Merge pull request #61 from r-hyperspec/feature/60-wl_create_label

Create function that creates wl labels

DESCRIPTION

@@ -145,7 +145,6 @@ Collate:
     'bind.R'
     'colMeans.R'
     'collapse.R'
-    'constants-units.R'
     'cov_pooled.R'
     'decomposition.R'
     'dim.R'
@@ -212,6 +211,7 @@ Collate:
     'wl.R'
     'wl_fix_unit_name.R'
     'wl_convert_units.R'
+    'wl_create_label_from_units.R'
     'wl_sort.R'
     'write_txt_long.R'
     'write_txt_wide.R'

NEWS.md

@@ -66,6 +66,7 @@
 * The default output of function `summary()` was changed (@GegznaV, cbeleites/hyperSpec#211).
 * New color palette `palette_colorblind` introduced (@bryanhanson).
 * Function `sample()` gains new argument `index`; `sample(..., index = TRUE)` replaced function `isample()` (@GegznaV, #17).
+* New function `wl_create_label_from_units()` that creates labels for wavelength axis (@GegznaV).
 
 
 ## Non-User-Facing Changes from 0.99 Series

R/wl_create_label_from_units.R

@@ -0,0 +1,192 @@
+# Function -------------------------------------------------------------------
+
+#' Create label from units for wavelength axis
+#'
+#' This function takes the name of units for wavelength axis and creates an
+#' R expression which can be used as a label for `@wavelength` axis for
+#' `hyperSpec` object.
+#'
+#' @param unit (character):
+#'        A name of unit for wavelength axis.
+#' @param greek (logical):
+#'        Should Greek symbols be preferred in the output expression?
+#' @param on_failure (string):
+#'        **Note:** This argument is still **experimental** and is only
+#'        intended to be used internally in \pkg{hyperSpec}.
+#'        The type of behavior in case unrecognized value of `unit` is passed:
+#' - `"fail"` -- the code is stopped with an error message.
+#' - `"warn"` -- a warning is issued and the value of `unit` is converted to an
+#'               expression and returned as an output.
+#' - `"pass"` -- the value of `unit` is converted to an expression and returned
+#'               as an output and no error nor warning is issued.
+#' - `"pass as-is"` -- the same as `"pass"`, just output is not converted into
+#'               an expression.
+#'
+#' @param null_ok (logical):
+#'        Should value `NULL` be accepted as `unit`.
+#'        This argument is passed to [.wl_fix_unit_name()].
+#'
+#' @author V. Gegzna
+#'
+#' @concept wavelengths
+#' @include wl_convert_units.R
+#'
+#' @export
+#'
+#' @examples
+#' wl_create_label_from_units("nm")
+#' wl_create_label_from_units("nm", greek = TRUE)
+#'
+#' wl_create_label_from_units("1/cm", greek = TRUE)
+#'
+wl_create_label_from_units <- function(unit, greek = FALSE, null_ok = FALSE,
+                                       on_failure = "warn") {
+
+  if (missing(unit)) stop("argument \"unit\" is missing")
+  on_failure <- match.arg(tolower(on_failure), c("fail", "warn", "pass", "pass as-is"))
+
+  u_fixed <- .wl_fix_unit_name(unit, null_ok = null_ok, on_failure = "pass")
+
+  if (greek) {
+    # At first, suffix "_greek" is removed if present to avoid duplication
+    u_fixed <- paste0(u_fixed, grep("_greek", "", u_fixed), "_greek")
+  }
+
+  switch(u_fixed,
+
+    nm               = expression("Wavelength, nm"),
+    nm_greek         = expression(list(lambda, nm)),
+
+    invcm            = expression(list(Wavenumber, cm^-1)), # expression("Wavenumber, 1/cm"),
+    invcm_greek      = expression(list(tilde(nu), cm^-1)),
+
+    # Possible alternative is expression(list(Wavenumber ~ shift, cm^-1))
+    raman            = expression(list(Raman ~ shift, cm^-1)),
+    raman_greek      = expression(list(Delta * tilde(nu), cm^-1)),
+
+    ev               = expression("Energy, eV"),
+    ev_greek         = expression("E, eV"),
+
+    freq             = expression("Frequency, THz"), # FIXME: why `freq` and not THz?
+    freq_greek       = expression(list(nu, THz)),
+
+    # Otherwise:
+    {
+      msg <- paste0(
+        "Value '", unit,
+        "' of argument 'unit' cannot be converted to any standard value."
+      )
+
+      switch(on_failure,
+
+        fail = stop(msg),
+
+        warn = {
+          warning(
+            msg, "\n",
+            "So it will be converted to an expression and ",
+            "returned as function's output."
+          )
+          as.expression(unit)
+        },
+
+        pass = as.expression(unit),
+
+        "pass as-is" = unit
+      )
+    }
+  )
+}
+
+# Unit tests -----------------------------------------------------------------
+
+hySpc.testthat::test(wl_create_label_from_units) <- function() {
+  context("wl_create_label_from_units")
+
+  test_that("wl_create_label_from_units() works", {
+    expect_silent(wl_create_label_from_units("nm"))
+  })
+
+  test_that("wl_create_label_from_units() works with unit names (Greek)", {
+    # nm Greek
+    expect_silent(lbl <- wl_create_label_from_units("nm", greek = TRUE))
+    expect_equal(class(lbl), "expression")
+    expect_equal(lbl, expression(list(lambda, nm)))
+
+    expect_equal(
+      wl_create_label_from_units("invcm", greek = TRUE),
+      expression(list(tilde(nu), cm^-1))
+    )
+
+    expect_equal(
+      wl_create_label_from_units("Raman shift", greek = TRUE),
+      expression(list(Delta * tilde(nu), cm^-1))
+    )
+
+    expect_equal(
+      wl_create_label_from_units("eV", greek = TRUE),
+      expression("E, eV")
+    )
+
+    expect_equal(
+      wl_create_label_from_units("THz", greek = TRUE),
+      expression(list(nu, THz))
+    )
+  })
+
+  test_that("wl_create_label_from_units() works with unit names (text)", {
+    # nm Text
+    expect_silent(lbl <- wl_create_label_from_units("nm", greek = FALSE))
+    expect_equal(class(lbl), "expression")
+    expect_equal(lbl, expression("Wavelength, nm"))
+
+    expect_equal(
+      wl_create_label_from_units("invcm", greek = FALSE),
+      expression(list(Wavenumber, cm^-1))
+    )
+
+    expect_equal(
+      wl_create_label_from_units("Raman shift", greek = FALSE),
+      expression(list(Raman ~ shift, cm^-1))
+    )
+
+    expect_equal(
+      wl_create_label_from_units("eV", greek = FALSE),
+      expression("Energy, eV")
+    )
+
+    expect_equal(
+      wl_create_label_from_units("THz", greek = FALSE),
+      expression("Frequency, THz")
+    )
+
+  })
+
+
+  test_that("wl_create_label_from_units() fails correnctly", {
+
+    expect_error(wl_create_label_from_units(), "argument \"unit\" is missing")
+
+    expect_error(
+      wl_create_label_from_units("WARNING!", on_failure = "fail"),
+      "'unit' cannot be converted to any standard value"
+    )
+
+    expect_warning(
+      wl_create_label_from_units("WARNING!", on_failure = "warn"),
+      "'unit' cannot be converted to any standard value"
+    )
+
+    expect_equal(
+      wl_create_label_from_units("WARNING!", on_failure = "pass"),
+      as.expression("WARNING!")
+    )
+
+    expect_equal(
+      wl_create_label_from_units("WARNING!", on_failure = "pass as-is"),
+      "WARNING!"
+    )
+
+  })
+}
+

R/wl_fix_unit_name.R

@@ -5,8 +5,8 @@
 #' can be used as a standardized argument value for other \pkg{hyperSpec}
 #' functions, e.g., [wl_convert_units()].
 #'
-#' **Note:** This function is usually used internally in other \pkg{hyperSpec}
-#'           functions.
+#' **Note:** This function is only intended to be used internally in
+#'           \pkg{hyperSpec} package.
 #'
 #' @param unit (sting):
 #'        A name, abbreviation or shot description of unit for wavelength axis.
@@ -95,7 +95,7 @@
 }
 
 
-#' # Unit tests -----------------------------------------------------------------
+# Unit tests -----------------------------------------------------------------
 
 hySpc.testthat::test(.wl_fix_unit_name) <- function() {
   context(".wl_fix_unit_name")