support for old rsi arguments

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.8.2.9147
+Version: 1.8.2.9148
-Date: 2023-02-26
+Date: 2023-03-11
 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

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.8.2.9147
+# AMR 1.8.2.9148
 
 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
 

R/aa_helper_functions.R

@@ -757,7 +757,7 @@ format_class <- function(class, plural = FALSE) {
 }
 
 # a check for every single argument in all functions
-meet_criteria <- function(object,
+meet_criteria <- function(object, # can be literally `list(...)` for `allow_arguments_from`
                           allow_class = NULL,
                           has_length = NULL,
                           looks_like = NULL,
@@ -769,6 +769,7 @@ meet_criteria <- function(object,
                           allow_NULL = FALSE,
                           allow_NA = FALSE,
                           ignore.case = FALSE,
+                          allow_arguments_from = NULL, # 1 function, or a list of functions
                           .call_depth = 0) { # depth in calling
 
   obj_name <- deparse(substitute(object))
@@ -886,6 +887,24 @@ meet_criteria <- function(object,
       call = call_depth
     )
   }
+  if (!is.null(allow_arguments_from) && !is.null(names(object))) {
+    args_given <- names(object)
+    if (is.function(allow_arguments_from)) {
+      allow_arguments_from <- list(allow_arguments_from)
+    }
+    args_allowed <- sort(unique(unlist(lapply(allow_arguments_from, function(x) names(formals(x))))))
+    args_allowed <- args_allowed[args_allowed != "..."]
+    disallowed <- args_given[!args_given %in% args_allowed]
+    stop_if(length(disallowed) > 0,
+      ifelse(length(disallowed) == 1,
+        paste("the argument", vector_and(disallowed), "is"),
+        paste("the arguments", vector_and(disallowed), "are")
+      ),
+      " not valid. Valid arguments are: ",
+      vector_and(args_allowed), ".",
+      call = call_depth
+    )
+  }
   return(invisible())
 }
 

R/ab_selectors.R

@@ -181,6 +181,10 @@ ab_class <- function(ab_class,
   meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec(NULL, only_sir_columns = only_sir_columns, ab_class_args = ab_class, only_treatable = only_treatable)
 }
 
@@ -193,6 +197,10 @@ ab_selector <- function(filter,
                         ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
 
   # get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
   # but it only takes a couple of milliseconds
@@ -224,6 +232,10 @@ ab_selector <- function(filter,
 aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -231,6 +243,10 @@ aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...
 #' @export
 aminopenicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("aminopenicillins", only_sir_columns = only_sir_columns)
 }
 
@@ -238,6 +254,10 @@ aminopenicillins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 antifungals <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("antifungals", only_sir_columns = only_sir_columns)
 }
 
@@ -245,6 +265,10 @@ antifungals <- function(only_sir_columns = FALSE, ...) {
 #' @export
 antimycobacterials <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("antimycobacterials", only_sir_columns = only_sir_columns)
 }
 
@@ -253,6 +277,10 @@ antimycobacterials <- function(only_sir_columns = FALSE, ...) {
 betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -261,6 +289,10 @@ betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -268,6 +300,10 @@ carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 #' @export
 cephalosporins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins", only_sir_columns = only_sir_columns)
 }
 
@@ -275,6 +311,10 @@ cephalosporins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns)
 }
 
@@ -282,6 +322,10 @@ cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns)
 }
 
@@ -289,6 +333,10 @@ cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns)
 }
 
@@ -296,6 +344,10 @@ cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns)
 }
 
@@ -303,6 +355,10 @@ cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns)
 }
 
@@ -310,6 +366,10 @@ cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
 #' @export
 fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns)
 }
 
@@ -317,6 +377,10 @@ fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 glycopeptides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("glycopeptides", only_sir_columns = only_sir_columns)
 }
 
@@ -324,6 +388,10 @@ glycopeptides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 lincosamides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("lincosamides", only_sir_columns = only_sir_columns)
 }
 
@@ -331,6 +399,10 @@ lincosamides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns)
 }
 
@@ -338,6 +410,10 @@ lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 macrolides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
 }
 
@@ -345,6 +421,10 @@ macrolides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 oxazolidinones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("oxazolidinones", only_sir_columns = only_sir_columns)
 }
 
@@ -352,6 +432,10 @@ oxazolidinones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 penicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("penicillins", only_sir_columns = only_sir_columns)
 }
 
@@ -360,6 +444,10 @@ penicillins <- function(only_sir_columns = FALSE, ...) {
 polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -367,6 +455,10 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 #' @export
 streptogramins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
 }
 
@@ -374,6 +466,10 @@ streptogramins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 quinolones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
 }
 
@@ -381,6 +477,10 @@ quinolones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 tetracyclines <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("tetracyclines", only_sir_columns = only_sir_columns)
 }
 
@@ -388,6 +488,10 @@ tetracyclines <- function(only_sir_columns = FALSE, ...) {
 #' @export
 trimethoprims <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("trimethoprims", only_sir_columns = only_sir_columns)
 }
 
@@ -395,6 +499,10 @@ trimethoprims <- function(only_sir_columns = FALSE, ...) {
 #' @export
 ureidopenicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns)
 }
 

R/antibiogram.R

@@ -194,7 +194,8 @@
 #'   antibiotics = aminoglycosides(),
 #'   ab_transform = "name",
 #'   syndromic_group = ifelse(ex1$ward == "ICU",
-#'                                      "UCI", "No UCI"),
+#'     "UCI", "No UCI"
+#'   ),
 #'   language = "es"
 #' )
 #'
@@ -217,7 +218,8 @@
 #'
 #' ureido <- antibiogram(example_isolates,
 #'   antibiotics = ureidopenicillins(),
-#'                       ab_transform = "name")
+#'   ab_transform = "name"
+#' )
 #'
 #' # in an Rmd file, you would just need to return `ureido` in a chunk,
 #' # but to be explicit here:
@@ -247,7 +249,6 @@
 #'
 #' plot(ab1)
 #' plot(ab2)
-#'
 #' }
 antibiogram <- function(x,
                         antibiotics = where(is.sir),

R/eucast_rules.R

@@ -181,6 +181,7 @@ eucast_rules <- function(x,
   meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
+  if ("only_rsi_columns" %in% names(list(...))) only_sir_columns <- list(...)$only_rsi_columns
 
   add_MO_lookup_to_AMR_env()
 

R/first_isolate.R

@@ -226,6 +226,10 @@ first_isolate <- function(x = NULL,
   meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
   meet_criteria(info, allow_class = "logical", has_length = 1)
   meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
+  if ("include_untested_rsi" %in% names(list(...))) {
+    deprecation_warning("include_untested_rsi", "include_untested_sir", is_function = FALSE)
+    include_untested_sir <- list(...)$include_untested_rsi
+  }
   meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
 
   # remove data.table, grouping from tibbles, etc.

R/key_antimicrobials.R

@@ -149,6 +149,10 @@ key_antimicrobials <- function(x = NULL,
   meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
 
   # force regular data.frame, not a tibble or data.table
   x <- as.data.frame(x, stringsAsFactors = FALSE)

R/mdro.R

@@ -192,6 +192,10 @@ mdro <- function(x = NULL,
   meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
   meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(verbose, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
 
   if (!any(is_sir_eligible(x))) {

R/plot.R

@@ -88,8 +88,8 @@ plot.mic <- function(x,
                      ab = NULL,
                      guideline = "EUCAST",
                      main = deparse(substitute(x)),
-                     ylab = "Frequency",
+                     ylab = translate_AMR("Frequency", language = language),
-                     xlab = "Minimum Inhibitory Concentration (mg/L)",
+                     xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                      colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                      language = get_AMR_locale(),
                      expand = TRUE,
@@ -100,18 +100,14 @@ plot.mic <- function(x,
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -180,8 +176,8 @@ barplot.mic <- function(height,
                         ab = NULL,
                         guideline = "EUCAST",
                         main = deparse(substitute(height)),
-                        ylab = "Frequency",
+                        ylab = translate_AMR("Frequency", language = language),
-                        xlab = "Minimum Inhibitory Concentration (mg/L)",
+                        xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                         language = get_AMR_locale(),
                         expand = TRUE,
@@ -192,18 +188,14 @@ barplot.mic <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   plot(
@@ -227,8 +219,8 @@ autoplot.mic <- function(object,
                          ab = NULL,
                          guideline = "EUCAST",
                          title = deparse(substitute(object)),
-                         ylab = "Frequency",
+                         ylab = translate_AMR("Frequency", language = language),
-                         xlab = "Minimum Inhibitory Concentration (mg/L)",
+                         xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                          colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                          language = get_AMR_locale(),
                          expand = TRUE,
@@ -240,18 +232,14 @@ autoplot.mic <- function(object,
   meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }
@@ -278,9 +266,12 @@ autoplot.mic <- function(object,
   df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
   df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
-                    levels = translate_into_language(c("(S) Susceptible",
+    levels = translate_into_language(
+      c(
+        "(S) Susceptible",
         paste("(I)", plot_name_of_I(cols_sub$guideline)),
-                                                       "(R) Resistant"),
+        "(R) Resistant"
+      ),
       language = language
     ),
     ordered = TRUE
@@ -328,8 +319,8 @@ fortify.mic <- function(object, ...) {
 #' @rdname plot
 plot.disk <- function(x,
                       main = deparse(substitute(x)),
-                      ylab = "Frequency",
+                      ylab = translate_AMR("Frequency", language = language),
-                      xlab = "Disk diffusion diameter (mm)",
+                      xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                       mo = NULL,
                       ab = NULL,
                       guideline = "EUCAST",
@@ -343,18 +334,14 @@ plot.disk <- function(x,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -420,8 +407,8 @@ plot.disk <- function(x,
 #' @noRd
 barplot.disk <- function(height,
                          main = deparse(substitute(height)),
-                         ylab = "Frequency",
+                         ylab = translate_AMR("Frequency", language = language),
-                         xlab = "Disk diffusion diameter (mm)",
+                         xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                          mo = NULL,
                          ab = NULL,
                          guideline = "EUCAST",
@@ -435,18 +422,14 @@ barplot.disk <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   plot(
@@ -469,8 +452,8 @@ autoplot.disk <- function(object,
                           mo = NULL,
                           ab = NULL,
                           title = deparse(substitute(object)),
-                          ylab = "Frequency",
+                          ylab = translate_AMR("Frequency", language = language),
-                          xlab = "Disk diffusion diameter (mm)",
+                          xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                           guideline = "EUCAST",
                           colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                           language = get_AMR_locale(),
@@ -483,18 +466,14 @@ autoplot.disk <- function(object,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }
@@ -522,9 +501,12 @@ autoplot.disk <- function(object,
   df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
   df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
-    levels = translate_into_language(c("(S) Susceptible",
+    levels = translate_into_language(
+      c(
+        "(S) Susceptible",
         paste("(I)", plot_name_of_I(cols_sub$guideline)),
-                                       "(R) Resistant"),
+        "(R) Resistant"
+      ),
       language = language
     ),
     ordered = TRUE
@@ -571,8 +553,8 @@ fortify.disk <- function(object, ...) {
 #' @importFrom graphics plot text axis
 #' @rdname plot
 plot.sir <- function(x,
-                     ylab = "Percentage",
+                     ylab = translate_AMR("Percentage", language = language),
-                     xlab = "Antimicrobial Interpretation",
+                     xlab = translate_AMR("Antimicrobial Interpretation", language = language),
                      main = deparse(substitute(x)),
                      language = get_AMR_locale(),
                      ...) {
@@ -580,14 +562,6 @@ plot.sir <- function(x,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   data <- as.data.frame(table(x), stringsAsFactors = FALSE)
   colnames(data) <- c("x", "n")
   data$s <- round((data$n / sum(data$n)) * 100, 1)
@@ -635,8 +609,8 @@ plot.sir <- function(x,
 #' @noRd
 barplot.sir <- function(height,
                         main = deparse(substitute(height)),
-                        xlab = "Antimicrobial Interpretation",
+                        xlab = translate_AMR("Antimicrobial Interpretation", language = language),
-                        ylab = "Frequency",
+                        ylab = translate_AMR("Frequency", language = language),
                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                         language = get_AMR_locale(),
                         expand = TRUE,
@@ -644,18 +618,14 @@ barplot.sir <- function(height,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -678,8 +648,8 @@ barplot.sir <- function(height,
 # will be exported using s3_register() in R/zzz.R
 autoplot.sir <- function(object,
                          title = deparse(substitute(object)),
-                         xlab = "Antimicrobial Interpretation",
+                         xlab = translate_AMR("Antimicrobial Interpretation", language = language),
-                         ylab = "Frequency",
+                         ylab = translate_AMR("Frequency", language = language),
                          colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                          language = get_AMR_locale(),
                          ...) {
@@ -689,14 +659,6 @@ autoplot.sir <- function(object,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }

R/random.R

@@ -83,6 +83,10 @@ random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
 #' @export
 random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
   meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
+  if ("prob_RSI" %in% names(list(...))) {
+    deprecation_warning("prob_RSI", "prob_SIR", is_function = FALSE)
+    prob_SIR <- list(...)$prob_RSI
+  }
   meet_criteria(prob_SIR, allow_class = c("numeric", "integer"), has_length = 3)
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
@@ -91,7 +95,7 @@ random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
 }
 
 random_exec <- function(type, size, mo = NULL, ab = NULL) {
-  df <- clinical_breakpoints %pm>%
+  df <- AMR::clinical_breakpoints %pm>%
     pm_filter(guideline %like% "EUCAST") %pm>%
     pm_arrange(pm_desc(guideline)) %pm>%
     subset(guideline == max(guideline) &

R/sir.R

@@ -775,7 +775,7 @@ as_sir_method <- function(method_short,
   } else {
     mo.bak <- mo
   }
-  # be sure to take current taxonomy, as the clinical_breakpoints data set only contains current taxonomy
+  # be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy
   mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, inf0 = FALSE)))
   guideline_coerced <- get_guideline(guideline, reference_data)
   if (is.na(ab)) {

R/zz_deprecated.R

@@ -189,21 +189,33 @@ summary.rsi <- summary.sir
 #' @export
 unique.rsi <- unique.sir
 
-# WHEN REMOVING RSI, DON'T FORGET TO REMOVE THE "rsi_df" CLASS FROM R/sir_calc.R
+# WHEN REMOVING RSI, DON'T FORGET TO REMOVE :
+# - THE "rsi_df" CLASS FROM R/sir_calc.R
+# - CODE CONTAINING only_rsi_columns, colours_RSI, include_untested_rsi, prob_RSI
 
-deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
+deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
   if (is.null(old)) {
     warning_(extra_msg)
   } else {
     env <- paste0("deprecated_", old)
     if (!env %in% names(AMR_env)) {
       AMR_env[[paste0("deprecated_", old)]] <- 1
+      if (isTRUE(is_function)) {
+        old <- paste0(old, "()")
+        new <- paste0(new, "()")
+        type <- "function"
+      } else {
+        type <- "argument"
+      }
       warning_(
         ifelse(is.null(new),
-          paste0("The `", old, "()` function is no longer in use"),
+          paste0("The `", old, "` ", type, " is no longer in use"),
-          paste0("The `", old, "()` function has been replaced with `", new, "()`")
+          paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
+        ),
+        ifelse(type == "argument",
+          ". While the old argument still works, it will be removed in a future version, so please update your code.",
+          ", see `?AMR-deprecated`."
         ),
-        ", see `?AMR-deprecated`.",
         ifelse(!is.null(extra_msg),
           paste0(" ", extra_msg),
           ""

data-raw/reproduction_of_microorganisms.R

@@ -1366,8 +1366,10 @@ microorganisms <- taxonomy
 # https://lpsn.dsmz.de/species/stenotrophomonas-maltophilia
 
 # all MO's to keep as 'accepted', not as 'synonym':
-to_restore <- c("Stenotrophomonas maltophilia",
+to_restore <- c(
-                "Moraxella catarrhalis")
+  "Stenotrophomonas maltophilia",
+  "Moraxella catarrhalis"
+)
 all(to_restore %in% microorganisms$fullname)
 for (nm in to_restore) {
   microorganisms$lpsn_renamed_to[which(microorganisms$fullname == nm)] <- NA

man/antibiogram.Rd

@@ -217,7 +217,8 @@ antibiogram(ex1,
   antibiotics = aminoglycosides(),
   ab_transform = "name",
   syndromic_group = ifelse(ex1$ward == "ICU",
-                                     "UCI", "No UCI"),
+    "UCI", "No UCI"
+  ),
   language = "es"
 )
 
@@ -240,7 +241,8 @@ antibiogram(example_isolates,
 
 ureido <- antibiogram(example_isolates,
   antibiotics = ureidopenicillins(),
-                      ab_transform = "name")
+  ab_transform = "name"
+)
 
 # in an Rmd file, you would just need to return `ureido` in a chunk,
 # but to be explicit here:
@@ -270,6 +272,5 @@ if (requireNamespace("ggplot2")) {
 
 plot(ab1)
 plot(ab2)
-
 }
 }

man/plot.Rd

@@ -19,8 +19,8 @@
   ab = NULL,
   guideline = "EUCAST",
   main = deparse(substitute(x)),
-  ylab = "Frequency",
+  ylab = translate_AMR("Frequency", language = language),
-  xlab = "Minimum Inhibitory Concentration (mg/L)",
+  xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   expand = TRUE,
@@ -33,8 +33,8 @@
   ab = NULL,
   guideline = "EUCAST",
   title = deparse(substitute(object)),
-  ylab = "Frequency",
+  ylab = translate_AMR("Frequency", language = language),
-  xlab = "Minimum Inhibitory Concentration (mg/L)",
+  xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   expand = TRUE,
@@ -46,8 +46,8 @@
 \method{plot}{disk}(
   x,
   main = deparse(substitute(x)),
-  ylab = "Frequency",
+  ylab = translate_AMR("Frequency", language = language),
-  xlab = "Disk diffusion diameter (mm)",
+  xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
   mo = NULL,
   ab = NULL,
   guideline = "EUCAST",
@@ -62,8 +62,8 @@
   mo = NULL,
   ab = NULL,
   title = deparse(substitute(object)),
-  ylab = "Frequency",
+  ylab = translate_AMR("Frequency", language = language),
-  xlab = "Disk diffusion diameter (mm)",
+  xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
   guideline = "EUCAST",
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
@@ -75,8 +75,8 @@
 
 \method{plot}{sir}(
   x,
-  ylab = "Percentage",
+  ylab = translate_AMR("Percentage", language = language),
-  xlab = "Antimicrobial Interpretation",
+  xlab = translate_AMR("Antimicrobial Interpretation", language = language),
   main = deparse(substitute(x)),
   language = get_AMR_locale(),
   ...
@@ -85,8 +85,8 @@
 \method{autoplot}{sir}(
   object,
   title = deparse(substitute(object)),
-  xlab = "Antimicrobial Interpretation",
+  xlab = translate_AMR("Antimicrobial Interpretation", language = language),
-  ylab = "Frequency",
+  ylab = translate_AMR("Frequency", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   ...

vignettes/AMR.Rmd

@@ -255,33 +255,38 @@ Below are some suggestions for how to generate the different antibiograms:
 # traditional:
 antibiogram(our_data_1st)
 antibiogram(our_data_1st,
-            ab_transform = "name")
+  ab_transform = "name"
+)
 antibiogram(our_data_1st,
   ab_transform = "name",
-            language = "es") # support for 20 languages
+  language = "es"
-
+) # support for 20 languages
 ```
 
 ```{r}
 # combined:
 antibiogram(our_data_1st,
-            antibiotics = c("AMC", "AMC+CIP", "AMC+GEN"))
+  antibiotics = c("AMC", "AMC+CIP", "AMC+GEN")
+)
 ```
 
 ```{r}
 # for a syndromic antibiogram, we must fake some clinical conditions:
 our_data_1st$condition <- sample(c("Cardial", "Respiratory", "Rheumatic"),
   size = nrow(our_data_1st),
-                                 replace = TRUE)
+  replace = TRUE
+)
 
 # syndromic:
 antibiogram(our_data_1st,
-            syndromic_group = "condition")
+  syndromic_group = "condition"
+)
 antibiogram(our_data_1st,
   # you can use AB selectors here as well:
   antibiotics = c(penicillins(), aminoglycosides()),
   syndromic_group = "condition",
-            mo_transform = "gramstain")
+  mo_transform = "gramstain"
+)
 ```
 
 ```{r}
@@ -290,7 +295,8 @@ antibiogram(our_data_1st,
 wisca <- antibiogram(our_data_1st,
   antibiotics = c("AMC", "AMC+CIP", "AMC+GEN"),
   syndromic_group = "condition",
-                     mo_transform = "gramstain")
+  mo_transform = "gramstain"
+)
 wisca
 ```