Skip to content

Commit

Permalink
Refactor and change default scenarios
Browse files Browse the repository at this point in the history 
Drop SSP2EU scenario.
Add ADB sources and scenarios.
Urban pop share scenarios are improved, so as to never exceed 1, even with bezier extensions.
SSP labour scenarios are now also filled in with UN_popDiv data.
Fixes #13.
Deprecate scenario.indicator naming.
Fix all linter warnings.
Fixes #56 and fixes #57.
Improve and simplify documentation. Fixes #16.
  • Loading branch information
@johanneskoch94
johanneskoch94 committed Oct 1, 2024
1 parent 15d6c7e commit 28820ed
Show file tree
Hide file tree
Showing 78 changed files with 1,139 additions and 1,952 deletions.
1 change: 0 additions & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@ Depends:
Imports:
countrycode,
dplyr,
lifecycle,
GDPuc (>= 1.0.0),
glue,
magrittr,
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,5 @@ exportPattern("^((calc(GDP|GDPpc|Population|Labour|Urban)(Past|Future|$))|read|d
import(madrat)
import(magclass)
importFrom(glue,glue)
importFrom(lifecycle,deprecate_soft)
importFrom(magrittr,"%>%")
importFrom(rlang,.data)
188 changes: 81 additions & 107 deletions R/calcDriver.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@
#' @param naming A string giving the naming scheme of the data dimension. Can be either:
#' \itemize{
#' \item "indicator_scenario" (default): Returns names of the type "gdp_SSP2", or "pop_SSP2".
#' \item "indicator.scenario": Returns names of the type "gdp.SSP2", or "pop.SSP2".
#' \item "indicator.scenario": (deprecated) Returns names of the type "gdp.SSP2", or "pop.SSP2".
#' \item "scenario": Returns names of the type "SSP2".
#' }
#' Set naming to "scenario" when you want to operate on SSP2 gdp and population data for instance, and not have to
Expand All @@ -60,12 +60,6 @@ calcDriver <- function(driver,
# Load ... arguments into function environment
list2env(list(...), environment())

# Temporary warning left as information. Remove in next release.
if ("FiveYearSteps" %in% ls()) {
warning("FiveYearSteps is deprecated and will throw an error in the next release.")
rm("FiveYearSteps")
}

# If the pastData, futureData and harmonization arguments are not in ..., then query them using "scenario" and
# load them into the function environment.
if (!any(c("pastData", "futureData", "harmonization") %in% ls())) {
Expand All @@ -83,16 +77,17 @@ calcDriver <- function(driver,
toolReduce()
}

#' ScenarioConstructor
#' Scenario construction
#'
#' @details # Combining data sources with "-"
#' Data sources can be combined with "-" and passed to both the pastData and futureData arguments, i.e. "WDI-MI". This
#' signifies that WDI data will be taken first, but missing data will be then be filled in with data from MI.
#'
#' @param harmonization A string designating the harmonization function.
#' @param pastData A string passed to the calc'Driver'Past function, e.g. [calcGDPPast()] or [calcPopulationPast()].
#' @param futureData A string passed to the calc'Driver'Future function, e.g. [calcGDPFuture()] or
#' [calcPopulationFuture()].
#' @param pastData A string designating the source for the past data, passed to the calc'Driver'Past function, e.g.
#' [calcGDPPast()] or [calcPopulationPast()].
#' @param futureData A string designating the source for the future data, passed to the calc'Driver'Future function,
#' e.g. [calcGDPFuture()] or [calcPopulationFuture()].
#' @param ... Arguments passed on to the 'driver'Past, 'driver'Future and driver'Harmonization' functions.
#' @inheritParams calcDriver
#' @inherit calcHarmonizedData seealso
Expand All @@ -118,10 +113,31 @@ calcScenarioConstructor <- function(driver,
supplementary = TRUE,
...)

harmonizedData$x <- toolFinishingTouches(x = harmonizedData$x, extension2150 = extension2150, naming = naming)
harmonizedData$x <- toolInterpolateAndExtrapolate(harmonizedData$x)
if (extension2150 != "none") harmonizedData <- toolExtend2150(harmonizedData, extension2150)

weight <- NULL
description <- harmonizedData$description
# If required, add indicators (drivers) to names, or as additional dimension
if (naming != "scenario") {
indicator <- switch(
driver,
"GDP" = "gdp",
"GDPpc" = "gdppc",
"Population" = "pop",
"Urban" = "urb",
# Label labour scenarios with "pop". Currently required for REMIND to work.
"Labour" = "pop"
)
if (naming == "indicator_scenario") {
getNames(harmonizedData$x) <- paste0(indicator, "_", getNames(harmonizedData$x))
}
if (naming == "indicator.scenario") {
warning("The naming option = 'indicator.scenario' is deprecated and will be removed in the next release.")
getNames(harmonizedData$x) <- paste0(indicator, ".", getNames(harmonizedData$x))
getSets(harmonizedData$x) <- c(getSets(harmonizedData$x)[1:2], "indicator", "scenario")
}
}

# If required, get population as weight
if (popAsWeight) {
weight <- calcOutput("Population",
scenario = scenario,
Expand All @@ -139,24 +155,19 @@ calcScenarioConstructor <- function(driver,
weight$x <- weight$x[, sort(getYears(weight$x)), ]
weight$x <- toolInterpolateAndExtrapolate(weight$x, extrapolate = FALSE)

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.")
harmonizedData$description <- glue("{harmonizedData$description} Associated {weight$description}")
} else {
weight <- NULL
}

list(x = harmonizedData$x,
weight = weight$x,
unit = harmonizedData$unit,
description = glue("{driver} {scenario} scenarios: {description}"))
description = glue("{driver} {scenario} scenarios: {harmonizedData$description}"))
}


#' Get Harmonized Data
#' Get harmonized data
#'
#' @param ... Arguments passed on to harmonization functions
#' @inheritParams calcScenarioConstructor
Expand All @@ -174,51 +185,48 @@ calcHarmonizedData <- function(driver, scenario, pastData, futureData, harmoniza
# population scenarios.
past <- if (pastData != "-") {
calcOutput("PastData", driver = driver, pastData = pastData, aggregate = FALSE, supplementary = TRUE, ...)
} else NULL
} else {
NULL
}
future <- if (futureData != "-") {
calcOutput("FutureData", driver = driver, futureData = futureData, aggregate = FALSE, supplementary = TRUE, ...)
} else NULL
} else {
NULL
}

switch(
# Load ... arguments into function environment
list2env(list(...), environment())

# Combine "past" and "future" time series.
harmonizedData <- switch(
harmonization,
"pastAndLevel" = toolHarmonizePast(past, future, method = "level"),
"pastAndGrowth" = toolHarmonizePast(past, future, method = "growth"),
"pastAndTransition" = toolHarmonizePast(past, future, method = "transition", yEnd = 2100),
"PopSSPs" = toolHarmonizeWithPEAPandFuture(past, future),
"PopISIMIP" = toolHarmonizePast(past, future, method = "transition", yEnd = 2030),
"GDPpcSSPs" = toolHarmonizeGDPpcSSPs(past, future, unit, yEnd = 2100),
"GDPpcSDPs" = toolBuildGDPpcSDPs(unit),
"GDPpcADBs" = toolHarmonizeGDPpcADBs(past, future),
"GDPoverPop" = toolDivideGDPbyPop(scenario, unit),
"GDPpcWithPop" = toolMultiplyGDPpcWithPop(scenario, unit),
"LabourADBs" = toolHarmonizeLabourADBs(),
stop(glue("Bad input for calcHarmonizedData Argument harmonization = '{harmonization}' is invalid."))
)

unit <- switch(
driver,
"Population" = calcOutput("PopulationHarmonized",
harmonization = harmonization,
past = past,
future = future,
aggregate = FALSE,
supplementary = TRUE,
...),
"GDP" = calcOutput("GDPHarmonized",
harmonization = harmonization,
past = past,
future = future,
scenario = scenario,
aggregate = FALSE,
supplementary = TRUE,
...),
"GDPpc" = calcOutput("GDPpcHarmonized",harmonization = harmonization,
past = past,
future = future,
scenario = scenario,
aggregate = FALSE,
supplementary = TRUE,
...),
"Labour" = calcOutput("LabourHarmonized",harmonization = harmonization,
past = past,
future = future,
aggregate = FALSE,
supplementary = TRUE,
...),
"Urban" = calcOutput("UrbanHarmonized",harmonization = harmonization,
past = past,
future = future,
aggregate = FALSE,
supplementary = TRUE,
...)
"GDP" = glue("mil. {unit}"),
"GDPpc" = unit,
"Population" = "million",
"Urban" = "share of population",
"Labour" = "million"
)

list(x = harmonizedData$x, weight = NULL, unit = unit, description = harmonizedData$description)
}

#' Get Past Data Building Block
#' Get past data
#'
#' @inheritParams calcScenarioConstructor
#' @inherit madrat::calcOutput return
Expand All @@ -227,32 +235,15 @@ calcHarmonizedData <- function(driver, scenario, pastData, futureData, harmoniza
calcPastData <- function(driver, pastData, unit) {
switch(
driver,
"GDP" = calcOutput("GDPPast",
GDPPast = pastData,
unit = unit,
aggregate = FALSE,
supplementary = TRUE),
"GDPpc" = calcOutput("GDPpcPast",
GDPpcPast = pastData,
unit = unit,
aggregate = FALSE,
supplementary = TRUE),
"Population" = calcOutput("PopulationPast",
PopulationPast = pastData,
aggregate = FALSE,
supplementary = TRUE),
"Urban" = calcOutput("UrbanPast",
UrbanPast = pastData,
aggregate = FALSE,
supplementary = TRUE),
"Labour" = calcOutput("LabourPast",
LabourPast = pastData,
aggregate = FALSE,
supplementary = TRUE)
"GDP" = calcOutput("GDPPast", pastData = pastData, unit = unit, aggregate = FALSE, supplementary = TRUE),
"GDPpc" = calcOutput("GDPpcPast", pastData = pastData, unit = unit, aggregate = FALSE, supplementary = TRUE),
"Population" = calcOutput("PopulationPast", pastData = pastData, aggregate = FALSE, supplementary = TRUE),
"Urban" = calcOutput("UrbanPast", pastData = pastData, aggregate = FALSE, supplementary = TRUE),
"Labour" = calcOutput("LabourPast", pastData = pastData, aggregate = FALSE, supplementary = TRUE)
)
}

#' Get Future Data Building Block
#' Get future data
#'
#' @inheritParams calcScenarioConstructor
#' @inherit madrat::calcOutput return
Expand All @@ -261,27 +252,10 @@ calcPastData <- function(driver, pastData, unit) {
calcFutureData <- function(driver, futureData, unit) {
switch(
driver,
"Population" = calcOutput("PopulationFuture",
PopulationFuture = futureData,
aggregate = FALSE,
supplementary = TRUE),
"GDP" = calcOutput("GDPFuture",
GDPFuture = futureData,
unit = unit,
aggregate = FALSE,
supplementary = TRUE),
"GDPpc" = calcOutput("GDPpcFuture",
GDPpcFuture = futureData,
unit = unit,
aggregate = FALSE,
supplementary = TRUE),
"Labour" = calcOutput("LabourFuture",
LabourFuture = futureData,
aggregate = FALSE,
supplementary = TRUE),
"Urban" = calcOutput("UrbanFuture",
UrbanFuture = futureData,
aggregate = FALSE,
supplementary = TRUE)
"GDP" = calcOutput("GDPFuture", futureData = futureData, unit = unit, aggregate = FALSE, supplementary = TRUE),
"GDPpc" = calcOutput("GDPpcFuture", futureData = futureData, unit = unit, aggregate = FALSE, supplementary = TRUE),
"Population" = calcOutput("PopulationFuture", futureData = futureData, aggregate = FALSE, supplementary = TRUE),
"Labour" = calcOutput("LabourFuture", futureData = futureData, aggregate = FALSE, supplementary = TRUE),
"Urban" = calcOutput("UrbanFuture", futureData = futureData, aggregate = FALSE, supplementary = TRUE),
)
}
79 changes: 75 additions & 4 deletions R/calcGDP.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@
#' \itemize{
#' \item the SSPs, i.e. SSP1-5
#' \item the SDPs, i.e. SDP, SDP_EI, SDP_RC, and SDP_MC
#' \item SSP2EU
#' }
#'
#' See the vignette: \code{vignette("scenarios")} for scenario options, definitions and references.
Expand Down Expand Up @@ -43,11 +42,11 @@
#' calcOutput("GDP")
#' calcOutput("GDPpc")
#'
#' # Return only the SSP2EU GDP scenario
#' calcOutput("GDP", scenario = "SSP2EU")
#' # Return only the SSP2 GDP scenario
#' calcOutput("GDP", scenario = "SSP2")
#' }
#'
calcGDP <- function(scenario = c("SSPs", "SDPs", "SSP2EU"),
calcGDP <- function(scenario = c("SSPs", "SDPs"),
unit = "constant 2017 Int$PPP",
average2020 = TRUE,
...) {
Expand Down Expand Up @@ -95,3 +94,75 @@ calcGDP <- function(scenario = c("SSPs", "SDPs", "SSP2EU"),

list(x = gdp$x, weight = gdp$weight, unit = glue("mil. {unit}"), description = gdp$description)
}


#' @rdname calcGDP
#' @examples \dontrun{
#' calcOutput("GDPpc")
#' }
#'
calcGDPpc <- function(scenario = c("SSPs", "SDPs"),
unit = "constant 2017 Int$PPP",
average2020 = TRUE,
...) {
# Check user input
toolCheckUserInput(driver = "GDPpc", args = c(list(...), as.list(environment())))

# GDPpc scenarios are constructed in 2017 Int$PPP, and converted, if necessary, at the end.
gdppc <- calcOutput("Driver",
driver = "GDPpc",
scenario = scenario,
unit = "constant 2017 Int$PPP",
popAsWeight = TRUE,
aggregate = FALSE,
supplementary = TRUE,
...)

if (average2020) {
# 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.)
# The dampening is supposed to take place on GDP. So for GDP per capita in 2020 to be consistent with the dampened
# GDP, it has to calculated from GDP and population. (In other words we can't just use the same formula as for GDP,
# since it would lead to inconsistency at the end.) This is a bit hacky...
gdp2020 <- calcOutput("GDP",
scenario = scenario,
unit = "constant 2017 Int$PPP",
average2020 = TRUE,
naming = "scenario",
extension2150 = "none",
aggregate = FALSE,
years = 2020)
pop2020 <- calcOutput("Population",
scenario = scenario,
naming = "scenario",
extension2150 = "none",
aggregate = FALSE,
years = 2020)
gdppc2020 <- gdp2020 / pop2020
gdppc2020[is.nan(gdppc2020)] <- 0
getNames(gdppc2020) <- getNames(gdppc$x)
gdppc$x[, 2020, ] <- gdppc2020
gdppc$description <- paste(gdppc$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(gdppc$x, as.integer = TRUE)[getYears(gdppc$x, as.integer = TRUE) %% 5 == 0 &
getYears(gdppc$x, as.integer = TRUE) != 1960]
gdppc$x <- gdppc$x[, years5ts, ]
gdppc$weight <- gdppc$weight[, years5ts, ]
gdppc$description <- paste(gdppc$description, "5 year time steps only.")
message("The 2020 value is an an avergae over the 2018-2022 time period!!")
}

# Convert to US$MER if required
if (grepl("US\\$MER", unit)) {
# Convert by interpolating and extrapolating missing conversion factors when possible.
gdppc$x <- GDPuc::convertGDP(gdppc$x,
unit_in = "constant 2017 Int$PPP",
unit_out = "constant 2017 US$MER",
replace_NAs = c("linear", "no_conversion"))
}
# Temporary shifting to 2005 prices, using only the US deflator
if (grepl("2005", unit)) gdppc$x <- gdppc$x * 0.8121123

list(x = gdppc$x, weight = gdppc$weight, unit = unit, description = gdppc$description)
}
Loading

0 comments on commit 28820ed

Please sign in to comment.