From f0316b87f418c5abb72da33d11c3b541f889610c Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Fri, 24 May 2024 10:59:33 +0200 Subject: [PATCH 1/3] clean up reports --- inst/markdown/validation_ARIADNE.Rmd | 108 ---------------- inst/markdown/validation_COMMITTED.Rmd | 158 ----------------------- inst/markdown/validation_NGFS.Rmd | 157 ----------------------- inst/markdown/validation_REMIND.Rmd | 161 ----------------------- inst/markdown/validation_default.Rmd | 171 ------------------------- 5 files changed, 755 deletions(-) delete mode 100644 inst/markdown/validation_ARIADNE.Rmd delete mode 100644 inst/markdown/validation_COMMITTED.Rmd delete mode 100644 inst/markdown/validation_NGFS.Rmd delete mode 100644 inst/markdown/validation_REMIND.Rmd delete mode 100644 inst/markdown/validation_default.Rmd diff --git a/inst/markdown/validation_ARIADNE.Rmd b/inst/markdown/validation_ARIADNE.Rmd deleted file mode 100644 index ab1a48c..0000000 --- a/inst/markdown/validation_ARIADNE.Rmd +++ /dev/null @@ -1,108 +0,0 @@ ---- -title: "piamValidation: ARIADNE" -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(m, "\n")) -``` - -Using config: - -`r params$cfg` - -```{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) -``` - - -### Historisch - KSG - -Vergleich zu - -- Historischer Wert UBA (2020) -- KSG (2030) - -Ab 10% Abweichung: gelb, ab 20% Abweichung: rot - - -```{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 = T) - } - plot_list -} -``` - - -### Projektionsbericht 2024 - MMS - -Comparison to MMS Scenario from Projektionsbericht 2024 - -source: https://www.umweltbundesamt.de/dokument/datenanhang-kernindikatoren-projektionsbericht-2024 - -```{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 = T) - } - plot_list -} -``` diff --git a/inst/markdown/validation_COMMITTED.Rmd b/inst/markdown/validation_COMMITTED.Rmd deleted file mode 100644 index 77c7eab..0000000 --- a/inst/markdown/validation_COMMITTED.Rmd +++ /dev/null @@ -1,158 +0,0 @@ ---- -title: "piamValidation: COMMITTED" -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 - - -```{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/validation_NGFS.Rmd b/inst/markdown/validation_NGFS.Rmd deleted file mode 100644 index 102e12f..0000000 --- a/inst/markdown/validation_NGFS.Rmd +++ /dev/null @@ -1,157 +0,0 @@ ---- -title: "piamValidation: NGFS" -date: "`r format(Sys.Date())`" -output: - html_document: - toc: true - toc_float: true - code_folding: hide -params: - mif: "" - ref: "" - 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, - #fig.width = params$figWidth, - message = params$message, - warning = params$warning -) - -``` - -## Import and Prepare Data - - -```{r, message = FALSE} -# Data Preparatio -df <- validateScenarios(scenarioPath, config) -df <- appendTooltips(df) - -# remove all-green rows (all regions green) -df_noGreen <- df[df$check != "green", ] -df_noGreennoGrey <- df[df$check %in% c("red", "yellow"), ] - -df <- df_noGreennoGrey -``` - - -## 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/validation_REMIND.Rmd b/inst/markdown/validation_REMIND.Rmd deleted file mode 100644 index a3fb0fa..0000000 --- a/inst/markdown/validation_REMIND.Rmd +++ /dev/null @@ -1,161 +0,0 @@ ---- -title: "piamValidation: REMIND" -date: "`r format(Sys.Date())`" -output: - html_document: - toc: true - toc_float: true - code_folding: hide -params: - mif: "" - ref: "" - 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, - #fig.width = params$figWidth, - message = params$message, - warning = params$warning -) -``` - -## Import and Prepare Data - - -```{r, message = FALSE} -# Data Preparation -df <- validateScenarios(mifs, config, referencePath = hmif) -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") -dt <- 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) - } - 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) - } - 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) - } - 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) - } - 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) - } - 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) - } - plot_list -} -``` diff --git a/inst/markdown/validation_default.Rmd b/inst/markdown/validation_default.Rmd deleted file mode 100644 index 738cddd..0000000 --- a/inst/markdown/validation_default.Rmd +++ /dev/null @@ -1,171 +0,0 @@ ---- -title: "piamValidation: default report" -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) - } - 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) - } - 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) - } - 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) - } - 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) - } - 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) - } - plot_list -} -``` From aa2c72430bd4bba5ae62a17f59f7184c4179137e Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Fri, 24 May 2024 11:02:30 +0200 Subject: [PATCH 2/3] improve file handling --- DESCRIPTION | 1 + NAMESPACE | 1 + R/combineData.R | 2 +- R/importFunctions.R | 3 +- R/validationReport.R | 47 ++++-- inst/markdown/validationReport_NGFS.Rmd | 171 +++++++++++++++++++++ inst/markdown/validationReport_default.Rmd | 171 +++++++++++++++++++++ man/validationReport.Rd | 6 +- 8 files changed, 386 insertions(+), 16 deletions(-) create mode 100644 inst/markdown/validationReport_NGFS.Rmd create mode 100644 inst/markdown/validationReport_default.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index ee613b6..a412f15 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,6 +16,7 @@ Imports: ggthemes, htmltools, knitr, + piamutils, plotly, quitte (>= 0.3123.0), readxl, diff --git a/NAMESPACE b/NAMESPACE index fddb1b7..8402b0b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,7 @@ importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(dplyr,summarise) importFrom(ggthemes,theme_tufte) +importFrom(piamutils,getSystemFile) importFrom(plotly,ggplotly) importFrom(readxl,excel_sheets) importFrom(readxl,read_excel) diff --git a/R/combineData.R b/R/combineData.R index 5179188..df3abef 100644 --- a/R/combineData.R +++ b/R/combineData.R @@ -14,7 +14,7 @@ combineData <- function(data, cfgRow, histData = NULL) { all_reg <- unique(data$region) all_per <- unique(data$period) # not a factor, convert? all_per <- all_per[all_per <= 2100] - # TODO: take ref_per from ref_data for current var + # TODO: check if this works well ref_per <- c(2005, 2010, 2015, 2020) diff --git a/R/importFunctions.R b/R/importFunctions.R index ae7f197..cf5e520 100644 --- a/R/importFunctions.R +++ b/R/importFunctions.R @@ -28,7 +28,8 @@ getConfig <- function(configName) { path <- normalizePath(configName) } if (path == "") stop("Config not found, please provide either full path to a - config file or choose a config from 'inst/config'.") + config file or select a config from 'inst/config' by choosing its + name ('validationConfig_.csv'.\n") # config can be .xlsx or .csv, use "config" sheet in .xlsx if available if (grepl("\\.xlsx$", path)) { diff --git a/R/validationReport.R b/R/validationReport.R index 304b85f..4302403 100644 --- a/R/validationReport.R +++ b/R/validationReport.R @@ -2,36 +2,59 @@ #' #' @param dataPath one or multiple path(s) to scenario data in .mif or .csv #' format -#' @param config name of a config from inst/config -#' @param report specify which .Rmd file should be used to create report +#' @param config name a config from inst/config ("validationConfig_.csv") +#' or give a full path to a separate configuration file +#' @param report name a .Rmd from inst/markdown ("validationReport_.Rmd") +#' to be rendered or give a full path to a separate .Rmd file +#' +#' @importFrom piamutils getSystemFile #' #' @export validationReport <- function(dataPath, config, report = "default") { - # convert relative to absolute paths dataPath <- normalizePath(dataPath) - # for config only if no config in inst/config was chosen + # user has the option to enter name of files that are shipped with package + # or provide full paths to manually created files for config and report + if (file.exists(normalizePath(config, mustWork = F))) { + # full path to config given config <- normalizePath(config) + config_name <- "Custom" + } else { + # name of config file in inst/config given + config_name <- config } - yamlParams <- list(mif = dataPath, cfg = config) - - report_name <- paste0("validation_", report) + if (file.exists(normalizePath(report, mustWork = F))) { + # full path to report given + report_path <- normalizePath(report) + report_name <- "Custom" + } else { + # name of report file in inst/markdown given + report_path <- piamutils::getSystemFile( + paste0("markdown/validationReport_", report, ".Rmd"), + package = "piamValidation") + report_name <- report + } + # put rendered reports in output folder in working directory output_path <- paste0(getwd(), "/output") if (!dir.exists(output_path)) dir.create(output_path) - # create default report for given data - rmarkdown::render(paste0(path.package("piamValidation"), - "/markdown/", report_name, ".Rmd"), + # include chosen config and report name in output file except if it is default + infix <- "" + if (config_name != "default") infix <- paste0(infix, "_cfg", config_name) + if (report_name != "default") infix <- paste0(infix, "_rep", report_name) + + # create specified report for given data and config + yamlParams <- list(mif = dataPath, cfg = config) + rmarkdown::render(input = report_path, params = yamlParams, - output_file = paste0(output_path, "/", report_name, + output_file = paste0(output_path, "/validation", infix, format(Sys.time(), "_%Y%m%d-%H%M%S"), ".html")) - } diff --git a/inst/markdown/validationReport_NGFS.Rmd b/inst/markdown/validationReport_NGFS.Rmd new file mode 100644 index 0000000..7b3e959 --- /dev/null +++ b/inst/markdown/validationReport_NGFS.Rmd @@ -0,0 +1,171 @@ +--- +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 new file mode 100644 index 0000000..738cddd --- /dev/null +++ b/inst/markdown/validationReport_default.Rmd @@ -0,0 +1,171 @@ +--- +title: "piamValidation: default report" +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) + } + 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) + } + 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) + } + 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) + } + 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) + } + 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) + } + plot_list +} +``` diff --git a/man/validationReport.Rd b/man/validationReport.Rd index d19abc4..63de0ba 100644 --- a/man/validationReport.Rd +++ b/man/validationReport.Rd @@ -10,9 +10,11 @@ validationReport(dataPath, config, report = "default") \item{dataPath}{one or multiple path(s) to scenario data in .mif or .csv format} -\item{config}{name of a config from inst/config} +\item{config}{name a config from inst/config ("validationConfig_.csv") +or give a full path to a separate configuration file} -\item{report}{specify which .Rmd file should be used to create report} +\item{report}{name a .Rmd from inst/markdown ("validationReport_.Rmd") +to be rendered or give a full path to a separate .Rmd file} } \description{ perform validateScenarios and create an .html report using .Rmd templates From 597b9c9bf58ad957d0f858a94622ed9c1af309d8 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Fri, 24 May 2024 11:17:29 +0200 Subject: [PATCH 3/3] increment version --- .buildlibrary | 3 ++- CITATION.cff | 4 ++-- DESCRIPTION | 4 ++-- NAMESPACE | 1 + README.md | 6 +++--- 5 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index d9f1ae7..30ff4da 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '555688' +ValidationKey: '576143' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' @@ -8,5 +8,6 @@ AcceptedNotes: - no visible binding for global variable - Found the following hidden files and directories: ~ - All declared Imports should be used. +- Non-standard file/directory found at top level: output allowLinterWarnings: yes enforceVersionUpdate: no diff --git a/CITATION.cff b/CITATION.cff index c16183c..34c135c 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.2.8 -date-released: '2024-05-03' +version: 0.2.9 +date-released: '2024-05-24' abstract: The piamValidation package provides validation tools for the Potsdam Integrated Assessment Modelling environment. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 31f970c..a05ebe4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: piamValidation Title: Validation Tools for PIK-PIAM -Version: 0.2.8 -Date: 2024-05-03 +Version: 0.2.9 +Date: 2024-05-24 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 8402b0b..9b8a889 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ import(ggplot2) importFrom(dplyr,"%>%") importFrom(dplyr,filter) importFrom(dplyr,group_by) +importFrom(dplyr,lag) importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(dplyr,summarise) diff --git a/README.md b/README.md index 37375b6..a700205 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Validation Tools for PIK-PIAM -R package **piamValidation**, version **0.2.8** +R package **piamValidation**, version **0.2.9** [![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.2.9, . 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.2.8}, + note = {R package version 0.2.9}, url = {https://github.com/pik-piam/piamValidation}, } ```