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 +} + +}