P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-13 01:51:52 +02:00
Code Releases Activity

(v2.1.1.9200) new argument capped_mic_handling, add Search to website

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-03-14 17:01:50 +01:00
parent 58d7aa8790
commit 72f2e723fb
17 changed files with 161 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
R/aa_options.R
View File

@ -33,6 +33,7 @@
#' @section Options:
#' * `AMR_antibiogram_formatting_type` \cr A [numeric] (1-22) to use in [antibiogram()], to indicate which formatting type to use.
#' * `AMR_breakpoint_type` \cr A [character] to use in [as.sir()], to indicate which breakpoint type to use. This must be either `r vector_or(clinical_breakpoints$type)`.
#' * `AMR_capped_mic_handling` \cr A [character] to use in [as.sir()], to indicate how capped MIC values (`<`, `<=`, `>`, `>=`) should be interpreted. Must be one of `"standard"`, `"strict"`, `"relaxed"`, or `"inverse"` - the default is `"standard"`.
#' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
#' * `AMR_custom_ab` \cr A file location to an RDS file, to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
#' * `AMR_custom_mo` \cr A file location to an RDS file, to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].

8
R/ab.R
View File

@ -172,11 +172,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
previously_coerced <- x %in% AMR_env$ab_previously_coerced$x
x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)]
prev <- x_bak[which(x[which(previously_coerced)] %in% x_bak_clean)]
if (any(previously_coerced) && isTRUE(info) && message_not_thrown_before("as.ab", prev, entire_session = TRUE)) {
if (any(previously_coerced) && isTRUE(info) && message_not_thrown_before("as.ab", entire_session = TRUE)) {
message_(
"Returning previously coerced value", ifelse(length(unique(prev)) > 1, "s", ""),
" for ", vector_and(prev), ". Run `ab_reset_session()` to reset this. This note will be shown once per session for this input."
"Returning previously coerced ",
ifelse(length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) > 1, "value for an antimicrobial", "values for various antimicrobials"),
". Run `ab_reset_session()` to reset this. This note will be shown once per session."
)
}

71
R/sir.R
View File

@ -44,7 +44,17 @@
#' @param uti (Urinary Tract Infection) a vector (or column name) with [logical]s (`TRUE` or `FALSE`) to specify whether a UTI specific interpretation from the guideline should be chosen. For using [as.sir()] on a [data.frame], this can also be a column containing [logical]s or when left blank, the data set will be searched for a column 'specimen', and rows within this column containing 'urin' (such as 'urine', 'urina') will be regarded isolates from a UTI. See *Examples*.
#' @inheritParams first_isolate
#' @param guideline defaults to `r AMR::clinical_breakpoints$guideline[1]` (the latest implemented EUCAST guideline in the [AMR::clinical_breakpoints] data set), but can be set with the package option [`AMR_guideline`][AMR-options]. Currently supports EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`), see *Details*.
#' @param conserve_capped_values a [logical] to indicate that MIC values starting with `">"` (but not `">="`) must always return "R" , and that MIC values starting with `"<"` (but not `"<="`) must always return "S"
#' @param capped_mic_handling A [character] string that controls how MIC values with a cap (i.e., starting with `<`, `<=`, `>`, or `>=`) are interpreted. Supports the following options:
#' - `"standard"` (default)\cr
#' `<=` and `>=` return `"NI"` if the value is **within** the breakpoint guideline range, while `<` and `>` are interpreted normally.
#' - `"strict"`\cr
#' Enforces conservative handling; `<` always returns `"S"`, `>` always returns `"R"`, and `<=`/`>=` return `"NI"` when within breakpoint guideline range.
#' - `"relaxed"`\cr
#' Ignores all signs, treating values as their numeric equivalents (e.g., `>0.5` is regarded `0.5`).
#' - `"inverse"`\cr
#' Opposite of `"standard"`; `<` always returns `"S"`, `>` always returns `"R"`, and `<=`/`>=` are treated as their numeric equivalents
#'
#' The default `"standard"` setting ensures cautious handling of uncertain values while preserving interpretability. This option can also be set with the package option [`AMR_capped_mic_handling`][AMR-options].
#' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a [logical] to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.3)`.
#' @param substitute_missing_r_breakpoint a [logical] to indicate that a missing clinical breakpoints for R (resistant) must be substituted with R - the default is `FALSE`. Some (especially CLSI) breakpoints only have a breakpoint for S, meaning the outcome can only be `"S"` or `NA`. Setting this to `TRUE` will convert the `NA`s to `"R"` only if the R breakpoint is missing. Can also be set with the package option [`AMR_substitute_missing_r_breakpoint`][AMR-options].
#' @param include_screening a [logical] to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`. Can also be set with the package option [`AMR_include_screening`][AMR-options].
@ -75,7 +85,7 @@
#' # for veterinary breakpoints, also set `host`:
#' your_data %>% mutate_if(is.mic, as.sir, host = "column_with_animal_species", guideline = "CLSI")
#' ```
#' * Operators like "<=" will be stripped before interpretation. When using `conserve_capped_values = TRUE`, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (`conserve_capped_values = FALSE`) considers ">2" to be lower than ">=4" and might in this case return "S" or "I".
#' * Operators like "<=" will be stripped before interpretation. When using `capped_mic_handling = "strict"`, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (`capped_mic_handling = "standard"`) considers ">2" to be lower than ">=4" and might in this case return "S" or "I".
#' 3. For **interpreting disk diffusion diameters** according to EUCAST or CLSI. You must clean your disk zones first using [as.disk()], that also gives your columns the new data class [`disk`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` argument.
#' * Using `dplyr`, SIR interpretation can be done very easily with either:
#' ```r
@ -561,7 +571,7 @@ as.sir.mic <- function(x,
ab = deparse(substitute(x)),
guideline = getOption("AMR_guideline", "EUCAST"),
uti = NULL,
conserve_capped_values = FALSE,
capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"),
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE),
@ -579,7 +589,7 @@ as.sir.mic <- function(x,
ab = ab,
guideline = guideline,
uti = uti,
conserve_capped_values = conserve_capped_values,
capped_mic_handling = capped_mic_handling,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
@ -616,7 +626,7 @@ as.sir.disk <- function(x,
ab = ab,
guideline = guideline,
uti = uti,
conserve_capped_values = FALSE,
capped_mic_handling = FALSE, # there are no MICs here
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
@ -636,7 +646,7 @@ as.sir.data.frame <- function(x,
col_mo = NULL,
guideline = getOption("AMR_guideline", "EUCAST"),
uti = NULL,
conserve_capped_values = FALSE,
capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"),
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE),
@ -645,11 +655,15 @@ as.sir.data.frame <- function(x,
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
host = NULL,
verbose = FALSE) {
if (isTRUE(list(...)$converse_capped_values)) {
deprecation_warning(old = "converse_capped_values", new = "capped_mic_handling", fn = "as.sir", is_argument = TRUE)
capped_mic_handling <- "strict"
}
meet_criteria(x, allow_class = "data.frame") # will also check for dimensions > 0
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(uti, allow_class = c("logical", "character"), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1)
meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "strict", "relaxed", "inverse"))
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
meet_criteria(reference_data, allow_class = "data.frame")
meet_criteria(substitute_missing_r_breakpoint, allow_class = "logical", has_length = 1)
@ -801,7 +815,7 @@ as.sir.data.frame <- function(x,
ab = ab_cols[i],
guideline = guideline,
uti = uti,
conserve_capped_values = conserve_capped_values,
capped_mic_handling = capped_mic_handling,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
@ -931,7 +945,7 @@ as_sir_method <- function(method_short,
ab,
guideline,
uti,
conserve_capped_values,
capped_mic_handling,
add_intrinsic_resistance,
reference_data,
substitute_missing_r_breakpoint,
@ -941,12 +955,16 @@ as_sir_method <- function(method_short,
host,
verbose,
...) {
if (isTRUE(list(...)$converse_capped_values)) {
deprecation_warning(old = "converse_capped_values", new = "capped_mic_handling", fn = "as.sir", is_argument = TRUE)
capped_mic_handling <- "strict"
}
meet_criteria(x, allow_NA = TRUE, .call_depth = -2)
meet_criteria(mo, allow_class = c("mo", "character"), has_length = c(1, length(x)), allow_NULL = TRUE, .call_depth = -2)
meet_criteria(ab, allow_class = c("ab", "character"), has_length = c(1, length(x)), .call_depth = -2)
meet_criteria(guideline, allow_class = "character", has_length = 1, .call_depth = -2)
meet_criteria(uti, allow_class = c("logical", "character"), has_length = c(1, length(x)), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = -2)
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1, .call_depth = -2)
meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "strict", "relaxed", "inverse"), .call_depth = -2)
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1, .call_depth = -2)
meet_criteria(reference_data, allow_class = "data.frame", .call_depth = -2)
meet_criteria(substitute_missing_r_breakpoint, allow_class = "logical", has_length = 1, .call_depth = -2)
@ -959,11 +977,13 @@ as_sir_method <- function(method_short,
# backward compatibilty
dots <- list(...)
dots <- dots[which(!names(dots) %in% c("warn", "mo.bak", "is_data.frame"))]
dots <- dots[which(!names(dots) %in% c("warn", "mo.bak", "is_data.frame", "conserve_capped_values"))]
if (length(dots) != 0) {
warning_("These arguments in `as.sir()` are no longer used: ", vector_and(names(dots), quotes = "`"), ".", call = FALSE)
}
current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history)
guideline_coerced <- get_guideline(guideline, reference_data)
if (message_not_thrown_before("as.sir", "sir_interpretation_history")) {
@ -1504,11 +1524,14 @@ as_sir_method <- function(method_short,
if (any(breakpoints_current$site %like% "screen", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "screen", na.rm = TRUE)) {
notes_current <- c(notes_current, "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this")
}
if (method == "mic" && conserve_capped_values == TRUE && any(as.character(values) %like% "^[<][0-9]")) {
notes_current <- c(notes_current, "MIC values 'lower than' are all considered 'S' since conserve_capped_values = TRUE")
if (capped_mic_handling %in% c("strict", "inverse") && any(as.character(values) %like% "^[<][0-9]")) {
notes_current <- c(notes_current, paste0("MIC values with the sign '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\""))
}
if (method == "mic" && conserve_capped_values == TRUE && any(as.character(values) %like% "^[>][0-9]")) {
notes_current <- c(notes_current, "MIC values 'greater than' are all considered 'R' since conserve_capped_values = TRUE")
if (capped_mic_handling %in% c("strict", "inverse") && any(as.character(values) %like% "^[>][0-9]")) {
notes_current <- c(notes_current, paste0("MIC values with the sign '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\""))
}
if (capped_mic_handling %in% c("strict", "standard") && any(as.character(values) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R, na.rm = TRUE)) {
notes_current <- c(notes_current, paste0("MIC values within the breakpoint guideline range with the sign '<=' or '>=' are considered 'NI' since capped_mic_handling = \"", capped_mic_handling, "\""))
}
if (isTRUE(substitute_missing_r_breakpoint) && !is.na(breakpoints_current$breakpoint_S) && is.na(breakpoints_current$breakpoint_R)) {
breakpoints_current$breakpoint_R <- breakpoints_current$breakpoint_S # breakpoints_current only has 1 row at this moment
@ -1518,8 +1541,9 @@ as_sir_method <- function(method_short,
if (method == "mic") {
new_sir <- case_when_AMR(
is.na(values) ~ NA_sir_,
conserve_capped_values == TRUE & as.character(values) %like% "^[<][0-9]" ~ as.sir("S"),
conserve_capped_values == TRUE & as.character(values) %like% "^[>][0-9]" ~ as.sir("R"),
capped_mic_handling %in% c("strict", "inverse") & as.character(values) %like% "^[<][0-9]" ~ as.sir("S"),
capped_mic_handling %in% c("strict", "inverse") & as.character(values) %like% "^[>][0-9]" ~ as.sir("R"),
capped_mic_handling %in% c("strict", "standard") & as.character(values) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R ~ as.sir("NI"),
values <= breakpoints_current$breakpoint_S ~ as.sir("S"),
guideline_coerced %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"),
guideline_coerced %like% "CLSI" & values >= breakpoints_current$breakpoint_R ~ as.sir("R"),
@ -1599,6 +1623,12 @@ as_sir_method <- function(method_short,
load_mo_uncertainties(metadata_mo)
# reorder AMR_env$sir_interpretation_history to get a clean ordering on index
old_part <- AMR_env$sir_interpretation_history[seq_len(current_sir_interpretation_history), , drop = FALSE]
new_part <- AMR_env$sir_interpretation_history[c((current_sir_interpretation_history + 1):NROW(AMR_env$sir_interpretation_history)), , drop = FALSE]
new_part <- new_part[order(new_part$index), , drop = FALSE]
AMR_env$sir_interpretation_history <- rbind_AMR(old_part, new_part)
df$result
}
@ -1607,18 +1637,11 @@ as_sir_method <- function(method_short,
#' @export
sir_interpretation_history <- function(clean = FALSE) {
meet_criteria(clean, allow_class = "logical", has_length = 1)
out <- AMR_env$sir_interpretation_history
out$outcome <- as.sir(out$outcome)
if (NROW(out) > 0) {
# sort descending on time
out <- out[order(format(out$datetime, "%Y%m%d%H%M"), out$index, decreasing = TRUE), , drop = FALSE]
}
if (isTRUE(clean)) {
AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
}
if (pkg_is_available("tibble")) {
out <- import_fn("as_tibble", "tibble")(out)
}

1
R/zz_deprecated.R
View File

@ -41,6 +41,7 @@ NULL
"antibiotics"
# REMEMBER to also remove the deprecated `antibiotics` argument in `antibiogram()`
# REMEMBER to also remove the deprecated `converse_capped_values` argument in `as.sir()`
#' @rdname AMR-deprecated
#' @export