Merge pull request #76 from johanneskoch94/main

Improve documentation and refactor Bezier extension method

.buildlibrary

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

.github/workflows/check.yaml

@@ -23,6 +23,7 @@ jobs:
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
           extra-packages: |
+            gamstransfer=?ignore
             any::lucode2
             any::covr
             any::madrat
@@ -56,6 +57,8 @@ jobs:
 
       - name: Test coverage
         shell: Rscript {0}
-        run: covr::codecov(quiet = FALSE)
+        run: |
+          nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps"))
+          if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE)
         env:
           NOT_CRAN: "true"

.pre-commit-config.yaml

@@ -3,7 +3,7 @@
 exclude: '^tests/testthat/_snaps/.*$'
 repos:
 -   repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.4.0
+    rev: v4.5.0
     hooks:
     -   id: check-case-conflict
     -   id: check-json
@@ -15,7 +15,7 @@ repos:
     -   id: mixed-line-ending
 
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.3.2.9019
+    rev: v0.3.2.9025
     hooks:
     -   id: parsable-R
     -   id: deps-in-desc

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: 'mrdrivers: Create GDP and Population Scenarios'
-version: 1.4.0
-date-released: '2023-08-18'
+version: 1.5.0
+date-released: '2023-12-15'
 abstract: Create GDP and population scenarios This package constructs the GDP and
   population scenarios used as drivers in both the REMIND and MAgPIE models.
 authors:

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mrdrivers
 Type: Package
 Title: Create GDP and Population Scenarios
-Version: 1.4.0
+Version: 1.5.0
 Authors@R: c(person(given = "Johannes", 
                     family = "Koch", 
                     email = "[email protected]", 
@@ -19,7 +19,6 @@ Depends:
     madrat (>= 2.5.1),
     magclass (>= 6.0.3)
 Imports: 
-    bezier,
     countrycode,
     dplyr,
     lifecycle,
@@ -49,6 +48,6 @@ Suggests:
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
-Date: 2023-08-18
+Date: 2023-12-15
 Config/testthat/edition: 3
 VignetteBuilder: knitr

R/calcDriver.R

@@ -121,21 +121,34 @@ calcScenarioConstructor <- function(driver,
   harmonizedData$x <- toolFinishingTouches(x = harmonizedData$x, extension2150 = extension2150, naming = naming)
 
   weight <- NULL
+  description <- harmonizedData$description
   if (popAsWeight) {
-    weight <- calcOutput("Population", scenario = scenario, extension2150 = extension2150, aggregate = FALSE)
+    weight <- calcOutput("Population",
+                         scenario = scenario,
+                         extension2150 = extension2150,
+                         aggregate = FALSE,
+                         supplementary = TRUE)
     # Give weight same names as data, so that aggregate doesn't mess up data dim
-    getNames(weight) <- getNames(harmonizedData$x)
+    getNames(weight$x) <- getNames(harmonizedData$x)
     # Make sure weight and harmonizedData have the same yearly resolution. Sometimes x has more years than weigth,
     # thus the intersect operation. Then if weight has more years than x, only years that exist in x are used.
     # (this applies specifically to the noCovid and ISIMIP scenarios)
-    harmonizedData$x <- harmonizedData$x[, intersect(getYears(harmonizedData$x), getYears(weight)), ]
-    weight <- weight[, getYears(harmonizedData$x), ]
+    harmonizedData$x <- harmonizedData$x[, intersect(getYears(harmonizedData$x), getYears(weight$x)), ]
+    weight$x <- weight$x[, getYears(harmonizedData$x), ]
+    description <- glue("{description} Associated {weight$description}")
+  }
+
+  if (extension2150 == "bezier") {
+    description <- glue("{description} Extended from 2100 to 2150 using bezier curves, resulting in a smooth \\
+                        flattening of the scenario (the slope in 2150 is equal to half of that in 2100).")
+  } else if (extension2150 == "constant") {
+    description <- glue("{description} Extended from 2100 to 2150 using the constant 2100 value.")
   }
 
   list(x = harmonizedData$x,
-       weight = weight,
+       weight = weight$x,
        unit = harmonizedData$unit,
-       description = glue("{driver} {scenario} data: {harmonizedData$description}"))
+       description = glue("{driver} {scenario} scenarios: {description}"))
 }
 
 

R/calcGDP.R

@@ -44,6 +44,7 @@
 #' @examples \dontrun{
 #' # Return default scenarios
 #' calcOutput("GDP")
+#' calcOutput("GDPpc")
 #'
 #' # Return only the SSP2EU GDP scenario
 #' calcOutput("GDP", scenario = "SSP2EU")
@@ -79,7 +80,7 @@ calcGDP <- function(scenario = c("SSPs", "SDPs", "SSP2EU"),
     average2020 <- FALSE
   }
   if (average2020) {
-    # For REMIND, the concensus is to avergae the 2020 value so as to dampen the effect of the COVID shock. (The
+    # For REMIND, the consensus is to average the 2020 value so as to dampen the effect of the COVID shock. (The
     # reasoning being that REMIND uses 5-year time steps, and that the year-in-itself should represent the 2,5 years
     # before and after.)
     xNew2020 <- (gdp$x[, 2018, ] + gdp$x[, 2019, ] + gdp$x[, 2020, ] + gdp$x[, 2021, ] + gdp$x[, 2022, ]) / 5
@@ -89,7 +90,7 @@ calcGDP <- function(scenario = c("SSPs", "SDPs", "SSP2EU"),
     gdp$description <- paste(gdp$description, "|| 2020 value averaged over 2018-2022 time period.")
     # Return only 5 year time steps, since the yearly data around 2020 is not connected to the 2020 value anymore.
     years5ts <- getYears(gdp$x, as.integer = TRUE)[getYears(gdp$x, as.integer = TRUE) %% 5 == 0 &
-                                                   getYears(gdp$x, as.integer = TRUE) != 1960]
+                                                     getYears(gdp$x, as.integer = TRUE) != 1960]
     gdp$x <- gdp$x[, years5ts, ]
     gdp$weight <- gdp$weight[, years5ts, ]
     gdp$description <- paste(gdp$description, "5 year time steps only.")

R/calcGDPFuture.R

@@ -26,16 +26,15 @@ calcGDPFuture <- function(GDPFuture = "SSPs-MI", unit = "constant 2005 Int$PPP")
 calcInternalGDPFuture <- function(GDPFuture, unit) { # nolint
   data <- switch(
     GDPFuture,
-    "SSPs"   = calcOutput("InternalGDPFutureSSPs", unit = unit, aggregate = FALSE),
-    "SSP2EU" = calcOutput("InternalGDPFutureSSP2EU", unit = unit, aggregate = FALSE),
-    "SDPs"   = calcOutput("InternalGDPFutureSDPs", unit = unit, aggregate = FALSE),
-    "MI"     = calcOutput("InternalGDPMI", unit = unit, aggregate = FALSE),
+    "SSPs"   = calcOutput("InternalGDPFutureSSPs", unit = unit, aggregate = FALSE, supplementary = TRUE),
+    "SSP2EU" = calcOutput("InternalGDPFutureSSP2EU", unit = unit, aggregate = FALSE, supplementary = TRUE),
+    "SDPs"   = calcOutput("InternalGDPFutureSDPs", unit = unit, aggregate = FALSE, supplementary = TRUE),
+    "MI"     = calcOutput("InternalGDPMI", unit = unit, aggregate = FALSE, supplementary = TRUE),
     stop("Bad input for calcGDPFuture. Invalid 'GDPFuture' argument.")
   )
 
-  data <- toolFinishingTouches(data)
-
-  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = glue("GDP data from {GDPFuture}"))
+  data$x <- toolFinishingTouches(data$x)
+  data
 }
 
 
@@ -77,7 +76,7 @@ calcInternalGDPFutureSSPs <- function(unit) {
       GDPuc::convertGDP("constant 2005 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
 
     y2 <- getYears(data2005PPP)[getYears(data2005PPP, as.integer = TRUE) > c15 &
-                                 getYears(data2005PPP, as.integer = TRUE) < 2100]
+                                  getYears(data2005PPP, as.integer = TRUE) < 2100]
     dataFarFut <- data2005PPP[, y2, ] * NA
 
     # Convert to 2017 Int$PPP using the 2017 value of base 2005 GDP deflator
@@ -87,22 +86,22 @@ calcInternalGDPFutureSSPs <- function(unit) {
 
     data2017PPP <- mbind(dataNearFut, dataFarFut, data2100)
 
-    q <- data2005PPP / data2017PPP
+    ratio <- data2005PPP / data2017PPP
     # For interpolation to work, the last and first values have to be non-NA/non-NaN
-    q[, 2100, ][is.na(q[, 2100, ])] <- 0
+    ratio[, 2100, ][is.na(ratio[, 2100, ])] <- 0
     # The first 2 years of the SSP data set are incomplete. For countries that only lack data in these first 2 years,
     # set NaN to 0.
-    q[, 2000, ][is.nan(q[, 2000, ]) & !is.nan(q[, 2010, ])] <- 0
+    ratio[, 2000, ][is.nan(ratio[, 2000, ]) & !is.nan(ratio[, 2010, ])] <- 0
 
-    q <- as.data.frame(q, rev = 2) %>%
+    ratio <- as.data.frame(ratio, rev = 2) %>%
       dplyr::rename("value" = ".value") %>%
       dplyr::arrange(.data$year) %>%
       dplyr::group_by(.data$iso3c, .data$variable) %>%
       dplyr::mutate(value = zoo::na.approx(.data$value)) %>%
       dplyr::ungroup() %>%
       as.magpie(tidy = TRUE)
 
-    data2017PPP <- data2005PPP / q
+    data2017PPP <- data2005PPP / ratio
     data2017PPP[is.na(data2017PPP)] <- data2005PPP[is.na(data2017PPP)]
     # Above should probably be "<- 0"
     ##################
@@ -111,10 +110,10 @@ calcInternalGDPFutureSSPs <- function(unit) {
 
   # If unit was in $MER
   if (constructUnit != unit) {
-     data <- GDPuc::convertGDP(data, constructUnit, unit, replace_NAs = c("linear", "no_conversion"))
+    data <- GDPuc::convertGDP(data, constructUnit, unit, replace_NAs = c("linear", "no_conversion"))
   }
 
-  list(x = data, weight = NULL, unit = unit, description = "GDP data from SSPs")
+  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = "SSP projections")
 }
 
 calcInternalGDPFutureSDPs <- function(unit) {
@@ -124,12 +123,12 @@ calcInternalGDPFutureSDPs <- function(unit) {
                      ~ setNames(dataSSP1, gsub("SSP1", .x, getNames(dataSSP1)))) %>%
     mbind()
 
-  list(x = data, weight = NULL, unit = unit, description = "GDP data from SDPs")
+  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = "SDP projections")
 }
 
 calcInternalGDPFutureSSP2EU <- function(unit) {
   dataSSP2EU <- readSource("ARIADNE", "gdp_corona") %>%
-      GDPuc::convertGDP("constant 2005 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
+    GDPuc::convertGDP("constant 2005 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
   dataSSP <- calcOutput("InternalGDPFutureSSPs", unit = unit, aggregate = FALSE)
 
   # Get EU-27 countries
@@ -143,11 +142,11 @@ calcInternalGDPFutureSSP2EU <- function(unit) {
   data <- dataSSP[, , "gdp_SSP2"] %>% setNames("gdp_SSP2EU")
   data[euCountries, , ] <- 0
   data[euCountries, cy, ] <- dataSSP2EU[euCountries, cy, ]
-  list(x = data, weight = NULL, unit = unit, description = "GDP data from ARIADNE")
+  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = "ARIADNE projections")
 }
 
 calcInternalGDPMI <- function(unit) {
   data <- readSource("MissingIslands", "gdp") %>%
     GDPuc::convertGDP("constant 2005 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
-  list(x = data, weight = NULL, unit = unit, description = "GDP data from MI")
+  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = "MI projections")
 }

R/calcGDPHarmonized.R

@@ -46,28 +46,27 @@ toolGDPHarmonizeSSP2EU <- function(past, future, unit) {
                      supplementary = TRUE)
   ssp2Data <- ssps$x[, , "gdp_SSP2"]
 
-  # For SSP2EU: simply glue past with future
-  # Get EUR countries.
+  # For SSP2EU: EU countries are equal to past
   euCountries <- toolGetEUcountries(onlyWithARIADNEgdpData = TRUE)
-  ssp2EUData <- ssp2Data[, getYears(ssp2Data)[getYears(ssp2Data, as.integer = TRUE) <= 2100], ]
-  ssp2EUData[euCountries, , ] <- 0
-  ssp2EUData[euCountries, getYears(past$x), ] <- past$x[euCountries, , ]
+  ssp2EUData <- ssp2Data[euCountries, getYears(ssp2Data)[getYears(ssp2Data, as.integer = TRUE) <= 2100], ]
+  ssp2EUData[, , ] <- 0
+  ssp2EUData[, getYears(past$x), ] <- past$x[euCountries, , ]
 
   # Use GDP growth rates of eurostat for the years 2022, 2023, 2024
   gr <- readSource("EurostatPopGDP", "GDPgr_projections")
-  ssp2EUData[euCountries, 2022, ] <- ssp2EUData[euCountries, 2021, ] * (1 + gr[euCountries, 2022, ] / 100)
-  ssp2EUData[euCountries, 2023, ] <- ssp2EUData[euCountries, 2022, ] * (1 + gr[euCountries, 2023, ] / 100)
-  ssp2EUData[euCountries, 2024, ] <- ssp2EUData[euCountries, 2023, ] * (1 + gr[euCountries, 2024, ] / 100)
+  ssp2EUData[, 2022, ] <- ssp2EUData[, 2021, ] * (1 + gr[euCountries, 2022, ] / 100)
+  ssp2EUData[, 2023, ] <- ssp2EUData[, 2022, ] * (1 + gr[euCountries, 2023, ] / 100)
+  ssp2EUData[, 2024, ] <- ssp2EUData[, 2023, ] * (1 + gr[euCountries, 2024, ] / 100)
 
   # After 2024 use growth rates from future object
   pastYears <- getYears(ssp2EUData)[getYears(ssp2EUData, as.integer = TRUE) <= 2024]
   cy <- union(pastYears, getYears(future$x))
-  ssp2EUData[euCountries, cy, ] <- toolHarmonizePastGrFuture(ssp2EUData[euCountries, pastYears, ],
-                                                             future$x[euCountries, , ])
+  ssp2EUData[, cy, ] <- toolHarmonizePastGrFuture(ssp2EUData[, pastYears, ],
+                                                  future$x[euCountries, , ])
 
   # After 2070, transition to SSP2 values by 2150
   pastYears <- getYears(ssp2EUData)[getYears(ssp2EUData, as.integer = TRUE) <= 2070]
-  combinedSSP2EU <- toolHarmonizePastTransition(ssp2EUData[euCountries, pastYears, ],
+  combinedSSP2EU <- toolHarmonizePastTransition(ssp2EUData[, pastYears, ],
                                                 ssp2Data[euCountries, , ],
                                                 2150)
 
@@ -79,7 +78,9 @@ toolGDPHarmonizeSSP2EU <- function(past, future, unit) {
   combined <- combined[, getYears(combined)[getYears(combined, as.integer = TRUE) <= 2100], ]
 
   list(x = combined,
-      description = glue("Equal to SSP2 in all countries except for EUR countries. For EUR countries glue past data \\
-                          ({past$description}) with future data ({future$description}) and after 2070 converge to \\
-                          2150 SSP2 values."))
+       description = glue("equal to SSP2 in all countries except for EU countries. \\
+                          For EU countries use {past$description} until 2021, \\
+                          growth rates from Eurostat until 2024, \\
+                          growth rates from {future$description} until 2070, \\
+                          and converge to 2150 (bezier-extended) SSP2 values thereafter."))
 }

R/calcGDPPast.R

@@ -57,7 +57,7 @@ calcInternalGDPPast <- function(GDPPast, unit) { # nolint
 
   data <- toolFinishingTouches(data)
 
-  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = glue("GDP data from {GDPPast}."))
+  list(x = data, weight = NULL, unit = glue("mil. {unit}"), description = glue("{GDPPast} data"))
 }
 
 
@@ -69,12 +69,12 @@ calcInternalGDPPast <- function(GDPPast, unit) { # nolint
 calcInternalGDPPastWDI <- function(unit) {
   # "NY.GDP.MKTP.PP.KD" = GDP in constant 2017 Int$PPP (as of time of writing this function)
   data <- readSource("WDI", "NY.GDP.MKTP.PP.KD") %>%
-     GDPuc::convertGDP("constant 2017 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
+    GDPuc::convertGDP("constant 2017 Int$PPP", unit, replace_NAs = c("linear", "no_conversion"))
 
   data <- fillWithWBFromJames2019(data, unit)
 
   getNames(data) <- glue("gdp in {unit}")
-  list(x = data, weight = NULL, unit = unit, description = "GDP from WDI")
+  list(x = data, weight = NULL, unit = unit, description = "WDI data")
 }
 
 calcInternalGDPPastEurostat <- function(unit) {
@@ -89,7 +89,7 @@ calcInternalGDPPastEurostat <- function(unit) {
   data <- data %>% toolCountryFill(fill = 0) %>% suppressMessages()
 
   getNames(data) <- glue("gdp in {unit}")
-  list(x = data, weight = NULL, unit = unit, description = "GDP from Eurostat")
+  list(x = data, weight = NULL, unit = unit, description = "Eurostat data")
 }
 
 calcInternalGDPPastJames <- function(subtype) {

R/calcGDPpcFuture.R

@@ -28,7 +28,7 @@ calcGDPpcFuture <- function(GDPpcFuture = "SSPsOld-MI", # nolint
 
   data <- data[, getYears(weight), ]
 
-  list(x = data, weight = weight, unit = unit, description = glue("GDPpc data from {GDPpcFuture}"))
+  list(x = data, weight = weight, unit = unit, description = glue("{GDPpcFuture} projections"))
 }
 
 toolGDPpcFutureSSPsOld <- function(unit, mi = FALSE) {