P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 05:42:18 +02:00
Code Releases Activity

(v2.1.1.9125) replace 'antibiotic selectors' with 'antimicrobial selectors'

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-01-17 12:09:39 +01:00
parent 1697ad37ce
commit 92c4fc0f94
33 changed files with 1029 additions and 807 deletions
Download Patch File Download Diff File Expand all files Collapse all files

508
R/ab_selectors.R → R/amr_selectors.R
View File

@ -27,28 +27,37 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
#' Antibiotic Selectors
#' Antimicrobial Selectors
#'
#' @description These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group (according to the [antibiotics] data set), without the need to define the columns or antibiotic abbreviations.
#' @description These functions allow for filtering rows and selecting columns based on antimicrobial test results that are of a specific antimicrobial class or group, without the need to define the columns or antimicrobial abbreviations.
#'
#' In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "kefzol", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
#' @param ab_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "kefzol", "CZO" and "J01DB04" will all be picked up using:
#'
#' ```r
#' library(dplyr)
#' my_data_with_all_these_columns %>%
#' select(cephalosporins())
#' ```
#' @param amr_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
#' @param only_sir_columns a [logical] to indicate whether only columns of class `sir` must be selected (default is `FALSE`), see [as.sir()]
#' @param only_treatable a [logical] to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
#' @param return_all a [logical] to indicate whether all matched columns must be returned (default is `TRUE`). With `FALSE`, only the first of each unique antimicrobial will be returned, e.g. if both columns `"genta"` and `"gentamicin"` exist in the data, only the first hit for gentamicin will be returned.
#' @param ... ignored, only in place to allow future extensions
#' @details
#' These functions can be used in data set calls for selecting columns and filtering rows. They work with base \R, the Tidyverse, and `data.table`. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but are not limited to `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
#'
#' All selectors can also be used in `tidymodels` packages such as `recipe` and `parsnip`. See for more info [our tutorial](https://msberends.github.io/AMR/articles/AMR_with_tidymodels.html) on using these AMR functions for predictive modelling.
#'
#' All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
#' All columns in the data in which these functions are called will be searched for known antimicrobial names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
#'
#' The [ab_class()] function can be used to filter/select on a manually defined antibiotic class. It searches for results in the [antibiotics] data set within the columns `group`, `atc_group1` and `atc_group2`.
#' @section Full list of supported (antibiotic) classes:
#' The [amr_class()] function can be used to filter/select on a manually defined antimicrobial class. It searches for results in the [antibiotics] data set within the columns `group`, `atc_group1` and `atc_group2`.
#' @section Full list of supported (antimicrobial) classes:
#'
#' `r paste0(" * ", na.omit(sapply(DEFINED_AB_GROUPS, function(ab) ifelse(tolower(gsub("^AB_", "", ab)) %in% ls(envir = asNamespace("AMR")), paste0("[", tolower(gsub("^AB_", "", ab)), "()] can select: \\cr ", vector_and(paste0(ab_name(eval(parse(text = ab), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), " (", eval(parse(text = ab), envir = asNamespace("AMR")), ")"), quotes = FALSE, sort = TRUE)), character(0)), USE.NAMES = FALSE)), "\n", collapse = "")`
#' @rdname antibiotic_class_selectors
#' @name antibiotic_class_selectors
#' @return When used inside selecting or filtering, this returns a [character] vector of column names, with additional class `"ab_selector"`. When used individually, this returns an ['ab' vector][as.ab()] with all possible antimicrobials that the function would be able to select or filter.
#' @rdname antimicrobial_class_selectors
#' @name antimicrobial_class_selectors
#' @return When used inside selecting or filtering, this returns a [character] vector of column names, with additional class `"amr_selector"`. When used individually, this returns an ['ab' vector][as.ab()] with all possible antimicrobials that the function would be able to select or filter.
#' @export
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
@ -79,7 +88,7 @@
#' # e.g., for betalactams, but not the ones with an enzyme inhibitor:
#' example_isolates %>% select(betalactams(), -betalactams_with_inhibitor())
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' # select only antimicrobials with DDDs for oral treatment
#' example_isolates %>% select(administrable_per_os())
#'
#' # get AMR for all aminoglycosides e.g., per ward:
@ -99,11 +108,11 @@
#' summarise_at(not_intrinsic_resistant(),
#' resistance)
#'
#' # get susceptibility for antibiotics whose name contains "trim":
#' # get susceptibility for antimicrobials whose name contains "trim":
#' example_isolates %>%
#' filter(first_isolate()) %>%
#' group_by(ward) %>%
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
#' summarise(across(amr_selector(name %like% "trim"), susceptibility))
#'
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
#' example_isolates %>%
@ -130,7 +139,7 @@
#'
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
#' example_isolates %>%
#' select(mo, ab_class("mycobact"))
#' select(mo, amr_class("mycobact"))
#'
#' # get bug/drug combinations for only glycopeptides in Gram-positives:
#' example_isolates %>%
@ -160,7 +169,7 @@
#' # select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
#' example_isolates[, c("mo", aminoglycosides())]
#'
#' # select only antibiotic columns with DDDs for oral treatment
#' # select only antimicrobials with DDDs for oral treatment
#' example_isolates[, administrable_per_os()]
#'
#' # filter using any() or all()
@ -171,7 +180,7 @@
#' example_isolates[any(carbapenems()), ]
#' example_isolates[all(carbapenems()), ]
#'
#' # filter with multiple antibiotic selectors using c()
#' # filter with multiple antimicrobial selectors using c()
#' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
#'
#' # filter + select in one go: get penicillins in carbapenem-resistant strains
@ -184,10 +193,10 @@
#' # and erythromycin is not a penicillin:
#' example_isolates[, penicillins() & administrable_per_os()]
#'
#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
#' # very flexible. For instance, to select antibiotic columns with an oral DDD
#' # amr_selector() applies a filter in the `antibiotics` data set and is thus
#' # very flexible. For instance, to select antimicrobials with an oral DDD
#' # of at least 1 gram:
#' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
#' example_isolates[, amr_selector(oral_ddd > 1 & oral_units == "g")]
#'
#'
#' # data.table --------------------------------------------------------------
@ -222,271 +231,305 @@
#' dt[any(carbapenems() == "S"), penicillins(), with = FALSE]
#' }
#' }
ab_class <- function(ab_class,
only_sir_columns = FALSE,
only_treatable = TRUE,
...) {
meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
amr_class <- function(amr_class,
only_sir_columns = FALSE,
only_treatable = TRUE,
return_all = TRUE,
...) {
meet_criteria(amr_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)
ab_select_exec(NULL, only_sir_columns = only_sir_columns, ab_class_args = ab_class, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec(NULL, only_sir_columns = only_sir_columns, amr_class_args = amr_class, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @details The [ab_selector()] function can be used to internally filter the [antibiotics] data set on any results, see *Examples*. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
#' @rdname antimicrobial_class_selectors
#' @details The [amr_selector()] function can be used to internally filter the [antibiotics] data set on any results, see *Examples*. It allows for filtering on a (part of) a certain name, and/or a group name or even a minimum of DDDs for oral treatment. This function yields the highest flexibility, but is also the least user-friendly, since it requires a hard-coded filter to set.
#' @export
ab_selector <- function(filter,
only_sir_columns = FALSE,
only_treatable = TRUE,
...) {
amr_selector <- function(filter,
only_sir_columns = FALSE,
only_treatable = TRUE,
return_all = TRUE,
...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
# 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
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df,
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "ab_selector"
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "amr_selector", return_all = return_all
)
call <- substitute(filter)
agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE],
error = function(e) stop_(e$message, call = -5)
error = function(e) stop_(e$message, call = -5)
)
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "ab_selector",
function_name = "amr_selector",
agents = agents,
ab_group = NULL,
examples = "",
call = call
)
structure(unname(agents),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
aminopenicillins <- function(only_sir_columns = FALSE, ...) {
aminopenicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("aminopenicillins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("aminopenicillins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
antifungals <- function(only_sir_columns = FALSE, ...) {
antifungals <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("antifungals", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("antifungals", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
antimycobacterials <- function(only_sir_columns = FALSE, ...) {
antimycobacterials <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("antimycobacterials", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("antimycobacterials", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
betalactams_with_inhibitor <- function(only_sir_columns = FALSE, ...) {
betalactams_with_inhibitor <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("betalactams_with_inhibitor", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("betalactams_with_inhibitor", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins <- function(only_sir_columns = FALSE, ...) {
cephalosporins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
cephalosporins_1st <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
cephalosporins_2nd <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
cephalosporins_3rd <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
cephalosporins_4th <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
cephalosporins_5th <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
fluoroquinolones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
glycopeptides <- function(only_sir_columns = FALSE, ...) {
glycopeptides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("glycopeptides", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("glycopeptides", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
lincosamides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
lincosamides <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("lincosamides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("lincosamides", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
lipoglycopeptides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
macrolides <- function(only_sir_columns = FALSE, ...) {
macrolides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("macrolides", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
nitrofurans <- function(only_sir_columns = FALSE, ...) {
nitrofurans <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("nitrofurans", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("nitrofurans", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
oxazolidinones <- function(only_sir_columns = FALSE, ...) {
oxazolidinones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("oxazolidinones", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("oxazolidinones", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
penicillins <- function(only_sir_columns = FALSE, ...) {
penicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("penicillins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("penicillins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
phenicols <- function(only_sir_columns = FALSE, ...) {
phenicols <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("phenicols", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("phenicols", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
ab_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
quinolones <- function(only_sir_columns = FALSE, ...) {
quinolones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("quinolones", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
rifamycins <- function(only_sir_columns = FALSE, ...) {
rifamycins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("rifamycins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("rifamycins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
streptogramins <- function(only_sir_columns = FALSE, ...) {
streptogramins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("streptogramins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
tetracyclines <- function(only_sir_columns = FALSE, ...) {
tetracyclines <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("tetracyclines", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("tetracyclines", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
trimethoprims <- function(only_sir_columns = FALSE, ...) {
trimethoprims <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("trimethoprims", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("trimethoprims", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
ureidopenicillins <- function(only_sir_columns = FALSE, ...) {
ureidopenicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
ab_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
amr_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns, return_all = return_all)
}
#' @rdname antibiotic_class_selectors
#' @details The [administrable_per_os()] and [administrable_iv()] functions also rely on the [antibiotics] data set - antibiotic columns will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the [antibiotics] data set.
#' @rdname antimicrobial_class_selectors
#' @details The [administrable_per_os()] and [administrable_iv()] functions also rely on the [antibiotics] data set - antimicrobials will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the [antibiotics] data set.
#' @export
administrable_per_os <- function(only_sir_columns = FALSE, ...) {
administrable_per_os <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
# 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
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df,
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "administrable_per_os"
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "administrable_per_os", return_all = return_all
)
agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$AB_lookup$oral_ddd)), "ab", drop = TRUE]
agents <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$AB_lookup$oral_ddd)), "ab", drop = TRUE]
@ -500,8 +543,8 @@ administrable_per_os <- function(only_sir_columns = FALSE, ...) {
vector_or(
ab_name(
sample(agents_all,
size = min(5, length(agents_all)),
replace = FALSE
size = min(5, length(agents_all)),
replace = FALSE
),
tolower = TRUE,
language = NULL
@ -512,21 +555,22 @@ administrable_per_os <- function(only_sir_columns = FALSE, ...) {
)
)
structure(unname(agents),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @export
administrable_iv <- function(only_sir_columns = FALSE, ...) {
administrable_iv <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
meet_criteria(return_all, allow_class = "logical", has_length = 1)
# 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
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df,
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "administrable_iv"
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "administrable_iv", return_all = return_all
)
agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$AB_lookup$iv_ddd)), "ab", drop = TRUE]
agents <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$AB_lookup$iv_ddd)), "ab", drop = TRUE]
@ -538,13 +582,13 @@ administrable_iv <- function(only_sir_columns = FALSE, ...) {
examples = ""
)
structure(unname(agents),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
#' @rdname antibiotic_class_selectors
#' @rdname antimicrobial_class_selectors
#' @inheritParams eucast_rules
#' @details The [not_intrinsic_resistant()] function can be used to only select antibiotic columns that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of *E. coli* and *K. pneumoniae* and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies `r format_eucast_version_nr(names(EUCAST_VERSION_EXPERT_RULES[1]))` to determine intrinsic resistance, using the [eucast_rules()] function internally. Because of this determination, this function is quite slow in terms of performance.
#' @details The [not_intrinsic_resistant()] function can be used to only select antimicrobials that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of *E. coli* and *K. pneumoniae* and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies `r format_eucast_version_nr(names(EUCAST_VERSION_EXPERT_RULES[1]))` to determine intrinsic resistance, using the [eucast_rules()] function internally. Because of this determination, this function is quite slow in terms of performance.
#' @export
not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, version_expertrules = 3.3, ...) {
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
@ -553,21 +597,21 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
vars_df <- get_current_data(arg_name = NA, call = -2)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
ab_in_data <- get_column_abx(vars_df,
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "not_intrinsic_resistant"
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = "not_intrinsic_resistant", return_all = TRUE
)
# intrinsic vars
vars_df_R <- tryCatch(
sapply(
eucast_rules(vars_df,
col_mo = col_mo,
version_expertrules = version_expertrules,
rules = "expert",
info = FALSE
col_mo = col_mo,
version_expertrules = version_expertrules,
rules = "expert",
info = FALSE
),
function(col) {
tryCatch(!any(is.na(col)) && all(col == "R"),
error = function(e) FALSE
error = function(e) FALSE
)
}
),
@ -592,35 +636,39 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
# find columns that are abx, but also intrinsic R
out <- unname(intersect(ab_in_data, vars_df_R))
structure(out,
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
ab_select_exec <- function(function_name,
only_sir_columns = FALSE,
only_treatable = FALSE,
ab_class_args = NULL) {
amr_select_exec <- function(function_name,
only_sir_columns = FALSE,
only_treatable = FALSE,
amr_class_args = NULL,
return_all = TRUE) {
# get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
# it only takes a couple of milliseconds, so no problem
vars_df <- tryCatch(get_current_data(arg_name = NA, call = -3), error = function(e) NULL)
# to improve speed, get_column_abx() will only run once when e.g. in a select or group call
if (!is.null(vars_df)) {
ab_in_data <- get_column_abx(vars_df,
info = FALSE, only_sir_columns = only_sir_columns,
sort = FALSE, fn = function_name)
info = FALSE,
only_sir_columns = only_sir_columns,
sort = FALSE,
fn = function_name,
return_all = return_all)
}
# untreatable drugs
if (!is.null(vars_df) && only_treatable == TRUE) {
untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam)"), "ab", drop = TRUE]
if (any(untreatable %in% names(ab_in_data))) {
if (message_not_thrown_before(function_name, "ab_class", "untreatable")) {
if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
warning_(
"in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ",
vector_and(
ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
language = NULL,
tolower = TRUE
language = NULL,
tolower = TRUE
),
quotes = FALSE,
sort = TRUE
@ -630,13 +678,13 @@ ab_select_exec <- function(function_name,
ab_in_data <- ab_in_data[!names(ab_in_data) %in% untreatable]
}
}
if (!is.null(vars_df) && length(ab_in_data) == 0) {
message_("No antimicrobial drugs found in the data.")
return(NULL)
}
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
if (is.null(amr_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
ab_group <- NULL
if (isTRUE(function_name == "antifungals")) {
abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antifungals")]
@ -663,22 +711,22 @@ ab_select_exec <- function(function_name,
}
examples <- paste0(" (such as ", vector_or(
ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
tolower = TRUE,
language = NULL
tolower = TRUE,
language = NULL
),
quotes = FALSE
), ")")
} else {
# this for the 'manual' ab_class() function
# this for the 'manual' amr_class() function
abx <- subset(
AMR_env$AB_lookup,
group %like% ab_class_args |
atc_group1 %like% ab_class_args |
atc_group2 %like% ab_class_args
group %like% amr_class_args |
atc_group1 %like% amr_class_args |
atc_group2 %like% amr_class_args
)$ab
ab_group <- find_ab_group(ab_class_args)
function_name <- "ab_class"
examples <- paste0(" (such as ", find_ab_names(ab_class_args, 2), ")")
ab_group <- find_ab_group(amr_class_args)
function_name <- "amr_class"
examples <- paste0(" (such as ", find_ab_names(amr_class_args, 2), ")")
}
if (is.null(vars_df)) {
@ -694,43 +742,43 @@ ab_select_exec <- function(function_name,
"\n\nNow returning a vector of all possible antimicrobials that `" , function_name, "()` can select.")
return(sort(abx))
}
# get the columns with a group names in the chosen ab class
agents <- ab_in_data[names(ab_in_data) %in% abx]
message_agent_names(
function_name = function_name,
agents = agents,
ab_group = ab_group,
examples = examples,
ab_class_args = ab_class_args
amr_class_args = amr_class_args
)
structure(unname(agents),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
#' @method print ab_selector
#' @method print amr_selector
#' @export
#' @noRd
print.ab_selector <- function(x, ...) {
warning_("It should never be needed to print an antibiotic selector class. Are you using data.table? Then add the argument `with = FALSE`, see our examples at `?ab_selector`.",
print.amr_selector <- function(x, ...) {
warning_("It should never be needed to print an antimicrobial selector class. Are you using data.table? Then add the argument `with = FALSE`, see our examples at `?amr_selector`.",
immediate = TRUE)
cat("Class 'ab_selector'\n")
cat("Class 'amr_selector'\n")
print(as.character(x), quote = FALSE)
}
#' @method c ab_selector
#' @method c amr_selector
#' @export
#' @noRd
c.ab_selector <- function(...) {
c.amr_selector <- function(...) {
structure(unlist(lapply(list(...), as.character)),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
all_any_ab_selector <- function(type, ..., na.rm = TRUE) {
all_any_amr_selector <- function(type, ..., na.rm = TRUE) {
cols_ab <- c(...)
result <- cols_ab[toupper(cols_ab) %in% c("S", "SDD", "I", "R", "NI")]
if (length(result) == 0) {
@ -739,13 +787,13 @@ all_any_ab_selector <- function(type, ..., na.rm = TRUE) {
}
cols_ab <- cols_ab[!cols_ab %in% result]
df <- get_current_data(arg_name = NA, call = -3)
if (type == "all") {
scope_fn <- all
} else {
scope_fn <- any
}
x_transposed <- as.list(as.data.frame(t(df[, cols_ab, drop = FALSE]), stringsAsFactors = FALSE))
vapply(
FUN.VALUE = logical(1),
@ -755,26 +803,26 @@ all_any_ab_selector <- function(type, ..., na.rm = TRUE) {
)
}
#' @method all ab_selector
#' @method all amr_selector
#' @export
#' @noRd
all.ab_selector <- function(..., na.rm = FALSE) {
all_any_ab_selector("all", ..., na.rm = na.rm)
all.amr_selector <- function(..., na.rm = FALSE) {
all_any_amr_selector("all", ..., na.rm = na.rm)
}
#' @method any ab_selector
#' @method any amr_selector
#' @export
#' @noRd
any.ab_selector <- function(..., na.rm = FALSE) {
all_any_ab_selector("any", ..., na.rm = na.rm)
any.amr_selector <- function(..., na.rm = FALSE) {
all_any_amr_selector("any", ..., na.rm = na.rm)
}
#' @method all ab_selector_any_all
#' @method all amr_selector_any_all
#' @export
#' @noRd
all.ab_selector_any_all <- function(..., na.rm = FALSE) {
# this is all() on a logical vector from `==.ab_selector` or `!=.ab_selector`
all.amr_selector_any_all <- function(..., na.rm = FALSE) {
# this is all() on a logical vector from `==.amr_selector` or `!=.amr_selector`
# e.g., example_isolates %>% filter(all(carbapenems() == "R"))
# so just return the vector as is, only correcting for na.rm
out <- unclass(c(...))
@ -784,11 +832,11 @@ all.ab_selector_any_all <- function(..., na.rm = FALSE) {
out
}
#' @method any ab_selector_any_all
#' @method any amr_selector_any_all
#' @export
#' @noRd
any.ab_selector_any_all <- function(..., na.rm = FALSE) {
# this is any() on a logical vector from `==.ab_selector` or `!=.ab_selector`
any.amr_selector_any_all <- function(..., na.rm = FALSE) {
# this is any() on a logical vector from `==.amr_selector` or `!=.amr_selector`
# e.g., example_isolates %>% filter(any(carbapenems() == "R"))
# so just return the vector as is, only correcting for na.rm
out <- unclass(c(...))
@ -798,10 +846,10 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
out
}
#' @method == ab_selector
#' @method == amr_selector
#' @export
#' @noRd
`==.ab_selector` <- function(e1, e2) {
`==.amr_selector` <- function(e1, e2) {
calls <- as.character(match.call())
fn_name <- calls[2]
fn_name <- gsub("^(c\\()(.*)(\\))$", "\\2", fn_name)
@ -818,15 +866,15 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
)
}
}
structure(all_any_ab_selector(type = type, e1, e2),
class = c("ab_selector_any_all", "logical")
structure(all_any_amr_selector(type = type, e1, e2),
class = c("amr_selector_any_all", "logical")
)
}
#' @method != ab_selector
#' @method != amr_selector
#' @export
#' @noRd
`!=.ab_selector` <- function(e1, e2) {
`!=.amr_selector` <- function(e1, e2) {
calls <- as.character(match.call())
fn_name <- calls[2]
fn_name <- gsub("^(c\\()(.*)(\\))$", "\\2", fn_name)
@ -846,29 +894,29 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
# this is `!=`, so turn around the values
sir <- c("S", "SDD", "I", "R", "NI")
e2 <- sir[sir != e2]
structure(all_any_ab_selector(type = type, e1, e2),
class = c("ab_selector_any_all", "logical")
structure(all_any_amr_selector(type = type, e1, e2),
class = c("amr_selector_any_all", "logical")
)
}
#' @method & ab_selector
#' @method & amr_selector
#' @export
#' @noRd
`&.ab_selector` <- function(e1, e2) {
`&.amr_selector` <- function(e1, e2) {
# this is only required for base R, since tidyselect has already implemented this
# e.g., for: example_isolates[, penicillins() & administrable_per_os()]
structure(intersect(unclass(e1), unclass(e2)),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
#' @method | ab_selector
#' @method | amr_selector
#' @export
#' @noRd
`|.ab_selector` <- function(e1, e2) {
`|.amr_selector` <- function(e1, e2) {
# this is only required for base R, since tidyselect has already implemented this
# e.g., for: example_isolates[, penicillins() | administrable_per_os()]
structure(union(unclass(e1), unclass(e2)),
class = c("ab_selector", "character")
class = c("amr_selector", "character")
)
}
@ -883,12 +931,12 @@ is_all <- function(el1) {
syscalls %like% paste0("[^_a-zA-Z0-9]all\\(", "(c\\()?", el1)
}
find_ab_group <- function(ab_class_args) {
ab_class_args <- gsub("[^a-zA-Z0-9]", ".*", ab_class_args)
find_ab_group <- function(amr_class_args) {
amr_class_args <- gsub("[^a-zA-Z0-9]", ".*", amr_class_args)
AMR_env$AB_lookup %pm>%
subset(group %like% ab_class_args |
atc_group1 %like% ab_class_args |
atc_group2 %like% ab_class_args) %pm>%
subset(group %like% amr_class_args |
atc_group1 %like% amr_class_args |
atc_group2 %like% amr_class_args) %pm>%
pm_pull(group) %pm>%
unique() %pm>%
tolower() %pm>%
@ -898,32 +946,32 @@ find_ab_group <- function(ab_class_args) {
find_ab_names <- function(ab_group, n = 3) {
ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group)
# try popular first, they have DDDs
drugs <- AMR_env$AB_lookup[which((!is.na(AMR_env$AB_lookup$iv_ddd) | !is.na(AMR_env$AB_lookup$oral_ddd)) &
AMR_env$AB_lookup$name %unlike% " " &
AMR_env$AB_lookup$group %like% ab_group &
AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
AMR_env$AB_lookup$name %unlike% " " &
AMR_env$AB_lookup$group %like% ab_group &
AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
if (length(drugs) < n) {
# now try it all
drugs <- AMR_env$AB_lookup[which((AMR_env$AB_lookup$group %like% ab_group |
AMR_env$AB_lookup$atc_group1 %like% ab_group |
AMR_env$AB_lookup$atc_group2 %like% ab_group) &
AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
AMR_env$AB_lookup$atc_group1 %like% ab_group |
AMR_env$AB_lookup$atc_group2 %like% ab_group) &
AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
}
if (length(drugs) == 0) {
return("??")
}
vector_or(
ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
tolower = TRUE,
language = NULL
tolower = TRUE,
language = NULL
),
quotes = FALSE
)
}
message_agent_names <- function(function_name, agents, ab_group = NULL, examples = "", ab_class_args = NULL, call = NULL) {
message_agent_names <- function(function_name, agents, ab_group = NULL, examples = "", amr_class_args = NULL, call = NULL) {
if (message_not_thrown_before(function_name, sort(agents))) {
if (length(agents) == 0) {
if (is.null(ab_group)) {
@ -942,12 +990,12 @@ message_agent_names <- function(function_name, agents, ab_group = NULL, examples
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
message_(
"For `", function_name, "(",
ifelse(function_name == "ab_class",
paste0("\"", ab_class_args, "\""),
ifelse(!is.null(call),
paste0(deparse(call), collapse = " "),
""
)
ifelse(function_name == "amr_class",
paste0("\"", amr_class_args, "\""),
ifelse(!is.null(call),
paste0(deparse(call), collapse = " "),
""
)
),
")` using ",
ifelse(length(agents) == 1, "column ", "columns "),

2
R/antibiogram.R
View File

@ -31,7 +31,7 @@
#'
#' Create detailed antibiograms with options for traditional, combination, syndromic, and Bayesian WISCA methods. Based on the approaches of Klinker *et al.*, Barbieri *et al.*, and the Bayesian WISCA model (Weighted-Incidence Syndromic Combination Antibiogram) by Bielicki *et al.*, this function provides flexible output formats including plots and tables, ideal for integration with R Markdown and Quarto reports.
#' @param x a [data.frame] containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see [as.sir()])
#' @param antibiotics vector of any antibiotic name or code (will be evaluated with [as.ab()], column name of `x`, or (any combinations of) [antibiotic selectors][antibiotic_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be set to values separated with `"+"`, such as "TZP+TOB" or "cipro + genta", given that columns resembling such antibiotics exist in `x`. See *Examples*.
#' @param antibiotics vector of any antibiotic name or code (will be evaluated with [as.ab()], column name of `x`, or (any combinations of) [antimicrobial selectors][antimicrobial_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be set to values separated with `"+"`, such as "TZP+TOB" or "cipro + genta", given that columns resembling such antibiotics exist in `x`. See *Examples*.
#' @param mo_transform a character to transform microorganism input - must be `"name"`, `"shortname"` (default), `"gramstain"`, or one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
#' @param ab_transform a character to transform antibiotic input - must be one of the column names of the [antibiotics] data set (defaults to `"name"`): `r vector_or(colnames(antibiotics), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
#' @param syndromic_group a column name of `x`, or values calculated to split rows of `x`, e.g. by using [ifelse()] or [`case_when()`][dplyr::case_when()]. See *Examples*.

2
R/custom_antimicrobials.R
View File

@ -108,7 +108,7 @@
#' ab_atc("Co-fluampicil")
#' ab_name("J01CR50")
#'
#' # even antibiotic selectors work
#' # even antimicrobial selectors work
#' x <- data.frame(
#' random_column = "some value",
#' coflu = as.sir("S"),

76
R/guess_ab_col.R
View File

@ -105,7 +105,8 @@ get_column_abx <- function(x,
only_sir_columns = FALSE,
sort = TRUE,
reuse_previous_result = TRUE,
fn = NULL) {
fn = NULL,
return_all = FALSE) {
# check if retrieved before, then get it from package environment
if (isTRUE(reuse_previous_result) && identical(
unique_call_id(
@ -253,47 +254,50 @@ get_column_abx <- function(x,
if (sort == TRUE) {
out <- out[order(names(out), out)]
}
# only keep the first hits, no duplicates
duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
if (length(duplicates) > 0) {
all_okay <- FALSE
}
if (isTRUE(info)) {
if (all_okay == TRUE) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
} else {
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
if (return_all == FALSE) {
# only keep the first hits, no duplicates
duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
if (length(duplicates) > 0) {
all_okay <- FALSE
}
for (i in seq_len(length(out))) {
if (isTRUE(verbose) && !names(out[i]) %in% names(duplicates)) {
message_(
"Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
)
if (isTRUE(info)) {
if (all_okay == TRUE) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
} else {
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
}
if (names(out[i]) %in% names(duplicates)) {
already_set_as <- out[unname(out) == unname(out[i])][1L]
if (names(out)[i] != names(already_set_as)) {
warning_(
paste0(
"Column '", font_bold(out[i]), "' will not be used for ",
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
", as it is already set for ",
names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"
),
add_fn = font_red,
immediate = verbose
for (i in seq_len(length(out))) {
if (isTRUE(verbose) && !names(out[i]) %in% names(duplicates)) {
message_(
"Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
)
}
if (names(out[i]) %in% names(duplicates)) {
already_set_as <- out[unname(out) == unname(out[i])][1L]
if (names(out)[i] != names(already_set_as)) {
warning_(
paste0(
"Column '", font_bold(out[i]), "' will not be used for ",
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
", as it is already set for ",
names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"
),
add_fn = font_red,
immediate = verbose
)
}
}
}
}
}
out <- out[!duplicated(names(out))]
out <- out[!duplicated(unname(out))]
if (sort == TRUE) {
out <- out[order(names(out), out)]
out <- out[!duplicated(names(out))]
out <- out[!duplicated(unname(out))]
if (sort == TRUE) {
out <- out[order(names(out), out)]
}
}
if (!is.null(hard_dependencies)) {

2
R/mean_amr_distance.R
View File

@ -31,7 +31,7 @@
#'
#' Calculates a normalised mean for antimicrobial resistance between multiple observations, to help to identify similar isolates without comparing antibiograms by hand.
#' @param x a vector of class [sir][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes
#' @param ... variables to select (supports [tidyselect language][tidyselect::language] such as `column1:column4` and `where(is.mic)`, and can thus also be [antibiotic selectors][ab_selector()]
#' @param ... variables to select (supports [tidyselect language][tidyselect::language] such as `column1:column4` and `where(is.mic)`, and can thus also be [antimicrobial selectors][amr_selector()]
#' @param combine_SI a [logical] to indicate whether all values of S, SDD, and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`
#' @details The mean AMR distance is effectively [the Z-score](https://en.wikipedia.org/wiki/Standard_score); a normalised numeric value to compare AMR test results which can help to identify similar isolates, without comparing antibiograms by hand.
#'

4
R/mo_source.R
View File

@ -60,10 +60,10 @@
#' 4 | | |
#' ```
#'
#' We save it as `"home/me/ourcodes.xlsx"`. Now we have to set it as a source:
#' We save it as `"/Users/me/Documents/ourcodes.xlsx"`. Now we have to set it as a source:
#'
#' ```
#' set_mo_source("home/me/ourcodes.xlsx")
#' set_mo_source("/Users/me/Documents/ourcodes.xlsx")
#' #> NOTE: Created mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
#' #> "Organisation XYZ" and "mo"

2
R/proportion.R
View File

@ -151,7 +151,7 @@
#' )
#' }
#' if (require("dplyr")) {
#' # scoped dplyr verbs with antibiotic selectors
#' # scoped dplyr verbs with antimicrobial selectors
#' # (you could also use across() of course)
#' example_isolates %>%
#' group_by(ward) %>%

16
R/vctrs.R
View File

@ -34,27 +34,27 @@
# see https://github.com/tidyverse/dplyr/issues/5955 why this is required
# S3: ab_selector ----
# S3: amr_selector ----
# this does not need a .default method since it's used internally only
vec_ptype2.character.ab_selector <- function(x, y, ...) {
vec_ptype2.character.amr_selector <- function(x, y, ...) {
x
}
vec_ptype2.ab_selector.character <- function(x, y, ...) {
vec_ptype2.amr_selector.character <- function(x, y, ...) {
y
}
vec_cast.character.ab_selector <- function(x, to, ...) {
vec_cast.character.amr_selector <- function(x, to, ...) {
unclass(x)
}
# S3: ab_selector_any_all ----
# S3: amr_selector_any_all ----
# this does not need a .default method since it's used internally only
vec_ptype2.logical.ab_selector_any_all <- function(x, y, ...) {
vec_ptype2.logical.amr_selector_any_all <- function(x, y, ...) {
x
}
vec_ptype2.ab_selector_any_all.logical <- function(x, y, ...) {
vec_ptype2.amr_selector_any_all.logical <- function(x, y, ...) {
y
}
vec_cast.logical.ab_selector_any_all <- function(x, to, ...) {
vec_cast.logical.amr_selector_any_all <- function(x, to, ...) {
unclass(x)
}

32
R/zz_deprecated.R
View File

@ -27,14 +27,28 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# #' Deprecated Functions
# #'
# #' These functions are so-called '[Deprecated]'. **They will be removed in a future release.** Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
# #' @keywords internal
# #' @name AMR-deprecated
# #' @rdname AMR-deprecated
# #' @export
# NULL
#' Deprecated Functions
#'
#' These functions are so-called '[Deprecated]'. **They will be removed in a future version of this package.** Using these functions will give a warning with the name of the function it has been replaced by (if there is one).
#' @keywords internal
#' @name AMR-deprecated
#' @rdname AMR-deprecated
NULL
#' @rdname AMR-deprecated
#' @export
ab_class <- function(...) {
deprecation_warning("ab_class", "amr_class")
amr_class(...)
}
#' @rdname AMR-deprecated
#' @export
ab_selector <- function(...) {
deprecation_warning("ab_selector", "amr_selector")
amr_selector(...)
}
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
if (is.null(old)) {
@ -53,7 +67,7 @@ deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_fun
warning_(
ifelse(is.null(new),
paste0("The `", old, "` ", type, " is no longer in use"),
paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
paste0("The `", old, "` ", type, " has been replaced with `", new, "` and will be removed in a future version")
),
ifelse(type == "argument",
". While the old argument still works, it will be removed in a future version, so please update your code.",

16
R/zzz.R
View File

@ -135,14 +135,14 @@ AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
# Support vctrs package for use in e.g. dplyr verbs
# NOTE 2024-02-22 this is the right way - it should be 2 S3 classes in the second argument
# S3: ab_selector
s3_register("vctrs::vec_ptype2", "character.ab_selector")
s3_register("vctrs::vec_ptype2", "ab_selector.character")
s3_register("vctrs::vec_cast", "character.ab_selector")
# S3: ab_selector_any_all
s3_register("vctrs::vec_ptype2", "logical.ab_selector_any_all")
s3_register("vctrs::vec_ptype2", "ab_selector_any_all.logical")
s3_register("vctrs::vec_cast", "logical.ab_selector_any_all")
# S3: amr_selector
s3_register("vctrs::vec_ptype2", "character.amr_selector")
s3_register("vctrs::vec_ptype2", "amr_selector.character")
s3_register("vctrs::vec_cast", "character.amr_selector")
# S3: amr_selector_any_all
s3_register("vctrs::vec_ptype2", "logical.amr_selector_any_all")
s3_register("vctrs::vec_ptype2", "amr_selector_any_all.logical")
s3_register("vctrs::vec_cast", "logical.amr_selector_any_all")
# S3: ab
s3_register("vctrs::vec_ptype2", "ab.default")
s3_register("vctrs::vec_ptype2", "ab.ab")