diff --git a/.buildlibrary b/.buildlibrary index 35b1f9d5..5ca542ff 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '40942800' +ValidationKey: '40962870' AcceptedWarnings: - Invalid URL: .* - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 75c68db4..93b7f2e7 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: 'mrremind: MadRat REMIND Input Data Package' -version: 0.204.0 +version: 0.204.1 date-released: '2024-12-13' abstract: The mrremind packages contains data preprocessing for the REMIND model. authors: diff --git a/DESCRIPTION b/DESCRIPTION index a7dc8692..20ef8e82 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: mrremind Title: MadRat REMIND Input Data Package -Version: 0.204.0 +Version: 0.204.1 Date: 2024-12-13 Authors@R: c( person("Lavinia", "Baumstark", , "lavinia@pik-potsdam.de", role = c("aut", "cre")), @@ -47,7 +47,6 @@ Imports: edgeTransport (>= 2.9.0), GDPuc (>= 1.3.0), ggplot2, - luscale, madrat (>= 3.7.1), magclass (>= 6.16.1), magrittr, diff --git a/NAMESPACE b/NAMESPACE index 0cbbb5a9..a0adf201 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ export(calcHRE) export(calcIEA_ETP) export(calcIEA_EVOutlook) export(calcIEA_WorldEnergyOutlook) +export(calcIRENA) export(calcOtherFossilInElectricity) export(calcPlasticsEoL) export(calcProjectPipelines) diff --git a/R/calcCapacity.R b/R/calcCapacity.R index c12e05aa..745d0219 100644 --- a/R/calcCapacity.R +++ b/R/calcCapacity.R @@ -6,90 +6,81 @@ #' @importFrom dplyr tribble #' @author Renato Rodrigues, Stephen Bi #' @examples -#' #' \dontrun{ -#' calcOutput("Capacity",subtype="capacityByTech") +#' calcOutput("Capacity", subtype = "capacityByTech") #' } calcCapacity <- function(subtype) { - if ((subtype == "capacityByTech_windoff") | (subtype == "capacityByTech")) { + if ((subtype == "capacityByTech_windoff") || (subtype == "capacityByTech")) { - if (subtype == "capacityByTech_windoff"){ + if (subtype == "capacityByTech_windoff") { description <- "Historical capacity by technology including offshore wind." # Use IRENA data for world renewables capacity. # Year: 2000-2017 # Technologies: "csp", "geohdr", "hydro", "spv", "wind", "windoff" - IRENAcap <- readSource(type="IRENA",subtype="Capacity") # Read IRENA renewables capacity data + IRENAcap <- readSource(type = "IRENA", subtype = "Capacity") # Read IRENA renewables capacity data - IRENAcap <- IRENAcap[,,c("Concentrated solar power", + IRENAcap <- IRENAcap[, , c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Onshore wind energy", "Offshore wind energy" )] # selecting data used on REMIND - mapping <- data.frame(IRENA_techs=c("Concentrated solar power", + mapping <- data.frame(IRENA_techs = c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Onshore wind energy", "Offshore wind energy"), - REMIND_techs=c("csp", "geohdr", "hydro", "spv", "wind", "windoff"), + REMIND_techs = c("csp", "geohdr", "hydro", "spv", "wind", "windoff"), stringsAsFactors = FALSE) - } - else if (subtype == "capacityByTech"){ - description <- "Historical capacity by technology." + } else if (subtype == "capacityByTech") { + description <- "Historical capacity by technology." - # Use IRENA data for world renewables capacity. - # Year: 2000-2017 - # Technologies: "csp", "geohdr", "hydro", "spv", "wind" - IRENAcap <- readSource(type="IRENA",subtype="Capacity") # Read IRENA renewables capacity data - # selecting data used on REMIND - IRENAcap <- IRENAcap[,,c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Wind")] + # Use IRENA data for world renewables capacity. + # Year: 2000-2017 + # Technologies: "csp", "geohdr", "hydro", "spv", "wind" + IRENAcap <- readSource(type = "IRENA", subtype = "Capacity") # Read IRENA renewables capacity data + # selecting data used on REMIND + IRENAcap <- IRENAcap[, , c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Wind")] - mapping <- data.frame(IRENA_techs=c("Concentrated solar power", + mapping <- data.frame(IRENA_techs = c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Wind"), - REMIND_techs=c("csp", "geohdr", "hydro", "spv", "wind"), + REMIND_techs = c("csp", "geohdr", "hydro", "spv", "wind"), stringsAsFactors = FALSE) - } + } # renaming technologies to REMIND naming convention - IRENAcap <- luscale::rename_dimnames(IRENAcap, dim = 3, query = mapping, from = "IRENA_techs", to="REMIND_techs") + IRENAcap <- madrat::toolAggregate(IRENAcap, dim = 3, rel = mapping, from = "IRENA_techs", to = "REMIND_techs") IRENAcap <- IRENAcap * 1E-06 # converting MW to TW - # overwriting Russia and Japan capacities for wind and spv to avoid REMIND convergence problems - # (this is a temporary solution that should be removed once the bounds in REMIND are reworked) - # IRENAcap["JPN",2010,"wind"] <- 0.0012 - # IRENAcap["RUS",2010,"spv"] <- 5e-06 - # IRENAcap["RUS",2015,"wind"] <- 2e-05 - # IRENAcap["RUS",2015,"spv"] <- 2e-05 - # # Use Openmod capacity values updated by the LIMES team for the European countries. # Year: 2015 # Technologies: "tnrs","ngcc","ngt","dot" - Openmodcap <- readSource(type="Openmod") # Read Openmod capacities + Openmodcap <- readSource(type = "Openmod") # Read Openmod capacities # selecting data used on REMIND "BAL" - Openmodcap <- Openmodcap[c("FIN","NOR","SWE","EST","LVA","LTU","DNK","GBR","IRL","NLD","POL", - "DEU","BEL","LUX","CZE","SVK","AUT","CHE","HUN","ROU","SVN","FRA", - "HRV","BGR","ITA","ESP","PRT","GRC"),,c("tnr","ngcc","ngt","oil")] - mapping <- data.frame( Openmod_techs=c("tnr","ngcc","ngt","oil"), - REMIND_techs=c("tnrs","ngcc","ngt","dot"), stringsAsFactors = FALSE) + Openmodcap <- Openmodcap[c("FIN", "NOR", "SWE", "EST", "LVA", "LTU", "DNK", "GBR", "IRL", "NLD", "POL", + "DEU", "BEL", "LUX", "CZE", "SVK", "AUT", "CHE", "HUN", "ROU", "SVN", "FRA", + "HRV", "BGR", "ITA", "ESP", "PRT", "GRC"), , c("tnr", "ngcc", "ngt", "oil")] + mapping <- data.frame(Openmod_techs = c("tnr", "ngcc", "ngt", "oil"), + REMIND_techs = c("tnrs", "ngcc", "ngt", "dot"), stringsAsFactors = FALSE) # renaming technologies to REMIND naming convention - Openmodcap <- luscale::rename_dimnames(Openmodcap, dim = 3, query = mapping, from = "Openmod_techs", to="REMIND_techs") + Openmodcap <- madrat::toolAggregate(Openmodcap, dim = 3, rel = mapping, from = "Openmod_techs", to = "REMIND_techs") Openmodcap <- Openmodcap * 1E-03 # converting GW to TW # Use WEO 2017 data to additional countries: "USA","BRA","RUS","CHN","IND","JPN" # Year: 2015 # Technologies: "tnrs","dot" - WEOcap <- readSource(type="IEA_WEO",subtype="Capacity") # Read IEA WEO capacities - WEOcap <- WEOcap[c("USA","BRA","RUS","CHN","IND","JPN"),2015,c("Nuclear","Oil")] # selecting data used on REMIND - mapping <- data.frame( WEO_techs=c("Nuclear","Oil"), - REMIND_techs=c("tnrs","dot"), stringsAsFactors = FALSE) + WEOcap <- readSource(type = "IEA_WEO", subtype = "Capacity") # Read IEA WEO capacities + WEOcap <- WEOcap[c("USA", "BRA", "RUS", "CHN", "IND", "JPN"), 2015, c("Nuclear", "Oil")] # selecting data used on REMIND + mapping <- data.frame(WEO_techs = c("Nuclear", "Oil"), + REMIND_techs = c("tnrs", "dot"), stringsAsFactors = FALSE) # renaming technologies to REMIND naming convention - WEOcap <- luscale::rename_dimnames(WEOcap, dim = 3, query = mapping, from = "WEO_techs", to="REMIND_techs") + WEOcap <- madrat::toolAggregate(WEOcap, dim = 3, rel = mapping, from = "WEO_techs", to = "REMIND_techs") WEOcap <- WEOcap * 1E-03 # converting GW to TW # ***CG: fix CHA gas power capacities: 97 GW by September 2020 (Oxford Institute for Energy Studies: @@ -121,31 +112,30 @@ calcCapacity <- function(subtype) { "USA", 2025, "spv", 0.265)) # merge IRENA, Openmod and WEO capacities data - output <- new.magpie(cells_and_regions=unique(c(getRegions(IRENAcap),getRegions(Openmodcap), getRegions(WEOcap), getRegions(CHA.2020.GasData), getRegions(USA.2025.PVData) )), - years = unique(c(getYears(IRENAcap),getYears(Openmodcap),getYears(WEOcap), getYears(CHA.2020.GasData), getYears(USA.2025.PVData))), - names = unique(c(getNames(IRENAcap),getNames(Openmodcap),getNames(WEOcap), getNames(CHA.2020.GasData), getNames(USA.2025.PVData))), - fill=0) + output <- new.magpie(cells_and_regions = unique(c(getRegions(IRENAcap), getRegions(Openmodcap), getRegions(WEOcap), getRegions(CHA.2020.GasData), getRegions(USA.2025.PVData))), + years = unique(c(getYears(IRENAcap), getYears(Openmodcap), getYears(WEOcap), getYears(CHA.2020.GasData), getYears(USA.2025.PVData))), + names = unique(c(getNames(IRENAcap), getNames(Openmodcap), getNames(WEOcap), getNames(CHA.2020.GasData), getNames(USA.2025.PVData))), + fill = 0) - output[getRegions(IRENAcap),getYears(IRENAcap),getNames(IRENAcap)] <- IRENAcap[getRegions(IRENAcap), + output[getRegions(IRENAcap), getYears(IRENAcap), getNames(IRENAcap)] <- IRENAcap[getRegions(IRENAcap), getYears(IRENAcap), getNames(IRENAcap)] - output[getRegions(Openmodcap),getYears(Openmodcap),getNames(Openmodcap)] <- Openmodcap[getRegions(Openmodcap), + output[getRegions(Openmodcap), getYears(Openmodcap), getNames(Openmodcap)] <- Openmodcap[getRegions(Openmodcap), getYears(Openmodcap), getNames(Openmodcap)] - output[getRegions(WEOcap),getYears(WEOcap),getNames(WEOcap)] <- WEOcap[getRegions(WEOcap), + output[getRegions(WEOcap), getYears(WEOcap), getNames(WEOcap)] <- WEOcap[getRegions(WEOcap), getYears(WEOcap), getNames(WEOcap)] - output[getRegions(CHA.2020.GasData),getYears(CHA.2020.GasData), getNames(CHA.2020.GasData)] <- CHA.2020.GasData + output[getRegions(CHA.2020.GasData), getYears(CHA.2020.GasData), getNames(CHA.2020.GasData)] <- CHA.2020.GasData - output[getRegions(USA.2025.PVData),getYears(USA.2025.PVData), getNames(USA.2025.PVData)] <- USA.2025.PVData + output[getRegions(USA.2025.PVData), getYears(USA.2025.PVData), getNames(USA.2025.PVData)] <- USA.2025.PVData - output[is.na(output)] <- 0 #set NA to 0 - output <- toolCountryFill(output,fill=0,verbosity=2) # fill missing countries + output[is.na(output)] <- 0 # set NA to 0 + output <- toolCountryFill(output, fill = 0, verbosity = 2) # fill missing countries - } - else if (grepl("capacityByPE", subtype)) { + } else if (grepl("capacityByPE", subtype)) { # Pe -> peoil, pegas, pecoal, peur, pegeo, pehyd, pewin, pesol, pebiolc, pebios, pebioil description <- "Historical capacity by primary energy." @@ -161,20 +151,20 @@ calcCapacity <- function(subtype) { # "pesol", "pehyd", "pebiolc", "pesol", "peoil"), stringsAsFactors = FALSE) mapping <- data.frame(ember_techs = c("Biomass", "Coal", "Gas", "Oil", "Hydro", "Nuclear", "Solar", "Wind"), - REMIND_PE=c("pebiolc", "pecoal", "pegas", "peoil", "pehyd", "peur", "pesol", "pewin"), stringsAsFactors = FALSE) + REMIND_PE = c("pebiolc", "pecoal", "pegas", "peoil", "pehyd", "peur", "pesol", "pewin"), stringsAsFactors = FALSE) - embercap <- calcOutput("Ember", subtype = "capacity", aggregate = F) + embercap <- calcOutput("Ember", subtype = "capacity", aggregate = FALSE) embercap <- setNames(embercap, nm = gsub("Cap|Electricity|", "", gsub(" (GW)", "", getNames(embercap), fixed = TRUE), fixed = TRUE)) # aggregating primary energies to REMIND naming convention - embercap <- toolAggregate(embercap[,,mapping$ember_techs], rel=mapping, from="ember_techs", - to="REMIND_PE",dim=3.1) + embercap <- toolAggregate(embercap[, , mapping$ember_techs], rel = mapping, from = "ember_techs", + to = "REMIND_PE", dim = 3.1) embercap <- embercap * 1E-03 # converting GW to TW - embercap <- embercap[,,c("peur", "pegas", "pebiolc", "pehyd")] #pegas is handled at technology level + embercap <- embercap[, , c("peur", "pegas", "pebiolc", "pehyd")] # pegas is handled at technology level # estimating lower bound coal capacity to remaining countries assuming # (1) capacity factors are given by REMIND pc capacity factor in 2015, @@ -183,65 +173,61 @@ calcCapacity <- function(subtype) { # SB Use coal capacity data from Global Coal Plant Tracker (GCPT) # historical coal capacity data - coal_hist <- readSource("GCPT",subtype="historical") * 1e-03 + coal_hist <- readSource("GCPT", subtype = "historical") * 1e-03 coal_hist <- setNames(coal_hist, nm = "pecoal") if (grepl("annual", subtype)) { - output <- new.magpie(cells_and_regions=c(getRegions(embercap)), - years = c(min(c(getYears(embercap, as.integer = T), getYears(coal_hist, as.integer = T))) - : max(c(getYears(embercap, as.integer = T), getYears(coal_hist, as.integer = T)))), + output <- new.magpie(cells_and_regions = c(getRegions(embercap)), + years = c(min(c(getYears(embercap, as.integer = TRUE), getYears(coal_hist, as.integer = TRUE))) + :max(c(getYears(embercap, as.integer = TRUE), getYears(coal_hist, as.integer = TRUE)))), names = c("pecoal", "pegas", "pebiolc", "pehyd", "peur"), - fill=0) + fill = 0) - output[, intersect(getYears(coal_hist), getYears(output)), "pecoal"] <- coal_hist[, intersect(getYears(coal_hist), getYears(output)),] + output[, intersect(getYears(coal_hist), getYears(output)), "pecoal"] <- coal_hist[, intersect(getYears(coal_hist), getYears(output)), ] - output[, intersect(getYears(embercap), getYears(output)), getItems(output, dim = 3) != "pecoal"] <- embercap[, intersect(getYears(embercap), getYears(output)),] + output[, intersect(getYears(embercap), getYears(output)), getItems(output, dim = 3) != "pecoal"] <- embercap[, intersect(getYears(embercap), getYears(output)), ] - }else { + } else { last_ts <- max(intersect(getYears(coal_hist, as.integer = TRUE), seq(2010, 2050, 5))) - coal_hist <- setNames(coal_hist[,getYears(coal_hist)>="y2007",], nm = "pecoal") + coal_hist <- setNames(coal_hist[, getYears(coal_hist) >= "y2007", ], nm = "pecoal") - output <- new.magpie(cells_and_regions=c(getRegions(embercap)), years = seq(2010, last_ts, 5), - names = c("pecoal", "pegas", "pebiolc", "pehyd", "peur"), fill=0) + output <- new.magpie(cells_and_regions = c(getRegions(embercap)), years = seq(2010, last_ts, 5), + names = c("pecoal", "pegas", "pebiolc", "pehyd", "peur"), fill = 0) # Fill in output with GCPT and Ember data, averaging across each 5 (or 3 or 4) year period ts_coal <- getYears(coal_hist, as.integer = TRUE) ts_ember <- getYears(embercap, as.integer = TRUE) for (yr in getYears(output, as.integer = TRUE)) { - if ((yr+2) %in% ts_coal) { ## Fill in coal separately because data is more recent - output[,yr,"pecoal"] <- dimSums(coal_hist[,(yr-2):(yr+2),],dim=2)/5 - }else if ((yr+1) %in% ts_coal) { - output[,yr,"pecoal"] <- dimSums(coal_hist[,(yr-2):(yr+1),],dim=2)/4 - }else { - output[,yr,"pecoal"] <- dimSums(coal_hist[,(yr-2):yr,],dim=2)/3 + if ((yr + 2) %in% ts_coal) { ## Fill in coal separately because data is more recent + output[, yr, "pecoal"] <- dimSums(coal_hist[, (yr - 2):(yr + 2), ], dim = 2) / 5 + } else if ((yr + 1) %in% ts_coal) { + output[, yr, "pecoal"] <- dimSums(coal_hist[, (yr - 2):(yr + 1), ], dim = 2) / 4 + } else { + output[, yr, "pecoal"] <- dimSums(coal_hist[, (yr - 2):yr, ], dim = 2) / 3 } - if ((yr+2) %in% ts_ember) { - output[,yr,getItems(output,dim=3)!='pecoal'] <- dimSums(embercap[,(yr-2):(yr+2),],dim=2)/5 - }else if ((yr+1) %in% ts_ember) { - output[,yr,getItems(output,dim=3)!='pecoal'] <- dimSums(embercap[,(yr-2):(yr+1),],dim=2)/4 - }else { - output[,yr,getItems(output,dim=3)!='pecoal'] <- dimSums(embercap[,(yr-2):yr,],dim=2)/3 + if ((yr + 2) %in% ts_ember) { + output[, yr, getItems(output, dim = 3) != "pecoal"] <- dimSums(embercap[, (yr - 2):(yr + 2), ], dim = 2) / 5 + } else if ((yr + 1) %in% ts_ember) { + output[, yr, getItems(output, dim = 3) != "pecoal"] <- dimSums(embercap[, (yr - 2):(yr + 1), ], dim = 2) / 4 + } else { + output[, yr, getItems(output, dim = 3) != "pecoal"] <- dimSums(embercap[, (yr - 2):yr, ], dim = 2) / 3 } } } - output <- toolCountryFill(output,fill=0,verbosity=2) # fill missing countries + output <- toolCountryFill(output, fill = 0, verbosity = 2) # fill missing countries output <- magclass::add_dimension(output, dim = 3.2, add = "enty", nm = "seel") # add secondary energy dimension - } else if (subtype=="coalPlantTraj") { - output <- readSource("GCPT",subtype="future") * 1e-03 - description <- "Coal power project pipeline completion scenarios" - } else { stop("Not a valid subtype!") } # Returning capacity values - return(list(x=output, weight=NULL, - unit="TW", - description=description + return(list(x = output, weight = NULL, + unit = "TW", + description = description )) } diff --git a/R/calcHistorical.R b/R/calcHistorical.R index 95d6de34..be16a83e 100644 --- a/R/calcHistorical.R +++ b/R/calcHistorical.R @@ -76,26 +76,6 @@ calcHistorical <- function() { # remove duplicates from LU_FAO_EmisAg LU_FAO_EmisAg <- LU_FAO_EmisAg[, , which(!duplicated(getNames(LU_FAO_EmisAg)))] - # Capacities historical data ==== - - # IRENA capacities - technologies: "csp", "geohdr", "hydro", "spv", "wind" - - # Read IRENA renewables capacity data - IRENAcap <- readSource(type = "IRENA", subtype = "Capacity")[, , c("Concentrated solar power", - "Geothermal", "Renewable hydropower", - "Solar photovoltaic", "Wind")] - IRENAcap <- IRENAcap * 1E-03 # converting MW to GW - mapping <- data.frame( - IRENA_techs = c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Wind"), - REMIND_var = c("Cap|Electricity|Solar|CSP (GW)", "Cap|Electricity|Geothermal (GW)", - "Cap|Electricity|Hydro (GW)", "Cap|Electricity|Solar|PV (GW)", - "Cap|Electricity|Wind (GW)"), stringsAsFactors = FALSE - ) - # renaming technologies to REMIND naming convention - IRENAcap <- luscale::rename_dimnames(IRENAcap, dim = 3, query = mapping, from = "IRENA_techs", to = "REMIND_var") - IRENAcap <- mbind(IRENAcap, setNames(IRENAcap[, , "Cap|Electricity|Solar|CSP (GW)"] + - IRENAcap[, , "Cap|Electricity|Solar|PV (GW)"], "Cap|Electricity|Solar (GW)")) - IRENAcap <- add_dimension(IRENAcap, dim = 3.1, add = "model", nm = "IRENA") # Region specific historical data ==== @@ -204,7 +184,7 @@ calcHistorical <- function() { varlist <- list( fe_iea, fe_weo, pe_iea, pe_weo, trade, pop, gdp, ceds, primap, cdiac, LU_EDGAR_LU, LU_CEDS, - LU_FAO_EmisLUC, LU_FAO_EmisAg, LU_PRIMAPhist, IRENAcap, + LU_FAO_EmisLUC, LU_FAO_EmisAg, LU_PRIMAPhist, EEA_GHGSectoral, EEA_GHGTotal, Emi_Reference, worldsteel, USGS_cement ) diff --git a/R/calcIEA_WorldEnergyOutlook.R b/R/calcIEA_WorldEnergyOutlook.R index 927955c6..3ca07369 100644 --- a/R/calcIEA_WorldEnergyOutlook.R +++ b/R/calcIEA_WorldEnergyOutlook.R @@ -56,8 +56,8 @@ calcIEA_WorldEnergyOutlook <- function() { # nolint } x <- toolAggregate(data, - dim = 3.2, rel = map, from = "from", - to = "to", partrel = TRUE, verbosity = 2 + dim = 3.2, rel = map, from = "from", + to = "to", partrel = TRUE, verbosity = 2 ) return(x) diff --git a/R/calcIRENA.R b/R/calcIRENA.R new file mode 100644 index 00000000..edabf7fd --- /dev/null +++ b/R/calcIRENA.R @@ -0,0 +1,42 @@ +#' Calculate REMIND variables from historical IRENA capacities. +#' +#' @author Falk Benke +#' @export +calcIRENA <- function() { + + data <- readSource(type = "IRENA", subtype = "Capacity")[, , c( + "Concentrated solar power", + "Geothermal", "Renewable hydropower", + "Solar photovoltaic", "Wind" + )] + + # converting MW to GW + data <- data * 1E-03 + + mapping <- data.frame( + IRENA_techs = + c("Concentrated solar power", "Geothermal", "Renewable hydropower", "Solar photovoltaic", "Wind"), + REMIND_var = + c( + "Cap|Electricity|Solar|CSP (GW)", "Cap|Electricity|Geothermal (GW)", "Cap|Electricity|Hydro (GW)", + "Cap|Electricity|Solar|PV (GW)", "Cap|Electricity|Wind (GW)" + ), stringsAsFactors = FALSE + ) + + data <- madrat::toolAggregate(data, mapping, dim = 3, from = "IRENA_techs", to = "REMIND_var") + + data <- mbind( + data, + setNames( + data[, , "Cap|Electricity|Solar|CSP (GW)"] + data[, , "Cap|Electricity|Solar|PV (GW)"], + "Cap|Electricity|Solar (GW)" + ) + ) + + return(list( + x = data, + weight = NULL, + unit = "GW", + description = "IRENA capacities for technologies csp, geohdr, hydro, spv, wind" + )) +} diff --git a/R/calcPE.R b/R/calcPE.R index ecde6517..81c817e9 100644 --- a/R/calcPE.R +++ b/R/calcPE.R @@ -24,7 +24,7 @@ calcPE <- function(subtype = "IEA", ieaVersion = "default") { map <- map[map$io %in% getNames(data), ] x <- data[, , map$io] # aggregate from the IO names to the reporting names. - x <- luscale::speed_aggregate(x, map, dim = 3, from = "io", to = "input") + x <- madrat::toolAggregate(x, map, dim = 3, from = "io", to = "input") # rename entries of data to match the reporting names getNames(x) <- paste0(getNames(x), " (EJ/yr)") diff --git a/R/convertEdgeBuildings.R b/R/convertEdgeBuildings.R index 78737fdd..c6a2ef1e 100644 --- a/R/convertEdgeBuildings.R +++ b/R/convertEdgeBuildings.R @@ -145,9 +145,17 @@ convertEdgeBuildings <- function(x, subtype = "FE") { wfe <- wfe[, getYears(x), getNames(x, dim = "item")] # Disaggregate and fill the gaps - xadd <- toolAggregate(x, mappingfile, weight = wfe, - from = region_col, - to = iso_col) + + weightSum <- toolAggregate(wfe, mappingfile, from = region_col, to = iso_col, dim = 1) + + # only throw the zeroWeight warning in toolAggregate, when any weights are zero, + # but the corresponding data in x is not 0, as only in these cases the total sum of + # the magpie object is actually changed + shouldWarn <- ifelse(any(weightSum[x != 0] == 0), "warn", "allow") + + xadd <- toolAggregate(x, mappingfile, weight = wfe, from = region_col, to = iso_col, + zeroWeight = shouldWarn) + result <- toolCountryFill(xadd, 0, verbosity = 2) # Attribute the growth in water heating demand of the EDGE Region OCD to TUR, diff --git a/R/fullVALIDATIONREMIND.R b/R/fullVALIDATIONREMIND.R index d300d250..86173058 100644 --- a/R/fullVALIDATIONREMIND.R +++ b/R/fullVALIDATIONREMIND.R @@ -201,6 +201,15 @@ fullVALIDATIONREMIND <- function(rev = 0) { writeArgs = list(scenario = "historical") ) + # IRENA Capacities ---- + + calcOutput( + type = "IRENA", file = valfile, + aggregate = columnsForAggregation, append = TRUE, warnNA = FALSE, + try = FALSE, years = years, + writeArgs = list(scenario = "historical", model = "IRENA") + ) + # JRC IDEES ---- calcOutput( diff --git a/README.md b/README.md index dd8afdcd..62d39b26 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # MadRat REMIND Input Data Package -R package **mrremind**, version **0.204.0** +R package **mrremind**, version **0.204.1** [![CRAN status](https://www.r-pkg.org/badges/version/mrremind)](https://cran.r-project.org/package=mrremind) [![R build status](https://github.com/pik-piam/mrremind/workflows/check/badge.svg)](https://github.com/pik-piam/mrremind/actions) [![codecov](https://codecov.io/gh/pik-piam/mrremind/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mrremind) [![r-universe](https://pik-piam.r-universe.dev/badges/mrremind)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Lavinia Baumstark . +Baumstark L, Rodrigues R, Levesque A, Oeser J, Bertram C, Mouratiadou I, Malik A, Schreyer F, Soergel B, Rottoli M, Mishra A, Dirnaichner A, Pehl M, Giannousakis A, Klein D, Strefler J, Feldhaus L, Brecha R, Rauner S, Dietrich J, Bi S, Benke F, Weigmann P, Richters O, Hasse R, Fuchs S, Mandaroux R, Koch J (2024). _mrremind: MadRat REMIND Input Data Package_. R package version 0.204.1, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {mrremind: MadRat REMIND Input Data Package}, author = {Lavinia Baumstark and Renato Rodrigues and Antoine Levesque and Julian Oeser and Christoph Bertram and Ioanna Mouratiadou and Aman Malik and Felix Schreyer and Bjoern Soergel and Marianna Rottoli and Abhijeet Mishra and Alois Dirnaichner and Michaja Pehl and Anastasis Giannousakis and David Klein and Jessica Strefler and Lukas Feldhaus and Regina Brecha and Sebastian Rauner and Jan Philipp Dietrich and Stephen Bi and Falk Benke and Pascal Weigmann and Oliver Richters and Robin Hasse and Sophie Fuchs and Rahel Mandaroux and Johannes Koch}, year = {2024}, - note = {R package version 0.204.0}, + note = {R package version 0.204.1}, url = {https://github.com/pik-piam/mrremind}, } ``` diff --git a/man/calcCapacity.Rd b/man/calcCapacity.Rd index a776d76e..13eb233e 100644 --- a/man/calcCapacity.Rd +++ b/man/calcCapacity.Rd @@ -16,9 +16,8 @@ magpie object of capacity data provides historical capacity values in TW } \examples{ - \dontrun{ -calcOutput("Capacity",subtype="capacityByTech") +calcOutput("Capacity", subtype = "capacityByTech") } } \author{ diff --git a/man/calcIRENA.Rd b/man/calcIRENA.Rd new file mode 100644 index 00000000..cc2053b4 --- /dev/null +++ b/man/calcIRENA.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calcIRENA.R +\name{calcIRENA} +\alias{calcIRENA} +\title{Calculate REMIND variables from historical IRENA capacities.} +\usage{ +calcIRENA() +} +\description{ +Calculate REMIND variables from historical IRENA capacities. +} +\author{ +Falk Benke +}