Merge branch 'master' into waste_disagg_update

Author: bl-young

.github/workflows/generate-2R-model.yaml

@@ -8,7 +8,7 @@ on:
         model:
             description: "Model"
             required: true
-            default: "GAEEIOv1.0-s-WAT-12"
+            default: "GAEEIOv1.0-GHG-19"
 
 jobs:
   build:
@@ -21,7 +21,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
         with:
           fetch-depth: 0
 
@@ -52,14 +52,14 @@ jobs:
 
       - name: Upload check results
         if: failure()  # if any of the previous steps fail, export a log
-        uses: actions/upload-artifact@main
+        uses: actions/upload-artifact@v4
         with:
           name: results
           path: check
 
       - name: Upload files
         if: always()
-        uses: actions/upload-artifact@v3.1.1
+        uses: actions/upload-artifact@v4
         with:
           name: "${{ github.event.inputs.model }}"
           path: | # uses local user data dir for ubuntu

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: useeior
 Type: Package
 Title: USEEIO R modeling software
-Version: 1.7.0
-Date: 2024-11-5
+Version: 1.7.1
+Date: 2025-4-28
 Authors@R: c(
   person("Ben","Young", email="[email protected]", role="aut"),
   person("Jorge","Vendries", email="[email protected]", role="aut"),

NAMESPACE

@@ -16,6 +16,7 @@ export(disaggregateTotalToDirectAndTier1)
 export(extractAndFormatDemandVector)
 export(formatDemandVector)
 export(generateModelIdentifier)
+export(getSectorLinkages)
 export(heatmapSatelliteTableCoverage)
 export(heatmapSectorRanking)
 export(normalizeResultMatrixByTotalImpacts)

R/BuildModel.R

@@ -334,7 +334,7 @@ buildTwoRegionModels <- function(modelname, configpaths = NULL, validate = FALSE
         model <- loadDemandVectors(model)
         model <- constructEEIOMatrices(model)
         if (validate) {
-          print2RValidationResults(model)
+          printValidationResults(model)
         }
         model_ls[[state]] <- model
       },

R/CalculationFunctions.R

@@ -634,3 +634,98 @@ calculateTotalImpactbyTier1Purchases <- function(model, impact, opt_impact='indi
   })
   return(totalImpactPerPurchase)
 }
+
+
+#' Function to get backward or forward economic linkages from a USEEIO model,
+#' Provides results based on input demand, sorted by total (direct+indirect)
+#' Backward linkages use A and L matrices
+#' Forward linkages use Ghosh counterparts to A and L
+#' @param model An EEIO model object with model specs, IO tables, satellite tables,
+#'    and indicators loaded
+#' @param demand A demand vector, can be name of a built-in model demand vector,
+#'    e.g. "Production" or "Consumption",
+#'    or an actual demand vector with names as one or more model sectors and
+#'    numeric values in USD with the same dollar year as model.
+#' @param type "backward" linkages use A and L matrices "forward" linkages use Ghosh
+#'    counterparts to A and L
+#' @param use_domestic_requirements A logical value: if TRUE, use domestic demand
+#'    and L_d matrix; if FALSE, use complete demand and L matrix.
+#' @param location str optional location code for demand vector, required for
+#'    two-region models
+#' @param cutoff numeric value, shows the cutoff value for sorted results.
+#'    Values smaller than cutoff are not shown
+#' @return dataframe of direct, indirect, and total economic linkages
+#' @export
+getSectorLinkages <- function(model, demand, type = "backward",
+                              location = NULL, use_domestic_requirements = FALSE,
+                              cutoff = 0.01) {
+  f <- prepareDemandVectorForStandardResults(model, demand, location,
+                                             use_domestic_requirements)
+  if(type=="backward") {
+    if (use_domestic_requirements) {
+      tier1 <- model$A_d %*%f 
+      all <- model$L_d %*%f  
+    } else {
+      tier1 <- model$A%*%f 
+      all <- model$L%*%f   
+    }
+  } else if(type=="forward") {
+    Ghosh_B <- calculateGhoshB(model, use_domestic_requirements)
+    Ghosh_G <- calculateGhoshG(Ghosh_B)
+    tier1 <- Ghosh_B%*%f 
+    all <- Ghosh_G%*%f  
+  }
+  tier2andbeyond <- all-tier1
+  
+  # Remove the additional "1" from the Leontief or Ghosh to avoid double counting indirect 
+  tier2andbeyond <- tier2andbeyond-f
+  total <- tier1 + tier2andbeyond
+  
+  linkages <- data.frame(direct=tier1, indirect=tier2andbeyond, total=total)
+  linkages$Name <- model$Commodities[match(rownames(linkages),
+                                           model$Commodities$Code_Loc),"Name"]
+  # Filter by share > 1%
+  linkages <- linkages[linkages$total > cutoff, ]
+  # Sort them
+  linkages <- linkages[order(linkages$total, decreasing = TRUE), ]
+  return(linkages)
+}
+
+#' Function to get supply side Ghosh matrix B. B can be calculated based on commodity-by-commodity or 
+#' industry-by-industry direct requirement matrix: (Miller and Blair)
+#' for industry-by-industry requirements: B = inverse(qhat) * A(industry-by-industry)*qhat,
+#' where q is the total commodity output
+#' for commodity-by-commodity requirements: B = inverse(xhat) * A(industry-by-industry)*xhat,
+#' where x is the total inudstry output
+#' @param model An EEIO model object with model specs, IO tables, satellite tables, and indicators loaded
+#' @param use_domestic_requirements A logical value: if TRUE, use domestic demand and L_d matrix;
+#'    if FALSE, use complete demand and L matrix.
+#' @return B, Ghosh B matrix
+calculateGhoshB <- function(model, use_domestic_requirements = FALSE) {
+  q <- model$q # total commodity output
+  x <- model$x # total industry output
+  if(use_domestic_requirements) {
+    A <- model$A_d
+  } else {
+    A <- model$A    
+  }
+  if(model$specs$CommodityorIndustryType == "Commodity") {
+    B <- solve(diag(q)) %*% A %*% diag(q)
+    row.names(B) <- model$Commodities$Code_Loc
+    colnames(B) <- model$Commodities$Code_Loc
+  } else if(model$specs$CommodityorIndustryType == "Industry") {
+    B <- solve(diag(x)) %*% A %*% diag(x)
+    row.names(B) <- model$Industries$Code_Loc
+    colnames(B) <- model$Industries$Code_Loc
+  }
+
+  return(B)
+}
+
+#' Function to calculate inverse of Ghosh matrix B, returns the inverse G
+#' @param GhoshB Ghosh matrix B
+#' @return G, Ghosh matrix G
+calculateGhoshG <- function(GhoshB) {
+  G <- useeior:::calculateLeontiefInverse(GhoshB)
+  return(G)
+}

R/DisaggregateFunctions.R

@@ -56,8 +56,10 @@ disaggregateModel <- function (model){
     #Disaggregating Crosswalk
     model$crosswalk <- disaggregateMasterCrosswalk(model, disagg)
 
-    #Disaggregate Margins
-    model$Margins <- disaggregateMargins(model, disagg)
+    if (model$specs$IODataSource != "stateior") {
+      #Disaggregate Margins, one region models only see #290
+      model$Margins <- disaggregateMargins(model, disagg)
+    }
     model$TaxLessSubsidies <- disaggregateTaxLessSubsidies(model, disagg)
 
     # Transform model FinalDemand, DomesticFinalDemand, and InternationalTradeAdjustment to by-industry form

R/LoadIOTables.R

@@ -380,7 +380,11 @@ loadCommodityandIndustryOutput <- function(model) {
     model$IndustryOutput <- getTwoRegionIOData(model, "IndustryOutput")
     model$CommodityOutput <- getTwoRegionIOData(model, "CommodityOutput")
     # Load multi-year industry and commodity output
-    years <- as.character(2012:2020)
+    if(model$specs$BaseIOSchema == 2017) {
+      years <- as.character(2017:2023)
+    } else {
+      years <- as.character(2012:2020)
+    }
     tmpmodel <- model
     model$MultiYearIndustryOutput <- as.data.frame(model$IndustryOutput)[, FALSE]
     model$MultiYearCommodityOutput <- as.data.frame(model$CommodityOutput)[, FALSE]

R/StateiorFunctions.R

@@ -12,14 +12,15 @@
 #' @return A list of two-region IO data of model iolevel and year.
 getTwoRegionIOData <- function(model, dataname) {
   # Define state, year and iolevel
+  alias <- ifelse(!is.na(model$specs$Alias), model$specs$Alias, NULL)
   if(!"US-DC" %in% model$specs$ModelRegionAcronyms) {
     state <- state.name[state.abb == gsub(".*-", "", model$specs$ModelRegionAcronyms[1])]
   } else {
     state <- "District of Columbia"
   }
   # Define data file name
   filename <- paste(lapply(c("TwoRegion", model$specs$BaseIOLevel, dataname,
-                              model$specs$DisaggregationSpecs, model$specs$IOYear,
+                              alias, model$specs$IOYear,
                               model$specs$IODataVersion),  
                   function(x) x[!is.na(x)]), collapse = "_")
   # Adjust filename to fit what is on the Data Commons
@@ -33,6 +34,7 @@ getTwoRegionIOData <- function(model, dataname) {
     filename <- gsub(dataname, "UsewithTrade", filename)
   }
   # Load data
+  logging::loginfo(paste0("Loading ", filename))
   TwoRegionIOData <- readRDS(loadDataCommonsfile(paste0("stateio/", filename, ".rds")))
   # Keep SoI and RoUS only
   TwoRegionIOData <- TwoRegionIOData[[state]]

R/ValidateModel.R

@@ -527,7 +527,10 @@ testCalculationFunctions <- function(model) {
     print("Error in calculateSectorContributiontoImpact()")
   }
 
-  demand = model$DemandVectors$vectors[[1]]
+  linkages <- getSectorLinkages(model, demand="Consumption", type="forward",
+                                location = model$specs$ModelRegionAcronyms[[1]])
+  
+  demand <- model$DemandVectors$vectors[[1]]
   result <- calculateSectorPurchasedbySectorSourcedImpact(y=demand, model, indicator)
   if(model$specs$IODataSource != "stateior") {
     # not working for 2R mode

README.md

@@ -2,7 +2,7 @@
 <!-- badges: start -->
 [![R CI/CD test](https://github.com/USEPA/useeior/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/USEPA/useeior/actions/workflows/R-CMD-check.yaml)
 [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html)
-[![useeior v1.0.0](http://img.shields.io/badge/useeior%20v1.0.0-10.5281/zenodo.6370101-blue.svg)](https://doi.org/10.5281/zenodo.6370101)
+[![useeior DOI](http://img.shields.io/badge/useeior%20DOI-10.5281/zenodo.7020213-blue.svg)](https://doi.org/10.5281/zenodo.7020213)
 [![useeior paper](http://img.shields.io/badge/useeior%20paper-10.3390/app12094469-blue.svg)](https://doi.org/10.3390/app12094469)
 <!-- badges: end -->