new convert_to_base, closes #132

Author: Enchufa2

NAMESPACE

@@ -74,6 +74,7 @@ S3method(units,units)
 S3method(weighted.mean,units)
 export(as_difftime)
 export(as_units)
+export(convert_to_base)
 export(deparse_unit)
 export(drop_units)
 export(install_unit)

NEWS.md

@@ -11,6 +11,8 @@
 
 * Implement `matrixOps.units`, with support for `%*%` (R >= 4.3.0); #226
 
+* New `convert_to_base()` implements conversion to base units; #132 @jamarav
+
 # version 0.8-7
 
 * Deep copy of `ud_convert()` input to avoid side effects; #403

R/symbolic_units.R

@@ -144,3 +144,60 @@ as.character.symbolic_units <- function(x, ...,
 
   as_units(drop_units(value), .symbolic_units(new_numerator, new_denominator))
 }
+
+#' Convert units to their base units
+#'
+#' Convert the units of a \code{units} object to their base units, as defined by
+#' the udunits database (SI units).
+#'
+#' @param x object of class \code{units}.
+#' @param simplify logical; if TRUE (default), the resulting units are simplified.
+#' @param keep_fraction logical; if TRUE (default), the result is kept as a fractio.n
+#'
+#' @return object of class \code{units} with units converted to base units.
+#' @export
+#'
+#' @examples
+#' x <- set_units(32, mJ/g)
+#' convert_to_base(x)
+#' convert_to_base(x, keep_fraction=FALSE)
+#' convert_to_base(x, simplify=FALSE)
+#' convert_to_base(x, simplify=FALSE, keep_fraction=FALSE)
+convert_to_base <- function(x, simplify = TRUE, keep_fraction = TRUE) {
+  stopifnot(inherits(x, "units"))
+
+  u_strBase <- function(u_str, simplify) {
+    u_new <- ud_parse(u_str, names=FALSE, definition=TRUE, ascii=TRUE)
+    u_new <- strsplit(x = u_new, split = " @ ")[[1]][1]
+    u_new <- strsplit(x = u_new, split = " ")[[1]]
+    u_new <- u_new[length(u_new)]
+
+    if (simplify)
+      u_new <- ud_parse(u_new, names=FALSE, definition=FALSE, ascii=TRUE)
+    gsub(".", " ", u_new, fixed = TRUE)
+  }
+
+  u <- sapply(units(x), function(i) paste0(i, collapse = "*", recycle0=TRUE))
+  u[u == ""] <- "1"
+
+  u["numerator"]   <- sprintf("(%s)", u["numerator"])
+  u["denominator"] <- sprintf("(%s)", u["denominator"])
+
+  if (!keep_fraction) u <- paste(u, collapse = "/")
+
+  u_base <- sapply(u, function(j) u_strBase(u_str = j, simplify = simplify))
+
+  if (!keep_fraction) {
+    u_base <- sprintf("(%s)", u_base)
+  } else {
+    is_unitless <- u_base == "1"
+
+    u_base["numerator"] <- sprintf("(%s)", u_base["numerator"])
+    u_base["denominator"] <- sprintf("(%s)-1", u_base["denominator"])
+
+    u_base <- u_base[!is_unitless]
+    u_base <- paste(u_base, collapse = " ")
+  }
+
+  set_units(x, u_base, mode = "standard")
+}

R/udunits.R

@@ -76,3 +76,7 @@ ud_is_parseable = function(u) {
 	res <- try(R_ut_parse(u), silent = TRUE)
 	! inherits(res, "try-error")
 }
+
+ud_parse <- function(u, names=FALSE, definition=FALSE, ascii=FALSE) {
+  R_ut_format(R_ut_parse(u), names, definition, ascii)
+}

man/convert_to_base.Rd

@@ -63,3 +63,29 @@ test_that("symbolic_unit works", {
   expect_error(units:::symbolic_unit("qqq"))
   expect_silent(units:::symbolic_unit("m"))
 })
+
+test_that("convert_to_base works", {
+  u <- set_units(1:5, "kJ/kg", mode = "standard")
+  expect_equal(convert_to_base(u), set_units(u, "J/kg"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE), set_units(u, "Gy"))
+  expect_equal(convert_to_base(u, keep_fraction=TRUE, simplify=FALSE), set_units(u, "m^2*kg/s^2/kg"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE, simplify=FALSE), set_units(u, "m^2/s^2"))
+
+  u <- set_units(1:5, "celsius", mode = "standard")
+  expect_equal(convert_to_base(u), set_units(u, "K"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE), set_units(u, "K"))
+  expect_equal(convert_to_base(u, keep_fraction=TRUE, simplify=FALSE), set_units(u, "K"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE, simplify=FALSE), set_units(u, "K"))
+
+  u <- set_units(1:5, "kJ/(kg*fahrenheit)", mode = "standard")
+  expect_equal(convert_to_base(u), set_units(u, "J/kg/K"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE), set_units(u, "m^2/s^2/K"))
+  expect_equal(convert_to_base(u, keep_fraction=TRUE, simplify=FALSE), set_units(u, "m^2*kg/s^2/kg/K"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE, simplify=FALSE), set_units(u, "m^2/s^2/K"))
+
+  u <- set_units(1:5, "J/s", mode = "standard")
+  expect_equal(convert_to_base(u), set_units(u, "J/s"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE), set_units(u, "W"))
+  expect_equal(convert_to_base(u, keep_fraction=TRUE, simplify=FALSE), set_units(u, "m^2*kg/s^3"))
+  expect_equal(convert_to_base(u, keep_fraction=FALSE, simplify=FALSE), set_units(u, "m^2*kg/s^3"))
+})