mirror of
https://github.com/msberends/AMR.git
synced 2025-07-10 19:41:55 +02:00
(v2.1.1.9144) new MIC scales and fix for rescale_mic()
This commit is contained in:
24
R/mic.R
24
R/mic.R
@ -207,7 +207,7 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
|
||||
# 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)
|
||||
x <- gsub("^0+[.]", "0.", x, perl = TRUE)
|
||||
# starting 00 is probably 0.0 if there's no dot yet
|
||||
x[x %unlike% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
||||
# remove last zeroes
|
||||
@ -224,7 +224,7 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
|
||||
x[x.bak != "" & x == ""] <- "invalid"
|
||||
|
||||
na_before <- x[is.na(x) | x == ""] %pm>% length()
|
||||
x[!x %in% VALID_MIC_LEVELS] <- NA
|
||||
x[!as.character(x) %in% VALID_MIC_LEVELS] <- NA
|
||||
na_after <- x[is.na(x) | x == ""] %pm>% length()
|
||||
|
||||
if (na_before != na_after) {
|
||||
@ -273,12 +273,22 @@ NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE)
|
||||
)
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @param mic_range a manual range to limit the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to set no limit on one side, e.g., `mic_range = c(NA, 32)`.
|
||||
#' @param mic_range a manual range to limit the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to prevent a limit on one side, e.g., `mic_range = c(NA, 32)`.
|
||||
#' @export
|
||||
rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical", "mic"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
if (is.numeric(mic_range)) {
|
||||
mic_range <- trimws(format(mic_range, scientific = FALSE))
|
||||
mic_range <- gsub("[.]0+$", "", mic_range)
|
||||
mic_range[mic_range == "NA"] <- NA_character_
|
||||
} else if (is.mic(mic_range)) {
|
||||
mic_range <- as.character(mic_range)
|
||||
}
|
||||
stop_ifnot(all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
"Values in `mic_range` must be valid MIC values. Unvalid: ", vector_and(mic_range[mic_range %in% c(VALID_MIC_LEVELS, NA)]))
|
||||
"Values in `mic_range` must be valid MIC values. ",
|
||||
"The allowed range is ", format(as.double(as.mic(VALID_MIC_LEVELS)[1]), scientific = FALSE), " to ", format(as.double(as.mic(VALID_MIC_LEVELS)[length(VALID_MIC_LEVELS)]), scientific = FALSE), ". ",
|
||||
"Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), ".")
|
||||
|
||||
x <- as.mic(x)
|
||||
if (is.null(mic_range)) {
|
||||
mic_range <- c(NA, NA)
|
||||
@ -297,7 +307,7 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators))
|
||||
|
||||
if (isTRUE(as.mic)) {
|
||||
if (keep_operators == "edges") {
|
||||
if (keep_operators == "edges" && length(x) > 1) {
|
||||
x[x == min(x, na.rm = TRUE)] <- paste0("<=", x[x == min(x, na.rm = TRUE)])
|
||||
x[x == max(x, na.rm = TRUE)] <- paste0(">=", x[x == max(x, na.rm = TRUE)])
|
||||
}
|
||||
@ -342,7 +352,7 @@ as.numeric.mic <- function(x, ...) {
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @method droplevels mic
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept - the default is `FALSE`
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept - the default is `TRUE` for [rescale_mic()] and `FALSE` for [droplevels()]. When setting this to `FALSE` in [rescale_mic()], the output will have factor levels that acknowledge `mic_range`.
|
||||
#' @export
|
||||
droplevels.mic <- function(x, as.mic = FALSE, ...) {
|
||||
x <- as.mic(x) # make sure that currently implemented MIC levels are used
|
||||
|
||||
116
R/plotting.R
116
R/plotting.R
@ -83,7 +83,7 @@
|
||||
#' plot(some_disk_values, mo = "Escherichia coli", ab = "cipro", language = "nl")
|
||||
#'
|
||||
#'
|
||||
#' # Plotting using scale_x_mic() ---------------------------------------------
|
||||
#' # Plotting using scale_x_mic() -----------------------------------------
|
||||
#' \donttest{
|
||||
#' if (require("ggplot2")) {
|
||||
#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
@ -114,6 +114,37 @@
|
||||
#' labs(title = "with scale_x_mic() using a manual 'outside' range")
|
||||
#' }
|
||||
#'
|
||||
#' # Plotting using scale_y_mic() -----------------------------------------
|
||||
#' some_groups <- sample(LETTERS[1:5], 20, replace = TRUE)
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(mic = some_mic_values,
|
||||
#' group = some_groups),
|
||||
#' aes(group, mic)) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' scale_y_mic()
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(mic = some_mic_values,
|
||||
#' group = some_groups),
|
||||
#' aes(group, mic)) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' scale_y_mic(mic_range = c(NA, 2))
|
||||
#' }
|
||||
#'
|
||||
#' # Plotting using scale_fill_mic() -----------------------------------------
|
||||
#' some_counts <- as.integer(runif(20, 5, 50))
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot(data.frame(mic = some_mic_values,
|
||||
#' group = some_groups,
|
||||
#' counts = some_counts,
|
||||
#' aes(group, counts, fill = mic)) +
|
||||
#' geom_col() +
|
||||
#' scale_fill_mic(mic_range = c(0.5, 16))
|
||||
#' }
|
||||
#'
|
||||
#' # Auto plotting --------------------------------------------------------
|
||||
#' if (require("ggplot2")) {
|
||||
#' autoplot(some_mic_values)
|
||||
#' }
|
||||
@ -124,7 +155,7 @@
|
||||
#' autoplot(some_sir_values)
|
||||
#' }
|
||||
#'
|
||||
#' # Plotting using scale_y_percent() -----------------------------------------
|
||||
#' # Plotting using scale_y_percent() -------------------------------------
|
||||
#' if (require("ggplot2")) {
|
||||
#' p <- ggplot(data.frame(mics = as.mic(c(0.25, "<=4", 4, 8, 32, ">=32")),
|
||||
#' counts = c(1, 1, 2, 2, 3, 3)),
|
||||
@ -145,16 +176,35 @@
|
||||
#' }
|
||||
NULL
|
||||
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @param drop a [logical] to remove intermediate MIC values, defaults to `FALSE`
|
||||
#' @rdname plot
|
||||
scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, drop = FALSE, ...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(drop, allow_class = "logical", has_length = 1)
|
||||
scale <- ggplot2::scale_x_discrete(drop = drop, ...)
|
||||
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
|
||||
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
|
||||
create_scale_mic <- function(aest, keep_operators, mic_range, ...) {
|
||||
ggplot_fn <- getExportedValue(paste0("scale_", aest, "_continuous"),
|
||||
ns = asNamespace("ggplot2"))
|
||||
args <- list(...)
|
||||
args[c("trans", "transform", "transform_df", "breaks", "labels", "limits")] <- NULL
|
||||
scale <- do.call(ggplot_fn, args)
|
||||
|
||||
scale$transform <- function(x) {
|
||||
as.double(rescale_mic(x = as.double(x), keep_operators = , "labels", mic_range = mic_range, as.mic = TRUE))
|
||||
}
|
||||
scale$transform_df <- function(self, df) {
|
||||
self$`.values_rescaled` <- rescale_mic(x = as.double(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
|
||||
self$`.values_levels` <- levels(rescale_mic(x = as.double(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = FALSE))
|
||||
if (length(self$`.values_levels`) > 6 & "0.025" %in% self$`.values_levels`) {
|
||||
# TODO weird levelling out leading to 0.025 being redundant
|
||||
self$`.values_levels` <- self$`.values_levels`[self$`.values_levels` != "0.025"]
|
||||
}
|
||||
self$`.values_log` <- log2(as.double(self$`.values_rescaled`))
|
||||
if (aest == "y" && "group" %in% colnames(df)) {
|
||||
df$group <- as.integer(factor(df$x))
|
||||
}
|
||||
df[[aest]] <- self$`.values_log`
|
||||
df
|
||||
}
|
||||
scale$breaks <- function(..., self) log2(as.mic(self$`.values_levels`))
|
||||
scale$labels <- function(..., self) self$`.values_levels`
|
||||
scale$limits <- function(..., self) {
|
||||
rng <- range(log2(as.mic(self$`.values_levels`)))
|
||||
c(rng[1] - 0.5, rng[2] + 0.5)
|
||||
}
|
||||
scale
|
||||
}
|
||||
@ -162,40 +212,34 @@ scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, drop = FALSE
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @rdname plot
|
||||
scale_y_mic <- function(keep_operators = "edges", mic_range = NULL, drop = FALSE, ...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(drop, allow_class = "logical", has_length = 1)
|
||||
scale <- ggplot2::scale_y_discrete(drop = drop, ...)
|
||||
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
|
||||
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
|
||||
}
|
||||
scale
|
||||
scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
|
||||
create_scale_mic("x", keep_operators = keep_operators, mic_range = mic_range, ...)
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @rdname plot
|
||||
scale_colour_mic <- function(keep_operators = "edges", mic_range = NULL, drop = FALSE, ...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(drop, allow_class = "logical", has_length = 1)
|
||||
scale <- ggplot2::scale_colour_discrete(drop = drop, ...)
|
||||
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
|
||||
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
|
||||
}
|
||||
scale
|
||||
scale_y_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
|
||||
create_scale_mic("y", keep_operators = keep_operators, mic_range = mic_range, ...)
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @rdname plot
|
||||
scale_fill_mic <- function(keep_operators = "edges", mic_range = NULL, drop = FALSE, ...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(drop, allow_class = "logical", has_length = 1)
|
||||
scale <- ggplot2::scale_fill_discrete(drop = drop, ...)
|
||||
scale$transform <- function(x, keep_ops = keep_operators, mic_rng = mic_range) {
|
||||
rescale_mic(x = x, keep_operators = keep_ops, mic_range = mic_rng, as.mic = FALSE)
|
||||
}
|
||||
scale
|
||||
scale_colour_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
|
||||
create_scale_mic("colour", keep_operators = keep_operators, mic_range = mic_range, ...)
|
||||
}
|
||||
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @rdname plot
|
||||
scale_color_mic <- scale_colour_mic
|
||||
|
||||
#' @export
|
||||
#' @inheritParams as.mic
|
||||
#' @rdname plot
|
||||
scale_fill_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
|
||||
create_scale_mic("fill", keep_operators = keep_operators, mic_range = mic_range, ...)
|
||||
}
|
||||
|
||||
#' @method plot mic
|
||||
|
||||
Reference in New Issue
Block a user