diff --git a/NAMESPACE b/NAMESPACE index 92888e90..803283a0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -72,11 +72,13 @@ export(drop_units) export(install_conversion_constant) export(install_conversion_offset) export(install_symbolic_unit) +export(install_unit) export(load_units_xml) export(make_unit_label) export(make_units) export(mixed_units) export(remove_symbolic_unit) +export(remove_unit) export(set_units) export(ud_are_convertible) export(unitless) diff --git a/NEWS.md b/NEWS.md index 14e6bb5c..57d690a9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,11 @@ * add `load_units_xml` to enable database reloading as well as loading user-provided unit systems; #254 addressing #243, #244 +* add `install_unit` and `remove_unit` for adding/removing custom user-defined + symbols or names, with optional mapping to existing units; + `install_symbolic_unit`, `remove_symbolic_unit`, `install_conversion_constant`, + `install_conversion_offset` are deprecated; #261 addressing #89 + * export `ud_are_convertible`; #263 addressing #258 @cregouby * remove deprecations: `as.units`, `as_cf`, `make_unit`, `parse_unit`; #259 diff --git a/R/RcppExports.R b/R/RcppExports.R index a437e69c..898c94d4 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -13,8 +13,8 @@ R_ut_parse <- function(name) { .Call('_units_R_ut_parse', PACKAGE = 'units', name) } -R_ut_get_dimensionless_unit_one <- function(name) { - .Call('_units_R_ut_get_dimensionless_unit_one', PACKAGE = 'units', name) +R_ut_get_dimensionless_unit_one <- function() { + .Call('_units_R_ut_get_dimensionless_unit_one', PACKAGE = 'units') } R_ut_are_convertible <- function(a, b) { @@ -25,16 +25,12 @@ R_convert_doubles <- function(from, to, val) { .Call('_units_R_convert_doubles', PACKAGE = 'units', from, to, val) } -R_ut_new_dimensionless_unit <- function(name) { - invisible(.Call('_units_R_ut_new_dimensionless_unit', PACKAGE = 'units', name)) +R_ut_new_dimensionless_unit <- function() { + .Call('_units_R_ut_new_dimensionless_unit', PACKAGE = 'units') } -R_ut_new_base_unit <- function(name) { - invisible(.Call('_units_R_ut_new_base_unit', PACKAGE = 'units', name)) -} - -R_ut_remove_unit <- function(name) { - invisible(.Call('_units_R_ut_remove_unit', PACKAGE = 'units', name)) +R_ut_new_base_unit <- function() { + .Call('_units_R_ut_new_base_unit', PACKAGE = 'units') } R_ut_scale <- function(nw, old, d) { @@ -86,6 +82,18 @@ R_ut_get_name <- function(ustr) { } R_ut_map_name_to_unit <- function(name, inunit) { - .Call('_units_R_ut_map_name_to_unit', PACKAGE = 'units', name, inunit) + invisible(.Call('_units_R_ut_map_name_to_unit', PACKAGE = 'units', name, inunit)) +} + +R_ut_unmap_name_to_unit <- function(name) { + invisible(.Call('_units_R_ut_unmap_name_to_unit', PACKAGE = 'units', name)) +} + +R_ut_map_symbol_to_unit <- function(name, inunit) { + invisible(.Call('_units_R_ut_map_symbol_to_unit', PACKAGE = 'units', name, inunit)) +} + +R_ut_unmap_symbol_to_unit <- function(name) { + invisible(.Call('_units_R_ut_unmap_symbol_to_unit', PACKAGE = 'units', name)) } diff --git a/R/conversion.R b/R/conversion.R index 59f9c9f9..9496a457 100644 --- a/R/conversion.R +++ b/R/conversion.R @@ -142,7 +142,7 @@ as.data.frame.units <- function(x, row.names = NULL, optional = FALSE, ...) { #' @export as.list.units <- function(x, ...) - mapply(set_units, unclass(x), x, mode="standard", SIMPLIFY=FALSE) + lapply(NextMethod(), set_units, units(x), mode="standard") #' convert units object into difftime object #' diff --git a/R/make_units.R b/R/make_units.R index 04dd17e5..1117ab23 100644 --- a/R/make_units.R +++ b/R/make_units.R @@ -8,20 +8,20 @@ #' @name units #' @export -#' +#' #' @param bare_expression a bare R expression describing units. Must be valid R #' syntax (reserved R syntax words like \code{in} must be backticked) #' #' @examples -#' # The easiest way to assign units to a numeric vector is like this: +#' # The easiest way to assign units to a numeric vector is like this: #' x <- y <- 1:4 #' units(x) <- "m/s" # meters / second -#' +#' #' # Alternatively, the easiest pipe-friendly way to set units: #' if(requireNamespace("magrittr", quietly = TRUE)) { #' library(magrittr) #' y %>% set_units(m/s) -#' } +#' } #' #' # these are different ways of creating the same unit: #' # meters per second squared, i.e, acceleration @@ -44,8 +44,8 @@ #' } #' all_identical(x1, x2, x3, x4, x5, x6, x7, x8) #' -#' # Note, direct usage of these unit creation functions is typically not -#' # necessary, since coercion is automatically done via as_units(). Again, +#' # Note, direct usage of these unit creation functions is typically not +#' # necessary, since coercion is automatically done via as_units(). Again, #' # these are all equivalent ways to generate the same result. #' #' x1 <- x2 <- x3 <- x4 <- x5 <- x6 <- x7 <- x8 <- 1:4 @@ -90,24 +90,22 @@ #' # For example, a microbiologist might work with counts of bacterial cells #' # make_units(cells/ml) # by default, throws an ERROR #' # First define the unit, then the newly defined unit is accepted. -#' install_symbolic_unit("cells") -#' make_units(cells/ml) -#' -#' # Note, install_symbolic_unit() does not add any support for unit -#' # conversion, or arithmetic operations that require unit conversion. See -#' # ?install_conversion_constant for defining relationships between user -#' # defined units. +#' install_unit("cells") +#' make_units(cells/ml) +#' +#' # Note that install_unit() adds support for defining relationships between +#' # the newly created symbols or names and existing units. #' #' ## set_units() -#' # set_units is a pipe friendly version of `units<-`. +#' # set_units is a pipe friendly version of `units<-`. #' if(requireNamespace("magrittr", quietly = TRUE)) { #' library(magrittr) #' 1:5 %>% set_units(N/m^2) #' # first sets to m, then converts to km #' 1:5 %>% set_units(m) %>% set_units(km) #' } -#' -#' # set_units has two modes of operation. By default, it operates with +#' +#' # set_units has two modes of operation. By default, it operates with #' # bare symbols to define the units. #' set_units(1:5, m/s) #' @@ -116,10 +114,10 @@ #' # thought of as a simple alias for `units<-` that is pipe friendly. #' set_units(1:5, "m/s", mode = "standard") #' set_units(1:5, make_units(m/s), mode = "standard") -#' +#' #' # the mode of set_units() can be controlled via a global option #' # units_options(set_units_mode = "standard") -#' +#' #' # To remove units use #' units(x) <- NULL #' # or @@ -164,14 +162,14 @@ as_units.symbolic_units <- function(x, value, ...) { #' s = Sys.time() #' d = s - (s+1) #' as_units(d) -#' +#' #' @name units #' @export as_units.difftime <- function(x, value, ...) { u <- attr(x, "units") x <- unclass(x) attr(x, "units") <- NULL - + # convert from difftime to udunits2: if (u == "secs") # secs -> s x <- x * symbolic_unit("s") @@ -184,16 +182,16 @@ as_units.difftime <- function(x, value, ...) { else if (u == "weeks") { # weeks -> 7 days x <- 7 * x x <- x * symbolic_unit("d") - } else + } else stop(paste("unknown time units", u, "in difftime object")) - + if (!missing(value)) # convert optionally: units(x) <- value - + x } -# ----- as_units.character helpers ------ +# ----- as_units.character helpers ------ backtick <- function(x) { # backtick all character runs uninterupted by one of ^()*^/`- or a space @@ -204,7 +202,7 @@ backtick <- function(x) { are_exponents_implicit <- function(s) { s <- trimws(s) - has <- function(chr, regex = FALSE) + has <- function(chr, regex = FALSE) grepl(chr, s, fixed = !regex, perl = regex) !has("^") && !has("*") && !has("/") && has("\\s|\\D.*\\d$", regex = TRUE) } @@ -218,14 +216,14 @@ is_udunits_time <- function(s) { #' #' @param force_single_symbol Whether to perform no string parsing and force #' treatment of the string as a single symbol. -#' +#' #' @param implicit_exponents If the unit string is in product power form (e.g. #' \code{"km m-2 s-1"}). Defaults to \code{NULL}, in which case a guess is made #' based on the supplied string. Set to \code{TRUE} or \code{FALSE} if the guess is #' incorrect. #' #' @section Character strings: -#' +#' #' Generally speaking, there are 3 types of unit strings are accepted in #' \code{as_units} (and by extension, \code{`units<-`}). #' @@ -258,7 +256,7 @@ is_udunits_time <- function(s) { #' string, and unit symbol or names must be separated by a space. Each unit #' symbol may optionally be followed by a single number, specifying the power. #' For example \code{"m2 s-2"} is equivalent to \code{"(m^2)*(s^-2)"}. -#' +#' #' It must be noted that prepended numbers are supported too, but their #' interpretation slightly varies depending on whether they are separated from #' the unit string or not. E.g., \code{"1000 m"} is interpreted as magnitude @@ -273,26 +271,26 @@ is_udunits_time <- function(s) { #' users that work with udunits time data, e.g., with NetCDF files. Users are #' otherwise encouraged to use \code{R}'s date and time functionality provided #' by \code{Date} and \code{POSIXt} classes. -#' -as_units.character <- function(x, +#' +as_units.character <- function(x, check_is_valid = TRUE, - implicit_exponents = NULL, + implicit_exponents = NULL, force_single_symbol = FALSE, ...) { stopifnot(is.character(x), length(x) == 1) - + if(force_single_symbol || is_udunits_time(x)) return(symbolic_unit(x, check_is_valid = check_is_valid)) - + if(is.null(implicit_exponents)) implicit_exponents <- are_exponents_implicit(x) - + if(implicit_exponents) x <- convert_implicit_to_explicit_exponents(x) - + x <- backtick(x) o <- try(expr <- parse(text = x)[[1]], silent = TRUE) - + if(inherits(o, "try-error")) { warning("Could not parse expression: ", sQuote(x), # nocov ". Returning as a single symbolic unit()", call. = FALSE) # nocov @@ -311,7 +309,7 @@ convert_implicit_to_explicit_exponents <- function(x) { x } -# ----- as_units.call helpers ------ +# ----- as_units.call helpers ------ # from package:yasp, paste collapse with serial (oxford) comma pc_and <- function(..., sep = "") { @@ -330,16 +328,16 @@ pc_and <- function(..., sep = "") { #`%not_in%` <- function(x, table) match(x, table, nomatch = 0L) == 0L .msg_units_not_recognized <- function(unrecognized_symbols, full_expr) { - + if (is.language(full_expr)) full_expr <- deparse(full_expr) - - is_are <- if (length(unrecognized_symbols) > 1L) "are" else "is" - - paste0("In ", sQuote(full_expr), ", ", + + is_are <- if (length(unrecognized_symbols) > 1L) "are" else "is" + + paste0("In ", sQuote(full_expr), ", ", pc_and(sQuote(unrecognized_symbols)), " ", is_are, " not recognized by udunits.\n\n", "See a table of valid unit symbols and names with valid_udunits().\n", - "Custom user-defined units can be added with install_symbolic_unit().\n\n", + "Custom user-defined units can be added with install_unit().\n\n", "See a table of valid unit prefixes with valid_udunits_prefixes().\n", "Prefixes will automatically work with any user-defined unit.") } @@ -355,9 +353,9 @@ units_eval_env$lb <- function(x) base::log(x, base = 2) #' #' @param check_is_valid throw an error if all the unit symbols are not either #' recognized by udunits2 via \code{ud_is_parseable()}, or a custom -#' user defined via \code{install_symbolic_unit()}. If \code{FALSE}, no check +#' user defined via \code{install_unit()}. If \code{FALSE}, no check #' for validity is performed. -#' +#' #' @note By default, unit names are automatically substituted with unit names #' (e.g., kilogram --> kg). To turn off this behavior, set #' \code{units_options(auto_convert_names_to_symbols = FALSE)} @@ -367,53 +365,52 @@ units_eval_env$lb <- function(x) base::log(x, base = 2) #' In \code{as_units()}, each of the symbols in the unit expression is treated #' individually, such that each symbol must be recognized by the udunits #' database (checked by \code{ud_is_parseable()}, \emph{or} be a custom, -#' user-defined unit symbol that was defined either by -#' \code{install_symbolic_unit()} or \code{install_conversion_constant()}. To +#' user-defined unit symbol that was defined by \code{install_unit()}. To #' see which symbols and names are currently recognized by the udunits -#' database, see \code{udunits_symbols()}. +#' database, see \code{valid_udunits()}. #' -#' @seealso \code{\link{valid_udunits}} +#' @seealso \code{\link{install_unit}}, \code{\link{valid_udunits}} as_units.call <- function(x, check_is_valid = TRUE, ...) { - - if(missing(x) || identical(x, quote(expr =)) || + + if(missing(x) || identical(x, quote(expr =)) || identical(x, 1) || identical(x, 1L)) return(.as.units(1, unitless)) - + if (is.vector(x) && any(is.na(x))) stop("a missing value for units is not allowed") stopifnot(is.language(x)) - + vars <- all.vars(x) if(!length(vars)) stop(call. = FALSE, "No symbols found. Please supply bare expressions with this approach. See ?as_units for usage examples.") - + if (check_is_valid) { valid <- vapply(vars, ud_is_parseable, logical(1L)) if (!all(valid)) stop(.msg_units_not_recognized(vars[!valid], x), call. = FALSE) } - + names(vars) <- vars tmp_env <- lapply(vars, symbolic_unit, check_is_valid = FALSE) - + if (dont_simplify_here <- is.na(.units.simplify())) { units_options(simplify = FALSE) on.exit(units_options(simplify = NA)) } - + unit <- tryCatch( eval(x, tmp_env, units_eval_env), error = function(e) stop( paste0( conditionMessage(e), "\n", "Did you try to supply a value in a context where a bare expression was expected?" ), call. = FALSE )) -# if(as.numeric(unit) %not_in% c(1, 0)) # 0 if log() used. +# if(as.numeric(unit) %not_in% c(1, 0)) # 0 if log() used. # stop(call. = FALSE, -#"In ", sQuote(deparse(x)), " the numeric multiplier ", sQuote(as.numeric(unit)), " is invalid. -#Use `install_conversion_constant()` to define a new unit that is a multiple of another unit.") - +#"In ", sQuote(deparse(x)), " the numeric multiplier ", sQuote(as.numeric(unit)), " is invalid. +#Use `install_unit()` to define a new unit that is a multiple of another unit.") + .as.units(as.numeric(unit), units(unit)) } @@ -447,20 +444,20 @@ as_units.Date = function(x, value, ...) { symbolic_unit <- function(chr, check_is_valid = TRUE) { - + stopifnot(is.character(chr), length(chr) == 1) - + if (check_is_valid && !ud_is_parseable(chr)) { msg <- paste(sQuote(chr), "is not a unit recognized by udunits or a user-defined unit") stop(msg, call. = FALSE) } - + auto_convert <- units_options("auto_convert_names_to_symbols") if (auto_convert && ud_is_parseable(chr)) { sym <- ud_get_symbol(chr) - if (nzchar(sym)) + if (length(sym)) chr <- sym } - + .as.units(1, .symbolic_units(chr)) } diff --git a/R/options.R b/R/options.R index 9ff9d078..35f871d0 100644 --- a/R/options.R +++ b/R/options.R @@ -21,7 +21,7 @@ } #' set one or more units global options -#' +#' #' set units global options, mostly related how units are printed and plotted #' @param ... named options (character) for which the value is queried #' @param sep character length two; default \code{c("~", "~")}; space separator between variable and units, and space separator between two different units @@ -30,12 +30,12 @@ #' @param parse logical, default \code{TRUE}; should the units be made into an expression (so we get subscripts)? Setting to \code{FALSE} may be useful if \link{parse} fails, e.g. if the unit contains symbols that assume a particular encoding #' @param set_units_mode character; either \code{"symbols"} or \code{"standard"}; see \link{set_units}; default is \code{"symbols"} #' @param auto_convert_names_to_symbols logical, default \code{TRUE}: should names, such as \code{degree_C} be converted to their usual symbol? -#' @param simplify logical, default \code{NA}; simplify units in expressions? +#' @param simplify logical, default \code{NA}; simplify units in expressions? #' @param allow_mixed logical; if \code{TRUE}, combining mixed units creates a \code{mixed_units} object, if \code{FALSE} it generates an error #' @param unitless_symbol character; set the symbol to use for unitless (1) units #' @param define_bel logical; if \code{TRUE}, define the unit \code{B} (i.e., the \emph{bel}, widely used with the \emph{deci-} prefix as \code{dB}, \emph{decibel}) as an alias of \code{lg(re 1)}. \code{TRUE} by default, unless \code{B} is already defined in the existing XML database. #' @details This sets or gets units options. Set them by using named arguments, get them by passing the option name. -#' +#' #' The default \code{NA} value for \code{simplify} means units are not simplified in \link{set_units} or \link{as_units}, but are simplified in arithmetical expressions. #' @return in case options are set, invisibly a named list with the option values that are being set; if an option is queried, the current option value. #' @examples @@ -90,9 +90,9 @@ units_options = function(..., sep, group, negative_power, parse, set_units_mode, ret$define_bel = .setopt(define_bel) if (!identical(ret$define_bel, define_bel)) { if (!is.na(ret$define_bel)) - try(remove_symbolic_unit("B"), silent = TRUE) + remove_unit("B", "bel") if (define_bel) - install_conversion_constant("lg(re 1)", "B", 1) + install_unit("B", "lg(re 1)", "bel") } } diff --git a/R/udunits.R b/R/udunits.R index 26b047ad..ddf054d6 100644 --- a/R/udunits.R +++ b/R/udunits.R @@ -24,11 +24,10 @@ ud_are_convertible = function(x, y) { } ud_get_symbol = function(u) { - sy = R_ut_get_symbol(u) - if (sy == "") - R_ut_get_name(u) - else - sy + sym = R_ut_get_symbol(u) + if (!length(sym)) + sym = R_ut_get_name(u) + sym } ud_is_parseable = function(u) { diff --git a/R/user_conversion.R b/R/user_conversion.R index a47cd5d6..7d5faf9e 100644 --- a/R/user_conversion.R +++ b/R/user_conversion.R @@ -1,3 +1,102 @@ +#' Define or remove units +#' +#' Installing new symbols and/or names allows them to be used in \code{as_units}, +#' \code{make_units} and \code{set_units}. Optionally, a relationship can be +#' defined between such symbols/names and existing ones (see details and examples). +#' +#' At least one symbol or name is expected, but multiple symbols and/or names +#' can be installed (and thus mapped to the same unit) or removed at the same +#' time. The \code{def} argument enables arbitrary relationships with existing +#' units using UDUNITS-2 syntax: +#' \tabular{llll}{ +#' \strong{String Type} \tab \strong{Using Names} \tab \strong{Using Symbols} +#' \tab \strong{Comment}\cr +#' Simple \tab meter \tab m \tab \cr +#' Raised \tab meter^2 \tab m2 \tab +#' higher precedence than multiplying or dividing\cr +#' Product \tab newton meter \tab N.m \tab \cr +#' Quotient \tab meter per second \tab m/s \tab \cr +#' Scaled \tab 60 second \tab 60 s \tab \cr +#' Prefixed \tab kilometer \tab km \tab \cr +#' Offset \tab kelvin from 273.15 \tab K @ 273.15 \tab +#' lower precedence than multiplying or dividing\cr +#' Logarithmic \tab lg(re milliwatt) \tab lg(re mW) \tab +#' "lg" is base 10, "ln" is base e, and "lb" is base 2\cr +#' Grouped \tab (5 meter)/(30 second) \tab (5 m)/(30 s) \tab +#' } +#' The above may be combined, e.g., \code{"0.1 lg(re m/(5 s)^2) @ 50"}. +#' You may also look at the \code{} elements in the units database to see +#' examples of string unit specifications. +#' +#' @param symbol a vector of symbols to be installed/removed. +#' @param def either \itemize{ +#' \item an empty definition, which defines a new base unit; +#' \item \code{"unitless"}, which defines a new dimensionless unit; +#' \item a relationship with existing units (see details for the syntax). +#' } +#' @param name a vector of names to be installed/removed. +#' +#' @examples +#' # define a fortnight +#' install_unit("fn", "2 week", "fortnight") +#' year <- as_units("year") +#' set_units(year, fn) # by symbol +#' set_units(year, fortnight) # by name +#' # clean up +#' remove_unit("fn", "fortnight") +#' +#' # working with currencies +#' install_unit("dollar") +#' install_unit("euro", "1.22 dollar") +#' install_unit("yen", "0.0079 euro") +#' set_units(as_units("dollar"), yen) +#' # clean up +#' remove_unit(c("dollar", "euro", "yen")) +#' +#' # an example from microbiology +#' cfu_symbols <- c("CFU", "cfu") +#' cfu_names <- c("colony_forming_unit", "ColonyFormingUnit") +#' install_unit("cell") +#' install_unit(cfu_symbols, "3.4 cell", cfu_names) +#' cell <- set_units(2.5e5, cell) +#' vol <- set_units(500, ul) +#' set_units(cell/vol, "cfu/ml") +#' set_units(cell/vol, "CFU/ml") +#' set_units(cell/vol, "colony_forming_unit/ml") +#' set_units(cell/vol, "ColonyFormingUnit/ml") +#' # clean up +#' remove_unit(c("cell", cfu_symbols), cfu_names) +#' +#' @export +install_unit <- function(symbol=character(0), def=character(0), name=character(0)) { + stopifnot(is.character(def), length(def) < 2) + stopifnot(is.character(symbol), is.character(name)) + if (!length(symbol) && !length(name)) + stop("at least one symbol or name must be specified") + + if (!length(def)) { + ut_unit <- R_ut_new_base_unit() + } else if (identical(def, "unitless")) { + ut_unit <- R_ut_new_dimensionless_unit() + } else { + ut_unit <- R_ut_parse(def) + } + + R_ut_map_symbol_to_unit(symbol, ut_unit) + R_ut_map_name_to_unit(name, ut_unit) +} + +#' @rdname install_unit +#' @export +remove_unit <- function(symbol=character(0), name=character(0)) { + stopifnot(is.character(symbol), is.character(name)) + if (!length(symbol) && !length(name)) + stop("at least one symbol or name must be specified") + + R_ut_unmap_symbol_to_unit(symbol) + R_ut_unmap_name_to_unit(name) +} + #' Define new symbolic units #' #' Adding a symbolic unit allows it to be used in \code{as_units}, @@ -7,64 +106,61 @@ #' @param name a length 1 character vector that is the unit name or symbol. #' @param warn warns if the supplied unit symbol is already a valid unit symbol #' recognized by udunits. -#' @param dimensionless logical; if \code{TRUE}, a new dimensionless unit is created, if \code{FALSE} a new base unit is created. Dimensionless units are convertible to other dimensionless units (such as \code{rad}), new base units are not convertible to other existing units. +#' @param dimensionless logical; if \code{TRUE}, a new dimensionless unit is +#' created, if \code{FALSE} a new base unit is created. Dimensionless units are +#' convertible to other dimensionless units (such as \code{rad}), new base units +#' are not convertible to other existing units. +#' +#' @details \code{install_symbolic_unit} installs a new dimensionless unit; +#' these are directly compatible to any other dimensionless unit. To install a +#' new unit that is a scaled or shifted version of an existing unit, use +#' \code{install_conversion_constant} or \code{install_conversion_offset} directly.ç #' -#' @details \code{install_symbolic_unit} installs a new dimensionless unit; these are directly compatible to any other dimensionless unit. To install a new unit that is a scaled or shifted version of an existing unit, use \code{install_conversion_constant} or \code{install_conversion_offset} directly. #' @export -#' @rdname install_symbolic_unit -#' @seealso \code{\link{install_conversion_constant}}, \code{\link{install_conversion_offset}} -#' @examples -#' install_symbolic_unit("person") -#' set_units(1, rad) + set_units(1, person) # that is how dimensionless units work! -install_symbolic_unit <- function(name, warn = TRUE, dimensionless = TRUE) { +install_symbolic_unit <- function(name, warn = TRUE, dimensionless = TRUE) {# nocov start + .Deprecated("install_unit") check_unit_format(name) + if(ud_is_parseable(name)) { - if (warn) - warning(sQuote(name), - " is already a valid unit recognized by udunits; removing and reinstalling.") + if (warn) warning( + sQuote(name), " is already a valid unit recognized by udunits; removing and reinstalling.") remove_symbolic_unit(name) } - if (dimensionless) - R_ut_new_dimensionless_unit(name) - else - R_ut_new_base_unit(name) -} + + ut_unit <- if (dimensionless) + R_ut_new_dimensionless_unit() else R_ut_new_base_unit() + R_ut_map_name_to_unit(name, ut_unit) + + invisible(NULL) +}# nocov end #' @export #' @rdname install_symbolic_unit -remove_symbolic_unit <- function(name) { - R_ut_remove_unit(name) -} +remove_symbolic_unit <- function(name) {# nocov start + .Deprecated("remove_unit") + remove_unit(name=name) +}# nocov end #' Install a conversion constant or offset between user-defined units. -#' -#' @description Tells the \code{units} package how to convert between units that -#' have a linear relationship, i.e. can be related on the form \eqn{y = \alpha -#' x} (constant) or \eqn{y = \alpha + x} (offset). -#' +#' +#' Tells the \code{units} package how to convert between units that +#' have a linear relationship, i.e. can be related on the form \eqn{y = \alpha +#' x} (constant) or \eqn{y = \alpha + x} (offset). +#' #' @param from String for the symbol of the unit being converted from. -#' @param to String for the symbol of the unit being converted to. One of \code{from} and \code{to} must be an existing unit name. +#' @param to String for the symbol of the unit being converted to. One of +#' \code{from} and \code{to} must be an existing unit name. #' @param const The constant \eqn{\alpha} in the conversion. -#' -#' @details This function handles the very common case where units are related -#' through a linear function, that is, you can convert from one to the other +#' +#' @details This function handles the very common case where units are related +#' through a linear function, that is, you can convert from one to the other #' as \eqn{y = \alpha x}. Using this function, you specify that you -#' can go from values of type \code{from} to values of type \code{to} by +#' can go from values of type \code{from} to values of type \code{to} by #' multiplying by a constant, or adding a constant. -#' -#' @examples -#' -#' # one orange is worth two apples -#' install_symbolic_unit("orange") -#' install_conversion_constant("orange", "apple", 2) # apple = 2 * orange -#' apples <- 2 * as_units("apple") -#' oranges <- 1 * as_units("orange") -#' apples + oranges -#' oranges + apples -#' +#' #' @export -#' @seealso \code{\link{install_symbolic_unit}}, \code{\link{remove_symbolic_unit}} -install_conversion_constant <- function(from, to, const) { +install_conversion_constant <- function(from, to, const) {# nocov start + .Deprecated("install_unit") stopifnot(is.finite(const), const != 0.0) if (! xor(ud_is_parseable(from), ud_is_parseable(to))) stop("exactly one of (from, to) must be a known unit") @@ -72,17 +168,12 @@ install_conversion_constant <- function(from, to, const) { R_ut_scale(check_unit_format(from), to, as.double(const)) else R_ut_scale(check_unit_format(to), from, 1.0 / as.double(const)) -} +}# nocov end #' @export -#' @name install_conversion_constant -#' @examples -#' install_conversion_offset("meter", "newmeter", 1) -#' m = set_units(1:3, meter) -#' n = set_units(1:3, newmeter) -#' m + n -#' n + m -install_conversion_offset <- function(from, to, const) { +#' @name install_conversion_constant +install_conversion_offset <- function(from, to, const) {# nocov start + .Deprecated("install_unit") stopifnot(is.finite(const)) if (! xor(ud_is_parseable(from), ud_is_parseable(to))) stop("exactly one of (from, to) must be a known unit") @@ -90,9 +181,9 @@ install_conversion_offset <- function(from, to, const) { R_ut_offset(check_unit_format(from), to, -as.double(const)) else R_ut_offset(check_unit_format(to), from, as.double(const)) -} +}# nocov end -check_unit_format <- function(x) { +check_unit_format <- function(x) {# nocov start cond <- c( # leading and trailing numbers grepl("^[[:space:]]*[0-9]+", x), grepl("[0-9]+[[:space:]]*$", x), @@ -107,4 +198,4 @@ check_unit_format <- function(x) { " - arithmetic operators\n", " - intermediate white spaces") x -} +}# nocov end diff --git a/man/install_conversion_constant.Rd b/man/install_conversion_constant.Rd index 5ab97fe4..7a2a3fbb 100644 --- a/man/install_conversion_constant.Rd +++ b/man/install_conversion_constant.Rd @@ -12,38 +12,20 @@ install_conversion_offset(from, to, const) \arguments{ \item{from}{String for the symbol of the unit being converted from.} -\item{to}{String for the symbol of the unit being converted to. One of \code{from} and \code{to} must be an existing unit name.} +\item{to}{String for the symbol of the unit being converted to. One of +\code{from} and \code{to} must be an existing unit name.} \item{const}{The constant \eqn{\alpha} in the conversion.} } \description{ Tells the \code{units} package how to convert between units that - have a linear relationship, i.e. can be related on the form \eqn{y = \alpha - x} (constant) or \eqn{y = \alpha + x} (offset). +have a linear relationship, i.e. can be related on the form \eqn{y = \alpha +x} (constant) or \eqn{y = \alpha + x} (offset). } \details{ -This function handles the very common case where units are related - through a linear function, that is, you can convert from one to the other +This function handles the very common case where units are related + through a linear function, that is, you can convert from one to the other as \eqn{y = \alpha x}. Using this function, you specify that you - can go from values of type \code{from} to values of type \code{to} by + can go from values of type \code{from} to values of type \code{to} by multiplying by a constant, or adding a constant. } -\examples{ - -# one orange is worth two apples -install_symbolic_unit("orange") -install_conversion_constant("orange", "apple", 2) # apple = 2 * orange -apples <- 2 * as_units("apple") -oranges <- 1 * as_units("orange") -apples + oranges -oranges + apples - -install_conversion_offset("meter", "newmeter", 1) -m = set_units(1:3, meter) -n = set_units(1:3, newmeter) -m + n -n + m -} -\seealso{ -\code{\link{install_symbolic_unit}}, \code{\link{remove_symbolic_unit}} -} diff --git a/man/install_symbolic_unit.Rd b/man/install_symbolic_unit.Rd index a70e0170..cf4d8bfc 100644 --- a/man/install_symbolic_unit.Rd +++ b/man/install_symbolic_unit.Rd @@ -15,7 +15,10 @@ remove_symbolic_unit(name) \item{warn}{warns if the supplied unit symbol is already a valid unit symbol recognized by udunits.} -\item{dimensionless}{logical; if \code{TRUE}, a new dimensionless unit is created, if \code{FALSE} a new base unit is created. Dimensionless units are convertible to other dimensionless units (such as \code{rad}), new base units are not convertible to other existing units.} +\item{dimensionless}{logical; if \code{TRUE}, a new dimensionless unit is +created, if \code{FALSE} a new base unit is created. Dimensionless units are +convertible to other dimensionless units (such as \code{rad}), new base units +are not convertible to other existing units.} } \description{ Adding a symbolic unit allows it to be used in \code{as_units}, @@ -23,12 +26,8 @@ Adding a symbolic unit allows it to be used in \code{as_units}, unit is already known by udunits. } \details{ -\code{install_symbolic_unit} installs a new dimensionless unit; these are directly compatible to any other dimensionless unit. To install a new unit that is a scaled or shifted version of an existing unit, use \code{install_conversion_constant} or \code{install_conversion_offset} directly. -} -\examples{ -install_symbolic_unit("person") -set_units(1, rad) + set_units(1, person) # that is how dimensionless units work! -} -\seealso{ -\code{\link{install_conversion_constant}}, \code{\link{install_conversion_offset}} +\code{install_symbolic_unit} installs a new dimensionless unit; +these are directly compatible to any other dimensionless unit. To install a +new unit that is a scaled or shifted version of an existing unit, use +\code{install_conversion_constant} or \code{install_conversion_offset} directly.ç } diff --git a/man/install_unit.Rd b/man/install_unit.Rd new file mode 100644 index 00000000..0e44cc8a --- /dev/null +++ b/man/install_unit.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/user_conversion.R +\name{install_unit} +\alias{install_unit} +\alias{remove_unit} +\title{Define or remove units} +\usage{ +install_unit(symbol = character(0), def = character(0), name = character(0)) + +remove_unit(symbol = character(0), name = character(0)) +} +\arguments{ +\item{symbol}{a vector of symbols to be installed/removed.} + +\item{def}{either \itemize{ + \item an empty definition, which defines a new base unit; + \item \code{"unitless"}, which defines a new dimensionless unit; + \item a relationship with existing units (see details for the syntax). +}} + +\item{name}{a vector of names to be installed/removed.} +} +\description{ +Installing new symbols and/or names allows them to be used in \code{as_units}, +\code{make_units} and \code{set_units}. Optionally, a relationship can be +defined between such symbols/names and existing ones (see details and examples). +} +\details{ +At least one symbol or name is expected, but multiple symbols and/or names +can be installed (and thus mapped to the same unit) or removed at the same +time. The \code{def} argument enables arbitrary relationships with existing +units using UDUNITS-2 syntax: +\tabular{llll}{ + \strong{String Type} \tab \strong{Using Names} \tab \strong{Using Symbols} + \tab \strong{Comment}\cr + Simple \tab meter \tab m \tab \cr + Raised \tab meter^2 \tab m2 \tab + higher precedence than multiplying or dividing\cr + Product \tab newton meter \tab N.m \tab \cr + Quotient \tab meter per second \tab m/s \tab \cr + Scaled \tab 60 second \tab 60 s \tab \cr + Prefixed \tab kilometer \tab km \tab \cr + Offset \tab kelvin from 273.15 \tab K @ 273.15 \tab + lower precedence than multiplying or dividing\cr + Logarithmic \tab lg(re milliwatt) \tab lg(re mW) \tab + "lg" is base 10, "ln" is base e, and "lb" is base 2\cr + Grouped \tab (5 meter)/(30 second) \tab (5 m)/(30 s) \tab +} +The above may be combined, e.g., \code{"0.1 lg(re m/(5 s)^2) @ 50"}. +You may also look at the \code{} elements in the units database to see +examples of string unit specifications. +} +\examples{ +# define a fortnight +install_unit("fn", "2 week", "fortnight") +year <- as_units("year") +set_units(year, fn) # by symbol +set_units(year, fortnight) # by name +# clean up +remove_unit("fn", "fortnight") + +# working with currencies +install_unit("dollar") +install_unit("euro", "1.22 dollar") +install_unit("yen", "0.0079 euro") +set_units(as_units("dollar"), yen) +# clean up +remove_unit(c("dollar", "euro", "yen")) + +# an example from microbiology +cfu_symbols <- c("CFU", "cfu") +cfu_names <- c("colony_forming_unit", "ColonyFormingUnit") +install_unit("cell") +install_unit(cfu_symbols, "3.4 cell", cfu_names) +cell <- set_units(2.5e5, cell) +vol <- set_units(500, ul) +set_units(cell/vol, "cfu/ml") +set_units(cell/vol, "CFU/ml") +set_units(cell/vol, "colony_forming_unit/ml") +set_units(cell/vol, "ColonyFormingUnit/ml") +# clean up +remove_unit(c("cell", cfu_symbols), cfu_names) + +} diff --git a/man/units.Rd b/man/units.Rd index 9a3d9424..ded70310 100644 --- a/man/units.Rd +++ b/man/units.Rd @@ -77,7 +77,7 @@ syntax (reserved R syntax words like \code{in} must be backticked)} \item{check_is_valid}{throw an error if all the unit symbols are not either recognized by udunits2 via \code{ud_is_parseable()}, or a custom -user defined via \code{install_symbolic_unit()}. If \code{FALSE}, no check +user defined via \code{install_unit()}. If \code{FALSE}, no check for validity is performed.} \item{implicit_exponents}{If the unit string is in product power form (e.g. @@ -123,7 +123,7 @@ By default, unit names are automatically substituted with unit names } \section{Character strings}{ - + Generally speaking, there are 3 types of unit strings are accepted in \code{as_units} (and by extension, \code{`units<-`}). @@ -156,7 +156,7 @@ By default, unit names are automatically substituted with unit names string, and unit symbol or names must be separated by a space. Each unit symbol may optionally be followed by a single number, specifying the power. For example \code{"m2 s-2"} is equivalent to \code{"(m^2)*(s^-2)"}. - + It must be noted that prepended numbers are supported too, but their interpretation slightly varies depending on whether they are separated from the unit string or not. E.g., \code{"1000 m"} is interpreted as magnitude @@ -179,10 +179,9 @@ By default, unit names are automatically substituted with unit names In \code{as_units()}, each of the symbols in the unit expression is treated individually, such that each symbol must be recognized by the udunits database (checked by \code{ud_is_parseable()}, \emph{or} be a custom, - user-defined unit symbol that was defined either by - \code{install_symbolic_unit()} or \code{install_conversion_constant()}. To + user-defined unit symbol that was defined by \code{install_unit()}. To see which symbols and names are currently recognized by the udunits - database, see \code{udunits_symbols()}. + database, see \code{valid_udunits()}. } \examples{ @@ -197,7 +196,7 @@ a # convert to a mixed_units object: units(a) = c("m/s", "km/h", "km/h") a -# The easiest way to assign units to a numeric vector is like this: +# The easiest way to assign units to a numeric vector is like this: x <- y <- 1:4 units(x) <- "m/s" # meters / second @@ -205,7 +204,7 @@ units(x) <- "m/s" # meters / second if(requireNamespace("magrittr", quietly = TRUE)) { library(magrittr) y \%>\% set_units(m/s) -} +} # these are different ways of creating the same unit: # meters per second squared, i.e, acceleration @@ -228,8 +227,8 @@ all_identical <- function(...) { } all_identical(x1, x2, x3, x4, x5, x6, x7, x8) -# Note, direct usage of these unit creation functions is typically not -# necessary, since coercion is automatically done via as_units(). Again, +# Note, direct usage of these unit creation functions is typically not +# necessary, since coercion is automatically done via as_units(). Again, # these are all equivalent ways to generate the same result. x1 <- x2 <- x3 <- x4 <- x5 <- x6 <- x7 <- x8 <- 1:4 @@ -274,16 +273,14 @@ set_units(x, grams/gallon) # For example, a microbiologist might work with counts of bacterial cells # make_units(cells/ml) # by default, throws an ERROR # First define the unit, then the newly defined unit is accepted. -install_symbolic_unit("cells") -make_units(cells/ml) +install_unit("cells") +make_units(cells/ml) -# Note, install_symbolic_unit() does not add any support for unit -# conversion, or arithmetic operations that require unit conversion. See -# ?install_conversion_constant for defining relationships between user -# defined units. +# Note that install_unit() adds support for defining relationships between +# the newly created symbols or names and existing units. ## set_units() -# set_units is a pipe friendly version of `units<-`. +# set_units is a pipe friendly version of `units<-`. if(requireNamespace("magrittr", quietly = TRUE)) { library(magrittr) 1:5 \%>\% set_units(N/m^2) @@ -291,7 +288,7 @@ if(requireNamespace("magrittr", quietly = TRUE)) { 1:5 \%>\% set_units(m) \%>\% set_units(km) } -# set_units has two modes of operation. By default, it operates with +# set_units has two modes of operation. By default, it operates with # bare symbols to define the units. set_units(1:5, m/s) @@ -316,5 +313,5 @@ as_units(d) } \seealso{ -\code{\link{valid_udunits}} +\code{\link{install_unit}}, \code{\link{valid_udunits}} } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 56eba25a..6f413d67 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -36,13 +36,12 @@ BEGIN_RCPP END_RCPP } // R_ut_get_dimensionless_unit_one -SEXP R_ut_get_dimensionless_unit_one(CharacterVector name); -RcppExport SEXP _units_R_ut_get_dimensionless_unit_one(SEXP nameSEXP) { +SEXP R_ut_get_dimensionless_unit_one(); +RcppExport SEXP _units_R_ut_get_dimensionless_unit_one() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); - rcpp_result_gen = Rcpp::wrap(R_ut_get_dimensionless_unit_one(name)); + rcpp_result_gen = Rcpp::wrap(R_ut_get_dimensionless_unit_one()); return rcpp_result_gen; END_RCPP } @@ -72,33 +71,23 @@ BEGIN_RCPP END_RCPP } // R_ut_new_dimensionless_unit -void R_ut_new_dimensionless_unit(CharacterVector name); -RcppExport SEXP _units_R_ut_new_dimensionless_unit(SEXP nameSEXP) { +SEXP R_ut_new_dimensionless_unit(); +RcppExport SEXP _units_R_ut_new_dimensionless_unit() { BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); - R_ut_new_dimensionless_unit(name); - return R_NilValue; + rcpp_result_gen = Rcpp::wrap(R_ut_new_dimensionless_unit()); + return rcpp_result_gen; END_RCPP } // R_ut_new_base_unit -void R_ut_new_base_unit(CharacterVector name); -RcppExport SEXP _units_R_ut_new_base_unit(SEXP nameSEXP) { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); - R_ut_new_base_unit(name); - return R_NilValue; -END_RCPP -} -// R_ut_remove_unit -void R_ut_remove_unit(CharacterVector name); -RcppExport SEXP _units_R_ut_remove_unit(SEXP nameSEXP) { +SEXP R_ut_new_base_unit(); +RcppExport SEXP _units_R_ut_new_base_unit() { BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); - R_ut_remove_unit(name); - return R_NilValue; + rcpp_result_gen = Rcpp::wrap(R_ut_new_base_unit()); + return rcpp_result_gen; END_RCPP } // R_ut_scale @@ -243,15 +232,45 @@ BEGIN_RCPP END_RCPP } // R_ut_map_name_to_unit -SEXP R_ut_map_name_to_unit(CharacterVector name, SEXP inunit); +void R_ut_map_name_to_unit(CharacterVector name, SEXP inunit); RcppExport SEXP _units_R_ut_map_name_to_unit(SEXP nameSEXP, SEXP inunitSEXP) { BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); Rcpp::traits::input_parameter< SEXP >::type inunit(inunitSEXP); - rcpp_result_gen = Rcpp::wrap(R_ut_map_name_to_unit(name, inunit)); - return rcpp_result_gen; + R_ut_map_name_to_unit(name, inunit); + return R_NilValue; +END_RCPP +} +// R_ut_unmap_name_to_unit +void R_ut_unmap_name_to_unit(CharacterVector name); +RcppExport SEXP _units_R_ut_unmap_name_to_unit(SEXP nameSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); + R_ut_unmap_name_to_unit(name); + return R_NilValue; +END_RCPP +} +// R_ut_map_symbol_to_unit +void R_ut_map_symbol_to_unit(CharacterVector name, SEXP inunit); +RcppExport SEXP _units_R_ut_map_symbol_to_unit(SEXP nameSEXP, SEXP inunitSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); + Rcpp::traits::input_parameter< SEXP >::type inunit(inunitSEXP); + R_ut_map_symbol_to_unit(name, inunit); + return R_NilValue; +END_RCPP +} +// R_ut_unmap_symbol_to_unit +void R_ut_unmap_symbol_to_unit(CharacterVector name); +RcppExport SEXP _units_R_ut_unmap_symbol_to_unit(SEXP nameSEXP) { +BEGIN_RCPP + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< CharacterVector >::type name(nameSEXP); + R_ut_unmap_symbol_to_unit(name); + return R_NilValue; END_RCPP } @@ -259,12 +278,11 @@ static const R_CallMethodDef CallEntries[] = { {"_units_udunits_init", (DL_FUNC) &_units_udunits_init, 1}, {"_units_udunits_exit", (DL_FUNC) &_units_udunits_exit, 0}, {"_units_R_ut_parse", (DL_FUNC) &_units_R_ut_parse, 1}, - {"_units_R_ut_get_dimensionless_unit_one", (DL_FUNC) &_units_R_ut_get_dimensionless_unit_one, 1}, + {"_units_R_ut_get_dimensionless_unit_one", (DL_FUNC) &_units_R_ut_get_dimensionless_unit_one, 0}, {"_units_R_ut_are_convertible", (DL_FUNC) &_units_R_ut_are_convertible, 2}, {"_units_R_convert_doubles", (DL_FUNC) &_units_R_convert_doubles, 3}, - {"_units_R_ut_new_dimensionless_unit", (DL_FUNC) &_units_R_ut_new_dimensionless_unit, 1}, - {"_units_R_ut_new_base_unit", (DL_FUNC) &_units_R_ut_new_base_unit, 1}, - {"_units_R_ut_remove_unit", (DL_FUNC) &_units_R_ut_remove_unit, 1}, + {"_units_R_ut_new_dimensionless_unit", (DL_FUNC) &_units_R_ut_new_dimensionless_unit, 0}, + {"_units_R_ut_new_base_unit", (DL_FUNC) &_units_R_ut_new_base_unit, 0}, {"_units_R_ut_scale", (DL_FUNC) &_units_R_ut_scale, 3}, {"_units_R_ut_offset", (DL_FUNC) &_units_R_ut_offset, 3}, {"_units_R_ut_divide", (DL_FUNC) &_units_R_ut_divide, 2}, @@ -278,6 +296,9 @@ static const R_CallMethodDef CallEntries[] = { {"_units_R_ut_get_symbol", (DL_FUNC) &_units_R_ut_get_symbol, 1}, {"_units_R_ut_get_name", (DL_FUNC) &_units_R_ut_get_name, 1}, {"_units_R_ut_map_name_to_unit", (DL_FUNC) &_units_R_ut_map_name_to_unit, 2}, + {"_units_R_ut_unmap_name_to_unit", (DL_FUNC) &_units_R_ut_unmap_name_to_unit, 1}, + {"_units_R_ut_map_symbol_to_unit", (DL_FUNC) &_units_R_ut_map_symbol_to_unit, 2}, + {"_units_R_ut_unmap_symbol_to_unit", (DL_FUNC) &_units_R_ut_unmap_symbol_to_unit, 1}, {NULL, NULL, 0} }; diff --git a/src/io.c b/src/io.c deleted file mode 100644 index bd8a2bc9..00000000 --- a/src/io.c +++ /dev/null @@ -1,39 +0,0 @@ -#include - -#if UDUNITS2_DIR != 0 -# include -#else -# include -#endif - -#include "io.h" - -/* From the enum comments in udunits2.h */ -const char * ut_status_strings[] = { - "Success", - "An argument violates the function's contract", - "Unit, prefix, or identifier already exists", - "No such unit exists", - "Operating-system error. See \"errno\".", - "The units belong to different unit-systems", - "The operation on the unit(s) is meaningless", - "The unit-system doesn't have a unit named \"second\"", - "An error occurred while visiting a unit", - "A unit can't be formatted in the desired manner", - "string unit representation contains syntax error", - "string unit representation contains unknown word", - "Can't open argument-specified unit database", - "Can't open environment-specified unit database", - "Can't open installed, default, unit database", - "Error parsing unit specification" -}; - -void handle_error(const char *calling_function) { - ut_status stat; - stat = ut_get_status(); - error("Error in function %s: %s", calling_function, ut_status_strings[stat]); -} - -void r_error_fn(const char* fmt, va_list args) { // #nocov start - Rvprintf(fmt, args); -} // #nocov end diff --git a/src/io.h b/src/io.h deleted file mode 100644 index 8dee3562..00000000 --- a/src/io.h +++ /dev/null @@ -1,2 +0,0 @@ -void r_error_fn(const char* fmt, va_list args); -void handle_error(const char *calling_function); diff --git a/src/udunits.cpp b/src/udunits.cpp index 9d0aff3f..ac980e82 100644 --- a/src/udunits.cpp +++ b/src/udunits.cpp @@ -17,7 +17,11 @@ #endif extern "C" { -#include "io.h" + void r_error_fn(const char* fmt, va_list args) { + char buf[256]; + vsprintf(buf, fmt, args); + Rf_error(buf); + } } using namespace Rcpp; @@ -38,7 +42,7 @@ void udunits_init(CharacterVector path) { sys = ut_read_xml(NULL); // #nocov ut_set_error_message_handler((ut_error_message_handler) r_error_fn); if (sys == NULL) - handle_error("udunits_init"); // #nocov + stop("no database found!"); // #nocov } // [[Rcpp::export]] @@ -62,24 +66,16 @@ ut_unit *ut_unwrap(SEXP u) { // [[Rcpp::export]] SEXP R_ut_parse(CharacterVector name) { ut_unit *u = ut_parse(sys, ut_trim(name[0], enc), enc); - if (u == NULL) { - switch (ut_get_status()) { - case UT_BAD_ARG: - case UT_SYNTAX: - case UT_UNKNOWN: - case UT_OS: - default: - handle_error("R_ut_parse"); - } - } - // error checking ... + if (u == NULL) + stop("syntax error, cannot parse '%s'", (char*)name[0]); return ut_wrap(u); } // [[Rcpp::export]] -SEXP R_ut_get_dimensionless_unit_one(CharacterVector name) { +SEXP R_ut_get_dimensionless_unit_one() { return ut_wrap(ut_get_dimensionless_unit_one(sys)); } + // [[Rcpp::export]] LogicalVector R_ut_are_convertible(SEXP a, SEXP b) { ut_unit *u1 = ut_unwrap(a); @@ -101,57 +97,29 @@ NumericVector R_convert_doubles(SEXP from, SEXP to, NumericVector val) { } // [[Rcpp::export]] -void R_ut_new_dimensionless_unit(CharacterVector name) { - ut_unit *u = ut_new_dimensionless_unit(sys); - if (ut_map_name_to_unit(name[0], enc, u) != UT_SUCCESS) - handle_error("R_ut_new_dimensionless_unit"); // #nocov - ut_free(u); +SEXP R_ut_new_dimensionless_unit() { + return ut_wrap(ut_new_dimensionless_unit(sys)); } // [[Rcpp::export]] -void R_ut_new_base_unit(CharacterVector name) { - ut_unit *u = ut_new_base_unit(sys); - if (ut_map_name_to_unit(name[0], enc, u) != UT_SUCCESS) - handle_error("R_ut_new_base_unit"); // #nocov - ut_free(u); -} - -// [[Rcpp::export]] -void R_ut_remove_unit(CharacterVector name) { - ut_unit *u = NULL; - if ((u = ut_get_unit_by_name(sys, name[0])) != NULL) { - ut_free(u); - if (ut_unmap_name_to_unit(sys, name[0], enc) != UT_SUCCESS) - handle_error("R_ut_remove_unit"); // #nocov - } else if ((u = ut_get_unit_by_symbol(sys, name[0])) != NULL) { - ut_free(u); - if (ut_unmap_symbol_to_unit(sys, name[0], enc) != UT_SUCCESS) - handle_error("R_ut_remove_unit"); // #nocov - } else - stop("unknown unit name or symbol"); - return ; +SEXP R_ut_new_base_unit() { + return ut_wrap(ut_new_base_unit(sys)); } // [[Rcpp::export]] void R_ut_scale(CharacterVector nw, CharacterVector old, NumericVector d) { - if (d.size() != 1) - stop("d should have size 1"); // #nocov ut_unit *u_old = ut_parse(sys, ut_trim(old[0], enc), enc); ut_unit *u_new = ut_scale(d[0], u_old); - if (ut_map_name_to_unit(nw[0], enc, u_new) != UT_SUCCESS) - handle_error("R_ut_scale"); // #nocov + ut_map_name_to_unit(nw[0], enc, u_new); ut_free(u_new); ut_free(u_old); } // [[Rcpp::export]] void R_ut_offset(CharacterVector nw, CharacterVector old, NumericVector d) { - if (d.size() != 1) - stop("d should have size 1"); // #nocov ut_unit *u_old = ut_parse(sys, ut_trim(old[0], enc), enc); ut_unit *u_new = ut_offset(u_old, d[0]); - if (ut_map_name_to_unit(nw[0], enc, u_new) != UT_SUCCESS) - handle_error("R_ut_offset"); // #nocov + ut_map_name_to_unit(nw[0], enc, u_new); ut_free(u_new); ut_free(u_old); } @@ -195,7 +163,7 @@ SEXP R_ut_log(SEXP a, NumericVector base) { } // [[Rcpp::export]] -CharacterVector R_ut_format(SEXP p, bool names = false, bool definition = false, +CharacterVector R_ut_format(SEXP p, bool names = false, bool definition = false, bool ascii = false) { int opt; @@ -208,20 +176,8 @@ CharacterVector R_ut_format(SEXP p, bool names = false, bool definition = false, if (definition) opt = opt | UT_DEFINITION; char buf[256]; - ut_set_error_message_handler(ut_ignore); - int len = ut_format(ut_unwrap(p), buf, 256, opt); - ut_set_error_message_handler((ut_error_message_handler) r_error_fn); - if (len == -1) { // #nocov start - switch (ut_get_status()) { - case UT_BAD_ARG: - case UT_CANT_FORMAT: - handle_error("R_ut_format"); - break; - default:; - } - buf[0] = '\0'; // "": dont' return rubbish - } else if (len == 256) - handle_error("buffer of 256 bytes too small!"); // #nocov end + if (ut_format(ut_unwrap(p), buf, 256, opt) == 256) + warning("buffer of 256 bytes too small!"); // #nocov return CharacterVector::create(buf); } @@ -240,12 +196,10 @@ void R_ut_set_encoding(std::string enc_str) { // [[Rcpp::export]] CharacterVector R_ut_get_symbol(CharacterVector ustr) { ut_unit *u = ut_parse(sys, ut_trim(ustr[0], enc), enc); - if (u == NULL) - handle_error("R_ut_get_symbol"); // #nocov -- never reached const char *s = ut_get_symbol(u, enc); ut_free(u); if (s == NULL) - return CharacterVector::create(""); + return CharacterVector::create(); else return CharacterVector::create(s); } @@ -253,21 +207,36 @@ CharacterVector R_ut_get_symbol(CharacterVector ustr) { // [[Rcpp::export]] CharacterVector R_ut_get_name(CharacterVector ustr) { ut_unit *u = ut_parse(sys, ut_trim(ustr[0], enc), enc); - if (u == NULL) - handle_error("R_ut_get_name"); // #nocov -- never reached const char *s = ut_get_name(u, enc); ut_free(u); if (s == NULL) - return CharacterVector::create(""); + return CharacterVector::create(); else return CharacterVector::create(s); // #nocov } -// https://github.com/r-quantities/units/issues/89#issuecomment-359251623 // [[Rcpp::export]] -SEXP R_ut_map_name_to_unit( CharacterVector name, SEXP inunit) { // #nocov start +void R_ut_map_name_to_unit(CharacterVector name, SEXP inunit) { + ut_unit *unit = ut_unwrap(inunit); + for (int i = 0; i < name.size(); i++) + ut_map_name_to_unit(name[i], enc, unit); +} + +// [[Rcpp::export]] +void R_ut_unmap_name_to_unit(CharacterVector name) { + for (int i = 0; i < name.size(); i++) + ut_unmap_name_to_unit(sys, name[i], enc); +} + +// [[Rcpp::export]] +void R_ut_map_symbol_to_unit(CharacterVector name, SEXP inunit) { ut_unit *unit = ut_unwrap(inunit); - if (ut_map_name_to_unit(name[0], enc, unit) != UT_SUCCESS) - handle_error("R_ut_map_name_to_unit"); - return ut_wrap(unit); -} // #nocov end + for (int i = 0; i < name.size(); i++) + ut_map_symbol_to_unit(name[i], enc, unit); +} + +// [[Rcpp::export]] +void R_ut_unmap_symbol_to_unit(CharacterVector name) { + for (int i = 0; i < name.size(); i++) + ut_unmap_symbol_to_unit(sys, name[i], enc); +} diff --git a/tests/testthat/test_conversion.R b/tests/testthat/test_conversion.R index 77d1bfb2..b8198714 100644 --- a/tests/testthat/test_conversion.R +++ b/tests/testthat/test_conversion.R @@ -172,12 +172,12 @@ test_that("units.symbolic_units works", { }) test_that("new base units work", { - install_symbolic_unit("person", dimensionless = FALSE) + install_unit("person") expect_equal(set_units(1, person) + set_units(1, kperson), set_units(1001, person)) expect_error(set_units(1, person) + set_units(1, rad), "cannot convert") # restore - remove_symbolic_unit("person") + remove_unit("person") }) test_that("errors are correctly coerced to a data frame", { diff --git a/tests/testthat/test_udunits.R b/tests/testthat/test_udunits.R index f7771816..fe51155b 100644 --- a/tests/testthat/test_udunits.R +++ b/tests/testthat/test_udunits.R @@ -5,14 +5,18 @@ test_that("udunits error messages", { }) test_that("udunits low-level functions work", { - expect_silent(units:::R_ut_get_dimensionless_unit_one(character(0))) + expect_silent(units:::R_ut_get_dimensionless_unit_one()) a <- units:::R_ut_parse("m") b <- units:::R_ut_parse("g") expect_error(units:::R_convert_doubles(a, b, 1:10), "not convertible") - u = units:::R_ut_offset("foo", "kg", -10) + units:::R_ut_offset("foo", "kg", -10) expect_equal(set_units(set_units(1, kg), foo), set_units(11, foo)) - remove_symbolic_unit("foo") + remove_unit(name="foo") + + units:::R_ut_scale("foo", "kg", 2) + expect_equal(set_units(set_units(2, kg), foo), set_units(1, foo)) + remove_unit(name="foo") expect_silent(units:::R_ut_divide(a, b)) expect_silent(units:::R_ut_multiply(a, b)) @@ -34,8 +38,8 @@ test_that("udunits low-level functions work", { expect_silent(units:::R_ut_set_encoding("utf8")) expect_silent(ud_set_encoding("utf8")) expect_error(units:::R_ut_set_encoding("foo")) - expect_error(units:::R_ut_get_symbol("foo"), "string unit representation contains unknown word") - expect_error(units:::R_ut_get_name("foo"), "R_ut_get_name") + expect_error(units:::R_ut_get_symbol("foo")) + expect_error(units:::R_ut_get_name("foo")) }) test_that("udunits database can be read", { diff --git a/tests/testthat/test_user_conversion.R b/tests/testthat/test_user_conversion.R index d2538f3b..ef52fe44 100644 --- a/tests/testthat/test_user_conversion.R +++ b/tests/testthat/test_user_conversion.R @@ -3,75 +3,50 @@ context("User-defined unit conversion") test_that("we can convert between units with a user-defined function", { expect_error(as_units("apple")) expect_error(as_units("orange")) - #install_symbolic_unit("apple") -> needs to be defined by install_conversion_constant - install_symbolic_unit("orange") + install_unit("orange") oranges <- 3 * as_units("orange") expect_error(apples + oranges) # obviously - install_conversion_constant("orange", "apple", 2) # one orange is worth two apples + install_unit("apple", "orange / 2") # one orange is worth two apples apples <- 2 * as_units("apple") expect_equal(apples + oranges, (2 + 2*3) * as_units("apple")) expect_equal(oranges + apples, (3 + 2/2) * as_units("orange")) - # FIXME: expect_equal(oranges + apples, set_units(apples + oranges, oranges, mode = "standard")) - # FIXME: expect_equal(apples + oranges, set_units(apples + oranges, apples, mode = "standard")) - - #install_conversion_constant("orange", "apple", 2, 1) # but you always have to add one - #expect_equal(apples + oranges, (2 + 2*3 + 1) * as_units("apple")) - #expect_equal(oranges + apples, (3 + (2 - 1)/2) * as_units("orange")) - #expect_equal(oranges + apples, set_units(apples + oranges, oranges)) + expect_equal(oranges + apples, set_units(apples + oranges, units(oranges), mode = "standard")) + expect_equal(apples + oranges, set_units(apples + oranges, units(apples), mode = "standard")) # now just checking that we get different results with a different fruit expect_error(as_units("banana")) - #install_symbolic_unit("banana") -> need to be done by install_user_conversion expect_error(apples + bananas) # obviously expect_error(bananas + apples) # obviously - install_conversion_constant("apple", "banana", 1/3) # one apple only gives you a third banana + install_unit("banana", "3 apple") # one apple is worth three bananas bananas <- 6 * as_units("banana") expect_equal(bananas + 3 * apples, (6 + 3 * 2 / 3) * as_units("banana")) - install_symbolic_unit("aaa") - install_conversion_offset("aaa", "bbb", 2) # bbb is aaa + 2 - expect_warning(install_symbolic_unit("aaa"), "is already a valid unit") + # check dimensionless + install_unit("person", "unitless") + persons <- set_units(3, person) + expect_equal(persons, set_units(3, 1)) # restore - remove_symbolic_unit("orange") - remove_symbolic_unit("apple") - remove_symbolic_unit("banana") - remove_symbolic_unit("aaa") - remove_symbolic_unit("bbb") + remove_unit(c("orange", "apple", "banana", "person")) }) test_that("we can simplify via user-defined units", { - install_symbolic_unit("orange") - install_conversion_constant("orange", "apple", 2) # one orange is worth two apples + install_unit("orange") + install_unit("apple", "orange / 2") # one orange is worth two apples apples <- 4 * as_units("apple") oranges <- 2 * as_units("orange") expect_equal(apples / oranges, set_units(1)) expect_equal(oranges / apples, set_units(1)) # restore - remove_symbolic_unit("orange") - remove_symbolic_unit("apple") + remove_unit(c("orange", "apple")) }) test_that("removing units works", { - expect_error(remove_symbolic_unit("foo")) - expect_silent(install_symbolic_unit("foo")) - expect_silent(remove_symbolic_unit("foo")) - expect_error(remove_symbolic_unit("foo")) -}) - -test_that("new units' format is checked for possible issues", { - wrong_formats <- c( - " 2asdf", "asdf2 ", - "as+df", "as-df", "as*df", "as/df", "as^df", - "as df") - for (i in wrong_formats) { - expect_error(install_symbolic_unit(i)) - expect_error(install_conversion_constant(i, "m", 2)) - expect_error(install_conversion_constant("m", i, 2)) - expect_error(install_conversion_offset(i, "m", 2)) - expect_error(install_conversion_offset("m", i, 2)) - } + expect_silent(remove_unit("foo")) + expect_silent(install_unit("foo")) + expect_error(install_unit("foo")) + expect_silent(remove_unit("foo")) })