diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 8cdae5d4..52cd4196 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -39,7 +39,6 @@ jobs: config: # - {os: macOS-latest, r: 'release'} - {os: windows-latest, r: 'release'} - #- {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} diff --git a/.gitignore b/.gitignore index 31700f3b..b8d27eda 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ work inst/doc/**/*.html renv/ examples +tests/*.xlsx diff --git a/DESCRIPTION b/DESCRIPTION index 5bbf8f77..b703a37c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,11 @@ Package: useeior Type: Package Title: USEEIO R modeling software -Version: 1.5.3 -Date: 2024-7-13 +Version: 1.6.1 +Date: 2024-11-4 Authors@R: c( person("Ben","Young", email="ben.young@erg.com", role="aut"), person("Jorge","Vendries", email="jvendries@gmail.com", role="aut"), - person("Mo","Li", email="mo.li@gdit.com", role="aut"), person("Wesley","Ingwersen", email="ingwersen.wesley@epa.gov", role= c("aut", "cre"))) Description: The United States Environmentally-Extended Input-Output model is a model used to estimate potential environmental and economic impacts @@ -41,7 +40,7 @@ License: file LICENSE Encoding: UTF-8 LazyData: true LazyDataCompression: xz -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 2518e067..c504c06d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,22 +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(calculateSectorContributiontoImpact) export(calculateSectorPurchasedbySectorSourcedImpact) -export(compare2RCommodityTotals) -export(compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation) -export(compareCommodityOutputandDomesticUseplusProductionDemand) -export(compareEandLCIResult) export(compareFlowTotals) -export(compareOutputandLeontiefXDemand) export(disaggregateTotalToDirectAndTier1) export(extractAndFormatDemandVector) export(formatDemandVector) @@ -26,10 +20,10 @@ export(heatmapSatelliteTableCoverage) export(heatmapSectorRanking) export(normalizeResultMatrixByTotalImpacts) export(plotMatrixCoefficient) -export(print2RValidationResults) export(printValidationResults) export(seeAvailableModels) -export(validate2RCommodityTotals) +export(testCalculationFunctions) +export(testVisualizationFunctions) export(writeModelMatrices) export(writeModelforAPI) export(writeModeltoXLSX) diff --git a/R/AdjustPrice.R b/R/AdjustPrice.R index 3170f08a..8a473a84 100644 --- a/R/AdjustPrice.R +++ b/R/AdjustPrice.R @@ -19,8 +19,12 @@ adjustResultMatrixPrice <- function(matrix_name, currency_year, purchaser_price= } # Adjust price type of multiplier if (purchaser_price) { - logging::loginfo(paste("Adjusting", matrix_name, "matrix from producer to purchaser price...")) - mat <- adjustMultiplierPriceType(mat, currency_year, model) + if(is.null(model$Phi)) { + logging::logwarn("Model does not contain margins, purchaser price can not be calculated") + } else { + logging::loginfo(paste("Adjusting", matrix_name, "matrix from producer to purchaser price...")) + mat <- adjustMultiplierPriceType(mat, currency_year, model) + } } else { logging::loginfo(paste("Keeping", matrix_name, "matrix in producer price...")) } diff --git a/R/BuildModel.R b/R/BuildModel.R index d5693f59..96a3928f 100644 --- a/R/BuildModel.R +++ b/R/BuildModel.R @@ -10,15 +10,17 @@ buildModel <- function(modelname, configpaths = NULL) { model <- loadandbuildSatelliteTables(model) model <- loadandbuildIndicators(model) model <- loadDemandVectors(model) - model <- constructEEIOMatrices(model) + model <- constructEEIOMatrices(model, configpaths) return(model) } #' Construct EEIO matrices based on loaded IO tables, built satellite tables, #' and indicator tables. #' @param model An EEIO model object with model specs, IO tables, satellite tables, and indicators loaded +#' @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 with EEIO matrices. -constructEEIOMatrices <- function(model) { +constructEEIOMatrices <- function(model, configpaths = NULL) { # Combine data into a single totals by sector df model$TbS <- do.call(rbind,model$SatelliteTables$totals_by_sector) # Set common year for flow when more than one year exists @@ -26,6 +28,89 @@ constructEEIOMatrices <- function(model) { # Generate coefficients model$CbS <- generateCbSfromTbSandModel(model) + model <- buildEconomicMatrices(model) + + # Generate B matrix + logging::loginfo("Building B matrix (direct emissions and resource use per dollar)...") + model$B <- createBfromFlowDataandOutput(model) + B_h <- standardizeandcastSatelliteTable(model$CbS, model, final_demand=TRUE) + if(!is.null(B_h)) { + model$B_h <- as.matrix(B_h) + } + if(model$specs$ModelType == "EEIO-IH"){ + model$B <- hybridizeBMatrix(model) + } + if(!is.null(model$Indicators)) { + # Generate C matrix + logging::loginfo("Building C matrix (characterization factors for model indicators)...") + model$C <- createCfromFactorsandBflows(model$Indicators$factors,rownames(model$B)) + + # Add direct impact matrix + logging::loginfo("Calculating D matrix (direct environmental impacts per dollar)...") + model$D <- model$C %*% model$B + } + + model <- buildPriceMatrices(model) + + if(!is.null(model$specs$ExternalImportFactors) && model$specs$ExternalImportFactors) { + # Alternate model build for implementing Import Factors + model <- buildModelwithImportFactors(model, configpaths) + } else { + # Standard model build procedure + + # Calculate total emissions/resource use per dollar (M) + logging::loginfo("Calculating M matrix (total emissions and resource use per dollar)...") + model$M <- model$B %*% model$L + + colnames(model$M) <- colnames(model$M) + # Calculate M_d, the domestic emissions per dollar using domestic Leontief + logging::loginfo("Calculating M_d matrix (total emissions and resource use per dollar from domestic activity)...") + model$M_d <- model$B %*% model$L_d + colnames(model$M_d) <- colnames(model$M) + } + if(!is.null(model$Indicators)) { + # Calculate total impacts per dollar (N), impact category x sector + if(!is.null(model$M)) { + 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 + } + + # Clean up model elements not written out or used in further functions to reduce clutter + mat_to_remove <- c("MakeTransactions", "UseTransactions", "DomesticUseTransactions", + "UseValueAdded", "FinalDemand", "DomesticFinalDemand", + "InternationalTradeAdjustment", "CommodityOutput", "IndustryOutput", + "U_n", "U_d_n") + # Drop U_n_m, UseTransactions_m for models with external import factors + if(!is.null(model$specs$ExternalImportFactors) && model$specs$ExternalImportFactors){ + mat_to_remove <- c(mat_to_remove, "U_n_m", "UseTransactions_m") + } + + if (model$specs$CommodityorIndustryType=="Industry") { + mat_to_remove <- c(mat_to_remove, + c("FinalDemandbyCommodity", "DomesticFinalDemandbyCommodity", + "InternationalTradeAdjustmentbyCommodity")) + } + model <- within(model, rm(list = mat_to_remove)) + + if(model$specs$ModelType == "EEIO-IH"){ + model <- hybridizeModelObjects(model) + } + + logging::loginfo("Model build complete.") + 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) @@ -46,13 +131,13 @@ constructEEIOMatrices <- function(model) { 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") { + + 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$U_d_n <- generateDirectRequirementsfromUse(model, domestic = TRUE) #normalized DomesticUse } model$q <- model$CommodityOutput @@ -69,7 +154,7 @@ constructEEIOMatrices <- function(model) { 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) @@ -82,69 +167,27 @@ constructEEIOMatrices <- function(model) { model$L <- solve(I - model$A) logging::loginfo("Calculating L_d matrix (domestic total requirements)...") model$L_d <- solve(I_d - model$A_d) - - # Generate B matrix - logging::loginfo("Building B matrix (direct emissions and resource use per dollar)...") - model$B <- createBfromFlowDataandOutput(model) - if(model$specs$ModelType == "EEIO-IH"){ - model$B <- hybridizeBMatrix(model) - } - if(!is.null(model$Indicators)) { - # Generate C matrix - logging::loginfo("Building C matrix (characterization factors for model indicators)...") - model$C <- createCfromFactorsandBflows(model$Indicators$factors,rownames(model$B)) - # Add direct impact matrix - logging::loginfo("Calculating D matrix (direct environmental impacts per dollar)...") - model$D <- model$C %*% model$B - } - - # Calculate total emissions/resource use per dollar (M) - logging::loginfo("Calculating M matrix (total emissions and resource use per dollar)...") - model$M <- model$B %*% model$L - colnames(model$M) <- colnames(model$M) - # Calculate M_d, the domestic emissions per dollar using domestic Leontief - logging::loginfo("Calculating M_d matrix (total emissions and resource use per dollar from domestic activity)...") - model$M_d <- model$B %*% model$L_d - colnames(model$M_d) <- colnames(model$M) - - if(!is.null(model$Indicators)) { - # Calculate total impacts per dollar (N), impact category x sector - logging::loginfo("Calculating N matrix (total environmental impacts per dollar)...") - model$N <- model$C %*% model$M - logging::loginfo("Calculating N_d matrix (total environmental impacts per dollar from domestic activity)...") - model$N_d <- model$C %*% model$M_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) - - # Calculate producer over purchaser price ratio. - logging::loginfo("Calculating Phi matrix (producer over purchaser price ratio)...") - model$Phi <- calculateProducerbyPurchaserPriceRatio(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) - - #Clean up model elements not written out or used in further functions to reduce clutter - mat_to_remove <- c("MakeTransactions", "UseTransactions", "DomesticUseTransactions", - "UseValueAdded", "FinalDemand", "DomesticFinalDemand", - "InternationalTradeAdjustment", "CommodityOutput", "IndustryOutput", - "U_n", "U_d_n") - if (model$specs$CommodityorIndustryType=="Industry") { - mat_to_remove <- c(mat_to_remove, - c("FinalDemandbyCommodity", "DomesticFinalDemandbyCommodity", - "InternationalTradeAdjustmentbyCommodity")) - } - model <- within(model, rm(list = mat_to_remove)) - - if(model$specs$ModelType == "EEIO-IH"){ - model <- hybridizeModelObjects(model) - } - - logging::loginfo("Model build complete.") return(model) } @@ -168,7 +211,7 @@ createBfromFlowDataandOutput <- function(model) { #' @return A dataframe of Coefficients-by-Sector (CbS) table generateCbSfromTbSandModel <- function(model) { CbS <- data.frame() - + hh_codes <- model$FinalDemandMeta[model$FinalDemandMeta$Group%in%c("Household"), "Code"] #Loop through model regions to get regional output for (r in model$specs$ModelRegionAcronyms) { tbs_r <- model$TbS[model$TbS$Location==r, ] @@ -184,7 +227,12 @@ generateCbSfromTbSandModel <- function(model) { cbs_r_y <- generateFlowtoDollarCoefficient(tbs_r[tbs_r$Year==year, ], year, model$specs$IOYear, r, IsRoUS = IsRoUS, model, output_type = "Industry") - cbs_r <- rbind(cbs_r,cbs_r_y) + # Split out Household emissions and generate coefficients from final demand + cbs_h_r_y <- generateFlowtoDollarCoefficient(tbs_r[tbs_r$Year==year & tbs_r$Sector %in% hh_codes, ], + year, model$specs$IOYear, r, IsRoUS = IsRoUS, + model, output_type = "Industry", + final_demand = TRUE) + cbs_r <- rbind(cbs_r,cbs_r_y,cbs_h_r_y) } CbS <- rbind(CbS,cbs_r) } @@ -194,8 +242,9 @@ generateCbSfromTbSandModel <- function(model) { #' Converts flows table into flows x sector matrix-like format #' @param df a dataframe of flowables, contexts, units, sectors and locations #' @param model An EEIO model object with model specs, IO tables, satellite tables, and indicators loaded +#' @param final_demand, bool, generate matrix based on final demand columns #' @return A matrix-like dataframe of flows x sector -standardizeandcastSatelliteTable <- function(df,model) { +standardizeandcastSatelliteTable <- function(df, model, final_demand = FALSE) { # Add fields for sector as combinations of existing fields df[, "Sector"] <- apply(df[, c("Sector", "Location")], 1, FUN = joinStringswithSlashes) @@ -204,10 +253,20 @@ standardizeandcastSatelliteTable <- function(df,model) { # Move Flow to rowname so matrix is all numbers rownames(df_cast) <- df_cast$Flow df_cast$Flow <- NULL - # Complete sector list according to model$Industries - df_cast[, setdiff(model$Industries$Code_Loc, colnames(df_cast))] <- 0 - # Adjust column order to be the same with V_n rownames - df_cast <- df_cast[, model$Industries$Code_Loc] + if(final_demand) { + codes <- model$FinalDemandMeta[model$FinalDemandMeta$Group%in%c("Household"), "Code_Loc"] + if(any(codes %in% colnames(df_cast))) { + df_cast <- df_cast[, codes, drop=FALSE] + } else { + # no final demand emissions in any satellite table, no need for B_h + return(NULL) + } + } else { + # Complete sector list according to model$Industries + df_cast[, setdiff(model$Industries$Code_Loc, colnames(df_cast))] <- 0 + # Adjust column order to be the same with V_n rownames + df_cast <- df_cast[, model$Industries$Code_Loc] + } return(df_cast) } @@ -291,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) } diff --git a/R/CalculationFunctions.R b/R/CalculationFunctions.R index e479f929..186fd875 100644 --- a/R/CalculationFunctions.R +++ b/R/CalculationFunctions.R @@ -12,22 +12,36 @@ #' @param location, str optional location code for demand vector, required for two-region models #' @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 household_emissions, bool, if TRUE, include calculation of emissions from households +#' @param show_RoW, bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects. +#' Only valid currently for models with ExternalImportFactors. #' @export #' @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) { - result <- list() - # Generate Total Requirements (L or L_d) matrix based on whether "use_domestic" - if (use_domestic_requirements) { - L <- model$L_d - M <- model$M_d - N <- model$N_d +calculateEEIOModel <- function(model, perspective, demand = "Production", location = NULL, + use_domestic_requirements = FALSE, household_emissions = FALSE, show_RoW = FALSE) { + if (!is.null(model$specs$ExternalImportFactors) && model$specs$ExternalImportFactors) { + result <- calculateResultsWithExternalFactors(model, perspective, demand, location = location, + use_domestic_requirements = use_domestic_requirements, + household_emissions = household_emissions, show_RoW = show_RoW) } else { - L <- model$L - M <- model$M - N <- model$N + # Standard model results calculation + result <- calculateStandardResults(model, perspective, demand, use_domestic_requirements, location, household_emissions) } - # Prepare demand vector + logging::loginfo("Result calculation complete.") + return(result) +} + +#' Prepare demand vector for EEIO model results calculations +#' @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", +#' 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 location, str optional location code for demand vector, required for two-region models +#' @param use_domestic_requirements A logical value: if TRUE, use domestic demand and L_d matrix; +#' if FALSE, use complete demand and L matrix. +prepareDemandVectorForStandardResults <- function(model, demand = "Production", + location = NULL, use_domestic_requirements = FALSE) { if (is.character(demand)) { #assume this is a model build-in demand #try to load the model vector @@ -37,9 +51,9 @@ calculateEEIOModel <- function(model, perspective, demand = "Production", locati paste0("Domestic", demand), paste0("Complete", demand)) # Get vector name (ID) from the meta table - if(is.null(location)) { + if (is.null(location)) { id <- meta[which(meta$Name==demand_name),"ID"] - if(length(id)>1) { + if (length(id)>1) { stop("Unique demand vector not found, consider passing location") } } else { @@ -53,14 +67,189 @@ calculateEEIOModel <- function(model, perspective, demand = "Production", locati } else { # Assume this is a user-defined demand vector #! Need to check that the given demand - if (isDemandVectorValid(demand,L)) { - d <- formatDemandVector(demand,L) + if (isDemandVectorValid(demand, model$L)) { + d <- formatDemandVector(demand, model$L) } else { stop("Format of the demand vector is invalid. Cannot calculate result.") } } # Convert demand vector into a matrix f <- as.matrix(d) + + return(f) + +} + + +#' Prepare demand vector for EEIO model results calculations +#' @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 +prepareDemandVectorForImportResults <- function(model, demand = "Production", location = NULL) { + if (is.character(demand)) { + # assume this is a built-in demand + if(is.null(location)) { + location <- "US" + } + # Calculate import demand vector y_m. + if(demand == "Production") { + # This option left in for validation purposes. + logging::loginfo(paste0("Warning: Production demand vector not recommended ", + "for estimating results for models with external ", + "Import Factors.")) + y_m <- prepareImportProductionDemand(model, location = location) + } else if(demand == "Consumption") { + y_m <- prepareImportConsumptionDemand(model, location = location) + } + } else { + # Assume this is a user-defined demand vector + if (isDemandVectorValid(demand, model$L)) { + y_m <- formatDemandVector(demand, model$L) + } else { + stop("Format of the demand vector is invalid. Cannot calculate result.") + } + } + return(as.matrix(y_m)) + +} + +#' Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model that has external import factors +#' for a given demand vector. +#' Note that for this calculation, perspective is always FINAL +#' @param model A complete EEIO model: a list with USEEIO model components and attributes. +#' @param perspective Perspective of the model, can be "DIRECT" or "FINAL". "DIRECT" perspective +#' aligns results with the sectors in which they are produced, while "FINAL" perspective aligns +#' results with the sectors consumed by the final user. +#' @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 +#' @param household_emissions, bool, if TRUE, include calculation of emissions from households +#' @param show_RoW, bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects. +#' @return A list with LCI and LCIA results (in data.frame format) of the EEIO model. +calculateResultsWithExternalFactors <- function(model, perspective = "FINAL", demand = "Consumption", location = NULL, + use_domestic_requirements = FALSE, household_emissions = FALSE, + show_RoW = FALSE) { + result <- list() + y_d <- prepareDemandVectorForStandardResults(model, demand, location = location, use_domestic_requirements = TRUE) + y_m <- prepareDemandVectorForImportResults(model, demand, location = location) + + if(show_RoW) { + if(model$specs$IODataSource=="stateior") { + sector_count <- nrow(y_d)/2 + row_names <- c(colnames(model$M_m), + gsub("/.*", "/RoW", colnames(model$M_m[, 1:sector_count]))) + } else { + row_names <- c(colnames(model$M_m), + gsub("/.*", "/RoW", colnames(model$M_m))) + } + } else { + row_names <- colnames(model$M_m) + } + + ## Description of result components apply to both FINAL and DIRECT perspectives + # r1 - Domestic emissions from domestic production + # r2 - Emissions from imported goods consumed as intermediate products + # r3 - Emissions from imported goods consumed as final products + + if(perspective == "FINAL") { + # Calculate Final Perspective LCI (a matrix with total impacts in form of sector x flows) + logging::loginfo("Calculating Final Perspective LCI and LCIA with external import factors...") + subscript <- "f" + r1 <- model$B %*% model$L_d %*% diag(as.vector(y_d)) + r2 <- model$M_m %*% model$A_m %*% model$L_d %*% diag(as.vector(y_d)) + + } else { # Calculate direct perspective results. + # Calculate Direct Perspective LCI (a matrix with total impacts in form of sector x flows) + logging::loginfo("Calculating Direct + Imported Perspective LCI and LCIA with external import factors...") + subscript <- "d" + s <- getScalingVector(model$L_d, y_d) + r1 <- t(calculateDirectPerspectiveLCI(model$B, s)) + r2 <- t(calculateDirectPerspectiveLCI(model$M_m, (model$A_m %*% model$L_d %*% y_d))) + } + r3 <- model$M_m %*% diag(as.vector(y_m)) + + if (use_domestic_requirements) { + # zero out the import results + r2[] <- 0 + r3[] <- 0 + } + + if(show_RoW) { + if(model$specs$IODataSource=="stateior") { + # collapse third term for SoI and RoUS + r3 <- r3[, 1:sector_count] + r3[, (sector_count+1):(sector_count*2)] + + if(perspective == "DIRECT") { + # collapse second and third term for SoI and RoUS + r2 <- r2[, 1:sector_count] + r2[, (sector_count+1):(sector_count*2)] + } + } + if(perspective == "DIRECT") { + LCI <- cbind(r1, r2 + r3) # Term 2 and Term 3 are assigned to RoW + } else { + LCI <- cbind(r1 + r2, r3) # Term 3 is assigned to RoW + } + } else { + LCI <- r1 + r2 + r3 # All three terms combined and regions do not change + } + + # Calculate LCIA (matrix with direct impacts in form of sector x impacts) + LCIA <- model$C %*% LCI + LCI <- t(LCI) + LCIA <- t(LCIA) + + colnames(LCI) <- rownames(model$M_m) + rownames(LCI) <- row_names + colnames(LCIA) <- rownames(model$D) + rownames(LCIA) <- row_names + + # Add household emissions to results if applicable + if(household_emissions) { + hh <- calculateHouseholdEmissions(model, f=(y_d + y_m), location, characterized=FALSE, show_RoW=show_RoW) + hh_lcia <- calculateHouseholdEmissions(model, f=(y_d + y_m), location, characterized=TRUE, show_RoW=show_RoW) + LCI <- rbind(LCI, hh) + LCIA <- rbind(LCIA, hh_lcia) + } + result[[paste0("LCI_", subscript)]] <- LCI + result[[paste0("LCIA_", subscript)]] <- LCIA + return(result) + +} + + +#' Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model +#' that does not have external import factors for a given perspective and demand vector. +#' @param model A complete EEIO model: a list with USEEIO model components and attributes. +#' @param perspective Perspective of the model, can be "DIRECT" or "FINAL". "DIRECT" perspective +#' aligns results with the sectors in which they are produced, while "FINAL" perspective aligns +#' results with the sectors consumed by the final user. +#' @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 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 household_emissions, bool, if TRUE, include calculation of emissions from households +#' @return A list with LCI and LCIA results (in data.frame format) of the EEIO model. +calculateStandardResults <- function(model, perspective, demand, use_domestic_requirements = FALSE, + location = NULL, household_emissions = FALSE) { + f <- prepareDemandVectorForStandardResults(model, demand, location, use_domestic_requirements) + # Initialize results list + result <- list() + # Generate Total Requirements (L or L_d) matrix based on whether "use_domestic" + if (use_domestic_requirements) { + L <- model$L_d + M <- model$M_d + N <- model$N_d + } else { + L <- model$L + M <- model$M + N <- model$N + } + if(household_emissions) { + hh <- calculateHouseholdEmissions(model, f, location, characterized=FALSE) + hh_lcia <- calculateHouseholdEmissions(model, f, location, characterized=TRUE) + } # Calculate LCI and LCIA in direct or final perspective if (perspective=="DIRECT") { # Calculate Direct Perspective LCI (a matrix with direct impacts in form of sector x flows) @@ -70,6 +259,10 @@ calculateEEIOModel <- function(model, perspective, demand = "Production", locati # Calculate Direct Perspective LCIA (matrix with direct impacts in form of sector x impacts) logging::loginfo("Calculating Direct Perspective LCIA...") result$LCIA_d <- calculateDirectPerspectiveLCIA(model$D, s) + if(household_emissions) { + result$LCI_d <- rbind(result$LCI_d, hh) + result$LCIA_d <- rbind(result$LCIA_d, hh_lcia) + } } else if (perspective=="FINAL") { # Calculate Final Perspective LCI (a matrix with total impacts in form of sector x flows) logging::loginfo("Calculating Final Perspective LCI...") @@ -77,9 +270,12 @@ calculateEEIOModel <- function(model, perspective, demand = "Production", locati # Calculate Final Perspective LCIA (matrix with total impacts in form of sector x impacts) logging::loginfo("Calculating Final Perspective LCIA...") result$LCIA_f <- calculateFinalPerspectiveLCIA(N, f) + if(household_emissions) { + result$LCI_f <- rbind(result$LCI_f, hh) + result$LCIA_f <- rbind(result$LCIA_f, hh_lcia) + } } - logging::loginfo("Result calculation complete.") return(result) } @@ -189,7 +385,7 @@ calculatePercentContributiontoImpact <- function (x,y) { #' @param indicator, str, index of a model indicator for use in the D matrix, e.g. "Acidification Potential". #' @param domestic, boolean, sets model to use domestic flow matrix. Default is FALSE. #' @return A dataframe sorted by contribution (high-to-low), also showing "L", "D", "impact". -#' @export +## @export calculateSectorContributiontoImpact <- function (model, sector, indicator, domestic=FALSE) { L <- model$L if (domestic) { @@ -233,7 +429,6 @@ calculateFlowContributiontoImpact <- function (model, sector, indicator, domesti #' @param to_level The level of BEA code this matrix will be aggregated to #' @param crosswalk Sector crosswalk between levels of detail #' @return An aggregated matrix with sectors as rows -#' @export aggregateResultMatrixbyRow <- function (matrix, to_level, crosswalk) { # Determine the columns within MasterCrosswalk that will be used in aggregation from_code <- "USEEIO" @@ -288,8 +483,12 @@ calculateSectorPurchasedbySectorSourcedImpact <- function (y, model, indicator) #' @return A list with M_margin and N_margin #' @export calculateMarginSectorImpacts <- function(model) { + if (model$specs$IODataSource == "stateior") { + stop("Margins not available for two-region models") + } # Calculation fractions of producer price for each margin - MarginCoefficients <- as.matrix(model$Margins[, c("Transportation", "Wholesale", "Retail")]/model$Margins[, c("ProducersValue")]) + MarginCoefficients <- as.matrix(model$Margins[, c("Transportation", "Wholesale", "Retail")] / + model$Margins[, c("ProducersValue")]) rownames(MarginCoefficients) <- model$Margins$SectorCode MarginCoefficients[is.na(MarginCoefficients)] <- 0 @@ -322,6 +521,55 @@ calculateMarginSectorImpacts <- function(model) { return(ls) } + +#' Calculate household emissions from B_h +#' @param model A complete EEIO model: a list with USEEIO model components and attributes. +#' @param f A demand vector with names as one or more model sectors and +#' numeric values in USD with the same dollar year as model. +#' @param location, str optional location code for demand vector, required for two-region models +#' @param characterized, bool, TRUE to characterize using C matrix, FALSE to show LCI +#' @param show_RoW, bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects. +#' Only valid currently for models with ExternalImportFactors. +#' @return A result vector with rows for final demand sector(s) +calculateHouseholdEmissions <- function(model, f, location, characterized=FALSE, show_RoW=FALSE) { + if(!"B_h" %in% names(model)) { + logging::logwarn("Household emissions not found in this model") + return(NULL) + } + if(length(model$specs$ModelRegionAcronyms) == 1) { + # Set location as NULL for single region model + location <- NULL + } + codes <- model$FinalDemandMeta[model$FinalDemandMeta$Group%in%c("Household"), "Code_Loc"] + if (!is.null(location)) { + other_code <- codes[!grepl(location, codes)] + codes <- codes[grepl(location, codes)] + } + + if(characterized) { + hh = t(model$C %*% as.matrix(model$B_h[, codes])) * colSums(f) + } else { + hh = t(as.matrix(model$B_h[, codes])) * colSums(f) + } + rownames(hh) <- codes + + # Create a matrix of 0 values for potential addition to household emissions matrix + mat <- matrix(0, nrow=nrow(hh), ncol=ncol(hh)) + + if(!is.null(location)) { + # add in 0 values for RoUS + rownames(mat) <- other_code + hh <- rbind(hh, mat) + } + if(show_RoW) { + # add in 0 values for RoW + rownames(mat) <- gsub("/.*", "/RoW", codes) + hh <- rbind(hh, mat) + } + return(hh) +} + + #' 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. diff --git a/R/CrosswalkFunctions.R b/R/CrosswalkFunctions.R index a1403570..8f24c95e 100644 --- a/R/CrosswalkFunctions.R +++ b/R/CrosswalkFunctions.R @@ -22,10 +22,10 @@ getNAICStoBEAAllocation <- function (year, model) { AllocationTable$Output <- AllocationTable[, as.character(year)] # Insert placeholders for NAs in the "Output" column AllocationTable[is.na(AllocationTable)] <- 1 - # Aggregate Output for the same NAICS code - sum_temp <- stats::aggregate(AllocationTable$Output, by = list(AllocationTable$NAICS_Code), sum) - colnames(sum_temp) <- c("NAICS_Code", "SumOutput") - AllocationTable <- merge(AllocationTable, sum_temp, by = "NAICS_Code", all.x = TRUE) + # Aggregate Output for the same NAICS code and Location + AllocationTable$SumOutput <- ave(AllocationTable$Output, + AllocationTable$NAICS_Code, AllocationTable$Location, + FUN=sum) # Calculate allocation factors AllocationTable$allocation_factor <- AllocationTable$Output/AllocationTable$SumOutput # Keep wanted columns diff --git a/R/DemandFunctions.R b/R/DemandFunctions.R index 7fe8b27b..107baaa5 100644 --- a/R/DemandFunctions.R +++ b/R/DemandFunctions.R @@ -71,8 +71,6 @@ prepareProductionDemand <- function(model, location) { #' @return A named vector with demand prepareDomesticProductionDemand <- function(model, location) { if (model$specs$IODataSource == "stateior") { - # This calls the same function as non-domestic demand since for 2R models the non-domestic Use table is replaced with - # domestic Use table with trade, meaning the model$U and model$U_d objects are equal. y_d_p <- prepare2RDemand(model, location, domestic = TRUE) } else { loc <- grepl(location, model$FinalDemandMeta$Code_Loc) @@ -87,6 +85,33 @@ prepareDomesticProductionDemand <- function(model, location) { return(y_d_p) } +#' Prepares a demand vector representing Import production +#' @param model An EEIO model object with model specs and IO tables loaded +#' @param location, str of location code for demand vector +#' @return A named vector with demand +prepareImportProductionDemand <- function(model, location) { + if (model$specs$IODataSource == "stateior") { + 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"] + # 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 + } + return(y_m_p) +} + #' Prepares a demand vector representing consumption #' @param model An EEIO model object with model specs and IO tables loaded #' @param location, str of location code for demand vector @@ -100,6 +125,25 @@ prepareConsumptionDemand <- function(model, location) { return(y_c) } +#' Prepares a demand vector representing Import consumption +#' @param model An EEIO model object with model specs and IO tables loaded +#' @param location, str of location code for demand vector +#' @return a named vector with demand +prepareImportConsumptionDemand <- function(model, location) { + if (model$specs$IODataSource == "stateior") { + 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) + } else { + # 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) +} + + #' Prepares a demand vector representing domestic consumption #' @param model An EEIO model object with model specs and IO tables loaded #' @param location, str of location code for demand vector diff --git a/R/DisaggregateFunctions.R b/R/DisaggregateFunctions.R index cdd2ddfd..e4c506af 100644 --- a/R/DisaggregateFunctions.R +++ b/R/DisaggregateFunctions.R @@ -121,6 +121,8 @@ disaggregateSetup <- function (model, configpaths = NULL, setupType = "Disaggreg for (spec in specs){ if(is.null(spec$package)){ spec$package = "useeior" + } else if(spec$package == "useeior") { + configpaths <- NULL } filename <- getInputFilePath(configpaths, folderPath, spec$SectorFile, package = spec$package) @@ -194,12 +196,62 @@ disaggregateSetup <- function (model, configpaths = NULL, setupType = "Disaggreg spec$EnvAllocRatio <- FALSE } - # For Two-region model, develop two-region specs from national disaggregation files - if (model$specs$IODataSource=="stateior"){ + # For Two-region model, develop two-region specs + if (model$specs$IODataSource=="stateior") { if (stringr::str_sub(spec$OriginalSectorCode, start=-3)=="/US") { - for(region in model$specs$ModelRegionAcronyms){ - d2 <- prepareTwoRegionDisaggregation(spec, region, model$specs$ModelRegionAcronyms) - specs[[d2$OriginalSectorCode]] <- d2 + + # Create disaggregation specs from proxy data (e.g., employment by sector by state) + if(!is.null(spec$stateFile)){ + + stop("This section of code is meant to be used with 2R models with disaggregated utilities + and is not yet fully implemented.") + + for(region in model$specs$ModelRegionAcronyms){ + # Define paramters for createDisaggFilesFromProxyData function call + year <- as.numeric(model$specs$IOYear) + + if(region != "RoUS"){ + state <- sub(".*-", "", model$specs$ModelRegionAcronyms[1]) # Get values after "-" to get state abbreviation + state <- state.name[match(state, state.abb)] # Get state name from abbreviation, e.g., Georgia from GA + } else { + state <- "US" + } + + + # Get file with proxy data for states + proxyFilename <- getInputFilePath(configpaths, folderPath, spec$stateFile, + package = spec$package) + spec$stateDF <- utils::read.table(proxyFilename, sep = ",", header = TRUE, stringsAsFactors = FALSE, check.names = FALSE) + + # Create Make, Use disagg objects; returns a model object with new Use and Make File objects + tempModel <- createDisaggFilesFromProxyData(model, spec, year, state) + # Get relevant disagg specs from temp model object + d2 <- tempModel$DisaggregationSpecs[[spec$OriginalSectorCode]] + rm(tempModel) # Remove tempModel to save on memory + + # Note: can't call prepareTwoRegionDisaggregation() function here to adjust all the objects in d2 (or spec) + # because the make and use files (UseFile and MakeFile) are not the same for the two approaches. + # As a result, need to adjust the objects in a different way, but such that they are still appropriate for the + # rest of the functions called under disaggregateModel() for 2R objects + + # Create appropriate Sector/region code combination + regionDisaggCode <- gsub("US", region, d2$OriginalSectorCode) + # Replace sector codes from having "US" to having appropriate region code + d2$OriginalSectorCode <- gsub("US", region, d2$OriginalSectorCode) + d2$NewSectorCodes <- lapply(X = d2$NewSectorCodes, FUN = function(t) gsub("US", region, x = t, fixed = TRUE)) + + # Add to specs object + specs[[regionDisaggCode]] <- d2 + + } + } else { + # Create disaggregation specs from national tables + for(region in model$specs$ModelRegionAcronyms){ + d2 <- prepareTwoRegionDisaggregation(spec, region, model$specs$ModelRegionAcronyms) + specs[[d2$OriginalSectorCode]] <- d2 + } + # # Remove original disaggregation spec + # specs[spec$OriginalSectorCode] <- NULL } # Remove original disaggregation spec specs[spec$OriginalSectorCode] <- NULL @@ -407,9 +459,9 @@ disaggregateMargins <- function(model, disagg) { #' @return newTLS A dataframe which contain the TaxLessSubsidies including the disaggregated sectors disaggregateTaxLessSubsidies <- function(model, disagg) { original <- model$TaxLessSubsidies - originalIndex <- grep(disagg$OriginalSectorCode, model$TaxLessSubsidies$Code_Loc) + originalIndex <- grep(paste0("^", disagg$OriginalSectorCode), model$TaxLessSubsidies$Code_Loc) originalRow <- model$TaxLessSubsidies[originalIndex,] - disaggTLS <-originalRow[rep(seq_len(nrow(originalRow)), length(disagg$NewSectorCodes)),,drop=FALSE] + disaggTLS <- originalRow[rep(seq_len(nrow(originalRow)), length(disagg$NewSectorCodes)),,drop=FALSE] disaggRatios <- unname(disaggregatedRatios(model, disagg, model$specs$CommodityorIndustryType)) codeLength <- nchar(gsub("/.*", "", disagg$NewSectorCodes[1])) diff --git a/R/ExternalImportFactors.R b/R/ExternalImportFactors.R new file mode 100644 index 00000000..2a8f8b73 --- /dev/null +++ b/R/ExternalImportFactors.R @@ -0,0 +1,146 @@ +# Functions for loading external import factors + +#' Load and prepare import coefficients +#' @param model An EEIO form USEEIO model object with model specs loaded +#' @param configpaths str vector, paths (including file name) of model configuration file. +#' If NULL, built-in config files are used. +#' @return M_m, matrix of import coefficients (flow x sector). +loadExternalImportFactors <- function(model, configpaths = NULL) { + IFTable <- readImportFactorTable(IFSpec=model$specs$ImportFactors, configpaths=configpaths) + IFTable <- processImportFactors(model, IFTable) + M_m <- castImportFactors(IFTable, model) + return(M_m) +} + +#' Load and prepare import coefficients +#' @param IFSpec list of specs for import factor file +#' @param configpaths str vector, paths (including file name) of model configuration file. +#' If NULL, built-in config files are used. +#' @return IFtable, dataframe of unprocessed import factors +readImportFactorTable <- function(IFSpec, configpaths = NULL) { + # Read in file with Import factors + if(is.null(IFSpec$FileLocation)){ + filename <- getInputFilePath(configpaths, folderPath = "extdata", filename = IFSpec$StaticFile) + } else if(IFSpec$FileLocation == "DataCommons") { + filename <- loadDataCommonsfile(IFSpec$StaticFile) + } else if(IFSpec$FileLocation == "useeior") { + filename <- getInputFilePath(configpaths, folderPath = "extdata", filename = IFSpec$StaticFile) + } + IFTable <- utils::read.table(filename, sep = ",", header = TRUE, + stringsAsFactors = FALSE) + return(IFTable) +} + +#' Load and prepare import coefficients +#' @param model An EEIO form USEEIO model object with model specs loaded +#' @param IFTable, dataframe of unprocessed import factors +#' @return IFTable, dataframe of processed of import coefficients (flow x sector). +processImportFactors <- function(model, IFTable) { + # Store meta data + meta <- data.frame(matrix(nrow = 0, ncol = 4)) + meta[1,1] <- model$specs$BaseIOLevel + meta[2:4] <- IFTable[1,c("ReferenceCurrency", "Year", "PriceType")] + colnames(meta) <- c("Sector","ReferenceCurrency", "Year", "PriceType") + + # Format IFTable to match model$M + IFTable['Flow'] <- paste(IFTable$Flowable, IFTable$Context, IFTable$Unit, sep = "/") + + if(meta[1, "PriceType"] == "Basic") { + # Convert from basic to producer price using TAU + Tau <- model$Tau[, as.character(meta$Year)] + names(Tau) <- gsub("/.*","",names(Tau)) + # For state models, keep only unique names + Tau <- Tau[unique(names(Tau))] + IFTable <- merge(IFTable, as.data.frame(Tau), by.x = 'Sector', by.y = 0, all.y = FALSE) + IFTable['FlowAmount'] <- IFTable['FlowAmount'] * IFTable['Tau'] + IFTable['PriceType'] <- 'Producer' + } else if (meta[1, "PriceType"] != "Producer") { + stop("PriceType must be 'Basic' or 'Producer'") + } + + if(model$specs$IODataSource =="stateior") { + IFTable_SoI <- IFTable + IFTable_SoI['Location'] <- model$specs$ModelRegionAcronyms[[1]] + IFTable_RoUS <- IFTable + IFTable_RoUS['Location'] <- model$specs$ModelRegionAcronyms[[2]] + IFTable <- rbind(IFTable_SoI, IFTable_RoUS) + } else { + # assumes that if IODataSource is not stateior, it is a one a region model + IFTable['Location'] <- "US" + } + return(IFTable) +} + +#' Converts import factors table (of commodities) into flows x sector matrix-like format +#' @param IFTable, dataframe of import factors +#' @param model An EEIO model object with model specs, IO tables, and matrices loaded +#' @return A matrix of flows x sector +castImportFactors <- function(IFTable, model) { + # Add fields for sector as combinations of existing fields + IFTable[, "Sector"] <- apply(IFTable[, c("Sector", "Location")], + 1, FUN = joinStringswithSlashes) + # Cast df into a flow x sector matrix + df_cast <- reshape2::dcast(IFTable, Flow ~ Sector, fun.aggregate = sum, value.var = "FlowAmount") + # Move Flow to rowname so matrix is all numbers + rownames(df_cast) <- df_cast$Flow + df_cast$Flow <- NULL + # Complete sector list according to model$Commodities + df_cast[, setdiff(model$Commodities$Code_Loc, colnames(df_cast))] <- 0 + # Adjust column order to be the same with M_d + df_cast <- df_cast[, colnames(model$M_d)] + M_m <- as.matrix(df_cast) + return(M_m) +} + +#' Create import Use table and validate domestic+import against full use model . +#' @param model, An EEIO model object with model specs and crosswalk table loaded +#' @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 model object with explicit import components. +buildModelwithImportFactors <- function(model, configpaths = NULL) { + # (see Palm et al. 2019) + + logging::loginfo("Building A_m (import requirements) accounting for international trade adjustment in domestic final demand.\n") + # Re-derive import values in Use and final demand + # _m denotes import-related structures + model$UseTransactions_m <- model$UseTransactions - model$DomesticUseTransactions + model$U_n_m <- normalizeIOTransactions(model$UseTransactions_m, model$IndustryOutput) #normalized imported Use + + 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 + } else if(model$specs$CommodityorIndustryType == "Industry") { + logging::loginfo("Building industry-by-industry A_m matrix (imported direct requirements)...") + model$A_m <- model$V_n %*% model$U_d_m + } + + logging::loginfo("Calculating M_d matrix (total emissions and resource use per dollar from domestic activity)...") + model$M_d <- model$B %*% model$L_d + + logging::loginfo("Calculating M_m matrix (total emissions and resource use per dollar from imported activity)...") + M_m <- loadExternalImportFactors(model, configpaths) + + # Fill in flows for M_m not found in Import Factors but that exist in model and align order + M_m <- rbind(M_m, model$M_d[setdiff(rownames(model$M_d), rownames(M_m)),]) + M_m <- M_m[rownames(model$M_d), ] + + model$M_m <- M_m + + model$M <- calculateMwithImportFactors(model) + + return(model) +} + +#' Derives an M matrix for total embodied flows from domestic and imported supply chains. +#' @param model, An EEIO model object with model specs and crosswalk table loaded +#' @return An M matrix of flows x sector +calculateMwithImportFactors <- function(model) { + logging::loginfo("Calculating M matrix (total emissions and resource use per dollar) ...") + + # embodied flows from the use of imports by industries to make their commodities + # both directly (from A_m) and indirectly (by scaling it to total requirements using L_d) + M_mi <- model$M_m %*% model$A_m %*% model$L_d + + M <- model$M_d + M_mi + return(M) +} diff --git a/R/IOFunctions.R b/R/IOFunctions.R index 8055572b..c6735664 100644 --- a/R/IOFunctions.R +++ b/R/IOFunctions.R @@ -76,8 +76,14 @@ generateCommodityMixMatrix <- function (model) { C <- normalizeIOTransactions(t(model$MakeTransactions), model$IndustryOutput) # C = V' %*% solve(x_hat) # Validation: check if column sums equal to 1 industryoutputfractions <- colSums(C) + if (model$specs$IODataSource == "stateior" && !is.null(model$specs$DisaggregationSpecs)){ + # increase tolerance for disaggregated state models + tolerance <- 0.02 + } else { + tolerance <- 0.01 + } for (s in industryoutputfractions) { - if (abs(1-s)>0.01) { + if (abs(1-s)>tolerance) { stop("Error in commoditymix") } } @@ -112,9 +118,15 @@ transformIndustryCPItoCommodityCPIforYear <- function(year, model) { # To avoid interruption in later calculations, they are forced to 100 CommodityCPI[CommodityCPI==0] <- 100 # Validation: check if IO year CommodityCPI is 100 + if (model$specs$IODataSource == "stateior" && !is.null(model$specs$DisaggregationSpecs)){ + # increase tolerance for disaggregated state models + tolerance <- 3.0 + } else { + tolerance <- 0.4 + } if (year==model$specs$BaseIOSchema) { for (s in CommodityCPI) { - if (abs(100-s)>0.4) { + if (abs(100-s)>tolerance) { stop("Error in CommodityCPI") } } @@ -171,23 +183,10 @@ calculateLeontiefInverse <- function(A) { #' Generate domestic Use table by adjusting Use table based on Import matrix. #' @param Use, dataframe of a Use table +#' @param Import, dataframe of a Import table #' @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(na.omit(c(model$specs$BaseIOLevel, "Import", - model$specs$IOYear, "BeforeRedef", schema)), - collapse = "_"))*1E6 - } else { - # Load Summary level Import matrix - 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)) - } - Import <- Import[rownames(Use), colnames(Use)] +generateDomesticUse <- function(Use, Import, model) { # Adjust Import matrix to BAS price if model is in BAS price # Note: according to the documentation in BEA Import matrix, import values in # the Import matrix are in producer (PRO) values. For PRO models, imports in the @@ -228,21 +227,10 @@ generateDomesticUse <- function(Use, model) { #' Generate international trade adjustment vector from Use and Import matrix. #' @param Use, dataframe of a Use table +#' @param Import, dataframe of a Import table #' @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(na.omit(c(model$specs$BaseIOLevel, "Import", model$specs$IOYear, "BeforeRedef", schema)), - collapse = "_"))*1E6 - } else { - # Load Summary level Import matrix - 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)) - } +generateInternationalTradeAdjustmentVector <- function(Use, Import, model) { # Define Import code ImportCode <- getVectorOfCodes(model$specs$BaseIOSchema, model$specs$BaseIOLevel, "Import") ImportCode <- ImportCode[startsWith(ImportCode, "F")] @@ -258,6 +246,7 @@ generateInternationalTradeAdjustmentVector <- function(Use, model) { return(InternationalTradeAdjustment) } + #' Convert Use table in the Supply-Use framework from purchasers' price (PUR) #' to basic price (BAS) #' @param UseSUT_PUR, a Use table (from the Supply-Use framework) in purchasers' price (PUR) @@ -340,4 +329,3 @@ generateTaxLessSubsidiesTable <- function(model) { by.x = 0, by.y = "Code", all.y = TRUE) return(TaxLessSubsidies) } - diff --git a/R/LoadIOTables.R b/R/LoadIOTables.R index 29e71b5f..163c39f8 100644 --- a/R/LoadIOTables.R +++ b/R/LoadIOTables.R @@ -12,15 +12,18 @@ loadIOData <- function(model, configpaths = NULL) { model <- loadIOmeta(model) # Define IO table names io_table_names <- c("MakeTransactions", "UseTransactions", "DomesticUseTransactions", - "DomesticUseTransactionswithTrade", "UseTransactionswithTrade", "UseValueAdded", "FinalDemand", "DomesticFinalDemand", "InternationalTradeAdjustment") # Load IO data if (model$specs$IODataSource=="BEA") { io_codes <- loadIOcodes(model$specs) + io_table_names <- c(io_table_names, "ImportMatrix") #TODO: Move this outside of If-else, depending on how it works with 2R models model[io_table_names] <- loadNationalIOData(model, io_codes)[io_table_names] + } else if (model$specs$IODataSource=="stateior") { + io_table_names <- c(io_table_names, "DomesticUseTransactionswithTrade", "UseTransactionswithTrade") model[io_table_names] <- loadTwoRegionStateIOtables(model)[io_table_names] + #TODO: Load 2R Imports } # Add Industry and Commodity Output @@ -38,8 +41,10 @@ loadIOData <- function(model, configpaths = NULL) { names(model$InternationalTradeAdjustment) <- model$Industries$Code_Loc } - # Add Margins table - model$Margins <- getMarginsTable(model) + if (model$specs$IODataSource != "stateior") { + # Add Margins table, currently only for one-region models (see Issue #290) + model$Margins <- getMarginsTable(model) + } # Add TaxLessSubsidies table model$TaxLessSubsidies <- generateTaxLessSubsidiesTable(model) @@ -195,12 +200,16 @@ loadNationalIOData <- function(model, io_codes) { "F")] io_codes$FinalDemandCodes <- colnames(BEA$FinalDemand) + BEA$ImportMatrix <- loadImportMatrix(model, io_codes) + # Generate domestic Use transaction and final demand - DomesticUse <- generateDomesticUse(cbind(BEA$UseTransactions, BEA$FinalDemand), model) + DomesticUse <- generateDomesticUse(cbind(BEA$UseTransactions, BEA$FinalDemand), + BEA$ImportMatrix, model) BEA$DomesticUseTransactions <- DomesticUse[, io_codes$Industries] BEA$DomesticFinalDemand <- DomesticUse[, io_codes$FinalDemandCodes] # Generate Import Cost vector - BEA$InternationalTradeAdjustment <- generateInternationalTradeAdjustmentVector(cbind(BEA$UseTransactions, BEA$FinalDemand), model) + BEA$InternationalTradeAdjustment <- generateInternationalTradeAdjustmentVector( + cbind(BEA$UseTransactions, BEA$FinalDemand), BEA$ImportMatrix, model) # Modify row and column names to Code_Loc format in all IO tables # Use model$Industries rownames(BEA$MakeTransactions) <- @@ -210,6 +219,7 @@ loadNationalIOData <- function(model, io_codes) { model$Industries$Code_Loc # Use model$Commodities colnames(BEA$MakeTransactions) <- + rownames(BEA$ImportMatrix) <- rownames(BEA$UseTransactions) <- rownames(BEA$DomesticUseTransactions) <- rownames(BEA$FinalDemand) <- @@ -222,6 +232,10 @@ loadNationalIOData <- function(model, io_codes) { model$FinalDemandMeta$Code_Loc # Use model$ValueAddedMeta rownames(BEA$UseValueAdded) <- model$ValueAddedMeta$Code_Loc + + # Use model$Industries and model$FInalDemandMeta together + colnames(BEA$ImportMatrix) <- c(model$Industries$Code_Loc, model$FinalDemandMeta$Code_Loc) + return(BEA) } @@ -294,6 +308,32 @@ loadBEAtables <- function(specs, io_codes) { return(BEA) } + +#' Load, format, and save import matrix as a USEEIO model object. +#' @param model A model object with model specs loaded. +#' @param io_codes A list of BEA IO codes. +#' @return Import, df of use table imports. +loadImportMatrix <- function(model, io_codes) { + schema <- getSchemaCode(model$specs) + # Load Import matrix + if (model$specs$BaseIOLevel != "Sector") { + 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(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)) + } + + FD_codes <- io_codes$FinalDemandCodes[startsWith(io_codes$FinalDemandCodes,"F")] + Import <- Import[io_codes$Commodities, c(io_codes$Industries, FD_codes)] + + return(Import) +} + #' Load two-region state IO tables in a list based on model config. #' @param model An EEIO form USEEIO model object with model specs and IO meta data loaded. #' @return A list with state IO tables. diff --git a/R/LoadSatellites.R b/R/LoadSatellites.R index 3790243b..39e11e17 100644 --- a/R/LoadSatellites.R +++ b/R/LoadSatellites.R @@ -139,8 +139,9 @@ generateTbSfromSatSpec <- function(sat_spec, model) { #'@param tbs, totals-by-sector df #'@param sat_spec, a standard specification for a single satellite table #'@param model an EEIO model with IO tables loaded +#' @param agg_metasources, bool, TRUE to aggregate TbS ignoring MetaSources field #'@return a totals-by-sector df with the sectors and flow amounts corresponding to the model schema -conformTbStoIOSchema <- function(tbs, sat_spec, model) { +conformTbStoIOSchema <- function(tbs, sat_spec, model, agg_metasources=TRUE) { # Check if aggregation or disaggregation are needed based on model metadata if(!is.null(sat_spec$StaticFile)) { for(aggSpecs in model$AggregationSpecs) { @@ -173,7 +174,8 @@ conformTbStoIOSchema <- function(tbs, sat_spec, model) { tbs <- aggregateSatelliteTable(tbs,from_level = sat_spec$SectorListLevel,model) } } else if ("NAICS" %in% sat_spec$SectorListSource) { - tbs <- mapFlowTotalsbySectorandLocationfromNAICStoBEA(tbs, sat_spec$DataYears[1], model) + tbs <- mapFlowTotalsbySectorandLocationfromNAICStoBEA(tbs, sat_spec$DataYears[1], model, + agg_metasources=agg_metasources) } return(tbs) } diff --git a/R/SatelliteFunctions.R b/R/SatelliteFunctions.R index a0cbe8b0..f4f9a9de 100644 --- a/R/SatelliteFunctions.R +++ b/R/SatelliteFunctions.R @@ -11,8 +11,10 @@ getStandardSatelliteTableFormat <- function () { #' @param totals_by_sector A standardized satellite table with resource and emission names from original sources. #' @param totals_by_sector_year Year of the satellite table. #' @param model A complete EEIO model: a list with USEEIO model components and attributes. +#' @param agg_metasources, bool, TRUE to aggregate TbS ignoring MetaSources field #' @return A satellite table aggregated by the USEEIO model sector codes. -mapFlowTotalsbySectorandLocationfromNAICStoBEA <- function (totals_by_sector, totals_by_sector_year, model) { +mapFlowTotalsbySectorandLocationfromNAICStoBEA <- function (totals_by_sector, totals_by_sector_year, + model, agg_metasources=TRUE) { # Consolidate master crosswalk on model level and rename NAICStoBEA <- unique(model$crosswalk[, c("NAICS","USEEIO")]) colnames(NAICStoBEA) <- c("NAICS","BEA") @@ -51,7 +53,8 @@ mapFlowTotalsbySectorandLocationfromNAICStoBEA <- function (totals_by_sector, to # Rename BEA to Sector colnames(totals_by_sector_BEA)[colnames(totals_by_sector_BEA)=="BEA"] <- "Sector" - totals_by_sector_BEA_agg <- collapseTBS(totals_by_sector_BEA, model) + totals_by_sector_BEA_agg <- collapseTBS(totals_by_sector_BEA, model, + agg_metasources=agg_metasources) return(totals_by_sector_BEA_agg) } @@ -64,11 +67,23 @@ mapFlowTotalsbySectorandLocationfromNAICStoBEA <- function (totals_by_sector, to #' @param IsRoUS A logical parameter indicating whether to adjust Industry output for Rest of US (RoUS). #' @param model A complete EEIO model: a list with USEEIO model components and attributes. #' @param output_type Type of the output, e.g. "Commodity" or "Industry" +#' @param final_demand, bool, generate coefficients using final demand vector #' @return A dataframe contains intensity coefficient (kg/$). -generateFlowtoDollarCoefficient <- function (sattable, outputyear, referenceyear, location_acronym, IsRoUS = FALSE, model, output_type = "Industry") { - # Generate adjusted industry output - Output_adj <- adjustOutputbyCPI(outputyear, referenceyear, location_acronym, IsRoUS, model, output_type) - rownames(Output_adj) <- gsub(paste0("/", location_acronym), "", rownames(Output_adj)) +generateFlowtoDollarCoefficient <- function (sattable, outputyear, referenceyear, location_acronym, + IsRoUS = FALSE, model, output_type = "Industry", final_demand = FALSE) { + if(final_demand) { + # Output_adj <- data.frame(colSums(model$FinalDemand)) + # Final demand emissions currenlty only assigned to households even though they reflect all final consumption + Output_adj <- data.frame(sum(prepareConsumptionDemand(model, location_acronym))) + rownames(Output_adj) <- model$FinalDemandMeta[model$FinalDemandMeta$Group%in%c("Household") & + grepl(location_acronym, model$FinalDemandMeta$Code_Loc) , "Code"] + # TODO adjust the final demand to reflect emission year!! + colnames(Output_adj) <- paste0(outputyear, output_type, "Output") + } else { + # Generate adjusted industry output + Output_adj <- adjustOutputbyCPI(outputyear, referenceyear, location_acronym, IsRoUS, model, output_type) + } + rownames(Output_adj) <- gsub(paste0("/", location_acronym), "", rownames(Output_adj)) # Merge the satellite table with the adjusted industry output Sattable_USEEIO_wOutput <- merge(sattable, Output_adj, by.x = "Sector", by.y = 0, all.x = TRUE) outputcolname <- paste0(outputyear, output_type, "Output") @@ -123,8 +138,9 @@ aggregateSatelliteTable <- function(sattable, from_level, model) { #' Collapse a totals by sector table so that each flow sector combination exists only once #' @param tbs totals by sector sourced from satellite table #' @param model An EEIO model object with model specs and IO table loaded +#' @param agg_metasources, bool, TRUE to aggregate TbS ignoring MetaSources field #' @return aggregated totals by sector -collapseTBS <- function(tbs, model) { +collapseTBS <- function(tbs, model, agg_metasources = TRUE) { # Add in BEA industry names sectornames <- unique(model$Industries[, c("Code", "Name")]) colnames(sectornames) <- c("Sector", "SectorName") @@ -146,21 +162,38 @@ collapseTBS <- function(tbs, model) { tbs[is.na(tbs[, f]), f] <- 5 } # Aggregate to BEA sectors using unique aggregation functions depending on the quantitative variable - tbs_agg <- dplyr::group_by(tbs, Flowable, Context, FlowUUID, Sector, SectorName, - Location, Unit, Year, DistributionType) - tbs_agg <- dplyr::summarize( - tbs_agg, - FlowAmountAgg = sum(FlowAmount), - Min = min(Min), - Max = max(Max), - DataReliability = stats::weighted.mean(DataReliability, FlowAmount), - TemporalCorrelation = stats::weighted.mean(TemporalCorrelation, FlowAmount), - GeographicalCorrelation = stats::weighted.mean(GeographicalCorrelation, FlowAmount), - TechnologicalCorrelation = stats::weighted.mean(TechnologicalCorrelation, FlowAmount), - DataCollection = stats::weighted.mean(DataCollection, FlowAmount), - MetaSources = paste(sort(unique(MetaSources)), collapse = ' '), - .groups = 'drop' - ) + if(agg_metasources) { + tbs_agg <- dplyr::group_by(tbs, Flowable, Context, FlowUUID, Sector, SectorName, + Location, Unit, Year, DistributionType) + tbs_agg <- dplyr::summarize( + tbs_agg, + FlowAmountAgg = sum(FlowAmount), + Min = min(Min), + Max = max(Max), + DataReliability = stats::weighted.mean(DataReliability, FlowAmount), + TemporalCorrelation = stats::weighted.mean(TemporalCorrelation, FlowAmount), + GeographicalCorrelation = stats::weighted.mean(GeographicalCorrelation, FlowAmount), + TechnologicalCorrelation = stats::weighted.mean(TechnologicalCorrelation, FlowAmount), + DataCollection = stats::weighted.mean(DataCollection, FlowAmount), + MetaSources = paste(sort(unique(MetaSources)), collapse = ' '), + .groups = 'drop' + ) + } else { + tbs_agg <- dplyr::group_by(tbs, Flowable, Context, FlowUUID, Sector, SectorName, + Location, Unit, Year, DistributionType, MetaSources) + tbs_agg <- dplyr::summarize( + tbs_agg, + FlowAmountAgg = sum(FlowAmount), + Min = min(Min), + Max = max(Max), + DataReliability = stats::weighted.mean(DataReliability, FlowAmount), + TemporalCorrelation = stats::weighted.mean(TemporalCorrelation, FlowAmount), + GeographicalCorrelation = stats::weighted.mean(GeographicalCorrelation, FlowAmount), + TechnologicalCorrelation = stats::weighted.mean(TechnologicalCorrelation, FlowAmount), + DataCollection = stats::weighted.mean(DataCollection, FlowAmount), + .groups = 'drop' + ) + } colnames(tbs_agg)[colnames(tbs_agg)=="FlowAmountAgg"] <- "FlowAmount" return(tbs_agg) @@ -281,7 +314,7 @@ mapFlowTotalsbySectorfromBEASchema2007to2012 <- function(totals_by_sector) { #'@param tbs0, totals-by-sector df in source schema #'@param tbs, totals-by-sector df in model schema #'@param tolerance, tolerance level for data loss -checkSatelliteFlowLoss <- function(tbs0, tbs, tolerance=0.005) { +checkSatelliteFlowLoss <- function(tbs0, tbs, tolerance=0.001) { tbs0 <- tbs0[!is.na(tbs0$Sector), ] tbs <- tbs[!is.na(tbs$Sector), ] @@ -311,7 +344,7 @@ checkSatelliteFlowLoss <- function(tbs0, tbs, tolerance=0.005) { n <- length(subset(rel_diff, rel_diff > tolerance)) if(n > 0){ - logging::logdebug("Data loss on conforming to model schema") + logging::logwarn("Data loss on conforming satellite table to model schema") } } diff --git a/R/StateiorFunctions.R b/R/StateiorFunctions.R index 5fa533db..02c12d11 100644 --- a/R/StateiorFunctions.R +++ b/R/StateiorFunctions.R @@ -47,7 +47,7 @@ getTwoRegionIOData <- function(model, dataname) { return(TwoRegionIOData) } -#' @description Disaggregate CPI table to ensure the correct dimensions +#' Disaggregate CPI table to ensure the correct dimensions #' @param df, CPI table #' @param model An EEIO form USEEIO model object with model specs and IO meta data loaded. #' @return An expanded CPI table with values replicated for disaggregated sectors. @@ -70,7 +70,7 @@ disaggregateCPI <- function(df, model){ } -#' @description Generate direct requirements Use table for 2 region models using domestic +#' Generate direct requirements Use table for 2 region models using domestic #' Use table with trade data generated by stateior #' @param model An EEIO form USEEIO model object with model specs and IO meta data loaded. #' @param domestic A logical parameter indicating whether to DR or Domestic DR. @@ -84,8 +84,7 @@ generate2RDirectRequirementsfromUseWithTrade <- function(model, domestic){ state_abb <- sub(".*-","",model$specs$ModelRegionAcronyms[1]) ## Extract characters after - # Define industries and commodities - industries <- getVectorOfCodes(ioschema, iolevel, "Industry") - commodities <- getVectorOfCodes(ioschema, iolevel, "Commodity") + industries <- unique(model$Industries$Code) ita_column <- ifelse(iolevel == "Detail", "F05100", "F051") if(domestic) { @@ -140,7 +139,9 @@ 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 +153,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]) { @@ -183,14 +184,14 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production # Calculate consumption demand for both regions if(location == state_abb[1]) { - # calculate production final demand for SoI - SoI2SoI_y <- rowSums(use_table[["SoI2SoI"]][, c(FD_columns, "ExportResidual")]) + # calculate consumption final demand for SoI + SoI2SoI_y <- rowSums(use_table[["SoI2SoI"]][, c(FD_columns)]) RoUS2SoI_y <- rowSums(use_table[["RoUS2SoI"]][, c(FD_columns)]) y_p <- c(SoI2SoI_y, RoUS2SoI_y) } else if(location == state_abb[2]) { - # calculate production final demand for RoUS + # calculate consumption final demand for RoUS SoI2RoUS_y <- rowSums(use_table[["SoI2RoUS"]][, c(FD_columns)]) - RoUS2RoUS_y <- rowSums(use_table[["RoUS2RoUS"]][, c(FD_columns, "ExportResidual")]) + RoUS2RoUS_y <- rowSums(use_table[["RoUS2RoUS"]][, c(FD_columns)]) y_p <- c(SoI2RoUS_y, RoUS2RoUS_y) } } @@ -201,15 +202,15 @@ prepare2RDemand <- function(model, location, domestic, demand_type = "Production #' Run validation checks for 2R models and print to console #' @param model A complete 2R EEIO model: a list with USEEIO model components and attributes -#' @return A list with 2R model results. -#' @export print2RValidationResults <- function(model) { # Check that Production demand can be run without errors - cat("Checking that production demand vectors do not produce errors for 2-R models, ", - "as well as validating model components.\n\n") - printValidationResults(model) - cat("\n") + cat("\nChecking that production demand vectors do not produce errors for 2-R models.\n") + + if(is.null(model$B)) { + # Stop validation as no satellite tables + return() + } # Creating 2-R Production Complete demand vector f <- model$DemandVectors$vectors[endsWith(names(model$DemandVectors$vectors), "Production_Complete")][[1]] @@ -255,39 +256,37 @@ print2RValidationResults <- function(model) { #' Validate commodity totals between 2R Use table, Make table, and total commodity output objects #' @param model A complete 2R EEIO model: a list with USEEIO model components and attributes #' @return A list containing failures of commodity total comparisons between various model objects. -#' @export validate2RCommodityTotals <- function(model) { failures_ls <- list() - cat("Comparing commodity totals summed from Make and Use (with trade) tables.\n") + cat("\nComparing commodity totals summed from Make and Use (with trade) tables.\n") commodityNum <- dim(model$Commodities)[1] # Get number of commodities q_make <- colSums(model$V) q_use <- rowSums(model$U[1:commodityNum,])#excluding VA rows, including all columns - failures_ls$Make_Use <- compare2RCommodityTotals(q_make, q_use) + failures_ls$Make_Use <- compare2RVectorTotals(q_make, q_use) cat("Comparing commodity totals summed from Make and Domestic Use (with trade) tables.\n") q_d_use <- rowSums(model$U_d[1:commodityNum,])#excluding VA rows, including all columns - failures_ls$Make_DUse <- compare2RCommodityTotals(q_make, q_d_use) + failures_ls$Make_DUse <- compare2RVectorTotals(q_make, q_d_use) cat("Comparing commodity totals summed from Make and commodityTotal (model$q) object imported from stateior.\n\n") - failures_ls$Make_modelq <- compare2RCommodityTotals(q_make, model$q) + failures_ls$Make_modelq <- compare2RVectorTotals(q_make, model$q) return(failures_ls) } -#' Compare commodity totals between the specified 2R model objects -#' @param q_One A vector of commodity totals derived from specific model object -#' @param q_Two A vector of commodity totals dervied from a different model object than q_One +#' Compare totals between the specified 2R model vectors +#' @param v_One A vector of totals derived from specific 2R model object +#' @param v_Two A vector of totals dervied from a different 2R model object than v_One #' @return A list of sectors that failed the comparison between the two specified q vectors. -#' @export -compare2RCommodityTotals <- function(q_One, q_Two) { +compare2RVectorTotals <- function(v_One, v_Two) { - # Calculate relative differences in q_One and q_Two - rel_diff_q <- (q_Two - q_One)/q_One + # Calculate relative differences in v_One and v_Two + rel_diff_q <- (v_Two - v_One)/v_One # Validate relative diff validationResults <- formatValidationResult(rel_diff_q, abs_diff = TRUE, tolerance = 0.01) failures <- validationResults$Failure @@ -300,3 +299,79 @@ compare2RCommodityTotals <- function(q_One, q_Two) { return(failures) } + + +#' Create Make, Use, and Env ratio files for each state from Proxy data for the relevant sectors. +#' @param model An stateior model object with model specs and specific IO tables loaded +#' @param disagg Specifications for disaggregating the current Table +#' @param disaggYear Integer specifying the state model year +#' @param disaggState A string value that indicates the state model being disaggregated. For national models, string should be "US" +#' @return model +createDisaggFilesFromProxyData <- function(model, disagg, disaggYear, disaggState){ + + # Note: this function assumes: + # 1) The disaggregation will use the same proxy values for all disaggregated sectors across all rows and columns. + # That is, if we are disaggregating Summary 22 into the 3 Detail utility sectors, and the proxy allocations are (for example) 0.5/0.25/0.25, then + # in the Use table, the three Detail utility commodities (rows) will have that same split for across all columns (industries/final demand) + # 2) The disagg parameter will contain a disagg$stateDF variable that includes the data for the relevant disaggState and disaggYear parameters. + + if(!is.null(spec$stateFile)){ + + stop("This section of code is meant to be used with 2R models with disaggregated utilities + and is not yet fully implemented.") + } + + #Get subset of ratios for current year + stateDFYear <- subset(disagg$stateDF, Year == disaggYear & State == disaggState) + + # If the state/year combination is not found, assume a uniform split between sectors + if(dim(stateDFYear)[1] == 0){ + + activity <- unlist(disagg$NewSectorCodes) + uniformAllocationVector <- 1/length(disagg$NewSectorCodes) + share <- rep(uniformAllocationVector,length(disagg$NewSectorCodes)) + + stateDFYear <- data.frame(State = rep(disaggState, length(disagg$NewSectorCodes)), + Activity = activity, + Share = share, + Year = rep(disaggYear, length(disagg$NewSectorCodes))) + + } + + print(paste0("For ",disaggState,"-",disaggYear, " the allocation to disaggregate ", + disagg$OriginalSectorCode, " into ", disagg$NewSectorCodes, " is ", stateDFYear$Share)) + + # Default Make DF based on proxy employment values + # Specifying commodity disaggregation (column splits) for Make DF + industries <- c(rep(disagg$OriginalSectorCode,length(disagg$NewSectorCodes))) + commodities <- unlist(disagg$NewSectorCodes) + PercentMake <- stateDFYear$Share # need to add code to ensure that the order of stateDF$Share is the same as the order of disagg$NewSectorCodes + note <- c(rep("CommodityDisagg", length(disagg$NewSectorCodes))) + + makeDF <- data.frame(cbind(data.frame(industries), data.frame(commodities), data.frame(PercentMake), data.frame(note))) #need to rename the columns with the correct column names + colnames(makeDF) <- c("IndustryCode","CommodityCode", "PercentMake", "Note") + + + # Default Use DF based on employment ratios + # Specifying industry disaggregation (column splits) for Use DF + industries <- unlist(disagg$NewSectorCodes) + commodities <- c(rep(disagg$OriginalSectorCode,length(disagg$NewSectorCodes))) + PercentUse <- stateDFYear$Share + note <- c(rep("IndustryDisagg", length(disagg$NewSectorCodes))) + + useDF <- data.frame(cbind(data.frame(industries), data.frame(commodities), data.frame(PercentUse), data.frame(note))) #need to rename the columns with the correct column names + useDF_2 <- makeDF # so that colnames match + colnames(useDF) <- c("IndustryCode","CommodityCode", "PercentUse", "Note") + colnames(useDF_2) <- c("IndustryCode","CommodityCode", "PercentUse", "Note") + + useDF <- rbind(useDF, useDF_2) #need to bid makeDF because disaggregation procedure requires the UseDF to have the default commodity and industry output. + + # Add new DFs to disagg and to model + disagg$MakeFileDF <- makeDF + disagg$UseFileDF <- useDF + + model$DisaggregationSpecs[[disagg$OriginalSectorCode]] <- disagg + + return(model) + +} diff --git a/R/ValidateModel.R b/R/ValidateModel.R index 99cccdc1..bab1e4a0 100644 --- a/R/ValidateModel.R +++ b/R/ValidateModel.R @@ -5,7 +5,6 @@ #' @param use_domestic, a logical value indicating whether to use domestic demand vector #' @param tolerance, a numeric value, tolerance level of the comparison #' @return A list with pass/fail validation result and the cell-by-cell relative diff matrix -#' @export compareEandLCIResult <- function(model, use_domestic = FALSE, tolerance = 0.05) { # Prepare left side of the equation CbS_cast <- standardizeandcastSatelliteTable(model$CbS,model) @@ -80,7 +79,6 @@ calculateProductofLeontiefAndProductionDemand <- function (model, use_domestic) #' @param use_domestic, a logical value indicating whether to use domestic demand vector #' @param tolerance, a numeric value, tolerance level of the comparison #' @return A list with pass/fail validation result and the cell-by-cell relative diff matrix -#' @export compareOutputandLeontiefXDemand <- function(model, use_domestic=FALSE, tolerance=0.05) { # Generate output and scaling vector if(model$specs$CommodityorIndustryType == "Commodity") { @@ -111,7 +109,6 @@ compareOutputandLeontiefXDemand <- function(model, use_domestic=FALSE, tolerance #' @param model A complete EEIO model: a list with USEEIO model components and attributes #' @param tolerance, a numeric value, tolerance level of the comparison #' @return A list with pass/fail validation result and the cell-by-cell relative diff matrix -#' @export compareCommodityOutputandDomesticUseplusProductionDemand <- function(model, tolerance=0.05) { q <- removeHybridProcesses(model, model$q) demand <- model$DemandVectors$vectors[endsWith(names(model$DemandVectors$vectors),"Production_Domestic")][[1]] @@ -141,7 +138,6 @@ compareCommodityOutputandDomesticUseplusProductionDemand <- function(model, tole #' @param model A complete EEIO model: a list with USEEIO model components and attributes #' @param tolerance, a numeric value, tolerance level of the comparison #' @return A list with pass/fail validation result and the cell-by-cell relative diff matrix -#' @export compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation <- function(model, tolerance=0.05) { if(model$specs$BaseIOSchema == 2012){ target_year <- "2017" @@ -312,17 +308,20 @@ printValidationResults <- function(model) { print(paste("Number of sectors passing:",econval$N_Pass)) print(paste("Number of sectors failing:",econval$N_Fail)) print(paste("Sectors failing:", paste(unique(econval$Failure$rownames), collapse = ", "))) - - print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total requirements matrix (L), and demand vector (y) for US production") - modelval <- compareEandLCIResult(model, tolerance = 0.01) - print(paste("Number of flow totals by commodity passing:",modelval$N_Pass)) - print(paste("Number of flow totals by commodity failing:",modelval$N_Fail)) - - print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total domestic requirements matrix (L_d), and demand vector (y) for US production") - dom_val <- compareEandLCIResult(model, use_domestic=TRUE, tolerance = 0.01) - print(paste("Number of flow totals by commodity passing:",dom_val$N_Pass)) - print(paste("Number of flow totals by commodity failing:",dom_val$N_Fail)) - print(paste("Sectors with flow totals failing:", paste(unique(dom_val$Failure$variable), collapse = ", "))) + + if(!is.null(model$B)) { + print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total requirements matrix (L), and demand vector (y) for US production") + modelval <- compareEandLCIResult(model, tolerance = 0.01) + print(paste("Number of flow totals by commodity passing:",modelval$N_Pass)) + print(paste("Number of flow totals by commodity failing:",modelval$N_Fail)) + print(paste("Sectors with flow totals failing:", paste(unique(modelval$Failure$variable), collapse = ", "))) + + print("Validate that flow totals by commodity (E_c) can be recalculated (within 1%) using the model satellite matrix (B), market shares matrix (V_n), total domestic requirements matrix (L_d), and demand vector (y) for US production") + dom_val <- compareEandLCIResult(model, use_domestic=TRUE, tolerance = 0.01) + print(paste("Number of flow totals by commodity passing:",dom_val$N_Pass)) + print(paste("Number of flow totals by commodity failing:",dom_val$N_Fail)) + print(paste("Sectors with flow totals failing:", paste(unique(dom_val$Failure$variable), collapse = ", "))) + } print("Validate that commodity output are properly transformed to industry output via MarketShare") q_x_val <- compareCommodityOutputXMarketShareandIndustryOutputwithCPITransformation(model, tolerance = 0.01) @@ -337,6 +336,18 @@ printValidationResults <- function(model) { print(paste("Number of flow totals by commodity failing:",q_val$N_Fail)) print(paste("Sectors with flow totals failing:", paste(unique(q_val$Failure$rownames), collapse = ", "))) } + + if(model$specs$IODataSource =="stateior") { + print2RValidationResults(model) + } + + if(!is.null(model$specs$ExternalImportFactors) && model$specs$ExternalImportFactors) { + validateImportFactorsApproach(model) + } + + if(!is.null(model$B_h)) { + validateHouseholdEmissions(model) + } } #' Removes hybrid processes form a model object for successful validation @@ -361,6 +372,7 @@ removeHybridProcesses <- function(model, object) { return(object) } + #' Compare commodity or industry output calculated from Make and Use tables. #' @param model A model list object with model specs and IO tables listed #' @param output_type A string indicating commodity or industry output. @@ -382,3 +394,193 @@ compareOutputfromMakeandUse <- function(model, output_type = "Commodity") { rel_diff[is.nan(rel_diff)] <- 0 return(rel_diff) } + +#' Validate the results of the model build using the Import Factor approach (i.e., coupled model approach) +#' @param model, An EEIO model object with model specs and crosswalk table loaded +#' @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(is.null(model$M_m)) { + return() + } + + if(model$specs$IODataSource == "stateior"){ + if(demand != "Consumption"){ + stop("Validation for 2-region models is only available for Consumption demand vector.") + } + location <- model$specs$ModelRegionAcronyms[[1]] + } else { + location <- NULL + } + # Compute standard final demand + 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 = 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 = 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)) + + # Calculate "Standard" economic throughput (x) + x <- model$L %*% y + + # Calculate economic throughput using coupled model approach + # Revised equation from RW email (2023-11-01): + # x_dm <- L_d * Y_d + L*A_m*L_d*Y_d + L*Y_m + + x_dm <- (model$L_d %*% y_d) + (model$L %*% model$A_m %*% model$L_d %*% y_d + model$L %*% y_m) + + cat("\nTesting that economic throughput is equivalement between standard and coupled model approaches for the given final demand vector.\n") + cat("I.e.,: x = x_dm.\n") + print(all.equal(x, x_dm)) + + # Calculate "Standard" environmental impacts + M <- model$B %*% model$L + LCI <- M %*% y # Equivalent to model$M %*% y, + + # Calculate LCI using coupled model approach + # Revised equation from RW email (2023-11-01): + # LCI <- (s_d * L_d * Y_d) + (s*L*A_m*L_d*Y_d + s*L*Y_m). I.e., s in RW email is analogous to model$B + # For validation, we use M as a stand-in for import emissions , whereas in normally we'd be using model$M_m + + LCI_dm <- (model$M_d %*% y_d) + (M %*% model$A_m %*% model$L_d %*% y_d + M %*% y_m) + + cat("\nTesting that LCI results are equivalent between standard and coupled model approaches (i.e., LCI = LCI_dm) when\n") + cat("assuming model$M = model$M_m.\n") + print(all.equal(LCI, LCI_dm)) + + # Calculate LCIA using standard approach + LCIA <- t(model$C %*% M %*% diag(as.vector(y))) #same as result_std_consumption$LCIA_f, above + colnames(LCIA) <- rownames(model$N_m) + rownames(LCIA) <- colnames(model$N_m) + + # Calculate LCIA using coupled model approach + y_d <- diag(as.vector(y_d)) + y_m <- diag(as.vector(y_m)) + + LCI_dm <- (model$M_d %*% y_d) + (M %*% model$A_m %*% model$L_d %*% y_d + M %*% y_m) + + LCIA_dm <- t(model$C %*% (LCI_dm)) + colnames(LCIA_dm) <- rownames(model$N_m) + rownames(LCIA_dm) <- colnames(model$N_m) + + cat("\nTesting that LCIA results are equivalent between standard and coupled model approaches (i.e., LCIA = LCIA_dm) when\n") + cat("assuming model$M = model$M_m.\n") + print(all.equal(LCIA_dm, LCIA)) + +} + +#' Validate the calculation of household_emissions +#' @param model, A fully built EEIO model object +validateHouseholdEmissions <- function(model) { + location <- model$specs$ModelRegionAcronyms[1] + r <- calculateEEIOModel(model, perspective="FINAL", demand="Consumption", + location = location, + household_emissions = TRUE) + codes <- model$FinalDemandMeta[model$FinalDemandMeta$Group%in%c("Household") & + grepl(location, model$FinalDemandMeta$Code_Loc), "Code_Loc"] + flows <- model$TbS + flows$Code_Loc <- paste0(flows$Sector, "/", flows$Location) + flows <- flows[flows$Code_Loc %in% codes, ] + flows <- setNames(flows$FlowAmount, flows$Flow) + + cat("\nTesting that LCI emissions from households are equivalent to calculated result from Total Consumption.\n") + result <- r$LCI_f[codes, names(flows)] + all.equal(flows, result) +} + +#' Test that model calculation functions are successful +#' Includes tests for the following functions: +#' adjustResultMatrixPrice, calculateFlowContributiontoImpact, +#' calculateSectorContributiontoImpact, disaggregateTotalToDirectAndTier1, +#' calculateSectorPurchasedbySectorSourcedImpact, aggregateResultMatrix, +#' calculateMarginSectorImpacts +#' +#' @param model, A fully built EEIO model object +#' @export +testCalculationFunctions <- function(model) { + target_year <- ifelse(model$specs$IOYear != 2019, 2019, 2020) + sector <- model$Commodities$Code_Loc[[10]] + indicator <- model$Indicators$meta$Name[[1]] + + matrix <- adjustResultMatrixPrice(matrix_name = "N", + currency_year = target_year, + purchaser_price = TRUE, + model) + if(!all(dim(model$N) == dim(matrix)) && !all(model$N == matrix)) { + print("Error in adjustResultMatrixPrice()") + } + + flow_contrib <- calculateFlowContributiontoImpact(model, sector, indicator) + if(!all.equal(sum(flow_contrib$contribution), 1)) { + print("Error in calculateFlowContributiontoImpact()") + } + + sector_contrib <- calculateSectorContributiontoImpact(model, sector, indicator) + if(!all.equal(sum(sector_contrib$contribution), 1)) { + print("Error in calculateSectorContributiontoImpact()") + } + + demand = model$DemandVectors$vectors[[1]] + result <- calculateSectorPurchasedbySectorSourcedImpact(y=demand, model, indicator) + if(model$specs$IODataSource != "stateior") { + # not working for 2R mode + agg_result <- aggregateResultMatrix(result, "Sector", model$crosswalk) + } + + result <- disaggregateTotalToDirectAndTier1(model, indicator) + + if(model$specs$IODataSource != "stateior") { + margins <- calculateMarginSectorImpacts(model) + } + +} + +#' Test that visualization functions are successful +#' Includes tests for the following functions: +#' barplotFloworImpactFractionbyRegion, barplotIndicatorScoresbySector, +#' heatmapSatelliteTableCoverage, heatmapSectorRanking, plotMatrixCoefficient +#' +#' @param model, A fully built EEIO model object +#' @export +testVisualizationFunctions <- function(model) { + model_list <- list("model" = model) + loc <- model$specs$ModelRegionAcronyms[[1]] + indicator <- model$Indicators$meta$Name[[1]] + + fullcons <- calculateEEIOModel(model, perspective='DIRECT', demand="Consumption", + location = loc) + domcons <- calculateEEIOModel(model, perspective='DIRECT', demand="Consumption", + location = loc, use_domestic_requirements = TRUE) + barplotFloworImpactFractionbyRegion(domcons$LCIA_d, + fullcons$LCIA_d, + "Domestic Proportion of Impact") + ## ^^ This may not be working correctly for 2R models + + barplotIndicatorScoresbySector(model_list, + totals_by_sector_name = "GHG", + indicator_name = "Greenhouse Gases", + sector = FALSE, y_title = "") + + heatmapSatelliteTableCoverage(model, form = "Industry") + # ^^ not working for form = "Commodity" + + indicators <- model$Indicators$meta$Code[1:min(5, length(model$Indicators$meta$Code))] + + if(model$specs$IODataSource != "stateior") { + # not working for 2R models + heatmapSectorRanking(model, matrix = fullcons$LCIA_d, indicators, + sector_to_remove = "", N_sector = 20) + } + + plotMatrixCoefficient(model_list, matrix_name = "D", + coefficient_name = indicator, + sector_to_remove = "", y_title = indicator, + y_label = "Name") +} diff --git a/R/VisualizationFunctions.R b/R/VisualizationFunctions.R index 3d0a29a0..cb757585 100644 --- a/R/VisualizationFunctions.R +++ b/R/VisualizationFunctions.R @@ -237,6 +237,9 @@ heatmapSatelliteTableCoverage <- function(model, form="Commodity") { #' @export heatmapSectorRanking <- function(model, matrix, indicators, sector_to_remove, N_sector, x_title = NULL, use_codes = TRUE) { + if(model$specs$IODataSource == "stateior") { + stop("heatmapSectorRanking not available for two-region models.") + } # Generate BEA sector color mapping mapping <- getBEASectorColorMapping(model) mapping$GroupName <- mapping$SectorName @@ -339,8 +342,8 @@ getBEASectorColorMapping <- function(model) { ColorLabelMapping$color <- rownames(ColorLabelMapping) # Add Households, Used and Other # ColorLabelMapping["#FFE119", ] <- c("Households", "F010", "#FFE119") # yellow - # ColorLabelMapping["#42D4F4", ] <- c("Used", "Used", "#42D4F4") # cyan (bright blue) - # ColorLabelMapping["#469990", ] <- c("Other", "Other", "#469990") # teal + ColorLabelMapping["#42D4F4", ] <- c("Used", "Used", "#42D4F4") # cyan (bright blue) + ColorLabelMapping["#469990", ] <- c("Other", "Other", "#469990") # teal # Prepare BEA Sector-modelIOLevel mapping mapping <- unique(model$crosswalk[, c("BEA_Sector", "USEEIO")]) colnames(mapping) <- c("Sector", paste0(model$specs$BaseIOLevel, "Code")) diff --git a/R/WriteModel.R b/R/WriteModel.R index 514cd550..06fd7ce6 100644 --- a/R/WriteModel.R +++ b/R/WriteModel.R @@ -1,8 +1,9 @@ # Functions for exporting the model to disc #' The vector of matrices to write out -matrices <- c("V", "U", "U_d", "A", "A_d", "B", "C", "D", "L", "L_d", - "M", "M_d", "N", "N_d", "Rho", "Phi", "Tau") +matrices <- c("V", "U", "U_d", "A", "A_d", "A_m", "B", "C", "D", "L", "L_d", + "M", "M_d", "M_m", "N", "N_d", "N_m", + "Rho", "Phi", "Tau") #' Writes all model data and metadata components to the API #' @param model A complete EEIO model: a list with USEEIO model components and attributes. @@ -84,6 +85,9 @@ writeModeltoXLSX <- function(model, outputfolder) { prepareWriteDirs(model, dirs) writeModelMetadata(model, dirs) metadata_tabs <- c("demands", "flows", "indicators", "sectors") + if(is.null(model$SatelliteTables)){ + metadata_tabs <- metadata_tabs[metadata_tabs != "flows"] + } if(is.null(model$Indicators)){ metadata_tabs <- metadata_tabs[metadata_tabs != "indicators"] } @@ -269,24 +273,29 @@ writeModelMetadata <- function(model, dirs) { utils::write.csv(sectors, paste0(dirs$model, "/sectors.csv"), na = "", row.names = FALSE, fileEncoding = "UTF-8") - # Write flows to csv - flows <- model$SatelliteTables$flows - flows$ID <- apply(flows[, c("Flowable", "Context", "Unit")], 1, FUN = joinStringswithSlashes) - names(flows)[names(flows) == 'FlowUUID'] <- 'UUID' - flows <- flows[order(flows$ID),] - flows$Index <- c(1:nrow(flows)-1) - flows <- flows[, fields$flows] - #checkNamesandOrdering(flows$ID, rownames(model$B), - # "flows in flows.csv and rows in B matrix") - utils::write.csv(flows, paste0(dirs$model, "/flows.csv"), na = "", - row.names = FALSE, fileEncoding = "UTF-8") + if(!is.null(model$SatelliteTables)) { + # Write flows to csv + flows <- model$SatelliteTables$flows + flows$ID <- apply(flows[, c("Flowable", "Context", "Unit")], 1, FUN = joinStringswithSlashes) + names(flows)[names(flows) == 'FlowUUID'] <- 'UUID' + flows <- flows[order(flows$ID),] + flows$Index <- c(1:nrow(flows)-1) + flows <- flows[, fields$flows] + #checkNamesandOrdering(flows$ID, rownames(model$B), + # "flows in flows.csv and rows in B matrix") + utils::write.csv(flows, paste0(dirs$model, "/flows.csv"), na = "", + row.names = FALSE, fileEncoding = "UTF-8") + } # Write years to csv years <- data.frame(ID=colnames(model$Rho), stringsAsFactors = FALSE) years$Index <- c(1:length(years$ID)-1) years <- years[, fields$years] - checkNamesandOrdering(years$ID, colnames(model$Phi), - "years in years.csv and cols in Phi matrix") + + if(!is.null(model$Phi)) { + checkNamesandOrdering(years$ID, colnames(model$Phi), + "years in years.csv and cols in Phi matrix") + } checkNamesandOrdering(years$ID, colnames(model$Rho), "years in years.csv and cols in Rho matrix") utils::write.csv(years, paste0(dirs$model, "/years.csv"), na = "", diff --git a/README.md b/README.md index 4b36353e..caeddea5 100644 --- a/README.md +++ b/README.md @@ -52,7 +52,7 @@ devtools::install_github("USEPA/useeior") devtools::install_github("USEPA/useeior@v1.0.0") ``` -See [Releases](https://github.com/USEPA/useeior/releases) for all previously realeased versions. +See [Releases](https://github.com/USEPA/useeior/releases) for all previously released versions. ## Usage diff --git a/format_specs/Model.md b/format_specs/Model.md index d411ed0c..f7efa7d8 100644 --- a/format_specs/Model.md +++ b/format_specs/Model.md @@ -21,6 +21,7 @@ Items are listed in the order in which they appear in a built Model object in R. | InternationalTradeAdjustmentMeta | data.frame | metadata | Metadata for international trade adjusment in [sector meta with group format](#Sector-Meta-with-Group) | | MarginSectors | data.frame | metadata | Margin sector metadata in [sector meta format](#sector-meta) | | ValueAddedMeta | data.frame | metadata | Value added metadata in [sector meta format](#sector-meta) | +| ImportMatrix | data.frame | supporting data | A version of the model Use table with imports only | | MultiYearIndustryOutput | data.frame | supporting data | Multi-year industry output in [sector-by-year format](#sector-by-year) | | MultiYearCommodityOutput | data.frame | supporting data | Multi-year commodity output in [sector-by-year format](#sector-by-year) | | Margins | data.frame | supporting data | [The final consumer margins table](#margins) | @@ -47,16 +48,20 @@ Items are listed in the order in which they appear in a built Model object in R. | x | numeric vector | component matrix | [Total output by industry](#output-vectors) | | mu | numeric vector | component matrix | [International trade adjustment by commodity](#international-trade-adjustment-vector) | | A | matrix | component matrix | [The direct requirements matrix](#A) | +| A_m | matrix | component matrix | [The imports direct requirements matrix](#A) | | A_d | matrix | component matrix | [The domestic direct requirements matrix](#A) | | L | matrix | component matrix | [The Leontief inverse matrix](#L) | | L_d | matrix | component matrix | [The domestic Leontief inverse matrix](#L) | | B | matrix | component matrix | [The direct emissions and resource use matrix](#B) | +| B_h | matrix | component matrix | [The direct emissions and resource use matrix for final demand](#B) | | C | matrix | component matrix | [The characterization factor matrix](#C) | | D | matrix | result matrix | [The direct impact matrix](#D) | | M | matrix | result matrix | [The total emissions and resource use matrix](#M) | | M_d | matrix | result matrix | [The total emissions and resource use (from and by domestic activity) matrix](#M) | +| M_m| matrix | result matrix | [The total emissions and resource use (from imported activity) matrix](#M) | | N | matrix | result matrix | [The total impact matrix](#N) | | N_d | matrix | result matrix | [The total impact (from domestic activity) matrix](#N) | +| N_m | matrix | result matrix | [The total impact (from imported activity) matrix](#N) | | Rho | matrix | component matrix | [The CPI1 price year ratio matrix for a given model](#Rho)| | Phi | matrix | component matrix | [The producer-to-purchaser price ratio matrix for a given model](#Phi)| | Tau | matrix | component matrix | [The basic-to-producer price ratio matrix for a given model](#Tau)| @@ -279,8 +284,8 @@ sectors | | +-------+ ``` -The related `A_d` matrix provides direct sector inputs per dollar sector output that are only from the US. - +The related `A_d` matrix provides direct sector inputs per dollar sector output for inputs that are from the US. +The related `A_m` matrix provides direct sector inputs per dollar output for inputs that are international imports if a model is built with [ExternalImportFactors](ModelSpecification.md). #### L `L` is also a `sector x sector` matrix and contains in each column `i` the total requirements of the respective sectors inputs per 1 USD of output @@ -294,7 +299,8 @@ sectors | | +-------+ ``` -The related `L_d` matrix provides direct + indirect sector inputs per dollar output that are only from the US. +The related `L_d` matrix provides direct + indirect sector inputs per dollar output for inputs that are from the US. + #### B The satellite matrix `B` is a `flow x sector` matrix and contains in @@ -383,6 +389,7 @@ flows | | ``` The related `M_d` matrix provides direct + indirect emissions and resources per dollar output that are only from the US. +The related `M_m` matrix provides direct + indirect emissions and resources per dollar of imported goods if a model is built with [ExternalImportFactors](ModelSpecification.md). #### N The matrix `N` is a `indicator x sector` matrix and contains in each column @@ -397,3 +404,4 @@ indicators | | ``` The related `N_d` matrix provides direct + indirect impact results per dollar output that are only from the US. +The related `N_m` matrix provides direct + indirect impact results per dollar of imported goods if a model is built with [ExternalImportFactors](ModelSpecification.md). diff --git a/format_specs/ModelCustomization.md b/format_specs/ModelCustomization.md index a286aa22..ca86f825 100644 --- a/format_specs/ModelCustomization.md +++ b/format_specs/ModelCustomization.md @@ -154,3 +154,13 @@ Unit | str | Y | | WIO Section | str | N | | Note | string | N | | +## Import Emission Factors + +Specifications for import emission factors file, e.g., + +``` +ImportFactors: + StaticFile: "useeior/US_summary_import_factors_exio_2019_17sch.csv" + FileLocation: "DataCommons" +``` + diff --git a/format_specs/ModelSpecification.md b/format_specs/ModelSpecification.md index 3324a24c..ba3c4f03 100644 --- a/format_specs/ModelSpecification.md +++ b/format_specs/ModelSpecification.md @@ -19,6 +19,7 @@ Model specifications are assigned in a yml file based on the parameters shown be | HybridizationSpecs | str | N | The [hybridization specifications](ModelCustomization.md#hybridization-file-specification) | | MUIOSpecs | str | N | The [mixed unit hybridization specifications](ModelCustomization.md#mixed-unit-file-specification) | | WIOSpecs | str | N | The [waste input output specifications](ModelCustomization.md#waste-input-output-file-specification) | +| ExternalImportFactors | bool | N | Whether the model includes specifications for [Import Emission Factors](ModelCustomization.md#import-emission-factors) | | SatelliteTable | list | | The [satellite table specifications](#Satellite-Table-Specifications) | | Indicators | list | N | The [indicator specifications](#Indicator-Specifications) | | DemandVectors | list | | The [demand vector specifications](#Demand-Vector-Specifications) | diff --git a/inst/extdata/Crosswalk_SummaryIndustrytoCommodityName2012Schema.csv b/inst/extdata/Crosswalk_SummaryIndustrytoCommodityName2012Schema.csv index df6f70db..83763166 100644 --- a/inst/extdata/Crosswalk_SummaryIndustrytoCommodityName2012Schema.csv +++ b/inst/extdata/Crosswalk_SummaryIndustrytoCommodityName2012Schema.csv @@ -18,7 +18,7 @@ 337,Furniture and related products,Furniture and shelving 339,Miscellaneous manufacturing,"Medical supplies, entertainment and sporting goods, fashion goods, advertising products" 311FT,Food and beverage and tobacco products,Food and beverage and tobacco products -313TT,Textile mills and textile product mills,Textiles and textile-dervied products (except clothes) +313TT,Textile mills and textile product mills,Textiles and textile-derived products (except clothes) 315AL,Apparel and leather and allied products,Clothing and leather 322,Paper products,Paper products and paper production facilities 323,Printing and related support activities,Print media and printing support diff --git a/inst/extdata/USEEIO_Commodity_Meta.csv b/inst/extdata/USEEIO_Commodity_Meta.csv index 4f0f7c27..cf3da284 100644 --- a/inst/extdata/USEEIO_Commodity_Meta.csv +++ b/inst/extdata/USEEIO_Commodity_Meta.csv @@ -237,7 +237,7 @@ Code,Name,Category,Subcategory,Description 335920,Communication and energy wire and cable,31-33: Manufacturing,3359: Other Electrical Equipment and Component Manufacturing,"BEA Code & Name is '335920:Communication and energy wire and cable manufacturing'. This industry comprises establishments insulating fiber-optic cable, and manufacturing insulated nonferrous wire and cable from nonferrous wire drawn in other establishments." 335930,Wiring devices,31-33: Manufacturing,3359: Other Electrical Equipment and Component Manufacturing,BEA Code & Name is '335930:Wiring device manufacturing'. This industry comprises establishments primarily engaged in manufacturing current-carrying wiring devices and noncurrent-carrying wiring devices for wiring electrical circuits. 335991,Carbon and graphite products,31-33: Manufacturing,3359: Other Electrical Equipment and Component Manufacturing,"BEA Code & Name is '335991:Carbon and graphite product manufacturing'. This U.S. industry comprises establishments primarily engaged in manufacturing carbon, graphite, and metal-graphite brushes and brush stock; carbon or graphite electrodes for thermal and electrolytic uses; carbon and graphite fibers; and other carbon, graphite, and metal-graphite products." -335999,other miscellaneous electrical equipment and components,31-33: Manufacturing,3359: Other Electrical Equipment and Component Manufacturing,"BEA Code & Name is '335999:All other miscellaneous electrical equipment and component manufacturing'. This U.S. industry comprises establishments primarily engaged in manufacturing industrial and commercial electric apparatus and other equipment (except lighting equipment, household appliances, transformers, motors, generators, switchgear, relays, industrial controls, batteries, communication and energy wire and cable, wiring devices, and carbon and graphite products). This industry includes power converters (i.e., AC to DC and DC to AC), power supplies, surge suppressors, and similar equipment for industrial-type and consumer-type equipment." +335999,Other miscellaneous electrical equipment and components,31-33: Manufacturing,3359: Other Electrical Equipment and Component Manufacturing,"BEA Code & Name is '335999:All other miscellaneous electrical equipment and component manufacturing'. This U.S. industry comprises establishments primarily engaged in manufacturing industrial and commercial electric apparatus and other equipment (except lighting equipment, household appliances, transformers, motors, generators, switchgear, relays, industrial controls, batteries, communication and energy wire and cable, wiring devices, and carbon and graphite products). This industry includes power converters (i.e., AC to DC and DC to AC), power supplies, surge suppressors, and similar equipment for industrial-type and consumer-type equipment." 336111,Automobiles,31-33: Manufacturing,3361: Motor Vehicle Manufacturing,"BEA Code & Name is '336111:Automobile manufacturing'. This U.S. industry comprises establishments primarily engaged in (1) manufacturing complete automobiles (i.e., body and chassis or unibody) or (2) manufacturing automobile chassis only." 336112,"Pickup trucks, vans, and SUVs",31-33: Manufacturing,3361: Motor Vehicle Manufacturing,"BEA Code & Name is '336112:Light truck and utility vehicle manufacturing'. This U.S. industry comprises establishments primarily engaged in (1) manufacturing complete light trucks and utility vehicles (i.e., body and chassis) or (2) manufacturing light truck and utility vehicle chassis only. Vehicles made include light duty vans, pick-up trucks, minivans, and sport utility vehicles." 336120,Heavy duty trucks,31-33: Manufacturing,3361: Motor Vehicle Manufacturing,"BEA Code & Name is '336120:Heavy duty truck manufacturing'. This industry comprises establishments primarily engaged in (1) manufacturing heavy duty truck chassis and assembling complete heavy duty trucks, buses, heavy duty motor homes, and other special purpose heavy duty motor vehicles for highway use or (2) manufacturing heavy duty truck chassis only." @@ -448,12 +448,12 @@ V00300,Gross operating surplus,,, 337,Furniture and shelving,31-33: Manufacturing,, 339,"Medical supplies, entertainment and sporting goods, fashion goods, advertising products",31-33: Manufacturing,, 311FT,Food and beverage and tobacco products,31-33: Manufacturing,, -313TT,Textiles and textile-dervied products (except clothes),31-33: Manufacturing,, +313TT,Textiles and textile-derived products (except clothes),31-33: Manufacturing,, 315AL,Clothing and leather,31-33: Manufacturing,, 322,Paper products and paper production facilities,31-33: Manufacturing,, 323,Print media and printing support,31-33: Manufacturing,, 324,"Petroleum fuels, asphalt, and other petroleum and coal products",31-33: Manufacturing,, -325,"Agricultural, pharamceutical, industrial, and commercial chemicals",31-33: Manufacturing,, +325,"Agricultural, pharmaceutical, industrial, and commercial chemicals",31-33: Manufacturing,, 326,Plastics and rubber products,31-33: Manufacturing,, 42,Wholesale trade,42: Wholesale Trade,, 441,Vehicles and parts sales,44-45: Retail Trade,, diff --git a/inst/extdata/VisualizationEssentials.yml b/inst/extdata/VisualizationEssentials.yml index 0f05bb05..f0c19fbe 100644 --- a/inst/extdata/VisualizationEssentials.yml +++ b/inst/extdata/VisualizationEssentials.yml @@ -45,6 +45,10 @@ BEASectorLevel: - "#B2DF8A": # light green - "Government" - "G" + - "#808080": # gray + - "Households" + - "F010" + Indicators: ColorLabelMapping: diff --git a/tests/modelspecs/USEEIOv2.0-s-GHG.yml b/inst/extdata/modelspecs/GAEEIOv1.0-GHG-19.yml similarity index 69% rename from tests/modelspecs/USEEIOv2.0-s-GHG.yml rename to inst/extdata/modelspecs/GAEEIOv1.0-GHG-19.yml index 8ef8c724..c1d124e9 100644 --- a/tests/modelspecs/USEEIOv2.0-s-GHG.yml +++ b/inst/extdata/modelspecs/GAEEIOv1.0-GHG-19.yml @@ -1,10 +1,11 @@ -Model: "USEEIOv2.0-s-GHG" +Model: "GAEEIOv1.0-GHG-19" BaseIOSchema: 2012 BaseIOLevel: "Summary" -IOYear: 2012 # Year for IO data -ModelRegionAcronyms: ["US"] +IOYear: 2019 # Year for IO data +ModelRegionAcronyms: ["US-GA", "RoUS"] ModelType: "EEIO" -IODataSource: "BEA" +IODataSource: "stateior" +IODataVersion: "0.2.1" BasePriceType: "PRO" #producer BasewithRedefinitions: FALSE CommodityorIndustryType: "Commodity" @@ -16,20 +17,22 @@ SatelliteTable: FullName: "Greenhouse Gases" Abbreviation: "GHG" StaticSource: TRUE - StaticFile: "useeior/NGHGIAM_GHG_TotalsBySector.csv" + StaticFile: "flowsa/FlowBySector/GHG_state_2019_m1_v2.0.0_a8c5929.parquet" FileLocation: "DataCommons" - DataYears: [2016] + DataYears: [2019] Locations: ["US"] - SectorListSource: "BEA" # or, NAICS + SectorListSource: "NAICS" SectorListYear: 2012 - SectorListLevel: "Detail" + SectorListLevel: "6" OriginalFlowSource: "FEDEFLv1.0.6" + ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script + ScriptFunctionParameters: null DataSources: - USEPA_GHG_2018: + USEPA_GHG_2021: Title: "GHG Inventory" Author: "USEPA" - DataYear: 2016 - URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2016" + DataYear: 2020 + URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2020" Primary: TRUE Indicators: @@ -56,4 +59,7 @@ Indicators: DemandVectors: DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file -# Additional demand vectors beyond useeior defaults + +# ImportFactors: +# StaticFile: "useeior/US_summary_import_factors_exio_2019_12sch.csv" +# FileLocation: "DataCommons" diff --git a/inst/extdata/modelspecs/USEEIOv2.3-GHG.yml b/inst/extdata/modelspecs/USEEIOv2.3-GHG.yml new file mode 100644 index 00000000..1905caa7 --- /dev/null +++ b/inst/extdata/modelspecs/USEEIOv2.3-GHG.yml @@ -0,0 +1,66 @@ +Model: "USEEIOv2.3-GHG" # 2017 Detail, Commodity +BaseIOSchema: 2017 +BaseIOLevel: "Detail" +IOYear: 2017 # Year for IO data +ModelRegionAcronyms: ["US"] +ModelType: "EEIO" +IODataSource: "BEA" +BasePriceType: "PRO" #producer +BasewithRedefinitions: FALSE +CommodityorIndustryType: "Commodity" +ScrapIncluded: FALSE +DisaggregationSpecs: null +ExternalImportFactors: TRUE + +SatelliteTable: + GHG: + FullName: "Greenhouse Gases" + Abbreviation: "GHG" + StaticSource: TRUE + StaticFile: "flowsa/FlowBySector/GHG_national_2019_m2_v2.0.3_1cb504c.parquet" + FileLocation: "DataCommons" + DataYears: [2019] + Locations: ["US"] + SectorListSource: "NAICS" + SectorListYear: 2017 + SectorListLevel: "6" + OriginalFlowSource: "FEDEFLv1.2" + ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script + ScriptFunctionParameters: null + DataSources: + USEPA_GHG_2024: + Title: "GHG Inventory" + Author: "USEPA" + DataYear: 2019 + URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2022" + 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/ipcc/IPCC_v1.1.1_27ba917.parquet" + FileLocation: "DataCommons" + ScriptFunctionCall: "getImpactMethod" #function to call for script + ScriptFunctionParameters: + indicators: ["AR6-100"] + DataSources: + IPCC_AR6: + Title: "IPCC Sixth Assessment Report: Direct Global Warming Potentials for 100 year time horizon" + Author: "IPCC" + DataYear: 2021 + URL: "" + Primary: TRUE + +DemandVectors: + DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file +# Additional demand vectors beyond useeior defaults + +ImportFactors: + StaticFile: "useeior/US_detail_import_factors_exio_2019_17sch.csv" + FileLocation: "DataCommons" diff --git a/inst/extdata/modelspecs/USEEIOv2.3-s-GHG-19.yml b/inst/extdata/modelspecs/USEEIOv2.3-s-GHG-19.yml new file mode 100644 index 00000000..469d2eaa --- /dev/null +++ b/inst/extdata/modelspecs/USEEIOv2.3-s-GHG-19.yml @@ -0,0 +1,66 @@ +Model: "USEEIOv2.3-s-GHG-19" +BaseIOSchema: 2017 +BaseIOLevel: "Summary" +IOYear: 2019 # Year for IO data +ModelRegionAcronyms: ["US"] +ModelType: "EEIO" +IODataSource: "BEA" +BasePriceType: "PRO" #producer +BasewithRedefinitions: FALSE +CommodityorIndustryType: "Commodity" +ScrapIncluded: FALSE +DisaggregationSpecs: null +ExternalImportFactors: TRUE + +SatelliteTable: + GHG: + FullName: "Greenhouse Gases" + Abbreviation: "GHG" + StaticSource: TRUE + StaticFile: "flowsa/FlowBySector/GHG_national_2019_m1_v2.0.3_1cb504c.parquet" + FileLocation: "DataCommons" + DataYears: [2019] + Locations: ["US"] + SectorListSource: "NAICS" + SectorListYear: 2017 + SectorListLevel: "6" + OriginalFlowSource: "FEDEFLv1.2" + ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script + ScriptFunctionParameters: null + DataSources: + USEPA_GHG_2024: + Title: "GHG Inventory" + Author: "USEPA" + DataYear: 2019 + URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2022" + 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/ipcc/IPCC_v1.1.1_27ba917.parquet" + FileLocation: "DataCommons" + ScriptFunctionCall: "getImpactMethod" #function to call for script + ScriptFunctionParameters: + indicators: ["AR6-100"] + DataSources: + IPCC_AR6: + Title: "IPCC Sixth Assessment Report: Direct Global Warming Potentials for 100 year time horizon" + Author: "IPCC" + DataYear: 2021 + URL: "" + Primary: TRUE + +DemandVectors: + DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file +# Additional demand vectors beyond useeior defaults + +ImportFactors: + StaticFile: "useeior/US_summary_import_factors_exio_2019_17sch.csv" + FileLocation: "DataCommons" diff --git a/man/applyAllocation.Rd b/man/applyAllocation.Rd index 2e4d91bc..c9647149 100644 --- a/man/applyAllocation.Rd +++ b/man/applyAllocation.Rd @@ -2,16 +2,20 @@ % Please edit documentation in R/DisaggregateFunctions.R \name{applyAllocation} \alias{applyAllocation} -\title{Allocate values specified by the .yml disaggregation specs to the correct places in a disaggregated row/column of the Use/Make tables.} +\title{Allocate values specified by the .yml disaggregation specs to the correct places in a +disaggregated row/column of the Use/Make tables.} \usage{ applyAllocation(disagg, allocPercentages, vectorToDisagg, originalTable) } \arguments{ \item{disagg}{Specifications for disaggregating the current Table} -\item{allocPercentages}{Dataframe. A subset of the dataframe that contains the percentages to allocate to specific industry and commodity combinations in the disaggregated vector. Parameter use coordinated with @param vectorToDisagg} +\item{allocPercentages}{Dataframe. A subset of the dataframe that contains the percentages +to allocate to specific industry and commodity combinations in the disaggregated vector. +Parameter use coordinated with @param vectorToDisagg} -\item{vectorToDisagg}{String. A parameter to indicate what table and what part of that table is being disaggregated (e.g. "MakeCol" or "Intersection")} +\item{vectorToDisagg}{String. A parameter to indicate what table and what part of that table +is being disaggregated (e.g. "MakeCol" or "Intersection")} \item{originalTable}{Dataframe. The original dataframe upon which allocation is performed (e.g., Make or Use)} } @@ -19,5 +23,6 @@ applyAllocation(disagg, allocPercentages, vectorToDisagg, originalTable) A dataframe with the values specified in the disaggSpecs assigned to the correct Make or Use table indeces. } \description{ -Allocate values specified by the .yml disaggregation specs to the correct places in a disaggregated row/column of the Use/Make tables. +Allocate values specified by the .yml disaggregation specs to the correct places in a +disaggregated row/column of the Use/Make tables. } diff --git a/man/buildEconomicMatrices.Rd b/man/buildEconomicMatrices.Rd new file mode 100644 index 00000000..a95bc1f5 --- /dev/null +++ b/man/buildEconomicMatrices.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/BuildModel.R +\name{buildEconomicMatrices} +\alias{buildEconomicMatrices} +\title{Construct the economic matrices of an IO model based on loaded IO tables.} +\usage{ +buildEconomicMatrices(model) +} +\arguments{ +\item{model}{An EEIO model object with model specs, IO tables} +} +\value{ +A list with EEIO economic matrices. +} +\description{ +Construct the economic matrices of an IO model based on loaded IO tables. +} diff --git a/man/buildEIOModel.Rd b/man/buildIOModel.Rd similarity index 60% rename from man/buildEIOModel.Rd rename to man/buildIOModel.Rd index 49abb9b0..10ca8009 100644 --- a/man/buildEIOModel.Rd +++ b/man/buildIOModel.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/BuildModel.R -\name{buildEIOModel} -\alias{buildEIOModel} -\title{Build an EIO model with economic components only.} +\name{buildIOModel} +\alias{buildIOModel} +\title{Build an IO model with economic components only.} \usage{ -buildEIOModel(modelname, configpaths = NULL) +buildIOModel(modelname, configpaths = NULL) } \arguments{ \item{modelname}{Name of the model from a config file.} @@ -13,8 +13,8 @@ buildEIOModel(modelname, configpaths = NULL) and optional agg/disagg configuration file(s). If NULL, built-in config files are used.} } \value{ -A list of EIO model with only economic components +A list of IO model with only economic components } \description{ -Build an EIO model with economic components only. +Build an IO model with economic components only. } diff --git a/man/buildModelwithImportFactors.Rd b/man/buildModelwithImportFactors.Rd new file mode 100644 index 00000000..16598d25 --- /dev/null +++ b/man/buildModelwithImportFactors.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{buildModelwithImportFactors} +\alias{buildModelwithImportFactors} +\title{Create import Use table and validate domestic+import against full use model .} +\usage{ +buildModelwithImportFactors(model, configpaths = NULL) +} +\arguments{ +\item{model, }{An EEIO model object with model specs and crosswalk table loaded} + +\item{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.} +} +\value{ +A model object with explicit import components. +} +\description{ +Create import Use table and validate domestic+import against full use model . +} diff --git a/man/buildPriceMatrices.Rd b/man/buildPriceMatrices.Rd new file mode 100644 index 00000000..bcf2ee3e --- /dev/null +++ b/man/buildPriceMatrices.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/BuildModel.R +\name{buildPriceMatrices} +\alias{buildPriceMatrices} +\title{Construct the price adjustment matrices, Rho, Tau, and Phi} +\usage{ +buildPriceMatrices(model) +} +\arguments{ +\item{model}{An EEIO model object with model specs and IO tables} +} +\value{ +A list with EEIO price adjustment matrices. +} +\description{ +Construct the price adjustment matrices, Rho, Tau, and Phi +} diff --git a/man/calculateEEIOModel.Rd b/man/calculateEEIOModel.Rd index ade7d8e3..467d7dc2 100644 --- a/man/calculateEEIOModel.Rd +++ b/man/calculateEEIOModel.Rd @@ -10,7 +10,9 @@ calculateEEIOModel( perspective, demand = "Production", location = NULL, - use_domestic_requirements = FALSE + use_domestic_requirements = FALSE, + household_emissions = FALSE, + show_RoW = FALSE ) } \arguments{ @@ -28,6 +30,11 @@ numeric values in USD with the same dollar year as model.} \item{use_domestic_requirements}{A logical value: if TRUE, use domestic demand and L_d matrix; if FALSE, use complete demand and L matrix.} + +\item{household_emissions, }{bool, if TRUE, include calculation of emissions from households} + +\item{show_RoW, }{bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects. +Only valid currently for models with ExternalImportFactors.} } \value{ A list with LCI and LCIA results (in data.frame format) of the EEIO model. diff --git a/man/calculateHouseholdEmissions.Rd b/man/calculateHouseholdEmissions.Rd new file mode 100644 index 00000000..9a64adae --- /dev/null +++ b/man/calculateHouseholdEmissions.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculationFunctions.R +\name{calculateHouseholdEmissions} +\alias{calculateHouseholdEmissions} +\title{Calculate household emissions from B_h} +\usage{ +calculateHouseholdEmissions( + model, + f, + location, + characterized = FALSE, + show_RoW = FALSE +) +} +\arguments{ +\item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{f}{A demand vector with names as one or more model sectors and +numeric values in USD with the same dollar year as model.} + +\item{location, }{str optional location code for demand vector, required for two-region models} + +\item{characterized, }{bool, TRUE to characterize using C matrix, FALSE to show LCI} + +\item{show_RoW, }{bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects. +Only valid currently for models with ExternalImportFactors.} +} +\value{ +A result vector with rows for final demand sector(s) +} +\description{ +Calculate household emissions from B_h +} diff --git a/man/calculateMwithImportFactors.Rd b/man/calculateMwithImportFactors.Rd new file mode 100644 index 00000000..d6725db0 --- /dev/null +++ b/man/calculateMwithImportFactors.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{calculateMwithImportFactors} +\alias{calculateMwithImportFactors} +\title{Derives an M matrix for total embodied flows from domestic and imported supply chains.} +\usage{ +calculateMwithImportFactors(model) +} +\arguments{ +\item{model, }{An EEIO model object with model specs and crosswalk table loaded} +} +\value{ +An M matrix of flows x sector +} +\description{ +Derives an M matrix for total embodied flows from domestic and imported supply chains. +} diff --git a/man/calculateResultsWithExternalFactors.Rd b/man/calculateResultsWithExternalFactors.Rd new file mode 100644 index 00000000..2c3cbfd9 --- /dev/null +++ b/man/calculateResultsWithExternalFactors.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculationFunctions.R +\name{calculateResultsWithExternalFactors} +\alias{calculateResultsWithExternalFactors} +\title{Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model that has external import factors +for a given demand vector. +Note that for this calculation, perspective is always FINAL} +\usage{ +calculateResultsWithExternalFactors( + model, + perspective = "FINAL", + demand = "Consumption", + location = NULL, + use_domestic_requirements = FALSE, + household_emissions = FALSE, + show_RoW = FALSE +) +} +\arguments{ +\item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{perspective}{Perspective of the model, can be "DIRECT" or "FINAL". "DIRECT" perspective +aligns results with the sectors in which they are produced, while "FINAL" perspective aligns +results with the sectors consumed by the final user.} + +\item{demand}{A demand vector, can be name of a built-in model demand vector, e.g. "Production" or "Consumption"} + +\item{location, }{str optional location code for demand vector, required for two-region models} + +\item{use_domestic_requirements}{bool, if TRUE, return only domestic portion of results} + +\item{household_emissions, }{bool, if TRUE, include calculation of emissions from households} + +\item{show_RoW, }{bool, if TRUE, include rows for commodities in RoW, e.g. `111CA/RoW` in result objects.} +} +\value{ +A list with LCI and LCIA results (in data.frame format) of the EEIO model. +} +\description{ +Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model that has external import factors +for a given demand vector. +Note that for this calculation, perspective is always FINAL +} diff --git a/man/calculateStandardResults.Rd b/man/calculateStandardResults.Rd new file mode 100644 index 00000000..23b2835e --- /dev/null +++ b/man/calculateStandardResults.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculationFunctions.R +\name{calculateStandardResults} +\alias{calculateStandardResults} +\title{Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model +that does not have external import factors for a given perspective and demand vector.} +\usage{ +calculateStandardResults( + model, + perspective, + demand, + use_domestic_requirements = FALSE, + location = NULL, + household_emissions = FALSE +) +} +\arguments{ +\item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{perspective}{Perspective of the model, can be "DIRECT" or "FINAL". "DIRECT" perspective +aligns results with the sectors in which they are produced, while "FINAL" perspective aligns +results with the sectors consumed by the final user.} + +\item{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.} + +\item{use_domestic_requirements}{A logical value: if TRUE, use domestic demand and L_d matrix; +if FALSE, use complete demand and L matrix.} + +\item{location, }{str optional location code for demand vector, required for two-region models} + +\item{household_emissions, }{bool, if TRUE, include calculation of emissions from households} +} +\value{ +A list with LCI and LCIA results (in data.frame format) of the EEIO model. +} +\description{ +Calculate total emissions/resources (LCI) and total impacts (LCIA) for an EEIO model +that does not have external import factors for a given perspective and demand vector. +} diff --git a/man/castImportFactors.Rd b/man/castImportFactors.Rd new file mode 100644 index 00000000..9c9c7ebe --- /dev/null +++ b/man/castImportFactors.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{castImportFactors} +\alias{castImportFactors} +\title{Converts import factors table (of commodities) into flows x sector matrix-like format} +\usage{ +castImportFactors(IFTable, model) +} +\arguments{ +\item{IFTable, }{dataframe of import factors} + +\item{model}{An EEIO model object with model specs, IO tables, and matrices loaded} +} +\value{ +A matrix of flows x sector +} +\description{ +Converts import factors table (of commodities) into flows x sector matrix-like format +} diff --git a/man/checkSatelliteFlowLoss.Rd b/man/checkSatelliteFlowLoss.Rd index 58859024..f5fa7e45 100644 --- a/man/checkSatelliteFlowLoss.Rd +++ b/man/checkSatelliteFlowLoss.Rd @@ -4,7 +4,7 @@ \alias{checkSatelliteFlowLoss} \title{Checks flow amounts are equal in totals by sector after conforming to model schema} \usage{ -checkSatelliteFlowLoss(tbs0, tbs, tolerance = 0.005) +checkSatelliteFlowLoss(tbs0, tbs, tolerance = 0.001) } \arguments{ \item{tbs0, }{totals-by-sector df in source schema} diff --git a/man/collapseTBS.Rd b/man/collapseTBS.Rd index 29e2307f..ffb1daab 100644 --- a/man/collapseTBS.Rd +++ b/man/collapseTBS.Rd @@ -4,12 +4,14 @@ \alias{collapseTBS} \title{Collapse a totals by sector table so that each flow sector combination exists only once} \usage{ -collapseTBS(tbs, model) +collapseTBS(tbs, model, agg_metasources = TRUE) } \arguments{ \item{tbs}{totals by sector sourced from satellite table} \item{model}{An EEIO model object with model specs and IO table loaded} + +\item{agg_metasources, }{bool, TRUE to aggregate TbS ignoring MetaSources field} } \value{ aggregated totals by sector diff --git a/man/compare2RCommodityTotals.Rd b/man/compare2RCommodityTotals.Rd deleted file mode 100644 index 0caee01a..00000000 --- a/man/compare2RCommodityTotals.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/StateiorFunctions.R -\name{compare2RCommodityTotals} -\alias{compare2RCommodityTotals} -\title{Compare commodity totals between the specified 2R model objects} -\usage{ -compare2RCommodityTotals(q_One, q_Two) -} -\arguments{ -\item{q_One}{A vector of commodity totals derived from specific model object} - -\item{q_Two}{A vector of commodity totals dervied from a different model object than q_One} -} -\value{ -A list of sectors that failed the comparison between the two specified q vectors. -} -\description{ -Compare commodity totals between the specified 2R model objects -} diff --git a/man/compare2RVectorTotals.Rd b/man/compare2RVectorTotals.Rd new file mode 100644 index 00000000..fcef5420 --- /dev/null +++ b/man/compare2RVectorTotals.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StateiorFunctions.R +\name{compare2RVectorTotals} +\alias{compare2RVectorTotals} +\title{Compare totals between the specified 2R model vectors} +\usage{ +compare2RVectorTotals(v_One, v_Two) +} +\arguments{ +\item{v_One}{A vector of totals derived from specific 2R model object} + +\item{v_Two}{A vector of totals dervied from a different 2R model object than v_One} +} +\value{ +A list of sectors that failed the comparison between the two specified q vectors. +} +\description{ +Compare totals between the specified 2R model vectors +} diff --git a/man/conformTbStoIOSchema.Rd b/man/conformTbStoIOSchema.Rd index ed30f2a6..f9ffc958 100644 --- a/man/conformTbStoIOSchema.Rd +++ b/man/conformTbStoIOSchema.Rd @@ -4,7 +4,7 @@ \alias{conformTbStoIOSchema} \title{Take a totals-by-sector df and maps flows to the model schema} \usage{ -conformTbStoIOSchema(tbs, sat_spec, model) +conformTbStoIOSchema(tbs, sat_spec, model, agg_metasources = TRUE) } \arguments{ \item{tbs, }{totals-by-sector df} @@ -12,6 +12,8 @@ conformTbStoIOSchema(tbs, sat_spec, model) \item{sat_spec, }{a standard specification for a single satellite table} \item{model}{an EEIO model with IO tables loaded} + +\item{agg_metasources, }{bool, TRUE to aggregate TbS ignoring MetaSources field} } \value{ a totals-by-sector df with the sectors and flow amounts corresponding to the model schema diff --git a/man/constructEEIOMatrices.Rd b/man/constructEEIOMatrices.Rd index 16f1c144..e2019df0 100644 --- a/man/constructEEIOMatrices.Rd +++ b/man/constructEEIOMatrices.Rd @@ -5,10 +5,13 @@ \title{Construct EEIO matrices based on loaded IO tables, built satellite tables, and indicator tables.} \usage{ -constructEEIOMatrices(model) +constructEEIOMatrices(model, configpaths = NULL) } \arguments{ \item{model}{An EEIO model object with model specs, IO tables, satellite tables, and indicators loaded} + +\item{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.} } \value{ A list with EEIO matrices. diff --git a/man/createDisaggFilesFromProxyData.Rd b/man/createDisaggFilesFromProxyData.Rd new file mode 100644 index 00000000..62dfaa81 --- /dev/null +++ b/man/createDisaggFilesFromProxyData.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StateiorFunctions.R +\name{createDisaggFilesFromProxyData} +\alias{createDisaggFilesFromProxyData} +\title{Create Make, Use, and Env ratio files for each state from Proxy data for the relevant sectors.} +\usage{ +createDisaggFilesFromProxyData(model, disagg, disaggYear, disaggState) +} +\arguments{ +\item{model}{An stateior model object with model specs and specific IO tables loaded} + +\item{disagg}{Specifications for disaggregating the current Table} + +\item{disaggYear}{Integer specifying the state model year} + +\item{disaggState}{A string value that indicates the state model being disaggregated. For national models, string should be "US"} +} +\value{ +model +} +\description{ +Create Make, Use, and Env ratio files for each state from Proxy data for the relevant sectors. +} diff --git a/man/disaggregateCPI.Rd b/man/disaggregateCPI.Rd new file mode 100644 index 00000000..1a982895 --- /dev/null +++ b/man/disaggregateCPI.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StateiorFunctions.R +\name{disaggregateCPI} +\alias{disaggregateCPI} +\title{Disaggregate CPI table to ensure the correct dimensions} +\usage{ +disaggregateCPI(df, model) +} +\arguments{ +\item{df, }{CPI table} + +\item{model}{An EEIO form USEEIO model object with model specs and IO meta data loaded.} +} +\value{ +An expanded CPI table with values replicated for disaggregated sectors. +} +\description{ +Disaggregate CPI table to ensure the correct dimensions +} diff --git a/man/generate2RDirectRequirementsfromUseWithTrade.Rd b/man/generate2RDirectRequirementsfromUseWithTrade.Rd new file mode 100644 index 00000000..2b21b508 --- /dev/null +++ b/man/generate2RDirectRequirementsfromUseWithTrade.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/StateiorFunctions.R +\name{generate2RDirectRequirementsfromUseWithTrade} +\alias{generate2RDirectRequirementsfromUseWithTrade} +\title{Generate direct requirements Use table for 2 region models using domestic +Use table with trade data generated by stateior} +\usage{ +generate2RDirectRequirementsfromUseWithTrade(model, domestic) +} +\arguments{ +\item{model}{An EEIO form USEEIO model object with model specs and IO meta data loaded.} + +\item{domestic}{A logical parameter indicating whether to DR or Domestic DR.} +} +\value{ +A 2-region direct requirements table generated using the domestic Use table with trade +} +\description{ +Generate direct requirements Use table for 2 region models using domestic +Use table with trade data generated by stateior +} diff --git a/man/generateDomesticUse.Rd b/man/generateDomesticUse.Rd index 5871d0ed..af1b8a01 100644 --- a/man/generateDomesticUse.Rd +++ b/man/generateDomesticUse.Rd @@ -4,11 +4,13 @@ \alias{generateDomesticUse} \title{Generate domestic Use table by adjusting Use table based on Import matrix.} \usage{ -generateDomesticUse(Use, model) +generateDomesticUse(Use, Import, model) } \arguments{ \item{Use, }{dataframe of a Use table} +\item{Import, }{dataframe of a Import table} + \item{model, }{An EEIO model object with model specs and crosswalk table loaded} } \value{ diff --git a/man/generateFlowtoDollarCoefficient.Rd b/man/generateFlowtoDollarCoefficient.Rd index d4fc6350..eb7c13d7 100644 --- a/man/generateFlowtoDollarCoefficient.Rd +++ b/man/generateFlowtoDollarCoefficient.Rd @@ -11,7 +11,8 @@ generateFlowtoDollarCoefficient( location_acronym, IsRoUS = FALSE, model, - output_type = "Industry" + output_type = "Industry", + final_demand = FALSE ) } \arguments{ @@ -28,6 +29,8 @@ generateFlowtoDollarCoefficient( \item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} \item{output_type}{Type of the output, e.g. "Commodity" or "Industry"} + +\item{final_demand, }{bool, generate coefficients using final demand vector} } \value{ A dataframe contains intensity coefficient (kg/$). diff --git a/man/generateInternationalTradeAdjustmentVector.Rd b/man/generateInternationalTradeAdjustmentVector.Rd index adc11d9d..d17c992a 100644 --- a/man/generateInternationalTradeAdjustmentVector.Rd +++ b/man/generateInternationalTradeAdjustmentVector.Rd @@ -4,11 +4,13 @@ \alias{generateInternationalTradeAdjustmentVector} \title{Generate international trade adjustment vector from Use and Import matrix.} \usage{ -generateInternationalTradeAdjustmentVector(Use, model) +generateInternationalTradeAdjustmentVector(Use, Import, model) } \arguments{ \item{Use, }{dataframe of a Use table} +\item{Import, }{dataframe of a Import table} + \item{model, }{An EEIO model object with model specs and crosswalk table loaded} } \value{ diff --git a/man/loadExternalImportFactors.Rd b/man/loadExternalImportFactors.Rd new file mode 100644 index 00000000..738195e4 --- /dev/null +++ b/man/loadExternalImportFactors.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{loadExternalImportFactors} +\alias{loadExternalImportFactors} +\title{Load and prepare import coefficients} +\usage{ +loadExternalImportFactors(model, configpaths = NULL) +} +\arguments{ +\item{model}{An EEIO form USEEIO model object with model specs loaded} + +\item{configpaths}{str vector, paths (including file name) of model configuration file. +If NULL, built-in config files are used.} +} +\value{ +M_m, matrix of import coefficients (flow x sector). +} +\description{ +Load and prepare import coefficients +} diff --git a/man/loadImportMatrix.Rd b/man/loadImportMatrix.Rd new file mode 100644 index 00000000..8698b1c5 --- /dev/null +++ b/man/loadImportMatrix.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/LoadIOTables.R +\name{loadImportMatrix} +\alias{loadImportMatrix} +\title{Load, format, and save import matrix as a USEEIO model object.} +\usage{ +loadImportMatrix(model, io_codes) +} +\arguments{ +\item{model}{A model object with model specs loaded.} + +\item{io_codes}{A list of BEA IO codes.} +} +\value{ +Import, df of use table imports. +} +\description{ +Load, format, and save import matrix as a USEEIO model object. +} diff --git a/man/mapFlowTotalsbySectorandLocationfromNAICStoBEA.Rd b/man/mapFlowTotalsbySectorandLocationfromNAICStoBEA.Rd index d311a399..b266ce9b 100644 --- a/man/mapFlowTotalsbySectorandLocationfromNAICStoBEA.Rd +++ b/man/mapFlowTotalsbySectorandLocationfromNAICStoBEA.Rd @@ -7,7 +7,8 @@ mapFlowTotalsbySectorandLocationfromNAICStoBEA( totals_by_sector, totals_by_sector_year, - model + model, + agg_metasources = TRUE ) } \arguments{ @@ -16,6 +17,8 @@ mapFlowTotalsbySectorandLocationfromNAICStoBEA( \item{totals_by_sector_year}{Year of the satellite table.} \item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{agg_metasources, }{bool, TRUE to aggregate TbS ignoring MetaSources field} } \value{ A satellite table aggregated by the USEEIO model sector codes. diff --git a/man/matrices.Rd b/man/matrices.Rd index 41bdba70..25f022cf 100644 --- a/man/matrices.Rd +++ b/man/matrices.Rd @@ -5,7 +5,7 @@ \alias{matrices} \title{The vector of matrices to write out} \format{ -An object of class \code{character} of length 17. +An object of class \code{character} of length 20. } \usage{ matrices diff --git a/man/prepareDemandVectorForImportResults.Rd b/man/prepareDemandVectorForImportResults.Rd new file mode 100644 index 00000000..18ce17d1 --- /dev/null +++ b/man/prepareDemandVectorForImportResults.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculationFunctions.R +\name{prepareDemandVectorForImportResults} +\alias{prepareDemandVectorForImportResults} +\title{Prepare demand vector for EEIO model results calculations} +\usage{ +prepareDemandVectorForImportResults( + model, + demand = "Production", + location = NULL +) +} +\arguments{ +\item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{demand}{A demand vector, can be name of a built-in model demand vector, e.g. "Production" or "Consumption",} + +\item{location, }{str optional location code for demand vector, required for two-region models} +} +\description{ +Prepare demand vector for EEIO model results calculations +} diff --git a/man/prepareDemandVectorForStandardResults.Rd b/man/prepareDemandVectorForStandardResults.Rd new file mode 100644 index 00000000..b4dc7da9 --- /dev/null +++ b/man/prepareDemandVectorForStandardResults.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculationFunctions.R +\name{prepareDemandVectorForStandardResults} +\alias{prepareDemandVectorForStandardResults} +\title{Prepare demand vector for EEIO model results calculations} +\usage{ +prepareDemandVectorForStandardResults( + model, + demand = "Production", + location = NULL, + use_domestic_requirements = FALSE +) +} +\arguments{ +\item{model}{A complete EEIO model: a list with USEEIO model components and attributes.} + +\item{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.} + +\item{location, }{str optional location code for demand vector, required for two-region models} + +\item{use_domestic_requirements}{A logical value: if TRUE, use domestic demand and L_d matrix; +if FALSE, use complete demand and L matrix.} +} +\description{ +Prepare demand vector for EEIO model results calculations +} diff --git a/man/prepareImportConsumptionDemand.Rd b/man/prepareImportConsumptionDemand.Rd new file mode 100644 index 00000000..6e4e1c60 --- /dev/null +++ b/man/prepareImportConsumptionDemand.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DemandFunctions.R +\name{prepareImportConsumptionDemand} +\alias{prepareImportConsumptionDemand} +\title{Prepares a demand vector representing Import consumption} +\usage{ +prepareImportConsumptionDemand(model, location) +} +\arguments{ +\item{model}{An EEIO model object with model specs and IO tables loaded} + +\item{location, }{str of location code for demand vector} +} +\value{ +a named vector with demand +} +\description{ +Prepares a demand vector representing Import consumption +} diff --git a/man/prepareImportProductionDemand.Rd b/man/prepareImportProductionDemand.Rd new file mode 100644 index 00000000..7bab0a8e --- /dev/null +++ b/man/prepareImportProductionDemand.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DemandFunctions.R +\name{prepareImportProductionDemand} +\alias{prepareImportProductionDemand} +\title{Prepares a demand vector representing Import production} +\usage{ +prepareImportProductionDemand(model, location) +} +\arguments{ +\item{model}{An EEIO model object with model specs and IO tables loaded} + +\item{location, }{str of location code for demand vector} +} +\value{ +A named vector with demand +} +\description{ +Prepares a demand vector representing Import production +} diff --git a/man/print2RValidationResults.Rd b/man/print2RValidationResults.Rd index e2436d49..93fe576f 100644 --- a/man/print2RValidationResults.Rd +++ b/man/print2RValidationResults.Rd @@ -9,9 +9,6 @@ print2RValidationResults(model) \arguments{ \item{model}{A complete 2R EEIO model: a list with USEEIO model components and attributes} } -\value{ -A list with 2R model results. -} \description{ Run validation checks for 2R models and print to console } diff --git a/man/processImportFactors.Rd b/man/processImportFactors.Rd new file mode 100644 index 00000000..8d918594 --- /dev/null +++ b/man/processImportFactors.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{processImportFactors} +\alias{processImportFactors} +\title{Load and prepare import coefficients} +\usage{ +processImportFactors(model, IFTable) +} +\arguments{ +\item{model}{An EEIO form USEEIO model object with model specs loaded} + +\item{IFTable, }{dataframe of unprocessed import factors} +} +\value{ +IFTable, dataframe of processed of import coefficients (flow x sector). +} +\description{ +Load and prepare import coefficients +} diff --git a/man/readImportFactorTable.Rd b/man/readImportFactorTable.Rd new file mode 100644 index 00000000..79138cd2 --- /dev/null +++ b/man/readImportFactorTable.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ExternalImportFactors.R +\name{readImportFactorTable} +\alias{readImportFactorTable} +\title{Load and prepare import coefficients} +\usage{ +readImportFactorTable(IFSpec, configpaths = NULL) +} +\arguments{ +\item{IFSpec}{list of specs for import factor file} + +\item{configpaths}{str vector, paths (including file name) of model configuration file. +If NULL, built-in config files are used.} +} +\value{ +IFtable, dataframe of unprocessed import factors +} +\description{ +Load and prepare import coefficients +} diff --git a/man/standardizeandcastSatelliteTable.Rd b/man/standardizeandcastSatelliteTable.Rd index 1f3872e4..bd81f926 100644 --- a/man/standardizeandcastSatelliteTable.Rd +++ b/man/standardizeandcastSatelliteTable.Rd @@ -4,12 +4,14 @@ \alias{standardizeandcastSatelliteTable} \title{Converts flows table into flows x sector matrix-like format} \usage{ -standardizeandcastSatelliteTable(df, model) +standardizeandcastSatelliteTable(df, model, final_demand = FALSE) } \arguments{ \item{df}{a dataframe of flowables, contexts, units, sectors and locations} \item{model}{An EEIO model object with model specs, IO tables, satellite tables, and indicators loaded} + +\item{final_demand, }{bool, generate matrix based on final demand columns} } \value{ A matrix-like dataframe of flows x sector diff --git a/man/testCalculationFunctions.Rd b/man/testCalculationFunctions.Rd new file mode 100644 index 00000000..b33dc432 --- /dev/null +++ b/man/testCalculationFunctions.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ValidateModel.R +\name{testCalculationFunctions} +\alias{testCalculationFunctions} +\title{Test that model calculation functions are successful +Includes tests for the following functions: +adjustResultMatrixPrice, calculateFlowContributiontoImpact, +calculateSectorContributiontoImpact, disaggregateTotalToDirectAndTier1, +calculateSectorPurchasedbySectorSourcedImpact, aggregateResultMatrix, +calculateMarginSectorImpacts} +\usage{ +testCalculationFunctions(model) +} +\arguments{ +\item{model, }{A fully built EEIO model object} +} +\description{ +Test that model calculation functions are successful +Includes tests for the following functions: +adjustResultMatrixPrice, calculateFlowContributiontoImpact, +calculateSectorContributiontoImpact, disaggregateTotalToDirectAndTier1, +calculateSectorPurchasedbySectorSourcedImpact, aggregateResultMatrix, +calculateMarginSectorImpacts +} diff --git a/man/testVisualizationFunctions.Rd b/man/testVisualizationFunctions.Rd new file mode 100644 index 00000000..4de6fbe3 --- /dev/null +++ b/man/testVisualizationFunctions.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ValidateModel.R +\name{testVisualizationFunctions} +\alias{testVisualizationFunctions} +\title{Test that visualization functions are successful +Includes tests for the following functions: +barplotFloworImpactFractionbyRegion, barplotIndicatorScoresbySector, +heatmapSatelliteTableCoverage, heatmapSectorRanking, plotMatrixCoefficient} +\usage{ +testVisualizationFunctions(model) +} +\arguments{ +\item{model, }{A fully built EEIO model object} +} +\description{ +Test that visualization functions are successful +Includes tests for the following functions: +barplotFloworImpactFractionbyRegion, barplotIndicatorScoresbySector, +heatmapSatelliteTableCoverage, heatmapSectorRanking, plotMatrixCoefficient +} diff --git a/man/validateHouseholdEmissions.Rd b/man/validateHouseholdEmissions.Rd new file mode 100644 index 00000000..93232fd0 --- /dev/null +++ b/man/validateHouseholdEmissions.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ValidateModel.R +\name{validateHouseholdEmissions} +\alias{validateHouseholdEmissions} +\title{Validate the calculation of household_emissions} +\usage{ +validateHouseholdEmissions(model) +} +\arguments{ +\item{model, }{A fully built EEIO model object} +} +\description{ +Validate the calculation of household_emissions +} diff --git a/man/validateImportFactorsApproach.Rd b/man/validateImportFactorsApproach.Rd new file mode 100644 index 00000000..ffbfab35 --- /dev/null +++ b/man/validateImportFactorsApproach.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ValidateModel.R +\name{validateImportFactorsApproach} +\alias{validateImportFactorsApproach} +\title{Validate the results of the model build using the Import Factor approach (i.e., coupled model approach)} +\usage{ +validateImportFactorsApproach(model, demand = "Consumption") +} +\arguments{ +\item{model, }{An EEIO model object with model specs and crosswalk table loaded} + +\item{demand, }{A demand vector, has to be name of a built-in model demand vector, e.g. "Production" or "Consumption". Consumption used as default.} +} +\value{ +A calculated direct requirements table +} +\description{ +Validate the results of the model build using the Import Factor approach (i.e., coupled model approach) +} diff --git a/tests/modelspecs/GAEEIOv1.0-s-WAT-12.yml b/tests/modelspecs/GAEEIOv1.0-s-WAT-12.yml deleted file mode 100644 index 8dd56cc3..00000000 --- a/tests/modelspecs/GAEEIOv1.0-s-WAT-12.yml +++ /dev/null @@ -1,61 +0,0 @@ -Model: "GAEEIOv1.0-s-WAT-12" # 2012 Summary, Commodity -BaseIOSchema: 2012 -BaseIOLevel: "Summary" -IOYear: 2012 # 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: - WAT: - FullName: "Water withdrawals" - Abbreviation: "WAT" - StaticSource: TRUE - StaticFile: "flowsa/FlowBySector/Water_state_2015_m1_v1.2.4_7c15ea5.parquet" - FileLocation: "DataCommons" - DataYears: [2015] - SectorListSource: "NAICS" - SectorListYear: 2012 - SectorListLevel: "6" - OriginalFlowSource: "FEDEFLv1.0.6" - ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script - ScriptFunctionParameters: null - DataSources: - USGS_NWIS_WU_2015: - Title: "Water Use in the US" - Author: "USGS" - DataYear: 2015 - URL: "https://waterdata.usgs.gov/" - Primary: TRUE - -Indicators: - freshwater_withdrawal: - Name: "Freshwater withdrawals" - Code: "WATR" - Group: "Resource Use" - Unit: "kg" - SimpleUnit: "Kilograms" - SimpleName: "Water Use" - StaticSource: TRUE - StaticFile: "lciafmt/fedefl/FEDEFL_Inventory_v1.0.0_5555779.parquet" - FileLocation: "DataCommons" - ScriptFunctionCall: "getImpactMethod" #function to call for script - ScriptFunctionParameters: - indicators: ["freshwater_resources"] - DataSources: - LCIAformatter: - Title: "LCIAformatter FEDEFL Inventory Methods" - Author: "USEPA" - DataYear: 2020 - URL: "https://github.com/USEPA/LCIAformatter" - Primary: TRUE - -DemandVectors: - DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file -# Additional demand vectors beyond useeior defaults diff --git a/tests/modelspecs/USEEIOv3.0-GHG.yml b/tests/modelspecs/USEEIOv2.0-s-GHG-19.yml similarity index 81% rename from tests/modelspecs/USEEIOv3.0-GHG.yml rename to tests/modelspecs/USEEIOv2.0-s-GHG-19.yml index ab921ab9..82324f2d 100644 --- a/tests/modelspecs/USEEIOv3.0-GHG.yml +++ b/tests/modelspecs/USEEIOv2.0-s-GHG-19.yml @@ -1,7 +1,7 @@ -Model: "USEEIOv3.0-GHG" # 2017 Detail, Commodity -BaseIOSchema: 2017 -BaseIOLevel: "Detail" -IOYear: 2017 # Year for IO data +Model: "USEEIOv2.0-s-GHG-19" +BaseIOSchema: 2012 +BaseIOLevel: "Summary" +IOYear: 2019 # Year for IO data ModelRegionAcronyms: ["US"] ModelType: "EEIO" IODataSource: "BEA" @@ -10,24 +10,25 @@ BasewithRedefinitions: FALSE CommodityorIndustryType: "Commodity" ScrapIncluded: FALSE DisaggregationSpecs: null +ExternalImportFactors: FALSE SatelliteTable: GHG: FullName: "Greenhouse Gases" Abbreviation: "GHG" StaticSource: TRUE - StaticFile: "flowsa/FlowBySector/GHG_national_2020_m2_v2.0.1_1d3a514.parquet" + StaticFile: "flowsa/FlowBySector/GHG_national_2019_m1_v2.0.0_a8c5929.parquet" FileLocation: "DataCommons" - DataYears: [2020] + DataYears: [2019] Locations: ["US"] SectorListSource: "NAICS" SectorListYear: 2012 SectorListLevel: "6" - OriginalFlowSource: "FEDEFLv1.1.0" + OriginalFlowSource: "FEDEFLv1.0.6" ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script ScriptFunctionParameters: null DataSources: - USEPA_GHG_2022: + USEPA_GHG_2021: Title: "GHG Inventory" Author: "USEPA" DataYear: 2020 @@ -58,4 +59,7 @@ Indicators: DemandVectors: DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file -# Additional demand vectors beyond useeior defaults + +# ImportFactors: +# StaticFile: "import_factors_summary_2019.csv" +# FileLocation: "useeior" diff --git a/tests/modelspecs/USEEIOv2.2-GHG.yml b/tests/modelspecs/USEEIOv2.2-GHG.yml new file mode 100644 index 00000000..3cd37b6e --- /dev/null +++ b/tests/modelspecs/USEEIOv2.2-GHG.yml @@ -0,0 +1,61 @@ +Model: "USEEIOv2.2-GHG" # 2017 Detail, Commodity +BaseIOSchema: 2017 +BaseIOLevel: "Detail" +IOYear: 2017 # Year for IO data +ModelRegionAcronyms: ["US"] +ModelType: "EEIO" +IODataSource: "BEA" +BasePriceType: "PRO" #producer +BasewithRedefinitions: FALSE +CommodityorIndustryType: "Commodity" +ScrapIncluded: FALSE +DisaggregationSpecs: null + +SatelliteTable: + GHG: + FullName: "Greenhouse Gases" + Abbreviation: "GHG" + StaticSource: TRUE + StaticFile: "flowsa/FlowBySector/GHG_national_2022_m2_v2.0.3_1cb504c.parquet" + FileLocation: "DataCommons" + DataYears: [2022] + Locations: ["US"] + SectorListSource: "NAICS" + SectorListYear: 2017 + SectorListLevel: "6" + OriginalFlowSource: "FEDEFLv1.2" + ScriptFunctionCall: "getFlowbySectorCollapsed" #function to call for script + ScriptFunctionParameters: null + DataSources: + USEPA_GHG_2024: + Title: "GHG Inventory" + Author: "USEPA" + DataYear: 2022 + URL: "https://www.epa.gov/ghgemissions/inventory-us-greenhouse-gas-emissions-and-sinks-1990-2022" + 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/ipcc/IPCC_v1.1.1_27ba917.parquet" + FileLocation: "DataCommons" + ScriptFunctionCall: "getImpactMethod" #function to call for script + ScriptFunctionParameters: + indicators: ["AR5-100"] + DataSources: + IPCC_AR5: + Title: "IPCC Fifth Assessment Report: Direct Global Warming Potentials for 100 year time horizon" + Author: "IPCC" + DataYear: 2017 + URL: "" + Primary: TRUE + +DemandVectors: + DefaultDemand: "DefaultDemandVectors" # Name of default demand vectors yml file +# Additional demand vectors beyond useeior defaults diff --git a/tests/test_model_build.R b/tests/test_model_build.R index c2ac46c4..8f36d433 100644 --- a/tests/test_model_build.R +++ b/tests/test_model_build.R @@ -4,12 +4,20 @@ # setwd("tests") library(useeior) # library(unittest, quietly = TRUE) -if (!interactive()) options(warn=2, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) }) +if (!interactive()) options(warn=1, error = function() { sink(stderr()) ; traceback(3) ; q(status = 1) }) ## USEEIOv2.0.1-411 Detail model with waste disaggregation m <- "USEEIOv2.0.1-411" model <- buildModel(m) printValidationResults(model) +testCalculationFunctions(model) +testVisualizationFunctions(model) + +## USEEIOv2.0.1-411 Detail model with waste disaggregation (Economic only) +m <- "USEEIOv2.0.1-411" +model <- buildIOModel(m) +printValidationResults(model) +writeModeltoXLSX(model, ".") ## USEEIOv2.0.1-i-411 Detail, industry model with waste disaggregation model <- useeior:::initializeModel(m) @@ -22,15 +30,15 @@ model <- useeior:::loadDemandVectors(model) model <- useeior:::constructEEIOMatrices(model) printValidationResults(model) -## USEEIOv3.0-GHG Detail, commodity model (2017 Schema) -m <- "USEEIOv3.0-GHG" +## USEEIOv2.2-GHG Detail, commodity model (2017 Schema) +m <- "USEEIOv2.2-GHG" cfg <- paste0("modelspecs/", m, ".yml") model <- buildModel(m, configpaths = file.path(cfg)) printValidationResults(model) -## USEEIOv3.0-s-GHG Summary, commodity model (2017 Schema) +## USEEIOv2.2-s-GHG Summary, commodity model (2017 Schema) model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) -model$specs$Model <- "USEEIOv3.0-s-GHG" +model$specs$Model <- "USEEIOv2.2-s-GHG" model$specs$BaseIOLevel <- "Summary" model$crosswalk <- useeior:::getModelCrosswalk(model) # reassign for summary model model <- useeior:::loadIOData(model) @@ -64,6 +72,7 @@ m <- "USEEIOv2.0-GHG" cfg <- paste0("modelspecs/", m, ".yml") model <- buildModel(m, configpaths = file.path(cfg)) printValidationResults(model) +writeModeltoXLSX(model, ".") ## USEEIOv2.0 Detail, industry model model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) @@ -76,19 +85,16 @@ model <- useeior:::loadDemandVectors(model) model <- useeior:::constructEEIOMatrices(model) printValidationResults(model) -## USEEIOv2.0 Summary, commodity model -m <- "USEEIOv2.0-s-GHG" -cfg <- c(paste0("modelspecs/", m, ".yml"), - "disaggspecs/WasteDisaggregationSummary.yml", - "disaggspecs/WasteDisaggregationSummary_Make.csv", - "disaggspecs/WasteDisaggregationSummary_Use.csv" - ) + +## USEEIOv2.0 Summary, commodity model with GHGs +m <- "USEEIOv2.0-s-GHG-19" +cfg <- c(paste0("modelspecs/", m, ".yml")) model <- buildModel(m, configpaths = file.path(cfg)) printValidationResults(model) ## USEEIOv2.0 Summary, industry model model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) -model$specs$Model <- "USEEIOv2.0-is-GHG" +model$specs$Model <- "USEEIOv2.0-is-GHG-19" model$specs$CommodityorIndustryType <- "Industry" model <- useeior:::loadIOData(model, file.path(cfg)) model <- useeior:::loadandbuildSatelliteTables(model) @@ -98,9 +104,15 @@ model <- useeior:::constructEEIOMatrices(model) printValidationResults(model) ## USEEIOv2.0 Summary model with waste disaggregation +cfg <- c(paste0("modelspecs/", m, ".yml"), + "disaggspecs/WasteDisaggregationSummary.yml", + "disaggspecs/WasteDisaggregationSummary_Make.csv", + "disaggspecs/WasteDisaggregationSummary_Use.csv" + ) model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) -model$specs$Model <- "USEEIOv2.0-79-GHG" +model$specs$Model <- "USEEIOv2.0-79-GHG-19" model$specs$DisaggregationSpecs <- "WasteDisaggregationSummary" +model$specs$IOYear <- 2013 # TODO some years generate error model <- useeior:::loadIOData(model, file.path(cfg)) model <- useeior:::loadandbuildSatelliteTables(model) model <- useeior:::loadandbuildIndicators(model) @@ -108,8 +120,71 @@ model <- useeior:::loadDemandVectors(model) model <- useeior:::constructEEIOMatrices(model) printValidationResults(model) +## USEEIOv2.3 Detail, commodity model with GHGs and Import Factors +m <- "USEEIOv2.3-GHG" +model <- buildModel(m) +printValidationResults(model) +writeModeltoXLSX(model, ".") + +## USEEIOv2.3 Summary, commodity model with GHGs and Import Factors +m <- "USEEIOv2.3-s-GHG-19" +model <- buildModel(m) +printValidationResults(model) +testCalculationFunctions(model) +testVisualizationFunctions(model) + ## StateEEIOv1.0 Two-region Summary model -m <- "GAEEIOv1.0-s-WAT-12" -cfg <- paste0("modelspecs/", m, ".yml") -model <- buildModel(m, configpaths = file.path(cfg)) -useeior::print2RValidationResults(model) +m <- "GAEEIOv1.0-GHG-19" +model <- buildModel(m) +printValidationResults(model) +writeModeltoXLSX(model, ".") +testCalculationFunctions(model) +testVisualizationFunctions(model) + +## StateEEIOv1.0 Two-region Summary model (Economic only) +model <- buildIOModel(m) +printValidationResults(model) +writeModeltoXLSX(model, ".") + +## StateEEIOv1.1 Two-region Summary model with Import Factors +cfg <- c("US_summary_import_factors_exio_2019_12sch.csv") +model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) +model$specs$Model <- "GAEEIOv1.1-GHG-19-IF" +model$specs$ExternalImportFactors <- TRUE +model$specs$ImportFactors <- list() +model$specs$ImportFactors$StaticFile <- "useeior/US_summary_import_factors_exio_2019_12sch.csv" +model$specs$ImportFactors$FileLocation <- "DataCommons" +model <- useeior:::loadIOData(model, file.path(cfg)) +model <- useeior:::loadandbuildSatelliteTables(model) +model <- useeior:::loadandbuildIndicators(model) +model <- useeior:::loadDemandVectors(model) +model <- useeior:::constructEEIOMatrices(model, file.path(cfg)) +printValidationResults(model) +testCalculationFunctions(model) +testVisualizationFunctions(model) + +# ## StateEEIOv1.0 Two-region Summary model with Utility disaggregation +# model <- useeior:::initializeModel(m, configpaths = file.path(cfg)) +# model$specs$Model <- "GAEEIOv1.0-75-GHG-19" +# model$specs$IODataVersion <- "0.3.0" # required for disaggregation +# model$specs$DisaggregationSpecs <- "UtilityDisaggregation" +# model <- useeior:::loadIOData(model, file.path(cfg)) +# model <- useeior:::loadandbuildSatelliteTables(model) +# model <- useeior:::loadandbuildIndicators(model) +# model <- useeior:::loadDemandVectors(model) +# model <- useeior:::constructEEIOMatrices(model) +# printValidationResults(model) + +# ## StateEEIOv1.0 Two-region Summary model with "standard" Utility disaggregation +# m <- "GAEEIOv1.0-75-GHG-19" +# cfg <- paste0("modelspecs/", m, ".yml") +# model <- buildModel(m, configpaths = file.path(cfg)) +# printValidationResults(model) + +# ## StateEEIOv1.0 Two-region Summary model with Utility disaggregation by Proxy +# ## I.e., using employment values by detail-level industries to inform disaggregation +# m <- "GAEEIOv1.0-75-Proxy-GHG-19" +# cfg <- paste0("modelspecs/", m, ".yml") +# modelProxy <- buildModel(m, configpaths = file.path(cfg)) +# printValidationResults(model) +