1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 09:01:52 +02:00

(v2.1.1.9194) new argument for missing R breakpoints - updated from WHONET

This commit is contained in:
2025-03-12 16:24:38 +01:00
parent e1b7252ff6
commit a7ef22a21e
27 changed files with 15755 additions and 15399 deletions

View File

@ -40,6 +40,7 @@
#' * `AMR_guideline` \cr A [character] to set the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
#' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to ignore (i.e., make `NA`) any match given in [as.mo()] and all [`mo_*`][mo_property()] functions.
#' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`.
#' * `AMR_substitute_missing_r_breakpoint` \cr A [logical] to use in [as.sir()], to indicate that missing R breakpoints must be substituted with `"R"` - the default is `FALSE`.
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
#' * `AMR_locale` \cr A [character] to set the language for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported, English otherwise).

View File

@ -294,7 +294,7 @@
#' - `ref_tbl`\cr Info about where the guideline rule can be found
#' - `disk_dose`\cr Dose of the used disk diffusion method
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R", can be `NA`
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' - `is_SDD`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the intermediate range between "S" and "R" should be interpreted as "SDD", instead of "I". This currently applies to `r sum(clinical_breakpoints$is_SDD)` breakpoints.
#' @details

View File

@ -191,6 +191,10 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
if (is.null(x.bak)) {
x.bak <- x
}
# remove NAs on beforehand to not count them
x.bak <- gsub("(NA)+", "", x.bak)
# and trim
x.bak <- trimws2(x.bak)
# comma to period
x <- gsub(",", ".", x, fixed = TRUE)

View File

@ -133,7 +133,7 @@ random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
# get highest/lowest +/- random 1 to 3 higher factors of two
max_range <- mic_range[min(
length(mic_range),
which(mic_range == max(df$breakpoint_R, na.rm = TRUE)) + sample(c(1:3), 1)
which(mic_range == max(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE)) + sample(c(1:3), 1)
)]
min_range <- mic_range[max(
1,
@ -155,7 +155,7 @@ random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
return(out)
} else if (method_type == "DISK") {
set_range <- seq(
from = as.integer(min(df$breakpoint_R, na.rm = TRUE) / 1.25),
from = as.integer(min(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE) / 1.25),
to = as.integer(max(df$breakpoint_S, na.rm = TRUE) * 1.25),
by = 1
)

21
R/sir.R
View File

@ -46,6 +46,7 @@
#' @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 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].
#' @param include_PKPD a [logical] to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`. Can also be set with the package option [`AMR_include_PKPD`][AMR-options].
#' @param breakpoint_type the type of breakpoints to use, either `r vector_or(clinical_breakpoints$type)`. ECOFF stands for Epidemiological Cut-Off values. The default is `"human"`, which can also be set with the package option [`AMR_breakpoint_type`][AMR-options]. If `host` is set to values of veterinary species, this will automatically be set to `"animal"`.
@ -563,6 +564,7 @@ as.sir.mic <- function(x,
conserve_capped_values = FALSE,
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE),
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
@ -580,6 +582,7 @@ as.sir.mic <- function(x,
conserve_capped_values = conserve_capped_values,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
include_screening = include_screening,
include_PKPD = include_PKPD,
breakpoint_type = breakpoint_type,
@ -598,6 +601,7 @@ as.sir.disk <- function(x,
uti = NULL,
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE),
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
@ -615,10 +619,11 @@ as.sir.disk <- function(x,
conserve_capped_values = FALSE,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
include_screening = include_screening,
include_PKPD = include_PKPD,
breakpoint_type = breakpoint_type,
host = NULL,
host = host,
verbose = verbose,
...
)
@ -634,6 +639,7 @@ as.sir.data.frame <- function(x,
conserve_capped_values = FALSE,
add_intrinsic_resistance = FALSE,
reference_data = AMR::clinical_breakpoints,
substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE),
include_screening = getOption("AMR_include_screening", FALSE),
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
@ -646,6 +652,7 @@ as.sir.data.frame <- function(x,
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1)
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)
meet_criteria(include_screening, allow_class = "logical", has_length = 1)
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1)
meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1)
@ -797,6 +804,7 @@ as.sir.data.frame <- function(x,
conserve_capped_values = conserve_capped_values,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
include_screening = include_screening,
include_PKPD = include_PKPD,
breakpoint_type = breakpoint_type,
@ -817,6 +825,7 @@ as.sir.data.frame <- function(x,
uti = uti,
add_intrinsic_resistance = add_intrinsic_resistance,
reference_data = reference_data,
substitute_missing_r_breakpoint = substitute_missing_r_breakpoint,
include_screening = include_screening,
include_PKPD = include_PKPD,
breakpoint_type = breakpoint_type,
@ -925,6 +934,7 @@ as_sir_method <- function(method_short,
conserve_capped_values,
add_intrinsic_resistance,
reference_data,
substitute_missing_r_breakpoint,
include_screening,
include_PKPD,
breakpoint_type,
@ -939,6 +949,7 @@ as_sir_method <- function(method_short,
meet_criteria(conserve_capped_values, allow_class = "logical", has_length = 1, .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)
meet_criteria(include_screening, allow_class = "logical", has_length = 1, .call_depth = -2)
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1, .call_depth = -2)
check_reference_data(reference_data, .call_depth = -2)
@ -1321,7 +1332,9 @@ as_sir_method <- function(method_short,
# This seems to not work well: as.sir(as.mic(c(4, ">4", ">=4", 8, ">8", ">=8")), ab = "AMC", mo = "E. coli", breakpoint_type = "animal", host = "dogs", guideline = "CLSI 2024")
## fall-back methods for veterinary guidelines ----
if (breakpoint_type == "animal" && !host_current %in% breakpoints_current$host) {
## TODO actually implement this well
if (FALSE) {
# if (breakpoint_type == "animal" && !host_current %in% breakpoints_current$host) {
if (guideline_coerced %like% "CLSI") {
# VET09 says that staph/strep/enterococcus BP can be extrapolated to all Gr+ cocci except for intrinsic resistance, so take all Gr+ cocci:
gram_plus_cocci_vet09 <- microorganisms$mo[microorganisms$genus %in% c("Staphylococcus", "Streptococcus", "Peptostreptococcus", "Aerococcus", "Micrococcus") & microorganisms$rank == "genus"] # TODO should probably include genera that were either of these before
@ -1475,6 +1488,10 @@ as_sir_method <- function(method_short,
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 (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
notes_current <- c(notes_current, "NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE")
}
if (method == "mic") {
new_sir <- case_when_AMR(