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

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

2
R/ab.R
View File

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

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

59
R/antibiogram.R
View File

@ -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 @@
#' <NA> <NA> - - - -
#' --------------------------------------------------------------------
#' ```
#'
#'
#' @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 {

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

4
R/mo.R
View File

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

4
R/mo_property.R
View File

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

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

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

35
man/antibiogram.Rd
View File

@ -127,8 +127,8 @@ Case example: Susceptibility of \emph{Pseudomonas aeruginosa} to TZP among respi
Code example:
\if{html}{\out{<div class="sourceCode r">}}\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)
}
}

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

2
tests/tinytest.R
View File

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

46
vignettes/AMR.Rmd
View File

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