Nothing
.as.mixed_units = function(x) {
stopifnot(is.list(unclass(x)))
structure(x, class = c("mixed_units", "list"))
}
# constructor function:
#' Create or convert to a mixed units list-column
#' @param x numeric, or vector of class \code{units}
#' @param values character vector with units encodings, or list with symbolic units of class \code{mixed_symbolic_units}
#' @param value see values
#' @param ... ignored
#' @details if \code{x} is of class \code{units}, \code{values} should be missing or of class \code{mixed_symbolic_units}; if \code{x} is numeric, \code{values} should be a character vector the length of \code{x}.
#' @examples
#' a <- 1:4
#' u <- c("m/s", "km/h", "mg/L", "g")
#' mixed_units(a, u)
#' units(a) = as_units("m/s")
#' mixed_units(a) # converts to mixed representation
#' @export
mixed_units <- function(x, values, ...) UseMethod("mixed_units")
#' @export
mixed_units.units = function(x, values, ...) {
stopifnot(missing(values))
u = as.character(units(x))
mixed_units(unclass(x), rep(u, length(x)))
}
#' @export
mixed_units.numeric = function(x, values, ...) {
#stopifnot(length(x) == length(values), is.character(values), is.numeric(x))
stopifnot(is.character(values), is.numeric(x))
.as.mixed_units(mapply(set_units, x, values, mode = "standard", SIMPLIFY = FALSE))
}
#' @export
#' @name mixed_units
`units<-.mixed_units` = function(x, value) {
set_units(x, value)
}
#' @export
format.mixed_units = function(x, ...) {
sapply(x, format, ...)
}
#' @export
`[.mixed_units` = function(x, i, ...) {
.as.mixed_units(unclass(x)[i])
}
#' @export
c.mixed_units = function(...) {
args = list(...)
.as.mixed_units(do.call(c, lapply(args, unclass)))
}
#' @export
set_units.mixed_units = function(x, value, ..., mode = "standard") {
if (! is.character(value))
stop("use character string to denote target unit") # FIXME: rlang::quo stuff needed here?
# conversion data frame and split
cv <- data.frame(
val = as.numeric(x), from = I(units(x)), to = value, idx = seq_along(x),
stringsAsFactors = FALSE)
sp <- paste(cv$from, cv$to, sep=".")
sp <- factor(sp, levels=unique(sp))
# grouped conversion
cv <- do.call(rbind, unname(by(cv, sp, function(x) {
x$val <- set_units(x$val, x$from[[1]], mode="standard")
x$val <- mixed_units(set_units(x$val, x$to[1], mode="standard"))
x
}, simplify=FALSE)))
# reordering
cv[order(cv$idx), ]$val
}
#' @export
as_units.mixed_units = function(x, ...) {
set_units(do.call(c, x), value = units(x[[1]]), mode = "standard")
}
#' @export
units.mixed_units = function(x) {
u = lapply(x, function(i) if (inherits(i, "units")) units(i) else NULL)
structure(u, class = "mixed_symbolic_units")
}
#' @export
as.character.mixed_symbolic_units = function(x, ...) {
sapply(x, function(i) if (!is.null(i)) as.character(i) else "NULL")
}
.cat_units_table <- function(x) {
cat("Mixed units: ")
if (!length(x)) return()
tbl = table(as.character(units(x)))
tbl = paste(names(tbl), " (", as.numeric(tbl), ")", sep = "")
cat(paste(tbl, collapse = ", "), "\n")
}
#' @export
print.mixed_units = function(x, ...) {
.cat_units_table(x)
cat(paste(format(x, ...), collapse = ", "), "\n")
}
#' @export
str.mixed_units = function(object, ...) {
.cat_units_table(object)
cat(capture.output(str(unclass(object), ...))[-1], sep="\n")
}
#' @name drop_units
#' @export
drop_units.mixed_units = function(x) {
sapply(x, drop_units)
}
#' @export
Ops.mixed_units = function(e1, e2) {
if (inherits(e2, "units"))
e2 = mixed_units(e2)
ret = switch(.Generic,
"==" = mapply(function(x, y) { x == y }, e1, e2, SIMPLIFY = TRUE),
"!=" = mapply(function(x, y) { x != y }, e1, e2, SIMPLIFY = TRUE),
"*" = mapply(function(x, y) { x * y }, e1, e2, SIMPLIFY = FALSE),
"/" = mapply(function(x, y) { x / y }, e1, e2, SIMPLIFY = FALSE),
"+" = mapply(function(x, y) { x + y }, e1, e2, SIMPLIFY = FALSE),
"-" = mapply(function(x, y) { x - y }, e1, e2, SIMPLIFY = FALSE),
stop(paste("operation", .Generic, "not supported"))
)
if (is.list(ret))
ret = .as.mixed_units(ret)
ret
}
#' @export
unique.mixed_units <- function(x, incomparables = FALSE, ...) {
.as.mixed_units(NextMethod())
}
#' @export
as.data.frame.mixed_units <- as.data.frame.AsIs
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.