From 136175caf1b665347b371929f9291a53d670987d Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Mon, 12 Aug 2024 18:31:49 +0200 Subject: [PATCH] Bugfix histTimesteps & ICEban trucks, busses --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- NAMESPACE | 2 ++ R/supportFunctions.R | 27 ++++++++++++++++++++++++++ R/toolApplyICEbanOnPreferences.R | 30 +++++++++++++++++++++++++++++ R/toolApplyScenPrefTrends.R | 27 -------------------------- R/toolCalculateFS3share.R | 3 +-- R/toolEdgeTransportSA.R | 4 ++++ README.md | 6 +++--- man/iterativeEdgeTransport.Rd | 2 +- man/toolApplyICEbanOnPreferences.Rd | 22 +++++++++++++++++++++ man/toolCalculateFS3share.Rd | 2 +- man/toolNormalizePreferences.Rd | 20 +++++++++++++++++++ 14 files changed, 116 insertions(+), 39 deletions(-) create mode 100644 R/toolApplyICEbanOnPreferences.R create mode 100644 man/toolApplyICEbanOnPreferences.Rd create mode 100644 man/toolNormalizePreferences.Rd diff --git a/.buildlibrary b/.buildlibrary index fd0dc3a..ee181df 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '4188030' +ValidationKey: '4208817' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index d474819..40de071 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'edgeTransport: Prepare EDGE Transport Data for the REMIND model' -version: 2.1.0 -date-released: '2024-08-08' +version: 2.1.1 +date-released: '2024-08-12' abstract: EDGE-T is a fork of the GCAM transport module https://jgcri.github.io/gcam-doc/energy.html#transportation with a high level of detail in its representation of technological and modal options. It is a partial equilibrium model with a nested multinomial logit structure and diff --git a/DESCRIPTION b/DESCRIPTION index c05b1f3..55c523e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: edgeTransport Title: Prepare EDGE Transport Data for the REMIND model -Version: 2.1.0 +Version: 2.1.1 Authors@R: c( person("Johanna", "Hoppe", , "johanna.hoppe@pik-potsdam.de", role = c("aut", "cre"), comment = c(ORCID = "0009-0004-6753-5090")), @@ -18,7 +18,7 @@ Encoding: UTF-8 LazyData: true RoxygenNote: 7.3.2 VignetteBuilder: knitr -Date: 2024-08-08 +Date: 2024-08-12 Config/testthat/edition: 3 Imports: rmndt, diff --git a/NAMESPACE b/NAMESPACE index 16efa51..f903ffc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(checkForNAsDups) export(csv2RDS) export(getFilterEntriesUnivocalName) export(iterativeEdgeTransport) +export(toolApplyICEbanOnPreferences) export(toolApplyMixedTimeRes) export(toolCalculateFS3share) export(toolCalculateFleetComposition) @@ -17,6 +18,7 @@ export(toolLoadDecisionTree) export(toolLoadInputs) export(toolLoadIterativeInputs) export(toolLoadREMINDesDemand) +export(toolNormalizePreferences) export(toolOrderandCheck) export(toolPrepareScenInputData) export(toolTraverseDecisionTree) diff --git a/R/supportFunctions.R b/R/supportFunctions.R index 0d42624..ca080bf 100644 --- a/R/supportFunctions.R +++ b/R/supportFunctions.R @@ -1,3 +1,30 @@ +#' Normalize preferences so that the maximum in each branch of the decision tree equals 1 +#' +#' @author Johanna Hoppe +#' @param preferenceTab data.table including preferences for all levels of the decision tree +#' @returns Normalized preferences +#' @import data.table +#' @export + +toolNormalizePreferences <- function(preferenceTab) { + preferenceTab[level == "S1S", max := max(value), by = c("region", "period", "sector")] + preferenceTab[level == "S1S" & max != 0, value := value/max(value), by = c("region", "period", "sector")] # S1S: logit level: distances (e.g. short-medium, long) + preferenceTab[level == "S2S1", max := max(value), by = c("region", "period", "sector", "subsectorL1")] + preferenceTab[level == "S2S1" & max != 0, value := value/max(value), by = c("region", "period", "sector", "subsectorL1")] # S2S1: logit level: modes/categories (e.g. walk, road, rail) + preferenceTab[level == "S3S2", max := max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2")] + preferenceTab[level == "S3S2" & max != 0, value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2")] # S3S2: logit level: modes/technologies (e.g. LDV, bus, Liquids) + preferenceTab[level == "VS3", max := max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3")] + preferenceTab[level == "VS3" & max != 0, value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3")] # VS3: logit level: modes/technologies (e.g. cars, Liquids) + preferenceTab[level == "FV", max := max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3", "vehicleType")] + preferenceTab[level == "FV" & max != 0, value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3", "vehicleType")] # FV: logit level: vehicle type (e.g. large car, moped) + preferenceTab[, max := NULL] + + if (anyNA(preferenceTab)) stop("Something went wrong with the normalization of the preference trends. Please check toolNormalizePreferences()") + + return(preferenceTab) +} + + #' Read and build the complete structure of the edgeTransport decision tree #' #' @author Johanna Hoppe diff --git a/R/toolApplyICEbanOnPreferences.R b/R/toolApplyICEbanOnPreferences.R new file mode 100644 index 0000000..f99d45d --- /dev/null +++ b/R/toolApplyICEbanOnPreferences.R @@ -0,0 +1,30 @@ +#' Apply ICE ban on vehicle types that feature preference factors +#' +#' @author Johanna Hoppe +#' @param preferenceTab data.table including preferences for all levels of the decision tree +#' @param helpers list of helpers +#' @returns Preferences in accordance to the ICE ban policy +#' @import data.table +#' @export + +toolApplyICEbanOnPreferences <- function(preferenceTab, helpers) { + #Ban is applied to EU28 + affectedRegions <- unique(helpers$regionmappingISOto21to12[regionCode12 == "EUR"]$regionCode21) + #affectedRegions <- affectedRegions[!affectedRegions == "UKI"] currently we apply the ban also to UK + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period == 2025, 0.98 * value[period == 2015], value), by = c("region","technology")] + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period == 2030, 0.75 * value[period == 2015], value), by = c("region","technology")] + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period == 2035, 0.3 * value[period == 2015], value), by = c("region","technology")] + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period == 2040, 0.2 * value[period == 2015], value), by = c("region","technology")] + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period == 2045, 0.1 * value[period == 2015], value), by = c("region","technology")] + preferenceTab[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), + value := ifelse(period > 2045, value * 0.05, value), by = c("region","technology")] + + if (anyNA(preferenceTab)) stop("Something went wrong with the ICE ban application. Please check toolApplyICEbanOnPreferences()") + + return(preferenceTab) +} diff --git a/R/toolApplyScenPrefTrends.R b/R/toolApplyScenPrefTrends.R index ab1e47d..7f4ae0d 100644 --- a/R/toolApplyScenPrefTrends.R +++ b/R/toolApplyScenPrefTrends.R @@ -31,7 +31,6 @@ toolApplyScenPrefTrends <- function(baselinePrefTrends, scenParPrefTrends, GDPpc GDPpcMER[, regionCat := ifelse(region %in% individualReg, region, regionCat)] mitigationFactors <- merge(mitigationFactors, GDPpcMER, by = "regionCat", allow.cartesian = TRUE, all.x = TRUE)[, regionCat := NULL] # apply mitigation factors - checkMitigation <- copy(baselinePrefTrends) setnames(checkMitigation, "value", "old") PrefTrends <- merge(baselinePrefTrends, mitigationFactors, by = c("region", "level", "subsectorL1", "subsectorL2", "vehicleType", "technology"), all.x = TRUE, allow.cartesian = TRUE) @@ -40,32 +39,6 @@ toolApplyScenPrefTrends <- function(baselinePrefTrends, scenParPrefTrends, GDPpc check[, diff := abs(value - old)] if (max(check$diff) < 0.001) stop("Mitigation preference factors have not been applied correctly. Please check toolApplyScenPrefTrends()") - # normalize preferences in each level - PrefTrends[level == "S1S", value := value/max(value), by = c("region", "period", "sector")] # S1S: logit level: distances (e.g. short-medium, long) - PrefTrends[level == "S2S1", value := value/max(value), by = c("region", "period", "sector", "subsectorL1")] # S2S1: logit level: modes/categories (e.g. walk, road, rail) - PrefTrends[level == "S3S2", value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2")] # S3S2: logit level: modes/technologies (e.g. LDV, bus, Liquids) - PrefTrends[level == "VS3", value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3")] # VS3: logit level: modes/technologies (e.g. cars, Liquids) - PrefTrends[level == "FV", value := value/max(value), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3", "vehicleType")] # FV: logit level: vehicle type (e.g. large car, moped) - - # Apply ICE ban if switched on - if (isICEban) { - #Ban is applied to EU28 - affectedRegions <- unique(helpers$regionmappingISOto21to12[regionCode12 == "EUR"]$regionCode21) - #affectedRegions <- affectedRegions[!affectedRegions == "UKI"] currently we apply the ban also to UK - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period == 2025, 0.98 * value[period == 2015], value), by = c("region","technology")] - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period == 2030, 0.75 * value[period == 2015], value), by = c("region","technology")] - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period == 2035, 0.3 * value[period == 2015], value), by = c("region","technology")] - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period == 2040, 0.2 * value[period == 2015], value), by = c("region","technology")] - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period == 2045, 0.1 * value[period == 2015], value), by = c("region","technology")] - PrefTrends[level == "FV" & region %in% affectedRegions & (subsectorL1 == "trn_freight_road" | subsectorL2 == "Bus") & technology %in% c("Liquids", "Gases"), - value := ifelse(period > 2045, value * 0.05, value), by = c("region","technology")] - } - PrefTrends[, variable := paste0("Preference|", level)][, unit := "-"] # order PrefTrends <- PrefTrends[, c("region", "period", "technology", "vehicleType", "subsectorL3", "subsectorL2", "subsectorL1", "sector", "level", "variable", "unit", "value")] diff --git a/R/toolCalculateFS3share.R b/R/toolCalculateFS3share.R index 4a56975..5bfb46a 100644 --- a/R/toolCalculateFS3share.R +++ b/R/toolCalculateFS3share.R @@ -1,5 +1,5 @@ #' @title toolCalculateFS3share -#' @description Provides updates for endogenous cost components e.g. inconvenience costs for cars +#' @description Calculates fuel subsector L3 shares #' #' @param endoCostData data.table containing all cost components on technology level #' @param timesteps years for which to calculate FS3 shares @@ -52,7 +52,6 @@ toolCalculateFS3share <- function(endoCostData, timesteps, timeValue, preference VS3share[, test := sum(VS3share), by = c("region", "period", "subsectorL3")] if (nrow(VS3share[test < 0.9999 | test > 1.0001]) > 0) stop("VS3 shares in toolPrepareEndogenousCosts were not calculated correctly") VS3share[, test := NULL] - shares <- merge(FVshare, VS3share, by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3", "vehicleType"), allow.cartesian = TRUE) shares <- shares[, .(FS3share = sum(VS3share * FVshare)), by = c("region", "period", "sector", "subsectorL1", "subsectorL2", "subsectorL3", "technology")] shares[, test := sum(FS3share), by = c("region", "period", "subsectorL3")] diff --git a/R/toolEdgeTransportSA.R b/R/toolEdgeTransportSA.R index 850355b..5c4844a 100644 --- a/R/toolEdgeTransportSA.R +++ b/R/toolEdgeTransportSA.R @@ -80,10 +80,13 @@ toolEdgeTransportSA <- function(SSPscen, inputDataRaw$timeValueCosts, genModelPar$lambdasDiscreteChoice, helpers) + scenSpecPrefTrends <- rbind(histPrefs$historicalPreferences, scenSpecInputData$scenSpecPrefTrends) scenSpecPrefTrends <- toolApplyMixedTimeRes(scenSpecPrefTrends, helpers) + if (isICEban) scenSpecPrefTrends <- toolApplyICEbanOnPreferences(scenSpecPrefTrends, helpers) + scenSpecPrefTrends <- toolNormalizePreferences(scenSpecPrefTrends) #------------------------------------------------------- inputData <- list( @@ -227,6 +230,7 @@ toolEdgeTransportSA <- function(SSPscen, fleetSizeAndComposition = fleetSizeAndComposition, endogenousCosts = endogenousCosts, vehSalesAndModeShares = vehSalesAndModeShares, + sectorESdemand = sectorESdemand, ESdemandFVsalesLevel = ESdemandFVsalesLevel, helpers = helpers ) diff --git a/README.md b/README.md index cece844..6e28c62 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Prepare EDGE Transport Data for the REMIND model -R package **edgeTransport**, version **2.1.0** +R package **edgeTransport**, version **2.1.1** [![CRAN status](https://www.r-pkg.org/badges/version/edgeTransport)](https://cran.r-project.org/package=edgeTransport) [![R build status](https://github.com/pik-piam/edgeTransport/workflows/check/badge.svg)](https://github.com/pik-piam/edgeTransport/actions) [![codecov](https://codecov.io/gh/pik-piam/edgeTransport/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/edgeTransport) [![r-universe](https://pik-piam.r-universe.dev/badges/edgeTransport)](https://pik-piam.r-universe.dev/builds) @@ -46,7 +46,7 @@ In case of questions / problems please contact Johanna Hoppe . +Hoppe J, Dirnaichner A, Rottoli M, Muessel J (2024). _edgeTransport: Prepare EDGE Transport Data for the REMIND model_. R package version 2.1.1, . A BibTeX entry for LaTeX users is @@ -55,7 +55,7 @@ A BibTeX entry for LaTeX users is title = {edgeTransport: Prepare EDGE Transport Data for the REMIND model}, author = {Johanna Hoppe and Alois Dirnaichner and Marianna Rottoli and Jarusch Muessel}, year = {2024}, - note = {R package version 2.1.0}, + note = {R package version 2.1.1}, url = {https://github.com/pik-piam/edgeTransport}, } ``` diff --git a/man/iterativeEdgeTransport.Rd b/man/iterativeEdgeTransport.Rd index 2d40d8c..c8e6b3b 100644 --- a/man/iterativeEdgeTransport.Rd +++ b/man/iterativeEdgeTransport.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/iterativeEDGETransport.R +% Please edit documentation in R/iterativeEdgeTransport.R \name{iterativeEdgeTransport} \alias{iterativeEdgeTransport} \title{EDGE-Transport iterative} diff --git a/man/toolApplyICEbanOnPreferences.Rd b/man/toolApplyICEbanOnPreferences.Rd new file mode 100644 index 0000000..d177f33 --- /dev/null +++ b/man/toolApplyICEbanOnPreferences.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolApplyICEbanOnPreferences.R +\name{toolApplyICEbanOnPreferences} +\alias{toolApplyICEbanOnPreferences} +\title{Apply ICE ban on vehicle types that feature preference factors} +\usage{ +toolApplyICEbanOnPreferences(preferenceTab, helpers) +} +\arguments{ +\item{preferenceTab}{data.table including preferences for all levels of the decision tree} + +\item{helpers}{list of helpers} +} +\value{ +Preferences in accordance to the ICE ban policy +} +\description{ +Apply ICE ban on vehicle types that feature preference factors +} +\author{ +Johanna Hoppe +} diff --git a/man/toolCalculateFS3share.Rd b/man/toolCalculateFS3share.Rd index 9081270..c7428b5 100644 --- a/man/toolCalculateFS3share.Rd +++ b/man/toolCalculateFS3share.Rd @@ -30,7 +30,7 @@ toolCalculateFS3share( data.table containing all cost components on technology level and their respective FS3 shares } \description{ -Provides updates for endogenous cost components e.g. inconvenience costs for cars +Calculates fuel subsector L3 shares } \author{ Johanna Hoppe diff --git a/man/toolNormalizePreferences.Rd b/man/toolNormalizePreferences.Rd new file mode 100644 index 0000000..77dade7 --- /dev/null +++ b/man/toolNormalizePreferences.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/supportFunctions.R +\name{toolNormalizePreferences} +\alias{toolNormalizePreferences} +\title{Normalize preferences so that the maximum in each branch of the decision tree equals 1} +\usage{ +toolNormalizePreferences(preferenceTab) +} +\arguments{ +\item{preferenceTab}{data.table including preferences for all levels of the decision tree} +} +\value{ +Normalized preferences +} +\description{ +Normalize preferences so that the maximum in each branch of the decision tree equals 1 +} +\author{ +Johanna Hoppe +}