Side-by-side plot of user selected variables across scenarios

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '28951650'
+ValidationKey: '29200400'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

CITATION.cff

@@ -2,8 +2,8 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'mip: Comparison of multi-model runs'
-version: 0.147.0
-date-released: '2023-12-04'
+version: 0.148.0
+date-released: '2024-01-08'
 abstract: Package contains generic functions to produce comparison plots of multi-model
   runs.
 authors:
@@ -30,6 +30,9 @@ authors:
   email: [email protected]
 - family-names: Richters
   given-names: Oliver
+- family-names: Rüter
+  given-names: Tonn
+  email: [email protected]
 license: BSD-2-Clause
 repository-code: https://github.com/pik-piam/mip
 doi: 10.5281/zenodo.1158586

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: mip
 Title: Comparison of multi-model runs
-Version: 0.147.0
-Date: 2023-12-04
+Version: 0.148.0
+Date: 2024-01-08
 Authors@R: c(
     person("David", "Klein", , "[email protected]", role = c("aut", "cre")),
     person("Jan Philipp", "Dietrich", , "[email protected]", role = "aut"),
@@ -11,7 +11,8 @@ Authors@R: c(
     person("Miodrag", "Stevanovic", , "[email protected]", role = "aut"),
     person("Stephen", "Wirth", , "[email protected]", role = "aut"),
     person("Pascal", "Führlich", , "[email protected]", role = "aut"),
-    person("Oliver", "Richters", role = "aut")
+    person("Oliver", "Richters", role = "aut"),
+    person("Tonn", "Rüter", , "[email protected]", role = "aut")
   )
 Description: Package contains generic functions to produce comparison
     plots of multi-model runs.
@@ -36,14 +37,14 @@ Imports:
     rlang,
     shiny,
     tidyr,
-    trafficlight
-Suggests: 
-    covr,
+    trafficlight,
+    stringr
+Suggests:
     gdxrrw,
     knitr,
     rmarkdown,
     testthat
-VignetteBuilder: 
+VignetteBuilder:
     knitr
 Encoding: UTF-8
 LazyData: yes

NAMESPACE

@@ -11,6 +11,7 @@ export(mipArea)
 export(mipBarYearData)
 export(mipIterations)
 export(mipLineHistorical)
+export(plotPercentiles)
 export(plotstyle)
 export(plotstyle.add)
 export(scenTool)
@@ -52,6 +53,7 @@ importFrom(dplyr,summarise)
 importFrom(dplyr,summarize)
 importFrom(dplyr,sym)
 importFrom(dplyr,ungroup)
+importFrom(dplyr,vars)
 importFrom(ggplot2,"%+replace%")
 importFrom(ggplot2,aes)
 importFrom(ggplot2,aes_)
@@ -72,6 +74,7 @@ importFrom(ggplot2,geom_col)
 importFrom(ggplot2,geom_hline)
 importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_ribbon)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,geom_vline)
 importFrom(ggplot2,ggplot)
@@ -191,8 +194,10 @@ importFrom(stats,median)
 importFrom(stats,na.omit)
 importFrom(stats,reshape)
 importFrom(stats,runif)
+importFrom(stringr,str_extract)
 importFrom(tidyr,crossing)
 importFrom(tidyr,drop_na)
+importFrom(tidyr,pivot_wider)
 importFrom(tidyr,unite)
 importFrom(tools,file_ext)
 importFrom(tools,file_path_sans_ext)

R/plotPercentiles.R

@@ -0,0 +1,108 @@
+#' Comparison plots show 50th percentile of user selected variables as obtained from different scenario runs. If
+#' available in the data, ribbon plots will also show the 33th - 67th percentile in a darker color and the 5th – 95th
+#' percentile in a lighter color. *Note*: the 5th, 33th, 67th and 95th percentile must be given in the provided data set
+#' as the percentiles are not computed
+
+#' @author Tonn Rueter
+#' @param df `quitte` style data frame containing all variables for each scenario. In the quitte data frame all
+#'    percentiles must be given as individual variables. Manipulate input data frame such that all percentiles
+#'    of a given quantity are transformed to individual columns.
+#' @param scenarios Character vector contains names of the desired scenarios. If none, all scenarios will be displayed
+#' @param variables Character vector contains names of the desired variables. If none, all variables will be displayed
+#'    Variable names in the quitte data frame need to follow the format "Any|Variable|50.0th Percentile". When
+#'    selecting variables for display only use the "Any|Variable"-prefix and omit the "X-th Percentile"-suffix
+#' @importFrom dplyr filter mutate vars
+#' @importFrom reshape2 melt
+#' @importFrom stringr str_extract
+#' @importFrom tidyr pivot_wider
+#' @importFrom ggplot2 ggplot geom_line geom_ribbon facet_wrap facet_grid theme ylab
+#' @export
+plotPercentiles <- function(df, scenarios = NULL, variables = NULL) {
+
+  # In the quitte data frame all percentiles are given as individual variables
+  # Manipulate input data frame such that all percentiles of a given quantity
+  # are transformed to individual columns. Variable names in the quitte data
+  # frame follow the format "Any|Variable|5.0th Percentile". The regular
+  # expressions below divide the variable name into the prefix and the
+  # percentile specifier
+  data <- df %>%
+    mutate(
+      "percentile" = stringr::str_extract(.data$variable, "[^\\|]+?$"),
+      "variable"   = gsub("\\|[^\\|]+$", "", .data$variable)
+    ) %>%
+    pivot_wider(
+      names_from = "percentile",
+      values_from = "value"
+    )
+
+  # Check which scenarios/variables are available
+  uniqueScenarios <- unique(data$scenario)
+  uniqueVariables <- unique(data$variable)
+
+  # Check which function parameters have been provided and default to unique values from the data frame in case none
+  # have. If scenarios/variables have been provided by user, check whether they are available in the data
+  if (!is.null(scenarios)) {
+    diffScenarios <- setdiff(scenarios, uniqueScenarios)
+    if (length(diffScenarios) > 0) {
+      stop(paste0("Missing scenarios: ", paste0(setdiff(scenarios, uniqueScenarios), collapse = ", "), "\n"))
+    }
+    theseScenarios <- scenarios
+  } else {
+    theseScenarios <- uniqueScenarios
+  }
+
+  if (!is.null(variables)) {
+    diffVariables <- setdiff(variables, uniqueVariables)
+    if (length(diffVariables) > 0) {
+      stop(paste0("Missing variables: ", paste0(diffVariables, collapse = ", "), "\n"))
+    }
+    theseVariables <- variables
+  } else {
+    theseVariables <- uniqueVariables
+  }
+
+  # Set up the plot
+  p <- ggplot()
+
+  # Fill plot by filtering for the requested variables and scenarios
+  for (thisVariable in theseVariables) {
+    for (thisScenario in theseScenarios) {
+      plotData <- filter(data, .data$variable == thisVariable & .data$scenario == thisScenario)
+      p <- p +
+        geom_line(
+          data = plotData, aes(x = .data$period, y = get("50.0th Percentile"))
+        ) +
+        geom_ribbon(
+          data = plotData, aes(x = .data$period, ymin = get("33.0th Percentile"), ymax = get("67.0th Percentile")),
+          fill = "#68788a", alpha = 0.5
+        ) +
+        geom_ribbon(
+          data = plotData, aes(x = .data$period, ymin = get("5.0th Percentile"), ymax = get("95.0th Percentile")),
+          fill = "#68788a", alpha = 0.2
+        )
+    }
+  }
+
+  # Depending on the function parameters, plots need to be arranged
+  if (length(theseScenarios) == 1) {
+    # Plots all parameters for a given scenario. Y-axes need to be independent
+    p <- p +
+      facet_wrap(vars(.data$variable), scales = "free_y", ncol = 1) +
+      theme(axis.title.x = element_blank()) +
+      ylab(unique(data$unit))
+  } else if (length(theseVariables) == 1) {
+    # Plots a given parameter for all scenarios. Lock y-axes to improve comparison
+    p <- p +
+      facet_wrap(vars(.data$scenario)) +
+      theme(axis.title.x = element_blank()) +
+      ylab(unique(data$unit))
+  } else {
+    # Using facet grid when multiple variables in multiple scenarios are compared
+    p <- p +
+      facet_grid(.data$variable ~ .data$scenario, scales = "free_y") +
+      theme(axis.title.x = element_blank()) +
+      ylab(unique(data$unit))
+  }
+
+  return(p)
+}

README.md

@@ -1,6 +1,6 @@
 # Comparison of multi-model runs
 
-R package **mip**, version **0.147.0**
+R package **mip**, version **0.148.0**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/mip)](https://cran.r-project.org/package=mip) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1158586.svg)](https://doi.org/10.5281/zenodo.1158586) [![R build status](https://github.com/pik-piam/mip/workflows/check/badge.svg)](https://github.com/pik-piam/mip/actions) [![codecov](https://codecov.io/gh/pik-piam/mip/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/mip) [![r-universe](https://pik-piam.r-universe.dev/badges/mip)](https://pik-piam.r-universe.dev/builds)
 
@@ -47,16 +47,16 @@ In case of questions / problems please contact David Klein <[email protected]
 
 To cite package **mip** in publications use:
 
-Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O (2023). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 <https://doi.org/10.5281/zenodo.1158586>, R package version 0.147.0, <https://github.com/pik-piam/mip>.
+Klein D, Dietrich J, Baumstark L, Humpenoeder F, Stevanovic M, Wirth S, Führlich P, Richters O, Rüter T (2024). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 <https://doi.org/10.5281/zenodo.1158586>, R package version 0.148.0, <https://github.com/pik-piam/mip>.
 
 A BibTeX entry for LaTeX users is
 
  ```latex
 @Manual{,
   title = {mip: Comparison of multi-model runs},
-  author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters},
-  year = {2023},
-  note = {R package version 0.147.0},
+  author = {David Klein and Jan Philipp Dietrich and Lavinia Baumstark and Florian Humpenoeder and Miodrag Stevanovic and Stephen Wirth and Pascal Führlich and Oliver Richters and Tonn Rüter},
+  year = {2024},
+  note = {R package version 0.148.0},
   doi = {10.5281/zenodo.1158586},
   url = {https://github.com/pik-piam/mip},
 }