Pass objects instead of paths to preftrend, SDP_RC update

R/calculate_logit_inconv_endog.R

@@ -7,7 +7,6 @@
 #' @param logit_params contains logit exponents
 #' @param intensity_data logit level intensity data
 #' @param price_nonmot price of non-motorized modes in the logit tree
-#' @param tech_scen technology scenario
 #' @param ptab4W inconvenience cost factors for LDVs
 #' @param totveh total demand for LDVs by tecnology, in million veh
 #' @import data.table
@@ -19,7 +18,6 @@ calculate_logit_inconv_endog = function(prices,
  logit_params,
  intensity_data,
  price_nonmot,
- tech_scen,
  ptab4W,
  totveh = NULL) {
 
@@ -112,7 +110,7 @@ calculate_logit_inconv_endog = function(prices,
 
 
 
- F2Vcalc <- function(prices, pref_data, ptab4W, logit_params, value_time, mj_km_data, group_value, totveh, tech_scen) {
+ F2Vcalc <- function(prices, pref_data, ptab4W, logit_params, value_time, mj_km_data, group_value, totveh) {
  vehicles_number <- param <- value <- NULL
  final_prefFV <- pref_data[["FV_final_pref"]]
  final_prefVS1 <- pref_data[["VS1_final_pref"]]
@@ -174,11 +172,6 @@ calculate_logit_inconv_endog = function(prices,
  ## apply the same logit exponent to all the years
  df[, logit.exponent := as.double(logit.exponent)]
  df[, logit.exponent := ifelse(is.na(logit.exponent), mean(logit.exponent, na.rm = TRUE), logit.exponent), by = c("vehicle_type")]
- if(tech_scen %in% c("ElecEra", "HydrHype")) {
- ## logit exponent gets higher in time for LDVs and road freight, doubling by 2035
- df[subsector_L1 %in% c("trn_freight_road_tmp_subsector_L1", "trn_pass_road_LDV_4W") & year >=2020, logit.exponent := ifelse(year <= 2035 & year >= 2020, logit.exponent[year==2020] + (2*logit.exponent[year==2020]-logit.exponent[year==2020]) * (year-2020)/(2035-2020), 2*logit.exponent[year==2020]),
- by=c("region", "vehicle_type", "technology")]
- }
 
  ## for 4W the value of V->S1 market shares is needed on a yearly basis
  final_prefVS1cp = final_prefVS1[subsector_L1 == "trn_pass_road_LDV_4W"]
@@ -473,7 +466,6 @@ calculate_logit_inconv_endog = function(prices,
  value_time = value_time,
  mj_km_data = mj_km_data,
  group_value = "vehicle_type",
- tech_scen = tech_scen,
  totveh = totveh)
  FV <- FV_all[["df"]]
  MJ_km_FV <- FV_all[["MJ_km"]]

R/generateEDGEdata.R

@@ -40,7 +40,7 @@ generateEDGEdata <- function(input_folder, output_folder, cache_folder = NULL,
  technology <- non_fuel_price <- tot_price <- fuel_price_pkm <- subsector_L1 <- loadFactor <-
  ratio <- Year <- value <- DP_cap <- region <- weight <- MJ <- variable.unit <-
  EJ <- grouping_value <- sector <- variable <- region <- logit.exponent <- EDGETscen <-
- SSPscen <- default <- techscen <- share <- demand_F <- NULL
+ SSPscen <- default <- techscen <- share <- demand_F <- tech_scenario <- SSP_scenario <- NULL
 
  if(is.null(output_folder) & storeRDS == TRUE){
  print("Warning: If storeRDS is set, output_folder has to be non-NULL. Setting storeRDS=FALSE")
@@ -234,28 +234,32 @@ generateEDGEdata <- function(input_folder, output_folder, cache_folder = NULL,
  if(storeRDS)
  saveRDS(calibration_output, file = level1path("calibration_output.RDS"))
 
-
- ## load inconvenience factor table for LDVs
- if(is.null(mitab4W.path)){
- mitab4W.path <- system.file("extdata", "inconv_factor.csv", package = "edgeTransport")
+ ## load baseline sw trend table (non-LDV)
+ if(is.null(preftab)) {
+ preftab <- system.file("extdata", "sw_trends.csv", package = "edgeTransport")
  }
+ ptab <- fread(preftab, header=T)[SSP_scenario == SSP_scen][, SSP_scenario := NULL]
 
- ## select the right combination of techscen and SSP scen
- preftab4W <- fread(mitab4W.path, header=T)[techscen == tech_scen & SSPscen == SSP_scen]
-
+ ## load mitigatin trends sw table
+ if(is.null(mitab.path)) {
+ mitab.path <- system.file("extdata", "edget-mitigation.csv", package="edgeTransport")
+ }
+ mitab <- fread(mitab.path, header = TRUE, check.names = TRUE)[
+ SSP_scenario == SSP_scen & tech_scenario == tech_scen]
 
  print("-- generating trends for inconvenience costs")
- prefs <- lvl1_preftrend(SWS = calibration_output$list_SW,
- preftab = preftab,
- incocost = incocost,
- calibdem = REMINDdat$dem,
- years = years,
- GDP_POP_MER = mrr$GDP_POP_MER,
- smartlifestyle = smartlifestyle,
- tech_scen = tech_scen,
- SSP_scen = SSP_scen,
- mitab.path = mitab.path
- )
+ prefs <- lvl1_preftrend(
+ SWS = calibration_output$list_SW,
+ ptab = ptab,
+ incocost = incocost,
+ calibdem = REMINDdat$dem,
+ years = years,
+ GDP_POP_MER = mrr$GDP_POP_MER,
+ smartlifestyle = smartlifestyle,
+ tech_scen = tech_scen,
+ SSP_scen = SSP_scen,
+ mitab = mitab
+ )
 
  if(storeRDS)
  saveRDS(prefs, file = level1path("prefs.RDS"))
@@ -274,6 +278,13 @@ generateEDGEdata <- function(input_folder, output_folder, cache_folder = NULL,
  #in the country, receive a zero sw. The missing input data for that vehcile classes causing NAs in the line underneath
  #IEAbal_comparison$merged_intensity = merge(IEAbal_comparison$merged_intensity, unique(prefs$FV_final_pref[!(vehicle_type %in% c("Cycle_tmp_vehicletype", "Walk_tmp_vehicletype")) , c("region", "vehicle_type")]), by = c("region", "vehicle_type"), all.y = TRUE)
 
+ ## load inconvenience factor table for LDVs
+ if(is.null(mitab4W.path)) {
+ mitab4W.path <- system.file("extdata", "inconv_factor.csv", package = "edgeTransport")
+ }
+
+ preftab4W <- fread(mitab4W.path, header=T)[techscen == tech_scen & SSPscen == SSP_scen]
+
  totveh=NULL
  ## multiple iterations of the logit calculation - set to 3
  for (i in seq(1,3,1)) {
@@ -284,7 +295,6 @@ generateEDGEdata <- function(input_folder, output_folder, cache_folder = NULL,
  logit_params = VOT_lambdas$logit_output,
  intensity_data = IEAbal_comparison$merged_intensity,
  price_nonmot = REMINDdat$pnm,
- tech_scen = tech_scen,
  ptab4W = preftab4W,
  totveh = totveh)
 

R/lvl0_mergeDat.R

@@ -472,6 +472,7 @@ lvl0_mergeDat = function(UCD_output, EU_data, PSI_costs, GDP_MER, altCosts, CHN_
  int <- int[!(iso == "DEU" & vehicle_type %in% c("Van", "Mini Car"))]
 
  LF = merge(LF, unique(dem[!vehicle_type %in% c("Cycle_tmp_vehicletype", "Walk_tmp_vehicletype"),c("iso", "vehicle_type", "technology", "subsector_L1", "subsector_L2", "subsector_L3", "sector", "year")]), all.y = TRUE, by = c("iso", "vehicle_type", "technology", "subsector_L1", "subsector_L2", "subsector_L3", "sector", "year"))
+
  LF[, loadFactor := ifelse(is.na(loadFactor), mean(loadFactor, na.rm = TRUE), loadFactor), by = c("year", "vehicle_type")]
  LF <- LF[year <= 2100]
  LF <- rbind(LF,

R/lvl1_incotrend.R

@@ -1,23 +1,23 @@
 #' Calculate a trend for share weights and inconvenience costs based on the EDGE scenario
 #'
 #' @param SWS preference factors
-#' @param preftab mode and veh preferences table
+#' @param ptab mode and veh preferences table
 #' @param calibdem calibration demand
 #' @param incocost inconvenience costs for 4wheelers
 #' @param years time steps
 #' @param GDP_POP_MER GDP population on MER base
 #' @param smartlifestyle switch activating sustainable lifestyles
 #' @param tech_scen technology at the center of the policy packages
 #' @param SSP_scen SSP or SDP scenario
-#' @param mitab.path mitigation pathways table path
+#' @param mitab mitigation pathways table
 #'
 #' @importFrom zoo na.approx na.spline
 #' @return projected trend of preference factors
 #' @author Alois Dirnaichner, Marianna Rottoli
 
 
-lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
- smartlifestyle, tech_scen, SSP_scen, mitab.path=NULL){
+lvl1_preftrend <- function(SWS, ptab, calibdem, incocost, years, GDP_POP_MER,
+ smartlifestyle, tech_scen, SSP_scen, mitab) {
  subsector_L1 <- gdp_pop <- technology <- tot_price <- sw <- logit.exponent <- NULL
  logit_type <- `.` <- region <- vehicle_type <- subsector_L2 <- subsector_L3 <- NULL
  sector <- V1 <- tech_output <- V2 <- GDP_cap <- value <- convsymmBEVlongDist <- NULL
@@ -37,12 +37,6 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  return(dt)
  }
 
- ## load pref table
- if(is.null(preftab)){
- preftab <- system.file("extdata", "sw_trends.csv", package = "edgeTransport")
- }
- ptab <- fread(preftab, header=T)[SSP_scenario == SSP_scen][, SSP_scenario := NULL]
-
  ptab <- melt(ptab, value.name = "sw", variable.name = "year", id.vars = colnames(ptab)[1:9])
  ptab[, year := as.numeric(as.character(year))]
  ## add missing years
@@ -107,7 +101,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
 
  setnames(FVtarget, "sw", "value")
  FVtarget[, logit_type := "sw"]
- FVtarget[, c("techscen", "level", "approx") := NULL]
+ FVtarget[, c("level", "approx") := NULL]
 
  ## merge with incocost, this should be moved elsewhere in the future
  FV_inco = FVdt[subsector_L1 == "trn_pass_road_LDV_4W" & technology == "Liquids" & year <= 2020]
@@ -132,7 +126,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
 
  ## merge placeholder
  tmps <- filldt(VSdt[grepl("_tmp_", vehicle_type)], 2010)[
- , `:=`(sw=1, level="VS1", techscen=unique(VStarget$techscen), approx="linear")]
+ , `:=`(sw=1, level="VS1", approx="linear")]
  tmps[, c("logit.exponent", "tot_price") := NULL]
  ## add missing placeholders (HSR and rail)
  tmps <- unique(
@@ -148,7 +142,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  by=c("region", "sector", "subsector_L1",
  "subsector_L2", "subsector_L3", "vehicle_type")]
  VStarget[sw < 0, sw := 0]
- VStarget[, c("techscen", "level", "approx") := NULL]
+ VStarget[, c("level", "approx") := NULL]
 
  ## merge L1 sws (4W vs 2W)
  S1dt <- SWS$S1S2_final_SW
@@ -162,7 +156,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
 
  ## merge placeholder
  tmps <- filldt(S1dt[grepl("_tmp_", subsector_L1)], 2010)[
- , `:=`(sw=1, level="S1S2", techscen=unique(S1target$techscen), approx="linear")]
+ , `:=`(sw=1, level="S1S2", approx="linear")]
  tmps[, c("logit.exponent", "tot_price") := NULL]
  ## add missing placeholders (HSR and rail)
  tmps <- unique(
@@ -178,7 +172,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  by=c("region", "sector", "subsector_L1",
  "subsector_L2", "subsector_L3")]
  S1target[sw < 0, sw := 0]
- S1target[, c("techscen", "level", "approx") := NULL]
+ S1target[, c("level", "approx") := NULL]
 
  ## merge L2 sws
  S2dt <- SWS$S2S3_final_SW
@@ -192,7 +186,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
 
  ## merge placeholder
  tmps <- filldt(S2dt[grepl("_tmp_", subsector_L2)], 2010)[
- , `:=`(sw=1, level="S2S3", techscen=unique(S2target$techscen), approx="linear")]
+ , `:=`(sw=1, level="S2S3", approx="linear")]
  tmps[, c("logit.exponent", "tot_price") := NULL]
  tmps <- unique(
  rbind(
@@ -207,7 +201,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  by=c("region", "sector",
  "subsector_L2", "subsector_L3")]
  S2target[sw < 0, sw := 0]
- S2target[, c("techscen", "level", "approx") := NULL]
+ S2target[, c("level", "approx") := NULL]
 
  ## merge L3 sws
  S3dt <- SWS$S3S_final_SW
@@ -222,7 +216,7 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  S3target[, sw := ifelse(approx == "spline", na.spline(sw, x = year), na.approx(sw, x = year)),
  by=c("region", "sector", "subsector_L3")]
  S3target[sw < 0, sw := 0]
- S3target[, c("techscen", "level", "approx") := NULL]
+ S3target[, c("level", "approx") := NULL]
 
  ## normalization
  S3target[, sw := sw/max(sw),
@@ -272,11 +266,6 @@ lvl1_preftrend <- function(SWS, preftab, calibdem, incocost, years, GDP_POP_MER,
  ## techvar=c("Liquids", "Electric", "Hydrogen"),
  ## target=1, symmyr=2050, speed=10)
  ## fwrite(mitab, "edget-mitigation.csv")
- if(is.null(mitab.path)){
- mitab.path <- system.file("extdata", "edget-mitigation.csv", package="edgeTransport")
- }
- mitab <- fread(mitab.path, header = TRUE, check.names = TRUE)[
- SSP_scenario == SSP_scen & tech_scenario == tech_scen]
  if(nrow(mitab) > 0){
  ## treat a region as a rich region starting from:
  richcutoff <- 25000

README.md

@@ -2,7 +2,7 @@
 
 R package **edgeTransport**, version **0.17.0**
 
-[![CRAN status](https://www.r-pkg.org/badges/version/edgeTransport)](https://cran.r-project.org/package=edgeTransport)   [![r-universe](https://pik-piam.r-universe.dev/badges/edgeTransport)](https://pik-piam.r-universe.dev/ui#builds)
+[![CRAN status](https://www.r-pkg.org/badges/version/edgeTransport)](https://cran.r-project.org/package=edgeTransport) [![R build status](https://github.com/pik-piam/edgeTransport/workflows/check/badge.svg)](https://github.com/pik-piam/edgeTransport/actions) [![codecov](https://codecov.io/gh/pik-piam/edgeTransport/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/edgeTransport) [![r-universe](https://pik-piam.r-universe.dev/badges/edgeTransport)](https://pik-piam.r-universe.dev/ui#builds)
 
 ## Purpose and Functionality