Merge pull request #5 from USEPA/new_labor

new extreme temperature mortality sector 
updated IEVSL option

.gitignore

@@ -6,3 +6,16 @@ inst/doc
 .Rproj.user
 
 .Rhistory
+
+analysis/*
+
+createSystemData/.Rproj.user/*
+createSystemData/.Rproj.user
+createSystemData/.Rhistory
+
+FrEDI/.Rproj.user/*
+FrEDI/.Rproj.user
+FrEDI/.Rhistory
+
+
+

FrEDI/.Rbuildignore

@@ -0,0 +1,8 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^doc$
+^Meta$
+^\..\.Rproj\.user$
+^.*\.Rhistory$
+^\.Rhistory\.user$
+^install$

R/get_plots.R → FrEDI/R/get_plots.R

@@ -104,8 +104,8 @@ get_plots <- function(
 
   ###### Load Config File ######
   ### Assign data objects to objects in this namespace
-  for(i in 1:length(tempBin_config)){
-    assign(names(tempBin_config)[i], tempBin_config[[i]])
+  for(i in 1:length(fredi_config)){
+    assign(names(fredi_config)[i], fredi_config[[i]])
   } ### End iterate over i
   for(i in 1:length(rDataList     )) assign(names(rDataList)[i], rDataList[[i]])
 
@@ -224,7 +224,7 @@ get_plots <- function(
 
 
   ###### Image Constants ######
-  getPlots_constants <- tempBin_config$get_plots
+  getPlots_constants <- fredi_config$get_plots
   for(i in 1:length(getPlots_constants)){
     assign(names(getPlots_constants)[i], getPlots_constants[[i]])
   }

R/run_fredi.R → FrEDI/R/run_fredi.R

@@ -11,6 +11,8 @@
 #' @param baseYear Base year used for calculating present values of annual impacts (i.e., discounting). Defaults to `baseYear=2010`.
 #' @param rate Annual discount rate used in calculating present values of annual impacts (i.e., discounting). Defaults to `rate=0.03` (i.e., 3% per year).
 # @param primaryTypes = F whether to filter to primary impacts
+#' @param elasticity=NULL A numeric value indicating an elasticity to use for adjusting economic values.
+#### ADD MORE INFO ABOUT ELASTICITY
 #' @param silent A `TRUE/FALSE` value indicating the level of messaging desired by the user (default=`TRUE`).
 #'
 #' @details This function allows users to project annual average climate change impacts throughout the 21st century (2010-2090) for available sectors. [FrEDI::run_fredi()] is the main function in the [FrEDI] R package, described elsewhere (See <https://epa.gov/cira/FrEDI> for more information).
@@ -92,6 +94,7 @@ run_fredi <- function(
   pv         = FALSE, ### T/F value indicating Whether to calculate net present value
   baseYear   = 2010, ### Default = 2010
   rate       = 0.03, ### Ratio, defaults to 0.03
+  elasticity = NULL, ### Override value for elasticity for economic values
   silent     = TRUE  ### Whether to message the user
 ){
 
@@ -106,8 +109,8 @@ run_fredi <- function(
   ###### Create file paths ######
   ### Assign data objects to objects in this namespace
   ### Configuration and data list
-  for(i in 1:length(tempBin_config)) assign(names(tempBin_config)[i], tempBin_config[[i]])
-  for(i in 1:length(rDataList     )) assign(names(rDataList)[i], rDataList[[i]])
+  for(i in 1:length(fredi_config)) assign(names(fredi_config)[i], fredi_config[[i]])
+  for(i in 1:length(rDataList   )) assign(names(rDataList)[i], rDataList[[i]])
 
   ###### Present values ######
   ### Default base year and rate defined in config
@@ -475,12 +478,18 @@ run_fredi <- function(
   ### Filter initial results to specified sectors
   ### Join to the updated base scenario
   ### Calculate physical scalars and economic multipliers then calculate scalars
+  if(!is.null(elasticity)){if(!is.numeric(elasticity)){
+    message("\t", "Incorrect value type provided for argument 'elasticity'...")
+    message("\t\t", "Using default elasticity values.")
+  }}
+
   initialResults <- df_results0 %>%
     filter(sector %in% sectorList) %>%
     left_join(updatedScenario, by = c("year", "region")) %>%
     match_scalarValues(df_mainScalars, scalarType="physScalar") %>%
     get_econAdjValues(scenario = updatedScenario, multipliers=co_econMultipliers[,1]) %>%
-    calcScalars; rm("df_mainScalars") ### df_mainScalars no longer needed
+    calcScalars(elasticity = elasticity)
+  rm("df_mainScalars") ### df_mainScalars no longer needed
 
   ### Message the user
   if(msgUser) message("\t", messages_tempBin[["updateScalars"]]$success)

R/temps2slr.R → FrEDI/R/temps2slr.R

@@ -86,7 +86,7 @@ temps2slr <- function(
   ###### Initial Values ######
   ### Reference year 2000 and equilibrium temperature offset for 2000
   ### Assign reference year from config file (max_year)
-  temps2slr_constants <- tempBin_config$temps2slr
+  temps2slr_constants <- fredi_config$temps2slr
   for(i in 1:length(temps2slr_constants)){
     assign(names(temps2slr_constants)[i], temps2slr_constants[[i]])
   }

R/utils.R → FrEDI/R/utils.R

@@ -198,12 +198,21 @@ get_econAdjValues <- function(
 ### The physical and economic scalars refer to the time series column from which the Annual Sectors tab
 ###   in the Excel tool draws values.
 calcScalars <- function(
-  data   ### Initial results dataframe
+  data,   ### Initial results dataframe
+  elasticity = NULL ### An elasticity to use to adjust values
 ){
   ###### Calculate physical scalar ######
   ### Physical scalars are the product of the physical scalar, the physical adjustment, and the damage adjustment
   df_x   <- data %>% mutate(physScalar = physScalarValue * physAdjValue * damageAdjValue )
 
+
+  ###### Adjust Elasticity ######
+  if(!is.null(elasticity)){
+    if(is.numeric(elasticity)){
+      df_x   <- df_x %>% mutate(exp0 = elasticity)
+    }
+  }
+
   ###### Calculate economic adjustment ######
   ### Economic multipliers are the economic multiplier value divided by the adjustment
   ### The economic multiplier value is 1, GDP, or GDP per capita

FrEDI/install/00_install.R

@@ -0,0 +1,46 @@
+###### Load Packages ######
+require(devtools)
+require(tidyverse)
+###### Package Source Directory ######
+### Open FrEDI.RProj before running this script
+package_name      <- "FrEDI"
+package_location  <- getwd(); package_location
+package_location %>% list.files
+
+###### Library ######
+list.files(package_location)
+list.dirs(package_location, recursive = F)
+
+###### Test Functions ######
+### Uncomment to generate and test example data
+load_all(package_location)
+testx <- run_fredi()
+
+# ### Uncomment to update and save default results
+# ###### Update and Save Default Scenario ######
+# rm("testx")
+# defaultResults <- run_fredi()
+# savePath <- package_location %>% file.path("data", "defaultResults.RData")
+# save(defaultResults, file=savePath)
+
+# ### Uncomment to update documentation
+###### Update Documentation ######
+###### - Build Manual
+###### - Add and build vignettes
+###### - Generate Documentation
+roxygen2::roxygenise(package_location)
+devtools::document(pkg = package_location)
+devtools::build_manual(pkg = package_location)
+devtools::build_vignettes(pkg = package_location)
+
+# ### Uncomment to build package
+###### Build Package ######
+###### - Build Package but don't include vignettes
+devtools::build(pkg=package_location)
+
+###### Test Package ######
+###### - Build package, reinstall, and restart R
+###### - Build Package but don't include vignettes
+# testx <- run_fredi()
+require(FrEDI)
+testx     <- run_fredi(pv=T)