diff --git a/DESCRIPTION b/DESCRIPTION index 2660a304b..beb4e53fa 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9233 -Date: 2025-03-31 +Version: 2.1.1.9234 +Date: 2025-04-07 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 7833285b3..ff3903579 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 2.1.1.9233 +# AMR 2.1.1.9234 *(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://msberends.github.io/AMR/#latest-development-version).)* diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 82da5788a..f340fc0d6 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -1191,12 +1191,16 @@ message_not_thrown_before <- function(fn, ..., entire_session = FALSE) { } has_colour <- function() { - if (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") { - # disable on emacs, which only supports 8 colours - return(FALSE) + if (is.null(AMR_env$supports_colour)) { + if (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") { + # disable on emacs, which only supports 8 colours + AMR_env$supports_colour <- FALSE + } else { + has_color <- import_fn("has_color", "crayon", error_on_fail = FALSE) + AMR_env$supports_colour <- !is.null(has_color) && isTRUE(has_color()) + } } - has_color <- import_fn("has_color", "crayon", error_on_fail = FALSE) - !is.null(has_color) && isTRUE(has_color()) + isTRUE(AMR_env$supports_colour) } # set colours if console has_colour() @@ -1216,13 +1220,7 @@ try_colour <- function(..., before, after, collapse = " ") { } } is_dark <- function() { - if (is.null(AMR_env$is_dark_theme) || - is.null(AMR_env$current_theme) || - ( - !is.null(AMR_env$current_theme) && - AMR_env$current_theme != tryCatch(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$editor, error = function(e) "") - )) { - AMR_env$current_theme <- tryCatch(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$editor, error = function(e) NULL) + if (is.null(AMR_env$is_dark_theme)) { AMR_env$is_dark_theme <- !has_colour() || tryCatch(isTRUE(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$dark), error = function(e) FALSE) } isTRUE(AMR_env$is_dark_theme) @@ -1545,7 +1543,7 @@ add_MO_lookup_to_AMR_env <- function() { MO_lookup <- AMR::microorganisms MO_lookup$kingdom_index <- NA_real_ - MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1 + MO_lookup[which(MO_lookup$kingdom == "Bacteria" | as.character(MO_lookup$mo) == "UNKNOWN"), "kingdom_index"] <- 1 MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 1.25 MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 1.5 MO_lookup[which(MO_lookup$kingdom == "Chromista"), "kingdom_index"] <- 1.75 diff --git a/R/antibiogram.R b/R/antibiogram.R index 9bf774c22..af26aea03 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -609,7 +609,6 @@ antibiogram.default <- function(x, pm_select(.mo, antimicrobials) } - # get numbers of S, I, R (per group) out <- out %pm>% bug_drug_combinations( @@ -706,6 +705,7 @@ antibiogram.default <- function(x, } out_wisca$p_susceptible <- out_wisca$n_susceptible / out_wisca$n_tested + out_wisca$p_susceptible[is.nan(out_wisca$p_susceptible)] <- 0 if (isTRUE(has_syndromic_group)) { out$group <- paste(out$syndromic_group, out$ab) @@ -721,10 +721,6 @@ antibiogram.default <- function(x, out$beta_posterior_2 <- NA_real_ for (i in seq_len(NROW(out))) { - if (out$n_tested[i] == 0) { - next - } - out_current <- out[i, , drop = FALSE] ## calculate priors ---- @@ -767,18 +763,19 @@ antibiogram.default <- function(x, # simulate pathogen incidence # = Dirichlet (Gamma) parameters - random_incidence <- stats::runif(1, min = 0, max = 1) + random_incidence <- stats::runif(n = 1, min = 0, max = 1) simulated_incidence <- stats::qgamma( p = random_incidence, shape = params_current$gamma_posterior, scale = 1 ) + # normalise simulated_incidence <- simulated_incidence / sum(simulated_incidence, na.rm = TRUE) # simulate susceptibility # = Beta parameters - random_susceptibity <- stats::runif(1, min = 0, max = 1) + random_susceptibity <- stats::runif(n = 1, min = 0, max = 1) simulated_susceptibility <- stats::qbeta( p = random_susceptibity, shape1 = params_current$beta_posterior_1, @@ -804,7 +801,6 @@ antibiogram.default <- function(x, } # remove progress bar from console close(progress) - # prepare for definitive output out <- out_wisca wisca_parameters <- wisca_parameters[, colnames(wisca_parameters)[!colnames(wisca_parameters) %in% c(levels(NA_sir_), "lower_ci", "upper_ci", "group")], drop = FALSE] @@ -836,7 +832,6 @@ antibiogram.default <- function(x, } } - out$digits <- digits # since pm_sumarise() cannot work with an object outside the current frame if (isFALSE(wisca)) { out$coverage <- out$p_susceptible } @@ -867,6 +862,7 @@ antibiogram.default <- function(x, if (wisca == TRUE && !formatting_type %in% c(1, 2, 13, 14) && info == TRUE && message_not_thrown_before("antibiogram", wisca, formatting_type)) { message_("Using WISCA with a `formatting_type` that includes the denominator is not useful") } + out$digits <- digits # since pm_sumarise() cannot work with an object outside the current frame if (formatting_type == 1) out <- out %pm>% pm_summarise(out_value = round(coverage * 100, digits = digits)) if (formatting_type == 2) out <- out %pm>% pm_summarise(out_value = n_susceptible) if (formatting_type == 3) out <- out %pm>% pm_summarise(out_value = n_tested) @@ -1148,6 +1144,7 @@ wisca <- function(x, antimicrobials = where(is.sir), ab_transform = "name", syndromic_group = NULL, + only_all_tested = FALSE, digits = 1, formatting_type = getOption("AMR_antibiogram_formatting_type", 14), col_mo = NULL, @@ -1166,7 +1163,7 @@ wisca <- function(x, mo_transform = NULL, syndromic_group = syndromic_group, add_total_n = FALSE, - only_all_tested = FALSE, + only_all_tested = only_all_tested, digits = digits, formatting_type = formatting_type, col_mo = col_mo, @@ -1236,7 +1233,7 @@ plot.antibiogram <- function(x, ...) { for (i in seq_along(mo_levels)) { mo <- mo_levels[i] - df_sub <- df[df$mo == mo, , drop = FALSE] + df_sub <- df[as.character(df$mo) == mo, , drop = FALSE] bp <- barplot( height = df_sub$coverage * 100, @@ -1311,7 +1308,7 @@ autoplot.antibiogram <- function(object, ...) { NULL } ) - if (!all(df$mo == "", na.rm = TRUE)) { + if (!all(as.character(df$mo) == "", na.rm = TRUE)) { out <- out + ggplot2::facet_wrap("mo") } diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 5161a82b0..746a7db54 100755 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -308,7 +308,7 @@ format.bug_drug_combinations <- function(x, # replace tidyr::pivot_wider() from here for (i in unique(y$mo)) { - mo_group <- y[which(y$mo == i), c("ab", "txt"), drop = FALSE] + mo_group <- y[which(as.character(y$mo) == i), c("ab", "txt"), drop = FALSE] colnames(mo_group) <- c("ab", i) rownames(mo_group) <- NULL y <- y %pm>% diff --git a/R/count.R b/R/count.R index c095832ba..9652764b2 100755 --- a/R/count.R +++ b/R/count.R @@ -146,9 +146,6 @@ count_susceptible <- function(..., only_all_tested = FALSE) { #' @rdname count #' @export count_S <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_S", entire_session = TRUE)) { - message_("Using `count_S()` is discouraged; use `count_susceptible()` instead to also consider \"I\" and \"SDD\" being susceptible. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = "S", @@ -162,9 +159,6 @@ count_S <- function(..., only_all_tested = FALSE) { #' @rdname count #' @export count_SI <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_SI", entire_session = TRUE)) { - message_("Note that `count_SI()` will also count dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("S", "SDD", "I"), @@ -178,9 +172,6 @@ count_SI <- function(..., only_all_tested = FALSE) { #' @rdname count #' @export count_I <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_I", entire_session = TRUE)) { - message_("Note that `count_I()` will also count dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("I", "SDD"), @@ -194,9 +185,6 @@ count_I <- function(..., only_all_tested = FALSE) { #' @rdname count #' @export count_IR <- function(..., only_all_tested = FALSE) { - if (message_not_thrown_before("count_IR", entire_session = TRUE)) { - message_("Using `count_IR()` is discouraged; use `count_resistant()` instead to not consider \"I\" and \"SDD\" being resistant. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("I", "SDD", "R"), diff --git a/R/proportion.R b/R/proportion.R index e8e69f0f9..f79a48896 100644 --- a/R/proportion.R +++ b/R/proportion.R @@ -357,9 +357,6 @@ proportion_IR <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - if (message_not_thrown_before("proportion_IR", entire_session = TRUE)) { - message_("Note that `proportion_IR()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("I", "SDD", "R"), @@ -378,9 +375,6 @@ proportion_I <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - if (message_not_thrown_before("proportion_I", entire_session = TRUE)) { - message_("Note that `proportion_I()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("I", "SDD"), @@ -399,9 +393,6 @@ proportion_SI <- function(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE) { - if (message_not_thrown_before("proportion_SI", entire_session = TRUE)) { - message_("Note that `proportion_SI()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) - } tryCatch( sir_calc(..., ab_result = c("S", "I", "SDD"), diff --git a/R/sir.R b/R/sir.R index b824b0a1c..a09ed5392 100755 --- a/R/sir.R +++ b/R/sir.R @@ -84,7 +84,7 @@ #' 1. For **cleaning raw / untransformed data**. The data will be cleaned to only contain valid values, namely: **S** for susceptible, **I** for intermediate or 'susceptible, increased exposure', **R** for resistant, **NI** for non-interpretable, and **SDD** for susceptible dose-dependent. Each of these can be set using a [regular expression][base::regex]. Furthermore, [as.sir()] will try its best to clean with some intelligence. For example, mixed values with SIR interpretations and MIC values such as `"<0.25; S"` will be coerced to `"S"`. Combined interpretations for multiple test methods (as seen in laboratory records) such as `"S; S"` will be coerced to `"S"`, but a value like `"S; I"` will return `NA` with a warning that the input is invalid. #' #' 2. For **interpreting minimum inhibitory concentration (MIC) values** according to EUCAST or CLSI. You must clean your MIC values first using [as.mic()], that also gives your columns the new data class [`mic`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` argument. -#' * Using `dplyr`, SIR interpretation can be done very easily with either: +#' * Example to apply using `dplyr`: #' ```r #' your_data %>% mutate_if(is.mic, as.sir) #' your_data %>% mutate(across(where(is.mic), as.sir)) @@ -95,8 +95,10 @@ #' your_data %>% mutate_if(is.mic, as.sir, host = "column_with_animal_species", guideline = "CLSI") #' ``` #' * Operators like "<=" will be stripped before interpretation. When using `capped_mic_handling = "conservative"`, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (`capped_mic_handling = "standard"`) considers ">2" to be lower than ">=4" and might in this case return "S" or "I". +#' * **Note:** When using CLSI as the guideline, MIC values must be log2-based doubling dilutions. Values not in this format, will be automatically rounded up to the nearest log2 level as CLSI instructs, and a warning will be thrown. +#' #' 3. For **interpreting disk diffusion diameters** according to EUCAST or CLSI. You must clean your disk zones first using [as.disk()], that also gives your columns the new data class [`disk`]. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the `mo` argument. -#' * Using `dplyr`, SIR interpretation can be done very easily with either: +#' * Example to apply using `dplyr`: #' ```r #' your_data %>% mutate_if(is.disk, as.sir) #' your_data %>% mutate(across(where(is.disk), as.sir)) @@ -106,6 +108,7 @@ #' # for veterinary breakpoints, also set `host`: #' your_data %>% mutate_if(is.disk, as.sir, host = "column_with_animal_species", guideline = "CLSI") #' ``` +#' #' 4. For **interpreting a complete data set**, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running `as.sir(your_data)`. #' #' **For points 2, 3 and 4: Use [sir_interpretation_history()]** to retrieve a [data.frame] (or [tibble][tibble::tibble()] if the `tibble` package is installed) with all results of the last [as.sir()] call. @@ -141,10 +144,6 @@ #' #' To determine which isolates are multi-drug resistant, be sure to run [mdro()] (which applies the MDR/PDR/XDR guideline from 2012 at default) on a data set that contains S/I/R values. Read more about [interpreting multidrug-resistant organisms here][mdro()]. #' -#' ### Machine-Readable Clinical Breakpoints -#' -#' The repository of this package [contains a machine-readable version](https://github.com/msberends/AMR/blob/main/data-raw/clinical_breakpoints.txt) of all guidelines. This is a CSV file consisting of `r format(nrow(AMR::clinical_breakpoints), big.mark = " ")` rows and `r ncol(AMR::clinical_breakpoints)` columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial drug and the microorganism. **This allows for easy implementation of these rules in laboratory information systems (LIS)**. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed. -#' #' ### Other #' #' The function [is.sir()] detects if the input contains class `sir`. If the input is a [data.frame] or [list], it iterates over all columns/items and returns a [logical] vector. @@ -153,18 +152,9 @@ #' #' The function [is_sir_eligible()] returns `TRUE` when a column contains at most 5% invalid antimicrobial interpretations (not S and/or I and/or R and/or NI and/or SDD), and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector. #' @section Interpretation of SIR: -#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (): +#' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (). #' -#' - **S - Susceptible, standard dosing regimen**\cr -#' A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -#' - **I - Susceptible, increased exposure** *\cr -#' A microorganism is categorised as "Susceptible, Increased exposure*" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -#' - **R = Resistant**\cr -#' A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -#' -#' * *Exposure* is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -#' -#' This AMR package honours this insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates. +#' This AMR package follows insight; use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates. #' @return Ordered [factor] with new class `sir` #' @aliases sir #' @export @@ -379,12 +369,13 @@ as_sir_structure <- function(x, levels = c("S", "SDD", "I", "R", "NI"), ordered = TRUE ), - guideline = guideline, - mo = mo, - ab = ab, - method = method, - ref_tbl = ref_tbl, - ref_breakpoints = ref_breakpoints, + # TODO for #170 + # guideline = guideline, + # mo = mo, + # ab = ab, + # method = method, + # ref_tbl = ref_tbl, + # ref_breakpoints = ref_breakpoints, class = c("sir", "ordered", "factor") ) } @@ -1253,9 +1244,11 @@ as_sir_method <- function(method_short, subset(method == method_coerced & ab %in% ab_coerced) } + # create the unique data frame to be filled to save time df <- data.frame( values = x, + values_bak = x, mo = mo, ab = ab, result = NA_sir_, @@ -1264,7 +1257,30 @@ as_sir_method <- function(method_short, stringsAsFactors = FALSE ) if (method == "mic") { - # when as.sir.mic is called directly + if (guideline %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( + FUN.VALUE = double(1), + as.double(df$values), + function(mic_val) { + if (is.na(mic_val)) { + return(NA_real_) + } else { + # find the smallest log2 level that is >= mic_val + log2_val <- log2_levels[which(log2_levels >= mic_val)][1] + if (is.na(log2_val)) { + return(mic_val) + } else { + if (mic_val != log2_val && message_not_thrown_before("as.sir", "CLSI", "MICupscaling")) { + warning_("Some MICs were converted to the nearest higher log2 level, following the CLSI interpretation guideline.") + } + return(log2_val) + } + } + } + ) + } df$values <- as.mic(df$values) } else if (method == "disk") { # when as.sir.disk is called directly @@ -1272,6 +1288,7 @@ as_sir_method <- function(method_short, } df_unique <- unique(df[, c("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 breakpoint_type_lookup <- breakpoint_type @@ -1332,8 +1349,6 @@ as_sir_method <- function(method_short, } } - mo_grams <- suppressWarnings(suppressMessages(mo_gramstain(df_unique$mo, language = NULL, keep_synonyms = FALSE))) - # run the rules (df_unique is a row combination per mo/ab/uti/host) ---- for (i in seq_len(nrow(df_unique))) { p$tick() @@ -1345,15 +1360,16 @@ as_sir_method <- function(method_short, notes_current <- character(0) if (is.na(uti_current)) { # no preference, so no filter on UTIs - rows <- which(df$mo == mo_current & df$ab == ab_current & df$host == host_current) + rows <- which(as.character(df$mo) == mo_current & df$ab == ab_current & df$host == host_current) } else { - rows <- which(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$uti == 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] new_sir <- rep(NA_sir_, length(rows)) # find different mo properties, as fast as possible @@ -1488,13 +1504,14 @@ as_sir_method <- function(method_short, data.frame( datetime = vectorise_log_entry(Sys.time(), length(rows)), index = rows, + method = vectorise_log_entry(method_coerced, length(rows)), ab_given = vectorise_log_entry(ab.bak[match(ab_current, df$ab)][1], length(rows)), mo_given = vectorise_log_entry(mo.bak[match(mo_current, df$mo)][1], length(rows)), host_given = vectorise_log_entry(host.bak[match(host_current, df$host)][1], length(rows)), + input_given = vectorise_log_entry(as.character(values_bak), length(rows)), ab = vectorise_log_entry(ab_current, length(rows)), mo = vectorise_log_entry(mo_current, length(rows)), host = vectorise_log_entry(host_current, length(rows)), - method = vectorise_log_entry(method_coerced, 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)), @@ -1616,13 +1633,14 @@ as_sir_method <- function(method_short, data.frame( datetime = vectorise_log_entry(Sys.time(), length(rows)), index = rows, + method = vectorise_log_entry(method_coerced, length(rows)), ab_given = vectorise_log_entry(ab.bak[match(ab_current, df$ab)][1], length(rows)), mo_given = vectorise_log_entry(mo.bak[match(mo_current, df$mo)][1], length(rows)), host_given = vectorise_log_entry(host.bak[match(host_current, df$host)][1], length(rows)), + input_given = vectorise_log_entry(as.character(values_bak), length(rows)), ab = vectorise_log_entry(breakpoints_current[, "ab", drop = TRUE], length(rows)), mo = vectorise_log_entry(breakpoints_current[, "mo", drop = TRUE], length(rows)), host = vectorise_log_entry(breakpoints_current[, "host", drop = TRUE], length(rows)), - method = vectorise_log_entry(method_coerced, 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)), diff --git a/R/sir_calc.R b/R/sir_calc.R index 4505e4b0b..e6042d32a 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -141,11 +141,17 @@ sir_calc <- function(..., MARGIN = 1, FUN = min ) + if ("SDD" %in% ab_result && "SDD" %in% y && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { + message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) + } numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE) denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y)))) } else { # may contain NAs in any column other_values <- setdiff(c(NA, levels(ab_result)), ab_result) + if ("SDD" %in% ab_result && "SDD" %in% unlist(x_transposed) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { + message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) + } numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE))) denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & anyNA(y)))) } @@ -155,6 +161,9 @@ sir_calc <- function(..., x <- as.sir(x) print_warning <- TRUE } + if ("SDD" %in% ab_result && "SDD" %in% x && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) { + message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE) + } numerator <- sum(x %in% ab_result, na.rm = TRUE) denominator <- sum(x %in% levels(ab_result), na.rm = TRUE) } @@ -250,10 +259,8 @@ sir_calc_df <- function(type, # "proportion", "count" or "both" for (i in seq_len(ncol(data))) { if (is.sir(data[, i, drop = TRUE])) { data[, i] <- as.character(data[, i, drop = TRUE]) - if ("SDD" %in% data[, i, drop = TRUE]) { - if (message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) { - message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE) - } + if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) { + message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE) } data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE]) } diff --git a/R/zzz.R b/R/zzz.R index 8acae8163..d0c99c64c 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -28,7 +28,7 @@ # ==================================================================== # # set up package environment, used by numerous AMR functions -AMR_env <- new.env(hash = FALSE) +AMR_env <- new.env(hash = TRUE, parent = emptyenv()) AMR_env$mo_uncertainties <- data.frame( original_input = character(0), input = character(0), @@ -58,13 +58,14 @@ AMR_env$av_previously_coerced <- data.frame( AMR_env$sir_interpretation_history <- data.frame( datetime = Sys.time()[0], index = integer(0), + method = character(0), ab_given = character(0), mo_given = character(0), host_given = character(0), + input_given = character(0), ab = set_clean_class(character(0), c("ab", "character")), mo = set_clean_class(character(0), c("mo", "character")), host = character(0), - method = character(0), input = character(0), outcome = NA_sir_[0], notes = character(0), @@ -75,9 +76,11 @@ AMR_env$sir_interpretation_history <- data.frame( stringsAsFactors = FALSE ) + AMR_env$custom_ab_codes <- character(0) AMR_env$custom_mo_codes <- character(0) AMR_env$is_dark_theme <- NULL +AMR_env$supports_colour <- NULL AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE) AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE) @@ -86,9 +89,7 @@ AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..." AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i" AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*" - AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE) - AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x" .onLoad <- function(libname, pkgname) { diff --git a/data-raw/gpt_training_text_v2.1.1.9233.txt b/data-raw/gpt_training_text_v2.1.1.9234.txt similarity index 98% rename from data-raw/gpt_training_text_v2.1.1.9233.txt rename to data-raw/gpt_training_text_v2.1.1.9234.txt index fcd7b94ea..0edaec92c 100644 --- a/data-raw/gpt_training_text_v2.1.1.9233.txt +++ b/data-raw/gpt_training_text_v2.1.1.9234.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.9233. Remember this whenever someone asks which AMR package version you’re at. +First and foremost, you are trained on version 2.1.1.9234. 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. ---------------------------------------------------------------------------------------------------- @@ -1702,7 +1702,7 @@ antibiogram(x, antimicrobials = where(is.sir), mo_transform = "shortname", info = interactive(), ...) wisca(x, antimicrobials = where(is.sir), ab_transform = "name", - syndromic_group = NULL, digits = 1, + syndromic_group = NULL, only_all_tested = FALSE, digits = 1, formatting_type = getOption("AMR_antibiogram_formatting_type", 14), col_mo = NULL, language = get_AMR_locale(), combine_SI = TRUE, sep = " + ", simulations = 1000, conf_interval = 0.95, @@ -3536,7 +3536,7 @@ The \code{\link[=as.sir]{as.sir()}} function can work in four ways: \item For \strong{cleaning raw / untransformed data}. The data will be cleaned to only contain valid values, namely: \strong{S} for susceptible, \strong{I} for intermediate or 'susceptible, increased exposure', \strong{R} for resistant, \strong{NI} for non-interpretable, and \strong{SDD} for susceptible dose-dependent. Each of these can be set using a \link[base:regex]{regular expression}. Furthermore, \code{\link[=as.sir]{as.sir()}} will try its best to clean with some intelligence. For example, mixed values with SIR interpretations and MIC values such as \code{"<0.25; S"} will be coerced to \code{"S"}. Combined interpretations for multiple test methods (as seen in laboratory records) such as \code{"S; S"} will be coerced to \code{"S"}, but a value like \code{"S; I"} will return \code{NA} with a warning that the input is invalid. \item For \strong{interpreting minimum inhibitory concentration (MIC) values} according to EUCAST or CLSI. You must clean your MIC values first using \code{\link[=as.mic]{as.mic()}}, that also gives your columns the new data class \code{\link{mic}}. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the \code{mo} argument. \itemize{ -\item Using \code{dplyr}, SIR interpretation can be done very easily with either: +\item Example to apply using \code{dplyr}: \if{html}{\out{
}}\preformatted{your_data \%>\% mutate_if(is.mic, as.sir) your_data \%>\% mutate(across(where(is.mic), as.sir)) @@ -3547,10 +3547,11 @@ your_data \%>\% mutate_if(is.mic, as.sir, ab = c("cipro", "ampicillin", ...), mo your_data \%>\% mutate_if(is.mic, as.sir, host = "column_with_animal_species", guideline = "CLSI") }\if{html}{\out{
}} \item Operators like "<=" will be stripped before interpretation. When using \code{capped_mic_handling = "conservative"}, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (\code{capped_mic_handling = "standard"}) considers ">2" to be lower than ">=4" and might in this case return "S" or "I". +\item \strong{Note:} When using CLSI as the guideline, MIC values must be log2-based doubling dilutions. Values not in this format, will be automatically rounded up to the nearest log2 level as CLSI instructs, and a warning will be thrown. } \item For \strong{interpreting disk diffusion diameters} according to EUCAST or CLSI. You must clean your disk zones first using \code{\link[=as.disk]{as.disk()}}, that also gives your columns the new data class \code{\link{disk}}. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the \code{mo} argument. \itemize{ -\item Using \code{dplyr}, SIR interpretation can be done very easily with either: +\item Example to apply using \code{dplyr}: \if{html}{\out{
}}\preformatted{your_data \%>\% mutate_if(is.disk, as.sir) your_data \%>\% mutate(across(where(is.disk), as.sir)) @@ -3596,11 +3597,6 @@ After using \code{\link[=as.sir]{as.sir()}}, you can use the \code{\link[=eucast To determine which isolates are multi-drug resistant, be sure to run \code{\link[=mdro]{mdro()}} (which applies the MDR/PDR/XDR guideline from 2012 at default) on a data set that contains S/I/R values. Read more about \link[=mdro]{interpreting multidrug-resistant organisms here}. } -\subsection{Machine-Readable Clinical Breakpoints}{ - -The repository of this package \href{https://github.com/msberends/AMR/blob/main/data-raw/clinical_breakpoints.txt}{contains a machine-readable version} of all guidelines. This is a CSV file consisting of 34 376 rows and 14 columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial drug and the microorganism. \strong{This allows for easy implementation of these rules in laboratory information systems (LIS)}. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed. -} - \subsection{Other}{ The function \code{\link[=is.sir]{is.sir()}} detects if the input contains class \code{sir}. If the input is a \link{data.frame} or \link{list}, it iterates over all columns/items and returns a \link{logical} vector. @@ -3614,20 +3610,9 @@ The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRU } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \section{Download Our Reference Data}{ @@ -4398,20 +4383,9 @@ The function \code{\link[=count_df]{count_df()}} takes any variable from \code{d } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \section{Combination Therapy}{ @@ -6556,20 +6530,9 @@ Amikacin (\code{AMK}, \href{https://atcddd.fhi.no/atc_ddd_index//?code=J01GB06&s \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{ @@ -8079,20 +8042,9 @@ Using \code{only_all_tested} has no impact when only using one antibiotic as inp \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{ @@ -8374,20 +8326,9 @@ Valid options for the statistical model (argument \code{model}) are: } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{ diff --git a/data-raw/~$v_14.0_Breakpoint_Tables.xlsx b/data-raw/~$v_14.0_Breakpoint_Tables.xlsx new file mode 100644 index 000000000..767eb740c Binary files /dev/null and b/data-raw/~$v_14.0_Breakpoint_Tables.xlsx differ diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index ecba7a80e..3c9dc56bc 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -28,7 +28,7 @@ antibiogram(x, antimicrobials = where(is.sir), mo_transform = "shortname", info = interactive(), ...) wisca(x, antimicrobials = where(is.sir), ab_transform = "name", - syndromic_group = NULL, digits = 1, + syndromic_group = NULL, only_all_tested = FALSE, digits = 1, formatting_type = getOption("AMR_antibiogram_formatting_type", 14), col_mo = NULL, language = get_AMR_locale(), combine_SI = TRUE, sep = " + ", simulations = 1000, conf_interval = 0.95, diff --git a/man/as.sir.Rd b/man/as.sir.Rd index 8f5db334d..6bc17239e 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -162,7 +162,7 @@ The \code{\link[=as.sir]{as.sir()}} function can work in four ways: \item For \strong{cleaning raw / untransformed data}. The data will be cleaned to only contain valid values, namely: \strong{S} for susceptible, \strong{I} for intermediate or 'susceptible, increased exposure', \strong{R} for resistant, \strong{NI} for non-interpretable, and \strong{SDD} for susceptible dose-dependent. Each of these can be set using a \link[base:regex]{regular expression}. Furthermore, \code{\link[=as.sir]{as.sir()}} will try its best to clean with some intelligence. For example, mixed values with SIR interpretations and MIC values such as \code{"<0.25; S"} will be coerced to \code{"S"}. Combined interpretations for multiple test methods (as seen in laboratory records) such as \code{"S; S"} will be coerced to \code{"S"}, but a value like \code{"S; I"} will return \code{NA} with a warning that the input is invalid. \item For \strong{interpreting minimum inhibitory concentration (MIC) values} according to EUCAST or CLSI. You must clean your MIC values first using \code{\link[=as.mic]{as.mic()}}, that also gives your columns the new data class \code{\link{mic}}. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the \code{mo} argument. \itemize{ -\item Using \code{dplyr}, SIR interpretation can be done very easily with either: +\item Example to apply using \code{dplyr}: \if{html}{\out{
}}\preformatted{your_data \%>\% mutate_if(is.mic, as.sir) your_data \%>\% mutate(across(where(is.mic), as.sir)) @@ -173,10 +173,11 @@ your_data \%>\% mutate_if(is.mic, as.sir, ab = c("cipro", "ampicillin", ...), mo your_data \%>\% mutate_if(is.mic, as.sir, host = "column_with_animal_species", guideline = "CLSI") }\if{html}{\out{
}} \item Operators like "<=" will be stripped before interpretation. When using \code{capped_mic_handling = "conservative"}, an MIC value of e.g. ">2" will always return "R", even if the breakpoint according to the chosen guideline is ">=4". This is to prevent that capped values from raw laboratory data would not be treated conservatively. The default behaviour (\code{capped_mic_handling = "standard"}) considers ">2" to be lower than ">=4" and might in this case return "S" or "I". +\item \strong{Note:} When using CLSI as the guideline, MIC values must be log2-based doubling dilutions. Values not in this format, will be automatically rounded up to the nearest log2 level as CLSI instructs, and a warning will be thrown. } \item For \strong{interpreting disk diffusion diameters} according to EUCAST or CLSI. You must clean your disk zones first using \code{\link[=as.disk]{as.disk()}}, that also gives your columns the new data class \code{\link{disk}}. Also, be sure to have a column with microorganism names or codes. It will be found automatically, but can be set manually using the \code{mo} argument. \itemize{ -\item Using \code{dplyr}, SIR interpretation can be done very easily with either: +\item Example to apply using \code{dplyr}: \if{html}{\out{
}}\preformatted{your_data \%>\% mutate_if(is.disk, as.sir) your_data \%>\% mutate(across(where(is.disk), as.sir)) @@ -222,11 +223,6 @@ After using \code{\link[=as.sir]{as.sir()}}, you can use the \code{\link[=eucast To determine which isolates are multi-drug resistant, be sure to run \code{\link[=mdro]{mdro()}} (which applies the MDR/PDR/XDR guideline from 2012 at default) on a data set that contains S/I/R values. Read more about \link[=mdro]{interpreting multidrug-resistant organisms here}. } -\subsection{Machine-Readable Clinical Breakpoints}{ - -The repository of this package \href{https://github.com/msberends/AMR/blob/main/data-raw/clinical_breakpoints.txt}{contains a machine-readable version} of all guidelines. This is a CSV file consisting of 34 376 rows and 14 columns. This file is machine-readable, since it contains one row for every unique combination of the test method (MIC or disk diffusion), the antimicrobial drug and the microorganism. \strong{This allows for easy implementation of these rules in laboratory information systems (LIS)}. Note that it only contains interpretation guidelines for humans - interpretation guidelines from CLSI for animals were removed. -} - \subsection{Other}{ The function \code{\link[=is.sir]{is.sir()}} detects if the input contains class \code{sir}. If the input is a \link{data.frame} or \link{list}, it iterates over all columns/items and returns a \link{logical} vector. @@ -240,20 +236,9 @@ The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRU } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \section{Download Our Reference Data}{ diff --git a/man/count.Rd b/man/count.Rd index 1406411fd..59a33401d 100644 --- a/man/count.Rd +++ b/man/count.Rd @@ -67,20 +67,9 @@ The function \code{\link[=count_df]{count_df()}} takes any variable from \code{d } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \section{Combination Therapy}{ diff --git a/man/mdro.Rd b/man/mdro.Rd index 44fcb72c3..71c0d3d02 100644 --- a/man/mdro.Rd +++ b/man/mdro.Rd @@ -187,20 +187,9 @@ Amikacin (\code{AMK}, \href{https://atcddd.fhi.no/atc_ddd_index//?code=J01GB06&s \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{ diff --git a/man/proportion.Rd b/man/proportion.Rd index 3fb2e5447..7d26cb44c 100644 --- a/man/proportion.Rd +++ b/man/proportion.Rd @@ -136,20 +136,9 @@ Using \code{only_all_tested} has no impact when only using one antibiotic as inp \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{ diff --git a/man/resistance_predict.Rd b/man/resistance_predict.Rd index 6cac8f43d..9f4645632 100644 --- a/man/resistance_predict.Rd +++ b/man/resistance_predict.Rd @@ -83,20 +83,9 @@ Valid options for the statistical model (argument \code{model}) are: } \section{Interpretation of SIR}{ -In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R as shown below (\url{https://www.eucast.org/newsiandr}): -\itemize{ -\item \strong{S - Susceptible, standard dosing regimen}\cr -A microorganism is categorised as "Susceptible, standard dosing regimen", when there is a high likelihood of therapeutic success using a standard dosing regimen of the agent. -\item \strong{I - Susceptible, increased exposure} \emph{\cr -A microorganism is categorised as "Susceptible, Increased exposure}" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. -\item \strong{R = Resistant}\cr -A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -\itemize{ -\item \emph{Exposure} is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. -} -} +In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (\url{https://www.eucast.org/newsiandr}). -This AMR package honours this insight. Use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. +This AMR package follows insight; use \code{\link[=susceptibility]{susceptibility()}} (equal to \code{\link[=proportion_SI]{proportion_SI()}}) to determine antimicrobial susceptibility and \code{\link[=count_susceptible]{count_susceptible()}} (equal to \code{\link[=count_SI]{count_SI()}}) to count susceptible isolates. } \examples{