R/zchunk_L252.Trn_Inc_Elas_scenarios.R

Defines functions module_socioeconomics_L252.Trn_Inc_Elas_scenarios

Documented in module_socioeconomics_L252.Trn_Inc_Elas_scenarios

# Copyright 2019 Battelle Memorial Institute; see the LICENSE file.

#' module_socioeconomics_L252.Trn_Inc_Elas_scenarios
#'
#' Calculates transportation income elasticity for SSP scenarios using linear interpolation of assumption data
#'
#' @param command API command to execute
#' @param ... other optional parameters, depending on command
#' @return Depends on \code{command}: either a vector of required inputs,
#' a vector of output names, or (if \code{command} is "MAKE") all
#' the generated outputs: \code{L252.IncomeElasticity_trn_GCAM3}, \code{object}. The corresponding file in the
#' original data system was \code{L252.Trn_Inc_Elas_scenarios.R} (socioeconomics level2).
#' @details Uses per-capita GDP data for SSP scenarios to generate transportation income elasticity using linear interpolation of assumption data.
#' @importFrom assertthat assert_that
#' @importFrom dplyr filter left_join mutate select transmute
#' @importFrom stats approx
#' @author RH May 2017
module_socioeconomics_L252.Trn_Inc_Elas_scenarios <- function(command, ...) {
  if(command == driver.DECLARE_INPUTS) {
    return(c(FILE = "common/GCAM_region_names",
             FILE = "socioeconomics/A52.inc_elas",
             "L102.pcgdp_thous90USD_Scen_R_Y",
             "L101.Pop_thous_GCAM3_R_Y",
             "L102.gdp_mil90usd_GCAM3_R_Y"))
  } else if(command == driver.DECLARE_OUTPUTS) {
    return(c("L252.IncomeElasticity_trn_gSSP1",
             "L252.IncomeElasticity_trn_gSSP2",
             "L252.IncomeElasticity_trn_gSSP3",
             "L252.IncomeElasticity_trn_gSSP4",
             "L252.IncomeElasticity_trn_gSSP5",
             "L252.IncomeElasticity_trn_SSP1",
             "L252.IncomeElasticity_trn_SSP2",
             "L252.IncomeElasticity_trn_SSP3",
             "L252.IncomeElasticity_trn_SSP4",
             "L252.IncomeElasticity_trn_SSP5",
             "L252.IncomeElasticity_trn_GCAM3"))
  } else if(command == driver.MAKE) {
    # silence package checks
    value <- year <- pcgdp_90thousUSD <- GCAM_region_ID <- . <- scenario <-
      income.elasticity <- region <- value.x <- value.y <-
      energy.final.demand <- NULL

    all_data <- list(...)[[1]]

    # Load required inputs
    GCAM_region_names <- get_data(all_data, "common/GCAM_region_names")
    A52.inc_elas <- get_data(all_data, "socioeconomics/A52.inc_elas")
    L102.pcgdp_thous90USD_Scen_R_Y <- get_data(all_data, "L102.pcgdp_thous90USD_Scen_R_Y", strip_attributes = TRUE) %>%
      rename(pcgdp_90thousUSD = value) %>%
      mutate(year = as.integer(year))
    L101.Pop_thous_GCAM3_R_Y <- get_data(all_data, "L101.Pop_thous_GCAM3_R_Y")
    L102.gdp_mil90usd_GCAM3_R_Y <- get_data(all_data, "L102.gdp_mil90usd_GCAM3_R_Y", strip_attributes = TRUE)
    # ===================================================
    # For SSP scenarios, linearly interpolate income elasticity at each level of per-capita GDP
    L252.IncomeElasticity_trn_SSP <- L102.pcgdp_thous90USD_Scen_R_Y %>%
      filter(year %in% MODEL_FUTURE_YEARS) %>%
      # Using approx rather than approx_fun because data is from assumption file, not in our tibble
      mutate(income.elasticity = approx(x = A52.inc_elas$pcgdp_90thousUSD, y = A52.inc_elas$inc_elas,
                                        # Rule 2 means that data outside of the interval of input
                                        # data will be assigned the closest data extreme
                                        xout = pcgdp_90thousUSD, rule = 2)[['y']],
             energy.final.demand = "transportation") %>%
      mutate(income.elasticity = round(income.elasticity, energy.DIGITS_INCELAS_TRN)) %>%
      # Add in region names
      left_join_error_no_match(GCAM_region_names, by = "GCAM_region_ID") %>%
      # KVC: previously this had `ungroup(GCAM_region_ID)`, but that isn't supported
      ungroup() %>%
      select(-pcgdp_90thousUSD, -GCAM_region_ID)

    # Split by scenario - turns into list of tibbles
    L252.IncomeElasticity_trn_SSP <- L252.IncomeElasticity_trn_SSP %>%
      split(.$scenario) %>%
      lapply(function(df) {select(df, -scenario) %>%
          add_units("Unitless (% change in service demand / % change in income)") %>%
          add_comments("Uses previously calculated per-capita GDP assumptions for all SSP scenarios") %>%
          add_comments("Transportation income elasticity for each GCAM region generated by linear interpolation of assumption data") %>%
          add_precursors("common/GCAM_region_names", "socioeconomics/A52.inc_elas", "L102.pcgdp_thous90USD_Scen_R_Y") })

    # L252.IncomeElasticity_trn_GCAM3: transportation sector income elasticity for GCAM 3.0 socioeconomics
    # For the GCAM 3.0 scenario, calculate the per-capita GDP
    L252.IncomeElasticity_trn_GCAM3 <- L102.gdp_mil90usd_GCAM3_R_Y %>%
      left_join_error_no_match(L101.Pop_thous_GCAM3_R_Y, by = c("GCAM_region_ID", "year")) %>%
      filter(year %in% MODEL_FUTURE_YEARS) %>%
      left_join_error_no_match(GCAM_region_names, by = "GCAM_region_ID") %>%
      transmute(region, year, pcgdp_90thousUSD = value.x / value.y) %>%
      # Using approx rather than approx_fun because data is from assumption file, not in our tibble
      mutate(income.elasticity = approx(x = A52.inc_elas$pcgdp_90thousUSD, y = A52.inc_elas$inc_elas,
                                        xout = pcgdp_90thousUSD,
                                        # Rule 2 means that data outside of the interval of input
                                        # data will be assigned the cloest data extreme
                                        rule = 2)[['y']] %>% round(3),
             energy.final.demand = "transportation") %>%
      select(region, energy.final.demand, year, income.elasticity)
     # ===================================================

    # Produce outputs
    L252.IncomeElasticity_trn_SSP[['gSSP1']] %>%
      add_title("Transportation Income Elasticity: gSSP1") %>%
      add_legacy_name("L252.IncomeElasticity_trn_gSSP1") ->
      L252.IncomeElasticity_trn_gSSP1
    L252.IncomeElasticity_trn_SSP[['gSSP2']] %>%
      add_title("Transportation Income Elasticity: gSSP2") %>%
      add_legacy_name("L252.IncomeElasticity_trn_gSSP2") ->
      L252.IncomeElasticity_trn_gSSP2
    L252.IncomeElasticity_trn_SSP[['gSSP3']] %>%
      add_title("Transportation Income Elasticity: gSSP3") %>%
      add_legacy_name("L252.IncomeElasticity_trn_gSSP3") ->
      L252.IncomeElasticity_trn_gSSP3
    L252.IncomeElasticity_trn_SSP[['gSSP4']] %>%
      add_title("Transportation Income Elasticity: gSSP4") %>%
      add_legacy_name("L252.IncomeElasticity_trn_gSSP4") ->
      L252.IncomeElasticity_trn_gSSP4
    L252.IncomeElasticity_trn_SSP[['gSSP5']] %>%
      add_title("Transportation Income Elasticity: gSSP5") %>%
      add_legacy_name("L252.IncomeElasticity_trn_gSSP5") ->
      L252.IncomeElasticity_trn_gSSP5
    L252.IncomeElasticity_trn_SSP[['SSP1']] %>%
      add_title("Transportation Income Elasticity: SSP1") %>%
      add_legacy_name("L252.IncomeElasticity_trn_SSP1") ->
      L252.IncomeElasticity_trn_SSP1
    L252.IncomeElasticity_trn_SSP[['SSP2']] %>%
      add_title("Transportation Income Elasticity: SSP2") %>%
      add_legacy_name("L252.IncomeElasticity_trn_SSP2") ->
      L252.IncomeElasticity_trn_SSP2
    L252.IncomeElasticity_trn_SSP[['SSP3']] %>%
      add_title("Transportation Income Elasticity: SSP3") %>%
      add_legacy_name("L252.IncomeElasticity_trn_SSP3") ->
      L252.IncomeElasticity_trn_SSP3
    L252.IncomeElasticity_trn_SSP[['SSP4']] %>%
      add_title("Transportation Income Elasticity: SSP4") %>%
      add_legacy_name("L252.IncomeElasticity_trn_SSP4") ->
      L252.IncomeElasticity_trn_SSP4
    L252.IncomeElasticity_trn_SSP[['SSP5']] %>%
      add_title("Transportation Income Elasticity: SSP5") %>%
      add_legacy_name("L252.IncomeElasticity_trn_SSP5") ->
      L252.IncomeElasticity_trn_SSP5

    L252.IncomeElasticity_trn_GCAM3 %>%
      add_title("Transportation Income Elasticity: GCAM3") %>%
      add_units("Unitless (% change in service demand / % change in income)") %>%
      add_comments("Uses previously calculated per-capita GDP assumptions of transport elasticity") %>%
      add_comments("Transportation income elasticity for each GCAM region generated by linear interpolation of assumption data") %>%
      add_legacy_name("L252.IncomeElasticity_trn_GCAM3") %>%
      add_precursors("common/GCAM_region_names", "socioeconomics/A52.inc_elas",
                     "L101.Pop_thous_GCAM3_R_Y", "L102.gdp_mil90usd_GCAM3_R_Y") ->
      L252.IncomeElasticity_trn_GCAM3

    return_data(L252.IncomeElasticity_trn_gSSP1,
                L252.IncomeElasticity_trn_gSSP2,
                L252.IncomeElasticity_trn_gSSP3,
                L252.IncomeElasticity_trn_gSSP4,
                L252.IncomeElasticity_trn_gSSP5,
                L252.IncomeElasticity_trn_SSP1,
                L252.IncomeElasticity_trn_SSP2,
                L252.IncomeElasticity_trn_SSP3,
                L252.IncomeElasticity_trn_SSP4,
                L252.IncomeElasticity_trn_SSP5,
                L252.IncomeElasticity_trn_GCAM3)
  } else {
    stop("Unknown command")
  }
}
JGCRI/gcamdata documentation built on March 21, 2023, 2:19 a.m.