diff --git a/DESCRIPTION b/DESCRIPTION index 2cea0ec2..8825f5e3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.8.2.9147 -Date: 2023-02-26 +Version: 1.8.2.9148 +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 diff --git a/NEWS.md b/NEWS.md index 8d7185a0..09454bb4 100755 --- a/NEWS.md +++ b/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!)* diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index dd192a6b..00aa0f4f 100755 --- a/R/aa_helper_functions.R +++ b/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()) } @@ -895,7 +914,7 @@ get_current_data <- function(arg_name, call) { } frms <- sys.frames() - + # check dplyr environments to support dplyr groups with_mask <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$mask)) for (env in frms[which(with_mask)]) { @@ -929,7 +948,7 @@ get_current_data <- function(arg_name, call) { return(env$x) } } - + # now a special case for dplyr's 'scoped' variants with_tbl <- vapply(FUN.VALUE = logical(1), frms, function(e) valid_df(e$`.tbl`)) for (env in frms[which(with_tbl)]) { diff --git a/R/ab.R b/R/ab.R index e57754cd..71074808 100755 --- a/R/ab.R +++ b/R/ab.R @@ -248,7 +248,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next } - + # length of input is quite long, and Levenshtein distance is only max 2 if (nchar(x[i]) >= 10) { levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name)) diff --git a/R/ab_selectors.R b/R/ab_selectors.R index c66dd5d5..bc61e7fe 100755 --- a/R/ab_selectors.R +++ b/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) } diff --git a/R/antibiogram.R b/R/antibiogram.R index 006fabde..ba951043 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -49,11 +49,11 @@ #' @details This function returns a table with values between 0 and 100 for *susceptibility*, not resistance. #' #' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms. -#' +#' #' All types of antibiograms as listed below can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]). The `antibiogram` object can also be used directly in R Markdown / Quarto (i.e., `knitr`) for reports. In this case, [knitr::kable()] will be applied automatically and microorganism names will even be printed in italics at default (see argument `italicise`). You can also use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. with `flextable::as_flextable()` or `gt::gt()`. #' #' ### Antibiogram Types -#' +#' #' There are four antibiogram types, as proposed by Klinker *et al.* (2021, \doi{10.1177/20499361211011373}), and they are all supported by [antibiogram()]: #' #' 1. **Traditional Antibiogram** @@ -98,8 +98,8 @@ #' #' ```r #' library(dplyr) -#' your_data %>% -#' filter(ward == "ICU" & specimen_type == "Respiratory") %>% +#' your_data %>% +#' filter(ward == "ICU" & specimen_type == "Respiratory") %>% #' antibiogram(antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), #' syndromic_group = ifelse(.$age >= 65 & #' .$gender == "Male" & @@ -127,7 +127,7 @@ #' - - - - #' -------------------------------------------------------------------- #' ``` -#' +#' #' @source #' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373} #' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2} @@ -191,11 +191,12 @@ #' # with a custom language, though this will be determined automatically #' # (i.e., this table will be in Spanish on Spanish systems) #' antibiogram(ex1, -#' antibiotics = aminoglycosides(), -#' ab_transform = "name", -#' syndromic_group = ifelse(ex1$ward == "ICU", -#' "UCI", "No UCI"), -#' language = "es" +#' antibiotics = aminoglycosides(), +#' ab_transform = "name", +#' syndromic_group = ifelse(ex1$ward == "ICU", +#' "UCI", "No UCI" +#' ), +#' language = "es" #' ) #' #' @@ -203,29 +204,30 @@ #' #' # the data set could contain a filter for e.g. respiratory specimens/ICU #' antibiogram(example_isolates, -#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), -#' mo_transform = "gramstain", -#' minimum = 10, # this should be >=30, but now just as example -#' syndromic_group = ifelse(example_isolates$age >= 65 & -#' example_isolates$gender == "M", -#' "WISCA Group 1", "WISCA Group 2" -#' ) +#' antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), +#' mo_transform = "gramstain", +#' minimum = 10, # this should be >=30, but now just as example +#' syndromic_group = ifelse(example_isolates$age >= 65 & +#' example_isolates$gender == "M", +#' "WISCA Group 1", "WISCA Group 2" +#' ) #' ) -#' +#' #' #' # Print the output for R Markdown / Quarto ----------------------------- -#' +#' #' ureido <- antibiogram(example_isolates, -#' antibiotics = ureidopenicillins(), -#' ab_transform = "name") -#' +#' antibiotics = ureidopenicillins(), +#' ab_transform = "name" +#' ) +#' #' # in an Rmd file, you would just need to return `ureido` in a chunk, #' # but to be explicit here: #' if (requireNamespace("knitr")) { #' knitr::knit_print(ureido) #' } -#' -#' +#' +#' #' # Generate plots with ggplot2 or base R -------------------------------- #' #' ab1 <- antibiogram(example_isolates, @@ -244,10 +246,9 @@ #' if (requireNamespace("ggplot2")) { #' ggplot2::autoplot(ab2) #' } -#' +#' #' plot(ab1) #' plot(ab2) -#' #' } antibiogram <- function(x, antibiotics = where(is.sir), @@ -276,7 +277,7 @@ antibiogram <- function(x, meet_criteria(combine_SI, allow_class = "logical", has_length = 1) meet_criteria(sep, allow_class = "character", has_length = 1) meet_criteria(info, allow_class = "logical", has_length = 1) - + # try to find columns based on type if (is.null(col_mo)) { col_mo <- search_type_in_df(x = x, type = "mo", info = interactive()) @@ -327,7 +328,7 @@ antibiogram <- function(x, out[!is.na(out)] }) user_ab <- user_ab[unlist(lapply(user_ab, length)) > 0] - + if (length(non_existing) > 0) { warning_("The following antibiotics were not available and ignored: ", vector_and(ab_name(non_existing, language = NULL, tolower = TRUE), quotes = FALSE)) } @@ -385,7 +386,7 @@ antibiogram <- function(x, FUN = function(x) x ) counts <- out - + if (isTRUE(combine_SI)) { out$numerator <- out$S + out$I } else { diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 1bbd1999..2c238def 100755 --- a/R/eucast_rules.R +++ b/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() diff --git a/R/first_isolate.R b/R/first_isolate.R index 19c6259d..20392cab 100755 --- a/R/first_isolate.R +++ b/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. diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index b3b61c53..de75e913 100755 --- a/R/key_antimicrobials.R +++ b/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) diff --git a/R/mdro.R b/R/mdro.R index bd4d15c6..57cef7d2 100755 --- a/R/mdro.R +++ b/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))) { diff --git a/R/mo.R b/R/mo.R index d850ecc5..534ab86d 100755 --- a/R/mo.R +++ b/R/mo.R @@ -69,9 +69,9 @@ #' Use the [`mo_*`][mo_property()] functions to get properties based on the returned code, see *Examples*. #' #' The [as.mo()] function uses a novel [matching score algorithm][mo_matching_score()] (see *Matching Score for Microorganisms* below) to match input against the [available microbial taxonomy][microorganisms] in this package. This will lead to the effect that e.g. `"E. coli"` (a microorganism highly prevalent in humans) will return the microbial ID of *Escherichia coli* and not *Entamoeba coli* (a microorganism less prevalent in humans), although the latter would alphabetically come first. -#' +#' #' With `Becker = TRUE`, the following `r length(MO_CONS[MO_CONS != "B_STPHY_CONS"])` staphylococci will be converted to the **coagulase-negative group**: `r vector_and(gsub("Staphylococcus", "S.", mo_name(MO_CONS[MO_CONS != "B_STPHY_CONS"], keep_synonyms = TRUE)), quotes = "*")`.\cr The following `r length(MO_COPS[MO_COPS != "B_STPHY_COPS"])` staphylococci will be converted to the **coagulase-positive group**: `r vector_and(gsub("Staphylococcus", "S.", mo_name(MO_COPS[MO_COPS != "B_STPHY_COPS"], keep_synonyms = TRUE)), quotes = "*")`. -#' +#' #' With `Lancefield = TRUE`, the following streptococci will be converted to their corresponding Lancefield group: `r vector_and(gsub("Streptococcus", "S.", paste0("*", mo_name(MO_LANCEFIELD, keep_synonyms = TRUE), "* (", mo_species(MO_LANCEFIELD, keep_synonyms = TRUE, Lancefield = TRUE), ")")), quotes = FALSE)`. #' #' ### Coping with Uncertain Results diff --git a/R/mo_property.R b/R/mo_property.R index 9132c9cd..64455890 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -114,7 +114,7 @@ #' mo_lpsn("Klebsiella aerogenes") #' mo_gbif("Klebsiella aerogenes") #' mo_synonyms("Klebsiella aerogenes") -#' +#' #' #' # abbreviations known in the field ----------------------------------------- #' @@ -754,7 +754,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio if (length(syns) == 1) { syns <- unlist(syns) } - + load_mo_uncertainties(metadata) syns } diff --git a/R/plot.R b/R/plot.R index 86f06723..32d6ab90 100755 --- a/R/plot.R +++ b/R/plot.R @@ -88,8 +88,8 @@ plot.mic <- function(x, ab = NULL, guideline = "EUCAST", main = deparse(substitute(x)), - ylab = "Frequency", - xlab = "Minimum Inhibitory Concentration (mg/L)", + ylab = translate_AMR("Frequency", language = language), + 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) } @@ -158,7 +154,7 @@ plot.mic <- function(x, legend_txt <- c(legend_txt, "(R) Resistant") legend_col <- c(legend_col, colours_SIR[3]) } - + legend("top", x.intersp = 0.5, legend = translate_into_language(legend_txt, language = language), @@ -180,8 +176,8 @@ barplot.mic <- function(height, ab = NULL, guideline = "EUCAST", main = deparse(substitute(height)), - ylab = "Frequency", - xlab = "Minimum Inhibitory Concentration (mg/L)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Minimum Inhibitory Concentration (mg/L)", + ylab = translate_AMR("Frequency", language = language), + 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,12 +266,15 @@ 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", - paste("(I)", plot_name_of_I(cols_sub$guideline)), - "(R) Resistant"), - language = language - ), - ordered = TRUE + levels = translate_into_language( + c( + "(S) Susceptible", + paste("(I)", plot_name_of_I(cols_sub$guideline)), + "(R) Resistant" + ), + language = language + ), + ordered = TRUE ) p <- ggplot2::ggplot(df) @@ -328,8 +319,8 @@ fortify.mic <- function(object, ...) { #' @rdname plot plot.disk <- function(x, main = deparse(substitute(x)), - ylab = "Frequency", - xlab = "Disk diffusion diameter (mm)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Disk diffusion diameter (mm)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Disk diffusion diameter (mm)", + ylab = translate_AMR("Frequency", language = language), + 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", - paste("(I)", plot_name_of_I(cols_sub$guideline)), - "(R) Resistant"), + levels = translate_into_language( + c( + "(S) Susceptible", + paste("(I)", plot_name_of_I(cols_sub$guideline)), + "(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", - xlab = "Antimicrobial Interpretation", + ylab = translate_AMR("Percentage", language = language), + 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", - ylab = "Frequency", + xlab = translate_AMR("Antimicrobial Interpretation", language = language), + 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", - ylab = "Frequency", + xlab = translate_AMR("Antimicrobial Interpretation", language = language), + 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 } diff --git a/R/random.R b/R/random.R index 39c6e882..54f09baf 100755 --- a/R/random.R +++ b/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) & diff --git a/R/sir.R b/R/sir.R index 3a20c0e0..93f1b4fa 100755 --- a/R/sir.R +++ b/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)) { diff --git a/R/zz_deprecated.R b/R/zz_deprecated.R index 46755748..6ae0adad 100755 --- a/R/zz_deprecated.R +++ b/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, "()` function has been replaced with `", new, "()`") + paste0("The `", old, "` ", type, " is no longer in use"), + 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), "" diff --git a/data-raw/reproduction_of_microorganisms.R b/data-raw/reproduction_of_microorganisms.R index 26e06798..c25f7cfe 100644 --- a/data-raw/reproduction_of_microorganisms.R +++ b/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", - "Moraxella catarrhalis") +to_restore <- c( + "Stenotrophomonas maltophilia", + "Moraxella catarrhalis" +) all(to_restore %in% microorganisms$fullname) for (nm in to_restore) { microorganisms$lpsn_renamed_to[which(microorganisms$fullname == nm)] <- NA diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index b4173217..7f97e1ba 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -127,8 +127,8 @@ Case example: Susceptibility of \emph{Pseudomonas aeruginosa} to TZP among respi Code example: \if{html}{\out{
}}\preformatted{library(dplyr) -your_data \%>\% - filter(ward == "ICU" & specimen_type == "Respiratory") \%>\% +your_data \%>\% + filter(ward == "ICU" & specimen_type == "Respiratory") \%>\% antibiogram(antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"), syndromic_group = ifelse(.$age >= 65 & .$gender == "Male" & @@ -214,11 +214,12 @@ ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ] # with a custom language, though this will be determined automatically # (i.e., this table will be in Spanish on Spanish systems) antibiogram(ex1, - antibiotics = aminoglycosides(), - ab_transform = "name", - syndromic_group = ifelse(ex1$ward == "ICU", - "UCI", "No UCI"), - language = "es" + antibiotics = aminoglycosides(), + ab_transform = "name", + syndromic_group = ifelse(ex1$ward == "ICU", + "UCI", "No UCI" + ), + language = "es" ) @@ -226,21 +227,22 @@ antibiogram(ex1, # the data set could contain a filter for e.g. respiratory specimens/ICU antibiogram(example_isolates, - antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), - mo_transform = "gramstain", - minimum = 10, # this should be >=30, but now just as example - syndromic_group = ifelse(example_isolates$age >= 65 & - example_isolates$gender == "M", - "WISCA Group 1", "WISCA Group 2" - ) + antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"), + mo_transform = "gramstain", + minimum = 10, # this should be >=30, but now just as example + syndromic_group = ifelse(example_isolates$age >= 65 & + example_isolates$gender == "M", + "WISCA Group 1", "WISCA Group 2" + ) ) # Print the output for R Markdown / Quarto ----------------------------- ureido <- antibiogram(example_isolates, - antibiotics = ureidopenicillins(), - ab_transform = "name") + antibiotics = ureidopenicillins(), + 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) - } } diff --git a/man/plot.Rd b/man/plot.Rd index 6067b9c4..bfaef50d 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -19,8 +19,8 @@ ab = NULL, guideline = "EUCAST", main = deparse(substitute(x)), - ylab = "Frequency", - xlab = "Minimum Inhibitory Concentration (mg/L)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Minimum Inhibitory Concentration (mg/L)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Disk diffusion diameter (mm)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Disk diffusion diameter (mm)", + ylab = translate_AMR("Frequency", language = language), + 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", - xlab = "Antimicrobial Interpretation", + ylab = translate_AMR("Percentage", language = language), + 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", - ylab = "Frequency", + xlab = translate_AMR("Antimicrobial Interpretation", language = language), + ylab = translate_AMR("Frequency", language = language), colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"), language = get_AMR_locale(), ... diff --git a/tests/tinytest.R b/tests/tinytest.R index c5c84610..f68d81dc 100644 --- a/tests/tinytest.R +++ b/tests/tinytest.R @@ -64,7 +64,7 @@ if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function( if (getRversion() < "4.0.0") { deparse1 <- AMR:::deparse1 } - + # start the unit tests out <- test_package("AMR", testdir = ifelse(dir.exists("inst/tinytest"), diff --git a/vignettes/AMR.Rmd b/vignettes/AMR.Rmd index cb959472..6437e4df 100755 --- a/vignettes/AMR.Rmd +++ b/vignettes/AMR.Rmd @@ -140,11 +140,11 @@ For now, we will just clean the SIR columns in our data using dplyr: ```{r} # method 1, be explicit about the columns: -our_data <- our_data %>% +our_data <- our_data %>% mutate_at(vars(AMX:GEN), as.sir) # method 2, let the AMR package determine the eligible columns -our_data <- our_data %>% +our_data <- our_data %>% mutate_if(is_sir_eligible, as.sir) # result: @@ -213,10 +213,10 @@ sapply(our_data_1st, n_distinct) To just get an idea how the species are distributed, create a frequency table with `count()` based on the name of the microorganisms: ```{r freq 1} -our_data %>% +our_data %>% count(mo_name(bacteria), sort = TRUE) -our_data_1st %>% +our_data_1st %>% count(mo_name(bacteria), sort = TRUE) ``` @@ -255,42 +255,48 @@ 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 - + ab_transform = "name", + 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) + size = nrow(our_data_1st), + 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") + # you can use AB selectors here as well: + antibiotics = c(penicillins(), aminoglycosides()), + syndromic_group = "condition", + mo_transform = "gramstain" +) ``` ```{r} -# WISCA: +# WISCA: # (we lack some details, but it could contain a filter on e.g. >65 year-old males) wisca <- antibiogram(our_data_1st, - antibiotics = c("AMC", "AMC+CIP", "AMC+GEN"), - syndromic_group = "condition", - mo_transform = "gramstain") + antibiotics = c("AMC", "AMC+CIP", "AMC+GEN"), + syndromic_group = "condition", + mo_transform = "gramstain" +) wisca ```