From 689f1affb5e5af2dfb31129176061e2ad7c32adc Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Thu, 19 Sep 2024 16:52:38 +0200 Subject: [PATCH 1/2] add extra colors for violating lower bounds --- R/evaluateThresholds.R | 61 ++++++++++++++++------ R/validateScenarios.R | 9 ++-- R/validationHeatmap.R | 10 ++-- R/validationReport.R | 6 ++- inst/markdown/validationReport_ELEVATE.Rmd | 9 ++-- inst/markdown/validationReport_default.Rmd | 9 ++-- man/validateScenarios.Rd | 5 +- man/validationReport.Rd | 11 +++- 8 files changed, 82 insertions(+), 38 deletions(-) diff --git a/R/evaluateThresholds.R b/R/evaluateThresholds.R index 16d437f..90eee07 100644 --- a/R/evaluateThresholds.R +++ b/R/evaluateThresholds.R @@ -2,7 +2,7 @@ # cleanInf = TRUE: replace "Inf" and "-Inf" which were introduced # for ease of calculations with "-" -evaluateThresholds <- function(df, cleanInf = TRUE) { +evaluateThresholds <- function(df, cleanInf = TRUE, extraColors = TRUE) { # first calculate values that will be compared to thresholds for each category # ("check_value") and metric separately, then perform evaluation for all together @@ -52,23 +52,54 @@ evaluateThresholds <- function(df, cleanInf = TRUE) { # evaluation #### # perform comparison to thresholds for whole data.frame at once # TODO: not as robust as previously thought. Partially fails if only max_red is given - df <- df %>% - mutate(check = ifelse(is.na(check_value) | is.infinite(check_value), - "grey", - ifelse( - # first check whether red threshold is violated... - check_value > max_red | check_value < min_red, - "red", - # otherwise check if yellow threshold is violated... + if (extraColors) { + df <- df %>% + mutate(check = ifelse(is.na(check_value) | is.infinite(check_value), + "grey", + # check thresholds from low to high ifelse( - check_value > max_yel | check_value < min_yel, - "yellow", - # ... else green - "green" + # first check whether min red is violated... + check_value < min_red, + "blue", + # then check if min yellow is violated... + ifelse( + check_value < min_yel, + "cyan", + # now check max thresholds, first yel... + ifelse( + check_value > max_red, + "red", + # then max red... + ifelse( + check_value > max_yel, + "yellow", + # ... else green + "green") + ) + ) ) ) - ) - ) + ) + } else { + # if only + df <- df %>% + mutate(check = ifelse(is.na(check_value) | is.infinite(check_value), + "grey", + ifelse( + # first check whether red threshold is violated... + check_value > max_red | check_value < min_red, + "red", + # otherwise check if yellow threshold is violated... + ifelse( + check_value > max_yel | check_value < min_yel, + "yellow", + # ... else green + "green" + ) + ) + ) + ) + } if (any(is.infinite(df$check_value))) { cat( diff --git a/R/validateScenarios.R b/R/validateScenarios.R index 56867d4..2ee060d 100644 --- a/R/validateScenarios.R +++ b/R/validateScenarios.R @@ -6,11 +6,14 @@ #' file on your computer #' @param outputFile give name of output file in case results should be exported; #' include file extension +#' @param extraColors if TRUE, use cyan and blue for violation of min thresholds +#' instead of using the same colors as for max thresholds (yel and red) #' #' @importFrom dplyr filter select mutate group_by %>% bind_rows #' #' @export -validateScenarios <- function(dataPath, config, outputFile = NULL) { +validateScenarios <- function(dataPath, config, + outputFile = NULL, extraColors = TRUE) { data <- importScenarioData(dataPath) @@ -34,7 +37,7 @@ validateScenarios <- function(dataPath, config, outputFile = NULL) { # combine scenario data (and reference data if needed) with the respective # thresholds for each row of the config and bind all into one data.frame - # TODO: parallelization works but makes development harder + # TODO: parallelization works but makes development harder, likely not needed # future::plan(future::multisession, workers = parallel::detectCores()) valiData <- bind_rows( lapply(1:nrow(cfg), function(i) { @@ -49,7 +52,7 @@ validateScenarios <- function(dataPath, config, outputFile = NULL) { valiData <- resolveDuplicates(valiData) # perform actual checks and write results in new columns of data.frame - valiData <- evaluateThresholds(valiData) + valiData <- evaluateThresholds(valiData, extraColors = extraColors) if (nrow(valiData) == 0) { stop("Something went wrong, returned data.frame is empty.") diff --git a/R/validationHeatmap.R b/R/validationHeatmap.R index f32603a..b2cffae 100644 --- a/R/validationHeatmap.R +++ b/R/validationHeatmap.R @@ -94,10 +94,12 @@ validationHeatmap <- function(df, # } d$period <- as.character(d$period) - colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - grey = "#808080") + 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 diff --git a/R/validationReport.R b/R/validationReport.R index 1df4f3e..4d6dbcb 100644 --- a/R/validationReport.R +++ b/R/validationReport.R @@ -7,13 +7,15 @@ #' @param report name a .Rmd from inst/markdown ("validationReport_.Rmd") #' to be rendered or give a full path to a separate .Rmd file #' @param outputDir choose a directory to save validation reports to +#' @param extraColors if TRUE, use cyan and blue for violation of min thresholds +#' instead of using the same colors as for max thresholds (yel and red) #' #' @importFrom piamutils getSystemFile #' #' @export validationReport <- function(dataPath, config, report = "default", - outputDir = "output") { + outputDir = "output", extraColors = TRUE) { # convert relative to absolute paths dataPath <- normalizePath(dataPath) @@ -52,7 +54,7 @@ validationReport <- function(dataPath, config, report = "default", if (reportName != "default") infix <- paste0(infix, "_rep", reportName) # create specified report for given data and config - yamlParams <- list(mif = dataPath, cfg = config) + yamlParams <- list(mif = dataPath, cfg = config, extraColors = extraColors) rmarkdown::render(input = reportPath, params = yamlParams, output_file = paste0(outputPath, "/validation", infix, diff --git a/inst/markdown/validationReport_ELEVATE.Rmd b/inst/markdown/validationReport_ELEVATE.Rmd index 6359f55..a9193ee 100644 --- a/inst/markdown/validationReport_ELEVATE.Rmd +++ b/inst/markdown/validationReport_ELEVATE.Rmd @@ -9,6 +9,7 @@ output: params: mif: "" cfg: "" + extraColors: true warning: false message: false figWidth: 8 @@ -47,7 +48,7 @@ cat(params$cfg, "\n") ```{r, message = FALSE, warning = TRUE} # Data Preparation -df <- validateScenarios(params$mif, params$cfg) +df <- validateScenarios(params$mif, params$cfg, extraColors = params$extraColors) df <- appendTooltips(df) ``` @@ -55,11 +56,7 @@ df <- appendTooltips(df) ### Summary ```{r} -# find "critical == yes" data points, that are red/yellow -colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - grey = "#808080") +# find "critical == yes" data points of each color dplyr::count(df, critical, check) ``` diff --git a/inst/markdown/validationReport_default.Rmd b/inst/markdown/validationReport_default.Rmd index e343ad2..440b739 100644 --- a/inst/markdown/validationReport_default.Rmd +++ b/inst/markdown/validationReport_default.Rmd @@ -9,6 +9,7 @@ output: params: mif: "" cfg: "" + extraColors: true warning: false message: false figWidth: 8 @@ -47,7 +48,7 @@ cat(params$cfg, "\n") ```{r, message = FALSE, warning = TRUE} # Data Preparation -df <- validateScenarios(params$mif, params$cfg) +df <- validateScenarios(params$mif, params$cfg, extraColors = params$extraColors) df <- appendTooltips(df) ``` @@ -55,11 +56,7 @@ df <- appendTooltips(df) ### Summary ```{r} -# find "critical == yes" data points, that are red/yellow -colors <- c(green = "#008450", - yellow = "#EFB700", - red = "#B81D13", - grey = "#808080") +# find "critical == yes" data points of each color dplyr::count(df, critical, check) ``` diff --git a/man/validateScenarios.Rd b/man/validateScenarios.Rd index a55a03e..fb9583d 100644 --- a/man/validateScenarios.Rd +++ b/man/validateScenarios.Rd @@ -4,7 +4,7 @@ \alias{validateScenarios} \title{performs the validation checks from a config on a scenario data set} \usage{ -validateScenarios(dataPath, config, outputFile = NULL) +validateScenarios(dataPath, config, outputFile = NULL, extraColors = TRUE) } \arguments{ \item{dataPath}{one or multiple path(s) to scenario data in .mif or .csv @@ -15,6 +15,9 @@ file on your computer} \item{outputFile}{give name of output file in case results should be exported; include file extension} + +\item{extraColors}{if TRUE, use cyan and blue for violation of min thresholds +instead of using the same colors as for max thresholds (yel and red)} } \description{ performs the validation checks from a config on a scenario data set diff --git a/man/validationReport.Rd b/man/validationReport.Rd index 19abf14..abce097 100644 --- a/man/validationReport.Rd +++ b/man/validationReport.Rd @@ -4,7 +4,13 @@ \alias{validationReport} \title{perform validateScenarios and create an .html report using .Rmd templates} \usage{ -validationReport(dataPath, config, report = "default", outputDir = "output") +validationReport( + dataPath, + config, + report = "default", + outputDir = "output", + extraColors = TRUE +) } \arguments{ \item{dataPath}{one or multiple path(s) to scenario data in .mif or .csv @@ -17,6 +23,9 @@ or give a full path to a separate configuration file} to be rendered or give a full path to a separate .Rmd file} \item{outputDir}{choose a directory to save validation reports to} + +\item{extraColors}{if TRUE, use cyan and blue for violation of min thresholds +instead of using the same colors as for max thresholds (yel and red)} } \description{ perform validateScenarios and create an .html report using .Rmd templates From a2f698f3b4ee4c6c5b7197011516b9a66d82caf6 Mon Sep 17 00:00:00 2001 From: Pascal Weigmann Date: Thu, 19 Sep 2024 16:54:47 +0200 Subject: [PATCH 2/2] increment version --- .buildlibrary | 2 +- CITATION.cff | 2 +- DESCRIPTION | 2 +- README.md | 6 +++--- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.buildlibrary b/.buildlibrary index 261f3bd..fb1a42b 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '719460' +ValidationKey: '739445' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/CITATION.cff b/CITATION.cff index 8164caf..5199b96 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,7 +2,7 @@ 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.6 +version: 0.3.7 date-released: '2024-09-19' abstract: The piamValidation package provides validation tools for the Potsdam Integrated Assessment Modelling environment. diff --git a/DESCRIPTION b/DESCRIPTION index b75ff06..a6728fd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: piamValidation Title: Validation Tools for PIK-PIAM -Version: 0.3.6 +Version: 0.3.7 Date: 2024-09-19 Authors@R: c(person("Pascal", "Weigmann",, "pascal.weigmann@pik-potsdam.de", role = c("aut", "cre")), diff --git a/README.md b/README.md index 96a3c69..9cb0d88 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Validation Tools for PIK-PIAM -R package **piamValidation**, version **0.3.6** +R package **piamValidation**, version **0.3.7** [![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.3.7, . 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.6}, + note = {R package version 0.3.7}, url = {https://github.com/pik-piam/piamValidation}, } ```