P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-05-01 19:03:50 +02:00
Code Releases Activity

(v2.1.1.9241) fix sir

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2025-04-18 13:25:59 +02:00
parent cf91e677c6
commit 579025f678
No known key found for this signature in database
9 changed files with 143 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 2.1.1.9240 Version: 2.1.1.9241
Date: 2025-04-16 Date: 2025-04-18
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

8
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 2.1.1.9240 # AMR 2.1.1.9241
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)* *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)*
@ -46,17 +46,17 @@ This package now supports not only tools for AMR data analysis in clinical setti
## Changed ## Changed
* SIR interpretation * SIR interpretation
* It is now possible to use column names for argument `ab`, `mo`, and `uti`: `as.sir(..., ab = "column1", mo = "column2", uti = "column3")`. This greatly improves the flexibility for users. * It is now possible to use column names for arguments `guideline`, `ab`, `mo`, and `uti`: `as.sir(..., ab = "column1", mo = "column2", uti = "column3")`. This greatly improves the flexibility for users.
* Users can now set their own criteria (using regular expressions) as to what should be considered S, I, R, SDD, and NI. * Users can now set their own criteria (using regular expressions) as to what should be considered S, I, R, SDD, and NI.
* To get quantitative values, `as.double()` on a `sir` object will return 1 for S, 2 for SDD/I, and 3 for R (NI will become `NA`). Other functions using `sir` classes (e.g., `summary()`) are updated to reflect the change to contain NI and SDD. * To get quantitative values, `as.double()` on a `sir` object will return 1 for S, 2 for SDD/I, and 3 for R (NI will become `NA`). Other functions using `sir` classes (e.g., `summary()`) are updated to reflect the change to contain NI and SDD.
* Following CLSI interpretation rules, values outside the log2-dilution range will be rounded upwards to the nearest log2-level before interpretation. Only if using a CLSI guideline. * Following CLSI interpretation rules, values outside the log2-dilution range will be rounded upwards to the nearest log2-level before interpretation. Only if using a CLSI guideline.
* Combined MIC values (e.g., from CLSI) are now supported * Combined MIC values (e.g., from CLSI) are now supported
* The argument `conserve_capped_values` in `as.sir()` has been replaced with `capped_mic_handling`, which allows greater flexibility in handling capped MIC values (`<`, `<=`, `>`, `>=`). The four available options (`"standard"`, `"strict"`, `"relaxed"`, `"inverse"`) provide full control over whether these values should be interpreted conservatively or ignored. Using `conserve_capped_values` is now deprecated and returns a warning. * The argument `conserve_capped_values` in `as.sir()` has been replaced with `capped_mic_handling`, which allows greater flexibility in handling capped MIC values (`<`, `<=`, `>`, `>=`). The four available options (`"standard"`, `"strict"`, `"relaxed"`, `"inverse"`) provide full control over whether these values should be interpreted conservatively or ignored. Using `conserve_capped_values` is now deprecated and returns a warning.
* Added argument `info` so silence all console messages * Added argument `info` to silence all console messages
* `antibiogram()` function * `antibiogram()` function
* Argument `antibiotics` has been renamed to `antimicrobials`. Using `antibiotics` will still work, but now returns a warning. * Argument `antibiotics` has been renamed to `antimicrobials`. Using `antibiotics` will still work, but now returns a warning.
* Added argument `formatting_type` to set any of the 22 options for the formatting of all 'cells'. This defaults to `18` for non-WISCA and `14` for WISCA, changing the output of antibiograms to cells with more info. * Added argument `formatting_type` to set any of the 22 options for the formatting of all 'cells'. This defaults to `18` for non-WISCA and `14` for WISCA, changing the output of antibiograms to cells with more info.
* For this reason, `add_total_n` is now `FALSE` at default since the denominators are added to the cells for non-WISCA. For WISCA, the denominator is not useful anyway. * For this reason, `add_total_n` is now deprecated and `FALSE` at default since the denominators are added to the cells dependent on the `formatting_type` setting
* The `ab_transform` argument now defaults to `"name"`, displaying antibiotic column names instead of codes * The `ab_transform` argument now defaults to `"name"`, displaying antibiotic column names instead of codes
* Antimicrobial selectors (previously: *antibiotic selectors*) * Antimicrobial selectors (previously: *antibiotic selectors*)
* 'Antibiotic selectors' are now called 'antimicrobial selectors' since their scope is broader than just antibiotics. All documentation have been updated, and `ab_class()` and `ab_selector()` have been replaced with `amr_class()` and `amr_selector()`. The old functions are now deprecated and will be removed in a future version. * 'Antibiotic selectors' are now called 'antimicrobial selectors' since their scope is broader than just antibiotics. All documentation have been updated, and `ab_class()` and `ab_selector()` have been replaced with `amr_class()` and `amr_selector()`. The old functions are now deprecated and will be removed in a future version.

7
R/antibiogram.R
View File

@ -34,9 +34,8 @@
#' #'
#' Adhering to previously described approaches (see *Source*) and especially the Bayesian WISCA model (Weighted-Incidence Syndromic Combination Antibiogram) by Bielicki *et al.*, these functions provide flexible output formats including plots and tables, ideal for integration with R Markdown and Quarto reports. #' Adhering to previously described approaches (see *Source*) and especially the Bayesian WISCA model (Weighted-Incidence Syndromic Combination Antibiogram) by Bielicki *et al.*, these functions provide flexible output formats including plots and tables, ideal for integration with R Markdown and Quarto reports.
#' @param x A [data.frame] containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see [as.sir()]). #' @param x A [data.frame] containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see [as.sir()]).
#' @param antimicrobials A vector specifying the antimicrobials to include in the antibiogram (see *Examples*). Will be evaluated using [guess_ab_col()]. This can be: #' @param antimicrobials A vector specifying the antimicrobials containing SIR values to include in the antibiogram (see *Examples*). Will be evaluated using [guess_ab_col()]. This can be:
#' - Any antimicrobial name or code that matches to a column name in `x` #' - Any antimicrobial name or code that could match (see [guess_ab_col()]) to any column in `x`
#' - A column name in `x` that contains SIR values
#' - Any [antimicrobial selector][antimicrobial_selectors], such as [aminoglycosides()] or [carbapenems()] #' - Any [antimicrobial selector][antimicrobial_selectors], such as [aminoglycosides()] or [carbapenems()]
#' - A combination of the above, using `c()`, e.g.: #' - A combination of the above, using `c()`, e.g.:
#' - `c(aminoglycosides(), "AMP", "AMC")` #' - `c(aminoglycosides(), "AMP", "AMC")`
@ -489,7 +488,7 @@ antibiogram.default <- function(x,
} }
meet_criteria(syndromic_group, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(syndromic_group, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(add_total_n, allow_class = "logical", has_length = 1) meet_criteria(add_total_n, allow_class = "logical", has_length = 1)
if (isTRUE(add_total_n) || !missing(add_total_n)) { if (isTRUE(add_total_n)) {
deprecation_warning("add_total_n", "formatting_type", fn = "antibiogram", is_argument = TRUE) deprecation_warning("add_total_n", "formatting_type", fn = "antibiogram", is_argument = TRUE)
} }
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1) meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)

12
R/plotting.R
View File

@ -244,11 +244,13 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
} }
scale$transform_df <- function(self, df) { scale$transform_df <- function(self, df) {
if (!aest %in% colnames(df)) { if (!aest %in% colnames(df)) {
# support for geom_hline() and geom_vline() # support for geom_hline(), geom_vline(), etc
if ("yintercept" %in% colnames(df)) { other_x <- c("xintercept", "xmin", "xmax", "xend", "width")
aest_val <- "yintercept" other_y <- c("yintercept", "ymin", "ymax", "yend", "height")
} else if ("xintercept" %in% colnames(df)) { if (any(other_y %in% colnames(df))) {
aest_val <- "xintercept" aest_val <- intersect(other_y, colnames(df))[1]
} else if (any(other_x %in% colnames(df))) {
aest_val <- intersect(other_x, colnames(df))[1]
} else { } else {
stop_("No support for plotting df with `scale_", aest, "_mic()` with columns ", vector_and(colnames(df), sort = FALSE)) stop_("No support for plotting df with `scale_", aest, "_mic()` with columns ", vector_and(colnames(df), sort = FALSE))
} }

163
R/sir.R
View File

@ -43,7 +43,7 @@
#' @param ab A vector (or column name) with [character]s that can be coerced to a valid antimicrobial drug code with [as.ab()]. #' @param ab A vector (or column name) with [character]s that can be coerced to a valid antimicrobial drug code with [as.ab()].
#' @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*. #' @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 #' @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 guideline A guideline name (or column name) to use for SIR interpretation. 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*. Using a column name for [as.sir()] allows for easy interpretation on historical data which needs to be interpreted according to e.g., various years.
#' @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: #' @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:
#' #'
#' `"none"` #' `"none"`
@ -189,7 +189,8 @@
#' bacteria = rep("Escherichia coli", 4), #' bacteria = rep("Escherichia coli", 4),
#' antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), #' antibiotic = c("amoxicillin", "cipro", "tobra", "genta"),
#' mics = as.mic(c(0.01, 1, 4, 8)), #' mics = as.mic(c(0.01, 1, 4, 8)),
#' disks = as.disk(c(6, 10, 14, 18)) #' disks = as.disk(c(6, 10, 14, 18)),
#' guideline = c("EUCAST 2021", "EUCAST 2022", "EUCAST 2023", "EUCAST 2024")
#' ) #' )
#' #'
#' \donttest{ #' \donttest{
@ -208,7 +209,7 @@
#' mutate_if(is.mic, as.sir, #' mutate_if(is.mic, as.sir,
#' mo = "bacteria", #' mo = "bacteria",
#' ab = "antibiotic", #' ab = "antibiotic",
#' guideline = "CLSI" #' guideline = guideline
#' ) #' )
#' df_long %>% #' df_long %>%
#' mutate(across( #' mutate(across(
@ -675,7 +676,7 @@ as.sir.data.frame <- function(x,
conserve_capped_values = NULL) { conserve_capped_values = NULL) {
meet_criteria(x, allow_class = "data.frame") # will also check for dimensions > 0 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(col_mo, allow_class = "character", is_in = colnames(x), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1) meet_criteria(guideline, allow_class = "character")
meet_criteria(uti, allow_class = c("logical", "character"), allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(uti, allow_class = c("logical", "character"), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "conservative", "none", "inverse")) meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "conservative", "none", "inverse"))
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1) meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1)
@ -908,14 +909,13 @@ get_guideline <- function(guideline, reference_data) {
if (!identical(reference_data, AMR::clinical_breakpoints)) { if (!identical(reference_data, AMR::clinical_breakpoints)) {
return(guideline) return(guideline)
} }
guideline_param <- toupper(guideline) guideline_param <- trimws2(toupper(guideline))
if (guideline_param %in% c("CLSI", "EUCAST")) { latest_clsi <- rev(sort(subset(reference_data, guideline %like% "CLSI")$guideline))[1L]
guideline_param <- rev(sort(subset(reference_data, guideline %like% guideline_param)$guideline))[1L] latest_eucast <- rev(sort(subset(reference_data, guideline %like% "EUCAST")$guideline))[1L]
} guideline_param[guideline_param == "CLSI"] <- latest_clsi
if (guideline_param %unlike% " ") { guideline_param[guideline_param == "EUCAST"] <- latest_eucast
# like 'EUCAST2020', should be 'EUCAST 2020' # like 'EUCAST2020', should be 'EUCAST 2020'
guideline_param <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param, ignore.case = TRUE) guideline_param[guideline_param %unlike% " "] <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param[guideline_param %unlike% " "], ignore.case = TRUE)
}
stop_ifnot(guideline_param %in% reference_data$guideline, stop_ifnot(guideline_param %in% reference_data$guideline,
"invalid guideline: '", guideline, "invalid guideline: '", guideline,
@ -988,7 +988,7 @@ as_sir_method <- function(method_short,
meet_criteria(x, allow_NA = TRUE, .call_depth = -2) 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(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(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(guideline, allow_class = "character", has_length = c(1, length(x)), .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(uti, allow_class = c("logical", "character"), has_length = c(1, length(x)), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = -2)
meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "conservative", "none", "inverse"), .call_depth = -2) meet_criteria(capped_mic_handling, allow_class = "character", has_length = 1, is_in = c("standard", "conservative", "none", "inverse"), .call_depth = -2)
meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1, .call_depth = -2) meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1, .call_depth = -2)
@ -1011,8 +1011,6 @@ as_sir_method <- function(method_short,
current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history) current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history)
guideline_coerced <- get_guideline(guideline, reference_data)
if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) { if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) {
message() message()
message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all the details of the breakpoint interpretations.\n\n", add_fn = font_green) message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all the details of the breakpoint interpretations.\n\n", add_fn = font_green)
@ -1020,6 +1018,12 @@ as_sir_method <- function(method_short,
current_df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL) current_df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL)
# get guideline
if (!is.null(current_df) && length(guideline) == 1 && guideline %in% colnames(current_df) && any(current_df[[guideline]] %like% "CLSI|EUCAST", na.rm = TRUE)) {
guideline <- current_df[[guideline]]
}
guideline_coerced <- get_guideline(guideline, reference_data)
# get host # get host
if (breakpoint_type == "animal") { if (breakpoint_type == "animal") {
if (is.null(host)) { if (is.null(host)) {
@ -1215,7 +1219,7 @@ as_sir_method <- function(method_short,
ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))), ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))),
mo_var_found, mo_var_found,
ifelse(identical(reference_data, AMR::clinical_breakpoints), ifelse(identical(reference_data, AMR::clinical_breakpoints),
paste0(", ", font_bold(guideline_coerced)), paste0(", ", vector_and(font_bold(guideline_coerced, collapse = NULL), quotes = FALSE)),
"" ""
), ),
"... " "... "
@ -1233,11 +1237,11 @@ as_sir_method <- function(method_short,
if (identical(reference_data, AMR::clinical_breakpoints)) { if (identical(reference_data, AMR::clinical_breakpoints)) {
breakpoints <- reference_data %pm>% breakpoints <- reference_data %pm>%
subset(guideline == guideline_coerced & method == method_coerced & ab %in% ab_coerced) subset(guideline %in% guideline_coerced & method == method_coerced & ab %in% ab_coerced)
if (any(ab_coerced == "AMX") && nrow(breakpoints[breakpoints$ab == "AMX", , drop = FALSE]) == 0) { if (any(ab_coerced == "AMX") && nrow(breakpoints[breakpoints$ab == "AMX", , drop = FALSE]) == 0) {
ab_coerced[ab_coerced == "AMX"] <- "AMP" ab_coerced[ab_coerced == "AMX"] <- "AMP"
breakpoints <- reference_data %pm>% breakpoints <- reference_data %pm>%
subset(guideline == guideline_coerced & method == method_coerced & ab %in% ab_coerced) subset(guideline %in% guideline_coerced & method == method_coerced & ab %in% ab_coerced)
} }
} else { } else {
breakpoints <- reference_data %pm>% breakpoints <- reference_data %pm>%
@ -1249,6 +1253,7 @@ as_sir_method <- function(method_short,
df <- data.frame( df <- data.frame(
values = x, values = x,
values_bak = x, values_bak = x,
guideline = guideline_coerced,
mo = mo, mo = mo,
ab = ab, ab = ab,
result = NA_sir_, result = NA_sir_,
@ -1257,12 +1262,12 @@ as_sir_method <- function(method_short,
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
if (method == "mic") { if (method == "mic") {
if (guideline %like% "CLSI") { if (any(guideline_coerced %like% "CLSI")) {
# CLSI says: if MIC is not a log2 value it must be rounded up to the nearest log2 value # CLSI says: if MIC is not a log2 value it must be rounded up to the nearest log2 value
log2_levels <- 2^c(-9:12) log2_levels <- 2^c(-9:12)
df$values <- vapply( df$values[which(df$guideline %like% "CLSI")] <- vapply(
FUN.VALUE = character(1), FUN.VALUE = character(1),
df$values, df$values[which(df$guideline %like% "CLSI")],
function(mic_val) { function(mic_val) {
if (is.na(mic_val)) { if (is.na(mic_val)) {
return(NA_character_) return(NA_character_)
@ -1282,13 +1287,12 @@ as_sir_method <- function(method_short,
) )
} }
df$values <- as.mic(df$values) df$values <- as.mic(df$values)
print(df)
} else if (method == "disk") { } else if (method == "disk") {
# when as.sir.disk is called directly # when as.sir.disk is called directly
df$values <- as.disk(df$values) df$values <- as.disk(df$values)
} }
df_unique <- unique(df[, c("mo", "ab", "uti", "host"), drop = FALSE]) df_unique <- unique(df[, c("guideline", "mo", "ab", "uti", "host"), drop = FALSE])
mo_grams <- suppressWarnings(suppressMessages(mo_gramstain(df_unique$mo, language = NULL, keep_synonyms = FALSE))) mo_grams <- suppressWarnings(suppressMessages(mo_gramstain(df_unique$mo, language = NULL, keep_synonyms = FALSE)))
# get all breakpoints, use humans as backup for animals # get all breakpoints, use humans as backup for animals
@ -1312,7 +1316,7 @@ as_sir_method <- function(method_short,
notes <- character(0) notes <- character(0)
if (guideline_coerced %like% "EUCAST") { if (any(guideline_coerced %like% "EUCAST")) {
any_is_intrinsic_resistant <- FALSE any_is_intrinsic_resistant <- FALSE
add_intrinsic_resistance_to_AMR_env() add_intrinsic_resistance_to_AMR_env()
} }
@ -1331,7 +1335,7 @@ as_sir_method <- function(method_short,
message( message(
paste0(font_rose_bg(" WARNING "), "\n"), paste0(font_rose_bg(" WARNING "), "\n"),
font_black(paste0( font_black(paste0(
" ", AMR_env$bullet_icon, " No ", guideline_coerced, " ", method_coerced, " breakpoints available for ", " ", AMR_env$bullet_icon, " No ", method_coerced, " breakpoints available for ",
suppressMessages(suppressWarnings(ab_name(unique(ab_coerced), language = NULL, tolower = TRUE))), suppressMessages(suppressWarnings(ab_name(unique(ab_coerced), language = NULL, tolower = TRUE))),
" (", unique(ab_coerced), ")." " (", unique(ab_coerced), ")."
), collapse = "\n") ), collapse = "\n")
@ -1353,24 +1357,26 @@ as_sir_method <- function(method_short,
# run the rules (df_unique is a row combination per mo/ab/uti/host) ---- # run the rules (df_unique is a row combination per mo/ab/uti/host) ----
for (i in seq_len(nrow(df_unique))) { for (i in seq_len(nrow(df_unique))) {
p$tick() p$tick()
guideline_current <- df_unique[i, "guideline", drop = TRUE]
mo_current <- df_unique[i, "mo", drop = TRUE] mo_current <- df_unique[i, "mo", drop = TRUE]
mo_gram_current <- mo_grams[i] mo_gram_current <- mo_grams[i]
ab_current <- df_unique[i, "ab", drop = TRUE] ab_current <- df_unique[i, "ab", drop = TRUE]
host_current <- df_unique[i, "host", drop = TRUE] host_current <- df_unique[i, "host", drop = TRUE]
uti_current <- df_unique[i, "uti", drop = TRUE] uti_current <- df_unique[i, "uti", drop = TRUE]
notes_current <- character(0) notes_current <- character(0)
if (is.na(uti_current)) { rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current & df$guideline == guideline_current)
# no preference, so no filter on UTIs if (!is.na(uti_current)) {
rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current) # also filter on UTIs
} else { rows <- rows[df$uti[rows] == uti_current]
rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current & df$uti == uti_current)
} }
if (length(rows) == 0) { if (length(rows) == 0) {
# this can happen if a host is unavailable, just continue with the next one, since a note about hosts having NA are already given at this point # this can happen if a host is unavailable, just continue with the next one, since a note about hosts having NA are already given at this point
next next
} }
values <- df[rows, "values", drop = TRUE] values <- df[rows, "values", drop = TRUE]
values_bak <- df[rows, "values_bak", drop = TRUE] values_bak <- df[rows, "values_bak", drop = TRUE]
notes_current <- rep("", length(rows))
new_sir <- rep(NA_sir_, length(rows)) new_sir <- rep(NA_sir_, length(rows))
# find different mo properties, as fast as possible # find different mo properties, as fast as possible
@ -1415,7 +1421,7 @@ as_sir_method <- function(method_short,
# gather all available breakpoints for current MO # gather all available breakpoints for current MO
# TODO for VET09 do not filter out E. coli and such # TODO for VET09 do not filter out E. coli and such
breakpoints_current <- breakpoints %pm>% breakpoints_current <- breakpoints %pm>%
subset(ab == ab_current) %pm>% subset(ab == ab_current & guideline == guideline_current) %pm>%
subset(mo %in% c( subset(mo %in% c(
mo_current, mo_current_genus, mo_current_family, mo_current, mo_current_genus, mo_current_family,
mo_current_order, mo_current_class, mo_current_order, mo_current_class,
@ -1424,6 +1430,7 @@ as_sir_method <- function(method_short,
mo_current_other mo_current_other
)) ))
# TODO are operators considered?? # TODO are operators considered??
# 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") # 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")
@ -1515,8 +1522,8 @@ as_sir_method <- function(method_short,
host = vectorise_log_entry(host_current, length(rows)), host = vectorise_log_entry(host_current, length(rows)),
input = vectorise_log_entry(as.character(values), length(rows)), input = vectorise_log_entry(as.character(values), length(rows)),
outcome = vectorise_log_entry(NA_sir_, length(rows)), outcome = vectorise_log_entry(NA_sir_, length(rows)),
notes = vectorise_log_entry("NO BREAKPOINT AVAILABLE", length(rows)), notes = vectorise_log_entry("No breakpoint available", length(rows)),
guideline = vectorise_log_entry(guideline_coerced, length(rows)), guideline = vectorise_log_entry(guideline_current, length(rows)),
ref_table = vectorise_log_entry(NA_character_, length(rows)), ref_table = vectorise_log_entry(NA_character_, length(rows)),
uti = vectorise_log_entry(uti_current, length(rows)), uti = vectorise_log_entry(uti_current, length(rows)),
breakpoint_S_R = vectorise_log_entry(NA_character_, length(rows)), breakpoint_S_R = vectorise_log_entry(NA_character_, length(rows)),
@ -1556,21 +1563,33 @@ as_sir_method <- function(method_short,
} }
if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && is.na(uti_current) && message_not_thrown_before("as.sir", "uti", ab_current)) { if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && is.na(uti_current) && message_not_thrown_before("as.sir", "uti", ab_current)) {
# only UTI breakpoints available # only UTI breakpoints available
notes_current <- c(notes_current, paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI); assuming `uti = TRUE`.")) notes_current <- paste0(
notes_current, "\n",
paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI); assuming `uti = TRUE`.")
)
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti_current)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_current, ab_current)) { } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti_current)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_current, ab_current)) {
# both UTI and Non-UTI breakpoints available # both UTI and Non-UTI breakpoints available
notes_current <- c(notes_current, 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`."))
breakpoints_current <- breakpoints_current %pm>% breakpoints_current <- breakpoints_current %pm>%
pm_filter(uti == FALSE) 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 `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)) { } 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 # breakpoints for multiple body sites available
notes_current <- c(notes_current, paste0("Multiple breakpoints available for ", font_bold(ab_formatted), " in ", mo_formatted, " - assuming ", site, ".")) notes_current <- paste0(
notes_current, "\n",
paste0("Multiple breakpoints available for ", font_bold(ab_formatted), " in ", mo_formatted, " - assuming ", site, ".")
)
} }
# first check if mo is intrinsic resistant # first check if mo is intrinsic resistant
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %like% "EUCAST" && paste(mo_current, ab_current) %in% AMR_env$intrinsic_resistant) { if (isTRUE(add_intrinsic_resistance) && guideline_current %like% "EUCAST" && paste(mo_current, ab_current) %in% AMR_env$intrinsic_resistant) {
notes_current <- c(notes_current, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ""))
new_sir <- rep(as.sir("R"), length(rows)) new_sir <- rep(as.sir("R"), length(rows))
notes_current <- paste0(
notes_current, "\n",
paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, "")
)
} else if (nrow(breakpoints_current) == 0) { } else if (nrow(breakpoints_current) == 0) {
# no rules available # no rules available
new_sir <- rep(NA_sir_, length(rows)) new_sir <- rep(NA_sir_, length(rows))
@ -1578,24 +1597,43 @@ as_sir_method <- function(method_short,
# then run the rules # then run the rules
breakpoints_current <- breakpoints_current[1L, , drop = FALSE] breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
if (any(breakpoints_current$mo == "UNKNOWN", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "PK.*PD", na.rm = TRUE)) { notes_current <- paste0(
notes_current <- c(notes_current, "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this") notes_current, "\n",
} ifelse(breakpoints_current$mo == "UNKNOWN" | breakpoints_current$ref_tbl %like% "PK.*PD",
if (any(breakpoints_current$site %like% "screen", na.rm = TRUE) | any(breakpoints_current$ref_tbl %like% "screen", na.rm = TRUE)) { "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this",
notes_current <- c(notes_current, "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this") ""
} ),
if (method == "mic" && capped_mic_handling %in% c("conservative", "inverse") && any(as.character(values_bak) %like% "^[<][0-9]")) { "\n",
notes_current <- c(notes_current, paste0("MIC values with the sign '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\"")) ifelse(breakpoints_current$site %like% "screen" | breakpoints_current$ref_tbl %like% "screen",
} "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this",
if (method == "mic" && capped_mic_handling %in% c("conservative", "inverse") && any(as.character(values_bak) %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, "\"")) ),
} "\n",
if (method == "mic" && capped_mic_handling %in% c("conservative", "standard") && any(as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R, na.rm = TRUE)) { ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[<][0-9]",
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, "\"")) paste0("MIC values with the sign '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\""),
} ""
),
"\n",
ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]",
paste0("MIC values with the sign '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\""),
""
),
"\n",
ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R,
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)) { 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 # 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") breakpoints_current$breakpoint_R <- breakpoints_current$breakpoint_S
notes_current <- paste0(
notes_current, "\n",
ifelse(!is.na(breakpoints_current$breakpoint_S) & is.na(breakpoints_current$breakpoint_R),
"NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE",
""
)
)
} }
if (method == "mic") { if (method == "mic") {
@ -1605,8 +1643,8 @@ as_sir_method <- function(method_short,
capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]" ~ as.sir("R"), capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]" ~ as.sir("R"),
capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R ~ as.sir("NI"), capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %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"), values <= breakpoints_current$breakpoint_S ~ as.sir("S"),
guideline_coerced %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"), guideline_current %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"),
guideline_coerced %like% "CLSI" & values >= breakpoints_current$breakpoint_R ~ as.sir("R"), guideline_current %like% "CLSI" & values >= breakpoints_current$breakpoint_R ~ as.sir("R"),
# return "I" or "SDD" when breakpoints are in the middle # return "I" or "SDD" when breakpoints are in the middle
!is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == TRUE ~ as.sir("SDD"), !is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == TRUE ~ as.sir("SDD"),
!is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == FALSE ~ as.sir("I"), !is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == FALSE ~ as.sir("I"),
@ -1617,8 +1655,8 @@ as_sir_method <- function(method_short,
new_sir <- case_when_AMR( new_sir <- case_when_AMR(
is.na(values) ~ NA_sir_, is.na(values) ~ NA_sir_,
as.double(values) >= as.double(breakpoints_current$breakpoint_S) ~ as.sir("S"), as.double(values) >= as.double(breakpoints_current$breakpoint_S) ~ as.sir("S"),
guideline_coerced %like% "EUCAST" & as.double(values) < as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"), guideline_current %like% "EUCAST" & as.double(values) < as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"),
guideline_coerced %like% "CLSI" & as.double(values) <= as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"), guideline_current %like% "CLSI" & as.double(values) <= as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"),
# return "I" or "SDD" when breakpoints are in the middle # return "I" or "SDD" when breakpoints are in the middle
!is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == TRUE ~ as.sir("SDD"), !is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == TRUE ~ as.sir("SDD"),
!is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == FALSE ~ as.sir("I"), !is.na(breakpoints_current$breakpoint_S) & !is.na(breakpoints_current$breakpoint_R) & breakpoints_current$is_SDD == FALSE ~ as.sir("I"),
@ -1628,6 +1666,8 @@ as_sir_method <- function(method_short,
} }
# write to verbose output # write to verbose output
notes_current <- trimws2(notes_current)
notes_current[notes_current == ""] <- NA_character_
AMR_env$sir_interpretation_history <- rbind_AMR( AMR_env$sir_interpretation_history <- rbind_AMR(
AMR_env$sir_interpretation_history, AMR_env$sir_interpretation_history,
# recycling 1 to 2 rows does not always seem to work, which is why vectorise_log_entry() was added # recycling 1 to 2 rows does not always seem to work, which is why vectorise_log_entry() was added
@ -1644,8 +1684,8 @@ as_sir_method <- function(method_short,
host = vectorise_log_entry(breakpoints_current[, "host", drop = TRUE], length(rows)), host = vectorise_log_entry(breakpoints_current[, "host", drop = TRUE], length(rows)),
input = vectorise_log_entry(as.character(values), length(rows)), input = vectorise_log_entry(as.character(values), length(rows)),
outcome = vectorise_log_entry(as.sir(new_sir), length(rows)), outcome = vectorise_log_entry(as.sir(new_sir), length(rows)),
notes = vectorise_log_entry(paste0(font_stripstyle(notes_current), collapse = "\n"), length(rows)), notes = font_stripstyle(notes_current), # vectorise_log_entry(paste0(font_stripstyle(notes_current), collapse = "\n"), length(rows)),
guideline = vectorise_log_entry(guideline_coerced, length(rows)), guideline = vectorise_log_entry(guideline_current, length(rows)),
ref_table = vectorise_log_entry(breakpoints_current[, "ref_tbl", drop = TRUE], 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)), uti = vectorise_log_entry(breakpoints_current[, "uti", drop = TRUE], length(rows)),
breakpoint_S_R = vectorise_log_entry(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)), breakpoint_S_R = vectorise_log_entry(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
@ -1665,6 +1705,7 @@ as_sir_method <- function(method_short,
# the progress bar has overwritten the intro text, so: # the progress bar has overwritten the intro text, so:
message_(intro_txt, appendLF = FALSE, as_note = FALSE) message_(intro_txt, appendLF = FALSE, as_note = FALSE)
} }
notes <- notes[!trimws2(notes) %in% c("", NA_character_)]
if (length(notes) > 0) { if (length(notes) > 0) {
if (isTRUE(rise_warning)) { if (isTRUE(rise_warning)) {
message(font_rose_bg(" WARNING ")) message(font_rose_bg(" WARNING "))

14
data-raw/gpt_training_text_v2.1.1.9240.txt → data-raw/gpt_training_text_v2.1.1.9241.txt
View File

@ -1,6 +1,6 @@
This knowledge base contains all context you must know about the AMR package for R. You are a GPT trained to be an assistant for the AMR package in R. You are an incredible R specialist, especially trained in this package and in the tidyverse. This knowledge base contains all context you must know about the AMR package for R. You are a GPT trained to be an assistant for the AMR package in R. You are an incredible R specialist, especially trained in this package and in the tidyverse.
First and foremost, you are trained on version 2.1.1.9240. Remember this whenever someone asks which AMR package version you’re at. First and foremost, you are trained on version 2.1.1.9241. Remember this whenever someone asks which AMR package version you’re at.
Below are the contents of the NAMESPACE file, the index.md file, and all the man/*.Rd files (documentation) in the package. Every file content is split using 100 hypens. Below are the contents of the NAMESPACE file, the index.md file, and all the man/*.Rd files (documentation) in the package. Every file content is split using 100 hypens.
---------------------------------------------------------------------------------------------------- ----------------------------------------------------------------------------------------------------
@ -1723,10 +1723,9 @@ retrieve_wisca_parameters(wisca_model, ...)
\arguments{ \arguments{
\item{x}{A \link{data.frame} containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see \code{\link[=as.sir]{as.sir()}}).} \item{x}{A \link{data.frame} containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see \code{\link[=as.sir]{as.sir()}}).}
\item{antimicrobials}{A vector specifying the antimicrobials to include in the antibiogram (see \emph{Examples}). Will be evaluated using \code{\link[=guess_ab_col]{guess_ab_col()}}. This can be: \item{antimicrobials}{A vector specifying the antimicrobials containing SIR values to include in the antibiogram (see \emph{Examples}). Will be evaluated using \code{\link[=guess_ab_col]{guess_ab_col()}}. This can be:
\itemize{ \itemize{
\item Any antimicrobial name or code that matches to a column name in \code{x} \item Any antimicrobial name or code that could match (see \code{\link[=guess_ab_col]{guess_ab_col()}}) to any column in \code{x}
\item A column name in \code{x} that contains SIR values
\item Any \link[=antimicrobial_selectors]{antimicrobial selector}, such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}} \item Any \link[=antimicrobial_selectors]{antimicrobial selector}, such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}}
\item A combination of the above, using \code{c()}, e.g.: \item A combination of the above, using \code{c()}, e.g.:
\itemize{ \itemize{
@ -3461,7 +3460,7 @@ sir_interpretation_history(clean = FALSE)
\item{ab}{A vector (or column name) with \link{character}s that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.} \item{ab}{A vector (or column name) with \link{character}s that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.}
\item{guideline}{Defaults to EUCAST 2024 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2024) and CLSI (2011-2024), see \emph{Details}.} \item{guideline}{A guideline name (or column name) to use for SIR interpretation. Defaults to EUCAST 2024 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2024) and CLSI (2011-2024), see \emph{Details}. Using a column name for \code{\link[=as.sir]{as.sir()}} allows for easy interpretation on historical data which needs to be interpreted according to e.g., various years.}
\item{uti}{(Urinary Tract Infection) a vector (or column name) with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.sir]{as.sir()}} on a \link{data.frame}, this can also be a column containing \link{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 \emph{Examples}.} \item{uti}{(Urinary Tract Infection) a vector (or column name) with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.sir]{as.sir()}} on a \link{data.frame}, this can also be a column containing \link{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 \emph{Examples}.}
@ -3646,7 +3645,8 @@ df_long <- data.frame(
bacteria = rep("Escherichia coli", 4), bacteria = rep("Escherichia coli", 4),
antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), antibiotic = c("amoxicillin", "cipro", "tobra", "genta"),
mics = as.mic(c(0.01, 1, 4, 8)), mics = as.mic(c(0.01, 1, 4, 8)),
disks = as.disk(c(6, 10, 14, 18)) disks = as.disk(c(6, 10, 14, 18)),
guideline = c("EUCAST 2021", "EUCAST 2022", "EUCAST 2023", "EUCAST 2024")
) )
\donttest{ \donttest{
@ -3665,7 +3665,7 @@ if (require("dplyr")) {
mutate_if(is.mic, as.sir, mutate_if(is.mic, as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI" guideline = guideline
) )
df_long \%>\% df_long \%>\%
mutate(across( mutate(across(

5
man/antibiogram.Rd
View File

@ -46,10 +46,9 @@ retrieve_wisca_parameters(wisca_model, ...)
\arguments{ \arguments{
\item{x}{A \link{data.frame} containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see \code{\link[=as.sir]{as.sir()}}).} \item{x}{A \link{data.frame} containing at least a column with microorganisms and columns with antimicrobial results (class 'sir', see \code{\link[=as.sir]{as.sir()}}).}
\item{antimicrobials}{A vector specifying the antimicrobials to include in the antibiogram (see \emph{Examples}). Will be evaluated using \code{\link[=guess_ab_col]{guess_ab_col()}}. This can be: \item{antimicrobials}{A vector specifying the antimicrobials containing SIR values to include in the antibiogram (see \emph{Examples}). Will be evaluated using \code{\link[=guess_ab_col]{guess_ab_col()}}. This can be:
\itemize{ \itemize{
\item Any antimicrobial name or code that matches to a column name in \code{x} \item Any antimicrobial name or code that could match (see \code{\link[=guess_ab_col]{guess_ab_col()}}) to any column in \code{x}
\item A column name in \code{x} that contains SIR values
\item Any \link[=antimicrobial_selectors]{antimicrobial selector}, such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}} \item Any \link[=antimicrobial_selectors]{antimicrobial selector}, such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}}
\item A combination of the above, using \code{c()}, e.g.: \item A combination of the above, using \code{c()}, e.g.:
\itemize{ \itemize{

7
man/as.sir.Rd
View File

@ -84,7 +84,7 @@ sir_interpretation_history(clean = FALSE)
\item{ab}{A vector (or column name) with \link{character}s that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.} \item{ab}{A vector (or column name) with \link{character}s that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.}
\item{guideline}{Defaults to EUCAST 2024 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2024) and CLSI (2011-2024), see \emph{Details}.} \item{guideline}{A guideline name (or column name) to use for SIR interpretation. Defaults to EUCAST 2024 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2024) and CLSI (2011-2024), see \emph{Details}. Using a column name for \code{\link[=as.sir]{as.sir()}} allows for easy interpretation on historical data which needs to be interpreted according to e.g., various years.}
\item{uti}{(Urinary Tract Infection) a vector (or column name) with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.sir]{as.sir()}} on a \link{data.frame}, this can also be a column containing \link{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 \emph{Examples}.} \item{uti}{(Urinary Tract Infection) a vector (or column name) with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.sir]{as.sir()}} on a \link{data.frame}, this can also be a column containing \link{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 \emph{Examples}.}
@ -269,7 +269,8 @@ df_long <- data.frame(
bacteria = rep("Escherichia coli", 4), bacteria = rep("Escherichia coli", 4),
antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), antibiotic = c("amoxicillin", "cipro", "tobra", "genta"),
mics = as.mic(c(0.01, 1, 4, 8)), mics = as.mic(c(0.01, 1, 4, 8)),
disks = as.disk(c(6, 10, 14, 18)) disks = as.disk(c(6, 10, 14, 18)),
guideline = c("EUCAST 2021", "EUCAST 2022", "EUCAST 2023", "EUCAST 2024")
) )
\donttest{ \donttest{
@ -288,7 +289,7 @@ if (require("dplyr")) {
mutate_if(is.mic, as.sir, mutate_if(is.mic, as.sir,
mo = "bacteria", mo = "bacteria",
ab = "antibiotic", ab = "antibiotic",
guideline = "CLSI" guideline = guideline
) )
df_long \%>\% df_long \%>\%
mutate(across( mutate(across(

12
tests/testthat/test-sir.R
View File

@ -126,6 +126,12 @@ test_that("test-sir.R", {
# Human ------------------------------------------------------------------- # Human -------------------------------------------------------------------
# allow for guideline length > 1
expect_equal(
get_guideline(c("CLSI", "CLSI", "CLSI2023", "EUCAST", "EUCAST2020"), AMR::clinical_breakpoints),
c("CLSI 2024", "CLSI 2024", "CLSI 2023", "EUCAST 2024", "EUCAST 2020")
)
# these are used in the script # these are used in the script
expect_true(all(c("B_GRAMN", "B_GRAMP", "B_ANAER-NEG", "B_ANAER-POS", "B_ANAER") %in% AMR::microorganisms$mo)) expect_true(all(c("B_GRAMN", "B_GRAMP", "B_ANAER-NEG", "B_ANAER-POS", "B_ANAER") %in% AMR::microorganisms$mo))
@ -341,6 +347,12 @@ test_that("test-sir.R", {
# Veterinary -------------------------------------------------------------- # Veterinary --------------------------------------------------------------
# multiple guidelines
sir_history <- sir_interpretation_history(clean = TRUE)
x <- as.sir(as.mic(c(16, 16)), mo = "B_STRPT_CANS", ab = "AMK", host = "dog", guideline = c("CLSI 2024", "CLSI 2014"))
expect_equal(x, as.sir(c("R", NA)))
sir_history <- sir_interpretation_history(clean = TRUE)
expect_equal(sir_history$guideline, c("CLSI 2024", "CLSI 2014"))
sir_history <- sir_interpretation_history(clean = TRUE) sir_history <- sir_interpretation_history(clean = TRUE)
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2 mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2