P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2026-03-11 15:47:54 +01:00
Code Releases Activity

eucast_rules(): add add_if_missing argument to control NA imputation (#259)

Browse Source 
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
This commit is contained in:
Claude
2026-03-09 20:00:06 +00:00
parent 353eaa3f38
commit 1d48012355
3 changed files with 24 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@@ -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)

3
NEWS.md
View File

@@ -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

36
R/interpretive_rules.R
View File

@@ -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"),