Merge pull request #295 from johannah-pik/master

Enable more detailed transport reporting

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '5484658'
+ValidationKey: '5607280'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
@@ -7,3 +7,4 @@ AcceptedWarnings:
 AcceptedNotes: 'Undefined global functions or variables:'
 allowLinterWarnings: yes
 enforceVersionUpdate: no
+skipCoverage: no

.github/workflows/check.yaml

@@ -63,6 +63,6 @@ jobs:
         shell: Rscript {0}
         run: |
           nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps"))
-          if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE)
+          if(length(nonDummyTests) > 0 && !lucode2:::loadBuildLibraryConfig()[["skipCoverage"]]) covr::codecov(quiet = FALSE)
         env:
           NOT_CRAN: "true"

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.7.4
-date-released: '2024-10-21'
+version: 2.8.0
+date-released: '2024-10-30'
 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

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: edgeTransport
 Title: Prepare EDGE Transport Data for the REMIND model
-Version: 2.7.4
+Version: 2.8.0
 Authors@R: c(
     person("Johanna", "Hoppe", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0009-0004-6753-5090")),
@@ -19,7 +19,7 @@ Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.3.2
 VignetteBuilder: knitr
-Date: 2024-10-21
+Date: 2024-10-30
 Config/testthat/edition: 3
 Imports:
     rmndt,
@@ -31,6 +31,7 @@ Imports:
     gdxrrw,
     zoo,
     gdxdt,
+    mrdrivers,
     reporttransport (>= 0.0.13)
 Suggests:
     testthat (>= 3.0.0),

R/iterativeEDGETransport.R

@@ -70,6 +70,8 @@ iterativeEdgeTransport <- function() {
   genModelPar <- inputs$genModelPar
   scenModelPar <- inputs$scenModelPar
   RDSinputs <- inputs$RDSfiles
+
+
 
   # Data from previous REMIND iteration
   ## Load REMIND energy service demand
@@ -78,20 +80,20 @@ iterativeEdgeTransport <- function() {
 
   ## Load REMIND fuel cost
   REMINDfuelCost <- toolLoadREMINDfuelCosts(gdx, hybridElecShare, helpers)
-  # Convert fuel costs from US$2017/MJ to US$2017/vehkm
+  # Convert fuel costs from US$/MJ to US$/vehkm
   # Merge with energy intensity
   energyIntensity <- copy(RDSinputs$scenSpecEnIntensity)
   energyIntensity[, c("variable", "unit") := NULL]
   setnames(energyIntensity, "value", "energyIntensity")
   REMINDfuelCost <- merge(REMINDfuelCost, energyIntensity, by = c("region", "univocalName", "technology", "period"))
-  REMINDfuelCost[, value := value * energyIntensity][, unit := "US$2017/vehkm"][, energyIntensity := NULL]
-  # Convert fuel costs from US$2017/vehkm to US$2017/(p|t)km
+  REMINDfuelCost[, value := value * energyIntensity][, unit := gsub("MJ", "vehkm", unit)][, energyIntensity := NULL]
+  # Convert fuel costs from US$/vehkm to US$/(p|t)km
   loadFactor <- copy(RDSinputs$scenSpecLoadFactor)
   loadFactor[, c("variable", "unit") := NULL]
   setnames(loadFactor, "value", "loadFactor")
   REMINDfuelCost <- merge(REMINDfuelCost, loadFactor, by = c("region", "univocalName", "technology", "period"))
   REMINDfuelCost[, value := value / loadFactor][, loadFactor := NULL]
-  REMINDfuelCost[, unit := ifelse(univocalName %in% c(helpers$filter$trn_pass, "International Aviation"), "US$2017/pkm", "US$2017/tkm")]
+  REMINDfuelCost[, unit := ifelse(univocalName %in% c(helpers$filterEntries$trn_pass, "International Aviation"), gsub("vehkm", "pkm", unit), gsub("vehkm", "tkm", unit))]
 
   pathFuelCosts <- list.files(file.path(".", edgeTransportFolder), "REMINDfuelCostIterations.RDS", recursive = TRUE, full.names = TRUE)
   if (length(pathFuelCosts) > 0) {

R/toolApplyScenPrefTrends.R

@@ -20,6 +20,7 @@ toolApplyScenPrefTrends <- function(baselinePrefTrends, scenParPrefTrends, GDPpc
 
   # restructure mitigation factors provided in scenParPrefTrends
   # resolve techmap
+  GDPpcMER <- copy(GDPpcMER)[, c("variable", "unit") := NULL]
   mitigationFactors <- merge(helpers$mitigationTechMap[, c("vehicleType", "FVvehvar")], scenParPrefTrends, by = "FVvehvar", all.y = TRUE, allow.cartesian = TRUE)
   mitigationFactors[is.na(vehicleType), vehicleType := ""][, FVvehvar := NULL]
   # implement differentiation by GDP and treatment of single region entries

R/toolApplyScenSpecLoadFactor.R

@@ -9,21 +9,22 @@
 
 toolApplyScenSpecLoadFactor <- function(loadFactor, scenParLoadFactor, policyStartYear, helpers) {
 
-percentChange <- scenParLoadFactor$percentChange
-targetYear <- scenParLoadFactor$targetYear
+  loadFactor <- copy(loadFactor)
+  percentChange <- scenParLoadFactor$percentChange
+  targetYear <- scenParLoadFactor$targetYear
 
-if (length(percentChange) > 1) {
-  stop("Scenario specific load factor changes are not unambiguously defined")
-}
+  if (length(percentChange) > 1) {
+    stop("Scenario specific load factor changes are not unambiguously defined")
+  }
 
   loadFactor[
-    univocalName %in% helpers$filter$trn_pass_road_LDV_4W &
+    univocalName %in% helpers$filterEntries$trn_pass_road_LDV_4W &
       period >= policyStartYear &
       period <= targetYear,
     value := value * (1 + percentChange * (period - policyStartYear)/(targetYear - policyStartYear))]
 
   loadFactor[
-    univocalName %in% helpers$filter$trn_pass_road_LDV_4W &
+    univocalName %in% helpers$filterEntries$trn_pass_road_LDV_4W &
       period >= policyStartYear &
       period >= targetYear,
     value := value * (1 + percentChange)]

R/toolCalculateFS3share.R

@@ -15,7 +15,7 @@
 
 toolCalculateFS3share <- function(endoCostData, timesteps, timeValue, preferences, lambdas, helpers){
 
-  #time costs in [US$2017/pkm] for traveling with mode X in region Y
+  #time costs in [US$/pkm] for traveling with mode X in region Y
   timeValueCosts <- merge(timeValue, unique(helpers$decisionTree[, -c("technology")]), by = c("region", "univocalName"), all.x = TRUE)
   timeValueCosts[, type := "Travel time"][, c("unit", "univocalName", "variable") := NULL]
   if (length(timesteps) > 1) {

R/toolCalculateInitialIncoCost.R

@@ -8,7 +8,7 @@
 #' @param annualMileage annual mileage data
 #' @param helpers list with helpers
 #' @import data.table
-#' @returns data.table including initial inconvenience costs from 1990-2020 for LDV 4W US$2017/(p|t)km
+#' @returns data.table including initial inconvenience costs from 1990-2020 for LDV 4W US$/(p|t)km
 
 toolCalculateInitialIncoCost <- function(combinedCost, incoCostStartVal, annuity, loadFactor, annualMileage, helpers) {
 
@@ -64,14 +64,12 @@ toolCalculateInitialIncoCost <- function(combinedCost, incoCostStartVal, annuity
   decTree <- unique(helpers$decisionTree[subsectorL3 == "trn_pass_road_LDV_4W", c("region", "univocalName", "technology")])
   incoCostStartValReg <- merge(decTree, incoCostStartValReg, by = c("region", "univocalName", "technology"),
                                all.x = TRUE, allow.cartesian = TRUE)
-
-  incoCostStartValReg[, unit := "US$2017/veh/yr"]
   setnames(incoCostStartValReg, "incoCostType", "variable")
 
-  # convert to US$2017/pkm
-  # Annualize and discount to convert to US$2017/veh/yr
+  # convert to US$/pkm
+  # Annualize and discount to convert to US$/veh yr
   annualizedincoCostStartVal <- merge(incoCostStartValReg, annuity, by = "univocalName", allow.cartesian = TRUE)
-  annualizedincoCostStartVal[, value := value * annuity][, unit := "US$2017/veh/yr"][, annuity := NULL]
+  annualizedincoCostStartVal[, value := value * annuity][, unit := gsub("veh", "veh yr", unit)][, annuity := NULL]
 
   loadFactor <- copy(loadFactor)
   loadFactor[, c("variable", "unit") := NULL]
@@ -85,9 +83,9 @@ toolCalculateInitialIncoCost <- function(combinedCost, incoCostStartVal, annuity
   annualizedincoCostStartVal <- merge(annualizedincoCostStartVal, annualMileage,
                                       c("region", "univocalName", "technology", "period"), all.x = TRUE)
   annualizedincoCostStartVal[, value := value / (annualMileage * loadFactor)][, c("loadFactor", "annualMileage") := NULL]
-  #unit US$2017/pkm for passenger and unit US$2017/tkm for freight
-  annualizedincoCostStartVal[, unit := ifelse(univocalName %in% c(helpers$filter$trn_pass, "International Aviation"),
-                                              "US$2017/pkm", "US$2017/tkm")]
+  #unit US$/pkm for passenger and unit US$/tkm for freight
+  annualizedincoCostStartVal[, unit := ifelse(univocalName %in% c(helpers$filterEntries$trn_pass, "International Aviation"),
+                                              gsub("veh yr", "pkm", unit), gsub("veh yr", "tkm", unit))]
 
   if (anyNA(annualizedincoCostStartVal) == TRUE) {
     stop("Inconvenience cost start values contain NAs")

R/toolCombineCAPEXandOPEX.R

@@ -1,4 +1,4 @@
-#' Function that converts CAPEX and OPEX into US$2017/(p|t)km and provides them combined in a structured format
+#' Function that converts CAPEX and OPEX into US$/(p|t)km and provides them combined in a structured format
 #'
 #' @param CAPEXtrackedFleet CAPEX data for vehicle types that feature fleet tracking: Cars, trucks, busses
 #' @param nonFuelOPEXtrackedFleet non-fuel OPEX data for vehicle types that feature fleet tracking: Cars, trucks, busses
@@ -12,7 +12,7 @@
 #' @param annuity calculated annuity for different vehicle types
 #' @param helpers list with helpers
 #' @import data.table
-#' @returns data.table including total costs of ownership in US$2017/(p|t)km
+#' @returns data.table including total costs of ownership in US$/(p|t)km
 
 
 toolCombineCAPEXandOPEX <- function(CAPEXtrackedFleet,
@@ -33,42 +33,42 @@ toolCombineCAPEXandOPEX <- function(CAPEXtrackedFleet,
                               value), by = c("region", "period", "value")]
 
   # Tracked fleet (LDV 4W, Trucks, Busses)
-  # Annualize and discount CAPEX to convert to US$2017/veh/yr
+  # Annualize and discount CAPEX to convert to US$/veh yr
   # Include subsidies on LDV 4 Wheelers
-  upfrontCAPEXtrackedFleet <- rbind(CAPEXtrackedFleet, subsidies) # in US$2017/veh
+  upfrontCAPEXtrackedFleet <- rbind(CAPEXtrackedFleet, subsidies) # in US$/veh
   cols <- names(upfrontCAPEXtrackedFleet)
   cols <- cols[!cols %in% c("value", "variable")]
   upfrontCAPEXtrackedFleet[, .(value = sum(value)), by = cols][, variable := "Upfront capital costs sales"]
   annualizedCapexTrackedFleet <- merge(upfrontCAPEXtrackedFleet, annuity, by = "univocalName", allow.cartesian = TRUE)
-  annualizedCapexTrackedFleet[, value := value * annuity][, unit := "US$2017/veh/yr"][, annuity := NULL]
+  annualizedCapexTrackedFleet[, value := value * annuity][, unit := gsub("veh", "veh yr", unit)][, annuity := NULL]
   # Combine with non Fuel OPEX
   CAPEXandNonFuelOPEXtrackedFleet <- rbind(annualizedCapexTrackedFleet, nonFuelOPEXtrackedFleet)
-  # Merge with annual mileage to convert to US$2017/vehkm
+  # Merge with annual mileage to convert to US$/vehkm
   annualMileage <- copy(annualMileage)
   annualMileage[, c("variable", "unit") := NULL]
   setnames(annualMileage, "value", "annualMileage")
   CAPEXandNonFuelOPEXtrackedFleet <- merge(CAPEXandNonFuelOPEXtrackedFleet, annualMileage, by = c("region", "univocalName", "technology", "period"))
-  CAPEXandNonFuelOPEXtrackedFleet[, value := value / annualMileage][, unit := "US$2017/vehkm"][, annualMileage := NULL]
+  CAPEXandNonFuelOPEXtrackedFleet[, value := value / annualMileage][, unit := gsub("veh yr", "vehkm", unit)][, annualMileage := NULL]
 
-  # Combine with other modes of transport provided in US$2017/vehkm
+  # Combine with other modes of transport provided in US$/vehkm
   CAPEXandNonFuelOPEX <- rbind(CAPEXandNonFuelOPEXtrackedFleet, CAPEXother, nonFuelOPEXother)
 
-  # Convert fuel costs from US$2017/MJ to US$2017/vehkm
+  # Convert fuel costs from US$/MJ to US$/vehkm
   # Merge with energy intensity
   energyIntensity <- copy(energyIntensity)
   energyIntensity[, c("variable", "unit") := NULL]
   setnames(energyIntensity, "value", "energyIntensity")
   fuelCosts <- merge(fuelCosts, energyIntensity, by = c("region", "univocalName", "technology", "period"))
-  fuelCosts[, value := value * energyIntensity][, unit := "US$2017/vehkm"][, energyIntensity := NULL]
+  fuelCosts[, value := value * energyIntensity][, unit := gsub("MJ", "vehkm", unit)][, energyIntensity := NULL]
   combinedCAPEXandOPEX <- rbind(CAPEXandNonFuelOPEX, fuelCosts)
 
-  # Convert all cost components from US$2017/vehkm to US$2017/(p|t)km
+  # Convert all cost components from US$/vehkm to US$/(p|t)km
   loadFactor <- copy(loadFactor)
   loadFactor[, c("variable", "unit") := NULL]
   setnames(loadFactor, "value", "loadFactor")
   combinedCAPEXandOPEX <- merge(combinedCAPEXandOPEX, loadFactor, by = c("region", "univocalName", "technology", "period"))
   combinedCAPEXandOPEX[, value := value / loadFactor][, loadFactor := NULL]
-  combinedCAPEXandOPEX[, unit := ifelse(univocalName %in% c(helpers$filter$trn_pass, "International Aviation"), "US$2017/pkm", "US$2017/tkm")]
+  combinedCAPEXandOPEX[, unit := ifelse(univocalName %in% c(helpers$filterEntries$trn_pass, "International Aviation"), gsub("vehkm", "pkm", unit), gsub("vehkm", "tkm", unit))]
 
   # add zeros for active modes (time value costs are treated seperately)
   # use dummy that does not feature fleet tracking

R/toolDemandRegression.R

@@ -22,8 +22,10 @@ toolDemandRegression <- function(historicalESdemand, GDPperCapitaPPP, POP, genPa
                                     baseYear, policyStartYear, helpers) {
 
   # interpolate SSP specific elasticities based on GDP PPP per capita ----------------------------
+  GDPperCapitaPPP <- copy(GDPperCapitaPPP)[, c("variable", "unit") := NULL]
   setnames(GDPperCapitaPPP, "value", "regionGDPpcPPP")
   GDPperCapitaPPP <- GDPperCapitaPPP[period %in% helpers$lowTimeRes]
+  POP <- copy(POP)[, c("variable", "unit") := NULL]
   POP <- POP[period %in% helpers$lowTimeRes]
 
   approxElasticities <- function(category, elasticityGDPValues, GDPpc) {
@@ -43,6 +45,7 @@ toolDemandRegression <- function(historicalESdemand, GDPperCapitaPPP, POP, genPa
   scenSpecRegionalIncomeElasticities <- rbindlist(lapply(categories, approxElasticities,
                                                  scenParDemRegression, GDPperCapitaPPP[period >= policyStartYear]))
   regionalIncomeElasticities <- rbind(regionalIncomeElasticities, scenSpecRegionalIncomeElasticities)
+
   # apply SSP specific regional changes------------------------------------------------------------
   if (!is.null(scenParRegionalDemRegression)) {
     scenParRegionalDemRegression <- melt(scenParRegionalDemRegression,

R/toolDiscreteChoice.R

@@ -19,8 +19,6 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   CAPEXandOPEX <- merge(CAPEXandOPEX, helpers$decisionTree, by = c("region", "univocalName", "technology"), all.x = TRUE)
   # detailed resolution of CAPEX and OPEX not needed
   CAPEXandOPEX[, type := "Monetary Costs"]
-  CAPEXandOPEX <- CAPEXandOPEX[, .(value = sum(value)), by = c(setdiff(names(CAPEXandOPEX), c("value", "variable")))]
-  CAPEXandOPEX[, variable := "CAPEX and OPEX"]
   # vehicles that have endogenous inconvenience costs receive these in addition
   updatedEndoCosts[, type := "Inconvenience costs"]
   allCostsFV <- rbind(CAPEXandOPEX, updatedEndoCosts)
@@ -50,6 +48,10 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   if (nrow(FVshares[test < 0.9999 | test > 1.0001]) > 0 | anyNA(FVshares)) stop("FV shares in toolDiscreteChoice() were not calculated correctly")
   FVshares[, c("test") := NULL]
   FVshares <- rbind(FVshares, FVsharesZero)[, level := "FV"]
+  # Discrete choice cost structure
+  storeAllCostsFV <- copy(allCostsFV)
+  storeAllCostsFV[, variable := paste0("Logit cost|FV|", variable)][, type := NULL]
+  costsDiscreteChoice <- list(allCostsFV = storeAllCostsFV)
 
   # calculate all VS3 shares --------------------------------------------------------------------
   allCostsFV <- allCostsFV[type == "Monetary Costs"][, univocalName := NULL]
@@ -86,6 +88,9 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   if (nrow(VS3shares[test < 0.9999 | test > 1.0001]) > 0 | anyNA(VS3shares) | nrow(VS3shares) == 0) stop("VS3 shares in toolDiscreteChoice() were not calculated correctly")
   VS3shares[, test := NULL]
   VS3shares <- rbind(VS3shares, VS3sharesZero)[, level := "VS3"]
+  storeAllCostsVS3 <- copy(allCostsVS3)
+  storeAllCostsVS3[, variable := paste0("Logit cost|VS3|", variable)][, type := NULL]
+  costsDiscreteChoice <- c(costsDiscreteChoice, list(allCostsVS3 = storeAllCostsVS3))
 
   # calculate all S3S2 shares --------------------------------------------------------------------
   allCostsVS3 <- merge(allCostsVS3, VS3shares[, -c("level")],  by = intersect(names(allCostsVS3), names(VS3shares)))
@@ -109,6 +114,9 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   S3S2shares[, test := sum(share), by = c("region", "period", "subsectorL2")]
   if (nrow(S3S2shares[test < 0.9999 | test > 1.0001]) > 0 | anyNA(S3S2shares) | nrow(S3S2shares) == 0) stop("S3S2 shares in toolDiscreteChoice() were not calculated correctly")
   S3S2shares[, test := NULL][, level := "S3S2"]
+  storeAllCostsS3S2 <- copy(allCostsS3S2)
+  storeAllCostsS3S2[, variable := paste0("Logit cost|S3S2|", variable)][, type := NULL]
+  costsDiscreteChoice <- c(costsDiscreteChoice, list(allCostsS3S2 = storeAllCostsS3S2))
 
   # calculate all S2S1 shares --------------------------------------------------------------------
   allCostsS3S2 <- merge(allCostsS3S2, S3S2shares[, -c("level")],  by = intersect(names(allCostsS3S2), names(S3S2shares)))
@@ -132,6 +140,9 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   S2S1shares[, test := sum(share), by = c("region", "period", "subsectorL1")]
   if (nrow(S2S1shares[test < 0.9999 | test > 1.0001]) > 0 | anyNA(S2S1shares) | nrow(S2S1shares) == 0) stop("S2S1 shares in toolDiscreteChoice() were not calculated correctly")
   S2S1shares[, test := NULL][, level := "S2S1"]
+  storeAllCostsS2S1 <- copy(allCostsS2S1)
+  storeAllCostsS2S1[, variable := paste0("Logit cost|S2S1|", variable)][, type := NULL]
+  costsDiscreteChoice <- c(costsDiscreteChoice, list(allCostsS2S1 = storeAllCostsS2S1))
 
   # calculate all S1S shares --------------------------------------------------------------------
   allCostsS2S1 <- merge(allCostsS2S1, S2S1shares[, -c("level")],  by = intersect(names(allCostsS2S1), names(S2S1shares)))
@@ -155,11 +166,15 @@ toolDiscreteChoice <- function(input, generalModelPar, updatedEndoCosts, helpers
   S1Sshares[, test := sum(share), by = c("region", "period", "sector")]
   if (nrow(S1Sshares[test < 0.9999 | test > 1.0001]) > 0 | anyNA(S1Sshares) | nrow(S1Sshares) == 0) stop("S1S shares in toolDiscreteChoice() were not calculated correctly")
   S1Sshares[, test := NULL][, level := "S1S"]
+  storeAllCostsS1S <- copy(allCostsS1S)
+  storeAllCostsS1S[, variable := paste0("Logit cost|S1S|", variable)][, type := NULL]
+  costsDiscreteChoice <- c(costsDiscreteChoice, list(allCostsS1S = storeAllCostsS1S))
 
   # format --------------------------------------------------------------------
   shares <- rbind(FVshares, VS3shares, S3S2shares, S2S1shares, S1Sshares)[, unit := "-"]
   #toolCheckAllLevelsComplete(shares, helpers$decisionTree, "vehicle sales and mode shares")
 
-  return(shares)
+  return(list(shares = shares,
+              costsDiscreteChoice = costsDiscreteChoice))
 
 }