diff --git a/DESCRIPTION b/DESCRIPTION index 07bef054d..943f76434 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9018 -Date: 2026-01-16 +Version: 3.0.1.9019 +Date: 2026-02-08 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/NAMESPACE b/NAMESPACE index 54f6c9563..8e3742fa4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -214,6 +214,7 @@ export(cephalosporins_4th) export(cephalosporins_5th) export(clear_custom_antimicrobials) export(clear_custom_microorganisms) +export(clsi_rules) export(count_I) export(count_IR) export(count_R) @@ -244,6 +245,7 @@ export(ggplot_sir_predict) export(glycopeptides) export(guess_ab_col) export(inner_join_microorganisms) +export(interpretive_rules) export(is.ab) export(is.av) export(is.disk) diff --git a/NEWS.md b/NEWS.md index 2b42197fd..0d71f378f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9018 +# AMR 3.0.1.9019 ### New * Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes` @@ -9,15 +9,24 @@ - `all_disk()`, `all_disk_predictors()` * Data set `esbl_isolates` to practise with AMR modelling * AMR selectors `phosphonics()` and `spiropyrimidinetriones()` -* `antimicrobials$group` is now a `list` instead of a `character`, to contain any group the drug is in (#246) +* Support for Wildtype (WT) / Non-wildtype (NWT) in `as.sir()`, all plotting functions, and all susceptibility/resistance functions. + - `as.sir()` gained an argument `as_wt_nwt`, which defaults to `TRUE` only when `breakpoint_type = "ECOFF"` (#254) + - This transforms the output from S/R to WT/NWT + - Functions such as `susceptibility()` count WT as S and NWT as R +* `interpretive_rules()`, which allows future implementation of CLSI interpretive rules (#235) + - `eucast_rules()` has become a wrapper around that function. ### Fixes * Fixed a bug in `antibiogram()` for when no antimicrobials are set * Fixed a bug in `as.sir()` where for numeric input the arguments `S`, `i`, and `R` would not be considered (#244) * Fixed some foreign translations of antimicrobial drugs * Fixed a bug for printing column names to the console when using `mutate_at(vars(...), as.mic)` (#249) +* Fixed a bug to disregard `NI` for susceptibility proportion functions +* Fixed Italian translation of CoNS to Stafilococco coagulasi-negativo and CoPS to Stafilococco coagulasi-positivo (#256) ### Updates +* `as.mic()` and `rescale_mic()` gained the argument `round_to_next_log2`, which can be set to `TRUE` to round all values up to the nearest next log2 level (#255) +* `antimicrobials$group` is now a `list` instead of a `character`, to contain any group the drug is in (#246) * `ab_group()` gained an argument `all_groups` to return all groups the antimicrobial drug is in (#246) * Added taniborbactam (`TAN`) and cefepime/taniborbactam (`FTA`) to the `antimicrobials` data set * Added explaining message to `as.sir()` when interpreting numeric values (e.g., 1 for S, 2 for I, 3 for R) (#244) diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index eb36953a6..f32e2f0fd 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -685,8 +685,12 @@ format_included_data_number <- function(data) { vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, last_sep = " or ") { # makes unique and sorts, and this also removed NAs v <- unique(v) + has_na <- anyNA(v) if (isTRUE(sort)) { v <- sort(v) + if (has_na) { + v <- c(v, NA) + } } if (isTRUE(reverse)) { v <- rev(v) @@ -708,18 +712,25 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca # class 'sir' should be sorted like this v <- c("S", "I", "R") } - if (identical(v, c("I", "NI", "R", "S", "SDD"))) { + if (identical(v, sort(VALID_SIR_LEVELS))) { # class 'sir' should be sorted like this - v <- c("S", "SDD", "I", "R", "NI") + v <- VALID_SIR_LEVELS } # oxford comma if (last_sep %in% c(" or ", " and ") && length(v) > 2) { last_sep <- paste0(",", last_sep) } + NAs <- which(is.na(v)) + + if (is.numeric(v)) { + v <- trimws(vapply(FUN.VALUE = character(1), v, format, scientific = FALSE)) + } + quoted <- paste0(quotes, v, quotes) + quoted[NAs] <- "NA" # all commas except for last item, so will become '"val1", "val2", "val3" or "val4"' paste0( - paste0(quotes, v[seq_len(length(v) - 1)], quotes, collapse = ", "), - last_sep, paste0(quotes, v[length(v)], quotes) + paste(quoted[seq_len(length(quoted) - 1)], collapse = ", "), + last_sep, quoted[length(quoted)] ) } @@ -1097,11 +1108,14 @@ format_custom_query_rule <- function(query, colours = has_colour()) { query <- gsub("any\\((.*)\\)$", paste0(font_black("any of "), "\\1"), query) query <- gsub("all\\((.*)\\)$", paste0(font_black("all of "), "\\1"), query) if (colours == TRUE) { - query <- gsub("[\"']R[\"']", font_rose_bg(" R "), query) - query <- gsub("[\"']SDD[\"']", font_orange_bg(" SDD "), query) query <- gsub("[\"']S[\"']", font_green_bg(" S "), query) - query <- gsub("[\"']NI[\"']", font_grey_bg(font_black(" NI ")), query) + query <- gsub("[\"']SDD[\"']", font_orange_bg(" SDD "), query) query <- gsub("[\"']I[\"']", font_orange_bg(" I "), query) + query <- gsub("[\"']R[\"']", font_rose_bg(" R "), query) + query <- gsub("[\"']NI[\"']", font_grey_bg(font_black(" NI ")), query) + query <- gsub("[\"']WT[\"']", font_green_bg(" SDD "), query) + query <- gsub("[\"']NWT[\"']", font_rose_bg(" I "), query) + query <- gsub("[\"']NS[\"']", font_rose_bg(" R "), query) } # replace the black colour 'stops' with blue colour 'starts' query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE) diff --git a/R/amr_selectors.R b/R/amr_selectors.R index 7636c51ba..ee7b106a0 100755 --- a/R/amr_selectors.R +++ b/R/amr_selectors.R @@ -839,10 +839,10 @@ c.amr_selector <- function(...) { all_any_amr_selector <- function(type, ..., na.rm = TRUE) { cols_ab <- c(...) - result <- cols_ab[toupper(cols_ab) %in% c("S", "SDD", "I", "R", "NI")] + result <- cols_ab[toupper(cols_ab) %in% VALID_SIR_LEVELS] if (length(result) == 0) { message_("Filtering ", type, " of columns ", vector_and(font_bold(cols_ab, collapse = NULL), quotes = "'"), ' to contain value "S", "I" or "R"') - result <- c("S", "SDD", "I", "R", "NI") + result <- VALID_SIR_LEVELS } cols_ab <- cols_ab[!cols_ab %in% result] df <- get_current_data(arg_name = NA, call = -3) @@ -951,7 +951,7 @@ any.amr_selector_any_all <- function(..., na.rm = FALSE) { } } # this is `!=`, so turn around the values - sir <- c("S", "SDD", "I", "R", "NI") + sir <- VALID_SIR_LEVELS e2 <- sir[sir != e2] structure(all_any_amr_selector(type = type, e1, e2), class = c("amr_selector_any_all", "logical") diff --git a/R/antibiogram.R b/R/antibiogram.R index b7199e13b..1fffc1dd0 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -560,12 +560,11 @@ antibiogram.default <- function(x, next } else { # determine whether this new column should contain S, I, R, or NA + S_values <- c("S", "WT") if (isTRUE(combine_SI)) { - S_values <- c("S", "SDD", "I") - } else { - S_values <- "S" + S_values <- c(S_values, "SDD", "I") } - other_values <- setdiff(c("S", "SDD", "I", "R"), S_values) + other_values <- setdiff(c("S", "SDD", "I", "R", "WT", "NWT", "NS"), S_values) x_transposed <- as.list(as.data.frame(t(x[, abx, drop = FALSE]), stringsAsFactors = FALSE)) if (isTRUE(only_all_tested)) { x[new_colname] <- as.sir(vapply(FUN.VALUE = character(1), x_transposed, function(x) ifelse(anyNA(x), NA_character_, ifelse(any(x %in% S_values), "S", "R")), USE.NAMES = FALSE)) @@ -615,10 +614,9 @@ antibiogram.default <- function(x, counts <- out + out$n_susceptible <- out$S + out$WT if (isTRUE(combine_SI)) { - out$n_susceptible <- out$S + out$I + out$SDD - } else { - out$n_susceptible <- out$S + out$n_susceptible <- out$n_susceptible + out$I + out$SDD } if (all(out$n_tested < minimum, na.rm = TRUE) && wisca == FALSE) { warning_("All combinations had less than `minimum = ", minimum, "` results, returning an empty antibiogram") diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 7e388eec7..6eb9a9beb 100755 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -43,7 +43,7 @@ #' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()]. #' @export #' @rdname bug_drug_combinations -#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "SDD", "I", "R", and "total". +#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "SDD", "I", "R", "WT, "NWT", and "total". #' @examples #' # example_isolates is a data set available in the AMR package. #' # run ?example_isolates for more info. @@ -111,6 +111,8 @@ bug_drug_combinations <- function(x, SDD = integer(0), I = integer(0), R = integer(0), + WT = integer(0), + NWT = integer(0), total = integer(0), total_rows = integer(0), stringsAsFactors = FALSE @@ -133,6 +135,9 @@ bug_drug_combinations <- function(x, I = m["I", ], R = m["R", ], NI = m["NI", ], + WT = m["WT", ], + NWT = m["NWT", ], + NS = m["NS", ], na = m[which(is.na(rownames(m))), ], stringsAsFactors = FALSE ) @@ -146,8 +151,11 @@ bug_drug_combinations <- function(x, I = merged$I, R = merged$R, NI = merged$NI, - total = merged$S + merged$SDD + merged$I + merged$R + merged$NI, - total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$na, + WT = merged$WT, + NWT = merged$NWT, + NS = merged$NS, + total = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$WT + merged$NWT + merged$NS, + total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$WT + merged$NWT + merged$NS + merged$na, stringsAsFactors = FALSE ) if (data_has_groups) { @@ -229,12 +237,17 @@ format.bug_drug_combinations <- function(x, I = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$I[i], na.rm = TRUE)), R = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$R[i], na.rm = TRUE)), NI = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NI[i], na.rm = TRUE)), + WT = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$WT[i], na.rm = TRUE)), + NWT = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NWT[i], na.rm = TRUE)), + NS = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NS[i], na.rm = TRUE)), total = vapply(FUN.VALUE = double(1), idx, function(i) { sum(x$S[i], na.rm = TRUE) + sum(x$SDD[i], na.rm = TRUE) + sum(x$I[i], na.rm = TRUE) + sum(x$R[i], na.rm = TRUE) + - sum(x$NI[i], na.rm = TRUE) + sum(x$WT[i], na.rm = TRUE) + + sum(x$NWT[i], na.rm = TRUE) + + sum(x$NS[i], na.rm = TRUE) }), stringsAsFactors = FALSE ) @@ -246,10 +259,10 @@ format.bug_drug_combinations <- function(x, if (remove_intrinsic_resistant == TRUE) { x <- subset(x, R != total) } + + x$isolates <- x$R + x$NWT if (combine_SI == TRUE) { - x$isolates <- x$R - } else { - x$isolates <- x$R + x$I + x$SDD + x$isolates <- x$isolates + x$I + x$SDD } give_ab_name <- function(ab, format, language) { diff --git a/R/count.R b/R/count.R index 532c0b748..c3a19d621 100755 --- a/R/count.R +++ b/R/count.R @@ -122,7 +122,7 @@ count_resistant <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = "R", + ab_result = c("R", "NWT", "NS"), only_all_tested = only_all_tested, only_count = TRUE ), @@ -135,7 +135,7 @@ count_resistant <- function(..., only_all_tested = FALSE) { count_susceptible <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("S", "SDD", "I"), + ab_result = c("S", "SDD", "I", "WT"), only_all_tested = only_all_tested, only_count = TRUE ), @@ -161,7 +161,7 @@ count_S <- function(..., only_all_tested = FALSE) { count_SI <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("S", "SDD", "I"), + ab_result = c("S", "SDD", "I", "WT"), only_all_tested = only_all_tested, only_count = TRUE ), @@ -187,7 +187,7 @@ count_I <- function(..., only_all_tested = FALSE) { count_IR <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("I", "SDD", "R"), + ab_result = c("I", "SDD", "R", "NWT"), only_all_tested = only_all_tested, only_count = TRUE ), @@ -200,7 +200,7 @@ count_IR <- function(..., only_all_tested = FALSE) { count_R <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = "R", + ab_result = c("R", "NWT", "NS"), only_all_tested = only_all_tested, only_count = TRUE ), @@ -213,7 +213,7 @@ count_R <- function(..., only_all_tested = FALSE) { count_all <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("S", "SDD", "I", "R", "NI"), + ab_result = VALID_SIR_LEVELS, only_all_tested = only_all_tested, only_count = TRUE ), diff --git a/R/custom_eucast_rules.R b/R/custom_eucast_rules.R index 5cea829c8..8a762fb12 100755 --- a/R/custom_eucast_rules.R +++ b/R/custom_eucast_rules.R @@ -220,8 +220,8 @@ custom_eucast_rules <- function(...) { result_value <- as.character(result)[[3]] result_value[result_value == "NA"] <- NA stop_ifnot( - result_value %in% c("S", "SDD", "I", "R", "NI", NA), - "the resulting value of rule ", i, " must be either \"S\", \"SDD\", \"I\", \"R\", \"NI\" or NA" + result_value %in% c(VALID_SIR_LEVELS, NA), + paste0("the resulting value of rule ", i, " must be either ", vector_or(c(VALID_SIR_LEVELS, NA), sort = FALSE)) ) result_value <- as.sir(result_value) diff --git a/R/first_isolate.R b/R/first_isolate.R index 95a5a2fb9..091154708 100644 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -246,7 +246,7 @@ first_isolate <- function(x = NULL, FUN.VALUE = logical(1), X = x, # check only first 10,000 rows - FUN = function(x) any(as.character(x[1:10000]) %in% c("S", "SDD", "I", "R", "NI"), na.rm = TRUE), + FUN = function(x) any(as.character(x[1:10000]) %in% VALID_SIR_LEVELS, na.rm = TRUE), USE.NAMES = FALSE )) if (method == "phenotype-based" && !any_col_contains_sir) { diff --git a/R/eucast_rules.R b/R/interpretive_rules.R similarity index 94% rename from R/eucast_rules.R rename to R/interpretive_rules.R index d049f5ae4..1e709e066 100755 --- a/R/eucast_rules.R +++ b/R/interpretive_rules.R @@ -53,15 +53,21 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { vector_and(txt, quotes = FALSE) } -#' Apply EUCAST Rules +#' Apply Interpretive Rules #' #' @description -#' Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, ), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set. +#' **WORK IN PROGRESS** #' -#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*. +# TODO Remove this remark before next release +#' **The `interpretive_rules()` function is new, to allow CLSI 'rules' too. The old `eucast_rules()` function will stay as a wrapper, but we need to generalise more parts of the underlying code to allow more than just EUCAST.** +#' +#' Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by e.g. the European Committee on Antimicrobial Susceptibility Testing (EUCAST, ), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set. +#' +#' To improve the interpretation of the antibiogram before CLSI/EUCAST interpretive rules are applied, some AMR-specific rules can be applied at default, see *Details*. #' @param x A data set with antimicrobials columns, such as `amox`, `AMX` and `AMC`. #' @param info A [logical] to indicate whether progress should be printed to the console - the default is only print while in interactive sessions. -#' @param rules A [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expected_phenotypes"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expected_phenotypes")`. The default value can be set to another value using the package option [`AMR_eucastrules`][AMR-options]: `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()]. +#' @param guideline A guideline name, either "EUCAST" (default) or "CLSI". This can be set with the package option [`AMR_guideline`][AMR-options]. +#' @param rules A [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expected_phenotypes"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expected_phenotypes")`. The default value can be set to another value using the package option [`AMR_interpretive_rules`][AMR-options]: `options(AMR_interpretive_rules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()]. #' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time. #' @param version_breakpoints The version number to use for the EUCAST Clinical Breakpoints guideline. Can be `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), reverse = TRUE)`. #' @param version_expected_phenotypes The version number to use for the EUCAST Expected Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_EXPECTED_PHENOTYPES), reverse = TRUE)`. @@ -100,9 +106,9 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' #' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set. #' -#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the package option [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`. +#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the package option [`AMR_interpretive_rules`][AMR-options], i.e. run `options(AMR_interpretive_rules = "all")`. #' @aliases EUCAST -#' @rdname eucast_rules +#' @rdname interpretive_rules #' @export #' @return The input of `x`, possibly with edited values of antimicrobials. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations. #' @source @@ -156,21 +162,23 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { #' eucast_dosage(c("tobra", "genta", "cipro"), "iv") #' #' eucast_dosage(c("tobra", "genta", "cipro"), "iv", version_breakpoints = 10) -eucast_rules <- function(x, - col_mo = NULL, - info = interactive(), - rules = getOption("AMR_eucastrules", default = c("breakpoints", "expected_phenotypes")), - verbose = FALSE, - version_breakpoints = 15.0, - version_expected_phenotypes = 1.2, - version_expertrules = 3.3, - ampc_cephalosporin_resistance = NA, - only_sir_columns = any(is.sir(x)), - custom_rules = NULL, - overwrite = FALSE, - ...) { +interpretive_rules <- function(x, + col_mo = NULL, + guideline = getOption("AMR_guideline", "EUCAST"), + info = interactive(), + rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")), + verbose = FALSE, + version_breakpoints = 15.0, + version_expected_phenotypes = 1.2, + version_expertrules = 3.3, + ampc_cephalosporin_resistance = NA, + only_sir_columns = any(is.sir(x)), + custom_rules = NULL, + overwrite = FALSE, + ...) { meet_criteria(x, allow_class = "data.frame") meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE) + meet_criteria(guideline, allow_class = "character", has_length = 1, is_in = c("EUCAST", "CLSI")) meet_criteria(info, allow_class = "logical", has_length = 1) meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4, 5, 6), is_in = c("breakpoints", "expected_phenotypes", "expert", "other", "all", "custom")) meet_criteria(verbose, allow_class = "logical", has_length = 1) @@ -1092,6 +1100,25 @@ eucast_rules <- function(x, } } +#' @rdname interpretive_rules +#' @export +eucast_rules <- function(x, + rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")), + ...) { + if (!is.null(getOption("AMR_eucastrules", default = NULL))) { + warning_("The global option `AMR_eucastrules` that you have set is now invalid was ignored - set `AMR_interpretive_rules` instead. See `?AMR-options`.") + } + interpretive_rules(x = x, guideline = "EUCAST", rules = rules, ...) +} + +#' @rdname interpretive_rules +#' @export +clsi_rules <- function(x, + rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")), + ...) { + interpretive_rules(x = x, guideline = "CLSI", rules = rules, ...) +} + # helper function for editing the table ---- edit_sir <- function(x, to, @@ -1131,7 +1158,7 @@ edit_sir <- function(x, track_changes$sir_warn <- cols[!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.sir)] } isNA <- is.na(new_edits[rows, cols]) - isSIR <- !isNA & (new_edits[rows, cols] == "S" | new_edits[rows, cols] == "I" | new_edits[rows, cols] == "R" | new_edits[rows, cols] == "SDD" | new_edits[rows, cols] == "NI") + isSIR <- !isNA & (new_edits[rows, cols] == "S" | new_edits[rows, cols] == "I" | new_edits[rows, cols] == "R" | new_edits[rows, cols] == "SDD" | new_edits[rows, cols] == "NI" | new_edits[rows, cols] == "WT" | new_edits[rows, cols] == "NWT" | new_edits[rows, cols] == "NS") non_SIR <- !isSIR if (isFALSE(overwrite) && any(isSIR) && message_not_thrown_before("edit_sir.warning_overwrite")) { warning_("Some values had SIR values and were not overwritten, since `overwrite = FALSE`.") @@ -1230,7 +1257,7 @@ edit_sir <- function(x, return(track_changes) } -#' @rdname eucast_rules +#' @rdname interpretive_rules #' @export eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 15) { meet_criteria(ab, allow_class = c("character", "numeric", "integer", "factor")) diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index b8165e7b8..1ead34817 100755 --- a/R/key_antimicrobials.R +++ b/R/key_antimicrobials.R @@ -282,6 +282,9 @@ generate_antimicrobials_string <- function(df) { function(x) { x <- toupper(as.character(x)) x[x == "SDD"] <- "I" + x[x == "WT"] <- "S" + x[x == "NWT"] <- "R" + x[x == "NS"] <- "R" # ignore "NI" here, no use for determining first isolates x[!x %in% c("S", "I", "R")] <- "." paste(x) @@ -311,11 +314,7 @@ antimicrobials_equal <- function(y, key2sir <- function(val) { val <- strsplit(val, "", fixed = TRUE)[[1L]] - val.int <- rep(NA_real_, length(val)) - val.int[val == "S"] <- 1 - val.int[val %in% c("I", "SDD")] <- 2 - val.int[val == "R"] <- 3 - val.int + as.double(as.sir(val)) } # only run on uniques uniq <- unique(c(y, z)) diff --git a/R/mdro.R b/R/mdro.R index 09a075840..e583ddea4 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -777,7 +777,7 @@ mdro <- function(x = NULL, sum(vapply( FUN.VALUE = logical(1), group_tbl, - function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "SDD", "I", "R")) + function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% VALID_SIR_LEVELS[VALID_SIR_LEVELS != "NI"]) )) } ) diff --git a/R/mic.R b/R/mic.R index c0234fff8..229f86e85 100644 --- a/R/mic.R +++ b/R/mic.R @@ -63,6 +63,7 @@ COMMON_MIC_VALUES <- c( #' @param x A [character] or [numeric] vector. #' @param na.rm A [logical] indicating whether missing values should be removed. #' @param keep_operators A [character] specifying how to handle operators (such as `>` and `<=`) in the input. Accepts one of three values: `"all"` (or `TRUE`) to keep all operators, `"none"` (or `FALSE`) to remove all operators, or `"edges"` to keep operators only at both ends of the range. +#' @param round_to_next_log2 A [logical] to round up all values to the next log2 level, that are not either `r vector_or(COMMON_MIC_VALUES, quotes = F)`. Values that are already in this list (with or without operators), are left unchanged (including any operators). #' @param ... Arguments passed on to methods. #' @details To interpret MIC values as SIR values, use [as.sir()] on MIC values. It supports guidelines from EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`). #' @@ -157,10 +158,12 @@ COMMON_MIC_VALUES <- c( #' if (require("ggplot2")) { #' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch #' } -as.mic <- function(x, na.rm = FALSE, keep_operators = "all") { +as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2 = FALSE) { meet_criteria(x, allow_NA = TRUE) meet_criteria(na.rm, allow_class = "logical", has_length = 1) meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1) + meet_criteria(round_to_next_log2, allow_class = "logical", has_length = 1) + if (isTRUE(keep_operators)) { keep_operators <- "all" } else if (isFALSE(keep_operators)) { @@ -168,6 +171,9 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") { } if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) { + if (isTRUE(round_to_next_log2)) { + x <- roundup_to_nearest_log2(x) + } if (!identical(levels(x), VALID_MIC_LEVELS)) { # might be from an older AMR version - just update MIC factor levels x <- set_clean_class(factor(as.character(x), levels = VALID_MIC_LEVELS, ordered = TRUE), @@ -279,6 +285,10 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") { x[!x %in% keep] <- gsub("[>=<]", "", x[!x %in% keep]) } + if (isTRUE(round_to_next_log2)) { + x <- roundup_to_nearest_log2(x) + } + set_clean_class(factor(x, levels = VALID_MIC_LEVELS, ordered = TRUE), new_class = c("mic", "ordered", "factor") ) @@ -305,7 +315,7 @@ NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE) #' @rdname as.mic #' @param mic_range A manual range to rescale the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to prevent rescaling on one side, e.g., `mic_range = c(NA, 32)`. #' @export -rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) { +rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, round_to_next_log2 = FALSE) { meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical", "mic"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE) if (is.numeric(mic_range)) { mic_range <- trimws(format(mic_range, scientific = FALSE)) @@ -336,7 +346,7 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) { x[x > max_mic] <- max_mic } - x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators)) + x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators), round_to_next_log2 = round_to_next_log2) if (isTRUE(as.mic)) { if (keep_operators == "edges" && length(unique(x)) > 1) { @@ -605,6 +615,24 @@ get_skimmers.mic <- function(column) { ) } + +roundup_to_nearest_log2 <- function(x) { + x_dbl <- suppressWarnings(as.double(gsub("[>=<]", "", x))) + x_new <- vapply( + FUN.VALUE = double(1), + x_dbl, + function(val) { + if (is.na(val)) { + NA_real_ + } else { + COMMON_MIC_VALUES[which(COMMON_MIC_VALUES >= val)][1] + } + } + ) + x[!x_dbl %in% COMMON_MIC_VALUES] <- x_new[!x_dbl %in% COMMON_MIC_VALUES] + x +} + # Miscellaneous mathematical functions ------------------------------------ #' @method mean mic diff --git a/R/plotting.R b/R/plotting.R index 72b842860..479d4cd71 100755 --- a/R/plotting.R +++ b/R/plotting.R @@ -399,7 +399,12 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) { args, list( aesthetics = aesthetics, - values = c(colours_SIR, NI = "grey30") + values = c(colours_SIR, + NI = "grey30", + WT = unname(colours_SIR[1]), + NWT = unname(colours_SIR[4]), + NS = unname(colours_SIR[4]) + ) ) ) } @@ -424,6 +429,9 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) { x[x == "SI"] <- "(S/I) Susceptible" x[x == "IR"] <- "(I/R) Non-susceptible" x[x == "NI"] <- "(NI) Non-interpretable" + x[x == "WT"] <- "(WT) Wildtype" + x[x == "NWT"] <- "(NWT) Non-wildtype" + x[x == "NS"] <- "(NS) Non-susceptible" x <- translate_AMR(x, language = language) } x @@ -537,11 +545,16 @@ plot.mic <- function(x, meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4)) language <- validate_language(language) meet_criteria(expand, allow_class = "logical", has_length = 1) + meet_criteria(include_PKPD, allow_class = "logical", has_length = 1) + meet_criteria(breakpoint_type, allow_class = "character", is_in = AMR::clinical_breakpoints$type, has_length = 1) x <- as.mic(x) # make sure that currently implemented MIC levels are used main <- gsub(" +", " ", paste0(main, collapse = " ")) colours_SIR <- expand_SIR_colours(colours_SIR) + # wildtype/Non-wildtype + is_wt_nwt <- identical(breakpoint_type, "ECOFF") + x <- plotrange_as_table(x, expand = expand) cols_sub <- plot_colours_subtitle_guideline( x = x, @@ -572,10 +585,14 @@ plot.mic <- function(x, if (any(colours_SIR %in% cols_sub$cols)) { legend_txt <- character(0) legend_col <- character(0) - if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { + if (!is_wt_nwt & any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { legend_txt <- c(legend_txt, "(S) Susceptible") legend_col <- colours_SIR[1] } + if (is_wt_nwt & any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { + legend_txt <- c(legend_txt, "(WT) Wildtype") + legend_col <- colours_SIR[1] + } if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) { legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent") legend_col <- c(legend_col, colours_SIR[2]) @@ -584,10 +601,14 @@ plot.mic <- function(x, legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline))) legend_col <- c(legend_col, colours_SIR[3]) } - if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { + if (!is_wt_nwt & any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { legend_txt <- c(legend_txt, "(R) Resistant") legend_col <- c(legend_col, colours_SIR[4]) } + if (is_wt_nwt & any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { + legend_txt <- c(legend_txt, "(NWT) Non-wildtype") + legend_col <- c(legend_col, colours_SIR[4]) + } legend("top", x.intersp = 0.5, @@ -680,6 +701,8 @@ autoplot.mic <- function(object, meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4)) language <- validate_language(language) meet_criteria(expand, allow_class = "logical", has_length = 1) + meet_criteria(include_PKPD, allow_class = "logical", has_length = 1) + meet_criteria(breakpoint_type, allow_class = "character", is_in = AMR::clinical_breakpoints$type, has_length = 1) if ("main" %in% names(list(...))) { title <- list(...)$main @@ -690,6 +713,9 @@ autoplot.mic <- function(object, colours_SIR <- expand_SIR_colours(colours_SIR) + # wildtype/Non-wildtype + is_wt_nwt <- identical(breakpoint_type, "ECOFF") + object <- as.mic(object) # make sure that currently implemented MIC levels are used x <- plotrange_as_table(object, expand = expand) cols_sub <- plot_colours_subtitle_guideline( @@ -708,17 +734,21 @@ autoplot.mic <- function(object, df <- as.data.frame(x, stringsAsFactors = TRUE) colnames(df) <- c("mic", "count") df$cols <- cols_sub$cols - df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible" + df$cols[df$cols == colours_SIR[1] & !is_wt_nwt] <- "(S) Susceptible" + df$cols[df$cols == colours_SIR[1] & is_wt_nwt] <- "(WT) Wildtype" df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent" df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline)) - df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant" + df$cols[df$cols == colours_SIR[4] & !is_wt_nwt] <- "(R) Resistant" + df$cols[df$cols == colours_SIR[4] & is_wt_nwt] <- "(NWT) Non-wildtype" df$cols <- factor(translate_into_language(df$cols, language = language), levels = translate_into_language( c( "(S) Susceptible", "(SDD) Susceptible dose-dependent", paste("(I)", plot_name_of_I(cols_sub$guideline)), - "(R) Resistant" + "(R) Resistant", + "(WT) Wildtype", + "(NWT) Non-wildtype" ), language = language ), @@ -733,7 +763,9 @@ autoplot.mic <- function(object, "(I) Susceptible, incr. exp." = colours_SIR[3], "(I) Intermediate" = colours_SIR[3], "(R) Resistant" = colours_SIR[4], - "(NI) Non-interpretable" = "grey30" + "(NI) Non-interpretable" = "grey30", + "(WT) Wildtype" = colours_SIR[1], + "(NWT) Non-wildtype" = colours_SIR[4] ) names(vals) <- translate_into_language(names(vals), language = language) p <- p + @@ -797,10 +829,15 @@ plot.disk <- function(x, meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4)) language <- validate_language(language) meet_criteria(expand, allow_class = "logical", has_length = 1) + meet_criteria(include_PKPD, allow_class = "logical", has_length = 1) + meet_criteria(breakpoint_type, allow_class = "character", is_in = AMR::clinical_breakpoints$type, has_length = 1) main <- gsub(" +", " ", paste0(main, collapse = " ")) colours_SIR <- expand_SIR_colours(colours_SIR) + # wildtype/Non-wildtype + is_wt_nwt <- identical(breakpoint_type, "ECOFF") + x <- plotrange_as_table(x, expand = expand) cols_sub <- plot_colours_subtitle_guideline( x = x, @@ -832,10 +869,14 @@ plot.disk <- function(x, if (any(colours_SIR %in% cols_sub$cols)) { legend_txt <- character(0) legend_col <- character(0) - if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { + if (!is_wt_nwt & any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { legend_txt <- "(R) Resistant" legend_col <- colours_SIR[4] } + if (is_wt_nwt & any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) { + legend_txt <- "(NWT) Non-wildtype" + legend_col <- colours_SIR[4] + } if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) { legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline))) legend_col <- c(legend_col, colours_SIR[3]) @@ -844,10 +885,14 @@ plot.disk <- function(x, legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent") legend_col <- c(legend_col, colours_SIR[2]) } - if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { + if (!is_wt_nwt & any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { legend_txt <- c(legend_txt, "(S) Susceptible") legend_col <- c(legend_col, colours_SIR[1]) } + if (is_wt_nwt & any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) { + legend_txt <- c(legend_txt, "(WT) Wildtype") + legend_col <- c(legend_col, colours_SIR[1]) + } legend("top", x.intersp = 0.5, legend = translate_into_language(legend_txt, language = language), @@ -879,6 +924,8 @@ barplot.disk <- function(height, ), language = get_AMR_locale(), expand = TRUE, + include_PKPD = getOption("AMR_include_PKPD", TRUE), + breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...) { meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE) meet_criteria(ylab, allow_class = "character", has_length = 1) @@ -889,6 +936,8 @@ barplot.disk <- function(height, meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4)) language <- validate_language(language) meet_criteria(expand, allow_class = "logical", has_length = 1) + meet_criteria(include_PKPD, allow_class = "logical", has_length = 1) + meet_criteria(breakpoint_type, allow_class = "character", is_in = AMR::clinical_breakpoints$type, has_length = 1) main <- gsub(" +", " ", paste0(main, collapse = " ")) @@ -901,6 +950,10 @@ barplot.disk <- function(height, ab = ab, guideline = guideline, colours_SIR = colours_SIR, + language = language, + expand = expand, + include_PKPD = include_PKPD, + breakpoint_type = breakpoint_type, ... ) } @@ -947,6 +1000,9 @@ autoplot.disk <- function(object, colours_SIR <- expand_SIR_colours(colours_SIR) + # wildtype/Non-wildtype + is_wt_nwt <- identical(breakpoint_type, "ECOFF") + x <- plotrange_as_table(object, expand = expand) cols_sub <- plot_colours_subtitle_guideline( x = x, @@ -964,23 +1020,26 @@ autoplot.disk <- function(object, df <- as.data.frame(x, stringsAsFactors = TRUE) colnames(df) <- c("disk", "count") df$cols <- cols_sub$cols - df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible" + df$cols[df$cols == colours_SIR[1] & !is_wt_nwt] <- "(S) Susceptible" + df$cols[df$cols == colours_SIR[1] & is_wt_nwt] <- "(WT) Wildtype" df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent" df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline)) - df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant" + df$cols[df$cols == colours_SIR[4] & !is_wt_nwt] <- "(R) Resistant" + df$cols[df$cols == colours_SIR[4] & is_wt_nwt] <- "(NWT) Non-wildtype" df$cols <- factor(translate_into_language(df$cols, language = language), levels = translate_into_language( c( "(S) Susceptible", paste("(I)", plot_name_of_I(cols_sub$guideline)), - "(R) Resistant" + "(R) Resistant", + "(WT) Wildtype", + "(NWT) Non-wildtype" ), language = language ), ordered = TRUE ) p <- ggplot2::ggplot(df) - if (any(colours_SIR %in% cols_sub$cols)) { vals <- c( "(S) Susceptible" = colours_SIR[1], @@ -988,7 +1047,9 @@ autoplot.disk <- function(object, "(I) Susceptible, incr. exp." = colours_SIR[3], "(I) Intermediate" = colours_SIR[3], "(R) Resistant" = colours_SIR[4], - "(NI) Non-interpretable" = "grey30" + "(NI) Non-interpretable" = "grey30", + "(WT) Wildtype" = colours_SIR[1], + "(NWT) Non-wildtype" = colours_SIR[4] ) names(vals) <- translate_into_language(names(vals), language = language) p <- p + @@ -1036,25 +1097,25 @@ plot.sir <- function(x, data <- as.data.frame(table(x), stringsAsFactors = FALSE) colnames(data) <- c("x", "n") data$s <- round((data$n / sum(data$n)) * 100, 1) + data <- data[which(data$n > 0), ] - if (!"S" %in% data$x) { - data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE)) - } - if (!"SDD" %in% data$x) { - data <- rbind_AMR(data, data.frame(x = "SDD", n = 0, s = 0, stringsAsFactors = FALSE)) - } - if (!"I" %in% data$x) { - data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE)) - } - if (!"R" %in% data$x) { - data <- rbind_AMR(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE)) - } - if (!"NI" %in% data$x) { - data <- rbind_AMR(data, data.frame(x = "NI", n = 0, s = 0, stringsAsFactors = FALSE)) + if (!all(data$x %in% c("WT", "NWT"), na.rm = TRUE)) { + # # be sure to have at least S, I, and R + if (!"S" %in% data$x) { + data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE)) + } + if (!"I" %in% data$x) { + data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE)) + } + if (!"R" %in% data$x) { + data <- rbind_AMR(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE)) + } + lvls <- VALID_SIR_LEVELS[VALID_SIR_LEVELS %in% c(data$x, c("S", "I", "R"))] + } else { + lvls <- c("WT", "NWT") } - data <- data[!(data$n == 0 & data$x %in% c("SDD", "I", "NI")), , drop = FALSE] - data$x <- factor(data$x, levels = intersect(unique(data$x), c("S", "SDD", "I", "R", "NI")), ordered = TRUE) + data$x <- factor(data$x, levels = lvls, ordered = TRUE) ymax <- pm_if_else(max(data$s) > 95, 105, 100) @@ -1069,7 +1130,7 @@ plot.sir <- function(x, axes = FALSE ) # x axis - axis(side = 1, at = 1:pm_n_distinct(data$x), labels = levels(data$x), lwd = 0) + axis(side = 1, at = seq_along(lvls), labels = lvls, lwd = 0) # y axis, 0-100% axis(side = 2, at = seq(0, 100, 5)) @@ -1112,9 +1173,14 @@ barplot.sir <- function(height, main <- gsub(" +", " ", paste0(main, collapse = " ")) x <- table(height) - # remove missing I, SDD, and N - colours_SIR <- colours_SIR[!(names(x) %in% c("SDD", "I", "NI") & x == 0)] - x <- x[!(names(x) %in% c("SDD", "I", "NI") & x == 0)] + if (all(height %in% c("WT", "NWT"), na.rm = TRUE)) { + colours_SIR <- colours_SIR[c(1, 4)] + x <- x[names(x) %in% c("WT", "NWT")] + } else { + # remove missing I, SDD, and N + colours_SIR <- colours_SIR[!(names(x) %in% c("SDD", "I", "NI") & x == 0)] + x <- x[!(names(x) %in% c("SDD", "I", "NI") & x == 0)] + } # plot it barplot(x, col = colours_SIR, @@ -1160,6 +1226,11 @@ autoplot.sir <- function(object, df <- as.data.frame(table(object), stringsAsFactors = TRUE) colnames(df) <- c("x", "n") df <- df[!(df$n == 0 & df$x %in% c("SDD", "I", "NI")), , drop = FALSE] + if (all(object %in% c("WT", "NWT"), na.rm = TRUE)) { + df <- df[which(df$x %in% c("WT", "NWT")), ] + } else { + df <- df[which(!df$x %in% c("WT", "NWT", "NS")), ] + } ggplot2::ggplot(df) + ggplot2::geom_col(ggplot2::aes(x = x, y = n, fill = x)) + # limits = force is needed because of a ggplot2 >= 3.3.4 bug (#4511) @@ -1169,7 +1240,9 @@ autoplot.sir <- function(object, "SDD" = colours_SIR[2], "I" = colours_SIR[3], "R" = colours_SIR[4], - "NI" = "grey30" + "NI" = "grey30", + "WT" = colours_SIR[1], + "NWT" = colours_SIR[4] ), limits = force ) + @@ -1298,6 +1371,9 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f cols[sir == "I"] <- colours_SIR[3] cols[sir == "R"] <- colours_SIR[4] cols[sir == "NI"] <- "grey30" + cols[sir == "WT"] <- colours_SIR[1] + cols[sir == "NWT"] <- colours_SIR[4] + cols[sir == "NS"] <- colours_SIR[4] sub <- bquote(.(abname) ~ "-" ~ italic(.(moname)) ~ .(guideline_txt)) } else { cols <- "#BEBEBE" diff --git a/R/proportion.R b/R/proportion.R index ed811e297..40c37a24f 100644 --- a/R/proportion.R +++ b/R/proportion.R @@ -231,7 +231,7 @@ resistance <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = "R", + ab_result = c("R", "NWT", "NS"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, @@ -249,7 +249,7 @@ susceptibility <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("S", "SDD", "I"), + ab_result = c("S", "SDD", "I", "WT"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, @@ -269,7 +269,7 @@ sir_confidence_interval <- function(..., confidence_level = 0.95, side = "both", collapse = FALSE) { - meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1:5), is_in = c("S", "SDD", "I", "R", "NI")) + meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = seq_along(VALID_SIR_LEVELS), is_in = VALID_SIR_LEVELS) meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE) meet_criteria(as_percent, allow_class = "logical", has_length = 1) meet_criteria(only_all_tested, allow_class = "logical", has_length = 1) @@ -287,7 +287,7 @@ sir_confidence_interval <- function(..., ) n <- tryCatch( sir_calc(..., - ab_result = c("S", "SDD", "I", "R", "NI"), + ab_result = VALID_SIR_LEVELS, only_all_tested = only_all_tested, only_count = TRUE ), @@ -341,7 +341,7 @@ proportion_R <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = "R", + ab_result = c("R", "NWT", "NS"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, @@ -359,7 +359,7 @@ proportion_IR <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("I", "SDD", "R"), + ab_result = c("I", "SDD", "R", "NWT", "NS"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, @@ -395,7 +395,7 @@ proportion_SI <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = c("S", "I", "SDD"), + ab_result = c("S", "I", "SDD", "WT"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, @@ -413,7 +413,7 @@ proportion_S <- function(..., only_all_tested = FALSE) { tryCatch( sir_calc(..., - ab_result = "S", + ab_result = c("S", "WT"), minimum = minimum, as_percent = as_percent, only_all_tested = only_all_tested, diff --git a/R/sir.R b/R/sir.R index 1235b3cb8..8641794ab 100755 --- a/R/sir.R +++ b/R/sir.R @@ -27,6 +27,8 @@ # how to conduct AMR data analysis: https://amr-for-r.org # # ==================================================================== # +VALID_SIR_LEVELS <- c("S", "SDD", "I", "R", "NI", "WT", "NWT", "NS") + #' Interpret MIC and Disk Diffusion as SIR, or Clean Existing SIR Data #' #' @description Clean up existing SIR values, or interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI. [as.sir()] transforms the input to a new class [`sir`], which is an ordered [factor] containing the levels `S`, `SDD`, `I`, `R`, `NI`. @@ -58,6 +60,7 @@ #' * `>=` and `>` always return `"R"`, regardless of the breakpoint. #' #' The default `"conservative"` setting ensures cautious handling of uncertain values while preserving interpretability. This option can also be set with the package option [`AMR_capped_mic_handling`][AMR-options]. +#' @param as_wt_nwt A [logical] to return `"WT"`/`"NWT"` instead of `"S"`/`"R"`. Defaults to `TRUE` when using ECOFFs, i.e., when `breakpoint_type` is set to `"ECOFF"`. #' @param add_intrinsic_resistance *(only useful when using a EUCAST guideline)* a [logical] to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in *Klebsiella* species. Determination is based on the [intrinsic_resistant] data set, that itself is based on `r format_eucast_version_nr(3.3)`. #' @param substitute_missing_r_breakpoint A [logical] to indicate that a missing clinical breakpoints for R (resistant) must be substituted with R - the default is `FALSE`. Some (especially CLSI) breakpoints only have a breakpoint for S, meaning that the outcome can only be `"S"` or `NA`. Setting this to `TRUE` will convert the `NA`s in these cases to `"R"`. Can also be set with the package option [`AMR_substitute_missing_r_breakpoint`][AMR-options]. #' @param include_screening A [logical] to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`. Can also be set with the package option [`AMR_include_screening`][AMR-options]. @@ -398,7 +401,7 @@ as_sir_structure <- function(x, ref_breakpoints = NULL) { structure( factor(as.character(unlist(unname(x))), - levels = c("S", "SDD", "I", "R", "NI"), + levels = VALID_SIR_LEVELS, ordered = TRUE ), # TODO for #170 @@ -454,9 +457,9 @@ is_sir_eligible <- function(x, threshold = 0.05) { %in% class(x))) { # no transformation needed return(FALSE) - } else if (!all(is.na(x)) && all(x %in% c("S", "SDD", "I", "R", "NI", NA, "s", "sdd", "i", "r", "ni"))) { + } else if (!all(is.na(x)) && all(x %in% c(VALID_SIR_LEVELS, tolower(VALID_SIR_LEVELS), NA))) { return(TRUE) - } else if (!all(is.na(x)) && !any(c("S", "SDD", "I", "R", "NI") %in% gsub("([SIR])\\1+", "\\1", gsub("[^A-Z]", "", toupper(unique(x[1:10000])), perl = TRUE), perl = TRUE), na.rm = TRUE)) { + } else if (!all(is.na(x)) && !any(VALID_SIR_LEVELS %in% gsub("([SIR])\\1+", "\\1", gsub("[^A-Z]", "", toupper(unique(x[1:10000])), perl = TRUE), perl = TRUE), na.rm = TRUE)) { return(FALSE) } else { x <- x[!is.na(x) & !is.null(x) & !x %in% c("", "-", "NULL")] @@ -486,7 +489,7 @@ is_sir_eligible <- function(x, threshold = 0.05) { #' @rdname as.sir #' @export -#' @param S,I,R,NI,SDD A case-independent [regular expression][base::regex] to translate input to this result. This regular expression will be run *after* all non-letters and whitespaces are removed from the input. +#' @param S,I,R,NI,SDD,WT,NWT,NS A case-independent [regular expression][base::regex] to translate input to this result. This regular expression will be run *after* all non-letters and whitespaces are removed from the input. #' @param info A [logical] to print information about the process, defaults to `TRUE` only in [interactive sessions][base::interactive()]. # extra param: warn (logical, to never throw a warning) as.sir.default <- function(x, @@ -495,13 +498,19 @@ as.sir.default <- function(x, R = "^(R|3)+$", NI = "^(N|NI|V|4)+$", SDD = "^(SDD|D|H|5)+$", + WT = "^(WT|6)+$", + NWT = "^(NWT|7)+$", + NS = "^(NS|8)+$", info = interactive(), ...) { - meet_criteria(S, allow_class = c("character", "numeric", "integer"), has_length = 1) - meet_criteria(I, allow_class = c("character", "numeric", "integer"), has_length = 1) - meet_criteria(R, allow_class = c("character", "numeric", "integer"), has_length = 1) - meet_criteria(NI, allow_class = c("character", "numeric", "integer"), has_length = 1) - meet_criteria(SDD, allow_class = c("character", "numeric", "integer"), has_length = 1) + meet_criteria(S, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(I, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(R, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(NI, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(SDD, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(WT, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(NWT, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) + meet_criteria(NS, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1) meet_criteria(info, allow_class = "logical", has_length = 1) if (inherits(x, "sir")) { return(as_sir_structure(x)) @@ -516,7 +525,7 @@ as.sir.default <- function(x, x[x.bak == 1] <- names(lbls[lbls == 1]) x[x.bak == 2] <- names(lbls[lbls == 2]) x[x.bak == 3] <- names(lbls[lbls == 3]) - } else if (!all(is.na(x)) && !identical(levels(x), c("S", "SDD", "I", "R", "NI")) && !all(x %in% c("S", "SDD", "I", "R", "NI", NA))) { + } else if (!all(is.na(x)) && !identical(levels(x), VALID_SIR_LEVELS) && !all(x %in% c(VALID_SIR_LEVELS, NA))) { if (all(x %unlike% "(S|I|R)", na.rm = TRUE) && !all(x %in% c(1, 2, 3, 4, 5), na.rm = TRUE)) { # check if they are actually MICs or disks if (all_valid_mics(x)) { @@ -557,7 +566,7 @@ as.sir.default <- function(x, x[x %like% "not|non"] <- "NI" x[x %like% "([^a-z]|^)int(er(mediate)?)?|incr.*exp"] <- "I" x[x %like% "dose"] <- "SDD" - mtch <- grepl(paste0("(", S, "|", I, "|", R, "|", NI, "|", SDD, "|[A-Z]+)"), x, perl = TRUE) + mtch <- grepl(paste0("(", S, "|", I, "|", R, "|", NI, "|", SDD, "|", WT, "|", NWT, "|", NS, "|[A-Z]+)"), x, perl = TRUE) x[!mtch] <- "" # apply regexes set by user x[x %like% S] <- "S" @@ -565,22 +574,31 @@ as.sir.default <- function(x, x[x %like% R] <- "R" x[x %like% NI] <- "NI" x[x %like% SDD] <- "SDD" - x[!x %in% c("S", "SDD", "I", "R", "NI")] <- NA_character_ + x[x %like% WT] <- "WT" + x[x %like% NWT] <- "NWT" + x[x %like% NS] <- "NS" + x[!x %in% VALID_SIR_LEVELS] <- NA_character_ na_after <- length(x[is.na(x) | x == ""]) if (!isFALSE(list(...)$warn)) { # so as.sir(..., warn = FALSE) will never throw a warning - if (all(x.bak %in% c(1, 2, 3, 4, 5), na.rm = TRUE) && message_not_thrown_before("as.sir", "numeric_interpretation", x, x.bak)) { + if (all(x.bak %in% c(1:8), na.rm = TRUE) && message_not_thrown_before("as.sir", "numeric_interpretation", x, x.bak)) { out1 <- unique(x[x.bak == 1]) out2 <- unique(x[x.bak == 2]) out3 <- unique(x[x.bak == 3]) out4 <- unique(x[x.bak == 4]) out5 <- unique(x[x.bak == 5]) + out6 <- unique(x[x.bak == 6]) + out7 <- unique(x[x.bak == 7]) + out8 <- unique(x[x.bak == 8]) out <- c( ifelse(length(out1) > 0, paste0("1 as \"", out1, "\""), NA_character_), ifelse(length(out2) > 0, paste0("2 as \"", out2, "\""), NA_character_), ifelse(length(out3) > 0, paste0("3 as \"", out3, "\""), NA_character_), ifelse(length(out4) > 0, paste0("4 as \"", out4, "\""), NA_character_), - ifelse(length(out5) > 0, paste0("5 as \"", out5, "\""), NA_character_) + ifelse(length(out5) > 0, paste0("5 as \"", out5, "\""), NA_character_), + ifelse(length(out6) > 0, paste0("6 as \"", out6, "\""), NA_character_), + ifelse(length(out7) > 0, paste0("7 as \"", out7, "\""), NA_character_), + ifelse(length(out8) > 0, paste0("8 as \"", out8, "\""), NA_character_) ) message_("in `as.sir()`: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE)) } @@ -615,6 +633,7 @@ as.sir.mic <- function(x, guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"), + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE), @@ -636,6 +655,7 @@ as.sir.mic <- function(x, guideline = guideline, uti = uti, capped_mic_handling = capped_mic_handling, + as_wt_nwt = as_wt_nwt, add_intrinsic_resistance = add_intrinsic_resistance, reference_data = reference_data, substitute_missing_r_breakpoint = substitute_missing_r_breakpoint, @@ -658,6 +678,7 @@ as.sir.disk <- function(x, ab = deparse(substitute(x)), guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE), @@ -678,6 +699,7 @@ as.sir.disk <- function(x, guideline = guideline, uti = uti, capped_mic_handling = "standard", # will be ignored for non-MIC anyway + as_wt_nwt = as_wt_nwt, add_intrinsic_resistance = add_intrinsic_resistance, reference_data = reference_data, substitute_missing_r_breakpoint = substitute_missing_r_breakpoint, @@ -702,6 +724,7 @@ as.sir.data.frame <- function(x, guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"), + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", FALSE), @@ -720,6 +743,7 @@ as.sir.data.frame <- function(x, 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("none", "conservative", "standard", "lenient")) + meet_criteria(as_wt_nwt, allow_class = "logical", has_length = 1) meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1) meet_criteria(reference_data, allow_class = "data.frame") meet_criteria(substitute_missing_r_breakpoint, allow_class = "logical", has_length = 1) @@ -899,6 +923,7 @@ as.sir.data.frame <- function(x, guideline = guideline, uti = uti, capped_mic_handling = capped_mic_handling, + as_wt_nwt = as_wt_nwt, add_intrinsic_resistance = add_intrinsic_resistance, reference_data = reference_data, substitute_missing_r_breakpoint = substitute_missing_r_breakpoint, @@ -926,6 +951,7 @@ as.sir.data.frame <- function(x, ab = ab_col, guideline = guideline, uti = uti, + as_wt_nwt = as_wt_nwt, add_intrinsic_resistance = add_intrinsic_resistance, reference_data = reference_data, substitute_missing_r_breakpoint = substitute_missing_r_breakpoint, @@ -988,7 +1014,7 @@ as.sir.data.frame <- function(x, on.exit(parallel::stopCluster(cl), add = TRUE) parallel::clusterExport(cl, varlist = c( "x", "x.bak", "x_mo", "ab_cols", "types", - "capped_mic_handling", "add_intrinsic_resistance", + "capped_mic_handling", "as_wt_nwt", "add_intrinsic_resistance", "reference_data", "substitute_missing_r_breakpoint", "include_screening", "include_PKPD", "breakpoint_type", "guideline", "host", "uti", "info", "verbose", "col_mo", "AMR_env", "conserve_capped_values", @@ -1101,6 +1127,7 @@ as_sir_method <- function(method_short, guideline, uti, capped_mic_handling, + as_wt_nwt, add_intrinsic_resistance, reference_data, substitute_missing_r_breakpoint, @@ -1123,6 +1150,7 @@ as_sir_method <- function(method_short, 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("none", "conservative", "standard", "lenient"), .call_depth = -2) + meet_criteria(as_wt_nwt, allow_class = "logical", has_length = 1, .call_depth = -2) meet_criteria(add_intrinsic_resistance, allow_class = "logical", has_length = 1, .call_depth = -2) meet_criteria(reference_data, allow_class = "data.frame", .call_depth = -2) meet_criteria(substitute_missing_r_breakpoint, allow_class = "logical", has_length = 1, .call_depth = -2) @@ -1409,8 +1437,7 @@ as_sir_method <- function(method_short, 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 >= as.double(mic_val))][1] + log2_val <- COMMON_MIC_VALUES[which(COMMON_MIC_VALUES >= as.double(mic_val))][1] if (!is.na(log2_val) && as.double(mic_val) != log2_val) { if (message_not_thrown_before("as.sir", "CLSI", "MICupscaling")) { warning_("Some MICs were converted to the nearest higher log2 level, following the CLSI interpretation guideline.") @@ -1863,6 +1890,12 @@ as_sir_method <- function(method_short, ) } + # rewrite S/R to WT/NWT if needed + if (isTRUE(as_wt_nwt)) { + new_sir[new_sir == "S"] <- "WT" + new_sir[new_sir == "R"] <- "NWT" + } + # write to verbose output notes_current <- gsub("\n\n", "\n", trimws2(notes_current), fixed = TRUE) notes_current[notes_current == ""] <- NA_character_ @@ -1977,6 +2010,9 @@ pillar_shaft.sir <- function(x, ...) { out[x == "I"] <- font_orange_bg(" I ") out[x == "R"] <- font_rose_bg(" R ") out[x == "NI"] <- font_grey_bg(font_black(" NI ")) + out[x == "WT"] <- font_green_bg(font_black(" WT ")) + out[x == "NWT"] <- font_rose_bg(font_black(" NWT ")) + out[x == "NS"] <- font_rose_bg(font_black(" NS ")) } create_pillar_column(out, align = "left", width = 5) } @@ -2073,9 +2109,9 @@ print.sir <- function(x, ...) { #' @export as.double.sir <- function(x, ...) { dbls <- rep(NA_real_, length(x)) - dbls[x == "S"] <- 1 - dbls[x %in% c("SDD", "I")] <- 2 - dbls[x == "R"] <- 3 + dbls[x %in% c("S", "WT")] <- 1 + dbls[x %in% c("I", "SDD")] <- 2 + dbls[x %in% c("R", "NWT", "NS")] <- 3 dbls } diff --git a/R/sir_calc.R b/R/sir_calc.R index 511fa682c..b7a338001 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -41,7 +41,7 @@ sir_calc <- function(..., as_percent = FALSE, only_all_tested = FALSE, only_count = FALSE) { - meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1:5)) + meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = seq_along(VALID_SIR_LEVELS), is_in = VALID_SIR_LEVELS) meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE) meet_criteria(as_percent, allow_class = "logical", has_length = 1) meet_criteria(only_all_tested, allow_class = "logical", has_length = 1) @@ -117,6 +117,8 @@ sir_calc <- function(..., print_warning <- FALSE ab_result <- as.sir(ab_result) + denominator_vals <- levels(ab_result) + denominator_vals <- denominator_vals[denominator_vals != "NI"] if (is.data.frame(x)) { sir_integrity_check <- character(0) @@ -148,7 +150,7 @@ sir_calc <- function(..., 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) + other_values <- setdiff(c(NA, denominator_vals), 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) } @@ -165,7 +167,7 @@ sir_calc <- function(..., 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) + denominator <- sum(x %in% denominator_vals, na.rm = TRUE) } if (print_warning == TRUE) { @@ -259,13 +261,13 @@ sir_calc_df <- function(type, # "proportion", "count" or "both" for (i in seq_len(ncol(data))) { # transform SIR columns if (is.sir(data[, i, drop = TRUE])) { - data[, i] <- as.character(data[, i, drop = TRUE]) + data[, i] <- as.character(as.sir(data[, i, drop = TRUE])) + data[which(data[, i, drop = TRUE] %in% c("S", "SDD", "WT")), i] <- "S" + data[which(data[, i, drop = TRUE] %in% c("R", "NWT", "NS")), i] <- "R" if (isTRUE(combine_SI)) { - 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]) + data[which(data[, i, drop = TRUE] %in% c("I", "S")), i] <- "SI" } + data[which(!data[, i, drop = TRUE] %in% c("S", "SI", "I", "R")), i] <- NA_character_ } } diff --git a/R/sysdata.rda b/R/sysdata.rda index f77bac311..176087748 100755 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/translations.tsv b/data-raw/translations.tsv index 386eee206..ad6984703 100644 --- a/data-raw/translations.tsv +++ b/data-raw/translations.tsv @@ -1,8 +1,8 @@ pattern regular_expr case_sensitive affect_ab_name affect_mo_name en ar bn zh cs da nl fi fr de el hi id it ja ko no pl pt ro ru es sw sv tr uk ur vi language name English FALSE FALSE FALSE FALSE English Arabic Bengali Chinese Czech Danish Dutch Finnish French German Greek Hindi Indonesian Italian Japanese Korean Norwegian Polish Portuguese Romanian Russian Spanish Swahili Swedish Turkish Ukrainian Urdu Vietnamese language name FALSE FALSE FALSE FALSE English العربية ইংরেজি 汉语 Čeština Dansk Nederlands Suomi Français Deutsch Ελληνικά हिन्दी Inggris Italiano 日本語 영어 Norsk Polski Português Română Русский Español Kiswahili Svenska Türkçe Українська انگریزی Tiếng Anh -Coagulase-negative Staphylococcus TRUE TRUE FALSE TRUE Coagulase-negative Staphylococcus المكورات العنقودية سالبة التخثر কোয়াগুলেজ-নেগেটিভ স্ট্যাফিলোকক্কাস 凝固酶阴性葡萄球菌 Koaguláza-negativní stafylokok Koagulase-negative stafylokokker Coagulase-negatieve Staphylococcus Koagulaasinegatiivinen stafylokokki Staphylococcus à coagulase négative Koagulase-negative Staphylococcus Σταφυλόκοκκος με αρνητική πηκτικότητα कोएगुलेज़-ऩेगेटिव स्टैफिलोकोकस Stafilokokus koagulase-negatif Staphylococcus negativo coagulasi コアグラーゼ陰性ブドウ球菌 코아귤라제 음성 포도상구균 Koagulase-negative stafylokokker Staphylococcus koagulazoujemny Staphylococcus coagulase negativo Stafilococ coagulazo-negativ Коагулазоотрицательный стафилококк Staphylococcus coagulasa negativo Staphylococcus wasiokuwa na coagulase Koagulasnegativa stafylokocker Koagülaz-negatif Stafilokok Коагулазонегативний стафілокок کواگولیز منفی اسٹیفیلوکوکس Staphylococcus âm tính với coagulase -Coagulase-positive Staphylococcus TRUE TRUE FALSE TRUE Coagulase-positive Staphylococcus المكورات العنقودية موجبة التخثر কোয়াগুলেজ-পজিটিভ স্ট্যাফিলোকক্কাস 凝固酶阳性葡萄球菌 Koagulázopozitivní stafylokok Koagulase-positive stafylokokker Coagulase-positieve Staphylococcus Koagulaasipositiivinen stafylokokki Staphylococcus à coagulase positif Koagulase-positive Staphylococcus Σταφυλόκοκκος θετικός στην πήξη कोएगुलेज़-पॉज़िटिव स्टैफिलोकोकस Stafilokokus koagulase-positif Staphylococcus positivo coagulasi コアグラーゼ陽性ブドウ球菌 코아귤라제 양성 포도상구균 Koagulase-positive stafylokokker Staphylococcus koagulazo-dodatni Staphylococcus coagulase positivo Stafilococul coagulazo-pozitiv Коагулазоположительный стафилококк Staphylococcus coagulasa positivo Staphylococcus wenye coagulase Koagulaspositiva stafylokocker Koagülaz-pozitif Stafilokok Коагулазопозитивний стафілокок کواگولیز مثبت اسٹیفیلوکوکس Staphylococcus dương tính với coagulase +Coagulase-negative Staphylococcus TRUE TRUE FALSE TRUE Coagulase-negative Staphylococcus المكورات العنقودية سالبة التخثر কোয়াগুলেজ-নেগেটিভ স্ট্যাফিলোকক্কাস 凝固酶阴性葡萄球菌 Koaguláza-negativní stafylokok Koagulase-negative stafylokokker Coagulase-negatieve Staphylococcus Koagulaasinegatiivinen stafylokokki Staphylococcus à coagulase négative Koagulase-negative Staphylococcus Σταφυλόκοκκος με αρνητική πηκτικότητα कोएगुलेज़-ऩेगेटिव स्टैफिलोकोकस Stafilokokus koagulase-negatif Stafilococco coagulasi-negativo コアグラーゼ陰性ブドウ球菌 코아귤라제 음성 포도상구균 Koagulase-negative stafylokokker Staphylococcus koagulazoujemny Staphylococcus coagulase negativo Stafilococ coagulazo-negativ Коагулазоотрицательный стафилококк Staphylococcus coagulasa negativo Staphylococcus wasiokuwa na coagulase Koagulasnegativa stafylokocker Koagülaz-negatif Stafilokok Коагулазонегативний стафілокок کواگولیز منفی اسٹیفیلوکوکس Staphylococcus âm tính với coagulase +Coagulase-positive Staphylococcus TRUE TRUE FALSE TRUE Coagulase-positive Staphylococcus المكورات العنقودية موجبة التخثر কোয়াগুলেজ-পজিটিভ স্ট্যাফিলোকক্কাস 凝固酶阳性葡萄球菌 Koagulázopozitivní stafylokok Koagulase-positive stafylokokker Coagulase-positieve Staphylococcus Koagulaasipositiivinen stafylokokki Staphylococcus à coagulase positif Koagulase-positive Staphylococcus Σταφυλόκοκκος θετικός στην πήξη कोएगुलेज़-पॉज़िटिव स्टैफिलोकोकस Stafilokokus koagulase-positif Stafilococco coagulasi-positivo コアグラーゼ陽性ブドウ球菌 코아귤라제 양성 포도상구균 Koagulase-positive stafylokokker Staphylococcus koagulazo-dodatni Staphylococcus coagulase positivo Stafilococul coagulazo-pozitiv Коагулазоположительный стафилококк Staphylococcus coagulasa positivo Staphylococcus wenye coagulase Koagulaspositiva stafylokocker Koagülaz-pozitif Stafilokok Коагулазопозитивний стафілокок کواگولیز مثبت اسٹیفیلوکوکس Staphylococcus dương tính với coagulase Beta-haemolytic Streptococcus TRUE TRUE FALSE TRUE Beta-haemolytic Streptococcus العقديات الحالة للدم من النوع بيتا বিটা-হেমোলাইটিক স্ট্রেপটোকক্কাস β-溶血性链球菌 Beta-hemolytický streptokok Beta-haemolytiske streptokokker Beta-hemolytische Streptococcus Beeta-hemolyyttinen streptokokki Streptococcus Bêta-hémolytique Beta-hämolytischer Streptococcus Β-αιμολυτικός στρεπτόκοκκος बीटा-हीमोलिटिक स्ट्रेप्टोकोकस Streptokokus beta-hemolitik Streptococcus Beta-emolitico ベータ溶血性レンサ球菌 베타 용혈성 연쇄상구균 Beta-hemolytiske streptokokker Streptococcus beta-hemolityczny Streptococcus Beta-hemolítico Streptococ beta-hemolitic Бета-гемолитический стрептококк Streptococcus Beta-hemolítico Streptococcus wa beta-hemolitiki Beta-hemolytiska streptokocker Beta-hemolitik Streptokok Бета-гемолітичний стрептокок بیٹا ہیمولائٹک اسٹریپٹوکوکس Streptococcus tan máu beta unknown Gram-negatives TRUE TRUE FALSE TRUE unknown Gram-negatives سالبة الجرام غير معروفة অজানা গ্রাম-নেগেটিভ 不明革兰氏阴性菌 neznámé gramnegativní ukendte Gram-negative onbekende Gram-negatieven tuntemattomat gramnegatiiviset Gram négatifs inconnus unbekannte Gramnegativen άγνωστοι αρνητικοί κατά Gram अज्ञात ग्राम-ऩेगेटिव्स Gram negatif tidak diketahui Gram negativi sconosciuti 不明なグラム陰性菌 알 수 없는 그람 음성균 ukjent Gram-negative Nieznane bakterie Gram-ujemne Gram negativos desconhecidos Gram-negative necunoscute неизвестные грамотрицательные Gram negativos desconocidos Gram hasi wasiojulikana okända gramnegativa bakterier bilinmeyen Gram-negatifler невідомі грамнегативні نامعلوم گرام منفی Gram âm chưa xác định unknown Gram-positives TRUE TRUE FALSE TRUE unknown Gram-positives موجبة الجرام غير معروفة অজানা গ্রাম-পজিটিভ 不明革兰氏阳性菌 neznámé grampozitivní ukendte Gram-positive onbekende Gram-positieven tuntemattomat grampositiiviset Gram positifs inconnus unbekannte Grampositiven άγνωστοι θετικοί κατά Gram अज्ञात ग्राम-पॉज़िटिव्स Gram positif tidak diketahui Gram positivi sconosciuti 未知のグラム陽性菌 알 수 없는 그람 양성균 ukjent Gram-positive Nieznane bakterie Gram-dodatnie Gram positivos desconhecidos Gram-pozitive necunoscute неизвестные грамположительные Gram positivos desconocidos Gram chanya wasiojulikana okända Gram-positiva bilinmeyen Gram-pozitifler невідомі грампозитивні نامعلوم گرام مثبت Gram dương chưa xác định diff --git a/index.md b/index.md index 07bd5026f..523723c56 100644 --- a/index.md +++ b/index.md @@ -259,10 +259,10 @@ antibiogram(example_isolates, language = "uk") # Ukrainian ``` -| Збудник | Ciprofloxacin | Гентаміцин | Тобраміцин | -|:--------------|:-------------------|:--------------------|:-------------------| -| Gram-negative | 91% (88-93%,N=684) | 96% (95-98%,N=684) | 96% (94-97%,N=686) | -| Gram-positive | 77% (74-80%,N=724) | 63% (60-66%,N=1170) | 34% (31-38%,N=665) | +| Збудник | Гентаміцин | Тобраміцин | Ципрофлоксацин | +|:--------------|:--------------------|:-------------------|:-------------------| +| Грамнегативні | 96% (95-98%,N=684) | 96% (94-97%,N=686) | 91% (88-93%,N=684) | +| Грампозитивні | 63% (60-66%,N=1170) | 34% (31-38%,N=665) | 77% (74-80%,N=724) | ### Interpreting and plotting MIC and SIR values diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index 431e8e514..de84c48b8 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -72,7 +72,7 @@ retrieve_wisca_parameters(wisca_model, ...) \item{ab_transform}{A character to transform antimicrobial input - must be one of the column names of the \link{antimicrobials} data set (defaults to \code{"name"}): "ab", "cid", "name", "group", "atc", "atc_group1", "atc_group2", "abbreviations", "synonyms", "oral_ddd", "oral_units", "iv_ddd", "iv_units", or "loinc". Can also be \code{NULL} to not transform the input.} -\item{syndromic_group}{A column name of \code{x}, or values calculated to split rows of \code{x}, e.g. by using \code{\link[=ifelse]{ifelse()}} or \code{\link[dplyr:case_when]{case_when()}}. See \emph{Examples}.} +\item{syndromic_group}{A column name of \code{x}, or values calculated to split rows of \code{x}, e.g. by using \code{\link[=ifelse]{ifelse()}} or \code{\link[dplyr:case-and-replace-when]{case_when()}}. See \emph{Examples}.} \item{add_total_n}{\emph{(deprecated in favour of \code{formatting_type})} A \link{logical} to indicate whether \code{n_tested} available numbers per pathogen should be added to the table (default is \code{TRUE}). This will add the lowest and highest number of available isolates per antimicrobial (e.g, if for \emph{E. coli} 200 isolates are available for ciprofloxacin and 150 for amoxicillin, the returned number will be "150-200"). This option is unavailable when \code{wisca = TRUE}; in that case, use \code{\link[=retrieve_wisca_parameters]{retrieve_wisca_parameters()}} to get the parameters used for WISCA.} diff --git a/man/as.mic.Rd b/man/as.mic.Rd index 70cb78363..24ec910c7 100644 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -12,13 +12,15 @@ \alias{droplevels.mic} \title{Transform Input to Minimum Inhibitory Concentrations (MIC)} \usage{ -as.mic(x, na.rm = FALSE, keep_operators = "all") +as.mic(x, na.rm = FALSE, keep_operators = "all", + round_to_next_log2 = FALSE) is.mic(x) NA_mic_ -rescale_mic(x, mic_range, keep_operators = "edges", as.mic = TRUE) +rescale_mic(x, mic_range, keep_operators = "edges", as.mic = TRUE, + round_to_next_log2 = FALSE) mic_p50(x, na.rm = FALSE, ...) @@ -33,6 +35,8 @@ mic_p90(x, na.rm = FALSE, ...) \item{keep_operators}{A \link{character} specifying how to handle operators (such as \code{>} and \code{<=}) in the input. Accepts one of three values: \code{"all"} (or \code{TRUE}) to keep all operators, \code{"none"} (or \code{FALSE}) to remove all operators, or \code{"edges"} to keep operators only at both ends of the range.} +\item{round_to_next_log2}{A \link{logical} to round up all values to the next log2 level, that are not either 0.0001, 0.0002, 0.0005, 0.001, 0.002, 0.004, 0.008, 0.016, 0.032, 0.064, 0.125, 0.25, 0.5, 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, or 4096. Values that are already in this list (with or without operators), are left unchanged (including any operators).} + \item{mic_range}{A manual range to rescale the MIC values, e.g., \code{mic_range = c(0.001, 32)}. Use \code{NA} to prevent rescaling on one side, e.g., \code{mic_range = c(NA, 32)}.} \item{as.mic}{A \link{logical} to indicate whether the \code{mic} class should be kept - the default is \code{TRUE} for \code{\link[=rescale_mic]{rescale_mic()}} and \code{FALSE} for \code{\link[=droplevels]{droplevels()}}. When setting this to \code{FALSE} in \code{\link[=rescale_mic]{rescale_mic()}}, the output will have factor levels that acknowledge \code{mic_range}.} diff --git a/man/as.sir.Rd b/man/as.sir.Rd index eed7a5661..279038b15 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -34,11 +34,13 @@ is_sir_eligible(x, threshold = 0.05) \method{as.sir}{default}(x, S = "^(S|U|1)+$", I = "^(I|2)+$", R = "^(R|3)+$", NI = "^(N|NI|V|4)+$", SDD = "^(SDD|D|H|5)+$", + WT = "^(WT|6)+$", NWT = "^(NWT|7)+$", NS = "^(NS|8)+$", info = interactive(), ...) \method{as.sir}{mic}(x, mo = NULL, ab = deparse(substitute(x)), guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"), + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", @@ -50,6 +52,7 @@ is_sir_eligible(x, threshold = 0.05) \method{as.sir}{disk}(x, mo = NULL, ab = deparse(substitute(x)), guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", @@ -62,6 +65,7 @@ is_sir_eligible(x, threshold = 0.05) \method{as.sir}{data.frame}(x, ..., col_mo = NULL, guideline = getOption("AMR_guideline", "EUCAST"), uti = NULL, capped_mic_handling = getOption("AMR_capped_mic_handling", "standard"), + as_wt_nwt = identical(breakpoint_type, "ECOFF"), add_intrinsic_resistance = FALSE, reference_data = AMR::clinical_breakpoints, substitute_missing_r_breakpoint = getOption("AMR_substitute_missing_r_breakpoint", @@ -82,7 +86,7 @@ Otherwise: arguments passed on to methods.} \item{threshold}{Maximum fraction of invalid antimicrobial interpretations of \code{x}, see \emph{Examples}.} -\item{S, I, R, NI, SDD}{A case-independent \link[base:regex]{regular expression} to translate input to this result. This regular expression will be run \emph{after} all non-letters and whitespaces are removed from the input.} +\item{S, I, R, NI, SDD, WT, NWT, NS}{A case-independent \link[base:regex]{regular expression} to translate input to this result. This regular expression will be run \emph{after} all non-letters and whitespaces are removed from the input.} \item{info}{A \link{logical} to print information about the process, defaults to \code{TRUE} only in \link[base:interactive]{interactive sessions}.} @@ -122,6 +126,8 @@ Otherwise: arguments passed on to methods.} The default \code{"conservative"} setting ensures cautious handling of uncertain values while preserving interpretability. This option can also be set with the package option \code{\link[=AMR-options]{AMR_capped_mic_handling}}.} +\item{as_wt_nwt}{A \link{logical} to return \code{"WT"}/\code{"NWT"} instead of \code{"S"}/\code{"R"}. Defaults to \code{TRUE} when using ECOFFs, i.e., when \code{breakpoint_type} is set to \code{"ECOFF"}.} + \item{add_intrinsic_resistance}{\emph{(only useful when using a EUCAST guideline)} a \link{logical} to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in \emph{Klebsiella} species. Determination is based on the \link{intrinsic_resistant} data set, that itself is based on \href{https://www.eucast.org/bacteria/important-additional-information/expert-rules/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).} \item{reference_data}{A \link{data.frame} to be used for interpretation, which defaults to the \link{clinical_breakpoints} data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the \link{clinical_breakpoints} data set (same column names and column types). Please note that the \code{guideline} argument will be ignored when \code{reference_data} is manually set.} diff --git a/man/bug_drug_combinations.Rd b/man/bug_drug_combinations.Rd index 6311ad509..592cff5e3 100644 --- a/man/bug_drug_combinations.Rd +++ b/man/bug_drug_combinations.Rd @@ -45,7 +45,7 @@ bug_drug_combinations(x, col_mo = NULL, FUN = mo_shortname, decimal point.} } \value{ -The function \code{\link[=bug_drug_combinations]{bug_drug_combinations()}} returns a \link{data.frame} with columns "mo", "ab", "S", "SDD", "I", "R", and "total". +The function \code{\link[=bug_drug_combinations]{bug_drug_combinations()}} returns a \link{data.frame} with columns "mo", "ab", "S", "SDD", "I", "R", "WT, "NWT", and "total". } \description{ Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use \code{\link[=format]{format()}} on the result to prettify it to a publishable/printable format, see \emph{Examples}. diff --git a/man/custom_eucast_rules.Rd b/man/custom_eucast_rules.Rd index cda94e12c..9dcede9ee 100644 --- a/man/custom_eucast_rules.Rd +++ b/man/custom_eucast_rules.Rd @@ -19,7 +19,7 @@ Define custom EUCAST rules for your organisation or specific analysis and use th Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the \code{\link[=eucast_rules]{eucast_rules()}} function. \subsection{Basics}{ -If you are familiar with the \code{\link[dplyr:case_when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde: +If you are familiar with the \code{\link[dplyr:case-and-replace-when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde: \if{html}{\out{
}}\preformatted{x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S", TZP == "R" ~ aminopenicillins == "R") diff --git a/man/custom_mdro_guideline.Rd b/man/custom_mdro_guideline.Rd index 56d17ef5a..73062da36 100644 --- a/man/custom_mdro_guideline.Rd +++ b/man/custom_mdro_guideline.Rd @@ -26,7 +26,7 @@ Define custom a MDRO guideline for your organisation or specific analysis and us Using a custom MDRO guideline is of importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data. \subsection{Basics}{ -If you are familiar with the \code{\link[dplyr:case_when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde: +If you are familiar with the \code{\link[dplyr:case-and-replace-when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde: \if{html}{\out{
}}\preformatted{custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A", ERY == "R" & age > 60 ~ "Elderly Type B") diff --git a/man/dosage.Rd b/man/dosage.Rd index 863d98a81..491d62d23 100644 --- a/man/dosage.Rd +++ b/man/dosage.Rd @@ -12,7 +12,7 @@ A \link[tibble:tibble]{tibble} with 759 observations and 9 variables: \item \code{type}\cr Type of the dosage, either "high_dosage", "standard_dosage", or "uncomplicated_uti" \item \code{dose}\cr Dose, such as "2 g" or "25 mg/kg" \item \code{dose_times}\cr Number of times a dose must be administered -\item \code{administration}\cr Route of administration, either "", "im", "iv", or "oral" +\item \code{administration}\cr Route of administration, either "", "im", "iv", "oral", or NA \item \code{notes}\cr Additional dosage notes \item \code{original_txt}\cr Original text in the PDF file of EUCAST \item \code{eucast_version}\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply, either 15, 14, 13.1, 12, or 11 diff --git a/man/eucast_rules.Rd b/man/interpretive_rules.Rd similarity index 85% rename from man/eucast_rules.Rd rename to man/interpretive_rules.Rd index 051d4af2b..cbeda0052 100644 --- a/man/eucast_rules.Rd +++ b/man/interpretive_rules.Rd @@ -1,10 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/eucast_rules.R -\name{eucast_rules} -\alias{eucast_rules} +% Please edit documentation in R/interpretive_rules.R +\name{interpretive_rules} +\alias{interpretive_rules} \alias{EUCAST} +\alias{eucast_rules} +\alias{clsi_rules} \alias{eucast_dosage} -\title{Apply EUCAST Rules} +\title{Apply Interpretive Rules} \source{ \itemize{ \item EUCAST Expert Rules. Version 2.0, 2012.\cr @@ -19,13 +21,20 @@ Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility test } } \usage{ -eucast_rules(x, col_mo = NULL, info = interactive(), - rules = getOption("AMR_eucastrules", default = c("breakpoints", +interpretive_rules(x, col_mo = NULL, guideline = getOption("AMR_guideline", + "EUCAST"), info = interactive(), + rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")), verbose = FALSE, version_breakpoints = 15, version_expected_phenotypes = 1.2, version_expertrules = 3.3, ampc_cephalosporin_resistance = NA, only_sir_columns = any(is.sir(x)), custom_rules = NULL, overwrite = FALSE, ...) +eucast_rules(x, rules = getOption("AMR_interpretive_rules", default = + c("breakpoints", "expected_phenotypes")), ...) + +clsi_rules(x, rules = getOption("AMR_interpretive_rules", default = + c("breakpoints", "expected_phenotypes")), ...) + eucast_dosage(ab, administration = "iv", version_breakpoints = 15) } \arguments{ @@ -33,9 +42,11 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15) \item{col_mo}{Column name of the names or codes of the microorganisms (see \code{\link[=as.mo]{as.mo()}}) - the default is the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.} +\item{guideline}{A guideline name, either "EUCAST" (default) or "CLSI". This can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}.} + \item{info}{A \link{logical} to indicate whether progress should be printed to the console - the default is only print while in interactive sessions.} -\item{rules}{A \link{character} vector that specifies which rules should be applied. Must be one or more of \code{"breakpoints"}, \code{"expected_phenotypes"}, \code{"expert"}, \code{"other"}, \code{"custom"}, \code{"all"}, and defaults to \code{c("breakpoints", "expected_phenotypes")}. The default value can be set to another value using the package option \code{\link[=AMR-options]{AMR_eucastrules}}: \code{options(AMR_eucastrules = "all")}. If using \code{"custom"}, be sure to fill in argument \code{custom_rules} too. Custom rules can be created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}.} +\item{rules}{A \link{character} vector that specifies which rules should be applied. Must be one or more of \code{"breakpoints"}, \code{"expected_phenotypes"}, \code{"expert"}, \code{"other"}, \code{"custom"}, \code{"all"}, and defaults to \code{c("breakpoints", "expected_phenotypes")}. The default value can be set to another value using the package option \code{\link[=AMR-options]{AMR_interpretive_rules}}: \code{options(AMR_interpretive_rules = "all")}. If using \code{"custom"}, be sure to fill in argument \code{custom_rules} too. Custom rules can be created with \code{\link[=custom_eucast_rules]{custom_eucast_rules()}}.} \item{verbose}{A \link{logical} to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.} @@ -57,15 +68,19 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15) \item{ab}{Any (vector of) text that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.} -\item{administration}{Route of administration, either "", "im", "iv", or "oral".} +\item{administration}{Route of administration, either "", "im", "iv", "oral", or NA.} } \value{ The input of \code{x}, possibly with edited values of antimicrobials. Or, if \code{verbose = TRUE}, a \link{data.frame} with all original and new values of the affected bug-drug combinations. } \description{ -Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{https://www.eucast.org}), see \emph{Source}. Use \code{\link[=eucast_dosage]{eucast_dosage()}} to get a \link{data.frame} with advised dosages of a certain bug-drug combination, which is based on the \link{dosage} data set. +\strong{WORK IN PROGRESS} -To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see \emph{Details}. +\strong{The \code{interpretive_rules()} function is new, to allow CLSI 'rules' too. The old \code{eucast_rules()} function will stay as a wrapper, but we need to generalise more parts of the underlying code to allow more than just EUCAST.} + +Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by e.g. the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{https://www.eucast.org}), see \emph{Source}. Use \code{\link[=eucast_dosage]{eucast_dosage()}} to get a \link{data.frame} with advised dosages of a certain bug-drug combination, which is based on the \link{dosage} data set. + +To improve the interpretation of the antibiogram before CLSI/EUCAST interpretive rules are applied, some AMR-specific rules can be applied at default, see \emph{Details}. } \details{ \strong{Note:} This function does not translate MIC values to SIR values. Use \code{\link[=as.sir]{as.sir()}} for that. \cr @@ -93,7 +108,7 @@ Before further processing, two non-EUCAST rules about drug combinations can be a Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set. -Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include \code{"other"} to the \code{rules} argument, or use \code{eucast_rules(..., rules = "all")}. You can also set the package option \code{\link[=AMR-options]{AMR_eucastrules}}, i.e. run \code{options(AMR_eucastrules = "all")}. +Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include \code{"other"} to the \code{rules} argument, or use \code{eucast_rules(..., rules = "all")}. You can also set the package option \code{\link[=AMR-options]{AMR_interpretive_rules}}, i.e. run \code{options(AMR_interpretive_rules = "all")}. } } \section{Download Our Reference Data}{ diff --git a/man/microorganisms.Rd b/man/microorganisms.Rd index 596a9aede..07028388f 100644 --- a/man/microorganisms.Rd +++ b/man/microorganisms.Rd @@ -13,7 +13,7 @@ A \link[tibble:tibble]{tibble} with 78 679 observations and 26 variables: \item \code{kingdom}, \code{phylum}, \code{class}, \code{order}, \code{family}, \code{genus}, \code{species}, \code{subspecies}\cr Taxonomic rank of the microorganism. Note that for fungi, \emph{phylum} is equal to their taxonomic \emph{division}. Also, for fungi, \emph{subkingdom} and \emph{subdivision} were left out since they do not occur in the bacterial taxonomy. \item \code{rank}\cr Text of the taxonomic rank of the microorganism, such as \code{"species"} or \code{"genus"} \item \code{ref}\cr Author(s) and year of related scientific publication. This contains only the \emph{first surname} and year of the \emph{latest} authors, e.g. "Wallis \emph{et al.} 2006 \emph{emend.} Smith and Jones 2018" becomes "Smith \emph{et al.}, 2018". This field is directly retrieved from the source specified in the column \code{source}. Moreover, accents were removed to comply with CRAN that only allows ASCII characters. -\item \code{oxygen_tolerance} \cr Oxygen tolerance, either "aerobe", "anaerobe", "anaerobe/microaerophile", "facultative anaerobe", "likely facultative anaerobe", or "microaerophile". These data were retrieved from BacDive (see \emph{Source}). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently 68.3\% of all ~39 000 bacteria in the data set contain an oxygen tolerance. +\item \code{oxygen_tolerance} \cr Oxygen tolerance, either "aerobe", "anaerobe", "anaerobe/microaerophile", "facultative anaerobe", "likely facultative anaerobe", "microaerophile", or NA. These data were retrieved from BacDive (see \emph{Source}). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently 68.3\% of all ~39 000 bacteria in the data set contain an oxygen tolerance. \item \code{source}\cr Either "GBIF", "LPSN", "Manually added", "MycoBank", or "manually added" (see \emph{Source}) \item \code{lpsn}\cr Identifier ('Record number') of List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, \emph{Acetobacter ascendens} has LPSN Record number 7864 and 11011. Only the first is available in the \code{microorganisms} data set. \emph{\strong{This is a unique identifier}}, though available for only ~33 000 records. \item \code{lpsn_parent}\cr LPSN identifier of the parent taxon diff --git a/man/plot.Rd b/man/plot.Rd index 78dd00aba..05ce6e4b4 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -181,7 +181,7 @@ When manually added though, they allow to rescale the MIC range with an 'inside' \subsection{The \verb{scale_*_sir()} Functions}{ -The functions \code{\link[=scale_x_sir]{scale_x_sir()}}, \code{\link[=scale_colour_sir]{scale_colour_sir()}}, and \code{\link[=scale_fill_sir]{scale_fill_sir()}} functions allow to plot the \link[=as.sir]{sir} class in the right order (S < SDD < I < R < NI). +The functions \code{\link[=scale_x_sir]{scale_x_sir()}}, \code{\link[=scale_colour_sir]{scale_colour_sir()}}, and \code{\link[=scale_fill_sir]{scale_fill_sir()}} functions allow to plot the \link[=as.sir]{sir} class in the right order (S < SDD < I < R < NI < WT < NWT < NS). There is normally no need to add these scale functions to your plot, as they are applied automatically when plotting values of class \link[=as.sir]{sir}.