mirror of
https://github.com/msberends/AMR.git
synced 2026-04-03 01:35:55 +02:00
Compare commits
19 Commits
main
...
51f689b069
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
51f689b069 | ||
|
|
1dabd4df3d | ||
|
|
5173009625 | ||
|
|
80e267f0d1 | ||
|
|
05d3ca941f | ||
|
|
ec310ed76b | ||
|
|
3e4983ff93 | ||
|
|
7218812c99 | ||
|
|
eae14d44bf | ||
|
|
11c175ae19 | ||
|
|
ec3b12b937 | ||
|
|
5ecbc9001e | ||
|
|
8760c6d85a | ||
|
|
3928a3de55 | ||
|
|
10c00ff606 | ||
|
|
b7edf3e548 | ||
|
|
0cc154257a | ||
|
|
4798d2c55e | ||
|
|
ad31fba556 |
@@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 3.0.1.9043
|
||||
Date: 2026-04-02
|
||||
Version: 3.0.1.9038
|
||||
Date: 2026-03-19
|
||||
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
|
||||
@@ -63,8 +63,7 @@ Suggests:
|
||||
tidyselect,
|
||||
tinytest,
|
||||
vctrs,
|
||||
xml2,
|
||||
usethis
|
||||
xml2
|
||||
VignetteBuilder: knitr,rmarkdown
|
||||
URL: https://amr-for-r.org, https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
|
||||
13
NEWS.md
13
NEWS.md
@@ -1,7 +1,6 @@
|
||||
# AMR 3.0.1.9043
|
||||
# AMR 3.0.1.9038
|
||||
|
||||
### New
|
||||
* Support for clinical breakpoints of 2026 of both CLSI and EUCAST, by adding all of their over 5,700 new clinical breakpoints to the `clinical_breakpoints` data set for usage in `as.sir()`. EUCAST 2026 is now the new default guideline for all MIC and disk diffusion interpretations.
|
||||
* Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
|
||||
- `step_mic_log2()` to transform `<mic>` columns with log2, and `step_sir_numeric()` to convert `<sir>` columns to numeric
|
||||
- New `tidyselect` helpers:
|
||||
@@ -24,7 +23,6 @@
|
||||
* Fixed a bug in `as.ab()` where certain AB codes containing "PH" or "TH" (such as `ETH`, `MTH`, `PHE`, `PHN`, `STH`, `THA`, `THI1`) would incorrectly return `NA` when combined in a vector with any untranslatable value (#245)
|
||||
* Fixed a bug in `antibiogram()` for when no antimicrobials are set
|
||||
* Fixed a bug in `as.sir()` where for numeric input the arguments `S`, `I`, and `R` would not be considered (#244)
|
||||
* Fixed a bug in plotting MIC values when `keep_operators = "all"`
|
||||
* Fixed some foreign translations of antimicrobial drugs
|
||||
* Fixed a bug for printing column names to the console when using `mutate_at(vars(...), as.mic)` (#249)
|
||||
* Fixed a bug to disregard `NI` for susceptibility proportion functions
|
||||
@@ -32,7 +30,9 @@
|
||||
* Fixed SIR and MIC coercion of combined values, e.g. `as.sir("<= 0.002; S") ` or `as.mic("S; 0.002")` (#252)
|
||||
|
||||
### Updates
|
||||
* Extensive `cli` integration for better message handling and clickable links in messages and warnings (#191, #265)
|
||||
* Replaced all bare backtick-quoted text in `message_()`, `warning_()`, and `stop_()` calls with proper cli inline markup (`{.arg}`, `{.cls}`, `{.fun}`, `{.pkg}`, `{.code}`); rewrote `print.ab` to use a cli named-vector with `*` bullets and code highlighting when cli is available
|
||||
* Added `format_inline_()` helper that formats a cli-markup string and returns it (rather than emitting it), using `cli::format_inline()` when available and `cli_to_plain()` otherwise; used this in `.onAttach` to replace the duplicated cli/non-cli startup message pattern
|
||||
* All inline `{variable}` / `{expression}` in messaging calls are now pre-evaluated via `paste0()`, so users without cli or glue never see raw template syntax
|
||||
* `mdro()` now infers resistance for a _missing_ base drug column from an _available_ corresponding drug+inhibitor combination showing resistance (e.g., piperacillin is absent but required, while piperacillin/tazobactam available and resistant). Can be set with the new argument `infer_from_combinations`, which defaults to `TRUE` (#209). Note that this can yield a higher MDRO detection (which is a good thing as it has become more reliable).
|
||||
* `susceptibility()` and `resistance()` gained the argument `guideline`, which defaults to EUCAST, for interpreting the 'I' category correctly.
|
||||
* Added to the `antimicrobials` data set: cefepime/taniborbactam (`FTA`), ceftibuten/avibactam (`CTA`), clorobiocin (`CLB`), kasugamycin (`KAS`), ostreogrycin (`OST`), taniborbactam (`TAN`), thiostrepton (`THS`), xeruborbactam (`XER`), and zorbamycin (`ZOR`)
|
||||
@@ -47,6 +47,11 @@
|
||||
* Removed the `"inverse"` option, which has now become redundant
|
||||
* `ab_group()` now returns values consist with the AMR selectors (#246)
|
||||
* Added two new `NA` objects, `NA_ab_` and `NA_mo_`, analogous to base R's `NA_character_` and `NA_integer_`, for use in pipelines that require typed missing values
|
||||
* `message_()`, `warning_()`, `stop_()` now use `cli` markup when available, with plain-text fallback; removed `add_fn` parameter from `message_()`, `warning_()`, `word_wrap()`
|
||||
* New internal `cli_to_plain()` converts `cli` markup to plain text for non-cli path
|
||||
* All internal call sites updated to `cli` glue syntax
|
||||
* CI dev-version and old-tinytest workflows now only run on `main` branch pushes
|
||||
* Single-quoted literal values in messaging calls replaced with `{.val}`, `{.cls}`, `{.field}`, or `{.code}` markup throughout
|
||||
|
||||
|
||||
# AMR 3.0.1
|
||||
|
||||
@@ -30,12 +30,6 @@
|
||||
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and clinical_breakpoints
|
||||
# (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
|
||||
EUCAST_VERSION_BREAKPOINTS <- list(
|
||||
"16.0" = list(
|
||||
version_txt = "v16.0",
|
||||
year = 2026,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
|
||||
),
|
||||
"15.0" = list(
|
||||
version_txt = "v15.0",
|
||||
year = 2025,
|
||||
|
||||
@@ -253,9 +253,12 @@ search_type_in_df <- function(x, type, info = TRUE, add_col_prefix = TRUE) {
|
||||
# WHONET support
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"])
|
||||
if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
|
||||
stop_("Found column {.field ", font_bold(found), "} to be used as input for {.arg ", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"}, but this column contains no valid dates. Transform its values to valid dates first.",
|
||||
call = FALSE
|
||||
stop(
|
||||
font_red(paste0(
|
||||
"Found column '", font_bold(found), "' to be used as input for `", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"`, but this column contains no valid dates. Transform its values to valid dates first."
|
||||
)),
|
||||
call. = FALSE
|
||||
)
|
||||
}
|
||||
} else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) {
|
||||
@@ -301,8 +304,7 @@ search_type_in_df <- function(x, type, info = TRUE, add_col_prefix = TRUE) {
|
||||
if (!is.null(found)) {
|
||||
# this column should contain logicals
|
||||
if (!is.logical(x[, found, drop = TRUE])) {
|
||||
message_(
|
||||
"Column {.field ", font_bold(found), "} found as input for {.arg ", ifelse(add_col_prefix, "col_", ""), type,
|
||||
message_("Column '", font_bold(found), "' found as input for {.arg ", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"}, but this column does not contain {.code TRUE}/{.code FALSE} values and was ignored."
|
||||
)
|
||||
found <- NULL
|
||||
@@ -314,9 +316,9 @@ search_type_in_df <- function(x, type, info = TRUE, add_col_prefix = TRUE) {
|
||||
|
||||
if (!is.null(found) && isTRUE(info)) {
|
||||
if (message_not_thrown_before("search_in_type", type)) {
|
||||
msg <- paste0("Using column {.field ", font_bold(found), "} as input for {.arg ", ifelse(add_col_prefix, "col_", ""), type, "}.")
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `", ifelse(add_col_prefix, "col_", ""), type, "`.")
|
||||
if (type %in% c("keyantibiotics", "keyantimicrobials", "specimen")) {
|
||||
msg <- paste(msg, "Use {.arg ", paste0(ifelse(add_col_prefix, "col_", ""), type), "= FALSE} to prevent this.")
|
||||
msg <- paste(msg, "Use", font_bold(paste0(ifelse(add_col_prefix, "col_", ""), type), "= FALSE"), "to prevent this.")
|
||||
}
|
||||
message_(msg)
|
||||
}
|
||||
@@ -359,9 +361,9 @@ stop_ifnot_installed <- function(package) {
|
||||
if (any(!installed) && any(package == "rstudioapi")) {
|
||||
stop("This function only works in RStudio when using R >= 3.2.", call. = FALSE)
|
||||
} else if (any(!installed)) {
|
||||
stop_(
|
||||
"This requires the ", vector_and(paste0("{.pkg ", package[!installed], "}"), quotes = FALSE), " package.",
|
||||
"\nTry to install with {.fun install.packages}."
|
||||
stop("This requires the ", vector_and(package[!installed]), " package.",
|
||||
"\nTry to install with install.packages().",
|
||||
call. = FALSE
|
||||
)
|
||||
} else {
|
||||
return(invisible())
|
||||
@@ -380,11 +382,32 @@ pkg_is_available <- function(pkg, also_load = FALSE, min_version = NULL) {
|
||||
isTRUE(out)
|
||||
}
|
||||
|
||||
highlight_code <- function(code) {
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
cli::code_highlight(code)
|
||||
} else {
|
||||
code
|
||||
}
|
||||
}
|
||||
|
||||
# Format a cli-markup string for output, with a plain-text fallback when cli is
|
||||
# unavailable. Unlike message_() / warning_() / stop_(), this function returns
|
||||
# the formatted string rather than emitting it, so it can be passed to any
|
||||
# output function (e.g. packageStartupMessage()).
|
||||
format_inline_ <- function(...) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
cli::format_inline(msg)
|
||||
} else {
|
||||
cli_to_plain(msg, envir = parent.frame())
|
||||
}
|
||||
}
|
||||
|
||||
import_fn <- function(name, pkg, error_on_fail = TRUE) {
|
||||
if (isTRUE(error_on_fail)) {
|
||||
stop_ifnot_installed(pkg)
|
||||
}
|
||||
if (pkg == "rstudioapi" && (!in_rstudio() || !interactive())) {
|
||||
if (pkg == "rstudioapi" && !in_rstudio()) {
|
||||
# only allow rstudioapi to be imported if we're in RStudio
|
||||
return(NULL)
|
||||
}
|
||||
@@ -405,30 +428,6 @@ import_fn <- function(name, pkg, error_on_fail = TRUE) {
|
||||
)
|
||||
}
|
||||
|
||||
highlight_code <- function(code) {
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
cli::code_highlight(code)
|
||||
} else {
|
||||
code
|
||||
}
|
||||
}
|
||||
|
||||
# Format a cli-markup string for output, with a plain-text fallback when cli is
|
||||
# unavailable. Unlike message_() / warning_() / stop_(), this function returns
|
||||
# the formatted string rather than emitting it, so it can be passed to any
|
||||
# output function (e.g. packageStartupMessage()).
|
||||
format_inline_ <- function(...) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
if (!cli::ansi_has_hyperlink_support()) {
|
||||
msg <- simplify_help_markup(msg)
|
||||
}
|
||||
cli::format_inline(msg)
|
||||
} else {
|
||||
cli_to_plain(msg, envir = parent.frame())
|
||||
}
|
||||
}
|
||||
|
||||
# Convert cli glue markup to plain text for the non-cli fallback path.
|
||||
# Called by message_(), warning_(), and stop_() when cli is not available.
|
||||
cli_to_plain <- function(msg, envir = parent.frame()) {
|
||||
@@ -465,15 +464,15 @@ cli_to_plain <- function(msg, envir = parent.frame()) {
|
||||
}
|
||||
|
||||
# cli inline markup -> plain-text equivalents (one level of glue nesting allowed)
|
||||
msg <- apply_sub(msg, "\\{\\.fun (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "()`"))
|
||||
msg <- apply_sub(msg, "\\{\\.arg (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "`"))
|
||||
msg <- apply_sub(msg, "\\{\\.code (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "`"))
|
||||
msg <- apply_sub(msg, "\\{\\.val (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0('"', resolve(c), '"'))
|
||||
msg <- apply_sub(msg, "\\{\\.field (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0('"', resolve(c), '"'))
|
||||
msg <- apply_sub(msg, "\\{\\.cls (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("<", resolve(c), ">"))
|
||||
msg <- apply_sub(msg, "\\{\\.pkg (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
||||
msg <- apply_sub(msg, "\\{\\.fun (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "()`"))
|
||||
msg <- apply_sub(msg, "\\{\\.arg (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "`"))
|
||||
msg <- apply_sub(msg, "\\{\\.code (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("`", resolve(c), "`"))
|
||||
msg <- apply_sub(msg, "\\{\\.val (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0('"', resolve(c), '"'))
|
||||
msg <- apply_sub(msg, "\\{\\.field (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0('"', resolve(c), '"'))
|
||||
msg <- apply_sub(msg, "\\{\\.cls (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("<", resolve(c), ">"))
|
||||
msg <- apply_sub(msg, "\\{\\.pkg (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
||||
msg <- apply_sub(msg, "\\{\\.strong (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("*", resolve(c), "*"))
|
||||
msg <- apply_sub(msg, "\\{\\.emph (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("*", resolve(c), "*"))
|
||||
msg <- apply_sub(msg, "\\{\\.emph (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("*", resolve(c), "*"))
|
||||
msg <- apply_sub(msg, "\\{\\.help ([^}]+)\\}", function(c) {
|
||||
# Handle [display text](topic) markdown link format: extract just the display text
|
||||
m <- regmatches(c, regexec("^\\[(.*)\\]\\([^)]*\\)$", c))[[1L]]
|
||||
@@ -484,8 +483,8 @@ cli_to_plain <- function(msg, envir = parent.frame()) {
|
||||
m <- regmatches(c, regexec("^\\[(.*)\\]\\([^)]*\\)$", c))[[1L]]
|
||||
if (length(m) >= 2L) m[2L] else paste0("?", resolve(c))
|
||||
})
|
||||
msg <- apply_sub(msg, "\\{\\.url (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
||||
msg <- apply_sub(msg, "\\{\\.href ([^}]+)\\}", function(c) strsplit(resolve(c), " ", fixed = TRUE)[[1L]][1L])
|
||||
msg <- apply_sub(msg, "\\{\\.url (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
||||
msg <- apply_sub(msg, "\\{\\.href ([^}]+)\\}", function(c) strsplit(resolve(c), " ", fixed = TRUE)[[1L]][1L])
|
||||
|
||||
# bare {variable} or {expression} -> evaluate in caller's environment
|
||||
while (grepl("\\{[^{}]+\\}", msg)) {
|
||||
@@ -552,46 +551,15 @@ word_wrap <- function(...,
|
||||
gsub("(\n| )+$", "", wrapped)
|
||||
}
|
||||
|
||||
simplify_help_markup <- function(msg) {
|
||||
# {.help [{.fun fn}](pkg::fn)} -> {.code fn()}
|
||||
# {.help [display](topic)} -> {.code display}
|
||||
msg <- gsub(
|
||||
"\\{\\.help \\[\\{\\.fun ([^}]+)\\}\\]\\([^)]+\\)\\}",
|
||||
"{.code \\1()}",
|
||||
msg,
|
||||
perl = TRUE
|
||||
)
|
||||
msg <- gsub(
|
||||
"\\{\\.help \\[([^]]+)\\]\\([^)]+\\)\\}",
|
||||
"{.code \\1}",
|
||||
msg,
|
||||
perl = TRUE
|
||||
)
|
||||
# {.topic [display](topic)} -> {.code ?display}
|
||||
msg <- gsub(
|
||||
"\\{\\.topic \\[([^]]+)\\]\\([^)]+\\)\\}",
|
||||
"{.code ?\\1}",
|
||||
msg,
|
||||
perl = TRUE
|
||||
)
|
||||
msg
|
||||
}
|
||||
|
||||
message_ <- function(...,
|
||||
appendLF = TRUE,
|
||||
as_note = TRUE) {
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
if (!cli::ansi_has_hyperlink_support()) {
|
||||
msg <- simplify_help_markup(msg)
|
||||
}
|
||||
if (isTRUE(as_note)) {
|
||||
cli::cli_inform(c("i" = msg), .envir = parent.frame())
|
||||
} else if (isTRUE(appendLF)) {
|
||||
cli::cli_inform(msg, .envir = parent.frame())
|
||||
} else {
|
||||
# This mirrors what rlang::inform() does internally (cat() to stderr), so it behaves consistently with cli_inform() output
|
||||
cat(format_inline_(msg), file = stderr())
|
||||
cli::cli_inform(msg, .envir = parent.frame())
|
||||
}
|
||||
} else {
|
||||
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||
@@ -604,9 +572,6 @@ warning_ <- function(...,
|
||||
call = FALSE) {
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
if (!cli::ansi_has_hyperlink_support()) {
|
||||
msg <- simplify_help_markup(msg)
|
||||
}
|
||||
cli::cli_warn(msg, .envir = parent.frame())
|
||||
} else {
|
||||
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||
@@ -619,9 +584,6 @@ warning_ <- function(...,
|
||||
# - wraps text to never break lines within words (plain-text fallback)
|
||||
stop_ <- function(..., call = TRUE) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
if (!cli::ansi_has_hyperlink_support()) {
|
||||
msg <- simplify_help_markup(msg)
|
||||
}
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
if (isTRUE(call)) {
|
||||
call_obj <- sys.call(-1)
|
||||
@@ -747,7 +709,7 @@ format_included_data_number <- function(data) {
|
||||
paste0(ifelse(rounder == 0, "", "~"), format(round(n, rounder), decimal.mark = ".", big.mark = " "))
|
||||
}
|
||||
|
||||
vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, last_sep = " or ", documentation = FALSE) {
|
||||
vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, last_sep = " or ") {
|
||||
# makes unique and sorts, and this also removed NAs
|
||||
v <- unique(v)
|
||||
has_na <- anyNA(v)
|
||||
@@ -761,25 +723,17 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
v <- rev(v)
|
||||
}
|
||||
if (isTRUE(quotes)) {
|
||||
if (isTRUE(documentation)) {
|
||||
quotes <- '"'
|
||||
} else {
|
||||
# use cli to format as values
|
||||
quotes <- c("{.val ", "}")
|
||||
}
|
||||
quotes <- '"'
|
||||
} else if (isFALSE(quotes)) {
|
||||
quotes <- ""
|
||||
} else {
|
||||
quotes <- quotes[1L]
|
||||
}
|
||||
if (length(quotes) == 1) {
|
||||
quotes <- c(quotes, quotes)
|
||||
}
|
||||
if (isTRUE(initial_captital)) {
|
||||
v[1] <- gsub("^([a-z])", "\\U\\1", v[1], perl = TRUE)
|
||||
}
|
||||
if (length(v) <= 1) {
|
||||
return(paste0(quotes[1], v, quotes[2]))
|
||||
return(paste0(quotes, v, quotes))
|
||||
}
|
||||
if (identical(v, c("I", "R", "S"))) {
|
||||
# class 'sir' should be sorted like this
|
||||
@@ -798,7 +752,7 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
if (is.numeric(v)) {
|
||||
v <- trimws(vapply(FUN.VALUE = character(1), v, format, scientific = FALSE))
|
||||
}
|
||||
quoted <- paste0(quotes[1], v, quotes[2])
|
||||
quoted <- paste0(quotes, v, quotes)
|
||||
quoted[NAs] <- "NA"
|
||||
# all commas except for last item, so will become '"val1", "val2", "val3" or "val4"'
|
||||
paste0(
|
||||
@@ -807,11 +761,10 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
)
|
||||
}
|
||||
|
||||
vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, documentation = FALSE) {
|
||||
vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE) {
|
||||
vector_or(
|
||||
v = v, quotes = quotes, reverse = reverse, sort = sort,
|
||||
initial_captital = initial_captital, documentation = documentation,
|
||||
last_sep = " and "
|
||||
initial_captital = initial_captital, last_sep = " and "
|
||||
)
|
||||
}
|
||||
|
||||
@@ -1107,7 +1060,7 @@ get_current_data <- function(arg_name, call) {
|
||||
} else {
|
||||
examples <- ""
|
||||
}
|
||||
stop_("this function must be used inside a {.pkg dplyr} verb or {.cls data.frame} call",
|
||||
stop_("this function must be used inside a {.pkg dplyr} verb or {.code data.frame} call",
|
||||
examples,
|
||||
call = call
|
||||
)
|
||||
|
||||
45
R/ab.R
45
R/ab.R
@@ -191,13 +191,12 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
|
||||
previously_coerced <- x %in% AMR_env$ab_previously_coerced$x
|
||||
x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)]
|
||||
previously_coerced_mention <- !is.na(x) & x %in% AMR_env$ab_previously_coerced$x & !x %in% AMR_env$AB_lookup$ab & !x %in% AMR_env$AB_lookup$generalised_name
|
||||
previously_coerced_mention <- x %in% AMR_env$ab_previously_coerced$x & !x %in% AMR_env$AB_lookup$ab & !x %in% AMR_env$AB_lookup$generalised_name
|
||||
if (any(previously_coerced_mention) && isTRUE(info) && message_not_thrown_before("as.ab", entire_session = TRUE)) {
|
||||
only_one <- length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) == 1
|
||||
message_(
|
||||
"Returning ", ifelse(only_one, "a ", ""), "previously coerced ",
|
||||
ifelse(only_one, "value for an antimicrobial", "values for various antimicrobials"),
|
||||
". Run {.help [{.fun ab_reset_session}](AMR::ab_reset_session)} to reset this. This note will be shown once per session."
|
||||
"Returning previously coerced ",
|
||||
ifelse(length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) > 1, "value for an antimicrobial", "values for various antimicrobials"),
|
||||
". Run `ab_reset_session()` to reset this. This note will be shown once per session."
|
||||
)
|
||||
}
|
||||
|
||||
@@ -445,7 +444,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
# take failed ATC codes apart from rest
|
||||
if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in {.help [{.fun as.ab}](AMR::as.ab)}: these ATC codes are not (yet) in the antimicrobials data set: ",
|
||||
"in `as.ab()`: these ATC codes are not (yet) in the antimicrobials data set: ",
|
||||
vector_and(x_unknown_ATCs), "."
|
||||
)
|
||||
}
|
||||
@@ -459,14 +458,12 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
x_unknown <- x_unknown[!x_unknown %in% c("", NA)]
|
||||
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in {.help [{.fun as.ab}](AMR::as.ab)}: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
|
||||
"in `as.ab()`: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
|
||||
vector_and(x_unknown), "."
|
||||
)
|
||||
}
|
||||
|
||||
# Throw note about uncertainties
|
||||
x_uncertain <- x_uncertain[!is.na(x_uncertain)]
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[!is.na(AMR_env$ab_previously_coerced$x), ]
|
||||
if (isTRUE(info) && length(x_uncertain) > 0 && fast_mode == FALSE) {
|
||||
x_uncertain <- unique(x_uncertain)
|
||||
if (message_not_thrown_before("as.ab", "uncertainties", x_bak)) {
|
||||
@@ -484,7 +481,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
}
|
||||
message_(
|
||||
"Antimicrobial translation was uncertain for ", examples,
|
||||
". If required, use {.help [{.fun add_custom_antimicrobials}](AMR::add_custom_antimicrobials)} to add custom entries."
|
||||
". If required, use `add_custom_antimicrobials()` to add custom entries."
|
||||
)
|
||||
}
|
||||
}
|
||||
@@ -529,7 +526,7 @@ NA_ab_ <- set_clean_class(NA_character_,
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
|
||||
pillar_shaft.ab <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
|
||||
# add the names to the drugs as mouse-over!
|
||||
if (in_rstudio()) {
|
||||
@@ -556,25 +553,25 @@ print.ab <- function(x, ...) {
|
||||
function_name <- attributes(x)$amr_selector
|
||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||
cli::cli_inform(c(
|
||||
"i" = paste0("This {.cls ab} vector was retrieved using {.fun ", function_name, "}, which should normally be used inside a {.pkg dplyr} verb or {.cls data.frame} call, e.g.:"),
|
||||
paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% select(", function_name, "())"))),
|
||||
paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% select(column_a, column_b, ", function_name, "())"))),
|
||||
paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% filter(any(", function_name, "() == \"R\"))"))),
|
||||
paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data[, ", function_name, "()]"))),
|
||||
paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]")))
|
||||
"i" = paste0("This {.cls ab} vector was retrieved using {.fun ", function_name, "}, which should normally be used inside a {.pkg dplyr} verb or {.code data.frame} call, e.g.:"),
|
||||
"*" = highlight_code(paste0("your_data %>% select(", function_name, "()")),
|
||||
"*" = highlight_code(paste0("your_data %>% select(column_a, column_b, ", function_name, "()")),
|
||||
"*" = highlight_code(paste0("your_data %>% filter(any(", function_name, "() == \"R\"))")),
|
||||
"*" = highlight_code(paste0("your_data[, ", function_name, "()]")),
|
||||
"*" = highlight_code(paste0("your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"))
|
||||
))
|
||||
} else {
|
||||
message(word_wrap(paste0(
|
||||
"This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a dplyr verb or data.frame call, e.g.:\n",
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
|
||||
), as_note = TRUE))
|
||||
}
|
||||
}
|
||||
cat(format_inline_("Class {.cls ab}\n"))
|
||||
cat("Class 'ab'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
@@ -718,7 +715,7 @@ get_translate_ab <- function(translate_ab) {
|
||||
} else {
|
||||
translate_ab <- tolower(translate_ab)
|
||||
stop_ifnot(translate_ab %in% colnames(AMR::antimicrobials),
|
||||
"invalid value for {.arg translate_ab}, this must be a column name of the {.help [antimicrobials](AMR::antimicrobials)} data set\n",
|
||||
"invalid value for {.arg translate_ab}, this must be a column name of the {.topic [antimicrobials](AMR::antimicrobials)} data set\n",
|
||||
"or {.code TRUE} (equals {.val name}) or {.code FALSE} to not translate at all.",
|
||||
call = FALSE
|
||||
)
|
||||
|
||||
@@ -265,7 +265,7 @@ ab_ddd <- function(x, administration = "oral", ...) {
|
||||
|
||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
warning_(
|
||||
"in {.help [{.fun ab_ddd}](AMR::ab_ddd)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"in `ab_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
@@ -285,7 +285,7 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
|
||||
|
||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
warning_(
|
||||
"in {.help [{.fun ab_ddd_units}](AMR::ab_ddd_units)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"in `ab_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
@@ -424,7 +424,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
||||
)
|
||||
if (any(x %in% c("", NA))) {
|
||||
warning_(
|
||||
"in {.help [{.fun set_ab_names}](AMR::set_ab_names)}: no ", property, " found for column(s): ",
|
||||
"in `set_ab_names()`: no ", property, " found for column(s): ",
|
||||
vector_and(vars[x %in% c("", NA)], sort = FALSE)
|
||||
)
|
||||
x[x %in% c("", NA)] <- vars[x %in% c("", NA)]
|
||||
|
||||
@@ -678,7 +678,7 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
|
||||
agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])]
|
||||
if (length(agents) > 0 &&
|
||||
message_not_thrown_before("not_intrinsic_resistant", sort(agents))) {
|
||||
agents_formatted <- paste0("{.field ", font_bold(agents, collapse = NULL), "}")
|
||||
agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'")
|
||||
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
|
||||
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
|
||||
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
|
||||
@@ -722,7 +722,7 @@ amr_select_exec <- function(function_name,
|
||||
if (any(untreatable %in% names(ab_in_data))) {
|
||||
if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
|
||||
warning_(
|
||||
"in {.help [{.fun ", function_name, "}](AMR::", function_name, ")}: some drugs were ignored since they cannot be used for treatment: ",
|
||||
"in `", function_name, "()`: some drugs were ignored since they cannot be used for treatment: ",
|
||||
vector_and(
|
||||
ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
|
||||
language = NULL,
|
||||
@@ -797,14 +797,14 @@ amr_select_exec <- function(function_name,
|
||||
if (only_treatable == TRUE) {
|
||||
if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
|
||||
message_(
|
||||
"in {.help [{.fun ", function_name, "}](AMR::", function_name, ")}: ",
|
||||
"in `", function_name, "()`: ",
|
||||
vector_and(
|
||||
paste0(
|
||||
ab_name(abx[abx %in% untreatable],
|
||||
language = NULL,
|
||||
tolower = TRUE
|
||||
),
|
||||
" ({.field ", font_bold(abx[abx %in% untreatable], collapse = NULL), "})"
|
||||
" (`", abx[abx %in% untreatable], "`)"
|
||||
),
|
||||
quotes = FALSE,
|
||||
sort = TRUE,
|
||||
@@ -837,10 +837,10 @@ amr_select_exec <- function(function_name,
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.amr_selector <- function(x, ...) {
|
||||
warning_("It should never be needed to print an antimicrobial selector class. Are you using {.pkg data.table}? Then add the argument {.arg with = FALSE}, see our examples at {.help [{.fun amr_selector}](AMR::amr_selector)}.",
|
||||
warning_("It should never be needed to print an antimicrobial selector class. Are you using {.pkg data.table}? Then add the argument {.code with = FALSE}, see our examples at {.help [{.fun amr_selector}](AMR::amr_selector)}.",
|
||||
immediate = TRUE
|
||||
)
|
||||
cat(format_inline_("Class {.cls amr_selector}\n"))
|
||||
cat("Class 'amr_selector'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
@@ -857,7 +857,7 @@ all_any_amr_selector <- function(type, ..., na.rm = TRUE) {
|
||||
cols_ab <- c(...)
|
||||
result <- cols_ab[toupper(cols_ab) %in% VALID_SIR_LEVELS]
|
||||
if (length(result) == 0) {
|
||||
message_("Filtering ", type, " of columns ", vector_and(paste0("{.field ", font_bold(cols_ab, collapse = NULL), "}"), quotes = FALSE), " to only contain values ", vector_or(VALID_SIR_LEVELS))
|
||||
message_("Filtering ", type, " of columns ", vector_and(font_bold(cols_ab, collapse = NULL), quotes = "'"), ' to contain value "S", "I" or "R"')
|
||||
result <- VALID_SIR_LEVELS
|
||||
}
|
||||
cols_ab <- cols_ab[!cols_ab %in% result]
|
||||
@@ -937,7 +937,7 @@ any.amr_selector_any_all <- function(..., na.rm = FALSE) {
|
||||
if (length(e1) > 1) {
|
||||
message_(
|
||||
"Assuming a filter on ", type, " ", length(e1), " ", gsub("[\\(\\)]", "", fn_name),
|
||||
". Wrap around {.fun all} or {.fun any} to prevent this note."
|
||||
". Wrap around `all()` or `any()` to prevent this note."
|
||||
)
|
||||
}
|
||||
}
|
||||
@@ -962,7 +962,7 @@ any.amr_selector_any_all <- function(..., na.rm = FALSE) {
|
||||
if (length(e1) > 1) {
|
||||
message_(
|
||||
"Assuming a filter on ", type, " ", length(e1), " ", gsub("[\\(\\)]", "", fn_name),
|
||||
". Wrap around {.fun all} or {.fun any} to prevent this note."
|
||||
". Wrap around `all()` or `any()` to prevent this note."
|
||||
)
|
||||
}
|
||||
}
|
||||
@@ -1071,12 +1071,12 @@ message_agent_names <- function(function_name, agents, ab_group = NULL, examples
|
||||
message_("No antimicrobial drugs of class '", ab_group, "' found", examples, ".")
|
||||
}
|
||||
} else {
|
||||
agents_formatted <- paste0("{.field ", font_bold(agents, collapse = NULL), "}")
|
||||
agents_formatted <- paste0("'", font_bold(agents, collapse = NULL), "'")
|
||||
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
|
||||
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
|
||||
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
|
||||
message_(
|
||||
"For {.help [", function_name, "(",
|
||||
"For `", function_name, "(",
|
||||
ifelse(function_name == "amr_class",
|
||||
paste0("\"", amr_class_args, "\""),
|
||||
ifelse(!is.null(call),
|
||||
@@ -1084,7 +1084,7 @@ message_agent_names <- function(function_name, agents, ab_group = NULL, examples
|
||||
""
|
||||
)
|
||||
),
|
||||
")](AMR::", function_name, ")} using ",
|
||||
")` using ",
|
||||
ifelse(length(agents) == 1, "column ", "columns "),
|
||||
vector_and(agents_formatted, quotes = FALSE, sort = FALSE)
|
||||
)
|
||||
|
||||
@@ -583,9 +583,9 @@ antibiogram.default <- function(x,
|
||||
if (length(existing_ab_combined_cols) > 0 && !is.null(ab_transform)) {
|
||||
ab_transform <- NULL
|
||||
warning_(
|
||||
"Detected column name(s) containing the '+' character, which conflicts with the expected syntax in {.help [{.fun antibiogram}](AMR::antibiogram)}: the '+' is used to combine separate antimicrobial drug columns (e.g., \"AMP+GEN\").\n\n",
|
||||
"To avoid incorrectly guessing which antimicrobials this represents, {.arg ab_transform} was automatically set to {.code NULL}.\n\n",
|
||||
"If this is unintended, please rename the column(s) to avoid using '+' in the name, or set {.code ab_transform = NULL} explicitly to suppress this message."
|
||||
"Detected column name(s) containing the '+' character, which conflicts with the expected syntax in `antibiogram()`: the '+' is used to combine separate antimicrobial drug columns (e.g., \"AMP+GEN\").\n\n",
|
||||
"To avoid incorrectly guessing which antimicrobials this represents, `ab_transform` was automatically set to `NULL`.\n\n",
|
||||
"If this is unintended, please rename the column(s) to avoid using '+' in the name, or set `ab_transform = NULL` explicitly to suppress this message."
|
||||
)
|
||||
}
|
||||
antimicrobials <- ab_trycatch
|
||||
|
||||
@@ -180,7 +180,7 @@ atc_online_property <- function(atc_code,
|
||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||
|
||||
if (length(out) == 0) {
|
||||
message_("{.help [{.fun atc_online_property}](AMR::atc_online_property)}: no properties found for ATC ", atc_code[i], ". Please check {.href ", atc_url, " this WHOCC webpage}.")
|
||||
message_("in {.help [{.fun atc_online_property}](AMR::atc_online_property)}: no properties found for ATC ", atc_code[i], ". Please check {.href ", atc_url, " this WHOCC webpage}.")
|
||||
returnvalue[i] <- NA
|
||||
next
|
||||
}
|
||||
|
||||
10
R/av.R
10
R/av.R
@@ -475,7 +475,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
# take failed ATC codes apart from rest
|
||||
if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in {.help [{.fun as.av}](AMR::as.av)}: these ATC codes are not (yet) in the antivirals data set: ",
|
||||
"in `as.av()`: these ATC codes are not (yet) in the antivirals data set: ",
|
||||
vector_and(x_unknown_ATCs), "."
|
||||
)
|
||||
}
|
||||
@@ -486,7 +486,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
)
|
||||
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in {.help [{.fun as.av}](AMR::as.av)}: these values could not be coerced to a valid antiviral drug ID: ",
|
||||
"in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
|
||||
vector_and(x_unknown), "."
|
||||
)
|
||||
}
|
||||
@@ -511,8 +511,8 @@ is.av <- function(x) {
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
|
||||
pillar_shaft.av <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[!is.na(x)] <- gsub("+", pillar::style_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
@@ -526,7 +526,7 @@ type_sum.av <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.av <- function(x, ...) {
|
||||
cat(format_inline_("Class {.cls av}\n"))
|
||||
cat("Class 'av'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@@ -162,7 +162,7 @@ av_ddd <- function(x, administration = "oral", ...) {
|
||||
|
||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
warning_(
|
||||
"in {.help [{.fun av_ddd}](AMR::av_ddd)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
@@ -182,7 +182,7 @@ av_ddd_units <- function(x, administration = "oral", ...) {
|
||||
|
||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
warning_(
|
||||
"in {.help [{.fun av_ddd_units}](AMR::av_ddd_units)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
|
||||
@@ -84,7 +84,7 @@ bug_drug_combinations <- function(x,
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
stop_if(is.null(col_mo), "{.arg col_mo} must be set")
|
||||
} else {
|
||||
stop_ifnot(col_mo %in% colnames(x), "column {.field ", font_bold(col_mo), "} ({.arg col_mo}) not found")
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' ({.arg col_mo}) not found")
|
||||
}
|
||||
|
||||
x.bak <- x
|
||||
|
||||
@@ -166,5 +166,5 @@ clear_custom_antimicrobials <- function() {
|
||||
n2 <- nrow(AMR_env$AB_lookup)
|
||||
AMR_env$custom_ab_codes <- character(0)
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(AMR_env$ab_previously_coerced$ab %in% AMR_env$AB_lookup$ab), , drop = FALSE]
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.help [antimicrobials](AMR::antimicrobials)} data set.")
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.topic [antimicrobials](AMR::antimicrobials)} data set.")
|
||||
}
|
||||
|
||||
@@ -80,7 +80,7 @@
|
||||
#'
|
||||
#' ### Using taxonomic properties in rules
|
||||
#'
|
||||
#' There is one exception in columns 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), sort = FALSE, documentation = TRUE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#' There is one exception in columns 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), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#'
|
||||
#' ```r
|
||||
#' y <- custom_eucast_rules(
|
||||
|
||||
@@ -235,9 +235,9 @@ print.custom_mdro_guideline <- function(x, ...) {
|
||||
for (i in seq_len(length(x))) {
|
||||
rule <- x[[i]]
|
||||
rule$query <- format_custom_query_rule(rule$query)
|
||||
cat("\u00a0\u00a0", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
|
||||
cat(" ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
|
||||
}
|
||||
cat("\u00a0\u00a0", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
|
||||
cat(" ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
|
||||
cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
|
||||
if (isTRUE(attributes(x)$as_factor)) {
|
||||
cat("Results will be of class 'factor', with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
|
||||
@@ -260,7 +260,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||
)
|
||||
if (identical(qry, "error")) {
|
||||
warning_("in {.help [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i,
|
||||
" ({.code ", as.character(guideline[[i]]$query), "}) was ignored because of this error message: ",
|
||||
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
||||
AMR_env$err_msg,
|
||||
call = FALSE
|
||||
)
|
||||
|
||||
@@ -128,7 +128,7 @@
|
||||
#' }
|
||||
add_custom_microorganisms <- function(x) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
stop_ifnot("genus" %in% tolower(colnames(x)), "{.arg x} must contain column {.code genus}.")
|
||||
stop_ifnot("genus" %in% tolower(colnames(x)), "{.arg x} must contain column 'genus'.")
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
|
||||
8
R/disk.R
8
R/disk.R
@@ -119,9 +119,9 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
cur_col <- get_current_column()
|
||||
warning_("in {.help [{.fun as.disk}](AMR::as.disk)}: ", na_after - na_before, " result",
|
||||
warning_("in {.fun as.disk}: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
@@ -162,7 +162,7 @@ is.disk <- function(x) {
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
|
||||
pillar_shaft.disk <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
create_pillar_column(out, align = "right", width = 2)
|
||||
}
|
||||
|
||||
@@ -170,7 +170,7 @@ pillar_shaft.disk <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.disk <- function(x, ...) {
|
||||
cat(format_inline_("Class {.cls disk}\n"))
|
||||
cat("Class 'disk'\n")
|
||||
print(as.integer(x), quote = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@@ -333,7 +333,7 @@ first_isolate <- function(x = NULL,
|
||||
check_columns_existance <- function(column, tblname = x) {
|
||||
if (!is.null(column)) {
|
||||
stop_ifnot(column %in% colnames(tblname),
|
||||
"Column {.code ", column, "} not found.",
|
||||
"Column '{column}' not found.",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
@@ -448,15 +448,13 @@ first_isolate <- function(x = NULL,
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "type")) {
|
||||
if (type == "keyantimicrobials") {
|
||||
message_(
|
||||
"Basing inclusion on key antimicrobials, ",
|
||||
message_("Basing inclusion on key antimicrobials, ",
|
||||
ifelse(ignore_I == FALSE, "not ", ""),
|
||||
"ignoring I"
|
||||
)
|
||||
}
|
||||
if (type == "points") {
|
||||
message_(
|
||||
"Basing inclusion on all antimicrobial results, using a points threshold of ",
|
||||
message_("Basing inclusion on all antimicrobial results, using a points threshold of ",
|
||||
points_threshold
|
||||
)
|
||||
}
|
||||
@@ -554,7 +552,7 @@ first_isolate <- function(x = NULL,
|
||||
format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark
|
||||
),
|
||||
" isolates with a microbial ID 'UNKNOWN' (in column {.field ", font_bold(col_mo), "})"
|
||||
" isolates with a microbial ID 'UNKNOWN' (in column '", font_bold(col_mo), "')"
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
|
||||
@@ -565,7 +563,7 @@ first_isolate <- function(x = NULL,
|
||||
"Excluding ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark
|
||||
),
|
||||
" isolates with a microbial ID `NA` (in column {.field ", font_bold(col_mo), "})"
|
||||
" isolates with a microbial ID `NA` (in column '", font_bold(col_mo), "')"
|
||||
)
|
||||
}
|
||||
x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
|
||||
|
||||
@@ -86,7 +86,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_s
|
||||
} else {
|
||||
if (isTRUE(verbose)) {
|
||||
message_(
|
||||
"Using column {.field ", font_bold(ab_result), "} as input for ", search_string,
|
||||
"Using column '", font_bold(ab_result), "' as input for ", search_string,
|
||||
" (", ab_name(search_string, language = NULL, tolower = TRUE), ")."
|
||||
)
|
||||
}
|
||||
@@ -146,7 +146,7 @@ get_column_abx <- function(x,
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(sort, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (isTRUE(info) && message_not_thrown_before("get_column_abx", colnames(x))) {
|
||||
if (isTRUE(info)) {
|
||||
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
|
||||
@@ -275,7 +275,7 @@ get_column_abx <- function(x,
|
||||
for (i in seq_len(length(out))) {
|
||||
if (isTRUE(verbose) && !out[i] %in% duplicates) {
|
||||
message_(
|
||||
"Using column {.field ", font_bold(out[i]), "} as input for ", names(out)[i],
|
||||
"Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
|
||||
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
|
||||
)
|
||||
}
|
||||
@@ -284,7 +284,7 @@ get_column_abx <- function(x,
|
||||
if (names(out)[i] != already_set_as) {
|
||||
message_(
|
||||
paste0(
|
||||
"Column {.field ", font_bold(out[i]), "} will not be used for ",
|
||||
"Column '", font_bold(out[i]), "' will not be used for ",
|
||||
names(out)[i], " (", suppressMessages(ab_name(names(out)[i], tolower = TRUE, language = NULL, fast_mode = TRUE)), ")",
|
||||
", as this antimicrobial has already been set."
|
||||
)
|
||||
|
||||
@@ -76,7 +76,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".
|
||||
#' @inheritParams first_isolate
|
||||
#' @details
|
||||
#' **Note:** This function does not translate MIC or disk values to SIR values. Use [as.sir()] for that. \cr
|
||||
#' **Note:** This function does not translate MIC values to SIR values. Use [as.sir()] for that. \cr
|
||||
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
||||
#'
|
||||
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The `AMR` package contains the full microbial taxonomy updated until `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`, see [microorganisms].
|
||||
@@ -163,7 +163,7 @@ interpretive_rules <- function(x,
|
||||
rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")),
|
||||
guideline = getOption("AMR_guideline", "EUCAST"),
|
||||
verbose = FALSE,
|
||||
version_breakpoints = 16.0,
|
||||
version_breakpoints = 15.0,
|
||||
version_expected_phenotypes = 1.2,
|
||||
version_expertrules = 3.3,
|
||||
ampc_cephalosporin_resistance = NA,
|
||||
@@ -329,7 +329,7 @@ interpretive_rules <- function(x,
|
||||
if (!"AMP" %in% names(cols_ab) && "AMX" %in% names(cols_ab)) {
|
||||
# ampicillin column is missing, but amoxicillin is available
|
||||
if (isTRUE(info)) {
|
||||
message_("Using column {.field ", font_bold(cols_ab[names(cols_ab) == "AMX"]), "} as input for ampicillin since many EUCAST rules depend on it.")
|
||||
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
|
||||
}
|
||||
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
||||
}
|
||||
@@ -510,8 +510,8 @@ interpretive_rules <- function(x,
|
||||
|
||||
## Set base to R where base + enzyme inhibitor is R ----
|
||||
rule_current <- paste0(
|
||||
ab_enzyme$base_name[i], " ({.field ", font_bold(col_base), "}) = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " ({.field ", font_bold(col_enzyme), "}) = R"
|
||||
ab_enzyme$base_name[i], " (`", col_base, "`) = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " (`", col_enzyme, "`) = R"
|
||||
)
|
||||
if (isTRUE(info)) {
|
||||
cat(word_wrap(rule_current,
|
||||
@@ -551,8 +551,8 @@ interpretive_rules <- function(x,
|
||||
|
||||
## Set base + enzyme inhibitor to S where base is S ----
|
||||
rule_current <- paste0(
|
||||
ab_enzyme$enzyme_name[i], " ({.field ", font_bold(col_enzyme), "}) = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " ({.field ", font_bold(col_base), "}) = S"
|
||||
ab_enzyme$enzyme_name[i], " (`", col_enzyme, "`) = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " (`", col_base, "`) = S"
|
||||
)
|
||||
|
||||
if (isTRUE(info)) {
|
||||
@@ -661,10 +661,9 @@ interpretive_rules <- function(x,
|
||||
ab <- gsub("-S$", "", ab_s)
|
||||
if (ab %in% names(cols_ab) && !ab_s %in% names(cols_ab)) {
|
||||
if (isTRUE(info)) {
|
||||
message_(
|
||||
"Using column {.field ", font_bold(cols_ab[names(cols_ab) == ab]),
|
||||
"} as ", ab_name(ab_s, language = NULL, tolower = TRUE),
|
||||
" since a column {.code ", ab_s, "} is missing but required for the chosen rules"
|
||||
message_("Using column '", cols_ab[names(cols_ab) == ab],
|
||||
"' as ", ab_name(ab_s, language = NULL, tolower = TRUE),
|
||||
" since a column '", ab_s, "' is missing but required for the chosen rules"
|
||||
)
|
||||
}
|
||||
cols_ab <- c(cols_ab, stats::setNames(unname(cols_ab[names(cols_ab) == ab]), ab_s))
|
||||
@@ -806,7 +805,7 @@ interpretive_rules <- function(x,
|
||||
")$"
|
||||
)
|
||||
} else if (like_is_one_of != "like") {
|
||||
stop("invalid value for column {.field like.is.one_of}", call. = FALSE)
|
||||
stop("invalid value for column 'like.is.one_of'", call. = FALSE)
|
||||
}
|
||||
|
||||
if (is.na(source_antibiotics)) {
|
||||
|
||||
@@ -182,7 +182,7 @@ key_antimicrobials <- function(x = NULL,
|
||||
any(filter, na.rm = TRUE) &&
|
||||
message_not_thrown_before("key_antimicrobials", name)) {
|
||||
warning_(
|
||||
"in {.help [{.fun key_antimicrobials}](AMR::key_antimicrobials)}: ",
|
||||
"in `key_antimicrobials()`: ",
|
||||
ifelse(values_new_length == 0,
|
||||
"No columns available ",
|
||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
||||
|
||||
6
R/mdro.R
6
R/mdro.R
@@ -476,7 +476,7 @@ mdro <- function(x = NULL,
|
||||
if (!"AMP" %in% names(cols_ab) && "AMX" %in% names(cols_ab)) {
|
||||
# ampicillin column is missing, but amoxicillin is available
|
||||
if (isTRUE(info)) {
|
||||
message_("Using column {.field ", font_bold(cols_ab[names(cols_ab) == "AMX"]), "} as input for ampicillin since many MDRO rules depend on it.")
|
||||
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.")
|
||||
}
|
||||
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
||||
}
|
||||
@@ -1888,8 +1888,8 @@ mdro <- function(x = NULL,
|
||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||
if (message_not_thrown_before("mdro", "availability")) {
|
||||
warning_(
|
||||
"in {.help [{.fun mdro}](AMR::mdro)}: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with {.arg pct_required_classes})"
|
||||
"in `mdro()`: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)"
|
||||
)
|
||||
}
|
||||
# set these -1s to NA
|
||||
|
||||
29
R/mic.R
29
R/mic.R
@@ -72,7 +72,7 @@ COMMON_MIC_VALUES <- c(
|
||||
#' ```
|
||||
#' x <- random_mic(10)
|
||||
#' x
|
||||
#' #> Class <mic>
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
#'
|
||||
#' is.factor(x)
|
||||
@@ -89,7 +89,7 @@ COMMON_MIC_VALUES <- c(
|
||||
#'
|
||||
#' ```
|
||||
#' x[x > 4]
|
||||
#' #> Class <mic>
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 8 8 64 >=128 32 32 16
|
||||
#'
|
||||
#' df <- data.frame(x, hospital = "A")
|
||||
@@ -174,7 +174,7 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2
|
||||
keep_operators <- "none"
|
||||
}
|
||||
|
||||
if (any(is.mic(x)) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
|
||||
if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
|
||||
if (isTRUE(round_to_next_log2)) {
|
||||
x <- roundup_to_nearest_log2(x)
|
||||
}
|
||||
@@ -269,9 +269,9 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
cur_col <- get_current_column()
|
||||
warning_("in {.help [{.fun as.mic}](AMR::as.mic)}: ", na_after - na_before, " result",
|
||||
warning_("in {.fun as.mic}: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
@@ -322,17 +322,16 @@ NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE)
|
||||
#' @export
|
||||
rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, round_to_next_log2 = FALSE) {
|
||||
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical", "mic"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
|
||||
if (is.numeric(mic_range)) {
|
||||
mic_range <- trimws(format(mic_range, scientific = FALSE))
|
||||
mic_range <- gsub("[.]0+$", "", mic_range)
|
||||
mic_range[mic_range == "NA"] <- NA_character_
|
||||
} else if (any(is.mic(mic_range))) {
|
||||
} else if (is.mic(mic_range)) {
|
||||
mic_range <- as.character(mic_range)
|
||||
}
|
||||
stop_ifnot(
|
||||
all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
"Values in {.arg mic_range} must be valid MIC values. ",
|
||||
"Values in `mic_range` must be valid MIC values. ",
|
||||
"The allowed range is ", format(as.double(as.mic(VALID_MIC_LEVELS)[1]), scientific = FALSE), " to ", format(as.double(as.mic(VALID_MIC_LEVELS)[length(VALID_MIC_LEVELS)]), scientific = FALSE), ". ",
|
||||
"Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), "."
|
||||
)
|
||||
@@ -449,12 +448,16 @@ pillar_shaft.mic <- function(x, ...) {
|
||||
crude_numbers <- as.double(x)
|
||||
operators <- gsub("[^<=>]+", "", as.character(x))
|
||||
# colourise operators
|
||||
operators[!is.na(operators) & operators != ""] <- pillar::style_subtle(operators[!is.na(operators) & operators != ""])
|
||||
operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL)
|
||||
out <- trimws(paste0(operators, trimws(format(crude_numbers))))
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
# make trailing zeroes less visible
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", pillar::style_subtle("\\1"), out[out %like% "[.]"], perl = TRUE)
|
||||
|
||||
if (is_dark()) {
|
||||
fn <- font_silver
|
||||
} else {
|
||||
fn <- font_white
|
||||
}
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", fn("\\1"), out[out %like% "[.]"], perl = TRUE)
|
||||
create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
|
||||
}
|
||||
|
||||
@@ -472,7 +475,7 @@ type_sum.mic <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mic <- function(x, ...) {
|
||||
cat(format_inline_("Class {.cls mic}"))
|
||||
cat("Class 'mic'")
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
|
||||
}
|
||||
|
||||
163
R/mo.R
163
R/mo.R
@@ -249,7 +249,7 @@ as.mo <- function(x,
|
||||
if (length(which(ind)) > 0 && isTRUE(info) && message_not_thrown_before("as.mo_microorganisms.codes", is.na(out), toupper(x))) {
|
||||
message_(
|
||||
"Retrieved value", ifelse(sum(ind) > 1, "s", ""),
|
||||
" from the {.help [microorganisms.codes](AMR::microorganisms.codes)} data set for ", vector_and(toupper(x)[ind]), "."
|
||||
" from the `microorganisms.codes` data set for ", vector_and(toupper(x)[ind]), "."
|
||||
)
|
||||
}
|
||||
# From SNOMED ----
|
||||
@@ -267,7 +267,7 @@ as.mo <- function(x,
|
||||
if (isTRUE(info) && message_not_thrown_before("as.mo", old, new, entire_session = TRUE) && any(is.na(old) & !is.na(new), na.rm = TRUE)) {
|
||||
message_(
|
||||
"Returning previously coerced value", ifelse(sum(is.na(old) & !is.na(new)) > 1, "s", ""),
|
||||
" for ", vector_and(x[is.na(old) & !is.na(new)]), ". Run {.help [{.fun mo_reset_session}](AMR::mo_reset_session)} to reset this. This note will be shown once per session for this input."
|
||||
" for ", vector_and(x[is.na(old) & !is.na(new)]), ". Run `mo_reset_session()` to reset this. This note will be shown once per session for this input."
|
||||
)
|
||||
}
|
||||
|
||||
@@ -407,9 +407,7 @@ as.mo <- function(x,
|
||||
paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"),
|
||||
minimum_matching_score
|
||||
),
|
||||
". Try setting this value lower or even to 0.",
|
||||
call = FALSE
|
||||
)
|
||||
". Try setting this value lower or even to 0.", call = FALSE)
|
||||
result_mo <- NA_character_
|
||||
} else {
|
||||
result_mo <- MO_lookup_current$mo[match(top_hits[1], MO_lookup_current$fullname)]
|
||||
@@ -455,8 +453,8 @@ as.mo <- function(x,
|
||||
if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
|
||||
examples <- vector_and(
|
||||
paste0(
|
||||
"{.val ", AMR_env$mo_uncertainties$original_input,
|
||||
"} (assumed ", italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||
'"', AMR_env$mo_uncertainties$original_input,
|
||||
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||
),
|
||||
quotes = FALSE
|
||||
)
|
||||
@@ -465,7 +463,7 @@ as.mo <- function(x,
|
||||
}
|
||||
msg <- c(msg, paste0(
|
||||
"Microorganism translation was uncertain for ", examples,
|
||||
". Run {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to review ", plural[2], ", or use {.help [{.fun add_custom_microorganisms}](AMR::add_custom_microorganisms)} to add custom entries."
|
||||
". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add custom entries."
|
||||
))
|
||||
|
||||
for (m in msg) {
|
||||
@@ -481,11 +479,11 @@ as.mo <- function(x,
|
||||
if (isFALSE(keep_synonyms)) {
|
||||
out[!is.na(out_current)] <- out_current[!is.na(out_current)]
|
||||
if (isTRUE(info) && length(AMR_env$mo_renamed$old) > 0) {
|
||||
print(mo_renamed(), extra_txt = " (use {.arg keep_synonyms = TRUE} to leave uncorrected)")
|
||||
print(mo_renamed(), extra_txt = " (use `keep_synonyms = TRUE` to leave uncorrected)")
|
||||
}
|
||||
} else if (is.null(getOption("AMR_keep_synonyms")) && length(AMR_env$mo_renamed$old) > 0 && message_not_thrown_before("as.mo", "keep_synonyms_warning", entire_session = TRUE)) {
|
||||
# keep synonyms is TRUE, so check if any do have synonyms
|
||||
warning_("{.help [{.fun as.mo}](AMR::as.mo)} returned ", nr2char(length(unique(AMR_env$mo_renamed$old))), " outdated taxonomic name", ifelse(length(unique(AMR_env$mo_renamed$old)) > 1, "s", ""), ". Use {.arg keep_synonyms = FALSE} to clean the input to currently accepted taxonomic names, or set the R option {.code AMR_keep_synonyms} to {.code FALSE}. This warning will be shown once per session.", call = FALSE)
|
||||
warning_("{.help [{.fun as.mo}](AMR::as.mo)} returned ", nr2char(length(unique(AMR_env$mo_renamed$old))), " outdated taxonomic name", ifelse(length(unique(AMR_env$mo_renamed$old)) > 1, "s", ""), ". Use ", highlight_code("as.mo(..., keep_synonyms = FALSE)"), " to clean the input to currently accepted taxonomic names, or set the R option {.code AMR_keep_synonyms} to {.code FALSE}. This warning will be shown once per session.", call = FALSE)
|
||||
}
|
||||
|
||||
# Apply Becker ----
|
||||
@@ -502,7 +500,7 @@ as.mo <- function(x,
|
||||
)
|
||||
if (any(out %in% AMR_env$MO_lookup$mo[match(post_Becker, AMR_env$MO_lookup$fullname)])) {
|
||||
if (message_not_thrown_before("as.mo", "becker")) {
|
||||
warning_("in {.help [{.fun as.mo}](AMR::as.mo)}: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
|
||||
warning_("in {.fun as.mo}: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
|
||||
vector_and(font_italic(gsub("Staphylococcus", "S.", post_Becker, fixed = TRUE), collapse = NULL), quotes = FALSE),
|
||||
". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).",
|
||||
immediate = TRUE, call = FALSE
|
||||
@@ -648,13 +646,13 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
out <- trimws(format(x))
|
||||
# grey out the kingdom (part until first "_")
|
||||
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
||||
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
||||
# and grey out every _
|
||||
out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
|
||||
out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)])
|
||||
|
||||
# markup NA and UNKNOWN
|
||||
out[is.na(x)] <- pillar::style_na(" NA")
|
||||
out[x == "UNKNOWN"] <- pillar::style_na(" UNKNOWN")
|
||||
out[is.na(x)] <- font_na(" NA")
|
||||
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
|
||||
|
||||
# markup manual codes
|
||||
out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo] <- font_blue(out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo], collapse = NULL)
|
||||
@@ -673,20 +671,20 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
|
||||
# markup old mo codes
|
||||
out[!x %in% all_mos] <- font_italic(
|
||||
pillar::style_na(x[!x %in% all_mos],
|
||||
font_na(x[!x %in% all_mos],
|
||||
collapse = NULL
|
||||
),
|
||||
collapse = NULL
|
||||
)
|
||||
# throw a warning with the affected column name(s)
|
||||
if (!is.null(mo_cols)) {
|
||||
col <- paste0("Column ", vector_or(paste0("{.field ", font_bold(colnames(df)[mo_cols], collapse = NULL), "}"), quotes = TRUE, sort = FALSE))
|
||||
col <- paste0("Column ", vector_or(colnames(df)[mo_cols], quotes = TRUE, sort = FALSE))
|
||||
} else {
|
||||
col <- "The data"
|
||||
}
|
||||
warning_(
|
||||
col, " contains old MO codes (from a previous AMR package version). ",
|
||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
|
||||
"Please update your MO codes with `as.mo()`.",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
@@ -783,7 +781,7 @@ get_skimmers.mo <- function(column) {
|
||||
#' @noRd
|
||||
print.mo <- function(x, print.shortnames = FALSE, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
cat(format_inline_("Class {.cls mo}\n"))
|
||||
cat("Class 'mo'\n")
|
||||
x_names <- names(x)
|
||||
if (is.null(x_names) & print.shortnames == TRUE) {
|
||||
x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
|
||||
@@ -793,7 +791,7 @@ print.mo <- function(x, print.shortnames = FALSE, ...) {
|
||||
if (!all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
|
||||
warning_(
|
||||
"Some MO codes are from a previous AMR package version. ",
|
||||
"Please update the MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
|
||||
"Please update the MO codes with `as.mo()`.",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
@@ -827,7 +825,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
if (!all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
|
||||
warning_(
|
||||
"The data contains old MO codes (from a previous AMR package version). ",
|
||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}."
|
||||
"Please update your MO codes with `as.mo()`."
|
||||
)
|
||||
}
|
||||
nm <- deparse1(substitute(x))
|
||||
@@ -909,16 +907,14 @@ rep.mo <- function(x, ...) {
|
||||
print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
more_than_50 <- FALSE
|
||||
if (NROW(x) == 0) {
|
||||
message_("No uncertainties to show. Only uncertainties of the last call to {.help [{.fun as.mo}](AMR::as.mo)} or any {.help [{.fun mo_*}](AMR::mo_property)} function are stored.")
|
||||
cat(font_blue(word_wrap("No uncertainties to show. Only uncertainties of the last call to {.help [{.fun as.mo}](AMR::as.mo)} or any mo_*() function are stored.\n\n")))
|
||||
return(invisible(NULL))
|
||||
} else if (NROW(x) > 50) {
|
||||
more_than_50 <- TRUE
|
||||
x <- x[1:50, , drop = FALSE]
|
||||
}
|
||||
|
||||
message_("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See {.help [{.fun mo_matching_score}](AMR::mo_matching_score)}.",
|
||||
as_note = FALSE
|
||||
)
|
||||
cat(font_blue(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See {.help [{.fun mo_matching_score}](AMR::mo_matching_score)}.\n\n")))
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
@@ -928,13 +924,12 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
col_green <- function(x) font_green_bg(x, collapse = NULL)
|
||||
|
||||
if (has_colour()) {
|
||||
cat(word_wrap(
|
||||
"Colour keys: ",
|
||||
cat(font_blue(word_wrap("Colour keys: ",
|
||||
col_red(" 0.000-0.549 "),
|
||||
col_orange(" 0.550-0.649 "),
|
||||
col_yellow(" 0.650-0.749 "),
|
||||
col_green(" 0.750-1.000")
|
||||
), font_green_bg(" "), "\n", sep = "")
|
||||
)), font_green_bg(" "), "\n", sep = "")
|
||||
}
|
||||
|
||||
score_set_colour <- function(text, scores) {
|
||||
@@ -965,6 +960,21 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
# sort on descending scores
|
||||
candidates_formatted <- candidates_formatted[order(1 - scores)]
|
||||
scores_formatted <- scores_formatted[order(1 - scores)]
|
||||
|
||||
candidates <- word_wrap(
|
||||
paste0(
|
||||
"Also matched: ",
|
||||
vector_and(
|
||||
paste0(
|
||||
candidates_formatted,
|
||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
||||
),
|
||||
quotes = FALSE, sort = FALSE
|
||||
)
|
||||
),
|
||||
extra_indent = nchar("Also matched: "),
|
||||
width = 0.9 * getOption("width", 100)
|
||||
)
|
||||
} else {
|
||||
candidates <- ""
|
||||
}
|
||||
@@ -974,54 +984,46 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
n = x[i, ]$fullname
|
||||
)
|
||||
score_formatted <- trimws(formatC(round(score, 3), format = "f", digits = 3))
|
||||
|
||||
out <- paste0(
|
||||
txt <- paste(txt,
|
||||
paste0(
|
||||
"", strrep(font_grey("-"), times = getOption("width", 100) - 1), "\n",
|
||||
"{.val ", x[i, ]$original_input, "}",
|
||||
" -> ",
|
||||
paste0(
|
||||
font_bold(italicise(x[i, ]$fullname)),
|
||||
" (", x[i, ]$mo, ", ", score_set_colour(score_formatted, score), ")"
|
||||
)
|
||||
),
|
||||
collapse = "\n"
|
||||
)
|
||||
message_(out, as_note = FALSE)
|
||||
|
||||
if (x[i, ]$mo %in% AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$status == "synonym")]) {
|
||||
out2 <- paste0(
|
||||
strrep(" ", nchar(x[i, ]$original_input) + 6),
|
||||
ifelse(x[i, ]$keep_synonyms == FALSE,
|
||||
# Add note if result was coerced to accepted taxonomic name
|
||||
font_red(paste0("This outdated taxonomic name was converted to ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", synonym_mo_to_accepted_mo(x[i, ]$mo), ")."), collapse = NULL),
|
||||
# Or add note if result is currently another taxonomic name
|
||||
font_red(paste0(font_bold("Note: "), "The current name is ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", AMR_env$MO_lookup$ref[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], ")."), collapse = NULL)
|
||||
)
|
||||
)
|
||||
message_(out2, as_note = FALSE)
|
||||
}
|
||||
|
||||
other_matches <- paste0(
|
||||
"Also matched: ",
|
||||
vector_and(
|
||||
paste0(
|
||||
candidates_formatted,
|
||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
||||
"", strrep(font_grey("-"), times = getOption("width", 100)), "\n",
|
||||
'"', x[i, ]$original_input, '"',
|
||||
" -> ",
|
||||
paste0(
|
||||
font_bold(italicise(x[i, ]$fullname)),
|
||||
" (", x[i, ]$mo, ", ", score_set_colour(score_formatted, score), ")"
|
||||
)
|
||||
),
|
||||
quotes = FALSE, sort = FALSE
|
||||
)
|
||||
collapse = "\n"
|
||||
),
|
||||
ifelse(x[i, ]$mo %in% AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$status == "synonym")],
|
||||
paste0(
|
||||
strrep(" ", nchar(x[i, ]$original_input) + 6),
|
||||
ifelse(x[i, ]$keep_synonyms == FALSE,
|
||||
# Add note if result was coerced to accepted taxonomic name
|
||||
font_red(paste0("This outdated taxonomic name was converted to ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", synonym_mo_to_accepted_mo(x[i, ]$mo), ")."), collapse = NULL),
|
||||
# Or add note if result is currently another taxonomic name
|
||||
font_red(paste0(font_bold("Note: "), "The current name is ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", AMR_env$MO_lookup$ref[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], ")."), collapse = NULL)
|
||||
)
|
||||
),
|
||||
""
|
||||
),
|
||||
candidates,
|
||||
sep = "\n"
|
||||
)
|
||||
message_(other_matches, as_note = FALSE)
|
||||
txt <- gsub("[\n]+", "\n", txt)
|
||||
# remove first and last break
|
||||
txt <- gsub("(^[\n]|[\n]$)", "", txt)
|
||||
txt <- paste0("\n", txt, "\n")
|
||||
}
|
||||
|
||||
cat(txt)
|
||||
if (isTRUE(any_maxed_out)) {
|
||||
cat("\n")
|
||||
message_("Only the first ", n, " other matches of each record are shown. Run {.help [`print(mo_uncertainties(), n = ...)`](AMR::mo_uncertainties)} to view more entries, or save {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to an object.")
|
||||
cat(font_blue(word_wrap("\nOnly the first ", n, " other matches of each record are shown. Run `print(mo_uncertainties(), n = ...)` to view more entries, or save `mo_uncertainties()` to an object.")))
|
||||
}
|
||||
if (isTRUE(more_than_50)) {
|
||||
cat("\n")
|
||||
message_("Only the first 50 uncertainties are shown. Run {.help [`View(mo_uncertainties())`](AMR::mo_uncertainties)} to view all entries, or save {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to an object.")
|
||||
cat(font_blue(word_wrap("\nOnly the first 50 uncertainties are shown. Run `View(mo_uncertainties())` to view all entries, or save `mo_uncertainties()` to an object.")))
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1030,7 +1032,7 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
#' @noRd
|
||||
print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) {
|
||||
if (NROW(x) == 0) {
|
||||
message_("No renamed taxonomy to show. Only renamed taxonomy of the last call of {.help [{.fun as.mo}](AMR::as.mo)} or any {.help [{.fun mo_*}](AMR::mo_property)} function are stored.")
|
||||
cat(font_blue(word_wrap("No renamed taxonomy to show. Only renamed taxonomy of the last call of {.help [{.fun as.mo}](AMR::as.mo)} or any mo_*() function are stored.\n")))
|
||||
return(invisible(NULL))
|
||||
}
|
||||
|
||||
@@ -1041,17 +1043,14 @@ print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) {
|
||||
|
||||
rows <- seq_len(min(NROW(x), n))
|
||||
|
||||
message_("The following microorganism", ifelse(NROW(x) > 1, "s were", " was"), " taxonomically renamed", extra_txt, ":")
|
||||
old_format <- format(paste0(font_italic(x$old[rows], collapse = NULL), x$ref_old[rows])) # format() will set trailing spaces for textual alignment
|
||||
old_format <- gsub(" ", "\u00a0", old_format, fixed = TRUE)
|
||||
for (old_tax in rows) {
|
||||
message_("\u00a0\u00a0", AMR_env$bullet_icon, " ", old_format[old_tax], " -> ", font_italic(x$new[old_tax]), x$ref_new[old_tax], as_note = FALSE)
|
||||
}
|
||||
if (NROW(x) > n) {
|
||||
message_("\u00a0\u00a0Only the first ", n, " (out of ", NROW(x), ") are shown. Run {.code print(mo_renamed(), n = ...)} to view more entries (might be slow), or save {.fun mo_renamed} to an object.",
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
message_(
|
||||
"The following microorganism", ifelse(NROW(x) > 1, "s were", " was"), " taxonomically renamed", extra_txt, ":\n",
|
||||
paste0(" ", AMR_env$bullet_icon, " ", font_italic(x$old[rows], collapse = NULL), x$ref_old[rows],
|
||||
" -> ", font_italic(x$new[rows], collapse = NULL), x$ref_new[rows],
|
||||
collapse = "\n"
|
||||
),
|
||||
ifelse(NROW(x) > n, paste0("\n\nOnly the first ", n, " (out of ", NROW(x), ") are shown. Run {.code print(mo_renamed(), n = ...)} to view more entries (might be slow), or save {.fun mo_renamed} to an object."), "")
|
||||
)
|
||||
}
|
||||
|
||||
# UNDOCUMENTED HELPER FUNCTIONS -------------------------------------------
|
||||
@@ -1256,14 +1255,14 @@ replace_old_mo_codes <- function(x, property) {
|
||||
}
|
||||
if (property != "mo") {
|
||||
warning_(
|
||||
"in {.help [{.fun mo_", property, "}](AMR::mo_", property, ")}: the input contained ", n_matched,
|
||||
"in `mo_", property, "()`: the input contained ", n_matched,
|
||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, "from a previous AMR package version). ",
|
||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)} to increase speed."
|
||||
"Please update your MO codes with `as.mo()` to increase speed."
|
||||
)
|
||||
} else {
|
||||
warning_(
|
||||
"in {.help [{.fun as.mo}](AMR::as.mo)}: the input contained ", n_matched,
|
||||
"in `as.mo()`: the input contained ", n_matched,
|
||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||
" (", n_unique, "from a previous AMR package version). ",
|
||||
n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
|
||||
|
||||
@@ -270,6 +270,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
@@ -1042,7 +1043,7 @@ find_mo_col <- function(fn) {
|
||||
)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
if (message_not_thrown_before(fn = fn)) {
|
||||
message_("Using column {.field ", font_bold(mo), "} as input for {.help [{.fun ", fn, "}](AMR::", fn, ")}")
|
||||
message_("Using column '", font_bold(mo), "' as input for {.help [{.fun ", fn, "}](AMR::", fn, ")}")
|
||||
}
|
||||
return(df[, mo, drop = TRUE])
|
||||
} else {
|
||||
|
||||
@@ -75,7 +75,7 @@
|
||||
#'
|
||||
#' ```
|
||||
#' as.mo("lab_mo_ecoli")
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_mo_kpneumoniae")
|
||||
@@ -85,7 +85,7 @@
|
||||
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||
#' #> Use mo_uncertainties() to review it.
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||
#' ```
|
||||
#'
|
||||
@@ -108,7 +108,7 @@
|
||||
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> "Organisation XYZ" and "mo"
|
||||
#' #> Class <mo>
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_Staph_aureus")
|
||||
@@ -289,7 +289,7 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
|
||||
}
|
||||
if (!"mo" %in% colnames(x)) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " must contain a column {.code mo}", call = FALSE)
|
||||
stop_(refer_to_name, " must contain a column {.field mo}", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
@@ -313,14 +313,14 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
|
||||
}
|
||||
if (colnames(x)[1] != "mo" && nrow(x) > length(unique(x[, 1, drop = TRUE]))) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(colnames(x)[1]), "}", call = FALSE)
|
||||
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[1], "'", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (colnames(x)[2] != "mo" && nrow(x) > length(unique(x[, 2, drop = TRUE]))) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(colnames(x)[2]), "}", call = FALSE)
|
||||
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[2], "'", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
|
||||
45
R/plotting.R
45
R/plotting.R
@@ -262,11 +262,11 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
}
|
||||
mics <- rescale_mic(x = as.double(as.mic(df[[aest_val]])), keep_operators = "none", mic_range = NULL, as.mic = TRUE)
|
||||
if (!is.null(self$mic_values_rescaled) && any(mics < min(self$mic_values_rescaled, na.rm = TRUE) | mics > max(self$mic_values_rescaled, na.rm = TRUE), na.rm = TRUE)) {
|
||||
warning_("The value for {.field ", font_bold(aest_val), "} is outside the plotted MIC range, consider using/updating the {.arg mic_range} argument in {.fun scale_", aest, "_mic}.")
|
||||
warning_("The value for {.field ", aest_val, "} is outside the plotted MIC range, consider using/updating the {.arg mic_range} argument in {.fun scale_", aest, "_mic}.")
|
||||
}
|
||||
out[[aest_val]] <- log2(as.double(mics))
|
||||
} else {
|
||||
self$mic_values_rescaled <- rescale_mic(x = as.character(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
|
||||
self$mic_values_rescaled <- rescale_mic(x = as.double(as.mic(df[[aest]])), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
|
||||
# create new breaks and labels here
|
||||
lims <- range(self$mic_values_rescaled, na.rm = TRUE)
|
||||
# support inner and outer 'mic_range' settings (e.g., the data ranges 0.5-8 and 'mic_range' is set to 0.025-32)
|
||||
@@ -280,21 +280,11 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
ind_max <- which(COMMON_MIC_VALUES >= lims[2])[which.min(abs(COMMON_MIC_VALUES[COMMON_MIC_VALUES >= lims[2]] - lims[2]))] # Closest index where COMMON_MIC_VALUES >= lims[2]
|
||||
|
||||
self$mic_values_levels <- as.mic(COMMON_MIC_VALUES[ind_min:ind_max])
|
||||
if (length(unique(self$mic_values_levels)) > 1) {
|
||||
if (keep_operators == "all" && !all(self$mic_values_rescaled %in% self$mic_values_levels, na.rm = TRUE)) {
|
||||
self$mic_values_levels <- unique(sort(c(self$mic_values_levels, self$mic_values_rescaled)))
|
||||
|
||||
# collision = same log2 position, but different string labels
|
||||
log_positions <- log2(as.double(self$mic_values_levels))
|
||||
dup_positions <- log_positions[duplicated(log_positions) | duplicated(log_positions, fromLast = TRUE)]
|
||||
colliding_labels <- as.character(self$mic_values_levels)[log_positions %in% dup_positions]
|
||||
self$warn_keep_all_operators <- length(unique(colliding_labels)) > 1
|
||||
} else if (keep_operators == "edges") {
|
||||
self$mic_values_levels[1] <- paste0("<=", self$mic_values_levels[1])
|
||||
self$mic_values_levels[length(self$mic_values_levels)] <- paste0(">=", self$mic_values_levels[length(self$mic_values_levels)])
|
||||
}
|
||||
if (keep_operators %in% c("edges", "all") && length(unique(self$mic_values_levels)) > 1) {
|
||||
self$mic_values_levels[1] <- paste0("<=", self$mic_values_levels[1])
|
||||
self$mic_values_levels[length(self$mic_values_levels)] <- paste0(">=", self$mic_values_levels[length(self$mic_values_levels)])
|
||||
}
|
||||
|
||||
self$mic_values_log <- log2(as.double(self$mic_values_rescaled))
|
||||
|
||||
if (aest == "y" && "group" %in% colnames(df)) {
|
||||
@@ -322,26 +312,7 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
}
|
||||
scale$labels <- function(..., self) {
|
||||
if (is.null(self$mic_breaks_set)) {
|
||||
if (isTRUE(self$warn_keep_all_operators)) {
|
||||
lookup <- tapply(
|
||||
as.character(self$mic_values_rescaled),
|
||||
self$mic_values_log,
|
||||
function(x) paste(unique(x), collapse = ", ")
|
||||
)
|
||||
level_log <- as.character(log2(as.double(self$mic_values_levels)))
|
||||
|
||||
if (any(grepl(", ", lookup))) {
|
||||
warning_("Using {.arg keep_operators = \"all\"} caused MIC values with different operators to share the same log2 position on the axis. These have been combined into a single label (e.g., {.val ", lookup[grepl(", ", lookup)][1], "}).", call = FALSE)
|
||||
}
|
||||
|
||||
ifelse(
|
||||
level_log %in% names(lookup),
|
||||
lookup[level_log],
|
||||
as.character(self$mic_values_levels)
|
||||
)
|
||||
} else {
|
||||
self$mic_values_levels
|
||||
}
|
||||
self$mic_values_levels
|
||||
} else {
|
||||
breaks <- tryCatch(scale$breaks(), error = function(e) NULL)
|
||||
if (!is.null(breaks)) {
|
||||
@@ -441,7 +412,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
|
||||
|
||||
scale$labels <- function(x) {
|
||||
stop_ifnot(all(x %in% c(levels(NA_sir_), "SI", "IR", NA)),
|
||||
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class {.cls sir}, see {.help [{.fun as.sir}](AMR::as.sir)}.",
|
||||
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see {.help [{.fun as.sir}](AMR::as.sir)}.",
|
||||
call = FALSE
|
||||
)
|
||||
x <- as.character(x)
|
||||
@@ -1619,7 +1590,7 @@ expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
|
||||
# named input: match and reorder
|
||||
stop_ifnot(
|
||||
all(names(colours_SIR) %in% sir_order),
|
||||
"Unknown names in {.arg colours_SIR}. Expected any of: ", vector_or(levels(NA_sir_), quotes = FALSE, sort = FALSE), "."
|
||||
"Unknown names in `colours_SIR`. Expected any of: ", vector_or(levels(NA_sir_), quotes = FALSE, sort = FALSE), "."
|
||||
)
|
||||
if (length(colours_SIR) == 4) {
|
||||
# add colours for SI (same as S) and IR (same as R)
|
||||
|
||||
@@ -346,7 +346,7 @@ sir_confidence_interval <- function(...,
|
||||
if (n < minimum) {
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(n == 0, "no", paste("only", n)),
|
||||
" results available for {.help [{.fun sir_confidence_interval}](AMR::sir_confidence_interval)} (whilst {.arg minimum = ", minimum, "}).",
|
||||
" results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
if (is.character(out)) {
|
||||
|
||||
@@ -150,7 +150,7 @@ resistance_predict <- function(x,
|
||||
}
|
||||
stop_ifnot(
|
||||
col_date %in% colnames(x),
|
||||
"column {.code ", col_date, "} not found"
|
||||
"column '", col_date, "' not found"
|
||||
)
|
||||
|
||||
year <- function(x) {
|
||||
|
||||
103
R/sir.R
103
R/sir.R
@@ -471,7 +471,7 @@ is_sir_eligible <- function(x, threshold = 0.05) {
|
||||
if (!is.na(ab)) {
|
||||
# this is a valid antibiotic drug code
|
||||
message_(
|
||||
"Column {.field ", font_bold(cur_col), "} is SIR eligible (despite only having empty values), since it seems to be ",
|
||||
"Column '", font_bold(cur_col), "' is SIR eligible (despite only having empty values), since it seems to be ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " (", ab, ")"
|
||||
)
|
||||
return(TRUE)
|
||||
@@ -601,7 +601,7 @@ as.sir.default <- function(x,
|
||||
ifelse(length(out7) > 0, paste0("7 as \"", out7, "\""), NA_character_),
|
||||
ifelse(length(out8) > 0, paste0("8 as \"", out8, "\""), NA_character_)
|
||||
)
|
||||
message_("{.help [{.fun as.sir}](AMR::as.sir)}: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE))
|
||||
message_("in {.help [{.fun as.sir}](AMR::as.sir)}: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE))
|
||||
}
|
||||
|
||||
if (na_before != na_after) {
|
||||
@@ -612,7 +612,7 @@ as.sir.default <- function(x,
|
||||
cur_col <- get_current_column()
|
||||
warning_("in {.help [{.fun as.sir}](AMR::as.sir)}: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid antimicrobial interpretations: ",
|
||||
@@ -759,10 +759,6 @@ as.sir.data.frame <- function(x,
|
||||
meet_criteria(max_cores, allow_class = c("numeric", "integer"), has_length = 1)
|
||||
x.bak <- x
|
||||
|
||||
if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) {
|
||||
message_("Run {.help [{.fun sir_interpretation_history}](AMR::sir_interpretation_history)} afterwards to retrieve a logbook with all details of the breakpoint interpretations.\n\n")
|
||||
}
|
||||
|
||||
if (tryCatch(length(list(...)) > 0, error = function(e) TRUE)) {
|
||||
sel <- colnames(pm_select(x, ...))
|
||||
} else {
|
||||
@@ -839,7 +835,7 @@ as.sir.data.frame <- function(x,
|
||||
message_(
|
||||
"Assuming value", plural[1], " ",
|
||||
vector_and(col_values, quotes = TRUE),
|
||||
" in column ", paste0("{.field ", font_bold(col_specimen), "}"), " reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
" in column ", paste0("{.field ", col_specimen, "}"), " reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
".\n Use `as.sir(uti = FALSE)` to prevent this."
|
||||
)
|
||||
}
|
||||
@@ -861,7 +857,7 @@ as.sir.data.frame <- function(x,
|
||||
return(FALSE)
|
||||
}
|
||||
if (length(sel) == 0 || (length(sel) > 0 && ab %in% sel)) {
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = info))
|
||||
if (is.na(ab_coerced) || (length(sel) > 0 & !ab %in% sel)) {
|
||||
# not even a valid AB code
|
||||
return(FALSE)
|
||||
@@ -911,11 +907,6 @@ as.sir.data.frame <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
if (isTRUE(info)) {
|
||||
message_(as_note = FALSE) # empty line
|
||||
message_("Processing columns:", as_note = FALSE)
|
||||
}
|
||||
|
||||
run_as_sir_column <- function(i) {
|
||||
ab_col <- ab_cols[i]
|
||||
out <- list(result = NULL, log = NULL)
|
||||
@@ -978,12 +969,12 @@ as.sir.data.frame <- function(x,
|
||||
return(out)
|
||||
} else if (types[i] == "sir") {
|
||||
ab <- ab_col
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = info))
|
||||
show_message <- FALSE
|
||||
if (!all(x[, ab, drop = TRUE] %in% c("S", "SDD", "I", "R", "NI", NA), na.rm = TRUE)) {
|
||||
show_message <- TRUE
|
||||
if (isTRUE(info)) {
|
||||
message_("\u00a0\u00a0", AMR_env$bullet_icon, " Cleaning values in column ", paste0("{.field ", font_bold(ab), "}"), " (",
|
||||
message_("Cleaning values in column ", paste0("{.field ", ab, "}"), " (",
|
||||
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE, info = info), ")... ",
|
||||
appendLF = FALSE,
|
||||
@@ -993,7 +984,7 @@ as.sir.data.frame <- function(x,
|
||||
} else if (!is.sir(x.bak[, ab, drop = TRUE])) {
|
||||
show_message <- TRUE
|
||||
if (isTRUE(info)) {
|
||||
message_("\u00a0\u00a0", AMR_env$bullet_icon, " Assigning class {.cls sir} to already clean column ", paste0("{.field ", font_bold(ab), "}"), " (",
|
||||
message_("Assigning class {.cls sir} to already clean column ", paste0("{.field ", ab, "}"), " (",
|
||||
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE, language = NULL, info = info), ")... ",
|
||||
appendLF = FALSE,
|
||||
@@ -1003,7 +994,7 @@ as.sir.data.frame <- function(x,
|
||||
}
|
||||
result <- as.sir.default(x = as.character(x[, ab, drop = TRUE]))
|
||||
if (show_message == TRUE && isTRUE(info)) {
|
||||
message_(font_green_bg("\u00a0OK\u00a0"), as_note = FALSE)
|
||||
message(font_green_bg(" OK "))
|
||||
}
|
||||
out$result <- result
|
||||
out$log <- NULL
|
||||
@@ -1015,7 +1006,7 @@ as.sir.data.frame <- function(x,
|
||||
|
||||
if (isTRUE(parallel) && n_cores > 1 && length(ab_cols) > 1) {
|
||||
if (isTRUE(info)) {
|
||||
message_(as_note = FALSE)
|
||||
message()
|
||||
message_("Running in parallel mode using ", n_cores, " out of ", get_n_cores(Inf), " cores, on columns ", vector_and(font_bold(ab_cols, collapse = NULL), quotes = "'", sort = FALSE), "...", as_note = FALSE, appendLF = FALSE)
|
||||
}
|
||||
if (.Platform$OS.type == "windows" || getRversion() < "4.0.0") {
|
||||
@@ -1035,15 +1026,15 @@ as.sir.data.frame <- function(x,
|
||||
result_list <- parallel::mclapply(seq_along(ab_cols), run_as_sir_column, mc.cores = n_cores)
|
||||
}
|
||||
if (isTRUE(info)) {
|
||||
message_(font_green_bg("\u00aDONE\u00a"), as_note = FALSE)
|
||||
message_(as_note = FALSE)
|
||||
message_(font_green_bg(" DONE "), as_note = FALSE)
|
||||
message()
|
||||
message_("Run {.help [{.fun sir_interpretation_history}](AMR::sir_interpretation_history)} to retrieve a logbook with all details of the breakpoint interpretations.")
|
||||
}
|
||||
} else {
|
||||
# sequential mode (non-parallel)
|
||||
if (isTRUE(info) && n_cores > 1 && NROW(x) * NCOL(x) > 10000) {
|
||||
# give a note that parallel mode might be better
|
||||
message_(as_note = FALSE)
|
||||
message()
|
||||
message_("Running in sequential mode. Consider setting {.arg parallel} to {.code TRUE} to speed up processing on multiple cores.\n")
|
||||
}
|
||||
# this will contain a progress bar already
|
||||
@@ -1079,8 +1070,8 @@ get_guideline <- function(guideline, reference_data) {
|
||||
guideline_param[guideline_param %unlike% " "] <- gsub("([a-z]+)([0-9]+)", "\\1 \\2", guideline_param[guideline_param %unlike% " "], ignore.case = TRUE)
|
||||
|
||||
stop_ifnot(guideline_param %in% reference_data$guideline,
|
||||
"invalid guideline: {.val ", guideline,
|
||||
"}.\nValid guidelines are: ", vector_and(reference_data$guideline, reverse = TRUE),
|
||||
"invalid guideline: '", guideline,
|
||||
"'.\nValid guidelines are: ", vector_and(reference_data$guideline, quotes = TRUE, reverse = TRUE),
|
||||
call = FALSE
|
||||
)
|
||||
|
||||
@@ -1230,7 +1221,7 @@ as_sir_method <- function(method_short,
|
||||
host <- convert_host(host, lang = language)
|
||||
if (any(is.na(host) & !is.na(host.bak)) && isTRUE(info) && message_not_thrown_before("as.sir", "missing_hosts")) {
|
||||
warning_("The following animal host(s) could not be coerced: ", vector_and(host.bak[is.na(host) & !is.na(host.bak)]), immediate = TRUE)
|
||||
message_(as_note = FALSE) # new line
|
||||
message() # new line
|
||||
}
|
||||
# TODO add a switch to turn this off? In interactive sessions perhaps ask the user. Default should be On.
|
||||
# if (breakpoint_type == "animal" && isTRUE(info) && message_not_thrown_before("as.sir", "host_missing_breakpoints")) {
|
||||
@@ -1255,7 +1246,7 @@ as_sir_method <- function(method_short,
|
||||
|
||||
# get mo
|
||||
if (!is.null(current_df) && length(mo) == 1 && mo %in% colnames(current_df)) {
|
||||
mo_var_found <- paste0(" based on column {.field ", font_bold(mo), "}")
|
||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
||||
mo <- current_df[[mo]]
|
||||
} else if (length(mo) != length(x)) {
|
||||
mo_var_found <- ""
|
||||
@@ -1271,7 +1262,7 @@ as_sir_method <- function(method_short,
|
||||
silent = TRUE
|
||||
)
|
||||
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
|
||||
mo_var_found <- paste0(" based on column {.field ", font_bold(mo), "}")
|
||||
mo_var_found <- paste0(" based on column '", font_bold(mo), "'")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
},
|
||||
@@ -1324,7 +1315,7 @@ as_sir_method <- function(method_short,
|
||||
}
|
||||
|
||||
ab.bak <- trimws2(ab)
|
||||
ab <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
ab <- suppressWarnings(as.ab(ab, info = info))
|
||||
if (!is.null(list(...)$mo.bak)) {
|
||||
mo.bak <- list(...)$mo.bak
|
||||
} else {
|
||||
@@ -1360,12 +1351,12 @@ as_sir_method <- function(method_short,
|
||||
}
|
||||
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
|
||||
if (isTRUE(info) && message_not_thrown_before("as.sir", "intrinsic")) {
|
||||
message_("{.help [{.fun as.sir}](AMR::as.sir)}: using {.arg add_intrinsic_resistance} is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
|
||||
message_("in {.help [{.fun as.sir}](AMR::as.sir)}: using {.arg add_intrinsic_resistance} is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
|
||||
}
|
||||
}
|
||||
|
||||
# format agents ----
|
||||
agent_formatted <- paste0("{.field ", font_bold(ab.bak, collapse = NULL), "}")
|
||||
agent_formatted <- paste0("'", font_bold(ab.bak, collapse = NULL), "'")
|
||||
agent_name <- ab_name(ab, tolower = TRUE, language = NULL, info = info)
|
||||
same_ab <- generalise_antibiotic_name(ab) == generalise_antibiotic_name(agent_name)
|
||||
same_ab.bak <- generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)
|
||||
@@ -1381,7 +1372,7 @@ as_sir_method <- function(method_short,
|
||||
)
|
||||
# this intro text will also be printed in the progress bar if the `progress` package is installed
|
||||
intro_txt <- paste0(
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||
"Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||
ifelse(length(unique(agent_formatted)) == 1, unique(agent_formatted), paste0(vector_and(agent_formatted, quotes = FALSE, sort = FALSE))),
|
||||
mo_var_found,
|
||||
ifelse(identical(reference_data, AMR::clinical_breakpoints),
|
||||
@@ -1399,7 +1390,7 @@ as_sir_method <- function(method_short,
|
||||
rise_warning <- FALSE
|
||||
rise_notes <- FALSE
|
||||
method_coerced <- toupper(method)
|
||||
ab_coerced <- as.ab(ab, info = FALSE)
|
||||
ab_coerced <- as.ab(ab, info = info)
|
||||
|
||||
if (identical(reference_data, AMR::clinical_breakpoints)) {
|
||||
breakpoints <- reference_data %pm>%
|
||||
@@ -1496,14 +1487,14 @@ as_sir_method <- function(method_short,
|
||||
# only print intro under 10 items, otherwise progressbar will print this and then it will be printed double
|
||||
message_(intro_txt, appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = intro_txt, only_bar_percent = TRUE)
|
||||
p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = font_blue(intro_txt), only_bar_percent = TRUE)
|
||||
has_progress_bar <- !is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE)) && nrow(df_unique) >= 10
|
||||
on.exit(close(p))
|
||||
|
||||
if (nrow(breakpoints) == 0) {
|
||||
# apparently no breakpoints found
|
||||
if (isTRUE(info)) {
|
||||
message_(font_grey_bg(font_black(" NO BREAKPOINTS ")), as_note = FALSE)
|
||||
message(font_grey_bg(font_black(" NO BREAKPOINTS ")))
|
||||
}
|
||||
|
||||
load_mo_uncertainties(metadata_mo)
|
||||
@@ -1729,7 +1720,7 @@ as_sir_method <- function(method_short,
|
||||
pm_filter(uti == FALSE)
|
||||
notes_current <- paste0(
|
||||
notes_current, "\n",
|
||||
paste0("Breakpoints for UTI ", font_bold("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument `uti` to set which isolates are from urine. See `?as.sir`.")
|
||||
paste0("Breakpoints for UTI ", font_bold("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument {.arg uti} to set which isolates are from urine. See {.help [{.fun as.sir}](AMR::as.sir)}.")
|
||||
)
|
||||
} else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_current)) {
|
||||
# breakpoints for multiple body sites available
|
||||
@@ -1919,7 +1910,7 @@ as_sir_method <- function(method_short,
|
||||
host = vectorise_log_entry(breakpoints_current[, "host", drop = TRUE], length(rows)),
|
||||
input = vectorise_log_entry(as.character(input_clean), length(rows)),
|
||||
outcome = vectorise_log_entry(as.sir(new_sir), length(rows)),
|
||||
notes = font_stripstyle(notes_current),
|
||||
notes = font_stripstyle(notes_current), # vectorise_log_entry(paste0(font_stripstyle(notes_current), collapse = "\n"), length(rows)),
|
||||
guideline = vectorise_log_entry(guideline_current, length(rows)),
|
||||
ref_table = vectorise_log_entry(breakpoints_current[, "ref_tbl", drop = TRUE], length(rows)),
|
||||
uti = vectorise_log_entry(breakpoints_current[, "uti", drop = TRUE], length(rows)),
|
||||
@@ -1944,9 +1935,9 @@ as_sir_method <- function(method_short,
|
||||
notes <- notes[!trimws2(notes) %in% c("", NA_character_)]
|
||||
if (length(notes) > 0) {
|
||||
if (isTRUE(rise_warning)) {
|
||||
message_(font_rose_bg("\u00a0WARNING\u00a0"), as_note = FALSE)
|
||||
message(font_rose_bg(" WARNING "))
|
||||
} else {
|
||||
message_(font_yellow_bg("\u00a0NOTE\u00a0"), as_note = FALSE)
|
||||
message(font_yellow_bg(" NOTE "))
|
||||
}
|
||||
notes <- unique(notes)
|
||||
# if (isTRUE(verbose) || length(notes) == 1 || NROW(AMR_env$sir_interpretation_history) == 0) {
|
||||
@@ -1955,10 +1946,10 @@ as_sir_method <- function(method_short,
|
||||
message_(notes[i], as_note = FALSE)
|
||||
}
|
||||
} else {
|
||||
# message_(word_wrap("\u00a0\u00a0", AMR_env$bullet_icon, " There were multiple notes. Print or View `sir_interpretation_history()` to examine them, or use `as.sir(..., verbose = TRUE)` next time to directly print them here.", add_fn = font_black))
|
||||
# message(word_wrap(" ", AMR_env$bullet_icon, " There were multiple notes. Print or View `sir_interpretation_history()` to examine them, or use `as.sir(..., verbose = TRUE)` next time to directly print them here.", add_fn = font_black))
|
||||
}
|
||||
} else {
|
||||
message_(font_green_bg("\u00a0OK\u00a0"), as_note = FALSE)
|
||||
message(font_green_bg(" OK "))
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2010,19 +2001,15 @@ pillar_shaft.sir <- function(x, ...) {
|
||||
if (has_colour()) {
|
||||
# colours will anyway not work when has_colour() == FALSE,
|
||||
# but then the indentation should also not be applied
|
||||
out[is.na(x)] <- pillar::style_subtle(" NA")
|
||||
out[x == "S"] <- font_green_bg(" S ") # has font_black internally
|
||||
out[x == "SDD"] <- font_green_lighter_bg(" SDD ") # has font_black internally
|
||||
if (getOption("AMR_guideline", "EUCAST")[1] == "EUCAST") {
|
||||
out[x == "I"] <- font_green_lighter_bg(" I ") # has font_black internally
|
||||
} else {
|
||||
out[x == "I"] <- font_orange_bg(" I ") # has font_black internally
|
||||
}
|
||||
out[x == "R"] <- font_rose_bg(" R ") # has font_black internally
|
||||
out[x == "NI"] <- font_grey_bg(font_black(" NI ", adapt = FALSE))
|
||||
out[x == "WT"] <- font_green_bg(" WT ") # has font_black internally
|
||||
out[x == "NWT"] <- font_rose_bg(" NWT ") # has font_black internally
|
||||
out[x == "NS"] <- font_rose_bg(" NS ") # has font_black internally
|
||||
out[is.na(x)] <- font_grey(" NA")
|
||||
out[x == "S"] <- font_green_bg(" S ")
|
||||
out[x == "SDD"] <- font_green_lighter_bg(" SDD ")
|
||||
out[x == "I"] <- font_orange_bg(" I ")
|
||||
out[x == "R"] <- font_rose_bg(" R ")
|
||||
out[x == "NI"] <- font_grey_bg(font_black(" NI "))
|
||||
out[x == "WT"] <- font_green_bg(font_black(" WT "))
|
||||
out[x == "NWT"] <- font_rose_bg(font_black(" NWT "))
|
||||
out[x == "NS"] <- font_rose_bg(font_black(" NS "))
|
||||
}
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
@@ -2080,10 +2067,10 @@ freq.sir <- function(x, ...) {
|
||||
# this prevents the requirement for putting the dependency in Imports:
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
|
||||
get_skimmers.sir <- function(column) {
|
||||
# TODO #170 add here in AMR 3.1.0 details about guideline
|
||||
# TODO add here in AMR 3.1.0 details about guideline
|
||||
skimr::sfl(
|
||||
skim_type = "sir",
|
||||
# guideline = function(x) "EUCAST 2026", # or "Multiple"
|
||||
# guideline = function(x) "EUCAST 2025", # or "Multiple"
|
||||
# origin = function(x) "MIC", # or "Multiple"
|
||||
count_S = count_S,
|
||||
count_I = count_I,
|
||||
@@ -2100,7 +2087,7 @@ get_skimmers.sir <- function(column) {
|
||||
#' @noRd
|
||||
print.sir <- function(x, ...) {
|
||||
x_name <- deparse(substitute(x))
|
||||
cat(format_inline_("Class {.cls sir}\n"))
|
||||
cat("Class 'sir'\n")
|
||||
# TODO for #170
|
||||
# if (!is.null(attributes(x)$guideline) && !all(is.na(attributes(x)$guideline))) {
|
||||
# cat(font_blue(word_wrap("These values were interpreted using ",
|
||||
@@ -2239,13 +2226,13 @@ check_reference_data <- function(reference_data, .call_depth) {
|
||||
class_sir <- vapply(FUN.VALUE = character(1), AMR::clinical_breakpoints, function(x) paste0("<", class(x), ">", collapse = " and "))
|
||||
class_ref <- vapply(FUN.VALUE = character(1), reference_data, function(x) paste0("<", class(x), ">", collapse = " and "))
|
||||
if (!all(names(class_sir) == names(class_ref))) {
|
||||
stop_("{.arg reference_data} must have the same column names as the {.help [clinical_breakpoints](AMR::clinical_breakpoints)} data set.", call = .call_depth)
|
||||
stop_("{.arg reference_data} must have the same column names as the {.topic [clinical_breakpoints](AMR::clinical_breakpoints)} data set.", call = .call_depth)
|
||||
}
|
||||
if (!all(class_sir == class_ref)) {
|
||||
bad_col <- names(class_ref[class_sir != class_ref][1])
|
||||
bad_cls <- gsub("<|>", "", class_ref[class_sir != class_ref][1])
|
||||
exp_cls <- gsub("<|>", "", class_sir[class_sir != class_ref][1])
|
||||
stop_("{.arg reference_data} must be the same structure as the {.help [clinical_breakpoints](AMR::clinical_breakpoints)} data set. Column ", paste0("{.field ", font_bold(bad_col, collapse = NULL), "}"), " is of class ", paste0("{.cls ", bad_cls, "}"), ", but should be of class ", paste0("{.cls ", exp_cls, "}"), call = .call_depth)
|
||||
stop_("{.arg reference_data} must be the same structure as the {.topic [clinical_breakpoints](AMR::clinical_breakpoints)} data set. Column ", paste0("{.field ", bad_col, "}"), " is of class ", paste0("{.cls ", bad_cls, "}"), ", but should be of class ", paste0("{.cls ", exp_cls, "}"), call = .call_depth)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -60,6 +60,11 @@ sir_calc <- function(...,
|
||||
dots <- eval(substitute(alist(...)))
|
||||
stop_if(length(dots) == 0, "no variables selected", call = -2)
|
||||
|
||||
stop_if("also_single_tested" %in% names(dots),
|
||||
"`also_single_tested` was replaced by `only_all_tested`.\n",
|
||||
"Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.",
|
||||
call = -2
|
||||
)
|
||||
ndots <- length(dots)
|
||||
|
||||
if (is.data.frame(dots_df)) {
|
||||
@@ -204,7 +209,7 @@ sir_calc <- function(...,
|
||||
ifelse(denominator == 0, "no", paste("only", denominator)),
|
||||
" results available",
|
||||
data_vars,
|
||||
" (whilst {.arg minimum = ", minimum, "}).",
|
||||
" (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
fraction <- NA_real_
|
||||
|
||||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
@@ -15,7 +15,7 @@ Overview:
|
||||
even WISCA
|
||||
- Provides the **full microbiological taxonomy** of ~79 000 distinct
|
||||
species and extensive info of ~620 antimicrobial drugs
|
||||
- Applies **CLSI 2011-2026** and **EUCAST 2011-2026** clinical and
|
||||
- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and
|
||||
veterinary breakpoints, and ECOFFs, for MIC and disk zone
|
||||
interpretation
|
||||
- Corrects for duplicate isolates, **calculates** and **predicts** AMR
|
||||
|
||||
@@ -37,11 +37,6 @@ devtools::load_all()
|
||||
|
||||
# BE SURE TO RUN data-raw/_reproduction_scripts/reproduction_of_microorganisms.groups.R FIRST TO GET THE GROUPS!
|
||||
|
||||
# For non-interactive use
|
||||
if (!interactive()) {
|
||||
View <- glimpse
|
||||
}
|
||||
|
||||
# READ DATA ----
|
||||
|
||||
# files are retrieved from https://github.com/AClark-WHONET/AMRIE
|
||||
@@ -51,21 +46,21 @@ file_organisms <- file.path(github_repo, "Organisms.txt")
|
||||
file_breakpoints <- file.path(github_repo, "Breakpoints.txt")
|
||||
file_antibiotics <- file.path(github_repo, "Antibiotics.txt")
|
||||
|
||||
whonet_organisms_raw <- read_tsv(file_organisms, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
whonet_organisms <- read_tsv(file_organisms, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
# remove old taxonomic names
|
||||
filter(TAXONOMIC_STATUS == "C") |>
|
||||
mutate(ORGANISM_CODE = toupper(WHONET_ORG_CODE))
|
||||
|
||||
whonet_breakpoints_raw <- read_tsv(file_breakpoints, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
whonet_breakpoints <- read_tsv(file_breakpoints, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
filter(GUIDELINES %in% c("CLSI", "EUCAST"))
|
||||
|
||||
whonet_antibiotics_raw <- read_tsv(file_antibiotics, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
whonet_antibiotics <- read_tsv(file_antibiotics, na = c("", "NA", "-"), show_col_types = FALSE, guess_max = Inf) |>
|
||||
arrange(WHONET_ABX_CODE) |>
|
||||
distinct(WHONET_ABX_CODE, .keep_all = TRUE)
|
||||
|
||||
# MICROORGANISMS WHONET CODES ----
|
||||
|
||||
whonet_organisms <- whonet_organisms_raw |>
|
||||
whonet_organisms <- whonet_organisms |>
|
||||
select(ORGANISM_CODE, ORGANISM, SPECIES_GROUP, GBIF_TAXON_ID) |>
|
||||
mutate(
|
||||
# this one was called Issatchenkia orientalis, but it should be:
|
||||
@@ -115,13 +110,6 @@ organisms <- matched |> transmute(code = toupper(ORGANISM_CODE), group = SPECIES
|
||||
mutate(name = mo_name(mo, keep_synonyms = TRUE)) |>
|
||||
arrange(code)
|
||||
|
||||
# self-defined codes in the MO table must be retained
|
||||
existing_codes <- microorganisms$fullname[microorganisms$fullname %like% ".* \\("]
|
||||
existing_codes <- gsub(".*\\((.*)\\)", "\\1", existing_codes)
|
||||
|
||||
organisms <- organisms |>
|
||||
filter(!code %in% existing_codes)
|
||||
|
||||
# some subspecies exist, while their upper species do not, add them as the species level:
|
||||
subspp <- organisms |>
|
||||
filter(mo_species(mo, keep_synonyms = TRUE) == mo_subspecies(mo, keep_synonyms = TRUE) &
|
||||
@@ -151,10 +139,9 @@ organisms <- organisms |> filter(code != "XXX")
|
||||
# 2023-07-08 SGM is also Strep gamma in WHONET, must only be Slowly-growing Mycobacterium
|
||||
# 2024-06-14 still the case
|
||||
# 2025-04-20 still the case
|
||||
# 2026-03-27 still the case, but fixed using `existing_codes` above
|
||||
organisms |> filter(code == "SGM")
|
||||
# organisms <- organisms |>
|
||||
# filter(!(code == "SGM" & name %like% "Streptococcus"))
|
||||
organisms <- organisms |>
|
||||
filter(!(code == "SGM" & name %like% "Streptococcus"))
|
||||
# this must be empty:
|
||||
organisms$code[organisms$code |> duplicated()]
|
||||
|
||||
@@ -175,7 +162,7 @@ microorganisms.codes2 <- microorganisms.codes |>
|
||||
# new codes:
|
||||
microorganisms.codes2$code[which(!microorganisms.codes2$code %in% microorganisms.codes$code)]
|
||||
mo_name(microorganisms.codes2$mo[which(!microorganisms.codes2$code %in% microorganisms.codes$code)], keep_synonyms = TRUE)
|
||||
microorganisms.codes <- microorganisms.codes2 |> distinct()
|
||||
microorganisms.codes <- microorganisms.codes2
|
||||
|
||||
# Run this part to update ASIARS-Net:
|
||||
# 2024-06-14: file not available anymore
|
||||
@@ -214,15 +201,10 @@ devtools::load_all()
|
||||
|
||||
# now that we have the correct MO codes, get the breakpoints and convert them
|
||||
|
||||
whonet_breakpoints_raw |>
|
||||
whonet_breakpoints |>
|
||||
count(GUIDELINES, BREAKPOINT_TYPE) |>
|
||||
pivot_wider(names_from = BREAKPOINT_TYPE, values_from = n) |>
|
||||
janitor::adorn_totals(where = c("row", "col"))
|
||||
whonet_breakpoints_raw |>
|
||||
filter(YEAR == format(Sys.Date(), "%Y")) |>
|
||||
count(GUIDELINES, YEAR, BREAKPOINT_TYPE) |>
|
||||
pivot_wider(names_from = BREAKPOINT_TYPE, values_from = n) |>
|
||||
janitor::adorn_totals(where = c("row", "col"))
|
||||
# compared to current
|
||||
AMR::clinical_breakpoints |>
|
||||
count(GUIDELINES = gsub("[^a-zA-Z]", "", guideline), type) |>
|
||||
@@ -231,7 +213,7 @@ AMR::clinical_breakpoints |>
|
||||
as.data.frame() |>
|
||||
janitor::adorn_totals(where = c("row", "col"))
|
||||
|
||||
breakpoints <- whonet_breakpoints_raw |>
|
||||
breakpoints <- whonet_breakpoints |>
|
||||
mutate(code = toupper(ORGANISM_CODE)) |>
|
||||
left_join(bind_rows(microorganisms.codes |> filter(!code %in% c("ALL", "GEN")),
|
||||
# GEN (Generic) and ALL (All) are PK/PD codes
|
||||
@@ -251,7 +233,7 @@ breakpoints <- breakpoints |>
|
||||
|
||||
# and these ones have unknown antibiotics according to WHONET itself:
|
||||
breakpoints |>
|
||||
filter(!WHONET_ABX_CODE %in% whonet_antibiotics_raw$WHONET_ABX_CODE) |>
|
||||
filter(!WHONET_ABX_CODE %in% whonet_antibiotics$WHONET_ABX_CODE) |>
|
||||
count(GUIDELINES, WHONET_ABX_CODE) |>
|
||||
mutate(ab = as.ab(WHONET_ABX_CODE, fast_mode = TRUE),
|
||||
ab_name = ab_name(ab))
|
||||
@@ -314,7 +296,7 @@ breakpoints_new[which(breakpoints_new$method == "DISK"), "breakpoint_R"] <- as.d
|
||||
# regarding animal breakpoints, CLSI has adults and foals for horses, but only for amikacin - only keep adult horses
|
||||
breakpoints_new |>
|
||||
filter(host %like% "foal") |>
|
||||
count(guideline, host, ab)
|
||||
count(guideline, host)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
filter(host %unlike% "foal") |>
|
||||
mutate(host = ifelse(host %like% "horse", "horse", host))
|
||||
@@ -322,7 +304,7 @@ breakpoints_new <- breakpoints_new |>
|
||||
# FIXES FOR WHONET ERRORS ----
|
||||
m <- unique(as.double(as.mic(levels(as.mic(1)))))
|
||||
|
||||
# WHONET has no >1024 but instead uses 1025, 513, and 129, so as.mic() cannot be used to clean.
|
||||
# WHONET has no >1024 but instead uses 1025, 513, etc, so as.mic() cannot be used to clean.
|
||||
# instead, raise these one higher valid MIC factor level:
|
||||
breakpoints_new |> filter(method == "MIC" & (!breakpoint_S %in% c(m, NA))) |> distinct(breakpoint_S)
|
||||
breakpoints_new |> filter(method == "MIC" & (!breakpoint_R %in% c(m, NA))) |> distinct(breakpoint_R)
|
||||
@@ -336,7 +318,6 @@ anyNA(breakpoints_new$breakpoint_S)
|
||||
|
||||
# a lot of R breakpoints are missing, but for CLSI this is required and can be set using as.sir(..., substitute_missing_r_breakpoint = TRUE/FALSE, ...)
|
||||
# 2025-04-20/ For EUCAST, this should not be the case, only happens to old guideline now it seems
|
||||
# 2026-03-27/ Now 2026 is in it as well, but making R same to S is fine
|
||||
breakpoints_new |>
|
||||
filter(method == "MIC" & guideline %like% "EUCAST" & is.na(breakpoint_R)) |>
|
||||
count(guideline)
|
||||
@@ -344,15 +325,10 @@ breakpoints_new[which(breakpoints_new$method == "MIC" & breakpoints_new$guidelin
|
||||
|
||||
|
||||
# fix streptococci in WHONET table of EUCAST: Strep A, B, C and G must only include these groups and not all streptococci:
|
||||
# 2026-03-27/ Only erroneous in EUCAST until 2024, it's fixed for 2025 and 2026, but we need to fix this historically too
|
||||
breakpoints_new$mo[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$mo == "B_STRPT" & breakpoints_new$ref_tbl %like% "^strep.* a.* b.*c.*g"] <- as.mo("B_STRPT_ABCG")
|
||||
breakpoints_new$mo[breakpoints_new$mo == "B_STRPT" & breakpoints_new$ref_tbl %like% "^strep.* a.* b.*c.*g"] <- as.mo("B_STRPT_ABCG")
|
||||
# Haemophilus same error (must only be H. influenzae)
|
||||
# 2026-03-27/ Only erroneous in EUCAST until 2024, it's fixed for 2025 and 2026, but we need to fix this historically too
|
||||
breakpoints_new$mo[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$mo == "B_HMPHL" & breakpoints_new$ref_tbl %like% "^h.* influenzae"] <- as.mo("B_HMPHL_INFL")
|
||||
breakpoints_new$mo[breakpoints_new$mo == "B_HMPHL" & breakpoints_new$ref_tbl %like% "^h.* influenzae"] <- as.mo("B_HMPHL_INFL")
|
||||
# EUCAST says that for H. parainfluenzae the H. influenza rules can be used, so add them
|
||||
breakpoints_new |>
|
||||
filter(method == "MIC" & guideline %like% "EUCAST" & mo %like% as.mo("B_HMPHL")) |>
|
||||
count(guideline, mo)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
bind_rows(
|
||||
breakpoints_new |>
|
||||
@@ -369,56 +345,24 @@ breakpoints_new |> filter(mo == as.mo("Streptococcus viridans") & ab == "GEH")
|
||||
breakpoints_new <- breakpoints_new |> filter(!(mo == as.mo("Streptococcus viridans") & ab == "GEN"))
|
||||
# Nitrofurantoin in Staph (EUCAST) only applies to S. saprophyticus, while WHONET has the DISK correct but the MIC on genus level
|
||||
breakpoints_new$mo[breakpoints_new$mo == "B_STPHY" & breakpoints_new$ab == "NIT" & breakpoints_new$guideline %like% "EUCAST"] <- as.mo("B_STPHY_SPRP")
|
||||
|
||||
# WHONET contains breakpoint for EUCAST that are not actually in EUCAST:
|
||||
# IPM in M. morganii is not in it since v10
|
||||
wrong <- with(breakpoints_new, guideline %like% "EUCAST" & ab == "IPM" & mo == as.mo("M. morganii") & ref_tbl != "ECOFF")
|
||||
breakpoints_new |> filter(wrong)
|
||||
breakpoints_new <- breakpoints_new |> filter(!wrong)
|
||||
# Breakpoints for COPS were part of EUCAST until v11
|
||||
wrong <- with(breakpoints_new, guideline %like% "EUCAST" & mo == as.mo("CoPS") & ref_tbl != "ECOFF")
|
||||
breakpoints_new |> filter(wrong)
|
||||
breakpoints_new <- breakpoints_new |> filter(!wrong)
|
||||
|
||||
# WHONET sets the 2023 breakpoints for SAM to MIC of 16/32 for Enterobacterales, should be MIC 8/32 like AMC (see issue #123 on github.com/msberends/AMR)
|
||||
# 2024-02-22/ fixed now
|
||||
|
||||
# There's a problem with C. diff in EUCAST where breakpoint_R is missing - they are listed as normal human breakpoints but are ECOFF
|
||||
# 2025-04-20/ fixed now
|
||||
|
||||
# WHONET sets for EUCAST 2026 TMP breakpoints for all Klebsiella, but this is now only for non-aerogenes species
|
||||
kleb_spp <- microorganisms |> filter(rank == "species", genus == "Klebsiella", !species %in% c("", "aerogenes")) |> pull(mo)
|
||||
kleb_tmp_mic <- breakpoints_new |>
|
||||
filter(guideline == "EUCAST 2026", method == "MIC", ab == "TMP", mo == as.mo("Klebsiella")) |>
|
||||
uncount(length(kleb_spp)) |>
|
||||
mutate(mo = kleb_spp)
|
||||
kleb_tmp_disk <- breakpoints_new |>
|
||||
filter(guideline == "EUCAST 2026", method == "DISK", ab == "TMP", mo == as.mo("Klebsiella")) |>
|
||||
uncount(length(kleb_spp)) |>
|
||||
mutate(mo = kleb_spp)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
filter(!(guideline == "EUCAST 2026" & method == "MIC" & ab == "TMP" & mo == as.mo("Klebsiella"))) |>
|
||||
bind_rows(kleb_tmp_mic,
|
||||
kleb_tmp_disk)
|
||||
|
||||
# WHONET contains wrong EUCAST breakpoints for enterococci/SXT: disk should be 23/23, not 21/50, and MIC should be 1/1, not 0.032/1
|
||||
# applies to all previous years, since v11 (2011)
|
||||
breakpoints_new |> filter(guideline %like% "EUCAST", ab == "SXT", mo == as.mo("Enterococcus"), type == "human")
|
||||
breakpoints_new$breakpoint_S[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "SXT" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "DISK"] <- 23
|
||||
breakpoints_new$breakpoint_R[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "SXT" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "DISK"] <- 23
|
||||
breakpoints_new$breakpoint_S[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "SXT" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "MIC"] <- 1
|
||||
breakpoints_new$breakpoint_R[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "SXT" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "MIC"] <- 1
|
||||
# Also wrong EUCAST breakpoints for enterococci/TMP: disk should be 21/21, not 21/50, and MIC should be 1/1, not 0.032/1
|
||||
breakpoints_new |> filter(guideline %like% "EUCAST", ab == "TMP", mo == as.mo("Enterococcus"), type == "human")
|
||||
breakpoints_new$breakpoint_S[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "TMP" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "DISK"] <- 21
|
||||
breakpoints_new$breakpoint_R[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "TMP" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "DISK"] <- 21
|
||||
breakpoints_new$breakpoint_S[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "TMP" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "MIC"] <- 1
|
||||
breakpoints_new$breakpoint_R[breakpoints_new$guideline %like% "EUCAST" & breakpoints_new$ab == "TMP" & breakpoints_new$mo == as.mo("Enterococcus") & breakpoints_new$type == "human" & breakpoints_new$method == "MIC"] <- 1
|
||||
|
||||
# WHONET still contains PK/PD rules for EUCAST >= 2024, but this was ended from v14 (2024) on
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
filter(!(guideline %like% "EUCAST (2024|2025|2026)" & ref_tbl == "PK/PD"))
|
||||
|
||||
# determine rank again now that some changes were made on taxonomic level (genus -> species)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
mutate(rank_index = case_when(
|
||||
mo_rank(mo, keep_synonyms = TRUE) %like% "(infra|sub)" ~ 1,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "species" ~ 2,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "species group" ~ 2.5,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "genus" ~ 3,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "family" ~ 4,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "order" ~ 5,
|
||||
mo != "UNKNOWN" ~ 6, # for B_ANAER, etc.
|
||||
TRUE ~ 7
|
||||
))
|
||||
|
||||
# WHONET adds one log2 level to the R breakpoint for their software, e.g. in AMC in Enterobacterales:
|
||||
# EUCAST 2023 guideline: S <= 8 and R > 8
|
||||
@@ -439,24 +383,24 @@ breakpoints_new <- breakpoints_new |>
|
||||
breakpoint_R
|
||||
))
|
||||
|
||||
|
||||
# check the strange duplicates
|
||||
breakpoints_new |>
|
||||
mutate(id = paste(guideline, type, host, method, site, mo, ab, uti)) %>%
|
||||
filter(id %in% .$id[which(duplicated(id))]) |>
|
||||
arrange(desc(guideline)) |>
|
||||
View()
|
||||
# 2024-06-19/ mostly ECOFFs, but there's no explanation in the whonet_breakpoints_raw df, we have to remove duplicates
|
||||
# 2024-06-19/ mostly ECOFFs, but there's no explanation in the whonet_breakpoints file, we have to remove duplicates
|
||||
# 2025-04-20/ same, most important one seems M. tuberculosis in CLSI (also in 2025)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
distinct(guideline, type, host, method, site, mo, ab, uti, .keep_all = TRUE)
|
||||
|
||||
|
||||
# CHECKS ----
|
||||
# CHECKS AND SAVE TO PACKAGE ----
|
||||
|
||||
breakpoints_new |> filter(guideline == "EUCAST 2026", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC")
|
||||
# check again
|
||||
breakpoints_new |> filter(guideline == "EUCAST 2025", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC")
|
||||
# compare with current version
|
||||
clinical_breakpoints |> filter(guideline == "EUCAST 2025", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC")
|
||||
clinical_breakpoints |> filter(guideline == "EUCAST 2024", ab == "AMC", mo == "B_[ORD]_ENTRBCTR", method == "MIC")
|
||||
|
||||
# must have "human" and "ECOFF"
|
||||
breakpoints_new |> filter(mo == "B_STRPT_PNMN", ab == "AMP", guideline == "EUCAST 2020", method == "MIC")
|
||||
@@ -465,24 +409,6 @@ breakpoints_new |> filter(mo == "B_STRPT_PNMN", ab == "AMP", guideline == "EUCAS
|
||||
dim(breakpoints_new)
|
||||
dim(clinical_breakpoints)
|
||||
|
||||
|
||||
# SAVE TO PACKAGE ----
|
||||
|
||||
# determine rank again now that some changes were made on taxonomic level (genus -> species)
|
||||
breakpoints_new <- breakpoints_new |>
|
||||
mutate(rank_index = case_when(
|
||||
mo_rank(mo, keep_synonyms = TRUE) %like% "(infra|sub)" ~ 1,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "species" ~ 2,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "species group" ~ 2.5,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "genus" ~ 3,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "family" ~ 4,
|
||||
mo_rank(mo, keep_synonyms = TRUE) == "order" ~ 5,
|
||||
mo != "UNKNOWN" ~ 6, # for B_ANAER, etc.
|
||||
TRUE ~ 7
|
||||
)) |>
|
||||
# and arrange
|
||||
arrange(desc(guideline), mo, ab, type, host, method)
|
||||
|
||||
clinical_breakpoints <- breakpoints_new
|
||||
clinical_breakpoints <- clinical_breakpoints |> dataset_UTF8_to_ASCII()
|
||||
usethis::use_data(clinical_breakpoints, overwrite = TRUE, compress = "xz", version = 2)
|
||||
|
||||
@@ -1 +1 @@
|
||||
45068afc4cd9770dea329782c1aed045
|
||||
c7062e60fa4fbc2eee233044d15903ce
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -2832,7 +2832,6 @@
|
||||
"FU-" "B_FSBCTR"
|
||||
"FUA.SP" "F_FUSRM"
|
||||
"FUL" "B_FSBCTR_ULCR"
|
||||
"FUO" "F_FUSRM_OXYS"
|
||||
"FUR" "F_FUSRM"
|
||||
"FUROXY" "F_FUSRM_OXYS"
|
||||
"FURPET" "F_FUSRM_PTRL"
|
||||
@@ -2937,7 +2936,6 @@
|
||||
"GLO.SP" "B_GLBCT"
|
||||
"GLOSAN" "B_GLBCT_SNGN"
|
||||
"GLOSPP" "B_GLBCT"
|
||||
"GLS" "B_GLSSR"
|
||||
"GM+" "B_GRAMP"
|
||||
"GM-" "B_GRAMN"
|
||||
"GMO" "B_GEMLL_MRBL"
|
||||
@@ -3028,6 +3026,7 @@
|
||||
"HABSPP" "B_HMTBC"
|
||||
"HAC" "B_AGGRG_ACTN"
|
||||
"HACEK" "B_HACEK"
|
||||
"HACEK" "B_HACEK"
|
||||
"HAE" "B_HMPHL"
|
||||
"HAE.SP" "B_HMPHL"
|
||||
"HAEAEG" "B_HMPHL_AEGY"
|
||||
@@ -3123,7 +3122,7 @@
|
||||
"HPL" "B_HMPHL_PRPH"
|
||||
"HPO" "F_OGATA"
|
||||
"HPOSPP" "F_HNDRS_ASTR"
|
||||
"HPR" "B_GLSSR_PRSS"
|
||||
"HPR" "B_HMPHL_PRSS"
|
||||
"HPU" "B_HLCBCT_PLLR"
|
||||
"HPY" "B_HLCBCT_PYLR"
|
||||
"HRB" "B_HRBSP"
|
||||
@@ -3472,7 +3471,6 @@
|
||||
"LQU" "B_LGNLL_QTRN"
|
||||
"LRC" "B_LPTSP_INTR"
|
||||
"LRE" "B_LCTBC_RETR"
|
||||
"LRF" "B_LCTCC_RFFN"
|
||||
"LRI" "B_LMNRL_RCHR"
|
||||
"LRU" "B_LGNLL_RBRL"
|
||||
"LSA" "B_LCTBC_SLVR"
|
||||
@@ -3762,7 +3760,6 @@
|
||||
"MNE" "B_MYCBC_NERM"
|
||||
"MNL" "B_MRXLL_NNLQ"
|
||||
"MNO" "B_MYCBC_NNCH"
|
||||
"MNT" "B_MYCBC"
|
||||
"MNV" "B_MNNHM_VRGN"
|
||||
"MO-" "B_MRXLL"
|
||||
"MO.BOV" "B_MRXLL_BOVS"
|
||||
@@ -4298,7 +4295,6 @@
|
||||
"PAT.SP" "B_PANTO"
|
||||
"PAU" "B_SLMNL_ENTR_ENTR"
|
||||
"PAV" "B_AVBCT_AVIM"
|
||||
"PBA" "B_PSDCL_ALBA"
|
||||
"PBC" "B_PRVTL_BCCL"
|
||||
"PBE" "B_PSTRL_BTTY"
|
||||
"PBI" "B_PRBCT"
|
||||
@@ -4595,7 +4591,6 @@
|
||||
"PSA" "F_PSDLL"
|
||||
"PSA.SP" "F_PSDLL"
|
||||
"PSASPP" "F_PSDLL"
|
||||
"PSB" "B_PSDCL"
|
||||
"PSC" "F_PSDCH"
|
||||
"PSCSPP" "B_PSDCL"
|
||||
"PSD" "B_STPHY_PSDN"
|
||||
@@ -4711,7 +4706,6 @@
|
||||
"RAH.SP" "B_RHNLL"
|
||||
"RAHAQU" "B_RHNLL_AQTL"
|
||||
"RAHSPP" "B_RHNLL"
|
||||
"RAI" "B_RLSTN_INSD"
|
||||
"RAK" "B_RTTSA_AKAR"
|
||||
"RAL" "B_RLSTN"
|
||||
"RAL.SP" "B_RLSTN"
|
||||
@@ -4806,7 +4800,6 @@
|
||||
"ROD" "B_RDNTB"
|
||||
"RODPNE" "B_RDNTB_PNMT"
|
||||
"RODSPP" "B_RDNTB"
|
||||
"ROK" "B_ROTHI_KRST"
|
||||
"ROL" "F_RHZPS_MCRS"
|
||||
"ROM" "B_RSMNS"
|
||||
"ROMMUC" "B_RSMNS"
|
||||
@@ -5049,10 +5042,8 @@
|
||||
"SAV" "B_SLMNL_ARCH"
|
||||
"SB2" "B_STRPT_BOVS"
|
||||
"SBA" "B_SLMNL_BRLL"
|
||||
"SBC" "B_SLBCL"
|
||||
"SBE" "B_SHWNL_BNTH"
|
||||
"SBG" "B_SLMNL_BNGR"
|
||||
"SBI" "B_SLBCL_SLVS"
|
||||
"SBL" "B_SLMNL_BLCK"
|
||||
"SBM" "B_SLMNL_BVSM"
|
||||
"SBN" "B_SLMNL_BBRG"
|
||||
@@ -5087,7 +5078,6 @@
|
||||
"SCS" "F_SCLCB_CNST"
|
||||
"SCT" "B_STRPT_CNST"
|
||||
"SCU" "B_STPHY_CRNS"
|
||||
"SCV" "F_SCPLR_VCLS"
|
||||
"SCY" "F_SCYTL"
|
||||
"SCYSPP" "F_SCYTL"
|
||||
"SD1" "B_SHGLL_DYSN"
|
||||
@@ -5666,7 +5656,6 @@
|
||||
"TAYSPP" "B_TYLRL"
|
||||
"TBE" "F_GTRCH_RDLL"
|
||||
"TBESPP" "F_TRCHS"
|
||||
"TBH" "F_TRCHP_BNHM"
|
||||
"TBN" "B_TRPRL_BRNR"
|
||||
"TCA" "F_DBRYM_CHVL"
|
||||
"TCASPP" "F_CANDD"
|
||||
@@ -5852,8 +5841,6 @@
|
||||
"TYASPP" "F_TRCHP"
|
||||
"TYE" "P_TRYPN_JNSN"
|
||||
"TYI" "F_TRCHP_INDT"
|
||||
"TYM" "B_TRPHR"
|
||||
"TYW" "B_TRPHR_WHPP"
|
||||
"ULO" "F_ULCLD"
|
||||
"UNK" "UNKNOWN"
|
||||
"UPEC" "B_ESCHR_COLI"
|
||||
@@ -5863,7 +5850,6 @@
|
||||
"UREPAR" "B_URPLS_PRVM"
|
||||
"URESPP" "B_URPLS"
|
||||
"UREURE" "B_URPLS_URLY"
|
||||
"URP" "B_URPLS_PRVM"
|
||||
"UUR" "B_URPLS_URLY"
|
||||
"V.ALG" "B_VIBRI_ALGN"
|
||||
"V.CHO" "B_VIBRI_CHLR"
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@@ -1 +1 @@
|
||||
6ef98bb1bcd27052fde453bb12c0b285
|
||||
986d5110a46bbf297ebaeb4dd5179fff
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
32
index.md
32
index.md
@@ -10,7 +10,7 @@
|
||||
even WISCA
|
||||
- Provides the **full microbiological taxonomy** of ~79 000 distinct
|
||||
species and extensive info of ~620 antimicrobial drugs
|
||||
- Applies **CLSI 2011-2026** and **EUCAST 2011-2026** clinical and
|
||||
- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and
|
||||
veterinary breakpoints, and ECOFFs, for MIC and disk zone
|
||||
interpretation
|
||||
- Corrects for duplicate isolates, **calculates** and **predicts** AMR
|
||||
@@ -68,7 +68,7 @@ species**](./reference/microorganisms.html) (updated June 2024) and all
|
||||
drugs**](./reference/antimicrobials.html) by name and code (including
|
||||
ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all
|
||||
about valid SIR and MIC values. The integral clinical breakpoint
|
||||
guidelines from CLSI 2011-2026 and EUCAST 2011-2026 are included, even
|
||||
guidelines from CLSI 2011-2025 and EUCAST 2011-2025 are included, even
|
||||
with epidemiological cut-off (ECOFF) values. It supports and can read
|
||||
any data format, including WHONET data. This package works on Windows,
|
||||
macOS and Linux with all versions of R since R-3.0 (April 2013). **It
|
||||
@@ -171,14 +171,14 @@ example_isolates %>%
|
||||
select(bacteria,
|
||||
aminoglycosides(),
|
||||
carbapenems())
|
||||
#> ℹ Using column mo as input for `mo_fullname()`
|
||||
#> ℹ Using column mo as input for `mo_is_gram_negative()`
|
||||
#> ℹ Using column mo as input for `mo_is_intrinsic_resistant()`
|
||||
#> ℹ Using column 'mo' as input for `mo_fullname()`
|
||||
#> ℹ Using column 'mo' as input for `mo_is_gram_negative()`
|
||||
#> ℹ Using column 'mo' as input for `mo_is_intrinsic_resistant()`
|
||||
#> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant
|
||||
#> Phenotypes' v1.2 (2023). This note will be shown once per session.
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB (tobramycin), AMK
|
||||
#> (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM (meropenem)
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
#> # A tibble: 35 × 7
|
||||
#> bacteria GEN TOB AMK KAN IPM MEM
|
||||
#> <chr> <sir> <sir> <sir> <sir> <sir> <sir>
|
||||
@@ -215,9 +215,9 @@ output format automatically (such as markdown, LaTeX, HTML, etc.).
|
||||
``` r
|
||||
antibiogram(example_isolates,
|
||||
antimicrobials = c(aminoglycosides(), carbapenems()))
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB (tobramycin), AMK
|
||||
#> (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM (meropenem)
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
```
|
||||
|
||||
| Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin |
|
||||
@@ -344,15 +344,15 @@ out <- example_isolates %>%
|
||||
# calculate AMR using resistance(), over all aminoglycosides and polymyxins:
|
||||
summarise(across(c(aminoglycosides(), polymyxins()),
|
||||
resistance))
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB (tobramycin), AMK
|
||||
#> (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `polymyxins()` using column COL (colistin)
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For `polymyxins()` using column 'COL' (colistin)
|
||||
#> Warning: There was 1 warning in `summarise()`.
|
||||
#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`.
|
||||
#> ℹ In group 3: `ward = "Outpatient"`.
|
||||
#> Caused by warning:
|
||||
#> ! Introducing NA: only 23 results available for KAN in group: ward = "Outpatient"
|
||||
#> (whilst `minimum = 30`).
|
||||
#> ! Introducing NA: only 23 results available for KAN in group: ward =
|
||||
#> "Outpatient" (`minimum` = 30).
|
||||
out
|
||||
#> # A tibble: 3 × 6
|
||||
#> ward GEN TOB AMK KAN COL
|
||||
|
||||
@@ -12,20 +12,20 @@ This is an overview of all the package-specific options you can set in the \code
|
||||
|
||||
\itemize{
|
||||
\item \code{AMR_antibiogram_formatting_type} \cr A \link{numeric} (1-22) to use in \code{\link[=antibiogram]{antibiogram()}}, to indicate which formatting type to use.
|
||||
\item \code{AMR_breakpoint_type} \cr A \link{character} to use in \code{\link[=as.sir]{as.sir()}}, to indicate which breakpoint type to use. This must be either {.val ECOFF}, {.val animal}, or {.val human}.
|
||||
\item \code{AMR_breakpoint_type} \cr A \link{character} to use in \code{\link[=as.sir]{as.sir()}}, to indicate which breakpoint type to use. This must be either "ECOFF", "animal", or "human".
|
||||
\item \code{AMR_capped_mic_handling} \cr A \link{character} to use in \code{\link[=as.sir]{as.sir()}}, to indicate how capped MIC values (\code{<}, \code{<=}, \code{>}, \code{>=}) should be interpreted. Must be one of \code{"none"}, \code{"conservative"}, \code{"standard"}, or \code{"lenient"} - the default is \code{"conservative"}.
|
||||
\item \code{AMR_cleaning_regex} \cr A \link[base:regex]{regular expression} (case-insensitive) to use in \code{\link[=as.mo]{as.mo()}} and all \code{\link[=mo_property]{mo_*}} functions, to clean the user input. The default is the outcome of \code{\link[=mo_cleaning_regex]{mo_cleaning_regex()}}, which removes texts between brackets and texts such as "species" and "serovar".
|
||||
\item \code{AMR_custom_ab} \cr A file location to an RDS file, to use custom antimicrobial drugs with this package. This is explained in \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}}.
|
||||
\item \code{AMR_custom_mo} \cr A file location to an RDS file, to use custom microorganisms with this package. This is explained in \code{\link[=add_custom_microorganisms]{add_custom_microorganisms()}}.
|
||||
\item \code{AMR_eucastrules} \cr A \link{character} to set the default types of rules for \code{\link[=eucast_rules]{eucast_rules()}} function, must be one or more of: \code{"breakpoints"}, \code{"expert"}, \code{"other"}, \code{"custom"}, \code{"all"}, and defaults to \code{c("breakpoints", "expert")}.
|
||||
\item \code{AMR_guideline} \cr A \link{character} to set the default guideline used throughout the \code{AMR} package wherever a \code{guideline} argument is available. This option is used as the default in e.g. \code{\link[=as.sir]{as.sir()}}, \code{\link[=resistance]{resistance()}}, \code{\link[=susceptibility]{susceptibility()}}, \code{\link[=interpretive_rules]{interpretive_rules()}} and many plotting functions. \strong{While unset}, the AMR package uses the latest implemented EUCAST guideline (currently EUCAST 2026).
|
||||
\item \code{AMR_guideline} \cr A \link{character} to set the default guideline used throughout the \code{AMR} package wherever a \code{guideline} argument is available. This option is used as the default in e.g. \code{\link[=as.sir]{as.sir()}}, \code{\link[=resistance]{resistance()}}, \code{\link[=susceptibility]{susceptibility()}}, \code{\link[=interpretive_rules]{interpretive_rules()}} and many plotting functions. \strong{While unset}, the AMR package uses the latest implemented EUCAST guideline (currently EUCAST 2025).
|
||||
\itemize{
|
||||
\item For \code{\link[=as.sir]{as.sir()}}, this determines which clinical breakpoint guideline is used to interpret MIC values and disk diffusion diameters. It can be either the guideline name (e.g., \code{"CLSI"} or \code{"EUCAST"}) or the name including a year (e.g., \code{"CLSI 2019"}). Supported guidelines are EUCAST 2011 to 2026, and CLSI 2011 to 2026.
|
||||
\item For \code{\link[=as.sir]{as.sir()}}, this determines which clinical breakpoint guideline is used to interpret MIC values and disk diffusion diameters. It can be either the guideline name (e.g., \code{"CLSI"} or \code{"EUCAST"}) or the name including a year (e.g., \code{"CLSI 2019"}). Supported guidelines are EUCAST 2011 to 2025, and CLSI 2011 to 2025.
|
||||
\item For \code{\link[=resistance]{resistance()}} and \code{\link[=susceptibility]{susceptibility()}}, this setting determines how the \code{"I"} (Intermediate / Increased exposure) category is handled in calculations. Under CLSI, \code{"I"} is considered \emph{resistant} in susceptibility calculations; under EUCAST, \code{"I"} is considered \emph{susceptible} in susceptibility calculations. Explicitly setting this option ensures reproducible AMR proportion estimates.
|
||||
\item For \code{\link[=interpretive_rules]{interpretive_rules()}}, this determines which guideline-specific interpretive (expert) rules are applied to antimicrobial test results, either EUCAST or CLSI.
|
||||
\item For many plotting functions (e.g., for MIC or disk diffusion values), supplying \code{mo} and \code{ab} enables automatic SIR-based interpretative colouring. These colours are derived from \code{\link[=as.sir]{as.sir()}} in the background and therefore depend on the active \code{guideline} setting, which again uses EUCAST 2026 if not set explicitly.
|
||||
\item For many plotting functions (e.g., for MIC or disk diffusion values), supplying \code{mo} and \code{ab} enables automatic SIR-based interpretative colouring. These colours are derived from \code{\link[=as.sir]{as.sir()}} in the background and therefore depend on the active \code{guideline} setting, which again uses EUCAST 2025 if not set explicitly.
|
||||
}
|
||||
\item \code{AMR_guideline} \cr A \link{character} to set the default guideline for interpreting MIC values and disk diffusion diameters with \code{\link[=as.sir]{as.sir()}}. Can be only the guideline name (e.g., \code{"CLSI"}) or the name with a year (e.g. \code{"CLSI 2019"}). The default to the latest implemented EUCAST guideline, currently \code{"EUCAST 2026"}. Supported guideline are currently EUCAST (2011-2026) and CLSI (2011-2026).
|
||||
\item \code{AMR_guideline} \cr A \link{character} to set the default guideline for interpreting MIC values and disk diffusion diameters with \code{\link[=as.sir]{as.sir()}}. Can be only the guideline name (e.g., \code{"CLSI"}) or the name with a year (e.g. \code{"CLSI 2019"}). The default to the latest implemented EUCAST guideline, currently \code{"EUCAST 2025"}. Supported guideline are currently EUCAST (2011-2025) and CLSI (2011-2025).
|
||||
\item \code{AMR_ignore_pattern} \cr A \link[base:regex]{regular expression} to ignore (i.e., make \code{NA}) any match given in \code{\link[=as.mo]{as.mo()}} and all \code{\link[=mo_property]{mo_*}} functions.
|
||||
\item \code{AMR_include_PKPD} \cr A \link{logical} to use in \code{\link[=as.sir]{as.sir()}}, to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is \code{TRUE}.
|
||||
\item \code{AMR_substitute_missing_r_breakpoint} \cr A \link{logical} to use in \code{\link[=as.sir]{as.sir()}}, to indicate that missing R breakpoints must be substituted with \code{"R"} - the default is \code{FALSE}.
|
||||
|
||||
@@ -32,7 +32,7 @@ The \code{AMR} package is a peer-reviewed, \href{https://amr-for-r.org/#copyrigh
|
||||
|
||||
This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
||||
|
||||
After installing this package, R knows \href{https://amr-for-r.org/reference/microorganisms.html}{\strong{~79 000 distinct microbial species}} (updated June 2024) and all \href{https://amr-for-r.org/reference/antimicrobials.html}{\strong{~620 antimicrobial and antiviral drugs}} by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI 2011-2026 and EUCAST 2011-2026 are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). \strong{It was designed to work in any setting, including those with very limited resources}. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the \href{https://www.rug.nl}{University of Groningen} and the \href{https://www.umcg.nl}{University Medical Center Groningen}.
|
||||
After installing this package, R knows \href{https://amr-for-r.org/reference/microorganisms.html}{\strong{~79 000 distinct microbial species}} (updated June 2024) and all \href{https://amr-for-r.org/reference/antimicrobials.html}{\strong{~620 antimicrobial and antiviral drugs}} by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI 2011-2025 and EUCAST 2011-2025 are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). \strong{It was designed to work in any setting, including those with very limited resources}. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the \href{https://www.rug.nl}{University of Groningen} and the \href{https://www.umcg.nl}{University Medical Center Groningen}.
|
||||
|
||||
The \code{AMR} package is available in English, Arabic, Bengali, Chinese, Czech, Danish, Dutch, Finnish, French, German, Greek, Hindi, Indonesian, Italian, Japanese, Korean, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swahili, Swedish, Turkish, Ukrainian, Urdu, and Vietnamese. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||
}
|
||||
|
||||
@@ -68,9 +68,9 @@ retrieve_wisca_parameters(wisca_model, ...)
|
||||
}
|
||||
}}
|
||||
|
||||
\item{mo_transform}{A character to transform microorganism input - must be \code{"name"}, \code{"shortname"} (default), \code{"gramstain"}, or one of the column names of the \link{microorganisms} data set: {.val mo}, {.val fullname}, {.val status}, {.val kingdom}, {.val phylum}, {.val class}, {.val order}, {.val family}, {.val genus}, {.val species}, {.val subspecies}, {.val rank}, {.val ref}, {.val oxygen_tolerance}, {.val source}, {.val lpsn}, {.val lpsn_parent}, {.val lpsn_renamed_to}, {.val mycobank}, {.val mycobank_parent}, {.val mycobank_renamed_to}, {.val gbif}, {.val gbif_parent}, {.val gbif_renamed_to}, {.val prevalence}, or {.val snomed}. Can also be \code{NULL} to not transform the input or \code{NA} to consider all microorganisms 'unknown'.}
|
||||
\item{mo_transform}{A character to transform microorganism input - must be \code{"name"}, \code{"shortname"} (default), \code{"gramstain"}, or one of the column names of the \link{microorganisms} data set: "mo", "fullname", "status", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", "rank", "ref", "oxygen_tolerance", "source", "lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence", or "snomed". Can also be \code{NULL} to not transform the input or \code{NA} to consider all microorganisms 'unknown'.}
|
||||
|
||||
\item{ab_transform}{A character to transform antimicrobial input - must be one of the column names of the \link{antimicrobials} data set (defaults to \code{"name"}): {.val ab}, {.val cid}, {.val name}, {.val group}, {.val atc}, {.val atc_group1}, {.val atc_group2}, {.val abbreviations}, {.val synonyms}, {.val oral_ddd}, {.val oral_units}, {.val iv_ddd}, {.val iv_units}, or {.val loinc}. Can also be \code{NULL} to not transform the input.}
|
||||
\item{ab_transform}{A character to transform antimicrobial input - must be one of the column names of the \link{antimicrobials} data set (defaults to \code{"name"}): "ab", "cid", "name", "group", "atc", "atc_group1", "atc_group2", "abbreviations", "synonyms", "oral_ddd", "oral_units", "iv_ddd", "iv_units", or "loinc". Can also be \code{NULL} to not transform the input.}
|
||||
|
||||
\item{syndromic_group}{A column name of \code{x}, or values calculated to split rows of \code{x}, e.g. by using \code{\link[=ifelse]{ifelse()}} or \code{\link[dplyr:case-and-replace-when]{case_when()}}. See \emph{Examples}.}
|
||||
|
||||
|
||||
@@ -157,7 +157,7 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
|
||||
|
||||
\item{col_mo}{Column name of the names or codes of the microorganisms (see \code{\link[=as.mo]{as.mo()}}) - the default is the first column of class \code{\link{mo}}. Values will be coerced using \code{\link[=as.mo]{as.mo()}}.}
|
||||
|
||||
\item{version_expected_phenotypes}{The version number to use for the EUCAST Expected Phenotypes. Can be {.val 1.2}.}
|
||||
\item{version_expected_phenotypes}{The version number to use for the EUCAST Expected Phenotypes. Can be "1.2".}
|
||||
}
|
||||
\value{
|
||||
When used inside selecting or filtering, this returns a \link{character} vector of column names, with additional class \code{"amr_selector"}. When used individually, this returns an \link[=as.ab]{'ab' vector} with all possible antimicrobials that the function would be able to select or filter.
|
||||
|
||||
@@ -50,13 +50,13 @@ Ordered \link{factor} with additional class \code{\link{mic}}, that in mathemati
|
||||
This transforms vectors to a new class \code{\link{mic}}, which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
|
||||
}
|
||||
\details{
|
||||
To interpret MIC values as SIR values, use \code{\link[=as.sir]{as.sir()}} on MIC values. It supports guidelines from EUCAST (2011-2026) and CLSI (2011-2026).
|
||||
To interpret MIC values as SIR values, use \code{\link[=as.sir]{as.sir()}} on MIC values. It supports guidelines from EUCAST (2011-2025) and CLSI (2011-2025).
|
||||
|
||||
This class for MIC values is a quite a special data type: formally it is an ordered \link{factor} with valid MIC values as \link{factor} levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{x <- random_mic(10)
|
||||
x
|
||||
#> Class <mic>
|
||||
#> Class 'mic'
|
||||
#> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
|
||||
is.factor(x)
|
||||
@@ -72,7 +72,7 @@ median(x)
|
||||
This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using \link{numeric} values in data analysis, e.g.:
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{x[x > 4]
|
||||
#> Class <mic>
|
||||
#> Class 'mic'
|
||||
#> [1] 16 8 8 64 >=128 32 32 16
|
||||
|
||||
df <- data.frame(x, hospital = "A")
|
||||
|
||||
@@ -16,11 +16,11 @@
|
||||
\source{
|
||||
For interpretations of minimum inhibitory concentration (MIC) values and disk diffusion diameters:
|
||||
\itemize{
|
||||
\item \strong{CLSI M39: Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data}, 2011-2026, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
|
||||
\item \strong{CLSI M100: Performance Standard for Antimicrobial Susceptibility Testing}, 2011-2026, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/microbiology/documents/m100/}.
|
||||
\item \strong{CLSI VET01: Performance Standards for Antimicrobial Disk and Dilution Susceptibility Tests for Bacteria Isolated From Animals}, 2019-2026, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/veterinary-medicine/documents/vet01/}.
|
||||
\item \strong{EUCAST Breakpoint tables for interpretation of MICs and zone diameters}, 2011-2026, \emph{European Committee on Antimicrobial Susceptibility Testing} (EUCAST). \url{https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/}.
|
||||
\item \strong{WHONET} as a source for machine-reading the clinical breakpoints (\href{https://amr-for-r.org/reference/clinical_breakpoints.html#imported-from-whonet}{read more here}), 1989-2026, \emph{WHO Collaborating Centre for Surveillance of Antimicrobial Resistance}. \url{https://whonet.org/}.
|
||||
\item \strong{CLSI M39: Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data}, 2011-2025, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
|
||||
\item \strong{CLSI M100: Performance Standard for Antimicrobial Susceptibility Testing}, 2011-2025, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/microbiology/documents/m100/}.
|
||||
\item \strong{CLSI VET01: Performance Standards for Antimicrobial Disk and Dilution Susceptibility Tests for Bacteria Isolated From Animals}, 2019-2025, \emph{Clinical and Laboratory Standards Institute} (CLSI). \url{https://clsi.org/standards/products/veterinary-medicine/documents/vet01/}.
|
||||
\item \strong{EUCAST Breakpoint tables for interpretation of MICs and zone diameters}, 2011-2025, \emph{European Committee on Antimicrobial Susceptibility Testing} (EUCAST). \url{https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/}.
|
||||
\item \strong{WHONET} as a source for machine-reading the clinical breakpoints (\href{https://amr-for-r.org/reference/clinical_breakpoints.html#imported-from-whonet}{read more here}), 1989-2025, \emph{WHO Collaborating Centre for Surveillance of Antimicrobial Resistance}. \url{https://whonet.org/}.
|
||||
}
|
||||
}
|
||||
\usage{
|
||||
@@ -94,7 +94,7 @@ Otherwise: arguments passed on to methods.}
|
||||
|
||||
\item{ab}{A vector (or column name) with \link{character}s that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.}
|
||||
|
||||
\item{guideline}{A guideline name (or column name) to use for SIR interpretation. Defaults to EUCAST 2026 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2026) and CLSI (2011-2026), see \emph{Details}. Using a column name allows for straightforward interpretation of historical data, which must be analysed in the context of, for example, different years.}
|
||||
\item{guideline}{A guideline name (or column name) to use for SIR interpretation. Defaults to EUCAST 2025 (the latest implemented EUCAST guideline in the \link{clinical_breakpoints} data set), but can be set with the package option \code{\link[=AMR-options]{AMR_guideline}}. Currently supports EUCAST (2011-2025) and CLSI (2011-2025), see \emph{Details}. Using a column name allows for straightforward interpretation of historical data, which must be analysed in the context of, for example, different years.}
|
||||
|
||||
\item{uti}{(Urinary Tract Infection) a vector (or column name) with \link{logical}s (\code{TRUE} or \code{FALSE}) to specify whether a UTI specific interpretation from the guideline should be chosen. For using \code{\link[=as.sir]{as.sir()}} on a \link{data.frame}, this can also be a column containing \link{logical}s or when left blank, the data set will be searched for a column 'specimen', and rows within this column containing 'urin' (such as 'urine', 'urina') will be regarded isolates from a UTI. See \emph{Examples}.}
|
||||
|
||||
@@ -138,7 +138,7 @@ The default \code{"conservative"} setting ensures cautious handling of uncertain
|
||||
|
||||
\item{include_PKPD}{A \link{logical} to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is \code{TRUE}. Can also be set with the package option \code{\link[=AMR-options]{AMR_include_PKPD}}.}
|
||||
|
||||
\item{breakpoint_type}{The type of breakpoints to use, either {.val ECOFF}, {.val animal}, or {.val human}. ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the package option \code{\link[=AMR-options]{AMR_breakpoint_type}}. If \code{host} is set to values of veterinary species, this will automatically be set to \code{"animal"}.}
|
||||
\item{breakpoint_type}{The type of breakpoints to use, either "ECOFF", "animal", or "human". ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the package option \code{\link[=AMR-options]{AMR_breakpoint_type}}. If \code{host} is set to values of veterinary species, this will automatically be set to \code{"animal"}.}
|
||||
|
||||
\item{host}{A vector (or column name) with \link{character}s to indicate the host. Only useful for veterinary breakpoints, as it requires \code{breakpoint_type = "animal"}. The values can be any text resembling the animal species, even in any of the 28 supported languages of this package. For foreign languages, be sure to set the language with \code{\link[=set_AMR_locale]{set_AMR_locale()}} (though it will be automatically guessed based on the system language).}
|
||||
|
||||
@@ -162,7 +162,7 @@ Ordered \link{factor} with new class \code{sir}
|
||||
\description{
|
||||
Clean up existing SIR values, or interpret minimum inhibitory concentration (MIC) values and disk diffusion diameters according to EUCAST or CLSI. \code{\link[=as.sir]{as.sir()}} transforms the input to a new class \code{\link{sir}}, which is an ordered \link{factor} containing the levels \code{S}, \code{SDD}, \code{I}, \code{R}, \code{NI}.
|
||||
|
||||
Breakpoints are currently implemented from EUCAST 2011-2026 and CLSI 2011-2026, see \emph{Details}. All breakpoints used for interpretation are available in our \link{clinical_breakpoints} data set.
|
||||
Breakpoints are currently implemented from EUCAST 2011-2025 and CLSI 2011-2025, see \emph{Details}. All breakpoints used for interpretation are available in our \link{clinical_breakpoints} data set.
|
||||
}
|
||||
\details{
|
||||
\emph{Note: The clinical breakpoints in this package were validated through, and imported from, \href{https://whonet.org}{WHONET}. The public use of this \code{AMR} package has been endorsed by both CLSI and EUCAST. See \link{clinical_breakpoints} for more information.}
|
||||
@@ -215,12 +215,12 @@ as.sir(your_data, ..., parallel = TRUE)
|
||||
|
||||
For interpreting MIC values as well as disk diffusion diameters, currently implemented guidelines are:
|
||||
\itemize{
|
||||
\item For \strong{clinical microbiology}: EUCAST 2011-2026 and CLSI 2011-2026;
|
||||
\item For \strong{veterinary microbiology}: EUCAST 2021-2026 and CLSI 2019-2026;
|
||||
\item For \strong{ECOFFs} (Epidemiological Cut-off Values): EUCAST 2020-2026 and CLSI 2022-2026.
|
||||
\item For \strong{clinical microbiology}: EUCAST 2011-2025 and CLSI 2011-2025;
|
||||
\item For \strong{veterinary microbiology}: EUCAST 2021-2025 and CLSI 2019-2025;
|
||||
\item For \strong{ECOFFs} (Epidemiological Cut-off Values): EUCAST 2020-2025 and CLSI 2022-2025.
|
||||
}
|
||||
|
||||
The \code{guideline} argument must be set to e.g., \code{"EUCAST 2026"} or \code{"CLSI 2026"}. By simply using \code{"EUCAST"} (the default) or \code{"CLSI"} as input, the latest included version of that guideline will automatically be selected. Importantly, using a column name of your data instead, allows for straightforward interpretation of historical data that must be analysed in the context of, for example, different years.
|
||||
The \code{guideline} argument must be set to e.g., \code{"EUCAST 2025"} or \code{"CLSI 2025"}. By simply using \code{"EUCAST"} (the default) or \code{"CLSI"} as input, the latest included version of that guideline will automatically be selected. Importantly, using a column name of your data instead, allows for straightforward interpretation of historical data that must be analysed in the context of, for example, different years.
|
||||
|
||||
You can set your own data set using the \code{reference_data} argument. The \code{guideline} argument will then be ignored.
|
||||
|
||||
|
||||
@@ -5,12 +5,12 @@
|
||||
\alias{clinical_breakpoints}
|
||||
\title{Data Set with Clinical Breakpoints for SIR Interpretation}
|
||||
\format{
|
||||
A \link[tibble:tibble]{tibble} with 45 730 observations and 14 variables:
|
||||
A \link[tibble:tibble]{tibble} with 40 217 observations and 14 variables:
|
||||
\itemize{
|
||||
\item \code{guideline}\cr Name of the guideline
|
||||
\item \code{type}\cr Breakpoint type, either {.val ECOFF}, {.val animal}, or {.val human}
|
||||
\item \code{host}\cr Host of infectious agent. This is mostly useful for veterinary breakpoints and is either {.val ECOFF}, {.val aquatic}, {.val cats}, {.val cattle}, {.val dogs}, {.val horse}, {.val human}, {.val poultry}, or {.val swine}
|
||||
\item \code{method}\cr Testing method, either {.val DISK} or {.val MIC}
|
||||
\item \code{type}\cr Breakpoint type, either "ECOFF", "animal", or "human"
|
||||
\item \code{host}\cr Host of infectious agent. This is mostly useful for veterinary breakpoints and is either "ECOFF", "aquatic", "cats", "cattle", "dogs", "horse", "human", "poultry", or "swine"
|
||||
\item \code{method}\cr Testing method, either "DISK" or "MIC"
|
||||
\item \code{site}\cr Body site for which the breakpoint must be applied, e.g. "Oral" or "Respiratory"
|
||||
\item \code{mo}\cr Microbial ID, see \code{\link[=as.mo]{as.mo()}}
|
||||
\item \code{rank_index}\cr Taxonomic rank index of \code{mo} from 1 (subspecies/infraspecies) to 5 (unknown microorganism)
|
||||
@@ -20,7 +20,7 @@ A \link[tibble:tibble]{tibble} with 45 730 observations and 14 variables:
|
||||
\item \code{breakpoint_S}\cr Lowest MIC value or highest number of millimetres that leads to "S"
|
||||
\item \code{breakpoint_R}\cr Highest MIC value or lowest number of millimetres that leads to "R", can be \code{NA}
|
||||
\item \code{uti}\cr A \link{logical} value (\code{TRUE}/\code{FALSE}) to indicate whether the rule applies to a urinary tract infection (UTI)
|
||||
\item \code{is_SDD}\cr A \link{logical} value (\code{TRUE}/\code{FALSE}) to indicate whether the intermediate range between "S" and "R" should be interpreted as "SDD", instead of "I". This currently applies to 72 breakpoints.
|
||||
\item \code{is_SDD}\cr A \link{logical} value (\code{TRUE}/\code{FALSE}) to indicate whether the intermediate range between "S" and "R" should be interpreted as "SDD", instead of "I". This currently applies to 48 breakpoints.
|
||||
}
|
||||
}
|
||||
\usage{
|
||||
@@ -31,9 +31,9 @@ Data set containing clinical breakpoints to interpret MIC and disk diffusion to
|
||||
|
||||
These breakpoints are currently implemented:
|
||||
\itemize{
|
||||
\item For \strong{clinical microbiology}: EUCAST 2011-2026 and CLSI 2011-2026;
|
||||
\item For \strong{veterinary microbiology}: EUCAST 2021-2026 and CLSI 2019-2026;
|
||||
\item For \strong{ECOFFs} (Epidemiological Cut-off Values): EUCAST 2020-2026 and CLSI 2022-2026.
|
||||
\item For \strong{clinical microbiology}: EUCAST 2011-2025 and CLSI 2011-2025;
|
||||
\item For \strong{veterinary microbiology}: EUCAST 2021-2025 and CLSI 2019-2025;
|
||||
\item For \strong{ECOFFs} (Epidemiological Cut-off Values): EUCAST 2020-2025 and CLSI 2022-2025.
|
||||
}
|
||||
|
||||
Use \code{\link[=as.sir]{as.sir()}} to transform MICs or disks measurements to SIR values.
|
||||
|
||||
@@ -9,10 +9,10 @@ A \link[tibble:tibble]{tibble} with 759 observations and 9 variables:
|
||||
\itemize{
|
||||
\item \code{ab}\cr Antimicrobial ID as used in this package (such as \code{AMC}), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
\item \code{name}\cr Official name of the antimicrobial drug as used by WHONET/EARS-Net or the WHO
|
||||
\item \code{type}\cr Type of the dosage, either {.val high_dosage}, {.val standard_dosage}, or {.val uncomplicated_uti}
|
||||
\item \code{type}\cr Type of the dosage, either "high_dosage", "standard_dosage", or "uncomplicated_uti"
|
||||
\item \code{dose}\cr Dose, such as "2 g" or "25 mg/kg"
|
||||
\item \code{dose_times}\cr Number of times a dose must be administered
|
||||
\item \code{administration}\cr Route of administration, either {.val }, {.val im}, {.val iv}, {.val oral}, or NA
|
||||
\item \code{administration}\cr Route of administration, either "", "im", "iv", "oral", or NA
|
||||
\item \code{notes}\cr Additional dosage notes
|
||||
\item \code{original_txt}\cr Original text in the PDF file of EUCAST
|
||||
\item \code{eucast_version}\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply, either 15, 14, 13.1, 12, or 11
|
||||
|
||||
@@ -10,8 +10,8 @@ A \link[tibble:tibble]{tibble} with 2 000 observations and 46 variables:
|
||||
\item \code{date}\cr Date of receipt at the laboratory
|
||||
\item \code{patient}\cr ID of the patient
|
||||
\item \code{age}\cr Age of the patient
|
||||
\item \code{gender}\cr Gender of the patient, either {.val F} or {.val M}
|
||||
\item \code{ward}\cr Ward type where the patient was admitted, either {.val Clinical}, {.val ICU}, or {.val Outpatient}
|
||||
\item \code{gender}\cr Gender of the patient, either "F" or "M"
|
||||
\item \code{ward}\cr Ward type where the patient was admitted, either "Clinical", "ICU", or "Outpatient"
|
||||
\item \code{mo}\cr ID of microorganism created with \code{\link[=as.mo]{as.mo()}}, see also the \link{microorganisms} data set
|
||||
\item \code{PEN:RIF}\cr 40 different antimicrobials with class \code{\link{sir}} (see \code{\link[=as.sir]{as.sir()}}); these column names occur in the \link{antimicrobials} data set and can be translated with \code{\link[=set_ab_names]{set_ab_names()}} or \code{\link[=ab_name]{ab_name()}}
|
||||
}
|
||||
|
||||
@@ -24,7 +24,7 @@ Leclercq et al. \strong{EUCAST expert rules in antimicrobial susceptibility test
|
||||
interpretive_rules(x, col_mo = NULL, info = interactive(),
|
||||
rules = getOption("AMR_interpretive_rules", default = c("breakpoints",
|
||||
"expected_phenotypes")), guideline = getOption("AMR_guideline", "EUCAST"),
|
||||
verbose = FALSE, version_breakpoints = 16,
|
||||
verbose = FALSE, version_breakpoints = 15,
|
||||
version_expected_phenotypes = 1.2, version_expertrules = 3.3,
|
||||
ampc_cephalosporin_resistance = NA, only_sir_columns = any(is.sir(x)),
|
||||
custom_rules = NULL, overwrite = FALSE, ...)
|
||||
@@ -52,11 +52,11 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15)
|
||||
|
||||
\item{verbose}{A \link{logical} to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.}
|
||||
|
||||
\item{version_breakpoints}{The version number to use for the EUCAST Clinical Breakpoints guideline. Can be {.val 16.0}, {.val 15.0}, {.val 14.0}, {.val 13.1}, {.val 12.0}, {.val 11.0}, or {.val 10.0}.}
|
||||
\item{version_breakpoints}{The version number to use for the EUCAST Clinical Breakpoints guideline. Can be "15.0", "14.0", "13.1", "12.0", "11.0", or "10.0".}
|
||||
|
||||
\item{version_expected_phenotypes}{The version number to use for the EUCAST Expected Phenotypes. Can be {.val 1.2}.}
|
||||
\item{version_expected_phenotypes}{The version number to use for the EUCAST Expected Phenotypes. Can be "1.2".}
|
||||
|
||||
\item{version_expertrules}{The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be {.val 3.3}, {.val 3.2}, or {.val 3.1}.}
|
||||
\item{version_expertrules}{The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be "3.3", "3.2", or "3.1".}
|
||||
|
||||
\item{ampc_cephalosporin_resistance}{(only applies when \code{rules} contains \code{"expert"} or \code{"all"}) a \link{character} value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is \code{NA}. Currently only works when \code{version_expertrules} is \code{3.2} and higher; these versions of '\emph{EUCAST Expert Rules on Enterobacterales}' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of \code{NA} (the default) for this argument will remove results for these three drugs, while e.g. a value of \code{"R"} will make the results for these drugs resistant. Use \code{NULL} or \code{FALSE} to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using \code{TRUE} is equal to using \code{"R"}. \cr For \emph{EUCAST Expert Rules} v3.2, this rule applies to: \emph{Citrobacter braakii}, \emph{Citrobacter freundii}, \emph{Citrobacter gillenii}, \emph{Citrobacter murliniae}, \emph{Citrobacter rodenticum}, \emph{Citrobacter sedlakii}, \emph{Citrobacter werkmanii}, \emph{Citrobacter youngae}, \emph{Enterobacter}, \emph{Hafnia alvei}, \emph{Klebsiella aerogenes}, \emph{Morganella morganii}, \emph{Providencia}, and \emph{Serratia}.}
|
||||
|
||||
@@ -70,7 +70,7 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15)
|
||||
|
||||
\item{ab}{Any (vector of) text that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.}
|
||||
|
||||
\item{administration}{Route of administration, either {.val }, {.val im}, {.val iv}, {.val oral}, or NA.}
|
||||
\item{administration}{Route of administration, either "", "im", "iv", "oral", or NA.}
|
||||
}
|
||||
\value{
|
||||
The input of \code{x}, possibly with edited values of antimicrobials. Or, if \code{verbose = TRUE}, a \link{data.frame} with all original and new values of the affected bug-drug combinations.
|
||||
@@ -81,7 +81,7 @@ Apply rules from clinical breakpoints notes and expected resistant phenotypes as
|
||||
To improve the interpretation of the antibiogram before CLSI/EUCAST interpretive rules are applied, some AMR-specific rules can be applied at default, see \emph{Details}.
|
||||
}
|
||||
\details{
|
||||
\strong{Note:} This function does not translate MIC or disk values to SIR values. Use \code{\link[=as.sir]{as.sir()}} for that. \cr
|
||||
\strong{Note:} This function does not translate MIC values to SIR values. Use \code{\link[=as.sir]{as.sir()}} for that. \cr
|
||||
\strong{Note:} When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
||||
|
||||
The file containing all EUCAST rules is located here: \url{https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv}. \strong{Note:} Old taxonomic names are replaced with the current taxonomy where applicable. For example, \emph{Ochrobactrum anthropi} was renamed to \emph{Brucella anthropi} in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The \code{AMR} package contains the full microbial taxonomy updated until June 24th, 2024, see \link{microorganisms}.
|
||||
|
||||
@@ -9,12 +9,12 @@ A \link[tibble:tibble]{tibble} with 78 679 observations and 26 variables:
|
||||
\itemize{
|
||||
\item \code{mo}\cr ID of microorganism as used by this package. \emph{\strong{This is a unique identifier.}}
|
||||
\item \code{fullname}\cr Full name, like \code{"Escherichia coli"}. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. \emph{\strong{This is a unique identifier.}}
|
||||
\item \code{status} \cr Status of the taxon, either {.val accepted}, {.val not validly published}, {.val synonym}, or {.val unknown}
|
||||
\item \code{status} \cr Status of the taxon, either "accepted", "not validly published", "synonym", or "unknown"
|
||||
\item \code{kingdom}, \code{phylum}, \code{class}, \code{order}, \code{family}, \code{genus}, \code{species}, \code{subspecies}\cr Taxonomic rank of the microorganism. Note that for fungi, \emph{phylum} is equal to their taxonomic \emph{division}. Also, for fungi, \emph{subkingdom} and \emph{subdivision} were left out since they do not occur in the bacterial taxonomy.
|
||||
\item \code{rank}\cr Text of the taxonomic rank of the microorganism, such as \code{"species"} or \code{"genus"}
|
||||
\item \code{ref}\cr Author(s) and year of related scientific publication. This contains only the \emph{first surname} and year of the \emph{latest} authors, e.g. "Wallis \emph{et al.} 2006 \emph{emend.} Smith and Jones 2018" becomes "Smith \emph{et al.}, 2018". This field is directly retrieved from the source specified in the column \code{source}. Moreover, accents were removed to comply with CRAN that only allows ASCII characters.
|
||||
\item \code{oxygen_tolerance} \cr Oxygen tolerance, either {.val aerobe}, {.val anaerobe}, {.val anaerobe/microaerophile}, {.val facultative anaerobe}, {.val likely facultative anaerobe}, {.val microaerophile}, or NA. These data were retrieved from BacDive (see \emph{Source}). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently 68.3\% of all ~39 000 bacteria in the data set contain an oxygen tolerance.
|
||||
\item \code{source}\cr Either {.val GBIF}, {.val LPSN}, {.val Manually added}, {.val MycoBank}, or {.val manually added} (see \emph{Source})
|
||||
\item \code{oxygen_tolerance} \cr Oxygen tolerance, either "aerobe", "anaerobe", "anaerobe/microaerophile", "facultative anaerobe", "likely facultative anaerobe", "microaerophile", or NA. These data were retrieved from BacDive (see \emph{Source}). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently 68.3\% of all ~39 000 bacteria in the data set contain an oxygen tolerance.
|
||||
\item \code{source}\cr Either "GBIF", "LPSN", "Manually added", "MycoBank", or "manually added" (see \emph{Source})
|
||||
\item \code{lpsn}\cr Identifier ('Record number') of List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, \emph{Acetobacter ascendens} has LPSN Record number 7864 and 11011. Only the first is available in the \code{microorganisms} data set. \emph{\strong{This is a unique identifier}}, though available for only ~33 000 records.
|
||||
\item \code{lpsn_parent}\cr LPSN identifier of the parent taxon
|
||||
\item \code{lpsn_renamed_to}\cr LPSN identifier of the currently valid taxon
|
||||
|
||||
@@ -3,9 +3,9 @@
|
||||
\docType{data}
|
||||
\name{microorganisms.codes}
|
||||
\alias{microorganisms.codes}
|
||||
\title{Data Set with 6 050 Common Microorganism Codes}
|
||||
\title{Data Set with 6 036 Common Microorganism Codes}
|
||||
\format{
|
||||
A \link[tibble:tibble]{tibble} with 6 050 observations and 2 variables:
|
||||
A \link[tibble:tibble]{tibble} with 6 036 observations and 2 variables:
|
||||
\itemize{
|
||||
\item \code{code}\cr Commonly used code of a microorganism. \emph{\strong{This is a unique identifier.}}
|
||||
\item \code{mo}\cr ID of the microorganism in the \link{microorganisms} data set
|
||||
|
||||
@@ -165,7 +165,7 @@ The default is \code{FALSE}, which will return a note if outdated taxonomic name
|
||||
|
||||
\item{open}{Browse the URL using \code{\link[utils:browseURL]{browseURL()}}.}
|
||||
|
||||
\item{property}{One of the column names of the \link{microorganisms} data set: {.val mo}, {.val fullname}, {.val status}, {.val kingdom}, {.val phylum}, {.val class}, {.val order}, {.val family}, {.val genus}, {.val species}, {.val subspecies}, {.val rank}, {.val ref}, {.val oxygen_tolerance}, {.val source}, {.val lpsn}, {.val lpsn_parent}, {.val lpsn_renamed_to}, {.val mycobank}, {.val mycobank_parent}, {.val mycobank_renamed_to}, {.val gbif}, {.val gbif_parent}, {.val gbif_renamed_to}, {.val prevalence}, or {.val snomed}, or must be \code{"shortname"}.}
|
||||
\item{property}{One of the column names of the \link{microorganisms} data set: "mo", "fullname", "status", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", "rank", "ref", "oxygen_tolerance", "source", "lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence", or "snomed", or must be \code{"shortname"}.}
|
||||
}
|
||||
\value{
|
||||
\itemize{
|
||||
|
||||
@@ -58,7 +58,7 @@ It has now created a file \code{"~/mo_source.rds"} with the contents of our Exce
|
||||
And now we can use it in our functions:
|
||||
|
||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{as.mo("lab_mo_ecoli")
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI
|
||||
|
||||
mo_genus("lab_mo_kpneumoniae")
|
||||
@@ -68,7 +68,7 @@ mo_genus("lab_mo_kpneumoniae")
|
||||
as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||
#> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||
#> Use mo_uncertainties() to review it.
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||
}\if{html}{\out{</div>}}
|
||||
|
||||
@@ -89,7 +89,7 @@ If we edit the Excel file by, let's say, adding row 4 like this:
|
||||
#> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#> "Organisation XYZ" and "mo"
|
||||
#> Class <mo>
|
||||
#> Class 'mo'
|
||||
#> [1] B_ESCHR_COLI
|
||||
|
||||
mo_genus("lab_Staph_aureus")
|
||||
|
||||
@@ -137,7 +137,7 @@ labels_sir_count(position = NULL, x = "antibiotic",
|
||||
|
||||
\item{include_PKPD}{A \link{logical} to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is \code{TRUE}. Can also be set with the package option \code{\link[=AMR-options]{AMR_include_PKPD}}.}
|
||||
|
||||
\item{breakpoint_type}{The type of breakpoints to use, either {.val ECOFF}, {.val animal}, or {.val human}. ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the package option \code{\link[=AMR-options]{AMR_breakpoint_type}}. If \code{host} is set to values of veterinary species, this will automatically be set to \code{"animal"}.}
|
||||
\item{breakpoint_type}{The type of breakpoints to use, either "ECOFF", "animal", or "human". ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the package option \code{\link[=AMR-options]{AMR_breakpoint_type}}. If \code{host} is set to values of veterinary species, this will automatically be set to \code{"animal"}.}
|
||||
|
||||
\item{facet}{Variable to split plots by, either \code{"interpretation"} (default) or \code{"antibiotic"} or a grouping variable.}
|
||||
|
||||
@@ -201,7 +201,7 @@ This package contains more functions that extend the \code{ggplot2} package, to
|
||||
|
||||
The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
|
||||
|
||||
For interpreting MIC values as well as disk diffusion diameters, the default guideline is EUCAST 2026, unless the package option \code{\link[=AMR-options]{AMR_guideline}} is set. See \code{\link[=as.sir]{as.sir()}} for more information.
|
||||
For interpreting MIC values as well as disk diffusion diameters, the default guideline is EUCAST 2025, unless the package option \code{\link[=AMR-options]{AMR_guideline}} is set. See \code{\link[=as.sir]{as.sir()}} for more information.
|
||||
}
|
||||
}
|
||||
\examples{
|
||||
|
||||
@@ -12,7 +12,7 @@ top_n_microorganisms(x, n, property = "species", n_for_each = NULL,
|
||||
|
||||
\item{n}{An integer specifying the maximum number of unique values of the \code{property} to include in the output.}
|
||||
|
||||
\item{property}{A character string indicating the microorganism property to use for filtering. Must be one of the column names of the \link{microorganisms} data set: {.val mo}, {.val fullname}, {.val status}, {.val kingdom}, {.val phylum}, {.val class}, {.val order}, {.val family}, {.val genus}, {.val species}, {.val subspecies}, {.val rank}, {.val ref}, {.val oxygen_tolerance}, {.val source}, {.val lpsn}, {.val lpsn_parent}, {.val lpsn_renamed_to}, {.val mycobank}, {.val mycobank_parent}, {.val mycobank_renamed_to}, {.val gbif}, {.val gbif_parent}, {.val gbif_renamed_to}, {.val prevalence}, or {.val snomed}. If \code{NULL}, the raw values from \code{col_mo} will be used without transformation. When using \code{"species"} (default) or \code{"subpecies"}, the genus will be added to make sure each (sub)species still belongs to the right genus.}
|
||||
\item{property}{A character string indicating the microorganism property to use for filtering. Must be one of the column names of the \link{microorganisms} data set: "mo", "fullname", "status", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", "rank", "ref", "oxygen_tolerance", "source", "lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence", or "snomed". If \code{NULL}, the raw values from \code{col_mo} will be used without transformation. When using \code{"species"} (default) or \code{"subpecies"}, the genus will be added to make sure each (sub)species still belongs to the right genus.}
|
||||
|
||||
\item{n_for_each}{An optional integer specifying the maximum number of rows to retain for each value of the selected property. If \code{NULL}, all rows within the top \emph{n} groups will be included.}
|
||||
|
||||
|
||||
@@ -32,15 +32,15 @@ test_that("test-eucast_rules.R", {
|
||||
|
||||
# thoroughly check input table
|
||||
expect_equal(
|
||||
sort(colnames(AMR:::EUCAST_RULES_DF)),
|
||||
sort(c(
|
||||
colnames(AMR:::EUCAST_RULES_DF),
|
||||
c(
|
||||
"if_mo_property", "like.is.one_of", "this_value",
|
||||
"and_these_antibiotics", "have_these_values",
|
||||
"then_change_these_antibiotics", "to_value",
|
||||
"reference.rule", "reference.rule_group",
|
||||
"reference.version",
|
||||
"note"
|
||||
))
|
||||
)
|
||||
)
|
||||
MOs_mentioned <- unique(AMR:::EUCAST_RULES_DF$this_value)
|
||||
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!AMR:::is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
|
||||
@@ -219,6 +219,7 @@ test_that("test-eucast_rules.R", {
|
||||
expect_inherits(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame")
|
||||
|
||||
|
||||
|
||||
x <- custom_eucast_rules(
|
||||
AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
|
||||
|
||||
@@ -270,8 +270,10 @@ test_that("test-mo.R", {
|
||||
))),
|
||||
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_KLBSL_TRRG")
|
||||
)
|
||||
|
||||
expect_output(print(mo_uncertainties()))
|
||||
x <- as.mo("Sta. aur")
|
||||
# many hits
|
||||
expect_output(print(mo_uncertainties()))
|
||||
|
||||
# no viruses
|
||||
expect_equal(suppressWarnings(as.mo("Virus")), as.mo("UNKNOWN"))
|
||||
|
||||
@@ -138,6 +138,7 @@ test_that("test-proportion.R", {
|
||||
expect_error(proportion_I("test", as_percent = "test"))
|
||||
expect_error(proportion_S("test", minimum = "test"))
|
||||
expect_error(proportion_S("test", as_percent = "test"))
|
||||
expect_error(proportion_S("test", also_single_tested = TRUE))
|
||||
|
||||
# check too low amount of isolates
|
||||
expect_identical(
|
||||
|
||||
@@ -120,7 +120,7 @@ test_that("test-sir.R", {
|
||||
# allow for guideline length > 1
|
||||
expect_equal(
|
||||
AMR:::get_guideline(c("CLSI", "CLSI", "CLSI2023", "EUCAST", "EUCAST2020"), AMR::clinical_breakpoints),
|
||||
c("CLSI 2026", "CLSI 2026", "CLSI 2023", "EUCAST 2026", "EUCAST 2020")
|
||||
c("CLSI 2025", "CLSI 2025", "CLSI 2023", "EUCAST 2025", "EUCAST 2020")
|
||||
)
|
||||
|
||||
# these are used in the script
|
||||
|
||||
@@ -36,7 +36,6 @@ test_that("test-zzz.R", {
|
||||
# functions used by import_fn()
|
||||
import_functions <- c(
|
||||
"%chin%" = "data.table",
|
||||
"ansi_has_hyperlink_support" = "cli",
|
||||
"anti_join" = "dplyr",
|
||||
"as.data.table" = "data.table",
|
||||
"as_tibble" = "tibble",
|
||||
@@ -80,12 +79,6 @@ test_that("test-zzz.R", {
|
||||
"freq.default" = "cleaner",
|
||||
"percentage" = "cleaner",
|
||||
# cli
|
||||
"ansi_has_hyperlink_support" = "cli",
|
||||
"cli_abort" = "cli",
|
||||
"cli_inform" = "cli",
|
||||
"cli_warn" = "cli",
|
||||
"code_highlight" = "cli",
|
||||
"format_inline" = "cli",
|
||||
"symbol" = "cli",
|
||||
# curl
|
||||
"has_internet" = "curl",
|
||||
@@ -131,8 +124,6 @@ test_that("test-zzz.R", {
|
||||
"availableCores" = "parallelly",
|
||||
# pillar
|
||||
"pillar_shaft" = "pillar",
|
||||
"style_na" = "pillar",
|
||||
"style_subtle" = "pillar",
|
||||
"tbl_format_footer" = "pillar",
|
||||
"tbl_sum" = "pillar",
|
||||
"type_sum" = "pillar",
|
||||
@@ -170,9 +161,7 @@ test_that("test-zzz.R", {
|
||||
"vec_math" = "vctrs",
|
||||
"vec_ptype2" = "vctrs",
|
||||
"vec_ptype_abbr" = "vctrs",
|
||||
"vec_ptype_full" = "vctrs",
|
||||
# usethis
|
||||
"use_course" = "usethis"
|
||||
"vec_ptype_full" = "vctrs"
|
||||
)
|
||||
|
||||
import_functions <- c(import_functions, call_functions)
|
||||
|
||||
Reference in New Issue
Block a user