Merge branch 'master' into generalized_agg_funs

Former-commit-id: cb14f1c

2_SWSF_p1of5_Settings_v51.R

@@ -45,6 +45,7 @@ debug.dump.objects <- interactive()
 #------Mode of framework
 minVersionRsoilwat <- "1.1.2"
 minVersion_dbWeather <- "3.1.0"
+use_rcpp <- TRUE
 num_cores <- 2
 parallel_backend <- "snow" #"snow" or "multicore" or "mpi"
 parallel_runs <- !interactive()
@@ -66,7 +67,7 @@ url.Rrepos <- "https://cran.us.r-project.org"
 dir.prj <- "~/YOURPROJECT"
 if (interactive()) setwd(dir.prj)
 dir.prj <- dir.big <- getwd()
-dir.code <- file.path(dir.prj, "R")
+dir.code <- dir.prj
 
 
 #parent folder containing external data
@@ -121,7 +122,7 @@ checkCompleteness <- FALSE
 check.blas <- FALSE
 
 #---Load functions (don't forget the C functions!)
-rSWSF <- file.path(dir.code, "2_SWSF_p5of5_Functions_v51.RData")
+rSWSF <- file.path(dir.code, "R", "2_SWSF_p5of5_Functions_v51.RData")
 if (!file.exists(rSWSF) || !continueAfterAbort) {
   sys.source(sub(".RData", ".R", rSWSF), envir = attach(NULL, name = "swsf_funs"))
   save(list = ls(name = "swsf_funs"), file = rSWSF)
@@ -534,4 +535,4 @@ if(any(actions == "create") || any(actions == "execute") || any(actions == "aggr
 ########################Source of the code base###############################
 
 if (!interactive())
-  source(file.path(dir.code, "2_SWSF_p4of5_Code_v51.R"), verbose = FALSE, chdir = FALSE)
+  source(file.path(dir.code, "R", "2_SWSF_p4of5_Code_v51.R"), verbose = FALSE, chdir = FALSE)

R/2_SWSF_p4of5_Code_v51.R

@@ -851,7 +851,7 @@ if(!be.quiet) print(paste("SWSF sets up the database: started at", t1 <- Sys.tim
 name.OutputDB <- file.path(dir.out, "dbTables.sqlite3")
 if(copyCurrentConditionsFromDatabase | copyCurrentConditionsFromTempSQL) name.OutputDBCurrent <- file.path(dir.out, "dbTables_current.sqlite3")
 setwd(dir.prj)
-source(file.path(dir.code, "2_SWSF_p2of5_CreateDB_Tables_v51.R"), verbose = FALSE, chdir = FALSE)
+source(file.path(dir.code, "R", "2_SWSF_p2of5_CreateDB_Tables_v51.R"), verbose = FALSE, chdir = FALSE)
 
 con <- RSQLite::dbConnect(RSQLite::SQLite(), dbname=name.OutputDB)
 
@@ -899,7 +899,7 @@ if(any(actions == "external") && any(exinfo[!grepl("GriddedDailyWeather", names(
 	if(!be.quiet) print(paste("SWSF extracts information from external datasets prior to simulation runs: started at", t1 <- Sys.time()))
 	stopifnot(file.exists(dir.external))
 
-	source(file.path(dir.code, "2_SWSF_p3of5_ExternalDataExtractions_v51.R"), verbose = FALSE, chdir = FALSE)
+	source(file.path(dir.code, "R", "2_SWSF_p3of5_ExternalDataExtractions_v51.R"), verbose = FALSE, chdir = FALSE)
   do_check_include <- TRUE
 
 	if(!be.quiet) print(paste("SWSF extracts information from external datasets prior to simulation runs: ended after",  round(difftime(Sys.time(), t1, units="secs"), 2), "s"))
@@ -1004,6 +1004,7 @@ if (any(unlist(pcalcs))) {
       has_changed <- FALSE
       sw_input_soils_data <- lapply(var_layers, function(x)
         as.matrix(sw_input_soils[runIDs_adjust_ws, grep(x, names(sw_input_soils))[ids_layers]]))
+      sw_input_soils_data2 <- NULL
 
       for (ils in seq_along(layer_sets)) {
         il_set <- avail_sl_ids == layer_sets[ils]
@@ -5874,8 +5875,8 @@ if(actionWithSoilWat && runsN_todo > 0){
     "tr_input_EvapCoeff", "tr_input_shiftedPPT", "tr_input_SnowD",
     "tr_input_TranspCoeff", "tr_input_TranspCoeff_Code", "tr_input_TranspRegions",
     "tr_prod", "tr_site", "tr_soil", "tr_VegetationComposition",
-    "tr_weather", "weatherin", "workersN", "yearsin")
-  list.export <- list.export[!duplicated(list.export)]
+    "tr_weather", "use_rcpp", "weatherin", "workersN", "yearsin")
+  #list.export <- list.export[!duplicated(list.export)]
 
   swsf_env <- new.env(parent = emptyenv())
   load(rSWSF, envir = swsf_env)
@@ -5901,7 +5902,7 @@ if(actionWithSoilWat && runsN_todo > 0){
 			mpi.bcast.cmd(library(RSQLite, quietly = TRUE))
 
       export_objects_to_workers(list.export, list_envs, "mpi")
-      mpi.bcast.cmd(source(file.path(dir.code, "SWSF_cpp_functions.R")))
+      mpi.bcast.cmd(source(file.path(dir.code, "R", "SWSF_cpp_functions.R")))
       if (print.debug) {
         mpi.bcast.cmd(print(paste("Slave", mpi.comm.rank(), "has", length(ls()), "objects")))
       }
@@ -6007,7 +6008,7 @@ tryCatch({
 			snow::clusterEvalQ(cl, library(RSQLite, quietly = TRUE))
 
       export_objects_to_workers(list.export, list_envs, "snow", cl)
-      snow::clusterEvalQ(cl, source(file.path(dir.code, "SWSF_cpp_functions.R")))
+      snow::clusterEvalQ(cl, source(file.path(dir.code, "R", "SWSF_cpp_functions.R")))
 			snow::clusterEvalQ(cl, Rsoilwat31::dbW_setConnection(dbFilePath = dbWeatherDataFile))
 
 			runs.completed <- foreach(i_sim=runIDs_todo, .combine="+", .inorder=FALSE) %dopar% {
@@ -6021,7 +6022,7 @@ tryCatch({
 		}
 
 		if (identical(parallel_backend, "multicore")) {
-      source(file.path(dir.code, "SWSF_cpp_functions.R"))
+      source(file.path(dir.code, "R", "SWSF_cpp_functions.R"))
 			Rsoilwat31::dbW_setConnection(dbFilePath = dbWeatherDataFile)
 
 			runs.completed <- foreach(i_sim=runIDs_todo, .combine="+", .inorder=FALSE, .noexport=list.noexport) %dopar% {
@@ -6034,7 +6035,7 @@ tryCatch({
 		}
 
 	} else { #call the simulations in serial
-		source(file.path(dir.code, "SWSF_cpp_functions.R"))
+		source(file.path(dir.code, "R", "SWSF_cpp_functions.R"))
 		Rsoilwat31::dbW_setConnection(dbFilePath = dbWeatherDataFile)
 		runs.completed <- 0
 

R/2_SWSF_p5of5_Functions_v51.R

@@ -129,7 +129,7 @@ file.copy2 <- compiler::cmpfun(function(from="", to="", overwrite=TRUE, copy.mod
 dir.create2 <- compiler::cmpfun(function(path, showWarnings = TRUE, recursive = FALSE, mode = "0777", times = 0) {
   dir.create(path, showWarnings, recursive, mode)
   if(times < 24)
-    if(!file.exists(path)) {
+    if(!dir.exists(path)) {
       print("trying to make directory again")
       Recall(path, showWarnings, TRUE, mode, (times+1)) #recursively call the function b/c when run on JANUS with MPI it doesn't seem to make the directories everytime... quite aggravating.
     }
@@ -2895,12 +2895,12 @@ update_biomass <- compiler::cmpfun(function(funct_veg = c("Grass", "Shrub", "Tre
   comps <- c("_Litter", "_Biomass", "_FractionLive", "_LAIconv")
   veg_ids = lapply(comps, function(x)
     grep(paste0(funct_veg, x), names(use)))
-  veg_incl = lapply(vegs_ids, function(x) use[x])
+  veg_incl = lapply(vegs_id, function(x) use[x])
 
   temp <- slot(prod_default, paste0("MonthlyProductionValues_", tolower(funct_veg)))
   if (any(unlist(veg_incl))) {
     for (k in seq_along(comps)) if (any(veg_incl[[k]]))
-      temp[veg_incl[[k]], k] <- prod_input[, veg_ids[[k]][veg_incl[[k]]]]
+      temp[veg_incl[[k]], k] <- as.numeric(prod_input[, veg_ids[[k]][veg_incl[[k]]]])
   }
 
   temp

R/SWSF_cpp_functions.R

@@ -29,8 +29,8 @@
 #'  \code{NA} for days when conditions were not evaluated, \code{TRUE} if all
 #'  relevant soil layers (columns) of \code{kill.conditions} were \code{TRUE}, and with
 #'  \code{FALSE} otherwise
-if (requireNamespace("Rcpp")) {
-  Rcpp::sourceCpp(file.path(dir.code, "..", "src", "GISSM_get_KilledBySoilLayers.cpp"))
+if (use_rcpp && requireNamespace("Rcpp")) {
+  Rcpp::sourceCpp(file.path(dir.code, "src", "GISSM_get_KilledBySoilLayers.cpp"))
 
 } else {
   get_KilledBySoilLayers <- compiler::cmpfun(function(relevantLayers, kill.conditions) {
@@ -44,8 +44,8 @@ if (requireNamespace("Rcpp")) {
 #' @setion: Note: The Rcpp version of the function is about 270x faster for vectors of
 #'  length 365 and 12,000x faster for vectors of length 11,000 than the R version.
 #'  The Rcpp version also reduced the memory footprint by a factor of >> 3080.
-if (requireNamespace("Rcpp")) {
-  Rcpp::sourceCpp(file.path(dir.code, "..", "src", "GISSM_germination_wait_times.cpp"))
+if (use_rcpp && requireNamespace("Rcpp")) {
+  Rcpp::sourceCpp(file.path(dir.code, "src", "GISSM_germination_wait_times.cpp"))
 
 } else {
   germination_wait_times <- compiler::cmpfun(function(time_to_germinate, duration_fave_cond) {
@@ -66,8 +66,8 @@ if (requireNamespace("Rcpp")) {
 
 #' @setion: Note: The Rcpp version of the function is about 4x faster than the R version.
 #'  The Rcpp version also reduced the memory footprint by a factor of 4.
-if (requireNamespace("Rcpp")) {
-  Rcpp::sourceCpp(file.path(dir.code, "..", "src", "GISSM_setFALSE_SeedlingSurvival_1stSeason.cpp"))
+if (use_rcpp && requireNamespace("Rcpp")) {
+  Rcpp::sourceCpp(file.path(dir.code, "src", "GISSM_setFALSE_SeedlingSurvival_1stSeason.cpp"))
 
 } else {
   setFALSE_SeedlingSurvival_1stSeason <- compiler::cmpfun(function(ss1s, ry_year_day, ry_useyrs, y, doy) {