Merge with upstream

.gitignore

@@ -75,3 +75,5 @@ shiny/BenchmarkReport/*
 .check/
 .test/
 .doc/
+# files generated by tests
+base/qaqc/tests/testthat/Rplots.pdf

CHANGELOG.md

@@ -22,6 +22,8 @@ For more information about this file see also [Keep a Changelog](http://keepacha
 - SIPNET output netcdf now includes LAI; some variable names changed to match standard
 - Cleanup of leap year logic, using new `PEcAn.utils::days_in_year(year)` function (#801).
 - Replace many hard-coded unit conversions with `udunits2::ud.convert` for consistency, readability, and clarity
+- Refactored extract_soil_nc to create soil2netcdf, which will write soil data out in PEcAn standard.
+- Added a new retry.func() to base/utils to provide ability to re-try a function X times before stopping.  Currently using this function in the download.CRUNCEP() function to handle slow responses from THREDDS.
 - Remote execution is more robust to errors in the submission process, not just the actual model execution
 
 ### Added

Makefile

@@ -1,6 +1,6 @@
 NCPUS ?= 1
 
-BASE := logger utils db settings visualization
+BASE := logger utils db settings visualization qaqc
 
 MODELS := biocro clm45 dalec ed fates gday jules linkages \
 				lpjguess maat maespa preles sipnet
@@ -13,27 +13,27 @@ MODULES := allometry assim.batch assim.sequential benchmark \
 BASE := $(BASE:%=base/%)
 MODELS := $(MODELS:%=models/%)
 MODULES := $(MODULES:%=modules/%)
-ALL_PKGS := $(BASE) $(MODULES) $(MODELS) models/template
+ALL_PKGS := $(BASE) $(MODULES) $(MODELS)
 
 BASE_I := $(BASE:%=.install/%)
 MODELS_I := $(MODELS:%=.install/%)
 MODULES_I := $(MODULES:%=.install/%)
-ALL_PKGS_I := $(BASE_I) $(MODULES_I) $(MODELS_I) .install/models/template
+ALL_PKGS_I := $(BASE_I) $(MODULES_I) $(MODELS_I)
 
 BASE_C := $(BASE:%=.check/%)
 MODELS_C := $(MODELS:%=.check/%)
 MODULES_C := $(MODULES:%=.check/%)
-ALL_PKGS_C := $(BASE_C) $(MODULES_C) $(MODELS_C) .check/models/template
+ALL_PKGS_C := $(BASE_C) $(MODULES_C) $(MODELS_C)
 
 BASE_T := $(BASE:%=.test/%)
 MODELS_T := $(MODELS:%=.test/%)
 MODULES_T := $(MODULES:%=.test/%)
-ALL_PKGS_T := $(BASE_T) $(MODULES_T) $(MODELS_T) .test/models/template
+ALL_PKGS_T := $(BASE_T) $(MODULES_T) $(MODELS_T)
 
 BASE_D := $(BASE:%=.doc/%)
 MODELS_D := $(MODELS:%=.doc/%)
 MODULES_D := $(MODULES:%=.doc/%)
-ALL_PKGS_D := $(BASE_D) $(MODULES_D) $(MODELS_D) .doc/models/template
+ALL_PKGS_D := $(BASE_D) $(MODULES_D) $(MODELS_D)
 
 .PHONY: all install check test document
 
@@ -55,6 +55,7 @@ depends = .doc/$(1) .install/$(1) .check/$(1) .test/$(1)
 $(call depends,base/db): .install/base/logger .install/base/utils
 $(call depends,base/settings): .install/base/logger .install/base/utils .install/base/db
 $(call depends,base/visualization): .install/base/logger .install/base/db
+$(call depends,base/qaqc): .install/base/logger
 $(call depends,modules/data.atmosphere): .install/base/logger .install/base/utils
 $(call depends,modules/data.land): .install/base/logger .install/base/db .install/base/utils
 $(call depends,modules/meta.analysis): .install/base/logger .install/base/utils .install/base/db
@@ -65,9 +66,6 @@ $(call depends,modules/uncertainty): .install/base/logger .install/base/utils .i
 $(call depends,models/template): .install/base/logger .install/base/utils
 $(call depends,models/biocro): .install/base/logger .install/base/utils .install/base/settings .install/base/db .install/modules/data.atmosphere .install/modules/data.land
 
-$(MODELS_I): .install/models/template
-
-
 clean:
 	rm -rf .install .check .test .doc
 	find modules/rtm/src \( -name \*.mod -o -name \*.o -o -name \*.so \) -delete

base/db/R/utils.R

@@ -81,7 +81,7 @@ db.open <- function(params) {
     args[['driver']] <- NULL
   }
 
-  c <- do.call(dbConnect, as.list(args))
+  c <- do.call(DBI::dbConnect, as.list(args))
   id <- sample(1000, size=1)
   while(length(which(.db.utils$connections$id==id)) != 0) {
     id <- sample(1000, size=1)
@@ -127,7 +127,7 @@ db.close <- function(con, showWarnings=TRUE) {
       .db.utils$connections$log <- .db.utils$connections$log[-deleteme]
     }
   }
-  dbDisconnect(con)
+  DBI::dbDisconnect(con)
 }
 
 ##' Debug method for db.open and db.close

base/qaqc/DESCRIPTION

@@ -16,3 +16,4 @@ LazyLoad: yes
 LazyData: FALSE
 Collate:
     'taylor.plot.R'
+RoxygenNote: 6.0.1

base/qaqc/NAMESPACE

@@ -0,0 +1,2 @@
+# Generated by roxygen2: do not edit by hand
+

base/utils/NAMESPACE

@@ -59,6 +59,7 @@ export(r2bugs.distributions)
 export(read.ensemble.output)
 export(read.output)
 export(read.sa.output)
+export(retry.func)
 export(rsync)
 export(run.write.configs)
 export(runModule.get.results)

base/utils/R/utils.R

@@ -332,6 +332,7 @@ get.parameter.stat <- function(mcmc.summary, parameter) {
               ucl = mcmc.summary$quantiles[parameter, c("97.5%")],
               n = 2)
 } # get.parameter.stat
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -364,6 +365,7 @@ pdf.stats <- function(distn, A, B) {
   out <- unlist(list(mean = mean, var = var, lcl = lcl, ucl = ucl))
   return(out)
 } # pdf.stats
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -416,6 +418,7 @@ tabnum <- function(x, n = 3) {
   names(ans) <- names(x)
   return(ans)
 } # tabnum
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -433,6 +436,7 @@ arrhenius.scaling <- function(observed.value, old.temp, new.temp = 25) {
   old.temp.K <- udunits2::ud.convert(old.temp, "degC", "K")
   return(observed.value / exp(3000 * (1 / (new.temp.K) - 1 / (old.temp.K))))
 } # arrhenius.scaling
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -442,14 +446,14 @@ arrhenius.scaling <- function(observed.value, old.temp, new.temp = 25) {
 ##' @param x string
 ##' @return x, capitalized
 ##' @author David LeBauer
-#--------------------------------------------------------------------------------------------------#
 capitalize <- function(x) {
   x <- as.character(x)
   s <- strsplit(x, " ")[[1]]
   return(paste(toupper(substring(s, 1, 1)), substring(s, 2), sep = "", collapse = " "))
 } # capitalize
 
 isFALSE <- function(x) !isTRUE(x)
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -475,6 +479,7 @@ newxtable <- function(x, environment = "table", table.placement = "ht", label =
         #        sanitize.text.function = function(x) gsub("%", "\\\\%", x),
         sanitize.rownames.function = function(x) paste(''))
 } # newxtable
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -486,11 +491,12 @@ newxtable <- function(x, environment = "table", table.placement = "ht", label =
 ##' @param year year of publication
 ##' @param title manuscript title
 ##' @return bibtex citation
-#--------------------------------------------------------------------------------------------------#
+##' @author unknown
 bibtexify <- function(author, year, title) {
   acronym <- abbreviate(title, minlength = 3, strict = TRUE)
   return(paste0(author, year, acronym))
 } # bibtexify
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -514,6 +520,7 @@ as.sequence <- function(x, na.rm = TRUE) {
   }
   return(x2)
 } # as.sequence
+#--------------------------------------------------------------------------------------------------#
 
 
 #--------------------------------------------------------------------------------------------------#
@@ -528,8 +535,10 @@ as.sequence <- function(x, na.rm = TRUE) {
 test.remote <- function(host) {
   return(try(remote.execute.cmd(host, "/bin/true")) == 0)
 } # test.remote
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' Create a temporary settings file
 ##'
 ##' Uses \code{\link{tempfile}} function to provide a valid temporary file (OS independent)
@@ -547,8 +556,10 @@ temp.settings <- function(settings.txt) {
   settings <- readLines(temp)
   return(settings)
 } # temp.settings
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' Test if function gives an error
 ##'
 ##' adaptation of try that returns a logical value (FALSE if error)
@@ -567,8 +578,10 @@ tryl <- function(FUN) {
   ans <- !any(class(out) == "error")
   return(ans)
 } # tryl
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' load model package
 ##' @title Load model package
 ##' @param model name of model
@@ -588,7 +601,10 @@ load.modelpkg <- function(model) {
     }
   }
 } # load.modelpkg
+#--------------------------------------------------------------------------------------------------#
 
+
+#--------------------------------------------------------------------------------------------------#
 ##' conversion function for the unit conversions that udunits cannot handle but often needed in PEcAn calculations
 ##' @title misc.convert
 ##' @export
@@ -624,8 +640,10 @@ misc.convert <- function(x, u1, u2) {
   }
   return(val)
 } # misc.convert
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' function to check whether units are convertible by misc.convert function
 ##' @title misc.are.convertible
 ##' @export
@@ -653,8 +671,10 @@ misc.are.convertible <- function(u1, u2) {
     return(FALSE)
   }
 }
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' Convert expression to variable names
 ##' @title convert.expr
 ##' @param expression expression string
@@ -678,8 +698,10 @@ convert.expr <- function(expression) {
 
   return(list(variable.drv = deri.var, variable.eqn = list(variables = variables, expression = deri.eqn)))
 }
+#--------------------------------------------------------------------------------------------------#
 
 
+#--------------------------------------------------------------------------------------------------#
 ##' Simple function to use ncftpget for FTP downloads behind a firewall.
 ##' Requires ncftpget and a properly formatted config file in the users
 ##' home directory
@@ -714,9 +736,54 @@ download.file <- function(url, filename, method) {
     utils::download.file(url, filename)
   }
 }
+#--------------------------------------------------------------------------------------------------#
+
 
+#--------------------------------------------------------------------------------------------------#
+##' Retry function X times before stopping in error
+##' 
+##' @title retry.func
+##' @name retry.func
+##' @description Retry function X times before stopping in error
+##'
+##' @param expr The function to try running
+##' @param maxErrors The number of times to retry the function
+##' @param sleep How long to wait before retrying the function call
+##' 
+##' @return retval returns the results of the function call
+##' 
+##' @examples
+##' \dontrun{
+##' dap <- retry.func(ncdf4::nc_open('https://thredds.daac.ornl.gov/thredds/dodsC/ornldaac/1220/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4'),
+##' maxErrors=10, sleep=2)
+##' }
+##' 
+##' @export
+##' @author Shawn Serbin <adapted from https://stackoverflow.com/questions/20770497/how-to-retry-a-statement-on-error>
+
+retry.func <- function(expr, isError=function(x) "try-error" %in% class(x), maxErrors=5, sleep=0) {
+  attempts = 0
+  retval = try(eval(expr))
+  while (isError(retval)) {
+    attempts = attempts + 1
+    if (attempts >= maxErrors) {
+      msg = sprintf("retry: too many retries [[%s]]", capture.output(str(retval)))
+      PEcAn.logger::logger.warn(msg)
+      stop(msg)
+    } else {
+      msg = sprintf("retry: error in attempt %i/%i [[%s]]", attempts, maxErrors, 
+                    capture.output(str(retval)))
+      PEcAn.logger::logger.warn(msg)
+      #warning(msg)
+    }
+    if (sleep > 0) Sys.sleep(sleep)
+    retval = try(eval(expr))
+  }
+  return(retval)
+}
+#--------------------------------------------------------------------------------------------------#
 
 
 ####################################################################################################
 ### EOF.  End of R script file.
-####################################################################################################
+####################################################################################################