(v3.0.1.9040) fix MIC plotting

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.0.1.9039
+Version: 3.0.1.9040
-Date: 2026-03-23
+Date: 2026-03-24
 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

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 3.0.1.9039
+# AMR 3.0.1.9040
 
 ### New
 * Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
@@ -23,6 +23,7 @@
 * Fixed a bug in `as.ab()` where certain AB codes containing "PH" or "TH" (such as `ETH`, `MTH`, `PHE`, `PHN`, `STH`, `THA`, `THI1`) would incorrectly return `NA` when combined in a vector with any untranslatable value (#245)
 * Fixed a bug in `antibiogram()` for when no antimicrobials are set
 * Fixed a bug in `as.sir()` where for numeric input the arguments `S`,  `I`,  and `R` would not be considered (#244)
+* Fixed a bug in plotting MIC values when `keep_operators = "all"`
 * Fixed some foreign translations of antimicrobial drugs
 * Fixed a bug for printing column names to the console when using `mutate_at(vars(...), as.mic)` (#249)
 * Fixed a bug to disregard `NI` for susceptibility proportion functions

R/ab.R

@@ -529,7 +529,7 @@ NA_ab_ <- set_clean_class(NA_character_,
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
 pillar_shaft.ab <- function(x, ...) {
   out <- trimws(format(x))
-  out[is.na(x)] <- font_na(NA)
+  out[is.na(x)] <- pillar::style_na(NA)
 
   # add the names to the drugs as mouse-over!
   if (in_rstudio()) {

R/av.R

@@ -511,8 +511,8 @@ is.av <- function(x) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
 pillar_shaft.av <- function(x, ...) {
   out <- trimws(format(x))
-  out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
+  out[!is.na(x)] <- gsub("+", pillar::style_subtle("+"), out[!is.na(x)], fixed = TRUE)
-  out[is.na(x)] <- font_na(NA)
+  out[is.na(x)] <- pillar::style_na(NA)
   create_pillar_column(out, align = "left", min_width = 4)
 }
 

R/disk.R

@@ -162,7 +162,7 @@ is.disk <- function(x) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
 pillar_shaft.disk <- function(x, ...) {
   out <- trimws(format(x))
-  out[is.na(x)] <- font_na(NA)
+  out[is.na(x)] <- pillar::style_na(NA)
   create_pillar_column(out, align = "right", width = 2)
 }
 

R/mic.R

@@ -322,6 +322,7 @@ NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE)
 #' @export
 rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, round_to_next_log2 = FALSE) {
   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)
@@ -448,16 +449,12 @@ pillar_shaft.mic <- function(x, ...) {
   crude_numbers <- as.double(x)
   operators <- gsub("[^<=>]+", "", as.character(x))
   # colourise operators
-  operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL)
+  operators[!is.na(operators) & operators != ""] <- pillar::style_subtle(operators[!is.na(operators) & operators != ""])
   out <- trimws(paste0(operators, trimws(format(crude_numbers))))
-  out[is.na(x)] <- font_na(NA)
+  out[is.na(x)] <- pillar::style_na(NA)
   # make trailing zeroes less visible
-  if (is_dark()) {
+  out[out %like% "[.]"] <- gsub("([.]?0+)$", pillar::style_subtle("\\1"), out[out %like% "[.]"], perl = TRUE)
-    fn <- font_silver
+
-  } else {
-    fn <- font_white
-  }
-  out[out %like% "[.]"] <- gsub("([.]?0+)$", fn("\\1"), out[out %like% "[.]"], perl = TRUE)
   create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
 }
 

R/mo.R

@@ -648,13 +648,13 @@ pillar_shaft.mo <- function(x, ...) {
   add_MO_lookup_to_AMR_env()
   out <- trimws(format(x))
   # grey out the kingdom (part until first "_")
-  out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
+  out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
   # and grey out every _
-  out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)])
+  out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
 
   # markup NA and UNKNOWN
-  out[is.na(x)] <- font_na("  NA")
+  out[is.na(x)] <- pillar::style_na("  NA")
-  out[x == "UNKNOWN"] <- font_na("  UNKNOWN")
+  out[x == "UNKNOWN"] <- pillar::style_na("  UNKNOWN")
 
   # markup manual codes
   out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo] <- font_blue(out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo], collapse = NULL)
@@ -673,7 +673,7 @@ pillar_shaft.mo <- function(x, ...) {
     (!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
     # markup old mo codes
     out[!x %in% all_mos] <- font_italic(
-      font_na(x[!x %in% all_mos],
+      pillar::style_na(x[!x %in% all_mos],
         collapse = NULL
       ),
       collapse = NULL

R/plotting.R

@@ -266,7 +266,7 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
       }
       out[[aest_val]] <- log2(as.double(mics))
     } else {
-      self$mic_values_rescaled <- rescale_mic(x = as.double(as.mic(df[[aest]])), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
+      self$mic_values_rescaled <- rescale_mic(x = as.character(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
       # create new breaks and labels here
       lims <- range(self$mic_values_rescaled, na.rm = TRUE)
       # support inner and outer 'mic_range' settings (e.g., the data ranges 0.5-8 and 'mic_range' is set to 0.025-32)
@@ -280,11 +280,21 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
       ind_max <- which(COMMON_MIC_VALUES >= lims[2])[which.min(abs(COMMON_MIC_VALUES[COMMON_MIC_VALUES >= lims[2]] - lims[2]))] # Closest index where COMMON_MIC_VALUES >= lims[2]
 
       self$mic_values_levels <- as.mic(COMMON_MIC_VALUES[ind_min:ind_max])
+      if (length(unique(self$mic_values_levels)) > 1) {
+        if (keep_operators == "all" && !all(self$mic_values_rescaled %in% self$mic_values_levels, na.rm = TRUE)) {
+          self$mic_values_levels <- unique(sort(c(self$mic_values_levels, self$mic_values_rescaled)))
 
-      if (keep_operators %in% c("edges", "all") && length(unique(self$mic_values_levels)) > 1) {
+          # collision = same log2 position, but different string labels
+          log_positions <- log2(as.double(self$mic_values_levels))
+          dup_positions <- log_positions[duplicated(log_positions) | duplicated(log_positions, fromLast = TRUE)]
+          colliding_labels <- as.character(self$mic_values_levels)[log_positions %in% dup_positions]
+          self$warn_keep_all_operators <- length(unique(colliding_labels)) > 1
+        } else if (keep_operators == "edges") {
           self$mic_values_levels[1] <- paste0("<=", self$mic_values_levels[1])
           self$mic_values_levels[length(self$mic_values_levels)] <- paste0(">=", self$mic_values_levels[length(self$mic_values_levels)])
         }
+      }
+
       self$mic_values_log <- log2(as.double(self$mic_values_rescaled))
 
       if (aest == "y" && "group" %in% colnames(df)) {
@@ -312,7 +322,26 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
   }
   scale$labels <- function(..., self) {
     if (is.null(self$mic_breaks_set)) {
+      if (isTRUE(self$warn_keep_all_operators)) {
+        lookup <- tapply(
+          as.character(self$mic_values_rescaled),
+          self$mic_values_log,
+          function(x) paste(unique(x), collapse = ", ")
+        )
+        level_log <- as.character(log2(as.double(self$mic_values_levels)))
+
+        if (any(grepl(", ", lookup))) {
+          warning_("Using {.arg keep_operators = \"all\"} caused MIC values with different operators to share the same log2 position on the axis. These have been combined into a single label (e.g., {.val ", lookup[grepl(", ", lookup)][1], "}).", call = FALSE)
+        }
+
+        ifelse(
+          level_log %in% names(lookup),
+          lookup[level_log],
+          as.character(self$mic_values_levels)
+        )
+      } else {
         self$mic_values_levels
+      }
     } else {
       breaks <- tryCatch(scale$breaks(), error = function(e) NULL)
       if (!is.null(breaks)) {

R/sir.R

@@ -1729,7 +1729,7 @@ as_sir_method <- function(method_short,
         pm_filter(uti == FALSE)
       notes_current <- paste0(
         notes_current, "\n",
-        paste0("Breakpoints for UTI ", font_bold("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument {.arg uti} to set which isolates are from urine. See {.help [{.fun as.sir}](AMR::as.sir)}.")
+        paste0("Breakpoints for UTI ", font_bold("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument `uti` to set which isolates are from urine. See `?as.sir`.")
       )
     } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_current)) {
       # breakpoints for multiple body sites available
@@ -1919,7 +1919,7 @@ as_sir_method <- function(method_short,
         host = vectorise_log_entry(breakpoints_current[, "host", drop = TRUE], length(rows)),
         input = vectorise_log_entry(as.character(input_clean), length(rows)),
         outcome = vectorise_log_entry(as.sir(new_sir), length(rows)),
-        notes = cli_to_plain(font_stripstyle(notes_current)),
+        notes = font_stripstyle(notes_current),
         guideline = vectorise_log_entry(guideline_current, length(rows)),
         ref_table = vectorise_log_entry(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
         uti = vectorise_log_entry(breakpoints_current[, "uti", drop = TRUE], length(rows)),
@@ -2010,15 +2010,19 @@ pillar_shaft.sir <- function(x, ...) {
   if (has_colour()) {
     # colours will anyway not work when has_colour() == FALSE,
     # but then the indentation should also not be applied
-    out[is.na(x)] <- font_grey("  NA")
+    out[is.na(x)] <- pillar::style_subtle("  NA")
-    out[x == "S"] <- font_green_bg("  S  ")
+    out[x == "S"] <- font_green_bg("  S  ") # has font_black internally
-    out[x == "SDD"] <- font_green_lighter_bg(" SDD ")
+    out[x == "SDD"] <- font_green_lighter_bg(" SDD ") # has font_black internally
-    out[x == "I"] <- font_orange_bg("  I  ")
+    if (getOption("AMR_guideline", "EUCAST")[1] == "EUCAST") {
-    out[x == "R"] <- font_rose_bg("  R  ")
+      out[x == "I"] <- font_green_lighter_bg("  I  ") # has font_black internally
-    out[x == "NI"] <- font_grey_bg(font_black("  NI "))
+    } else {
-    out[x == "WT"] <- font_green_bg(font_black("  WT "))
+      out[x == "I"] <- font_orange_bg("  I  ") # has font_black internally
-    out[x == "NWT"] <- font_rose_bg(font_black(" NWT "))
+    }
-    out[x == "NS"] <- font_rose_bg(font_black("  NS "))
+    out[x == "R"] <- font_rose_bg("  R  ") # has font_black internally
+    out[x == "NI"] <- font_grey_bg(font_black("  NI ", adapt = FALSE))
+    out[x == "WT"] <- font_green_bg("  WT ") # has font_black internally
+    out[x == "NWT"] <- font_rose_bg(" NWT ") # has font_black internally
+    out[x == "NS"] <- font_rose_bg("  NS ") # has font_black internally
   }
   create_pillar_column(out, align = "left", width = 5)
 }

tests/testthat/test-zzz.R

@@ -131,6 +131,8 @@ test_that("test-zzz.R", {
     "availableCores" = "parallelly",
     # pillar
     "pillar_shaft" = "pillar",
+    "style_na" = "pillar",
+    "style_subtle" = "pillar",
     "tbl_format_footer" = "pillar",
     "tbl_sum" = "pillar",
     "type_sum" = "pillar",