From d7e73db7b61bb78cb7bb1561d03ebd578f7fd53e Mon Sep 17 00:00:00 2001
From: Michaja Pehl <pehl@pik-potsdam.de>
Date: Tue, 9 Jul 2024 14:12:45 +0200
Subject: [PATCH] plotstyle() does not strip units from variable names, based
 on strip_units argument or plotstyle.strip_units option

---
 DESCRIPTION                     |  5 +++--
 R/mip-package.R                 | 12 ++++++++----
 R/plotstyle.R                   | 15 ++++++++++++---
 tests/testthat/test-plotstyle.R | 15 +++++++++++++++
 4 files changed, 38 insertions(+), 9 deletions(-)
 create mode 100644 tests/testthat/test-plotstyle.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 9b2624e..dcbd4a1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -25,7 +25,6 @@ Depends:
     magclass,
     quitte (>= 0.3072)
 Imports:
-    RColorBrewer,
     data.table,
     dplyr,
     ggplot2,
@@ -33,12 +32,14 @@ Imports:
     htmltools,
     lusweave (>= 1.43.2),
     plotly,
+    RColorBrewer,
     reshape2,
     rlang,
     shiny,
+    stringr,
     tidyr,
     trafficlight,
-    stringr
+    withr,
 Suggests:
     gdxrrw,
     knitr,
diff --git a/R/mip-package.R b/R/mip-package.R
index 01d621d..d5f09eb 100644
--- a/R/mip-package.R
+++ b/R/mip-package.R
@@ -1,14 +1,18 @@
 #' The MIP R package
-#' 
+#'
 #' Contains the routines for plotting multi model and multi scenario comparisons
-#' 
+#'
 #' \tabular{ll}{ Package: \tab mip\cr Type: \tab Package\cr Version: \tab
 #' 7.6\cr Date: \tab 2016-06-13\cr License: \tab LGPL-3\cr LazyLoad: \tab
 #' yes\cr }
-#' 
+#'
 #' @name mip-package
 #' @aliases mip-package mip
 #' @author David Klein
-#' 
+#'
 #' Maintainer: Anastasis Giannousakis <giannou@@pik-potsdam.de>
 "_PACKAGE"
+
+ignore_unused_imports <- function() {
+  withr::with_options # used in tests
+}
diff --git a/R/plotstyle.R b/R/plotstyle.R
index 2ba054e..82b73ff 100644
--- a/R/plotstyle.R
+++ b/R/plotstyle.R
@@ -3,6 +3,7 @@
 #' Returns a named vector (using entity names) with style codes (e.g. colors)
 #' for given entities.
 #'
+#' @md
 #' @param ... One or more strings or a vector of strings with names of entities
 #'   (regions, variable names, etc.). Units in brackets "(US$2005/GJ)" will be
 #'   ignored. If left empty all available entities will be used
@@ -21,6 +22,9 @@
 #'   entities are expanded, non-matching entities are returned as the original
 #'   expression.  Does not generate default color maps. Implies \code{plot =
 #'   FALSE} and \code{verbosity = 0}.
+#' @param strip_units If `TRUE` everything from the first opening
+#'   brace (`'('`) on is stripped from the entity names.  Defaults to `TRUE` and
+#'   can be set globally using the `plotstyle.strip_units` option.
 #' @return Plot styles for given entities
 #' @section Colors for unknown entities:
 #' \if{html}{\figure{colors.png}{options: width="100\%"}}
@@ -49,8 +53,11 @@
 #' @importFrom grDevices colorRampPalette
 #' @importFrom stats runif
 
-plotstyle <- function(..., out = "color", unknown = NULL, plot = FALSE, verbosity = getOption("plotstyle.verbosity"),
-                      regexp = FALSE) {
+plotstyle <- function(..., out = "color", unknown = NULL, plot = FALSE,
+                      verbosity = getOption("plotstyle.verbosity"),
+                      regexp = FALSE,
+                      strip_units = getOption("plotstyle.strip_units",
+                                              default = TRUE)) {
 
   luplot <- list()
   luplot$plotstyle <- read.csv2(
@@ -73,7 +80,9 @@ plotstyle <- function(..., out = "color", unknown = NULL, plot = FALSE, verbosit
     entity <- row.names(luplot$plotstyle)
   } else {
     entity[is.na(entity)] <- "NA"
-    entity <- unlist(lapply(strsplit(entity, " \\("), function(x) x[1]))
+    if (isTRUE(strip_units)) {
+      entity <- unlist(lapply(strsplit(entity, " \\("), function(x) x[1]))
+    }
   }
 
   uqEntity <- unique(entity)
diff --git a/tests/testthat/test-plotstyle.R b/tests/testthat/test-plotstyle.R
new file mode 100644
index 0000000..c830980
--- /dev/null
+++ b/tests/testthat/test-plotstyle.R
@@ -0,0 +1,15 @@
+test_that(
+  "plotstyle() does not strip units if told not to do so",
+  {
+    expect_identical(plotstyle("Forcing|CO2 (W/m2)"),
+                     c(`Forcing|CO2` = "#e6194B"))
+
+    expect_identical(plotstyle("Forcing|CO2 (W/m2)", strip_units = FALSE),
+                     c(`Forcing|CO2 (W/m2)` = "#e6194B"))
+
+    withr::with_options(
+      list('plotstyle.strip_units' = FALSE),
+      expect_identical(plotstyle("Forcing|CO2 (W/m2)"),
+                     c(`Forcing|CO2 (W/m2)` = "#e6194B"))
+    )
+  })