1#' Define or remove units
2#'
3#' Installing new symbols and/or names allows them to be used in \code{as_units},
4#' \code{make_units} and \code{set_units}. Optionally, a relationship can be
5#' defined between such symbols/names and existing ones (see details and examples).
6#'
7#' At least one symbol or name is expected, but multiple symbols and/or names
8#' can be installed (and thus mapped to the same unit) or removed at the same
9#' time. The \code{def} argument enables arbitrary relationships with existing
10#' units using UDUNITS-2 syntax:
11#' \tabular{llll}{
12#'   \strong{String Type} \tab \strong{Using Names} \tab \strong{Using Symbols}
13#'     \tab \strong{Comment}\cr
14#'   Simple \tab meter \tab m \tab \cr
15#'   Raised \tab meter^2 \tab m2 \tab
16#'     higher precedence than multiplying or dividing\cr
17#'   Product \tab newton meter \tab N.m \tab \cr
18#'   Quotient \tab meter per second \tab m/s \tab \cr
19#'   Scaled \tab 60 second \tab 60 s \tab \cr
20#'   Prefixed \tab kilometer \tab km \tab \cr
21#'   Offset \tab kelvin from 273.15 \tab K @ 273.15 \tab
22#'     lower precedence than multiplying or dividing\cr
23#'   Logarithmic \tab lg(re milliwatt) \tab lg(re mW) \tab
24#'     "lg" is base 10, "ln" is base e, and "lb" is base 2\cr
25#'   Grouped \tab (5 meter)/(30 second) \tab (5 m)/(30 s) \tab
26#' }
27#' The above may be combined, e.g., \code{"0.1 lg(re m/(5 s)^2) @ 50"}.
28#' You may also look at the \code{<def>} elements in the units database to see
29#' examples of string unit specifications.
30#'
31#' @param symbol a vector of symbols to be installed/removed.
32#' @param def either \itemize{
33#'   \item an empty definition, which defines a new base unit;
34#'   \item \code{"unitless"}, which defines a new dimensionless unit;
35#'   \item a relationship with existing units (see details for the syntax).
36#' }
37#' @param name a vector of names to be installed/removed.
38#'
39#' @examples
40#' # define a fortnight
41#' install_unit("fn", "2 week", "fortnight")
42#' year <- as_units("year")
43#' set_units(year, fn)        # by symbol
44#' set_units(year, fortnight) # by name
45#' # clean up
46#' remove_unit("fn", "fortnight")
47#'
48#' # working with currencies
49#' install_unit("dollar")
50#' install_unit("euro", "1.22 dollar")
51#' install_unit("yen", "0.0079 euro")
52#' set_units(as_units("dollar"), yen)
53#' # clean up
54#' remove_unit(c("dollar", "euro", "yen"))
55#'
56#' # an example from microbiology
57#' cfu_symbols <- c("CFU", "cfu")
58#' cfu_names <- c("colony_forming_unit", "ColonyFormingUnit")
59#' install_unit("cell")
60#' install_unit(cfu_symbols, "3.4 cell", cfu_names)
61#' cell <- set_units(2.5e5, cell)
62#' vol <- set_units(500, ul)
63#' set_units(cell/vol, "cfu/ml")
64#' set_units(cell/vol, "CFU/ml")
65#' set_units(cell/vol, "colony_forming_unit/ml")
66#' set_units(cell/vol, "ColonyFormingUnit/ml")
67#' # clean up
68#' remove_unit(c("cell", cfu_symbols), cfu_names)
69#'
70#' @export
71install_unit <- function(symbol=character(0), def=character(0), name=character(0)) {
72  stopifnot(is.character(def), length(def) < 2)
73  stopifnot(is.character(symbol), is.character(name))
74  if (!length(symbol) && !length(name))
75    stop("at least one symbol or name must be specified")
76
77  if (!length(def)) {
78    ut_unit <- R_ut_new_base_unit()
79  } else if (identical(def, "unitless")) {
80    ut_unit <- R_ut_new_dimensionless_unit()
81  } else {
82    ut_unit <- R_ut_parse(def)
83  }
84
85  R_ut_map_symbol_to_unit(symbol, ut_unit)
86  R_ut_map_name_to_unit(name, ut_unit)
87}
88
89#' @rdname install_unit
90#' @export
91remove_unit <- function(symbol=character(0), name=character(0)) {
92  stopifnot(is.character(symbol), is.character(name))
93  if (!length(symbol) && !length(name))
94    stop("at least one symbol or name must be specified")
95
96  R_ut_unmap_symbol_to_unit(symbol)
97  R_ut_unmap_name_to_unit(name)
98}
99
100#' Define new symbolic units
101#'
102#' Adding a symbolic unit allows it to be used in \code{as_units},
103#' \code{make_units} and \code{set_units}. No installation is performed if the
104#' unit is already known by udunits.
105#'
106#' @param name a length 1 character vector that is the unit name or symbol.
107#' @param warn warns if the supplied unit symbol is already a valid unit symbol
108#'   recognized by udunits.
109#' @param dimensionless logical; if \code{TRUE}, a new dimensionless unit is
110#' created, if \code{FALSE} a new base unit is created. Dimensionless units are
111#' convertible to other dimensionless units (such as \code{rad}), new base units
112#' are not convertible to other existing units.
113#'
114#' @details \code{install_symbolic_unit} installs a new dimensionless unit;
115#' these are directly compatible to any other dimensionless unit. To install a
116#' new unit that is a scaled or shifted version of an existing unit, use
117#' \code{install_conversion_constant} or \code{install_conversion_offset} directly.ç
118#'
119#' @export
120install_symbolic_unit <- function(name, warn = TRUE, dimensionless = TRUE) {# nocov start
121  .Deprecated("install_unit")
122  check_unit_format(name)
123
124  if(ud_is_parseable(name)) {
125    if (warn) warning(
126      sQuote(name), " is already a valid unit recognized by udunits; removing and reinstalling.")
127    remove_symbolic_unit(name)
128  }
129
130  ut_unit <- if (dimensionless)
131    R_ut_new_dimensionless_unit() else R_ut_new_base_unit()
132  R_ut_map_name_to_unit(name, ut_unit)
133
134  invisible(NULL)
135}# nocov end
136
137#' @export
138#' @rdname install_symbolic_unit
139remove_symbolic_unit <- function(name) {# nocov start
140  .Deprecated("remove_unit")
141	remove_unit(name=name)
142}# nocov end
143
144#' Install a conversion constant or offset between user-defined units.
145#'
146#' Tells the \code{units} package how to convert between units that
147#' have a linear relationship, i.e. can be related on the form \eqn{y = \alpha
148#' x} (constant) or \eqn{y = \alpha + x} (offset).
149#'
150#' @param from    String for the symbol of the unit being converted from.
151#' @param to      String for the symbol of the unit being converted to. One of
152#' \code{from} and \code{to} must be an existing unit name.
153#' @param const   The constant \eqn{\alpha} in the conversion.
154#'
155#' @details This function handles the very common case where units are related
156#'   through a linear function, that is, you can convert from one to the other
157#'   as \eqn{y = \alpha x}. Using this function, you specify that you
158#'   can go from values of type \code{from} to values of type \code{to} by
159#'   multiplying by a constant, or adding a constant.
160#'
161#' @export
162install_conversion_constant <- function(from, to, const) {# nocov start
163  .Deprecated("install_unit")
164  stopifnot(is.finite(const), const != 0.0)
165  if (! xor(ud_is_parseable(from), ud_is_parseable(to)))
166    stop("exactly one of (from, to) must be a known unit")
167  if (ud_is_parseable(to))
168    R_ut_scale(check_unit_format(from), to, as.double(const))
169  else
170    R_ut_scale(check_unit_format(to), from, 1.0 / as.double(const))
171}# nocov end
172
173#' @export
174#' @name install_conversion_constant
175install_conversion_offset <- function(from, to, const) {# nocov start
176  .Deprecated("install_unit")
177  stopifnot(is.finite(const))
178  if (! xor(ud_is_parseable(from), ud_is_parseable(to)))
179    stop("exactly one of (from, to) must be a known unit")
180  if (ud_is_parseable(to))
181    R_ut_offset(check_unit_format(from), to, -as.double(const))
182  else
183    R_ut_offset(check_unit_format(to), from, as.double(const))
184}# nocov end
185
186check_unit_format <- function(x) {# nocov start
187  cond <- c(
188    # leading and trailing numbers
189    grepl("^[[:space:]]*[0-9]+", x), grepl("[0-9]+[[:space:]]*$", x),
190    # arithmetic operators
191    grepl("\\+|\\-|\\*|\\/|\\^", x),
192    # intermediate spaces
193    grepl("[[:alnum:][:punct:]]+[[:space:]]+[[:alnum:][:punct:]]+", x)
194  )
195  if (any(cond))
196    stop("the following elements are not allowed in new unit names/symbols:\n",
197         "  - leading or trailing numbers\n",
198         "  - arithmetic operators\n",
199         "  - intermediate white spaces")
200  x
201}# nocov end
202