mirror of https://github.com/msberends/AMR.git
768 lines
19 KiB
R
Executable File
768 lines
19 KiB
R
Executable File
# ==================================================================== #
|
|
# TITLE #
|
|
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
|
# #
|
|
# SOURCE #
|
|
# https://github.com/msberends/AMR #
|
|
# #
|
|
# LICENCE #
|
|
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
|
# Developed at the University of Groningen, the Netherlands, in #
|
|
# collaboration with non-profit organisations Certe Medical #
|
|
# Diagnostics & Advice, and University Medical Center Groningen. #
|
|
# #
|
|
# This R package is free software; you can freely use and distribute #
|
|
# it for both personal and commercial purposes under the terms of the #
|
|
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
|
# the Free Software Foundation. #
|
|
# We created this package for both routine data analysis and academic #
|
|
# research and it was publicly released in the hope that it will be #
|
|
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
|
# #
|
|
# Visit our website for the full manual and a complete tutorial about #
|
|
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
|
# ==================================================================== #
|
|
|
|
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
|
|
#'
|
|
#' This ransforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
|
|
#' @inheritSection lifecycle Stable Lifecycle
|
|
#' @rdname as.mic
|
|
#' @param x character or numeric vector
|
|
#' @param na.rm a logical indicating whether missing values should be removed
|
|
#' @details To interpret MIC values as RSI values, use [as.rsi()] on MIC values. It supports guidelines from EUCAST and CLSI.
|
|
#'
|
|
#' This class for MIC values is a quite a special data type: formally it is an ordered factor with valid MIC values as factor levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
|
|
#'
|
|
#' ```
|
|
#' x <- random_mic(10)
|
|
#' x
|
|
#' #> Class <mic>
|
|
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
|
#'
|
|
#' is.factor(x)
|
|
#' #> [1] TRUE
|
|
#'
|
|
#' x[1] * 2
|
|
#' #> [1] 32
|
|
#'
|
|
#' median(x)
|
|
#' #> [1] 26
|
|
#' ```
|
|
#'
|
|
#' This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using numeric values in data analysis, e.g.:
|
|
#'
|
|
#' ```
|
|
#' x[x > 4]
|
|
#' #> Class <mic>
|
|
#' #> [1] 16 8 8 64 >=128 32 32 16
|
|
#'
|
|
#' df <- data.frame(x, hospital = "A")
|
|
#' subset(df, x > 4) # or with dplyr: df %>% filter(x > 4)
|
|
#' #> x hospital
|
|
#' #> 1 16 A
|
|
#' #> 5 64 A
|
|
#' #> 6 >=128 A
|
|
#' #> 8 32 A
|
|
#' #> 9 32 A
|
|
#' #> 10 16 A
|
|
#' ```
|
|
#'
|
|
#' The following [generic functions][groupGeneric()] are implemented for the MIC class: `!`, `!=`, `%%`, `%/%`, `&`, `*`, `+`, `-`, `/`, `<`, `<=`, `==`, `>`, `>=`, `^`, `|`, [abs()], [acos()], [acosh()], [all()], [any()], [asin()], [asinh()], [atan()], [atanh()], [ceiling()], [cos()], [cosh()], [cospi()], [cummax()], [cummin()], [cumprod()], [cumsum()], [digamma()], [exp()], [expm1()], [floor()], [gamma()], [lgamma()], [log()], [log1p()], [log2()], [log10()], [max()], [mean()], [min()], [prod()], [range()], [round()], [sign()], [signif()], [sin()], [sinh()], [sinpi()], [sqrt()], [sum()], [tan()], [tanh()], [tanpi()], [trigamma()] and [trunc()]. Some functions of the `stats` package are also implemented: [median()], [quantile()], [mad()], [IQR()], [fivenum()]. Also, [boxplot.stats()] is supported. Since [sd()] and [var()] are non-generic functions, these could not be extended. Use [mad()] as an alternative, or use e.g. `sd(as.numeric(x))` where `x` is your vector of MIC values.
|
|
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a numeric value.
|
|
#' @aliases mic
|
|
#' @export
|
|
#' @seealso [as.rsi()]
|
|
#' @inheritSection AMR Read more on Our Website!
|
|
#' @examples
|
|
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
|
#' is.mic(mic_data)
|
|
#'
|
|
#' # this can also coerce combined MIC/RSI values:
|
|
#' as.mic("<=0.002; S") # will return <=0.002
|
|
#'
|
|
#' # mathematical processing treats MICs as numeric values
|
|
#' fivenum(mic_data)
|
|
#' quantile(mic_data)
|
|
#' all(mic_data < 512)
|
|
#'
|
|
#' # interpret MIC values
|
|
#' as.rsi(x = as.mic(2),
|
|
#' mo = as.mo("S. pneumoniae"),
|
|
#' ab = "AMX",
|
|
#' guideline = "EUCAST")
|
|
#' as.rsi(x = as.mic(4),
|
|
#' mo = as.mo("S. pneumoniae"),
|
|
#' ab = "AMX",
|
|
#' guideline = "EUCAST")
|
|
#'
|
|
#' # plot MIC values, see ?plot
|
|
#' plot(mic_data)
|
|
#' plot(mic_data, mo = "E. coli", ab = "cipro")
|
|
as.mic <- function(x, na.rm = FALSE) {
|
|
meet_criteria(x, allow_class = c("mic", "character", "numeric", "integer"), allow_NA = TRUE)
|
|
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
|
|
|
if (is.mic(x)) {
|
|
x
|
|
} else {
|
|
x <- unlist(x)
|
|
if (na.rm == TRUE) {
|
|
x <- x[!is.na(x)]
|
|
}
|
|
x.bak <- x
|
|
|
|
# comma to period
|
|
x <- gsub(",", ".", x, fixed = TRUE)
|
|
# transform Unicode for >= and <=
|
|
x <- gsub("\u2264", "<=", x, fixed = TRUE)
|
|
x <- gsub("\u2265", ">=", x, fixed = TRUE)
|
|
# remove space between operator and number ("<= 0.002" -> "<=0.002")
|
|
x <- gsub("(<|=|>) +", "\\1", x, perl = TRUE)
|
|
# transform => to >= and =< to <=
|
|
x <- gsub("=<", "<=", x, fixed = TRUE)
|
|
x <- gsub("=>", ">=", x, fixed = TRUE)
|
|
# dots without a leading zero must start with 0
|
|
x <- gsub("([^0-9]|^)[.]", "\\10.", x, perl = TRUE)
|
|
# values like "<=0.2560.512" should be 0.512
|
|
x <- gsub(".*[.].*[.]", "0.", x, perl = TRUE)
|
|
# remove ending .0
|
|
x <- gsub("[.]+0$", "", x, perl = TRUE)
|
|
# remove all after last digit
|
|
x <- gsub("[^0-9]+$", "", x, perl = TRUE)
|
|
# keep only one zero before dot
|
|
x <- gsub("0+[.]", "0.", x, perl = TRUE)
|
|
# starting 00 is probably 0.0 if there's no dot yet
|
|
x[!x %like% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
|
# remove last zeroes
|
|
x <- gsub("([.].?)0+$", "\\1", x, perl = TRUE)
|
|
x <- gsub("(.*[.])0+$", "\\10", x, perl = TRUE)
|
|
# remove ending .0 again
|
|
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
|
|
# never end with dot
|
|
x <- gsub("[.]$", "", x, perl = TRUE)
|
|
# force to be character
|
|
x <- as.character(x)
|
|
# trim it
|
|
x <- trimws(x)
|
|
|
|
## previously unempty values now empty - should return a warning later on
|
|
x[x.bak != "" & x == ""] <- "invalid"
|
|
|
|
# these are allowed MIC values and will become factor levels
|
|
ops <- c("<", "<=", "", ">=", ">")
|
|
lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))),
|
|
unique(c(t(vapply(FUN.VALUE = character(104), ops, function(x) paste0(x, sort(as.double(paste0("0.0",
|
|
sort(c(1:99, 125, 128, 256, 512, 625)))))))))),
|
|
unique(c(t(vapply(FUN.VALUE = character(103), ops, function(x) paste0(x, sort(as.double(paste0("0.",
|
|
c(1:99, 125, 128, 256, 512))))))))),
|
|
c(t(vapply(FUN.VALUE = character(10), ops, function(x) paste0(x, sort(c(1:9, 1.5)))))),
|
|
c(t(vapply(FUN.VALUE = character(45), ops, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])))),
|
|
c(t(vapply(FUN.VALUE = character(15), ops, function(x) paste0(x, sort(c(2 ^ c(7:10), 80 * c(2:12))))))))
|
|
|
|
na_before <- x[is.na(x) | x == ""] %pm>% length()
|
|
x[!x %in% lvls] <- NA
|
|
na_after <- x[is.na(x) | x == ""] %pm>% length()
|
|
|
|
if (na_before != na_after) {
|
|
list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %pm>%
|
|
unique() %pm>%
|
|
sort() %pm>%
|
|
vector_and(quotes = TRUE)
|
|
warning_(na_after - na_before, " results truncated (",
|
|
round(((na_after - na_before) / length(x)) * 100),
|
|
"%) that were invalid MICs: ",
|
|
list_missing, call = FALSE)
|
|
}
|
|
|
|
set_clean_class(factor(x, levels = lvls, ordered = TRUE),
|
|
new_class = c("mic", "ordered", "factor"))
|
|
}
|
|
}
|
|
|
|
all_valid_mics <- function(x) {
|
|
if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) {
|
|
return(FALSE)
|
|
}
|
|
x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
|
|
error = function(e) NA)
|
|
!any(is.na(x_mic)) && !all(is.na(x))
|
|
}
|
|
|
|
#' @rdname as.mic
|
|
#' @export
|
|
is.mic <- function(x) {
|
|
inherits(x, "mic")
|
|
}
|
|
|
|
#' @method as.double mic
|
|
#' @export
|
|
#' @noRd
|
|
as.double.mic <- function(x, ...) {
|
|
as.double(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
|
}
|
|
|
|
#' @method as.integer mic
|
|
#' @export
|
|
#' @noRd
|
|
as.integer.mic <- function(x, ...) {
|
|
as.integer(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
|
}
|
|
|
|
#' @method as.numeric mic
|
|
#' @export
|
|
#' @noRd
|
|
as.numeric.mic <- function(x, ...) {
|
|
as.numeric(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
|
}
|
|
|
|
#' @method droplevels mic
|
|
#' @export
|
|
#' @noRd
|
|
droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA, as.mic = TRUE, ...) {
|
|
x <- droplevels.factor(x, exclude = exclude, ...)
|
|
if (as.mic == TRUE) {
|
|
class(x) <- c("mic", "ordered", "factor")
|
|
}
|
|
x
|
|
}
|
|
|
|
# will be exported using s3_register() in R/zzz.R
|
|
pillar_shaft.mic <- function(x, ...) {
|
|
crude_numbers <- as.double(x)
|
|
operators <- gsub("[^<=>]+", "", as.character(x))
|
|
pasted <- trimws(paste0(operators, trimws(format(crude_numbers))))
|
|
out <- pasted
|
|
out[is.na(x)] <- font_na(NA)
|
|
out <- gsub("(<|=|>)", font_silver("\\1"), out)
|
|
out <- gsub("([.]?0+)$", font_white("\\1"), out)
|
|
create_pillar_column(out, align = "right", width = max(nchar(pasted)))
|
|
}
|
|
|
|
# will be exported using s3_register() in R/zzz.R
|
|
type_sum.mic <- function(x, ...) {
|
|
"mic"
|
|
}
|
|
|
|
#' @method print mic
|
|
#' @export
|
|
#' @noRd
|
|
print.mic <- function(x, ...) {
|
|
cat("Class <mic>\n")
|
|
print(as.character(x), quote = FALSE)
|
|
att <- attributes(x)
|
|
if ("na.action" %in% names(att)) {
|
|
cat(font_silver(paste0("(NA ", class(att$na.action), ": ", paste0(att$na.action, collapse = ", "), ")\n")))
|
|
}
|
|
}
|
|
|
|
#' @method summary mic
|
|
#' @export
|
|
#' @noRd
|
|
summary.mic <- function(object, ...) {
|
|
summary(as.double(object), ...)
|
|
}
|
|
|
|
#' @method as.matrix mic
|
|
#' @export
|
|
#' @noRd
|
|
as.matrix.mic <- function(x, ...) {
|
|
as.matrix(as.double(x), ...)
|
|
}
|
|
|
|
#' @method [ mic
|
|
#' @export
|
|
#' @noRd
|
|
"[.mic" <- function(x, ...) {
|
|
y <- NextMethod()
|
|
attributes(y) <- attributes(x)
|
|
y
|
|
}
|
|
#' @method [[ mic
|
|
#' @export
|
|
#' @noRd
|
|
"[[.mic" <- function(x, ...) {
|
|
y <- NextMethod()
|
|
attributes(y) <- attributes(x)
|
|
y
|
|
}
|
|
#' @method [<- mic
|
|
#' @export
|
|
#' @noRd
|
|
"[<-.mic" <- function(i, j, ..., value) {
|
|
value <- as.mic(value)
|
|
y <- NextMethod()
|
|
attributes(y) <- attributes(i)
|
|
y
|
|
}
|
|
#' @method [[<- mic
|
|
#' @export
|
|
#' @noRd
|
|
"[[<-.mic" <- function(i, j, ..., value) {
|
|
value <- as.mic(value)
|
|
y <- NextMethod()
|
|
attributes(y) <- attributes(i)
|
|
y
|
|
}
|
|
#' @method c mic
|
|
#' @export
|
|
#' @noRd
|
|
c.mic <- function(x, ...) {
|
|
y <- unlist(lapply(list(...), as.character))
|
|
x <- as.character(x)
|
|
as.mic(c(x, y))
|
|
}
|
|
|
|
#' @method unique mic
|
|
#' @export
|
|
#' @noRd
|
|
unique.mic <- function(x, incomparables = FALSE, ...) {
|
|
y <- NextMethod()
|
|
attributes(y) <- attributes(x)
|
|
y
|
|
}
|
|
|
|
#' @method sort mic
|
|
#' @export
|
|
#' @noRd
|
|
sort.mic <- function(x, decreasing = FALSE, ...) {
|
|
if (decreasing == TRUE) {
|
|
ord <- order(-as.double(x))
|
|
} else {
|
|
ord <- order(as.double(x))
|
|
}
|
|
x[ord]
|
|
}
|
|
|
|
#' @method hist mic
|
|
#' @importFrom graphics hist
|
|
#' @export
|
|
#' @noRd
|
|
hist.mic <- function(x, ...) {
|
|
warning_("Use `plot()` or `ggplot()` for optimal plotting of MIC values", call = FALSE)
|
|
hist(log2(x))
|
|
}
|
|
|
|
# will be exported using s3_register() in R/zzz.R
|
|
get_skimmers.mic <- function(column) {
|
|
skimr::sfl(
|
|
skim_type = "mic",
|
|
min = ~min(., na.rm = TRUE),
|
|
max = ~max(., na.rm = TRUE),
|
|
median = ~stats::median(., na.rm = TRUE),
|
|
n_unique = ~pm_n_distinct(., na.rm = TRUE),
|
|
hist_log2 = ~skimr::inline_hist(log2(stats::na.omit(.)))
|
|
)
|
|
}
|
|
|
|
# Miscellaneous mathematical functions ------------------------------------
|
|
|
|
#' @method mean mic
|
|
#' @export
|
|
#' @noRd
|
|
mean.mic <- function(x, trim = 0, na.rm = FALSE, ...) {
|
|
mean(as.double(x), trim = trim, na.rm = na.rm, ...)
|
|
}
|
|
|
|
#' @method median mic
|
|
#' @importFrom stats median
|
|
#' @export
|
|
#' @noRd
|
|
median.mic <- function(x, na.rm = FALSE, ...) {
|
|
median(as.double(x), na.rm = na.rm, ...)
|
|
}
|
|
|
|
#' @method quantile mic
|
|
#' @importFrom stats quantile
|
|
#' @export
|
|
#' @noRd
|
|
quantile.mic <- function(x, probs = seq(0, 1, 0.25), na.rm = FALSE,
|
|
names = TRUE, type = 7, ...) {
|
|
quantile(as.double(x), probs = probs, na.rm = na.rm, names = names, type = type, ...)
|
|
}
|
|
|
|
# Math (see ?groupGeneric) ----------------------------------------------
|
|
|
|
#' @method abs mic
|
|
#' @export
|
|
#' @noRd
|
|
abs.mic <- function(x) {
|
|
abs(as.double(x))
|
|
}
|
|
#' @method sign mic
|
|
#' @export
|
|
#' @noRd
|
|
sign.mic <- function(x) {
|
|
sign(as.double(x))
|
|
}
|
|
#' @method sqrt mic
|
|
#' @export
|
|
#' @noRd
|
|
sqrt.mic <- function(x) {
|
|
sqrt(as.double(x))
|
|
}
|
|
#' @method floor mic
|
|
#' @export
|
|
#' @noRd
|
|
floor.mic <- function(x) {
|
|
floor(as.double(x))
|
|
}
|
|
#' @method ceiling mic
|
|
#' @export
|
|
#' @noRd
|
|
ceiling.mic <- function(x) {
|
|
ceiling(as.double(x))
|
|
}
|
|
#' @method trunc mic
|
|
#' @export
|
|
#' @noRd
|
|
trunc.mic <- function(x, ...) {
|
|
trunc(as.double(x), ...)
|
|
}
|
|
#' @method round mic
|
|
#' @export
|
|
#' @noRd
|
|
round.mic <- function(x, digits = 0) {
|
|
round(as.double(x), digits = digits)
|
|
}
|
|
#' @method signif mic
|
|
#' @export
|
|
#' @noRd
|
|
signif.mic <- function(x, digits = 6) {
|
|
signif(as.double(x), digits = digits)
|
|
}
|
|
#' @method exp mic
|
|
#' @export
|
|
#' @noRd
|
|
exp.mic <- function(x) {
|
|
exp(as.double(x))
|
|
}
|
|
#' @method log mic
|
|
#' @export
|
|
#' @noRd
|
|
log.mic <- function(x, base = exp(1)) {
|
|
log(as.double(x), base = base)
|
|
}
|
|
#' @method log10 mic
|
|
#' @export
|
|
#' @noRd
|
|
log10.mic <- function(x) {
|
|
log10(as.double(x))
|
|
}
|
|
#' @method log2 mic
|
|
#' @export
|
|
#' @noRd
|
|
log2.mic <- function(x) {
|
|
log2(as.double(x))
|
|
}
|
|
#' @method expm1 mic
|
|
#' @export
|
|
#' @noRd
|
|
expm1.mic <- function(x) {
|
|
expm1(as.double(x))
|
|
}
|
|
#' @method log1p mic
|
|
#' @export
|
|
#' @noRd
|
|
log1p.mic <- function(x) {
|
|
log1p(as.double(x))
|
|
}
|
|
#' @method cos mic
|
|
#' @export
|
|
#' @noRd
|
|
cos.mic <- function(x) {
|
|
cos(as.double(x))
|
|
}
|
|
#' @method sin mic
|
|
#' @export
|
|
#' @noRd
|
|
sin.mic <- function(x) {
|
|
sin(as.double(x))
|
|
}
|
|
#' @method tan mic
|
|
#' @export
|
|
#' @noRd
|
|
tan.mic <- function(x) {
|
|
tan(as.double(x))
|
|
}
|
|
#' @method cospi mic
|
|
#' @export
|
|
#' @noRd
|
|
cospi.mic <- function(x) {
|
|
cospi(as.double(x))
|
|
}
|
|
#' @method sinpi mic
|
|
#' @export
|
|
#' @noRd
|
|
sinpi.mic <- function(x) {
|
|
sinpi(as.double(x))
|
|
}
|
|
#' @method tanpi mic
|
|
#' @export
|
|
#' @noRd
|
|
tanpi.mic <- function(x) {
|
|
tanpi(as.double(x))
|
|
}
|
|
#' @method acos mic
|
|
#' @export
|
|
#' @noRd
|
|
acos.mic <- function(x) {
|
|
acos(as.double(x))
|
|
}
|
|
#' @method asin mic
|
|
#' @export
|
|
#' @noRd
|
|
asin.mic <- function(x) {
|
|
asin(as.double(x))
|
|
}
|
|
#' @method atan mic
|
|
#' @export
|
|
#' @noRd
|
|
atan.mic <- function(x) {
|
|
atan(as.double(x))
|
|
}
|
|
#' @method cosh mic
|
|
#' @export
|
|
#' @noRd
|
|
cosh.mic <- function(x) {
|
|
cosh(as.double(x))
|
|
}
|
|
#' @method sinh mic
|
|
#' @export
|
|
#' @noRd
|
|
sinh.mic <- function(x) {
|
|
sinh(as.double(x))
|
|
}
|
|
#' @method tanh mic
|
|
#' @export
|
|
#' @noRd
|
|
tanh.mic <- function(x) {
|
|
tanh(as.double(x))
|
|
}
|
|
#' @method acosh mic
|
|
#' @export
|
|
#' @noRd
|
|
acosh.mic <- function(x) {
|
|
acosh(as.double(x))
|
|
}
|
|
#' @method asinh mic
|
|
#' @export
|
|
#' @noRd
|
|
asinh.mic <- function(x) {
|
|
asinh(as.double(x))
|
|
}
|
|
#' @method atanh mic
|
|
#' @export
|
|
#' @noRd
|
|
atanh.mic <- function(x) {
|
|
atanh(as.double(x))
|
|
}
|
|
#' @method lgamma mic
|
|
#' @export
|
|
#' @noRd
|
|
lgamma.mic <- function(x) {
|
|
lgamma(as.double(x))
|
|
}
|
|
#' @method gamma mic
|
|
#' @export
|
|
#' @noRd
|
|
gamma.mic <- function(x) {
|
|
gamma(as.double(x))
|
|
}
|
|
#' @method digamma mic
|
|
#' @export
|
|
#' @noRd
|
|
digamma.mic <- function(x) {
|
|
digamma(as.double(x))
|
|
}
|
|
#' @method trigamma mic
|
|
#' @export
|
|
#' @noRd
|
|
trigamma.mic <- function(x) {
|
|
trigamma(as.double(x))
|
|
}
|
|
#' @method cumsum mic
|
|
#' @export
|
|
#' @noRd
|
|
cumsum.mic <- function(x) {
|
|
cumsum(as.double(x))
|
|
}
|
|
#' @method cumprod mic
|
|
#' @export
|
|
#' @noRd
|
|
cumprod.mic <- function(x) {
|
|
cumprod(as.double(x))
|
|
}
|
|
#' @method cummax mic
|
|
#' @export
|
|
#' @noRd
|
|
cummax.mic <- function(x) {
|
|
cummax(as.double(x))
|
|
}
|
|
#' @method cummin mic
|
|
#' @export
|
|
#' @noRd
|
|
cummin.mic <- function(x) {
|
|
cummin(as.double(x))
|
|
}
|
|
|
|
# Ops (see ?groupGeneric) -----------------------------------------------
|
|
|
|
|
|
#' @method + mic
|
|
#' @export
|
|
#' @noRd
|
|
`+.mic` <- function(e1, e2) {
|
|
as.double(e1) + as.double(e2)
|
|
}
|
|
|
|
#' @method - mic
|
|
#' @export
|
|
#' @noRd
|
|
`-.mic` <- function(e1, e2) {
|
|
as.double(e1) - as.double(e2)
|
|
}
|
|
|
|
#' @method * mic
|
|
#' @export
|
|
#' @noRd
|
|
`*.mic` <- function(e1, e2) {
|
|
as.double(e1) * as.double(e2)
|
|
}
|
|
|
|
#' @method / mic
|
|
#' @export
|
|
#' @noRd
|
|
`/.mic` <- function(e1, e2) {
|
|
as.double(e1) / as.double(e2)
|
|
}
|
|
|
|
#' @method ^ mic
|
|
#' @export
|
|
#' @noRd
|
|
`^.mic` <- function(e1, e2) {
|
|
as.double(e1) ^ as.double(e2)
|
|
}
|
|
|
|
#' @method %% mic
|
|
#' @export
|
|
#' @noRd
|
|
`%%.mic` <- function(e1, e2) {
|
|
as.double(e1) %% as.double(e2)
|
|
}
|
|
|
|
#' @method %/% mic
|
|
#' @export
|
|
#' @noRd
|
|
`%/%.mic` <- function(e1, e2) {
|
|
as.double(e1) %/% as.double(e2)
|
|
}
|
|
|
|
#' @method & mic
|
|
#' @export
|
|
#' @noRd
|
|
`&.mic` <- function(e1, e2) {
|
|
as.double(e1) & as.double(e2)
|
|
}
|
|
|
|
#' @method | mic
|
|
#' @export
|
|
#' @noRd
|
|
`|.mic` <- function(e1, e2) {
|
|
as.double(e1) | as.double(e2)
|
|
}
|
|
|
|
#' @method ! mic
|
|
#' @export
|
|
#' @noRd
|
|
`!.mic` <- function(x) {
|
|
!as.double(x)
|
|
}
|
|
|
|
#' @method == mic
|
|
#' @export
|
|
#' @noRd
|
|
`==.mic` <- function(e1, e2) {
|
|
as.double(e1) == as.double(e2)
|
|
}
|
|
|
|
#' @method != mic
|
|
#' @export
|
|
#' @noRd
|
|
`!=.mic` <- function(e1, e2) {
|
|
as.double(e1) != as.double(e2)
|
|
}
|
|
|
|
#' @method < mic
|
|
#' @export
|
|
#' @noRd
|
|
`<.mic` <- function(e1, e2) {
|
|
as.double(e1) < as.double(e2)
|
|
}
|
|
|
|
#' @method <= mic
|
|
#' @export
|
|
#' @noRd
|
|
`<=.mic` <- function(e1, e2) {
|
|
as.double(e1) <= as.double(e2)
|
|
}
|
|
|
|
#' @method >= mic
|
|
#' @export
|
|
#' @noRd
|
|
`>=.mic` <- function(e1, e2) {
|
|
as.double(e1) >= as.double(e2)
|
|
}
|
|
|
|
#' @method > mic
|
|
#' @export
|
|
#' @noRd
|
|
`>.mic` <- function(e1, e2) {
|
|
as.double(e1) > as.double(e2)
|
|
}
|
|
|
|
# Summary (see ?groupGeneric) -------------------------------------------
|
|
|
|
#' @method all mic
|
|
#' @export
|
|
#' @noRd
|
|
all.mic <- function(..., na.rm = FALSE) {
|
|
all(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method any mic
|
|
#' @export
|
|
#' @noRd
|
|
any.mic <- function(..., na.rm = FALSE) {
|
|
any(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method sum mic
|
|
#' @export
|
|
#' @noRd
|
|
sum.mic <- function(..., na.rm = FALSE) {
|
|
sum(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method prod mic
|
|
#' @export
|
|
#' @noRd
|
|
prod.mic <- function(..., na.rm = FALSE) {
|
|
prod(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method min mic
|
|
#' @export
|
|
#' @noRd
|
|
min.mic <- function(..., na.rm = FALSE) {
|
|
min(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method max mic
|
|
#' @export
|
|
#' @noRd
|
|
max.mic <- function(..., na.rm = FALSE) {
|
|
max(as.double(c(...)), na.rm = na.rm)
|
|
}
|
|
#' @method range mic
|
|
#' @export
|
|
#' @noRd
|
|
range.mic <- function(..., na.rm = FALSE) {
|
|
range(as.double(c(...)), na.rm = na.rm)
|
|
}
|