plotstyle() does not strip units from variable names, based on strip_…

…units argument or plotstyle.strip_units option

DESCRIPTION

@@ -25,20 +25,21 @@ Depends:
     magclass,
     quitte (>= 0.3072)
 Imports:
-    RColorBrewer,
     data.table,
     dplyr,
     ggplot2,
     gridExtra,
     htmltools,
     lusweave (>= 1.43.2),
     plotly,
+    RColorBrewer,
     reshape2,
     rlang,
     shiny,
+    stringr,
     tidyr,
     trafficlight,
-    stringr
+    withr,
 Suggests:
     gdxrrw,
     knitr,

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
+}

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)

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"))
+    )
+  })