update functions for more dyanmic access to data objects w/ 2017 schema

R/AdjustPrice.R

@@ -46,11 +46,12 @@ calculateProducerbyPurchaserPriceRatio <- function(model) {
   Margins <- Margins[match(rownames(model$Rho), Margins$Code_Loc), ]
   # Prepare ratio table PHI
   PHI <- model$Rho
+  schema <- getSchemaCode(model$specs)
   for (year in colnames(model$Rho)) {
     # Adjust ProducersValue from model$specs$IOyear to currency year using model$Rho
     ProducersValue <- Margins$ProducersValue * (Margins[, year]/Margins[, as.character(model$specs$IOYear)])
     # Adjust Transportation, Wholesale and Retail using corresponding CPI_ratio
-    TWR_CPI <- useeior::Sector_CPI_IO[c("48TW", "42", "44RT"), ]
+    TWR_CPI <- get(paste0(na.omit(c('Sector_CPI_IO', schema)), collapse = "_"))[c("48TW", "42", "44RT"), ]
     TWR_CPI_ratio <- TWR_CPI[, year]/TWR_CPI[, as.character(model$specs$IOYear)]
     TWRValue <- sweep(Margins[, c("Transportation", "Wholesale", "Retail")], 2, TWR_CPI_ratio, "*")
     # Generate PRObyPURRatios, or phi vector

R/IOFunctions.R

@@ -174,13 +174,16 @@ calculateLeontiefInverse <- function(A) {
 #' @param model, An EEIO model object with model specs and crosswalk table loaded
 #' @return A Domestic Use table with rows as commodity codes and columns as industry and final demand codes
 generateDomesticUse <- function(Use, model) {
+  schema <- getSchemaCode(model$specs)
   # Load Import matrix
   if (model$specs$BaseIOLevel != "Sector") {
-    Import <- get(paste(model$specs$BaseIOLevel, "Import",
-                        model$specs$IOYear, "BeforeRedef", sep = "_"))*1E6
+    Import <- get(paste(na.omit(c(model$specs$BaseIOLevel, "Import",
+                                  model$specs$IOYear, "BeforeRedef", schema)),
+                        collapse = "_"))*1E6
   } else {
     # Load Summary level Import matrix
-    Import <- get(paste("Summary_Import", model$specs$IOYear, "BeforeRedef", sep = "_"))*1E6
+    Import <- get(paste(na.omit(c("Summary_Import", model$specs$IOYear, "BeforeRedef", schema)),
+                        collapse = "_"))*1E6
     # Aggregate Import from Summary to Sector
     Import <- as.data.frame(aggregateMatrix(as.matrix(Import), "Summary", "Sector", model))
   }
@@ -197,8 +200,8 @@ generateDomesticUse <- function(Use, model) {
   # needs to be subtracted from the original Import matrix
   if (model$specs$BasePriceType == "BAS") {
     # Find "MDTY - import duties" in Supply table
-    Supply <- get(paste(model$specs$BaseIOLevel, "Supply", model$specs$IOYear,
-                        sep = "_")) * 1E6
+    Supply <- get(paste(na.omit(c(model$specs$BaseIOLevel, "Supply", model$specs$IOYear, schema)),
+                        collapse = "_")) * 1E6
     ImportDuty <- Supply[rownames(Import), "MDTY"]
     # Subtract import duties from  Import matrix
     # Expanding it to a matrix based on the Import matrix, except for the import column
@@ -228,12 +231,15 @@ generateDomesticUse <- function(Use, model) {
 #' @param model, An EEIO model object with model specs and crosswalk table loaded
 #' @return An international trade adjustment vector with names as commodity codes
 generateInternationalTradeAdjustmentVector <- function(Use, model) {
+  schema <- getSchemaCode(model$specs)
   # Load Import matrix
   if (model$specs$BaseIOLevel!="Sector") {
-    Import <- get(paste(model$specs$BaseIOLevel, "Import", model$specs$IOYear, "BeforeRedef", sep = "_"))*1E6
+    Import <- get(paste(na.omit(c(model$specs$BaseIOLevel, "Import", model$specs$IOYear, "BeforeRedef", schema)),
+                        collapse = "_"))*1E6
   } else {
     # Load Summary level Import matrix
-    Import <- get(paste("Summary_Import", model$specs$IOYear, "BeforeRedef", sep = "_"))*1E6
+    Import <- get(paste(na.omit(c("Summary_Import", model$specs$IOYear, "BeforeRedef", schema)),
+                        collapse = "_"))*1E6
     # Aggregate Import from Summary to Sector
     Import <- as.data.frame(aggregateMatrix(as.matrix(Import), "Summary", "Sector", model))
   }
@@ -309,9 +315,10 @@ convertUsefromPURtoBAS <- function(UseSUT_PUR, specs, io_codes) {
 #' @return A data.frame containing CommodityCode, basic price, tax less subsidies,
 #' and producer price of total product supply
 generateTaxLessSubsidiesTable <- function(model) {
+  schema <- getSchemaCode(model$specs)
   # Load Supply table
-  Supply <- get(paste(model$specs$BaseIOLevel, "Supply", model$specs$IOYear,
-                      sep = "_"))
+  Supply <- get(paste(na.omit(c(model$specs$BaseIOLevel, "Supply", model$specs$IOYear, schema)),
+                      collapse = "_"))
   # Get basic price and tax less subsidies vectors from Supply
   import_cols <- getVectorOfCodes(model$specs$BaseIOSchema,
                                   model$specs$BaseIOLevel,

R/InitializeModel.R

@@ -15,7 +15,7 @@ initializeModel <- function(modelname, configpaths = NULL) {
     # Get model crosswalk
     crosswalk <- get(paste0("MasterCrosswalk", model$specs$BaseIOSchema),
                      as.environment("package:useeior"))
-    crosswalk <- unique(crosswalk[, c("NAICS_2012_Code",
+    crosswalk <- unique(crosswalk[, c(paste0("NAICS_", model$specs$BaseIOSchema, "_Code"),
                                       colnames(crosswalk)[startsWith(colnames(crosswalk), "BEA")])])
     colnames(crosswalk) <- gsub(paste0("_", model$specs$BaseIOSchema, "|_Code"),
                                 "", colnames(crosswalk))

R/LoadGOandCPI.R

@@ -5,8 +5,10 @@
 #' @return A data.frame of US Gross Output.
 loadNationalGrossOutputTable <- function(specs) {
   logging::loginfo("Initializing Gross Output tables...")
+  schema <- getSchemaCode(specs)
   # Load pre-saved Gross Output tables
-  GrossOutput <- get(paste0(specs$BaseIOLevel, "_GrossOutput_IO")) * 1E6 # data frame, values are in dollars ($)
+  GrossOutput <- get(paste0(na.omit(c(specs$BaseIOLevel, "GrossOutput_IO", schema)),
+                            collapse = "_")) * 1E6 # data frame, values are in dollars ($)
   return(GrossOutput)
 }
 
@@ -15,6 +17,7 @@ loadNationalGrossOutputTable <- function(specs) {
 #' @return A data.frame of Chain Price Index.
 loadChainPriceIndexTable <- function(specs) {
   logging::loginfo("Initializing Chain Price Index tables...")
-  ChainPriceIndex <- get(paste0(specs$BaseIOLevel, "_CPI_IO"))
+  schema <- getSchemaCode(specs)
+  ChainPriceIndex <- get(paste0(na.omit(c(specs$BaseIOLevel, "CPI_IO", schema)), collapse = "_"))
   return(ChainPriceIndex)
 }

R/LoadIOTables.R

@@ -47,6 +47,8 @@ loadIOData <- function(model, configpaths = NULL) {
   # Add Chain Price Index (CPI) to model
   model$MultiYearIndustryCPI <- loadChainPriceIndexTable(model$specs)[model$Industries$Code, ]
   rownames(model$MultiYearIndustryCPI) <- model$Industries$Code_Loc
+  ## TODO check in 2017 schema some new rows get added w/ NA
+  model$MultiYearIndustryCPI[is.na(model$MultiYearIndustryCPI)] <- 100
 
   ## if Disaggregated two-region model, adjust CPI data frame
   if(model$specs$IODataSource == "stateior" && !is.null(model$specs$DisaggregationSpecs)){
@@ -218,11 +220,12 @@ loadNationalIOData <- function(model, io_codes) {
 #' @return A list with BEA IO tables
 loadBEAtables <- function(specs, io_codes) {
   BEA <- list()
+  schema <- getSchemaCode(specs)
   if (specs$BasePriceType != "BAS") {
     # Load pre-saved Make and Use tables
     Redef <- ifelse(specs$BasewithRedefinitions, "AfterRedef", "BeforeRedef")
-    BEA$Make <- get(paste(specs$BaseIOLevel, "Make", specs$IOYear, Redef, sep = "_"))
-    BEA$Use <-  get(paste(specs$BaseIOLevel, "Use", specs$IOYear, specs$BasePriceType, Redef, sep = "_"))
+    BEA$Make <- get(paste(na.omit(c(specs$BaseIOLevel, "Make", specs$IOYear, Redef, schema)), collapse="_"))
+    BEA$Use <-  get(paste(na.omit(c(specs$BaseIOLevel, "Use", specs$IOYear, specs$BasePriceType, Redef, schema)), collapse="_"))
     # Separate Make table into specific IO tables (all values in $)
     BEA$MakeTransactions <- BEA$Make[io_codes$Industries, io_codes$Commodities] * 1E6
     # Separate Use table into specific IO tables (all values in $)
@@ -235,8 +238,8 @@ loadBEAtables <- function(specs, io_codes) {
                                  io_codes$Industries] * 1E6
   } else if (specs$BasePriceType == "BAS") {
     # Load pre-saved Supply and Use tables
-    BEA$Supply <- get(paste(specs$BaseIOLevel, "Supply", specs$IOYear, sep = "_"))
-    UseSUT_PUR <- get(paste(specs$BaseIOLevel, "Use_SUT", specs$IOYear, sep = "_"))
+    BEA$Supply <- get(paste(na.omit(c(specs$BaseIOLevel, "Supply", specs$IOYear, schema)), collapse = "_"))
+    UseSUT_PUR <- get(paste(na.omit(c(specs$BaseIOLevel, "Use_SUT", specs$IOYear, schema)), collapse = "_"))
     BEA$Use <- convertUsefromPURtoBAS(UseSUT_PUR, specs, io_codes)
     # Separate Supply table into specific IO tables (all values in $)
     # Transpose Supply table to conform the structure of Make table

R/LoadMargins.R

@@ -6,11 +6,11 @@
 getMarginsTable <- function (model) {
   # Define value_columns in Margins table
   value_columns <- c("ProducersValue", "Transportation", "Wholesale", "Retail")
+  schema <- getSchemaCode(model$specs)
   # Use BEA Margin Details table
-  if (model$specs$BaseIOSchema==2012) {
-    MarginsTable <- useeior::Detail_Margins_2012_BeforeRedef
-    MarginsTable[, value_columns] <- MarginsTable[, value_columns]*1E6
-  }
+  MarginsTable <- get(paste0(na.omit(c('Detail_Margins', model$specs$BaseIOSchema, 'BeforeRedef', schema)),
+                             collapse = "_"))
+  MarginsTable[, value_columns] <- MarginsTable[, value_columns]*1E6
   # Remove Export, Import and Change in Inventory records.
   # Exports do not reflect what a US consumer would pay for margins, hence the removal.
   # Imports have negative PRO price which impacts calculations. 

R/UtilityFunctions.R

@@ -460,3 +460,16 @@ getInputFilePath <- function(configpaths, folderPath="extdata", filename, packag
   filepath <- system.file(folderPath, filename, package = package)
   return(filepath)
 }
+
+#' Return the schema subscript for accessing useeior objects
+#' @param specs list of model specs must include BaseIOSchema
+#' @return schema, str in form "YYsch" or NULL for 2012
+getSchemaCode <- function(specs) {
+  if(specs$BaseIOSchema != 2012) {
+    schema <- paste0(substring(specs$BaseIOSchema, 3,4), "sch")
+  } else {
+    # despite the file name, the objects don't have the schema so it should not be used
+    schema <- NULL
+  }
+  return(schema)
+}