From 903a3d2be3251325cf48cb5b2739844f64722b37 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Tue, 19 Nov 2024 15:51:27 +0100 Subject: [PATCH 1/5] allow for NA in threshold columns in config --- R/importFunctions.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/importFunctions.R b/R/importFunctions.R index bc968ed..c9109ca 100644 --- a/R/importFunctions.R +++ b/R/importFunctions.R @@ -68,13 +68,13 @@ getConfig <- function(configName) { return(cfg) } -# fill empty threshold columns with Infinity for easier evaluation +# fill empty and NA threshold columns with Infinity for easier evaluation fillInf <- function(cfg) { cfg <- cfg %>% - mutate(min_red = as.numeric(ifelse(is.na(min_red), -Inf, min_red)), - min_yel = as.numeric(ifelse(is.na(min_yel), -Inf, min_yel)), - max_yel = as.numeric(ifelse(is.na(max_yel), Inf, max_yel)), - max_red = as.numeric(ifelse(is.na(max_red), Inf, max_red)) + mutate(min_red = as.numeric(ifelse(is.na(min_red) | min_red == "NA", -Inf, min_red)), + min_yel = as.numeric(ifelse(is.na(min_yel) | min_yel == "NA", -Inf, min_yel)), + max_yel = as.numeric(ifelse(is.na(max_yel) | max_yel == "NA", Inf, max_yel)), + max_red = as.numeric(ifelse(is.na(max_red) | max_red == "NA", Inf, max_red)) ) return(cfg) From 2d8d71c2a2df95fbf589e11a81d2494ab7a03322 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Tue, 19 Nov 2024 15:52:41 +0100 Subject: [PATCH 2/5] rework heat map plotting function --- R/validationHeatmap.R | 272 ++++++++++++++++++++++----------------- man/validationHeatmap.Rd | 57 ++++---- 2 files changed, 184 insertions(+), 145 deletions(-) diff --git a/R/validationHeatmap.R b/R/validationHeatmap.R index b2cffae..e97d63a 100644 --- a/R/validationHeatmap.R +++ b/R/validationHeatmap.R @@ -1,138 +1,176 @@ -#' takes the output of "validateScenarios()" and plots heatmaps per variable +#' takes the output of "validateScenarios()" and plots heat maps per variable #' -#' @param df data.frame as returned by ``validateScenarios()`` -#' and ``appendTooltips()`` -#' @param var variable to be plotted -#' @param met choose metric from "relative", "difference", "absolute" or -#' "growthrate" -#' @param historical should this be a plot comparing to historical data +#' @param df data.frame to be plotted, as returned by ``validateScenarios()`` +#' (and ``appendTooltips()`` if interactive), plus optional filtering. +#' Needs to have at least one dimension with only one unique element. +#' @param main_dim out of the 5-dim df, 1 dim has to contain only on element, +#' this is the main dimension of the plot, default: variable #' @param interactive return plots as interactive plotly plots by default -#' @param x_plot choose dimension to display on x-axis of plot, default: region -#' @param y_plot choose dimension to display on y-axis of plot, default: period -#' @param x_facet choose dimension to display on x-dim of facets, default: model -#' @param y_facet choose dimension to display on x-dim of facets, default: scenario +#' @param x_plot choose dimension to display on x-axis of plot, if any +#' is NULL, arrangement is chosen automatically based on data dimensions +#' @param y_plot choose dimension to display on y-axis of plot +#' @param x_facet choose dimension to display on x-dim of facets +#' @param y_facet choose dimension to display on x-dim of facets #' #' @importFrom dplyr filter select mutate %>% #' @import ggplot2 #' @importFrom ggthemes theme_tufte -#' @importFrom plotly ggplotly #' @export validationHeatmap <- function(df, - var, - met, - historical = TRUE, - interactive = TRUE, - x_plot = "region", - y_plot = "period", - x_facet = "model", - y_facet = "scenario") { - - # wip: when giving multiple vars, plot as facets in same row - if (length(var) > 1) { - d <- df3 %>% - filter(.data$metric == met) - if (historical) { - d <- filter(d, ref_scenario == "historical") - plot_title <- paste0("Summary ", met, " (historical)") - } else { - d <- filter(d, (ref_scenario != "historical" | is.na(ref_scenario))) - plot_title <- paste0("Summary ", met) - } + main_dim = "variable", + x_plot = NULL, y_plot = NULL, + x_facet = NULL, y_facet = NULL, + interactive = TRUE) { + + # setup #### + + plot_title <- paste0(df[1, main_dim]) + + # prepare data + df$period <- as.character(df$period) + standard_dims <- c("model", "scenario", "variable", "region", "period") + colors <- c(green = "#008450", + yellow = "#EFB700", + red = "#B81D13", + cyan = "#66ccee", + blue = "#4477aa", + grey = "#808080") + + # check arguments #### + + # check if valid name for main_dim is passed + if (!main_dim %in% standard_dims) { + stop("Please choose 'main_dim' from the standard dimensions: \n", + "model, scenario, variable, region or period\n") + } - # gg tile plot using data along dimensions as given in function call - x_plot <- "scenario" - y_plot <- "variable" - - p <- ggplot(d, aes(x = .data[[x_plot,]], - y = .data[[y_plot,]], - fill = score)) + - geom_tile(color="white", linewidth=0.0) + - scale_fill_gradient2(low="#008450", high="#B81D13", guide="colorbar") + - labs(x = NULL, y = NULL, title = plot_title) + - theme_tufte(base_family = "Helvetica") + # creates warnings - theme(axis.ticks = element_blank()) + - theme(axis.text = element_text(size = 10)) + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + - theme(strip.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + - coord_equal() + - theme(legend.position = "none") - - # create small gap to "World" data by creating white outline - if("World" %in% d$region) { - p <- p + geom_vline(xintercept = 1.5, linewidth = 0.8, color = "white") - } - fig <- ggplotly(p, tooltip = "text") + # check if data.frame has at least one dimension of only one element + if (length(unique(df[, main_dim])) > 1) { + cat("Data dimensions: \n") + print(lengths(lapply(df[, standard_dims], unique))) + stop(main_dim, " (main_dim) can only contain one unique element, + Please filter data before plotting or select a different main_dim.\n") + } - # if only one variable if passed to function - } else { + # check validation categories, only one per plot allowed + # TODO: ref_scenario is not checked, but important as "historical" signals a + # different type of check. Problem: how to deal with "regular" scenario + # comparison to multiple different scenarios + if (length(unique(df[, c("metric")])) > 1) { + cat("Validation types: \n") + print(unique(df[, c("metric")])) + stop("Multiple categories of checks found in data, please filter the data + object to contain only one metric.\n") + } - # prepare data slice which will be plotted - d <- df %>% - filter(.data$variable == var, - .data$metric == met) + # check if an incomplete set of x/y_plot/facet arguments is passed + null_args <- sum(sapply(list(x_plot, y_plot, x_facet, y_facet), is.null)) + if (null_args %in% c(1, 2, 3)) { + stop("Please define either all 'plot' and 'facet' arguments or none.") + } - if (historical) { - d <- filter(d, ref_scenario == "historical") - plot_title <- paste0(var, " [", d$unit[1], "] - ", met, " (historical)") + # arranging dimensions #### + if (any(is.null(c(x_plot, y_plot, x_facet, y_facet)))) { + # select dimensions except main_dim and how they should be plotted + # length of each dim important to find the best arrangement of axis and facets + # generally preferred, period and region as axis, scenario and model as facets + # variable wherever there is space + dim_length <- sort(lengths( + lapply(df[, setdiff(standard_dims, main_dim)], unique) + )) + other_dims <- names(dim_length) + + # 3 possible ways to form 2 groups of 2 dimensions each + # start by creating possible dimension products + p <- as.data.frame(matrix(NA, 3, 2)) + p[1, ] <- c(dim_length[1]*dim_length[2], dim_length[3]*dim_length[4]) + p[2, ] <- c(dim_length[1]*dim_length[3], dim_length[2]*dim_length[4]) + p[3, ] <- c(dim_length[1]*dim_length[4], dim_length[2]*dim_length[3]) + + # select combination that is closest to ideal plot layout ratio (x/y) + ideal <- 2 + # determine ratio of bigger to smaller dim products, + # V1 is the first product, V2 the second product + p <- mutate(p, ratio = ifelse(V2 > V1, abs(V2/V1 - ideal), abs(V1/V2 - ideal))) + # find idx of row closest to ideal + ideal_idx <- which(p[, "ratio"] == min(p[, "ratio"]), arr.ind = TRUE)[1] + + # idx is found, but we don't know if the first or second product is the larger + # one and thus should be on the y-axis and y-facet + if (p[ideal_idx, "V1"] < p[ideal_idx, "V2"]) { + # V1 always contains the the first other dim "other_dims[1]" + # (dim_length and other_dims have same order of elements) + # other element of V1 product has index "ideal_idx" + 1 by definition + # region or period should be "plot" if possible + y_plot <- ifelse(other_dims[1] %in% c("period", "region"), + other_dims[1], + other_dims[ideal_idx + 1]) + y_facet <- ifelse(other_dims[1] %in% c("period", "region"), + other_dims[ideal_idx + 1], + other_dims[1]) + + # remaining two dimensions are used for x axis and facet + x_dims <- setdiff(c(2,3,4), ideal_idx + 1) + x_plot <- ifelse(other_dims[x_dims[1]] %in% c("period", "region"), + other_dims[x_dims[1]], + other_dims[x_dims[2]]) + x_facet <- ifelse(other_dims[x_dims[1]] %in% c("period", "region"), + other_dims[x_dims[2]], + other_dims[x_dims[1]]) } else { - d <- filter(d, (ref_scenario != "historical" | is.na(ref_scenario))) - plot_title <- paste0(var, " [", d$unit[1], "] - ", met) - } - - # warn if no data is found for combination of var, cat and met - # TODO: fix for case without category - # if (nrow(d) == 0) { - # data$cm <- paste(metric, sep = "-") - # warning( - # paste0( - # "No data found for variable in this category and metric.\n - # variable ", var ," is available for the following category-metric - # combinations: ", unique(data[data$variable == var, "cm"]) - # ) - # ) - # } - - d$period <- as.character(d$period) - colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - cyan = "#66ccee", - blue = "#4477aa", - grey = "#808080") - - - # gg tile plot using data along dimensions as given in function call - p <- ggplot(d, aes(x = .data[[x_plot,]], - y = .data[[y_plot,]], - fill = check, - text = text)) + - geom_tile(color="white", linewidth=0.0) + - scale_fill_manual(values = colors, breaks = colors) + - facet_grid(.data[[y_facet,]] ~ .data[[x_facet,]]) + - labs(x = NULL, y = NULL, title = plot_title) + - theme_tufte(base_family = "Helvetica") + # creates warnings - theme(axis.ticks = element_blank()) + - theme(axis.text = element_text(size = 9)) + - theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) + - coord_equal() + - theme(legend.position = "none") - - # tweak for ELEVATE: to make facet labels and title readable - if (x_facet == "scenario") { - p <- p + - theme(strip.text.x = element_text(angle = 30, vjust = 0.5, hjust=1)) + - theme(strip.text.y = element_text(angle = 0, vjust = 0.5, hjust=1)) + # same as "if", just switched x and y + x_plot <- ifelse(other_dims[1] %in% c("period", "region"), + other_dims[1], + other_dims[ideal_idx + 1]) + x_facet <- ifelse(other_dims[1] %in% c("period", "region"), + other_dims[ideal_idx + 1], + other_dims[1]) + + y_dims <- setdiff(c(2,3,4), ideal_idx + 1) + y_plot <- ifelse(other_dims[y_dims[1]] %in% c("period", "region"), + other_dims[y_dims[1]], + other_dims[y_dims[2]]) + y_facet <- ifelse(other_dims[y_dims[1]] %in% c("period", "region"), + other_dims[y_dims[2]], + other_dims[y_dims[1]]) } - - # create small gap to "World" data by creating white outline - if("World" %in% d$region) { - p <- p + geom_vline(xintercept = 1.5, linewidth = 0.8, color = "white") - } - fig <- ggplotly(p, tooltip = "text") } + # plot #### + p <- ggplot(df, aes(x = .data[[x_plot, ]], + y = .data[[y_plot, ]], + fill = check, + text = text)) + + geom_tile(color = "white", linewidth = 0.0) + + scale_fill_manual(values = colors, breaks = colors) + + facet_grid(.data[[y_facet, ]] ~ .data[[x_facet, ]]) + + labs(x = NULL, y = NULL, title = plot_title) + + theme_tufte(base_family = "Arial") + + theme(axis.ticks = element_blank()) + # remove ticks + theme(axis.text = element_text(size = 8)) + # font size plot labels + theme(strip.text = element_text(size = 8)) + # font size facet labels + # default labels for axis and facets, might need to be adjusted depending + # on plot layout + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)) + + theme(axis.text.y = element_text(angle = 0, vjust = 0.5, hjust = 1)) + + theme(strip.text.x = element_text(angle = 90, vjust = 0.5, hjust = 0)) + + theme(strip.text.y = element_text(angle = 0, vjust = 0.5, hjust = 0)) + + coord_equal() + + theme(legend.position = "none") + + # create small gap to "World" data by creating white outline + # -> in some cases this creates an area where tooltips do not work, disabled + #if("World" %in% d$region) { + #p <- p + geom_vline(xintercept = 1.5, linewidth = 0.6, color = "white") + #} + if (interactive) { + # create interactive element + fig <- plotly::ggplotly(p, tooltip = "text") %>% + # avoid overlap of title and facet labels (plotly issue) + plotly::layout(title = list(y = .95, xref = "plot"), + margin = list(l = 0, t = 150, r = 150)) return(fig) } else { return(p) diff --git a/man/validationHeatmap.Rd b/man/validationHeatmap.Rd index 73122b9..7c58ab5 100644 --- a/man/validationHeatmap.Rd +++ b/man/validationHeatmap.Rd @@ -6,51 +6,52 @@ \usage{ validationHeatmap( df, - var, - met, - historical = TRUE, - interactive = TRUE, - x_plot = "region", - y_plot = "period", - x_facet = "model", - y_facet = "scenario" + main_dim = "variable", + x_plot = NULL, + y_plot = NULL, + x_facet = NULL, + y_facet = NULL, + interactive = TRUE ) validationHeatmap( df, - var, - met, - historical = TRUE, - interactive = TRUE, - x_plot = "region", - y_plot = "period", - x_facet = "model", - y_facet = "scenario" + main_dim = "variable", + x_plot = NULL, + y_plot = NULL, + x_facet = NULL, + y_facet = NULL, + interactive = TRUE ) } \arguments{ -\item{df}{data.frame as returned by ``validateScenarios()`` -and ``appendTooltips()``} +\item{df}{data.frame to be plotted, as returned by ``validateScenarios()`` +(and ``appendTooltips()`` if interactive), plus optional filtering. +Needs to have at least one dimension with only one unique element.} -\item{var}{variable to be plotted} +\item{main_dim}{out of the 5-dim df, 1 dim has to contain only on element, +this is the main dimension of the plot, default: variable} -\item{met}{choose metric from "relative", "difference", "absolute" or -"growthrate"} +\item{x_plot}{choose dimension to display on x-axis of plot, if any +is NULL, arrangement is chosen automatically based on data dimensions} -\item{historical}{should this be a plot comparing to historical data} +\item{y_plot}{choose dimension to display on y-axis of plot} -\item{interactive}{return plots as interactive plotly plots by default} +\item{x_facet}{choose dimension to display on x-dim of facets} + +\item{y_facet}{choose dimension to display on x-dim of facets} -\item{x_plot}{choose dimension to display on x-axis of plot, default: region} +\item{interactive}{return plots as interactive plotly plots by default} -\item{y_plot}{choose dimension to display on y-axis of plot, default: period} +\item{var}{variable to be plotted} -\item{x_facet}{choose dimension to display on x-dim of facets, default: model} +\item{met}{choose metric from "relative", "difference", "absolute" or +"growthrate"} -\item{y_facet}{choose dimension to display on x-dim of facets, default: scenario} +\item{historical}{should this be a plot comparing to historical data} } \description{ takes the output of "validateScenarios()" and plots heatmaps per variable -takes the output of "validateScenarios()" and plots heatmaps per variable +takes the output of "validateScenarios()" and plots heat maps per variable } From 21c72850b207410b869b388b9271dad00ed72a5b Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Tue, 19 Nov 2024 15:57:42 +0100 Subject: [PATCH 3/5] update report Rmds, add scenarioMIP report --- inst/markdown/validationReport_ELEVATE.Rmd | 48 ++--- inst/markdown/validationReport_NGFS.Rmd | 171 --------------- inst/markdown/validationReport_default.Rmd | 140 ++++++++---- .../markdown/validationReport_scenarioMIP.Rmd | 202 ++++++++++++++++++ 4 files changed, 314 insertions(+), 247 deletions(-) delete mode 100644 inst/markdown/validationReport_NGFS.Rmd create mode 100644 inst/markdown/validationReport_scenarioMIP.Rmd diff --git a/inst/markdown/validationReport_ELEVATE.Rmd b/inst/markdown/validationReport_ELEVATE.Rmd index a9193ee..0b5055f 100644 --- a/inst/markdown/validationReport_ELEVATE.Rmd +++ b/inst/markdown/validationReport_ELEVATE.Rmd @@ -63,42 +63,26 @@ dplyr::count(df, critical, check) ## Heatmaps by Category ### Scenario - Absolute -```{r, fig.width=10, fig.height=10} -historic <- FALSE -m <- "absolute" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) -interact <- TRUE +```{r} +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "absolute") +vars <- unique(d$variable) -if (interact) { - # interactive plots can only be printed from outside of loops, use tagList - # to store html objects in List - if (nrow(d) > 0) { - vars <- unique(d$variable) +if (nrow(d) > 0) { + if (interact) { # interactive plots need to be collected in a tagList plot_list <- htmltools::tagList() for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, - x_plot = "period", - y_plot = "region", - x_facet = "scenario", - y_facet = "model", - interactive = interact) %>% - # avoid overlap of title and facet labels (plotly issue) - layout(title = list(y = .95, xref = "plot"), - margin = list(l = 75, t = 150)) + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) } - plot_list + plot_list + } else { # non-interactive plots can simply be printed in a loop + for (i in 1:length(vars)) { + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) + } } -} else { - # non-interactive plots can simply be printed - vars <- unique(d$variable) - for (i in 1:length(vars)) { - p <- validationHeatmap(d, vars[i], met = m, historic, - x_plot = "period", - y_plot = "region", - x_facet = "scenario", - y_facet = "model", - interactive = interact) - print(p) - } } ``` diff --git a/inst/markdown/validationReport_NGFS.Rmd b/inst/markdown/validationReport_NGFS.Rmd deleted file mode 100644 index 7b3e959..0000000 --- a/inst/markdown/validationReport_NGFS.Rmd +++ /dev/null @@ -1,171 +0,0 @@ ---- -title: "piamValidation: NGFS" -date: "`r format(Sys.Date())`" -output: - html_document: - toc: true - toc_float: true - code_folding: hide -params: - mif: "" - cfg: "" - warning: false - message: false - figWidth: 8 ---- - -```{r include=FALSE} -library(piamValidation) -library(knitr) -library(dplyr) -library(ggplot2) -library(ggthemes) -library(plotly) - -knitr::opts_chunk$set( - echo = FALSE, - error = TRUE, - message = params$message, - warning = params$warning -) -``` - -## Import and Prepare Data - -Loading data from: - -```{r} -for (m in params$mif) cat(paste0(normalizePath(m), "\n")) -``` - -Using config: - -```{r} -cat(params$cfg, "\n") -``` - - -```{r, message = FALSE} -# Data Preparation -df <- validateScenarios(params$mif, params$cfg) -df <- appendTooltips(df) -``` - -## Validation - -### Summary -```{r} -# find "critical == yes" data points, that are red/yellow -colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - grey = "#808080") -dplyr::count(df, critical, check) -``` - -## Heatmaps by Category - -### Historic - Relative -Relative deviation to historical reference data. -```{r} -historic <- TRUE -m <- "relative" -d <- filter(df, metric == m, ref_scenario == "historical") - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` - -### Historic - Difference -Absolute difference to historical reference data -```{r} -historic <- TRUE -m <- "difference" -d <- filter(df, metric == m, ref_scenario == "historical") - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` - -### Scenario - Relative -Relative deviation to data point from either: - -- period (same scenario/model) -- scenario (same period/model) -- model (same period/scenario) - -```{r} -historic <- FALSE -m <- "relative" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` - -### Scenario - Difference -```{r} -historic <- FALSE -m <- "difference" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` - -### Scenario - Absolute -```{r} -historic <- FALSE -m <- "absolute" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` - - -### Scenario - Growthrate -```{r} -historic <- FALSE -m <- "growthrate" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) - -if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() - for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic, compareModels = TRUE) - } - plot_list -} -``` diff --git a/inst/markdown/validationReport_default.Rmd b/inst/markdown/validationReport_default.Rmd index 440b739..f2f1850 100644 --- a/inst/markdown/validationReport_default.Rmd +++ b/inst/markdown/validationReport_default.Rmd @@ -65,36 +65,52 @@ dplyr::count(df, critical, check) ### Historic - Relative Relative deviation to historical reference data. ```{r} -historic <- TRUE -m <- "relative" -d <- filter(df, metric == m, ref_scenario == "historical") +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "relative", ref_scenario == "historical") +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - - # tagList only works for interactive plots - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` ### Historic - Difference Absolute difference to historical reference data ```{r} -historic <- TRUE -m <- "difference" -d <- filter(df, metric == m, ref_scenario == "historical") +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "difference", ref_scenario == "historical") +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` @@ -106,65 +122,101 @@ Relative deviation to data point from either: - model (same period/scenario) ```{r} -historic <- FALSE -m <- "relative" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "relative", ref_scenario != "historical" | is.na(ref_scenario)) +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` ### Scenario - Difference ```{r} -historic <- FALSE -m <- "difference" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "difference", ref_scenario != "historical" | is.na(ref_scenario)) +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` ### Scenario - Absolute ```{r} -historic <- FALSE -m <- "absolute" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "absolute") +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` ### Scenario - Growthrate ```{r} -historic <- FALSE -m <- "growthrate" -d <- filter(df, metric == m, ref_scenario != "historical" | is.na(ref_scenario)) +interact = TRUE + +# plot one heat map for each variable in this category +d <- filter(df, metric == "growthrate") +vars <- unique(d$variable) if (nrow(d) > 0) { - vars <- unique(d$variable) - plot_list <- htmltools::tagList() + if (interact) { # interactive plots need to be collected in a tagList + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_data <- filter(d, variable == vars[i]) + plot_list[[i]] <- validationHeatmap(plot_data) + } + plot_list + } else { # non-interactive plots can simply be printed in a loop for (i in 1:length(vars)) { - plot_list[[i]] <- validationHeatmap(d, vars[i], met = m, historic) + p <- validationHeatmap(d, vars[i], interactive = interact) + print(p) } - plot_list + } } ``` diff --git a/inst/markdown/validationReport_scenarioMIP.Rmd b/inst/markdown/validationReport_scenarioMIP.Rmd new file mode 100644 index 0000000..95a7624 --- /dev/null +++ b/inst/markdown/validationReport_scenarioMIP.Rmd @@ -0,0 +1,202 @@ +--- +title: "piamValidation: Scenario MIP report" +date: "`r format(Sys.Date())`" +output: + html_document: + toc: true + toc_float: true + code_folding: hide + toc_depth: 4 +params: + mif: "" + cfg: "" + extraColors: true + warning: false + message: false + figWidth: 8 +--- + +```{r include=FALSE} +library(piamValidation) +library(knitr) +library(dplyr) +library(ggplot2) +library(ggthemes) +library(plotly) +library(madrat) +library(piamInterfaces) + +knitr::opts_chunk$set( + echo = FALSE, + error = TRUE, + message = params$message, + warning = params$warning +) +``` + +## Import and Prepare Data + +Loading data from: +"scenarioMIP_snapshot_2024-10-25", "historical_R10_scenarioMIP_2024-11-05.mif" + +```{r} +#for (m in params$mif) cat(paste0(normalizePath(m), "\n")) +``` + +Using config: + +```{r} +cat(params$cfg, "\n") +``` + + +```{r, message = FALSE, warning = TRUE} + +hist <- quitte::read.snapshot("C:/Users/pascalwe/Code/scenarioMIP/historical_R10_scenarioMIP_2024-11-05.mif") %>% + filter(period %in% seq(2018, 2022)) %>% + as.magpie(spatial = "region") + +# average 2020 values over 5 year period to even out Covid shock +hist[, 2020, ] <- dimSums(hist, dim = 2)/5 +hist <- quitte::as.quitte(hist[, 2020, ]) + +data <- readRDS("C:/Users/pascalwe/Code/scenarioMIP/scenarioMIP_snapshot_2024-10-25") + +dR10 <- filter(data, region %in% unique(hist$region)) %>% + filter(period %in% c(2020, 2030)) + +df <- rbind(hist, dR10) + +# Data Preparation +df <- validateScenarios(df, "scenarioMIP", extraColors = TRUE) +df <- appendTooltips(df) + +# reorder scenario names alphabetically +df$scenario <- factor(df$scenario, levels = sort(levels(df$scenario))) +``` + +## Validation + +### Summary +```{r} +# find "critical == yes" data points of each color +summary <- dplyr::count(df, model, check) + +colors <- c(green = "#008450", + yellow = "#EFB700", + red = "#B81D13", + cyan = "#66ccee", + blue = "#4477aa", + grey = "#808080") + +ggplot(summary, aes(x = model, y= n, fill = check)) + + geom_bar(stat = "identity") + + scale_fill_manual(values = colors) + + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +``` + +## Historical (non-interactive) + +### All models, all scenarios + +Deviation to IEA data, averaged from 2018 to 2022 to dampen Covid shock. + +```{r, fig.width=10, fig.height=10} +d <- filter(df, metric == "relative", ref_scenario == "historical" | is.na(ref_scenario)) +interact <- FALSE + +if (interact) { + # interactive plots can only be printed from outside of loops, use tagList + # to store html objects in List + if (nrow(d) > 0) { + vars <- unique(d$variable) + plot_list <- htmltools::tagList() + for (i in 1:length(vars)) { + plot_list[[i]] <- validationHeatmap(filter(d, variable == vars[i]), + y_plot = "period", + x_plot = "region", + y_facet = "scenario", + x_facet = "model", + interactive = interact) %>% + # avoid overlap of title and facet labels (plotly issue) + layout(title = list(y = .95, xref = "plot"), + margin = list(l = 75, t = 150)) + } + plot_list + } +} else { + # non-interactive plots can simply be printed + vars <- unique(d$variable) + for (i in 1:length(vars)) { + p <- validationHeatmap(filter(d, variable == vars[i]), + y_plot = "period", + x_plot = "region", + y_facet = "scenario", + x_facet = "model", + interactive = interact) + print(p) + } +} +``` + +## Historical (interactive) + +### By Model + +Deviation to IEA data, averaged from 2018 to 2022 to dampen Covid shock. + +```{r, fig.width=10, fig.height=10} +d <- filter(df, metric == "relative", ref_scenario == "historical" | is.na(ref_scenario)) +interact <- TRUE + +# interactive plots can only be printed from outside of loops, use tagList +# to store html objects in List +if (nrow(d) > 0) { + models <- unique(d$model) + plot_list <- htmltools::tagList() + for (i in 1:length(models)) { + d_model <- filter(d, model == models[i]) + plot_list[[i]] <- validationHeatmap(d_model, main_dim = "model", + x_plot = "region", + y_plot = "period", + x_facet = "variable", + y_facet = "scenario", + interactive = interact) %>% + # avoid overlap of title and facet labels (plotly issue) + layout(title = list(y = .95, xref = "plot"), + margin = list(l = 0, t = 150, r = 150)) + } + plot_list +} +``` + +## Near-Term Trends + +### Emissions by Model + +Deviation to "Medium" Scenario of the respective SSP in 2030. + +```{r, fig.width=10, fig.height=10} +d <- filter(df, metric == "relative", ref_scenario != "historical" | is.na(ref_scenario)) +interact <- TRUE + +# interactive plots can only be printed from outside of loops, use tagList +# to store html objects in List +if (nrow(d) > 0) { + models <- unique(d$model) + plot_list <- htmltools::tagList() + for (i in 1:length(models)) { + d_model <- filter(d, model == models[i]) + plot_list[[i]] <- validationHeatmap(d_model, main_dim = "model", + x_plot = "region", + y_plot = "period", + x_facet = "variable", + y_facet = "scenario", + interactive = interact) %>% + # avoid overlap of title and facet labels (plotly issue) + layout(title = list(y = .95, xref = "plot"), + margin = list(l = 0, t = 150, r = 150)) + } + plot_list +} +``` From ed82d2a97d5dc1220a534ef322772d000646ecb5 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Tue, 19 Nov 2024 16:01:05 +0100 Subject: [PATCH 4/5] update configs, add scenarioMIP config --- inst/config/validationConfig_AMT.csv | 249 ++++++++++--------- inst/config/validationConfig_ARIADNE.csv | 40 +-- inst/config/validationConfig_scenarioMIP.csv | 66 +++++ 3 files changed, 211 insertions(+), 144 deletions(-) create mode 100644 inst/config/validationConfig_scenarioMIP.csv diff --git a/inst/config/validationConfig_AMT.csv b/inst/config/validationConfig_AMT.csv index 05caae7..d6327c0 100644 --- a/inst/config/validationConfig_AMT.csv +++ b/inst/config/validationConfig_AMT.csv @@ -1,125 +1,126 @@ -metric;critical;variable;unit;model;scenario;region;period;min_red;min_yel;max_yel;max_red;ref_model;ref_scenario;ref_period;source/link to discussion -Deviation to historical data;;;;;;;;;;;;;;; -relative;yes;Emi|CO2|Energy;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;Emi|CO2|Energy|Demand|Transport;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;Emi|CO2|Energy|Demand|Buildings;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;Emi|CO2|Energy|Demand|Industry;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;Emi|CO2|Energy|Supply;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;Emi|CO2|Industrial Processes;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;EDGAR8;historical;; -relative;yes;PE|Coal;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;BP, IEA;historical;; -relative;yes;PE|Oil;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;BP, IEA;historical;; -relative;yes;PE|Gas;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;BP, IEA;historical;; -relative;yes;SE|Electricity;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;Ember, BP;historical;; -relative;yes;FE;EJ/yr;;;;2005-2020;-40%;-20%;20%;40%;IEA;historical;; -relative;yes;FE|*;EJ/yr;;;;2005-2020;-40%;-20%;20%;40%;IEA;historical;; -;;;;;;;;;;;;;;; -Near-term realism;;;;;;;;;;;;;;; -relative;yes;FE;EJ/yr;;;;2030;-40%;-20%;;;;;2020;Survey: Felix -relative;yes;Emi|GHG;Mt CO2/yr;;;;2030;-50%;-30%;;;;;2020;Survey: Felix -absolute;yes;Emi|CO2;Mt CO2/yr;;;World;2025;39816;;;;;;;"based on Elmars assumptions on max. reduction scenarios: +metric;critical;variable;unit;model;scenario;region;period;min_red;min_yel;max_yel;max_red;tolerance;ref_model;ref_scenario;ref_period;source/link to discussion +Deviation to historical data;;;;;;;;;;;;;;;; +relative;yes;Emi|CO2|Energy;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;Emi|CO2|Energy|Demand|Transport;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;Emi|CO2|Energy|Demand|Buildings;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;Emi|CO2|Energy|Demand|Industry;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;Emi|CO2|Energy|Supply;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;Emi|CO2|Industrial Processes;Mt CO2/yr;;;;2005-2020;-40%;-20%;20%;40%;;CEDS;historical;; +relative;yes;PE|Coal;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;;IEA;historical;; +relative;yes;PE|Oil;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;;IEA;historical;; +relative;yes;PE|Gas;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;;IEA;historical;; +relative;yes;SE|Electricity;EJ/yr;;;;2005-2020;-30%;-15%;15%;30%;;Ember, BP;historical;; +relative;yes;FE;EJ/yr;;;;2005-2020;-40%;-20%;20%;40%;;IEA;historical;; +relative;yes;FE|*;EJ/yr;;;;2005-2020;-40%;-20%;20%;40%;;IEA;historical;; +relative;yes;Cap|Electricity|*;GW;;;;2005-2020;-40%;-20%;20%;40%;;Ember;historical;; +;;;;;;;;;;;;;;;; +Near-term realism;;;;;;;;;;;;;;;; +relative;yes;FE;EJ/yr;;;;2030;-40%;-20%;;;;;;2020;Survey +relative;yes;Emi|GHG;Mt CO2/yr;;;;2030;-50%;-30%;;;;;;2020;Survey +absolute;yes;Emi|CO2;Mt CO2/yr;;;World;2025;39816;;;;;;;;"based on assumptions on max. reduction scenarios: 2019: 37.65Gt (EDGAR, wo LULUCF). 2025 (-3.4%): 36.37Gt + 3.45Gt LULUCF = 39.82Gt CO2" -absolute;yes;Emi|CO2;Mt CO2/yr;;;World;2030;30987;;;;;;;2030 (-23%): 28.99Gt + 2.0Gt LULUCF = 30.99Gt CO2 -absolute;yes;Emi|CH4;Mt CH4/yr;;;World;2040;100;;;1000;;;;AR6 WG3 Annex III, Table 11 -absolute;yes;SE|Electricity|Nuclear;EJ/yr;;;World;2030;;;;20;;;;AR6 WG3 Annex III, Table 11 -;;;;;;;;;;;;;;; -Absolute technical/geological limits;;;;;;;;;;;;;;; -growthrate;yes;New Cap|Electricity|Solar|PV;GW/yr;;;;2020-2050;;;50%;100%;;;;Survey: Felix -;;;;;;;;;;;;;;; -Scenario specific;;;;;;;;;;;;;;; -absolute;yes;Temperature|Global Mean;K;;SSP2EU-EU21-PkBudg500-AMT, SSP2EU-PkBudg500-AMT;;2100;;;1.5;1.6;;;;corresponds to C1 category -absolute;yes;Temperature|Global Mean;K;;SDP_MC-PkBudg650-AMT, SSP1-PkBudg650-AMT, SSP2EU-EU21-PkBudg650-AMT, SSP2EU-PkBudg650-AMT, SSP5-PkBudg650;;2100;;;;1.8;;;;C2 -;;;;;;;;;;;;;;; -from fullThresholds;;;;;;;;;;;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2020;41.292;43.586;48.174;50.468;;;;IEA CCUS -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2020;6.36;8.48;12.72;14.84;;;;https://github.com/pik-piam/mrremind/discussions/544 -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2020;;;;0;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2020;;;;0;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2020;0.606;0.808;1.212;1.414;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2020;0.51;0.68;1.02;1.19;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2020;2.22;2.96;4.44;5.18;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2020;;;;0;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2020;5.52;7.36;11.04;12.88;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2020;0.42;0.56;0.84;0.98;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2020;;;;0;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2020;;;;0;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2020;11.892;15.856;23.784;27.748;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2025;39.6207;49.49215;83.5611;152.4457;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2025;;5.724;17.64;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2025;;0;7.602;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2025;;0;0.0014;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2025;;0.5454;3.864;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2025;;0.4614;2.2988;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2025;;1.998;13.5226;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2025;;;0;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2025;;4.968;47.124;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2025;;1.809;7.35;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2025;;0;0.98;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2025;;;0;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2025;;10.908;93.639;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2030;44.0226;60.01815;152.4663;457.8915;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2030;;6.36;28.84;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2030;;0;20.9076;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2030;;0;0.0014;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2030;;0.606;88.074;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2030;;0.5124;22.526;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2030;;2.22;32.5626;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2030;;;0;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2030;;5.52;89.698;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2030;;2.01;12.95;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2030;;0;0.98;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2030;;0;2.3884;;;;; -absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2030;;12.12;283.843;;;;; -;;;;;;;;;;;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;World;2020;979.4295;1033.84225;1142.66775;1197.0805;;;;IEA HSMR -absolute;yes;Cap|Electricity|Hydro;GW;;;LAM;2020;110.94;147.92;221.88;258.86;;;;https://github.com/pik-piam/mrremind/discussions/541 -absolute;yes;Cap|Electricity|Hydro;GW;;;OAS;2020;32.88;43.84;65.76;76.72;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;SSA;2020;12.78;17.04;25.56;29.82;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;EUR;2020;57.084;76.112;114.168;133.196;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;NEU;2020;49.08;65.44;98.16;114.52;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;MEA;2020;9.369;12.492;18.738;21.861;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;REF;2020;37.74;50.32;75.48;88.06;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;CAZ;2020;52.5;70;105;122.5;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;CHA;2020;201.24;268.32;402.48;469.56;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;IND;2020;27.06;36.08;54.12;63.14;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;JPN;2020;13.44;17.92;26.88;31.36;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;USA;2020;48.84;65.12;97.68;113.96;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;World;2030;979.4295;1175.3742;1606.66275;2117.577;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;LAM;2030;;110.94;376.292;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;OAS;2030;;32.88;189.602;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;SSA;2030;;12.78;85.232;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;EUR;2030;;57.084;247.1728;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;NEU;2030;;49.08;188.916;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;MEA;2030;;9.369;42.9156;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;REF;2030;;37.74;135.9456;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;CAZ;2030;;52.5;178.99;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;CHA;2030;;201.24;832.118;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;IND;2030;;27.06;149.562;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;JPN;2030;;13.44;80.682;;;;; -absolute;yes;Cap|Electricity|Hydro;GW;;;USA;2030;;48.84;187.67;;;;; -;;;;;;;;;;;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;World;2020;337.1886;355.9213;393.3867;412.1194;;;;IEA PRIS -absolute;yes;Cap|Electricity|Nuclear;GW;;;LAM;2020;3.042;4.056;6.084;7.098;;;;https://github.com/pik-piam/mrremind/discussions/540 -absolute;yes;Cap|Electricity|Nuclear;GW;;;OAS;2020;17.448;23.264;34.896;40.712;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;SSA;2020;1.11;1.48;2.22;2.59;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;EUR;2020;61.35;81.8;122.7;143.15;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;NEU;2020;1.782;2.376;3.564;4.158;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;MEA;2020;3.744;4.992;7.488;8.736;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;REF;2020;25.53;34.04;51.06;59.57;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;CAZ;2020;8.22;10.96;16.44;19.18;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;CHA;2020;33.6144;44.8192;67.2288;78.4336;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;IND;2020;4.152;5.536;8.304;9.688;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;JPN;2020;6.63;8.84;13.26;15.47;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;USA;2020;58.17;77.56;116.34;135.73;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;World;2030;269.7507;320.32955;441.924;479.9179;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;LAM;2030;;2.4336;9.009;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;OAS;2030;;13.9584;47.488;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;SSA;2030;;0.888;2.59;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;EUR;2030;;49.08;150.612;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;NEU;2030;;1.4256;10.402;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;MEA;2030;;2.9952;16.254;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;REF;2030;;20.424;67.858;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;CAZ;2030;;6.576;19.18;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;CHA;2030;;26.8914;115.2536;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;IND;2030;;3.3216;17.248;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;JPN;2030;;5.304;19.18;;;;; -absolute;yes;Cap|Electricity|Nuclear;GW;;;USA;2030;;46.536;135.73;;;;; +absolute;yes;Emi|CO2;Mt CO2/yr;;;World;2030;30987;;;;;;;;2030 (-23%): 28.99Gt + 2.0Gt LULUCF = 30.99Gt CO2 +absolute;yes;Emi|CH4;Mt CH4/yr;;;World;2040;100;;;1000;;;;;AR6 WG3 Annex III, Table 11 +absolute;yes;SE|Electricity|Nuclear;EJ/yr;;;World;2030;;;;20;;;;;AR6 WG3 Annex III, Table 11 +;;;;;;;;;;;;;;;; +Absolute technical/geological limits;;;;;;;;;;;;;;;; +growthrate;yes;New Cap|Electricity|Solar|PV;GW/yr;;;;2020-2050;;;50%;100%;;;;;Survey +;;;;;;;;;;;;;;;; +Scenario specific;;;;;;;;;;;;;;;; +absolute;yes;Temperature|Global Mean;K;;SSP2EU-EU21-PkBudg500-AMT, SSP2EU-PkBudg500-AMT;;2100;;;1.5;1.6;;;;;corresponds to C1 category +absolute;yes;Temperature|Global Mean;K;;SDP_MC-PkBudg650-AMT, SSP1-PkBudg650-AMT, SSP2EU-EU21-PkBudg650-AMT, SSP2EU-PkBudg650-AMT, SSP5-PkBudg650;;2100;;;;1.8;;;;;C2 +;;;;;;;;;;;;;;;; +from fullThresholds;;;;;;;;;;;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2020;41.292;43.586;48.174;50.468;;;;;IEA CCUS +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2020;6.36;8.48;12.72;14.84;;;;;https://github.com/pik-piam/mrremind/discussions/544 +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2020;;;;0;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2020;;;;0;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2020;0.606;0.808;1.212;1.414;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2020;0.51;0.68;1.02;1.19;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2020;2.22;2.96;4.44;5.18;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2020;;;;0;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2020;5.52;7.36;11.04;12.88;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2020;0.42;0.56;0.84;0.98;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2020;;;;0;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2020;;;;0;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2020;11.892;15.856;23.784;27.748;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2025;39.6207;49.49215;83.5611;152.4457;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2025;;5.724;17.64;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2025;;0;7.602;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2025;;0;0.0014;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2025;;0.5454;3.864;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2025;;0.4614;2.2988;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2025;;1.998;13.5226;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2025;;;0;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2025;;4.968;47.124;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2025;;1.809;7.35;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2025;;0;0.98;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2025;;;0;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2025;;10.908;93.639;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;World;2030;44.0226;60.01815;152.4663;457.8915;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;LAM;2030;;6.36;28.84;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;OAS;2030;;0;20.9076;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;SSA;2030;;0;0.0014;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;EUR;2030;;0.606;88.074;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;NEU;2030;;0.5124;22.526;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;MEA;2030;;2.22;32.5626;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;REF;2030;;;0;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CAZ;2030;;5.52;89.698;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;CHA;2030;;2.01;12.95;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;IND;2030;;0;0.98;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;JPN;2030;;0;2.3884;;;;;; +absolute;yes;Carbon Management|Storage;Mt CO2/yr;;;USA;2030;;12.12;283.843;;;;;; +;;;;;;;;;;;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;World;2020;979.4295;1033.84225;1142.66775;1197.0805;;;;;IEA HSMR +absolute;yes;Cap|Electricity|Hydro;GW;;;LAM;2020;110.94;147.92;221.88;258.86;;;;;https://github.com/pik-piam/mrremind/discussions/541 +absolute;yes;Cap|Electricity|Hydro;GW;;;OAS;2020;32.88;43.84;65.76;76.72;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;SSA;2020;12.78;17.04;25.56;29.82;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;EUR;2020;57.084;76.112;114.168;133.196;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;NEU;2020;49.08;65.44;98.16;114.52;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;MEA;2020;9.369;12.492;18.738;21.861;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;REF;2020;37.74;50.32;75.48;88.06;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;CAZ;2020;52.5;70;105;122.5;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;CHA;2020;201.24;268.32;402.48;469.56;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;IND;2020;27.06;36.08;54.12;63.14;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;JPN;2020;13.44;17.92;26.88;31.36;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;USA;2020;48.84;65.12;97.68;113.96;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;World;2030;979.4295;1175.3742;1606.66275;2117.577;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;LAM;2030;;110.94;376.292;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;OAS;2030;;32.88;189.602;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;SSA;2030;;12.78;85.232;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;EUR;2030;;57.084;247.1728;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;NEU;2030;;49.08;188.916;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;MEA;2030;;9.369;42.9156;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;REF;2030;;37.74;135.9456;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;CAZ;2030;;52.5;178.99;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;CHA;2030;;201.24;832.118;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;IND;2030;;27.06;149.562;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;JPN;2030;;13.44;80.682;;;;;; +absolute;yes;Cap|Electricity|Hydro;GW;;;USA;2030;;48.84;187.67;;;;;; +;;;;;;;;;;;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;World;2020;299.7232;337.1886;442.64;482.88;;;;;IEA PRIS +absolute;yes;Cap|Electricity|Nuclear;GW;;;LAM;2020;3.042;4.056;6.42;7.49;;;;;https://github.com/pik-piam/mrremind/discussions/540 +absolute;yes;Cap|Electricity|Nuclear;GW;;;OAS;2020;15.0696;20.0928;34.896;40.712;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;SSA;2020;1.11;1.48;2.3256;2.7132;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;EUR;2020;61.35;81.8;138.1104;161.1288;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;NEU;2020;1.782;2.376;3.8184;4.4548;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;MEA;2020;1.2792;1.7056;7.488;8.736;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;REF;2020;25.53;34.04;53.1936;62.0592;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;CAZ;2020;8.004;10.672;16.44;19.18;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;CHA;2020;32.5308;43.3744;67.2288;78.4336;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;IND;2020;4.068;5.424;8.304;9.688;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;JPN;2020;6.63;8.84;40.8864;47.7008;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;USA;2020;58.1112;77.4816;116.34;135.73;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;World;2030;269.7507;320.32955;463.58865;507.1;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;LAM;2030;;2.4336;9.009;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;OAS;2030;;13.9584;47.488;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;SSA;2030;;0.888;2.59;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;EUR;2030;;49.08;150.612;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;NEU;2030;;1.4256;10.402;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;MEA;2030;;2.9952;16.254;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;REF;2030;;20.424;67.858;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;CAZ;2030;;6.576;19.18;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;CHA;2030;;26.8914;115.2536;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;IND;2030;;3.3216;17.248;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;JPN;2030;;5.304;48.0662;;;;;; +absolute;yes;Cap|Electricity|Nuclear;GW;;;USA;2030;;46.536;135.73;;;;;; diff --git a/inst/config/validationConfig_ARIADNE.csv b/inst/config/validationConfig_ARIADNE.csv index ab0a586..7da7720 100644 --- a/inst/config/validationConfig_ARIADNE.csv +++ b/inst/config/validationConfig_ARIADNE.csv @@ -1,23 +1,23 @@ metric;critical;variable;unit;model;scenario;region;period;min_red;min_yel;max_yel;max_red;ref_model;ref_scenario;ref_period;source/link to discussion -relative;yes;Emi|GHG|w/o Land-Use Change;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;yes;Emi|GHG|Energy|Supply;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;yes;Emi|GHG|Industry;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;yes;Emi|GHG|Energy|Demand|Buildings;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;yes;Emi|GHG|Energy|Demand|Transport;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;no;Emi|GHG|Agriculture;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;no;Emi|GHG|Waste;Mt CO2eq/yr;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; -relative;yes;Emi|GHG|Energy|Supply;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;yes;Emi|GHG|Industry;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;yes;Emi|GHG|Energy|Demand|Buildings;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;yes;Emi|GHG|Energy|Demand|Transport;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;no;Emi|GHG|Agriculture;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;no;Emi|GHG|Waste;Mt CO2eq/yr;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; -relative;no;Emi|GHG|w/o Land-Use Change;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|Energy|Supply;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|Industry;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|Energy|Demand|Buildings;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|Energy|Demand|Transport;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|Agriculture;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;yes;Emi|GHG|w/o Land-Use Change;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;yes;Emi|GHG|Energy|Supply;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;yes;Emi|GHG|Industry;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;yes;Emi|GHG|Energy|Demand|Buildings;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;yes;Emi|GHG|Energy|Demand|Transport;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;no;Emi|GHG|Agriculture;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;no;Emi|GHG|Waste;;REMIND;;DEU;2020;-0.2;-0.1;0.1;0.2;UBA;historical;; +relative;yes;Emi|GHG|Energy|Supply;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;yes;Emi|GHG|Industry;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;yes;Emi|GHG|Energy|Demand|Buildings;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;yes;Emi|GHG|Energy|Demand|Transport;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;no;Emi|GHG|Agriculture;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;no;Emi|GHG|Waste;;REMIND;;DEU;2030;-0.2;-0.1;0.1;0.2;KSG;historical;; +relative;no;Emi|GHG|w/o Land-Use Change;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|Energy|Supply;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|Industry;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|Energy|Demand|Buildings;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|Energy|Demand|Transport;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|Agriculture;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; relative;no;Emi|GHG|Waste;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; -relative;no;Emi|GHG|**;Mt CO2eq/yr;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; +relative;no;Emi|GHG|**;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; relative;no;Emi|CO2|**;;REMIND;;DEU;2025, 2030;-0.2;-0.1;0.1;0.2;MMS_2024;;; diff --git a/inst/config/validationConfig_scenarioMIP.csv b/inst/config/validationConfig_scenarioMIP.csv new file mode 100644 index 0000000..1da856c --- /dev/null +++ b/inst/config/validationConfig_scenarioMIP.csv @@ -0,0 +1,66 @@ +metric;critical;variable;unit;model;scenario;region;period;min_red;min_yel;max_yel;max_red;ref_model;ref_scenario;ref_period;source/link to discussion +Historical Vetting;;;;;;;;;;;;;;; +relative;yes;Final Energy;EJ/yr;;;;2020;-20%;-10%;10%;20%;IEA;historical;; +relative;yes;Primary Energy|Coal;EJ/yr;;;;2020;-20%;-10%;10%;20%;IEA;historical;; +relative;yes;Primary Energy|Oil;EJ/yr;;;;2020;-20%;-10%;10%;20%;IEA;historical;; +relative;yes;Primary Energy|Gas;EJ/yr;;;;2020;-20%;-10%;10%;20%;IEA;historical;; +Near-Term Trends;;;;;;;;;;;;;;; +relative to 2030;;;;;;;;;;;;;;; +relative;yes;Emissions|CO2;Mt CO2/yr;;SSP1 - High Emissions, SSP1 - Very Low Emissions, SSP1 - Low Overshoot, SSP1 - Low Emissions, SSP1 - Low Emissions_a, SSP1 - Medium Emissions_a, SSP1 - Medium-Low Emissions, SSP1 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP1 - Medium Emissions;; +relative;yes;Emissions|CO2;Mt CO2/yr;;SSP2 - High Emissions, SSP2 - Low Emissions, SSP2 - Low Overshoot, SSP2 - Very Low Emissions, SSP2 - Medium Overshoot, SSP2 - Medium-Low Emissions, SSP2 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP2 - Medium Emissions;; +relative;yes;Emissions|CO2;Mt CO2/yr;;SSP3 - High Emissions;;2030;-20%;-10%;10%;20%;;SSP3 - Medium Emissions;; +relative;yes;Emissions|CO2;Mt CO2/yr;;SSP5 - High Emissions, SSP5 - Low Overshoot;;2030;-20%;-10%;10%;20%;;SSP5 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy;Mt CO2/yr;;SSP1 - High Emissions, SSP1 - Very Low Emissions, SSP1 - Low Overshoot, SSP1 - Low Emissions, SSP1 - Low Emissions_a, SSP1 - Medium Emissions_a, SSP1 - Medium-Low Emissions, SSP1 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP1 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy;Mt CO2/yr;;SSP2 - High Emissions, SSP2 - Low Emissions, SSP2 - Low Overshoot, SSP2 - Very Low Emissions, SSP2 - Medium Overshoot, SSP2 - Medium-Low Emissions, SSP2 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP2 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy;Mt CO2/yr;;SSP3 - High Emissions;;2030;-20%;-10%;10%;20%;;SSP3 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy;Mt CO2/yr;;SSP5 - High Emissions, SSP5 - Low Overshoot;;2030;-20%;-10%;10%;20%;;SSP5 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Supply;Mt CO2/yr;;SSP1 - High Emissions, SSP1 - Very Low Emissions, SSP1 - Low Overshoot, SSP1 - Low Emissions, SSP1 - Low Emissions_a, SSP1 - Medium Emissions_a, SSP1 - Medium-Low Emissions, SSP1 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP1 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Supply;Mt CO2/yr;;SSP2 - High Emissions, SSP2 - Low Emissions, SSP2 - Low Overshoot, SSP2 - Very Low Emissions, SSP2 - Medium Overshoot, SSP2 - Medium-Low Emissions, SSP2 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP2 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Supply;Mt CO2/yr;;SSP3 - High Emissions;;2030;-20%;-10%;10%;20%;;SSP3 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Supply;Mt CO2/yr;;SSP5 - High Emissions, SSP5 - Low Overshoot;;2030;-20%;-10%;10%;20%;;SSP5 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Residential and Commercial;Mt CO2/yr;;SSP1 - High Emissions, SSP1 - Very Low Emissions, SSP1 - Low Overshoot, SSP1 - Low Emissions, SSP1 - Low Emissions_a, SSP1 - Medium Emissions_a, SSP1 - Medium-Low Emissions, SSP1 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP1 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Residential and Commercial;Mt CO2/yr;;SSP2 - High Emissions, SSP2 - Low Emissions, SSP2 - Low Overshoot, SSP2 - Very Low Emissions, SSP2 - Medium Overshoot, SSP2 - Medium-Low Emissions, SSP2 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP2 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Residential and Commercial;Mt CO2/yr;;SSP3 - High Emissions;;2030;-20%;-10%;10%;20%;;SSP3 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Residential and Commercial;Mt CO2/yr;;SSP5 - High Emissions, SSP5 - Low Overshoot;;2030;-20%;-10%;10%;20%;;SSP5 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Transportation;Mt CO2/yr;;SSP1 - High Emissions, SSP1 - Very Low Emissions, SSP1 - Low Overshoot, SSP1 - Low Emissions, SSP1 - Low Emissions_a, SSP1 - Medium Emissions_a, SSP1 - Medium-Low Emissions, SSP1 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP1 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Transportation;Mt CO2/yr;;SSP2 - High Emissions, SSP2 - Low Emissions, SSP2 - Low Overshoot, SSP2 - Very Low Emissions, SSP2 - Medium Overshoot, SSP2 - Medium-Low Emissions, SSP2 - Very Low Emissions_a;;2030;-20%;-10%;10%;20%;;SSP2 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Transportation;Mt CO2/yr;;SSP3 - High Emissions;;2030;-20%;-10%;10%;20%;;SSP3 - Medium Emissions;; +relative;yes;Emissions|CO2|Energy|Demand|Transportation;Mt CO2/yr;;SSP5 - High Emissions, SSP5 - Low Overshoot;;2030;-20%;-10%;10%;20%;;SSP5 - Medium Emissions;; +;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;; +CCS;;;;;;;;;;;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;World;2030;44.02;60.02;152.47;457.89;;;;Near-term vetting: Carbon Management +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Latin America (R10);2030;;6.36;28.84;;;;;https://github.com/pik-piam/mrremind/discussions/544 +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Rest of Asia (R10);2030;;0.00;20.91;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Africa (R10);2030;;0.00;2.24;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Europe (R10);2030;;1.12;110.60;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Middle East (R10);2030;;2.22;30.32;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Reforming Economies (R10);2030;;;0.00;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;Pacific OECD (R10);2030;;5.52;92.09;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;China+ (R10);2030;;2.01;12.95;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;India+ (R10);2030;;0.00;0.98;;;;; +absolute;yes;Carbon Capture|Storage;Mt CO2/yr;;;North America (R10);2030;;12.12;283.84;;;;; +Nuclear;;;;;;;;;;;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;World;2030;269.75;320.33;441.92;479.92;;;;Near-term vetting: Nuclear +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Latin America (R10);2030;;2.43;9.01;;;;;https://github.com/pik-piam/mrremind/discussions/540 +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Rest of Asia (R10);2030;;13.96;47.49;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Africa (R10);2030;;0.89;8.75;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Europe (R10);2030;;50.51;161.01;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Middle East (R10);2030;;3.00;10.09;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Reforming Economies (R10);2030;;20.42;67.86;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;Pacific OECD (R10);2030;;11.88;38.36;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;China+ (R10);2030;;26.89;115.25;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;India+ (R10);2030;;3.32;17.25;;;;; +absolute;yes;Capacity|Electricity|Nuclear;GW;;;North America (R10);2030;;46.54;135.73;;;;; +Hydro;;;;;;;;;;;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;World;2030;979.43;1175.37;1606.66;2117.58;;;;Near-term vetting: Hydro +absolute;yes;Capacity|Electricity|Hydro;GW;;;Latin America (R10);2030;;110.94;376.29;;;;;https://github.com/pik-piam/mrremind/discussions/541 +absolute;yes;Capacity|Electricity|Hydro;GW;;;Rest of Asia (R10);2030;;32.88;189.60;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;Africa (R10);2030;;15.30;96.39;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;Europe (R10);2030;;106.16;436.09;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;Middle East (R10);2030;;6.85;31.76;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;Reforming Economies (R10);2030;;37.74;135.95;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;Pacific OECD (R10);2030;;65.94;259.67;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;China+ (R10);2030;;201.24;832.12;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;India+ (R10);2030;;27.06;149.56;;;;; +absolute;yes;Capacity|Electricity|Hydro;GW;;;North America (R10);2030;;48.84;187.67;;;;; From 26408abbca0a7621d457666f65fd45141b439842 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Tue, 19 Nov 2024 16:07:26 +0100 Subject: [PATCH 5/5] increment version --- .buildlibrary | 3 ++- .github/workflows/check.yaml | 18 +++++++++--------- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- NAMESPACE | 1 - README.md | 6 +++--- man/validationHeatmap.Rd | 23 ++--------------------- 7 files changed, 20 insertions(+), 39 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index fb1a42b..a78411a 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '739445' +ValidationKey: '801840' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' @@ -11,3 +11,4 @@ AcceptedNotes: - Non-standard file/directory found at top level: output allowLinterWarnings: yes enforceVersionUpdate: no +skipCoverage: no diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index f6ea5d4..d85a316 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -23,14 +23,14 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: | - any::lucode2 - any::covr - any::madrat - any::magclass - any::citation - any::gms - any::goxygen - any::GDPuc + lucode2 + covr + madrat + magclass + citation + gms + goxygen + GDPuc # piam packages also available on CRAN (madrat, magclass, citation, # gms, goxygen, GDPuc) will usually have an outdated binary version # available; by using extra-packages we get the newest version @@ -63,6 +63,6 @@ jobs: shell: Rscript {0} run: | nonDummyTests <- setdiff(list.files("./tests/testthat/"), c("test-dummy.R", "_snaps")) - if(length(nonDummyTests) > 0) covr::codecov(quiet = FALSE) + if(length(nonDummyTests) > 0 && !lucode2:::loadBuildLibraryConfig()[["skipCoverage"]]) covr::codecov(quiet = FALSE) env: NOT_CRAN: "true" diff --git a/CITATION.cff b/CITATION.cff index 5199b96..58abbff 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: 'piamValidation: Validation Tools for PIK-PIAM' -version: 0.3.7 -date-released: '2024-09-19' +version: 0.4.0 +date-released: '2024-11-19' abstract: The piamValidation package provides validation tools for the Potsdam Integrated Assessment Modelling environment. authors: diff --git a/DESCRIPTION b/DESCRIPTION index a6728fd..73bb9ec 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: piamValidation Title: Validation Tools for PIK-PIAM -Version: 0.3.7 -Date: 2024-09-19 +Version: 0.4.0 +Date: 2024-11-19 Authors@R: c(person("Pascal", "Weigmann",, "pascal.weigmann@pik-potsdam.de", role = c("aut", "cre")), person("Oliver", "Richters",, role = "aut")) diff --git a/NAMESPACE b/NAMESPACE index d5c58bc..e481223 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,7 +19,6 @@ importFrom(dplyr,ungroup) importFrom(ggthemes,theme_tufte) importFrom(piamInterfaces,areUnitsIdentical) importFrom(piamutils,getSystemFile) -importFrom(plotly,ggplotly) importFrom(readxl,excel_sheets) importFrom(readxl,read_excel) importFrom(utils,read.csv2) diff --git a/README.md b/README.md index 9cb0d88..c698652 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Validation Tools for PIK-PIAM -R package **piamValidation**, version **0.3.7** +R package **piamValidation**, version **0.4.0** [![CRAN status](https://www.r-pkg.org/badges/version/piamValidation)](https://cran.r-project.org/package=piamValidation) [![R build status](https://github.com/pik-piam/piamValidation/workflows/check/badge.svg)](https://github.com/pik-piam/piamValidation/actions) [![codecov](https://codecov.io/gh/pik-piam/piamValidation/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/piamValidation) [![r-universe](https://pik-piam.r-universe.dev/badges/piamValidation)](https://pik-piam.r-universe.dev/builds) @@ -46,7 +46,7 @@ In case of questions / problems please contact Pascal Weigmann . +Weigmann P, Richters O (2024). _piamValidation: Validation Tools for PIK-PIAM_. R package version 0.4.0, . A BibTeX entry for LaTeX users is @@ -55,7 +55,7 @@ A BibTeX entry for LaTeX users is title = {piamValidation: Validation Tools for PIK-PIAM}, author = {Pascal Weigmann and Oliver Richters}, year = {2024}, - note = {R package version 0.3.7}, + note = {R package version 0.4.0}, url = {https://github.com/pik-piam/piamValidation}, } ``` diff --git a/man/validationHeatmap.Rd b/man/validationHeatmap.Rd index 7c58ab5..0519ea2 100644 --- a/man/validationHeatmap.Rd +++ b/man/validationHeatmap.Rd @@ -1,19 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/summaryHeatmap.R, R/validationHeatmap.R +% Please edit documentation in R/validationHeatmap.R \name{validationHeatmap} \alias{validationHeatmap} -\title{takes the output of "validateScenarios()" and plots heatmaps per variable} +\title{takes the output of "validateScenarios()" and plots heat maps per variable} \usage{ -validationHeatmap( - df, - main_dim = "variable", - x_plot = NULL, - y_plot = NULL, - x_facet = NULL, - y_facet = NULL, - interactive = TRUE -) - validationHeatmap( df, main_dim = "variable", @@ -42,16 +32,7 @@ is NULL, arrangement is chosen automatically based on data dimensions} \item{y_facet}{choose dimension to display on x-dim of facets} \item{interactive}{return plots as interactive plotly plots by default} - -\item{var}{variable to be plotted} - -\item{met}{choose metric from "relative", "difference", "absolute" or -"growthrate"} - -\item{historical}{should this be a plot comparing to historical data} } \description{ -takes the output of "validateScenarios()" and plots heatmaps per variable - takes the output of "validateScenarios()" and plots heat maps per variable }