diff --git a/.buildlibrary b/.buildlibrary
index fbac4820..3fcd1617 100644
--- a/.buildlibrary
+++ b/.buildlibrary
@@ -1,4 +1,4 @@
-ValidationKey: '220891308'
+ValidationKey: '220922208'
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 bf145041..4ffb5886 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.123.1
-date-released: '2023-11-07'
+version: 1.123.2
+date-released: '2023-11-08'
abstract: Contains the REMIND-specific routines for data and model output manipulation.
authors:
- family-names: Rodrigues
diff --git a/DESCRIPTION b/DESCRIPTION
index e621d989..499a113d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,8 +1,8 @@
Type: Package
Package: remind2
Title: The REMIND R package (2nd generation)
-Version: 1.123.1
-Date: 2023-11-07
+Version: 1.123.2
+Date: 2023-11-08
Authors@R: c(
person("Renato", "Rodrigues", , "renato.rodrigues@pik-potsdam.de", role = c("aut", "cre")),
person("Lavinia", "Baumstark", role = "aut"),
diff --git a/R/plotNashConvergence.R b/R/plotNashConvergence.R
index 1597e1ec..41497ba9 100644
--- a/R/plotNashConvergence.R
+++ b/R/plotNashConvergence.R
@@ -19,428 +19,356 @@
#' @export
plotNashConvergence <- 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]]
+ .generatePlots <- function(gdx) {
- if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) {
- warning("Run failed - Check code, pre-triangular infes ...")
- return(list())
- }
+ lastIteration <- readGDX(gdx, name = "o_iterationNumber", react = "error")[[1]]
- aestethics <- list(
- "alpha" = 0.6,
- "line" = list("size" = 2 / 3.78),
- "point" = list("size" = 2 / 3.78)
- )
+ aestethics <- list(
+ "alpha" = 0.6,
+ "line" = list("size" = 2 / 3.78),
+ "point" = list("size" = 2 / 3.78)
+ )
- booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D")
+ booleanColor <- c("yes" = "#00BFC4", "no" = "#F8766D")
- subplots <- list()
+ subplots <- list()
- # Feasibility -----
+ # 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"
+ p80RepyIteration <- readGDX(gdx, name = "p80_repy_iteration", restore_zeros = FALSE, react = "error") %>%
+ 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)
+ 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", react = "error") %>%
+ 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, react = "error") %>%
+ 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")
)
- ) %>%
- 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)
+ for (iter in unique(data$iteration)) {
+ current <- filter(p80RepyIteration, .data$iteration == iter)
- if (!all(current$objvalCondition)) {
- tooltip <- NULL
- current <- filter(current, .data$objvalCondition == FALSE)
+ 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))
+ 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
}
- 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"
- )
- )
+ 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)
- p80SurplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE) %>%
- as.quitte() %>%
- select(c("maxTol" = 7, "all_enty" = 8))
+ objVarSummaryPlotly <- ggplotly(objVarSummary, tooltip = c("text"))
+ subplots <- append(subplots, list(objVarSummaryPlotly))
- 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
+ # Trade goods surplus detail ----
- 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."
+ surplus <- readGDX(gdx, name = "p80_surplusMax_iter", restore_zeros = FALSE, react = "error")[, 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"
)
)
- )
- surplusColor <- c(
- peoil = "#cc7500",
- pegas = "#999959",
- pecoal = "#0c0c0c",
- peur = "#EF7676",
- pebiolc = "#005900",
- good = "#00BFC4"
- )
+ p80SurplusMaxTolerance <- readGDX(gdx, name = "p80_surplusMaxTolerance", restore_zeros = FALSE, react = "error") %>%
+ as.quitte() %>%
+ select(c("maxTol" = 7, "all_enty" = 8))
- 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
+ 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")
)
- 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
+ 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(
- "Not converged
Price Anticipation fade out is not low enough
",
- round(.data$fadeoutPriceAnticip, 5), " > ", cmMaxFadeoutPriceAnticip
+ 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"
)
- 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" = 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 = ", ")
+ 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
}
}
- }
- yLabel <- ifelse(cmTaxConvCheck == 0, "Tax Convergence\n(inactive)", "Tax Convergence")
+ 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))
- 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)
+ # Price anticipation ----
- taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text"))
- subplots <- append(subplots, list(taxConvergencePlotly))
+ 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")
- # Emission Market Deviation (optional) ----
+ 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
+ )
+ )
+ )
- pmEmiMktTarget <- readGDX(gdx, name = "pm_emiMktTarget", react = "silent", restore_zeros = FALSE)
+ 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))
- if (!is.null(pmEmiMktTarget)) {
+ priceAnticipationPlotly <- ggplotly(priceAnticipation, tooltip = c("text"))
+ subplots <- append(subplots, list(priceAnticipationPlotly))
- pmEmiMktTargetDevIter <- suppressWarnings(
- readGDX(gdx, name = "pm_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE)
- )
+ # Tax Convergence (optional) ----
- cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance"))
+ cmTaxConvCheck <- as.vector(readGDX(gdx, name = "cm_TaxConvCheck", react = "error"))
- pmEmiMktTargetDevIter <- pmEmiMktTargetDevIter %>%
+ p80ConvNashTaxrevIter <- readGDX(gdx, name = "p80_convNashTaxrev_iter", restore_zeros = FALSE, react = "error") %>%
as.quitte() %>%
- select("period", "iteration", "ext_regi", "emiMktExt", "value") %>%
- mutate("converged" = .data$value <= cmEmiMktTargetTolerance)
+ select("region", "period", "iteration", "value") %>%
+ mutate("failed" = abs(.data$value) > 1e-4)
- data <- pmEmiMktTargetDevIter %>%
+ 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(pmEmiMktTargetDevIter$iteration)) {
+ for (i in unique(p80ConvNashTaxrevIter$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") %>%
+ 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$ext_regi), collapse = ", "),
- "
",
- paste0(unique(tmp$period), collapse = ", "),
+ paste0(unique(tmp$region), collapse = ", "),
"
",
- paste0(unique(tmp$emiMktExt), collapse = ", ")
+ paste0(unique(tmp$period), collapse = ", ")
)
} else {
data[data$iteration == i, "tooltip"] <- paste0(
@@ -452,158 +380,256 @@ plotNashConvergence <- function(gdx) { # nolint cyclocomp_linter
}
}
- emiMktTargetDev <- suppressWarnings(ggplot(data, aes_(
- x = ~iteration, y = "Emission Market\nTarget",
+ 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("Emission Market\nTarget"), drop = FALSE) +
+ scale_y_discrete(breaks = c(yLabel), drop = FALSE) +
labs(x = NULL, y = NULL)
- emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text"))
+ taxConvergencePlotly <- ggplotly(taxConvergence, tooltip = c("text"))
+ subplots <- append(subplots, list(taxConvergencePlotly))
- subplots <- append(subplots, list(emiMktTargetDevPlotly))
- }
+ # Emission Market Deviation (optional) ----
- # Implicit Quantity Target (optional) ----
+ pmEmiMktTarget <- readGDX(gdx, name = "pm_emiMktTarget", react = "silent", restore_zeros = FALSE)
- pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE,
- react = "silent")
+ if (!is.null(pmEmiMktTarget)) {
- if (!is.null(pmImplicitQttyTarget)) {
+ pmEmiMktTargetDevIter <- suppressWarnings(
+ readGDX(gdx, name = "pm_emiMktTarget_dev_iter", react = "silent", restore_zeros = FALSE)
+ )
- cmImplicitQttyTargetTolerance <- as.vector(readGDX(gdx, name = "cm_implicitQttyTarget_tolerance"))
+ cmEmiMktTargetTolerance <- as.vector(readGDX(gdx, name = "cm_emiMktTarget_tolerance", react = "error"))
+
+ 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 = ", ")
+ )
+ }
+ }
+ }
- pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE) %>%
- as.quitte() %>%
- select("period", "ext_regi", "taxType", "qttyTarget", "qttyTargetGroup")
+ 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)
- pmImplicitQttyTargetIsLimited <- readGDX(gdx, name = "pm_implicitQttyTarget_isLimited") %>%
- as.quitte() %>%
- select("iteration", "qttyTarget", "qttyTargetGroup", "isLimited" = "value")
+ emiMktTargetDevPlotly <- ggplotly(emiMktTargetDev, tooltip = c("text"))
- 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
- )
+ subplots <- append(subplots, list(emiMktTargetDevPlotly))
+ }
- data <- p80ImplicitQttyTargetDevIter %>%
- group_by(.data$iteration) %>%
- summarise(converged = ifelse(any(.data$failed == TRUE), "no", "yes")) %>%
- mutate("tooltip" = ifelse(.data$converged == "yes", "Converged", "Not converged"))
+ # Implicit Quantity Target (optional) ----
- 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)
+ pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE,
+ react = "silent")
- qttyTargetPlotly <- ggplotly(qttyTarget, tooltip = c("text"))
- subplots <- append(subplots, list(qttyTargetPlotly))
+ if (!is.null(pmImplicitQttyTarget)) {
- }
+ cmImplicitQttyTargetTolerance <- as.vector(readGDX(gdx, name = "cm_implicitQttyTarget_tolerance",
+ react = "error"))
- # Global Bugdet Deviation (optional) ----
+ pmImplicitQttyTarget <- readGDX(gdx, name = "pm_implicitQttyTarget", restore_zeros = FALSE, react = "error") %>%
+ as.quitte() %>%
+ select("period", "ext_regi", "taxType", "qttyTarget", "qttyTargetGroup")
- 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)
+ pmImplicitQttyTargetIsLimited <- readGDX(gdx, name = "pm_implicitQttyTarget_isLimited", react = "error") %>%
+ as.quitte() %>%
+ select("iteration", "qttyTarget", "qttyTargetGroup", "isLimited" = "value")
- data <- p80GlobalBudgetDevIter %>%
- mutate(
- "converged" = ifelse(.data$failed == TRUE, "no", "yes"),
- "tooltip" = ifelse(.data$failed, "Not converged", "Converged")
- )
+ p80ImplicitQttyTargetDevIter <- readGDX(gdx, name = "p80_implicitQttyTarget_dev_iter",
+ restore_zeros = FALSE, react = "error") %>%
+ 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
+ )
- 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)
+ 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))
- p80GmtConvIter <- readGDX(gdx, name = "p80_gmt_conv_iter") %>%
+ }
+
+ # Global Bugdet Deviation (optional) ----
+
+ p80GlobalBudgetDevIter <- readGDX(gdx, name = "p80_globalBudget_dev_iter",
+ restore_zeros = FALSE, react = "error") %>%
as.quitte() %>%
- select("iteration", "p80GmtConvIter" = "value") %>%
- mutate("iteration" := as.numeric(.data$iteration)) %>%
- filter(.data$iteration <= lastIteration)
+ select("value", "iteration") %>%
+ mutate("failed" = .data$value > 1.01 | .data$value < 0.99)
- data <- left_join(p80SccConvergenceMaxDeviationIter, p80GmtConvIter, by = "iteration") %>%
+ data <- p80GlobalBudgetDevIter %>%
mutate(
- "converged" = ifelse(.data$p80SccConvergenceMaxDeviationIter > cmSccConvergence |
- .data$p80GmtConvIter > cmTempConvergence, "no", "yes"),
- "tooltip" = ifelse(.data$converged == "no", "Not converged", "Converged")
+ "converged" = ifelse(.data$failed == TRUE, "no", "yes"),
+ "tooltip" = ifelse(.data$failed, "Not converged", "Converged")
)
- damageInternalization <- suppressWarnings(ggplot(data, aes_(
- x = ~iteration, y = "Damage\nInternalization",
+ 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("Damage\nInternalization"), drop = FALSE) +
+ scale_y_discrete(breaks = c("Global Budget\nDeviation"), drop = FALSE) +
labs(x = NULL, y = NULL)
- damageInternalizationPlotly <- ggplotly(damageInternalization, tooltip = c("text"))
- subplots <- append(subplots, list(damageInternalizationPlotly))
+ globalBugetPlotly <- ggplotly(globalBuget, tooltip = c("text"))
+ subplots <- append(subplots, list(globalBugetPlotly))
+
+ # Internalized Damages (optional) ----
+
+ module2realisation <- readGDX(gdx, name = "module2realisation", react = "error")
+ if (module2realisation[module2realisation$modules == "internalizeDamages", ][, 2] != "off") {
+ cmSccConvergence <- as.numeric(readGDX(gdx, name = "cm_sccConvergence",
+ types = c("parameters"), react = "error"))
+ cmTempConvergence <- as.numeric(readGDX(gdx, name = "cm_tempConvergence",
+ types = c("parameters"), react = "error"))
+ p80SccConvergenceMaxDeviationIter <- readGDX(gdx, name = "p80_sccConvergenceMaxDeviation_iter",
+ react = "error") %>%
+ as.quitte() %>%
+ select("iteration", "p80SccConvergenceMaxDeviationIter" = "value") %>%
+ mutate("iteration" := as.numeric(.data$iteration)) %>%
+ filter(.data$iteration <= lastIteration)
+
+ p80GmtConvIter <- readGDX(gdx, name = "p80_gmt_conv_iter", react = "error") %>%
+ 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()
- # Summary plot ----
+ 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)
- out <- list()
+ return(out)
+ }
- out$tradeDetailPlot <- surplusConvergencePlotly
+ if (!file.exists(gdx)) {
+ warning("gdx file not found!")
+ return(list())
+ }
- 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)
+ modelstat <- readGDX(gdx, name = "o_modelstat", react = "error")[[1]]
+
+ if (!(modelstat %in% c(1, 2, 3, 4, 5, 6, 7))) {
+ warning("Run failed - Check code, pre-triangular infes ...")
+ return(list())
+ }
+
+ tryCatch(
+ expr = {
+ return(.generatePlots(gdx))
+ },
+ error = function(e) {
+ if (e$message == "No corresponding object found in the GDX!") {
+ message("This function does not support runs before version 3.2.1.dev333")
+ }
+ warning(e)
+ return(list())
+ }
+ )
- return(out)
}
diff --git a/README.md b/README.md
index 5e031c42..863a65de 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,6 @@
# The REMIND R package (2nd generation)
-R package **remind2**, version **1.123.1**
+R package **remind2**, version **1.123.2**
[![CRAN status](https://www.r-pkg.org/badges/version/remind2)](https://cran.r-project.org/package=remind2) [![R build status](https://github.com/pik-piam/remind2/workflows/check/badge.svg)](https://github.com/pik-piam/remind2/actions) [![codecov](https://codecov.io/gh/pik-piam/remind2/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/remind2) [![r-universe](https://pik-piam.r-universe.dev/badges/remind2)](https://pik-piam.r-universe.dev/builds)
@@ -49,7 +49,7 @@ In case of questions / problems please contact Renato Rodrigues .
+Rodrigues R, Baumstark L, Benke F, Dietrich J, Dirnaichner A, Führlich P, Giannousakis A, Hasse R, Hilaire J, Klein D, Koch J, Kowalczyk K, Levesque A, Malik A, Merfort A, Merfort L, Morena-Leiva S, Pehl M, Pietzcker R, Rauner S, Richters O, Rottoli M, Schötz C, Schreyer F, Siala K, Sörgel B, Spahr M, Strefler J, Verpoort P, Weigmann P (2023). _remind2: The REMIND R package (2nd generation)_. R package version 1.123.2, .
A BibTeX entry for LaTeX users is
@@ -58,7 +58,7 @@ A BibTeX entry for LaTeX users is
title = {remind2: The REMIND R package (2nd generation)},
author = {Renato Rodrigues and Lavinia Baumstark and Falk Benke and Jan Philipp Dietrich and Alois Dirnaichner and Pascal Führlich and Anastasis Giannousakis and Robin Hasse and Jérome Hilaire and David Klein and Johannes Koch and Katarzyna Kowalczyk and Antoine Levesque and Aman Malik and Anne Merfort and Leon Merfort and Simón Morena-Leiva and Michaja Pehl and Robert Pietzcker and Sebastian Rauner and Oliver Richters and Marianna Rottoli and Christof Schötz and Felix Schreyer and Kais Siala and Björn Sörgel and Mike Spahr and Jessica Strefler and Philipp Verpoort and Pascal Weigmann},
year = {2023},
- note = {R package version 1.123.1},
+ note = {R package version 1.123.2},
url = {https://github.com/pik-piam/remind2},
}
```