(v2.1.1.9195) add BTL-S, fix ranks in unknown microorganisms

R/amr_selectors.R

@@ -338,10 +338,10 @@ cephalosporins_5th <- function(only_sir_columns = FALSE, return_all = TRUE, ...)
 
 #' @rdname antimicrobial_selectors
 #' @export
-fluoroquinolones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+fluoroquinolones <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns, return_all = return_all)
+  amr_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
 }
 
 #' @rdname antimicrobial_selectors
@@ -354,10 +354,10 @@ glycopeptides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
 
 #' @rdname antimicrobial_selectors
 #' @export
-isoxazolylpenicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+isoxazolylpenicillins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("isoxazolylpenicillins", only_sir_columns = only_sir_columns, return_all = return_all)
+  amr_select_exec("isoxazolylpenicillins", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
 }
 
 #' @rdname antimicrobial_selectors
@@ -436,10 +436,10 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_a
 
 #' @rdname antimicrobial_selectors
 #' @export
-quinolones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+quinolones <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("quinolones", only_sir_columns = only_sir_columns, return_all = return_all)
+  amr_select_exec("quinolones", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
 }
 
 #' @rdname antimicrobial_selectors
@@ -460,10 +460,10 @@ streptogramins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
 
 #' @rdname antimicrobial_selectors
 #' @export
-tetracyclines <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+tetracyclines <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("tetracyclines", only_sir_columns = only_sir_columns, return_all = return_all)
+  amr_select_exec("tetracyclines", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
 }
 
 #' @rdname antimicrobial_selectors
@@ -676,12 +676,12 @@ amr_select_exec <- function(function_name,
   }
 
   # untreatable drugs
+  untreatable <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam)")]
   if (!is.null(vars_df) && only_treatable == TRUE) {
-    untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam)"), "ab", drop = TRUE]
     if (any(untreatable %in% names(ab_in_data))) {
       if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
         warning_(
-          "in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ",
+          "in `", function_name, "()`: some drugs were ignored since they cannot be used for treatment: ",
           vector_and(
             ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
               language = NULL,
@@ -749,6 +749,26 @@ amr_select_exec <- function(function_name,
   if (is.null(vars_df)) {
     # no data found, no antimicrobials, so no input. Happens if users run e.g. `aminoglycosides()` as a separate command.
     # print.ab will cover the additional printing text
+    if (only_treatable == TRUE) {
+      if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
+        message_(
+          "in `", function_name, "()`: ",
+          vector_and(
+            paste0(
+              ab_name(abx[abx %in% untreatable],
+                language = NULL,
+                tolower = TRUE
+              ),
+              " (`", abx[abx %in% untreatable], "`)"
+            ),
+            quotes = FALSE,
+            sort = TRUE,
+            initial_captital = TRUE
+          ), ifelse(length(abx[abx %in% untreatable]) == 1, " is ", " are "), "not included since `only_treatable = TRUE`."
+        )
+      }
+      abx <- abx[!abx %in% untreatable]
+    }
     return(structure(sort(abx), amr_selector = function_name))
   }
 

R/sir.R

@@ -1270,10 +1270,13 @@ as_sir_method <- function(method_short,
     }
   }
 
+  mo_grams <- suppressWarnings(suppressMessages(mo_gramstain(df_unique$mo, language = NULL, keep_synonyms = FALSE)))
+
   # run the rules (df_unique is a row combination per mo/ab/uti/host) ----
   for (i in seq_len(nrow(df_unique))) {
     p$tick()
     mo_current <- df_unique[i, "mo", drop = TRUE]
+    mo_gram_current <- mo_grams[i]
     ab_current <- df_unique[i, "ab", drop = TRUE]
     host_current <- df_unique[i, "host", drop = TRUE]
     uti_current <- df_unique[i, "uti", drop = TRUE]
@@ -1300,12 +1303,25 @@ as_sir_method <- function(method_short,
     mo_current_class <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$class[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$fullname)]
     mo_current_rank <- AMR_env$MO_lookup$rank[match(mo_current, AMR_env$MO_lookup$mo)]
     mo_current_name <- AMR_env$MO_lookup$fullname[match(mo_current, AMR_env$MO_lookup$mo)]
+    mo_current_oxygen_tolerance <- AMR_env$MO_lookup$oxygen_tolerance[match(mo_current, AMR_env$MO_lookup$mo)]
     if (mo_current %in% AMR::microorganisms.groups$mo) {
       # get the species group (might be more than 1 entry)
       mo_current_species_group <- AMR::microorganisms.groups$mo_group[which(AMR::microorganisms.groups$mo == mo_current)]
     } else {
       mo_current_species_group <- NULL
     }
+    mo_current_gram <- structure(character(0), class = c("mo", "character"))
+    if (identical(mo_gram_current, "Gram-negative")) {
+      mo_current_gram <- c(mo_current_gram, "B_GRAMN")
+      if (identical(mo_current_oxygen_tolerance, "anaerobe")) {
+        mo_current_gram <- c(mo_current_gram, "B_ANAER", "B_ANAER-NEG")
+      }
+    } else if (identical(mo_gram_current, "Gram-positive")) {
+      mo_current_gram <- c(mo_current_gram, "B_GRAMP")
+      if (identical(mo_current_oxygen_tolerance, "anaerobe")) {
+        mo_current_gram <- c(mo_current_gram, "B_ANAER", "B_ANAER-POS")
+      }
+    }
     mo_current_other <- structure("UNKNOWN", class = c("mo", "character"))
     # formatted for notes
     mo_formatted <- mo_current_name
@@ -1325,6 +1341,7 @@ as_sir_method <- function(method_short,
         mo_current, mo_current_genus, mo_current_family,
         mo_current_order, mo_current_class,
         mo_current_species_group,
+        mo_current_gram,
         mo_current_other
       ))
 

R/zz_deprecated.R

@@ -61,7 +61,7 @@ ab_selector <- function(...) {
 deprecation_warning <- function(old = NULL, new = NULL, fn = NULL, extra_msg = NULL, is_function = FALSE, is_dataset = FALSE, is_argument = FALSE) {
   if (is.null(old)) {
     warning_(extra_msg)
-  } else {
+  } else if (message_not_thrown_before("deprecation", old, new, entire_session = TRUE)) {
     env <- paste0("deprecated_", old)
     if (!env %in% names(AMR_env)) {
       AMR_env[[paste0("deprecated_", old)]] <- 1