From 0f0118adcb639e38f14be78cbc1bd3c4ec19919a Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 7 Dec 2023 16:34:34 +0100 Subject: [PATCH 01/11] remove no longer working dashboard script --- NAMESPACE | 45 - R/dashboard.R | 60 -- R/reportCharts.R | 1737 ------------------------------- R/reportDiagnosis.R | 507 --------- inst/markdown/dashboard.Rmd | 1938 ----------------------------------- man/dashboard.Rd | 44 - man/reportCharts.Rd | 38 - man/reportDiagnosis.Rd | 35 - 8 files changed, 4404 deletions(-) delete mode 100644 R/dashboard.R delete mode 100644 R/reportCharts.R delete mode 100644 R/reportDiagnosis.R delete mode 100644 inst/markdown/dashboard.Rmd delete mode 100644 man/dashboard.Rd delete mode 100644 man/reportCharts.Rd delete mode 100644 man/reportDiagnosis.Rd diff --git a/NAMESPACE b/NAMESPACE index 23e0a152..cca95498 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,7 +19,6 @@ export(convGDX2MIF_LCOE) export(convGDX2MIF_REMIND2MAgPIE) export(convergenceCheck) export(createVarListHtml) -export(dashboard) export(deletePlus) export(gdx.copy) export(getCfgDefaultPath) @@ -56,11 +55,9 @@ export(readTimeStepWeight) export(readTrade) export(reportCapacity) export(reportCapitalStock) -export(reportCharts) export(reportCosts) export(reportCrossVariables) export(reportDIETER) -export(reportDiagnosis) export(reportEDGETransport) export(reportEmi) export(reportEmiAirPol) @@ -87,7 +84,6 @@ export(toolRegionSubsets) export(validationREMIND) export(variablesAsList) import(magclass) -importFrom(RColorBrewer,brewer.pal) importFrom(abind,abind) importFrom(assertr,assert) importFrom(assertr,not_na) @@ -111,7 +107,6 @@ importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) importFrom(dplyr,coalesce) importFrom(dplyr,distinct) -importFrom(dplyr,do) importFrom(dplyr,filter) importFrom(dplyr,full_join) importFrom(dplyr,group_by) @@ -135,63 +130,33 @@ importFrom(gdx,readGDX) importFrom(gdxdt,readgdx) importFrom(gdxrrw,gdxInfo) importFrom(ggplot2,aes) -importFrom(ggplot2,aes_) -importFrom(ggplot2,coord_cartesian) -importFrom(ggplot2,coord_flip) -importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) -importFrom(ggplot2,expand_limits) importFrom(ggplot2,facet_grid) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_area) -importFrom(ggplot2,geom_bar) -importFrom(ggplot2,geom_boxplot) importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_errorbar) -importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) -importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_rect) -importFrom(ggplot2,geom_text) -importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) -importFrom(ggplot2,labeller) importFrom(ggplot2,labs) -importFrom(ggplot2,position_stack) -importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,scale_fill_brewer) importFrom(ggplot2,scale_fill_discrete) -importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_identity) -importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_x_discrete) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,sec_axis) -importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggplot2,theme_minimal) importFrom(ggplot2,unit) importFrom(ggplot2,xlab) -importFrom(ggplot2,ylab) importFrom(gms,getLine) importFrom(gms,readDefaultConfig) importFrom(grDevices,colorRampPalette) -importFrom(grDevices,rgb) -importFrom(highcharter,hc_add_series_list) -importFrom(highcharter,hc_mapNavigation) -importFrom(highcharter,hc_plotOptions) -importFrom(highcharter,hc_tooltip) -importFrom(highcharter,highchart) -importFrom(highcharter,list_parse) importFrom(iamc,iamCheck) importFrom(knitr,knit) -importFrom(lubridate,day) -importFrom(lubridate,hour) -importFrom(lubridate,minute) -importFrom(lubridate,second) -importFrom(lubridate,seconds_to_period) importFrom(lucode2,getScenNames) importFrom(luplot,magpie2ggplot2) importFrom(luplot,plotcountrymap) @@ -240,11 +205,9 @@ importFrom(magclass,setItems) importFrom(magclass,setNames) importFrom(magclass,setYears) importFrom(magclass,write.report) -importFrom(mip,mipArea) importFrom(mip,mipBarYearData) importFrom(mip,mipLineHistorical) importFrom(mip,plotstyle) -importFrom(mip,shorten_legend) importFrom(openxlsx,addStyle) importFrom(openxlsx,addWorksheet) importFrom(openxlsx,createStyle) @@ -256,7 +219,6 @@ importFrom(plotly,config) importFrom(plotly,ggplotly) importFrom(plotly,hide_legend) importFrom(plotly,layout) -importFrom(plotly,style) importFrom(plotly,subplot) importFrom(quitte,as.quitte) importFrom(quitte,calcCumulatedDiscount) @@ -282,19 +244,12 @@ importFrom(rlang,.env) importFrom(rlang,is_empty) importFrom(rlang,sym) importFrom(rlang,syms) -importFrom(rmarkdown,render) importFrom(rmndt,approx_dt) importFrom(rmndt,readMIF) importFrom(rmndt,writeMIF) -importFrom(scales,pretty_breaks) -importFrom(stats,IQR) -importFrom(stats,as.formula) -importFrom(stats,lag) -importFrom(stats,quantile) importFrom(tibble,as_tibble) importFrom(tibble,tibble) importFrom(tibble,tribble) -importFrom(tidyr,"%>%") importFrom(tidyr,complete) importFrom(tidyr,crossing) importFrom(tidyr,drop_na) diff --git a/R/dashboard.R b/R/dashboard.R deleted file mode 100644 index a989ae2d..00000000 --- a/R/dashboard.R +++ /dev/null @@ -1,60 +0,0 @@ -#' @title REMIND dashboard -#' @description Create REMIND dashboard results for single runs -#' -#' @author Renato Rodrigues -#' -#' @param gdx GDX (fulldata.gdx) file path -#' @param statsFile run statistics (runstatistics.rda) file path -#' @param regionMapping regionMapping file name or file path (ex. "regionmappingH12.csv") -#' @param hist historical mif file path -#' @param reportfile REMIND mif report file path -#' @param output_file file name to save the html dashboard -#' -#' @examples -#' \dontrun{ -#' # loading required libraries -#' library(remind2) -#' # creating the REMINd dashboard -#' dashboard(gdx="./output/Base/fulldata.gdx",statsFile="./output/Base/runstatistics.rda", -#' output_file="./output/Base/REMIND_dashboard_Base.html") -#' } -#' -#' @importFrom rmarkdown render -#' -#' @export -#' - -dashboard <- function(gdx=NULL, statsFile=NULL, regionMapping=NULL, hist=NULL, reportfile=NULL, output_file=NULL) { - - # error checking - if(!(!(is.null(gdx)) && file.exists(gdx))){ - warning("REMIND dashboard require a valid gdx file path.") - return() - } - if(!(!(is.null(statsFile)) && file.exists(statsFile))){ - warning("REMIND dashboard require a valid run statistics (runstatistics.rda) file path.") - return() - } - if(is.null(regionMapping)){ - warning("REMIND dashboard require a regionMapping file.") - return() - } - - stats <- NULL - load(file = statsFile) - if(stats$config$gms$optimization == "testOneRegi"){ - warning("REMIND dashboard does not support yet testOneRegi runs.") - return() - } - - #dashboard markdown file path - markdownPath <- system.file("markdown","dashboard.Rmd",package = "remind") - - #set output file if null - if(is.null(output_file)) - output_file <- file.path(getwd(),"REMIND_dashboard.html") - - # generate dashboard for REMIND - rmarkdown::render(markdownPath, output_file = output_file, params = list(gdx=gdx, statsFile=statsFile, regionMapping=regionMapping, hist=hist, reportfile=reportfile)) - -} diff --git a/R/reportCharts.R b/R/reportCharts.R deleted file mode 100644 index 24cdece0..00000000 --- a/R/reportCharts.R +++ /dev/null @@ -1,1737 +0,0 @@ -#' @title Create REMIND reporting charts -#' @description Create REMIND reporting plots -#' -#' @param gdx GDX file path -#' @param regionMapping regionMapping file name -#' @param hist historic file path -#' @param reportfile REMIND mif report file path -#' @param chartType plot type to include in output object. Either "plotly", "ggplot" or both c("plotly","ggplot") -#' -#' @author Renato Rodrigues -#' -#' @examples -#' -#' \dontrun{ -#' reportCharts(gdx="fulldata.gdx",regionMapping="./config/regionmappingH12.csv") -#' } -#' -#' @importFrom madrat toolGetMapping -#' @importFrom highcharter highchart hc_plotOptions hc_add_series_list hc_tooltip hc_mapNavigation list_parse -#' @importFrom mip plotstyle mipArea shorten_legend mipLineHistorical -#' @importFrom tidyr %>% -#' @importFrom gdx readGDX -#' @importFrom dplyr group_by do summarise mutate ungroup -#' @importFrom ggplot2 ggplot theme theme_minimal expand_limits labs element_blank ylab labeller geom_vline scale_color_manual geom_area -#' @importFrom RColorBrewer brewer.pal -#' @importFrom stats as.formula -#' @importFrom scales pretty_breaks -#' -#' @export - -reportCharts <- function(gdx=NULL, regionMapping=NULL, hist=NULL, reportfile=NULL, chartType="ggplot") { - - # error checking - if(!(!(is.null(gdx)) && file.exists(gdx)) && !(!(is.null(reportfile)) && file.exists(reportfile))){ - warning("reportCharts function require either a valid gdx or a mif report file path.") - return() - } - if(is.null(regionMapping)){ - warning("REMIND dashboard require a regionMapping file.") - return() - } - - # if no reporting-mif-file is provided create reporting - if(is.null(reportfile)){ - reportfile <- convGDX2MIF(gdx) - } - - data <- read.report(reportfile,as.list=FALSE) - data <- deletePlus(data) - data <- collapseNames(data) - data <- data[,getYears(data)<="y2100",] - - ### Aestethics Options - aestethics <- list("alpha"=0.6, - "line" = list("size"= 2/3.78), - "y-axis" = list("color"="#878787","size"= 1/3.78) - ) - - # variable labels renaming for facet grids - variable_label <- c( - "Emi|CO2" = "Carbon Dioxide (Mt CO2)", - "Emi|CH4" = "Methane (Mt CH4)", - "Emi|N2O" = "Nitrous Oxide (kt N2O)", - - "Emi|PFC" = "Perfluorocarbons (kt CF4-equiv)", - "Emi|HFC" = "Hydrofluorocarbons (kt HFC134a-equiv)", - "Emi|SF6" = "Sulphur hexafluoride (kt SF6)", - - "Emi|NH3" = "NH3 (Mt)", - "Emi|NOX" = "NOX (Mt)", - "Emi|OC" = "OC (Mt)", - "Emi|SO2" = "SO2 (Mt)", - "Emi|VOC" = "VOC (Mt)", - "Emi|BC" = "BC (Mt)", - "Emi|C2F6" = "C2F6 (kt)", - "Emi|C6F14" = "C6F14 (kt C6F14)", - - "Price|Final Energy|Buildings" = "Buildings", - "Price|Final Energy|Industry" = "Industry", - "Price|Final Energy|Transport" = "Transport", - - "Price|Final Energy|Electricity|Transport" = "Electricity", - "Price|Final Energy|Liquids|Transport" = "Liquids", - "Price|Final Energy|Hydrogen|Transport" = "Hydrogen", - - "Price|Final Energy|Electricity|Industry" = "Electricity", - "Price|Final Energy|Heating Oil|Industry" = "Heating Oil", - "Price|Final Energy|Solids|Industry" = "Solids", - "Price|Final Energy|Gases|Industry" = "Gases", - "Price|Final Energy|Heat|Industry" = "Heat", - "Price|Final Energy|Hydrogen|Industry" = "Hydrogen", - - "Price|Final Energy|Electricity|Buildings" = "Electricity", - "Price|Final Energy|Heat|Buildings" = "Heat", - "Price|Final Energy|Gases|Buildings" = "Gases", - "Price|Final Energy|Hydrogen|Buildings" = "Hydrogen", - "Price|Final Energy|Heating Oil|Buildings" = "Heating Oil", - "Price|Final Energy|Solids|Buildings" = "Solids" - ) - - missingColors <- c( - "DEU"=brewer.pal(9,"Oranges")[9], - "EUW"=brewer.pal(9,"YlOrRd")[6], "EWN"=brewer.pal(9,"YlOrRd")[6], "FRA"=brewer.pal(9,"YlOrRd")[7], - "EUS"=brewer.pal(9,"YlOrRd")[2], "ESW"=brewer.pal(9,"YlOrRd")[2], "ESC"=brewer.pal(9,"YlOrRd")[3], - "EUC"=brewer.pal(9,"Greys")[5], "ECS"=brewer.pal(9,"Greys")[3], "ECE"=brewer.pal(9,"Greys")[5], - "EUN"=brewer.pal(9,"Blues")[6], "ENC"=brewer.pal(9,"Blues")[5], "UKI"=brewer.pal(9,"Blues")[6], - "NEU"=brewer.pal(9,"YlGn")[5], "NEN"=brewer.pal(9,"YlGn")[5], "NES"=brewer.pal(9,"YlGn")[3], - "CHE"="#78C679", "ENN"="#78C679", "ESE"="#D9F0A3","EUI"="#78C679", "ROE"="#D9F0A3", #older EU - "SSA"="#00BAFF", "REF"="#D900BC", "CAZ"="#007362", "CHA"="#F24200", #maps - "F-Gases"="#ff9977", "N2O|Waste"="#bcbc6d", "N2O|Industry"="#666666", #Kyoto Gases - "Energy|Supply|Non-Elec"="#661a00", "Energy|Supply|Electricity|Gross"="#993a44", "FFaI|Industry|Process"="#aa5a00", "Energy|Demand|Industry|Gross"="#7777ff", "Buildings|Direct"="#4444bb", "Transport|Demand"="#222288", "Carbon Capture and Storage|Biomass|Neg"="#00aa00", "Land-Use Change"="#116611", # CO2 emissions per sector - "Emi|CO2" = "#333333", "Emi|CH4" = "#3333aa", "Emi|N2O" = "#aa3333", # Main Greenhouse Gases Emissions - "Emi|PFC" = "#000000", "Emi|HFC" = "#000000", "Emi|SF6" = "#000000", # F-Gases - "Emi|NH3" = "#000000", "Emi|NOX" = "#000000", "Emi|OC" = "#000000", "Emi|SO2" = "#000000", "Emi|VOC" = "#000000", "Emi|BC" = "#000000", "Emi|C2F6" = "#000000", "Emi|C6F14" = "#000000", # Other Gases - "Biomass|World Market" = "#005900", "Coal|Primary Level" = "#0c0c0c", "Natural Gas|Primary Level" = "#999959", "Crude Oil|Primary Level" = "#cc7500", # PE - "Uranium"="EF7676", #Uranium extraction - "Lignocellulosic"="#005900", - "1st Generation"="#008c00", - "Traditional Biomass" = "#000000", #SE Solids - "Industry" = "#000000", "Heating Oil" = "#E41A1C", #FE prices - "Liquids|Fossil" = "#cc7500", "Liquids|Oil" = "#cc7500", "Liquids|Coal" = "#0c0c0c", "Liquids|Biomass" = "#005900", "Solids|Coal" = "#0c0c0c", "Solids|Biomass" = "#005900" #FE - ) - missingColorsdf <- data.frame(row.names=names(missingColors), color=missingColors) - - plotlyButtonsToHide <- list('sendDataToCloud', 'zoom2d', 'pan2d', 'select2d', 'lasso2d', 'zoomIn2d', 'zoomOut2d', 'autoScale2d', 'resetScale2d', 'hoverClosestCartesian', 'hoverCompareCartesian', 'zoom3d', 'pan3d', 'orbitRotation', 'tableRotation', 'resetCameraDefault3d', 'resetCameraLastSave3d', 'hoverClosest3d', 'zoomInGeo', 'zoomOutGeo', 'resetGeo', 'hoverClosestGeo', 'hoverClosestGl2d', 'hoverClosestPie', 'resetSankeyGroup', 'toggleHover', 'resetViews', 'toggleSpikelines', 'resetViewMapbox') - - ### auxiliar function to format specific text - unitSubscript <- function(unit){ - unit <- gsub("CO2", "CO\\2\\<\\/sub\\>", unit) - unit <- gsub("CO2 equivalent", "CO\\2 equivalent\\<\\/sub\\>", unit) - unit <- gsub("CH4", "CH\\4\\<\\/sub\\>", unit) - unit <- gsub("N2O", "N\\2\\<\\/sub\\>O", unit) - unit <- gsub("CF4", "CF\\4\\<\\/sub\\>", unit) - unit <- gsub("SF6", "SF\\6\\<\\/sub\\>", unit) - unit <- gsub("NH3", "NH\\3\\<\\/sub\\>", unit) - unit <- gsub("NOX", "NO\\x\\<\\/sub\\>", unit) - unit <- gsub("SO2", "SO\\2\\<\\/sub\\>", unit) - unit <- gsub("C2F6", "C\\2\\<\\/sub\\>F\\6\\<\\/sub\\>", unit) - unit <- gsub("C6F14", "C\\6\\<\\/sub\\>F\\14\\<\\/sub\\>", unit) - return(unit) - } - - ### Create output object - out <- list() - - ### Define which region plots to create - gdxRegions <- unique(readGDX(gdx, name = "regi2iso")[[1]]) - regionSubsetList <- toolRegionSubsets(gdx) - mainRegions <- c(gdxRegions[!gdxRegions %in% as.vector(unlist(sapply(regionSubsetList,function(x)x)))],names(regionSubsetList)) - - if (is.null(regionSubsetList)){ - regionsList <- c(list("world"="GLO"), - list("regions"=mainRegions)) # main regions - } else { - regionsList <- c(list("world"="GLO"), - list("regions"=mainRegions), # main regions - regionSubsetList, # aggregated regions - list("DEU"="DEU")) #extra country - } - out$data$regions <- regionsList - - ## loading population info - pop <- readGDX(gdx, name = "pm_pop")[,getYears(data),] # pop in billions - pop <- mbind(pop,dimSums(pop,dim=1)) # adding GLO - if (!is.null(regionSubsetList)) - pop <- mbind(pop, calc_regionSubset_sums(pop, regionSubsetList)) - pop <- as.quitte(pop) - pop <- pop[c("region","period","value")] - colnames(pop) <- c("region","period","population") - pop$population <- pop$population*1e9 - - ### Creating maps - - # #Creating map files (only needed if you include a new map plot using highcharter) - # library(highcharter) - # worldMap <- download_map_data("custom/world-palestine-highres") - # #adding missing Kosovo iso3 label - # for (i in 1:length(worldMap$features)){ - # if (worldMap$features[i][[1]]$id == "KV"){ - # worldMap$features[i][[1]]$properties$`iso-a3` <- "KOS" - # } - # } - # save(worldMap, file="WorldMap.RData") - # europeMap <- download_map_data("custom/europe") - # #adding missing Kosovo iso3 label - # for (i in 1:length(europeMap$features)){ - # if (europeMap$features[i][[1]]$id == "KV"){ - # europeMap$features[i][[1]]$properties$`iso-a3` <- "KOS" - # } - # } - # save(europeMap, file="EuropeMap.RData") - - # loading previosuly created map files - worldMap <- system.file("extdata","WorldMap.RData",package = "remind") - load(worldMap) #updates worldMap object with world map file data - #europeMap <- system.file("extdata","EuropeMap.RData",package = "remind") - #load(europeMap) #updates europeMap object with europe map file data - - # loading region mapping - regionMapping <- toolGetMapping(basename(regionMapping), type = "regional") - - # adding kosovo - regionMapping <- rbind(regionMapping,data.frame(CountryCode = "KOS", X = "Kosovo", RegionCode = regionMapping[which(regionMapping$CountryCode=="SRB"),]$RegionCode)) - - colors <- plotstyle(unique(regionMapping$RegionCode),unknown=missingColorsdf) # region colors - - series <- regionMapping %>% - group_by(name = .data$RegionCode) %>% - do(data = list_parse(select(.data, .data$CountryCode))) %>% - ungroup() - series$color <- colors[series$name] - - out$maps$world <- highchart(type = "map") %>% - hc_plotOptions(map = list(allAreas = FALSE, joinBy = c("iso-a3", "CountryCode"), mapData = worldMap, borderColor = "#FAFAFA", borderWidth = 0.03)) %>% - hc_add_series_list(series) %>% - hc_tooltip(useHTML = TRUE, headerFormat = "", pointFormat = "Region: {point.series.name}
Country: {point.name}") %>% - hc_mapNavigation(enabled = TRUE) - - # out$maps$europe <- highchart(type = "map") %>% - # hc_plotOptions(map = list(allAreas = FALSE, joinBy = c("iso-a3", "CountryCode"), mapData = europeMap, borderColor = "#FAFAFA", borderWidth = 0.03)) %>% - # hc_add_series_list(series) %>% - # hc_tooltip(useHTML = TRUE, headerFormat = "", pointFormat = "Region: {point.series.name}
Country: {point.name}") %>% - # hc_mapNavigation(enabled = TRUE) - - ### Creating Charts - - ##### Emissions - - # CO2 prices - vars <- c("Price|Carbon (US$2005/t CO2)") - - color <- c("Price|Carbon"="#000000") #overwritting default mip color value for carbon price - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," US$2005/t CO2
CO2 ",ifelse(reg=="GLO","World", as.character(df$region))," carbon price","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - expand_limits(y=c(0,100)) + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'Carbon Price' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'Carbon Price' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$emissions$'Carbon Price') <- names(regionsList) - } - - out$legend$'Carbon Price'$description <- "

CO2 emissions price

" - out$legend$'Carbon Price'$contents <- list("CO2 price" =list("fill"=color["Price|Carbon"],"linetype"="solid")) - out$legend$'Carbon Price'$units <- "US$2005/t CO2 per year" - - # Kyoto Gases - vars <- c("F-Gases" = "Emi|F-Gases (Mt CO2-equiv/yr)", - "CO2 - Gross Fossil Fuels and Industry" = "Emi|CO2|Gross Fossil Fuels and Industry (Mt CO2/yr)", - "CH4 - Energy Supply and Demand" = "Emi|CH4|Energy Supply and Demand (Mt CH4/yr)", - "N2O - Energy Supply and Demand" = "Emi|N2O|Energy Supply and Demand (kt N2O/yr)", - "N2O - Industry" = "Emi|N2O|Industry (kt N2O/yr)", - "CH4 - Waste" = "Emi|CH4|Waste (Mt CH4/yr)", - "N2O - Waste" = "Emi|N2O|Waste (kt N2O/yr)", - "CH4 - Other" = "Emi|CH4|Other (Mt CH4/yr)", - "CH4 - Land-Use Change" = "Emi|CH4|Land Use (Mt CH4/yr)", - "N2O - Land-Use Change" = "Emi|N2O|Land Use (kt N2O/yr)", - "CO2 - CCS Biomass" = "Emi|CO2|Carbon Capture and Storage|Biomass (Mt CO2/yr)", - "CO2 - Land-Use Change" = "Emi|CO2|Land-Use Change (Mt CO2/yr)" - ) - tmpData <- data[,,vars] # converting emissions to CO2 equivalent - GWP <- c("CO2"=1,"CH4"=28,"N2O"=265) - tmpData[,,c("Emi|CO2|Land-Use Change (Mt CO2/yr)","Emi|CO2|Gross Fossil Fuels and Industry (Mt CO2/yr)","Emi|CO2|Carbon Capture and Storage|Biomass (Mt CO2/yr)")] <- tmpData[,,c("Emi|CO2|Land-Use Change (Mt CO2/yr)","Emi|CO2|Gross Fossil Fuels and Industry (Mt CO2/yr)","Emi|CO2|Carbon Capture and Storage|Biomass (Mt CO2/yr)")] * GWP["CO2"] - tmpData[,,c("Emi|CH4|Energy Supply and Demand (Mt CH4/yr)","Emi|CH4|Land Use (Mt CH4/yr)","Emi|CH4|Other (Mt CH4/yr)","Emi|CH4|Waste (Mt CH4/yr)")] <- tmpData[,,c("Emi|CH4|Energy Supply and Demand (Mt CH4/yr)","Emi|CH4|Land Use (Mt CH4/yr)","Emi|CH4|Other (Mt CH4/yr)","Emi|CH4|Waste (Mt CH4/yr)")] * GWP["CH4"] - tmpData[,,c("Emi|N2O|Land Use (kt N2O/yr)","Emi|N2O|Energy Supply and Demand (kt N2O/yr)","Emi|N2O|Waste (kt N2O/yr)","Emi|N2O|Industry (kt N2O/yr)")] <- tmpData[,,c("Emi|N2O|Land Use (kt N2O/yr)","Emi|N2O|Energy Supply and Demand (kt N2O/yr)","Emi|N2O|Waste (kt N2O/yr)","Emi|N2O|Industry (kt N2O/yr)")] * GWP["N2O"]/1000 - tmpData[,,c("Emi|CO2|Carbon Capture and Storage|Biomass (Mt CO2/yr)")] <- -tmpData[,,c("Emi|CO2|Carbon Capture and Storage|Biomass (Mt CO2/yr)")] - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(tmpData[reg,,vars]) - df$details <- unitSubscript(paste0(round(df$value,2)," Mt CO2 equivalent
CO2 equivalent ",ifelse(reg=="GLO","World", as.character(df$region))," ", gsub("\\|"," emissions by ",gsub("Emi\\|","",df$variable)),"
year: ",df$period)) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'Kyoto Gases Emissions' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'Kyoto Gases Emissions' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$emissions$'Kyoto Gases Emissions') <- names(regionsList) - } - - out$legend$'Kyoto Gases Emissions'$description <- "

Kyoto Gases Emissions

" - out$legend$'Kyoto Gases Emissions'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Kyoto Gases Emissions'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Kyoto Gases Emissions'$units <- "US$2005/t CO2 per year" - - # CO2 emissions per sector - vars <- c("Energy - Non-electricity" = "Emi|CO2|Energy|Supply|Non-Elec (Mt CO2/yr)", - "Energy - Electricity" = "Emi|CO2|Energy|Supply|Electricity|Gross (Mt CO2/yr)", - "Industrial Processes" = "Emi|CO2|FFaI|Industry|Process (Mt CO2/yr)", - "Demand - Industry" = "Emi|CO2|Energy|Demand|Industry|Gross (Mt CO2/yr)", - # "Emi|CO2|Industrial Processes (Mt CO2/yr)", - "Demand - Buildings" = "Emi|CO2|Buildings|Direct (Mt CO2/yr)", - "Demand - Transport" = "Emi|CO2|Transport|Demand (Mt CO2/yr)", - "Land use change" = "Emi|CO2|Carbon Capture and Storage|Biomass|Neg (Mt CO2/yr)", - "Carbon Capture and Storage - Biomass" = "Emi|CO2|Land-Use Change (Mt CO2/yr)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- unitSubscript(paste0(round(df$value,2)," Mt CO2
CO2 ",ifelse(reg=="GLO","World", as.character(df$region))," emissions by ",names(vars[df$variable]),"
year: ",df$period)) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= unitSubscript(paste0(round(.data$value,2)," Mt CO2
","Total carbon emissions in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period))) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'CO2 Emissions per Sector' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'CO2 Emissions per Sector' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$emissions$'CO2 Emissions per Sector') <- names(regionsList) - } - - out$legend$'CO2 Emissions per Sector'$description <- "

Annual CO2 emissions per sector

" - out$legend$'CO2 Emissions per Sector'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'CO2 Emissions per Sector'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'CO2 Emissions per Sector'$contents <- c(list("Total CO2 emissions" =list("fill"="#000","linetype"="dashed")),out$legend$'CO2 Emissions per Sector'$contents) - out$legend$'CO2 Emissions per Sector'$units <- "Mt CO2 per year" - - # Main Greenhouse Gases Emissions - vars <- c("Emi|CO2 (Mt CO2/yr)", - "Emi|CH4 (Mt CH4/yr)", - "Emi|N2O (kt N2O/yr)") - - g <- lapply(regionsList, function(reg) { - if (length(reg) == 1) # color as variable - color <- plotstyle(as.character(gsub(" \\(.*","",vars)),unknown=missingColorsdf) - else # color as region - color <- plotstyle(unique(reg),unknown=missingColorsdf) - df <- as.quitte(data[reg,,vars]) - df$details <- unitSubscript(paste0(round(df$value,2), " ", gsub("/yr","",df$unit),"
",gsub(".* ","",gsub("/yr","",df$unit))," ",ifelse(reg=="GLO","World", as.character(df$region))," emissions", "
","year: ",df$period)) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=as.formula(paste("~",ifelse(length(reg) == 1,"variable","region"))),text=~details, group = ~region)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~variable, ncol=1, scales="free_y",labeller=labeller(variable = unitSubscript(variable_label))) + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'Main Greenhouse Gases Emissions' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'Main Greenhouse Gases Emissions' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$emissions$'Main Greenhouse Gases Emissions') <- names(regionsList) - } - - #out$legend$'Main Greenhouse Gases Emissions'$description <- "

Annual emissions for main greenhouse gases

" - #out$legend$'Main Greenhouse Gases Emissions'$contents <- "placeholder - not needed" - - # F-Gases - vars <- c("Emi|PFC (kt CF4-equiv/yr)", - "Emi|HFC (kt HFC134a-equiv/yr)", - "Emi|SF6 (kt SF6/yr)") - - g <- lapply(regionsList, function(reg) { - if (length(reg) == 1) # color as variable - color <- plotstyle(as.character(gsub(" \\(.*","",vars)),unknown=missingColorsdf) - else # color as region - color <- plotstyle(unique(reg),unknown=missingColorsdf) - df <- as.quitte(data[reg,,vars]) - df$details <- unitSubscript(paste0(round(df$value,2), " ", gsub("/yr","",df$unit),"
",gsub(".* ","",gsub("/yr","",df$unit))," ",ifelse(reg=="GLO","World", as.character(df$region))," emissions", "
","year: ",df$period)) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=as.formula(paste("~",ifelse(length(reg) == 1,"variable","region"))),text=~details, group = ~region)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~variable, ncol=1, scales="free_y",labeller=labeller(variable = unitSubscript(variable_label))) + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'F-Gases' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'F-Gases' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$emissions$'F-Gases') <- names(regionsList) - } - - #out$legend$'F-Gases'$description <- "

placeholder - not needed

" - #out$legend$'F-Gases'$contents <- "placeholder - not needed" - - # Other Gases - vars <- c("Emi|NH3 (Mt NH3/yr)", - "Emi|NOX (Mt NOX/yr)", - "Emi|OC (Mt OC/yr)", - "Emi|SO2 (Mt SO2/yr)", - "Emi|VOC (Mt VOC/yr)", - "Emi|BC (Mt BC/yr)", - "Emi|C2F6 (kt C2F6/yr)", - "Emi|C6F14 (kt C6F14/yr)") - - g <- lapply(regionsList, function(reg) { - if (length(reg) == 1) # color as variable - color <- plotstyle(as.character(gsub(" \\(.*","",vars)),unknown=missingColorsdf) - else # color as region - color <- plotstyle(unique(reg),unknown=missingColorsdf) - df <- as.quitte(data[reg,,vars]) - df$details <- unitSubscript(paste0(round(df$value,2), " ", gsub("/yr","",df$unit),"
",gsub(".* ","",gsub("/yr","",df$unit))," ",ifelse(reg=="GLO","World", as.character(df$region))," emissions", "
","year: ",df$period)) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=as.formula(paste("~",ifelse(length(reg) == 1,"variable","region"))),text=~details, group = ~region)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - scale_y_continuous(breaks = pretty_breaks(2), limits = c(0, NA)) + - facet_wrap(~variable, ncol=1, scales="free_y",labeller=labeller(variable = unitSubscript(variable_label))) + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$emissions$'Other Gases' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$emissions$'Other Gases' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$emissions$'Other Gases') <- names(regionsList) - } - - #out$legend$'Other Gases'$description <- "

placeholder - not needed

" - #out$legend$'Other Gases'$contents <- "placeholder - not needed" - - - ##### PRIMARY ENERGY - - #var.tot <-"PE (EJ/yr)" - vars <- c("Coal with CCS" = "PE|Coal|w/ CC (EJ/yr)", - "Coal without CCS" = "PE|Coal|w/o CC (EJ/yr)", - "Oil" = "PE|Oil (EJ/yr)", - "Gas with CCS" = "PE|Gas|w/ CC (EJ/yr)", - "Gas without CCS" = "PE|Gas|w/o CC (EJ/yr)", - "Biomass with CCS" = "PE|Biomass|w/ CC (EJ/yr)", - "Biomass without CCS" = "PE|Biomass|w/o CC (EJ/yr)", - "Nuclear" = "PE|Nuclear (EJ/yr)", - "Hydro" = "PE|Hydro (EJ/yr)", - "Geothermal" = "PE|Geothermal (EJ/yr)", - "Solar" = "PE|Solar (EJ/yr)", - "Wind" = "PE|Wind (EJ/yr)") - - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",gsub("\\|"," ",gsub("\\+\\|","",gsub("PE\\|","",as.character(df$variable)))), " primary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- list() - # absolute chart - g$abs <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total primary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - # relative chart - df <- df %>% group_by(.data$region,.data$period) %>% mutate(percent = .data$value/sum(.data$value)*100) #creating percentage column - df$percDetails <- paste0(round(df$percent,2)," %
",gsub("\\|"," ",gsub("\\+\\|","",gsub("PE\\|","",as.character(df$variable)))), " primary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g$perc <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~percDetails,group = ~variable)) + - geom_bar(position = "fill",stat = "identity",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) + - scale_y_continuous(labels = scales::percent) + - scale_x_continuous(limits = c(2005, NA)) ) - #per capita chart - df <- suppressWarnings(left_join(df, pop, by=c("region", "period"))) - df <- df %>% group_by(.data$region,.data$period) %>% mutate(percapita = .data$value/.data$population) #creating per capita column - df$percapitaDetails <- paste0(round(df$percapita,2)," EJ per capita
",gsub("\\|"," ",gsub("\\+\\|","",gsub("PE\\|","",as.character(df$variable)))), " primary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g$percapita <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~percapita,fill=~variable,text=~percapitaDetails,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(percapita = sum(.data$percapita,na.rm=TRUE)) %>% - mutate(position= .data$percapita+max(.data$percapita)/1000) %>% - mutate(details= paste0(round(.data$percapita,2)," EJ per capita
","Total primary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1){ - g$abs <- g$abs + theme(strip.text.x = element_blank()) - g$perc <- g$perc + theme(strip.text.x = element_blank()) - g$percapita <- g$percapita + theme(strip.text.x = element_blank()) - } - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Total Primary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Total Primary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- lapply(names(g[[reg]]), function(type) { - gg <- ggplotly(g[[reg]][[type]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(gg) - }) - names(ggplotly) <- names(g[[reg]]) - return(ggplotly) - }) - names(out$plotly$PE$'Total Primary Energy') <- names(regionsList) - } - - out$legend$'Total Primary Energy'$description <- "

Primary energy per carrier

" - out$legend$'Total Primary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Total Primary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Total Primary Energy'$contents <- c(list("Total primary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Total Primary Energy'$contents) - out$legend$'Total Primary Energy'$units <- c("EJ per year","Percentage share","EJ per capita") - - # PE prices - vars <- c("Biomass - World Market" = "Price|Biomass|World Market (US$2005/GJ)", - "Coal - Primary Level" = "Price|Coal|Primary Level (US$2005/GJ)", - "Natural Gas - Primary Level" = "Price|Natural Gas|Primary Level (US$2005/GJ)", - "Crude Oil - Primary Level"="Price|Crude Oil|Primary Level (US$2005/GJ)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
",gsub("\\|","",regmatches(df$variable, gregexpr("\\|.*?\\|", df$variable))), " ", ifelse(reg=="GLO","World", as.character(df$region))," price","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color,alpha=aestethics$alpha) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="free") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Primary Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Primary Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$PE$'Primary Energy Prices') <- names(regionsList) - } - - out$legend$'Primary Energy Prices'$description <- "

Primary energy prices

" - out$legend$'Primary Energy Prices'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"="solid")) }) - names(out$legend$'Primary Energy Prices'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Primary Energy Prices'$units <- "US$2005/GJ per year" - - # Coal production - vars <- c("PE|Production|Net|Coal (EJ/yr)") - - color <- plotstyle("Coal") - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2),"
", ifelse(reg=="GLO","World", as.character(df$region)), " Coal production","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Coal production' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Coal production' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.02 - return(ggplotly) - }) - names(out$plotly$PE$'Coal production') <- names(regionsList) - } - - out$legend$'Coal production'$description <- "

Net Coal production.

" - out$legend$'Coal production'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"=NULL)) }) - names(out$legend$'Coal production'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Coal production'$units <- "EJ/yr" - - # Gas production - vars <- c("PE|Production|Net|Gas (EJ/yr)") - - color <- "#999959" - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2),"
", ifelse(reg=="GLO","World", as.character(df$region)), " Gas production","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Gas production' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Gas production' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.02 - return(ggplotly) - }) - names(out$plotly$PE$'Gas production') <- names(regionsList) - } - - out$legend$'Gas production'$description <- "

Net Gas production.

" - out$legend$'Gas production'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"=NULL)) }) - names(out$legend$'Gas production'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Gas production'$units <- "EJ/yr" - - # Oil production - vars <- c("PE|Production|Net|Oil (EJ/yr)") - - color <- "#cc7500" - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2),"
", ifelse(reg=="GLO","World", as.character(df$region)), " Oil production","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Oil production' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Oil production' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.02 - return(ggplotly) - }) - names(out$plotly$PE$'Oil production') <- names(regionsList) - } - - out$legend$'Oil production'$description <- "

Net Oil production.

" - out$legend$'Oil production'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"=NULL)) }) - names(out$legend$'Oil production'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Oil production'$units <- "EJ/yr" - - # Uranium production - vars <- c("PE|Production|Net|Uranium [Energy] (EJ/yr)") - - color <- plotstyle("Uranium") - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2),"
", ifelse(reg=="GLO","World", as.character(df$region)), " Uranium production","
year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Uranium production' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Uranium production' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.02 - return(ggplotly) - }) - names(out$plotly$PE$'Uranium production') <- names(regionsList) - } - - out$legend$'Uranium production'$description <- "

Net Uranium production.

" - out$legend$'Uranium production'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"=NULL)) }) - names(out$legend$'Uranium production'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Uranium production'$units <- "EJ/yr" - - # Biomass production - vars <- c("PE|Production|Biomass|Lignocellulosic (EJ/yr)", - "PE|Production|Biomass|1st Generation (EJ/yr)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ/yr
", ifelse(reg=="GLO","World", as.character(df$region)),gsub(".*\\|","",gsub(" \\(.*","",df$variable)), " Biomass production
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$PE$'Biomass production' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$PE$'Biomass production' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.02 - return(ggplotly) - }) - names(out$plotly$PE$'Biomass production') <- names(regionsList) - } - - out$legend$'Biomass production'$description <- "

Energy crops Biomass production.

" - out$legend$'Biomass production'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"=NULL)) }) - names(out$legend$'Biomass production'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Biomass production'$units <- "EJ/yr" - - ##### SECONDARY ENERGY - - # SE price - vars <- c("Price|Secondary Energy|Biomass (US$2005/GJ)", - "Price|Secondary Energy|Electricity (US$2005/GJ)", - "Price|Secondary Energy|Gases (US$2005/GJ)", - "Price|Secondary Energy|Heat (US$2005/GJ)", - "Price|Secondary Energy|Hydrogen (US$2005/GJ)", - "Price|Secondary Energy|Liquids (US$2005/GJ)", - "Price|Secondary Energy|Solids (US$2005/GJ)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
",ifelse(reg=="GLO","World", as.character(df$region))," ",gsub("Price\\|Secondary Energy\\|","",df$variable), " price
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Secondary Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Secondary Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$SE$'Secondary Energy Prices') <- names(regionsList) - } - - out$legend$'Secondary Energy Prices'$description <- "

Secondary energy prices

" - out$legend$'Secondary Energy Prices'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"="solid")) }) - names(out$legend$'Secondary Energy Prices'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Secondary Energy Prices'$units <- "US$2005/GJ per year" - - #SE quantity - vars <- c("SE|Electricity (EJ/yr)", - "SE|Gases (EJ/yr)", - "SE|Heat (EJ/yr)", - "SE|Hydrogen (EJ/yr)", - "SE|Liquids (EJ/yr)", - "SE|Solids (EJ/yr)") - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",gsub("SE\\|","",as.character(df$variable)), " secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Total Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Total Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - return(ggplotly) - }) - names(out$plotly$SE$'Total Secondary Energy') <- names(regionsList) - } - - out$legend$'Total Secondary Energy'$description <- "

Secondary energy per carrier

" - out$legend$'Total Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Total Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Total Secondary Energy'$contents <- c(list("Total secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Total Secondary Energy'$contents) - out$legend$'Total Secondary Energy'$units <- "EJ per year" - - ### SE Electricity - #var.tot <-"SE|Electricity (EJ/yr)" - vars <- c("Coal with CC" = "SE|Electricity|Coal|w/ CC (EJ/yr)", - "Coal without CC" = "SE|Electricity|Coal|w/o CC (EJ/yr)", - "Oil" = "SE|Electricity|Oil (EJ/yr)", - "Gas with CC" = "SE|Electricity|Gas|w/ CC (EJ/yr)", - "Gas without CC" = "SE|Electricity|Gas|w/o CC (EJ/yr)", - "Biomass with CC" = "SE|Electricity|Biomass|w/ CC (EJ/yr)", - "Biomass without CC" = "SE|Electricity|Biomass|w/o CC (EJ/yr)", - "Nuclear" = "SE|Electricity|Nuclear (EJ/yr)", - "Hydrogen" = "SE|Electricity|Hydrogen (EJ/yr)", - "Solar" = "SE|Electricity|Solar (EJ/yr)", - "Wind" = "SE|Electricity|Wind (EJ/yr)", - "Geothermal" = "SE|Electricity|Geothermal (EJ/yr)", - "Hydro" = "SE|Electricity|Hydro (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$value <- 1/0.0036 * df$value # converting from EJ to TWh - df$unit <- "TWh/yr" - df$details <- paste0(round(df$value,2)," TWh
",names(vars[df$variable]), " electricity secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," TWh
","Total electricity secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) - #+ annotate("text", x=2015,y=Inf, label = unique(df$region), hjust = 0, vjust = 2, size=3.5) - ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Electricity Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Electricity Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Electricity Secondary Energy') <- names(regionsList) - } - - out$legend$'Electricity Secondary Energy'$description <- "

Electricity secondary energy per carrier

" - out$legend$'Electricity Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Electricity Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Electricity Secondary Energy'$contents <- c(list("Total electricity secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Electricity Secondary Energy'$contents) - out$legend$'Electricity Secondary Energy'$units <- "Terawatt hour per year" - - - ### SE Biomass - - ### SE Gases - #var.tot <-"SE|Gases (EJ/yr)" - vars <- c("Biomass with CC" = "SE|Gases|Biomass|w/ CC (EJ/yr)", - "Biomass without CC" = "SE|Gases|Biomass|w/o CC (EJ/yr)", - "Coal with CC" = "SE|Gases|Coal|w/ CC (EJ/yr)", - "Coal without CC" = "SE|Gases|Coal|w/o CC (EJ/yr)", - "Natural Gas" = "SE|Gases|Natural Gas (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " gases secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total gases secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Gases Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Gases Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Gases Secondary Energy') <- names(regionsList) - } - - out$legend$'Gases Secondary Energy'$description <- "

Gases secondary energy per carrier

" - out$legend$'Gases Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Gases Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Gases Secondary Energy'$contents <- c(list("Total gases secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Gases Secondary Energy'$contents) - out$legend$'Gases Secondary Energy'$units <- "EJ per year" - - ### SE Heat - #var.tot <-"SE|Heat (EJ/yr)" - vars <- c("Biomass" = "SE|Heat|Biomass (EJ/yr)", - "Coal" = "SE|Heat|Coal (EJ/yr)", - "Gas" = "SE|Heat|Gas (EJ/yr)", - "Heat Pump" = "SE|Heat|Electricity|Heat Pump (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " heat secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total heat secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Heat Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Heat Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Heat Secondary Energy') <- names(regionsList) - } - - out$legend$'Heat Secondary Energy'$description <- "

Heat secondary energy per carrier

" - out$legend$'Heat Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Heat Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Heat Secondary Energy'$contents <- c(list("Total heat secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Heat Secondary Energy'$contents) - out$legend$'Heat Secondary Energy'$units <- "EJ per year" - - ### SE Liquids - #var.tot <-"SE|Liquids (EJ/yr)" - vars <- c("Biomass" = "SE|Liquids|Biomass (EJ/yr)", - "Coal with CC" = "SE|Liquids|Coal|w/ CC (EJ/yr)", - "Coal without CC" = "SE|Liquids|Coal|w/o CC (EJ/yr)", - "Gas with CC" = "SE|Liquids|Gas|w/ CC (EJ/yr)", - "Gas without CC" = "SE|Liquids|Gas|w/o CC (EJ/yr)", - "Oil" = "SE|Liquids|Oil (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " liquids secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total liquids secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Liquids Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Liquids Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Liquids Secondary Energy') <- names(regionsList) - } - - out$legend$'Liquids Secondary Energy'$description <- "

Liquids secondary energy per carrier

" - out$legend$'Liquids Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Liquids Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Liquids Secondary Energy'$contents <- c(list("Total liquids secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Liquids Secondary Energy'$contents) - out$legend$'Liquids Secondary Energy'$units <- "EJ per year" - - ### SE Solids - #var.tot <-"SE|Solids (EJ/yr)" - vars <- c("Biomass" = "SE|Solids|Biomass (EJ/yr)", - "Traditional Biomass" = "SE|Solids|Traditional Biomass (EJ/yr)", - "Coal" = "SE|Solids|Coal (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " solids secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total solids secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Solids Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Solids Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Solids Secondary Energy') <- names(regionsList) - } - - out$legend$'Solids Secondary Energy'$description <- "

Solids secondary energy per carrier

" - out$legend$'Solids Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Solids Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Solids Secondary Energy'$contents <- c(list("Total solids secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Solids Secondary Energy'$contents) - out$legend$'Solids Secondary Energy'$units <- "EJ per year" - - ### SE Hydrogen - #var.tot <-"SE|Hydrogen (EJ/yr)" - vars <- c("Biomass with CC" = "SE|Hydrogen|Biomass|w/ CC (EJ/yr)", - "Biomass without CC" = "SE|Hydrogen|Biomass|w/o CC (EJ/yr)", - "Coal with CC" = "SE|Hydrogen|Coal|w/ CC (EJ/yr)", - "Coal without CC" = "SE|Hydrogen|Coal|w/o CC (EJ/yr)", - "Gas with CC" = "SE|Hydrogen|Gas|w/ CC (EJ/yr)", - "Gas without CC" = "SE|Hydrogen|Gas|w/o CC (EJ/yr)", - "Electricity" = "SE|Hydrogen|Electricity (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " hydrogen secondary energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total hydrogen secondary energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$SE$'Hydrogen Secondary Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$SE$'Hydrogen Secondary Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$SE$'Hydrogen Secondary Energy') <- names(regionsList) - } - - out$legend$'Hydrogen Secondary Energy'$description <- "

Hydrogen secondary energy per carrier

" - out$legend$'Hydrogen Secondary Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Hydrogen Secondary Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Hydrogen Secondary Energy'$contents <- c(list("Total hydrogen secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Hydrogen Secondary Energy'$contents) - out$legend$'Hydrogen Secondary Energy'$units <- "EJ per year" - - ##### FINAL ENERGY - - #var.tot <-"FE (EJ/yr)" - vars <- c("Electricity" = "FE|Electricity (EJ/yr)", - "Solids" = "FE|Solids (EJ/yr)", - "Liquids" = "FE|Liquids (EJ/yr)", - "Gases" = "FE|Gases (EJ/yr)", - "Heat" = "FE|Heat (EJ/yr)", - "Hydrogen" = "FE|Hydrogen (EJ/yr)"#, - #"FE|Solar (EJ/yr)", - #"FE|Other (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",gsub(".*\\|","",as.character(df$variable)), " final energy consumption in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total final energy in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Total Final Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Total Final Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Total Final Energy') <- names(regionsList) - } - - out$legend$'Total Final Energy'$description <- "

Final energy per carrier

" - out$legend$'Total Final Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Total Final Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Total Final Energy'$contents <- c(list("Total secondary energy" =list("fill"="#000","linetype"="dashed")),out$legend$'Total Final Energy'$contents) - out$legend$'Total Final Energy'$units <- "EJ per year" - - #price - vars <- c("Price|Final Energy|Buildings (US$2005/GJ)", - #"Price|Final Energy|Transport (US$2005/GJ)", - "Price|Final Energy|Industry (US$2005/GJ)" - ) - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
", ifelse(reg=="GLO","World", as.character(df$region)), " final energy price for ",gsub("Price\\|Final Energy\\|","",df$variable), "
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Final Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Final Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - if(length(ggplotly$x$layout$annotations)>4) - for (i in 4:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Final Energy Prices') <- names(regionsList) - } - - out$legend$'Final Energy Prices'$description <- "

Final energy prices

" - out$legend$'Final Energy Prices'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"="solid")) }) - names(out$legend$'Final Energy Prices'$contents) <- gsub(".*\\|","",gsub(" \\(.*","",vars)) - out$legend$'Final Energy Prices'$units <- "US$2005/GJ per year" - - ### FE Transport - - #var.tot <-"FE|Transport (EJ/yr)" - vars <- c("Electricity" = "FE|Transport|Electricity (EJ/yr)", - "Liquids - Fossil" = "FE|Transport|Liquids|Fossil (EJ/yr)", - #"Liquids - Oil" = "FE|Transport|Liquids|Oil (EJ/yr)", - #"Liquids - Coal" = "FE|Transport|Liquids|Coal (EJ/yr)", - "Liquids - Biomass" = "FE|Transport|Liquids|Biomass (EJ/yr)", - #"FE|Transport|Gases (EJ/yr)", - "Hydrogen" = "FE|Transport|Hydrogen (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " use by transport in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total final energy use by transportat in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Transport Final Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Transport Final Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Transport Final Energy') <- names(regionsList) - } - - out$legend$'Transport Final Energy'$description <- "

Transport final energy use per carrier

" - out$legend$'Transport Final Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Transport Final Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Transport Final Energy'$contents <- c(list("Total final energy use by transport" =list("fill"="#000","linetype"="dashed")),out$legend$'Transport Final Energy'$contents) - out$legend$'Transport Final Energy'$units <- "EJ per year" - - #price - vars <- c("Price|Final Energy|Electricity|Transport (US$2005/GJ)", - "Price|Final Energy|Liquids|Transport (US$2005/GJ)", - "Price|Final Energy|Hydrogen|Transport (US$2005/GJ)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
", ifelse(reg=="GLO","World", as.character(df$region)), " ",as.character(variable_label[as.character(df$variable)]), " final energy price for transport
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Transport Final Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Transport Final Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - if(length(ggplotly$x$layout$annotations)>4) - for (i in 4:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Transport Final Energy Prices') <- names(regionsList) - } - - out$legend$'Transport Final Energy Prices'$description <- "

Transport final energy Prices prices

" - out$legend$'Transport Final Energy Prices'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"="solid")) }) - names(out$legend$'Transport Final Energy Prices'$contents) <- as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))) - out$legend$'Transport Final Energy Prices'$units <- "US$2005/GJ per year" - - ### FE Industry - #var.tot <-"FE|Industry (EJ/yr)" - vars <- c("Electricity" = "FE|Industry|Electricity (EJ/yr)", - "Liquids" = "FE|Industry|Liquids (EJ/yr)", - "Gases" = "FE|Industry|Gases (EJ/yr)", - "Heat" = "FE|Industry|Heat (EJ/yr)", - "Solids" = "FE|Industry|Solids (EJ/yr)", -# "Solids - Coal" = "FE|Industry|Solids|Coal (EJ/yr)", -# "Solids - Biomass" = "FE|Industry|Solids|Biomass (EJ/yr)", - "Hydrogen" = "FE|Industry|Hydrogen (EJ/yr)"#, - #"FE|Industry|Other (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " use by industry in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total final energy use by industry in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Industry Final Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Industry Final Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Industry Final Energy') <- names(regionsList) - } - - out$legend$'Industry Final Energy'$description <- "

Industry final energy use per carrier

" - out$legend$'Industry Final Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Industry Final Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Industry Final Energy'$contents <- c(list("Total final energy use by industry" =list("fill"="#000","linetype"="dashed")),out$legend$'Industry Final Energy'$contents) - out$legend$'Industry Final Energy'$units <- "EJ per year" - - #price - vars <- c("Price|Final Energy|Electricity|Industry (US$2005/GJ)", - "Price|Final Energy|Heating Oil|Industry (US$2005/GJ)", - "Price|Final Energy|Gases|Industry (US$2005/GJ)", - "Price|Final Energy|Heat|Industry (US$2005/GJ)", - "Price|Final Energy|Solids|Industry (US$2005/GJ)", - "Price|Final Energy|Hydrogen|Industry (US$2005/GJ)") - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
", ifelse(reg=="GLO","World", as.character(df$region)), " ",as.character(variable_label[as.character(df$variable)]), " final energy price for industry
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color,alpha=aestethics$alpha) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Industry Final Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Industry Final Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - if(length(ggplotly$x$layout$annotations)>4) - for (i in 4:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Industry Final Energy Prices') <- names(regionsList) - } - - out$legend$'Industry Final Energy Prices'$description <- "

Industry final energy Prices prices

" - out$legend$'Industry Final Energy Prices'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"="solid")) }) - names(out$legend$'Industry Final Energy Prices'$contents) <- as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))) - out$legend$'Industry Final Energy Prices'$units <- "US$2005/GJ per year" - - ### FE Buildings - #var.tot <-"FE|Buildings (EJ/yr)" - vars <- c("Electricity" = "FE|Buildings|Electricity (EJ/yr)", - "Liquids" = "FE|Buildings|Liquids (EJ/yr)", - "Gases" = "FE|Buildings|Gases (EJ/yr)", - "Heat" = "FE|Buildings|Heat (EJ/yr)", - "Solids - Coal" = "FE|Buildings|Solids|Coal (EJ/yr)", - "Solids - Biomass" = "FE|Buildings|Solids|Biomass (EJ/yr)", - "Hydrogen" = "FE|Buildings|Hydrogen (EJ/yr)"#, - #"FE|Buildings|Other (EJ/yr)" - ) - - color <- plotstyle(as.character(gsub("\\+\\|","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2)," EJ
",names(vars[df$variable]), " use by buildings in ", ifelse(reg=="GLO","the World", as.character(df$region)),"
year: ",df$period) - g <- suppressWarnings( ggplot(data=df,aes_(x=~period,y=~value,fill=~variable,text=~details,group = ~variable)) + - geom_area(alpha=aestethics$alpha) + - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - geom_line(data=df %>% - group_by(.data$region,.data$period) %>% - summarise(value = sum(.data$value,na.rm=TRUE)) %>% - mutate(position= .data$value+max(.data$value)/1000) %>% - mutate(details= paste0(round(.data$value,2)," EJ
","Total final energy use by buildings in ", ifelse(reg=="GLO","the World", as.character(.data$region)),"
year: ",.data$period)) %>% - ungroup(), - aes_(~period,~position,text=~details,group = ~region),color="#000000",size=aestethics$line$size,inherit.aes = FALSE, linetype="dashed",alpha=aestethics$alpha) + - facet_wrap(~region, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_fill_manual(values = color) ) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Buildings Final Energy' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Buildings Final Energy' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - for (i in 1:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - if(ggplotly$x$layout$annotations[[i]]$y < 0.9) - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Buildings Final Energy') <- names(regionsList) - } - - out$legend$'Buildings Final Energy'$description <- "

Buildings final energy use per carrier

" - out$legend$'Buildings Final Energy'$contents <- lapply(names(gsub(" \\(.*","",vars)), function(var) { return(list("fill"=color[gsub(" \\(.*","",vars[var])],"linetype"=NULL)) }) - names(out$legend$'Buildings Final Energy'$contents) <- names(gsub(" \\(.*","",vars)) - out$legend$'Buildings Final Energy'$contents <- c(list("Total final energy use by buildings" =list("fill"="#000","linetype"="dashed")),out$legend$'Buildings Final Energy'$contents) - out$legend$'Buildings Final Energy'$units <- "EJ per year" - - #price - vars <- c("Price|Final Energy|Electricity|Buildings (US$2005/GJ)", - "Price|Final Energy|Heating Oil|Buildings (US$2005/GJ)", - "Price|Final Energy|Gases|Buildings (US$2005/GJ)", - "Price|Final Energy|Heat|Buildings (US$2005/GJ)", - "Price|Final Energy|Solids|Buildings (US$2005/GJ)", - "Price|Final Energy|Hydrogen|Buildings (US$2005/GJ)" - ) - - color <- plotstyle(as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))),unknown=missingColorsdf) - names(color) <- gsub(" \\(.*","",vars) - - g <- lapply(regionsList, function(reg) { - df <- as.quitte(data[reg,,vars]) - df$details <- paste0(round(df$value,2), " US$2005/GJ
", ifelse(reg=="GLO","World", as.character(df$region)), " ",as.character(variable_label[as.character(df$variable)]), " final energy price for buildings
", "year: ",df$period) - g <- ggplot(data=df,aes_(x=~period,y=~value,color=~variable,text=~details, group = ~variable)) + - geom_line(size=aestethics$line$size,alpha=aestethics$alpha) + # line plot - geom_vline(xintercept=as.numeric(min(df$period)),linetype=2, size=aestethics$`y-axis`$size, color=aestethics$`y-axis`$color) + # vertical line at initial year - facet_wrap(~region, ncol=3, scales="fixed") + - theme_minimal() + - labs(x = NULL, y = NULL) + - scale_color_manual(values = color) - if (length(reg) == 1) - g <- g + theme(strip.text.x = element_blank()) - else - g <- g + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - return(g) - }) - - if ("ggplot" %in% chartType){ - out$ggplot$FE$'Buildings Final Energy Prices' <- g - } - - if ("plotly" %in% chartType){ - out$plotly$FE$'Buildings Final Energy Prices' <- lapply(names(regionsList), function(reg) { - ggplotly <- ggplotly(g[[reg]], tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - if(length(ggplotly$x$layout$annotations)>4) - for (i in 4:length(ggplotly$x$layout$annotations)) #displacing facet titles a little down - ggplotly$x$layout$annotations[[i]]$y <- ggplotly$x$layout$annotations[[i]]$y - 0.04 - return(ggplotly) - }) - names(out$plotly$FE$'Buildings Final Energy Prices') <- names(regionsList) - } - - out$legend$'Buildings Final Energy Prices'$description <- "

Buildings final energy prices

" - out$legend$'Buildings Final Energy Prices'$contents <- lapply(gsub(" \\(.*","",vars), function(var) { return(list("fill"=color[var],"linetype"="solid")) }) - names(out$legend$'Buildings Final Energy Prices'$contents) <- as.character(gsub(" \\(.*","",shorten_legend(vars,identical_only=TRUE))) - out$legend$'Buildings Final Energy Prices'$units <- "US$2005/GJ per year" - - return(out) -} diff --git a/R/reportDiagnosis.R b/R/reportDiagnosis.R deleted file mode 100644 index 99e58906..00000000 --- a/R/reportDiagnosis.R +++ /dev/null @@ -1,507 +0,0 @@ -#' @title Create REMIND Diagnosis variables and plots -#' @description Create REMIND run diagnosis variables and plots -#' -#' -#' @param gdx GDX file -#' @param statsFile run statistics file -#' @param chartType plot type to include in output object. Either "plotly", "ggplot" or both c("plotly","ggplot") -#' @param includeData boolean to include diagnosis data in output (default: FALSE) -#' -#' @author Renato Rodrigues -#' -#' @examples -#' -#' \dontrun{ -#' reportDiagnosis(gdx="fulldata.gdx",statsFile="runstatistics.rda") -#' } -#' -#' @importFrom gdx readGDX -#' @importFrom lubridate seconds_to_period day hour minute second -#' @importFrom dplyr bind_rows summarise group_by mutate filter -#' @importFrom tidyr %>% -#' @importFrom quitte as.quitte -#' @importFrom ggplot2 ggplot geom_point geom_line scale_fill_manual -#' scale_y_discrete geom_rect geom_hline scale_x_continuous coord_cartesian -#' coord_flip geom_bar geom_text position_stack element_blank geom_boxplot -#' aes_ -#' @importFrom plotly ggplotly config hide_legend subplot layout style -#' @importFrom reshape2 dcast -#' @importFrom stats quantile IQR lag -#' @importFrom grDevices rgb -#' @importFrom RColorBrewer brewer.pal -#' -#' @export - -reportDiagnosis <- function(gdx=NULL,statsFile=NULL,chartType="ggplot",includeData=FALSE) { - - # error checking - if(!(!(is.null(gdx)) && file.exists(gdx))){ - warning("reportDiagnosis function require a valid gdx file path.") - return() - } - if(!(!(is.null(statsFile)) && file.exists(statsFile))){ - warning("reportDiagnosis function require a valid stats file.") - return() - } - - ### Aestethics Options - aestethics <- list("alpha"=0.6, - "line" = list("size"= 2/3.78), - "point" = list("size"= 2/3.78) - ) - - missingColors <- c( - "DEU"="#7F2704", - "EUW"="#FC4E2A", "EWN"="#FC4E2A", "FRA"="#E31A1C", - "EUS"="#FFEDA0", "ESW"="#FFEDA0", "ESC"=brewer.pal(9,"YlOrRd")[3], - "EUC"="#969696", "ECS"="#D9D9D9", "ECE"="#969696", - "EUN"="#4292C6", "ENC"="#6BAED6", "UKI"="#4292C6", - "NEU"="#78C679", "NEN"="#78C679", "NES"="#D9F0A3", - "CHE"="#78C679", "ENN"="#78C679", "ESE"="#D9F0A3","EUI"="#78C679", "ROE"="#D9F0A3", #older EU - "SSA"="#00BAFF", "REF"="#D900BC", "CAZ"="#007362", "CHA"="#F24200", - "Uranium"="#EF7676", "Goods"= "#00BFC4", - "optimal"="#00BFC4","feasible"="#ffcc66","infeasible"="#F8766D", - "yes"="#00BFC4","no"="#F8766D", - "optimal_alt"="#00BFC4", "feasible_alt"="#ffcc66") - missingColorsdf <- data.frame(row.names=names(missingColors), color=missingColors) - - plotlyButtonsToHide <- list('sendDataToCloud', 'zoom2d', 'pan2d', 'select2d', 'lasso2d', 'zoomIn2d', 'zoomOut2d', 'autoScale2d', 'resetScale2d', 'hoverClosestCartesian', 'hoverCompareCartesian', 'zoom3d', 'pan3d', 'orbitRotation', 'tableRotation', 'resetCameraDefault3d', 'resetCameraLastSave3d', 'hoverClosest3d', 'zoomInGeo', 'zoomOutGeo', 'resetGeo', 'hoverClosestGeo', 'hoverClosestGl2d', 'hoverClosestPie', 'resetSankeyGroup', 'toggleHover', 'resetViews', 'toggleSpikelines', 'resetViewMapbox') - - ### Auxiliar functions - - #Format time duration in seconds - format_duration <- function(dur,type="long") { - dur <- seconds_to_period(round(dur)) - if(type == "short") { - return(as.character(dur)) - } else { # long format - funs <- list(day, hour, minute, second) - names(funs) <- c("day", "hour", "minute", "second") - dur <- sapply(names(funs), function(x){ ifelse(funs[[x]](dur),paste0(funs[[x]](dur), " ", x, ifelse(funs[[x]](dur)>1, "s", ""), ""),"")}) - if(is.null(dim(dur))) - return (sub(",([^,]*)$", " and\\1", paste(dur[dur!=""], collapse = ', '))) - else { - out <- NULL - for (i in 1:length(dur[,1])) { - x <- dur[i,] - out <- c(out, sub(",([^,]*)$", " and\\1", paste(x[x!=""], collapse = ', '))) - } - return(out) - } - } - } - - - #create diagnosis object - diag <- list() - - ### Pre-loop errors - - # model did not created output - if(!file.exists(gdx)) { - diag$summary$status <- "fulldata.gdx file not found!" - return (diag) - } - - # Run failed before nash iterations - modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] - if (!(modelstat %in% c(1,2,3,4,5,6,7))){ - diag$summary$status <- "Run failed - Check code, pre-triangular infes ..." - return (diag) - } - - # TODO: check if model finished properly (full.log and log.txt files) -> "REMIND run finished!",logfile / "Stop" / "Run stopped - Cluster problem, HWCL exceeded ..." - - ### Model diagnosis - - # it converged? - diag$data$lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] - diag$data$maxIterations <- readGDX(gdx, name = "cm_iteration_max")[[1]] - - if(diag$data$lastIteration == diag$data$maxIterations) { # check if run converged before iterations limit - diag$summary$status <- "Iteration Limit" - diag$summary$statusMessage <- paste0("The solver did NOT converge within the maximum number of iterations allowed!") - } else { # check run convergence status - status <- list("1" = list("optimal", paste0("The solver converged after ", diag$data$lastIteration, " iterations")), - "2" = list("locally optimal", paste0("The solver converged after ", diag$data$lastIteration, " iterations")), - "3" = list("unbounded", "The model is unbounded!"), - "4" = list("infeasible", "The model is infeasible!"), - "5" = list("locally infeasible", "The model is locally infeasible!"), - "6" = list("intermediate infeasible","The model is intermediate infeasible!"), - "7" = list("intermediate nonoptimal",paste0("The solver found an intermediate nonoptimal solution after ", diag$data$lastIteration, " iterations"))) # ignored by REMIND in the o_modelstat parameter as it would imply a solution if the initial or any intermediate point is optimal - diag$summary$status <- status[[modelstat]][[1]] - diag$summary$statusMessage <- status[[modelstat]][[2]] - } - - #load runstatistics.rda - stats <- NULL - load(file = statsFile) - diag$data$runStatistics <- stats - - # run time - diag$data$runTime$seconds <- round(ifelse(attr(diag$data$runStatistics$runtime,'units')=="hours", as.numeric(diag$data$runStatistics$runtime*60*60), as.numeric(diag$data$runStatistics$runtime*60))) - diag$data$runTime$formated <- format_duration(diag$data$runTime$seconds,type="short") # short formated run time - diag$data$runTime$longFormat <- format_duration(diag$data$runTime$seconds) # long formated run time - - - ### Iteration details - - p80_repy_iteration <- as.quitte(readGDX(gdx, name = "p80_repy_iteration",restore_zeros = FALSE))[,c("solveinfo80","region","iteration","value")] - p80_repy_wide <- dcast(p80_repy_iteration, region + iteration ~ solveinfo80, value.var="value") - - # adding columns with per region objective difference between iterations (diff.objval) and convergence condition for objective value divergence - p80_repy_wide <- p80_repy_wide %>% - group_by(.data$region) %>% - mutate(diff.objval = .data$objval - lag(.data$objval, order_by=.data$iteration), - objvalCondition = ifelse(modelstat=="2",T, - ifelse(modelstat=="7" & is.na(.data$diff.objval), F, - ifelse(modelstat=="7" & abs(.data$diff.objval) < 1e-4, T, F)))) - - # adding column with per iteration convergence for objective value divergence (objvalConverge) - if any region did not converged in the difference between iteration objectives, then objvalConverge will be false for all regions in the respective iteration - p80_repy_wide <- p80_repy_wide %>% - group_by(.data$iteration) %>% - mutate(objvalConverge = all(.data$objvalCondition)) - - # adding column with literal string for model convergence (convergence). values: optimal, feasible or infeasible - p80_repy_wide$convergence <- "infeasible" - p80_repy_wide[(p80_repy_wide$modelstat == 1 & p80_repy_wide$solvestat == 1),"convergence"] <- "optimal" - p80_repy_wide[(p80_repy_wide$modelstat == 2 & p80_repy_wide$solvestat == 1),"convergence"] <- "optimal" - p80_repy_wide[(p80_repy_wide$modelstat == 7 & p80_repy_wide$solvestat == 4),"convergence"] <- "feasible" - - # saving convergence table - diag$data$summaryTable <- p80_repy_wide - - - ### Solver convergence plots - - ### solver status summary plot - - # forcing all convergence levels to be present - diag$data$summaryTable$convergence <- factor(diag$data$summaryTable$convergence,levels=c("infeasible", "feasible", "optimal")) - - # creating tooltip text (plotly) - data <- diag$data$summaryTable %>% - group_by(.data$iteration, .data$convergence) %>% - mutate(details = paste0("Iteration: ", .data$iteration,"
region: ",paste0(.data$region, collapse = ", "))) - - # solver status summary - optColor <- plotstyle(as.character(unique(data$convergence)),unknown=missingColorsdf) - regColor <- plotstyle(as.character(unique(data$region)),unknown=missingColorsdf) - - diag$plots$convergence <- ggplot(mapping = aes_(~iteration, ~convergence, text=~details))+ - geom_line(data = data, linetype = "dashed",aes_(group=~region, color=~region), alpha=aestethics$alpha, size=aestethics$line$size) + - geom_point(data = data %>% group_by(.data$iteration, .data$convergence, .data$details) %>% summarise(), aes_(fill=~convergence), size=2, alpha=aestethics$alpha) + - scale_fill_manual(values=optColor) + - scale_color_manual(values=regColor) + - scale_y_discrete(breaks=c("infeasible", "feasible", "optimal"), drop = FALSE) + - theme_minimal() + - labs(x = NULL, y = NULL) - - ### Trade balance plots - - ### Trade convergence - surplus <- as.quitte(readGDX(gdx, name = "p80_surplus",restore_zeros = F)[,c(2100,2150),])[c(6,7,8,9)] # c("peoil","pegas","pecoal","peur","pebiolc","good","perm") - surplus$value[is.na(surplus$value)] <- 0 - surplus$type <- ifelse(surplus$all_enty == "good", "Goods trade surplus", ifelse(surplus$all_enty == "perm", "Permits", "Primary energy trade surplus")) - - maxTol <- as.quitte(readGDX(gdx, name = "p80_surplusMaxTolerance",restore_zeros = F))[c(7,8)] - colnames(maxTol) <- c("maxTol","all_enty") - surplus <- merge(surplus,maxTol,by = "all_enty") - surplus[which(surplus$period==2150),]$maxTol <- surplus[which(surplus$period==2150),]$maxTol*10 - surplus$rectXmin <- as.numeric(surplus$iteration) - 0.5 - surplus$rectXmax <- as.numeric(surplus$iteration) + 0.5 - surplus$Surplus_within_limits <- ifelse(surplus$value > surplus$maxTol,"no", ifelse(surplus$value < -surplus$maxTol, "no", "yes")) - - diag$data$surplus <- surplus - - # filter surplus results - maxTol <- surplus %>% group_by(.data$type, .data$period, .data$iteration) %>% mutate(Surplus_within_limits = ifelse(all(.data$Surplus_within_limits=="yes"),"yes","no")) - maxTol <- maxTol[which(surplus$all_enty %in% c("peoil","good","perm")),][c(-1)] - - vars <- c("pecoal"="Coal","pegas"="Gas","peoil"="Oil","peur"="Uranium","good"="Goods","pebiolc"="Biomass") - surplus$name <- vars[surplus$all_enty] - - booleanColor <- plotstyle(as.character(unique(maxTol$Surplus_within_limits)),unknown=missingColorsdf) - surplusColor <- plotstyle(vars,unknown=missingColorsdf) - names(surplusColor) <- names(vars) - - surplus$tooltip <- paste0(ifelse(surplus$Surplus_within_limits=="no", - ifelse(surplus$value > surplus$maxTol, - paste0(surplus$name," trade surplus (", surplus$value, ") is greater than maximum tolerance (", surplus$maxTol, ")."), - paste0(surplus$name," trade surplus (", surplus$value, ") is lower than maximum tolerance (-", surplus$maxTol, ").")), - paste0(surplus$type," is within tolerance.")), - "
Iteration: ", surplus$iteration) - - maxTol$tooltip <- paste0(maxTol$type, ifelse(maxTol$Surplus_within_limits=="no", " outside tolerance limits.", " within tolerance limits.")) - - diag$plots$surplusConvergence <- suppressWarnings( ggplot() + - geom_line(data=surplus, aes_(x=~iteration, y=~value, color=~all_enty, group=~all_enty, text = ~tooltip), alpha=aestethics$alpha, size=aestethics$line$size) + - geom_rect(data=maxTol,aes_(xmin=~rectXmin, xmax=~rectXmax, ymin=~-maxTol, ymax=~maxTol, fill=~Surplus_within_limits, text = ~tooltip), inherit.aes = FALSE, alpha=aestethics$alpha) + - theme_minimal() + - ggtitle("Tradable goods surplus") + - facet_grid(type ~ period, scales = 'free_y') + - scale_color_manual(values=surplusColor) + - scale_fill_manual(values=booleanColor) + - labs(x = NULL, y = NULL) ) + - theme(axis.text.x = element_text(angle = 90, hjust = 1)) - - diag$plotly$surplusConvergence <- ggplotly(diag$plots$surplusConvergence, tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - - ### Trade convergence Summary - - surplusCondition <- surplus %>% group_by(.data$iteration) %>% summarise(Surplus_within_limits = ifelse(all(.data$Surplus_within_limits=="yes"),"yes","no")) - - surplusCondition$tooltip <- paste0("Iteration: ", surplusCondition$iteration, "
Converged") - for(iter in surplusCondition$iteration){ - if(all(surplusCondition[which(surplusCondition$iteration == iter),]$Surplus_within_limits == "no")){ - tooltip <- NULL - for (period in unique(surplus$period)){ - for (good in unique(surplus$all_enty)){ - currSurplus <- surplus[which(surplus$iteration == iter & surplus$period == period & surplus$all_enty == good),] - Surplus_within_limits <- ifelse(currSurplus$value > currSurplus$maxTol,"no", ifelse(currSurplus$value < -currSurplus$maxTol, "no", "yes")) - if(Surplus_within_limits == "no"){ - tooltip <- paste0(tooltip,"
", period, " | ", good, " | ", ifelse(currSurplus$value > currSurplus$maxTol, paste0(round(currSurplus$value,5), " > ", currSurplus$maxTol), paste0(round(currSurplus$value,5), " < ", -currSurplus$maxTol))) - } - } - } - tooltip <- paste0("Iteration: ", iter, "
Did not converged!", - "
Period | Trade | Surplus", tooltip) - surplusCondition[which(surplusCondition$iteration == iter),]$tooltip <- tooltip - } - } - - diag$plots$surplusSummary <- ggplot(surplusCondition, aes_(x = ~iteration, y="Trade\nSurplus", fill=~Surplus_within_limits, text = ~tooltip)) + - geom_hline(yintercept=0) + - theme_minimal() + - geom_point(size=2,alpha=aestethics$alpha) + - scale_fill_manual(values=booleanColor) + - scale_y_discrete(breaks=c("Trade\nSurplus"), drop = FALSE) + - labs(x = NULL, y = NULL) - - ### Objective function variation convergence plots - - ### Objective function variation condition. If the convergence condition is not respected, then the axis labels are red - data <- p80_repy_wide - - objVarCondition <- data[which(data$region == data$region[1]),]$objvalConverge - - axisColor <- ifelse(objVarCondition,"black", "red") - - diag$plots$objVar <- ggplot(data, aes_(x = ~iteration)) + - geom_point(aes_(y = ~diff.objval, col=~region),alpha=aestethics$alpha) + - theme_minimal() + - theme(axis.text.x = element_text(colour = axisColor)) - - ### Summary - objVarCondition <- p80_repy_wide[which(p80_repy_wide$region == p80_repy_wide$region[1]),]$objvalConverge - data <- data.frame(iteration = p80_repy_wide[which(p80_repy_wide$region == p80_repy_wide$region[1]),]$iteration, objVarCondition = ifelse(objVarCondition,"yes","no")) - - data$tooltip <- paste0("Iteration: ", data$iteration, "
Converged") - for(iter in unique(data$iteration)){ - if(!all(p80_repy_wide[which(p80_repy_wide$iteration == iter),]$objvalCondition)){ - tooltip <- NULL - for (reg in p80_repy_wide[which(p80_repy_wide$iteration == iter & p80_repy_wide$objvalCondition == F),]$region){ - - diff <- p80_repy_wide[which(p80_repy_wide$iteration == iter & p80_repy_wide$region == reg),]$diff.objval - - tooltip <- paste0(tooltip,"
", reg, " | ", round(diff,5)) - } - tooltip <- paste0("Iteration: ", iter, "
Did not converged!", - "
Region | Deviation", tooltip,"
The deviation limit is +- 0.0001") - data[which(data$iteration == iter),]$tooltip <- tooltip - } - } - - diag$plots$objVarSummary <- ggplot(data, aes_(x = ~iteration, y="Objective\nDeviation", fill=~objVarCondition, text=~tooltip)) + - geom_hline(yintercept=0) + - theme_minimal() + - geom_point(size=2,alpha=aestethics$alpha) + - scale_fill_manual(values=booleanColor) + - scale_y_discrete(breaks=c("Objective\nDeviation"), drop = FALSE) + - labs(x = NULL, y = NULL) - - - ### Price anticipation convergence plots - - diag$data$priceAntecipationFadeoutIteration <- as.vector(readGDX(gdx, name = "s80_fadeoutPriceAnticipStartingPeriod")) - - data <- data.frame(iteration = 1:diag$data$lastIteration) - - data <- data %>% mutate(fadeoutPriceAnticip = ifelse(.data$iteration < diag$data$priceAntecipationFadeoutIteration, 1,0.7**(.data$iteration - diag$data$priceAntecipationFadeoutIteration + 1)), - converged = ifelse(.data$fadeoutPriceAnticip > 1e-4, "no", "yes"), - tooltip = ifelse(.data$converged == "yes", paste0("Converged
Price Anticipation fade out is low enough
", round(.data$fadeoutPriceAnticip,5), " <= 0.0001"), - paste0("Did not converged
Price Anticipation fade out is not low enough
", round(.data$fadeoutPriceAnticip,5), " > 0.0001"))) - - - diag$plots$priceAnticipation <- suppressWarnings( ggplot(data, aes_(x = ~iteration)) + - geom_line(aes_(y=~fadeoutPriceAnticip), alpha=0.3, size=aestethics$line$size) + - geom_point(size=2, aes_(y=0.0001, fill=~converged, text = ~tooltip), alpha=aestethics$alpha) + - theme_minimal() + - scale_fill_manual(values=booleanColor) + - scale_y_continuous(breaks=c(0.0001), labels=c("Price\nAnticipation")) + - scale_x_continuous(breaks=c(data$iteration)) + - labs(x = NULL, y = NULL) + - coord_cartesian(ylim=c(-0.2, 1)) - ) - - ### Summary plot - - diag$plotly$'Convergence Report' <- subplot(ggplotly(diag$plots$convergence, tooltip = c("text")), - ggplotly(diag$plots$surplusSummary, tooltip = c("text")), - ggplotly(diag$plots$objVarSummary, tooltip = c("text")), - ggplotly(diag$plots$priceAnticipation, tooltip = c("text")), - nrows = 4, shareX = TRUE, titleX = FALSE, heights = c(0.4, 0.2, 0.2, 0.2), margin = c(.1,.1,.1,.0001)) %>% - hide_legend() %>% - config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) %>% - layout(margin=list(l=-100, r=10)) - - diag$legend$'Convergence Report'$description <- "

Conditions to REMIND convergence.
Convergence is only achieved if all conditions are met.


  • Condition one: each region must be optimal, or at most feasible in a latter iteration.
  • Condition two: market clearing for all tradable goods.
  • Condition three: stable objective function value for all regions.
  • Condition four: price anticipation slack must fade out.
" - diag$legend$'Convergence Report'$contents <- list("Convergence criteria met"=list("fill"=plotstyle("optimal",unknown=missingColorsdf),"linetype"=NULL), - "Partial convergence target met"=list("fill"=plotstyle("feasible",unknown=missingColorsdf),"linetype"=NULL), - "Not converged"=list("fill"=plotstyle("infeasible",unknown=missingColorsdf),"linetype"=NULL)) - - ### Time convergence plots - - # total convergence time per region and convergence type (value) - cumConvergenceTime <- diag$data$summaryTable %>% - group_by(.data$region, .data$convergence) %>% - summarise(value = sum(.data$resusd)) - - # total convergence time per region (total) - cumConvergenceTime <- cumConvergenceTime %>% - group_by(.data$region) %>% - mutate(total = sum(.data$value)) - - # tooltip text (plotly) - cumConvergenceTime$Details <- paste0("
Region: ",cumConvergenceTime$region, "
Duration: ", format_duration(cumConvergenceTime$value), "
Convergence: ", cumConvergenceTime$convergence, "
Total Duration: ", format_duration(cumConvergenceTime$total)) - - # Slowest iteration per region and convergence type - SlowestIteration <- diag$data$summaryTable %>% - group_by(.data$region, .data$convergence) %>% - filter(max(.data$resusd) == .data$resusd) %>% - summarise(value = .data$resusd, iteration = .data$iteration) - - # tooltip text (plotly) - SlowestIteration$Details <- paste0("
Region: ",SlowestIteration$region, "
Duration: ", format_duration(SlowestIteration$value), "
Iteration: ", SlowestIteration$iteration, "
Convergence: ", SlowestIteration$convergence) - - ### cumulative convergence time in minutes - diag$plots$cumConvergenceTime <- suppressWarnings( ggplot() + - geom_col(data = cumConvergenceTime, aes_(x = ~region, y = ~value/60, fill = ~convergence, text = ~Details), alpha=aestethics$alpha) + - theme_minimal() + - coord_flip(expand = FALSE) + - labs(x = NULL, y = NULL, title = "") + - theme(legend.position = 'bottom') + - ggtitle("Cumulative convergence time in minutes")) - - ### Slowest iteration per region and convergence type - diag$plots$SlowestIteration <- ggplot(data = SlowestIteration, aes_(x = ~region, y = ~value/60, fill = ~convergence, text = ~Details)) + - geom_bar(stat = "identity", alpha=aestethics$alpha) + - geom_text(aes_(label=~iteration), position=position_stack(vjust = 1), hjust = 1, size = 3) + - theme_minimal() + - coord_flip(expand = FALSE) + - labs(x = NULL, y = NULL, title = "") + - theme(legend.position = 'bottom') + - ggtitle("Slowest iteration per region and convergence type in minutes") - - ### cumulative convergence and slowest iteration charts merged - data <- bind_rows(cumConvergenceTime %>% mutate(variable = "Cumulative convergence time in minutes"), - SlowestIteration %>% mutate(variable = "Slowest iteration per region and convergence type in minutes")) - - convergenceTypeColor <- plotstyle(paste0(as.character(unique(data$convergence))),unknown=missingColorsdf) - names(convergenceTypeColor) <- as.character(unique(data$convergence)) - - diag$plots$iterationSummary <- ggplot(data=data,aes_(x = ~region, y = ~value/60, fill = ~convergence, text=~Details)) + - geom_bar(stat = "identity", alpha=aestethics$alpha) + - geom_text(aes_(label=~iteration), position=position_stack(vjust = 1), hjust = 1, size = 3) + - theme_minimal() + - scale_fill_manual(values=convergenceTypeColor) + - coord_flip(expand = FALSE) + - labs(x = NULL, y = NULL, title = "") + - theme(legend.position = 'bottom', legend.title=element_blank()) + - facet_wrap(~variable, ncol = 1, scales = 'free_x') - - diag$plotly$'Summary' <- ggplotly(diag$plots$iterationSummary, tooltip = c("text")) %>% - hide_legend() %>% - config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) %>% - layout(legend = list(orientation = "h", x = 0.4, y =-0.05)) %>% - style(textposition = "left") - - diag$legend$'Summary'$description <- "

Total solution time taken by each region and time of the slowest iteration per region and optimality type.

" - diag$legend$'Summary'$contents <- list("Optimal solution"=list("fill"=plotstyle("optimal",unknown=missingColorsdf),"linetype"=NULL), - "Feasible solution"=list("fill"=plotstyle("feasible",unknown=missingColorsdf),"linetype"=NULL)) - diag$legend$'Summary'$units <- "minutes" - - ### Detailed convergence time - data <- diag$data$summaryTable - - data$Details <- paste0("
Iteration: ",data$iteration, "
Duration: ", format_duration(data$resusd), "
Convergence: ", data$convergence, "
Region: ",data$region) - - diag$plots$iterationDetails <- ggplot(data = data, aes_(x = ~iteration, y = ~resusd, fill = ~convergence, text = ~Details)) + - geom_col(alpha=aestethics$alpha) + - theme_minimal() + - facet_wrap(~region) + #, scales = 'free' - scale_fill_manual(values=convergenceTypeColor) + - labs(x = NULL, y = NULL, title = "") + - theme(legend.position = 'bottom') + - ggtitle("Convergence time in seconds") + - theme(axis.text.x = element_text(angle = 90, hjust = 1)) - - diag$plotly$iterationDetails <- ggplotly(diag$plots$iterationDetails, tooltip = c("text")) %>% - hide_legend() %>% - config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) %>% - layout(legend = list(orientation = "h", x = 0.4, y =-0.05)) - - ### Convergence time per region and iteration (error bars) - is_outlier <- function(x) { #Get outliers - return(x < quantile(x, 0.25) - 1.5 * IQR(x) | x > quantile(x, 0.75) + 1.5 * IQR(x)) - } - - data <- diag$data$summaryTable %>% - group_by(.data$iteration) %>% - mutate(outlier = ifelse(is_outlier(.data$resusd), .data$resusd, as.numeric(NA))) - - #tooltip - data$Outlier_info <- paste0("
Region: ",data$region, "
Duration: ", format_duration(data$resusd), "
Iteration: ", data$iteration) - - color <- plotstyle(as.character(unique(data$region)),unknown=missingColorsdf) - - diag$plots$iterationProgress <- suppressWarnings( ggplot(data, aes_(x = ~iteration, y = ~resusd)) + - geom_boxplot(fill=rgb(0,0.75,0.75),alpha=aestethics$alpha) + - geom_point(aes_(x=~iteration, y=~outlier, fill=~region, text=~Outlier_info), size=2.5,alpha=aestethics$alpha) + - theme_minimal() + - scale_fill_manual(values=color) + - labs(x = NULL, y = "Seconds") - ) - - diag$plotly$'Execution time' <- ggplotly(diag$plots$iterationProgress, tooltip = c("text")) %>% hide_legend() %>% config(modeBarButtonsToRemove=plotlyButtonsToHide, displaylogo=FALSE) - - # remove contour created by plotly on outliers - diag$plotly$'Execution time'$x$data <- lapply(diag$plotly$'Execution time'$x$data, FUN = function(x){ - if(!(is.null(x$marker$outliercolor))){ - x$marker = list(opacity = 0) - } - return(x) - }) - - diag$legend$'Execution time'$description <- "

Regional time deviation and region outliers per iteration.

" - diag$legend$'Execution time'$contents <- lapply(as.character(unique(data$region)), function(reg) { return(list("fill"=color[reg],"linetype"=NULL)) }) - names(diag$legend$'Execution time'$contents) <- as.character(unique(data$region)) - diag$legend$'Execution time'$units <- "seconds" - - #preparing output object - out <- diag - - #remove data from output object - if(!(includeData)){ - out$data <- NULL - out$data$runTime$formated <- diag$data$runTime$formated - out$data$runTime$longFormat <- diag$data$runTime$longFormat - out$data$runStatistics$config$gms$optimization <- diag$data$runStatistics$config$gms$optimization - } - - #remove extra plot types from output object - if(!(length(setdiff(c("plotly","ggplot"),chartType))) == 0) - out[[setdiff(c("plotly","ggplot"),chartType)]] <- NULL - - return(out) -} diff --git a/inst/markdown/dashboard.Rmd b/inst/markdown/dashboard.Rmd deleted file mode 100644 index 36d101f2..00000000 --- a/inst/markdown/dashboard.Rmd +++ /dev/null @@ -1,1938 +0,0 @@ ---- -title: "REMIND Dashboard" -output: - flexdashboard::flex_dashboard: - orientation: columns - vertical_layout: fill -params: - gdx: "fulldata.gdx" - statsFile: "runstatistics.rda" - regionMapping: "regionmappingH12.csv" - hist: NULL - reportfile: "REMIND_generic_Base.mif" ---- - - - - -
-
-
- - - -```{r loading_libraries, include=FALSE} - #loading required libraries - #library(remind2) - library(knitr) - library(flexdashboard) -``` - -```{r global_options, include=FALSE} - # setting global R chunk options (https://yihui.name/knitr/options/#chunk_options) - knitr::opts_chunk$set(dev='svg', fig.asp = 1 ) # fig.asp = default aspect ratio -``` - -```{r loading_diagnosis_charts, include=FALSE} - # loading diagnosis results - diag <- reportDiagnosis(gdx=gdx, statsFile=statsFile, chartType="plotly") -``` - -```{r loading_REMIND_charts, include=FALSE} - #loading REMIND results and plots - out <- reportCharts(gdx=gdx, regionMapping=regionMapping, hist=hist, reportfile=reportfile, chartType="plotly") -``` - -```{r creating_info_tooltips, include=FALSE} - #data frame with help tooltips - # helpTooltip_df <- data.frame( - # title=c("Convergence Report","Carbon Price","CO2 Emissions per Sector","Main Greenhouse Gases Emissions","F-Gases","Kyoto Gases Emissions","Other Gases"), - # placement=c("right","right","top","right","right","left","left")) - helpTooltip_df <- data.frame( - title=c("Convergence Report","Execution time","Summary", - "Carbon Price","CO2 Emissions per Sector","Kyoto Gases Emissions", - "Total Primary Energy","Primary Energy Prices","Coal production","Gas production","Oil production","Uranium production","Biomass production", - "Secondary Energy Prices","Total Secondary Energy","Electricity Secondary Energy","Liquids Secondary Energy","Gases Secondary Energy","Heat Secondary Energy","Solids Secondary Energy","Hydrogen Secondary Energy", - "Final Energy Prices","Total Final Energy","Buildings Final Energy Prices","Buildings Final Energy","Transport Final Energy Prices","Transport Final Energy","Industry Final Energy Prices","Industry Final Energy"), - placement=c("right","none","top", - "none","right","left", - "right","right","left","left","left","left","left", - "right","right","right","right","right","left","top","top", - "right","right","right","right","right","right","left","top")) - legend <- c(diag$legend,out$legend) -``` - -```{r hidding_unused_region_menus, include=FALSE} - #control region menus appearance - showMenu <- list() - for (region in names(out$data$regions)) - showMenu[[region]] <- TRUE - -``` - - -```{r loading_aesthetics, include=FALSE} - #aesthetics - aesthetics <- list( - color = c( "Iteration Limit" = "warning", - # solver status - "optimal"="success", - "locally optimal"="success", #theme colors “primary”, “info”, “success”, “warning”, and “danger” - "unbounded"="danger", - "infeasible"="danger", - "locally infeasible"="danger", - "intermediate infeasible"="danger", - "intermediate nonoptimal"="warning", - # solving time - "solvingTime"="primary"), - icon = c( "Iteration Limit" = "glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - # solver status - "optimal"="glyphicon glyphicon-thumbs-up", #fa-thumbs-up - "locally optimal"="glyphicon glyphicon-thumbs-up", #fa-thumbs-up - "unbounded"="glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - "infeasible"="glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - "locally infeasible"="glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - "intermediate infeasible"="glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - "intermediate nonoptimal"="glyphicon glyphicon-exclamation-sign", #fa-exclamation-triangle - # solving time - "solvingTime"="glyphicon glyphicon-time") - ) -``` - - - - - - - - -Diagnosis {data-orientation=rows data-icon="glyphicon glyphicon-stats"} -===================================== - -Side Navigation {.sidebar .sidebarDiagnosis data-width=60} -------------------------------------- - -[](#diagnosis){class="glyphicon glyphicon-stats sidebar-button selected"} -[](#coupled-models-report){class="glyphicon glyphicon-link sidebar-button"} - - -Row ------------------------------------------------------------------------ - -### Iterations number {data-width=200} - -```{r} - valueBox(diag$summary$status, - caption=diag$summary$statusMessage, - color = aesthetics$color[[diag$summary$status]], - icon = aesthetics$icon[[diag$summary$status]]) -``` - -### Solving time {data-width=200} - -```{r} - valueBox(diag$data$runTime$formated, - caption=paste0("The runtime was ", diag$data$runTime$longFormat), - color = aesthetics$color[["solvingTime"]], - icon = aesthetics$icon[["solvingTime"]]) -``` - -### Additional info {data-width=400} - -Execution type = `r diag$data$runStatistics$config$gms$optimization` - -Row {data-height=300} -------------------------------------- - -### Convergence Report {.hasModal data-width=300 data-target=".surplusConvergence"} - -```{r} - diag$plotly$'Convergence Report' -``` - - - - - -### {data-width=100} - -```{r} -# regions mapping - out$maps$world -``` - -Row {data-height=400} -------------------------------------- -### Execution time - -```{r fig.width = 12, fig.asp = .2} - diag$plotly$'Execution time' -``` - -### Summary {.hasModal data-target=".iterationDetails"} - -```{r fig.width = 12, fig.asp = .2} - diag$plotly$'Summary' -``` - - - - - - - -Coupled Models Report {data-orientation=rows .hidden data-icon="glyphicon glyphicon-link"} -===================================== - -Side Navigation {.sidebar .sidebarDiagnosis data-width=60} -------------------------------------- - -[](#diagnosis){class="glyphicon glyphicon-stats sidebar-button"} -[](#coupled-models-report){class="glyphicon glyphicon-link sidebar-button selected"} - - -Row ------------------------------------------------------------------------ - -### Electricity - -### Transport - -Row ------------------------------------------------------------------------ - -### Air Polution - -### Damages - - - - - - - - -Emissions {data-orientation=columns data-icon="glyphicon glyphicon-cloud"} -===================================== - -Side Navigation {.sidebar .sidebarEmissions data-width=60} -------------------------------------- - -[](#emissions){class="ico-GLO selected sidebar-button"} -[](#emissions---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#emissions---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#emissions---neu){class="ico-NEU sidebar-button"}') -``` - -Column {data-width=600} -------------------------------------- - -### Carbon Price - -```{r} - out$plotly$emissions$'Carbon Price'$world -``` - -### CO2 Emissions per Sector - -```{r} - out$plotly$emissions$'CO2 Emissions per Sector'$world -``` - - -Column {data-width=300} -------------------------------------- - -### Main Greenhouse Gases Emissions - -```{r} - out$plotly$emissions$'Main Greenhouse Gases Emissions'$world -``` - -### F-Gases - -```{r} - out$plotly$emissions$'F-Gases'$world -``` - -Column {data-width=300} -------------------------------------- - - -### Kyoto Gases Emissions {data-height=200} - -```{r} - out$plotly$emissions$'Kyoto Gases Emissions'$world -``` - -### Other Gases {data-height=400} - -```{r} - out$plotly$emissions$'Other Gases'$world -``` - - - - -Emissions - Regional {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarEmissions data-width=60} -------------------------------------- - -[](#emissions){class="ico-GLO sidebar-button"} -[](#emissions---regional){class="ico-regions sidebar-button selected"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#emissions---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#emissions---neu){class="ico-NEU sidebar-button"}') -``` - -Column {data-width=600} -------------------------------------- - -### Carbon Price - -```{r} - out$plotly$emissions$'Carbon Price'$regions -``` - -### CO2 Emissions per Sector - -```{r} - out$plotly$emissions$'CO2 Emissions per Sector'$regions -``` - - -Column {data-width=300} -------------------------------------- - -### Main Greenhouse Gases Emissions - -```{r} - out$plotly$emissions$'Main Greenhouse Gases Emissions'$regions -``` - -### F-Gases - -```{r} - out$plotly$emissions$'F-Gases'$regions -``` - -Column {data-width=300} -------------------------------------- - - -### Kyoto Gases Emissions {data-height=200} - -```{r} - out$plotly$emissions$'Kyoto Gases Emissions'$regions -``` - -### Other Gases {data-height=400} - -```{r} - out$plotly$emissions$'Other Gases'$regions -``` - - - - - -Emissions - EUR {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarEmissions data-width=60} -------------------------------------- - -[](#emissions){class="ico-GLO sidebar-button"} -[](#emissions---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#emissions---eur){class="ico-EUR sidebar-button selected"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#emissions---neu){class="ico-NEU sidebar-button"}') -``` - -Column {data-width=600} -------------------------------------- - -### Carbon Price - -```{r} - out$plotly$emissions$'Carbon Price'$EUR -``` - -### CO2 Emissions per Sector - -```{r} - out$plotly$emissions$'CO2 Emissions per Sector'$EUR -``` - - -Column {data-width=300} -------------------------------------- - -### Main Greenhouse Gases Emissions - -```{r} - out$plotly$emissions$'Main Greenhouse Gases Emissions'$EUR -``` - -### F-Gases - -```{r} - out$plotly$emissions$'F-Gases'$EUR -``` - -Column {data-width=300} -------------------------------------- - - -### Kyoto Gases Emissions {data-height=200} - -```{r} - out$plotly$emissions$'Kyoto Gases Emissions'$EUR -``` - -### Other Gases {data-height=400} - -```{r} - out$plotly$emissions$'Other Gases'$EUR -``` - - -Emissions - NEU {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarEmissions data-width=60} -------------------------------------- - -[](#emissions){class="ico-GLO sidebar-button"} -[](#emissions---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#emissions---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#emissions---neu){class="ico-NEU sidebar-button selected"}') -``` - -Column {data-width=600} -------------------------------------- - -### Carbon Price - -```{r} - out$plotly$emissions$'Carbon Price'$NEU -``` - -### CO2 Emissions per Sector - -```{r} - out$plotly$emissions$'CO2 Emissions per Sector'$NEU -``` - - -Column {data-width=300} -------------------------------------- - -### Main Greenhouse Gases Emissions - -```{r} - out$plotly$emissions$'Main Greenhouse Gases Emissions'$NEU -``` - -### F-Gases - -```{r} - out$plotly$emissions$'F-Gases'$NEU -``` - -Column {data-width=300} -------------------------------------- - - -### Kyoto Gases Emissions {data-height=200} - -```{r} - out$plotly$emissions$'Kyoto Gases Emissions'$NEU -``` - -### Other Gases {data-height=400} - -```{r} - out$plotly$emissions$'Other Gases'$NEU -``` - - - - - - - -Primary Energy {data-orientation=columns} -===================================== - -Side Navigation {.sidebar .sidebarPrimaryEnergy data-width=60} -------------------------------------- - -[](#primary-energy){class="ico-GLO sidebar-button selected"} -[](#primary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#primary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#primary-energy---neu){class="ico-NEU sidebar-button"}') -``` - - -Column {data-width=600} -------------------------------------- - -### Primary Energy Prices - -```{r} - out$plotly$PE$'Primary Energy Prices'$world -``` - - -### Total Primary Energy - -```{r} - out$plotly$PE$'Total Primary Energy'$world$abs - out$plotly$PE$'Total Primary Energy'$world$perc - out$plotly$PE$'Total Primary Energy'$world$percapita -``` - -Column {data-width=300} -------------------------------------- - -### Coal production -```{r} - out$plotly$PE$'Coal production'$world -``` - -### Gas production -```{r} - out$plotly$PE$'Gas production'$world -``` - -Column {data-width=300} -------------------------------------- - -### Oil production -```{r} - out$plotly$PE$'Oil production'$world -``` - -### Uranium production -```{r} - out$plotly$PE$'Uranium production'$world -``` - -### Biomass production -```{r} - out$plotly$PE$'Biomass production'$world -``` - - - -Primary Energy - Regional {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarPrimaryEnergy data-width=60} -------------------------------------- - -[](#primary-energy){class="ico-GLO sidebar-button"} -[](#primary-energy---regional){class="ico-regions sidebar-button selected"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#primary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#primary-energy---neu){class="ico-NEU sidebar-button"}') -``` - - - -Column {data-width=600} -------------------------------------- - -### Total Primary Energy - -```{r} - out$plotly$PE$'Total Primary Energy'$regions$abs - out$plotly$PE$'Total Primary Energy'$regions$perc - out$plotly$PE$'Total Primary Energy'$regions$percapita -``` - -Column {data-width=300} -------------------------------------- - -### Coal production -```{r} - out$plotly$PE$'Coal production'$regions -``` - -### Gas production -```{r} - out$plotly$PE$'Gas production'$regions -``` - -Column {data-width=300} -------------------------------------- - -### Oil production -```{r} - out$plotly$PE$'Oil production'$regions -``` - -### Uranium production -```{r} - out$plotly$PE$'Uranium production'$regions -``` - -### Biomass production -```{r} - out$plotly$PE$'Biomass production'$regions -``` - - - - -Primary Energy - EUR {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarPrimaryEnergy data-width=60} -------------------------------------- - -[](#primary-energy){class="ico-GLO sidebar-button"} -[](#primary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#primary-energy---eur){class="ico-EUR sidebar-button selected"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#primary-energy---neu){class="ico-NEU sidebar-button"}') -``` - - - -Column {data-width=600} -------------------------------------- - -### Total Primary Energy - -```{r} - out$plotly$PE$'Total Primary Energy'$EUR$abs - out$plotly$PE$'Total Primary Energy'$EUR$perc - out$plotly$PE$'Total Primary Energy'$EUR$percapita -``` - -Column {data-width=300} -------------------------------------- - -### Coal production -```{r} - out$plotly$PE$'Coal production'$EUR -``` - -### Gas production -```{r} - out$plotly$PE$'Gas production'$EUR -``` - -Column {data-width=300} -------------------------------------- - -### Oil production -```{r} - out$plotly$PE$'Oil production'$EUR -``` - -### Uranium production -```{r} - out$plotly$PE$'Uranium production'$EUR -``` - -### Biomass production -```{r} - out$plotly$PE$'Biomass production'$EUR -``` - - - -Primary Energy - NEU {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarPrimaryEnergy data-width=60} -------------------------------------- - -[](#primary-energy){class="ico-GLO sidebar-button"} -[](#primary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#primary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#primary-energy---neu){class="ico-NEU sidebar-button selected"}') -``` - - - -Column {data-width=600} -------------------------------------- - -### Total Primary Energy - -```{r} - out$plotly$PE$'Total Primary Energy'$NEU$abs - out$plotly$PE$'Total Primary Energy'$NEU$perc - out$plotly$PE$'Total Primary Energy'$NEU$percapita -``` - -Column {data-width=300} -------------------------------------- - -### Coal production -```{r} - out$plotly$PE$'Coal production'$NEU -``` - -### Gas production -```{r} - out$plotly$PE$'Gas production'$NEU -``` - -Column {data-width=300} -------------------------------------- - -### Oil production -```{r} - out$plotly$PE$'Oil production'$NEU -``` - -### Uranium production -```{r} - out$plotly$PE$'Uranium production'$NEU -``` - -### Biomass production -```{r} - out$plotly$PE$'Biomass production'$NEU -``` - - - - - - -Secondary Energy {data-orientation=columns} -===================================== - -Side Navigation {.sidebar .sidebarSecondaryEnergy data-width=60} -------------------------------------- - -[](#secondary-energy){class="ico-GLO sidebar-button selected"} -[](#secondary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#secondary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#secondary-energy---neu){class="ico-NEU sidebar-button"}') -``` - -Column {data-width=600} -------------------------------------- - -### Secondary Energy Prices - -```{r} - out$plotly$SE$'Secondary Energy Prices'$world -``` - - -### Total Secondary Energy - -```{r} - out$plotly$SE$'Total Secondary Energy'$world -``` - - - Column {data-width=300} -------------------------------------- - -### Electricity Secondary Energy - -```{r} - out$plotly$SE$'Electricity Secondary Energy'$world -``` - - -### Liquids Secondary Energy - -```{r} - out$plotly$SE$'Liquids Secondary Energy'$world -``` - - -### Gases Secondary Energy - -```{r} - out$plotly$SE$'Gases Secondary Energy'$world -``` - - - - Column {data-width=300} -------------------------------------- - -### Heat Secondary Energy - -```{r} - out$plotly$SE$'Heat Secondary Energy'$world -``` - - -### Solids Secondary Energy - -```{r} - out$plotly$SE$'Solids Secondary Energy'$world -``` - - -### Hydrogen Secondary Energy - -```{r} - out$plotly$SE$'Hydrogen Secondary Energy'$world -``` - - - - -Secondary Energy - Regional {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarSecondaryEnergy data-width=60} -------------------------------------- - -[](#secondary-energy){class="ico-GLO sidebar-button"} -[](#secondary-energy---regional){class="ico-regions sidebar-button selected"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#secondary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#secondary-energy---neu){class="ico-NEU sidebar-button"}') -``` - - -Column {data-width=600} -------------------------------------- - -### Secondary Energy Prices - -```{r} - out$plotly$SE$'Secondary Energy Prices'$regions -``` - -### Total Secondary Energy - -```{r} - out$plotly$SE$'Total Secondary Energy'$regions -``` - - - Column {data-width=300} -------------------------------------- - -### Electricity Secondary Energy - -```{r} - out$plotly$SE$'Electricity Secondary Energy'$regions -``` - - -### Liquids Secondary Energy - -```{r} - out$plotly$SE$'Liquids Secondary Energy'$regions -``` - -### Gases Secondary Energy - -```{r} - out$plotly$SE$'Gases Secondary Energy'$regions -``` - - - - Column {data-width=300} -------------------------------------- - -### Heat Secondary Energy - -```{r} - out$plotly$SE$'Heat Secondary Energy'$regions -``` - - -### Solids Secondary Energy - -```{r} - out$plotly$SE$'Solids Secondary Energy'$regions -``` - - -### Hydrogen Secondary Energy - -```{r} - out$plotly$SE$'Hydrogen Secondary Energy'$regions -``` - - - - - -Secondary Energy - EUR {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarSecondaryEnergy data-width=60} -------------------------------------- - -[](#secondary-energy){class="ico-GLO sidebar-button"} -[](#secondary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#secondary-energy---eur){class="ico-EUR sidebar-button selected"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#secondary-energy---neu){class="ico-NEU sidebar-button"}') -``` - - -Column {data-width=600} -------------------------------------- - -### Secondary Energy Prices - -```{r} - out$plotly$SE$'Secondary Energy Prices'$EUR -``` - -### Total Secondary Energy - -```{r} - out$plotly$SE$'Total Secondary Energy'$EUR -``` - - - Column {data-width=300} -------------------------------------- - -### Electricity Secondary Energy - -```{r} - out$plotly$SE$'Electricity Secondary Energy'$EUR -``` - -### Liquids Secondary Energy - -```{r} - out$plotly$SE$'Liquids Secondary Energy'$EUR -``` - - -### Gases Secondary Energy - -```{r} - out$plotly$SE$'Gases Secondary Energy'$EUR -``` - - - - - Column {data-width=300} -------------------------------------- - -### Heat Secondary Energy - -```{r} - out$plotly$SE$'Heat Secondary Energy'$EUR -``` - - -### Solids Secondary Energy - -```{r} - out$plotly$SE$'Solids Secondary Energy'$EUR -``` - - -### Hydrogen Secondary Energy - -```{r} - out$plotly$SE$'Hydrogen Secondary Energy'$EUR -``` - - - - - -Secondary Energy - NEU {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarSecondaryEnergy data-width=60} -------------------------------------- - -[](#secondary-energy){class="ico-GLO sidebar-button"} -[](#secondary-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#secondary-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#secondary-energy---neu){class="ico-NEU sidebar-button selected"}') -``` - - -Column {data-width=600} -------------------------------------- - -### Secondary Energy Prices - -```{r} - out$plotly$SE$'Secondary Energy Prices'$NEU -``` - -### Total Secondary Energy - -```{r} - out$plotly$SE$'Total Secondary Energy'$NEU -``` - - - Column {data-width=300} -------------------------------------- - -### Electricity Secondary Energy - -```{r} - out$plotly$SE$'Electricity Secondary Energy'$NEU -``` - -### Liquids Secondary Energy - -```{r} - out$plotly$SE$'Liquids Secondary Energy'$NEU -``` - - -### Gases Secondary Energy - -```{r} - out$plotly$SE$'Gases Secondary Energy'$NEU -``` - - - - - Column {data-width=300} -------------------------------------- - -### Heat Secondary Energy - -```{r} - out$plotly$SE$'Heat Secondary Energy'$NEU -``` - - -### Solids Secondary Energy - -```{r} - out$plotly$SE$'Solids Secondary Energy'$NEU -``` - - -### Hydrogen Secondary Energy - -```{r} - out$plotly$SE$'Hydrogen Secondary Energy'$NEU -``` - - - - - - - - -Final Energy {data-orientation=columns} -===================================== - -Side Navigation {.sidebar .sidebarFinalEnergy data-width=60} -------------------------------------- - -[](#final-energy){class="ico-GLO sidebar-button selected"} -[](#final-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#final-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#final-energy---neu){class="ico-NEU sidebar-button"}') -``` - - -Column -------------------------------------- - -### Final Energy Prices - -```{r} - out$plotly$FE$'Final Energy Prices'$world -``` - -### Total Final Energy - -```{r} - out$plotly$FE$'Total Final Energy'$world -``` - - -Column -------------------------------------- - -### Buildings Final Energy Prices - -```{r} - out$plotly$FE$'Buildings Final Energy Prices'$world -``` - -### Buildings Final Energy - -```{r} - out$plotly$FE$'Buildings Final Energy'$world -``` - -Column -------------------------------------- - -### Transport Final Energy Prices - -```{r} - out$plotly$FE$'Transport Final Energy Prices'$world -``` - -### Transport Final Energy - -```{r} - out$plotly$FE$'Transport Final Energy'$world -``` - - -Column -------------------------------------- - -### Industry Final Energy Prices - -```{r} - out$plotly$FE$'Industry Final Energy Prices'$world -``` - -### Industry Final Energy - -```{r} - out$plotly$FE$'Industry Final Energy'$world -``` - - - - -Final Energy - Regional {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarFinalEnergy data-width=60} -------------------------------------- - -[](#final-energy){class="ico-GLO sidebar-button"} -[](#final-energy---regional){class="ico-regions sidebar-button selected"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#final-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#final-energy---neu){class="ico-NEU sidebar-button"}') -``` - - -Column -------------------------------------- - -### Final Energy Prices - -```{r} - out$plotly$FE$'Final Energy Prices'$regions -``` - -### Total Final Energy - -```{r} - out$plotly$FE$'Total Final Energy'$regions -``` - -Column -------------------------------------- - -### Buildings Final Energy Prices - -```{r} - out$plotly$FE$'Buildings Final Energy Prices'$regions -``` - -### Buildings Final Energy - -```{r} - out$plotly$FE$'Buildings Final Energy'$regions -``` - - -Column -------------------------------------- - -### Transport Final Energy Prices - -```{r} - out$plotly$FE$'Transport Final Energy Prices'$regions -``` - -### Transport Final Energy - -```{r} - out$plotly$FE$'Transport Final Energy'$regions -``` - -Column -------------------------------------- - -### Industry Final Energy Prices - -```{r} - out$plotly$FE$'Industry Final Energy Prices'$regions -``` - -### Industry Final Energy - -```{r} - out$plotly$FE$'Industry Final Energy'$regions -``` - - - - - -Final Energy - EUR {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarFinalEnergy data-width=60} -------------------------------------- - -[](#final-energy){class="ico-GLO sidebar-button"} -[](#final-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#final-energy---eur){class="ico-EUR sidebar-button selected"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#final-energy---neu){class="ico-NEU sidebar-button"}') -``` - -Column -------------------------------------- - -### Final Energy Prices - -```{r} - out$plotly$FE$'Final Energy Prices'$EUR -``` - -### Total Final Energy - -```{r} - out$plotly$FE$'Total Final Energy'$EUR -``` - -Column -------------------------------------- - -### Buildings Final Energy Prices - -```{r} - out$plotly$FE$'Buildings Final Energy Prices'$EUR -``` - -### Buildings Final Energy - -```{r} - out$plotly$FE$'Buildings Final Energy'$EUR -``` - - -Column -------------------------------------- - -### Transport Final Energy Prices - -```{r} - out$plotly$FE$'Transport Final Energy Prices'$EUR -``` - -### Transport Final Energy - -```{r} - out$plotly$FE$'Transport Final Energy'$EUR -``` - -Column -------------------------------------- - -### Industry Final Energy Prices - -```{r} - out$plotly$FE$'Industry Final Energy Prices'$EUR -``` - -### Industry Final Energy - -```{r} - out$plotly$FE$'Industry Final Energy'$EUR -``` - - - -Final Energy - NEU {data-orientation=columns .hidden data-icon="glyphicon glyphicon-th"} -===================================== - -Side Navigation {.sidebar .sidebarFinalEnergy data-width=60} -------------------------------------- - -[](#final-energy){class="ico-GLO sidebar-button"} -[](#final-energy---regional){class="ico-regions sidebar-button"} -```{r, results='asis'} - if (!is.null(showMenu$EUR)) - cat('\n[](#final-energy---eur){class="ico-EUR sidebar-button"}') - if (!is.null(showMenu$NEU)) - cat('\n[](#final-energy---neu){class="ico-NEU sidebar-button selected"}') -``` - -Column -------------------------------------- - -### Final Energy Prices - -```{r} - out$plotly$FE$'Final Energy Prices'$NEU -``` - -### Total Final Energy - -```{r} - out$plotly$FE$'Total Final Energy'$NEU -``` - -Column -------------------------------------- - -### Buildings Final Energy Prices - -```{r} - out$plotly$FE$'Buildings Final Energy Prices'$NEU -``` - -### Buildings Final Energy - -```{r} - out$plotly$FE$'Buildings Final Energy'$NEU -``` - - -Column -------------------------------------- - -### Transport Final Energy Prices - -```{r} - out$plotly$FE$'Transport Final Energy Prices'$NEU -``` - -### Transport Final Energy - -```{r} - out$plotly$FE$'Transport Final Energy'$NEU -``` - -Column -------------------------------------- - -### Industry Final Energy Prices - -```{r} - out$plotly$FE$'Industry Final Energy Prices'$NEU -``` - -### Industry Final Energy - -```{r} - out$plotly$FE$'Industry Final Energy'$NEU -``` - - - - - - - - - -```{r} -navBarMemory = function(topMenuLabel, sideBarClass){ - result = "" - result = paste0(result,""); - return(result) -} -``` - -```{r, results='asis'} - cat(navBarMemory("Diagnosis",".sidebarDiagnosis")) - cat(navBarMemory("Emissions",".sidebarEmissions")) - cat(navBarMemory("Primary Energy",".sidebarPrimaryEnergy")) - cat(navBarMemory("Secondary Energy",".sidebarSecondaryEnergy")) - cat(navBarMemory("Final Energy",".sidebarFinalEnergy")) -``` - - - -```{r} -# function to add html element with unit information -unitDiv = function(tooltipdf){ - title <- as.character(tooltipdf$title) - if (!(is.null(legend[[title]]$units))){ - unit <- as.vector(NULL) - for(i in 1:length(legend[[title]]$units)) - unit <- c(unit,paste0("data-unit-", i-1, "=\"", legend[[title]]$units[i], "\"")) - unit <- paste(as.vector(unit),collapse=" ") - result = "" - result = paste0(result,""); - return(result) - } -} -``` - - - -```{r} -# function to add tooltips -helpTooltip = function(tooltipdf){ - - title <- as.character(tooltipdf$title) - placement <- as.character(tooltipdf$placement) - - contents <- gsub('\n', '',gsub('"', '"',paste0(' -
-
', - legend[[title]]$description,' -
-
- - - ', - do.call(paste,lapply(names(legend[[title]]$contents),function(x){ - paste0('' - ) - })),' - -
', - ifelse(is.null(legend[[title]]$contents[[x]]$linetype), - paste0('
'), - paste0('
') - ),' - 		',x,'
-
-
'))) - - result = "" - result = paste0(result,""); - - return(result) -} -``` - - - - - - -```{r, results='asis'} -for(i in 1:nrow(helpTooltip_df)){ - cat(helpTooltip(helpTooltip_df[i,])) -} -``` - - - - - - - -```{r, results='asis'} -for(i in 1:nrow(helpTooltip_df)){ - cat(unitDiv(helpTooltip_df[i,])) -} -``` - - - - - - - - - - - - - - diff --git a/man/dashboard.Rd b/man/dashboard.Rd deleted file mode 100644 index 06a93e04..00000000 --- a/man/dashboard.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dashboard.R -\name{dashboard} -\alias{dashboard} -\title{REMIND dashboard} -\usage{ -dashboard( - gdx = NULL, - statsFile = NULL, - regionMapping = NULL, - hist = NULL, - reportfile = NULL, - output_file = NULL -) -} -\arguments{ -\item{gdx}{GDX (fulldata.gdx) file path} - -\item{statsFile}{run statistics (runstatistics.rda) file path} - -\item{regionMapping}{regionMapping file name or file path (ex. "regionmappingH12.csv")} - -\item{hist}{historical mif file path} - -\item{reportfile}{REMIND mif report file path} - -\item{output_file}{file name to save the html dashboard} -} -\description{ -Create REMIND dashboard results for single runs -} -\examples{ - \dontrun{ - # loading required libraries - library(remind2) - # creating the REMINd dashboard - dashboard(gdx="./output/Base/fulldata.gdx",statsFile="./output/Base/runstatistics.rda", - output_file="./output/Base/REMIND_dashboard_Base.html") - } - -} -\author{ -Renato Rodrigues -} diff --git a/man/reportCharts.Rd b/man/reportCharts.Rd deleted file mode 100644 index a0c7d82a..00000000 --- a/man/reportCharts.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reportCharts.R -\name{reportCharts} -\alias{reportCharts} -\title{Create REMIND reporting charts} -\usage{ -reportCharts( - gdx = NULL, - regionMapping = NULL, - hist = NULL, - reportfile = NULL, - chartType = "ggplot" -) -} -\arguments{ -\item{gdx}{GDX file path} - -\item{regionMapping}{regionMapping file name} - -\item{hist}{historic file path} - -\item{reportfile}{REMIND mif report file path} - -\item{chartType}{plot type to include in output object. Either "plotly", "ggplot" or both c("plotly","ggplot")} -} -\description{ -Create REMIND reporting plots -} -\examples{ - - \dontrun{ - reportCharts(gdx="fulldata.gdx",regionMapping="./config/regionmappingH12.csv") - } - -} -\author{ -Renato Rodrigues -} diff --git a/man/reportDiagnosis.Rd b/man/reportDiagnosis.Rd deleted file mode 100644 index 8e4149dd..00000000 --- a/man/reportDiagnosis.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/reportDiagnosis.R -\name{reportDiagnosis} -\alias{reportDiagnosis} -\title{Create REMIND Diagnosis variables and plots} -\usage{ -reportDiagnosis( - gdx = NULL, - statsFile = NULL, - chartType = "ggplot", - includeData = FALSE -) -} -\arguments{ -\item{gdx}{GDX file} - -\item{statsFile}{run statistics file} - -\item{chartType}{plot type to include in output object. Either "plotly", "ggplot" or both c("plotly","ggplot")} - -\item{includeData}{boolean to include diagnosis data in output (default: FALSE)} -} -\description{ -Create REMIND run diagnosis variables and plots -} -\examples{ - - \dontrun{ - reportDiagnosis(gdx="fulldata.gdx",statsFile="runstatistics.rda") - } - -} -\author{ -Renato Rodrigues -} From ea663d0be70d06df62ddc5f7390c29a2109dda6a Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 7 Dec 2023 16:35:10 +0100 Subject: [PATCH 02/11] add initial version of nashAnalysis markdown --- inst/markdown/nashAnalysis.Rmd | 407 +++++++++++++++++++++++++++++++++ 1 file changed, 407 insertions(+) create mode 100644 inst/markdown/nashAnalysis.Rmd diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd new file mode 100644 index 00000000..b5be74e6 --- /dev/null +++ b/inst/markdown/nashAnalysis.Rmd @@ -0,0 +1,407 @@ +--- +output: + html_document: + toc: true + toc_float: true + warning: false + message: false + fig.width: 7 + fig.height: 5 +title: Nash Iterations +--- + + +```{r loading_libraries, include=FALSE} +library(knitr) +library(dplyr) +library(magclass) +library(ggplot2) +library(quitte) +library(plotly) +library(remind2) +``` + +## Setup +```{r} +runPath <- "/home/benke/dev/pik-piam/miptemplate/SSP2EU-EU21-NDC_2023-11-01_19.58.36/" + +m2r <- gdx::readGDX(file.path(runPath, "/fulldata.gdx"), "module2realisation", restore_zeros = FALSE) +if (m2r[m2r$module == "optimization", "*"] != "nash") { + print("Warning: this script only supports nash optimizations") +} + +adjustSliderAnimation <- function(p){ + return(list(p[[1]] %>% animation_opts(frame = 1))) +} + +``` + +## p80_surplus + +### Read Data from gdx +```{r p80_surplus___READ} +p80_surplus <- mip::getPlotData("p80_surplus", runPath) %>% + mutate(tall := as.numeric(tall)) +str(p80_surplus) +``` + + +### Option 1 +```{r} + +p <- mip::mipIterations( + plotData = p80_surplus, + xAxis = "tall", facets = "all_enty", color = NULL, slider = "iteration", + facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + +### Option 2 +```{r results = "asis"} +p <- mip::mipIterations( + plotData = filter(p80_surplus, tall > 2005), # for this to work, we starting year must be available for all facets + xAxis = "iteration", slider = "tall", color = NULL, facets = "all_enty", facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) +``` + +### Option 3 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = p80_surplus, + xAxis = "tall", facets = NULL, color = "all_enty", slider = "iteration" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) +``` + + +### Option 4 +```{r results = "asis"} +p <- mip::mipIterations( + plotData = p80_surplus, + returnGgplots = TRUE, + xAxis = "iteration", facets = "tall", color = NULL, slider = NULL +) + +print(p) +``` + + +## p80_pvp_itr + +### Read Data from gdx +```{r p80_pvp_itr___READ} +p80_pvp_itr <- mip::getPlotData("p80_pvp_itr", runPath) %>% + mutate(ttot := as.numeric(ttot)) %>% + filter(ttot >= 2005) +str(p80_pvp_itr) +``` + + +### Option 1 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = p80_pvp_itr, + xAxis = "ttot", facets = "all_enty", color = NULL, slider = "iteration", + facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + +### Option 2 +```{r results = "asis"} + +p <- mip::mipIterations( + filter(p80_pvp_itr, ttot > 2005), # for this to work, we starting year must be available for all facets + xAxis = "iteration", slider = "ttot", color = NULL, facets = "all_enty", facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + +### Option 3 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = p80_pvp_itr, + xAxis = "ttot", facets = NULL, color = "all_enty", slider = "iteration" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + + +### Option 4 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = p80_pvp_itr, + returnGgplots = TRUE, + xAxis = "iteration", facets = "ttot", color = NULL, slider = NULL, + facetScales = "free_y" +) + +print(p) + +``` + +## price not discounted + +### Read Data from gdx +```{r results = "asis"} +price_not_discounted_itr <- left_join(p80_pvp_itr, + filter(p80_pvp_itr, all_enty == "good"), + by = c("ttot", "iteration") +) %>% + mutate( + all_enty = all_enty.x, + p80_pvp_itr_no_discount = p80_pvp_itr.x / p80_pvp_itr.y + ) %>% + select("ttot", "iteration", "all_enty", "p80_pvp_itr_no_discount") +``` + +### Option 1 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = price_not_discounted_itr, + xAxis = "ttot", facets = "all_enty", color = NULL, slider = "iteration", + facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + +### Option 2 +```{r results = "asis"} +p <- mip::mipIterations( + filter(price_not_discounted_itr, ttot > 2005), # for this to work, we starting year must be available for all facets + xAxis = "iteration", slider = "ttot", color = NULL, facets = "all_enty", facetScales = "free_y" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) +``` + +### Option 3 +```{r results = "asis"} + +p <- mip::mipIterations( + plotData = price_not_discounted_itr, + xAxis = "ttot", facets = NULL, color = "all_enty", slider = "iteration" +) %>% adjustSliderAnimation() + +htmltools::tagList(p) + +``` + +### Option 4 +```{r results = "asis"} +p <- mip::mipIterations( + plotData = price_not_discounted_itr, + returnGgplots = TRUE, + xAxis = "iteration", facets = "ttot", color = NULL, slider = NULL, + facetScales = "free_y" +) + +print(p) +``` + +## prices and surplus in one plot + +### Read Data from gdx +```{r results = "asis"} +prices_and_surplus <- left_join(p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration")) %>% + filter(!is.na(p80_pvp_itr_no_discount)) %>% + reshape2::melt(id.vars = c(1, 2, 3)) +``` + +### Option 1 +```{r results = "asis"} +for (v in unique(prices_and_surplus$all_enty)) { + p <- mip::mipIterations( + plotData = filter(prices_and_surplus, all_enty == v, tall >= 2005), + xAxis = "tall", facets = "variable", color = NULL, slider = "iteration", facetScales = "free_y" + ) %>% adjustSliderAnimation() + + print(htmltools::tagList(p)) +} +``` + +### Option 2 +```{r results = "asis"} +for (v in unique(prices_and_surplus$all_enty)) { + p <- mip::mipIterations( + plotData = filter(prices_and_surplus, all_enty == v, tall >= 2005), + xAxis = "iteration", facets = "variable", color = NULL, slider = "tall", facetScales = "free_y" + ) %>% adjustSliderAnimation() + + print(htmltools::tagList(p)) +} +``` + +### Option 3 +```{r results = "asis", fig.width=12, fig.height=5} +prices_and_surplus_scaled <- left_join(p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration")) %>% + filter(!is.na(p80_pvp_itr_no_discount)) + +for (v in unique(prices_and_surplus_scaled$all_enty)) { + df <- prices_and_surplus_scaled %>% + filter(all_enty == v) + + # scale factor per all_enty value + scale_factor <- round(select(df, "p80_surplus") %>% max() / + select(df, "p80_pvp_itr_no_discount") %>% max(), digits = 1) + + df <- df %>% + mutate(p80_pvp_itr_no_discount := p80_pvp_itr_no_discount * scale_factor) %>% + reshape2::melt(id.vars = c(1, 2, 3)) + + p <- mip::mipIterations( + plotData = df, returnGgplots = TRUE, + xAxis = "iteration", facets = "tall", color = "variable", slider = NULL, + facetScales = "free_y" + ) + + lapply(p, function(plot) { + plot <- plot + scale_y_continuous("p80_surplus", sec.axis = sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) + print(plot) + }) +} +``` + +## Convergence Plots +```{r results = "asis"} +diag <- plotNashConvergence(gdx = file.path(runPath, "/fulldata.gdx")) +htmltools::tagList(diag$plot) +htmltools::tagList(diag$tradeDetailPlot) +``` + +## Price Anticipation Plots + +### p80_DevPriceAnticipGlobMax2100Iter +p80_DevPriceAnticipGlobMax2100Iter(all_enty,iteration) "Track the 2100 value of p80_DevPriceAnticipGlobMax over iterations. [Unit: trillion Dollar]" +p80_DevPriceAnticipGlobAllMax2100Iter(iteration) "Track the 2100 value of p80_DevPriceAnticipGlobAllMax over iterations. [Unit: trillion Dollar]" + +```{r results = "asis"} + +df <- mip::getPlotData("p80_DevPriceAnticipGlobMax2100Iter", runPath) + +df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax2100Iter", runPath) %>% + mutate(all_enty = "all") %>% + rename(p80_DevPriceAnticipGlobMax2100Iter = p80_DevPriceAnticipGlobAllMax2100Iter) + +df <- rbind(df, df.all) + +p <- mip::mipIterations( + plotData = df, returnGgplots = TRUE, facetScales = "free_y", + xAxis = "iteration", facets = "all_enty", color = NULL, slider = NULL) + +# add logarithmic scale +p[[1]] + scale_y_log10() +``` + + +### p80_DevPriceAnticipGlobIter + +p80_DevPriceAnticipGlobIter(ttot,all_enty,iteration) "Track p80_DevPriceAnticipGlob over iterations. [Unit: trillion Dollar]" + +```{r results = "asis"} +df <- mip::getPlotData("p80_DevPriceAnticipGlobIter", runPath) %>% + mutate(ttot := as.numeric(ttot)) + +p <- mip::mipIterations( + plotData = df, + xAxis = "ttot", facets = "all_enty", slider = "iteration", + facetScales = "free_y", returnGgplots = TRUE +) %>% adjustSliderAnimation() + +# add logarithmic scale and then convert to plotly +plots <- p[[1]] + scale_y_log10() +plots <- list(plots) +plots <- lapply(plots, ggplotly) + +print(htmltools::tagList(plots)) +``` + + +### p80_PriceChangePriceAnticipReg + +p80_PriceChangePriceAnticipReg(ttot,all_enty,all_regi) "Price change of a trade good due to the price anticipation effect. [Unit: Percent]" + +```{r results = "asis"} +df <- mip::getPlotData("p80_PriceChangePriceAnticipReg", runPath) %>% + mutate(ttot := as.numeric(ttot)) %>% + select(-"iteration") + +mip::mipIterations( + plotData = df, returnGgplots = TRUE, + xAxis = "ttot", facets = "all_regi", color = "all_enty", slider = NULL, + facetScales = "free_y" +) +``` +### p80_DevPriceAnticipReg + +p80_DevPriceAnticipReg(ttot,all_enty,all_regi) "Deviation of the yearly monetary export/import expenditure due to price change anticipation effect. [Unit: trillion Dollar]" + +```{r results = "asis"} +df <- mip::getPlotData("p80_DevPriceAnticipReg", runPath) %>% + mutate(ttot := as.numeric(ttot)) %>% + select(-"iteration") + +mip::mipIterations( + plotData = df, returnGgplots = TRUE, + xAxis = "ttot", facets = "all_regi", color = "all_enty", slider = NULL, + facetScales = "free_y" +) +``` + +### p80_DevPriceAnticipGlob +p80_DevPriceAnticipGlob(ttot,all_enty) "Global sum of p80_DevPriceAnticipReg. [Unit: trillion Dollar]" +p80_DevPriceAnticipGlobAll(ttot) "p80_DevPriceAnticipGlob summed over all trade goods. [Units: trillion Dollar]" +p80_DevPriceAnticipGlobAllMax(ttot) "Max of p80_DevPriceAnticipGlobAll until the given year. [Unit: trillion Dollar]" +p80_DevPriceAnticipGlobMax(ttot,all_enty) "Max of p80_DevPriceAnticipGlob until the given year. [Unit: trillion Dollar]" + +```{r results = "asis"} +df <- mip::getPlotData("p80_DevPriceAnticipGlob", runPath) %>% + mutate(ttot := as.numeric(ttot)) %>% + select(-"iteration") + +df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAll", runPath) %>% + mutate(ttot := as.numeric(ttot), all_enty = "all") %>% + rename(p80_DevPriceAnticipGlob = p80_DevPriceAnticipGlobAll) %>% + select(-"iteration") + +df.allmax <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax", runPath) %>% + mutate(ttot := as.numeric(ttot), all_enty = "allmax") %>% + rename(p80_DevPriceAnticipGlob = p80_DevPriceAnticipGlobAllMax) %>% + select(-"iteration") + +df <- rbind(df, df.all, df.allmax) + +mip::mipIterations( + plotData = df, returnGgplots = TRUE, + xAxis = "ttot", facets = "all_enty", color = NULL, slider = NULL, + facetScales = "free_y" +) + +df.max <- mip::getPlotData("p80_DevPriceAnticipGlobMax", runPath) %>% + select(-"iteration") + +mip::mipIterations( + plotData = df.max, returnGgplots = TRUE, + xAxis = "ttot", facets = "all_enty", color = NULL, slider = NULL, + facetScales = "free_y" +) +``` From 76e0012091ac4170614c9b7306752146de9e6829 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 7 Dec 2023 16:52:43 +0100 Subject: [PATCH 03/11] adjust headings in markdown --- inst/markdown/nashAnalysis.Rmd | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index b5be74e6..7f8a0fa4 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -45,8 +45,7 @@ p80_surplus <- mip::getPlotData("p80_surplus", runPath) %>% str(p80_surplus) ``` - -### Option 1 +### x: time, slider: iter, facet: enty ```{r} p <- mip::mipIterations( @@ -59,7 +58,7 @@ htmltools::tagList(p) ``` -### Option 2 +### x: iter, slider: time, facet: enty ```{r results = "asis"} p <- mip::mipIterations( plotData = filter(p80_surplus, tall > 2005), # for this to work, we starting year must be available for all facets @@ -69,7 +68,7 @@ p <- mip::mipIterations( htmltools::tagList(p) ``` -### Option 3 +### x: time, slider: iter, color: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -81,7 +80,7 @@ htmltools::tagList(p) ``` -### Option 4 +### x: iter, facets: time ```{r results = "asis"} p <- mip::mipIterations( plotData = p80_surplus, @@ -93,7 +92,7 @@ print(p) ``` -## p80_pvp_itr +## trade price: p80_pvp_itr ### Read Data from gdx ```{r p80_pvp_itr___READ} @@ -104,7 +103,7 @@ str(p80_pvp_itr) ``` -### Option 1 +### x: time, slider: iter, facet: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -117,7 +116,7 @@ htmltools::tagList(p) ``` -### Option 2 +### x: iter, slider: time, facet: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -129,7 +128,7 @@ htmltools::tagList(p) ``` -### Option 3 +### x: time, slider: iter, color: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -141,8 +140,7 @@ htmltools::tagList(p) ``` - -### Option 4 +### x: iter, facets: time ```{r results = "asis"} p <- mip::mipIterations( @@ -171,7 +169,7 @@ price_not_discounted_itr <- left_join(p80_pvp_itr, select("ttot", "iteration", "all_enty", "p80_pvp_itr_no_discount") ``` -### Option 1 +### x: time, slider: iter, facet: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -184,7 +182,7 @@ htmltools::tagList(p) ``` -### Option 2 +### x: iter, slider: time, facet: enty ```{r results = "asis"} p <- mip::mipIterations( filter(price_not_discounted_itr, ttot > 2005), # for this to work, we starting year must be available for all facets @@ -194,7 +192,7 @@ p <- mip::mipIterations( htmltools::tagList(p) ``` -### Option 3 +### x: time, slider: iter, color: enty ```{r results = "asis"} p <- mip::mipIterations( @@ -206,7 +204,7 @@ htmltools::tagList(p) ``` -### Option 4 +### x: iter, facets: time ```{r results = "asis"} p <- mip::mipIterations( plotData = price_not_discounted_itr, @@ -227,7 +225,7 @@ prices_and_surplus <- left_join(p80_surplus, price_not_discounted_itr, by = c("t reshape2::melt(id.vars = c(1, 2, 3)) ``` -### Option 1 +### x: time, slider: iter, facet: var ```{r results = "asis"} for (v in unique(prices_and_surplus$all_enty)) { p <- mip::mipIterations( @@ -239,7 +237,7 @@ for (v in unique(prices_and_surplus$all_enty)) { } ``` -### Option 2 +### x: iter, slider: time, facet: var ```{r results = "asis"} for (v in unique(prices_and_surplus$all_enty)) { p <- mip::mipIterations( @@ -251,7 +249,7 @@ for (v in unique(prices_and_surplus$all_enty)) { } ``` -### Option 3 +### x: iter, facet: time, color: var ```{r results = "asis", fig.width=12, fig.height=5} prices_and_surplus_scaled <- left_join(p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration")) %>% filter(!is.na(p80_pvp_itr_no_discount)) From c65506c3081083b004e7135cb84e4dcefa402f80 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 8 Dec 2023 17:02:20 +0100 Subject: [PATCH 04/11] improve tradable goods surplus plot --- R/plotNashConvergence.R | 47 +++++++++++++++------------------- inst/markdown/nashAnalysis.Rmd | 2 +- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R index 41497ba9..2b898859 100644 --- a/R/plotNashConvergence.R +++ b/R/plotNashConvergence.R @@ -158,6 +158,7 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter as.quitte() %>% select(c("period", "value", "all_enty", "iteration")) %>% mutate( + "iteration" := as.numeric(.data$iteration), "value" := ifelse(is.na(.data$value), 0, .data$value), "type" := case_when( .data$all_enty == "good" ~ "Goods trade surplus", @@ -173,24 +174,17 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter surplus <- left_join(surplus, p80SurplusMaxTolerance, by = "all_enty") %>% mutate( "maxTol" := ifelse(.data$period == 2150, .data$maxTol * 10, .data$maxTol), - "withinLimits" := ifelse(abs(.data$value) > .data$maxTol, "no", "yes") + "withinLimits" := ifelse(.data$value > .data$maxTol, "no", "yes") ) data <- surplus data$tooltip <- paste0( ifelse(data$withinLimits == "no", - ifelse(data$value > data$maxTol, - paste0( - data$all_enty, " trade surplus (", data$value, - ") is greater than maximum tolerance (", data$maxTol, ")." - ), - paste0( - data$all_enty, " trade surplus (", data$value, - ") is lower than maximum tolerance (-", data$maxTol, ")." - ) - ), - paste0(data$all_enty, " is within tolerance.") + paste0(data$all_enty, " trade surplus (", data$value, + ") is greater than maximum tolerance (", data$maxTol, ")."), + paste0(data$all_enty, " trade surplus (", data$value, + ") is within tolerance (", data$maxTol, ").") ), "
Iteration: ", data$iteration ) @@ -202,8 +196,8 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter select("type", "period", "iteration", "maxTol", "withinLimits") %>% distinct() %>% mutate( - "rectXmin" = as.numeric(.data$iteration) - 0.5, - "rectXmax" = as.numeric(.data$iteration) + 0.5, + "rectXmin" = .data$iteration - 0.5, + "rectXmax" = .data$iteration + 0.5, "tooltip" = paste0( .data$type, ifelse(.data$withinLimits == "no", @@ -223,25 +217,25 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter ) surplusConvergence <- ggplot() + - suppressWarnings(geom_line( - data = data, - aes_( - x = ~iteration, y = ~value, color = ~all_enty, - group = ~all_enty, text = ~tooltip - ), - alpha = aestethics$alpha, - linewidth = aestethics$line$size - )) + suppressWarnings(geom_rect( data = limits, aes_( xmin = ~rectXmin, xmax = ~rectXmax, - ymin = ~ -maxTol, ymax = ~maxTol, + ymin = 0, ymax = ~maxTol, fill = ~withinLimits, text = ~tooltip ), inherit.aes = FALSE, alpha = aestethics$alpha )) + + suppressWarnings(geom_line( + data = data, + aes_( + x = ~iteration, y = ~value, color = ~all_enty, + group = ~all_enty, text = ~tooltip + ), + alpha = aestethics$alpha, + linewidth = aestethics$line$size + )) + theme_minimal() + ggtitle("Tradable goods surplus") + facet_grid(type ~ period, scales = "free_y") + @@ -250,9 +244,10 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) + theme(axis.text.x = element_text(angle = 90, hjust = 1)) - surplusConvergencePlotly <- ggplotly(surplusConvergence, tooltip = c("text")) %>% + surplusConvergencePlotly <- ggplotly(surplusConvergence, tooltip = c("text"), height = 700) %>% hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) + config(displayModeBar = TRUE, displaylogo = FALSE) %>% + layout(hovermode = "closest") # Trade surplus summary ---- diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 7f8a0fa4..5b8f7959 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -6,7 +6,6 @@ output: warning: false message: false fig.width: 7 - fig.height: 5 title: Nash Iterations --- @@ -284,6 +283,7 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { diag <- plotNashConvergence(gdx = file.path(runPath, "/fulldata.gdx")) htmltools::tagList(diag$plot) htmltools::tagList(diag$tradeDetailPlot) + ``` ## Price Anticipation Plots From 7828dd5f2beec891cc12e868a64976086e48d2aa Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 11 Dec 2023 17:16:32 +0100 Subject: [PATCH 05/11] enhance nash convergence plot with succeeding iterations --- inst/markdown/nashAnalysis.Rmd | 100 ++++++++++++++++++--------------- 1 file changed, 55 insertions(+), 45 deletions(-) diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 5b8f7959..bade1639 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -5,19 +5,16 @@ output: toc_float: true warning: false message: false + code_folding: hide fig.width: 7 title: Nash Iterations --- ```{r loading_libraries, include=FALSE} -library(knitr) library(dplyr) -library(magclass) -library(ggplot2) -library(quitte) -library(plotly) library(remind2) +library(ggplot2) ``` ## Setup @@ -29,10 +26,9 @@ if (m2r[m2r$module == "optimization", "*"] != "nash") { print("Warning: this script only supports nash optimizations") } -adjustSliderAnimation <- function(p){ - return(list(p[[1]] %>% animation_opts(frame = 1))) +adjustSliderAnimation <- function(p) { + return(list(p[[1]] %>% plotly::animation_opts(frame = 1))) } - ``` ## p80_surplus @@ -46,7 +42,6 @@ str(p80_surplus) ### x: time, slider: iter, facet: enty ```{r} - p <- mip::mipIterations( plotData = p80_surplus, xAxis = "tall", facets = "all_enty", color = NULL, slider = "iteration", @@ -54,7 +49,6 @@ p <- mip::mipIterations( ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, slider: time, facet: enty @@ -69,7 +63,6 @@ htmltools::tagList(p) ### x: time, slider: iter, color: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = p80_surplus, xAxis = "tall", facets = NULL, color = "all_enty", slider = "iteration" @@ -78,11 +71,10 @@ p <- mip::mipIterations( htmltools::tagList(p) ``` - ### x: iter, facets: time ```{r results = "asis"} p <- mip::mipIterations( - plotData = p80_surplus, + plotData = filter(p80_surplus, tall >= 2025), returnGgplots = TRUE, xAxis = "iteration", facets = "tall", color = NULL, slider = NULL ) @@ -104,7 +96,6 @@ str(p80_pvp_itr) ### x: time, slider: iter, facet: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = p80_pvp_itr, xAxis = "ttot", facets = "all_enty", color = NULL, slider = "iteration", @@ -112,45 +103,38 @@ p <- mip::mipIterations( ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, slider: time, facet: enty ```{r results = "asis"} - p <- mip::mipIterations( filter(p80_pvp_itr, ttot > 2005), # for this to work, we starting year must be available for all facets xAxis = "iteration", slider = "ttot", color = NULL, facets = "all_enty", facetScales = "free_y" ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: time, slider: iter, color: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = p80_pvp_itr, xAxis = "ttot", facets = NULL, color = "all_enty", slider = "iteration" ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, facets: time ```{r results = "asis"} - p <- mip::mipIterations( - plotData = p80_pvp_itr, + plotData = filter(p80_pvp_itr, ttot >= 2025), returnGgplots = TRUE, xAxis = "iteration", facets = "ttot", color = NULL, slider = NULL, facetScales = "free_y" ) print(p) - ``` ## price not discounted @@ -170,7 +154,6 @@ price_not_discounted_itr <- left_join(p80_pvp_itr, ### x: time, slider: iter, facet: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = price_not_discounted_itr, xAxis = "ttot", facets = "all_enty", color = NULL, slider = "iteration", @@ -178,7 +161,6 @@ p <- mip::mipIterations( ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, slider: time, facet: enty @@ -193,20 +175,18 @@ htmltools::tagList(p) ### x: time, slider: iter, color: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = price_not_discounted_itr, xAxis = "ttot", facets = NULL, color = "all_enty", slider = "iteration" ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, facets: time ```{r results = "asis"} p <- mip::mipIterations( - plotData = price_not_discounted_itr, + plotData = filter(price_not_discounted_itr, ttot >= 2025), returnGgplots = TRUE, xAxis = "iteration", facets = "ttot", color = NULL, slider = NULL, facetScales = "free_y" @@ -219,17 +199,44 @@ print(p) ### Read Data from gdx ```{r results = "asis"} -prices_and_surplus <- left_join(p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration")) %>% +prices_and_surplus <- left_join(p80_surplus, price_not_discounted_itr, + by = c("tall" = "ttot", "all_enty", "iteration") +) %>% filter(!is.na(p80_pvp_itr_no_discount)) %>% reshape2::melt(id.vars = c(1, 2, 3)) + +# calculate iteration +1 and +2 + +.step <- function(data, i) { + data %>% + filter(.data$iteration > i) %>% + mutate( + "iteration" := .data$iteration - i, + "variable" := paste0(.data$variable, "iter+", i) + ) %>% + return() +} + +prices_and_surplus_steps <- rbind( + prices_and_surplus, + .step(prices_and_surplus, 1), + .step(prices_and_surplus, 2) +) %>% + mutate( + "group" = ifelse(grepl("^p80_surplus", .data$variable), "p80_surplus", "p80_pvp_itr_no_discount"), + "step" = gsub("^(p80_surplus|p80_pvp_itr_no_discount) ?", "", .data$variable), + "step" = ifelse(.data$step == "", "iter", .data$step) + ) %>% + relocate(where(is.numeric), .after = last_col()) %>% + select(-"variable") ``` ### x: time, slider: iter, facet: var ```{r results = "asis"} -for (v in unique(prices_and_surplus$all_enty)) { +for (v in unique(prices_and_surplus_steps$all_enty)) { p <- mip::mipIterations( - plotData = filter(prices_and_surplus, all_enty == v, tall >= 2005), - xAxis = "tall", facets = "variable", color = NULL, slider = "iteration", facetScales = "free_y" + plotData = filter(prices_and_surplus_steps, all_enty == v, tall >= 2005), + xAxis = "tall", facets = "group", color = "step", slider = "iteration", facetScales = "free_y" ) %>% adjustSliderAnimation() print(htmltools::tagList(p)) @@ -240,7 +247,7 @@ for (v in unique(prices_and_surplus$all_enty)) { ```{r results = "asis"} for (v in unique(prices_and_surplus$all_enty)) { p <- mip::mipIterations( - plotData = filter(prices_and_surplus, all_enty == v, tall >= 2005), + plotData = filter(prices_and_surplus, all_enty == v, tall >= 2025), xAxis = "iteration", facets = "variable", color = NULL, slider = "tall", facetScales = "free_y" ) %>% adjustSliderAnimation() @@ -250,8 +257,10 @@ for (v in unique(prices_and_surplus$all_enty)) { ### x: iter, facet: time, color: var ```{r results = "asis", fig.width=12, fig.height=5} -prices_and_surplus_scaled <- left_join(p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration")) %>% - filter(!is.na(p80_pvp_itr_no_discount)) +prices_and_surplus_scaled <- left_join(p80_surplus, price_not_discounted_itr, + by = c("tall" = "ttot", "all_enty", "iteration") +) %>% + filter(!is.na(p80_pvp_itr_no_discount), tall >= 2025) for (v in unique(prices_and_surplus_scaled$all_enty)) { df <- prices_and_surplus_scaled %>% @@ -259,7 +268,7 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { # scale factor per all_enty value scale_factor <- round(select(df, "p80_surplus") %>% max() / - select(df, "p80_pvp_itr_no_discount") %>% max(), digits = 1) + select(df, "p80_pvp_itr_no_discount") %>% max(), digits = 1) df <- df %>% mutate(p80_pvp_itr_no_discount := p80_pvp_itr_no_discount * scale_factor) %>% @@ -272,7 +281,9 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { ) lapply(p, function(plot) { - plot <- plot + scale_y_continuous("p80_surplus", sec.axis = sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) + plot <- plot + + ggplot2::scale_y_continuous("p80_surplus", sec.axis = + ggplot2::sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) print(plot) }) } @@ -280,10 +291,9 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { ## Convergence Plots ```{r results = "asis"} -diag <- plotNashConvergence(gdx = file.path(runPath, "/fulldata.gdx")) +diag <- remind2::plotNashConvergence(gdx = file.path(runPath, "/fulldata.gdx")) htmltools::tagList(diag$plot) htmltools::tagList(diag$tradeDetailPlot) - ``` ## Price Anticipation Plots @@ -293,7 +303,6 @@ p80_DevPriceAnticipGlobMax2100Iter(all_enty,iteration) "Track the 2100 value of p80_DevPriceAnticipGlobAllMax2100Iter(iteration) "Track the 2100 value of p80_DevPriceAnticipGlobAllMax over iterations. [Unit: trillion Dollar]" ```{r results = "asis"} - df <- mip::getPlotData("p80_DevPriceAnticipGlobMax2100Iter", runPath) df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax2100Iter", runPath) %>% @@ -303,11 +312,12 @@ df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax2100Iter", runPath) %>% df <- rbind(df, df.all) p <- mip::mipIterations( - plotData = df, returnGgplots = TRUE, facetScales = "free_y", - xAxis = "iteration", facets = "all_enty", color = NULL, slider = NULL) + plotData = df, returnGgplots = TRUE, facetScales = "free_y", + xAxis = "iteration", facets = "all_enty", color = NULL, slider = NULL +) # add logarithmic scale -p[[1]] + scale_y_log10() +p[[1]] + ggplot2::scale_y_log10() ``` @@ -323,12 +333,12 @@ p <- mip::mipIterations( plotData = df, xAxis = "ttot", facets = "all_enty", slider = "iteration", facetScales = "free_y", returnGgplots = TRUE -) %>% adjustSliderAnimation() +) # add logarithmic scale and then convert to plotly -plots <- p[[1]] + scale_y_log10() +plots <- p[[1]] + ggplot2::scale_y_log10() plots <- list(plots) -plots <- lapply(plots, ggplotly) +plots <- lapply(plots, plotly::ggplotly) %>% adjustSliderAnimation() print(htmltools::tagList(plots)) ``` From 568628df0df1c70d10965a6650138da1812ff485 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 12 Dec 2023 17:09:18 +0100 Subject: [PATCH 06/11] remove warnings and notes --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 6 +- NAMESPACE | 8 ++ R/checkVsCalibData.R | 3 +- R/compareCalibrationTargets.R | 2 +- R/nashAnalysis.R | 26 +++++++ R/plotNashConvergence.R | 4 +- ...rc_main.Rmd => checkVsCalibrationData.Rmd} | 49 ++++++------ ...main.Rmd => compareCalibrationTargets.Rmd} | 49 +++++++----- inst/markdown/nashAnalysis.Rmd | 74 +++++++++++-------- 11 files changed, 141 insertions(+), 84 deletions(-) create mode 100644 R/nashAnalysis.R rename inst/markdown/{checkVsCalibData/rc_main.Rmd => checkVsCalibrationData.Rmd} (83%) rename inst/markdown/{compareCalibrationTargets/cct_main.Rmd => compareCalibrationTargets.Rmd} (79%) diff --git a/.buildlibrary b/.buildlibrary index 2cbfed91..8d95523e 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '221686904' +ValidationKey: '221698156' 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 bddca7b9..a9922b4f 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.125.2 -date-released: '2023-12-11' +date-released: '2023-12-12' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 7f0db975..1b6edfff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) Version: 1.125.2 -Date: 2023-12-11 +Date: 2023-12-12 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), person("Lavinia", "Baumstark", role = "aut"), @@ -42,7 +42,6 @@ URL: https://github.com/pik-piam/remind2 Depends: magclass (>= 3.37) Imports: - RColorBrewer, abind, assertr, data.table, @@ -52,10 +51,8 @@ Imports: gdxrrw, ggplot2, gms, - highcharter, iamc, knitr, - lubridate, lucode2 (>= 0.43.0), luplot, luscale, @@ -72,7 +69,6 @@ Imports: rlang, rmarkdown, rmndt, - scales, tibble, tidyr, tidyselect, diff --git a/NAMESPACE b/NAMESPACE index 26ae0745..dc15b0ee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -129,24 +129,32 @@ importFrom(gdx,readGDX) importFrom(gdxdt,readgdx) importFrom(gdxrrw,gdxInfo) importFrom(ggplot2,aes) +importFrom(ggplot2,aes_) +importFrom(ggplot2,coord_cartesian) importFrom(ggplot2,element_text) importFrom(ggplot2,facet_grid) importFrom(ggplot2,facet_wrap) importFrom(ggplot2,geom_area) importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_errorbar) +importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) +importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_rect) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) importFrom(ggplot2,labs) +importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,scale_fill_brewer) importFrom(ggplot2,scale_fill_discrete) +importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_identity) +importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_x_discrete) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,sec_axis) +importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggplot2,theme_minimal) importFrom(ggplot2,unit) diff --git a/R/checkVsCalibData.R b/R/checkVsCalibData.R index 1e85c549..c06957eb 100644 --- a/R/checkVsCalibData.R +++ b/R/checkVsCalibData.R @@ -18,10 +18,11 @@ #' } #' @export checkVsCalibData <- function(gdx, outputDir = getwd(), outputFile = "Check_vs_CalibData.pdf") { + yamlParams <- list(gdx = normalizePath(gdx, mustWork = TRUE)) rmarkdown::render( - system.file("markdown/checkVsCalibData/rc_main.Rmd", package = "remind2"), + system.file("markdown", "checkVsCalibrationData.Rmd", package = "remind2"), output_dir = outputDir, output_file = outputFile, output_format = "pdf_document", diff --git a/R/compareCalibrationTargets.R b/R/compareCalibrationTargets.R index 731083d9..f28bd2cd 100644 --- a/R/compareCalibrationTargets.R +++ b/R/compareCalibrationTargets.R @@ -26,7 +26,7 @@ compareCalibrationTargets <- function(gdxPaths, outputDir = getwd(), gdxPathNames = names(gdxPaths) ) rmarkdown::render( - system.file("markdown/compareCalibrationTargets/cct_main.Rmd", package = "remind2"), + system.file("markdown/compareCalibrationTargets.Rmd", package = "remind2"), output_dir = outputDir, output_file = outputFile, output_format = "html_document", diff --git a/R/nashAnalysis.R b/R/nashAnalysis.R new file mode 100644 index 00000000..f55a5359 --- /dev/null +++ b/R/nashAnalysis.R @@ -0,0 +1,26 @@ +#' @title Nash Analysis +#' @description Create plots visualizing nash convergence of a given REMIND run +#' +#' @author Falk Benke +#' +#' @param gdx file path to a gdx file (default fulldata.gdx) +#' @param outputFile file name to save the html dashboard +#' +#' @importFrom rmarkdown render +#' +#' @export +nashAnalysis <- function(gdx = "fulldata.gdx", outputFile = NULL) { + + if (!file.exists(gdx)) { + warning("Gdx file not found.") + return() + } + + markdownPath <- system.file("markdown", "nashAnalysis.Rmd", package = "remind2") + + if (is.null(outputFile)) { + outputFile <- file.path(getwd(), "Nash Analysis.html") + } + + rmarkdown::render(markdownPath, output_file = outputFile, params = list(gdx = gdx)) +} diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R index 2b898859..d00cf6b7 100644 --- a/R/plotNashConvergence.R +++ b/R/plotNashConvergence.R @@ -12,7 +12,9 @@ #' @importFrom gdx readGDX #' @importFrom dplyr summarise group_by mutate filter distinct case_when #' @importFrom quitte as.quitte -#' @importFrom ggplot2 scale_y_continuous scale_y_discrete geom_rect +#' @importFrom ggplot2 scale_y_continuous scale_x_continuous scale_y_discrete +#' scale_fill_manual scale_color_manual coord_cartesian aes_ geom_rect +#' theme geom_point geom_hline #' @importFrom plotly ggplotly config hide_legend subplot layout #' @importFrom reshape2 dcast #' diff --git a/inst/markdown/checkVsCalibData/rc_main.Rmd b/inst/markdown/checkVsCalibrationData.Rmd similarity index 83% rename from inst/markdown/checkVsCalibData/rc_main.Rmd rename to inst/markdown/checkVsCalibrationData.Rmd index 9eb4a59f..2dfe7121 100644 --- a/inst/markdown/checkVsCalibData/rc_main.Rmd +++ b/inst/markdown/checkVsCalibrationData.Rmd @@ -37,46 +37,45 @@ knitr::opts_chunk$set( # may cause "Undefined control sequence" errors in LaTeX. try(unloadNamespace("kableExtra"), silent = TRUE) -library(gridExtra) -options(tidyverse.quiet = TRUE) -library(tidyverse) -library(kableExtra) -library(quitte) -library(gdx) -library(ggplot2) -library(dplyr) +library(gridExtra) # nolint +options(tidyverse.quiet = TRUE) # nolint +library(tidyverse) # nolint +library(kableExtra) # nolint +library(quitte) # nolint +library(gdx) # nolint +library(ggplot2) # nolint +library(dplyr) # nolint ``` ```{r read, include=FALSE} - scen <- readGDX(params$gdx, "c_expname")[[1]] vars <- setdiff( c( - readGDX(params$gdx, "ppf", restore_zeros = F), - readGDX(params$gdx, "industry_ue_calibration_target_dyn37", restore_zeros = F) + readGDX(params$gdx, "ppf", restore_zeros = FALSE), + readGDX(params$gdx, "industry_ue_calibration_target_dyn37", restore_zeros = FALSE) ), "lab" ) # baseline run quantities -q.baseline <- readGDX(params$gdx, "vm_cesIO", restore_zeros = F)[, , "l"] %>% dimReduce() +q.baseline <- readGDX(params$gdx, "vm_cesIO", restore_zeros = FALSE)[, , "l"] %>% dimReduce() # calibration data quantities -q.calibration <- readGDX(params$gdx, "pm_cesdata", restore_zeros = F)[, , "quantity"] %>% dimReduce() +q.calibration <- readGDX(params$gdx, "pm_cesdata", restore_zeros = FALSE)[, , "quantity"] %>% dimReduce() q.baseline <- q.baseline[, , c(vars, "inco")] q.calibration <- q.calibration[, , c(vars, "inco")] # baseline run prices -p.baseline <- readGDX(params$gdx, "o01_CESderivatives", restore_zeros = F) +p.baseline <- readGDX(params$gdx, "o01_CESderivatives", restore_zeros = FALSE) if (!is.null(p.baseline)) { p.baseline <- p.baseline[, , "inco"] %>% dimReduce() p.baseline <- p.baseline[, , vars] } # calibration data prices -p.calibration <- readGDX(params$gdx, "pm_cesdata", restore_zeros = F)[, , "price"] %>% dimReduce() +p.calibration <- readGDX(params$gdx, "pm_cesdata", restore_zeros = FALSE)[, , "price"] %>% dimReduce() p.calibration <- p.calibration[, , vars] ``` @@ -89,7 +88,6 @@ This report compares how well a baseline run matches with the target data of the The following table lists all deviations greater 15 %. ```{r quantity deviations} - min.reldev <- 15 min.absdev <- 1e-1 @@ -118,29 +116,30 @@ kable(as.data.frame(deviations), longtable = TRUE) %>% ## Plots ```{r plots, echo = FALSE, results='asis'} - if (!is.null(p.baseline)) { regions <- union( union(getItems(p.baseline, dim = 1), getItems(q.baseline, dim = 1)), union(getItems(p.calibration, dim = 1), getItems(q.calibration, dim = 1)) ) years <- intersect(getItems(p.baseline, dim = 2), getItems(q.baseline, dim = 2)) - } else { regions <- union(getItems(q.baseline, dim = 1), getItems(q.calibration, dim = 1)) years <- getItems(q.baseline, dim = 2) } for (r in regions) { - # quantity plot cat(paste0("### ", r)) cat("\n\n\\pagebreak\n") data <- rbind( - as.quitte(q.baseline[r, years, ]) %>% select(region, variable = all_in, period, value) %>% mutate(model = scen), - as.quitte(q.calibration[r, years, ]) %>% select(region, variable = all_in, period, value) %>% mutate(model = "Calib. Target") + as.quitte(q.baseline[r, years, ]) %>% + select(region, variable = all_in, period, value) %>% + mutate(model = scen), + as.quitte(q.calibration[r, years, ]) %>% + select(region, variable = all_in, period, value) %>% + mutate(model = "Calib. Target") ) p <- ggplot() + geom_line( @@ -169,8 +168,12 @@ for (r in regions) { if (!is.null(p.baseline)) { data <- rbind( - as.quitte(p.baseline[r, years, ]) %>% select(region, variable = all_in1, period, value) %>% mutate(model = scen), - as.quitte(p.calibration[r, years, ]) %>% select(region, variable = all_in, period, value) %>% mutate(model = "Calib. Target") + as.quitte(p.baseline[r, years, ]) %>% + select(region, variable = all_in1, period, value) %>% + mutate(model = scen), + as.quitte(p.calibration[r, years, ]) %>% + select(region, variable = all_in, period, value) %>% + mutate(model = "Calib. Target") ) p <- ggplot() + geom_line( diff --git a/inst/markdown/compareCalibrationTargets/cct_main.Rmd b/inst/markdown/compareCalibrationTargets.Rmd similarity index 79% rename from inst/markdown/compareCalibrationTargets/cct_main.Rmd rename to inst/markdown/compareCalibrationTargets.Rmd index 101386e2..323d4074 100644 --- a/inst/markdown/compareCalibrationTargets/cct_main.Rmd +++ b/inst/markdown/compareCalibrationTargets.Rmd @@ -34,7 +34,7 @@ params: ```{r setup, include=FALSE} -library(svglite) +library(svglite) # nolint knitr::opts_chunk$set( echo = FALSE, @@ -51,7 +51,6 @@ knitr::opts_chunk$set( ```{r libraries, include=FALSE} - # kableExtra must not be loaded before the call of library(kableExtra) below, # as its .onLoad() function must be called to tell knitr about add necessary # LaTeX libraries needed for tables. @@ -59,20 +58,19 @@ knitr::opts_chunk$set( # may cause "Undefined control sequence" errors in LaTeX. try(unloadNamespace("kableExtra"), silent = TRUE) -library(kableExtra) -library(quitte) -library(gdx) -library(ggplot2) -library(dplyr) -library(madrat) +library(kableExtra) # nolint +library(quitte) # nolint +library(gdx) # nolint +library(ggplot2) # nolint +library(dplyr) # nolint +library(madrat) # nolint ``` ```{r read, include=FALSE} - data <- NULL for (i in seq(length(params$gdxPaths))) { - tmp <- readGDX(params$gdxPaths[[i]], "pm_cesdata", restore_zeros = F)[, , "quantity"] %>% dimReduce() + tmp <- readGDX(params$gdxPaths[[i]], "pm_cesdata", restore_zeros = FALSE)[, , "quantity"] %>% dimReduce() if (!is.null(params$gdxPathNames)) { tmp <- add_dimension(tmp, dim = 3.1, add = "scenario", @@ -132,7 +130,6 @@ data <- as.quitte(data) %>% select(region, scenario, variable = all_in, period, ### Top Level ```{r top-2050} - vars <- c("inco", "lab", "kap") for (v in vars) { @@ -151,7 +148,6 @@ for (v in vars) { ### Buildings ```{r buildings-2050} - vars <- c("feelcb", "fehob", "fesob", "feelhpb", "feelrhb", "feheb", "fegab", "feh2b") for (v in vars) { @@ -169,7 +165,6 @@ for (v in vars) { ### Transportation ```{r transportation-2050} - vars <- c("entrp_pass_sm", "entrp_pass_lo", "entrp_frgt_sm", "entrp_frgt_lo") for (v in vars) { @@ -187,8 +182,16 @@ for (v in vars) { ### Industry ```{r industry-2050} - -vars <- c("ue_cement", "feso_cement", "feli_cement", "fega_cement", "feh2_cement", "feel_cement", "kap_cement", "ue_chemicals", "feso_chemicals", "feli_chemicals", "fega_chemicals", "feh2_chemicals", "feelhth_chemicals", "feelwlth_chemicals", "kap_chemicals", "ue_steel_primary", "feso_steel", "feli_steel", "fega_steel", "feh2_steel", "feel_steel_primary", "kap_steel_primary", "ue_steel_secondary", "kap_steel_secondary", "feel_steel_secondary", "ue_otherInd", "feso_otherInd", "feli_otherInd", "fega_otherInd", "feh2_otherInd", "fehe_otherInd", "feelhth_otherInd", "feelwlth_otherInd", "kap_otherInd") +vars <- c( + "ue_cement", "feso_cement", "feli_cement", "fega_cement", "feh2_cement", + "feel_cement", "kap_cement", "ue_chemicals", "feso_chemicals", "feli_chemicals", + "fega_chemicals", "feh2_chemicals", "feelhth_chemicals", "feelwlth_chemicals", + "kap_chemicals", "ue_steel_primary", "feso_steel", "feli_steel", "fega_steel", + "feh2_steel", "feel_steel_primary", "kap_steel_primary", "ue_steel_secondary", + "kap_steel_secondary", "feel_steel_secondary", "ue_otherInd", "feso_otherInd", + "feli_otherInd", "fega_otherInd", "feh2_otherInd", "fehe_otherInd", + "feelhth_otherInd", "feelwlth_otherInd", "kap_otherInd" +) for (v in vars) { if (any(regionsH12 %in% unique(data$region))) { @@ -207,7 +210,6 @@ for (v in vars) { ### Top Level ```{r top-all} - vars <- c("inco", "lab", "kap") for (v in vars) { if (any(regionsH12 %in% unique(data$region))) { @@ -224,7 +226,6 @@ for (v in vars) { ### Buildings ```{r buildings-all} - vars <- c("feelcb", "fehob", "fesob", "feelhpb", "feelrhb", "feheb", "fegab", "feh2b") for (v in vars) { @@ -244,7 +245,6 @@ for (v in vars) { ### Transportation ```{r transportation-all} - vars <- c("entrp_pass_sm", "entrp_pass_lo", "entrp_frgt_sm", "entrp_frgt_lo") for (v in vars) { @@ -262,8 +262,17 @@ for (v in vars) { ### Industry ```{r industry-all} - -vars <- c("ue_cement", "feso_cement", "feli_cement", "fega_cement", "feh2_cement", "feel_cement", "kap_cement", "ue_chemicals", "feso_chemicals", "feli_chemicals", "fega_chemicals", "feh2_chemicals", "feelhth_chemicals", "feelwlth_chemicals", "kap_chemicals", "ue_steel_primary", "feso_steel", "feli_steel", "fega_steel", "feh2_steel", "feel_steel_primary", "kap_steel_primary", "ue_steel_secondary", "kap_steel_secondary", "feel_steel_secondary", "ue_otherInd", "feso_otherInd", "feli_otherInd", "fega_otherInd", "feh2_otherInd", "fehe_otherInd", "feelhth_otherInd", "feelwlth_otherInd", "kap_otherInd") +vars <- c( + "ue_cement", "feso_cement", "feli_cement", "fega_cement", "feh2_cement", + "feel_cement", "kap_cement", "ue_chemicals", "feso_chemicals", + "feli_chemicals", "fega_chemicals", "feh2_chemicals", "feelhth_chemicals", + "feelwlth_chemicals", "kap_chemicals", "ue_steel_primary", "feso_steel", + "feli_steel", "fega_steel", "feh2_steel", "feel_steel_primary", + "kap_steel_primary", "ue_steel_secondary", "kap_steel_secondary", + "feel_steel_secondary", "ue_otherInd", "feso_otherInd", "feli_otherInd", + "fega_otherInd", "feh2_otherInd", "fehe_otherInd", "feelhth_otherInd", + "feelwlth_otherInd", "kap_otherInd" +) for (v in vars) { if (any(regionsH12 %in% unique(data$region))) { diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index bade1639..4271f0ac 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -1,27 +1,38 @@ --- +title: "REMIND Nash Convergence" output: html_document: toc: true toc_float: true - warning: false - message: false code_folding: hide - fig.width: 7 -title: Nash Iterations +params: + gdx: "fulldata.gdx" + warning: false + message: false + figWidth: 7 --- ```{r loading_libraries, include=FALSE} -library(dplyr) -library(remind2) -library(ggplot2) +library(knitr) # nolint +library(dplyr) # nolint +library(remind2) # nolint +library(ggplot2) # nolint + +knitr::opts_chunk$set( + echo = FALSE, + error = TRUE, + fig.width = params$figWidth, + message = params$message, + warning = params$warning +) + ``` ## Setup ```{r} -runPath <- "/home/benke/dev/pik-piam/miptemplate/SSP2EU-EU21-NDC_2023-11-01_19.58.36/" -m2r <- gdx::readGDX(file.path(runPath, "/fulldata.gdx"), "module2realisation", restore_zeros = FALSE) +m2r <- gdx::readGDX(params$gdx, "module2realisation", restore_zeros = FALSE) if (m2r[m2r$module == "optimization", "*"] != "nash") { print("Warning: this script only supports nash optimizations") } @@ -35,7 +46,7 @@ adjustSliderAnimation <- function(p) { ### Read Data from gdx ```{r p80_surplus___READ} -p80_surplus <- mip::getPlotData("p80_surplus", runPath) %>% +p80_surplus <- mip::getPlotData("p80_surplus", params$gdx) %>% mutate(tall := as.numeric(tall)) str(p80_surplus) ``` @@ -87,7 +98,7 @@ print(p) ### Read Data from gdx ```{r p80_pvp_itr___READ} -p80_pvp_itr <- mip::getPlotData("p80_pvp_itr", runPath) %>% +p80_pvp_itr <- mip::getPlotData("p80_pvp_itr", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% filter(ttot >= 2005) str(p80_pvp_itr) @@ -291,7 +302,7 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { ## Convergence Plots ```{r results = "asis"} -diag <- remind2::plotNashConvergence(gdx = file.path(runPath, "/fulldata.gdx")) +diag <- remind2::plotNashConvergence(gdx = params$gdx) htmltools::tagList(diag$plot) htmltools::tagList(diag$tradeDetailPlot) ``` @@ -299,13 +310,14 @@ htmltools::tagList(diag$tradeDetailPlot) ## Price Anticipation Plots ### p80_DevPriceAnticipGlobMax2100Iter -p80_DevPriceAnticipGlobMax2100Iter(all_enty,iteration) "Track the 2100 value of p80_DevPriceAnticipGlobMax over iterations. [Unit: trillion Dollar]" -p80_DevPriceAnticipGlobAllMax2100Iter(iteration) "Track the 2100 value of p80_DevPriceAnticipGlobAllMax over iterations. [Unit: trillion Dollar]" + +- p80_DevPriceAnticipGlobMax2100Iter(all_enty,iteration) "Track the 2100 value of p80_DevPriceAnticipGlobMax over iterations. [Unit: trillion Dollar]" +- p80_DevPriceAnticipGlobAllMax2100Iter(iteration) "Track the 2100 value of p80_DevPriceAnticipGlobAllMax over iterations. [Unit: trillion Dollar]" ```{r results = "asis"} -df <- mip::getPlotData("p80_DevPriceAnticipGlobMax2100Iter", runPath) +df <- mip::getPlotData("p80_DevPriceAnticipGlobMax2100Iter", params$gdx) -df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax2100Iter", runPath) %>% +df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax2100Iter", params$gdx) %>% mutate(all_enty = "all") %>% rename(p80_DevPriceAnticipGlobMax2100Iter = p80_DevPriceAnticipGlobAllMax2100Iter) @@ -323,17 +335,17 @@ p[[1]] + ggplot2::scale_y_log10() ### p80_DevPriceAnticipGlobIter -p80_DevPriceAnticipGlobIter(ttot,all_enty,iteration) "Track p80_DevPriceAnticipGlob over iterations. [Unit: trillion Dollar]" +- p80_DevPriceAnticipGlobIter(ttot,all_enty,iteration) "Track p80_DevPriceAnticipGlob over iterations. [Unit: trillion Dollar]" ```{r results = "asis"} -df <- mip::getPlotData("p80_DevPriceAnticipGlobIter", runPath) %>% +df <- mip::getPlotData("p80_DevPriceAnticipGlobIter", params$gdx) %>% mutate(ttot := as.numeric(ttot)) p <- mip::mipIterations( plotData = df, xAxis = "ttot", facets = "all_enty", slider = "iteration", facetScales = "free_y", returnGgplots = TRUE -) +) # add logarithmic scale and then convert to plotly plots <- p[[1]] + ggplot2::scale_y_log10() @@ -346,10 +358,10 @@ print(htmltools::tagList(plots)) ### p80_PriceChangePriceAnticipReg -p80_PriceChangePriceAnticipReg(ttot,all_enty,all_regi) "Price change of a trade good due to the price anticipation effect. [Unit: Percent]" +- p80_PriceChangePriceAnticipReg(ttot,all_enty,all_regi) "Price change of a trade good due to the price anticipation effect. [Unit: Percent]" ```{r results = "asis"} -df <- mip::getPlotData("p80_PriceChangePriceAnticipReg", runPath) %>% +df <- mip::getPlotData("p80_PriceChangePriceAnticipReg", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% select(-"iteration") @@ -361,10 +373,10 @@ mip::mipIterations( ``` ### p80_DevPriceAnticipReg -p80_DevPriceAnticipReg(ttot,all_enty,all_regi) "Deviation of the yearly monetary export/import expenditure due to price change anticipation effect. [Unit: trillion Dollar]" +- p80_DevPriceAnticipReg(ttot,all_enty,all_regi) "Deviation of the yearly monetary export/import expenditure due to price change anticipation effect. [Unit: trillion Dollar]" ```{r results = "asis"} -df <- mip::getPlotData("p80_DevPriceAnticipReg", runPath) %>% +df <- mip::getPlotData("p80_DevPriceAnticipReg", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% select(-"iteration") @@ -376,22 +388,22 @@ mip::mipIterations( ``` ### p80_DevPriceAnticipGlob -p80_DevPriceAnticipGlob(ttot,all_enty) "Global sum of p80_DevPriceAnticipReg. [Unit: trillion Dollar]" -p80_DevPriceAnticipGlobAll(ttot) "p80_DevPriceAnticipGlob summed over all trade goods. [Units: trillion Dollar]" -p80_DevPriceAnticipGlobAllMax(ttot) "Max of p80_DevPriceAnticipGlobAll until the given year. [Unit: trillion Dollar]" -p80_DevPriceAnticipGlobMax(ttot,all_enty) "Max of p80_DevPriceAnticipGlob until the given year. [Unit: trillion Dollar]" +- p80_DevPriceAnticipGlob(ttot,all_enty) "Global sum of p80_DevPriceAnticipReg. [Unit: trillion Dollar]" +- p80_DevPriceAnticipGlobAll(ttot) "p80_DevPriceAnticipGlob summed over all trade goods. [Units: trillion Dollar]" +- p80_DevPriceAnticipGlobAllMax(ttot) "Max of p80_DevPriceAnticipGlobAll until the given year. [Unit: trillion Dollar]" +- p80_DevPriceAnticipGlobMax(ttot,all_enty) "Max of p80_DevPriceAnticipGlob until the given year. [Unit: trillion Dollar]" ```{r results = "asis"} -df <- mip::getPlotData("p80_DevPriceAnticipGlob", runPath) %>% +df <- mip::getPlotData("p80_DevPriceAnticipGlob", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% select(-"iteration") -df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAll", runPath) %>% +df.all <- mip::getPlotData("p80_DevPriceAnticipGlobAll", params$gdx) %>% mutate(ttot := as.numeric(ttot), all_enty = "all") %>% rename(p80_DevPriceAnticipGlob = p80_DevPriceAnticipGlobAll) %>% select(-"iteration") -df.allmax <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax", runPath) %>% +df.allmax <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax", params$gdx) %>% mutate(ttot := as.numeric(ttot), all_enty = "allmax") %>% rename(p80_DevPriceAnticipGlob = p80_DevPriceAnticipGlobAllMax) %>% select(-"iteration") @@ -404,7 +416,7 @@ mip::mipIterations( facetScales = "free_y" ) -df.max <- mip::getPlotData("p80_DevPriceAnticipGlobMax", runPath) %>% +df.max <- mip::getPlotData("p80_DevPriceAnticipGlobMax", params$gdx) %>% select(-"iteration") mip::mipIterations( From c51cdb0b8fa3e2fc404ba4d620423e49796a6a9f Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 12 Dec 2023 17:38:31 +0100 Subject: [PATCH 07/11] increment version --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- NAMESPACE | 2 ++ README.md | 6 +++--- man/nashAnalysis.Rd | 19 +++++++++++++++++++ 6 files changed, 29 insertions(+), 8 deletions(-) create mode 100644 man/nashAnalysis.Rd diff --git a/.buildlibrary b/.buildlibrary index 83a358c1..ee046c09 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '221844520' +ValidationKey: '221875483' 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 83ffa28b..e77dc411 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: 'remind2: The REMIND R package (2nd generation)' -version: 1.126.0 -date-released: '2023-12-11' +version: 1.126.1 +date-released: '2023-12-12' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 1ea80f8e..457140bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) -Version: 1.126.0 -Date: 2023-12-11 +Version: 1.126.1 +Date: 2023-12-12 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 dc15b0ee..40082166 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ export(getRunsMIFGDX) export(get_total_efficiencies) export(loadCs2Data) export(loadModeltest) +export(nashAnalysis) export(plotCDR) export(plotLCOE) export(plotNashConvergence) @@ -249,6 +250,7 @@ importFrom(rlang,.env) importFrom(rlang,is_empty) importFrom(rlang,sym) importFrom(rlang,syms) +importFrom(rmarkdown,render) importFrom(rmndt,approx_dt) importFrom(rmndt,readMIF) importFrom(rmndt,writeMIF) diff --git a/README.md b/README.md index 97651eba..816cd2bc 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The REMIND R package (2nd generation) -R package **remind2**, version **1.126.0** +R package **remind2**, version **1.126.1** [![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, 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 (2023). _remind2: The REMIND R package (2nd generation)_. R package version 1.126.1, . 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 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}, year = {2023}, - note = {R package version 1.126.0}, + note = {R package version 1.126.1}, url = {https://github.com/pik-piam/remind2}, } ``` diff --git a/man/nashAnalysis.Rd b/man/nashAnalysis.Rd new file mode 100644 index 00000000..72d75584 --- /dev/null +++ b/man/nashAnalysis.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/nashAnalysis.R +\name{nashAnalysis} +\alias{nashAnalysis} +\title{Nash Analysis} +\usage{ +nashAnalysis(gdx = "fulldata.gdx", outputFile = NULL) +} +\arguments{ +\item{gdx}{file path to a gdx file (default fulldata.gdx)} + +\item{outputFile}{file name to save the html dashboard} +} +\description{ +Create plots visualizing nash convergence of a given REMIND run +} +\author{ +Falk Benke +} From 33542c741a67fef0030330a660b8f3c861492687 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 12 Dec 2023 17:56:53 +0100 Subject: [PATCH 08/11] adjust limits of plots with log y-axis --- DESCRIPTION | 1 + inst/markdown/nashAnalysis.Rmd | 7 ++++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 457140bf..2607490d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,6 +51,7 @@ Imports: gdxrrw, ggplot2, gms, + htmltools, iamc, knitr, lucode2 (>= 0.43.0), diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 4271f0ac..e50cadb1 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -9,7 +9,7 @@ params: gdx: "fulldata.gdx" warning: false message: false - figWidth: 7 + figWidth: 8 --- @@ -329,7 +329,7 @@ p <- mip::mipIterations( ) # add logarithmic scale -p[[1]] + ggplot2::scale_y_log10() +p[[1]] + ggplot2::scale_y_log10(limits = c(1e-4, 1e+1)) ``` @@ -348,7 +348,7 @@ p <- mip::mipIterations( ) # add logarithmic scale and then convert to plotly -plots <- p[[1]] + ggplot2::scale_y_log10() +plots <- p[[1]] + ggplot2::scale_y_log10(limits = c(1e-4, 1e+1)) plots <- list(plots) plots <- lapply(plots, plotly::ggplotly) %>% adjustSliderAnimation() @@ -371,6 +371,7 @@ mip::mipIterations( facetScales = "free_y" ) ``` + ### p80_DevPriceAnticipReg - p80_DevPriceAnticipReg(ttot,all_enty,all_regi) "Deviation of the yearly monetary export/import expenditure due to price change anticipation effect. [Unit: trillion Dollar]" From f62388d44320cb4b3207a5769adc24aebb2997e1 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 12 Dec 2023 19:05:58 +0100 Subject: [PATCH 09/11] fix bug in rendering script for nash analysis --- .buildlibrary | 1 + R/nashAnalysis.R | 28 +++++++++++++++------------- man/nashAnalysis.Rd | 17 ++++++++++++++--- 3 files changed, 30 insertions(+), 16 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index ee046c09..a31e83d8 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -9,5 +9,6 @@ AcceptedNotes: - Imports includes .* non-default packages. - unable to verify current time - checking installed package size +- Namespace in Imports field not imported from: ‘htmltools’ AutocreateReadme: yes allowLinterWarnings: yes diff --git a/R/nashAnalysis.R b/R/nashAnalysis.R index f55a5359..a54729a0 100644 --- a/R/nashAnalysis.R +++ b/R/nashAnalysis.R @@ -3,24 +3,26 @@ #' #' @author Falk Benke #' -#' @param gdx file path to a gdx file (default fulldata.gdx) -#' @param outputFile file name to save the html dashboard +#' @param gdx a GDX object as created by readGDX, or the path to a gdx +#' @param outputDir \code{character(1)}. The directory where the output document +#' and intermediary files are created. +#' @param outputFile \code{character(1)}. File name (without extension) of the +#' output document to be created. +#' @return The value returned by \code{\link[rmarkdown:render]{rmarkdown::render()}}. #' #' @importFrom rmarkdown render #' #' @export -nashAnalysis <- function(gdx = "fulldata.gdx", outputFile = NULL) { +nashAnalysis <- function(gdx = "fulldata.gdx", outputDir = getwd(), outputFile = "Nash Analysis.html") { - if (!file.exists(gdx)) { - warning("Gdx file not found.") - return() - } - markdownPath <- system.file("markdown", "nashAnalysis.Rmd", package = "remind2") + yamlParams <- list(gdx = normalizePath(gdx, mustWork = TRUE)) - if (is.null(outputFile)) { - outputFile <- file.path(getwd(), "Nash Analysis.html") - } - - rmarkdown::render(markdownPath, output_file = outputFile, params = list(gdx = gdx)) + rmarkdown::render( + system.file("markdown", "nashAnalysis.Rmd", package = "remind2"), + output_dir = outputDir, + output_file = outputFile, + output_format = "html_document", + params = yamlParams + ) } diff --git a/man/nashAnalysis.Rd b/man/nashAnalysis.Rd index 72d75584..77088323 100644 --- a/man/nashAnalysis.Rd +++ b/man/nashAnalysis.Rd @@ -4,12 +4,23 @@ \alias{nashAnalysis} \title{Nash Analysis} \usage{ -nashAnalysis(gdx = "fulldata.gdx", outputFile = NULL) +nashAnalysis( + gdx = "fulldata.gdx", + outputDir = getwd(), + outputFile = "Nash Analysis.html" +) } \arguments{ -\item{gdx}{file path to a gdx file (default fulldata.gdx)} +\item{gdx}{a GDX object as created by readGDX, or the path to a gdx} -\item{outputFile}{file name to save the html dashboard} +\item{outputDir}{\code{character(1)}. The directory where the output document +and intermediary files are created.} + +\item{outputFile}{\code{character(1)}. File name (without extension) of the +output document to be created.} +} +\value{ +The value returned by \code{\link[rmarkdown:render]{rmarkdown::render()}}. } \description{ Create plots visualizing nash convergence of a given REMIND run From a34584257f4897236653793af6e93d5b33855680 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 15 Dec 2023 14:03:14 +0100 Subject: [PATCH 10/11] add facet plot --- inst/markdown/nashAnalysis.Rmd | 39 ++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 7f98e15f..16d2b118 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -14,10 +14,11 @@ params: ```{r loading_libraries, include=FALSE} -library(knitr) # nolint -library(dplyr) # nolint -library(remind2) # nolint -library(ggplot2) # nolint +library(knitr) +library(dplyr) +library(remind2) +library(ggplot2) +library(plotly) knitr::opts_chunk$set( echo = FALSE, @@ -241,6 +242,7 @@ prices_and_surplus_steps <- rbind( ) %>% relocate(where(is.numeric), .after = last_col()) %>% select(-"variable") + ``` ### x: time, slider: iter, facet: var @@ -254,8 +256,8 @@ for (v in unique(prices_and_surplus_steps$all_enty)) { # manually override colors plots <- p[[1]] + - ggplot2::scale_colour_manual(values = c("iter" = "#08519c", "iter+1" = "#3182bd", - "iter+2" = "#6baed6", "iter+3" = "#bdd7e7")) + ggplot2::scale_colour_manual(values = c("iter" = "#000066", "iter+1" = "#39418d", + "iter+2" = "#7b8cba", "iter+3" = "#bdd7e7")) plots <- list(plots) plots <- lapply(plots, plotly::ggplotly) %>% adjustSliderAnimation() @@ -264,6 +266,31 @@ for (v in unique(prices_and_surplus_steps$all_enty)) { } ``` + +### x: time, slider: iter, facet: var + all_enty + +```{r results = "asis"} + +df <- prices_and_surplus_steps %>% + filter(.data$all_enty != "peur", .data$tall >= 2005) %>% + mutate("group" = paste0(.data$all_enty, "-", .data$group)) %>% + select(-"all_enty") + +p <- ggplot(df) + + geom_line(aes_string(x = "tall", y = "value", color = "step", frame = "iteration")) + + facet_wrap("group", scales = "free_y",ncol = 2) + + ggplot2::scale_color_manual( + breaks = c("iter", "iter+1", "iter+2", "iter+3"), + values = c("#000066", "#39418d", "#7b8cba", "#bdd7e7") + ) + + theme_bw() + + theme(strip.background = element_blank()) + +plotly::ggplotly(p, autosize = F, height = 800) %>% + plotly::animation_opts(frame = 1) + +``` + ### x: iter, slider: time, facet: var ```{r results = "asis"} for (v in unique(prices_and_surplus$all_enty)) { From 8a358d4343da1ddfedf7f91904587d0b1fce878a Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 15 Dec 2023 15:03:11 +0100 Subject: [PATCH 11/11] increment version --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- inst/markdown/nashAnalysis.Rmd | 37 ++++++++++++++++++++++++---------- 5 files changed, 34 insertions(+), 19 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 67c0a7b9..58df726e 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '222064080' +ValidationKey: '222106326' 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 df1b9334..cc29c46e 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: 'remind2: The REMIND R package (2nd generation)' -version: 1.127.0 -date-released: '2023-12-13' +version: 1.127.1 +date-released: '2023-12-15' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 66daa0bc..301f0d7d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) -Version: 1.127.0 -Date: 2023-12-13 +Version: 1.127.1 +Date: 2023-12-15 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), person("Lavinia", "Baumstark", role = "aut"), diff --git a/README.md b/README.md index ca6c86cc..90cfe50c 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The REMIND R package (2nd generation) -R package **remind2**, version **1.127.0** +R package **remind2**, version **1.127.1** [![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, 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 (2023). _remind2: The REMIND R package (2nd generation)_. R package version 1.127.1, . 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 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}, year = {2023}, - note = {R package version 1.127.0}, + note = {R package version 1.127.1}, url = {https://github.com/pik-piam/remind2}, } ``` diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 16d2b118..b2fe2b2e 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -91,7 +91,10 @@ p <- mip::mipIterations( xAxis = "iteration", facets = "tall", color = NULL, slider = NULL ) -print(p) +for (i in p) { + print(i) +} + ``` @@ -146,7 +149,9 @@ p <- mip::mipIterations( facetScales = "free_y" ) -print(p) +for (i in p) { + print(i) +} ``` ## price not discounted @@ -204,7 +209,9 @@ p <- mip::mipIterations( facetScales = "free_y" ) -print(p) +for (i in p) { + print(i) +} ``` ## prices and surplus in one plot @@ -266,9 +273,7 @@ for (v in unique(prices_and_surplus_steps$all_enty)) { } ``` - ### x: time, slider: iter, facet: var + all_enty - ```{r results = "asis"} df <- prices_and_surplus_steps %>% @@ -331,7 +336,8 @@ for (v in unique(prices_and_surplus_scaled$all_enty)) { lapply(p, function(plot) { plot <- plot + ggplot2::scale_y_continuous("p80_surplus", sec.axis = - ggplot2::sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) + ggplot2::sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) + + theme(legend.position = "bottom") print(plot) }) } @@ -389,7 +395,7 @@ plots <- p[[1]] + ggplot2::scale_y_log10(limits = c(1e-4, 1e+1)) plots <- list(plots) plots <- lapply(plots, plotly::ggplotly) %>% adjustSliderAnimation() -print(htmltools::tagList(plots)) +htmltools::tagList(plots) ``` @@ -402,11 +408,14 @@ df <- mip::getPlotData("p80_PriceChangePriceAnticipReg", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% select(-"iteration") -mip::mipIterations( +plots <- mip::mipIterations( plotData = df, returnGgplots = TRUE, xAxis = "ttot", facets = "all_regi", color = "all_enty", slider = NULL, facetScales = "free_y" ) + +plots[[1]] + ``` ### p80_DevPriceAnticipReg @@ -418,11 +427,13 @@ df <- mip::getPlotData("p80_DevPriceAnticipReg", params$gdx) %>% mutate(ttot := as.numeric(ttot)) %>% select(-"iteration") -mip::mipIterations( +plots <- mip::mipIterations( plotData = df, returnGgplots = TRUE, xAxis = "ttot", facets = "all_regi", color = "all_enty", slider = NULL, facetScales = "free_y" ) + +plots[[1]] ``` ### p80_DevPriceAnticipGlob @@ -448,18 +459,22 @@ df.allmax <- mip::getPlotData("p80_DevPriceAnticipGlobAllMax", params$gdx) %>% df <- rbind(df, df.all, df.allmax) -mip::mipIterations( +plots <- mip::mipIterations( plotData = df, returnGgplots = TRUE, xAxis = "ttot", facets = "all_enty", color = NULL, slider = NULL, facetScales = "free_y" ) +plots[[1]] + df.max <- mip::getPlotData("p80_DevPriceAnticipGlobMax", params$gdx) %>% select(-"iteration") -mip::mipIterations( +plots <- mip::mipIterations( plotData = df.max, returnGgplots = TRUE, xAxis = "ttot", facets = "all_enty", color = NULL, slider = NULL, facetScales = "free_y" ) + +plots[[1]] ```