Adjust reporting

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '1019439'
+ValidationKey: '1200720'
 AutocreateReadme: yes
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'

.github/workflows/check.yaml

@@ -23,14 +23,14 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: |
-            any::lucode2
-            any::covr
-            any::madrat
-            any::magclass
-            any::citation
-            any::gms
-            any::goxygen
-            any::GDPuc
+            lucode2
+            covr
+            madrat
+            magclass
+            citation
+            gms
+            goxygen
+            GDPuc
           # piam packages also available on CRAN (madrat, magclass, citation,
           # gms, goxygen, GDPuc) will usually have an outdated binary version
           # available; by using extra-packages we get the newest version

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: 'reporttransport: Reporting package for edgeTransport'
-version: 0.5.1
-date-released: '2024-09-23'
+version: 0.6.0
+date-released: '2024-10-16'
 abstract: This package contains edgeTransport-specific routines to report model results.
   The main functionality is to generate transport reporting variables in MIF format
   from a given edgeTransport model run folder or REMIND input data.

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: reporttransport
 Title: Reporting package for edgeTransport
-Version: 0.5.1
-Date: 2024-09-23
+Version: 0.6.0
+Date: 2024-10-16
 Authors@R:
     person("Johanna", "Hoppe", , "[email protected]", role = c("aut", "cre"))
 Description: This package contains edgeTransport-specific routines to

R/aggregateVariables.R

@@ -75,6 +75,7 @@ aggregateVariables <- function(vars, mapAggregation, weight = NULL) {
   # Test for duplicated entries to prevent double counting in the aggregation
   test <- copy(vars)
   test[, value := NULL]
+
   if (anyDuplicated(test)) stop("Variables for aggregation contain duplicates.
                                 Check reportEdgeTransport() to prevent double counting")
 
@@ -96,6 +97,13 @@ aggregateVariables <- function(vars, mapAggregation, weight = NULL) {
     setnames(weight, "value", "weight")
   }
 
+  # Exclude vars that are not aggregated and create solely the variable entry
+  exclude <- c("Load factor", "Load factor raw", "Preference|FV", "Preference|S1S", "Preference|S2S1",
+               "Preference|S3S2", "Preference|VS3", "TCO sales Operating costs (total non-fuel)", "TCO sales Fuel costs", "TCO sales Capital costs", "Time value costs",
+               "Annual mileage", "Energy intensity sales", "Energy intensity sales raw", "Purchase Price")
+  aggregatedvars <- createVariableEntry(vars[variable %in% exclude], aggrOrder)
+  vars <- vars[!variable %in% exclude]
+
   # Aggregate each level of the decision tree --------------------------------------------------------------------
   for (i in seq(0, length(aggrOrder) - 1)) {
     aggrvars <- copy(vars)
@@ -135,7 +143,7 @@ aggregateVariables <- function(vars, mapAggregation, weight = NULL) {
     }
   }
 
-  exclude <- c("Sales", "Vintages", "Stock", "Load factor")
+  exclude <- c("Sales", "Vintages", "Stock")
   varsForFurtherAggregation <- vars[!variable %in% exclude]
 
   # Aggregate Pass with bunkers --------------------------------------------------------------------

R/convertToMIF.R

@@ -22,13 +22,15 @@ convertToMIF <- function(vars, GDPMER, helpers, scenario, model, gdx,  isTranspo
   applyReportingNames <- function(vars, mapNames) {
 
     rename <- function(columns, mapNames) {
+
       dt <- data.table(name = c(columns))
       dt[, rownum := .I]
       dt <- merge(dt, mapNames, by = "name", allow.cartesian = TRUE, all.x = TRUE)
       # Important to prevent change of row order
       setkey(dt, "rownum")
       dt <- dt[!is.na(reportName), name := reportName]
       dt[grepl(".*tmp", name), name := NA]
+      dt[name == "", name := NA]
       dt[!is.na(name), name := paste0("|", name)]
 
       return(dt$name)
@@ -45,42 +47,42 @@ convertToMIF <- function(vars, GDPMER, helpers, scenario, model, gdx,  isTranspo
     return(varsNew)
   }
 
-  # Use ES demand as weight to aggregate over modes-------------------------------------------
-  varsToMIFext <- vars$ext[!names(vars$ext) %in% c("GDPppp", "population")]
-  noAggregationvars <- vars$ext[c("GDPppp","population")]
-  varsToMIFext <- rbindlist(varsToMIFext, fill = TRUE, use.names = TRUE)
-  varsToMIFint <- rbindlist(vars$int, fill = TRUE, use.names = TRUE)
-
-  # Prepare vars that are not aggregated over modes
-  if (!is.null(noAggregationvars$GDPppp)){
-    noAggregationvars$GDPppp[, variable := "GDP|PPP"][, value := value * 1e-3][, unit := "billion constant 2017 Int$PPP"]
-    noAggregationvars$population[, variable := "Population"][, unit := "million"]
-    noAggregationvars <- rbindlist(noAggregationvars, fill = TRUE, use.names = TRUE)
-  }
-
-  # Apply variable naming convention----------------------------------------------------------
-  varsToMIFext <- applyReportingNames(varsToMIFext, helpers$reportingNames)
-  varsToMIFint[, fuel := NA]
-  varsToMIFint <- applyReportingNames(varsToMIFint, helpers$reportingNames)
-
   # Regional aggregation----------------------------------------------------------------------
   ## Aggregation to world is always supplied
-  mapWorld <- unique(varsToMIFext[, c("region")])[, aggrReg := "World"]
-  worldDataExt <- as.data.table(aggregate_map(varsToMIFext, mapWorld, by = "region"))
-  if (!is.null(noAggregationvars$GDPppp)) worldDatanoAggregationvars <- as.data.table(aggregate_map(noAggregationvars, mapWorld, by = "region"))
-  weight <- copy(varsToMIFext[variable == "ES"])
-  weight[, c("variable", "unit", "fuel") := NULL]
+  mapWorld <- unique(vars$ext[[1]][, c("region")])[, aggrReg := "World"]
+  worldDataExt <- lapply(vars$ext, function(x, mapWorld) as.data.table(aggregate_map(x, mapWorld, by = "region")), mapWorld)
+
+  weight <- copy(vars$ext$GDPppp)
+  weight[, c("variable", "unit") := NULL]
   setnames(weight, "value", "weight")
-  weightedInt <- merge(weight,varsToMIFint, by = intersect(names(varsToMIFint), names(weight)), all.x = TRUE)
-  byCols <- names(weightedInt)
-  byCols <- byCols[!byCols %in% c("region", "value", "weight")]
-  weightedInt[, sum := sum(weight), by = eval(byCols)]
-  weightedInt[sum == 0, weight := 1, by = eval(byCols)][, sum := NULL]
-  worldDataInt <- weightedInt[, .(value = sum(value * (weight / sum(weight)))), by = eval(byCols)]
-  worldDataInt[, region := "World"]
-  varsToMIFint <- rbind(varsToMIFint, worldDataInt)
-  varsToMIFext <- rbind(varsToMIFext, worldDataExt)
-  if (!is.null(noAggregationvars$GDPppp)) noAggregationvars <- rbind(noAggregationvars, worldDatanoAggregationvars)
+
+  #split shareweights
+  if (!is.null(vars$int$scenScpecPrefTrends)) {
+    Preferences <- list(
+      PrefrenceFV = vars$int$scenScpecPrefTrends[variable == "Preference|FV"],
+      PrefrenceS1S = vars$int$scenScpecPrefTrends[variable == "Preference|S1S"],
+      PrefrenceS2S1 = vars$int$scenScpecPrefTrends[variable == "Preference|S2S1"],
+      PrefrenceS3S2 = vars$int$scenScpecPrefTrends[variable == "Preference|S3S2"],
+      PrefrenceVS3 = vars$int$scenScpecPrefTrends[variable == "Preference|VS3"]
+    )
+    vars$int <- vars$int[!names(vars$int) == "scenScpecPrefTrends"]
+    vars$int <- append(vars$int, Preferences)
+  }
+
+  worldDataInt <- lapply(vars$int, function(x, weight) {
+    byCols <- names(x)
+    #sharweights include empty columns
+    emptyColumns <- names(vars$int)[sapply(vars$int, function(x) all(is.na(x) | x == ""))]
+    byCols <- byCols[!byCols %in% c("value") & byCols %in% names(weight) & !byCols %in% emptyColumns]
+    weight <- weight[, .(weight = sum(weight)), by = eval(byCols)]
+    weightedInt <- merge(weight, x, by = intersect(names(x), names(weight)), all.x = TRUE)
+    byCols <- names(weightedInt)
+    byCols <- byCols[!byCols %in% c("region", "value", "weight")]
+    weightedInt[, sum := sum(weight), by = eval(byCols)]
+    weightedInt[sum == 0, weight := 1, by = eval(byCols)][, sum := NULL]
+    worldDataInt <- weightedInt[, .(value = sum(value * (weight / sum(weight)))), by = eval(byCols)]
+    worldDataInt[, region := "World"]
+    return(worldDataInt)}, weight)
 
   ## Additional regions
   ## if regionSubsetList != NULL -> gdx provides 21 region resolution
@@ -99,33 +101,50 @@ convertToMIF <- function(vars, GDPMER, helpers, scenario, model, gdx,  isTranspo
       tmp <- data.table(region = regionSubsetList[[i]], aggrReg = namesReg[i])
       regSubsetMap <- rbind(regSubsetMap, tmp)
     }
-    regSubsetDataExt <- as.data.table(aggregate_map(varsToMIFext[region %in% unique(regSubsetMap$region)],
-                                                 regSubsetMap, by = "region"))
-    if (!is.null(noAggregationvars$GDPppp)) regSubsetDataNoAggregationVars <- as.data.table(aggregate_map(noAggregationvars[region %in% unique(regSubsetMap$region)],
-                                                                  regSubsetMap, by = "region"))
-    weightedInt <- merge(varsToMIFint, regSubsetMap, by = intersect(names(varsToMIFint), names(regSubsetMap)), all.y = TRUE)
-    weightedInt <- merge(weight, weightedInt, by = intersect(names(weightedInt), names(weight)), all.y = TRUE)
-    byCols <- names(weightedInt)
-    byCols <- byCols[!byCols %in% c("region", "value", "weight")]
-    weightedInt[, sum := sum(weight), by = eval(byCols)]
-    weightedInt[sum == 0, weight := 1, by = eval(byCols)][, sum := NULL]
-    regSubsetDataInt <- weightedInt[, .(value = sum(value * (weight / sum(weight)))), by = eval(byCols)]
-    setnames(regSubsetDataInt, "aggrReg", "region")
-
-    regSubsetDataExt <- as.data.table(aggregate_map(varsToMIFext[region %in% unique(regSubsetMap$region)],
-                                                    regSubsetMap, by = "region"))
-
-    varsToMIFint <- rbind(varsToMIFint, regSubsetDataInt)
-    varsToMIFext <- rbind(varsToMIFext, regSubsetDataExt)
-    if (!is.null(noAggregationvars$GDPppp)) noAggregationvars <- rbind(regSubsetDataNoAggregationVars, noAggregationvars)
+    regSubsetDataExt <- lapply(vars$ext, function(x, regSubsetMap) {
+      as.data.table(aggregate_map(x[region %in% unique(regSubsetMap$region)],
+                                                 regSubsetMap, by = "region"))}, regSubsetMap)
+    regSubsetDataInt <- lapply(vars$int, function(x, regSubsetMap, weight) {
+      weightedInt <- merge(x, regSubsetMap, by = intersect(names(x), names(regSubsetMap)), all.y = TRUE)
+      byCols <- names(x)
+      byCols <- byCols[!byCols %in% c("value") & byCols %in% names(weight)]
+      weight <- weight[, .(weight = sum(weight)), by = eval(byCols)]
+      weightedInt <- merge(weight, weightedInt, by = intersect(names(weightedInt), names(weight)), all.y = TRUE)
+      byCols <- names(weightedInt)
+      byCols <- byCols[!byCols %in% c("region", "value", "weight")]
+      weightedInt[, sum := sum(weight), by = eval(byCols)]
+      weightedInt[sum == 0, weight := 1, by = eval(byCols)][, sum := NULL]
+      regSubsetDataInt <- weightedInt[, .(value = sum(value * (weight / sum(weight)))), by = eval(byCols)]
+      setnames(regSubsetDataInt, "aggrReg", "region")
+      return(regSubsetDataInt)}, regSubsetMap, weight)
+
+    noAggregationvars <- rbind(rbindlist(vars$int[c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE),
+                               rbindlist(regSubsetDataInt[c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE),
+                               rbindlist(worldDataInt[c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE),
+                               rbindlist(vars$ext[c("GDPppp", "population")], fill = TRUE, use.names = TRUE),
+                               rbindlist(regSubsetDataExt[c("GDPppp", "population")], fill = TRUE, use.names = TRUE),
+                               rbindlist(worldDataExt[c("GDPppp", "population")], fill = TRUE, use.names = TRUE))
+
+    varsToMIFint <- rbind(rbindlist(vars$int[!names(vars$int) %in% c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE),
+                          rbindlist(regSubsetDataInt[!names(regSubsetDataInt) %in% c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE),
+                          rbindlist(worldDataInt[!names(worldDataInt) %in% c("GDPpcPPP", "GDPpcMER")], fill = TRUE, use.names = TRUE))
+
+    varsToMIFext <- rbind(rbindlist(vars$ext[!names(vars$ext) %in% c("GDPppp", "population")], fill = TRUE, use.names = TRUE),
+                          rbindlist(regSubsetDataExt[!names(regSubsetDataExt) %in% c("GDPppp", "population")], fill = TRUE, use.names = TRUE),
+                          rbindlist(worldDataExt[!names(worldDataExt) %in% c("GDPppp", "population")], fill = TRUE, use.names = TRUE))
   }
 
+  # Apply variable naming convention----------------------------------------------------------
+  varsToMIFext <- applyReportingNames(varsToMIFext, helpers$reportingNames)
+  varsToMIFint[, fuel := NA]
+  varsToMIFint <- applyReportingNames(varsToMIFint, helpers$reportingNames)
+
   # Aggregate variables-----------------------------------------------------------------------
   toMIFext <- aggregateVariables(varsToMIFext, helpers$reportingAggregation)
   weight <- varsToMIFext[variable == "ES"]
   toMIFint <- aggregateVariables(varsToMIFint, helpers$reportingAggregation, weight)
 
-  if (!is.null(noAggregationvars$GDPppp)) {
+  if (!is.null(noAggregationvars)) {
     toMIF <- rbind(toMIFint, toMIFext, noAggregationvars)
   } else {toMIF <- rbind(toMIFint, toMIFext)}