Merge branch 'master' of github-BGC:bgctw/REddyProc

closes EarthyScience#32, closes EarthyScience#34

NAMESPACE

@@ -168,6 +168,7 @@ importFrom(stats,quantile)
 importFrom(stats,resid)
 importFrom(stats,rnorm)
 importFrom(stats,sd)
+importFrom(stats,setNames)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
 importFrom(utils,capture.output)

R/EddyPartitioning.R

@@ -3,12 +3,16 @@
 sEddyProc_sGLFluxPartitionUStarScens <- function(
   ### Flux partitioning after Lasslop et al. (2010)
   ...  ##<< arguments to \code{\link{sEddyProc_sGLFluxPartition}}
+  , uStarScenKeep = character(0) ##<< Scalar string specifying the scenario
+  ## for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+  ## Defaults to the first scenario.
 ) {
   ##details<<
   ## Daytime-based partitioning of measured net ecosystem fluxes into
   ## gross primary production (GPP) and ecosystem respiration (Reco)
   ## for all u* threshold scenarios.
-  tmp <- sApplyUStarScen( .self$sGLFluxPartition, ... )
+  tmp <- sApplyUStarScen(
+    .self$sGLFluxPartition, ..., uStarScenKeep = uStarScenKeep)
   NULL
 }
 sEddyProc$methods(
@@ -67,12 +71,16 @@ sEddyProc$methods(sGLFluxPartition = sEddyProc_sGLFluxPartition)
 sEddyProc_sTKFluxPartitionUStarScens <- function(
   ### Flux partitioning after Lasslop 2015
   ...  ##<< arguments to \code{\link{sEddyProc_sTKFluxPartition}}
+  , uStarScenKeep = character(0) ##<< Scalar string specifying the scenario
+  ## for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+  ## Defaults to the first scenario.
 ) {
   ##details<<
   ## Daytime-based partitioning of measured net ecosystem fluxes into
   ## gross primary production (GPP) and ecosystem respiration (Reco)
   ## for all u* threshold scenarios.
-  tmp <- sApplyUStarScen( .self$sTKFluxPartition, ... )
+  tmp <- sApplyUStarScen(
+    .self$sTKFluxPartition, ..., uStarScenKeep = uStarScenKeep )
   NULL
 }
 sEddyProc$methods(
@@ -98,12 +106,16 @@ sEddyProc$methods(sTKFluxPartition = sEddyProc_sTKFluxPartition)
 sEddyProc_sMRFluxPartitionUStarScens <- function(
   ### Flux partitioning after Reichstein et al. (2005)
   ...  ##<< arguments to \code{\link{sEddyProc_sMRFluxPartition}}
+  , uStarScenKeep = character(0) ##<< Scalar string specifying the scenario
+  ## for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+  ## Defaults to the first scenario.
 ) {
   ##details<<
   ## Nighttime-based partitioning of measured net ecosystem fluxes into
   ## gross primary production (GPP) and ecosystem respiration (Reco)
   ## for all u* threshold scenarios.
-  tmp <- sApplyUStarScen( .self$sMRFluxPartition, ... )
+  tmp <- sApplyUStarScen(
+    .self$sMRFluxPartition, ..., uStarScenKeep = uStarScenKeep)
   ##value<< NULL, it adds output columns in the class
   invisible(tmp)
 }

R/EddyUStarFilterDP.R

@@ -1404,11 +1404,25 @@ sEddyProc_sApplyUStarScen <- function(
   ### apply a function with changing the suffix argument
   FUN  ##<< function to be applied
   , ...  ##<< further arguments to FUN
+  , uStarScenKeep = character(0) ##<< Scalar string specifying the scenario
+  ## for which to keep parameters. If not specified defaults to the first
+  ## entry in \code{uStarSuffixes}.
 ) {
+  ##details<<
+  ## When repeating computations, some of the
+  ## output variables maybe replaced. Argument \code{uStarKeep}
+  ## allows to select the scenario which is computed last,
+  ## and hence to which ouptut columns refer to.
   uStarSuffixes = colnames(.self$sGetUstarScenarios())[-1]
-  resScen <- setNames(lapply(uStarSuffixes, function(suffix){
+  if (length(uStarScenKeep) != 1) uStarScenKeep = uStarSuffixes[1]
+  iKeep = match(uStarScenKeep, uStarSuffixes)
+  if (is.na(iKeep)) stop(
+    "Provided uStarScenKeep=",uStarScenKeep," was not among Scenarios: "
+    ,paste(uStarSuffixes,collapse = ","))
+  uStarSuffixesOrdered = c(uStarSuffixes[iKeep], uStarSuffixes[-iKeep])
+  resScen <- setNames(rev(lapply(rev(uStarSuffixesOrdered), function(suffix){
     FUN(..., suffix = suffix)
-  }), uStarSuffixes)
+  })), uStarSuffixesOrdered)
 }
 sEddyProc$methods(sApplyUStarScen =
                     sEddyProc_sApplyUStarScen)

R/Example.R

@@ -31,8 +31,14 @@ getExamplePath <- function(
     if (file.access(exampleDir, mode = 2) != 0) stop(
       "target example directory ", exampleDir, " is not writeable.")
     url <- file.path(remoteDir, filename)
-    retCode <- suppressWarnings(try(download.file(url, fullname, quiet = TRUE)
-                                    , silent = TRUE))
+    retCode <- suppressWarnings(try(
+      download.file(url, fullname, quiet = TRUE)
+      , silent = TRUE))
+    # on Windows may fail because of root certificates, retry with curl
+    if (inherits(retCode, "try-error"))
+        retCode <- suppressWarnings(try(
+          download.file(url, fullname, quiet = TRUE, method = "curl")
+          , silent = TRUE))
     if (!inherits(retCode, "try-error") && retCode == 0) return(fullname)
   }
   ##value<< the full path name to the example data or if not available

R/imports.R

@@ -14,7 +14,7 @@ NULL
 #' @importFrom graphics abline axis box close.screen curve image legend lines
 #'        mtext par plot points polygon screen split.screen
 #' @importFrom stats aggregate anova approx coef cor cov lm median na.omit
-#'        nls nls.control optim predict quantile resid rnorm sd
+#'        nls nls.control optim predict quantile resid rnorm sd setNames
 #' @importFrom utils capture.output download.file read.csv recover write.table
 #' @importFrom stats plogis qlogis
 NULL

man/sEddyProc_sApplyUStarScen.Rd

@@ -2,12 +2,18 @@
 \alias{sEddyProc_sApplyUStarScen}
 \title{sEddyProc sApplyUStarScen}
 \description{apply a function with changing the suffix argument}
-\usage{sEddyProc_sApplyUStarScen(FUN, ...)}
+\usage{sEddyProc_sApplyUStarScen(FUN, ..., uStarScenKeep = character(0))}
 \arguments{
   \item{FUN}{function to be applied}
   \item{\dots}{further arguments to FUN}
+  \item{uStarScenKeep}{Scalar string specifying the scenario
+for which to keep parameters. If not specified defaults to the first
+entry in \code{uStarSuffixes}.}
 }
-
+\details{When repeating computations, some of the
+output variables maybe replaced. Argument \code{uStarKeep}
+allows to select the scenario which is computed last,
+and hence to which ouptut columns refer to.}
 
 
 \author{Department for Biogeochemical Integration at MPI-BGC, Jena, Germany <REddyProc-help@bgc-jena.mpg.de> [cph], Thomas Wutzler <twutz@bgc-jena.mpg.de> [aut, cre], Markus Reichstein <mreichstein@bgc-jena.mpg.de> [aut], Antje Maria Moffat <antje.moffat@bgc.mpg.de> [aut, trl], Olaf Menzer <omenzer@bgc-jena.mpg.de> [ctb], Mirco Migliavacca <mmiglia@bgc-jena.mpg.de> [aut], Kerstin Sickel <ksickel@bgc-jena.mpg.de> [ctb, trl], Ladislav Šigut <sigut.l@czechglobe.cz> [ctb]}

man/sEddyProc_sGLFluxPartitionUStarScens.Rd

@@ -2,9 +2,13 @@
 \alias{sEddyProc_sGLFluxPartitionUStarScens}
 \title{sEddyProc sGLFluxPartitionUStarScens}
 \description{Flux partitioning after Lasslop et al. (2010)}
-\usage{sEddyProc_sGLFluxPartitionUStarScens(...)}
+\usage{sEddyProc_sGLFluxPartitionUStarScens(..., 
+    uStarScenKeep = character(0))}
 \arguments{
   \item{\dots}{arguments to \code{\link{sEddyProc_sGLFluxPartition}}}
+  \item{uStarScenKeep}{Scalar string specifying the scenario
+for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+Defaults to the first scenario.}
 }
 \details{Daytime-based partitioning of measured net ecosystem fluxes into
 gross primary production (GPP) and ecosystem respiration (Reco)

man/sEddyProc_sMRFluxPartitionUStarScens.Rd

@@ -2,9 +2,13 @@
 \alias{sEddyProc_sMRFluxPartitionUStarScens}
 \title{sEddyProc sMRFluxPartitionUStarScens}
 \description{Flux partitioning after Reichstein et al. (2005)}
-\usage{sEddyProc_sMRFluxPartitionUStarScens(...)}
+\usage{sEddyProc_sMRFluxPartitionUStarScens(..., 
+    uStarScenKeep = character(0))}
 \arguments{
   \item{\dots}{arguments to \code{\link{sEddyProc_sMRFluxPartition}}}
+  \item{uStarScenKeep}{Scalar string specifying the scenario
+for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+Defaults to the first scenario.}
 }
 \details{Nighttime-based partitioning of measured net ecosystem fluxes into
 gross primary production (GPP) and ecosystem respiration (Reco)

man/sEddyProc_sTKFluxPartitionUStarScens.Rd

@@ -2,9 +2,13 @@
 \alias{sEddyProc_sTKFluxPartitionUStarScens}
 \title{sEddyProc sTKFluxPartitionUStarScens}
 \description{Flux partitioning after Lasslop 2015}
-\usage{sEddyProc_sTKFluxPartitionUStarScens(...)}
+\usage{sEddyProc_sTKFluxPartitionUStarScens(..., 
+    uStarScenKeep = character(0))}
 \arguments{
   \item{\dots}{arguments to \code{\link{sEddyProc_sTKFluxPartition}}}
+  \item{uStarScenKeep}{Scalar string specifying the scenario
+for which to keep parameters (see \code{\link{sEddyProc_sApplyUStarScen}}.
+Defaults to the first scenario.}
 }
 \details{Daytime-based partitioning of measured net ecosystem fluxes into
 gross primary production (GPP) and ecosystem respiration (Reco)

man/sEddyProc_useSeaonsalUStarThresholds.Rd

@@ -11,5 +11,5 @@
 
 
 \seealso{\code{\link{sEddyProc_sSetUstarScenarios}},
-\code{\link{sEddyProc_useSeaonsalUStarThresholds}}}
+\code{\link{sEddyProc_useAnnualUStarThresholds}}}
 

tests/testthat/test_uStarProc.R

@@ -23,35 +23,60 @@ rm( EddyData99.F )
 
 test_that("UStarProcessing",{
   skip_on_cran()
-  EddyProc.C <- sEddyProc$new(
+  EProc <- sEddyProc$new(
     'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg', 'Tair', 'VPD', 'Ustar'))
-  EddyProc.C$sEstimateUstarScenarios(
+  EProc$sEstimateUstarScenarios(
     nSample = 30L, probs = c(0.1, 0.5, 0.9))
-  uStarScen <- EddyProc.C$sGetUstarScenarios()
+  uStarScen <- EProc$sGetUstarScenarios()
   expect_equal( colnames(uStarScen), c("season", "uStar", "U10", "U50", "U90"))
   # omit the uStar scenario
-  EddyProc.C$sSetUstarScenarios(uStarScen[-2])
-  uStarScen <- EddyProc.C$sGetUstarScenarios()
+  EProc$sSetUstarScenarios(uStarScen[-2])
+  uStarScen <- EProc$sGetUstarScenarios()
   expect_equal( colnames(uStarScen), c("season", "U10", "U50", "U90"))
   # go on with processing without the need to specify scenarios again
-  EddyProc.C$sMDSGapFillUStarScens("NEE")
-  dsFilled <- EddyProc.C$sExportResults()
+  EProc$sMDSGapFillUStarScens("NEE")
+  dsFilled <- EProc$sExportResults()
   expect_true(all(
     c("NEE_U10_f","NEE_U50_f","NEE_U90_f") %in% colnames(dsFilled)))
   expect_true(all(
     c("NEE_U10_fqc","NEE_U50_fqc","NEE_U90_fqc") %in% colnames(dsFilled)))
   expect_true(!any(c("NEE_f","NEE_uStar_f") %in% colnames(dsFilled)))
   # MR flux partitioning
-  EddyProc.C$sSetLocationInfo(LatDeg = 51.0, LongDeg = 13.6, TimeZoneHour = 1)
-  EddyProc.C$sMDSGapFill('Tair', FillAll.b = FALSE)
-  EddyProc.C$sMDSGapFill('VPD', FillAll.b = FALSE)
-  #EddyProc.C$sApplyUStarScen( EddyProc.C$sMRFluxPartition )
-  EddyProc.C$sMRFluxPartitionUStarScens()
-  dsFilled <- EddyProc.C$sExportResults()
+  EProc$sSetLocationInfo(LatDeg = 51.0, LongDeg = 13.6, TimeZoneHour = 1)
+  EProc$sMDSGapFill('Tair', FillAll.b = FALSE)
+  EProc$sMDSGapFill('VPD', FillAll.b = FALSE)
+  #EProc$sApplyUStarScen( EProc$sMRFluxPartition )
+  EProc$sMRFluxPartitionUStarScens()
+  dsFilled <- EProc$sExportResults()
   expect_true(all(
     c("GPP_U10_f","GPP_U50_f","GPP_U90_f") %in% colnames(dsFilled)))
   expect_true(all(
     c("GPP_U10_fqc","GPP_U50_fqc","GPP_U90_fqc") %in% colnames(dsFilled)))
   expect_true(!any(c("GPP_f","GPP_uStar_f") %in% colnames(dsFilled)))
 })
 
+test_that("sApplyUStarScen",{
+  skip_on_cran()
+  EProc <- sEddyProc$new(
+    'DE-Tha', EddyDataWithPosix.F, c('NEE','Rg', 'Tair', 'VPD', 'Ustar'))
+  EProc$sEstimateUstarScenarios(
+    nSample = 30L, probs = c(0.1, 0.5, 0.9))
+  uStarScen <- EProc$sGetUstarScenarios()
+  scenKept <- scenFirst <- colnames(uStarScen)[2]
+  #
+  # by default suffix of first scenario is kept
+  res = unlist(EProc$sApplyUStarScen(function(suffix){EProc$sTEMP$suffix <- suffix}))
+  expect_equal(scenKept, unname(res[1]))
+  expect_equal(scenKept, EProc$sTEMP$suffix[1])
+  #
+  # specify different one
+  scenKept <- colnames(uStarScen)[3]
+  res = unlist(EProc$sApplyUStarScen(
+    function(suffix){EProc$sTEMP$suffix <- suffix}
+    , uStarScenKeep = scenKept
+    ))
+  expect_equal(scenKept, unname(res[1]))
+  expect_equal(scenKept, EProc$sTEMP$suffix[1])
+})
+
+

vignettes/uStarCases.Rmd

@@ -19,7 +19,7 @@ knitr::opts_chunk$set(eval = !is_check)
 
 ```{r setup, include = FALSE}
 library(knitr)
-#rmarkdown::render("vignettes/uStarCases.Rmd")
+#rmarkdown::render("vignettes/uStarCases.Rmd","md_document")
 opts_knit$set(root.dir = '..')
 opts_chunk$set(
     #, fig.align = "center"
@@ -116,7 +116,7 @@ Output columns use the suffix as specified by argument `uSstarSuffix`
 which defaults to "uStar".
 
 ```{r singleUStarGapfill, message = FALSE}
-#usGetAnnualSeasonUStarMap(EProc$sUSTAR_DETAILS$uStarTh)
+#EProc$useAnnualUStarThresholds()
 EProc$sMDSGapFillAfterUstar('NEE')
 grep("NEE.*_f$",names(EProc$sExportResults()), value = TRUE)
 ```
@@ -175,11 +175,21 @@ grep("NEE_.*_f$",names(EProc$sExportResults()), value = TRUE)
 ```{r uStarScenMRPart, message=FALSE}
 EProc$sSetLocationInfo(LatDeg = 51.0, LongDeg = 13.6, TimeZoneHour = 1)
 EProc$sMDSGapFill('Tair', FillAll = FALSE, minNWarnRunLength = NA)
+EProc$sMDSGapFill('Rg', FillAll = FALSE, minNWarnRunLength = NA)
 EProc$sMDSGapFill('VPD', FillAll = FALSE, minNWarnRunLength = NA)
 EProc$sMRFluxPartitionUStarScens()
 grep("GPP_.*_f$",names(EProc$sExportResults()), value = TRUE)
+if (FALSE) {
+  # run only interactively, because it takes long
+  EProc$sGLFluxPartitionUStarScens(uStarScenKeep = "U50")
+  grep("GPP_DT_.*_f$",names(EProc$sExportResults()), value = TRUE)
+}
 ```
 
+The argument `uStarScenKeep = "U50"` specifies that the outputs that
+are not distinguished by the suffix, e.g. `FP_GPP2000`, should be reported for the
+median u* threshold scenario with suffix `U50`, instead of the default first scenario.
+
 ## See also
 A more advanced case of user-specified seasons for
 uStar threshold estimate is given in [`vignette('DEGebExample')`](DEGebExample.html).