Updates to examples to provide additional functionality

.gitignore

@@ -1,3 +1,4 @@
+ed-inputs/met3/US-WCr/ED_MET_DRIVER_HEADER
 ed-inputs/sites/US-WCr/rtm/1cohort/
 ed-inputs/sites/US-Syv/rtm/1cohort/
 run-ed/1cohort/
@@ -11,13 +12,17 @@ run-ed/template/ed_2.1
 
 # redr tests
 redr/tests/testthat/edr-testthat-outdir/
+redr_*
 
 # Deprecated code
 .deprecated/
 
 # Anything starting with .edr
 # (Use this is a prefix for EDR runtime directories)
 .edr*
+edr_prior_sensitivity/
+edr_*
+edr-*
 
 # System-specific configuration
 config.R

cleanup.sh

@@ -4,3 +4,6 @@
 rm -f config.R 
 rm -f ed-inputs/met3/US-WCr/ED_MET_DRIVER_HEADER
 rm -f ed-inputs/met3/US-Syv/ED_MET_DRIVER_HEADER
+
+rm -rf edr_prior_sensitivity/
+rm -rf edr_sensitivity/

examples/prior_sensitivity.R

@@ -1,3 +1,4 @@
+#--------------------------------------------------------------------------------------------------#
 source('config.R')
 
 library(tidyverse)
@@ -7,7 +8,17 @@ data(css_ex1)
 data(pss_ex1)
 data(site_ex1)
 
-prefix <- '.edr_prior_sensitivity'
+save_plot <- FALSE #TRUE/FALSE
+hidden <- TRUE #TRUE/FALSE
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+if (hidden) {
+  prefix <- '.edr_prior_sensitivity'
+} else {
+  prefix <- 'edr_prior_sensitivity'
+}
 
 css_bl_same_dbh <- extend_df(css_df, cohort = 1:3, dbh = 30, pft = c(9, 10, 11))
 genrun <- generate_run(prefix = prefix,
@@ -60,15 +71,36 @@ for (i in seq_len(nsamp)) {
     print(i)
     params <- sample_params_pft(pfts)
     arg_list <- params_df2list(params, prospect_version = 5)
+    #arg_list$par.wl <- 400:2499
+    #arg_list$nir.wl <- 2500
     albedo[,i] <- run_edr(prefix, edr_args = arg_list)
 }
+#--------------------------------------------------------------------------------------------------#
+
 
+#--------------------------------------------------------------------------------------------------#
 wl <- 400:2500
 mu <- rowMeans(albedo)
 lo <- apply(albedo, 1, quantile, 0.025)
 hi <- apply(albedo, 1, quantile, 0.975)
 
-matplot(wl, albedo, type='l', lty = 'dashed', col = 'grey')
-lines(wl, hi, col = 'red', lwd = 2)
-lines(wl, mu, col = 'black', lwd = 2)
-lines(wl, lo, col = 'red', lwd = 2)
+if (save_plot) {
+  png(file.path(prefix,'prior_sensitivity_test_albedo.png'),width=4900, height =2700,res=400)
+  par(mfrow=c(1,1), mar=c(4.3,4.5,1.0,1), oma=c(0.1,0.1,0.1,0.1)) # B L T R
+  matplot(wl, albedo, type='l', lty = 'dashed', col = 'grey')
+  lines(wl, hi, col = 'red', lwd = 2)
+  lines(wl, mu, col = 'black', lwd = 2)
+  lines(wl, lo, col = 'red', lwd = 2)
+  box(lwd=2.2)
+  dev.off()
+} else {
+  matplot(wl, albedo, type='l', lty = 'dashed', col = 'grey')
+  lines(wl, hi, col = 'red', lwd = 2)
+  lines(wl, mu, col = 'black', lwd = 2)
+  lines(wl, lo, col = 'red', lwd = 2)
+}
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+### EOF

examples/sensitivity_analysis.R

@@ -1,3 +1,4 @@
+#--------------------------------------------------------------------------------------------------#
 source('config.R')
 
 library(tidyverse)
@@ -7,7 +8,17 @@ data(css_ex1)
 data(pss_ex1)
 data(site_ex1)
 
-prefix <- '.edr_sensitivity'
+save_plot <- FALSE #TRUE/FALSE
+hidden <- TRUE #TRUE/FALSE
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+if (hidden) {
+  prefix <- '.edr_sensitivity'
+} else {
+  prefix <- 'edr_sensitivity'
+}
 
 css_bl_same_dbh <- extend_df(css_df, cohort = 1:3, dbh = 30, pft = c(9, 10, 11))
 genrun <- generate_run(prefix = prefix,
@@ -42,7 +53,10 @@ sensitivity <- function(base_params, pft, parameter, param_seq) {
         # This changes the value of one parameter for one PFT from a properly 
         # formatted parameter data.frame (like the `params` data.frame above)
         temp_params <- set_param(base_params, pft, parameter, param_seq[i])
-        albedo_mat[,i] <- run_edr(prefix, edr_args = params_df2list(temp_params))
+        arg_list <- params_df2list(temp_params)
+        #arg_list$par.wl <- 400:2499
+        #arg_list$nir.wl <- 2500
+        albedo_mat[,i] <- run_edr(prefix, edr_args = arg_list)
     }
     return(albedo_mat)
 }
@@ -52,8 +66,28 @@ N_seq <- seq(from = 1.1, to = 2.0, length.out = 10)
 early_N <- sensitivity(params, 'temperate.Early_Hardwood', 'N', N_seq)
 mid_N <- sensitivity(params, 'temperate.North_Mid_Hardwood', 'N', N_seq)
 late_N <- sensitivity(params, 'temperate.North_Mid_Hardwood', 'N', N_seq)
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+if (save_plot) { 
+  png(file.path(prefix,'Albedo_sensitivity_analysis_PROSPECT_N_param.png'),width=3100, height=1300, res=200)
+  par(mfrow=c(1,3), mar=c(4.3,4.5,1.0,1), oma=c(0.1,0.1,0.1,0.1)) # B L T R
+  matplot(early_N, type='l', main = 'Early Hardwood')
+  box(lwd=2.2)
+  matplot(mid_N, type='l', main = 'Mid Hardwood')
+  box(lwd=2.2)
+  matplot(late_N, type='l', main = 'Late Hardwood')
+  box(lwd=2.2)
+  dev.off()
+} else {
+  par(mfrow = c(1,3))
+  matplot(early_N, type='l', main = 'Early Hardwood')
+  matplot(mid_N, type='l', main = 'Mid Hardwood')
+  matplot(late_N, type='l', main = 'Late Hardwood')
+}
+#--------------------------------------------------------------------------------------------------#
+
 
-par(mfrow = c(1,3))
-matplot(early_N, type='l', main = 'Early Hardwood')
-matplot(mid_N, type='l', main = 'Mid Hardwood')
-matplot(late_N, type='l', main = 'Late Hardwood')
+#--------------------------------------------------------------------------------------------------#
+### EOF

examples/single_run.R

@@ -1,11 +1,22 @@
+#--------------------------------------------------------------------------------------------------#
 source('config.R')
 
 library(redr)
 
+save_plot <- FALSE #TRUE/FALSE
+hidden <- TRUE #TRUE/FALSE
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
 # This is the directory for storing all required elements for a single run.
 # It provides a shortcut for executing related instances of ED2 and EDR.
 # NOTE: Any directories starting with `.edr` will be automatically gitignored
-prefix <- '.edr-single-run'
+if (hidden) {
+  prefix <- '.edr-single-run'
+} else {
+  prefix <- 'edr-single-run'
+}
 
 # Load default css, pss, and site files
 data(css_ex1)   # css_df
@@ -50,8 +61,11 @@ edr_params_df <- tibble::tribble(
     'temperate.Late_Hardwood', 1.4, 20, 0.01, 0.01, 0.5, 0.5
     )
 edr_params_list <- params_df2list(edr_params_df, prospect_version = 4, pftcol = "pft", datetime = datetime)
+edr_params_list$par.wl <- 400:2499
+edr_params_list$nir.wl <- 2500
 str(edr_params_list)
 
+
 # Alternatively, can just pass a list in directly.
 # The list needs to contain, at a minimum:
 #   - `$spectra_list` -- Leaf spectra for each PFT, as a named list, with names 
@@ -64,3 +78,24 @@ str(edr_params_list)
 # Run EDR
 albedo <- run_edr(prefix, edr_params_list)
 head(albedo)
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+if (save_plot) { 
+  waves <- seq(400,2500,1)
+  png(file.path(prefix,'simulated_albedo.png'),width=4900, height =2700,res=400)
+  par(mfrow=c(1,1), mar=c(4.3,4.5,1.0,1), oma=c(0.1,0.1,0.1,0.1)) # B L T R
+  plot(waves,unlist(albedo)*100,type="l",lwd=3,ylim=c(0,65),xlab="Wavelength (nm)",ylab="Reflectance (%)",
+       cex.axis=1.5, cex.lab=1.7,col="black")
+  rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = 
+         "grey80")
+  lines(waves,unlist(albedo)*100,lwd=5, col="black")
+  dev.off()
+}
+
+#--------------------------------------------------------------------------------------------------#
+
+
+#--------------------------------------------------------------------------------------------------#
+### EOF

inversion/single_pft/tests/clumping_test.R

@@ -95,4 +95,4 @@ dev.off()
 
 
 #--------------------------------------------------------------------------------------------------#
-### EOF
+### EOF

redr/R/params_df2list.R

@@ -1,4 +1,4 @@
-#' @export
+##' @export
 params_df2list <- function(params_df, prospect_version = 4, pftcol = 'pft', datetime = as.POSIXlt('2004-07-01 12:00:00')) {
     stopifnot(pftcol %in% colnames(params_df))
     prospect_params_rxp <- 'N|Cab|Cbrown|Canth|Car|Cw|Cm'