From acd33fdf8ee4074dd76698f716cf6a05e771b47f Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Wed, 3 Jan 2024 12:18:45 +0100 Subject: [PATCH 1/5] Add colored range for surplus tolerance in nash plots --- inst/markdown/nashAnalysis.Rmd | 130 ++++++++++++++++++++++++++++----- 1 file changed, 112 insertions(+), 18 deletions(-) diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index b2fe2b2e..6d4b551c 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -41,50 +41,78 @@ if (m2r[m2r$module == "optimization", "*"] != "nash") { adjustSliderAnimation <- function(p) { return(list(p[[1]] %>% plotly::animation_opts(frame = 1))) } + +mipIterationsSurplus <- function( + plotData, xAxis = "year", color = NULL, + slider = "iteration", facets = "region", facetScales = "fixed", rectData) { + + p <- mip::mipIterations(plotData, returnGgplots = TRUE, xAxis, color, slider, facets, facetScales)[[1]] + + p <- p + geom_rect(data = rectData, aes( + xmin = min(plotData[xAxis]), + xmax = max(plotData[xAxis]), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", alpha = 0.5, inherit.aes = FALSE) + + p <- plotly::ggplotly(p) %>% + plotly::animation_opts(frame = 1) %>% + hide_legend() + + htmltools::tagList(p) +} + ``` ## p80_surplus ### Read Data from gdx ```{r p80_surplus___READ} + p80_surplus <- mip::getPlotData("p80_surplus", params$gdx) %>% mutate(tall := as.numeric(tall)) str(p80_surplus) + +p80_surplusMaxTolerance <- mip::getPlotData("p80_surplusMaxTolerance", params$gdx) %>% + filter(all_enty %in% unique(p80_surplus[["all_enty"]])) + ``` ### x: time, slider: iter, facet: enty ```{r} -p <- mip::mipIterations( - plotData = p80_surplus, + +mipIterationsSurplus(plotData = p80_surplus, xAxis = "tall", facets = "all_enty", color = NULL, slider = "iteration", - facetScales = "free_y" -) %>% adjustSliderAnimation() + facetScales = "free_y", p80_surplusMaxTolerance) -htmltools::tagList(p) ``` ### x: iter, slider: time, facet: enty ```{r results = "asis"} -p <- mip::mipIterations( + +mipIterationsSurplus( plotData = filter(p80_surplus, tall >= 2025), # for this to work, we starting year must be available for all facets - xAxis = "iteration", slider = "tall", color = NULL, facets = "all_enty", facetScales = "free_y" -) %>% adjustSliderAnimation() + xAxis = "iteration", slider = "tall", color = NULL, facets = "all_enty", facetScales = "free_y", p80_surplusMaxTolerance +) -htmltools::tagList(p) ``` ### x: time, slider: iter, color: enty ```{r results = "asis"} + p <- mip::mipIterations( plotData = p80_surplus, xAxis = "tall", facets = NULL, color = "all_enty", slider = "iteration" ) %>% adjustSliderAnimation() htmltools::tagList(p) + ``` ### x: iter, facets: time ```{r results = "asis"} + p <- mip::mipIterations( plotData = filter(p80_surplus, tall >= 2025), returnGgplots = TRUE, @@ -92,6 +120,18 @@ p <- mip::mipIterations( ) for (i in p) { + + rectData <- p80_surplusMaxTolerance %>% + filter(all_enty == unique(i$data$all_enty)) + + i <- i + suppressWarnings( + geom_rect(data = rectData, aes( + xmin = 0, xmax = max(p80_surplus$iteration), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", alpha = 0.5, inherit.aes = FALSE)) + print(i) } @@ -256,18 +296,35 @@ prices_and_surplus_steps <- rbind( ```{r results = "asis"} for (v in unique(prices_and_surplus_steps$all_enty)) { + p <- mip::mipIterations( - plotData = filter(prices_and_surplus_steps, all_enty == v, tall >= 2005), returnGgplots = TRUE, - xAxis = "tall", facets = "group", color = "step", slider = "iteration", facetScales = "free_y" + plotData = filter(prices_and_surplus_steps, all_enty == v, tall >= 2005), + returnGgplots = TRUE, + xAxis = "tall", facets = "group", color = "step", + slider = "iteration", facetScales = "free_y" ) # manually override colors plots <- p[[1]] + ggplot2::scale_colour_manual(values = c("iter" = "#000066", "iter+1" = "#39418d", "iter+2" = "#7b8cba", "iter+3" = "#bdd7e7")) - plots <- list(plots) - plots <- lapply(plots, plotly::ggplotly) %>% adjustSliderAnimation() - + + # add surplus tolerance as background + dataRect <- filter(p80_surplusMaxTolerance, all_enty == v) %>% + mutate(group = "p80_surplus") + + plots <- plots + suppressWarnings( + geom_rect( + data = dataRect, + aes( + xmin = 2005, xmax = max(p80_surplus$tall), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2)) + + plots <- plotly::ggplotly(plots) %>% plotly::animation_opts(frame = 1) + print(htmltools::tagList(plots)) } @@ -281,13 +338,28 @@ df <- prices_and_surplus_steps %>% mutate("group" = paste0(.data$all_enty, "-", .data$group)) %>% select(-"all_enty") +dataRect <- p80_surplusMaxTolerance %>% + mutate("group" = paste0(.data$all_enty, "-p80_surplus")) %>% + filter(group %in% unique(df$group)) + p <- ggplot(df) + geom_line(aes_string(x = "tall", y = "value", color = "step", frame = "iteration")) + - facet_wrap("group", scales = "free_y",ncol = 2) + + facet_wrap("group", scales = "free_y", ncol = 2) + ggplot2::scale_color_manual( breaks = c("iter", "iter+1", "iter+2", "iter+3"), values = c("#000066", "#39418d", "#7b8cba", "#bdd7e7") ) + + suppressWarnings( + geom_rect( + data = dataRect, + aes( + xmin = min(df$tall), xmax = max(df$tall), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2 + ) + ) + theme_bw() + theme(strip.background = element_blank()) @@ -299,10 +371,32 @@ plotly::ggplotly(p, autosize = F, height = 800) %>% ### x: iter, slider: time, facet: var ```{r results = "asis"} for (v in unique(prices_and_surplus$all_enty)) { + dataRect <- p80_surplusMaxTolerance %>% + filter(all_enty == v) %>% + mutate(variable = "p80_surplus") + + df <- filter(prices_and_surplus, all_enty == v, tall >= 2025) + p <- mip::mipIterations( - plotData = filter(prices_and_surplus, all_enty == v, tall >= 2025), - xAxis = "iteration", facets = "variable", color = NULL, slider = "tall", facetScales = "free_y" - ) %>% adjustSliderAnimation() + df, + xAxis = "iteration", facets = "variable", color = NULL, + slider = "tall", facetScales = "free_y", returnGgplots = TRUE + )[[1]] + + suppressWarnings( + geom_rect( + data = dataRect, + aes( + xmin = min(df$iteration), xmax = max(df$iteration), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2 + ) + ) + + p <- plotly::ggplotly(p) %>% + plotly::animation_opts(frame = 1) + print(htmltools::tagList(p)) } From 6aa13d3db3f818ebfe7ed5ce5a72157c3f1b0fc3 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Thu, 18 Jan 2024 11:46:39 +0100 Subject: [PATCH 2/5] refactor plot for nash analysis --- DESCRIPTION | 1 + inst/markdown/nashAnalysis.Rmd | 145 ++++++++++++++++----------------- 2 files changed, 69 insertions(+), 77 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 28b810ce..0642b97b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -51,6 +51,7 @@ Imports: gdxrrw, ggplot2, gms, + gridExtra, htmltools, iamc, knitr, diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 6d4b551c..2db9d99a 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -17,8 +17,11 @@ params: library(knitr) library(dplyr) library(remind2) -library(ggplot2) library(plotly) +library(ggplot2) +library(gridExtra) +library(scales) +library(mip) knitr::opts_chunk$set( echo = FALSE, @@ -27,12 +30,10 @@ knitr::opts_chunk$set( message = params$message, warning = params$warning ) - ``` ## Setup ```{r} - m2r <- gdx::readGDX(params$gdx, "module2realisation", restore_zeros = FALSE) if (m2r[m2r$module == "optimization", "*"] != "nash") { print("Warning: this script only supports nash optimizations") @@ -45,9 +46,8 @@ adjustSliderAnimation <- function(p) { mipIterationsSurplus <- function( plotData, xAxis = "year", color = NULL, slider = "iteration", facets = "region", facetScales = "fixed", rectData) { - p <- mip::mipIterations(plotData, returnGgplots = TRUE, xAxis, color, slider, facets, facetScales)[[1]] - + p <- p + geom_rect(data = rectData, aes( xmin = min(plotData[xAxis]), xmax = max(plotData[xAxis]), @@ -55,64 +55,56 @@ mipIterationsSurplus <- function( ymax = p80_surplusMaxTolerance, text = all_enty ), fill = "#00BFC4", alpha = 0.5, inherit.aes = FALSE) - + p <- plotly::ggplotly(p) %>% plotly::animation_opts(frame = 1) %>% hide_legend() htmltools::tagList(p) } - ``` ## p80_surplus ### Read Data from gdx ```{r p80_surplus___READ} - p80_surplus <- mip::getPlotData("p80_surplus", params$gdx) %>% mutate(tall := as.numeric(tall)) str(p80_surplus) p80_surplusMaxTolerance <- mip::getPlotData("p80_surplusMaxTolerance", params$gdx) %>% filter(all_enty %in% unique(p80_surplus[["all_enty"]])) - ``` ### x: time, slider: iter, facet: enty ```{r} - -mipIterationsSurplus(plotData = p80_surplus, +mipIterationsSurplus( + plotData = p80_surplus, xAxis = "tall", facets = "all_enty", color = NULL, slider = "iteration", - facetScales = "free_y", p80_surplusMaxTolerance) - + facetScales = "free_y", p80_surplusMaxTolerance +) ``` ### x: iter, slider: time, facet: enty ```{r results = "asis"} - mipIterationsSurplus( plotData = filter(p80_surplus, tall >= 2025), # for this to work, we starting year must be available for all facets xAxis = "iteration", slider = "tall", color = NULL, facets = "all_enty", facetScales = "free_y", p80_surplusMaxTolerance ) - ``` ### x: time, slider: iter, color: enty ```{r results = "asis"} - p <- mip::mipIterations( plotData = p80_surplus, xAxis = "tall", facets = NULL, color = "all_enty", slider = "iteration" ) %>% adjustSliderAnimation() htmltools::tagList(p) - ``` ### x: iter, facets: time ```{r results = "asis"} - p <- mip::mipIterations( plotData = filter(p80_surplus, tall >= 2025), returnGgplots = TRUE, @@ -120,21 +112,20 @@ p <- mip::mipIterations( ) for (i in p) { - rectData <- p80_surplusMaxTolerance %>% - filter(all_enty == unique(i$data$all_enty)) - + filter(all_enty == unique(i$data$all_enty)) + i <- i + suppressWarnings( geom_rect(data = rectData, aes( - xmin = 0, xmax = max(p80_surplus$iteration), - ymin = p80_surplusMaxTolerance * -1, - ymax = p80_surplusMaxTolerance, - text = all_enty - ), fill = "#00BFC4", alpha = 0.5, inherit.aes = FALSE)) - + xmin = 0, xmax = max(p80_surplus$iteration), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", alpha = 0.5, inherit.aes = FALSE) + ) + print(i) } - ``` @@ -289,50 +280,49 @@ prices_and_surplus_steps <- rbind( ) %>% relocate(where(is.numeric), .after = last_col()) %>% select(-"variable") - ``` ### x: time, slider: iter, facet: var ```{r results = "asis"} - for (v in unique(prices_and_surplus_steps$all_enty)) { - p <- mip::mipIterations( - plotData = filter(prices_and_surplus_steps, all_enty == v, tall >= 2005), + plotData = filter(prices_and_surplus_steps, all_enty == v, tall >= 2005), returnGgplots = TRUE, - xAxis = "tall", facets = "group", color = "step", + xAxis = "tall", facets = "group", color = "step", slider = "iteration", facetScales = "free_y" ) # manually override colors plots <- p[[1]] + - ggplot2::scale_colour_manual(values = c("iter" = "#000066", "iter+1" = "#39418d", - "iter+2" = "#7b8cba", "iter+3" = "#bdd7e7")) - + ggplot2::scale_colour_manual(values = c( + "iter" = "#000066", "iter+1" = "#39418d", + "iter+2" = "#7b8cba", "iter+3" = "#bdd7e7" + )) + # add surplus tolerance as background - dataRect <- filter(p80_surplusMaxTolerance, all_enty == v) %>% + dataRect <- filter(p80_surplusMaxTolerance, all_enty == v) %>% mutate(group = "p80_surplus") - + plots <- plots + suppressWarnings( geom_rect( data = dataRect, aes( - xmin = 2005, xmax = max(p80_surplus$tall), - ymin = p80_surplusMaxTolerance * -1, - ymax = p80_surplusMaxTolerance, - text = all_enty - ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2)) - + xmin = 2005, xmax = max(p80_surplus$tall), + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, + text = all_enty + ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2 + ) + ) + plots <- plotly::ggplotly(plots) %>% plotly::animation_opts(frame = 1) - - print(htmltools::tagList(plots)) + print(htmltools::tagList(plots)) } ``` ### x: time, slider: iter, facet: var + all_enty ```{r results = "asis"} - df <- prices_and_surplus_steps %>% filter(.data$all_enty != "peur", .data$tall >= 2005) %>% mutate("group" = paste0(.data$all_enty, "-", .data$group)) %>% @@ -354,8 +344,8 @@ p <- ggplot(df) + data = dataRect, aes( xmin = min(df$tall), xmax = max(df$tall), - ymin = p80_surplusMaxTolerance * -1, - ymax = p80_surplusMaxTolerance, + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, text = all_enty ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2 ) @@ -363,9 +353,8 @@ p <- ggplot(df) + theme_bw() + theme(strip.background = element_blank()) -plotly::ggplotly(p, autosize = F, height = 800) %>% +plotly::ggplotly(p, autosize = FALSE, height = 800) %>% plotly::animation_opts(frame = 1) - ``` ### x: iter, slider: time, facet: var @@ -387,8 +376,8 @@ for (v in unique(prices_and_surplus$all_enty)) { data = dataRect, aes( xmin = min(df$iteration), xmax = max(df$iteration), - ymin = p80_surplusMaxTolerance * -1, - ymax = p80_surplusMaxTolerance, + ymin = p80_surplusMaxTolerance * -1, + ymax = p80_surplusMaxTolerance, text = all_enty ), fill = "#00BFC4", inherit.aes = FALSE, alpha = 0.2 ) @@ -403,37 +392,40 @@ for (v in unique(prices_and_surplus$all_enty)) { ``` ### x: iter, facet: time, color: var -```{r results = "asis", fig.width=12, fig.height=5} -prices_and_surplus_scaled <- left_join(p80_surplus, price_not_discounted_itr, + +```{r results = "asis", fig.width=12, fig.height=6} + +prices_and_surplus_scaled <- left_join( + p80_surplus, price_not_discounted_itr, by = c("tall" = "ttot", "all_enty", "iteration") ) %>% filter(!is.na(p80_pvp_itr_no_discount), tall >= 2025) -for (v in unique(prices_and_surplus_scaled$all_enty)) { - df <- prices_and_surplus_scaled %>% - filter(all_enty == v) +for (v in setdiff(unique(prices_and_surplus_scaled$all_enty), "good")) { + dfv <- prices_and_surplus_scaled %>% filter(all_enty == v) + plots <- list() - # scale factor per all_enty value - scale_factor <- round(select(df, "p80_surplus") %>% max() / - select(df, "p80_pvp_itr_no_discount") %>% max(), digits = 1) + for (t in unique(dfv$tall)) { + df <- filter(dfv, tall == t) - df <- df %>% - mutate(p80_pvp_itr_no_discount := p80_pvp_itr_no_discount * scale_factor) %>% - reshape2::melt(id.vars = c(1, 2, 3)) + secScaleDiff <- max(df$p80_pvp_itr_no_discount) - min(df$p80_pvp_itr_no_discount) + secScaleMin <- min(df$p80_pvp_itr_no_discount) - 0.05 * secScaleDiff + secScaleMax <- max(df$p80_pvp_itr_no_discount) + 0.05 * secScaleDiff - p <- mip::mipIterations( - plotData = df, returnGgplots = TRUE, - xAxis = "iteration", facets = "tall", color = "variable", slider = NULL, - facetScales = "free_y" - ) + p <- ggplot(df) + + geom_line(aes(x = iteration, y = p80_surplus), color = "#00BFC4") + + geom_line(aes(x = iteration, y = rescale(p80_pvp_itr_no_discount, to = c(min(p80_surplus), max(p80_surplus)))), color = "#F8766D") + + scale_y_continuous("", sec.axis = sec_axis(~ rescale(., to = c(secScaleMin, secScaleMax)), name = "")) + + theme(axis.title.x = element_blank(), plot.title = element_text(size = 7)) + + ggtitle(t) + + plots <- append(plots, list(p)) + } + + do.call("grid.arrange", c(plots, ncol = 4, top = v)) + cat('primary y-axis: p80_surplus
') + cat('secondary y-axis: p80_pvp_itr_no_discount') - lapply(p, function(plot) { - plot <- plot + - ggplot2::scale_y_continuous("p80_surplus", sec.axis = - ggplot2::sec_axis(~ . / scale_factor, name = "p80_pvp_itr_no_discount")) + - theme(legend.position = "bottom") - print(plot) - }) } ``` @@ -509,7 +501,6 @@ plots <- mip::mipIterations( ) plots[[1]] - ``` ### p80_DevPriceAnticipReg From e1dc041b71b22451d87f4b018f6a9b93ce16fba1 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 19 Jan 2024 15:00:38 +0100 Subject: [PATCH 3/5] add price anticipation deviation criterion to convergence plot --- .buildlibrary | 2 +- CITATION.cff | 4 +- DESCRIPTION | 7 +- R/plotNashConvergence.R | 193 +++++++++++++++++++-------------- README.md | 6 +- inst/markdown/nashAnalysis.Rmd | 21 ++-- man/remind2-package.Rd | 44 ++++++++ 7 files changed, 179 insertions(+), 98 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 7b548e7b..4d70ade8 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '222856062' +ValidationKey: '222943560' 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 dbb36836..c2a1f2fc 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'remind2: The REMIND R package (2nd generation)' -version: 1.129.3 -date-released: '2024-01-12' +version: 1.129.4 +date-released: '2024-01-18' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 0642b97b..8a531a3f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) -Version: 1.129.3 -Date: 2024-01-12 +Version: 1.129.4 +Date: 2024-01-18 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), person("Lavinia", "Baumstark", role = "aut"), @@ -51,7 +51,6 @@ Imports: gdxrrw, ggplot2, gms, - gridExtra, htmltools, iamc, knitr, @@ -89,6 +88,6 @@ Suggests: VignetteBuilder: knitr Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.0 Config/testthat/parallel: true Config/testthat/edition: 3 diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R index d00cf6b7..ed1d5516 100644 --- a/R/plotNashConvergence.R +++ b/R/plotNashConvergence.R @@ -296,33 +296,26 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter surplusSummaryPlotly <- ggplotly(surplusSummary, tooltip = c("text")) subplots <- append(subplots, list(surplusSummaryPlotly)) - # Price anticipation ---- + # Deviation due to price anticipation ---- - cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip", react = "error")) - p80FadeoutPriceAnticipIter <- readGDX(gdx, name = "p80_fadeoutPriceAnticip_iter", - restore_zeros = FALSE, react = "error") %>% - as.quitte() %>% - select("iteration", "fadeoutPriceAnticip" = "value") + maxTolerance <- readGDX(gdx, + name = "p80_surplusMaxTolerance", + restore_zeros = FALSE, react = "error" + )[, , "good"] %>% + as.numeric() - data <- p80FadeoutPriceAnticipIter %>% + data <- readGDX(gdx, name = "p80_DevPriceAnticipGlobAllMax2100Iter", + restore_zeros = FALSE, react = "error") %>% + as.quitte() %>% + select("iteration", "value") %>% 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 - ) - ) + "converged" = ifelse(.data$value > 0.1 * maxTolerance, "no", "yes"), + "text" = "hallo" ) - priceAnticipation <- ggplot(data, aes_(x = ~iteration)) + - geom_line(aes_(y = ~fadeoutPriceAnticip), alpha = 0.3, linewidth = aestethics$line$size) + + + priceAnticipationDeviation <- ggplot(data, aes_(x = ~iteration)) + suppressWarnings(geom_point( size = 2, aes_(y = 0.0001, fill = ~converged, text = ~tooltip), @@ -330,68 +323,13 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter )) + theme_minimal() + scale_fill_manual(values = booleanColor) + - scale_y_continuous(breaks = c(0.0001), labels = c("Price\nAnticipation")) + + scale_y_continuous(breaks = c(0.0001), labels = c("Price Anticipation\nDeviation")) + 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", react = "error")) - - p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE, react = "error") %>% - as.quitte() %>% - select("region", "period", "iteration", "value") %>% - mutate("failed" = abs(.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)) + priceAnticipationDeviation <- ggplotly(priceAnticipationDeviation, tooltip = c("text")) + subplots <- append(subplots, list(priceAnticipationDeviation)) # Emission Market Deviation (optional) ---- @@ -580,9 +518,104 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter damageInternalizationPlotly <- ggplotly(damageInternalization, tooltip = c("text")) subplots <- append(subplots, list(damageInternalizationPlotly)) + } + + # Tax Convergence (optional) ---- + + cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck", react = "error")) + + p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE, react = "error") %>% + as.quitte() %>% + select("region", "period", "iteration", "value") %>% + mutate("failed" = abs(.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)) + + # Price anticipation (optional) ---- + + cmMaxFadeoutPriceAnticip <- as.vector(readGDX(gdx, name = "cm_maxFadeoutPriceAnticip", react = "error")) + p80FadeoutPriceAnticipIter <- readGDX(gdx, name = "p80_fadeoutPriceAnticip_iter", + restore_zeros = FALSE, react = "error") %>% + 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 (inactive)")) + + 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)) # Summary plot ---- @@ -594,7 +627,7 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter 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)), + heights = c(2 / (n + 1), rep(1 / (n + 1), n - 1)), shareX = TRUE, titleX = FALSE ) %>% diff --git a/README.md b/README.md index 7bac9b32..326f5138 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The REMIND R package (2nd generation) -R package **remind2**, version **1.129.3** +R package **remind2**, version **1.129.4** [![CRAN status](https://www.r-pkg.org/badges/version/remind2)](https://cran.r-project.org/package=remind2) [![R build status](https://github.com/pik-piam/remind2/workflows/check/badge.svg)](https://github.com/pik-piam/remind2/actions) [![codecov](https://codecov.io/gh/pik-piam/remind2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/remind2) [![r-universe](https://pik-piam.r-universe.dev/badges/remind2)](https://pik-piam.r-universe.dev/builds) @@ -49,7 +49,7 @@ In case of questions / problems please contact Renato Rodrigues . +Rodrigues R, Baumstark L, Benke F, Dietrich J, Dirnaichner A, Führlich P, Giannousakis A, Hasse R, Hilaire J, Klein D, Koch J, Kowalczyk K, Levesque A, Malik A, Merfort A, Merfort L, Morena-Leiva S, Pehl M, Pietzcker R, Rauner S, Richters O, Rottoli M, Schötz C, Schreyer F, Siala K, Sörgel B, Spahr M, Strefler J, Verpoort P, Weigmann P (2024). _remind2: The REMIND R package (2nd generation)_. R package version 1.129.4, . A BibTeX entry for LaTeX users is @@ -58,7 +58,7 @@ A BibTeX entry for LaTeX users is title = {remind2: The REMIND R package (2nd generation)}, author = {Renato Rodrigues and Lavinia Baumstark and Falk Benke and Jan Philipp Dietrich and Alois Dirnaichner and Pascal Führlich and Anastasis Giannousakis and Robin Hasse and Jérome Hilaire and David Klein and Johannes Koch and Katarzyna Kowalczyk and Antoine Levesque and Aman Malik and Anne Merfort and Leon Merfort and Simón Morena-Leiva and Michaja Pehl and Robert Pietzcker and Sebastian Rauner and Oliver Richters and Marianna Rottoli and Christof Schötz and Felix Schreyer and Kais Siala and Björn Sörgel and Mike Spahr and Jessica Strefler and Philipp Verpoort and Pascal Weigmann}, year = {2024}, - note = {R package version 1.129.3}, + note = {R package version 1.129.4}, url = {https://github.com/pik-piam/remind2}, } ``` diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 2db9d99a..75867933 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -6,7 +6,7 @@ output: toc_float: true code_folding: hide params: - gdx: "fulldata.gdx" + gdx: "/home/benke/dev/pik-piam/miptemplate/SSP2EU-EU21-NDC_2023-11-01_19.58.36/fulldata.gdx" warning: false message: false figWidth: 8 @@ -14,21 +14,26 @@ params: ```{r loading_libraries, include=FALSE} -library(knitr) + library(dplyr) -library(remind2) -library(plotly) library(ggplot2) library(gridExtra) -library(scales) +library(knitr) library(mip) +library(plotly) +library(remind2) +library(scales) +library(svglite) knitr::opts_chunk$set( echo = FALSE, error = TRUE, fig.width = params$figWidth, message = params$message, - warning = params$warning + warning = params$warning, + dev = "svglite", + fix.ext = ".svg", + dpi = 100 ) ``` @@ -430,8 +435,8 @@ for (v in setdiff(unique(prices_and_surplus_scaled$all_enty), "good")) { ``` ## Convergence Plots -```{r results = "asis"} -diag <- remind2::plotNashConvergence(gdx = params$gdx) +```{r results = "asis", fig.width=12, fig.height=6} +diag <- plotNashConvergence(gdx = params$gdx) htmltools::tagList(diag$plot) htmltools::tagList(diag$tradeDetailPlot) ``` diff --git a/man/remind2-package.Rd b/man/remind2-package.Rd index 0d429646..1fa7c63d 100644 --- a/man/remind2-package.Rd +++ b/man/remind2-package.Rd @@ -8,3 +8,47 @@ \description{ Contains the REMIND-specific routines for data and model output manipulation. } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/pik-piam/remind2} +} + +} +\author{ +\strong{Maintainer}: Renato Rodrigues \email{renato.rodrigues@pik-potsdam.de} + +Authors: +\itemize{ + \item Lavinia Baumstark + \item Falk Benke + \item Jan Philipp Dietrich + \item Alois Dirnaichner + \item Pascal Führlich + \item Anastasis Giannousakis + \item Robin Hasse + \item Jérome Hilaire + \item David Klein + \item Johannes Koch + \item Katarzyna Kowalczyk + \item Antoine Levesque + \item Aman Malik + \item Anne Merfort + \item Leon Merfort + \item Simón Morena-Leiva + \item Michaja Pehl + \item Robert Pietzcker + \item Sebastian Rauner + \item Oliver Richters + \item Marianna Rottoli + \item Christof Schötz + \item Felix Schreyer + \item Kais Siala + \item Björn Sörgel + \item Mike Spahr + \item Jessica Strefler + \item Philipp Verpoort + \item Pascal Weigmann +} + +} From dd11e752397369f2009282cdfcd4454759a7dedf Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 19 Jan 2024 15:19:35 +0100 Subject: [PATCH 4/5] increment version --- .buildlibrary | 2 +- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- README.md | 6 +++--- inst/markdown/nashAnalysis.Rmd | 2 +- man/remind2-package.Rd | 1 - 6 files changed, 9 insertions(+), 10 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 4d70ade8..f6b11e4d 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '222943560' +ValidationKey: '222974595' 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 c2a1f2fc..47adef5c 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'remind2: The REMIND R package (2nd generation)' -version: 1.129.4 -date-released: '2024-01-18' +version: 1.129.5 +date-released: '2024-01-19' abstract: Contains the REMIND-specific routines for data and model output manipulation. authors: - family-names: Rodrigues diff --git a/DESCRIPTION b/DESCRIPTION index 8a531a3f..455801d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: remind2 Title: The REMIND R package (2nd generation) -Version: 1.129.4 -Date: 2024-01-18 +Version: 1.129.5 +Date: 2024-01-19 Authors@R: c( person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")), person("Lavinia", "Baumstark", role = "aut"), diff --git a/README.md b/README.md index 9b14e758..3c59015b 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # The REMIND R package (2nd generation) -R package **remind2**, version **1.129.4** +R package **remind2**, version **1.129.5** [![CRAN status](https://www.r-pkg.org/badges/version/remind2)](https://cran.r-project.org/package=remind2) [![R build status](https://github.com/pik-piam/remind2/workflows/check/badge.svg)](https://github.com/pik-piam/remind2/actions) [![codecov](https://codecov.io/gh/pik-piam/remind2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/remind2) [![r-universe](https://pik-piam.r-universe.dev/badges/remind2)](https://pik-piam.r-universe.dev/builds) @@ -49,7 +49,7 @@ In case of questions / problems please contact Renato Rodrigues . +Rodrigues R, Baumstark L, Benke F, Dietrich J, Dirnaichner A, Führlich P, Giannousakis A, Hasse R, Hilaire J, Klein D, Koch J, Kowalczyk K, Levesque A, Malik A, Merfort A, Merfort L, Morena-Leiva S, Pehl M, Pietzcker R, Rauner S, Richters O, Rottoli M, Schötz C, Schreyer F, Siala K, Sörgel B, Spahr M, Strefler J, Verpoort P, Weigmann P (2024). _remind2: The REMIND R package (2nd generation)_. R package version 1.129.5, . A BibTeX entry for LaTeX users is @@ -58,7 +58,7 @@ A BibTeX entry for LaTeX users is title = {remind2: The REMIND R package (2nd generation)}, author = {Renato Rodrigues and Lavinia Baumstark and Falk Benke and Jan Philipp Dietrich and Alois Dirnaichner and Pascal Führlich and Anastasis Giannousakis and Robin Hasse and Jérome Hilaire and David Klein and Johannes Koch and Katarzyna Kowalczyk and Antoine Levesque and Aman Malik and Anne Merfort and Leon Merfort and Simón Morena-Leiva and Michaja Pehl and Robert Pietzcker and Sebastian Rauner and Oliver Richters and Marianna Rottoli and Christof Schötz and Felix Schreyer and Kais Siala and Björn Sörgel and Mike Spahr and Jessica Strefler and Philipp Verpoort and Pascal Weigmann}, year = {2024}, - note = {R package version 1.129.4}, + note = {R package version 1.129.5}, url = {https://github.com/pik-piam/remind2}, } ``` diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 75867933..9b78692f 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -6,7 +6,7 @@ output: toc_float: true code_folding: hide params: - gdx: "/home/benke/dev/pik-piam/miptemplate/SSP2EU-EU21-NDC_2023-11-01_19.58.36/fulldata.gdx" + gdx: "fulldata.gdx" warning: false message: false figWidth: 8 diff --git a/man/remind2-package.Rd b/man/remind2-package.Rd index 2fb25f61..1fa7c63d 100644 --- a/man/remind2-package.Rd +++ b/man/remind2-package.Rd @@ -3,7 +3,6 @@ \docType{package} \name{remind2-package} \alias{remind2-package} -\alias{_PACKAGE} \alias{remind2} \title{The REMIND R package (2nd generation)} \description{ From 35f3ac4faa1e657446f1d14fed7f46d1a648efd3 Mon Sep 17 00:00:00 2001 From: Falk Benke Date: Fri, 19 Jan 2024 16:43:45 +0100 Subject: [PATCH 5/5] correct tooltip in convergence plot --- R/plotNashConvergence.R | 15 +++++++++++---- inst/markdown/nashAnalysis.Rmd | 2 +- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R index ed1d5516..3f9da363 100644 --- a/R/plotNashConvergence.R +++ b/R/plotNashConvergence.R @@ -304,17 +304,24 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter )[, , "good"] %>% as.numeric() - data <- readGDX(gdx, name = "p80_DevPriceAnticipGlobAllMax2100Iter", - restore_zeros = FALSE, react = "error") %>% + data <- readGDX(gdx, + name = "p80_DevPriceAnticipGlobAllMax2100Iter", + restore_zeros = FALSE, react = "error" + ) %>% as.quitte() %>% select("iteration", "value") %>% mutate( "iteration" := as.numeric(.data$iteration), "converged" = ifelse(.data$value > 0.1 * maxTolerance, "no", "yes"), - "text" = "hallo" + "tooltip" = ifelse(.data$value > 0.1 * maxTolerance, + paste0( + "Not converged
Price Anticipation deviation is not low enough
", + round(.data$value, 5), " > ", 0.1 * maxTolerance + ), + "Converged" + ), ) - priceAnticipationDeviation <- ggplot(data, aes_(x = ~iteration)) + suppressWarnings(geom_point( size = 2, diff --git a/inst/markdown/nashAnalysis.Rmd b/inst/markdown/nashAnalysis.Rmd index 9b78692f..6fa82516 100644 --- a/inst/markdown/nashAnalysis.Rmd +++ b/inst/markdown/nashAnalysis.Rmd @@ -435,7 +435,7 @@ for (v in setdiff(unique(prices_and_surplus_scaled$all_enty), "good")) { ``` ## Convergence Plots -```{r results = "asis", fig.width=12, fig.height=6} +```{r results = "asis", fig.height=10} diag <- plotNashConvergence(gdx = params$gdx) htmltools::tagList(diag$plot) htmltools::tagList(diag$tradeDetailPlot)