add scale_x_mic()

2025-10-31 11:28:18 +01:00 · 2023-12-03 01:06:00 +01:00
parent 4c11a7bd9c
commit 6f417d0ef2
9 changed files with 208 additions and 22 deletions
--- a/4
+++ b/4
@@ -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
--- a/1
+++ b/1
@@ -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)
--- 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
--- 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)
  }
--- 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))))
 }

--- 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
--- a/R/sysdata.rda
+++ b/R/sysdata.rda
--- 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}
--- 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")
+}
+}
 }