diff --git a/DESCRIPTION b/DESCRIPTION index 534f0d5a1..5079746a0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9240 -Date: 2025-04-16 +Version: 2.1.1.9241 +Date: 2025-04-18 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NEWS.md b/NEWS.md index 2f2e9dba4..a44d0b2f5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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).)* @@ -46,17 +46,17 @@ This package now supports not only tools for AMR data analysis in clinical setti ## Changed * 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. * 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. * 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. - * Added argument `info` so silence all console messages + * Added argument `info` to silence all console messages * `antibiogram()` function * 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. - * 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 * 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. diff --git a/R/antibiogram.R b/R/antibiogram.R index 375c09753..556208306 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -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. #' @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: -#' - Any antimicrobial name or code that matches to a column name in `x` -#' - A column name in `x` that contains SIR values +#' @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 could match (see [guess_ab_col()]) to any column in `x` #' - Any [antimicrobial selector][antimicrobial_selectors], such as [aminoglycosides()] or [carbapenems()] #' - A combination of the above, using `c()`, e.g.: #' - `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(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) } meet_criteria(only_all_tested, allow_class = "logical", has_length = 1) diff --git a/R/plotting.R b/R/plotting.R index feca9b519..da39c0132 100755 --- a/R/plotting.R +++ b/R/plotting.R @@ -244,11 +244,13 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) { } scale$transform_df <- function(self, df) { if (!aest %in% colnames(df)) { - # support for geom_hline() and geom_vline() - if ("yintercept" %in% colnames(df)) { - aest_val <- "yintercept" - } else if ("xintercept" %in% colnames(df)) { - aest_val <- "xintercept" + # support for geom_hline(), geom_vline(), etc + other_x <- c("xintercept", "xmin", "xmax", "xend", "width") + other_y <- c("yintercept", "ymin", "ymax", "yend", "height") + if (any(other_y %in% colnames(df))) { + 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 { stop_("No support for plotting df with `scale_", aest, "_mic()` with columns ", vector_and(colnames(df), sort = FALSE)) } diff --git a/R/sir.R b/R/sir.R index 9751c4c46..aae9bc555 100755 --- a/R/sir.R +++ b/R/sir.R @@ -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 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 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: #' #' `"none"` @@ -189,7 +189,8 @@ #' bacteria = rep("Escherichia coli", 4), #' antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), #' 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{ @@ -208,7 +209,7 @@ #' mutate_if(is.mic, as.sir, #' mo = "bacteria", #' ab = "antibiotic", -#' guideline = "CLSI" +#' guideline = guideline #' ) #' df_long %>% #' mutate(across( @@ -675,7 +676,7 @@ as.sir.data.frame <- function(x, conserve_capped_values = NULL) { 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(guideline, allow_class = "character") 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(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)) { return(guideline) } - guideline_param <- toupper(guideline) - if (guideline_param %in% c("CLSI", "EUCAST")) { - guideline_param <- rev(sort(subset(reference_data, guideline %like% guideline_param)$guideline))[1L] - } - if (guideline_param %unlike% " ") { - # like 'EUCAST2020', should be 'EUCAST 2020' - guideline_param <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param, ignore.case = TRUE) - } + guideline_param <- trimws2(toupper(guideline)) + latest_clsi <- rev(sort(subset(reference_data, guideline %like% "CLSI")$guideline))[1L] + latest_eucast <- rev(sort(subset(reference_data, guideline %like% "EUCAST")$guideline))[1L] + guideline_param[guideline_param == "CLSI"] <- latest_clsi + guideline_param[guideline_param == "EUCAST"] <- latest_eucast + # like 'EUCAST2020', should be 'EUCAST 2020' + 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, "invalid guideline: '", guideline, @@ -988,7 +988,7 @@ as_sir_method <- function(method_short, 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(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(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) @@ -1011,8 +1011,6 @@ as_sir_method <- function(method_short, 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")) { 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) @@ -1020,6 +1018,12 @@ as_sir_method <- function(method_short, 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 if (breakpoint_type == "animal") { 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))), mo_var_found, 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)) { 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) { ab_coerced[ab_coerced == "AMX"] <- "AMP" 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 { breakpoints <- reference_data %pm>% @@ -1249,6 +1253,7 @@ as_sir_method <- function(method_short, df <- data.frame( values = x, values_bak = x, + guideline = guideline_coerced, mo = mo, ab = ab, result = NA_sir_, @@ -1257,12 +1262,12 @@ as_sir_method <- function(method_short, stringsAsFactors = FALSE ) 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 log2_levels <- 2^c(-9:12) - df$values <- vapply( + df$values[which(df$guideline %like% "CLSI")] <- vapply( FUN.VALUE = character(1), - df$values, + df$values[which(df$guideline %like% "CLSI")], function(mic_val) { if (is.na(mic_val)) { return(NA_character_) @@ -1282,13 +1287,12 @@ as_sir_method <- function(method_short, ) } df$values <- as.mic(df$values) - print(df) } else if (method == "disk") { # when as.sir.disk is called directly 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))) # get all breakpoints, use humans as backup for animals @@ -1312,7 +1316,7 @@ as_sir_method <- function(method_short, notes <- character(0) - if (guideline_coerced %like% "EUCAST") { + if (any(guideline_coerced %like% "EUCAST")) { any_is_intrinsic_resistant <- FALSE add_intrinsic_resistance_to_AMR_env() } @@ -1331,7 +1335,7 @@ as_sir_method <- function(method_short, message( paste0(font_rose_bg(" WARNING "), "\n"), 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))), " (", unique(ab_coerced), ")." ), 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) ---- for (i in seq_len(nrow(df_unique))) { p$tick() + guideline_current <- df_unique[i, "guideline", drop = TRUE] mo_current <- df_unique[i, "mo", drop = TRUE] mo_gram_current <- mo_grams[i] ab_current <- df_unique[i, "ab", drop = TRUE] host_current <- df_unique[i, "host", drop = TRUE] uti_current <- df_unique[i, "uti", drop = TRUE] notes_current <- character(0) - if (is.na(uti_current)) { - # no preference, so no filter on UTIs - rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current) - } else { - rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current & df$uti == uti_current) + rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current & df$guideline == guideline_current) + if (!is.na(uti_current)) { + # also filter on UTIs + rows <- rows[df$uti[rows] == uti_current] } + 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 next } values <- df[rows, "values", drop = TRUE] values_bak <- df[rows, "values_bak", drop = TRUE] + notes_current <- rep("", length(rows)) new_sir <- rep(NA_sir_, length(rows)) # 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 # TODO for VET09 do not filter out E. coli and such breakpoints_current <- breakpoints %pm>% - subset(ab == ab_current) %pm>% + subset(ab == ab_current & guideline == guideline_current) %pm>% subset(mo %in% c( mo_current, mo_current_genus, mo_current_family, mo_current_order, mo_current_class, @@ -1424,6 +1430,7 @@ as_sir_method <- function(method_short, mo_current_other )) + # 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") @@ -1515,8 +1522,8 @@ as_sir_method <- function(method_short, host = vectorise_log_entry(host_current, length(rows)), input = vectorise_log_entry(as.character(values), length(rows)), outcome = vectorise_log_entry(NA_sir_, length(rows)), - notes = vectorise_log_entry("NO BREAKPOINT AVAILABLE", length(rows)), - guideline = vectorise_log_entry(guideline_coerced, length(rows)), + notes = vectorise_log_entry("No breakpoint available", length(rows)), + guideline = vectorise_log_entry(guideline_current, length(rows)), ref_table = vectorise_log_entry(NA_character_, length(rows)), uti = vectorise_log_entry(uti_current, 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)) { # 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)) { # 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>% 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)) { # 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 - if (isTRUE(add_intrinsic_resistance) && guideline_coerced %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, "")) + if (isTRUE(add_intrinsic_resistance) && guideline_current %like% "EUCAST" && paste(mo_current, ab_current) %in% AMR_env$intrinsic_resistant) { 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) { # no rules available new_sir <- rep(NA_sir_, length(rows)) @@ -1578,24 +1597,43 @@ as_sir_method <- function(method_short, # then run the rules 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 <- c(notes_current, "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this") - } - 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" && 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 'S' since capped_mic_handling = \"", capped_mic_handling, "\"")) - } - 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, "\"")) - } - 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)) { - 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, "\"")) - } + notes_current <- paste0( + notes_current, "\n", + ifelse(breakpoints_current$mo == "UNKNOWN" | breakpoints_current$ref_tbl %like% "PK.*PD", + "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this", + "" + ), + "\n", + ifelse(breakpoints_current$site %like% "screen" | breakpoints_current$ref_tbl %like% "screen", + "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this", + "" + ), + "\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 '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)) { - 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") + # breakpoints_current only has 1 row at this moment + 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") { @@ -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", "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"), - guideline_coerced %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% "EUCAST" & 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 !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"), @@ -1617,8 +1655,8 @@ as_sir_method <- function(method_short, new_sir <- case_when_AMR( is.na(values) ~ NA_sir_, 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_coerced %like% "CLSI" & 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_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 !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"), @@ -1628,6 +1666,8 @@ as_sir_method <- function(method_short, } # 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, # 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)), input = vectorise_log_entry(as.character(values), 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)), - guideline = vectorise_log_entry(guideline_coerced, length(rows)), + notes = font_stripstyle(notes_current), # vectorise_log_entry(paste0(font_stripstyle(notes_current), collapse = "\n"), length(rows)), + guideline = vectorise_log_entry(guideline_current, 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)), 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: message_(intro_txt, appendLF = FALSE, as_note = FALSE) } + notes <- notes[!trimws2(notes) %in% c("", NA_character_)] if (length(notes) > 0) { if (isTRUE(rise_warning)) { message(font_rose_bg(" WARNING ")) diff --git a/data-raw/gpt_training_text_v2.1.1.9240.txt b/data-raw/gpt_training_text_v2.1.1.9241.txt similarity index 99% rename from data-raw/gpt_training_text_v2.1.1.9240.txt rename to data-raw/gpt_training_text_v2.1.1.9241.txt index e989cb58a..988349482 100644 --- a/data-raw/gpt_training_text_v2.1.1.9240.txt +++ b/data-raw/gpt_training_text_v2.1.1.9241.txt @@ -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. -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. ---------------------------------------------------------------------------------------------------- @@ -1723,10 +1723,9 @@ retrieve_wisca_parameters(wisca_model, ...) \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{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{ -\item Any antimicrobial name or code that matches to a column name in \code{x} -\item A column name in \code{x} that contains SIR values +\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 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.: \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{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}.} @@ -3646,7 +3645,8 @@ df_long <- data.frame( bacteria = rep("Escherichia coli", 4), antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), 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{ @@ -3665,7 +3665,7 @@ if (require("dplyr")) { mutate_if(is.mic, as.sir, mo = "bacteria", ab = "antibiotic", - guideline = "CLSI" + guideline = guideline ) df_long \%>\% mutate(across( diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index 21f8dfa6b..352d63aa9 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -46,10 +46,9 @@ retrieve_wisca_parameters(wisca_model, ...) \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{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{ -\item Any antimicrobial name or code that matches to a column name in \code{x} -\item A column name in \code{x} that contains SIR values +\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 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.: \itemize{ diff --git a/man/as.sir.Rd b/man/as.sir.Rd index 50e725a9d..5a47ad419 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -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{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}.} @@ -269,7 +269,8 @@ df_long <- data.frame( bacteria = rep("Escherichia coli", 4), antibiotic = c("amoxicillin", "cipro", "tobra", "genta"), 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{ @@ -288,7 +289,7 @@ if (require("dplyr")) { mutate_if(is.mic, as.sir, mo = "bacteria", ab = "antibiotic", - guideline = "CLSI" + guideline = guideline ) df_long \%>\% mutate(across( diff --git a/tests/testthat/test-sir.R b/tests/testthat/test-sir.R index 259abbc65..8a03101e6 100644 --- a/tests/testthat/test-sir.R +++ b/tests/testthat/test-sir.R @@ -126,6 +126,12 @@ test_that("test-sir.R", { # 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 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 -------------------------------------------------------------- + # 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) mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2