From 0ad8936d23477c2c85cbd22d4425ffe739b9b823 Mon Sep 17 00:00:00 2001 From: orichters Date: Thu, 11 May 2023 08:50:45 +0200 Subject: [PATCH 01/41] add Prices|*|Rawdata to plotstyles --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- inst/extdata/plotstyle.csv | 24 +++++++++++++++++------- man/showLinePlots.Rd | 2 +- man/showLinePlotsWithTarget.Rd | 7 +------ 7 files changed, 27 insertions(+), 22 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index af2b426..edd80f3 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28109640' +ValidationKey: '28140672' 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 dd1bdf5..146e3a1 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: 'mip: Comparison of multi-model runs' -version: 0.144.3 -date-released: '2023-05-03' +version: 0.144.4 +date-released: '2023-05-11' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 91276eb..149ef27 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.144.3 -Date: 2023-05-03 +Version: 0.144.4 +Date: 2023-05-11 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/README.md b/README.md index b0e6c03..81b51fe 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.144.3** +R package **mip**, version **0.144.4** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi: 10.5281/zenodo.1158586 (URL: https://doi.org/10.5281/zenodo.1158586), R package version 0.144.4, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.144.3}, + note = {R package version 0.144.4}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } diff --git a/inst/extdata/plotstyle.csv b/inst/extdata/plotstyle.csv index e05e89d..dedc6d6 100644 --- a/inst/extdata/plotstyle.csv +++ b/inst/extdata/plotstyle.csv @@ -317,18 +317,28 @@ water;water;#B2DF8A;; codePerformance;codePerformance;#808080;; climate;climate;#CAB2D6;; aerosols;aerosols;#CAB2D6;; +Price|Final Energy|Diesel;Diesel;#08262f;; +Price|Final Energy|Diesel|Rawdata;Diesel;#08262f;; Price|Final Energy|Electricity|Stationary;Electricity|Stationary;#ffdc00;; +Price|Final Energy|Electricity|Stationary|Rawdata;Electricity|Stationary;#ffdc00;; Price|Final Energy|Electricity|Transport;Electricity|Transport;#331a00;; +Price|Final Energy|Electricity|Transport|Rawdata;Electricity|Transport;#331a00;; +Price|Final Energy|Gases;Gases;#1a4114;; +Price|Final Energy|Gases|Rawdata;Gases;#1a4114;; +Price|Final Energy|Heat;Heat;#ff9977;; +Price|Final Energy|Heat|Rawdata;Heat;#ff9977;; +Price|Final Energy|Heating Oil;Heating Oil;#44ba97;; +Price|Final Energy|Heating Oil|Rawdata;Heating Oil;#44ba97;; Price|Final Energy|Hydrogen|Stationary;Hydrogen|Stationary;#ff7b00;; +Price|Final Energy|Hydrogen|Stationary|Rawdata;Hydrogen|Stationary;#ff7b00;; Price|Final Energy|Hydrogen|Transport;Hydrogen|Transport;#ab7bb8;; -Price|Final Energy|Gases;Gases;#1a4114;; +Price|Final Energy|Hydrogen|Transport|Rawdata;Hydrogen|Transport;#ab7bb8;; Price|Final Energy|Liquids;Liquids;#db0e00;; -Price|Final Energy|Heating Oil;Heating Oil;#44ba97;; -Price|Final Energy|Heat;Heat;#ff9977;; -Price|Final Energy|Solids;Solids;#6e7700;; +Price|Final Energy|Liquids|Rawdata;Liquids;#db0e00;; Price|Final Energy|Petrol;Petrol;#29b1da;; -Price|Final Energy|Diesel;Diesel;#08262f;; -Forcing|CO2 (W/m2);CO2;#331a00;; +Price|Final Energy|Petrol|Rawdata;Petrol;#29b1da;; +Price|Final Energy|Solids;Solids;#6e7700;; +Price|Final Energy|Solids|Rawdata;Solids;#6e7700;; Forcing|CH4 (W/m2);CH4;#ffe7a0;; Forcing|N2O (W/m2);N2O;#44ba97;; Forcing|F-Gases (W/m2);F-Gases;#ff9977;; @@ -696,4 +706,4 @@ Heat-only|Heat Pump;Heat-only|Heat Pump;#3cb44b;; Heat-only|Electric Boiler;Heat-only|Electric Boiler;#f58231;; Heat-only|Solar;Heat-only|Solar;#7f7f00;; Heat-only|Geothermal;Heat-only|Geothermal;#660000;; -Cap|Stationary;EU ETS cap;#ff9800;; \ No newline at end of file +Cap|Stationary;EU ETS cap;#ff9800;; diff --git a/man/showLinePlots.Rd b/man/showLinePlots.Rd index adb8ea1..67db8d3 100644 --- a/man/showLinePlots.Rd +++ b/man/showLinePlots.Rd @@ -8,7 +8,7 @@ showLinePlots( data, vars = NULL, scales = "free_y", - color.dim.name = "Model output", + color.dim.name = NULL, mainReg = getOption("mip.mainReg") ) } diff --git a/man/showLinePlotsWithTarget.Rd b/man/showLinePlotsWithTarget.Rd index c86379f..17feb31 100644 --- a/man/showLinePlotsWithTarget.Rd +++ b/man/showLinePlotsWithTarget.Rd @@ -4,12 +4,7 @@ \alias{showLinePlotsWithTarget} \title{Show Line Plots With Target} \usage{ -showLinePlotsWithTarget( - data, - vars, - scales = "free_y", - color.dim.name = "Model output" -) +showLinePlotsWithTarget(data, vars, scales = "free_y", color.dim.name = NULL) } \arguments{ \item{data}{A quitte object or an object that can be transformed into a From 06aef30e63d7d2e98b6f39482209aff5b1e1a112 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 12 May 2023 15:32:09 +0200 Subject: [PATCH 02/41] add intuitive error messages to harmonize --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/harmonize.R | 9 +++++++++ README.md | 6 +++--- man/harmonize.Rd | 6 ++---- 6 files changed, 19 insertions(+), 12 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index edd80f3..035d747 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28140672' +ValidationKey: '28161605' 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 146e3a1..07eb694 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: 'mip: Comparison of multi-model runs' -version: 0.144.4 -date-released: '2023-05-11' +version: 0.144.5 +date-released: '2023-05-12' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 149ef27..774c5dc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.144.4 -Date: 2023-05-11 +Version: 0.144.5 +Date: 2023-05-12 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/harmonize.R b/R/harmonize.R index 25dfa83..11bf777 100644 --- a/R/harmonize.R +++ b/R/harmonize.R @@ -75,8 +75,17 @@ harmonize <- function(df, hist, finalYear = "2050", harmonizeYear = "2015", meth # iterate over models and variables vars <- intersect(unique(df$variable), unique(hist$variable)) + + if (length(vars) == 0) { + stop("No matching variables in model data and historical data found.") + } + regions <- intersect(unique(df$region), unique(hist$region)) + if (length(regions) == 0) { + stop("No matching regions in model data and historical data found.") + } + hist <- hist %>% filter(!is.na(!!sym("value")), !!sym("variable") %in% vars, !!sym("region") %in% regions) %>% reshape2::dcast(formula = ... ~ period) diff --git a/README.md b/README.md index 9decd7d..d3f369b 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.144.4** +R package **mip**, version **0.144.5** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.144.4, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.144.5, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.144.4}, + note = {R package version 0.144.5}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } diff --git a/man/harmonize.Rd b/man/harmonize.Rd index 191ddb4..6ed0c51 100644 --- a/man/harmonize.Rd +++ b/man/harmonize.Rd @@ -22,11 +22,9 @@ harmonize( \item{finalYear}{when should harmonized data match model data again?} -\item{harmonizeYear}{when should harmonization begin? -sets model data = reference data for this year} +\item{harmonizeYear}{when should harmonization begin? sets model data = reference data for this year} -\item{method}{harmonization method, currently supported methods are -"ratio" and "offset"} +\item{method}{harmonization method, currently supported methods are "ratio" and "offset"} \item{suffix}{to be appended to harmonized variables} } From 6411b0ff84fdaedc86ba80a4ad79011cf4ec9d94 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 16 May 2023 11:18:12 +0200 Subject: [PATCH 03/41] add error checks to harmonize --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/harmonize.R | 5 +++++ README.md | 6 +++--- 5 files changed, 13 insertions(+), 8 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 035d747..0cba3ec 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28161605' +ValidationKey: '28186878' 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 07eb694..8560fb6 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: 'mip: Comparison of multi-model runs' -version: 0.144.5 -date-released: '2023-05-12' +version: 0.144.6 +date-released: '2023-05-16' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 774c5dc..524527c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.144.5 -Date: 2023-05-12 +Version: 0.144.6 +Date: 2023-05-16 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/harmonize.R b/R/harmonize.R index 11bf777..e01a740 100644 --- a/R/harmonize.R +++ b/R/harmonize.R @@ -17,6 +17,11 @@ harmonize <- function(df, hist, finalYear = "2050", harmonizeYear = "2015", meth stop("Invalid method. Options are 'offset' and 'ratio'.") } + if (!all(c("region", "period", "variable", "value", "model", "scenario", "unit") %in% colnames(df)) || + length(colnames(df)) != 7) { + stop("df must contain columns: region, period, variable, value, model, scenario, unit") + } + .reduceRatio <- function(df, hist, finalYear = "2050", harmonizeYear = "2015") { # harmonize factors c <- hist[, harmonizeYear] diff --git a/README.md b/README.md index d3f369b..d4aa124 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.144.5** +R package **mip**, version **0.144.6** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.144.5, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.144.6, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.144.5}, + note = {R package version 0.144.6}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From f5f0a4dc297787a46fbce1fe282fcae4bd5baa28 Mon Sep 17 00:00:00 2001 From: florianh Date: Tue, 16 May 2023 11:22:24 +0200 Subject: [PATCH 04/41] update scenToolMAgPIE --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 4 +- R/scenToolMAgPIE.R | 191 +++++++++++++++++++++++++++------------------ README.md | 6 +- 5 files changed, 122 insertions(+), 85 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 035d747..0cba3ec 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28161605' +ValidationKey: '28186878' 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 07eb694..8560fb6 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: 'mip: Comparison of multi-model runs' -version: 0.144.5 -date-released: '2023-05-12' +version: 0.144.6 +date-released: '2023-05-16' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 774c5dc..524527c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.144.5 -Date: 2023-05-12 +Version: 0.144.6 +Date: 2023-05-16 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/scenToolMAgPIE.R b/R/scenToolMAgPIE.R index 57e926e..72c6422 100644 --- a/R/scenToolMAgPIE.R +++ b/R/scenToolMAgPIE.R @@ -1,6 +1,6 @@ #' @title scenToolMAgPIE #' @description scenToolMAgPIE allows to explore and visualize time series of modelling results. The app is based on shiny opens in an external web brower. For more details: https://github.com/flohump/scenTool -#' +#' #' @param file report data. Can be a CSV/MIF file or rds file with a quitte object (saved with saveRDS). file can also be a vector of rds files. NULL by default; in this case the user can upload files directly in the tool #' @param valfile validation data. Can be a CSV/MIF file or rds file with a quitte object (saved with saveRDS). NULL by default; in this case the user can upload files directly in the tool #' @author Florian Humpenoeder @@ -8,7 +8,7 @@ #' \dontrun{ #' scenToolMAgPIE("testdata.mif") #' } -#' +#' #' @importFrom quitte as.quitte read.quitte #' @importFrom shiny reactiveValues observeEvent updateTextInput observe updateSelectInput reactive hoverOpts uiOutput sliderInput #' renderPrint renderDataTable downloadHandler fluidPage navbarPage tabPanel sidebarLayout sidebarPanel @@ -26,7 +26,7 @@ #' scenToolMAgPIE <- function(file=NULL,valfile=NULL) { model <- scenario <- region <- year <- period <- variable <- unit <- NULL - + #limit for file upload set to 300 MB options(shiny.maxRequestSize = 300*1024^2) @@ -35,7 +35,7 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { #initialize reactive value val <- reactiveValues(rep_full=NULL,rep_sel=NULL,rep_sel_tmp=NULL,val_full=NULL,val_sel=NULL,val_sel_tmp=NULL) - + if(is.null(file)) { #create dummy data for testing the tool model <- factor(c("Model1","Model2","Model3")) @@ -47,7 +47,7 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { long <- expand.grid(model,scenario,region,variable,unit,period,1,KEEP.OUT.ATTRS = FALSE,stringsAsFactors = TRUE) names(long) <- c("model","scenario","region","variable","unit","period","value") long$value <- 1:length(long$value) - val$rep_full <- as.quitte(long) + val$rep_full <- as.data.table(as.quitte(long)) } else if (all(file_ext(file) == "rds")) { readdata <- function(file) { if(grepl("http://",file)) { @@ -73,36 +73,36 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { # #sort regions # tmp$region <- factor(tmp$region, levels = c(setdiff(levels(tmp$region),"GLO"),"GLO")) # tmp <- tmp[order(tmp$region,tmp$variable,tmp$period),] - val$rep_full <- tmp - } else val$rep_full <- read.quitte(file) + val$rep_full <- as.data.table(tmp) + } else val$rep_full <- as.data.table(read.quitte(file)) if(!is.null(valfile)) { if (file_ext(valfile) %in% c("RData","rda","rds")) { - val$val_full <- readRDS(valfile) - } else val$val_full <- read.quitte(valfile) + val$val_full <- as.data.table(readRDS(valfile)) + } else val$val_full <- as.data.table(read.quitte(valfile)) } - - + + #Upload and read in data file if there is a change in input$datafile observeEvent(input$datafile, { print("read data") #assing to reactive value if (file_ext(input$datafile$datapath) %in% c("RData","rda","rds")) { - val$rep_full <- readRDS(input$datafile$datapath) - } else val$rep_full <- read.quitte(input$datafile$datapath) + val$rep_full <- as.data.table(readRDS(input$datafile$datapath)) + } else val$rep_full <- as.data.table(read.quitte(input$datafile$datapath)) }) - + #Upload and read in data file if there is a change in input$valfile observeEvent(input$valfile, { print("read val data") #assing to reactive value if (file_ext(input$valfile$datapath) %in% c("RData","rda","rds")) { - val$val_full <- readRDS(input$valfile$datapath) - } else val$val_full <- read.quitte(input$valfile$datapath) + val$val_full <- as.data.table(readRDS(input$valfile$datapath)) + } else val$val_full <- as.data.table(read.quitte(input$valfile$datapath)) #setnames(val$val_full,"Model","Validation Source") }) - + #subsetting the data stepwise is faster than all at once - observeEvent(c(input$model,input$scenario,input$region,input$year,input$variable,input$valfile,input$show_val,input$update_plot),{ + observeEvent(c(input$model,input$scenario,input$region,input$year,input$variable,input$show_hist,input$show_proj,input$update_plot),{ if (input$update_plot) { # print(!is.null(val$rep_sel)) # if(!is.null(val$rep_sel)) { @@ -118,40 +118,46 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { # } # } else { print("full subset model data") - val$rep_sel <- subset(val$rep_full,model %in% input$model) - val$rep_sel <- subset(val$rep_sel,scenario %in% input$scenario) - val$rep_sel <- subset(val$rep_sel,region %in% input$region) - val$rep_sel <- subset(val$rep_sel,period %in% input$year) - val$rep_sel <- subset(val$rep_sel,variable %in% input$variable) + val$rep_sel <- val$rep_full[get("model") %in% input$model & get("scenario") %in% input$scenario & get("region") %in% input$region & get("period") >= min(input$year) & get("period") <= max(input$year) & get("variable") %in% input$variable,] + #val$rep_sel <- subset(val$rep_full,model %in% input$model) + # val$rep_sel <- subset(val$rep_sel,scenario %in% input$scenario) + # val$rep_sel <- subset(val$rep_sel,region %in% input$region) + # val$rep_sel <- subset(val$rep_sel,period >= min(input$year) & period <= max(input$year)) + # val$rep_sel <- subset(val$rep_sel,variable %in% input$variable) val$rep_sel <- droplevels(val$rep_sel) #print(head(val$rep_sel,12)) #val$rep_sel$scenario <- factor(val$rep_sel$scenario, levels = val$rep_sel$scenario[order(input$scenario)]) - + # } - - if(!is.null(val$val_full) & input$show_val) { + + if(!is.null(val$val_full) & (input$show_hist | input$show_proj)) { #levels(val_full$region) <- sub("World","GLO",levels(val_full$region)) - val$val_full <- val$val_full[val$val_full$period > 1950,] #show validation data only for years > 1950 print("subset validation data") - val$val_sel <- subset(val$val_full,region %in% input$region) - val$val_sel <- subset(val$val_sel,variable %in% input$variable) + val$val_sel <- val$val_full[get("region") %in% input$region & get("period") >= 1950 & get("period") <= max(input$year) & get("variable") %in% input$variable,] + if (input$show_hist & !input$show_proj) val$val_sel <- val$val_sel[get("scenario") == "historical",] + if (!input$show_hist & input$show_proj) val$val_sel <- val$val_sel[get("scenario") != "historical",] + # val$val_sel <- val$val_sel[val$val_full$period > 1950,] #show validation data only for years > 1950 + # val$val_sel <- subset(val$val_sel,scenario == "historical") + # val$val_sel <- subset(val$val_sel,region %in% input$region) + # val$val_sel <- subset(val$val_sel,variable %in% input$variable) val$val_sel <- droplevels(val$val_sel) if(nrow(val$val_sel) == 0) val$val_sel <- NULL - } else val$val_sel <- NULL + } else val$val_sel <- NULL } }) - - + + #subsetting the data stepwise is faster than all at once - observeEvent(c(input$valmodel,input$valscenario,input$valyear),{ + observeEvent(c(input$valmodel,input$valscenario),{ print("subset selected validation data") - val$val_sel <- subset(val$val_sel,model %in% input$valmodel) - val$val_sel <- subset(val$val_sel,scenario %in% input$valscenario) + val$val_sel <- val$val_sel[get("model") %in% input$valmodel & get("scenario") %in% input$valscenario,] + # val$val_sel <- subset(val$val_sel,model %in% input$valmodel) + # val$val_sel <- subset(val$val_sel,scenario %in% input$valscenario) #val$val_sel <- subset(val$val_sel,Region %in% input$valregion) - val$val_sel <- subset(val$val_sel,period %in% input$valyear) + #val$val_sel <- subset(val$val_sel,period %in% input$valyear) #val$val_sel <- subset(val$val_sel,Variable %in% input$valvariable) }) - + #normalize observeEvent(c(input$normalize),{ if(input$normalize) { @@ -170,17 +176,17 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { if(!is.null(val$val_sel_tmp)) val$val_sel <- val$val_sel_tmp } }) - - - + + + observe({ print("update choices data") updateSelectInput(session, "model", choices = levels(val$rep_full$model),selected = levels(val$rep_full$model)[1]) updateSelectInput(session, "scenario", choices = levels(val$rep_full$scenario),selected = if (length(levels(val$rep_full$scenario)) > 2) levels(val$rep_full$scenario)[1:2] else levels(val$rep_full$scenario)) updateSelectInput(session, "region", choices = levels(val$rep_full$region),selected = levels(val$rep_full$region)) - updateSelectInput(session, "year", choices = unique(val$rep_full$period),selected = unique(val$rep_full$period)) + updateSliderInput(session, "year", min = min(val$rep_full$period),max = max(val$rep_full$period), value = range(val$rep_full$period), step = min(diff(unique(val$rep_full$period)))) updateSelectInput(session, "variable", choices = levels(val$rep_full$variable),selected = levels(val$rep_full$variable)[1]) - + }) observe({ @@ -188,38 +194,38 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { updateSelectInput(session, "valmodel", choices = levels(val$val_sel$model),selected = levels(val$val_sel$model)) updateSelectInput(session, "valscenario", choices = levels(val$val_sel$scenario),selected = levels(val$val_sel$scenario)) # updateSelectInput(session, "valregion", choices = levels(val$valtmp$Region),selected = levels(val$valtmp$Region)) - updateSelectInput(session, "valyear", choices = unique(val$val_sel$period),selected = unique(val$val_sel$period)) +# updateSelectInput(session, "valyear", choices = unique(val$val_sel$period),selected = unique(val$val_sel$period)) # updateSelectInput(session, "valvariable", choices = levels(val$valtmp$Variable),selected = levels(val$valtmp$Variable)[1]) }) - - + + tf <- reactive({ if(is.null(val$val_sel)) stop("Validation file needed for trafficlights!") else trafficlight(x=as.magpie(val$rep_sel,spatial="region",temporal="period",tidy=TRUE),xc=as.magpie(val$val_sel,spatial="region",temporal="period",tidy=TRUE),detailed=FALSE) }) - - - lineplot <- reactive({ + + + lineplot <- debounce(reactive({ if(input$update_plot) { p <- mipLineHistorical(x=val$rep_sel,x_hist=val$val_sel,size = 10,ylab = val$rep_sel$unit,title = val$rep_sel$variable,scales = input$scales,ylim=switch(input$auto_y + 1, 0, NULL)) } else p <- NULL return(p) - }) - + }), 500) + areaplot <- reactive({ p <- mipArea(x=if(input$exclude_world) val$rep_sel[val$rep_sel$region!="World",] else val$rep_sel) return(p) }) - + output$lineplot <- renderPlot({ lineplot()},res = 120)#height = 400, width = 500 - + output$areaplot <- renderPlot({ areaplot()},res = 120)#height = 400, width = 500 - + output$tf <- renderPlot({ tf()},res = 120)#height = 400, width = 500 - + output$summary <- renderPrint({ summary(val$rep_sel$value) }) @@ -233,18 +239,48 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { output$data <- renderDataTable({ val$rep_sel }, options = list(pageLength = 10)) - output$downloadLinePlot <- downloadHandler( + output$downloadLinePlotPDF <- downloadHandler( filename = function() { paste("export", '.pdf', sep='') }, content = function(file) { - ggsave(file, plot = lineplot(), device = "pdf",scale=1,width=20,height=18,units="cm",dpi=150) + ggsave(file, plot = lineplot(), device = "pdf",scale=1,width=20,height=18,units="cm",dpi=150, bg = 'white') } ) - output$downloadAreaPlot <- downloadHandler( + + output$downloadLinePlotPNG <- downloadHandler( + filename = function() { paste("export", '.png', sep='') }, + content = function(file) { + ggsave(file, plot = lineplot(), device = "png",scale=1,width=20,height=18,units="cm",dpi=150, bg = 'white') + } + ) + + output$downloadLinePlotRDS <- downloadHandler( + filename = function() { paste("export", '.rds', sep='') }, + content = function(file) { + saveRDS(lineplot(),file=file) + } + ) + + output$downloadAreaPlotPDF <- downloadHandler( filename = function() { paste("export", '.pdf', sep='') }, content = function(file) { - ggsave(file, plot = areaplot(), device = "pdf",scale=1,width=20,height=13,units="cm",dpi=150) + ggsave(file, plot = areaplot(), device = "pdf",scale=1,width=20,height=13,units="cm",dpi=150, bg = 'white') } ) + + output$downloadAreaPlotPNG <- downloadHandler( + filename = function() { paste("export", '.png', sep='') }, + content = function(file) { + ggsave(file, plot = areaplot(), device = "png",scale=1,width=20,height=13,units="cm",dpi=150, bg = 'white') + } + ) + + output$downloadAreaPlotRDS <- downloadHandler( + filename = function() { paste("export", '.rds', sep='') }, + content = function(file) { + saveRDS(lineplot(),file=file) + } + ) + output$downloadData <- downloadHandler( filename = function() { paste("export", '.csv', sep='') }, content = function(file) { @@ -253,13 +289,13 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { write.csv(out, file ,row.names = FALSE,quote = FALSE) } ) - + } - + #client-sided function ui <- fluidPage( sidebarLayout( - + sidebarPanel( tabsetPanel(id="side",type = "tabs", tabPanel("Report Data", @@ -268,27 +304,28 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { selectInput('model', 'Model', "Pending upload",multiple = TRUE), selectInput('scenario', 'Scenario', "Pending upload",multiple = TRUE), selectInput('region', 'Region', "Pending upload",multiple = TRUE), - selectInput('year', 'Year', "Pending upload",multiple = TRUE), - #sliderInput("year", "Year",min=2000,max=2100,value=c(2000,2100),step=10), + #selectInput('year', 'Year', "Pending upload",multiple = TRUE), + sliderInput("year", "Year", min = 2000, max = 2100, step = 10, value = c(2000,2100)), selectInput('variable', 'Variable', "Pending upload",multiple = FALSE), tags$hr(), checkboxInput('update_plot', 'Update Plot', value = TRUE, width = NULL), - conditionalPanel(condition = "input.valfile != NULL", checkboxInput('show_val', 'Show Validation', value = TRUE, width = NULL)) + conditionalPanel(condition = "input.valfile != NULL", checkboxInput('show_hist', 'Show history', value = TRUE, width = NULL)), + conditionalPanel(condition = "input.valfile != NULL", checkboxInput('show_proj', 'Show other projections', value = FALSE, width = NULL)) ), tabPanel("Validation Data", fileInput('valfile', 'Upload Validation File', accept=c('.mif','.csv','.rda','.rds','.RData')), tags$hr(), #checkboxInput('auto_val_sel', 'Automatic matching with Model Data', value = TRUE, width = NULL), selectInput('valmodel', 'Model', "Pending upload",multiple = TRUE), - selectInput('valscenario', 'Scenario', "Pending upload",multiple = TRUE), + selectInput('valscenario', 'Scenario', "Pending upload",multiple = TRUE) #selectInput('valregion', 'Region', "Pending upload",multiple = TRUE), - selectInput('valyear', 'Year', "Pending upload",multiple = TRUE) + #selectInput('valyear', 'Year', "Pending upload",multiple = TRUE) #sliderInput("year", "Year",min=2000,max=2100,value=c(2000,2100),step=10), #selectInput('valvariable', 'Variable', "Pending upload",multiple = FALSE) ) - + ) - + ,width=3), mainPanel( tabsetPanel(id = "main",type = "tabs", @@ -303,7 +340,7 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { ) ) ), - wellPanel(downloadButton('downloadLinePlot', 'Download Plot')) + wellPanel(downloadButton('downloadLinePlotPDF', 'PDF'),downloadButton('downloadLinePlotPNG', 'PNG'),downloadButton('downloadLinePlotRDS', 'RDS')) ), tabPanel("AreaPlot", plotOutput("areaplot",height = "800px",width = "auto"), @@ -314,16 +351,16 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { ) ) ), - wellPanel(downloadButton('downloadAreaPlot', 'Download Plot')) + wellPanel(downloadButton('downloadAreaPlotPDF', 'PDF'),downloadButton('downloadAreaPlotPNG', 'PNG'),downloadButton('downloadAreaPlotRDS', 'RDS')) ), - tabPanel("Table", + tabPanel("Table", dataTableOutput("data"), - wellPanel(downloadButton('downloadData', 'Download Data')) + wellPanel(downloadButton('downloadData', 'CSV')) ), tabPanel("Trafficlight", plotOutput("tf",height = "200px",width = "auto") ), - tabPanel("Info", + tabPanel("Info", h2("Summary"), verbatimTextOutput("summary"), h2("General information about the dataset"), @@ -333,9 +370,9 @@ scenToolMAgPIE <- function(file=NULL,valfile=NULL) { ) ) ) - - - + + + #start the app shinyApp(ui = ui, server = server) - } + } diff --git a/README.md b/README.md index d3f369b..d4aa124 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.144.5** +R package **mip**, version **0.144.6** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.144.5, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.144.6, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.144.5}, + note = {R package version 0.144.6}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From d781144ba80d3a1402ea8a61100fc4ce7bf912ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pascal=20F=C3=BChrlich?= <82826417+pfuehrlich-pik@users.noreply.github.com> Date: Mon, 22 May 2023 11:42:32 +0200 Subject: [PATCH 05/41] fix broken link in harmonize.R --- R/harmonize.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/harmonize.R b/R/harmonize.R index e01a740..d991374 100644 --- a/R/harmonize.R +++ b/R/harmonize.R @@ -1,6 +1,6 @@ #' Harmonization of model data to historical data, using harmonization methods #' of aneris, ported to R. -#' See: https://github.com/iiasa/aneris/blob/master/aneris/methods.py +#' See: https://github.com/iiasa/aneris/blob/ad6301eb42155c968f20b2c7e071cbec039acc03/aneris/methods.py #' @author Falk Benke #' @param df data frame with model data to be harmonized From 9554ce80d69bcd3d113bc4e4b971f32316576a23 Mon Sep 17 00:00:00 2001 From: orichters Date: Mon, 22 May 2023 17:58:28 +0200 Subject: [PATCH 06/41] fix wrong ylabel and total lines, add pCap to plotstyle --- R/showAreaAndBarPlots.R | 4 ++-- inst/extdata/plotstyle.csv | 7 +++++++ 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/R/showAreaAndBarPlots.R b/R/showAreaAndBarPlots.R index 82baa80..5de2daa 100644 --- a/R/showAreaAndBarPlots.R +++ b/R/showAreaAndBarPlots.R @@ -85,7 +85,7 @@ showAreaAndBarPlots <- function( } dnohist <- data %>% - filter(data$scenario != "historical") %>% + filter(.data$variable %in% c(.env$vars, tot), .data$scenario != "historical") %>% droplevels() if (! "identifier" %in% names(dnohist)) dnohist$identifier <- identifierModelScen(dnohist) d <- dnohist %>% @@ -119,7 +119,7 @@ showAreaAndBarPlots <- function( ) # Common label for y-axis. - lcp <- gsub("\\|$", "", attr(shorten_legend(vars, identical_only = TRUE), "front")) + lcp <- if (is.null(tot)) gsub("\\|$", "", attr(shorten_legend(vars, identical_only = TRUE), "front")) else tot label <- paste0(lcp, " (", paste0(levels(d$unit), collapse = ","), ")") # Create plots. diff --git a/inst/extdata/plotstyle.csv b/inst/extdata/plotstyle.csv index dedc6d6..dd255d9 100644 --- a/inst/extdata/plotstyle.csv +++ b/inst/extdata/plotstyle.csv @@ -383,13 +383,16 @@ Hydrogen|w/ CCS;Hydrogen w/ CCS;#ff7b00;; Hydrogen|w/o CCS;Hydrogen w/o CCS;#ab7bb8;; Other;Other;#ff6666;; Gases;Gases;#999959;; +Gases pCap;Gases;#999959;; Solar|CSP;Solar CSP;#ffb400;; Solar|PV;Solar PV;#ffe600;; Electricity;Electricity;#ffb200;; Heat;Heat;#cc0000;; Solids;Solids;#0c0c0c;; Liquids;Liquids;#0000cc;; +Liquids pCap;Liquids;#0000cc;; Hydrogen;Hydrogen;#66cccc;; +Hydrogen pCap;Hydrogen;#66cccc;; CO2|Land-Use Change;CO2|Land-Use Change;#007f00;; CO2|Gross Fossil Fuels and Industry;CO2|Gross FF & I;#000000;; CO2|Carbon Capture and Storage|Biomass;CO2|CCS|Biomass;#666666;; @@ -661,9 +664,13 @@ SUV;SUV;#C4A1A1;; Large;Large;#424242;; Van;Van;#604343;; BEV;BEV;#ffb200;; +BEV pCap;BEV;#ffb200;; Electric;Electric;#ffb200;; +Electric pCap;Electric;#ffb200;; FCEV;FCEV;#66cccc;; +FCEV pCap;FCEV;#66cccc;; Hybrid Electric;Hybrid Electric;#f37735;; +Hybrid Electric pCap;Hybrid Electric;#f37735;; International Shipping;International Shipping;#660099;; Rail;Rail;#333366;; Road;Road;#6699CC;; From 034fe6afc22e03db1c6c0418d1a5553ca0278571 Mon Sep 17 00:00:00 2001 From: orichters Date: Tue, 23 May 2023 10:55:34 +0200 Subject: [PATCH 07/41] add pCap to legend titles --- inst/extdata/plotstyle.csv | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/inst/extdata/plotstyle.csv b/inst/extdata/plotstyle.csv index dd255d9..5a7326a 100644 --- a/inst/extdata/plotstyle.csv +++ b/inst/extdata/plotstyle.csv @@ -383,16 +383,16 @@ Hydrogen|w/ CCS;Hydrogen w/ CCS;#ff7b00;; Hydrogen|w/o CCS;Hydrogen w/o CCS;#ab7bb8;; Other;Other;#ff6666;; Gases;Gases;#999959;; -Gases pCap;Gases;#999959;; +Gases pCap;Gases pCap;#999959;; Solar|CSP;Solar CSP;#ffb400;; Solar|PV;Solar PV;#ffe600;; Electricity;Electricity;#ffb200;; Heat;Heat;#cc0000;; Solids;Solids;#0c0c0c;; Liquids;Liquids;#0000cc;; -Liquids pCap;Liquids;#0000cc;; +Liquids pCap;Liquids pCap;#0000cc;; Hydrogen;Hydrogen;#66cccc;; -Hydrogen pCap;Hydrogen;#66cccc;; +Hydrogen pCap;Hydrogen pCap;#66cccc;; CO2|Land-Use Change;CO2|Land-Use Change;#007f00;; CO2|Gross Fossil Fuels and Industry;CO2|Gross FF & I;#000000;; CO2|Carbon Capture and Storage|Biomass;CO2|CCS|Biomass;#666666;; @@ -664,13 +664,13 @@ SUV;SUV;#C4A1A1;; Large;Large;#424242;; Van;Van;#604343;; BEV;BEV;#ffb200;; -BEV pCap;BEV;#ffb200;; +BEV pCap;BEV pCap;#ffb200;; Electric;Electric;#ffb200;; -Electric pCap;Electric;#ffb200;; +Electric pCap;Electric pCap;#ffb200;; FCEV;FCEV;#66cccc;; -FCEV pCap;FCEV;#66cccc;; +FCEV pCap;FCEV pCap;#66cccc;; Hybrid Electric;Hybrid Electric;#f37735;; -Hybrid Electric pCap;Hybrid Electric;#f37735;; +Hybrid Electric pCap;Hybrid Electric pCap;#f37735;; International Shipping;International Shipping;#660099;; Rail;Rail;#333366;; Road;Road;#6699CC;; From 2614eb93798a1295753bb181041da99e7ce9d23a Mon Sep 17 00:00:00 2001 From: bodirsky Date: Mon, 5 Jun 2023 17:21:24 +0200 Subject: [PATCH 08/41] scratchBar function --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 4 +- NAMESPACE | 1 + R/scratchBar.R | 106 ++++++++++++++++++++++++++++++++++++++++++++++ README.md | 6 +-- man/harmonize.Rd | 4 +- man/scratchBar.Rd | 35 +++++++++++++++ 8 files changed, 152 insertions(+), 10 deletions(-) create mode 100644 R/scratchBar.R create mode 100644 man/scratchBar.Rd diff --git a/.buildlibrary b/.buildlibrary index 69672d7..c2e90b9 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28219394' +ValidationKey: '28293850' 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 18a130f..6f3c950 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: 'mip: Comparison of multi-model runs' -version: 0.144.7 -date-released: '2023-05-25' +version: 0.145.0 +date-released: '2023-06-05' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 18a0d1b..87d0946 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.144.7 -Date: 2023-05-25 +Version: 0.145.0 +Date: 2023-06-05 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 15208da..bb59d9c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(plotstyle) export(plotstyle.add) export(scenTool) export(scenToolMAgPIE) +export(scratchBar) export(shorten_legend) export(showAreaAndBarPlots) export(showAreaAndBarPlotsPlus) diff --git a/R/scratchBar.R b/R/scratchBar.R new file mode 100644 index 0000000..0688935 --- /dev/null +++ b/R/scratchBar.R @@ -0,0 +1,106 @@ +#' @title scratchBar +#' @description Fast visualization of a magpie object or quitte object as bar plot. +#' If available, the years 2020 and 2050 will be selected; if not available the first and last year of the available years. +#' +#' +#' @export +#' +#' @param x an object that can be converted to a quitte (e.g. a quitte object or a magpie objet) +#' @param complete "default" or list with specifications for scratchComplete +#' @param simplify "default" or list with specifications for scratchSimplify +#' @param ... furhter arguments handed on to mipBarYearData function +#' @return ggplot object +#' @author Benjamin Leon Bodirsky + +#' @examples +#' +#' \dontrun{ +#' x <- Intake(gdx) +#' } +#' +#' +scratchBar <- function (x, complete = "default", simplify = "default", ...) { + + # complete object + x <- scratchComplete(x) + + # simplify object + x <- scratchSimplify(x) + + # add metadata + + #plot + + plot = mipBarYearData(x, ...) + + return(plot) +} + +scratchComplete <- function(x) { + + if(!is.quitte(x)){ + cat("Expected input data format is quitte. Converting to quitte.") + if(is.magpie(x)){ + # handle missing years + if(length(getYears(x))==0){ + cat("Year missing. Set to y9999 for plotting") + x=setYears(x,"y9999") + } + # handle misspecified variable column + potential_vars = setdiff(strsplit(getSets(x,fulldim = F)[[3]],split = "\\.")[[1]],c("model","scenario")) + if("variable"%in%potential_vars){} else { + cat(paste0("Using the set ", potential_vars[1], " as variable dimension.")) + tmp=getSets(x) + tmp[which(tmp==potential_vars[1])]<-"variable" + getSets(x)<-tmp + } + } + + x <- as.quitte(x) + } + + # rescue model and scenario if missing + x$model <- revalue(x$model,c("(Missing)" = "unspecified_model"),warn_missing = FALSE) + x$scenario <- revalue(x$scenario,c("(Missing)" = "unspecified_scenario"),warn_missing = FALSE) + x$variable <- revalue(x$variable,c("(Missing)" = "unspecified_variable"),warn_missing = FALSE) + x$unit <- revalue(x$unit,c("(Missing)" = "unspecified_unit"),warn_missing = FALSE) + + return(x) +} + +scratchSimplify<-function(x,simplify="default"){ + x=as.quitte(x) + x=as.magpie(x) + if(simplify=="default"){ + + #subselect two years for simplication + if(length(getYears(x)>2)){ + if("y2020"%in%getYears(x)){ + year_one="y2020" + } else { + year_one=getYears(x)[1] + } + if("y2050" %in% getYears(x)){ + year_two="y2050" + } else { + year_two= getYears(x)[length(getYears(x))] + } + x = x[,c(year_one,year_two),] + } + + #if multiple variables, throw warning + if (length(setdiff( + strsplit(getSets(x,fulldim = FALSE)[[3]],split = "\\.")[[1]], + c("model","scenario")))>1) { + cat("There is more than one variable beyond model and scenario. This cannot be well handled by the plotting script.") + # no further handling strategy needed as for now, as the plotting function seems to handle this. + } + + #if first year contains equal values, only show one bar + + } + x=as.quitte(x) + return(x) +} + + diff --git a/README.md b/README.md index fe634b1..fc2ec4a 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.144.7** +R package **mip**, version **0.145.0** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.0, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.144.7}, + note = {R package version 0.145.0}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } diff --git a/man/harmonize.Rd b/man/harmonize.Rd index 6ed0c51..929a5c1 100644 --- a/man/harmonize.Rd +++ b/man/harmonize.Rd @@ -4,7 +4,7 @@ \alias{harmonize} \title{Harmonization of model data to historical data, using harmonization methods of aneris, ported to R. -See: https://github.com/iiasa/aneris/blob/master/aneris/methods.py} +See: https://github.com/iiasa/aneris/blob/ad6301eb42155c968f20b2c7e071cbec039acc03/aneris/methods.py} \usage{ harmonize( df, @@ -31,7 +31,7 @@ harmonize( \description{ Harmonization of model data to historical data, using harmonization methods of aneris, ported to R. -See: https://github.com/iiasa/aneris/blob/master/aneris/methods.py +See: https://github.com/iiasa/aneris/blob/ad6301eb42155c968f20b2c7e071cbec039acc03/aneris/methods.py } \author{ Falk Benke diff --git a/man/scratchBar.Rd b/man/scratchBar.Rd new file mode 100644 index 0000000..b9a8fef --- /dev/null +++ b/man/scratchBar.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scratchBar.R +\name{scratchBar} +\alias{scratchBar} +\title{scratchBar} +\usage{ +scratchBar(x, complete = "default", simplify = "default", ...) +} +\arguments{ +\item{x}{an object that can be converted to a quitte (e.g. a quitte object or a magpie objet)} + +\item{complete}{"default" or list with specifications for scratchComplete} + +\item{simplify}{"default" or list with specifications for scratchSimplify} + +\item{...}{furhter arguments handed on to mipBarYearData function} +} +\value{ +ggplot object +} +\description{ +Fast visualization of a magpie object or quitte object as bar plot. +If available, the years 2020 and 2050 will be selected; if not available the first and last year of the available years. +} +\examples{ + + \dontrun{ + x <- Intake(gdx) + } + + +} +\author{ +Benjamin Leon Bodirsky +} From d8e41e00a1e001a8d6b02ecec5af68a44eb89c7e Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 6 Jul 2023 15:50:18 +0200 Subject: [PATCH 09/41] bring back missing markers in historical legend --- .buildlibrary | 2 +- .pre-commit-config.yaml | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- Makefile | 5 +++-- R/mipLineHistorical.R | 2 +- README.md | 6 +++--- 7 files changed, 13 insertions(+), 12 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index c2e90b9..2d313d8 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28293850' +ValidationKey: '28358344' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index d9409d2..9c3b069 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.3.2.9007 + rev: v0.3.2.9013 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index 6f3c950..2f88da6 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: 'mip: Comparison of multi-model runs' -version: 0.145.0 -date-released: '2023-06-05' +version: 0.145.1 +date-released: '2023-07-06' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 87d0946..102d8eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.0 -Date: 2023-06-05 +Version: 0.145.1 +Date: 2023-07-06 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/Makefile b/Makefile index c1e0c68..38e857f 100644 --- a/Makefile +++ b/Makefile @@ -11,8 +11,9 @@ HELP_PARSING = 'm <- readLines("Makefile");\ help: ## Show this help. @Rscript -e $(HELP_PARSING) -build: ## Build the package using lucode2::buildLibrary(). - Rscript -e 'lucode2::buildLibrary()' +build: ## Build the package using lucode2::buildLibrary(). You can pass the + ## updateType with 'make build u=3' + Rscript -e 'lucode2::buildLibrary(updateType = "$(u)")' check: ## Build documentation and vignettes, run testthat tests, ## and check if code etiquette is followed using lucode2::check(). diff --git a/R/mipLineHistorical.R b/R/mipLineHistorical.R index b055e81..503fbce 100644 --- a/R/mipLineHistorical.R +++ b/R/mipLineHistorical.R @@ -257,7 +257,7 @@ mipLineHistorical <- function(x,x_hist=NULL,color.dim="identifier",linetype.dim= #alpha: add colors for projection depending on leg.proj p <- p + scale_color_manual(color.dim.name,values = color_set, breaks=model_output,labels=sub("\\."," ",model_output),guide=guide_legend(order=1,title.position = "top", ncol=legend.ncol)) p <- p + scale_fill_manual("Historical data",values = color_set[historical],breaks=historical, - guide=guide_legend(override.aes = list(colour=color_set[historical],shape="+",linetype=0,linewidth=5),order=2,title.position = "top", ncol=legend.ncol)) + guide=guide_legend(override.aes = list(colour=color_set[historical],shape="+",linetype=0,size=5),order=2,title.position = "top", ncol=legend.ncol)) if(leg.proj) p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour=color_set[projection],shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) else p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour="#A1A194",shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) p <- p + guides(linetype=guide_legend(order=4,title.position="top",ncol=legend.ncol)) diff --git a/README.md b/README.md index fc2ec4a..5338d7e 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.0** +R package **mip**, version **0.145.1** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.0, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.1, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.0}, + note = {R package version 0.145.1}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From dd853c01a45adff918d562df449ce582319788af Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Wed, 9 Aug 2023 14:37:11 +0200 Subject: [PATCH 10/41] fix bugs in mipIterations plot --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/mipIterations.R | 9 +++++---- README.md | 6 +++--- 5 files changed, 13 insertions(+), 12 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 2d313d8..bef1a4f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28358344' +ValidationKey: '28427256' 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 2f88da6..cefe563 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: 'mip: Comparison of multi-model runs' -version: 0.145.1 -date-released: '2023-07-06' +version: 0.145.2 +date-released: '2023-08-09' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 102d8eb..6edbf33 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.1 -Date: 2023-07-06 +Version: 0.145.2 +Date: 2023-08-09 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/mipIterations.R b/R/mipIterations.R index b146771..88586bf 100644 --- a/R/mipIterations.R +++ b/R/mipIterations.R @@ -88,11 +88,12 @@ mipIterations <- function(plotData, returnGgplots = FALSE, # all combinations of values of columns not plotted (not mapped to x/y/color etc.) plottedColumns <- c(xAxis, color, slider, facets, valueColumnName) - unplottedCombinations <- unique(plotData[!(names(plotData) %in% plottedColumns)]) - unplottedCombinations <- lapply(split(unplottedCombinations, seq_len(nrow(unplottedCombinations))), as.list) - if (identical(length(unplottedCombinations), 0L)) { + if (length(plottedColumns) == ncol(plotData)) { unplottedCombinations <- list(list()) + } else { + unplottedCombinations <- unique(plotData[!(names(plotData) %in% plottedColumns)]) + unplottedCombinations <- lapply(split(unplottedCombinations, seq_len(nrow(unplottedCombinations))), as.list) } # create a plot for each combination of unplotted values (not mapped to an aesthetic) @@ -116,7 +117,7 @@ mipIterations <- function(plotData, returnGgplots = FALSE, # by default create a small plot for each region; always show all facets, even if empty plot <- plot + facet_wrap(facets, drop = FALSE) } - if (!is.null(color) & is.numeric(plotData[[color]])) { + if (!is.null(color) && is.numeric(plotData[[color]])) { plot <- plot + scale_color_gradientn(colours = rainbow(5, v = 0.8)) } return(plot) diff --git a/README.md b/README.md index 5338d7e..f126151 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.1** +R package **mip**, version **0.145.2** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.1, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.2, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.1}, + note = {R package version 0.145.2}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From 275f982f39185b65575b0051bf03d3aedba232a1 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 10 Aug 2023 11:00:50 +0200 Subject: [PATCH 11/41] add scale option to iteration plots --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/mipIterations.R | 7 +++++-- README.md | 6 +++--- man/mipIterations.Rd | 5 ++++- 6 files changed, 17 insertions(+), 11 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index bef1a4f..3d2128f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28427256' +ValidationKey: '28448287' 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 cefe563..8422535 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: 'mip: Comparison of multi-model runs' -version: 0.145.2 -date-released: '2023-08-09' +version: 0.145.3 +date-released: '2023-08-10' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 6edbf33..d82f92f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.2 -Date: 2023-08-09 +Version: 0.145.3 +Date: 2023-08-10 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/mipIterations.R b/R/mipIterations.R index 88586bf..a16838f 100644 --- a/R/mipIterations.R +++ b/R/mipIterations.R @@ -17,6 +17,8 @@ #' plotly. If NULL no slider is used. #' @param facets A string from names(x), defining which column is used for grouping. A small plot (facet) is #' shown for each group. If NULL facets are not used. +#' @param facetScales The 'scales' argument for facets (if used), defaults to 'fixed'. See help(facet_wrap) for more info. +#' #' @return A list of plotly plots, if returnGgplots is TRUE a list of ggplots instead #' @author Pascal Führlich #' @seealso \code{\link{getPlotData}} @@ -27,7 +29,8 @@ #' @importFrom utils tail #' @export mipIterations <- function(plotData, returnGgplots = FALSE, - xAxis = "year", color = NULL, slider = "iteration", facets = "region") { + xAxis = "year", color = NULL, slider = "iteration", facets = "region", + facetScales = "fixed") { nonNullArgs <- Filter(Negate(is.null), c(xAxis, color, slider, facets)) if (any(!(nonNullArgs %in% c(names(plotData), "year", "region")))) { stop( @@ -115,7 +118,7 @@ mipIterations <- function(plotData, returnGgplots = FALSE, theme(strip.background = element_blank()) if (!is.null(facets)) { # by default create a small plot for each region; always show all facets, even if empty - plot <- plot + facet_wrap(facets, drop = FALSE) + plot <- plot + facet_wrap(facets, drop = FALSE, scales = facetScales) } if (!is.null(color) && is.numeric(plotData[[color]])) { plot <- plot + scale_color_gradientn(colours = rainbow(5, v = 0.8)) diff --git a/README.md b/README.md index f126151..5f637af 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.2** +R package **mip**, version **0.145.3** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.2, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.3, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.2}, + note = {R package version 0.145.3}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } diff --git a/man/mipIterations.Rd b/man/mipIterations.Rd index 7253e0a..561567b 100644 --- a/man/mipIterations.Rd +++ b/man/mipIterations.Rd @@ -10,7 +10,8 @@ mipIterations( xAxis = "year", color = NULL, slider = "iteration", - facets = "region" + facets = "region", + facetScales = "fixed" ) } \arguments{ @@ -31,6 +32,8 @@ plotly. If NULL no slider is used.} \item{facets}{A string from names(x), defining which column is used for grouping. A small plot (facet) is shown for each group. If NULL facets are not used.} + +\item{facetScales}{The 'scales' argument for facets (if used), defaults to 'fixed'. See help(facet_wrap) for more info.} } \value{ A list of plotly plots, if returnGgplots is TRUE a list of ggplots instead From d1070c45139d0d5737fff6efc29ccf7d7b21b4b6 Mon Sep 17 00:00:00 2001 From: Renato-Rodrigues Date: Fri, 6 Oct 2023 18:43:27 +0200 Subject: [PATCH 12/41] only show regional facet if there is more than one region to be displayed --- NAMESPACE | 1 + R/showAreaAndBarPlots.R | 64 +++++++++++++++++++++++------------------ 2 files changed, 37 insertions(+), 28 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index bb59d9c..039b0aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,6 +71,7 @@ importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) +importFrom(ggplot2,geom_errorbar) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_text) importFrom(ggplot2,geom_vline) diff --git a/R/showAreaAndBarPlots.R b/R/showAreaAndBarPlots.R index 5de2daa..a97f9fa 100644 --- a/R/showAreaAndBarPlots.R +++ b/R/showAreaAndBarPlots.R @@ -134,19 +134,21 @@ showAreaAndBarPlots <- function( droplevels() %>% mipBarYearData(ylab = lcp) + ylab(NULL) + - theme(legend.position = "none") - p3 <- d %>% - filter(.data$region != .env$mainReg, .data$period %in% .env$yearsBarPlot) %>% - droplevels() %>% - mipBarYearData(ylab = lcp) + - ylab(NULL) + - guides(fill = guide_legend(reverse = TRUE, ncol = 3)) - p4 <- d %>% - filter(.data$region != .env$mainReg) %>% - droplevels() %>% - mipArea(scales = scales, total = is.null(tot), ylab = lcp, - stack_priority = if (is.null(tot)) c("variable", "region") else "variable") + - guides(fill = guide_legend(reverse = TRUE)) + { if (length(unique(data$region)) > 1) theme(legend.position = "none") } # nolint + if (length(unique(data$region)) > 1) { + p3 <- d %>% + filter(.data$region != .env$mainReg, .data$period %in% .env$yearsBarPlot) %>% + droplevels() %>% + mipBarYearData(ylab = lcp) + + ylab(NULL) + + guides(fill = guide_legend(reverse = TRUE, ncol = 3)) + p4 <- d %>% + filter(.data$region != .env$mainReg) %>% + droplevels() %>% + mipArea(scales = scales, total = is.null(tot), ylab = lcp, + stack_priority = if (is.null(tot)) c("variable", "region") else "variable") + + guides(fill = guide_legend(reverse = TRUE)) + } # Add black lines in area plots from variable tot if provided. if (!is.null(tot)) { @@ -161,24 +163,30 @@ showAreaAndBarPlots <- function( mapping = aes(.data$period, .data$value), size = 1.3 ) - dRegiTot <- dnohist %>% - filter( - .data$region != .env$mainReg, - .data$variable == .env$tot) %>% - droplevels() - dRegiTot$scenario <- dRegiTot$identifier - p4 <- p4 + - geom_line( - data = dRegiTot, - mapping = aes(.data$period, .data$value), - size = 1.3 - ) + if (length(unique(data$region)) > 1) { + dRegiTot <- dnohist %>% + filter( + .data$region != .env$mainReg, + .data$variable == .env$tot) %>% + droplevels() + dRegiTot$scenario <- dRegiTot$identifier + p4 <- p4 + + geom_line( + data = dRegiTot, + mapping = aes(.data$period, .data$value), + size = 1.3 + ) + } } # Show plots. - grid.arrange(p1, p2, p3, layout_matrix = rbind(c(1, 3), c(2, 3)), left = label) - cat("\n\n") - print(p4) + if (length(unique(data$region)) > 1) { + grid.arrange(p1, p2, p3, layout_matrix = rbind(c(1, 3), c(2, 3)), left = label) + cat("\n\n") + print(p4) + } else { + grid.arrange(p1, p2, layout_matrix = rbind(c(1, 2)), left = label) + } cat("\n\n") return(invisible(NULL)) From d631e5ad9bf0ae639f402458f901946805cd9292 Mon Sep 17 00:00:00 2001 From: Renato-Rodrigues Date: Fri, 6 Oct 2023 19:01:47 +0200 Subject: [PATCH 13/41] updating version --- .buildlibrary | 2 +- .github/workflows/check.yaml | 92 ++++++++---------------------------- .pre-commit-config.yaml | 2 +- CITATION.cff | 4 +- DESCRIPTION | 4 +- NAMESPACE | 1 - README.md | 6 +-- 7 files changed, 30 insertions(+), 81 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 3d2128f..d9c1ff3 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28448287' +ValidationKey: '28550744' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index fcd7136..7d564a1 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -1,5 +1,3 @@ -# Run CI for R using https://eddelbuettel.github.io/r-ci/ - name: check on: @@ -8,11 +6,6 @@ on: pull_request: branches: [main, master] -env: - USE_BSPM: "true" - _R_CHECK_FORCE_SUGGESTS_: "false" - NO_BINARY_INSTALL_R_PACKAGES: 'c("madrat", "magclass", "citation", "gms", "goxygen", "GDPuc", "roxygen2")' - jobs: check: runs-on: ubuntu-latest @@ -20,80 +13,37 @@ jobs: steps: - uses: actions/checkout@v3 - - name: Bootstrap - run: | - sudo chown runner -R . - sudo locale-gen en_US.UTF-8 - sudo add-apt-repository -y ppa:ubuntugis/ppa - curl -OLs https://eddelbuettel.github.io/r-ci/run.sh - chmod 0755 run.sh - ./run.sh bootstrap - rm -f bspm_*.tar.gz - - - name: Enable r-universe repo, modify bspm integration - run: | - # install packages from https://pik-piam.r-universe.dev and CRAN - echo ' - options(repos = c(universe = "https://pik-piam.r-universe.dev", - CRAN = "https://cloud.r-project.org")) - ' >> .Rprofile - cat .Rprofile - # modify bspm integration to never install binary builds of PIK CRAN packages - sudo sed -i '/bspm::enable()/d' /etc/R/Rprofile.site - # need double % because of printf, %s is replaced with "$NO_BINARY_INSTALL_R_PACKAGES" (see "env:" above) - printf ' - local({ - expr <- quote({ - if (!is.null(repos)) { - noBinaryInstallRPackages <- %s - pkgs <- c(bspm::install_sys(pkgs[!pkgs %%in%% noBinaryInstallRPackages]), - pkgs[pkgs %%in%% noBinaryInstallRPackages]) - } - type <- "source" - }) - trace(utils::install.packages, expr, print = FALSE) - }) - ' "$NO_BINARY_INSTALL_R_PACKAGES" | sudo tee --append /etc/R/Rprofile.site >/dev/null - cat /etc/R/Rprofile.site - - - name: Set up Pandoc - uses: r-lib/actions/setup-pandoc@v2 + - uses: r-lib/actions/setup-pandoc@v2 - - name: Set up Python 3.9 - uses: actions/setup-python@v4 + - uses: r-lib/actions/setup-r@v2 with: - python-version: 3.9 + use-public-rspm: true + extra-repositories: "https://rse.pik-potsdam.de/r/packages" - - name: Cache R libraries - if: ${{ !env.ACT }} # skip when running locally via nektos/act - uses: pat-s/always-upload-cache@v3 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - path: /usr/local/lib/R/ - key: 3-${{ runner.os }}-usr-local-lib-R-${{ hashFiles('DESCRIPTION') }} - restore-keys: | - 3-${{ runner.os }}-usr-local-lib-R- - - - name: Restore R library permissions - run: | - sudo chmod 2777 /usr/local/lib/R /usr/local/lib/R/site-library - - - name: Install dependencies - run: | - ./run.sh install_aptget libhdf5-dev libharfbuzz-dev libfribidi-dev - ./run.sh install_all - ./run.sh install_r_binary covr rstudioapi - ./run.sh install_r lucode2 + extra-packages: | + any::lucode2 + any::covr + any::madrat + any::magclass + any::citation + any::gms + any::goxygen + any::GDPuc + # piam packages also available on CRAN (madrat, magclass, citation, + # gms, goxygen, GDPuc) will usually have an outdated binary version + # available; by using extra-packages we get the newest version + + - uses: actions/setup-python@v4 + with: + python-version: 3.9 - name: Install python dependencies if applicable run: | [ -f requirements.txt ] && python -m pip install --upgrade pip wheel || true [ -f requirements.txt ] && pip install -r requirements.txt || true - - name: Remove bspm integration # to get rid of error when running install.packages - run: | - sudo sed -i '/ trace(utils::install.packages, expr, print = FALSE)/d' /etc/R/Rprofile.site - cat /etc/R/Rprofile.site - - name: Verify validation key shell: Rscript {0} run: lucode2:::validkey(stopIfInvalid = TRUE) diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 9c3b069..5d2e4ca 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.3.2.9013 + rev: v0.3.2.9019 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index 8422535..350334e 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: 'mip: Comparison of multi-model runs' -version: 0.145.3 -date-released: '2023-08-10' +version: 0.145.4 +date-released: '2023-10-06' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index d82f92f..cdf4fc7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.3 -Date: 2023-08-10 +Version: 0.145.4 +Date: 2023-10-06 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 039b0aa..bb59d9c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -71,7 +71,6 @@ importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_line) -importFrom(ggplot2,geom_errorbar) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_text) importFrom(ggplot2,geom_vline) diff --git a/README.md b/README.md index 5f637af..10617a2 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.3** +R package **mip**, version **0.145.4** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.3, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.4, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.3}, + note = {R package version 0.145.4}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From 9f044e36b68052c86ba9425b7405c1b97df42457 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 12 Oct 2023 17:59:21 +0200 Subject: [PATCH 14/41] add convergence plot --- R/mipConvergence.R | 347 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 347 insertions(+) create mode 100644 R/mipConvergence.R diff --git a/R/mipConvergence.R b/R/mipConvergence.R new file mode 100644 index 0000000..f375e39 --- /dev/null +++ b/R/mipConvergence.R @@ -0,0 +1,347 @@ +#' @title Create REMIND convergence overview +#' +#' @param gdx GDX file +#' @author Renato Rodrigues, Falk Benke +#' +#' @examples +#' +#' \dontrun{ +#' mipConvergence(gdx="fulldata.gdx") +#' } +#' +#' @importFrom gdx readGDX +#' @importFrom dplyr bind_rows summarise group_by mutate filter +#' @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 aes_ +#' @importFrom plotly ggplotly config hide_legend subplot layout +#' @importFrom reshape2 dcast +#' @importFrom stats lag +#' @importFrom RColorBrewer brewer.pal +#' +#' @export +mipConvergence <- function(gdx) { + + if (!file.exists(gdx)) { + stop("gdx file not found!") + } + + modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] + + if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) { + stop("Run failed - Check code, pre-triangular infes ...") + } + + 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) + + # data preparation ---- + + p80_repy_wide <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + as.quitte() %>% + select(c("solveinfo80", "region", "iteration", "value")) %>% + dcast(region + iteration ~ solveinfo80, value.var = "value") + + 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", TRUE, + ifelse(modelstat == "7" & is.na(.data$diff.objval), FALSE, + ifelse(modelstat == "7" & abs(.data$diff.objval) < 1e-4, TRUE, FALSE) + ) + ) + ) %>% + ungroup() + + p80_repy_wide <- p80_repy_wide %>% + group_by(.data$iteration) %>% + mutate(objvalConverge = all(.data$objvalCondition)) + + 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" + + data <- p80_repy_wide %>% + group_by(.data$iteration, .data$convergence) %>% + mutate(details = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% + ungroup() + + data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) + + # Convergence plot ----- + + convergencePlot <- + suppressWarnings(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 = select(data, c("iteration", "convergence", "details")) %>% distinct(), + aes_(fill = ~convergence), + size = 2, + alpha = aestethics$alpha + ) + + scale_fill_manual(values = plotstyle(as.character(unique(data$convergence)), unknown = missingColorsdf)) + + scale_color_manual(values = plotstyle(as.character(unique(data$region)), unknown = missingColorsdf)) + + scale_y_discrete(breaks = c("infeasible", "feasible", "optimal"), drop = FALSE) + + theme_minimal() + + labs(x = NULL, y = NULL) + + + # Trade goods surplus detail ---- + + surplus <- readGDX(gdx, name = "p80_surplus", restore_zeros = FALSE)[, c(2100, 2150), ] %>% + as.quitte() %>% + select(c("period", "value", "all_enty", "iteration")) + 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 <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% + as.quitte() %>% + select(c("maxTol" = 7, "all_enty" = 8)) + + 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$withinLimits <- ifelse(surplus$value > surplus$maxTol, "no", + ifelse(surplus$value < -surplus$maxTol, "no", "yes")) + + maxTol <- surplus %>% + group_by(.data$type, .data$period, .data$iteration) %>% + mutate(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% + ungroup() %>% + filter(.data$all_enty %in% c("peoil", "good", "perm")) %>% + select(-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$withinLimits)), unknown = missingColorsdf) + surplusColor <- plotstyle(vars, unknown = missingColorsdf) + names(surplusColor) <- names(vars) + + surplus$tooltip <- paste0( + ifelse(surplus$withinLimits == "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$withinLimits == "no", + " outside tolerance limits.", + " within tolerance limits.")) + + surplusConvergence <- ggplot() + + suppressWarnings(geom_line(data = surplus, + aes_(x = ~iteration, y = ~value, color = ~all_enty, + group = ~all_enty, text = ~tooltip), + alpha = aestethics$alpha, + size = aestethics$line$size)) + + suppressWarnings(geom_rect(data = maxTol, + aes_(xmin = ~rectXmin, xmax = ~rectXmax, + ymin = ~ -maxTol, ymax = ~maxTol, + fill = ~withinLimits, 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)) + + surplusConvergencePlotly <- ggplotly(surplusConvergence, tooltip = c("text")) %>% + hide_legend() %>% + config(displayModeBar = FALSE, displaylogo = FALSE) + + + # Trade surplus summary ---- + + surplusCondition <- surplus %>% + group_by(.data$iteration) %>% + summarise(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) + + surplusCondition$tooltip <- paste0("Iteration: ", surplusCondition$iteration, "
Converged") + + for (iter in surplusCondition$iteration) { + if (all(surplusCondition[which(surplusCondition$iteration == iter), ]$withinLimits == "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), ] + withinLimits <- ifelse(currSurplus$value > currSurplus$maxTol, + "no", ifelse(currSurplus$value < -currSurplus$maxTol, "no", "yes")) + if (withinLimits == "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, "
Not converged", + "
Period | Trade | Surplus", tooltip + ) + surplusCondition[which(surplusCondition$iteration == iter), ]$tooltip <- tooltip + } + } + + surplusSummary <- suppressWarnings(ggplot(surplusCondition, + aes_(x = ~iteration, y = "Trade\nSurplus", + fill = ~withinLimits, 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 derivation ---- + + data <- p80_repy_wide %>% + select("iteration", "objvalConverge") %>% + distinct() %>% + mutate( + !!sym("objVarCondition") := ifelse(isTRUE(.data$objvalConverge), "yes", "no"), + tooltip := paste0("Iteration: ", .data$iteration, "
Converged") + ) + + for (iter in unique(data$iteration)) { + + current <- filter(p80_repy_wide, .data$iteration == iter) + + if (!all(current$objvalCondition)) { + tooltip <- NULL + current <- filter(current, .data$objvalCondition == FALSE) + + for (reg in current$region) { + diff <- current[current$region == reg, ]$diff.objval + tooltip <- paste0(tooltip, "
", reg, " | ", round(diff, 5)) + } + tooltip <- paste0( + "Iteration: ", iter, "
Not converged", + "
Region | Deviation", tooltip, "
The deviation limit is +- 0.0001" + ) + data[which(data$iteration == iter), ]$tooltip <- tooltip + } + } + objVarSummary <- suppressWarnings(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 ---- + priceAntecipationFadeoutIteration <- as.vector(readGDX(gdx, name = "s80_fadeoutPriceAnticipStartingPeriod")) + lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] + data <- data.frame(iteration = 1:lastIteration) + + data <- data %>% mutate( + fadeoutPriceAnticip = ifelse( + .data$iteration < priceAntecipationFadeoutIteration, 1, + 0.7**(.data$iteration - 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("Not converged
Price Anticipation fade out is not low enough
", + round(.data$fadeoutPriceAnticip, 5), " > 0.0001") + ) + ) + + + priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + + geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, size = aestethics$line$size) + + suppressWarnings(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 ---- + + out <- list() + + out$plot <- subplot( + ggplotly(convergencePlot, tooltip = c("text")), + ggplotly(surplusSummary, tooltip = c("text")), + ggplotly(objVarSummary, tooltip = c("text")), + ggplotly(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(displayModeBar = FALSE, displaylogo = FALSE) %>% + layout(margin = list(l = -100, r = 10)) + + + out$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.
" # nolint + out$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) + ) + + out$tradeDetailPlot <- surplusConvergencePlotly + + return(out) +} From 4d27d41a762f28eba0b8a08f8db0c3840016dab9 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 16 Oct 2023 12:11:58 +0200 Subject: [PATCH 15/41] minor refactoring --- R/mipConvergence.R | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index f375e39..7982d29 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -100,7 +100,7 @@ mipConvergence <- function(gdx) { linetype = "dashed", aes_(group = ~region, color = ~region), alpha = aestethics$alpha, - size = aestethics$line$size + linewidth = aestethics$line$size ) + geom_point( data = select(data, c("iteration", "convergence", "details")) %>% distinct(), @@ -115,14 +115,19 @@ mipConvergence <- function(gdx) { labs(x = NULL, y = NULL) + convergencePlotPlotly <- ggplotly(convergencePlot, tooltip = c("text")) + # Trade goods surplus detail ---- surplus <- readGDX(gdx, name = "p80_surplus", restore_zeros = FALSE)[, c(2100, 2150), ] %>% as.quitte() %>% - select(c("period", "value", "all_enty", "iteration")) - 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")) + select(c("period", "value", "all_enty", "iteration")) %>% + mutate(value := ifelse(is.na(value), 0, value), + type := case_when( + all_enty == "good" ~ "Goods trade surplus", + all_enty == "perm" ~ "Permits", + TRUE ~ "Primary energy trade surplus" + )) maxTol <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% as.quitte() %>% @@ -196,7 +201,6 @@ mipConvergence <- function(gdx) { hide_legend() %>% config(displayModeBar = FALSE, displaylogo = FALSE) - # Trade surplus summary ---- surplusCondition <- surplus %>% @@ -240,6 +244,8 @@ mipConvergence <- function(gdx) { scale_y_discrete(breaks = c("Trade\nSurplus"), drop = FALSE) + labs(x = NULL, y = NULL) + surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) + # Objective derivation ---- data <- p80_repy_wide %>% @@ -269,6 +275,7 @@ mipConvergence <- function(gdx) { data[which(data$iteration == iter), ]$tooltip <- tooltip } } + objVarSummary <- suppressWarnings(ggplot(data, aes_( x = ~iteration, y = "Objective\nDeviation", fill = ~objVarCondition, text = ~tooltip @@ -280,7 +287,10 @@ mipConvergence <- function(gdx) { scale_y_discrete(breaks = c("Objective\nDeviation"), drop = FALSE) + labs(x = NULL, y = NULL) + objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text")) + # Price anticipation ---- + priceAntecipationFadeoutIteration <- as.vector(readGDX(gdx, name = "s80_fadeoutPriceAnticipStartingPeriod")) lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] data <- data.frame(iteration = 1:lastIteration) @@ -300,7 +310,6 @@ mipConvergence <- function(gdx) { ) ) - priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, size = aestethics$line$size) + suppressWarnings(geom_point(size = 2, @@ -313,15 +322,17 @@ mipConvergence <- function(gdx) { labs(x = NULL, y = NULL) + coord_cartesian(ylim = c(-0.2, 1)) + priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) + # Summary plot ---- out <- list() out$plot <- subplot( - ggplotly(convergencePlot, tooltip = c("text")), - ggplotly(surplusSummary, tooltip = c("text")), - ggplotly(objVarSummary, tooltip = c("text")), - ggplotly(priceAnticipation, tooltip = c("text")), + convergencePlotPlotly, + surplusSummaryPlotly, + objVarSummaryPlotly, + priceAnticipationPlotly, nrows = 4, shareX = TRUE, titleX = FALSE, heights = c(0.4, 0.2, 0.2, 0.2), margin = c(.1, .1, .1, .0001) @@ -330,17 +341,6 @@ mipConvergence <- function(gdx) { config(displayModeBar = FALSE, displaylogo = FALSE) %>% layout(margin = list(l = -100, r = 10)) - - out$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.
" # nolint - out$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) - ) - out$tradeDetailPlot <- surplusConvergencePlotly return(out) From 3ca94606778caa1145fca2d3fd65284e6c58745a Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 17 Oct 2023 14:58:19 +0200 Subject: [PATCH 16/41] increment version --- .buildlibrary | 2 +- .pre-commit-config.yaml | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 5 +++-- NAMESPACE | 7 +++++++ README.md | 6 +++--- man/mipConvergence.Rd | 24 ++++++++++++++++++++++++ 7 files changed, 41 insertions(+), 9 deletions(-) create mode 100644 man/mipConvergence.Rd diff --git a/.buildlibrary b/.buildlibrary index d9c1ff3..e6e0b8a 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28550744' +ValidationKey: '28586385' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 5d2e4ca..7a47c41 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.3.2.9019 + rev: v0.3.2.9021 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index 350334e..725325e 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: 'mip: Comparison of multi-model runs' -version: 0.145.4 -date-released: '2023-10-06' +version: 0.145.5 +date-released: '2023-10-17' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index cdf4fc7..7908305 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.4 -Date: 2023-10-06 +Version: 0.145.5 +Date: 2023-10-17 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), @@ -27,6 +27,7 @@ Imports: RColorBrewer, data.table, dplyr, + gdx, ggplot2, gridExtra, htmltools, diff --git a/NAMESPACE b/NAMESPACE index bb59d9c..0f7a0b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(identifierModelScen) export(longestCommonPrefix) export(mipArea) export(mipBarYearData) +export(mipConvergence) export(mipIterations) export(mipLineHistorical) export(plotstyle) @@ -52,6 +53,7 @@ importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(dplyr,sym) importFrom(dplyr,ungroup) +importFrom(gdx,readGDX) importFrom(ggplot2,"%+replace%") importFrom(ggplot2,aes) importFrom(ggplot2,aes_) @@ -72,6 +74,7 @@ importFrom(ggplot2,geom_col) 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) @@ -92,6 +95,7 @@ importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_discrete) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,scale_y_log10) importFrom(ggplot2,stat_summary) importFrom(ggplot2,theme) @@ -127,7 +131,9 @@ importFrom(magclass,nregions) importFrom(magclass,nyears) importFrom(plotly,add_annotations) importFrom(plotly,as.widget) +importFrom(plotly,config) importFrom(plotly,ggplotly) +importFrom(plotly,hide_legend) importFrom(plotly,layout) importFrom(plotly,plotly) importFrom(plotly,plotlyOutput) @@ -187,6 +193,7 @@ importFrom(shiny,verbatimTextOutput) importFrom(shiny,wellPanel) importFrom(stats,as.formula) importFrom(stats,complete.cases) +importFrom(stats,lag) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,reshape) diff --git a/README.md b/README.md index 10617a2..bc11730 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.4** +R package **mip**, version **0.145.5** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.4, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.145.5, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.4}, + note = {R package version 0.145.5}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } diff --git a/man/mipConvergence.Rd b/man/mipConvergence.Rd new file mode 100644 index 0000000..3eb8916 --- /dev/null +++ b/man/mipConvergence.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mipConvergence.R +\name{mipConvergence} +\alias{mipConvergence} +\title{Create REMIND convergence overview} +\usage{ +mipConvergence(gdx) +} +\arguments{ +\item{gdx}{GDX file} +} +\description{ +Create REMIND convergence overview +} +\examples{ + + \dontrun{ + mipConvergence(gdx="fulldata.gdx") + } + +} +\author{ +Renato Rodrigues, Falk Benke +} From b1cf87d5607a7bf6ba7bdb2139bb2b457a8f52c8 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 17 Oct 2023 15:31:27 +0200 Subject: [PATCH 17/41] convert errors to warnings --- R/mipConvergence.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 7982d29..41b6ec3 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -24,13 +24,15 @@ mipConvergence <- function(gdx) { if (!file.exists(gdx)) { - stop("gdx file not found!") + warning("gdx file not found!") + return(list()) } modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) { - stop("Run failed - Check code, pre-triangular infes ...") + warning("Run failed - Check code, pre-triangular infes ...") + return(list()) } aestethics <- list( From 44c28b78caa1e989eadf9553dcf65953cf2a2681 Mon Sep 17 00:00:00 2001 From: orichters Date: Mon, 23 Oct 2023 15:44:11 +0200 Subject: [PATCH 18/41] don't remove dot in scenario names in mipLineHistorical --- .buildlibrary | 3 ++- .github/workflows/check.yaml | 4 +++- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- R/mipLineHistorical.R | 6 +++--- README.md | 6 +++--- 6 files changed, 15 insertions(+), 12 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index e6e0b8a..55016cb 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28586385' +ValidationKey: '28614768' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' @@ -8,5 +8,6 @@ AcceptedNotes: - unable to verify current time - File .mip/R/onLoad\.R.:\W+\.onLoad calls:\W+packageStartupMessage - no visible binding for global variable ‘.’ +- checking installed package size AutocreateReadme: yes allowLinterWarnings: yes diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 7d564a1..b75d0ed 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -56,6 +56,8 @@ jobs: - name: Test coverage shell: Rscript {0} - run: covr::codecov(quiet = FALSE) + run: | + nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps")) + if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE) env: NOT_CRAN: "true" diff --git a/CITATION.cff b/CITATION.cff index 725325e..183724d 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: 'mip: Comparison of multi-model runs' -version: 0.145.5 -date-released: '2023-10-17' +version: 0.145.6 +date-released: '2023-10-23' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 7908305..6d134f7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.5 -Date: 2023-10-17 +Version: 0.145.6 +Date: 2023-10-23 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/R/mipLineHistorical.R b/R/mipLineHistorical.R index 503fbce..3369bf0 100644 --- a/R/mipLineHistorical.R +++ b/R/mipLineHistorical.R @@ -255,11 +255,11 @@ mipLineHistorical <- function(x,x_hist=NULL,color.dim="identifier",linetype.dim= #color: show only model_output #fill: add colors for historical and keep shape symbol #alpha: add colors for projection depending on leg.proj - p <- p + scale_color_manual(color.dim.name,values = color_set, breaks=model_output,labels=sub("\\."," ",model_output),guide=guide_legend(order=1,title.position = "top", ncol=legend.ncol)) + p <- p + scale_color_manual(color.dim.name,values = color_set, breaks=model_output,labels=model_output,guide=guide_legend(order=1,title.position = "top", ncol=legend.ncol)) p <- p + scale_fill_manual("Historical data",values = color_set[historical],breaks=historical, guide=guide_legend(override.aes = list(colour=color_set[historical],shape="+",linetype=0,size=5),order=2,title.position = "top", ncol=legend.ncol)) - if(leg.proj) p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour=color_set[projection],shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) - else p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=sub("\\."," ",projection),guide=guide_legend(override.aes = list(colour="#A1A194",shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) + if(leg.proj) p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=projection,guide=guide_legend(override.aes = list(colour=color_set[projection],shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) + else p <- p + scale_alpha_manual("Other projections",values = seq(0.1,1,length.out = length(projection)),breaks=projection,labels=projection,guide=guide_legend(override.aes = list(colour="#A1A194",shape=NULL,linetype=1,linewidth=1,alpha=0.5),order=3,title.position = "top", ncol=legend.ncol)) p <- p + guides(linetype=guide_legend(order=4,title.position="top",ncol=legend.ncol)) return(p) diff --git a/README.md b/README.md index bc11730..95d97cb 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.5** +R package **mip**, version **0.145.6** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.145.5, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi: 10.5281/zenodo.1158586 (URL: https://doi.org/10.5281/zenodo.1158586), R package version 0.145.6, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.5}, + note = {R package version 0.145.6}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From 6bad6c2d17d6def4401363e57ce5a76e444be940 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 26 Oct 2023 14:20:48 +0200 Subject: [PATCH 19/41] remove no longer needed code --- R/mipConvergence.R | 18 +++++------------- 1 file changed, 5 insertions(+), 13 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 41b6ec3..c754204 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -42,18 +42,8 @@ mipConvergence <- function(gdx) { ) 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" + "yes" = "#00BFC4", "no" = "#F8766D" ) missingColorsdf <- data.frame(row.names = names(missingColors), color = missingColors) @@ -297,12 +287,14 @@ mipConvergence <- function(gdx) { lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] data <- data.frame(iteration = 1:lastIteration) + cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) data <- data %>% mutate( fadeoutPriceAnticip = ifelse( .data$iteration < priceAntecipationFadeoutIteration, 1, 0.7**(.data$iteration - priceAntecipationFadeoutIteration + 1) ), - converged = ifelse(.data$fadeoutPriceAnticip > 1e-4, "no", "yes"), + + converged = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), tooltip = ifelse( .data$converged == "yes", paste0("Converged
Price Anticipation fade out is low enough
", @@ -332,8 +324,8 @@ mipConvergence <- function(gdx) { out$plot <- subplot( convergencePlotPlotly, - surplusSummaryPlotly, objVarSummaryPlotly, + surplusSummaryPlotly, priceAnticipationPlotly, nrows = 4, shareX = TRUE, titleX = FALSE, heights = c(0.4, 0.2, 0.2, 0.2), From 6580cc82dd2cd7734f4ab856f57f7ddd33d7218d Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 26 Oct 2023 16:58:25 +0200 Subject: [PATCH 20/41] refactor obective deviation plot --- R/mipConvergence.R | 134 +++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 66 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index c754204..55babd6 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -10,15 +10,10 @@ #' } #' #' @importFrom gdx readGDX -#' @importFrom dplyr bind_rows summarise group_by mutate filter +#' @importFrom dplyr summarise group_by mutate filter #' @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 aes_ #' @importFrom plotly ggplotly config hide_legend subplot layout #' @importFrom reshape2 dcast -#' @importFrom stats lag -#' @importFrom RColorBrewer brewer.pal #' #' @export mipConvergence <- function(gdx) { @@ -29,6 +24,7 @@ mipConvergence <- function(gdx) { } modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] + lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) { warning("Run failed - Check code, pre-triangular infes ...") @@ -47,44 +43,92 @@ mipConvergence <- function(gdx) { ) missingColorsdf <- data.frame(row.names = names(missingColors), color = missingColors) + booleanColor <- plotstyle(c("yes", "no"), unknown = missingColorsdf) + + # Optimality / Objective Deviation ---- - # data preparation ---- + p80_convNashObjVal_iter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% + as.quitte() %>% + select(c("region", "iteration", "objvalDifference" = "value")) %>% + mutate(iteration := as.numeric(iteration)) %>% + filter(iteration <= lastIteration) - p80_repy_wide <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + p80_repy_iteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% as.quitte() %>% select(c("solveinfo80", "region", "iteration", "value")) %>% + mutate(iteration := as.numeric(iteration)) %>% dcast(region + iteration ~ solveinfo80, value.var = "value") - p80_repy_wide <- p80_repy_wide %>% + p80_repy_iteration <- p80_repy_iteration %>% + left_join(p80_convNashObjVal_iter, by = c("region", "iteration")) %>% group_by(.data$region) %>% mutate( - diff.objval = .data$objval - lag(.data$objval, order_by = .data$iteration), objvalCondition = ifelse(modelstat == "2", TRUE, - ifelse(modelstat == "7" & is.na(.data$diff.objval), FALSE, - ifelse(modelstat == "7" & abs(.data$diff.objval) < 1e-4, TRUE, FALSE) + ifelse(modelstat == "7" & is.na(.data$objvalDifference), FALSE, + ifelse(modelstat == "7" & .data$objvalDifference < -1e-4, FALSE, TRUE) ) ) ) %>% + ungroup() %>% + group_by(.data$iteration) %>% + mutate(objvalConverge = all(.data$objvalCondition)) %>% ungroup() - p80_repy_wide <- p80_repy_wide %>% - group_by(.data$iteration) %>% - mutate(objvalConverge = all(.data$objvalCondition)) + data <- p80_repy_iteration %>% + select("iteration", "objvalConverge") %>% + distinct() %>% + mutate( + !!sym("objVarCondition") := ifelse(.data$objvalConverge, "yes", "no"), + tooltip := paste0("Iteration: ", .data$iteration, "
Converged") + ) + + for (iter in unique(data$iteration)) { + current <- filter(p80_repy_iteration, .data$iteration == iter) + + if (!all(current$objvalCondition)) { + tooltip <- NULL + current <- filter(current, .data$objvalCondition == FALSE) + + for (reg in current$region) { + diff <- current[current$region == reg, ]$objvalDifference + tooltip <- paste0(tooltip, "
", reg, " | ", round(diff, 5)) + } + tooltip <- paste0( + "Iteration: ", iter, "
Not converged", + "
Region | Deviation", tooltip, "
The deviation limit is +- 0.0001" + ) + data[which(data$iteration == iter), ]$tooltip <- tooltip + } + } + + objVarSummary <- suppressWarnings(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) + + objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text")) + - 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" + # Feasibility ----- - data <- p80_repy_wide %>% + p80_repy_iteration$convergence <- "infeasible" + p80_repy_iteration[(p80_repy_iteration$modelstat == 1 & p80_repy_iteration$solvestat == 1), "convergence"] <- "optimal" + p80_repy_iteration[(p80_repy_iteration$modelstat == 2 & p80_repy_iteration$solvestat == 1), "convergence"] <- "optimal" + p80_repy_iteration[(p80_repy_iteration$modelstat == 7 & p80_repy_iteration$solvestat == 4), "convergence"] <- "feasible" + + data <- p80_repy_iteration %>% group_by(.data$iteration, .data$convergence) %>% mutate(details = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% ungroup() data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) - # Convergence plot ----- - convergencePlot <- suppressWarnings(ggplot(mapping = aes_(~iteration, ~convergence, text = ~details))) + geom_line( @@ -147,7 +191,7 @@ mipConvergence <- function(gdx) { "pebiolc" = "Biomass") surplus$name <- vars[surplus$all_enty] - booleanColor <- plotstyle(as.character(unique(maxTol$withinLimits)), unknown = missingColorsdf) + surplusColor <- plotstyle(vars, unknown = missingColorsdf) names(surplusColor) <- names(vars) @@ -238,53 +282,11 @@ mipConvergence <- function(gdx) { surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) - # Objective derivation ---- - - data <- p80_repy_wide %>% - select("iteration", "objvalConverge") %>% - distinct() %>% - mutate( - !!sym("objVarCondition") := ifelse(isTRUE(.data$objvalConverge), "yes", "no"), - tooltip := paste0("Iteration: ", .data$iteration, "
Converged") - ) - - for (iter in unique(data$iteration)) { - - current <- filter(p80_repy_wide, .data$iteration == iter) - - if (!all(current$objvalCondition)) { - tooltip <- NULL - current <- filter(current, .data$objvalCondition == FALSE) - - for (reg in current$region) { - diff <- current[current$region == reg, ]$diff.objval - tooltip <- paste0(tooltip, "
", reg, " | ", round(diff, 5)) - } - tooltip <- paste0( - "Iteration: ", iter, "
Not converged", - "
Region | Deviation", tooltip, "
The deviation limit is +- 0.0001" - ) - data[which(data$iteration == iter), ]$tooltip <- tooltip - } - } - - objVarSummary <- suppressWarnings(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) - - objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text")) # Price anticipation ---- priceAntecipationFadeoutIteration <- as.vector(readGDX(gdx, name = "s80_fadeoutPriceAnticipStartingPeriod")) - lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] + data <- data.frame(iteration = 1:lastIteration) cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) From 56b240997447ebae7a3cd0be3ce0c52460302d3f Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 26 Oct 2023 17:24:21 +0200 Subject: [PATCH 21/41] minor refactoring --- R/mipConvergence.R | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 55babd6..39ff60d 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -117,10 +117,19 @@ mipConvergence <- function(gdx) { # Feasibility ----- - p80_repy_iteration$convergence <- "infeasible" - p80_repy_iteration[(p80_repy_iteration$modelstat == 1 & p80_repy_iteration$solvestat == 1), "convergence"] <- "optimal" - p80_repy_iteration[(p80_repy_iteration$modelstat == 2 & p80_repy_iteration$solvestat == 1), "convergence"] <- "optimal" - p80_repy_iteration[(p80_repy_iteration$modelstat == 7 & p80_repy_iteration$solvestat == 4), "convergence"] <- "feasible" + p80_repy_iteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + as.quitte() %>% + select(c("solveinfo80", "region", "iteration", "value")) %>% + dcast(region + iteration ~ solveinfo80, value.var = "value") %>% + mutate( + iteration := as.numeric(iteration), + convergence := case_when( + modelstat == 1 & solvestat == 1 ~ "optimal", + modelstat == 2 & solvestat == 1 ~ "optimal", + modelstat == 7 & solvestat == 4 ~ "feasible", + .default = "infeasible" + ) + ) data <- p80_repy_iteration %>% group_by(.data$iteration, .data$convergence) %>% @@ -150,7 +159,6 @@ mipConvergence <- function(gdx) { theme_minimal() + labs(x = NULL, y = NULL) - convergencePlotPlotly <- ggplotly(convergencePlot, tooltip = c("text")) # Trade goods surplus detail ---- From 7b44f87a3c44962241d562522331055fba7525b9 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 27 Oct 2023 16:47:41 +0200 Subject: [PATCH 22/41] refactor trade plots --- R/mipConvergence.R | 152 ++++++++++++++++++++++++--------------------- 1 file changed, 82 insertions(+), 70 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 39ff60d..778f2fc 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -37,13 +37,7 @@ mipConvergence <- function(gdx) { "point" = list("size" = 2 / 3.78) ) - missingColors <- c( - "optimal" = "#00BFC4", "feasible" = "#ffcc66", "infeasible" = "#F8766D", - "yes" = "#00BFC4", "no" = "#F8766D" - ) - - missingColorsdf <- data.frame(row.names = names(missingColors), color = missingColors) - booleanColor <- plotstyle(c("yes", "no"), unknown = missingColorsdf) + booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D") # Optimality / Objective Deviation ---- @@ -153,8 +147,8 @@ mipConvergence <- function(gdx) { size = 2, alpha = aestethics$alpha ) + - scale_fill_manual(values = plotstyle(as.character(unique(data$convergence)), unknown = missingColorsdf)) + - scale_color_manual(values = plotstyle(as.character(unique(data$region)), unknown = missingColorsdf)) + + scale_fill_manual(values = c("optimal" = "#00BFC4", "feasible" = "#ffcc66", "infeasible" = "#F8766D")) + + scale_color_manual(values = plotstyle(as.character(unique(data$region)))) + scale_y_discrete(breaks = c("infeasible", "feasible", "optimal"), drop = FALSE) + theme_minimal() + labs(x = NULL, y = NULL) @@ -163,76 +157,95 @@ mipConvergence <- function(gdx) { # Trade goods surplus detail ---- + # TODO: why is p80_surplusMax_iter only returning positive values? surplus <- readGDX(gdx, name = "p80_surplus", restore_zeros = FALSE)[, c(2100, 2150), ] %>% as.quitte() %>% select(c("period", "value", "all_enty", "iteration")) %>% - mutate(value := ifelse(is.na(value), 0, value), - type := case_when( - all_enty == "good" ~ "Goods trade surplus", - all_enty == "perm" ~ "Permits", - TRUE ~ "Primary energy trade surplus" - )) - - maxTol <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% + mutate( + value := ifelse(is.na(value), 0, value), + type := case_when( + all_enty == "good" ~ "Goods trade surplus", + all_enty == "perm" ~ "Permits", + TRUE ~ "Primary energy trade surplus" + ) + ) + + p80_surplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% as.quitte() %>% select(c("maxTol" = 7, "all_enty" = 8)) - 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$withinLimits <- ifelse(surplus$value > surplus$maxTol, "no", - ifelse(surplus$value < -surplus$maxTol, "no", "yes")) + surplus <- left_join(surplus, p80_surplusMaxTolerance, by = "all_enty") %>% + mutate( + maxTol := ifelse(period == 2150, maxTol * 10, maxTol), + withinLimits := ifelse(abs(value) > maxTol, "no", "yes") + ) - maxTol <- surplus %>% - group_by(.data$type, .data$period, .data$iteration) %>% - mutate(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% - ungroup() %>% - filter(.data$all_enty %in% c("peoil", "good", "perm")) %>% - select(-1) - - vars <- c("pecoal" = "Coal", - "pegas" = "Gas", - "peoil" = "Oil", - "peur" = "Uranium", - "good" = "Goods", - "pebiolc" = "Biomass") - surplus$name <- vars[surplus$all_enty] - - - surplusColor <- plotstyle(vars, unknown = missingColorsdf) - names(surplusColor) <- names(vars) - - surplus$tooltip <- paste0( - ifelse(surplus$withinLimits == "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, ").") + 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(surplus$type, " is within tolerance.") + paste0(data$all_enty, " is within tolerance.") ), - "
Iteration: ", surplus$iteration + "
Iteration: ", data$iteration ) - maxTol$tooltip <- paste0(maxTol$type, - ifelse(maxTol$withinLimits == "no", - " outside tolerance limits.", - " within tolerance limits.")) + limits <- surplus %>% + group_by(.data$type, .data$period, .data$iteration) %>% + mutate(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% + ungroup() %>% + select("type", "period", "iteration", "maxTol", "withinLimits") %>% + distinct() %>% + mutate( + rectXmin = as.numeric(iteration) - 0.5, + rectXmax = as.numeric(iteration) + 0.5, + tooltip = paste0( + type, + ifelse(withinLimits == "no", + " outside tolerance limits.", + " within tolerance limits." + ) + ) + ) + + surplusColor <- c( + peoil = "#cc7500", + pegas = "#999959", + pecoal = "#0c0c0c", + peur = "#EF7676", + pebiolc = "#005900", + good = "#00BFC4" + ) surplusConvergence <- ggplot() + - suppressWarnings(geom_line(data = surplus, - aes_(x = ~iteration, y = ~value, color = ~all_enty, - group = ~all_enty, text = ~tooltip), - alpha = aestethics$alpha, - size = aestethics$line$size)) + - suppressWarnings(geom_rect(data = maxTol, - aes_(xmin = ~rectXmin, xmax = ~rectXmax, - ymin = ~ -maxTol, 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, + size = aestethics$line$size + )) + + suppressWarnings(geom_rect( + data = limits, + aes_( + xmin = ~rectXmin, xmax = ~rectXmax, + ymin = ~ -maxTol, ymax = ~maxTol, + fill = ~withinLimits, text = ~tooltip + ), + inherit.aes = FALSE, + alpha = aestethics$alpha + )) + theme_minimal() + ggtitle("Tradable goods surplus") + facet_grid(type ~ period, scales = "free_y") + @@ -249,12 +262,11 @@ mipConvergence <- function(gdx) { surplusCondition <- surplus %>% group_by(.data$iteration) %>% - summarise(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) - - surplusCondition$tooltip <- paste0("Iteration: ", surplusCondition$iteration, "
Converged") + summarise(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% + mutate(tooltip = paste0("Iteration: ", iteration, "
Converged")) for (iter in surplusCondition$iteration) { - if (all(surplusCondition[which(surplusCondition$iteration == iter), ]$withinLimits == "no")) { + if (surplusCondition[which(surplusCondition$iteration == iter), ]$withinLimits == "no") { tooltip <- NULL for (period in unique(surplus$period)) { for (good in unique(surplus$all_enty)) { From ec423e454c89b4d691d3c5711af276404d534aad Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 27 Oct 2023 17:01:03 +0200 Subject: [PATCH 23/41] avoid snake case variable names --- R/mipConvergence.R | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 778f2fc..73f1b9b 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -41,20 +41,20 @@ mipConvergence <- function(gdx) { # Optimality / Objective Deviation ---- - p80_convNashObjVal_iter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% + p80ConvNashObjValIter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% as.quitte() %>% select(c("region", "iteration", "objvalDifference" = "value")) %>% mutate(iteration := as.numeric(iteration)) %>% filter(iteration <= lastIteration) - p80_repy_iteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% as.quitte() %>% select(c("solveinfo80", "region", "iteration", "value")) %>% mutate(iteration := as.numeric(iteration)) %>% dcast(region + iteration ~ solveinfo80, value.var = "value") - p80_repy_iteration <- p80_repy_iteration %>% - left_join(p80_convNashObjVal_iter, by = c("region", "iteration")) %>% + p80RepyIteration <- p80RepyIteration %>% + left_join(p80ConvNashObjValIter, by = c("region", "iteration")) %>% group_by(.data$region) %>% mutate( objvalCondition = ifelse(modelstat == "2", TRUE, @@ -68,7 +68,7 @@ mipConvergence <- function(gdx) { mutate(objvalConverge = all(.data$objvalCondition)) %>% ungroup() - data <- p80_repy_iteration %>% + data <- p80RepyIteration %>% select("iteration", "objvalConverge") %>% distinct() %>% mutate( @@ -77,7 +77,7 @@ mipConvergence <- function(gdx) { ) for (iter in unique(data$iteration)) { - current <- filter(p80_repy_iteration, .data$iteration == iter) + current <- filter(p80RepyIteration, .data$iteration == iter) if (!all(current$objvalCondition)) { tooltip <- NULL @@ -111,7 +111,7 @@ mipConvergence <- function(gdx) { # Feasibility ----- - p80_repy_iteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% as.quitte() %>% select(c("solveinfo80", "region", "iteration", "value")) %>% dcast(region + iteration ~ solveinfo80, value.var = "value") %>% @@ -125,7 +125,7 @@ mipConvergence <- function(gdx) { ) ) - data <- p80_repy_iteration %>% + data <- p80RepyIteration %>% group_by(.data$iteration, .data$convergence) %>% mutate(details = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% ungroup() @@ -170,11 +170,11 @@ mipConvergence <- function(gdx) { ) ) - p80_surplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% + p80SurplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% as.quitte() %>% select(c("maxTol" = 7, "all_enty" = 8)) - surplus <- left_join(surplus, p80_surplusMaxTolerance, by = "all_enty") %>% + surplus <- left_join(surplus, p80SurplusMaxTolerance, by = "all_enty") %>% mutate( maxTol := ifelse(period == 2150, maxTol * 10, maxTol), withinLimits := ifelse(abs(value) > maxTol, "no", "yes") @@ -310,6 +310,7 @@ mipConvergence <- function(gdx) { data <- data.frame(iteration = 1:lastIteration) cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) + data <- data %>% mutate( fadeoutPriceAnticip = ifelse( .data$iteration < priceAntecipationFadeoutIteration, 1, From 44944cf3f69a4ca8f5b22d16f7c2619b86c03e99 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 27 Oct 2023 17:16:30 +0200 Subject: [PATCH 24/41] refactor price anticipation by reading p80_fadeoutPriceAnticip_iter --- R/mipConvergence.R | 46 +++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 73f1b9b..7979c48 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -305,33 +305,35 @@ mipConvergence <- function(gdx) { # Price anticipation ---- - priceAntecipationFadeoutIteration <- as.vector(readGDX(gdx, name = "s80_fadeoutPriceAnticipStartingPeriod")) - - data <- data.frame(iteration = 1:lastIteration) - cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) + p80FadeoutPriceAnticipIter <- readGDX(gdx, name = "p80_fadeoutPriceAnticip_iter", restore_zeros = FALSE) %>% + as.quitte() %>% + select("iteration", "fadeoutPriceAnticip" = value ) - data <- data %>% mutate( - fadeoutPriceAnticip = ifelse( - .data$iteration < priceAntecipationFadeoutIteration, 1, - 0.7**(.data$iteration - priceAntecipationFadeoutIteration + 1) - ), - - converged = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), - tooltip = ifelse( - .data$converged == "yes", - paste0("Converged
Price Anticipation fade out is low enough
", - round(.data$fadeoutPriceAnticip, 5), " <= 0.0001"), - paste0("Not converged
Price Anticipation fade out is not low enough
", - round(.data$fadeoutPriceAnticip, 5), " > 0.0001") + data <- p80FadeoutPriceAnticipIter %>% + mutate( + iteration := as.numeric(iteration), + converged = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), + tooltip = ifelse( + .data$converged == "yes", + paste0( + "Converged
Price Anticipation fade out is low enough
", + round(.data$fadeoutPriceAnticip, 5), " <= ", cmMaxFadeoutPriceAnticip + ), + paste0( + "Not converged
Price Anticipation fade out is not low enough
", + round(.data$fadeoutPriceAnticip, 5), " > ", cmMaxFadeoutPriceAnticip + ) + ) ) - ) priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, size = aestethics$line$size) + - suppressWarnings(geom_point(size = 2, - aes_(y = 0.0001, fill = ~converged, text = ~tooltip), - alpha = aestethics$alpha)) + + suppressWarnings(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")) + @@ -341,6 +343,8 @@ mipConvergence <- function(gdx) { priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) + # Tax Convergence ---- + # Summary plot ---- out <- list() From f5a90d015cbd38096bf4bbab95cd4d7f3f9f3025 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 27 Oct 2023 17:43:24 +0200 Subject: [PATCH 25/41] fix linter warnings --- R/mipConvergence.R | 64 +++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 7979c48..7043fc7 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -44,36 +44,36 @@ mipConvergence <- function(gdx) { p80ConvNashObjValIter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% as.quitte() %>% select(c("region", "iteration", "objvalDifference" = "value")) %>% - mutate(iteration := as.numeric(iteration)) %>% - filter(iteration <= lastIteration) + mutate("iteration" := as.numeric(.data$iteration)) %>% + filter(.data$iteration <= lastIteration) p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% as.quitte() %>% select(c("solveinfo80", "region", "iteration", "value")) %>% - mutate(iteration := as.numeric(iteration)) %>% + mutate("iteration" := as.numeric(.data$iteration)) %>% dcast(region + iteration ~ solveinfo80, value.var = "value") p80RepyIteration <- p80RepyIteration %>% left_join(p80ConvNashObjValIter, by = c("region", "iteration")) %>% group_by(.data$region) %>% mutate( - objvalCondition = ifelse(modelstat == "2", TRUE, - ifelse(modelstat == "7" & is.na(.data$objvalDifference), FALSE, - ifelse(modelstat == "7" & .data$objvalDifference < -1e-4, FALSE, TRUE) + "objvalCondition" = ifelse(.data$modelstat == "2", TRUE, + ifelse(.data$modelstat == "7" & is.na(.data$objvalDifference), FALSE, + ifelse(.data$modelstat == "7" & .data$objvalDifference < -1e-4, FALSE, TRUE) ) ) ) %>% ungroup() %>% group_by(.data$iteration) %>% - mutate(objvalConverge = all(.data$objvalCondition)) %>% + mutate("objvalConverge" = all(.data$objvalCondition)) %>% ungroup() data <- p80RepyIteration %>% select("iteration", "objvalConverge") %>% distinct() %>% mutate( - !!sym("objVarCondition") := ifelse(.data$objvalConverge, "yes", "no"), - tooltip := paste0("Iteration: ", .data$iteration, "
Converged") + "objVarCondition" := ifelse(.data$objvalConverge, "yes", "no"), + "tooltip" := paste0("Iteration: ", .data$iteration, "
Converged") ) for (iter in unique(data$iteration)) { @@ -116,18 +116,18 @@ mipConvergence <- function(gdx) { select(c("solveinfo80", "region", "iteration", "value")) %>% dcast(region + iteration ~ solveinfo80, value.var = "value") %>% mutate( - iteration := as.numeric(iteration), - convergence := case_when( - modelstat == 1 & solvestat == 1 ~ "optimal", - modelstat == 2 & solvestat == 1 ~ "optimal", - modelstat == 7 & solvestat == 4 ~ "feasible", + "iteration" := as.numeric(.data$iteration), + "convergence" := case_when( + .data$modelstat == 1 & .data$solvestat == 1 ~ "optimal", + .data$modelstat == 2 & .data$solvestat == 1 ~ "optimal", + .data$modelstat == 7 & .data$solvestat == 4 ~ "feasible", .default = "infeasible" ) ) data <- p80RepyIteration %>% group_by(.data$iteration, .data$convergence) %>% - mutate(details = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% + mutate("details" = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% ungroup() data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) @@ -162,10 +162,10 @@ mipConvergence <- function(gdx) { as.quitte() %>% select(c("period", "value", "all_enty", "iteration")) %>% mutate( - value := ifelse(is.na(value), 0, value), - type := case_when( - all_enty == "good" ~ "Goods trade surplus", - all_enty == "perm" ~ "Permits", + "value" := ifelse(is.na(.data$value), 0, .data$value), + "type" := case_when( + .data$all_enty == "good" ~ "Goods trade surplus", + .data$all_enty == "perm" ~ "Permits", TRUE ~ "Primary energy trade surplus" ) ) @@ -176,8 +176,8 @@ mipConvergence <- function(gdx) { surplus <- left_join(surplus, p80SurplusMaxTolerance, by = "all_enty") %>% mutate( - maxTol := ifelse(period == 2150, maxTol * 10, maxTol), - withinLimits := ifelse(abs(value) > maxTol, "no", "yes") + "maxTol" := ifelse(.data$period == 2150, .data$maxTol * 10, .data$maxTol), + "withinLimits" := ifelse(abs(.data$value) > .data$maxTol, "no", "yes") ) data <- surplus @@ -201,16 +201,16 @@ mipConvergence <- function(gdx) { limits <- surplus %>% group_by(.data$type, .data$period, .data$iteration) %>% - mutate(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% + mutate("withinLimits" = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% ungroup() %>% select("type", "period", "iteration", "maxTol", "withinLimits") %>% distinct() %>% mutate( - rectXmin = as.numeric(iteration) - 0.5, - rectXmax = as.numeric(iteration) + 0.5, - tooltip = paste0( - type, - ifelse(withinLimits == "no", + "rectXmin" = as.numeric(.data$iteration) - 0.5, + "rectXmax" = as.numeric(.data$iteration) + 0.5, + "tooltip" = paste0( + .data$type, + ifelse(.data$withinLimits == "no", " outside tolerance limits.", " within tolerance limits." ) @@ -263,7 +263,7 @@ mipConvergence <- function(gdx) { surplusCondition <- surplus %>% group_by(.data$iteration) %>% summarise(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% - mutate(tooltip = paste0("Iteration: ", iteration, "
Converged")) + mutate("tooltip" = paste0("Iteration: ", .data$iteration, "
Converged")) for (iter in surplusCondition$iteration) { if (surplusCondition[which(surplusCondition$iteration == iter), ]$withinLimits == "no") { @@ -308,13 +308,13 @@ mipConvergence <- function(gdx) { cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) p80FadeoutPriceAnticipIter <- readGDX(gdx, name = "p80_fadeoutPriceAnticip_iter", restore_zeros = FALSE) %>% as.quitte() %>% - select("iteration", "fadeoutPriceAnticip" = value ) + select("iteration", "fadeoutPriceAnticip" = "value") data <- p80FadeoutPriceAnticipIter %>% mutate( - iteration := as.numeric(iteration), - converged = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), - tooltip = ifelse( + "iteration" := as.numeric(.data$iteration), + "converged" = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), + "tooltip" = ifelse( .data$converged == "yes", paste0( "Converged
Price Anticipation fade out is low enough
", From ca0234e4265ea5d71a20fab9bacdf226b9fee176 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 30 Oct 2023 12:08:49 +0100 Subject: [PATCH 26/41] add tax convergence plot --- R/mipConvergence.R | 53 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 49 insertions(+), 4 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 7043fc7..e0241f2 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -16,7 +16,7 @@ #' @importFrom reshape2 dcast #' #' @export -mipConvergence <- function(gdx) { +mipConvergence <- function(gdx) { # nolint cyclocomp_linter if (!file.exists(gdx)) { warning("gdx file not found!") @@ -127,7 +127,8 @@ mipConvergence <- function(gdx) { data <- p80RepyIteration %>% group_by(.data$iteration, .data$convergence) %>% - mutate("details" = paste0("Iteration: ", .data$iteration, "
region: ", paste0(.data$region, collapse = ", "))) %>% + mutate("details" = paste0("Iteration: ", .data$iteration, + "
region: ", paste0(.data$region, collapse = ", "))) %>% ungroup() data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) @@ -345,6 +346,47 @@ mipConvergence <- function(gdx) { # Tax Convergence ---- + cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck")) + + p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE) %>% + as.quitte() %>% + select("region", "period", "iteration", "value") %>% + mutate("converged" = .data$value <= 1e-4) + + data <- p80ConvNashTaxrevIter %>% + group_by(.data$iteration) %>% + summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% + mutate("tooltip" = "Converged") + + for (i in unique(p80ConvNashTaxrevIter$iteration)) { + if (data[data$iteration == i, "converged"] == "no") { + tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$converged == FALSE) + + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$region), collapse = ", "), + "
", + paste0(unique(tmp$period), collapse = ", ") + ) + } + } + + yLabel <- ifelse(cmTaxConvCheck == 0, "Tax\nConvergence\n(incactive)", "Tax\nConvergence") + + taxConvergence <- suppressWarnings(ggplot(data, aes_( + x = ~iteration, y = yLabel, + fill = ~converged, 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(yLabel), drop = FALSE) + + labs(x = NULL, y = NULL) + + taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text")) + # Summary plot ---- out <- list() @@ -354,8 +396,11 @@ mipConvergence <- function(gdx) { objVarSummaryPlotly, surplusSummaryPlotly, priceAnticipationPlotly, - nrows = 4, shareX = TRUE, titleX = FALSE, - heights = c(0.4, 0.2, 0.2, 0.2), + taxConvergencePlotly, + nrows = 5, + shareX = TRUE, + titleX = FALSE, + heights = c(0.3, 0.5 / 3, 0.5 / 3, 0.2, 0.5 / 3), margin = c(.1, .1, .1, .0001) ) %>% hide_legend() %>% From bfe0c8edcdf5da84bc8c9577a484ca56c0186193 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 30 Oct 2023 12:54:51 +0100 Subject: [PATCH 27/41] add emission market target deviation plot --- R/mipConvergence.R | 73 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 72 insertions(+), 1 deletion(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index e0241f2..1129021 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -344,7 +344,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) - # Tax Convergence ---- + # Tax Convergence (optional) ---- cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck")) @@ -387,6 +387,68 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text")) + + # Emission Market Deviation (optional) ---- + + optionalPlots <- list() + + p80EmiMktTargetDevIter <- suppressWarnings( + readGDX(gdx, name = "p80_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) + ) + + if (!is.null(p80EmiMktTargetDevIter)) { + cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance")) + + p80EmiMktTargetDevIter <- p80EmiMktTargetDevIter %>% + as.quitte() %>% + select("period", "iteration", "ext_regi", "emiMktExt", "value") %>% + mutate("converged" = .data$value <= cmEmiMktTargetTolerance) + + data <- p80EmiMktTargetDevIter %>% + group_by(.data$iteration) %>% + summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% + mutate("tooltip" = "Converged") + + # TODO: What to add to the tooltip if not converged? + + for (i in unique(p80EmiMktTargetDevIter$iteration)) { + if (data[data$iteration == i, "converged"] == "no") { + tmp <- filter(p80EmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) + + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$ext_regi), collapse = ", "), + "
", + paste0(unique(tmp$period), collapse = ", "), + "
", + paste0(unique(tmp$emiMktExt), collapse = ", ") + ) + } + } + + emiMktTargetDev <- suppressWarnings(ggplot(data, aes_( + x = ~iteration, y = "Emission Market\nTarget Deviation", + fill = ~converged, 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("Emission Market\nTarget Deviation"), drop = FALSE) + + labs(x = NULL, y = NULL) + + emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text")) + + optionalPlots <- append(optionalPlots, list(emiMktTargetDevPlotly)) + } + + # Implicity Quantity Target (optional) ---- + + # Global Bugdet Deviation (optional) ---- + + # Internalized Damages (optional) ---- + # Summary plot ---- out <- list() @@ -409,5 +471,14 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter out$tradeDetailPlot <- surplusConvergencePlotly + if (length(optionalPlots) > 0) { + out$optionalPlots <- subplot( + optionalPlots + ) %>% + hide_legend() %>% + config(displayModeBar = FALSE, displaylogo = FALSE) %>% + layout(margin = list(l = -100, r = 10)) + } + return(out) } From d8d3beb96398df4db5df4b2a01e08753689d484e Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 31 Oct 2023 14:04:29 +0100 Subject: [PATCH 28/41] add implicit quantity target plot --- R/mipConvergence.R | 146 +++++++++++++++++++++++++++++++++++---------- 1 file changed, 116 insertions(+), 30 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 1129021..1777dc4 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -22,7 +22,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter warning("gdx file not found!") return(list()) } - modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] @@ -39,6 +38,8 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D") + optionalPlots <- list() + # Optimality / Objective Deviation ---- p80ConvNashObjValIter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% @@ -159,6 +160,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Trade goods surplus detail ---- # TODO: why is p80_surplusMax_iter only returning positive values? + surplus <- readGDX(gdx, name = "p80_surplus", restore_zeros = FALSE)[, c(2100, 2150), ] %>% as.quitte() %>% select(c("period", "value", "all_enty", "iteration")) %>% @@ -346,6 +348,9 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Tax Convergence (optional) ---- + # TODO: What to add to the tooltip if not converged? + # TODO: correct implementation? + cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck")) p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE) %>% @@ -360,15 +365,26 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter for (i in unique(p80ConvNashTaxrevIter$iteration)) { if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$converged == FALSE) - - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$region), collapse = ", "), - "
", - paste0(unique(tmp$period), collapse = ", ") - ) + tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$converged == FALSE) %>% + mutate("item" = paste0(.data$region, " ", .data$period)) %>% + select("region", "period", "item") %>% + distinct() + + if (nrow(tmp) > 10) { + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$region), collapse = ", "), + "
", + paste0(unique(tmp$period), collapse = ", ") + ) + } else { + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$item), collapse = ", ") + ) + } } } @@ -390,13 +406,19 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Emission Market Deviation (optional) ---- - optionalPlots <- list() + # TODO: can I use p80_emiMktTarget_dev_iter directly here? + # TODO: use pm_emiMktTarget_dev_iter instead of p80_emiMktTarget_dev_iter + # TODO: What to add to the tooltip if not converged? + # TODO: correct implementation - p80EmiMktTargetDevIter <- suppressWarnings( - readGDX(gdx, name = "p80_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) - ) + pmEmiMktTarget <- readGDX(gdx, name = "pm_emiMktTarget", react = "silent", restore_zeros = FALSE) + + if (!is.null(pmEmiMktTarget)) { + + p80EmiMktTargetDevIter <- suppressWarnings( + readGDX(gdx, name = "p80_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) + ) - if (!is.null(p80EmiMktTargetDevIter)) { cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance")) p80EmiMktTargetDevIter <- p80EmiMktTargetDevIter %>% @@ -409,21 +431,30 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% mutate("tooltip" = "Converged") - # TODO: What to add to the tooltip if not converged? - for (i in unique(p80EmiMktTargetDevIter$iteration)) { if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(p80EmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) - - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$ext_regi), collapse = ", "), - "
", - paste0(unique(tmp$period), collapse = ", "), - "
", - paste0(unique(tmp$emiMktExt), collapse = ", ") - ) + tmp <- filter(p80EmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) %>% + mutate("item" = paste0(.data$ext_regi, " ", .data$period, " ", .data$emiMktExt)) %>% + select("ext_regi", "period", "emiMktExt", "item") %>% + distinct() + + if (nrow(tmp) > 10) { + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$ext_regi), collapse = ", "), + "
", + paste0(unique(tmp$period), collapse = ", "), + "
", + paste0(unique(tmp$emiMktExt), collapse = ", ") + ) + } else { + data[data$iteration == i, "tooltip"] <- paste0( + "Iteration ", i, " ", + "not converged:
", + paste0(unique(tmp$item), collapse = ", ") + ) + } } } @@ -443,7 +474,58 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter optionalPlots <- append(optionalPlots, list(emiMktTargetDevPlotly)) } - # Implicity Quantity Target (optional) ---- + # Implicit Quantity Target (optional) ---- + + pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE) + + if (!is.null(pmImplicitQttyTarget)) { + + cmImplicitQttyTargetTolerance <- as.vector(readGDX(gdx, name = "cm_implicitQttyTarget_tolerance")) + + pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE) %>% + as.quitte() %>% + select("period", "ext_regi", "taxType", "qttyTarget", "qttyTargetGroup") + + pmImplicitQttyTargetIsLimited <- readGDX(gdx, name = "pm_implicitQttyTarget_isLimited") %>% + as.quitte() %>% + select("iteration", "qttyTarget", "qttyTargetGroup", "isLimited" = "value") + + p80ImplicitQttyTargetDevIter <- readGDX(gdx, name = "p80_implicitQttyTarget_dev_iter", restore_zeros = FALSE) %>% + as.quitte() %>% + select("period", "value", "iteration", "ext_regi", "qttyTarget", "qttyTargetGroup") %>% + left_join(pmImplicitQttyTarget, by = c("period", "ext_regi", "qttyTarget", "qttyTargetGroup")) %>% + left_join(pmImplicitQttyTargetIsLimited, by = c("iteration", "qttyTarget", "qttyTargetGroup")) %>% + mutate( + "failed" = + abs(.data$value) > cmImplicitQttyTargetTolerance & ( + !(ifelse(.data$taxType == "tax", .data$value < 0, FALSE)) | + ifelse(.data$taxType == "sub", .data$value > 0, FALSE) + ) & .data$isLimited != 1 + ) + + # TODO: What to add to the tooltip if not converged? + data <- p80ImplicitQttyTargetDevIter %>% + group_by(.data$iteration) %>% + summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>% + mutate("tooltip" = ifelse(.data$converged == "yes", "Converged", "Not converged")) + + qttyTarget <- suppressWarnings(ggplot(data, aes_( + x = ~iteration, y = "Implicit Quantity\nTarget", + fill = ~converged, 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("Implicit Quantity\nTarget"), drop = FALSE) + + labs(x = NULL, y = NULL) + + qttyTargetPlotly <- ggplotly(qttyTarget, tooltip = c("text")) + + optionalPlots <- append(optionalPlots, list(qttyTargetPlotly)) + + } + # Global Bugdet Deviation (optional) ---- @@ -473,7 +555,11 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter if (length(optionalPlots) > 0) { out$optionalPlots <- subplot( - optionalPlots + optionalPlots, + nrows = length(optionalPlots), + shareX = TRUE, + titleX = FALSE, + margin = c(.1, .1, .1, .0001) ) %>% hide_legend() %>% config(displayModeBar = FALSE, displaylogo = FALSE) %>% From caec1c906f5f007e79c7f5b3570e9230c31529e9 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Tue, 31 Oct 2023 14:23:02 +0100 Subject: [PATCH 29/41] add global budget deviation plot --- R/mipConvergence.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 1777dc4..d0b66f2 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -529,6 +529,34 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Global Bugdet Deviation (optional) ---- + # TODO. what is the condition? + + p80GlobalBudgetDevIter <- readGDX(gdx, name = "p80_globalBudget_dev_iter", restore_zeros = FALSE) %>% + as.quitte() %>% + select("value", "iteration") %>% + mutate("failed" = .data$value > 1.01 | .data$value < 0.99) + + data <- p80GlobalBudgetDevIter %>% + mutate( + "converged" = ifelse(.data$failed == TRUE, "no", "yes"), + "tooltip" = ifelse(.data$failed, "Not converged", "Converged") + ) + + globalBuget <- suppressWarnings(ggplot(data, aes_( + x = ~iteration, y = "Global Budget\nDeviation", + fill = ~converged, 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("Global Budget\nDeviation"), drop = FALSE) + + labs(x = NULL, y = NULL) + + globalBugetPlotly <- ggplotly(globalBuget, tooltip = c("text")) + + optionalPlots <- append(optionalPlots, list(globalBugetPlotly)) + # Internalized Damages (optional) ---- # Summary plot ---- From 8ed92f90db6117d0023ae2cbb812f62c4be783ed Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 2 Nov 2023 12:31:53 +0100 Subject: [PATCH 30/41] dynamically scale plot heights --- R/mipConvergence.R | 138 ++++++++++++++++++++------------------------- 1 file changed, 61 insertions(+), 77 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index d0b66f2..e69b325 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -38,7 +38,55 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D") - optionalPlots <- list() + subplots <- list() + + # Feasibility ----- + + p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% + as.quitte() %>% + select(c("solveinfo80", "region", "iteration", "value")) %>% + dcast(region + iteration ~ solveinfo80, value.var = "value") %>% + mutate( + "iteration" := as.numeric(.data$iteration), + "convergence" := case_when( + .data$modelstat == 1 & .data$solvestat == 1 ~ "optimal", + .data$modelstat == 2 & .data$solvestat == 1 ~ "optimal", + .data$modelstat == 7 & .data$solvestat == 4 ~ "feasible", + .default = "infeasible" + ) + ) + + data <- p80RepyIteration %>% + group_by(.data$iteration, .data$convergence) %>% + mutate("details" = paste0("Iteration: ", .data$iteration, + "
region: ", paste0(.data$region, collapse = ", "))) %>% + ungroup() + + data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) + + convergencePlot <- + suppressWarnings(ggplot(mapping = aes_(~iteration, ~convergence, text = ~details))) + + geom_line( + data = data, + linetype = "dashed", + aes_(group = ~region, color = ~region), + alpha = aestethics$alpha, + linewidth = aestethics$line$size + ) + + geom_point( + data = select(data, c("iteration", "convergence", "details")) %>% distinct(), + aes_(fill = ~convergence), + size = 2, + alpha = aestethics$alpha + ) + + scale_fill_manual(values = c("optimal" = "#00BFC4", "feasible" = "#ffcc66", "infeasible" = "#F8766D")) + + scale_color_manual(values = plotstyle(as.character(unique(data$region)))) + + scale_y_discrete(breaks = c("infeasible", "feasible", "optimal"), drop = FALSE) + + theme_minimal() + + labs(x = NULL, y = NULL) + + convergencePlotPlotly <- ggplotly(convergencePlot, tooltip = c("text")) + subplots <- append(subplots, list(convergencePlotPlotly)) # Optimality / Objective Deviation ---- @@ -108,55 +156,9 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text")) + subplots <- append(subplots, list(objVarSummaryPlotly)) - # Feasibility ----- - - p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% - as.quitte() %>% - select(c("solveinfo80", "region", "iteration", "value")) %>% - dcast(region + iteration ~ solveinfo80, value.var = "value") %>% - mutate( - "iteration" := as.numeric(.data$iteration), - "convergence" := case_when( - .data$modelstat == 1 & .data$solvestat == 1 ~ "optimal", - .data$modelstat == 2 & .data$solvestat == 1 ~ "optimal", - .data$modelstat == 7 & .data$solvestat == 4 ~ "feasible", - .default = "infeasible" - ) - ) - - data <- p80RepyIteration %>% - group_by(.data$iteration, .data$convergence) %>% - mutate("details" = paste0("Iteration: ", .data$iteration, - "
region: ", paste0(.data$region, collapse = ", "))) %>% - ungroup() - - data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) - - convergencePlot <- - suppressWarnings(ggplot(mapping = aes_(~iteration, ~convergence, text = ~details))) + - geom_line( - data = data, - linetype = "dashed", - aes_(group = ~region, color = ~region), - alpha = aestethics$alpha, - linewidth = aestethics$line$size - ) + - geom_point( - data = select(data, c("iteration", "convergence", "details")) %>% distinct(), - aes_(fill = ~convergence), - size = 2, - alpha = aestethics$alpha - ) + - scale_fill_manual(values = c("optimal" = "#00BFC4", "feasible" = "#ffcc66", "infeasible" = "#F8766D")) + - scale_color_manual(values = plotstyle(as.character(unique(data$region)))) + - scale_y_discrete(breaks = c("infeasible", "feasible", "optimal"), drop = FALSE) + - theme_minimal() + - labs(x = NULL, y = NULL) - - convergencePlotPlotly <- ggplotly(convergencePlot, tooltip = c("text")) - # Trade goods surplus detail ---- # TODO: why is p80_surplusMax_iter only returning positive values? @@ -304,7 +306,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) - + subplots <- append(subplots, list(surplusSummaryPlotly)) # Price anticipation ---- @@ -345,6 +347,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter coord_cartesian(ylim = c(-0.2, 1)) priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) + subplots <- append(subplots, list(priceAnticipationPlotly)) # Tax Convergence (optional) ---- @@ -402,7 +405,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text")) - + subplots <- append(subplots, list(taxConvergencePlotly)) # Emission Market Deviation (optional) ---- @@ -471,7 +474,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text")) - optionalPlots <- append(optionalPlots, list(emiMktTargetDevPlotly)) + subplots <- append(subplots, list(emiMktTargetDevPlotly)) } # Implicit Quantity Target (optional) ---- @@ -521,8 +524,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) qttyTargetPlotly <- ggplotly(qttyTarget, tooltip = c("text")) - - optionalPlots <- append(optionalPlots, list(qttyTargetPlotly)) + subplots <- append(subplots, list(qttyTargetPlotly)) } @@ -554,8 +556,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter labs(x = NULL, y = NULL) globalBugetPlotly <- ggplotly(globalBuget, tooltip = c("text")) - - optionalPlots <- append(optionalPlots, list(globalBugetPlotly)) + subplots <- append(subplots, list(globalBugetPlotly)) # Internalized Damages (optional) ---- @@ -563,36 +564,19 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter out <- list() + out$tradeDetailPlot <- surplusConvergencePlotly + n <- length(subplots) out$plot <- subplot( - convergencePlotPlotly, - objVarSummaryPlotly, - surplusSummaryPlotly, - priceAnticipationPlotly, - taxConvergencePlotly, - nrows = 5, + subplots, + nrows = n, + heights = c(2 / (n + 2), rep(1 / (n + 2), 2), 2 / (n + 2), 1 / (n + 2), rep(1 / (n + 2), n - 5)), shareX = TRUE, titleX = FALSE, - heights = c(0.3, 0.5 / 3, 0.5 / 3, 0.2, 0.5 / 3), margin = c(.1, .1, .1, .0001) ) %>% hide_legend() %>% config(displayModeBar = FALSE, displaylogo = FALSE) %>% layout(margin = list(l = -100, r = 10)) - out$tradeDetailPlot <- surplusConvergencePlotly - - if (length(optionalPlots) > 0) { - out$optionalPlots <- subplot( - optionalPlots, - nrows = length(optionalPlots), - shareX = TRUE, - titleX = FALSE, - margin = c(.1, .1, .1, .0001) - ) %>% - hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) %>% - layout(margin = list(l = -100, r = 10)) - } - return(out) } From 12f4bbc43944cc6cf9f9c3e2cfb35f04dc349bb1 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 2 Nov 2023 15:25:15 +0100 Subject: [PATCH 31/41] add damage internalization plot --- R/mipConvergence.R | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index e69b325..e72b177 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -560,6 +560,47 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Internalized Damages (optional) ---- + module2realisation <- readGDX(gdx, name = "module2realisation") + if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] == "on") { + cmSccConvergence <- as.numeric(readGDX(gdx, name = "cm_sccConvergence", types = c("parameters"))) + cmTempConvergence <- as.numeric(readGDX(gdx, name = "cm_tempConvergence", types = c("parameters"))) + p80SccConvergenceMaxDeviationIter <- readGDX(gdx, name = "p80_sccConvergenceMaxDeviation_iter") %>% + as.quitte() %>% + select("iteration", "p80SccConvergenceMaxDeviationIter" = "value") %>% + mutate("iteration" := as.numeric(.data$iteration)) %>% + filter(.data$iteration <= lastIteration) + + p80GmtConvIter <- readGDX(gdx, name = "p80_gmt_conv_iter") %>% + as.quitte() %>% + select("iteration", "p80GmtConvIter" = "value") %>% + mutate("iteration" := as.numeric(.data$iteration)) %>% + filter(.data$iteration <= lastIteration) + + data <- left_join(p80SccConvergenceMaxDeviationIter, p80GmtConvIter, by = "iteration") %>% + mutate( + "converged" = ifelse(.data$p80SccConvergenceMaxDeviationIter > cmSccConvergence | + .data$p80GmtConvIter > cmTempConvergence, "no", "yes"), + "tooltip" = ifelse(.data$converged == "no", "Not converged", "Converged") + ) + + + damageInternalization <- suppressWarnings(ggplot(data, aes_( + x = ~iteration, y = "Damage\nInternalization", + fill = ~converged, 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("Damage\nInternalization"), drop = FALSE) + + labs(x = NULL, y = NULL) + + damageInternalizationPlotly <- ggplotly(damageInternalization, tooltip = c("text")) + subplots <- append(subplots, list(damageInternalizationPlotly)) + + } + + # Summary plot ---- out <- list() From c75b5c61decfb4df45d47c89a7d822845843dc09 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 2 Nov 2023 17:01:33 +0100 Subject: [PATCH 32/41] add format fixes --- R/mipConvergence.R | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index e72b177..22b7d40 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -391,7 +391,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter } } - yLabel <- ifelse(cmTaxConvCheck == 0, "Tax\nConvergence\n(incactive)", "Tax\nConvergence") + yLabel <- ifelse(cmTaxConvCheck == 0, "Tax Convergence\n(inactive)", "Tax Convergence") taxConvergence <- suppressWarnings(ggplot(data, aes_( x = ~iteration, y = yLabel, @@ -418,25 +418,25 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter if (!is.null(pmEmiMktTarget)) { - p80EmiMktTargetDevIter <- suppressWarnings( - readGDX(gdx, name = "p80_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) + pmEmiMktTargetDevIter <- suppressWarnings( + readGDX(gdx, name = "pm_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) ) cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance")) - p80EmiMktTargetDevIter <- p80EmiMktTargetDevIter %>% + pmEmiMktTargetDevIter <- pmEmiMktTargetDevIter %>% as.quitte() %>% select("period", "iteration", "ext_regi", "emiMktExt", "value") %>% mutate("converged" = .data$value <= cmEmiMktTargetTolerance) - data <- p80EmiMktTargetDevIter %>% + data <- pmEmiMktTargetDevIter %>% group_by(.data$iteration) %>% summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% mutate("tooltip" = "Converged") - for (i in unique(p80EmiMktTargetDevIter$iteration)) { + for (i in unique(pmEmiMktTargetDevIter$iteration)) { if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(p80EmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) %>% + tmp <- filter(pmEmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) %>% mutate("item" = paste0(.data$ext_regi, " ", .data$period, " ", .data$emiMktExt)) %>% select("ext_regi", "period", "emiMktExt", "item") %>% distinct() @@ -479,7 +479,8 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Implicit Quantity Target (optional) ---- - pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE) + pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE, + react = "silent") if (!is.null(pmImplicitQttyTarget)) { @@ -560,8 +561,9 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Internalized Damages (optional) ---- + # TODO: never turned on? module2realisation <- readGDX(gdx, name = "module2realisation") - if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] == "on") { + if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] != "off") { cmSccConvergence <- as.numeric(readGDX(gdx, name = "cm_sccConvergence", types = c("parameters"))) cmTempConvergence <- as.numeric(readGDX(gdx, name = "cm_tempConvergence", types = c("parameters"))) p80SccConvergenceMaxDeviationIter <- readGDX(gdx, name = "p80_sccConvergenceMaxDeviation_iter") %>% @@ -606,18 +608,17 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter out <- list() out$tradeDetailPlot <- surplusConvergencePlotly + n <- length(subplots) out$plot <- subplot( subplots, nrows = n, - heights = c(2 / (n + 2), rep(1 / (n + 2), 2), 2 / (n + 2), 1 / (n + 2), rep(1 / (n + 2), n - 5)), + heights = c(3 / (n + 3), rep(1 / (n + 3), 2), 2 / (n + 3), 1 / (n + 3), rep(1 / (n + 3), n - 5)), shareX = TRUE, - titleX = FALSE, - margin = c(.1, .1, .1, .0001) + titleX = FALSE ) %>% hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) %>% - layout(margin = list(l = -100, r = 10)) + config(displayModeBar = FALSE, displaylogo = FALSE) return(out) } From 3032e2dfa9de36c929959fe3bcc17bc508487282 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 2 Nov 2023 17:39:08 +0100 Subject: [PATCH 33/41] remove todos --- R/mipConvergence.R | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 22b7d40..656dd26 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -161,9 +161,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Trade goods surplus detail ---- - # TODO: why is p80_surplusMax_iter only returning positive values? - - surplus <- readGDX(gdx, name = "p80_surplus", restore_zeros = FALSE)[, c(2100, 2150), ] %>% + surplus <- readGDX(gdx, name = "p80_surplusMax_iter", restore_zeros = FALSE)[, c(2100, 2150), ] %>% as.quitte() %>% select(c("period", "value", "all_enty", "iteration")) %>% mutate( @@ -351,9 +349,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Tax Convergence (optional) ---- - # TODO: What to add to the tooltip if not converged? - # TODO: correct implementation? - cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck")) p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE) %>% @@ -409,11 +404,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Emission Market Deviation (optional) ---- - # TODO: can I use p80_emiMktTarget_dev_iter directly here? - # TODO: use pm_emiMktTarget_dev_iter instead of p80_emiMktTarget_dev_iter - # TODO: What to add to the tooltip if not converged? - # TODO: correct implementation - pmEmiMktTarget <- readGDX(gdx, name = "pm_emiMktTarget", react = "silent", restore_zeros = FALSE) if (!is.null(pmEmiMktTarget)) { @@ -462,14 +452,14 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter } emiMktTargetDev <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = "Emission Market\nTarget Deviation", + x = ~iteration, y = "Emission Market\nTarget", fill = ~converged, 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("Emission Market\nTarget Deviation"), drop = FALSE) + + scale_y_discrete(breaks = c("Emission Market\nTarget"), drop = FALSE) + labs(x = NULL, y = NULL) emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text")) @@ -507,7 +497,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter ) & .data$isLimited != 1 ) - # TODO: What to add to the tooltip if not converged? data <- p80ImplicitQttyTargetDevIter %>% group_by(.data$iteration) %>% summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>% @@ -532,8 +521,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Global Bugdet Deviation (optional) ---- - # TODO. what is the condition? - p80GlobalBudgetDevIter <- readGDX(gdx, name = "p80_globalBudget_dev_iter", restore_zeros = FALSE) %>% as.quitte() %>% select("value", "iteration") %>% @@ -561,7 +548,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter # Internalized Damages (optional) ---- - # TODO: never turned on? module2realisation <- readGDX(gdx, name = "module2realisation") if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] != "off") { cmSccConvergence <- as.numeric(readGDX(gdx, name = "cm_sccConvergence", types = c("parameters"))) From 22eecdf88675a618786e4df25524346b48978926 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 3 Nov 2023 11:59:56 +0100 Subject: [PATCH 34/41] minor corrections --- R/mipConvergence.R | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 656dd26..a7ea34f 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -294,13 +294,13 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter } surplusSummary <- suppressWarnings(ggplot(surplusCondition, - aes_(x = ~iteration, y = "Trade\nSurplus", + aes_(x = ~iteration, y = "Max. Trade\nSurplus", fill = ~withinLimits, 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) + + scale_y_discrete(breaks = c("Max. Trade\nSurplus"), drop = FALSE) + labs(x = NULL, y = NULL) surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) @@ -354,16 +354,16 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE) %>% as.quitte() %>% select("region", "period", "iteration", "value") %>% - mutate("converged" = .data$value <= 1e-4) + mutate("failed" = .data$value > 1e-4) data <- p80ConvNashTaxrevIter %>% group_by(.data$iteration) %>% - summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% + summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>% mutate("tooltip" = "Converged") for (i in unique(p80ConvNashTaxrevIter$iteration)) { if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$converged == FALSE) %>% + tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$failed == TRUE) %>% mutate("item" = paste0(.data$region, " ", .data$period)) %>% select("region", "period", "item") %>% distinct() @@ -518,7 +518,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter } - # Global Bugdet Deviation (optional) ---- p80GlobalBudgetDevIter <- readGDX(gdx, name = "p80_globalBudget_dev_iter", restore_zeros = FALSE) %>% @@ -571,7 +570,6 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter "tooltip" = ifelse(.data$converged == "no", "Not converged", "Converged") ) - damageInternalization <- suppressWarnings(ggplot(data, aes_( x = ~iteration, y = "Damage\nInternalization", fill = ~converged, text = ~tooltip From 03f23bab7c5f777338530f30750bac1ef66363ff Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 3 Nov 2023 12:25:39 +0100 Subject: [PATCH 35/41] handle ggplot warnings --- R/mipConvergence.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index a7ea34f..647052e 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -237,7 +237,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter group = ~all_enty, text = ~tooltip ), alpha = aestethics$alpha, - size = aestethics$line$size + linewidth = aestethics$line$size )) + suppressWarnings(geom_rect( data = limits, @@ -331,7 +331,7 @@ mipConvergence <- function(gdx) { # nolint cyclocomp_linter ) priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + - geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, size = aestethics$line$size) + + geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, linewidth = aestethics$line$size) + suppressWarnings(geom_point( size = 2, aes_(y = 0.0001, fill = ~converged, text = ~tooltip), From 529522c7d0ec79424855281c1cc39a681d5c2391 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 3 Nov 2023 13:40:43 +0100 Subject: [PATCH 36/41] increment version --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- NAMESPACE | 3 --- README.md | 6 +++--- 5 files changed, 8 insertions(+), 11 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 55016cb..e22f62f 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28614768' +ValidationKey: '28709440' 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 183724d..11f6f93 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: 'mip: Comparison of multi-model runs' -version: 0.145.6 -date-released: '2023-10-23' +version: 0.146.0 +date-released: '2023-11-03' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 6d134f7..37d4941 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.145.6 -Date: 2023-10-23 +Version: 0.146.0 +Date: 2023-11-03 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 0f7a0b8..0c01383 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -74,7 +74,6 @@ importFrom(ggplot2,geom_col) 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) @@ -95,7 +94,6 @@ importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_discrete) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) -importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,scale_y_log10) importFrom(ggplot2,stat_summary) importFrom(ggplot2,theme) @@ -193,7 +191,6 @@ importFrom(shiny,verbatimTextOutput) importFrom(shiny,wellPanel) importFrom(stats,as.formula) importFrom(stats,complete.cases) -importFrom(stats,lag) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,reshape) diff --git a/README.md b/README.md index 95d97cb..851b17f 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.145.6** +R package **mip**, version **0.146.0** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.146.0, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.145.6}, + note = {R package version 0.146.0}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From 09266dca8827bfab5726724f391969a10aeeb234 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 3 Nov 2023 13:54:12 +0100 Subject: [PATCH 37/41] add imports --- NAMESPACE | 5 +++++ R/mipConvergence.R | 3 ++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 0c01383..41f9a54 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,6 +41,8 @@ importFrom(data.table,setnames) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,bind_rows) +importFrom(dplyr,case_when) +importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,inner_join) @@ -74,6 +76,7 @@ importFrom(ggplot2,geom_col) 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) @@ -94,6 +97,8 @@ importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_discrete) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_y_continuous) +importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,scale_y_log10) importFrom(ggplot2,stat_summary) importFrom(ggplot2,theme) diff --git a/R/mipConvergence.R b/R/mipConvergence.R index 647052e..571fc12 100644 --- a/R/mipConvergence.R +++ b/R/mipConvergence.R @@ -10,8 +10,9 @@ #' } #' #' @importFrom gdx readGDX -#' @importFrom dplyr summarise group_by mutate filter +#' @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 plotly ggplotly config hide_legend subplot layout #' @importFrom reshape2 dcast #' From be76900ace1a805422cf3aa38cb0e14c7206c657 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Mon, 6 Nov 2023 11:26:17 +0100 Subject: [PATCH 38/41] remove mipConvergence --- .buildlibrary | 2 +- .github/workflows/check.yaml | 1 + .pre-commit-config.yaml | 4 +- CITATION.cff | 2 +- DESCRIPTION | 3 +- NAMESPACE | 9 - R/mipConvergence.R | 609 ----------------------------------- man/mipConvergence.Rd | 24 -- 8 files changed, 6 insertions(+), 648 deletions(-) delete mode 100644 R/mipConvergence.R delete mode 100644 man/mipConvergence.Rd diff --git a/.buildlibrary b/.buildlibrary index e22f62f..b8e025e 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28709440' +ValidationKey: '28713820' AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' - 'Warning: namespace ''.*'' is not available and has been replaced' diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index b75d0ed..870f216 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -23,6 +23,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: | + gamstransfer=?ignore any::lucode2 any::covr any::madrat diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 7a47c41..2f13466 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -3,7 +3,7 @@ exclude: '^tests/testthat/_snaps/.*$' repos: - repo: https://github.com/pre-commit/pre-commit-hooks - rev: v4.4.0 + rev: v4.5.0 hooks: - id: check-case-conflict - id: check-json @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.3.2.9021 + rev: v0.3.2.9025 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index 11f6f93..a5c4248 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: 'mip: Comparison of multi-model runs' version: 0.146.0 -date-released: '2023-11-03' +date-released: '2023-11-06' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 37d4941..4d3ae84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: mip Title: Comparison of multi-model runs Version: 0.146.0 -Date: 2023-11-03 +Date: 2023-11-06 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), @@ -27,7 +27,6 @@ Imports: RColorBrewer, data.table, dplyr, - gdx, ggplot2, gridExtra, htmltools, diff --git a/NAMESPACE b/NAMESPACE index 41f9a54..bb59d9c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,6 @@ export(identifierModelScen) export(longestCommonPrefix) export(mipArea) export(mipBarYearData) -export(mipConvergence) export(mipIterations) export(mipLineHistorical) export(plotstyle) @@ -41,8 +40,6 @@ importFrom(data.table,setnames) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,bind_rows) -importFrom(dplyr,case_when) -importFrom(dplyr,distinct) importFrom(dplyr,filter) importFrom(dplyr,group_by) importFrom(dplyr,inner_join) @@ -55,7 +52,6 @@ importFrom(dplyr,summarise) importFrom(dplyr,summarize) importFrom(dplyr,sym) importFrom(dplyr,ungroup) -importFrom(gdx,readGDX) importFrom(ggplot2,"%+replace%") importFrom(ggplot2,aes) importFrom(ggplot2,aes_) @@ -76,7 +72,6 @@ importFrom(ggplot2,geom_col) 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) @@ -97,8 +92,6 @@ importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_linetype_discrete) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) -importFrom(ggplot2,scale_y_continuous) -importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,scale_y_log10) importFrom(ggplot2,stat_summary) importFrom(ggplot2,theme) @@ -134,9 +127,7 @@ importFrom(magclass,nregions) importFrom(magclass,nyears) importFrom(plotly,add_annotations) importFrom(plotly,as.widget) -importFrom(plotly,config) importFrom(plotly,ggplotly) -importFrom(plotly,hide_legend) importFrom(plotly,layout) importFrom(plotly,plotly) importFrom(plotly,plotlyOutput) diff --git a/R/mipConvergence.R b/R/mipConvergence.R deleted file mode 100644 index 571fc12..0000000 --- a/R/mipConvergence.R +++ /dev/null @@ -1,609 +0,0 @@ -#' @title Create REMIND convergence overview -#' -#' @param gdx GDX file -#' @author Renato Rodrigues, Falk Benke -#' -#' @examples -#' -#' \dontrun{ -#' mipConvergence(gdx="fulldata.gdx") -#' } -#' -#' @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 plotly ggplotly config hide_legend subplot layout -#' @importFrom reshape2 dcast -#' -#' @export -mipConvergence <- function(gdx) { # nolint cyclocomp_linter - - if (!file.exists(gdx)) { - warning("gdx file not found!") - return(list()) - } - modelstat <- readGDX(gdx, name = "o_modelstat")[[1]] - lastIteration <- readGDX(gdx, name = "o_iterationNumber")[[1]] - - if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) { - warning("Run failed - Check code, pre-triangular infes ...") - return(list()) - } - - aestethics <- list( - "alpha" = 0.6, - "line" = list("size" = 2 / 3.78), - "point" = list("size" = 2 / 3.78) - ) - - booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D") - - subplots <- list() - - # Feasibility ----- - - p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% - as.quitte() %>% - select(c("solveinfo80", "region", "iteration", "value")) %>% - dcast(region + iteration ~ solveinfo80, value.var = "value") %>% - mutate( - "iteration" := as.numeric(.data$iteration), - "convergence" := case_when( - .data$modelstat == 1 & .data$solvestat == 1 ~ "optimal", - .data$modelstat == 2 & .data$solvestat == 1 ~ "optimal", - .data$modelstat == 7 & .data$solvestat == 4 ~ "feasible", - .default = "infeasible" - ) - ) - - data <- p80RepyIteration %>% - group_by(.data$iteration, .data$convergence) %>% - mutate("details" = paste0("Iteration: ", .data$iteration, - "
region: ", paste0(.data$region, collapse = ", "))) %>% - ungroup() - - data$convergence <- factor(data$convergence, levels = c("infeasible", "feasible", "optimal")) - - convergencePlot <- - suppressWarnings(ggplot(mapping = aes_(~iteration, ~convergence, text = ~details))) + - geom_line( - data = data, - linetype = "dashed", - aes_(group = ~region, color = ~region), - alpha = aestethics$alpha, - linewidth = aestethics$line$size - ) + - geom_point( - data = select(data, c("iteration", "convergence", "details")) %>% distinct(), - aes_(fill = ~convergence), - size = 2, - alpha = aestethics$alpha - ) + - scale_fill_manual(values = c("optimal" = "#00BFC4", "feasible" = "#ffcc66", "infeasible" = "#F8766D")) + - scale_color_manual(values = plotstyle(as.character(unique(data$region)))) + - scale_y_discrete(breaks = c("infeasible", "feasible", "optimal"), drop = FALSE) + - theme_minimal() + - labs(x = NULL, y = NULL) - - convergencePlotPlotly <- ggplotly(convergencePlot, tooltip = c("text")) - subplots <- append(subplots, list(convergencePlotPlotly)) - - # Optimality / Objective Deviation ---- - - p80ConvNashObjValIter <- readGDX(gdx, name = "p80_convNashObjVal_iter") %>% - as.quitte() %>% - select(c("region", "iteration", "objvalDifference" = "value")) %>% - mutate("iteration" := as.numeric(.data$iteration)) %>% - filter(.data$iteration <= lastIteration) - - p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE) %>% - as.quitte() %>% - select(c("solveinfo80", "region", "iteration", "value")) %>% - mutate("iteration" := as.numeric(.data$iteration)) %>% - dcast(region + iteration ~ solveinfo80, value.var = "value") - - p80RepyIteration <- p80RepyIteration %>% - left_join(p80ConvNashObjValIter, by = c("region", "iteration")) %>% - group_by(.data$region) %>% - mutate( - "objvalCondition" = ifelse(.data$modelstat == "2", TRUE, - ifelse(.data$modelstat == "7" & is.na(.data$objvalDifference), FALSE, - ifelse(.data$modelstat == "7" & .data$objvalDifference < -1e-4, FALSE, TRUE) - ) - ) - ) %>% - ungroup() %>% - group_by(.data$iteration) %>% - mutate("objvalConverge" = all(.data$objvalCondition)) %>% - ungroup() - - data <- p80RepyIteration %>% - select("iteration", "objvalConverge") %>% - distinct() %>% - mutate( - "objVarCondition" := ifelse(.data$objvalConverge, "yes", "no"), - "tooltip" := paste0("Iteration: ", .data$iteration, "
Converged") - ) - - for (iter in unique(data$iteration)) { - current <- filter(p80RepyIteration, .data$iteration == iter) - - if (!all(current$objvalCondition)) { - tooltip <- NULL - current <- filter(current, .data$objvalCondition == FALSE) - - for (reg in current$region) { - diff <- current[current$region == reg, ]$objvalDifference - tooltip <- paste0(tooltip, "
", reg, " | ", round(diff, 5)) - } - tooltip <- paste0( - "Iteration: ", iter, "
Not converged", - "
Region | Deviation", tooltip, "
The deviation limit is +- 0.0001" - ) - data[which(data$iteration == iter), ]$tooltip <- tooltip - } - } - - objVarSummary <- suppressWarnings(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) - - objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text")) - subplots <- append(subplots, list(objVarSummaryPlotly)) - - - # Trade goods surplus detail ---- - - surplus <- readGDX(gdx, name = "p80_surplusMax_iter", restore_zeros = FALSE)[, c(2100, 2150), ] %>% - as.quitte() %>% - select(c("period", "value", "all_enty", "iteration")) %>% - mutate( - "value" := ifelse(is.na(.data$value), 0, .data$value), - "type" := case_when( - .data$all_enty == "good" ~ "Goods trade surplus", - .data$all_enty == "perm" ~ "Permits", - TRUE ~ "Primary energy trade surplus" - ) - ) - - p80SurplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>% - as.quitte() %>% - select(c("maxTol" = 7, "all_enty" = 8)) - - 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") - ) - - 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.") - ), - "
Iteration: ", data$iteration - ) - - limits <- surplus %>% - group_by(.data$type, .data$period, .data$iteration) %>% - mutate("withinLimits" = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% - ungroup() %>% - select("type", "period", "iteration", "maxTol", "withinLimits") %>% - distinct() %>% - mutate( - "rectXmin" = as.numeric(.data$iteration) - 0.5, - "rectXmax" = as.numeric(.data$iteration) + 0.5, - "tooltip" = paste0( - .data$type, - ifelse(.data$withinLimits == "no", - " outside tolerance limits.", - " within tolerance limits." - ) - ) - ) - - surplusColor <- c( - peoil = "#cc7500", - pegas = "#999959", - pecoal = "#0c0c0c", - peur = "#EF7676", - pebiolc = "#005900", - good = "#00BFC4" - ) - - 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, - fill = ~withinLimits, 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)) - - surplusConvergencePlotly <- ggplotly(surplusConvergence, tooltip = c("text")) %>% - hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) - - # Trade surplus summary ---- - - surplusCondition <- surplus %>% - group_by(.data$iteration) %>% - summarise(withinLimits = ifelse(all(.data$withinLimits == "yes"), "yes", "no")) %>% - mutate("tooltip" = paste0("Iteration: ", .data$iteration, "
Converged")) - - for (iter in surplusCondition$iteration) { - if (surplusCondition[which(surplusCondition$iteration == iter), ]$withinLimits == "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), ] - withinLimits <- ifelse(currSurplus$value > currSurplus$maxTol, - "no", ifelse(currSurplus$value < -currSurplus$maxTol, "no", "yes")) - if (withinLimits == "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, "
Not converged", - "
Period | Trade | Surplus", tooltip - ) - surplusCondition[which(surplusCondition$iteration == iter), ]$tooltip <- tooltip - } - } - - surplusSummary <- suppressWarnings(ggplot(surplusCondition, - aes_(x = ~iteration, y = "Max. Trade\nSurplus", - fill = ~withinLimits, 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("Max. Trade\nSurplus"), drop = FALSE) + - labs(x = NULL, y = NULL) - - surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) - subplots <- append(subplots, list(surplusSummaryPlotly)) - - # Price anticipation ---- - - cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip")) - p80FadeoutPriceAnticipIter <- readGDX(gdx, name = "p80_fadeoutPriceAnticip_iter", restore_zeros = FALSE) %>% - as.quitte() %>% - select("iteration", "fadeoutPriceAnticip" = "value") - - data <- p80FadeoutPriceAnticipIter %>% - mutate( - "iteration" := as.numeric(.data$iteration), - "converged" = ifelse(.data$fadeoutPriceAnticip > cmMaxFadeoutPriceAnticip, "no", "yes"), - "tooltip" = ifelse( - .data$converged == "yes", - paste0( - "Converged
Price Anticipation fade out is low enough
", - round(.data$fadeoutPriceAnticip, 5), " <= ", cmMaxFadeoutPriceAnticip - ), - paste0( - "Not converged
Price Anticipation fade out is not low enough
", - round(.data$fadeoutPriceAnticip, 5), " > ", cmMaxFadeoutPriceAnticip - ) - ) - ) - - priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + - geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, linewidth = aestethics$line$size) + - suppressWarnings(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)) - - priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) - subplots <- append(subplots, list(priceAnticipationPlotly)) - - # Tax Convergence (optional) ---- - - cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck")) - - p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE) %>% - as.quitte() %>% - select("region", "period", "iteration", "value") %>% - mutate("failed" = .data$value > 1e-4) - - data <- p80ConvNashTaxrevIter %>% - group_by(.data$iteration) %>% - summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>% - mutate("tooltip" = "Converged") - - for (i in unique(p80ConvNashTaxrevIter$iteration)) { - if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(p80ConvNashTaxrevIter, .data$iteration == i, .data$failed == TRUE) %>% - mutate("item" = paste0(.data$region, " ", .data$period)) %>% - select("region", "period", "item") %>% - distinct() - - if (nrow(tmp) > 10) { - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$region), collapse = ", "), - "
", - paste0(unique(tmp$period), collapse = ", ") - ) - } else { - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$item), collapse = ", ") - ) - } - } - } - - yLabel <- ifelse(cmTaxConvCheck == 0, "Tax Convergence\n(inactive)", "Tax Convergence") - - taxConvergence <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = yLabel, - fill = ~converged, 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(yLabel), drop = FALSE) + - labs(x = NULL, y = NULL) - - taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text")) - subplots <- append(subplots, list(taxConvergencePlotly)) - - # Emission Market Deviation (optional) ---- - - pmEmiMktTarget <- readGDX(gdx, name = "pm_emiMktTarget", react = "silent", restore_zeros = FALSE) - - if (!is.null(pmEmiMktTarget)) { - - pmEmiMktTargetDevIter <- suppressWarnings( - readGDX(gdx, name = "pm_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE) - ) - - cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance")) - - pmEmiMktTargetDevIter <- pmEmiMktTargetDevIter %>% - as.quitte() %>% - select("period", "iteration", "ext_regi", "emiMktExt", "value") %>% - mutate("converged" = .data$value <= cmEmiMktTargetTolerance) - - data <- pmEmiMktTargetDevIter %>% - group_by(.data$iteration) %>% - summarise(converged = ifelse(any(.data$converged == FALSE), "no", "yes")) %>% - mutate("tooltip" = "Converged") - - for (i in unique(pmEmiMktTargetDevIter$iteration)) { - if (data[data$iteration == i, "converged"] == "no") { - tmp <- filter(pmEmiMktTargetDevIter, .data$iteration == i, .data$converged == FALSE) %>% - mutate("item" = paste0(.data$ext_regi, " ", .data$period, " ", .data$emiMktExt)) %>% - select("ext_regi", "period", "emiMktExt", "item") %>% - distinct() - - if (nrow(tmp) > 10) { - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$ext_regi), collapse = ", "), - "
", - paste0(unique(tmp$period), collapse = ", "), - "
", - paste0(unique(tmp$emiMktExt), collapse = ", ") - ) - } else { - data[data$iteration == i, "tooltip"] <- paste0( - "Iteration ", i, " ", - "not converged:
", - paste0(unique(tmp$item), collapse = ", ") - ) - } - } - } - - emiMktTargetDev <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = "Emission Market\nTarget", - fill = ~converged, 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("Emission Market\nTarget"), drop = FALSE) + - labs(x = NULL, y = NULL) - - emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text")) - - subplots <- append(subplots, list(emiMktTargetDevPlotly)) - } - - # Implicit Quantity Target (optional) ---- - - pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE, - react = "silent") - - if (!is.null(pmImplicitQttyTarget)) { - - cmImplicitQttyTargetTolerance <- as.vector(readGDX(gdx, name = "cm_implicitQttyTarget_tolerance")) - - pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE) %>% - as.quitte() %>% - select("period", "ext_regi", "taxType", "qttyTarget", "qttyTargetGroup") - - pmImplicitQttyTargetIsLimited <- readGDX(gdx, name = "pm_implicitQttyTarget_isLimited") %>% - as.quitte() %>% - select("iteration", "qttyTarget", "qttyTargetGroup", "isLimited" = "value") - - p80ImplicitQttyTargetDevIter <- readGDX(gdx, name = "p80_implicitQttyTarget_dev_iter", restore_zeros = FALSE) %>% - as.quitte() %>% - select("period", "value", "iteration", "ext_regi", "qttyTarget", "qttyTargetGroup") %>% - left_join(pmImplicitQttyTarget, by = c("period", "ext_regi", "qttyTarget", "qttyTargetGroup")) %>% - left_join(pmImplicitQttyTargetIsLimited, by = c("iteration", "qttyTarget", "qttyTargetGroup")) %>% - mutate( - "failed" = - abs(.data$value) > cmImplicitQttyTargetTolerance & ( - !(ifelse(.data$taxType == "tax", .data$value < 0, FALSE)) | - ifelse(.data$taxType == "sub", .data$value > 0, FALSE) - ) & .data$isLimited != 1 - ) - - data <- p80ImplicitQttyTargetDevIter %>% - group_by(.data$iteration) %>% - summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>% - mutate("tooltip" = ifelse(.data$converged == "yes", "Converged", "Not converged")) - - qttyTarget <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = "Implicit Quantity\nTarget", - fill = ~converged, 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("Implicit Quantity\nTarget"), drop = FALSE) + - labs(x = NULL, y = NULL) - - qttyTargetPlotly <- ggplotly(qttyTarget, tooltip = c("text")) - subplots <- append(subplots, list(qttyTargetPlotly)) - - } - - # Global Bugdet Deviation (optional) ---- - - p80GlobalBudgetDevIter <- readGDX(gdx, name = "p80_globalBudget_dev_iter", restore_zeros = FALSE) %>% - as.quitte() %>% - select("value", "iteration") %>% - mutate("failed" = .data$value > 1.01 | .data$value < 0.99) - - data <- p80GlobalBudgetDevIter %>% - mutate( - "converged" = ifelse(.data$failed == TRUE, "no", "yes"), - "tooltip" = ifelse(.data$failed, "Not converged", "Converged") - ) - - globalBuget <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = "Global Budget\nDeviation", - fill = ~converged, 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("Global Budget\nDeviation"), drop = FALSE) + - labs(x = NULL, y = NULL) - - globalBugetPlotly <- ggplotly(globalBuget, tooltip = c("text")) - subplots <- append(subplots, list(globalBugetPlotly)) - - # Internalized Damages (optional) ---- - - module2realisation <- readGDX(gdx, name = "module2realisation") - if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] != "off") { - cmSccConvergence <- as.numeric(readGDX(gdx, name = "cm_sccConvergence", types = c("parameters"))) - cmTempConvergence <- as.numeric(readGDX(gdx, name = "cm_tempConvergence", types = c("parameters"))) - p80SccConvergenceMaxDeviationIter <- readGDX(gdx, name = "p80_sccConvergenceMaxDeviation_iter") %>% - as.quitte() %>% - select("iteration", "p80SccConvergenceMaxDeviationIter" = "value") %>% - mutate("iteration" := as.numeric(.data$iteration)) %>% - filter(.data$iteration <= lastIteration) - - p80GmtConvIter <- readGDX(gdx, name = "p80_gmt_conv_iter") %>% - as.quitte() %>% - select("iteration", "p80GmtConvIter" = "value") %>% - mutate("iteration" := as.numeric(.data$iteration)) %>% - filter(.data$iteration <= lastIteration) - - data <- left_join(p80SccConvergenceMaxDeviationIter, p80GmtConvIter, by = "iteration") %>% - mutate( - "converged" = ifelse(.data$p80SccConvergenceMaxDeviationIter > cmSccConvergence | - .data$p80GmtConvIter > cmTempConvergence, "no", "yes"), - "tooltip" = ifelse(.data$converged == "no", "Not converged", "Converged") - ) - - damageInternalization <- suppressWarnings(ggplot(data, aes_( - x = ~iteration, y = "Damage\nInternalization", - fill = ~converged, 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("Damage\nInternalization"), drop = FALSE) + - labs(x = NULL, y = NULL) - - damageInternalizationPlotly <- ggplotly(damageInternalization, tooltip = c("text")) - subplots <- append(subplots, list(damageInternalizationPlotly)) - - } - - - # Summary plot ---- - - out <- list() - - out$tradeDetailPlot <- surplusConvergencePlotly - - n <- length(subplots) - out$plot <- subplot( - subplots, - nrows = n, - heights = c(3 / (n + 3), rep(1 / (n + 3), 2), 2 / (n + 3), 1 / (n + 3), rep(1 / (n + 3), n - 5)), - shareX = TRUE, - titleX = FALSE - ) %>% - hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) - - return(out) -} diff --git a/man/mipConvergence.Rd b/man/mipConvergence.Rd deleted file mode 100644 index 3eb8916..0000000 --- a/man/mipConvergence.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mipConvergence.R -\name{mipConvergence} -\alias{mipConvergence} -\title{Create REMIND convergence overview} -\usage{ -mipConvergence(gdx) -} -\arguments{ -\item{gdx}{GDX file} -} -\description{ -Create REMIND convergence overview -} -\examples{ - - \dontrun{ - mipConvergence(gdx="fulldata.gdx") - } - -} -\author{ -Renato Rodrigues, Falk Benke -} From c9cb1929bf5e54742cf903498c5adb3ec6ebb415 Mon Sep 17 00:00:00 2001 From: Michaja Pehl Date: Fri, 1 Dec 2023 10:40:33 +0100 Subject: [PATCH 39/41] add plotstyle colours for steel production processess --- inst/extdata/plotstyle.csv | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/inst/extdata/plotstyle.csv b/inst/extdata/plotstyle.csv index 5a7326a..96d8636 100644 --- a/inst/extdata/plotstyle.csv +++ b/inst/extdata/plotstyle.csv @@ -714,3 +714,9 @@ Heat-only|Electric Boiler;Heat-only|Electric Boiler;#f58231;; Heat-only|Solar;Heat-only|Solar;#7f7f00;; Heat-only|Geothermal;Heat-only|Geothermal;#660000;; Cap|Stationary;EU ETS cap;#ff9800;; +BF-BOF; BF-BOF;#0c0c0c;; +BF-BOF-CCS; BF-BOF-CCS;#b2b2b2;; +DRI-NG-EAF; DRI-NG-EAF;#999959;; +DRI-NG-EAF-CCS; DRI-NG-EAF-CCS;#e5e5b2;; +DRI-H2-EAF; DRI-H2-EAF;#66cccc;; +SCRAP-EAF; SCRAP-EAF;#ffb200;; From d77079f21f69bcfffe827a17a32422bfb4ba6cae Mon Sep 17 00:00:00 2001 From: Michaja Pehl Date: Mon, 4 Dec 2023 12:52:45 +0100 Subject: [PATCH 40/41] lucoded hubbub --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index b8e025e..ad4077b 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28713820' +ValidationKey: '28951650' 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 a5c4248..5ba6247 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: 'mip: Comparison of multi-model runs' -version: 0.146.0 -date-released: '2023-11-06' +version: 0.147.0 +date-released: '2023-12-04' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 4d3ae84..79fd123 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: mip Title: Comparison of multi-model runs -Version: 0.146.0 -Date: 2023-11-06 +Version: 0.147.0 +Date: 2023-12-04 Authors@R: c( person("David", "Klein", , "dklein@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), diff --git a/README.md b/README.md index 851b17f..a6d923f 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Comparison of multi-model runs -R package **mip**, version **0.146.0** +R package **mip**, version **0.147.0** [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds) @@ -47,7 +47,7 @@ In case of questions / problems please contact David Klein , R package version 0.146.0, . +Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 , R package version 0.147.0, . A BibTeX entry for LaTeX users is @@ -56,7 +56,7 @@ A BibTeX entry for LaTeX users is title = {mip: Comparison of multi-model runs}, author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters}, year = {2023}, - note = {R package version 0.146.0}, + note = {R package version 0.147.0}, doi = {10.5281/zenodo.1158586}, url = {https://github.com/pik-piam/mip}, } From 59ecac72d50a5fd23b855e2d03b78cee057eff4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pascal=20F=C3=BChrlich?= <82826417+pfuehrlich-pik@users.noreply.github.com> Date: Tue, 16 Jan 2024 11:05:17 +0100 Subject: [PATCH 41/41] Update mip-package.R --- R/mip-package.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/mip-package.R b/R/mip-package.R index 43aafb1..01d621d 100644 --- a/R/mip-package.R +++ b/R/mip-package.R @@ -1,5 +1,3 @@ - - #' The MIP R package #' #' Contains the routines for plotting multi model and multi scenario comparisons @@ -10,8 +8,7 @@ #' #' @name mip-package #' @aliases mip-package mip -#' @docType package #' @author David Klein #' #' Maintainer: Anastasis Giannousakis -NULL +"_PACKAGE"