From b4091372e95bbef33c5ebff0d5257f6840b50b4a Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Fri, 23 Aug 2024 09:29:51 +0200 Subject: [PATCH 1/4] change bn to billion + delete old reportEDGET --- R/reportEDGETransport.R | 680 ---------------------------------------- R/reportFE.R | 12 +- 2 files changed, 6 insertions(+), 686 deletions(-) delete mode 100644 R/reportEDGETransport.R diff --git a/R/reportEDGETransport.R b/R/reportEDGETransport.R deleted file mode 100644 index 5b86dde4..00000000 --- a/R/reportEDGETransport.R +++ /dev/null @@ -1,680 +0,0 @@ -#' Reporting for the coupled EDGE-T Transport Sector Model (REMIND Module edge_esm) -#' -#' Data is loaded from the EDGE-T subfolder in the output folder. -#' The input files can be (re-) generated calling -#' `Rscript EDGETransport.R --reporting` -#' from the output folder. -#' -#' *Warning* The function modifies the "REMIND_generic_.mif" file by appending the -#' additional reporting variables and replaces the "_withoutPlus" version. -#' -#' Region subsets are obtained from fulldata.gdx -#' -#' @param output_folder path to the output folder, default is current folder. -#' @param remind_root path to the REMIND root directory, defaults to two levels up from output_folder. -#' @param append try to find the REMIND output file in the output folder and append to it. If FALSE, the function returns a quitte object with the reporting variables. -#' @author Alois Dirnaichner Marianna Rottoli -#' -#' @importFrom rmndt approx_dt readMIF writeMIF -#' @importFrom gdxdt readgdx -#' @importFrom data.table fread fwrite rbindlist copy CJ setnames := data.table as.data.table -#' @importFrom dplyr %>% -#' @importFrom quitte as.quitte -#' @importFrom utils capture.output -#' @export - -reportEDGETransport <- function(output_folder=".", - remind_root=NULL, - append=TRUE) { - - if(is.null(remind_root)){ - remind_root <- file.path(output_folder, "../..") - } - gdx <- file.path(output_folder, "fulldata.gdx") - - ## check the regional aggregation - regionSubsetList <- toolRegionSubsets(gdx) - - # ADD EU-27 region aggregation if possible - if("EUR" %in% names(regionSubsetList)){ - regionSubsetList <- c(regionSubsetList,list( - "EU27"=c("ENC","EWN","ECS","ESC","ECE","FRA","DEU","ESW") - )) - } - - sub_folder = "EDGE-T/" - - ## NULL Definitons for codeCheck compliance - RegionCode <- CountryCode <- cfg <- `.` <- sector <- subsector_L3 <- region <- year <- NULL - subsector_L2 <- subsector_L1 <- aggr_mode <- vehicle_type <- det_veh <- aggr_nonmot <- NULL - demand_F <- demand_EJ <- remind_rep <- V25 <- aggr_veh <- technology <- NULL - ttot <- se_share <- fe_demand <- variable <- value <- demand_VKM <- loadFactor <- NULL - all_enty <- ef <- variable_agg <- model <- scenario <- period <- NULL - Region <- Variable <- co2 <- co2val <- elh2 <- fe <- NULL - int <- se <- sec <- sharesec <- te <- tech <- val <- share <- NULL - eff <- sharebio <- sharesyn <- totseliq <- type <- ven <- NULL - unit <- NULL - - load(file.path(output_folder, "config.Rdata")) - - datapath <- function(fname){ - file.path(output_folder, sub_folder, fname) - } - - ## load input data from last EDGE run - demand_km <- readRDS(datapath(fname = "demandF_plot_pkm.RDS"))[ - , demand_F := demand_F * 1e-3] ## million -> billion pkm - load_factor <- readRDS(datapath(fname = "loadFactor.RDS")) - annual_mileage <- readRDS(datapath(fname = "annual_mileage.RDS")) - demand_vkm <- merge(demand_km, load_factor, by=c("year", "region", "vehicle_type")) - demand_vkm[, demand_VKM := demand_F/loadFactor] ## billion vkm - - demand_ej <- readRDS(datapath(fname = "demandF_plot_EJ.RDS")) ## detailed final energy demand, EJ - - ## ES and FE Demand - - reportingESandFE <- function(datatable, mode){ - - datatable[, sector := ifelse(sector %in% c("trn_pass", "trn_aviation_intl"), "Pass", "Freight")] - - ## attribute aggregated mode and vehicle names for plotting purposes, and aggregate - ## Large Categories (as used by REMIND) - datatable[subsector_L2 == "trn_pass_road_LDV", - aggr_mode := "Pass|Road|LDV"] - datatable[subsector_L2 != "trn_pass_road_LDV" & sector == "Pass", - aggr_mode := "Pass|non-LDV"] - - ## A little more detail: Vehicle Aggregates - datatable[grepl("^Truck", vehicle_type), aggr_veh := "Freight|Road"] - datatable["Freight Rail_tmp_vehicletype" == vehicle_type, aggr_veh := "Freight|Rail"] - ## there seem to be no passenger ships in EDGE-T! - datatable[subsector_L3 == "International Ship", aggr_veh := "Freight|International Shipping"] - datatable[subsector_L3 == "Domestic Ship", aggr_veh := "Freight|Navigation"] - - datatable[grepl("Bus", vehicle_type), aggr_veh := "Pass|Road|Bus"] - - - if(mode == "ES") - datatable[grepl("Cycle|Walk", subsector_L3), aggr_nonmot := "Pass|Road|Non-Motorized"] - - ## Rail & Aviation - datatable[grepl("Passenger Rail|HSR", vehicle_type), aggr_veh := "Pass|Rail"] - datatable[subsector_L3 == "Domestic Aviation", aggr_veh := "Pass|Aviation|Domestic"] - datatable[subsector_L3 == "International Aviation", aggr_veh := "Pass|Aviation|International"] - - ## Freight - datatable[grepl("^Truck", vehicle_type), det_veh := sprintf("Freight|Road|%s", vehicle_type)] - - ## High Detail: Ecoinvent-Compatible Output - datatable[grepl("Subcompact", vehicle_type), - det_veh := "Pass|Road|LDV|Small"] - datatable[grepl("Mini", vehicle_type), - det_veh := "Pass|Road|LDV|Mini"] - datatable[vehicle_type == "Compact Car", det_veh := "Pass|Road|LDV|Medium"] - datatable[grepl("Large Car|Midsize Car", vehicle_type), det_veh := "Pass|Road|LDV|Large"] - datatable[grepl("SUV", vehicle_type), - det_veh := "Pass|Road|LDV|SUV"] - datatable[grepl("Van|Multipurpose", vehicle_type), - det_veh := "Pass|Road|LDV|Van"] - - datatable[grepl("Motorcycle|Scooter|Moped", vehicle_type), - det_veh := "Pass|Road|LDV|Two-Wheelers"] - - prepare4MIF <- function(dt, remind_unit, valcol, varcol){ - ## REMIND years, loading from MIF File would take too long - yrs <- c(seq(2005, 2060, 5), seq(2070, 2110, 10), 2130, 2150) - remind_scenario <- cfg$title - - prefix <- switch(mode, - "FE" = "FE|Transport|", - "ES" = "ES|Transport|", - "VKM" = "ES|Transport|VKM|") - - ## we only care for non-NA variables (NA is basically *all others*) - toadd = dt[!is.na(get(varcol)), .(model=cfg$model_name, scenario=remind_scenario, region, - variable=paste0(prefix, get(varcol)), - unit=remind_unit, period=year, - value=get(valcol))] - - toadd <- approx_dt(toadd, yrs, xcol="period", ycol = "value", - idxcols=colnames(toadd)[1:5], - extrapolate=T) - return(toadd) - } - - if(mode == "ES"){ - report <- rbindlist(list( - prepare4MIF( - datatable[sector == "Pass", sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_mode")], - "bn pkm/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[sector == "Freight" & !is.na(aggr_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_veh")], - "bn tkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[sector == "Pass" & !is.na(aggr_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_veh")], - "bn pkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[!is.na(aggr_nonmot), sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_nonmot")], - "bn pkm/yr", "V1", "aggr_nonmot"), - prepare4MIF( - datatable[!is.na(det_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "det_veh")], "bn pkm/yr", "V1", "det_veh"))) - }else if(mode == "VKM"){ - report <- rbindlist(list( - prepare4MIF( - datatable[sector == "Pass", sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_mode")], - "bn vkm/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[sector == "Freight" & !is.na(aggr_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_veh")], - "bn vkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[sector == "Pass" & !is.na(aggr_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_veh")], - "bn vkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[!is.na(det_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "det_veh")], "bn vkm/yr", "V1", "det_veh"))) - }else{ - report <- rbindlist(list( - prepare4MIF( - datatable[!is.na(aggr_mode), sum(demand_EJ, na.rm=T), - by = c("region", "year", "aggr_mode")], - "EJ/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[!is.na(aggr_veh), sum(demand_EJ, na.rm=T), - by = c("region", "year", "aggr_veh")], - "EJ/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[!is.na(det_veh), sum(demand_EJ, na.rm=T), - by = c("region", "year", "det_veh")], - "EJ/yr", "V1", "det_veh"))) - } - - ## with energy carrier - - ## remove cycling and walking placeholder techs for ESs - techmap <- data.table(technology=unique(datatable$technology), - key="technology")[!c("Cycle_tmp_technology", "Walk_tmp_technology")] - - if(mode == "ES"){ - ## for energy services, it is better to refer to the actual technologies - ## and not the fuel types (-> LCA) - techmap[, remind_rep := technology] - techmap["NG", remind_rep := "Gases"] - - datatable <- datatable[techmap, on="technology"] - - report_tech <- rbindlist(list( - prepare4MIF( - datatable[sector == "Pass", sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_mode", "remind_rep") - ][, aggr_mode := paste0(aggr_mode, "|", remind_rep)], - "bn pkm/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[sector == "Freight" & !is.na(aggr_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, aggr_veh := paste0(aggr_veh, "|", remind_rep)], - "bn tkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[sector == "Pass" & !is.na(aggr_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, aggr_veh := paste0(aggr_veh, "|", remind_rep)], - "bn pkm/yr", "V1", "aggr_veh"), - prepare4MIF(datatable[!is.na(det_veh), sum(demand_F, na.rm=T), - by = c("region", "year", "det_veh", "remind_rep") - ][, det_veh := paste0(det_veh, "|", remind_rep)], - "bn pkm/yr", "V1", "det_veh"))) - }else if(mode == "VKM"){ - ## for energy services, it is better to refer to the actual technologies - ## and not the fuel types (-> LCA) - techmap[, remind_rep := technology] - techmap["LA-BEV", remind_rep := "BEV"] - techmap["NG", remind_rep := "Gases"] - - datatable <- datatable[techmap, on="technology"] - - report_tech <- rbindlist(list( - prepare4MIF( - datatable[sector == "Pass", sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_mode", "remind_rep") - ][, aggr_mode := paste0(aggr_mode, "|", remind_rep)], - "bn vkm/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[sector == "Freight" & !is.na(aggr_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, aggr_veh := paste0(aggr_veh, "|", remind_rep)], - "bn vkm/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[sector == "Pass" & !is.na(aggr_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, aggr_veh := paste0(aggr_veh, "|", remind_rep)], - "bn vkm/yr", "V1", "aggr_veh"), - prepare4MIF(datatable[!is.na(det_veh), sum(demand_VKM, na.rm=T), - by = c("region", "year", "det_veh", "remind_rep") - ][, det_veh := paste0(det_veh, "|", remind_rep)], - "bn vkm/yr", "V1", "det_veh"))) - }else{ - techmap["BEV", remind_rep := "Electricity"] - techmap["Electric", remind_rep := "Electricity"] - techmap["FCEV", remind_rep := "Hydrogen"] - techmap["Hydrogen", remind_rep := "Hydrogen"] - techmap["Liquids", remind_rep := "Liquids"] - techmap["NG", remind_rep := "Gases"] - - datatable <- datatable[techmap, on="technology"] - - report_tech <- rbindlist(list( - prepare4MIF( - datatable[!is.na(aggr_mode), sum(demand_EJ, na.rm=T), - by = c("region", "year", "aggr_mode", "remind_rep") - ][, aggr_mode := paste0(aggr_mode, "|", remind_rep)], - "EJ/yr", "V1", "aggr_mode"), - prepare4MIF( - datatable[!is.na(aggr_veh), sum(demand_EJ, na.rm=T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, aggr_veh := paste0(aggr_veh, "|", remind_rep)], - "EJ/yr", "V1", "aggr_veh"), - prepare4MIF( - datatable[!is.na(det_veh), sum(demand_EJ, na.rm=T), - by = c("region", "year", "det_veh", "remind_rep") - ][, det_veh := paste0(det_veh, "|", remind_rep)], - "EJ/yr", "V1", "det_veh"))) - - df <- rbind( - datatable[!is.na(aggr_mode), sum(demand_EJ, na.rm = T), - by = c("region", "year", "aggr_mode", "remind_rep") - ][, variable := paste0(aggr_mode, "|", remind_rep)][,c("region", "year", "variable", "V1")], - datatable[!is.na(aggr_veh), sum(demand_EJ, na.rm = T), - by = c("region", "year", "aggr_veh", "remind_rep") - ][, variable := paste0(aggr_veh, "|", remind_rep)][,c("region", "year", "variable", "V1")] - ) - - # splits Liquids variables into Biomass, Fossil and Hydrogen according to FE demand shares - .split_liquids <- function(df) { - demFeSector <- readGDX(gdx, "vm_demFeSector", field = "l", restore_zeros = F) - - # biomass share in biomass+hydrogen liquids in total transport sector - bioShareTrans <- dimSums(mselect(demFeSector, all_enty = "seliqbio", emi_sectors = "trans"), dim = 3, na.rm = T) / - dimSums(mselect(demFeSector, all_enty = c("seliqbio", "seliqsyn"), emi_sectors = "trans"), dim = 3, na.rm = T) - - # hydrogen share in biomass+hydrogen liquids in total transport sector - synShareTrans <- dimSums(mselect(demFeSector, all_enty = "seliqsyn", emi_sectors = "trans"), dim = 3, na.rm = T) / - dimSums(mselect(demFeSector, all_enty = c("seliqbio", "seliqsyn"), emi_sectors = "trans"), dim = 3, na.rm = T) - - # calculate LDV share ---- - - # liquids for LDVs - demFeSectorLdv <- mselect(demFeSector, - all_enty = c("seliqfos", "seliqbio", "seliqsyn"), - all_enty1 = "fepet", emi_sectors = "trans" - ) - - feShareLdvLiqFos <- dimSums(demFeSectorLdv[, , "seliqfos.fepet"], dim = 3, na.rm = T) / dimSums(demFeSectorLdv, dim = 3, na.rm = T) - - # for non-fossil liquids we apply the share of the transport sector to the subsector - feShareLdvLiqBio <- dimSums(mselect(demFeSectorLdv, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * bioShareTrans / dimSums(demFeSectorLdv, dim = 3, na.rm = T) - feShareLdvLiqSyn <- dimSums(mselect(demFeSectorLdv, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * synShareTrans / dimSums(demFeSectorLdv, dim = 3, na.rm = T) - - # calculate share for Non-LDV (Trucks, Domestic Aviation etc.) ---- - - # liquids for Non-LDVs - demFeSectorNonLdv <- mselect(demFeSector, - all_enty = c("seliqfos", "seliqbio", "seliqsyn"), - all_enty1 = "fedie", emi_sectors = "trans", all_emiMkt = "ES" - ) - - feShareNonLdvLiqFos <- demFeSectorNonLdv[, , "seliqfos.fedie"] / dimSums(demFeSectorNonLdv, dim = 3, na.rm = T) - feShareNonLdvLiqBio <- dimSums(mselect(demFeSectorNonLdv, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * bioShareTrans / dimSums(demFeSectorNonLdv, dim = 3, na.rm = T) - feShareNonLdvLiqSyn <- dimSums(mselect(demFeSectorNonLdv, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * synShareTrans / dimSums(demFeSectorNonLdv, dim = 3, na.rm = T) - - # calculate share for Bunkers ---- - - # liquids for bunkers - demFeSectorBunkers <- mselect(demFeSector, - all_enty = c("seliqfos", "seliqbio", "seliqsyn"), - all_enty1 = "fedie", emi_sectors = "trans", all_emiMkt = "other" - ) - - feShareBunkersLiqFos <- demFeSectorBunkers[, , "seliqfos.fedie"] / dimSums(demFeSectorBunkers, dim = 3, na.rm = T) - feShareBunkersLiqBio <- dimSums(mselect(demFeSectorBunkers, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * bioShareTrans / dimSums(demFeSectorBunkers, dim = 3, na.rm = T) - feShareBunkersLiqSyn <- dimSums(mselect(demFeSectorBunkers, all_enty = c("seliqbio", "seliqsyn")), dim = 3, na.rm = T) * synShareTrans / dimSums(demFeSectorBunkers, dim = 3, na.rm = T) - - m <- as.magpie(df) - y <- intersect(getItems(m, dim = 2), getItems(demFeSector, dim = 2)) - tmp <- mbind( - setNames(m[, y, "Pass|Road|LDV|Liquids"] * feShareLdvLiqFos[, y, ], "Pass|Road|LDV|Liquids|Fossil"), - setNames(m[, y, "Pass|Road|LDV|Liquids"] * feShareLdvLiqBio[, y, ], "Pass|Road|LDV|Liquids|Biomass"), - setNames(m[, y, "Pass|Road|LDV|Liquids"] * feShareLdvLiqSyn[, y, ], "Pass|Road|LDV|Liquids|Hydrogen"), - setNames(m[, y, "Freight|Road|Liquids"] * feShareNonLdvLiqFos[, y, ], "Freight|Road|Liquids|Fossil"), - setNames(m[, y, "Freight|Road|Liquids"] * feShareNonLdvLiqBio[, y, ], "Freight|Road|Liquids|Biomass"), - setNames(m[, y, "Freight|Road|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Freight|Road|Liquids|Hydrogen"), - setNames(m[, y, "Pass|Road|Bus|Liquids"] * feShareNonLdvLiqFos[, y, ], "Pass|Road|Bus|Liquids|Fossil"), - setNames(m[, y, "Pass|Road|Bus|Liquids"] * feShareNonLdvLiqBio[, y, ], "Pass|Road|Bus|Liquids|Biomass"), - setNames(m[, y, "Pass|Road|Bus|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Pass|Road|Bus|Liquids|Hydrogen"), - setNames(m[, y, "Freight|Rail|Liquids"] * feShareNonLdvLiqFos[, y, ], "Freight|Rail|Liquids|Fossil"), - setNames(m[, y, "Freight|Rail|Liquids"] * feShareNonLdvLiqBio[, y, ], "Freight|Rail|Liquids|Biomass"), - setNames(m[, y, "Freight|Rail|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Freight|Rail|Liquids|Hydrogen"), - setNames(m[, y, "Pass|Rail|Liquids"] * feShareNonLdvLiqFos[, y, ], "Pass|Rail|Liquids|Fossil"), - setNames(m[, y, "Pass|Rail|Liquids"] * feShareNonLdvLiqBio[, y, ], "Pass|Rail|Liquids|Biomass"), - setNames(m[, y, "Pass|Rail|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Pass|Rail|Liquids|Hydrogen"), - setNames(m[, y, "Pass|Aviation|Domestic|Liquids"] * feShareNonLdvLiqFos[, y, ], "Pass|Aviation|Domestic|Liquids|Fossil"), - setNames(m[, y, "Pass|Aviation|Domestic|Liquids"] * feShareNonLdvLiqBio[, y, ], "Pass|Aviation|Domestic|Liquids|Biomass"), - setNames(m[, y, "Pass|Aviation|Domestic|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Pass|Aviation|Domestic|Liquids|Hydrogen"), - setNames(m[, y, "Freight|Navigation|Liquids"] * feShareNonLdvLiqFos[, y, ], "Freight|Navigation|Liquids|Fossil"), - setNames(m[, y, "Freight|Navigation|Liquids"] * feShareNonLdvLiqBio[, y, ], "Freight|Navigation|Liquids|Biomass"), - setNames(m[, y, "Freight|Navigation|Liquids"] * feShareNonLdvLiqSyn[, y, ], "Freight|Navigation|Liquids|Hydrogen"), - setNames(m[, y, "Pass|Aviation|International|Liquids"] * feShareBunkersLiqFos[, y, ], "Pass|Aviation|International|Liquids|Fossil"), - setNames(m[, y, "Pass|Aviation|International|Liquids"] * feShareBunkersLiqBio[, y, ], "Pass|Aviation|International|Liquids|Biomass"), - setNames(m[, y, "Pass|Aviation|International|Liquids"] * feShareBunkersLiqSyn[, y, ], "Pass|Aviation|International|Liquids|Hydrogen"), - setNames(m[, y, "Freight|International Shipping|Liquids"] * feShareBunkersLiqFos[, y, ], "Freight|International Shipping|Liquids|Fossil"), - setNames(m[, y, "Freight|International Shipping|Liquids"] * feShareBunkersLiqBio[, y, ], "Freight|International Shipping|Liquids|Biomass"), - setNames(m[, y, "Freight|International Shipping|Liquids"] * feShareBunkersLiqSyn[, y, ], "Freight|International Shipping|Liquids|Hydrogen") - ) - - as.data.frame(tmp, rev = 2) %>% - as.data.table() %>% - prepare4MIF("EJ/yr", ".value", "variable") %>% - return() - } - - report_liquids_split <- .split_liquids(df) - - report_liquids_split_w <- report_liquids_split[,.(value = sum(value), region = "World"), by = .(model, scenario, variable, unit, period)] - report_liquids_split <- rbind(report_liquids_split, report_liquids_split_w) - - } - - ## add World - report_w = report[,.(value = sum(value), region = "World"), by = .(model, scenario, variable, unit, period)] - report = rbind(report, report_w) - - report_tech_w = report_tech[,.(value = sum(value), region = "World"), by = .(model, scenario, variable, unit, period)] - report_tech = rbind(report_tech, report_tech_w) - - if (mode == "FE") { - report_complete <- rbindlist(list(report, report_tech, report_liquids_split)) - } else { - report_complete <- rbindlist(list(report, report_tech)) - } - - - ## in case the aggregation features EU sub-regions, include also the aggregated versions - return(report_complete) - } - - - ## Demand emissions - reportingEmi <- function(repFE, gdx){ - - ## load emission factors for fossil fuels - p_ef_dem <- readgdx(gdx, "p_ef_dem")[all_enty %in% c("fepet", "fedie", "fegas")] ## MtCO2/EJ - p_ef_dem[all_enty == "fegas", all_enty := "fegat"] - setnames(p_ef_dem, old = c("value", "all_regi"), new = c("ef", "region")) - ## attribute explicitly fuel used to the FE values - emidem = repFE[grepl("Liquids|Gases|Hydrogen|Electricity", variable) & region != "World"] ## EJ - emidem[, all_enty := ifelse(grepl("Liquids", variable), "fedie", NA)] - emidem[, all_enty := ifelse(grepl("LDV.+Liquids", variable), "fepet", all_enty)] - emidem[, all_enty := ifelse(grepl("Gases", variable), "fegat", all_enty)] - emidem[, all_enty := ifelse(grepl("Electricity", variable), "feelt", all_enty)] - emidem[, all_enty := ifelse(grepl("Hydrogen", variable), "feh2t", all_enty)] - ## merge with emission factors - emidem = emidem[p_ef_dem, on = c("all_enty","region")] - ## calculate emissions and attribute variable and unit names - emidem[, value := value*ef][, c("variable", "unit") := list(gsub("FE", "Emi\\|CO2", variable), "Mt CO2/yr")] - - emi = rbind(copy(emidem)[, c("type", "variable") := list("tailpipe", paste0(variable, "|Tailpipe"))], - copy(emidem)[, c("type", "variable") := list("demand", paste0(variable, "|Demand"))]) - - prodFe <- readgdx(gdx, "vm_prodFE")[, ttot := as.numeric(ttot)] - setnames(prodFe, - c("period", "region", "se", "all_enty", "te", "fe_demand")) - prodFe[, se_share := fe_demand/sum(fe_demand), by=c("period", "region", "all_enty")] - prodFe <- prodFe[all_enty %in% c("fedie", "fepet", "fegat") & se %in% c("segafos", "seliqfos")][, c("se", "te", "fe_demand") := NULL] - - emi <- prodFe[emi, on=c("period", "region", "all_enty")] - ## in case no fossil fuels are used (e.g. 100% biodiesel), the value in se_share results NA. set the NA value to 0 - emi[is.na(se_share), se_share := 0] - emi <- emi[all_enty %in% c("fedie", "fepet", "fegat") & type == "demand", value := value*se_share] - - emi[, c("se_share", "type", "ef", "all_enty") := NULL] - - ## aggregate removing the fuel dependency - emi[, variable_agg := gsub("\\|Liquids|\\|Electricity|\\|Hydrogen|\\|Gases", "", variable)] - emi = emi[, .(value = sum(value)), by = c("model", "scenario", "region", "unit", "period", "variable_agg")] - setnames(emi, old = "variable_agg", new = "variable") - emi = emi[, .(model, scenario, region, variable, unit, period, value)] - - ## add World - emi_w = emi[,.(value = sum(value), region = "World"), by = .(model, scenario, variable, unit, period)] - emi = rbind(emi, emi_w) - - return(emi) - } - - reportingVehNum <- function(demand_vkm, annual_mileage){ - venum <- copy(demand_vkm) - ## merge annual mileage - anmil <- copy(annual_mileage) - anmil[grepl("Subcompact", vehicle_type), - variable := "Pass|Road|LDV|Small"] - anmil[grepl("Mini", vehicle_type), - variable := "Pass|Road|LDV|Mini"] - anmil[vehicle_type == "Compact Car", variable := "Pass|Road|LDV|Medium"] - anmil[grepl("Large Car|Midsize Car", vehicle_type), variable := "Pass|Road|LDV|Large"] - anmil[grepl("SUV", vehicle_type), - variable := "Pass|Road|LDV|SUV"] - anmil[grepl("Van|Multipurpose", vehicle_type), - variable := "Pass|Road|LDV|Van"] - anmil[grepl("Motorcycle|Scooter|Moped", vehicle_type), - variable := "Pass|Road|LDV|Two-Wheelers"] - anmil[grepl("^Truck", vehicle_type), - variable := sprintf("Freight|Road|%s", vehicle_type)] - anmil[grepl("Bus", vehicle_type), - variable := "Pass|Road|Bus"] - - anmil <- anmil[,.(region, period = year, variable, annual_mileage)] - - anmil <- approx_dt(anmil, unique(demand_vkm$period), xcol = "period", ycol = "annual_mileage", idxcols = c("region", "variable"), extrapolate = T) - anmil<- unique(anmil[,c("period", "region", "variable", "annual_mileage")]) - anmil <- anmil[, variable := paste0("ES|Transport|VKM|", variable)] - venum <- merge(demand_vkm, anmil, by = c("variable", "region", "period")) - venum[, ven := value/annual_mileage] # billion vehicle-km -> thousand vehicles - - venum <- venum[!is.na(ven)] - venum[, variable := gsub("|VKM", "|VNUM", variable, fixed=TRUE)][, c("value", "annual_mileage") := NULL] - venum[, unit := "tsd veh"] - setnames(venum, "ven", "value") - venum = venum[,.(model, scenario, region, variable, unit, period, value)] - return(venum) - } - - reportStockAndSales <- function(annual_mileage){ - vintages_file <- file.path(output_folder, "vintcomp.csv") - if(!file.exists(vintages_file)){ - print("EDGE-T Reporting: No vintages file found.") - return(NULL) - } - - year_c <- construction_year <- Stock <- Sales <- vintage_demand_vkm <- fct <- category <- NULL - vintgs <- fread(vintages_file) - - ## backward compat. fix - fct <- 1. - if("variable" %in% colnames(vintgs)){ - fct <- 1e-6 - setnames(vintgs, "variable", "construction_year") - } - - vintgs[, year_c := as.numeric(gsub("C_", "", construction_year))] - - ## stock is the full stock up to the end of the current year - ## sales are the sales of the current year - - setnames(vintgs, "full_demand_vkm", "Stock") - vintgs[, Stock := Stock * fct] - vintgs[, Sales := Stock - sum(vintage_demand_vkm), by=.(year, region, vehicle_type, technology)] - vintgs[, c("construction_year", "vintage_demand_vkm", "year_c") := NULL] - vintgs <- unique(vintgs) - - vintgs <- data.table::melt(vintgs, measure.vars = c("Stock", "Sales"), variable.name = "category") - ## vkm -> v-num - vintgs = merge(vintgs, annual_mileage, by = c("year", "region", "vehicle_type")) - vintgs[, value := value / annual_mileage] - vintgs[, variable := ifelse( - vehicle_type == "Bus_tmp_vehicletype", - sprintf("%s|Transport|Bus|%s", category, technology), - sprintf("%s|Transport|LDV|%s|%s", category, vehicle_type, technology))] - - ## totals - vintgs <- rbindlist(list( - vintgs, - vintgs[, .(value=sum(value), variable=gsub("(.+)\\|.+$", "\\1", variable)), - by=c("category", "year", "region", "vehicle_type")], - vintgs[grepl("|LDV|", variable, fixed=TRUE), - .(value=sum(value), variable=sprintf("%s|Transport|LDV", category)), - by=c("category", "year", "region")]), fill=TRUE) - - vintgs[, c("vehicle_type", "technology", "annual_mileage", "category") := NULL] - vintgs <- unique(vintgs[!is.na(value)]) - - setnames(vintgs, "year", "period") - - vintgs = approx_dt(vintgs, c(2005, 2010, unique(vintgs$period), 2110, 2130, 2150), - xcol = "period", ycol = "value", idxcols = c("region", "variable"), extrapolate = T) - vintgs[period <= 2010|period > 2100, value := 0] - - ## remove the variable (e.g. vehicle_types) that are not present for this specific region - vintgs[, `:=`(model=cfg$model_name, scenario=cfg$title, unit="Million vehicles")] - - return(vintgs) - - } - - repFE <- reportingESandFE( - demand_ej, - mode ="FE") - - repVKM <- reportingESandFE( - datatable=demand_vkm, - mode="VKM") - - toMIF <- rbindlist(list( - repFE, - repVKM, - reportingESandFE( - datatable=demand_km, - mode="ES"), - reportingVehNum(repVKM, - annual_mileage), - reportingEmi(repFE = repFE, - gdx = gdx) - )) - - - ## add Road Totals - toMIF <- rbindlist(list( - toMIF, - toMIF[grep("ES\\|Transport\\|Pass\\|Road\\|[A-Za-z-]+$", variable), - .(variable="ES|Transport|Pass|Road", - unit="bn pkm/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|Pass\\|Road\\|[A-Za-z-]+\\|Tailpipe$", variable), - .(variable="Emi|CO2|Transport|Pass|Road|Tailpipe", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|Pass\\|Road\\|[A-Za-z-]+\\|Demand$", variable), - .(variable="Emi|CO2|Transport|Pass|Road|Demand", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("ES\\|Transport\\|VKM\\|Pass\\|Road\\|[A-Za-z-]+$", variable), - .(variable="ES|Transport|VKM|Pass|Road", - unit="bn vkm/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("FE\\|Transport\\|Pass\\|Road\\|[A-Za-z-]+$", variable), - .(variable="FE|Transport|Pass|Road", - unit="EJ/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")]), use.names = TRUE) - - ## VKM totals, Road and Rail - toMIF <- rbindlist(list( - toMIF, - toMIF[grep("ES\\|Transport\\|VKM\\|(Pass|Freight)\\|Road$", variable), - .(variable="ES|Transport|VKM|Road", - unit="bn vkm/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("ES\\|Transport\\|VKM\\|(Pass|Freight)\\|Rail$", variable), - .(variable="ES|Transport|VKM|Rail", - unit="bn vkm/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")] - ), use.names = TRUE) - - toMIF <- rbindlist(list( - toMIF, - toMIF[grep("FE\\|Transport\\|(Pass|Freight)\\|Road$", variable), - .(variable="FE|Transport|Road", - unit="EJ/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|(Pass|Freight)\\|Road\\|Tailpipe$", variable), - .(variable="Emi|CO2|Transport|Road|Tailpipe", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|(Pass|Freight)\\|Rail\\|Tailpipe$", variable), - .(variable="Emi|CO2|Transport|Rail|Tailpipe", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|(Pass|Freight)\\|Road\\|Demand$", variable), - .(variable="Emi|CO2|Transport|Road|Demand", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("Emi\\|CO2\\|Transport\\|(Pass|Freight)\\|Rail\\|Demand$", variable), - .(variable="Emi|CO2|Transport|Rail|Demand", - unit="Mt CO2/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")], - toMIF[grep("FE\\|Transport\\|(Pass|Freight)\\|Rail$", variable), - .(variable="FE|Transport|Rail", - unit="EJ/yr", value=sum(value)), - by=c("model", "scenario", "region", "period")]), use.names = TRUE) - - toMIF <- rbindlist(list(toMIF, reportStockAndSales(annual_mileage)), use.names=TRUE) - - - if (!is.null(regionSubsetList)){ - toMIF <- rbindlist(list( - toMIF, - toMIF[region %in% regionSubsetList[["EUR"]],.(value = sum(value), region = "EUR"), by = .(model, scenario, variable, unit, period)], - toMIF[region %in% regionSubsetList[["NEU"]],.(value = sum(value), region = "NEU"), by = .(model, scenario, variable, unit, period)], - toMIF[region %in% regionSubsetList[["EU27"]],.(value = sum(value), region = "EU27"), by = .(model, scenario, variable, unit, period)] - ), use.names=TRUE) - } - - - ## Make sure there are no duplicates! - idx <- anyDuplicated(toMIF, by = c("region", "variable", "period")) - if(idx){ - warning(paste0("Duplicates found in EDGE-T reporting output:", - capture.output(toMIF[idx]), collapse="\n")) - } - - toMIF <- data.table::dcast(toMIF, ... ~ period, value.var="value") - setnames(toMIF, colnames(toMIF)[1:5], c("Model", "Scenario", "Region", "Variable", "Unit")) - - if(append){ - name_mif <- list.files(output_folder, pattern = "REMIND_generic", full.names = F) %>% - .[!grepl("withoutPlu|adjustedPolicy", .)] - stopifnot(!is.na(name_mif) && length(name_mif) == 1) - - name_mif <- file.path(output_folder, name_mif) - - - writeMIF(toMIF, name_mif, append=T) - deletePlus(name_mif, writemif=T) - }else{ - return(as.quitte(toMIF)) - } -} diff --git a/R/reportFE.R b/R/reportFE.R index bd125920..db7d54e5 100644 --- a/R/reportFE.R +++ b/R/reportFE.R @@ -1036,17 +1036,17 @@ reportFE <- function(gdx, regionSubsetList = NULL, setNames(dimSums(vm_demFeForEs_trnsp[,,"_frgt_",pmatch=TRUE],dim=3,na.rm=T),"FE|Transport|Freight (EJ/yr)"), setNames(dimSums(vm_demFeForEs_trnsp[,,"_pass_",pmatch=TRUE],dim=3,na.rm=T),"FE|Transport|Pass (EJ/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_frgt_",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # remove EJ conversion factor, conv. trillion to billion tkm - "ES|Transport|Freight (bn tkm/yr)"), + "ES|Transport|Freight (billion tkm/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_pass_",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # trillion to billion pkm - "ES|Transport|Pass (bn pkm/yr)"), + "ES|Transport|Pass (billion pkm/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_frgt_sm",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # trillion to billion tkm - "ES|Transport|Freight|Short-Medium distance (bn tkm/yr)"), + "ES|Transport|Freight|Short-Medium distance (billion tkm/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_pass_sm",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # trillion to billion pkm - "ES|Transport|Pass|Short-Medium distance (bn pkm/yr)"), + "ES|Transport|Pass|Short-Medium distance (billion pkm/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_frgt_lo",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # trillion to billion tkm - "ES|Transport|Freight|Long distance (bn tkm/yr)"), + "ES|Transport|Freight|Long distance (billion tkm/yr)"), setNames(dimSums(vm_cesIO[,,"entrp_pass_lo",pmatch=TRUE],dim=3,na.rm=T)/TWa_2_EJ * 1e3, # trillion to billion pkm - "ES|Transport|Pass|Long distance (bn pkm/yr)")) + "ES|Transport|Pass|Long distance (billion pkm/yr)")) # calculate total diesel and petrol liquids across all modes, needed in reportPrices From 04fffcbe0b81ec154d27a6729c57cf7d69b39c42 Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Fri, 23 Aug 2024 15:52:59 +0200 Subject: [PATCH 2/4] buildlib --- .buildlibrary | 1 + NAMESPACE | 12 ------------ man/reportEDGETransport.Rd | 30 ------------------------------ 3 files changed, 1 insertion(+), 42 deletions(-) delete mode 100644 man/reportEDGETransport.Rd diff --git a/.buildlibrary b/.buildlibrary index 6a007fd3..a895f7f0 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -11,6 +11,7 @@ AcceptedNotes: - Imports includes .* non-default packages. - unable to verify current time - checking installed package size +- no visible global function definition for ':=' AutocreateReadme: yes allowLinterWarnings: yes enforceVersionUpdate: yes diff --git a/NAMESPACE b/NAMESPACE index 0f24ee57..ce6cb72b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -55,7 +55,6 @@ export(reportClimate) export(reportCosts) export(reportCrossVariables) export(reportDIETER) -export(reportEDGETransport) export(reportEmi) export(reportEmiAirPol) export(reportEmiForClimateAssessment) @@ -83,17 +82,10 @@ import(magclass) importFrom(abind,abind) importFrom(assertr,assert) importFrom(assertr,not_na) -importFrom(data.table,":=") -importFrom(data.table,CJ) -importFrom(data.table,as.data.table) -importFrom(data.table,copy) -importFrom(data.table,data.table) importFrom(data.table,fread) importFrom(data.table,frollmean) importFrom(data.table,fwrite) -importFrom(data.table,rbindlist) importFrom(data.table,setDT) -importFrom(data.table,setnames) importFrom(digest,digest) importFrom(dplyr,"%>%") importFrom(dplyr,across) @@ -124,7 +116,6 @@ importFrom(dplyr,tibble) importFrom(dplyr,tribble) importFrom(dplyr,ungroup) importFrom(gdx,readGDX) -importFrom(gdxdt,readgdx) importFrom(gdxrrw,gdxInfo) importFrom(ggplot2,aes) importFrom(ggplot2,aes_) @@ -242,9 +233,6 @@ importFrom(rlang,is_empty) importFrom(rlang,sym) importFrom(rlang,syms) importFrom(rmarkdown,render) -importFrom(rmndt,approx_dt) -importFrom(rmndt,readMIF) -importFrom(rmndt,writeMIF) importFrom(tibble,as_tibble) importFrom(tibble,tibble) importFrom(tibble,tribble) diff --git a/man/reportEDGETransport.Rd b/man/reportEDGETransport.Rd deleted file mode 100644 index 0ae81c90..00000000 --- a/man/reportEDGETransport.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reportEDGETransport.R -\name{reportEDGETransport} -\alias{reportEDGETransport} -\title{Reporting for the coupled EDGE-T Transport Sector Model (REMIND Module edge_esm)} -\usage{ -reportEDGETransport(output_folder = ".", remind_root = NULL, append = TRUE) -} -\arguments{ -\item{output_folder}{path to the output folder, default is current folder.} - -\item{remind_root}{path to the REMIND root directory, defaults to two levels up from output_folder.} - -\item{append}{try to find the REMIND output file in the output folder and append to it. If FALSE, the function returns a quitte object with the reporting variables.} -} -\description{ -Data is loaded from the EDGE-T subfolder in the output folder. -The input files can be (re-) generated calling -`Rscript EDGETransport.R --reporting` -from the output folder. -} -\details{ -*Warning* The function modifies the "REMIND_generic_.mif" file by appending the -additional reporting variables and replaces the "_withoutPlus" version. - -Region subsets are obtained from fulldata.gdx -} -\author{ -Alois Dirnaichner Marianna Rottoli -} From 2d4c9933a96d3804aa02da6b96dab38a17bbd2f3 Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Fri, 23 Aug 2024 18:41:17 +0200 Subject: [PATCH 3/4] buildlib --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 7 ++----- README.md | 6 +++--- 4 files changed, 7 insertions(+), 10 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 1cf63dba..d27bc446 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '229736538' +ValidationKey: '229756496' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/CITATION.cff b/CITATION.cff index 5e6ab74d..1a1062ec 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'remind2: The REMIND R package (2nd generation)' -version: 1.151.1 +version: 1.151.2 date-released: '2024-08-23' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: diff --git a/DESCRIPTION b/DESCRIPTION index a622f78b..42a1c14a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) -Version: 1.151.1 +Version: 1.151.2 Date: 2024-08-23 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), @@ -49,12 +49,9 @@ Imports: data.table, dplyr (>= 1.1.1), gdx (>= 1.53.0), - gdxdt, gdxrrw, ggplot2, gms, - htmltools, - knitr, lucode2 (>= 0.43.0), lusweave, madrat (>= 3.11.3), @@ -70,11 +67,11 @@ Imports: reshape2, rlang, rmarkdown, - rmndt, tibble, tidyr, tidyselect, withr, + knitr, yaml, digest Suggests: diff --git a/README.md b/README.md index bcf6a601..ac2efa2d 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The REMIND R package (2nd generation) -R package **remind2**, version **1.151.1** +R package **remind2**, version **1.151.2** [![CRAN status](https://www.r-pkg.org/badges/version/remind2)](https://cran.r-project.org/package=remind2) [![R build status](https://github.com/pik-piam/remind2/workflows/check/badge.svg)](https://github.com/pik-piam/remind2/actions) [![codecov](https://codecov.io/gh/pik-piam/remind2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/remind2) [![r-universe](https://pik-piam.r-universe.dev/badges/remind2)](https://pik-piam.r-universe.dev/builds) @@ -49,7 +49,7 @@ In case of questions / problems please contact Renato Rodrigues . +Rodrigues R, Baumstark L, Benke F, Dietrich J, Dirnaichner A, Duerrwaechter J, Führlich P, Giannousakis A, Hasse R, Hilaire J, Klein D, Koch J, Kowalczyk K, Levesque A, Malik A, Merfort A, Merfort L, Morena-Leiva S, Pehl M, Pietzcker R, Rauner S, Richters O, Rottoli M, Schötz C, Schreyer F, Siala K, Sörgel B, Spahr M, Strefler J, Verpoort P, Weigmann P, Rüter T (2024). _remind2: The REMIND R package (2nd generation)_. R package version 1.151.2, . A BibTeX entry for LaTeX users is @@ -58,7 +58,7 @@ A BibTeX entry for LaTeX users is title = {remind2: The REMIND R package (2nd generation)}, author = {Renato Rodrigues and Lavinia Baumstark and Falk Benke and Jan Philipp Dietrich and Alois Dirnaichner and Jakob Duerrwaechter and Pascal Führlich and Anastasis Giannousakis and Robin Hasse and Jérome Hilaire and David Klein and Johannes Koch and Katarzyna Kowalczyk and Antoine Levesque and Aman Malik and Anne Merfort and Leon Merfort and Simón Morena-Leiva and Michaja Pehl and Robert Pietzcker and Sebastian Rauner and Oliver Richters and Marianna Rottoli and Christof Schötz and Felix Schreyer and Kais Siala and Björn Sörgel and Mike Spahr and Jessica Strefler and Philipp Verpoort and Pascal Weigmann and Tonn Rüter}, year = {2024}, - note = {R package version 1.151.1}, + note = {R package version 1.151.2}, url = {https://github.com/pik-piam/remind2}, } ``` From 2a38b0f2d6782b27ed8499eafa36bad682414f30 Mon Sep 17 00:00:00 2001 From: johannah-pik <89136160+johannah-pik@users.noreply.github.com> Date: Mon, 26 Aug 2024 12:26:28 +0200 Subject: [PATCH 4/4] bugfix --- .buildlibrary | 3 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- NAMESPACE | 1 + R/calc_CES_marginals.R | 145 +++++++++++++++++++------------------- R/plotNashConvergence.R | 1 + R/reportCrossVariables.R | 3 +- man/calc_CES_marginals.Rd | 4 +- 8 files changed, 82 insertions(+), 79 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index d27bc446..da739709 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '229756496' +ValidationKey: '229791032' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' @@ -11,7 +11,6 @@ AcceptedNotes: - Imports includes .* non-default packages. - unable to verify current time - checking installed package size -- no visible global function definition for ':=' AutocreateReadme: yes allowLinterWarnings: yes enforceVersionUpdate: yes diff --git a/CITATION.cff b/CITATION.cff index 1a1062ec..e27934fe 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -3,7 +3,7 @@ message: If you use this software, please cite it using the metadata from this f type: software title: 'remind2: The REMIND R package (2nd generation)' version: 1.151.2 -date-released: '2024-08-23' +date-released: '2024-08-26' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 42a1c14a..9d13d232 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) Version: 1.151.2 -Date: 2024-08-23 +Date: 2024-08-26 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), person("Lavinia", "Baumstark", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index ce6cb72b..93b9337c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -82,6 +82,7 @@ import(magclass) importFrom(abind,abind) importFrom(assertr,assert) importFrom(assertr,not_na) +importFrom(data.table,":=") importFrom(data.table,fread) importFrom(data.table,frollmean) importFrom(data.table,fwrite) diff --git a/R/calc_CES_marginals.R b/R/calc_CES_marginals.R index c2ccc234..67d43889 100644 --- a/R/calc_CES_marginals.R +++ b/R/calc_CES_marginals.R @@ -1,147 +1,148 @@ #' Calculate CES Marginals -#' +#' #' Calculate marginals on the REMIND CES function and combine them to prices. -#' +#' #' Marginals are calculated analytically -#' \deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o} +#' \deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o} #' {V_o}^{1 - \rho_o} {V_i}^{\rho_o - 1}} #' and prices by recursively applying the chain rule -#' \deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o +#' \deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o #' \quad \forall (i,o) \in CES} #' #' @md #' @param gdxName Vector of paths to `.gdx` files. -#' @param id If several `.gdx` files are read, an id column is appended to the +#' @param id If several `.gdx` files are read, an id column is appended to the #' result; either `file`, with the paths of the originating `.gdx` files, #' or `scenario`, with the content of `c_expname`. #' #' @return A `data frame` with columns `pf` (production factor), `t`, `regi`, #' `marginal`, `price`, and `file` (path to originating `.gdx` file). -#' +#' #' @importFrom quitte read.gdx -#' @importFrom dplyr %>% left_join filter sym select rename mutate pull +#' @importFrom dplyr %>% left_join filter sym select rename mutate pull +#' @importFrom data.table := #' @importFrom tidyr pivot_wider drop_na #' @importFrom gdxrrw gdxInfo #' @importFrom rlang is_empty #' @export calc_CES_marginals <- function(gdxName, id = 'file') { - + if (all(!is.null(id), !id %in% c('file', 'scenario'))) { warning('id must be either "file" or "scenario". Defaulting to "file".') id <- 'file' } - + gdxName <- path.expand(gdxName) - + .calc_CES_marginals <- function(gdxName, id) { # ---- read required items from gdx ---- pm_cesdata <- read.gdx(gdxName, 'pm_cesdata', colNames = c('t', 'regi', 'pf', 'param', 'value')) - + vm_effGr <- read.gdx(gdxName, 'vm_effGr', colNames = c('t', 'regi', 'pf', 'effGr')) - + vm_cesIO <- read.gdx(gdxName, 'vm_cesIO', colNames = c('t', 'regi', 'pf', 'value')) - + cesOut2cesIn <- read.gdx(gdxName, 'cesOut2cesIn', colNames = c('pf.out', 'pf.in')) - + # ---- calculate marginals ---- - marginals <- cesOut2cesIn %>% + marginals <- cesOut2cesIn %>% left_join( - pm_cesdata %>% - filter(!!sym('param') %in% c('xi', 'eff')) %>% - pivot_wider(names_from = 'param') %>% + pm_cesdata %>% + filter(!!sym('param') %in% c('xi', 'eff')) %>% + pivot_wider(names_from = 'param') %>% drop_na(), - + c('pf.in' = 'pf') - ) %>% + ) %>% left_join( - pm_cesdata %>% - filter('rho' == !!sym('param')) %>% + pm_cesdata %>% + filter('rho' == !!sym('param')) %>% select(-'param', 'rho' = 'value'), - + c('t', 'regi', 'pf.out' = 'pf') - ) %>% + ) %>% left_join( vm_effGr, - + c('t', 'regi', 'pf.in' = 'pf') - ) %>% + ) %>% left_join( - vm_cesIO %>% - rename('value.in' = 'value'), - + vm_cesIO %>% + rename('value.in' = 'value'), + c('t', 'regi', 'pf.in' = 'pf') - ) %>% + ) %>% left_join( - vm_cesIO %>% + vm_cesIO %>% rename('value.out' = 'value'), - + c('t', 'regi', 'pf.out' = 'pf') - ) %>% + ) %>% mutate( # ^ !!sym() doesn't work, so use the explicit function call - !!sym('marginal') := !!sym('xi') + !!sym('marginal') := !!sym('xi') * (!!sym('eff') * !!sym('effGr')) ^ (!!sym('rho')) * `^`(!!sym('value.out'), 1 - !!sym('rho')) * `^`(!!sym('value.in'), !!sym('rho') - 1)) - + # ---- calculate prices recursively using the chain rule ---- CES_root <- setdiff(cesOut2cesIn$pf.out, cesOut2cesIn$pf.in) - - prices <- marginals %>% - filter(!!sym('pf.out') %in% CES_root) %>% + + prices <- marginals %>% + filter(!!sym('pf.out') %in% CES_root) %>% select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal') - - CES_root <- cesOut2cesIn %>% - filter(!!sym('pf.out') %in% CES_root) %>% + + CES_root <- cesOut2cesIn %>% + filter(!!sym('pf.out') %in% CES_root) %>% pull('pf.in') - + while (!is_empty(CES_root)) { prices <- bind_rows( prices, - - marginals %>% - filter(!!sym('pf.out') %in% CES_root) %>% - select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal') %>% - left_join(cesOut2cesIn, c('pf' = 'pf.in')) %>% + + marginals %>% + filter(!!sym('pf.out') %in% CES_root) %>% + select('pf' = 'pf.in', 't', 'regi', 'price' = 'marginal') %>% + left_join(cesOut2cesIn, c('pf' = 'pf.in')) %>% left_join( - prices %>% - rename('price.out' = 'price'), - + prices %>% + rename('price.out' = 'price'), + c('t', 'regi', 'pf.out' = 'pf') - ) %>% - mutate(!!sym('price') := !!sym('price') * !!sym('price.out')) %>% + ) %>% + mutate(!!sym('price') := !!sym('price') * !!sym('price.out')) %>% select('pf', 't', 'regi', 'price') ) - - CES_root <- cesOut2cesIn %>% - filter(!!sym('pf.out') %in% CES_root) %>% + + CES_root <- cesOut2cesIn %>% + filter(!!sym('pf.out') %in% CES_root) %>% pull('pf.in') } - + # ---- bind marginals and prices together ---- r <- bind_rows( - marginals %>% - select('pf' = 'pf.in', 't', 'regi', 'value' = 'marginal') %>% + marginals %>% + select('pf' = 'pf.in', 't', 'regi', 'value' = 'marginal') %>% mutate(!!sym('name') := 'marginal'), - - prices %>% - rename('value' = 'price') %>% + + prices %>% + rename('value' = 'price') %>% mutate(!!sym('name') := 'price') - ) %>% + ) %>% pivot_wider() - + if (id) { - r <- r %>% - mutate(!!sym('scenario') := read.gdx(gdxName, 'c_expname', - colNames = 'c_expname') %>% + r <- r %>% + mutate(!!sym('scenario') := read.gdx(gdxName, 'c_expname', + colNames = 'c_expname') %>% pull('c_expname')) } - + return(r) } @@ -158,19 +159,19 @@ calc_CES_marginals <- function(gdxName, id = 'file') { } ) } - + # ---- bind results for all valid input files together ---- r <- bind_rows( lapply(gdxName, function(gdxName) { - .calc_CES_marginals(gdxName, id = all(!is.null(id), id == 'scenario')) %>% + .calc_CES_marginals(gdxName, id = all(!is.null(id), id == 'scenario')) %>% mutate(file = gdxName) }) ) - + if (any(is.null(id), 'file' != id)) { - r <- r %>% + r <- r %>% select(-file) } - + return(r) } diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R index bef133df..57635a3a 100644 --- a/R/plotNashConvergence.R +++ b/R/plotNashConvergence.R @@ -12,6 +12,7 @@ #' @importFrom gdx readGDX #' @importFrom dplyr summarise group_by mutate filter distinct case_when #' @importFrom quitte as.quitte +#' @importFrom data.table := #' @importFrom mip plotstyle #' @importFrom ggplot2 scale_y_continuous scale_x_continuous scale_y_discrete #' scale_fill_manual scale_color_manual coord_cartesian aes_ geom_rect diff --git a/R/reportCrossVariables.R b/R/reportCrossVariables.R index c86f4271..27532489 100644 --- a/R/reportCrossVariables.R +++ b/R/reportCrossVariables.R @@ -23,6 +23,7 @@ #' @importFrom magclass getYears getRegions mbind setNames mselect #' new.magpie setYears mcalc #' @importFrom tibble as_tibble +#' @importFrom data.table := #' @importFrom tidyselect everything #' @importFrom madrat toolAggregate #' @@ -234,7 +235,7 @@ reportCrossVariables <- function(gdx, output = NULL, regionSubsetList = NULL, output[,,"FE|Transport|Liquids (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Liquids (US$2005/GJ)"] + output[,,"FE|Transport|Hydrogen (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Hydrogen (US$2005/GJ)"] + output[,,"FE|Transport|Electricity (EJ/yr)"] * output[,,"Price|Final Energy|Transport|Electricity (US$2005/GJ)"], - "Expenditure|Transport|Fuel (billion $US/yr)")) + "Expenditure|Transport|Fuel (billion US$2005/yr)")) # calculate intensities growth int_gr <- new.magpie(getRegions(tmp),getYears(tmp),c("Intensity Growth|GDP|Final Energy (% pa)","Intensity Growth|GDP|Final Energy to 2005 (% pa)", diff --git a/man/calc_CES_marginals.Rd b/man/calc_CES_marginals.Rd index 1a5c038a..9b872816 100644 --- a/man/calc_CES_marginals.Rd +++ b/man/calc_CES_marginals.Rd @@ -22,9 +22,9 @@ Calculate marginals on the REMIND CES function and combine them to prices. } \details{ Marginals are calculated analytically -\deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o} +\deqn{\frac{\partial V_i}{\partial V_o} = \xi_i (\theta_i \delta_i)^{\rho_o} {V_o}^{1 - \rho_o} {V_i}^{\rho_o - 1}} and prices by recursively applying the chain rule -\deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o +\deqn{\pi_i = \frac{\partial V_i}{\partial V_o} \pi_o \quad \forall (i,o) \in CES} }