diff --git a/.buildlibrary b/.buildlibrary index 55016cb..b8e025e 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '28614768' +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 183724d..a5c4248 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-06' abstract: Package contains generic functions to produce comparison plots of multi-model runs. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 6d134f7..4d3ae84 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-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 0f7a0b8..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) @@ -53,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_) @@ -74,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) @@ -95,7 +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_discrete) importFrom(ggplot2,scale_y_log10) importFrom(ggplot2,stat_summary) importFrom(ggplot2,theme) @@ -131,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) @@ -193,7 +187,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/R/mipConvergence.R b/R/mipConvergence.R deleted file mode 100644 index 41b6ec3..0000000 --- a/R/mipConvergence.R +++ /dev/null @@ -1,349 +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 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)) { - 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))) { - 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) - ) - - 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, - 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 = 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) - - - 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")) %>% - 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() %>% - 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) - - 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) - - 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)) - - priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text")) - - # Summary plot ---- - - out <- list() - - out$plot <- subplot( - 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) - ) %>% - hide_legend() %>% - config(displayModeBar = FALSE, displaylogo = FALSE) %>% - layout(margin = list(l = -100, r = 10)) - - out$tradeDetailPlot <- surplusConvergencePlotly - - return(out) -} 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}, } 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 -}