Fix for check of REF within states

R/biomass_new.R

@@ -63,8 +63,8 @@ bioStarter <- function(x,
     warning(paste('Method', method,
                   'unknown. Defaulting to Temporally Indifferent (TI).'))
   }
-  if (any(stringr::str_to_upper(component) %in% c('AG', 'ROOTS', 'BOLE', "TOP", "FOLIAGE", "STUMP", "SAPLING", "WDLD_SPP", "TOTAL")) == FALSE) {
-    stop('Unknown component. Must be a combination of: "AG", "ROOTS", "BOLE", "TOP", "FOLIAGE", "STUMP", "SAPLING", and "WDLD_SPP". Alternatively, use "TOTAL" for a sum of all components, and set "byComponent=TRUE" to estimate all components simultaneously.')
+  if (any(stringr::str_to_upper(component) %in% c('AG', 'ROOTS', 'STEM', "BRANCH", "FOLIAGE", "STUMP", "TOTAL")) == FALSE) {
+    stop('Unknown component. Must be a combination of: "AG", "ROOTS", "STEM", "BRANCH", "FOLIAGE", "STUMP". Alternatively, use "TOTAL" for a sum of all components, and set "byComponent=TRUE" to estimate all components simultaneously.')
   }
 
   ## Biomass method warnings
@@ -91,8 +91,8 @@ bioStarter <- function(x,
 
   ## When component = AG or total, replace with component names
   component = stringr::str_to_upper(unique(component))
-  if ('TOTAL' %in% component | byComponent) {component <- c('ROOTS', 'BOLE', "TOP", "FOLIAGE", "STUMP", "SAPLING", "WDLD_SPP")}
-  if ('AG' %in% component & byComponent == FALSE) {component <- unique(c(component[component != 'AG'], 'BOLE', "TOP", "STUMP", "SAPLING", "WDLD_SPP"))}
+  if ('TOTAL' %in% component | byComponent) {component <- c("ROOTS", "STEM", "BRANCH", "FOLIAGE", "STUMP")}
+  if ('AG' %in% component & byComponent == FALSE) {component <- unique(c(component[component != "AG"], "STEM", "BRANCH", "FOLIAGE", "STUMP"))}
 
 
 
@@ -196,10 +196,9 @@ bioStarter <- function(x,
                   jBoleBio = (jTotal * stemRatio) + (jTotal * barkRatio),
                   jLeafBio = jTotal * leafRatio,
                   adj = dplyr::case_when(is.na(DIA) ~ NA_real_,
-                                         !is.na(DRYBIO_WDLD_SPP) ~ DRYBIO_WDLD_SPP / (jTotal - jLeafBio),
-                                         DIA >= 5 ~ DRYBIO_BOLE / jBoleBio,
+                                         DIA >= 5 ~ DRYBIO_STEM / jBoleBio,
                                          TRUE ~ JENKINS_SAPLING_ADJUSTMENT),
-                  DRYBIO_FOLIAGE = dplyr::case_when(STATUSCD == 1 ~ jLeafBio * adj,
+                  DRYBIO_FOLIAGE = dplyr::case_when(STATUSCD == 1 ~ DRYBIO_FOLIAGE,
                                                     STATUSCD == 2 ~ 0,
                                                     TRUE ~ NA_real_)) %>%
     as.data.frame()
@@ -209,15 +208,15 @@ bioStarter <- function(x,
   if (bioMethod == 'JENKINS') {
     db$TREE <- db$TREE %>%
       ## Replacing component ratio biomass estimates w/ Jenkins
-      dplyr::mutate(DRYBIO_BOLE = jBoleBio,
+      dplyr::mutate(DRYBIO_STEM = jBoleBio,
                     ## adj defined above - ratio of volume-based biomass estimates and
                     ## diameter-based estimates for bole volume
-                    DRYBIO_TOP = DRYBIO_TOP / adj,
+                    DRYBIO_BRANCH = DRYBIO_BRANCH / adj,
                     DRYBIO_STUMP = DRYBIO_STUMP / adj,
                     DRYBIO_BG = DRYBIO_BG / adj,
-                    DRYBIO_SAPLING = DRYBIO_SAPLING / adj,
-                    DRYBIO_WDLD_SPP = DRYBIO_WDLD_SPP / adj,
-                    DRYBIO_FOLIAGE = DRYBIO_WDLD_SPP / adj)
+                    # DRYBIO_SAPLING = DRYBIO_SAPLING / adj,
+                    # DRYBIO_WDLD_SPP = DRYBIO_WDLD_SPP / adj,
+                    DRYBIO_FOLIAGE = jLeafBio)
   }
 
 
@@ -263,8 +262,8 @@ bioStarter <- function(x,
   db$TREE <- db$TREE %>%
     dplyr::select(c(PLT_CN, CONDID, DIA, SPCD, TPA_UNADJ,
                     SUBP, TREE, dplyr::all_of(grpT), tD, typeD,
-                    DRYBIO_TOP, DRYBIO_BOLE, DRYBIO_STUMP, DRYBIO_ROOTS = DRYBIO_BG,
-                    DRYBIO_SAPLING, DRYBIO_WDLD_SPP, DRYBIO_FOLIAGE)) %>%
+                    DRYBIO_BRANCH, DRYBIO_STEM, DRYBIO_STUMP, DRYBIO_ROOTS = DRYBIO_BG,
+                    DRYBIO_FOLIAGE)) %>%
     ## Drop plots outside our domain of interest
     dplyr::filter(!is.na(DIA) & TPA_UNADJ > 0 & tD == 1 & typeD == 1) %>%
     ## Drop visits not used in our eval of interest
@@ -291,7 +290,7 @@ bioStarter <- function(x,
 
   ## Convert to long format, where biomass component is the observation (multiple per tree)
   data <- data %>%
-    tidyr::pivot_longer(cols = DRYBIO_TOP:DRYBIO_FOLIAGE,
+    tidyr::pivot_longer(cols = DRYBIO_BRANCH:DRYBIO_FOLIAGE,
                         names_to = c(".value", 'COMPONENT'),
                         names_sep = 7) %>%
     dplyr::rename(DRYBIO = DRYBIO_) %>%

R/carbon_new.R

@@ -153,7 +153,7 @@ carbonStarter <- function(x,
                     COND_STATUS_CD, CONDID,
                     dplyr::all_of(grpC), aD, landD,
                     CARBON_DOWN_DEAD, CARBON_LITTER,
-                    CARBON_SOIL_ORG, CARBON_STANDING_DEAD,
+                    CARBON_SOIL_ORG, #CARBON_STANDING_DEAD,
                     CARBON_UNDERSTORY_AG, CARBON_UNDERSTORY_BG)) %>%
     ## Drop non-forested plots, and those otherwise outside our domain of interest
     dplyr::filter(aD == 1 & landD == 1) %>%
@@ -202,7 +202,7 @@ carbonStarter <- function(x,
       dplyr::summarize(AG_UNDER_LIVE = sum(CONDPROP_UNADJ * CARBON_UNDERSTORY_AG * aDI, na.rm = TRUE),
                        BG_UNDER_LIVE = sum(CONDPROP_UNADJ * CARBON_UNDERSTORY_BG * aDI, na.rm = TRUE),
                        DOWN_DEAD = sum(CONDPROP_UNADJ * CARBON_DOWN_DEAD * aDI, na.rm = TRUE),
-                       STAND_DEAD_MOD = sum(CONDPROP_UNADJ * CARBON_STANDING_DEAD * aDI, na.rm = TRUE),
+                      #  STAND_DEAD_MOD = sum(CONDPROP_UNADJ * CARBON_STANDING_DEAD * aDI, na.rm = TRUE),
                        LITTER = sum(CONDPROP_UNADJ * CARBON_LITTER * aDI, na.rm = TRUE),
                        SOIL_ORG = sum(CONDPROP_UNADJ * CARBON_SOIL_ORG * aDI, na.rm = TRUE),
                        PROP_FOREST = sum(CONDPROP_UNADJ * aDI, na.rm = TRUE)) %>%
@@ -224,16 +224,16 @@ carbonStarter <- function(x,
       dplyr::left_join(t, by = c('PLT_CN', grpBy))
 
     ## Decide which estimate to use for snags
-    if (modelSnag){
-      t <- t %>%
-        dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
-        dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+    # if (modelSnag){
+    #   t <- t %>%
+    #     dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
+    #     dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
 
-    } else {
-      t <- t %>%
-        dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
-        dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
-    }
+    # } else {
+      # t <- t %>%
+      #   dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
+      #   dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+    # }
 
 
     ## Convert to long format, where rows are ecosystem components
@@ -301,7 +301,7 @@ carbonStarter <- function(x,
       dplyr::mutate(AG_UNDER_LIVE = CONDPROP_UNADJ * CARBON_UNDERSTORY_AG * aDI,
                        BG_UNDER_LIVE = CONDPROP_UNADJ * CARBON_UNDERSTORY_BG * aDI,
                        DOWN_DEAD = CONDPROP_UNADJ * CARBON_DOWN_DEAD * aDI,
-                       STAND_DEAD_MOD = CONDPROP_UNADJ * CARBON_STANDING_DEAD * aDI,
+                      #  STAND_DEAD_MOD = CONDPROP_UNADJ * CARBON_STANDING_DEAD * aDI,
                        LITTER = CONDPROP_UNADJ * CARBON_LITTER * aDI,
                     SOIL_ORG = CONDPROP_UNADJ * CARBON_SOIL_ORG * aDI,
                     PROP_FOREST = CONDPROP_UNADJ * aDI) %>%
@@ -351,16 +351,16 @@ carbonStarter <- function(x,
 
 
       ## Decide which estimate to use for snags
-      if (modelSnag){
-        t <- t %>%
-          dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
-          dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+      # if (modelSnag){
+      #   t <- t %>%
+      #     dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
+      #     dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
 
-      } else {
-        t <- t %>%
-          dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
-          dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
-      }
+      # } else {
+      #   t <- t %>%
+      #     dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
+      #     dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+      # }
 
       ## Convert to long format, where rows are ecosystem components
       t <- t %>%
@@ -415,16 +415,16 @@ carbonStarter <- function(x,
 
 
       ## Decide which estimate to use for snags
-      if (modelSnag){
-        tPlt <- tPlt %>%
-          dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
-          dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
-
-      } else {
-        tPlt <- tPlt %>%
-          dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
-          dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
-      }
+      # if (modelSnag){
+      #   tPlt <- tPlt %>%
+      #     dplyr::mutate(STAND_DEAD = STAND_DEAD_MOD) %>%
+      #     dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+
+      # } else {
+      #   tPlt <- tPlt %>%
+      #     dplyr::mutate(STAND_DEAD = AG_OVER_DEAD + BG_OVER_DEAD) %>%
+      #     dplyr::select(-c(AG_OVER_DEAD, BG_OVER_DEAD, STAND_DEAD_MOD))
+      # }
 
       ## Convert to long format, where rows are ecosystem components
       tPlt <- tPlt %>%

R/readWriteGet.R

@@ -255,7 +255,8 @@ getFIA <- function(states,
                    common = TRUE,
                    tables = NULL,
                    load = TRUE,
-                   nCores = 1){
+                   nCores = 1,
+                   timeout = 3600){
 
   if (!is.null(dir)){
     # Add a slash to end of directory name if missing
@@ -280,8 +281,10 @@ getFIA <- function(states,
   }
 
   ## All or nothing w/ new FIADB for some reason
-  if (states == 'REF') {
-    tables <- NULL
+  if (length(unique(states)) == 1){
+    if (states == 'REF') {
+      tables <- NULL
+    }
   }
 
   ## If dir is not specified, hold in a temporary directory
@@ -363,7 +366,8 @@ Did you accidentally include the state abbreviation in front of the table name?
 
       ## Download the zip to a temporary file
       temp <- tempfile()
-      download.file(urls[n], temp, timeout = 3600)
+      options(timeout = max(timeout, getOption("timeout")))
+      download.file(urls[n], temp)
 
       # Write the data out the directory they've chosen
       if(is.null(dir)){
@@ -438,10 +442,11 @@ Did you accidentally include the state abbreviation in front of the table name?
       temp <- paste0(tempDir, '/', states[i],'_CSV.zip') #tempfile()
       ## Make the URL
       url <- paste0('https://apps.fs.usda.gov/fia/datamart/CSV/', states[i],'_CSV.zip')
-      if (states == 'REF') {url <- paste0('https://apps.fs.usda.gov/fia/datamart/CSV/FIADB_REFERENCE.zip')}
+      if (states[i] == 'REF') {url <- paste0('https://apps.fs.usda.gov/fia/datamart/CSV/FIADB_REFERENCE.zip')}
       #newName <- paste0(str_sub(url, 1, -4), 'csv')
       ## Download as temporary file
-      download.file(url, temp, timeout = 3600)
+      options(timeout = max(timeout, getOption("timeout")))
+      download.file(url, temp)
       ## Extract
       if (is.null(dir)){
         unzip(temp, exdir = tempDir)