Merge branch 'develop' into two_region_disagg

USEPA · Oct 26, 2024 · 239fbfa · 239fbfa
2 parents a4e3fa5 + 9cfe575
commit 239fbfa
Show file tree

Hide file tree

Showing 320 changed files with 2,656 additions and 830 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,12 +1,11 @@
 Package: useeior
 Type: Package
 Title: USEEIO R modeling software
-Version: 1.5.1
-Date: 2024-4-8
+Version: 1.6.0
+Date: 2024-8-6
 Authors@R: c(
   person("Ben","Young", email="[email protected]", role="aut"),
   person("Jorge","Vendries", email="[email protected]", role="aut"),
-  person("Mo","Li", email="[email protected]", role="aut"),
   person("Wesley","Ingwersen", email="[email protected]", role= c("aut", "cre")))
 Description: The United States Environmentally-Extended Input-Output model
   is a model used to estimate potential environmental and economic impacts
@@ -40,7 +39,8 @@ Depends:
 License: file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+LazyDataCompression: xz
+RoxygenNote: 7.3.1
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
@@ -2,24 +2,16 @@
 
 export(adjustResultMatrixPrice)
 export(aggregateResultMatrix)
-export(aggregateResultMatrixbyRow)
 export(barplotFloworImpactFractionbyRegion)
 export(barplotIndicatorScoresbySector)
+export(buildIOModel)
 export(buildModel)
 export(buildTwoRegionModels)
 export(calculateEEIOModel)
 export(calculateFlowContributiontoImpact)
 export(calculateMarginSectorImpacts)
-export(calculateResultsWithExternalFactors)
-export(calculateSectorContributiontoImpact)
 export(calculateSectorPurchasedbySectorSourcedImpact)
-export(calculateStandardResults)
-export(compare2RVectorTotals)
-export(compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation)
-export(compareCommodityOutputandDomesticUseplusProductionDemand)
-export(compareEandLCIResult)
 export(compareFlowTotals)
-export(compareOutputandLeontiefXDemand)
 export(disaggregateTotalToDirectAndTier1)
 export(extractAndFormatDemandVector)
 export(formatDemandVector)
@@ -28,10 +20,8 @@ export(heatmapSatelliteTableCoverage)
 export(heatmapSectorRanking)
 export(normalizeResultMatrixByTotalImpacts)
 export(plotMatrixCoefficient)
-export(print2RValidationResults)
 export(printValidationResults)
 export(seeAvailableModels)
-export(validate2RCommodityTotals)
 export(writeModelMatrices)
 export(writeModelforAPI)
 export(writeModeltoXLSX)

diff --git a/R/BuildModel.R b/R/BuildModel.R
@@ -28,62 +28,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
   # Generate coefficients 
   model$CbS <- generateCbSfromTbSandModel(model)
 
-  # Generate matrices
-  model$V <- as.matrix(model$MakeTransactions) # Make
-  model$C_m <- generateCommodityMixMatrix(model) # normalized t(Make)
-  model$V_n <- generateMarketSharesfromMake(model) # normalized Make
-  if (model$specs$CommodityorIndustryType=="Industry") {
-    FinalDemand_df <- model$FinalDemandbyCommodity
-    DomesticFinalDemand_df <- model$DomesticFinalDemandbyCommodity
-  } else {
-    FinalDemand_df <- model$FinalDemand
-    DomesticFinalDemand_df <- model$DomesticFinalDemand
-  }
-  model$U <- as.matrix(dplyr::bind_rows(cbind(model$UseTransactions,
-                                              FinalDemand_df),
-                                        model$UseValueAdded)) # Use
-  model$U_d <- as.matrix(dplyr::bind_rows(cbind(model$DomesticUseTransactions,
-                                                DomesticFinalDemand_df),
-                                          model$UseValueAdded)) # DomesticUse
-  colnames(model$U_d) <- colnames(model$U)
-  model[c("U", "U_d")] <- lapply(model[c("U", "U_d")],
-                                 function(x) ifelse(is.na(x), 0, x))
-
-  if (model$specs$IODataSource=="stateior") {
-    model$U_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = FALSE)
-    model$U_d_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = TRUE)
-  } else {
-    model$U_n <- generateDirectRequirementsfromUse(model, domestic = FALSE) #normalized Use
-    model$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse 
-  }
-
-  model$q <- model$CommodityOutput
-  model$x <- model$IndustryOutput
-  model$mu <- model$InternationalTradeAdjustment
-  if(model$specs$CommodityorIndustryType == "Commodity") {
-    logging::loginfo("Building commodity-by-commodity A matrix (direct requirements)...")
-    model$A <- model$U_n %*% model$V_n
-    logging::loginfo("Building commodity-by-commodity A_d matrix (domestic direct requirements)...")
-    model$A_d <- model$U_d_n %*% model$V_n
-  } else if(model$specs$CommodityorIndustryType == "Industry") {
-    logging::loginfo("Building industry-by-industry A matrix (direct requirements)...")
-    model$A <- model$V_n %*% model$U_n
-    logging::loginfo("Building industry-by-industry A_d matrix (domestic direct requirements)...")
-    model$A_d <- model$V_n %*% model$U_d_n
-  }
-
-  if(model$specs$ModelType == "EEIO-IH"){
-    model$A <- hybridizeAMatrix(model)
-    model$A_d <- hybridizeAMatrix(model, domestic=TRUE)
-  }
-
-  # Calculate total requirements matrix as Leontief inverse (L) of A
-  logging::loginfo("Calculating L matrix (total requirements)...")
-  I <- diag(nrow(model$A))
-  I_d <- diag(nrow(model$A_d))
-  model$L <- solve(I - model$A)
-  logging::loginfo("Calculating L_d matrix (domestic total requirements)...")
-  model$L_d <- solve(I_d - model$A_d)
+  model <- buildEconomicMatrices(model)
 
   # Generate B matrix
   logging::loginfo("Building B matrix (direct emissions and resource use per dollar)...")
@@ -105,19 +50,7 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
     model$D <- model$C %*% model$B
   }
 
-  # Calculate year over model IO year price ratio
-  logging::loginfo("Calculating Rho matrix (price year ratio)...")
-  model$Rho <- calculateModelIOYearbyYearPriceRatio(model)
-
-  if (model$specs$IODataSource!="stateior") { 
-    # Calculate producer over purchaser price ratio.
-    logging::loginfo("Calculating Phi matrix (producer over purchaser price ratio)...")
-    model$Phi <- calculateProducerbyPurchaserPriceRatio(model)
-  }
-
-  # Calculate basic over producer price ratio.
-  logging::loginfo("Calculating Tau matrix (basic over producer price ratio)...")
-  model$Tau <- calculateBasicbyProducerPriceRatio(model)
+  model <- buildPriceMatrices(model)
 
   if(!is.null(model$specs$ExternalImportFactors) && model$specs$ExternalImportFactors) {
     # Alternate model build for implementing Import Factors
@@ -141,6 +74,10 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
       logging::loginfo("Calculating N matrix (total environmental impacts per dollar)...")
       model$N <- model$C %*% model$M
     }
+    if(!is.null(model$M_m)) {
+      logging::loginfo("Calculating N_m matrix (total environmental impacts per dollar from imported activity)...")
+      model$N_m <- model$C %*% model$M_m
+    }
     logging::loginfo("Calculating N_d matrix (total environmental impacts per dollar from domestic activity)...")
     model$N_d <- model$C %*% model$M_d
   }
@@ -170,6 +107,90 @@ constructEEIOMatrices <- function(model, configpaths = NULL) {
   return(model)
 }
 
+#' Construct the economic matrices of an IO model based on loaded IO tables.
+#' @param model An EEIO model object with model specs, IO tables
+#' @return A list with EEIO economic matrices.
+buildEconomicMatrices <- function(model) {
+  # Generate matrices
+  model$V <- as.matrix(model$MakeTransactions) # Make
+  model$C_m <- generateCommodityMixMatrix(model) # normalized t(Make)
+  model$V_n <- generateMarketSharesfromMake(model) # normalized Make
+  if (model$specs$CommodityorIndustryType=="Industry") {
+    FinalDemand_df <- model$FinalDemandbyCommodity
+    DomesticFinalDemand_df <- model$DomesticFinalDemandbyCommodity
+  } else {
+    FinalDemand_df <- model$FinalDemand
+    DomesticFinalDemand_df <- model$DomesticFinalDemand
+  }
+  model$U <- as.matrix(dplyr::bind_rows(cbind(model$UseTransactions,
+                                              FinalDemand_df),
+                                        model$UseValueAdded)) # Use
+  model$U_d <- as.matrix(dplyr::bind_rows(cbind(model$DomesticUseTransactions,
+                                                DomesticFinalDemand_df),
+                                          model$UseValueAdded)) # DomesticUse
+  colnames(model$U_d) <- colnames(model$U)
+  model[c("U", "U_d")] <- lapply(model[c("U", "U_d")],
+                                 function(x) ifelse(is.na(x), 0, x))
+
+  if (model$specs$IODataSource=="stateior") {
+    model$U_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = FALSE)
+    model$U_d_n <- generate2RDirectRequirementsfromUseWithTrade(model, domestic = TRUE)
+  } else {
+    model$U_n <- generateDirectRequirementsfromUse(model, domestic = FALSE) #normalized Use
+    model$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse 
+  }
+
+  model$q <- model$CommodityOutput
+  model$x <- model$IndustryOutput
+  model$mu <- model$InternationalTradeAdjustment
+  if(model$specs$CommodityorIndustryType == "Commodity") {
+    logging::loginfo("Building commodity-by-commodity A matrix (direct requirements)...")
+    model$A <- model$U_n %*% model$V_n
+    logging::loginfo("Building commodity-by-commodity A_d matrix (domestic direct requirements)...")
+    model$A_d <- model$U_d_n %*% model$V_n
+  } else if(model$specs$CommodityorIndustryType == "Industry") {
+    logging::loginfo("Building industry-by-industry A matrix (direct requirements)...")
+    model$A <- model$V_n %*% model$U_n
+    logging::loginfo("Building industry-by-industry A_d matrix (domestic direct requirements)...")
+    model$A_d <- model$V_n %*% model$U_d_n
+  }
+
+  if(model$specs$ModelType == "EEIO-IH"){
+    model$A <- hybridizeAMatrix(model)
+    model$A_d <- hybridizeAMatrix(model, domestic=TRUE)
+  }
+
+  # Calculate total requirements matrix as Leontief inverse (L) of A
+  logging::loginfo("Calculating L matrix (total requirements)...")
+  I <- diag(nrow(model$A))
+  I_d <- diag(nrow(model$A_d))
+  model$L <- solve(I - model$A)
+  logging::loginfo("Calculating L_d matrix (domestic total requirements)...")
+  model$L_d <- solve(I_d - model$A_d)
+
+  return(model)
+}
+
+#' Construct the price adjustment matrices, Rho, Tau, and Phi
+#' @param model An EEIO model object with model specs and IO tables
+#' @return A list with EEIO price adjustment matrices.
+buildPriceMatrices <- function(model) {
+  # Calculate year over model IO year price ratio
+  logging::loginfo("Calculating Rho matrix (price year ratio)...")
+  model$Rho <- calculateModelIOYearbyYearPriceRatio(model)
+
+  if (model$specs$IODataSource!="stateior") {
+    # Calculate producer over purchaser price ratio.
+    logging::loginfo("Calculating Phi matrix (producer over purchaser price ratio)...")
+    model$Phi <- calculateProducerbyPurchaserPriceRatio(model)
+  }
+
+  # Calculate basic over producer price ratio.
+  logging::loginfo("Calculating Tau matrix (basic over producer price ratio)...")
+  model$Tau <- calculateBasicbyProducerPriceRatio(model)
+  return(model)
+}
+
 #'Creates the B matrix from the flow data
 #'@param model, a model with econ and flow data loaded
 #'@return B, a matrix in flow x sector format with values of flow per $ output sector
@@ -268,9 +289,11 @@ createCfromFactorsandBflows <- function(factors,B_flows) {
   C[, flows_inBnotC] <- 0
   C[is.na(C)] <- 0
 
-  # Make sure CO2e flows are characterized (see issue #281)
-  f <- B_flows[!(B_flows %in% factors$Flow) & grepl("kg CO2e", B_flows)]
-  C[, f] <- 1
+  if("Greenhouse Gases" %in% factors$Indicator) {
+    # Make sure CO2e flows are characterized (see issue #281)
+    f <- B_flows[!(B_flows %in% factors$Flow) & grepl("kg CO2e", B_flows)]
+    C["Greenhouse Gases", f] <- 1
+  }
   # Filter and resort model C flows and make it into a matrix
   C <- as.matrix(C[, B_flows])
   return(C)
@@ -327,77 +350,20 @@ buildTwoRegionModels <- function(modelname, configpaths = NULL, validate = FALSE
   return(model_ls)
 }
 
-#' Build an EIO model with economic components only.
+#' Build an IO model with economic components only.
 #' @param modelname Name of the model from a config file.
 #' @param configpaths str vector, paths (including file name) of model configuration file
 #' and optional agg/disagg configuration file(s). If NULL, built-in config files are used.
-#' @return A list of EIO model with only economic components
-buildEIOModel <- function(modelname, configpaths = NULL) {
+#' @return A list of IO model with only economic components
+#' @export
+buildIOModel <- function(modelname, configpaths = NULL) {
   model <- initializeModel(modelname, configpaths)
   model <- loadIOData(model, configpaths)
   model <- loadDemandVectors(model)
 
-  model$V <- as.matrix(model$MakeTransactions) # Make
-  model$C_m <- generateCommodityMixMatrix(model) # normalized t(Make)
-  model$V_n <- generateMarketSharesfromMake(model) # normalized Make
-  if (model$specs$CommodityorIndustryType=="Industry") {
-    FinalDemand_df <- model$FinalDemandbyCommodity
-    DomesticFinalDemand_df <- model$DomesticFinalDemandbyCommodity
-  } else {
-    FinalDemand_df <- model$FinalDemand
-    DomesticFinalDemand_df <- model$DomesticFinalDemand
-  }
-  model$U <- as.matrix(dplyr::bind_rows(cbind(model$UseTransactions,
-                                              FinalDemand_df),
-                                        model$UseValueAdded)) # Use
-  model$U_d <- as.matrix(dplyr::bind_rows(cbind(model$DomesticUseTransactions,
-                                                DomesticFinalDemand_df),
-                                          model$UseValueAdded)) # DomesticUse
-  colnames(model$U_d) <- colnames(model$U)
-  model[c("U", "U_d")] <- lapply(model[c("U", "U_d")],
-                                 function(x) ifelse(is.na(x), 0, x))
-  model$U_n <- generateDirectRequirementsfromUse(model, domestic = FALSE) #normalized Use
-  model$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse
-  model$q <- model$CommodityOutput
-  model$x <- model$IndustryOutput
-  model$mu <- model$InternationalTradeAdjustment
-  if(model$specs$CommodityorIndustryType == "Commodity") {
-    logging::loginfo("Building commodity-by-commodity A matrix (direct requirements)...")
-    model$A <- model$U_n %*% model$V_n
-    logging::loginfo("Building commodity-by-commodity A_d matrix (domestic direct requirements)...")
-    model$A_d <- model$U_d_n %*% model$V_n
-  } else if(model$specs$CommodityorIndustryType == "Industry") {
-    logging::loginfo("Building industry-by-industry A matrix (direct requirements)...")
-    model$A <- model$V_n %*% model$U_n
-    logging::loginfo("Building industry-by-industry A_d matrix (domestic direct requirements)...")
-    model$A_d <- model$V_n %*% model$U_d_n
-  }
-
-  if(model$specs$ModelType == "EEIO-IH"){
-    model$A <- hybridizeAMatrix(model)
-    model$A_d <- hybridizeAMatrix(model, domestic=TRUE)
-  }
-
-  # Calculate total requirements matrix as Leontief inverse (L) of A
-  logging::loginfo("Calculating L matrix (total requirements)...")
-  I <- diag(nrow(model$A))
-  I_d <- diag(nrow(model$A_d))
-  model$L <- solve(I - model$A)
-  logging::loginfo("Calculating L_d matrix (domestic total requirements)...")
-  model$L_d <- solve(I_d - model$A_d)
-
-  # Calculate year over model IO year price ratio
-  logging::loginfo("Calculating Rho matrix (price year ratio)...")
-  model$Rho <- calculateModelIOYearbyYearPriceRatio(model)
-
-  # Calculate producer over purchaser price ratio.
-  logging::loginfo("Calculating Phi matrix (producer over purchaser price ratio)...")
-  model$Phi <- calculateProducerbyPurchaserPriceRatio(model)
-
-  # Calculate basic over producer price ratio.
-  logging::loginfo("Calculating Tau matrix (basic over producer price ratio)...")
-  model$Tau <- calculateBasicbyProducerPriceRatio(model)
-
+  model <- buildEconomicMatrices(model)
+  model <- buildPriceMatrices(model)
+
   logging::loginfo("EIO model build complete.")
   return(model)
 }