P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

support for old rsi arguments

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-03-11 14:24:34 +01:00
parent 4416394e10
commit 262598b8d7
21 changed files with 327 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

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

2
NEWS.md
View File

@ -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!)*

21
R/aa_helper_functions.R
View File

@ -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())
}

108
R/ab_selectors.R
View File

@ -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)
}

7
R/antibiogram.R
View File

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

1
R/eucast_rules.R
View File

@ -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()

4
R/first_isolate.R
View File

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

4
R/key_antimicrobials.R
View File

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

4
R/mdro.R
View File

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

150
R/plot.R
View File

@ -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)
}
@ -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,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",
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",
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",
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
}

6
R/random.R
View File

@ -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) &

2
R/sir.R
View File

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

22
R/zz_deprecated.R
View File

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

6
data-raw/reproduction_of_microorganisms.R
View File

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

7
man/antibiogram.Rd
View File

@ -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)
}
}

24
man/plot.Rd
View File

@ -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(),
...

22
vignettes/AMR.Rmd
View File

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