Merge pull request pik-piam#84 from tonnrueter/master

Function plots median values of user selected variables as well as 33th-67th and 5th-95th percentiles side-by-side across scenarios

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '29335712'
+ValidationKey: '29374785'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'
@@ -11,3 +11,4 @@ AcceptedNotes:
 - checking installed package size
 AutocreateReadme: yes
 allowLinterWarnings: yes
+enforceVersionUpdate: no

.github/workflows/check.yaml

@@ -49,6 +49,11 @@ jobs:
         shell: Rscript {0}
         run: lucode2:::validkey(stopIfInvalid = TRUE)
 
+      - name: Verify that lucode2::buildLibrary was successful
+        if: github.event_name == 'pull_request'
+        shell: Rscript {0}
+        run: lucode2:::isVersionUpdated()
+
       - name: Checks
         shell: Rscript {0}
         run: |

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.148.4
-date-released: '2024-02-15'
+version: 0.148.5
+date-released: '2024-02-28'
 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.148.4
-Date: 2024-02-15
+Version: 0.148.5
+Date: 2024-02-28
 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/mipLineHistorical.R

@@ -239,8 +239,7 @@ mipLineHistorical <- function(x,x_hist=NULL,color.dim="identifier",linetype.dim=
       axis.text.x=element_text(size=text_size, angle=90, hjust=.5, colour="black"),
       legend.position="bottom",
       legend.direction = "horizontal",
-      legend.title=element_text(size=text_size,face="bold"),
-      legend.title.align=0,
+      legend.title=element_text(size=text_size,face="bold",hjust=0),
       legend.text=element_text(size=text_size-2),
       #legend.background=element_rect(fill="white"),
       legend.key=element_blank(),

R/plotPercentiles.R

@@ -0,0 +1,122 @@
+#' Comparison line plots with percentiles
+#'
+#' Line plots show median (50th percentile) of user selected variable(s) obtained from different scenario runs. If
+#' available in the data, ribbon plots will also show the 33th - 67th percentile region in a darker color and the
+#' 5th – 95th percentile region in a lighter color. Note: the 5th, 33th, 67th and 95th percentiles must be provided in
+#' the data set as the percentiles are not computed
+#'
+#' @author Tonn Rüter
+#' @param df The \code{quitte}-style data frame must contain all percentiles of the quantity of interest as individual
+#'    variables (e.g. for atmospheric CO2 concentrations "Atmospheric Concentrations|CO2|50th Percentile",
+#'    "Atmospheric Concentrations|CO2|33th Percentile", ..., must be present)
+#' @param scenarios Character vector containing names of the desired scenarios. If \code{NULL}, all scenarios present in
+#'    the data will be displayed
+#' @param variables Character vector containing names of the desired variables. If \code{NULL}, all variables present in
+#'    the data will be displayed. When selecting particular variables for display only use the "Any|Variable"-prefix and
+#'    omit the "X-th Percentile"-suffix (e.g. for atmospheric CO2 concentrations write "Atmospheric Concentrations|CO2")
+#' @examples
+#' \dontrun{
+#' # Plot atmospheric CO2 concentrations for all scenarios available in the data
+#' p <- plotPercentiles(
+#'   data,
+#'   # Use variable name without "X-th Percentile"-suffix
+#'   variables = c("AR6 climate diagnostics|Atmospheric Concentrations|CO2|MAGICCv7.5.3")
+#' )
+#' # Plot all available variables for selected scenarios
+#' p <- plotPercentiles(data, scenarios = c("d_delfrag", "d_another"))
+#' }
+#' @section Example Plot:
+#' \if{html}{\figure{plotPercentiles1.png}{Atmospheric CO2 concentrations for all scenarios available in the data}}
+#' @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.148.4**
+R package **mip**, version **0.148.5**
 
 [![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 (2024). _mip: Comparison of multi-model runs_. doi:10.5281/zenodo.1158586 <https://doi.org/10.5281/zenodo.1158586>, R package version 0.148.4, <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.5, <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},
+  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.4},
+  note = {R package version 0.148.5},
   doi = {10.5281/zenodo.1158586},
   url = {https://github.com/pik-piam/mip},
 }