From 79d1db2db5b62c632e013e8f3d07931318ce7e4b Mon Sep 17 00:00:00 2001 From: Ben Young Date: Wed, 19 Jun 2024 15:58:19 -0400 Subject: [PATCH] add agg_metasources parameter to enable access to TbS while maintaining separate MetaSources --- R/LoadSatellites.R | 6 +- R/SatelliteFunctions.R | 57 +++++++++++++------ man/collapseTBS.Rd | 4 +- man/conformTbStoIOSchema.Rd | 4 +- ...TotalsbySectorandLocationfromNAICStoBEA.Rd | 5 +- 5 files changed, 53 insertions(+), 23 deletions(-) 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 3c379f48..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) } @@ -135,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") @@ -158,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) 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/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/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.