From 9c95aa455c0aaef97393f8219937b309ae03f278 Mon Sep 17 00:00:00 2001 From: Matthijs Berends Date: Tue, 24 Mar 2026 12:44:47 +0100 Subject: [PATCH] (v3.0.1.9040) fix MIC plotting --- DESCRIPTION | 4 ++-- NEWS.md | 3 ++- R/ab.R | 2 +- R/av.R | 4 ++-- R/disk.R | 2 +- R/mic.R | 13 +++++-------- R/mo.R | 10 +++++----- R/plotting.R | 39 ++++++++++++++++++++++++++++++++++----- R/sir.R | 26 +++++++++++++++----------- tests/testthat/test-zzz.R | 2 ++ 10 files changed, 69 insertions(+), 36 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8ebd4a2bc..650f939fc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9039 -Date: 2026-03-23 +Version: 3.0.1.9040 +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 diff --git a/NEWS.md b/NEWS.md index e447c4792..e43d0f943 100644 --- a/NEWS.md +++ b/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 diff --git a/R/ab.R b/R/ab.R index 6ea6b0d45..db97914da 100755 --- a/R/ab.R +++ b/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()) { diff --git a/R/av.R b/R/av.R index beb2d6176..72898e9cf 100755 --- a/R/av.R +++ b/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)] <- font_na(NA) + out[!is.na(x)] <- gsub("+", pillar::style_subtle("+"), out[!is.na(x)], fixed = TRUE) + out[is.na(x)] <- pillar::style_na(NA) create_pillar_column(out, align = "left", min_width = 4) } diff --git a/R/disk.R b/R/disk.R index c3effe851..941cf6ac2 100755 --- a/R/disk.R +++ b/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) } diff --git a/R/mic.R b/R/mic.R index cafa53c0c..ff5b9815e 100644 --- a/R/mic.R +++ b/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()) { - fn <- font_silver - } else { - fn <- font_white - } - out[out %like% "[.]"] <- gsub("([.]?0+)$", fn("\\1"), out[out %like% "[.]"], perl = TRUE) + out[out %like% "[.]"] <- gsub("([.]?0+)$", pillar::style_subtle("\\1"), out[out %like% "[.]"], perl = TRUE) + create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out)))) } diff --git a/R/mo.R b/R/mo.R index ffeec4356..fed825139 100755 --- a/R/mo.R +++ b/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[x == "UNKNOWN"] <- font_na(" UNKNOWN") + out[is.na(x)] <- pillar::style_na(" NA") + 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 diff --git a/R/plotting.R b/R/plotting.R index 8b9b7e3c6..0d292616c 100755 --- a/R/plotting.R +++ b/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) { - 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)]) + # 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)) { - self$mic_values_levels + 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)) { diff --git a/R/sir.R b/R/sir.R index ab47a52ee..74cde946b 100755 --- a/R/sir.R +++ b/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[x == "S"] <- font_green_bg(" S ") - out[x == "SDD"] <- font_green_lighter_bg(" SDD ") - out[x == "I"] <- font_orange_bg(" I ") - out[x == "R"] <- font_rose_bg(" R ") - out[x == "NI"] <- font_grey_bg(font_black(" NI ")) - out[x == "WT"] <- font_green_bg(font_black(" WT ")) - out[x == "NWT"] <- font_rose_bg(font_black(" NWT ")) - out[x == "NS"] <- font_rose_bg(font_black(" NS ")) + out[is.na(x)] <- pillar::style_subtle(" NA") + out[x == "S"] <- font_green_bg(" S ") # has font_black internally + out[x == "SDD"] <- font_green_lighter_bg(" SDD ") # has font_black internally + if (getOption("AMR_guideline", "EUCAST")[1] == "EUCAST") { + out[x == "I"] <- font_green_lighter_bg(" I ") # has font_black internally + } else { + out[x == "I"] <- font_orange_bg(" I ") # has font_black internally + } + 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) } diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R index 8b2f7ab80..153fc97fe 100644 --- a/tests/testthat/test-zzz.R +++ b/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",