From 1d48012355f723feb9d44e23e6b9f2a209e9278f Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 9 Mar 2026 20:00:06 +0000 Subject: [PATCH] eucast_rules(): add `add_if_missing` argument to control NA imputation (#259) When `add_if_missing = FALSE`, rules are only applied to cells that already contain an SIR value; `NA` cells are left untouched. This is useful with `overwrite = TRUE` to update reported results without imputing values for drugs that were not tested. https://claude.ai/code/session_01Nucc8nXGLqNUjtuC9GrhTc --- DESCRIPTION | 2 +- NEWS.md | 3 ++- R/interpretive_rules.R | 36 +++++++++++++++++++++--------------- 3 files changed, 24 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index de8d80492..dcf58a40a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 3.0.1.9033 +Version: 3.0.1.9034 Date: 2026-03-09 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index c6ecbb237..1c84456f8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9033 +# AMR 3.0.1.9034 ### New * Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes` @@ -15,6 +15,7 @@ - Functions such as `susceptibility()` count WT as S and NWT as R * `interpretive_rules()`, which allows future implementation of CLSI interpretive rules (#235) - `eucast_rules()` has become a wrapper around that function +* `eucast_rules()` / `interpretive_rules()` gained argument `add_if_missing` (default: `TRUE`). When set to `FALSE`, rules are only applied to cells that already contain an SIR value; `NA` cells are left untouched. This is useful with `overwrite = TRUE` to update reported results without imputing values for drugs that were not tested (#259) * Two new `NA` objects, `NA_ab_` and `NA_mo_`, analogous to base R's `NA_character_` and `NA_integer_`, for use in pipelines that require typed missing values ### Fixes diff --git a/R/interpretive_rules.R b/R/interpretive_rules.R index 02b3094ae..4dfdb2e50 100755 --- a/R/interpretive_rules.R +++ b/R/interpretive_rules.R @@ -79,6 +79,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()]. #' @param custom_rules Custom rules to apply, created with [custom_eucast_rules()]. #' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant". +#' @param add_if_missing A [logical] indicating whether rules should also be applied to missing (`NA`) values (default: `TRUE`). When `FALSE`, rules are only applied to cells that already contain an SIR value; cells with `NA` are left untouched. This is particularly useful when using `overwrite = TRUE` with custom rules and you want to update reported results without imputing values for untested drugs. #' @inheritParams first_isolate #' @details #' **Note:** This function does not translate MIC values to SIR values. Use [as.sir()] for that. \cr @@ -175,6 +176,7 @@ interpretive_rules <- function(x, only_sir_columns = any(is.sir(x)), custom_rules = NULL, overwrite = FALSE, + add_if_missing = TRUE, ...) { meet_criteria(x, allow_class = "data.frame") meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) @@ -189,6 +191,7 @@ interpretive_rules <- function(x, meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1) meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE) meet_criteria(overwrite, allow_class = "logical", has_length = 1) + meet_criteria(add_if_missing, allow_class = "logical", has_length = 1) stop_if( guideline == "CLSI", @@ -538,7 +541,8 @@ interpretive_rules <- function(x, warned = warned, info = info, verbose = verbose, - overwrite = overwrite + overwrite = overwrite, + add_if_missing = add_if_missing ) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed @@ -580,7 +584,8 @@ interpretive_rules <- function(x, warned = warned, info = info, verbose = verbose, - overwrite = overwrite + overwrite = overwrite, + add_if_missing = add_if_missing ) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed @@ -877,7 +882,8 @@ interpretive_rules <- function(x, warned = warned, info = info, verbose = verbose, - overwrite = overwrite + overwrite = overwrite, + add_if_missing = add_if_missing ) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed @@ -947,7 +953,8 @@ interpretive_rules <- function(x, warned = warned, info = info, verbose = verbose, - overwrite = overwrite + overwrite = overwrite, + add_if_missing = add_if_missing ) n_added <- n_added + run_changes$added n_changed <- n_changed + run_changes$changed @@ -1139,7 +1146,8 @@ edit_sir <- function(x, warned, info, verbose, - overwrite) { + overwrite, + add_if_missing) { cols <- unique(cols[!is.na(cols) & !is.null(cols)]) # for Verbose Mode, keep track of all changes and return them @@ -1172,13 +1180,15 @@ edit_sir <- function(x, if (isFALSE(overwrite) && any(isSIR) && message_not_thrown_before("edit_sir.warning_overwrite")) { warning_("Some values had SIR values and were not overwritten, since `overwrite = FALSE`.") } + # determine which cells to modify based on overwrite and add_if_missing + apply_mask <- if (isTRUE(overwrite)) { + if (isFALSE(add_if_missing)) !isNA else rep(TRUE, length(isNA)) + } else { + if (isFALSE(add_if_missing)) isSIR else non_SIR + } tryCatch( # insert into original table - if (isTRUE(overwrite)) { - new_edits[rows, cols] <- to - } else { - new_edits[rows, cols][non_SIR] <- to - }, + new_edits[rows, cols][apply_mask] <- to, warning = function(w) { if (w$message %like% "invalid factor level") { xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) { @@ -1188,11 +1198,7 @@ edit_sir <- function(x, ) TRUE }) - if (isTRUE(overwrite)) { - suppressWarnings(new_edits[rows, cols] <<- to) - } else { - suppressWarnings(new_edits[rows, cols][non_SIR] <<- to) - } + suppressWarnings(new_edits[rows, cols][apply_mask] <<- to) warning_( "in `eucast_rules()`: value \"", to, "\" added to the factor levels of column", ifelse(length(cols) == 1, "", "s"),