Merge pull request #3601 from harshagr70/render_get.trait.data

Add flat-file bypass for get.trait.data()

Author: dlebauer

base/db/NAMESPACE

@@ -66,5 +66,6 @@ export(workflows)
 importFrom(magrittr,"%>%")
 importFrom(rlang,"!!!")
 importFrom(rlang,"!!")
+importFrom(rlang,"%||%")
 importFrom(rlang,":=")
 importFrom(rlang,.data)

base/db/R/get.trait.data.R

@@ -6,7 +6,12 @@
 ##' - `settings$database$bety`
 ##' - `settings$database$dbfiles`
 ##' - `settings$meta.analysis$update`
-##' 
+##'
+##' If either `input_file` or `settings$pfts$file_path` is provided,
+##'   it should be a valid path to a CSV (with at least columns
+##'   `name`, `distn`, `parama`, `paramb`, `n`) and will be used instead of
+##'   `database` for trait lookup.
+##'
 ##' @param pfts the list of pfts to get traits for
 ##' @param modeltype type of model that is used, this is is used to distinguish
 ##'   between different PFTs with the same name.
@@ -21,30 +26,69 @@
 ##' @param trait.names Character vector of trait names to search. If
 ##'   `NULL` (default), use all traits that have a prior for at least
 ##'   one of the `pfts`.
+##' @param input_file Path to a CSV file containing prior information.
+##'   If specified, `database` is not used.
 ##' @return list of PFTs with update posteriorids
 ##' @author David LeBauer, Shawn Serbin, Alexey Shiklomanov
+##' @importFrom rlang %||%
 ##' @export
-get.trait.data <-
-  function(pfts,
-           modeltype,
-           dbfiles,
-           database,
-           forceupdate,
-           write = FALSE,
-           trait.names = NULL) {
-    
+get.trait.data <- function(pfts,
+                           modeltype,
+                           dbfiles,
+                           database,
+                           forceupdate,
+                           write = FALSE,
+                           trait.names = NULL,
+                           input_file = NULL) {
   if (!is.list(pfts)) {
-    PEcAn.logger::logger.severe('pfts must be a list')
+    PEcAn.logger::logger.severe("pfts must be a list")
   }
   # Check that all PFTs have associated outdir entries
-  pft_outdirs <- lapply(pfts, '[[', 'outdir')
+  pft_outdirs <- lapply(pfts, "[[", "outdir")
   if (any(sapply(pft_outdirs, is.null))) {
-    PEcAn.logger::logger.severe('At least one pft in settings is missing its "outdir"')
+    PEcAn.logger::logger.severe("At least one pft in settings is missing its `outdir`")
+  }
+
+  #check for flatfile path, if present use it
+  file_path <- input_file %||% pfts$file_path
+  if (!is.null(file_path)) {
+    if (!file.exists(file_path)) {
+      PEcAn.logger::logger.error("trait data file not found at specified path", sQuote(file_path))
+    }
+    PEcAn.logger::logger.info("Using flat file for trait data instead of database")
+
+    # Load flat file as data.frame
+    trait_data_flat <- utils::read.csv(file_path, stringsAsFactors = FALSE)
+
+    # Build trait.names from flat file if not already provided
+    if (is.null(trait.names)) {
+      pft_names <- vapply(pfts, "[[", character(1), "name")
+      pft_ids <- unique(trait_data_flat$pft_id[
+        trait_data_flat$pft_name %in% pft_names &
+          trait_data_flat$pft_type == modeltype
+      ])
+      trait.names <- unique(trait_data_flat$trait_name[
+        trait_data_flat$pft_id %in% pft_ids
+      ])
+    }
+
+    # Call get.trait.data.pft with trait_data instead of dbcon
+    result <- lapply(pfts, get.trait.data.pft,
+                     modeltype   = modeltype,
+                     dbfiles     = dbfiles,
+                     dbcon       = NULL,
+                     trait_data  = trait_data_flat,
+                     write       = write,
+                     forceupdate = forceupdate,
+                     trait.names = trait.names)
+
+    return(invisible(result))
   }
-  
+
+
   dbcon <- db.open(database)
   on.exit(db.close(dbcon), add = TRUE)
-  
+
   if (is.null(trait.names)) {
     PEcAn.logger::logger.debug(paste0(
       "`trait.names` is NULL, so retrieving all traits ",
@@ -55,15 +99,15 @@ get.trait.data <-
     # NOTE: Use `format` here to avoid implicit (incorrect) coercion
     # to double by `lapply`. This works fine if we switch to
     # `query_priors`, but haven't done so yet because that requires
-    # prepared statements and therefore requires the Postgres driver. 
+    # prepared statements and therefore requires the Postgres driver.
     all_priors_list <- lapply(format(pft_ids, scientific = FALSE), query.priors,
                               con = dbcon, trstr = trait.names)
     trait.names <- unique(unlist(lapply(all_priors_list, rownames)))
     # Eventually, can replace with this:
     # all_priors <- query_priors(pfts, params = database)
     # trait.names <- unique(all_priors[["name"]])
   }
-  
+
   # process all pfts
   result <- lapply(pfts, get.trait.data.pft,
                    modeltype = modeltype,
@@ -72,6 +116,6 @@ get.trait.data <-
                    write = write,
                    forceupdate = forceupdate,
                    trait.names = trait.names)
-  
+
   invisible(result)
-}
+}