Hf landscape updates [WIP]

base/workflow/R/run.write.configs.R

@@ -11,6 +11,7 @@
 #' @param posterior.files Filenames for posteriors for drawing samples for ensemble and sensitivity
 #'    analysis (e.g. post.distns.Rdata, or prior.distns.Rdata)
 #' @param overwrite logical: Replace output files that already exist?
+#' @param use.existing.samples FALSE (default), TRUE, or filename
 #'
 #' @details The default value for \code{posterior.files} is NA, in which case the
 #'    most recent posterior or prior (in that order) for the workflow is used.
@@ -24,7 +25,7 @@
 #' @author David LeBauer, Shawn Serbin, Ryan Kelly, Mike Dietze
 run.write.configs <- function(settings, write = TRUE, ens.sample.method = "uniform", 
                               posterior.files = rep(NA, length(settings$pfts)), 
-                              overwrite = TRUE) {
+                              overwrite = TRUE,use.existing.samples=FALSE) {
   tryCatch({
     con <- PEcAn.DB::db.open(settings$database$bety)
     on.exit(PEcAn.DB::db.close(con), add = TRUE)
@@ -34,57 +35,68 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo
       conditionMessage(e))
   })
 
-  ## Which posterior to use?
-  for (i in seq_along(settings$pfts)) {
-    ## if posterior.files is specified us that
-    if (is.na(posterior.files[i])) {
-      ## otherwise, check to see if posteriorid exists
-      if (!is.null(settings$pfts[[i]]$posteriorid)) {
-        #TODO: sometimes `files` is a 0x0 tibble and other operations with it fail.
-        files <- PEcAn.DB::dbfile.check("Posterior",
-                                        settings$pfts[[i]]$posteriorid, 
-                                        con, settings$host$name, return.all = TRUE)
-        pid <- grep("post.distns.*Rdata", files$file_name)  ## is there a posterior file?
-        if (length(pid) == 0) {
-          pid <- grep("prior.distns.Rdata", files$file_name)  ## is there a prior file?
-        }
-        if (length(pid) > 0) {
-          posterior.files[i] <- file.path(files$file_path[pid], files$file_name[pid])
-        }  ## otherwise leave posteriors as NA
-      }
-      ## otherwise leave NA and get.parameter.samples will look for local
-    } else {
-      ## does posterior.files point to a directory instead of a file?
-      if(utils::file_test("-d",posterior.files[i])){
-        pfiles = dir(posterior.files[i],pattern = "post.distns.*Rdata",full.names = TRUE)
-        if(length(pfiles)>1){
-          pid = grep("post.distns.Rdata",pfiles)
-          if(length(pid > 0)){
-            pfiles = pfiles[grep("post.distns.Rdata",pfiles)]
-          } else {
-            PEcAn.logger::logger.error(
-              "run.write.configs: could uniquely identify posterior files within",
-              posterior.files[i])
-          }
-          posterior.files[i] = pfiles
-        }
-      }
-      ## also, double check PFT outdir exists
-      if (is.null(settings$pfts[[i]]$outdir) || is.na(settings$pfts[[i]]$outdir)) {
-        ## no outdir
-        settings$pfts[[i]]$outdir <- file.path(settings$outdir, "pfts", settings$pfts[[i]]$name)
-      }
-    }  ## end else
-  } ## end for loop over pfts
-
-  ## Sample parameters
   model <- settings$model$type
   scipen <- getOption("scipen")
   options(scipen = 12)
-
-  PEcAn.uncertainty::get.parameter.samples(settings, posterior.files, ens.sample.method)
-  load(file.path(settings$outdir, "samples.Rdata")) ## loads ensemble.samples, trait.samples, sa.samples, runs.samples, env.samples
 
+  ## Which posterior to use?
+  if(is.logical(use.existing.samples)){
+    if(use.existing.samples & file.exists(file.path(settings$outdir, "samples.Rdata"))){
+      load(file.path(settings$outdir, "samples.Rdata")) ## loads ensemble.samples, trait.samples, sa.samples, runs.samples, env.samples
+    } else {
+      for (i in seq_along(settings$pfts)) {
+        ## if posterior.files is specified us that
+        if (is.na(posterior.files[i])) {
+          ## otherwise, check to see if posteriorid exists
+          if (!is.null(settings$pfts[[i]]$posteriorid)) {
+            #TODO: sometimes `files` is a 0x0 tibble and other operations with it fail.
+            files <- PEcAn.DB::dbfile.check("Posterior",
+                                            settings$pfts[[i]]$posteriorid, 
+                                            con, settings$host$name, return.all = TRUE)
+            pid <- grep("post.distns.*Rdata", files$file_name)  ## is there a posterior file?
+            if (length(pid) == 0) {
+              pid <- grep("prior.distns.Rdata", files$file_name)  ## is there a prior file?
+            }
+            if (length(pid) > 0) {
+              posterior.files[i] <- file.path(files$file_path[pid], files$file_name[pid])
+            }  ## otherwise leave posteriors as NA
+          }
+          ## otherwise leave NA and get.parameter.samples will look for local
+        } else {
+          ## does posterior.files point to a directory instead of a file?
+          if(utils::file_test("-d",posterior.files[i])){
+            pfiles = dir(posterior.files[i],pattern = "post.distns.*Rdata",full.names = TRUE)
+            if(length(pfiles)>1){
+              pid = grep("post.distns.Rdata",pfiles)
+              if(length(pid > 0)){
+                pfiles = pfiles[grep("post.distns.Rdata",pfiles)]
+              } else {
+                PEcAn.logger::logger.error(
+                  "run.write.configs: could uniquely identify posterior files within",
+                  posterior.files[i])
+              }
+              posterior.files[i] = pfiles
+            }
+          }
+          ## also, double check PFT outdir exists
+          if (is.null(settings$pfts[[i]]$outdir) || is.na(settings$pfts[[i]]$outdir)) {
+            ## no outdir
+            settings$pfts[[i]]$outdir <- file.path(settings$outdir, "pfts", settings$pfts[[i]]$name)
+          }
+        }  ## end else
+      } ## end for loop over pfts
+
+      ## Sample parameters
+      PEcAn.uncertainty::get.parameter.samples(settings, posterior.files, ens.sample.method)
+      load(file.path(settings$outdir, "samples.Rdata")) ## loads ensemble.samples, trait.samples, sa.samples, runs.samples, env.samples
+
+      ## end use.existing.samples == FALSE
+    } ## is.logical(use.existing.samples)
+  } else {
+    ### use.existing.samples must be a filename
+    load(use.existing.samples)
+  }
+
   ## remove previous runs.txt
   if (overwrite && file.exists(file.path(settings$rundir, "runs.txt"))) {
     PEcAn.logger::logger.warn("Existing runs.txt file will be removed.")

base/workflow/R/runModule.run.write.configs.R

@@ -2,16 +2,17 @@
 #'
 #' @param settings a PEcAn Settings or MultiSettings object
 #' @param overwrite logical: Replace config files if they already exist?
+#' @param use.existing.samples FALSE (default), TRUE, or filename
 #' @return A modified settings object, invisibly
 #' @export
-runModule.run.write.configs <- function(settings, overwrite = TRUE) {
+runModule.run.write.configs <- function(settings, overwrite = TRUE, use.existing.samples = TRUE) {
 
   if (PEcAn.settings::is.MultiSettings(settings)) {
     if (overwrite && file.exists(file.path(settings$rundir, "runs.txt"))) {
       PEcAn.logger::logger.warn("Existing runs.txt file will be removed.")
       unlink(file.path(settings$rundir, "runs.txt"))
     }
-    return(PEcAn.settings::papply(settings, runModule.run.write.configs, overwrite = FALSE))
+    return(PEcAn.settings::papply(settings, runModule.run.write.configs, overwrite = overwrite,use.existing.samples=use.existing.samples))
   } else if (PEcAn.settings::is.Settings(settings)) {
     write <- settings$database$bety$write
     # double check making sure we have method for parameter sampling
@@ -27,7 +28,12 @@ runModule.run.write.configs <- function(settings, overwrite = TRUE) {
       }) %>%
       unlist()
 
-    return(PEcAn.workflow::run.write.configs(settings, write, ens.sample.method, posterior.files = posterior.files, overwrite = overwrite))
+    return(PEcAn.workflow::run.write.configs(settings, 
+                                             write, 
+                                             ens.sample.method, 
+                                             posterior.files = posterior.files, 
+                                             overwrite = overwrite, 
+                                             use.existing.samples = use.existing.samples))
   } else {
     stop("runModule.run.write.configs only works with Settings or MultiSettings")
   }

models/sipnet/R/model2netcdf.SIPNET.R

@@ -103,7 +103,7 @@ sipnet2datetime <- function(sipnet_tval, base_year, base_month = 1,
 ##' @export
 ##' @author Shawn Serbin, Michael Dietze
 model2netcdf.SIPNET <- function(outdir, sitelat, sitelon, start_date, end_date, delete.raw = FALSE, revision, prefix = "sipnet.out",
-                                overwrite = FALSE, conflict = FALSE) {
+                                overwrite = FALSE, conflict = TRUE) {
 
   ### Read in model output in SIPNET format
   sipnet_out_file <- file.path(outdir, prefix)
@@ -323,4 +323,4 @@ model2netcdf.SIPNET <- function(outdir, sitelat, sitelon, start_date, end_date,
   }
 } # model2netcdf.SIPNET
 #--------------------------------------------------------------------------------------------------#
-### EOF
+### EOF