From dc3abb8201f78c3bca0b0cbdd16b8f374491652e Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Mon, 28 Oct 2024 08:22:29 +0100 Subject: [PATCH 1/4] flexUnit --- R/calcEdgeTransportSAinputs.R | 20 +++++++++++--------- R/convertUCD.R | 6 +++--- R/toolAdjustCAPEXother.R | 3 ++- 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/R/calcEdgeTransportSAinputs.R b/R/calcEdgeTransportSAinputs.R index 7b95cea..cdabb9f 100644 --- a/R/calcEdgeTransportSAinputs.R +++ b/R/calcEdgeTransportSAinputs.R @@ -16,6 +16,8 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU capex <- untilPrice <- untilPrice2 <- purchasePriceSubsidy <- purchasePriceSubsidy2 <- NULL + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + lowResYears <- data.table(temporal = "all", period = c( 1990, seq(2005, 2060, by = 5), @@ -171,7 +173,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU }, "annualMileage" = { - unit <- "vehkm/veh/yr" + unit <- "vehkm/yr" description <- "Annual mileage on technology level. Sources: TRACCS, UCD" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(highResYears) weight <- weight[, , paste0("gdp_", SSPscen)] @@ -345,7 +347,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- loadFactor }, "CAPEXtrackedFleet" = { - unit <- "US$2017/veh" + unit <- paste0(monUnit, "/veh") description <- "CAPEX for vehicle types that feature fleet tracking (cars, trucks and busses). Sources: UCD, PSI" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(highResYears) @@ -353,9 +355,9 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU # read PSI CAPEX CAPEXPSI <- toolPreparePSI(readSource("PSI", "CAPEX")) - # read UCD CAPEX given in US$2017/vkt and US$2017/veh + # read UCD CAPEX given in US$/vehkm and US$/veh CAPEXUCD <- toolPrepareUCD(readSource("UCD", "CAPEX"), "CAPEX") - # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$2017/vehkm + # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$/vehkm CAPEXcombinedUCD <- toolPrepareUCD(readSource("UCD", "CAPEXandNonFuelOPEX"), "CAPEXandNonFuelOPEX") # Operating subsidies for Freight Rail, Passenger Rail, HSR (+ Bus not used here) are partially attributed to CAPEX # otherwise negative values in OPEX @@ -424,7 +426,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- CAPEX }, "nonFuelOPEXtrackedFleet" = { - unit <- "US$2017/veh/yr" + unit <- paste0(monUnit, "/veh yr") description <- "Non-fuel OPEX on technology level for vehicle types that feature fleet tracking (cars, trucks, busses). Sources: UCD, PSI" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(highResYears) @@ -432,7 +434,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU nonFuelOPEXUCD <- toolPrepareUCD(readSource("UCD", "nonFuelOPEX"), "nonFuelOPEX") nonFuelOPEXUCD <- nonFuelOPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_4W] - # For trucks and busses UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$2017/vehkm + # For trucks and busses UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$/vehkm nonFuelOPEXcombinedUCD <- toolPrepareUCD(readSource("UCD", "CAPEXandNonFuelOPEX"), "CAPEXandNonFuelOPEX") nonFuelOPEXcombinedUCD <- nonFuelOPEXcombinedUCD[univocalName %in% filterEntries$trn_freight_road | univocalName == "Bus"] @@ -483,13 +485,13 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- nonFuelOPEX }, "CAPEXother" = { - unit <- "US$2017/vehkm" + unit <- paste0(monUnit, "/vehkm") description <- "CAPEX (purchase costs) for vehicle types that do not feature fleet tracking (all other than cars, trucks and busses). Sources: UCD" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(lowResYears) weight <- weight[, , paste0("gdp_", SSPscen)] - # read UCD CAPEX given in US$2017/vkt and US$2017/veh + # read UCD CAPEX given in US$/vehkm and US$/veh # non fuel OPEX include Domestic Aviation, International Aviation, Moped, Motorcycle (50-250cc), Motorcycle (>250cc) (+4W not used here) CAPEXUCD <- toolPrepareUCD(readSource("UCD", "CAPEX"), "CAPEX") CAPEXUCD <- CAPEXUCD[!univocalName %in% filterEntries$trn_pass_road_LDV_4W] @@ -583,7 +585,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU (other than cars, trucks, busses). Sources: UCD, PSI" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(lowResYears) weight <- weight[, , paste0("gdp_", SSPscen)] - # read UCD non fuel given in US$2017/vkt and US$2017/veh/yr + # read UCD non fuel given in US$2017/vehkm and US$2017/veh/yr # non fuel OPEX include Domestic Aviation, International Aviation, Moped, Motorcycle (50-250cc), Motorcycle (>250cc) (+4W not used here) nonFuelOPEXUCD <- toolPrepareUCD(readSource("UCD", "nonFuelOPEX"), "nonFuelOPEX") nonFuelOPEXUCD <- nonFuelOPEXUCD[!univocalName %in% filterEntries$trn_pass_road_LDV_4W] diff --git a/R/convertUCD.R b/R/convertUCD.R index 524e40b..f192b1d 100644 --- a/R/convertUCD.R +++ b/R/convertUCD.R @@ -37,15 +37,15 @@ convertUCD <- function(x, subtype) { x <- toolAggregate(x, rel = UCD2iso) - # convert US$2005 to US$20217 x <- GDPuc::toolConvertGDP( gdp = x, unit_in = "constant 2005 US$MER", unit_out = mrdrivers::toolGetUnitDollar(), replace_NAs = "with_USA" ) - - magclass::getNames(x) <- gsub("US\\$2005", "US$2017", magclass::getNames(x)) + + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + magclass::getNames(x) <- gsub("US\\$2005", monUnit, magclass::getNames(x)) } else { x <- toolAggregate(x, rel = UCD2iso) diff --git a/R/toolAdjustCAPEXother.R b/R/toolAdjustCAPEXother.R index 741df3a..7239941 100644 --- a/R/toolAdjustCAPEXother.R +++ b/R/toolAdjustCAPEXother.R @@ -105,7 +105,8 @@ toolAdjustCAPEXother <- function(dt, ISOcountries, yrs, completeData, GDPpcMER, missingMoped[is.na(value), value := twoW250][, twoW250 := NULL] missing2W <- rbind(missing50, missing250, missingMoped) - missing2W[, unit := "US$2017/vehkm"][, variable := "Capital costs (total)"] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + missing2W[, unit := paste0(monUnit, "/vehkm")][, variable := "Capital costs (total)"] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_2W)], missing2W) dt[, check := NULL] From d7caa3fba4bf417ca0d30f7887dc5c0346fa2a29 Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Mon, 28 Oct 2024 08:46:38 +0100 Subject: [PATCH 2/4] flex monetary unit --- R/calcEdgeTransportSAinputs.R | 38 +++++++++++++-------------- R/convertPSI.R | 6 ++--- R/toolAdjustCAPEXtrackedFleet.R | 15 ++++++----- R/toolAdjustNonFuelOPEXother.R | 3 ++- R/toolAdjustNonFuelOPEXtrackedFleet.R | 11 ++++---- R/toolPreparePurchasePriceSubsidies.R | 3 ++- 6 files changed, 41 insertions(+), 35 deletions(-) diff --git a/R/calcEdgeTransportSAinputs.R b/R/calcEdgeTransportSAinputs.R index ecbede1..ae71676 100644 --- a/R/calcEdgeTransportSAinputs.R +++ b/R/calcEdgeTransportSAinputs.R @@ -387,7 +387,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU # PSI CAPEX for 4 Wheelers feature only purchase costs - take other capital costs from UCD for EUR regions CAPEXraw <- rbind(PSIpurchaseCosts, CAPEXUCD4W, CAPEXcombinedUCD, data$operatingSubsidyUCD) - GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = "constant 2017 US$MER") |> time_interpolate(highResYears) + GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = mrdrivers::toolGetUnitDollar()) |> time_interpolate(highResYears) GDPpcMERmag <- GDPpcMERmag[, , paste0("gdppc_", SSPscen)] GDPpcMER <- magpie2dt(GDPpcMERmag, yearcol = "period", regioncol = "region", valcol = "gdppc")[, variable := NULL] @@ -495,7 +495,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU # non fuel OPEX include Domestic Aviation, International Aviation, Moped, Motorcycle (50-250cc), Motorcycle (>250cc) (+4W not used here) CAPEXUCD <- toolPrepareUCD(readSource("UCD", "CAPEX"), "CAPEX") CAPEXUCD <- CAPEXUCD[!univocalName %in% filterEntries$trn_pass_road_LDV_4W] - # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$2017/vehkm + # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$/vehkm # combined CAPEX and OPEX include Domestic Ship, Freight Rail, HSR, International Ship, Passenger Rail CAPEXcombinedUCD <- toolPrepareUCD(readSource("UCD", "CAPEXandNonFuelOPEX"), "CAPEXandNonFuelOPEX") CAPEXcombinedUCD <- CAPEXcombinedUCD[!(univocalName %in% filterEntries$trn_freight_road | univocalName == "Bus")] @@ -509,7 +509,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU c("region", "univocalName", "technology", "variable", "unit"), extrapolate = TRUE) - # Data for two wheelers is given in US$2017/veh and needs to be converted to US$2017/vehkm + # Data for two wheelers is given in US$/veh and needs to be converted to US$/vehkm # with the help of annuity and annual mileage # UCD applied interest rate of 10% and uniform vehicle lifetime of 15 yrs @@ -529,12 +529,12 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU CAPEXUCD <- merge.data.table(data$CAPEXUCD, AMUCD2W, by = c("region", "univocalName", "technology", "period"), all.x = TRUE) CAPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, value := (value * annuityFactor)/ annualMileage] - CAPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, unit := "US$2017/vehkm"][, annualMileage := NULL] + CAPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, unit := paste0(monUnit, "/vehkm")][, annualMileage := NULL] # merge.data.table data CAPEXraw <- rbind(CAPEXUCD, data$CAPEXcombinedUCD, data$operatingSubsidyUCD) - GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = "constant 2017 US$MER") |> time_interpolate(lowResYears) + GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = mrdrivers::toolGetUnitDollar()) |> time_interpolate(lowResYears) GDPpcMERmag <- GDPpcMERmag[, , paste0("gdppc_", SSPscen)] GDPpcMER <- magpie2dt(GDPpcMERmag, yearcol = "period", regioncol = "region", valcol = "gdppc")[, variable := NULL] @@ -580,16 +580,16 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- CAPEX }, "nonFuelOPEXother" = { - unit <- "US$2017/vehkm" + unit <- paste0(monUnit, "/vehkm") description <- "Non fuel OPEX on technology level for vehicle types that do not feature fleet tracking (other than cars, trucks, busses). Sources: UCD, PSI" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(lowResYears) weight <- weight[, , paste0("gdp_", SSPscen)] - # read UCD non fuel given in US$2017/vehkm and US$2017/veh/yr + # read UCD non fuel given in US$/vehkm and US$/veh/yr # non fuel OPEX include Domestic Aviation, International Aviation, Moped, Motorcycle (50-250cc), Motorcycle (>250cc) (+4W not used here) nonFuelOPEXUCD <- toolPrepareUCD(readSource("UCD", "nonFuelOPEX"), "nonFuelOPEX") nonFuelOPEXUCD <- nonFuelOPEXUCD[!univocalName %in% filterEntries$trn_pass_road_LDV_4W] - # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$2017/vehkm + # For some modes UCD offers only a combined value for CAPEX and non-fuel OPEX given in US$/vehkm # combined CAPEX and OPEX include Domestic Ship, Freight Rail, HSR, International Ship, Passenger Rail nonFuelOPEXcombinedUCD <- toolPrepareUCD(readSource("UCD", "CAPEXandNonFuelOPEX"), "CAPEXandNonFuelOPEX") nonFuelOPEXcombinedUCD <- nonFuelOPEXcombinedUCD[!univocalName %in% c(filterEntries$trn_freight_road, @@ -606,7 +606,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU data <- lapply(data, approx_dt, lowResYears, "period", "value", c("region", "univocalName", "technology", "variable", "unit"), extrapolate = TRUE) - # Data for two wheelers is given in US$2017/veh and needs to be converted to US$2017/vehkm + # Data for two wheelers is given in US$/veh and needs to be converted to US$/vehkm # with the help of annual mileage AMUCD2W <- toolPrepareUCD(readSource("UCD", "annualMileage"), "annualMileage") AMUCD2W <- AMUCD2W[univocalName %in% filterEntries$trn_pass_road_LDV_2W] @@ -618,7 +618,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU "univocalName", "technology"), all.x = TRUE) nonFuelOPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, value := value / annualMileage] - nonFuelOPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, unit := "US$2017/vehkm"][, annualMileage + nonFuelOPEXUCD[univocalName %in% filterEntries$trn_pass_road_LDV_2W, unit := paste0(monUnit, "/vehkm")][, annualMileage := NULL] # merge.data.table data @@ -760,7 +760,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- VOT }, "timeValueCosts" = { - unit <- "US$2017/pkm" + unit <- paste0(monUnit, "/pkm") description <- "Time value costs for passenger transport modes. Sources: GCAM" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(highResYears) @@ -778,7 +778,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU valcol = "multiplier")[, c("variable", "unit") := NULL] setkey(valueOfTimeMultiplier, region, period, univocalName, technology) - GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = "constant 2017 US$MER") |> time_interpolate(highResYears) + GDPpcMERmag <- calcOutput("GDPpc", aggregate = FALSE, unit = mrdrivers::toolGetUnitDollar()) |> time_interpolate(highResYears) GDPpcMERmag <- GDPpcMERmag[, , paste0("gdppc_", SSPscen)] GDPpcMER <- magpie2dt(GDPpcMERmag, yearcol = "period", regioncol = "region", valcol = "gdppc")[, variable := NULL] @@ -789,11 +789,11 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU timeValueCosts <- merge(timeValueCosts, GDPpcMER) weeksPerYear <- 50 hoursPerWeek <- 40 - timeValueCosts[, value := gdppc ## [US$2017/person/year] - * multiplier ## [US$2017/person/year] - / (hoursPerWeek * weeksPerYear) / ## [US$2017/h] - speed] ## [US$2017/pkm] - timeValueCosts[, variable := "Time value costs"][, unit := "US$2017/pkm"] + timeValueCosts[, value := gdppc ## [US$/person/year] + * multiplier ## [US$/person/year] + / (hoursPerWeek * weeksPerYear) / ## [US$/h] + speed] ## [US$/pkm] + timeValueCosts[, variable := "Time value costs"][, unit := paste0(monUnit, "/pkm")] timeValueCosts <- timeValueCosts[, c("region", "univocalName", "technology", "variable", "unit", "period", "value")] timeValueCosts <- timeValueCosts[(univocalName %in% highResUnivocalNames @@ -822,7 +822,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU quitteobj <- timeValueCosts }, "PurchasePriceSubsidies" = { - unit <- "US$2017/veh" + unit <- paste0(monUnit, "/veh") description <- "Subsidies for individuals purchasing alternative technology LDVs. If untilPrice is not NA, then the subsidies only apply if the purchase price (CAPEX) is smaller than or equal to the untilPrice." @@ -846,7 +846,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU # merge subsidies with CAPEX data to obtain purchase price and calculate subsidies data <- merge(data, CAPEXapprox, all.y = TRUE, by = intersect(names(data), names(CAPEXapprox))) - data$unit <- "US$2017/veh" + data$unit <- paste0(monUnit, "/veh") # calculate subsidies based on purchase price and untilPrice values calculateSubsidies <- function(period, price, subsidy, untilPrice, subsidy2, diff --git a/R/convertPSI.R b/R/convertPSI.R index 51fc16e..5677e80 100644 --- a/R/convertPSI.R +++ b/R/convertPSI.R @@ -32,15 +32,15 @@ convertPSI <- function(x, subtype) { subtype, "CAPEX" = { - # PSI CAPEX need to be transformed from EUR 2017 to USD 2017 + # PSI CAPEX need to be transformed from EUR 2017 to USD x <- GDPuc::toolConvertGDP( gdp = x, unit_in = "constant 2017 EUR", unit_out = mrdrivers::toolGetUnitDollar(), replace_NAs = "with_USA" ) - - getItems(x, dim = "unit") <- "US$2017/veh" # nolint: object_usage_linter + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + getItems(x, dim = "unit") <- paste0(monUnit, "/veh") # nolint: object_usage_linter }, "energyIntensity" = { #PSI energy intensity needs to be transformed to MJ/vehkm diff --git a/R/toolAdjustCAPEXtrackedFleet.R b/R/toolAdjustCAPEXtrackedFleet.R index a4d9880..8dcced3 100644 --- a/R/toolAdjustCAPEXtrackedFleet.R +++ b/R/toolAdjustCAPEXtrackedFleet.R @@ -96,7 +96,7 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP #Sum part of the CAPEX and non Fuel OPEX and the operating subsidies that is now attributed to the CAPEX dt <- dt[, .(value = sum(value)), by = c("region", "univocalName", "technology", "variable", "unit", "period")] - # Values given in US$2017/vehkm need to be transferred to US$2017/veh with the help of annual mileage + # Values given in US$/vehkm need to be transferred to US$/veh with the help of annual mileage # and annuity factor annualMileage <- magpie2dt(calcOutput(type = "EdgeTransportSAinputs", subtype = "annualMileage", warnNA = FALSE, aggregate = FALSE))[, c("unit", "variable") := NULL] @@ -110,14 +110,15 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP discountRate <- 0.1 #discount rate for vehicle purchases lifeTime <- 15 #Number of years over which vehicle capital payments are amortized annuityFactor <- (discountRate * (1 + discountRate) ^ lifeTime) / ((1 + discountRate) ^ lifeTime - 1) - # Divide by Annual Mileage to get [unit = US$2017/veh/yr] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + # Divide by Annual Mileage to get [unit = US$/veh yr] dt <- merge.data.table(dt, annualMileage, all.x = TRUE) dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value * annualMileage] - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := "US$2017/veh/yr"] + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh yr")] # Divide by annuity factor to get CAPEX per veh dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value / annuityFactor] dt[, annualMileage := NULL] - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := "US$2017/veh"] + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh")] #4: Missing vehicle types in certain countries completeData <- completeData[univocalName %in% filter$trn_freight_road | @@ -180,7 +181,9 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP missingTrucks <- rbind(missing18t, missing26t, missing40t) #Korea (KOR) is missing all truck types and gets assigned the values of Taiwan (TWN) - missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Capital costs (total)"][, unit := "US$2017/veh"] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Capital costs (total)"] + missingTrucks[, unit := paste0(monUnit, "/veh")] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_freight_road)], missingTrucks) trucksKOR <- dt[region == "TWN" & univocalName %in% filter$trn_freight_road][, region := "KOR"] @@ -264,7 +267,7 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP missingLar[, value := SUV][, SUV := NULL] missing4W <- rbind(missingVan, missingMini, missingMid, missingSub, missingCom, missingLar) - missing4W[, unit := "US$2017/veh"] + missing4W[, unit := paste0(monUnit, "/veh")] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_4W)], missing4W)[, check := NULL] # 5: Lower the prices for LDW 4 Wheelers depending on the GDP to represent a 2nd hand vehicle market diff --git a/R/toolAdjustNonFuelOPEXother.R b/R/toolAdjustNonFuelOPEXother.R index f850696..e83d83a 100644 --- a/R/toolAdjustNonFuelOPEXother.R +++ b/R/toolAdjustNonFuelOPEXother.R @@ -104,7 +104,8 @@ toolAdjustNonFuelOPEXother <- function(dt, ISOcountries, yrs, completeData, filt missingMoped[is.na(value), value := twoW250][, twoW250 := NULL] missing2W <- rbind(missing50, missing250, missingMoped) - missing2W[, unit := "US$2017/vehkm"][, variable := "Operating costs (total non-fuel)"] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + missing2W[, unit := paste0(monUnit, "/vehkm")][, variable := "Operating costs (total non-fuel)"] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_2W)], missing2W) dt[, check := NULL] diff --git a/R/toolAdjustNonFuelOPEXtrackedFleet.R b/R/toolAdjustNonFuelOPEXtrackedFleet.R index 9ad51aa..9bebc89 100644 --- a/R/toolAdjustNonFuelOPEXtrackedFleet.R +++ b/R/toolAdjustNonFuelOPEXtrackedFleet.R @@ -64,17 +64,18 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { dt[univocalName %in% filter$trn_freight_road & technology %in% c("Liquids", "Gases"), value := value * (1 - 0.3)] dt[univocalName %in% filter$trn_freight_road & technology %in% c("BEV", "FCEV"), value := value * (1 - 0.5)] dt[univocalName %in% filter$trn_freight_road, variable := "Operating costs (total non-fuel)"] - #Values given in US$2017/vehkm need to be transferred to US$2017/veh/yr with the help of annual mileage + #Values given in US$/vehkm need to be transferred to US$/veh/yr with the help of annual mileage annualMileage <- magpie2dt(calcOutput(type = "EdgeTransportSAinputs", subtype = "annualMileage", warnNA = FALSE, aggregate = FALSE))[, c("unit", "variable") := NULL] setnames(annualMileage, "value", "annualMileage") #magclass converts "." in vehicle types to "_" (e.g. Truck (0-3_5t)) setkey(annualMileage, region, univocalName, technology, period) - #Divide by Annual Mileage to get [unit = US$2017/veh/yr] + #Divide by Annual Mileage to get [unit = US$/veh/yr] dt <- merge.data.table(dt, annualMileage, all.x = TRUE) dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value * annualMileage] - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := "US$2017/veh/yr"] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh yr")] dt[, annualMileage := NULL] dt <- dt[, .(value = sum(value)), by = c("region", "univocalName", "technology", "variable", "unit", "period")] @@ -128,7 +129,7 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { missingTrucks <- rbind(missing18t, missing26t, missing40t) # Korea (KOR) is missing all truck types and gets assigned the values of Taiwan (TWN) - missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Operating costs (total non-fuel)"][, unit := "US$2017/veh/yr"] + missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Operating costs (total non-fuel)"][, unit := paste0(monUnit, "/veh yr")] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_freight_road)], missingTrucks) trucksKOR <- dt[region == "TWN" & univocalName %in% filter$trn_freight_road][, region := "KOR"] @@ -192,7 +193,7 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { missing4W <- rbind(missingVan, missingMini, missingMid, missingSub, missingCom, missingLar) missing4W[is.na(variable), variable := "Operating costs (total non-fuel)"] - missing4W[is.na(unit), unit := "US$2017/veh/yr"] + missing4W[is.na(unit), unit := paste0(monUnit, "/veh yr")] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_4W)], missing4W) return(dt) diff --git a/R/toolPreparePurchasePriceSubsidies.R b/R/toolPreparePurchasePriceSubsidies.R index a124f66..b46fa80 100644 --- a/R/toolPreparePurchasePriceSubsidies.R +++ b/R/toolPreparePurchasePriceSubsidies.R @@ -23,7 +23,8 @@ toolPreparePurchasePriceSubsidies <- function(x) { setkey(dt, region, subsidiesVehicleType, subsidiesTechnology) dt <- merge.data.table(dt, mappingSubsidies, all.x = TRUE, allow.cartesian = TRUE) - dt[, unit := "US$2017"] + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + dt[, unit := paste0(monUnit, "/veh")] dt <- dt[, c("region", "period", "univocalName", "technology", "variable", "unit", "value")] return(dt) From 4bfb0f22e66465fbbdb2fb5bf0591464d5d63e0b Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Tue, 29 Oct 2024 19:10:16 +0100 Subject: [PATCH 3/4] flex unit shift --- R/calcEdgeTransportSAinputs.R | 6 +++--- R/convertUCD.R | 2 +- R/readTRACCS.R | 2 +- R/readUCD.R | 4 ++-- R/toolAdjustAnnualMileage.R | 3 ++- R/toolAdjustCAPEXother.R | 3 +-- R/toolAdjustCAPEXtrackedFleet.R | 11 +++++------ R/toolAdjustNonFuelOPEXother.R | 3 +-- R/toolAdjustNonFuelOPEXtrackedFleet.R | 11 ++++++----- 9 files changed, 22 insertions(+), 23 deletions(-) diff --git a/R/calcEdgeTransportSAinputs.R b/R/calcEdgeTransportSAinputs.R index ae71676..2dc925c 100644 --- a/R/calcEdgeTransportSAinputs.R +++ b/R/calcEdgeTransportSAinputs.R @@ -8,7 +8,7 @@ #' @importFrom madrat readSource calcOutput #' @importFrom magclass time_interpolate -calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRUE) { # nolint: cyclocomp_linter +calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2", IEAharm = TRUE) { # nolint: cyclocomp_linter temporal <- spatial <- present <- period <- region <- technology <- univocalName <- gdppc <- speed <- altTech <- variable <- value <- @@ -173,7 +173,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU }, "annualMileage" = { - unit <- "vehkm/yr" + unit <- "vehkm/veh yr" description <- "Annual mileage on technology level. Sources: TRACCS, UCD" weight <- calcOutput("GDP", average2020 = FALSE, aggregate = FALSE) |> time_interpolate(highResYears) weight <- weight[, , paste0("gdp_", SSPscen)] @@ -199,7 +199,7 @@ calcEdgeTransportSAinputs <- function(subtype, SSPscen = "SSP2EU", IEAharm = TRU # Add annual mileage of zero for active modes activeModes <- completeDataSet[univocalName %in% c("Cycle", "Walk")] - activeModes[, unit := "vehkm/veh/yr"][, variable := "Annual mileage"][, value := 0][, check := NULL] + activeModes[, unit := "vehkm/veh yr"][, variable := "Annual mileage"][, value := 0][, check := NULL] annualMileage <- rbind(annualMileage, activeModes) annualMileage <- annualMileage[, c("region", "period", "univocalName", "technology", diff --git a/R/convertUCD.R b/R/convertUCD.R index f192b1d..8560433 100644 --- a/R/convertUCD.R +++ b/R/convertUCD.R @@ -43,7 +43,7 @@ convertUCD <- function(x, subtype) { unit_out = mrdrivers::toolGetUnitDollar(), replace_NAs = "with_USA" ) - + monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) magclass::getNames(x) <- gsub("US\\$2005", monUnit, magclass::getNames(x)) diff --git a/R/readTRACCS.R b/R/readTRACCS.R index fc60310..19ce25e 100644 --- a/R/readTRACCS.R +++ b/R/readTRACCS.R @@ -155,7 +155,7 @@ readTRACCS <- function(subtype = c("fuelEnDensity", "roadFuelConsumption", "ener })) mpobj <- data[ , .(country_name, TRACCS_category, TRACCS_vehicle_type, - TRACCS_technology, variable = "Annual mileage", unit = "vehkm/veh/yr", period, value)] %>% + TRACCS_technology, variable = "Annual mileage", unit = "vehkm/veh yr", period, value)] %>% as.magpie(spatial = "country_name", temporal = "period") return(mpobj) }, diff --git a/R/readUCD.R b/R/readUCD.R index 5a75f93..48d833e 100644 --- a/R/readUCD.R +++ b/R/readUCD.R @@ -42,7 +42,7 @@ readUCD <- function(subtype = c( "annualMileage" = { dt <- UCD[variable == "annual travel per vehicle"] dt[, variable := "Annual mileage"] - dt[, unit := "vehkm/veh/yr"] + dt[, unit := "vehkm/veh yr"] }, "nonMotorizedDemand" = { dt <- UCD[variable == "service output"] @@ -68,7 +68,7 @@ readUCD <- function(subtype = c( "Operating costs (tolls)", "Operating costs (total non-fuel)")] dt[unit == "2005$/vkt", unit := "US$2005/vehkm"] - dt[unit == "2005$/veh/yr", unit := "US$2005/veh/yr"] + dt[unit == "2005$/veh/yr", unit := "US$2005/veh yr"] }, "CAPEXandNonFuelOPEX" = { dt <- UCD[variable %in% c("CAPEX and non-fuel OPEX")] diff --git a/R/toolAdjustAnnualMileage.R b/R/toolAdjustAnnualMileage.R index f6a52a5..828906d 100644 --- a/R/toolAdjustAnnualMileage.R +++ b/R/toolAdjustAnnualMileage.R @@ -28,12 +28,13 @@ toolAdjustAnnualMileage <- function(dt, completeData, filter, ariadneAdjustments # Non-motorized modes do not get an annual mileage (no fleet tracking possible for walking/ # not planned for non-motorized cycling) completeData <- completeData[!univocalName %in% c("Cycle", "Walk")] + mileageUnit <- unique(dt$unit) dt <- merge.data.table(completeData, dt, all = TRUE) # For some regions an annual mileage is provided for certain vehicle types, but no demand. # These values need to be deleted dt <- dt[!is.na(check)] # update variable and unit for introduced NAs - dt[, unit := "vehkm/veh/yr"][, variable := "Annual mileage"][, check := NULL] + dt[, unit := mileageUnit][, variable := "Annual mileage"][, check := NULL] # Average first within regions over technologies -> e.g. BEV gets the same value as other technologies # Take min over technologies for BEV diff --git a/R/toolAdjustCAPEXother.R b/R/toolAdjustCAPEXother.R index e507083..213da48 100644 --- a/R/toolAdjustCAPEXother.R +++ b/R/toolAdjustCAPEXother.R @@ -105,8 +105,7 @@ toolAdjustCAPEXother <- function(dt, ISOcountries, yrs, completeData, GDPpcMER, missingMoped[is.na(value), value := twoW250][, twoW250 := NULL] missing2W <- rbind(missing50, missing250, missingMoped) - monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) - missing2W[, unit := paste0(monUnit, "/vehkm")][, variable := "Capital costs (total)"] + missing2W[, unit := unique(dt[!(is.na(value))]$unit)][, variable := "Capital costs (total)"] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_2W)], missing2W) dt[, check := NULL] diff --git a/R/toolAdjustCAPEXtrackedFleet.R b/R/toolAdjustCAPEXtrackedFleet.R index 8dcced3..7a1d3bf 100644 --- a/R/toolAdjustCAPEXtrackedFleet.R +++ b/R/toolAdjustCAPEXtrackedFleet.R @@ -110,15 +110,15 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP discountRate <- 0.1 #discount rate for vehicle purchases lifeTime <- 15 #Number of years over which vehicle capital payments are amortized annuityFactor <- (discountRate * (1 + discountRate) ^ lifeTime) / ((1 + discountRate) ^ lifeTime - 1) - monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) + # Divide by Annual Mileage to get [unit = US$/veh yr] dt <- merge.data.table(dt, annualMileage, all.x = TRUE) dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value * annualMileage] - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh yr")] + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := gsub("vehkm", "veh yr", unit)] # Divide by annuity factor to get CAPEX per veh dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value / annuityFactor] dt[, annualMileage := NULL] - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh")] + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := gsub("veh yr", "veh", unit)] #4: Missing vehicle types in certain countries completeData <- completeData[univocalName %in% filter$trn_freight_road | @@ -181,9 +181,8 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP missingTrucks <- rbind(missing18t, missing26t, missing40t) #Korea (KOR) is missing all truck types and gets assigned the values of Taiwan (TWN) - monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Capital costs (total)"] - missingTrucks[, unit := paste0(monUnit, "/veh")] + missingTrucks[, unit := unique(dt[!(is.na(value))]$unit)] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_freight_road)], missingTrucks) trucksKOR <- dt[region == "TWN" & univocalName %in% filter$trn_freight_road][, region := "KOR"] @@ -267,7 +266,7 @@ toolAdjustCAPEXtrackedFleet <- function(dt, ISOcountries, yrs, completeData, GDP missingLar[, value := SUV][, SUV := NULL] missing4W <- rbind(missingVan, missingMini, missingMid, missingSub, missingCom, missingLar) - missing4W[, unit := paste0(monUnit, "/veh")] + missing4W[, unit := unique(dt[!(is.na(value))]$unit)] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_4W)], missing4W)[, check := NULL] # 5: Lower the prices for LDW 4 Wheelers depending on the GDP to represent a 2nd hand vehicle market diff --git a/R/toolAdjustNonFuelOPEXother.R b/R/toolAdjustNonFuelOPEXother.R index e83d83a..8d76e7a 100644 --- a/R/toolAdjustNonFuelOPEXother.R +++ b/R/toolAdjustNonFuelOPEXother.R @@ -104,8 +104,7 @@ toolAdjustNonFuelOPEXother <- function(dt, ISOcountries, yrs, completeData, filt missingMoped[is.na(value), value := twoW250][, twoW250 := NULL] missing2W <- rbind(missing50, missing250, missingMoped) - monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) - missing2W[, unit := paste0(monUnit, "/vehkm")][, variable := "Operating costs (total non-fuel)"] + missing2W[, unit := unique(dt[!(is.na(value))]$unit)][, variable := "Operating costs (total non-fuel)"] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_2W)], missing2W) dt[, check := NULL] diff --git a/R/toolAdjustNonFuelOPEXtrackedFleet.R b/R/toolAdjustNonFuelOPEXtrackedFleet.R index 9bebc89..76b7bbd 100644 --- a/R/toolAdjustNonFuelOPEXtrackedFleet.R +++ b/R/toolAdjustNonFuelOPEXtrackedFleet.R @@ -71,11 +71,11 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { #magclass converts "." in vehicle types to "_" (e.g. Truck (0-3_5t)) setkey(annualMileage, region, univocalName, technology, period) - #Divide by Annual Mileage to get [unit = US$/veh/yr] + #Divide by Annual Mileage to get [unit = US$/veh yr] dt <- merge.data.table(dt, annualMileage, all.x = TRUE) dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", value := value * annualMileage] - monUnit <- gsub(".*?(\\d{4}).*", "US$\\1", mrdrivers::toolGetUnitDollar()) - dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := paste0(monUnit, "/veh yr")] + + dt[univocalName %in% filter$trn_freight_road | univocalName == "Bus", unit := gsub("vehkm", "veh yr", unit)] dt[, annualMileage := NULL] dt <- dt[, .(value = sum(value)), by = c("region", "univocalName", "technology", "variable", "unit", "period")] @@ -129,7 +129,8 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { missingTrucks <- rbind(missing18t, missing26t, missing40t) # Korea (KOR) is missing all truck types and gets assigned the values of Taiwan (TWN) - missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Operating costs (total non-fuel)"][, unit := paste0(monUnit, "/veh yr")] + missingTrucks <- missingTrucks[!region == "KOR"][, variable := "Operating costs (total non-fuel)"] + missingTrucks[, unit := unique(dt[!(is.na(value))]$unit)] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_freight_road)], missingTrucks) trucksKOR <- dt[region == "TWN" & univocalName %in% filter$trn_freight_road][, region := "KOR"] @@ -193,7 +194,7 @@ toolAdjustNonFuelOPEXtrackedFleet <- function(dt, yrs, completeData, filter) { missing4W <- rbind(missingVan, missingMini, missingMid, missingSub, missingCom, missingLar) missing4W[is.na(variable), variable := "Operating costs (total non-fuel)"] - missing4W[is.na(unit), unit := paste0(monUnit, "/veh yr")] + missing4W[is.na(unit), unit := unique(dt[!(is.na(value))]$unit)] dt <- rbind(dt[!(is.na(value) & univocalName %in% filter$trn_pass_road_LDV_4W)], missing4W) return(dt) From 0dfbaf1263567815026d2b4241c40ea63a36cbeb Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Wed, 30 Oct 2024 10:46:05 +0100 Subject: [PATCH 4/4] buildlib --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- man/calcEdgeTransportSAinputs.Rd | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index ae6e3c8..a58762c 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '1561560' +ValidationKey: '1602080' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index b4961ad..d5bc0c1 100644 --- a/CITATION.cff +++ b/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: 'mrtransport: Input data generation for the EDGE-Transport model' -version: 0.7.8 -date-released: '2024-10-24' +version: 0.8.0 +date-released: '2024-10-30' abstract: The mrtransport package contains data preprocessing for the EDGE-Transport model. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 689a594..50c6703 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: mrtransport Title: Input data generation for the EDGE-Transport model -Version: 0.7.8 +Version: 0.8.0 Authors@R: c( person("Johanna", "Hoppe", , "johanna.hoppe@pik-potsdam.de", role = c("aut", "cre"), comment = c(ORCID = "0009-0004-6753-5090")), @@ -26,4 +26,4 @@ Imports: magrittr, quitte, data.table -Date: 2024-10-24 +Date: 2024-10-30 diff --git a/README.md b/README.md index 47ab584..39cfbd7 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Input data generation for the EDGE-Transport model -R package **mrtransport**, version **0.7.8** +R package **mrtransport**, version **0.8.0** [![CRAN status](https://www.r-pkg.org/badges/version/mrtransport)](https://cran.r-project.org/package=mrtransport) [![R build status](https://github.com/pik-piam/mrtransport/workflows/check/badge.svg)](https://github.com/pik-piam/mrtransport/actions) [![codecov](https://codecov.io/gh/pik-piam/mrtransport/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrtransport) [![r-universe](https://pik-piam.r-universe.dev/badges/mrtransport)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Johanna Hoppe . +Hoppe J, Muessel J, Dirnaichner A (2024). _mrtransport: Input data generation for the EDGE-Transport model_. R package version 0.8.0, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrtransport: Input data generation for the EDGE-Transport model}, author = {Johanna Hoppe and Jarusch Muessel and Alois Dirnaichner}, year = {2024}, - note = {R package version 0.7.8}, + note = {R package version 0.8.0}, url = {https://github.com/pik-piam/mrtransport}, } ``` diff --git a/man/calcEdgeTransportSAinputs.Rd b/man/calcEdgeTransportSAinputs.Rd index d7ccde9..2278665 100644 --- a/man/calcEdgeTransportSAinputs.Rd +++ b/man/calcEdgeTransportSAinputs.Rd @@ -4,7 +4,7 @@ \alias{calcEdgeTransportSAinputs} \title{Provide EDGE-Transport input parameters} \usage{ -calcEdgeTransportSAinputs(subtype, SSPscen = "SSP2EU", IEAharm = TRUE) +calcEdgeTransportSAinputs(subtype, SSPscen = "SSP2", IEAharm = TRUE) } \arguments{ \item{subtype}{one of the parameters required for EDGE-T SA}