Merge pull request #271 from USEPA/imports_2region

Import factor calculation for two region models

R/CalculationFunctions.R

@@ -16,7 +16,8 @@
 #' @return A list with LCI and LCIA results (in data.frame format) of the EEIO model.
 calculateEEIOModel <- function(model, perspective, demand = "Production", location = NULL, use_domestic_requirements = FALSE) {
   if (!is.null(model$specs$ExternalImportFactors)) {
-    result <- calculateResultsWithExternalFactors(model, demand, use_domestic_requirements = use_domestic_requirements)
+    result <- calculateResultsWithExternalFactors(model, demand, location = location,
+                                                  use_domestic_requirements = use_domestic_requirements)
   } else {
     # Standard model results calculation
     f <- prepareDemandVectorForStandardResults(model, demand, location, use_domestic_requirements)
@@ -80,6 +81,9 @@ prepareDemandVectorForStandardResults <- function(model, demand = "Production",
 #' @param demand A demand vector, can be name of a built-in model demand vector, e.g. "Production" or "Consumption",
 #' @param location, str optional location code for demand vector, required for two-region models
 prepareDemandVectorForImportResults <- function(model, demand = "Production", location = NULL) {
+  if(is.null(location)) {
+    location <- "US"
+  }
   # Calculate import demand vector y_m. 
   if(demand == "Production"){
     # This option left in for validation purposes.
@@ -99,13 +103,14 @@ prepareDemandVectorForImportResults <- function(model, demand = "Production", lo
 #' Note that for this calculation, perspective is always FINAL
 #' @param model A complete EEIO model: a list with USEEIO model components and attributes.
 #' @param demand A demand vector, can be name of a built-in model demand vector, e.g. "Production" or "Consumption"
+#' @param location, str optional location code for demand vector, required for two-region models
 #' @param use_domestic_requirements bool, if TRUE, return only domestic portion of results
 #' @export
 #' @return A list with LCI and LCIA results (in data.frame format) of the EEIO model.
-calculateResultsWithExternalFactors <- function(model, demand = "Consumption", use_domestic_requirements = FALSE) {
+calculateResultsWithExternalFactors <- function(model, demand = "Consumption", location = NULL, use_domestic_requirements = FALSE) {
   result <- list()
-  y_d <- prepareDemandVectorForStandardResults(model, demand, location = NULL, use_domestic_requirements = TRUE)
-  y_m <- prepareDemandVectorForImportResults(model, demand, location = "US")
+  y_d <- prepareDemandVectorForStandardResults(model, demand, location = location, use_domestic_requirements = TRUE)
+  y_m <- prepareDemandVectorForImportResults(model, demand, location = location)
 
   # Calculate Final Perspective LCI (a matrix with total impacts in form of sector x flows)
   logging::loginfo("Calculating Final Perspective LCI...")

R/DemandFunctions.R

@@ -91,18 +91,20 @@ prepareDomesticProductionDemand <- function(model, location) {
 #' @return A named vector with demand
 prepareImportProductionDemand <- function(model, location) {
   if (model$specs$IODataSource == "stateior") {
-    # y_d_p <- prepare2RDemand(model, location, domestic = TRUE) #TODO
-    stop("Import production demand not yet implemented for 2R models.")
+    y_m_p <- prepare2RDemand(model, location, domestic = FALSE)
+    # stop("Import production demand not yet implemented for 2R models.")
   } else {
     # Note that model$mu (i.e., ITA) is not included in import production demand because it is included in Domestic Production Demand
     loc <- grepl(location, model$FinalDemandMeta$Code_Loc)
     export_code <- model$FinalDemandMeta[model$FinalDemandMeta$Group=="Export" & loc, "Code_Loc"]
     changeinventories_code <- model$FinalDemandMeta[model$FinalDemandMeta$Group=="ChangeInventories" & loc, "Code_Loc"]
     import_code <- model$FinalDemandMeta[model$FinalDemandMeta$Group=="Import" & loc, "Code_Loc"]
-    y_m_c <- sumforConsumption(model, model$ImportFinalDemand, location)
-    y_m_e <- sumDemandCols(model$ImportFinalDemand, export_code)
-    y_m_i <- sumDemandCols(model$ImportFinalDemand, import_code)
-    y_m_delta <- sumDemandCols(model$ImportFinalDemand, changeinventories_code)
+    # Including InternationalTradeAdjustment in DomesticFinalDemand for import factors calculations
+    ImportFinalDemand <- model$ImportMatrix[, which(colnames(model$ImportMatrix) %in% model$FinalDemandMeta$Code_Loc)]
+    y_m_c <- sumforConsumption(model, ImportFinalDemand, location)
+    y_m_e <- sumDemandCols(ImportFinalDemand, export_code)
+    y_m_i <- sumDemandCols(ImportFinalDemand, import_code)
+    y_m_delta <- sumDemandCols(ImportFinalDemand, changeinventories_code)
 
     y_m_p <- y_m_c + y_m_e + y_m_i + y_m_delta 
   }
@@ -128,10 +130,16 @@ prepareConsumptionDemand <- function(model, location) {
 #' @return a named vector with demand
 prepareImportConsumptionDemand <- function(model, location) {
   if (model$specs$IODataSource == "stateior") {
-    #y_c <- prepare2RDemand(model, location, domestic = FALSE, demand_type = "Consumption")
-    stop("Consumption vector for import final demand not yet implemented.")
+    # y_c <- prepare2RDemand(model, location, domestic = FALSE, demand_type = "Consumption")
+    ImportMatrix <- model$U - model$U_d
+    ImportMatrix <- head(ImportMatrix, -6) # drop value add rows; TODO update this
+    ImportFinalDemand <- ImportMatrix[, which(colnames(ImportMatrix) %in% model$FinalDemandMeta$Code_Loc)]
+    y_c <- sumforConsumption(model, ImportFinalDemand, location)
+    # stop("Import consumption demand not yet implemented for 2R models.")
   } else {
-    y_c <- sumforConsumption(model, model$ImportFinalDemand, location)
+    # Including InternationalTradeAdjustment in DomesticFinalDemand for import factors calculations
+    ImportFinalDemand <- model$ImportMatrix[, which(colnames(model$ImportMatrix) %in% model$FinalDemandMeta$Code_Loc)]
+    y_c <- sumforConsumption(model, ImportFinalDemand, location)
   }
   return(y_c)
 }

R/IOFunctions.R

@@ -255,17 +255,6 @@ buildModelwithImportFactors <- function(model, configpaths = NULL) {
   model$UseTransactions_m <- model$UseTransactions - model$DomesticUseTransactions
   model$U_n_m <- normalizeIOTransactions(model$UseTransactions_m, model$IndustryOutput) #normalized imported Use
 
-  # Including InternationalTradeAdjustment in DomesticFinalDemand for import factors calculations
-
-  if(model$specs$IODataSource != "stateior") {
-    FD_col_index <- which(colnames(model$ImportMatrix) %in% model$FinalDemandMeta$Code_Loc)
-    model$ImportFinalDemand <- model$ImportMatrix[,FD_col_index]
-  }else{
-    # TODO
-    stop("Import demand vector for 2R models not implemented yet.")
-  }
-
-
   if(model$specs$CommodityorIndustryType == "Commodity") {
     logging::loginfo("Building commodity-by-commodity A_m matrix (imported direct requirements)...")
     model$A_m <- model$U_n_m %*% model$V_n

R/StateiorFunctions.R

@@ -140,7 +140,7 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production
   state_abb <- unique(state_abb)
   iolevel <- model$specs$BaseIOLevel
 
-  if(domestic){
+  if(domestic){#TODO: CHANGE domestic FROM BOOLEAN TO STRING WITH VALUES 'domestic', 'production', and 'import', so we can calculate the import matrix in the following if else if else block
     use_table <- model$DomesticUseTransactionswithTrade    
   } else {
     use_table <- model$UseTransactionswithTrade
@@ -152,7 +152,7 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production
                                      "GovernmentDemand"),
                                 getVectorOfCodes, ioschema = model$specs$BaseIOSchema,
                                 iolevel = iolevel))
-    FD_columns <- FD_columns[FD_columns %in% gsub("/.*", "", colnames(model$FinalDemand))]
+    FD_columns <- FD_columns[FD_columns %in% gsub("/.*", "", model$FinalDemandMeta$Code_Loc)]
     # Calculate production demand for both regions
     ita_column <- ifelse(iolevel == "Detail", "F05100", "F051")
     if(location == state_abb[1]) {
@@ -162,6 +162,13 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production
       } else {
         SoI2SoI_y <- rowSums(use_table[["SoI2SoI"]][, c(FD_columns, "ExportResidual")])
       }
+
+      # if(!is.null(model$specs$ImportFactors)){
+      #   RoUS2SoI_y  <- rowSums(use_table[["RoUS2SoI"]][, c(FD_columns)]) # ITA column accounted for in domestic production demand vector for models with IF       
+      # }else{
+      #   RoUS2SoI_y  <- rowSums(use_table[["RoUS2SoI"]][, c(FD_columns, ita_column)])
+      # }
+      # 
       RoUS2SoI_y  <- rowSums(use_table[["RoUS2SoI"]][, c(FD_columns, ita_column)])
       y_p <- c(SoI2SoI_y, RoUS2SoI_y)
 
@@ -172,6 +179,13 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production
       } else {
         RoUS2RoUS_y <- rowSums(use_table[["RoUS2RoUS"]][, c(FD_columns, "ExportResidual")])
       }
+
+      # if(!is.null(model$specs$ImportFactors)){
+      #   SoI2RoUS_y <- rowSums(use_table[["SoI2RoUS"]][, c(FD_columns)]) # ITA column accounted for in domestic production demand vector for models with IF       
+      # }else{
+      #   SoI2RoUS_y <- rowSums(use_table[["SoI2RoUS"]][, c(FD_columns, ita_column)])
+      # }
+      # 
       SoI2RoUS_y <- rowSums(use_table[["SoI2RoUS"]][, c(FD_columns, ita_column)])
       y_p <- c(SoI2RoUS_y, RoUS2RoUS_y)
     }

R/ValidateModel.R

@@ -382,18 +382,22 @@ compareOutputfromMakeandUse <- function(model, output_type = "Commodity") {
 #' @param demand, A demand vector, has to be name of a built-in model demand vector, e.g. "Production" or "Consumption". Consumption used as default.
 #' @return A calculated direct requirements table
 validateImportFactorsApproach <- function(model, demand = "Consumption"){
-
+  if(model$specs$IODataSource == "stateior"){
+    location <- model$specs$ModelRegionAcronyms[[1]]
+  } else {
+    location <- NULL
+  }
   # Compute standard final demand
-  y <- prepareDemandVectorForStandardResults(model, demand, location = NULL, use_domestic_requirements = FALSE)
+  y <- prepareDemandVectorForStandardResults(model, demand, location = location, use_domestic_requirements = FALSE)
   # Equivalent to as.matrix(rowSums(model$U[1:numCom, (numInd+1):(numInd+numFD)])). Note that both of these include negative values from F050
 
 
   # Retrieve domestic final demand production vector from model$DemandVectors
-  y_d  <- prepareDemandVectorForStandardResults(model, demand, location = NULL, use_domestic_requirements = TRUE)
+  y_d  <- prepareDemandVectorForStandardResults(model, demand, location = location, use_domestic_requirements = TRUE)
   # Equivalent to as.matrix(rowSums(model$DomesticFDWithITA[,c(model$FinalDemandMeta$Code_Loc)]))
 
   # Calculate import demand vector y_m.
-  y_m <- prepareDemandVectorForImportResults(model, demand, location = "US")
+  y_m <- prepareDemandVectorForImportResults(model, demand, location = location)
 
   cat("\nTesting that final demand vector is equivalent between standard and coupled model approaches. I.e.: y = y_m + y_d.\n")
   print(all.equal(y, y_d+y_m))

inst/extdata/modelspecs/GAEEIOv2.0-s-GHG-19-IF.yml → inst/extdata/modelspecs/GAEEIOv1.0-s-GHG-19-IF.yml

@@ -1,4 +1,4 @@
-Model: "GAEEIOv2.0-s-GHG-19-IF"
+Model: "GAEEIOv1.0-s-GHG-19-IF"
 BaseIOSchema: 2012
 BaseIOLevel: "Summary"
 IOYear: 2019 # Year for IO data
@@ -68,3 +68,4 @@ ImportFactors:
     Abbreviation: "RoW_IF"
     StaticSource: TRUE
     StaticFile: "imports_multipliers_2019.csv"
+    FileLocation: "useeior"

inst/extdata/modelspecs/GAEEIOv1.0-s-GHG-19.yml

@@ -0,0 +1,70 @@
+Model: "GAEEIOv1.0-s-GHG-19-IF"
+BaseIOSchema: 2012
+BaseIOLevel: "Summary"
+IOYear: 2019 # Year for IO data
+ModelRegionAcronyms: ["US-GA", "RoUS"]
+ModelType: "EEIO"
+IODataSource: "stateior"
+IODataVersion: "0.2.1"
+BasePriceType: "PRO" #producer
+BasewithRedefinitions: FALSE
+CommodityorIndustryType: "Commodity"
+ScrapIncluded: FALSE
+DisaggregationSpecs: null
+
+SatelliteTable:
+  GHG:
+    FullName: "Greenhouse Gases"
+    Abbreviation: "GHG"
+    StaticSource: TRUE
+    StaticFile: "flowsa/FlowBySector/GHG_state_2019_m1_v2.0.0_a8c5929.parquet"
+    FileLocation: "DataCommons"
+    DataYears: [2019]
+    Locations: ["US"]
+    SectorListSource: "NAICS"
+    SectorListYear: 2012
+    SectorListLevel: "6"
+    OriginalFlowSource: "FEDEFLv1.0.6"
+    ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script
+    ScriptFunctionParameters: null
+    DataSources:
+      USEPA_GHG_2021:
+        Title: "GHG Inventory"
+        Author: "USEPA"
+        DataYear: 2020
+        URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2020"
+        Primary: TRUE
+
+Indicators:
+  GreenhouseGases:
+    Name: "Greenhouse Gases"
+    Code: "GHG"
+    Group: "Impact Potential"
+    Unit: "kg CO2 eq"
+    SimpleUnit: "Kilograms Carbon Dioxide (CO2)"
+    SimpleName: "Greenhouse Gases"
+    StaticSource: TRUE
+    StaticFile: "lciafmt/traci/TRACI_2.1_v1.0.0_5555779.parquet"
+    FileLocation: "DataCommons"
+    ScriptFunctionCall: "getImpactMethod" #function to call for script
+    ScriptFunctionParameters: 
+      indicators: ["Global warming"]
+    DataSources:
+      USEPA_TRACI_2.1:
+        Title: "TRACI 2.1"
+        Author: "USEPA"
+        DataYear: NA
+        URL: "https://www.epa.gov/chemical-research/tool-reduction-and-assessment-chemicals-and-other-environmental-impacts-traci"
+        Primary: TRUE
+
+DemandVectors:
+    DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file
+# Additional demand vectors beyond useeior defaults
+
+ImportFactors:
+  RoWRegion:
+    FullName: "Rest of World Import Factors"
+    Abbreviation: "RoW_IF"
+    StaticSource: TRUE
+    StaticFile: "imports_multipliers_2019.csv"
+    FileLocation: "useeior"