(v3.0.1.9019) Wildtype/Non-wildtype support, and start with interpretive_rules()

Fixes #246
Fixes #254
Fixes #255
Fixes #256

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.0.1.9018
+Version: 3.0.1.9019
-Date: 2026-01-16
+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

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)

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)

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 = ", "),
+    paste(quoted[seq_len(length(quoted) - 1)], collapse = ", "),
-    last_sep, paste0(quotes, v[length(v)], quotes)
+    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)

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")

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")
+          S_values <- c(S_values, "SDD", "I")
-        } else {
-          S_values <- "S"
         }
-        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
+    out$n_susceptible <- out$n_susceptible + out$I + out$SDD
-  } else {
-    out$n_susceptible <- out$S
   }
   if (all(out$n_tested < minimum, na.rm = TRUE) && wisca == FALSE) {
     warning_("All combinations had less than `minimum = ", minimum, "` results, returning an empty antibiogram")

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,
+        WT = merged$WT,
-        total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$na,
+        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
+    x$isolates <- x$isolates + x$I + x$SDD
-  } else {
-    x$isolates <- x$R + x$I + x$SDD
   }
 
   give_ab_name <- function(ab, format, language) {

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
     ),

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),
+      result_value %in% c(VALID_SIR_LEVELS, NA),
-      "the resulting value of rule ", i, " must be either \"S\", \"SDD\", \"I\", \"R\", \"NI\" or 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)
 

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) {

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, <https://www.eucast.org>), 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, <https://www.eucast.org>), 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,
+interpretive_rules <- function(x,
-                         col_mo = NULL,
+                               col_mo = NULL,
-                         info = interactive(),
+                               guideline = getOption("AMR_guideline", "EUCAST"),
-                         rules = getOption("AMR_eucastrules", default = c("breakpoints", "expected_phenotypes")),
+                               info = interactive(),
-                         verbose = FALSE,
+                               rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")),
-                         version_breakpoints = 15.0,
+                               verbose = FALSE,
-                         version_expected_phenotypes = 1.2,
+                               version_breakpoints = 15.0,
-                         version_expertrules = 3.3,
+                               version_expected_phenotypes = 1.2,
-                         ampc_cephalosporin_resistance = NA,
+                               version_expertrules = 3.3,
-                         only_sir_columns = any(is.sir(x)),
+                               ampc_cephalosporin_resistance = NA,
-                         custom_rules = NULL,
+                               only_sir_columns = any(is.sir(x)),
-                         overwrite = FALSE,
+                               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"))

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))
+    as.double(as.sir(val))
-    val.int[val == "S"] <- 1
-    val.int[val %in% c("I", "SDD")] <- 2
-    val.int[val == "R"] <- 3
-    val.int
   }
   # only run on uniques
   uniq <- unique(c(y, z))

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"])
           ))
         }
       )

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

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) {
+  if (!all(data$x %in% c("WT", "NWT"), na.rm = TRUE)) {
-    data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
+    # # be sure to have at least S, I, and R
-  }
+    if (!"S" %in% data$x) {
-  if (!"SDD" %in% data$x) {
+      data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
-    data <- rbind_AMR(data, data.frame(x = "SDD", n = 0, s = 0, stringsAsFactors = FALSE))
+    }
-  }
+    if (!"I" %in% data$x) {
-  if (!"I" %in% data$x) {
+      data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
-    data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
+    }
-  }
+    if (!"R" %in% data$x) {
-  if (!"R" %in% data$x) {
+      data <- rbind_AMR(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
-    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"))]
-  if (!"NI" %in% data$x) {
+  } else {
-    data <- rbind_AMR(data, data.frame(x = "NI", n = 0, s = 0, stringsAsFactors = FALSE))
+    lvls <- c("WT", "NWT")
   }
 
-  data <- data[!(data$n == 0 & data$x %in% c("SDD", "I", "NI")), , drop = FALSE]
+  data$x <- factor(data$x, levels = lvls, ordered = TRUE)
-  data$x <- factor(data$x, levels = intersect(unique(data$x), c("S", "SDD", "I", "R", "NI")), 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
+  if (all(height %in% c("WT", "NWT"), na.rm = TRUE)) {
-  colours_SIR <- colours_SIR[!(names(x) %in% c("SDD", "I", "NI") & x == 0)]
+    colours_SIR <- colours_SIR[c(1, 4)]
-  x <- x[!(names(x) %in% c("SDD", "I", "NI") & x == 0)]
+    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"

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,

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(S, allow_class = c("character", "numeric", "integer", "factor"), has_length = 1)
-  meet_criteria(I, allow_class = c("character", "numeric", "integer"), 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"), 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"), 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"), 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 <- COMMON_MIC_VALUES[which(COMMON_MIC_VALUES >= as.double(mic_val))][1]
-            log2_val <- log2_levels[which(log2_levels >= 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("S", "WT")] <- 1
-  dbls[x %in% c("SDD", "I")] <- 2
+  dbls[x %in% c("I", "SDD")] <- 2
-  dbls[x == "R"] <- 3
+  dbls[x %in% c("R", "NWT", "NS")] <- 3
   dbls
 }
 

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)) {
+        data[which(data[, i, drop = TRUE] %in% c("I", "S")), i] <- "SI"
-          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("S", "SI", "I", "R")), i] <- NA_character_
     }
   }
 

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-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	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-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

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) |
+| Грамнегативні | 96% (95-98%,N=684)  | 96% (94-97%,N=686) | 91% (88-93%,N=684) |
-| Gram-positive | 77% (74-80%,N=724) | 63% (60-66%,N=1170) | 34% (31-38%,N=665) |
+| Грампозитивні | 63% (60-66%,N=1170) | 34% (31-38%,N=665) | 77% (74-80%,N=724) |
 
 ### Interpreting and plotting MIC and SIR values
 

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.}
 

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}.}

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.}

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}.

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{<div class="sourceCode r">}}\preformatted{x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
                          TZP == "R" ~ aminopenicillins == "R")

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{<div class="sourceCode r">}}\preformatted{custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
                                 ERY == "R" & age > 60 ~ "Elderly Type 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

man/interpretive_rules.Rd

@@ -1,10 +1,12 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/eucast_rules.R
+% Please edit documentation in R/interpretive_rules.R
-\name{eucast_rules}
+\name{interpretive_rules}
-\alias{eucast_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(),
+interpretive_rules(x, col_mo = NULL, guideline = getOption("AMR_guideline",
-  rules = getOption("AMR_eucastrules", default = c("breakpoints",
+  "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}{

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

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}.