Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor and change default scenarios #89

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion DESCRIPTION
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
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
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
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
Loading