mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 18:41:58 +02:00
(v1.6.0.9007) documentation custom eucast rules, progress bar as.mo
This commit is contained in:
@ -932,8 +932,8 @@ font_stripstyle <- function(x) {
|
||||
gsub("(?:(?:\\x{001b}\\[)|\\x{009b})(?:(?:[0-9]{1,3})?(?:(?:;[0-9]{0,3})*)?[A-M|f-m])|\\x{001b}[A-M]", "", x, perl = TRUE)
|
||||
}
|
||||
|
||||
progress_ticker <- function(n = 1, n_min = 0, ...) {
|
||||
if (!interactive() || n < n_min) {
|
||||
progress_ticker <- function(n = 1, n_min = 0, print = TRUE, ...) {
|
||||
if (print == FALSE || n < n_min) {
|
||||
pb <- list()
|
||||
pb$tick <- function() {
|
||||
invisible()
|
||||
|
||||
7
R/ab.R
7
R/ab.R
@ -29,7 +29,7 @@
|
||||
#' @inheritSection lifecycle Stable Lifecycle
|
||||
#' @param x character vector to determine to antibiotic ID
|
||||
#' @param flag_multiple_results logical to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
|
||||
#' @param info logical to indicate whether a progress bar should be printed
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to internal functions
|
||||
#' @rdname as.ab
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
@ -90,7 +90,7 @@
|
||||
#' rename_with(as.ab, where(is.rsi))
|
||||
#'
|
||||
#' }
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
meet_criteria(x, allow_class = c("character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
@ -155,8 +155,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
|
||||
}
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
progress <- progress_ticker(n = length(x),
|
||||
n_min = ifelse(isTRUE(info) & isFALSE(fast_mode), 25, length(x) + 1)) # start if n >= 25
|
||||
progress <- progress_ticker(n = length(x), n_min = 25, print = info) # start if n >= 25
|
||||
on.exit(close(progress))
|
||||
}
|
||||
|
||||
|
||||
@ -32,6 +32,7 @@
|
||||
#' @param collapse character to pass on to `paste(, collapse = ...)` to only return one character per element of `text`, see *Examples*
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search logical to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param info logical to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to [as.ab()]
|
||||
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.ab()] function may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
|
||||
#'
|
||||
@ -92,6 +93,7 @@ ab_from_text <- function(text,
|
||||
collapse = NULL,
|
||||
translate_ab = FALSE,
|
||||
thorough_search = NULL,
|
||||
info = interactive(),
|
||||
...) {
|
||||
if (missing(type)) {
|
||||
type <- type[1L]
|
||||
@ -102,12 +104,13 @@ ab_from_text <- function(text,
|
||||
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(translate_ab, allow_NULL = FALSE) # get_translate_ab() will be more informative about what's allowed
|
||||
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
type <- tolower(trimws(type))
|
||||
|
||||
text <- tolower(as.character(text))
|
||||
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5)
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
||||
on.exit(close(progress))
|
||||
|
||||
if (type %like% "(drug|ab|anti)") {
|
||||
|
||||
@ -23,17 +23,76 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Create Custom EUCAST Rules
|
||||
#' Define Custom EUCAST Rules
|
||||
#'
|
||||
#' @inheritSection lifecycle Experimental Lifecycle
|
||||
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
|
||||
#' @inheritSection lifecycle Maturing Lifecycle
|
||||
#' @param ... rules in formula notation, see *Examples*
|
||||
#' @details
|
||||
#' This documentation page will be updated shortly. **This function is experimental.**
|
||||
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
|
||||
#'
|
||||
#' @section How it works:
|
||||
#' ..
|
||||
#'
|
||||
#' It is also possible to define antibiotic groups instead of single antibiotics. The following groups are allowed (case-insensitive): `r vector_and(tolower(DEFINED_AB_GROUPS), quote = "``")`.
|
||||
#' ### Basics
|
||||
#'
|
||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" ~ aminopenicillins == "R")
|
||||
#' ```
|
||||
#'
|
||||
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
|
||||
#'
|
||||
#' ```
|
||||
#' x
|
||||
#' #> A set of custom EUCAST rules:
|
||||
#' #>
|
||||
#' #> 1. If TZP is S then set to S:
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' #>
|
||||
#' #> 2. If TZP is R then set to R:
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' ```
|
||||
#'
|
||||
#' The rules (the part *before* the tilde, in above example `TZP == "S"` and `TZP == "R"`) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column `TZP` must exist. We will create a sample data set and test the rules set:
|
||||
#'
|
||||
#' ```
|
||||
#' df <- data.frame(mo = c("E. coli", "K. pneumoniae"),
|
||||
#' TZP = "R",
|
||||
#' amox = "",
|
||||
#' AMP = "")
|
||||
#' df
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R
|
||||
#' #> 2 K. pneumoniae R
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = x)
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R R R
|
||||
#' #> 2 K. pneumoniae R R R
|
||||
#' ```
|
||||
#'
|
||||
#' ### Using taxonomic properties in rules
|
||||
#'
|
||||
#' There is one exception in variables used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), quote = "``", sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#'
|
||||
#' ```
|
||||
#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = y)
|
||||
#' #> mo TZP amox AMP
|
||||
#' #> 1 E. coli R
|
||||
#' #> 2 K. pneumoniae R R R
|
||||
#' ```
|
||||
#'
|
||||
#' ### Usage of antibiotic group names
|
||||
#'
|
||||
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the antibiotic agents that will be matched when running the rule.
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("``", tolower(x), "``\\cr(", paste0(sort(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE)), collapse = ", "), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' @returns A [list] containing the custom rules
|
||||
#' @export
|
||||
#' @examples
|
||||
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
|
||||
2
R/data.R
2
R/data.R
@ -98,7 +98,7 @@
|
||||
#' @details
|
||||
#' Please note that entries are only based on the Catalogue of Life and the LPSN (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
|
||||
#'
|
||||
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the AMR package returns 2007 for `mo_year("S. pettenkoferi")`.
|
||||
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the `AMR` package returns 2007 for `mo_year("S. pettenkoferi")`.
|
||||
#'
|
||||
#' ## Manual additions
|
||||
#' For convenience, some entries were added manually:
|
||||
|
||||
@ -42,7 +42,7 @@
|
||||
#' @param type type to determine weighed isolates; can be `"keyantibiotics"` or `"points"`, see *Details*
|
||||
#' @param ignore_I logical to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantibiotics"`, see *Details*
|
||||
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when `type = "points"`, see *Details*
|
||||
#' @param info print progress
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
|
||||
#' @param include_unknown logical to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @param include_untested_rsi logical to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], or arguments passed on to [key_antibiotics()] when using [filter_first_weighted_isolate()]
|
||||
|
||||
@ -314,10 +314,8 @@ key_antibiotics_equal <- function(y,
|
||||
|
||||
result <- logical(length(x))
|
||||
|
||||
if (info_needed == TRUE) {
|
||||
p <- progress_ticker(length(x))
|
||||
on.exit(close(p))
|
||||
}
|
||||
p <- progress_ticker(length(x), print = info_needed)
|
||||
on.exit(close(p))
|
||||
|
||||
for (i in seq_len(length(x))) {
|
||||
|
||||
@ -375,8 +373,8 @@ key_antibiotics_equal <- function(y,
|
||||
}
|
||||
}
|
||||
}
|
||||
if (info_needed == TRUE) {
|
||||
close(p)
|
||||
}
|
||||
|
||||
|
||||
close(p)
|
||||
result
|
||||
}
|
||||
|
||||
15
R/like.R
15
R/like.R
@ -35,18 +35,17 @@
|
||||
#' @rdname like
|
||||
#' @export
|
||||
#' @details
|
||||
#' This `%like%` function:
|
||||
#' * Is case-insensitive (use `%like_case%` for case-sensitive matching)
|
||||
#' * Supports multiple patterns
|
||||
#' * Checks if `pattern` is a valid regular expression and sets `fixed = TRUE` if not, to greatly improve speed (vectorised over `pattern`)
|
||||
#' * Always uses compatibility with Perl unless `fixed = TRUE`, to greatly improve speed
|
||||
#' These [like()] and `%like%` functions:
|
||||
#' * Are case-insensitive (use `%like_case%` for case-sensitive matching)
|
||||
#' * Support multiple patterns
|
||||
#' * Check if `pattern` is a valid regular expression and sets `fixed = TRUE` if not, to greatly improve speed (vectorised over `pattern`)
|
||||
#' * Always use compatibility with Perl unless `fixed = TRUE`, to greatly improve speed
|
||||
#'
|
||||
#' Using RStudio? The text `%like%` can also be directly inserted in your code from the Addins menu and can have its own Keyboard Shortcut like `Ctrl+Shift+L` or `Cmd+Shift+L` (see `Tools` > `Modify Keyboard Shortcuts...`).
|
||||
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R), although altered as explained in *Details*.
|
||||
#' @seealso [grepl()]
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @examples
|
||||
#' # simple test
|
||||
#' a <- "This is a test"
|
||||
#' b <- "TEST"
|
||||
#' a %like% b
|
||||
@ -65,12 +64,12 @@
|
||||
#' #> TRUE FALSE FALSE
|
||||
#'
|
||||
#' # get isolates whose name start with 'Ent' or 'ent'
|
||||
#' \donttest{
|
||||
#' example_isolates[which(mo_name() %like% "^ent"), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_name() %like% "^ent")
|
||||
#' }
|
||||
#' }
|
||||
like <- function(x, pattern, ignore.case = TRUE) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(pattern, allow_NA = FALSE)
|
||||
|
||||
2
R/mdro.R
2
R/mdro.R
@ -78,7 +78,7 @@
|
||||
#'
|
||||
#' Custom guidelines can be set with the [custom_mdro_guideline()] function. This is of great importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
|
||||
#'
|
||||
#' If you are familiar with `case_when()` of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation':
|
||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||
#'
|
||||
#' ```
|
||||
#' custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
|
||||
|
||||
9
R/mo.R
9
R/mo.R
@ -38,6 +38,7 @@
|
||||
#' @param reference_df a [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
|
||||
#' @param ignore_pattern a regular expression (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the option `AMR_ignore_pattern`, e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
||||
#' @param language language to translate text like "no growth", which defaults to the system language (see [get_locale()])
|
||||
#' @param info a [logical] to indicate if a progress bar should be printed if more than 25 items are to be coerced, defaults to `TRUE` only in interactive mode
|
||||
#' @param ... other arguments passed on to functions
|
||||
#' @rdname as.mo
|
||||
#' @aliases mo
|
||||
@ -161,6 +162,7 @@ as.mo <- function(x,
|
||||
reference_df = get_mo_source(),
|
||||
ignore_pattern = getOption("AMR_ignore_pattern"),
|
||||
language = get_locale(),
|
||||
info = interactive(),
|
||||
...) {
|
||||
meet_criteria(x, allow_class = c("mo", "data.frame", "list", "character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(Becker, allow_class = c("logical", "character"), has_length = 1)
|
||||
@ -169,7 +171,8 @@ as.mo <- function(x,
|
||||
meet_criteria(reference_df, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(ignore_pattern, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo)
|
||||
@ -227,6 +230,7 @@ as.mo <- function(x,
|
||||
reference_df = reference_df,
|
||||
ignore_pattern = ignore_pattern,
|
||||
language = language,
|
||||
info = info,
|
||||
...)
|
||||
}
|
||||
|
||||
@ -253,6 +257,7 @@ exec_as.mo <- function(x,
|
||||
Lancefield = FALSE,
|
||||
allow_uncertain = TRUE,
|
||||
reference_df = get_mo_source(),
|
||||
info = interactive(),
|
||||
property = "mo",
|
||||
initial_search = TRUE,
|
||||
dyslexia_mode = FALSE,
|
||||
@ -600,7 +605,7 @@ exec_as.mo <- function(x,
|
||||
}
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
progress <- progress_ticker(n = length(x[!already_known]), n_min = 25) # start if n >= 25
|
||||
progress <- progress_ticker(n = length(x[!already_known]), n_min = 25, print = info) # start if n >= 25
|
||||
on.exit(close(progress))
|
||||
}
|
||||
|
||||
|
||||
17
R/zzz.R
17
R/zzz.R
@ -61,20 +61,3 @@ pkg_env$mo_failed <- character(0)
|
||||
}
|
||||
}, silent = TRUE)
|
||||
}
|
||||
|
||||
.onAttach <- function(...) {
|
||||
# show notice in 10% of cases in interactive session
|
||||
if (!interactive() || stats::runif(1) > 0.1 || isTRUE(as.logical(getOption("AMR_silentstart", FALSE)))) {
|
||||
return()
|
||||
}
|
||||
packageStartupMessage(word_wrap("Thank you for using the AMR package! ",
|
||||
"If you have a minute, please anonymously fill in this short questionnaire to improve the package and its functionalities: ",
|
||||
font_blue("https://msberends.github.io/AMR/survey.html\n"),
|
||||
"[prevent his notice with ",
|
||||
font_bold("suppressPackageStartupMessages(library(AMR))"),
|
||||
" or use ",
|
||||
font_bold("options(AMR_silentstart = TRUE)"), "]"))
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user