Merge pull request #132 from USEPA/state_level_initial_thru2300

Fixed an issue with calculating scalar values for SLR sectors post 2090. Moved step updating elasticity later in workflow and corrected column name looking for the "vsl_usd" value.
USEPA · Jan 5, 2024 · 4f123e1 · 4f123e1
2 parents 579a3c0 + 149e80b
commit 4f123e1
Show file tree

Hide file tree

Showing 3 changed files with 18 additions and 15 deletions.
diff --git a/FrEDI/R/import_inputs.R b/FrEDI/R/import_inputs.R
@@ -115,7 +115,7 @@ import_inputs <- function(
   ###### Initialize Inputs List ######
   ### Get input scenario info: co_inputScenarioInfo
   name_dfScenarioInfo <- "co_inputScenarioInfo"
-  assign(name_dfScenarioInfo, rDataList[["regionData"]][["data"]][[name_dfScenarioInfo]])
+  assign(name_dfScenarioInfo, rDataList[["frediData"]][["data"]][[name_dfScenarioInfo]])
   name_stateInfo <- "co_states"
   assign(name_stateInfo, rDataList[["frediData"]][["data"]][[name_stateInfo]])
   input_names_vector  <- co_inputScenarioInfo$inputName
@@ -149,7 +149,7 @@ import_inputs <- function(
       cols0      <- statecols0
       colNames_i <- numCols_i <- c("year", "state_pop")
     }
-    
+
     ### Add state/region columns as needed
     if(region_i == 1){
       colNames_i  <- c(colNames_i[1], cols0, colNames_i[2])
@@ -202,9 +202,9 @@ import_inputs <- function(
         if(byState){
           df_input_i <- df_input_i |>
             left_join(co_states, by = c("state" = "state"), suffix = c("", ".y")) |>
-            select(colNames_i) 
+            select(colNames_i)
         }
-        
+
         df_input_i  <- df_input_i |>
           rename_inputs(colNames_i) |>
           mutate_all(as.character) |>

diff --git a/FrEDI/R/run_fredi.R b/FrEDI/R/run_fredi.R
@@ -675,7 +675,7 @@ run_fredi <- function(
   ### Grouping columns
   groupCols0  <- c("sector", "variant", "impactType", "impactYear", "region") |> c(stateCols0)
   groupCols0  <- groupCols0 |> c("model_type", "model")
-  groupCols0  <- groupCols0 |> c("modelUnitType")
+  # groupCols0  <- groupCols0 |> c("modelUnitType")
   groupCols0  <- groupCols0 |> c("sectorprimary", "includeaggregate")
   groupCols0  <- groupCols0 |> c("physicalmeasure")
   groupCols0  <- groupCols0 |> (function(x){x[!(x %in% (x |> names()))]})()

diff --git a/FrEDI/R/utils.R b/FrEDI/R/utils.R
@@ -337,13 +337,6 @@ extend_slrScalars <- function(
     df_scalars, ### Main scalar values: df_mainScalars
     elasticity  = NULL
 ){
-  ###### Elasticity ######
-  ### Update exponent
-  if(!(elasticity |> is.null())){
-    # df_scalars <- df_scalars |> mutate(exp0 = (exp0 == 1) |> ifelse(exp0, elasticity))
-    df_scalars <- df_scalars |> mutate(exp0 = (econScalarName=="vsl_usd") |> ifelse(elasticity, exp0))
-  } ### End if(!(elasticity |> is.null()))
-
   ###### By State ######
   ### By state
   byState    <- TRUE
@@ -367,6 +360,15 @@ extend_slrScalars <- function(
   df0        <- df0   |> select(-all_of(drop1))
   rm(drop0, drop1)
 
+  ###### Elasticity ######
+  ### Update exponent
+  if(!(elasticity |> is.null())){
+    # df_info <- df_info |> mutate(exp0 = (exp0 == 1) |> ifelse(exp0, elasticity))
+    df_info <- df_info |> mutate(exp0 = (econMultiplierName=="vsl_usd") |> ifelse(elasticity, exp0))
+  } ### End if(!(elasticity |> is.null()))
+  ### Add column
+  df_info    <- df_info |> mutate(econAdjName = "none")
+
   ###### Join Data & Scalar Info ######
   ### Join initial results & scalar info
   drop0      <- c("byState")
@@ -388,7 +390,7 @@ extend_slrScalars <- function(
   gather0    <- c("gdp_usd", "gdp_percap")
   select0    <- gather0 |> c("year")
   # select0    <- gather0 |> c("byState", "year")
-  df_mult0   <- df_se   |> summarize_seScenario(national=T)
+  df_mult0   <- df_se    |> summarize_seScenario(national=T)
   df_mult0   <- df_mult0 |> filter(byState==0)
   df_mult0   <- df_mult0 |> select(all_of(select0))
   df_mult0   <- df_mult0 |> pivot_longer(
@@ -777,8 +779,9 @@ initialize_resultsDf <- function(
     df_slr2    <- df_slr2 |> filter(year > refYear0)
 
     ### Add results back together
-    df_slr0    <- df_slr1 |> rbind(df_slr2)
-    df0        <- df_gcm0 |> rbind(df_slr0)
+    df_slr0    <- df_slr1 |> bind_rows(df_slr2)
+    df0        <- df_gcm0 |> bind_rows(df_slr0)
+
     rm(df_slr1, df_slr2, df_slr0, df_gcm0)
   } ### End if(do_npd)