diff --git a/DESCRIPTION b/DESCRIPTION index b6cdbf11..22f425ee 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1 -Date: 2023-10-20 +Version: 2.1.1.9001 +Date: 2023-12-03 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NAMESPACE b/NAMESPACE index e080bc4b..ca05ddbe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -330,6 +330,7 @@ export(rsi_df) export(rsi_predict) export(scale_rsi_colours) export(scale_sir_colours) +export(scale_x_mic) export(scale_y_percent) export(semi_join_microorganisms) export(set_AMR_locale) diff --git a/NEWS.md b/NEWS.md index f6b9c467..d33307a5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,14 @@ +# AMR 2.1.1.9001 + +## New +* Function `scale_x_mic()`, an advanced function to use in ggplot, to allow plotting of MIC values on the x axis. It allow for manual range definition and plotting missing intermediate log2 levels. + +### Changed +* For MICs: + * Added 4096 and 5 powers of 192 as valid levels (192, 384, 576, 768, 960) + * Added new argument `keep_operators` to `as.mic()`. This can be `"all"` (default), `"none"`, or `"edges"`. + + # AMR 2.1.1 * Fix for selecting first isolates using the phenotype-based method diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 5665f969..4cfdbbf2 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -862,12 +862,20 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu object <- tolower(object) is_in <- tolower(is_in) } - stop_ifnot(all(object %in% is_in, na.rm = TRUE), "argument `", obj_name, "` ", + is_in.bak <- is_in + if ("logical" %in% allow_class) { + is_in <- is_in[!is_in %in% c("TRUE", "FALSE")] + } + or_values <- vector_or(is_in, quotes = !isTRUE(any(c("double", "numeric", "integer") %in% allow_class))) + if ("logical" %in% allow_class) { + or_values <- paste0(or_values, ", or TRUE or FALSE") + } + stop_ifnot(all(object %in% is_in.bak, na.rm = TRUE), "argument `", obj_name, "` ", ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1, "must be either ", "must only contain values " ), - vector_or(is_in, quotes = !isTRUE(any(c("double", "numeric", "integer") %in% allow_class))), + or_values, ifelse(allow_NA == TRUE, ", or NA", ""), call = call_depth ) @@ -1551,7 +1559,7 @@ readRDS_AMR <- function(file, refhook = NULL) { match <- function(x, table, ...) { if (!is.null(AMR_env$chmatch) && inherits(x, "character") && inherits(table, "character")) { # data.table::chmatch() is much faster than base::match() for character - AMR_env$chmatch(x, table, ...) + tryCatch(AMR_env$chmatch(x, table, ...), error = function(e) base::match(x, table, ...)) } else { base::match(x, table, ...) } @@ -1559,7 +1567,7 @@ match <- function(x, table, ...) { `%in%` <- function(x, table) { if (!is.null(AMR_env$chin) && inherits(x, "character") && inherits(table, "character")) { # data.table::`%chin%`() is much faster than base::`%in%`() for character - AMR_env$chin(x, table) + tryCatch(AMR_env$chin(x, table), error = function(e) base::`%in%`(x, table)) } else { base::`%in%`(x, table) } diff --git a/R/mic.R b/R/mic.R index 7116635b..0a70f5d1 100644 --- a/R/mic.R +++ b/R/mic.R @@ -64,10 +64,10 @@ valid_mic_levels <- c( FUN.VALUE = character(45), operators, function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE]) ))), - c(t(vapply( - FUN.VALUE = character(17), operators, - function(x) paste0(x, sort(c(2^c(7:11), 192, 80 * c(2:12)))) - ))) + unique(c(t(vapply( + FUN.VALUE = character(22), operators, + function(x) paste0(x, sort(c(2^c(7:12), 192 * c(1:5), 80 * c(2:12)))) + )))) ) #' Transform Input to Minimum Inhibitory Concentrations (MIC) @@ -76,6 +76,7 @@ valid_mic_levels <- c( #' @rdname as.mic #' @param x a [character] or [numeric] vector #' @param na.rm a [logical] indicating whether missing values should be removed +#' @param keep_operators a [character] specifying how to handle operators (such as `>` and `<=`) in the input. Accepts one of three values: `"all"` (or `TRUE`) to keep all operators, `"none"` (or `FALSE`) to remove all operators, or `"edges"` to keep operators only at both ends of the range. #' @param ... arguments passed on to methods #' @details To interpret MIC values as SIR values, use [as.sir()] on MIC values. It supports guidelines from EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`). #' @@ -161,15 +162,24 @@ valid_mic_levels <- c( #' if (require("ggplot2")) { #' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch #' } -as.mic <- function(x, na.rm = FALSE) { +as.mic <- function(x, na.rm = FALSE, keep_operators = "all") { meet_criteria(x, allow_NA = TRUE) meet_criteria(na.rm, allow_class = "logical", has_length = 1) - - if (is.mic(x)) { + meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1) + if (isTRUE(keep_operators)) { + keep_operators <- "all" + } else if (isFALSE(keep_operators)) { + keep_operators <- "none" + } + + if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) { x } else { + x.bak <- NULL if (is.numeric(x)) { - x <- format(x, scientific = FALSE) + x.bak <- format(x, scientific = FALSE) + # MICs never need more than 4 decimals, so: + x <- format(round(x, 4), scientific = FALSE) } else { x <- as.character(unlist(x)) } @@ -177,7 +187,9 @@ as.mic <- function(x, na.rm = FALSE) { x <- x[!is.na(x)] } x[trimws2(x) == ""] <- NA - x.bak <- x + if (is.null(x.bak)) { + x.bak <- x + } # comma to period x <- gsub(",", ".", x, fixed = TRUE) @@ -238,6 +250,16 @@ as.mic <- function(x, na.rm = FALSE) { call = FALSE ) } + + if (keep_operators == "none" && !all(is.na(x))) { + x <- gsub("[>=<]", "", x) + } else if (keep_operators == "edges" && !all(is.na(x))) { + dbls <- as.double(gsub("[>=<]", "", x)) + x[dbls == min(dbls, na.rm = TRUE)] <- paste0("<=", min(dbls, na.rm = TRUE)) + x[dbls == max(dbls, na.rm = TRUE)] <- paste0(">=", max(dbls, na.rm = TRUE)) + keep <- x[dbls == max(dbls, na.rm = TRUE) | dbls == min(dbls, na.rm = TRUE)] + x[!x %in% keep] <- gsub("[>=<]", "", x[!x %in% keep]) + } set_clean_class(factor(x, levels = valid_mic_levels, ordered = TRUE), new_class = c("mic", "ordered", "factor") @@ -302,8 +324,8 @@ pillar_shaft.mic <- function(x, ...) { operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL) out <- trimws(paste0(operators, trimws(format(crude_numbers)))) out[is.na(x)] <- font_na(NA) - # maketrailing zeroes almost invisible - out[out %like% "[.]"] <- gsub("([.]?0+)$", font_white("\\1"), out[out %like% "[.]"], perl = TRUE) + # make trailing zeroes less visible + out[out %like% "[.]"] <- gsub("([.]?0+)$", font_silver("\\1"), out[out %like% "[.]"], perl = TRUE) create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out)))) } diff --git a/R/plot.R b/R/plot.R index 6451b1e6..5b0fa585 100755 --- a/R/plot.R +++ b/R/plot.R @@ -29,8 +29,10 @@ #' Plotting for Classes `sir`, `mic` and `disk` #' +#' @description #' Functions to plot classes `sir`, `mic` and `disk`, with support for base \R and `ggplot2`. - +#' +#' Especially [scale_x_mic()] is a relevant wrapper to plot MIC values for `ggplot2`. It allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values. #' @param x,object values created with [as.mic()], [as.disk()] or [as.sir()] (or their `random_*` variants, such as [random_mic()]) #' @param mo any (vector of) text that can be coerced to a valid microorganism code with [as.mo()] #' @param ab any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()] @@ -322,6 +324,89 @@ fortify.mic <- function(object, ...) { ) } +#' @export +#' @inheritParams as.mic +#' @param mic_range a manual range to plot 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 drop,guide,position,na.translate arguments passed on to [ggplot2::scale_x_discrete()] +#' @rdname plot +#' @examples +#' +#' # Plotting using scale_x_mic() +#' \donttest{ +#' if (require("ggplot2")) { +#' mic_plot <- ggplot(data.frame(mics = as.mic(c(0.125, "<=4", 4, 8, 32, ">=32")), +#' counts = c(1, 1, 2, 2, 3, 3)), +#' aes(mics, counts)) + +#' geom_col() +#' mic_plot + +#' labs(title = "without scale_x_mic()") +#' } +#' if (require("ggplot2")) { +#' mic_plot + +#' scale_x_mic() + +#' labs(title = "with scale_x_mic()") +#' } +#' if (require("ggplot2")) { +#' mic_plot + +#' scale_x_mic(keep_operators = "all") + +#' labs(title = "with scale_x_mic() keeping all operators") +#' } +#' if (require("ggplot2")) { +#' mic_plot + +#' scale_x_mic(mic_range = c(1, 128)) + +#' labs(title = "with scale_x_mic() using a manual range") +#' } +#' } +scale_x_mic <- function(keep_operators = "edges", mic_range = NULL, ..., drop = FALSE, guide = waiver(), position = "bottom", na.translate = TRUE) { + meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1) + meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE) + stop_ifnot(all(mic_range %in% c(levels(as.mic(1)), NA)), + "Values in `mic_range` must be valid MIC values") + stop_ifnot_installed("ggplot2") + + ggplot2::ggproto(NULL, ggplot2::ScaleDiscretePosition, + aesthetics = c("x", "xmin", "xmax", "xend"), + na.translate = na.translate, + drop = drop, + guide = guide, + position = position, + transform = function(x, keep_ops = keep_operators, mic_rng = mic_range) { + if (!is.null(mic_rng)) { + min_mic <- mic_rng[1] + max_mic <- mic_rng[2] + if (!is.na(min_mic)) { + x[x < as.mic(min_mic)] <- as.mic(min_mic) + } + if (!is.na(max_mic)) { + x[x > as.mic(max_mic)] <- as.mic(max_mic) + } + } + # transform MICs to only keep required operators + x <- as.mic(x, keep_operators = ifelse(keep_ops == "edges", "none", keep_ops)) + # get range betwen min and max of MICs + expanded <- plot_prepare_table(x, + expand = TRUE, + keep_operators = ifelse(keep_ops == "edges", "none", keep_ops), + mic_range = mic_rng) + if (keep_ops == "edges") { + names(expanded)[1] <- paste0("<=", names(expanded)[1]) + names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)]) + } + # MICs contain all MIC levels, so strip this to only existing levels and their intermediate values + out <- factor(names(expanded), + levels = names(expanded), + ordered = TRUE) + # and only keep the ones in the data + if (keep_ops == "edges") { + out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))] + } else { + out <- out[match(x, out)] + } + out + }, + ...) +} + #' @method plot disk #' @export #' @importFrom graphics barplot axis mtext legend @@ -714,15 +799,26 @@ fortify.sir <- function(object, ...) { ) } -plot_prepare_table <- function(x, expand) { +plot_prepare_table <- function(x, expand, keep_operators = "all", mic_range = NULL) { x <- x[!is.na(x)] stop_if(length(x) == 0, "no observations to plot", call = FALSE) if (is.mic(x)) { + x <- as.mic(x, keep_operators = keep_operators) if (expand == TRUE) { # expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print valid_lvls <- levels(x) - extra_range <- max(x) / 2 - while (min(extra_range) / 2 > min(x)) { + extra_range <- max(x) + min_range <- min(x) + if (!is.null(mic_range)) { + if (!is.na(mic_range[2])) { + extra_range <- as.mic(mic_range[2]) * 2 + } + if (!is.na(mic_range[1])) { + min_range <- as.mic(mic_range[1]) + } + } + extra_range <- extra_range / 2 + while (min(extra_range) / 2 > min_range) { extra_range <- c(min(extra_range) / 2, extra_range) } nms <- extra_range diff --git a/R/sysdata.rda b/R/sysdata.rda index 6cd9001a..49ddae29 100755 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/man/as.mic.Rd b/man/as.mic.Rd index 83b7c9ab..7f7920b4 100644 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -9,7 +9,7 @@ \alias{droplevels.mic} \title{Transform Input to Minimum Inhibitory Concentrations (MIC)} \usage{ -as.mic(x, na.rm = FALSE) +as.mic(x, na.rm = FALSE, keep_operators = "all") NA_mic_ @@ -22,6 +22,8 @@ is.mic(x) \item{na.rm}{a \link{logical} indicating whether missing values should be removed} +\item{keep_operators}{a \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} + \item{as.mic}{a \link{logical} to indicate whether the \code{mic} class should be kept - the default is \code{FALSE}} \item{...}{arguments passed on to methods} diff --git a/man/plot.Rd b/man/plot.Rd index 6edbaf62..dcaa8561 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -5,6 +5,7 @@ \alias{plot.mic} \alias{autoplot.mic} \alias{fortify.mic} +\alias{scale_x_mic} \alias{plot.disk} \alias{autoplot.disk} \alias{fortify.disk} @@ -47,6 +48,16 @@ \method{fortify}{mic}(object, ...) +scale_x_mic( + keep_operators = "edges", + mic_range = NULL, + ..., + drop = FALSE, + guide = waiver(), + position = "bottom", + na.translate = TRUE +) + \method{plot}{disk}( x, main = deparse(substitute(x)), @@ -126,6 +137,12 @@ \item{breakpoint_type}{the type of breakpoints to use, either "ECOFF", "animal", or "human". ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_breakpoint_type}}.} \item{...}{arguments passed on to methods} + +\item{keep_operators}{a \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} + +\item{mic_range}{a manual range to plot the MIC values, e.g., \code{mic_range = c(0.001, 32)}. Use \code{NA} to set no limit on one side, e.g., \code{mic_range = c(NA, 32)}.} + +\item{drop, guide, position, na.translate}{arguments passed on to \code{\link[ggplot2:scale_discrete]{ggplot2::scale_x_discrete()}}} } \value{ The \code{autoplot()} functions return a \code{\link[ggplot2:ggplot]{ggplot}} model that is extendible with any \code{ggplot2} function. @@ -134,6 +151,8 @@ The \code{fortify()} functions return a \link{data.frame} as an extension for us } \description{ Functions to plot classes \code{sir}, \code{mic} and \code{disk}, with support for base \R and \code{ggplot2}. + +Especially \code{\link[=scale_x_mic]{scale_x_mic()}} is a relevant wrapper to plot MIC values for \code{ggplot2}. It allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values. } \details{ The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases. @@ -167,4 +186,31 @@ if (require("ggplot2")) { autoplot(some_sir_values) } } + +# Plotting using scale_x_mic() +\donttest{ +if (require("ggplot2")) { + mic_plot <- ggplot(data.frame(mics = as.mic(c(0.125, "<=4", 4, 8, 32, ">=32")), + counts = c(1, 1, 2, 2, 3, 3)), + aes(mics, counts)) + + geom_col() + mic_plot + + labs(title = "without scale_x_mic()") +} +if (require("ggplot2")) { + mic_plot + + scale_x_mic() + + labs(title = "with scale_x_mic()") +} +if (require("ggplot2")) { + mic_plot + + scale_x_mic(keep_operators = "all") + + labs(title = "with scale_x_mic() keeping all operators") +} +if (require("ggplot2")) { + mic_plot + + scale_x_mic(mic_range = c(1, 128)) + + labs(title = "with scale_x_mic() using a manual range") +} +} }