Merge branch 'develop' into linkstateiorImportF

# Conflicts: # .github/workflows/R-CMD-check.yaml # R/DisaggregateFunctions.R # R/IOFunctions.R
USEPA · Apr 8, 2024 · 07fa0e1 · 07fa0e1
2 parents 5712510 + aa5f438
commit 07fa0e1
Show file tree

Hide file tree

Showing 716 changed files with 7,666 additions and 7,628 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^data-raw$

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -37,7 +37,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
+          # - {os: macOS-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
           - {os: ubuntu-latest,   r: 'oldrel-1'}
@@ -47,7 +47,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -65,96 +65,9 @@ jobs:
 
       - uses: r-lib/actions/check-r-package@v2
 
-      - name: Build and validate models - USEEIOv2.0-411 detail model with waste disaggregation
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-411")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2.0-i-411 detail industry model with waste disaggregation
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-i-411")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2.0 industry model
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-i-GHG")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2.0 summary model
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-s-GHG")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2.0.1-411 detail model with waste disaggregation
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0.1-411")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2 - integrated hybrid
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-GHG-NGCombustion")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - GAEEIOv1.0-s-WAT-12 two-region model
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("GAEEIOv1.0-s-WAT-12")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      - name: Build and validate models - USEEIOv2.0-s-GHG-19-IF summary model with import factors
-        if: always()
-        run: |
-          require(devtools)
-          devtools::load_all()
-          m <- useeior::buildModel("USEEIOv2.0-s-GHG-19-IF")
-          useeior::printValidationResults(m)
-        shell: Rscript {0}
-
-      # - name: Build and validate models - GAEEIOv1.0-75-GHG-19 two-region disaggregated model
-      #   if: always()
-      #   run: |
-      #     require(devtools)
-      #     devtools::load_all()
-      #     m <- useeior::buildModel("GAEEIOv1.0-75-GHG-19")
-      #     useeior::printValidationResults(m)
-      #   shell: Rscript {0}
-
-      #- name: Show testthat output
-      #  if: always()  # step will run even if previous steps fail
-      #  run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
-      #  shell: bash
-
-      - name: Upload check results
-        if: failure()  # if any of the previous steps fail, export a log
+      - name: Upload model build and validation log
         uses: actions/upload-artifact@main
         with:
-          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
-          path: check    
+          name: ${{ runner.os }}-r${{ matrix.config.r }}-test_model_build
+          path: check/useeior.Rcheck/tests/test_model_build*
 
diff --git a/.github/workflows/save-BEA-data.yaml b/.github/workflows/save-BEA-data.yaml
@@ -34,8 +34,6 @@ jobs:
           http-user-agent: ${{ matrix.config.http-user-agent }}
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-renv@v2
-
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: devtools

diff --git a/.github/workflows/save-annual-BEA-data.yaml b/.github/workflows/save-annual-BEA-data.yaml
@@ -34,8 +34,6 @@ jobs:
           http-user-agent: ${{ matrix.config.http-user-agent }}
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-renv@v2
-
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: devtools

diff --git a/.gitignore b/.gitignore
@@ -2,5 +2,8 @@
 .Rhistory
 .RData
 .Ruserdata
+.RProfile
 work
 inst/doc/**/*.html
+renv/
+examples
diff --git a/.zenodo.json b/.zenodo.json
@@ -4,35 +4,25 @@
     "title": "useeior", 
     "upload_type": "software", 
     "creators": [
-        {
-            "affiliation": "General Dynamics Information Technology, Inc.", 
-            "name": "Mo Li"
-            "orcid": "https://orcid.org/0000-0002-3672-1622"
-        }, 
-        {
-            "affiliation": "US Environmental Protection Agency", 
-            "name": "Wesley Ingwersen"
-            "orcid": "https://orcid.org/0000-0002-9614-701X"
-        }, 
         {
             "affiliation": "Eastern Research Group", 
-            "name": "Ben Young"
+            "name": "Ben Young",
             "orcid": "https://orcid.org/0000-0001-6276-8670"
         }, 
         {
             "affiliation": "Eastern Research Group", 
-            "name": "Jorge Vendries"
+            "name": "Jorge Vendries",
             "orcid": "https://orcid.org/0000-0002-8452-229X"
-        }, 
-        {
-            "affiliation": "US Environmental Protection Agency", 
-            "name": "Catherine Birney",
-            "orcid": "https://orcid.org/0000-0003-4467-9927"
+        },
+	{
+            "affiliation": "General Dynamics Information Technology, Inc.", 
+            "name": "Mo Li",
+            "orcid": "https://orcid.org/0000-0002-3672-1622"
         },
         {
-            "affiliation": "Eastern Research Group", 
-            "name": "Andrew Beck",
-            "orcid": "https://orcid.org/0000-0003-4051-6901"
+            "affiliation": "US Environmental Protection Agency", 
+            "name": "Wesley Ingwersen",
+            "orcid": "https://orcid.org/0000-0002-9614-701X"
         }
     ], 
     "access_right": "open"

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,13 +1,13 @@
 Package: useeior
 Type: Package
 Title: USEEIO R modeling software
-Version: 1.4.0
-Date: 2023-8-24
+Version: 1.5.0
+Date: 2024-3-22
 Authors@R: c(
-  person("Mo","Li", email="[email protected]", role="aut"),
-  person("Wesley","Ingwersen", email="[email protected]", role= c("aut", "cre")),
   person("Ben","Young", email="[email protected]", role="aut"),
-  person("Jorge","Vendries", 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
   associated with the production and consumption of goods and services in the US.

diff --git a/R/AdjustPrice.R b/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

diff --git a/R/CalculationFunctions.R b/R/CalculationFunctions.R
@@ -545,44 +545,65 @@ calculateMarginSectorImpacts <- function(model) {
   return(ls)
 }
 
-#' For a given indicator, disaggregate total impacts per purchase (N) into 
-#' direct impacts (D) and upstream, Tier 1 purchase impacts. Return a long format
-#' dataframe of exchanges, with sector names mapped to sector codes.
+#' For a given impact, provided via indicator or elementary flow label, 
+#' disaggregate the total impacts per purchase (indicator: N, flow: M) into 
+#' direct impacts (indicator: D, flow: B) and upstream, Tier 1 purchase impacts. 
+#' Return a long-format df of exchanges, with sector names mapped to sector codes.
 #' @param model A complete EEIO model: a list with USEEIO model components and attributes
-#' @param indicator str, index of a model indicator, e.g. "Greenhouse Gases".
+#' @param impact str, a model indicator (e.g., "Greenhouse Gases") row index of N, 
+#'                    or elementary flow (e.g., "Methane/emission/air/kg") index of M
+#' @param opt_impact str {'indicator', 'elemflow'}, string code to specify impact type
 #' @export
 #' @return A data frame of direct and per-tier-1-purchase sector impacts
-disaggregateTotalToDirectAndTier1 <- function(model, indicator) {
-  sector_map <- setNames(model$Commodities$Name, model$Commodities$Code_Loc)
-
-  # direct sector impacts
-  df_D <- tibble::enframe(model$D[indicator,])
-  df_D <- dplyr::rename(df_D, impact_per_purchase=value, sector_code=name) 
+disaggregateTotalToDirectAndTier1 <- function(model, impact, opt_impact="indicator") {
+  mtx_direct <- c("indicator"="D", "elemflow"="B")[opt_impact]
+  if (is.na(mtx_direct)) {
+    stop(paste0("'",opt_impact,"' is not a valid opt_impact string code"))
+  }
+  # get direct sector impacts
+  df_direct <- tryCatch({  # catches bad `impact` row label
+      tibble::enframe(model[[mtx_direct]][impact,])
+  }, error=function(e) {
+      stop(paste0("'",impact,"' is not a valid ",opt_impact," label"))
+  })
+  df_direct <- dplyr::rename(df_direct, impact_per_purchase=value, sector_code=name) 
   # assign "Direct" as purchased commodity label for data-vis & stat convenience
-  df_D <- dplyr::mutate(df_D, purchased_commodity = 'Direct')
-
-  # total impacts per Tier 1 purchase by sector
-  df_N <- calculateTotalImpactbyTier1Purchases(model, indicator) 
-  df_N <- tibble::as_tibble(df_N, rownames="purchased_commodity_code") 
-  df_N <- reshape2::melt(df_N, id.vars="purchased_commodity_code", 
-                         variable.name="sector_code", 
-                         value.name="impact_per_purchase") 
-  df_N <- dplyr::mutate(df_N, purchased_commodity = dplyr::recode(
-    purchased_commodity_code, !!!sector_map))
-
-  # combined df 
-  df_impacts <- dplyr::bind_rows(df_N, df_D) 
-  df_impacts <- dplyr::mutate(df_impacts, sector = dplyr::recode(sector_code, !!!sector_map))
+  df_direct <- dplyr::mutate(df_direct, purchased_commodity = 'Direct')
+  # get total impacts per Tier 1 purchase by sector
+  df_total <- calculateTotalImpactbyTier1Purchases(model, impact, opt_impact) 
+  df_total <- tibble::as_tibble(df_total, rownames="purchased_commodity_code") 
+  df_total <- reshape2::melt(df_total, id.vars="purchased_commodity_code",
+                                       variable.name="sector_code",
+                                       value.name="impact_per_purchase") 
+  # map sector codes to names
+  sector_map <- setNames(model$Commodities$Name, model$Commodities$Code_Loc)
+  df_total <- dplyr::mutate(df_total, 
+    purchased_commodity = dplyr::recode(purchased_commodity_code, !!!sector_map))
+  # concat direct + total impacts  
+  df_impacts <- dplyr::bind_rows(df_total, df_direct) 
+  df_impacts <- dplyr::mutate(df_impacts, 
+    sector = dplyr::recode(sector_code, !!!sector_map))
   return(df_impacts)
 }
 
-#' Calculate sector x sector total impacts (single indicator) for Tier 1 purchases
-#' Multiply each row of sector x sector A matrix by scalar elements of an
-#' indicator (single) x sector array from N
+#' Calculate sector x sector total impacts (single indicator or elementary flow) 
+#' for Tier 1 purchases. Multiply each row of the sector by sector A matrix by 
+#' the scalar elements of a single-impact by sector array (indicator: N, flow: M)
 #' @param model A complete EEIO model: a list with USEEIO model components and attributes
-#' @param indicator str, index of a model indicator, e.g. "Greenhouse Gases".
-#' @return A sector x sector, impact-per-tier-1-purchase matrix.
-calculateTotalImpactbyTier1Purchases <- function(model, indicator) {
-  totalImpactPerPurchase <- model$N[indicator,] * model$A
+#' @param impact str, a model indicator (e.g., "Greenhouse Gases") row index of N, 
+#'                    or elementary flow (e.g., "Methane/emission/air/kg") index of M
+#' @param opt_impact str {'indicator', 'elemflow'}, string code to specify impact type
+#' @return A sector by sector, impact-per-tier-1-purchase matrix.
+calculateTotalImpactbyTier1Purchases <- function(model, impact, opt_impact='indicator') {
+  mtx_total <- c("indicator"="N", "elemflow"="M")[opt_impact]
+  if (is.na(mtx_total)) {
+    stop(paste0("'",opt_impact,"' is not a valid opt_impact string code"))
+  }
+  df_direct <- tryCatch({  # catches bad `impact` row label
+    totalImpactPerPurchase <- model[[mtx_total]][impact,] * model$A
+    # totalImpactPerPurchase <- model$N[impact,] * model[["A"]]
+  }, error=function(e) {
+    stop(paste0("'",impact,"' is not a valid ",opt_impact," label"))
+  })
   return(totalImpactPerPurchase)
 }
diff --git a/R/ConfigurationFunctions.R b/R/ConfigurationFunctions.R
@@ -12,7 +12,7 @@ getConfiguration <- function(configname, configtype, configpaths = NULL, pkg="us
   if (is.null(configpaths)) {
     configpath <- system.file(paste0("extdata/", configtype, "specs/"), configfile, package = pkg)
   } else {
-    configpath <- configpaths[endsWith(configpaths, configfile)]
+    configpath <- configpaths[endsWith(configpaths, paste0("/", configfile))]
     if (length(configpath) == 0) {
       # Specific input file not found in configpaths, assume it is in useeior
       configpath <- system.file(paste0("extdata/", configtype, "specs/"), configfile, package = "useeior")
@@ -24,6 +24,10 @@ getConfiguration <- function(configname, configtype, configpaths = NULL, pkg="us
     }
   }
   config <- configr::read.config(configpath)
+  if (typeof(config) == "logical" && config == FALSE) {
+    logging::logwarn(paste0("Configuration not found for ", configname))
+    return(NULL)
+  }
   return(config)
 }