mirror of
https://github.com/msberends/AMR.git
synced 2026-03-30 14:55:54 +02:00
Compare commits
7 Commits
3e4983ff93
...
claude/rev
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ec11b4ebc1 | ||
|
|
6a7e8ce036 | ||
| 9c95aa455c | |||
| 2a8a1eda97 | |||
| 975a690c10 | |||
| 3d1412e8c9 | |||
|
|
4171d5b778 |
@@ -29,10 +29,11 @@
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
# run in each PR in this repo
|
||||
# run in each PR in this repo (1 worker, see matrix logic below)
|
||||
branches: '**'
|
||||
push:
|
||||
branches: '**'
|
||||
# only on main; pushing to a PR branch is already covered by pull_request above
|
||||
branches: [main]
|
||||
schedule:
|
||||
# also run a schedule everyday at 1 AM.
|
||||
# this is to check that all dependencies are still available (see R/zzz.R)
|
||||
|
||||
6
.github/workflows/codecovr.yaml
vendored
6
.github/workflows/codecovr.yaml
vendored
@@ -28,10 +28,12 @@
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: '**'
|
||||
pull_request:
|
||||
# run on every PR update (once per push)
|
||||
branches: '**'
|
||||
push:
|
||||
# only on main; PR pushes are already covered by pull_request above
|
||||
branches: [main]
|
||||
|
||||
name: code-coverage
|
||||
|
||||
|
||||
11
CLAUDE.md
11
CLAUDE.md
@@ -152,7 +152,16 @@ All PRs are **squash-merged**, so each PR lands as exactly **one commit** on the
|
||||
|
||||
#### Computing the correct version number
|
||||
|
||||
Run the following from the repo root to determine the version string to use:
|
||||
**First, ensure `git` and `gh` are installed** — both are required for the version computation and for pushing changes. Install them if missing before doing anything else:
|
||||
|
||||
```bash
|
||||
which git || apt-get install -y git
|
||||
which gh || apt-get install -y gh
|
||||
# Also ensure all tags are fetched so git describe works
|
||||
git fetch --tags
|
||||
```
|
||||
|
||||
Then run the following from the repo root to determine the version string to use:
|
||||
|
||||
```bash
|
||||
currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 3.0.1.9036
|
||||
Date: 2026-03-18
|
||||
Version: 3.0.1.9040
|
||||
Date: 2026-03-24
|
||||
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,7 +63,8 @@ Suggests:
|
||||
tidyselect,
|
||||
tinytest,
|
||||
vctrs,
|
||||
xml2
|
||||
xml2,
|
||||
usethis
|
||||
VignetteBuilder: knitr,rmarkdown
|
||||
URL: https://amr-for-r.org, https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
|
||||
9
NEWS.md
9
NEWS.md
@@ -1,4 +1,4 @@
|
||||
# AMR 3.0.1.9036
|
||||
# AMR 3.0.1.9040
|
||||
|
||||
### New
|
||||
* Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
|
||||
@@ -23,6 +23,7 @@
|
||||
* 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
|
||||
@@ -30,6 +31,7 @@
|
||||
* 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)
|
||||
* `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`)
|
||||
@@ -44,11 +46,6 @@
|
||||
* 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
|
||||
|
||||
@@ -253,12 +253,9 @@ 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(
|
||||
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
|
||||
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
|
||||
)
|
||||
}
|
||||
} else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) {
|
||||
@@ -304,8 +301,9 @@ 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 '", font_bold(found), "' found as input for `", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"`, but this column does not contain 'logical' values (TRUE/FALSE) and was ignored."
|
||||
message_(
|
||||
"Column {.field ", 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
|
||||
}
|
||||
@@ -316,9 +314,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 '", font_bold(found), "' as input for `", ifelse(add_col_prefix, "col_", ""), type, "`.")
|
||||
msg <- paste0("Using column {.field ", font_bold(found), "} as input for {.arg ", ifelse(add_col_prefix, "col_", ""), type, "}.")
|
||||
if (type %in% c("keyantibiotics", "keyantimicrobials", "specimen")) {
|
||||
msg <- paste(msg, "Use", font_bold(paste0(ifelse(add_col_prefix, "col_", ""), type), "= FALSE"), "to prevent this.")
|
||||
msg <- paste(msg, "Use {.arg ", paste0(ifelse(add_col_prefix, "col_", ""), type), "= FALSE} to prevent this.")
|
||||
}
|
||||
message_(msg)
|
||||
}
|
||||
@@ -382,19 +380,11 @@ 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
|
||||
}
|
||||
}
|
||||
|
||||
import_fn <- function(name, pkg, error_on_fail = TRUE) {
|
||||
if (isTRUE(error_on_fail)) {
|
||||
stop_ifnot_installed(pkg)
|
||||
}
|
||||
if (pkg == "rstudioapi" && !in_rstudio()) {
|
||||
if (pkg == "rstudioapi" && (!in_rstudio() || !interactive())) {
|
||||
# only allow rstudioapi to be imported if we're in RStudio
|
||||
return(NULL)
|
||||
}
|
||||
@@ -415,6 +405,30 @@ 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()) {
|
||||
@@ -451,15 +465,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]]
|
||||
@@ -470,8 +484,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)) {
|
||||
@@ -538,15 +552,46 @@ 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 {
|
||||
} 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())
|
||||
}
|
||||
} else {
|
||||
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||
@@ -559,6 +604,9 @@ 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())
|
||||
@@ -571,6 +619,9 @@ 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)
|
||||
@@ -771,7 +822,7 @@ format_class <- function(class, plural = FALSE) {
|
||||
ifelse(plural, "s", "")
|
||||
)
|
||||
# exceptions
|
||||
class[class == "logical"] <- ifelse(plural, "a vector of `TRUE`/`FALSE`", "`TRUE` or `FALSE`")
|
||||
class[class == "logical"] <- ifelse(plural, "a vector of {.code TRUE}/{.code FALSE}", "{.code TRUE} or {.code FALSE}")
|
||||
class[class == "data.frame"] <- "a data set"
|
||||
if ("list" %in% class) {
|
||||
class <- "a list"
|
||||
@@ -780,12 +831,12 @@ format_class <- function(class, plural = FALSE) {
|
||||
class <- "a matrix"
|
||||
}
|
||||
if ("custom_eucast_rules" %in% class) {
|
||||
class <- "input created with `custom_eucast_rules()`"
|
||||
class <- "input created with {.fun custom_eucast_rules}"
|
||||
}
|
||||
if (any(c("mo", "ab", "sir") %in% class)) {
|
||||
class <- paste0("of class '", class[1L], "'")
|
||||
class <- paste0("of class {.cls ", class[1L], "}")
|
||||
}
|
||||
class[class == class.bak] <- paste0("of class '", class[class == class.bak], "'")
|
||||
class[class == class.bak] <- paste0("of class {.cls ", class[class == class.bak], "}")
|
||||
# output
|
||||
vector_or(class, quotes = FALSE, sort = FALSE)
|
||||
}
|
||||
@@ -820,11 +871,11 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
AMR_env$meet_criteria_error_txt <- NULL
|
||||
|
||||
if (is.null(object)) {
|
||||
stop_if(allow_NULL == FALSE, "argument `", obj_name, "` must not be NULL", call = call_depth)
|
||||
stop_if(allow_NULL == FALSE, "argument {.arg ", obj_name, "} must not be NULL", call = call_depth)
|
||||
return(invisible())
|
||||
}
|
||||
if (is.null(dim(object)) && length(object) == 1 && suppressWarnings(is.na(object))) { # suppressWarnings for functions
|
||||
stop_if(allow_NA == FALSE, "argument `", obj_name, "` must not be NA", call = call_depth)
|
||||
stop_if(allow_NA == FALSE, "argument {.arg ", obj_name, "} must not be NA", call = call_depth)
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
@@ -834,32 +885,32 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
}
|
||||
|
||||
if (!is.null(allow_class) && !(suppressWarnings(all(is.na(object))) && allow_NA == TRUE)) {
|
||||
stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
|
||||
"` must be ", format_class(allow_class, plural = isTRUE(has_length > 1)),
|
||||
stop_ifnot(inherits(object, allow_class), "argument {.arg ", obj_name,
|
||||
"} must be ", format_class(allow_class, plural = isTRUE(has_length > 1)),
|
||||
", i.e. not be ", format_class(class(object), plural = isTRUE(has_length > 1)),
|
||||
call = call_depth
|
||||
)
|
||||
# check data.frames for data
|
||||
if (inherits(object, "data.frame")) {
|
||||
stop_if(any(dim(object) == 0),
|
||||
"the data provided in argument `", obj_name,
|
||||
"` must contain rows and columns (current dimensions: ",
|
||||
"the data provided in argument {.arg ", obj_name,
|
||||
"} must contain rows and columns (current dimensions: ",
|
||||
paste(dim(object), collapse = "x"), ")",
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
}
|
||||
if (!is.null(has_length)) {
|
||||
stop_ifnot(length(object) %in% has_length, "argument `", obj_name,
|
||||
"` must ", # ifelse(allow_NULL, "be NULL or must ", ""),
|
||||
stop_ifnot(length(object) %in% has_length, "argument {.arg ", obj_name,
|
||||
"} must ", # ifelse(allow_NULL, "be NULL or must ", ""),
|
||||
"be of length ", vector_or(has_length, quotes = FALSE),
|
||||
", not ", length(object),
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
if (!is.null(looks_like)) {
|
||||
stop_ifnot(object %like% looks_like, "argument `", obj_name,
|
||||
"` must ", # ifelse(allow_NULL, "be NULL or must ", ""),
|
||||
stop_ifnot(object %like% looks_like, "argument {.arg ", obj_name,
|
||||
"} must ", # ifelse(allow_NULL, "be NULL or must ", ""),
|
||||
"resemble the regular expression \"", looks_like, "\"",
|
||||
call = call_depth
|
||||
)
|
||||
@@ -877,7 +928,7 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
if ("logical" %in% allow_class) {
|
||||
or_values <- paste0(or_values, ", or TRUE or FALSE")
|
||||
}
|
||||
stop_ifnot(all(object %in% is_in.bak, na.rm = TRUE), "argument `", obj_name, "` ",
|
||||
stop_ifnot(all(object %in% is_in.bak, na.rm = TRUE), "argument {.arg ", obj_name, "} ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"must be either ",
|
||||
"must only contain values "
|
||||
@@ -888,8 +939,8 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
)
|
||||
}
|
||||
if (isTRUE(is_positive)) {
|
||||
stop_if(is.numeric(object) && !all(object > 0, na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
stop_if(is.numeric(object) && !all(object > 0, na.rm = TRUE), "argument {.arg ", obj_name,
|
||||
"} must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be a number higher than zero",
|
||||
"all be numbers higher than zero"
|
||||
@@ -898,8 +949,8 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
)
|
||||
}
|
||||
if (isTRUE(is_positive_or_zero)) {
|
||||
stop_if(is.numeric(object) && !all(object >= 0, na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
stop_if(is.numeric(object) && !all(object >= 0, na.rm = TRUE), "argument {.arg ", obj_name,
|
||||
"} must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be zero or a positive number",
|
||||
"all be zero or numbers higher than zero"
|
||||
@@ -908,8 +959,8 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
)
|
||||
}
|
||||
if (isTRUE(is_finite)) {
|
||||
stop_if(is.numeric(object) && !all(is.finite(object[!is.na(object)]), na.rm = TRUE), "argument `", obj_name,
|
||||
"` must ",
|
||||
stop_if(is.numeric(object) && !all(is.finite(object[!is.na(object)]), na.rm = TRUE), "argument {.arg ", obj_name,
|
||||
"} must ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"be a finite number",
|
||||
"all be finite numbers"
|
||||
@@ -943,8 +994,8 @@ ascertain_sir_classes <- function(x, obj_name) {
|
||||
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
|
||||
if (!any(sirs, na.rm = TRUE)) {
|
||||
warning_(
|
||||
"the data provided in argument `", obj_name,
|
||||
"` should contain at least one column of class 'sir'. Eligible SIR column were now guessed. ",
|
||||
"the data provided in argument {.arg ", obj_name,
|
||||
"} should contain at least one column of class {.cls sir}. Eligible SIR columns were now guessed. ",
|
||||
"See {.help [{.fun as.sir}](AMR::as.sir)}.",
|
||||
immediate = TRUE
|
||||
)
|
||||
@@ -1047,13 +1098,13 @@ get_current_data <- function(arg_name, call) {
|
||||
} else {
|
||||
examples <- ""
|
||||
}
|
||||
stop_("this function must be used inside a `dplyr` verb or `data.frame` call",
|
||||
stop_("this function must be used inside a {.pkg dplyr} verb or {.cls data.frame} call",
|
||||
examples,
|
||||
call = call
|
||||
)
|
||||
} else {
|
||||
# mimic a base R error that the argument is missing
|
||||
stop_("argument `", arg_name, "` is missing with no default", call = call)
|
||||
stop_("argument {.arg ", arg_name, "} is missing with no default", call = call)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1647,7 +1698,7 @@ if (!is.null(import_fn("where", "tidyselect", error_on_fail = FALSE))) {
|
||||
where <- function(fn) {
|
||||
# based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
|
||||
if (!is.function(fn)) {
|
||||
stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
|
||||
stop_("{.fun ", deparse(substitute(fn)), "} is not a valid predicate function.")
|
||||
}
|
||||
df <- pm_select_env$.data
|
||||
cols <- pm_select_env$get_colnames()
|
||||
@@ -1662,7 +1713,7 @@ if (!is.null(import_fn("where", "tidyselect", error_on_fail = FALSE))) {
|
||||
},
|
||||
fn
|
||||
))
|
||||
if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
|
||||
if (!is.logical(preds)) stop_("{.fun where} must be used with functions that return {.code TRUE} or {.code FALSE}.")
|
||||
data_cols <- cols
|
||||
cols <- data_cols[preds]
|
||||
which(data_cols %in% cols)
|
||||
|
||||
52
R/ab.R
52
R/ab.R
@@ -191,12 +191,13 @@ 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 <- 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 <- !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
|
||||
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 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."
|
||||
"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."
|
||||
)
|
||||
}
|
||||
|
||||
@@ -444,7 +445,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 `as.ab()`: these ATC codes are not (yet) in the antimicrobials data set: ",
|
||||
"in {.help [{.fun as.ab}](AMR::as.ab)}: these ATC codes are not (yet) in the antimicrobials data set: ",
|
||||
vector_and(x_unknown_ATCs), "."
|
||||
)
|
||||
}
|
||||
@@ -458,12 +459,14 @@ 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 `as.ab()`: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
|
||||
"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: ",
|
||||
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)) {
|
||||
@@ -481,7 +484,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
|
||||
}
|
||||
message_(
|
||||
"Antimicrobial translation was uncertain for ", examples,
|
||||
". If required, use `add_custom_antimicrobials()` to add custom entries."
|
||||
". If required, use {.help [{.fun add_custom_antimicrobials}](AMR::add_custom_antimicrobials)} to add custom entries."
|
||||
)
|
||||
}
|
||||
}
|
||||
@@ -526,7 +529,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)] <- font_na(NA)
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
|
||||
# add the names to the drugs as mouse-over!
|
||||
if (in_rstudio()) {
|
||||
@@ -551,16 +554,27 @@ type_sum.ab <- function(x, ...) {
|
||||
print.ab <- function(x, ...) {
|
||||
if (!is.null(attributes(x)$amr_selector)) {
|
||||
function_name <- attributes(x)$amr_selector
|
||||
message_(
|
||||
"This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a `dplyr` verb or `data.frame` call, e.g.:\n",
|
||||
" ", 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, "())]"
|
||||
)
|
||||
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, "())]")))
|
||||
))
|
||||
} 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, "())]"
|
||||
), as_note = TRUE))
|
||||
}
|
||||
}
|
||||
cat("Class 'ab'\n")
|
||||
cat(format_inline_("Class {.cls ab}\n"))
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
@@ -704,8 +718,8 @@ get_translate_ab <- function(translate_ab) {
|
||||
} else {
|
||||
translate_ab <- tolower(translate_ab)
|
||||
stop_ifnot(translate_ab %in% colnames(AMR::antimicrobials),
|
||||
"invalid value for 'translate_ab', this must be a column name of the `antimicrobials` data set\n",
|
||||
"or `TRUE` (equals 'name') or `FALSE` to not translate at all.",
|
||||
"invalid value for {.arg translate_ab}, this must be a column name of the {.help [antimicrobials](AMR::antimicrobials)} data set\n",
|
||||
"or {.code TRUE} (equals {.val name}) or {.code FALSE} to not translate at all.",
|
||||
call = FALSE
|
||||
)
|
||||
translate_ab
|
||||
|
||||
@@ -265,7 +265,7 @@ ab_ddd <- function(x, administration = "oral", ...) {
|
||||
|
||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
warning_(
|
||||
"in `ab_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"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.",
|
||||
"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 `ab_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"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.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
@@ -341,12 +341,12 @@ ab_url <- function(x, open = FALSE, ...) {
|
||||
|
||||
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(atcs)]
|
||||
if (length(NAs) > 0) {
|
||||
warning_("in `ab_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
warning_("in {.fun ab_url}: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
}
|
||||
|
||||
if (open == TRUE) {
|
||||
if (length(u) > 1 && !is.na(u[1L])) {
|
||||
warning_("in `ab_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
warning_("in {.fun ab_url}: only the first URL will be opened, as {.fun browseURL} only suports one string.")
|
||||
}
|
||||
if (!is.na(u[1L])) {
|
||||
utils::browseURL(u[1L])
|
||||
@@ -397,7 +397,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
||||
}
|
||||
vars <- get_column_abx(df, info = FALSE, only_sir_columns = FALSE, sort = FALSE, fn = "set_ab_names")
|
||||
if (length(vars) == 0) {
|
||||
message_("No columns with antibiotic results found for `set_ab_names()`, leaving names unchanged.")
|
||||
message_("No columns with antibiotic results found for {.fun set_ab_names}, leaving names unchanged.")
|
||||
return(data)
|
||||
}
|
||||
} else {
|
||||
@@ -424,7 +424,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
|
||||
)
|
||||
if (any(x %in% c("", NA))) {
|
||||
warning_(
|
||||
"in `set_ab_names()`: no ", property, " found for column(s): ",
|
||||
"in {.help [{.fun set_ab_names}](AMR::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)]
|
||||
|
||||
12
R/age.R
12
R/age.R
@@ -67,7 +67,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
} else if (length(reference) == 1) {
|
||||
reference <- rep(reference, length(x))
|
||||
} else {
|
||||
stop_("`x` and `reference` must be of same length, or `reference` must be of length 1.")
|
||||
stop_("{.arg x} and {.arg reference} must be of same length, or {.arg reference} must be of length 1.")
|
||||
}
|
||||
}
|
||||
x <- as.POSIXlt(x, ...)
|
||||
@@ -109,10 +109,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
|
||||
if (any(ages < 0, na.rm = TRUE)) {
|
||||
ages[!is.na(ages) & ages < 0] <- NA
|
||||
warning_("in `age()`: NAs introduced for ages below 0.")
|
||||
warning_("in {.fun age}: NAs introduced for ages below 0.")
|
||||
}
|
||||
if (any(ages > 120, na.rm = TRUE)) {
|
||||
warning_("in `age()`: some ages are above 120.")
|
||||
warning_("in {.fun age}: some ages are above 120.")
|
||||
}
|
||||
|
||||
if (isTRUE(na.rm)) {
|
||||
@@ -191,7 +191,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
|
||||
|
||||
if (any(x < 0, na.rm = TRUE)) {
|
||||
x[x < 0] <- NA
|
||||
warning_("in `age_groups()`: NAs introduced for ages below 0.")
|
||||
warning_("in {.fun age_groups}: NAs introduced for ages below 0.")
|
||||
}
|
||||
if (is.character(split_at)) {
|
||||
split_at <- split_at[1L]
|
||||
@@ -211,7 +211,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
|
||||
split_at <- c(0, split_at)
|
||||
}
|
||||
split_at <- split_at[!is.na(split_at)]
|
||||
stop_if(length(split_at) == 1, "invalid value for `split_at`.") # only 0 is available
|
||||
stop_if(length(split_at) == 1, "invalid value for {.arg split_at}.") # only 0 is available
|
||||
|
||||
# turn input values to 'split_at' indices
|
||||
y <- x
|
||||
@@ -228,7 +228,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
|
||||
agegroups <- factor(lbls[y], levels = lbls, ordered = TRUE)
|
||||
|
||||
if (!is.null(names)) {
|
||||
stop_ifnot(length(names) == length(levels(agegroups)), "`names` must have the same length as the number of age groups (", length(levels(agegroups)), ").")
|
||||
stop_ifnot(length(names) == length(levels(agegroups)), "{.arg names} must have the same length as the number of age groups (", length(levels(agegroups)), ").")
|
||||
levels(agegroups) <- names
|
||||
}
|
||||
|
||||
|
||||
@@ -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("'", font_bold(agents, collapse = NULL), "'")
|
||||
agents_formatted <- paste0("{.field ", 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 `", function_name, "()`: some drugs were ignored since they cannot be used for treatment: ",
|
||||
"in {.help [{.fun ", function_name, "}](AMR::", 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 `", function_name, "()`: ",
|
||||
"in {.help [{.fun ", function_name, "}](AMR::", function_name, ")}: ",
|
||||
vector_and(
|
||||
paste0(
|
||||
ab_name(abx[abx %in% untreatable],
|
||||
language = NULL,
|
||||
tolower = TRUE
|
||||
),
|
||||
" (`", abx[abx %in% untreatable], "`)"
|
||||
" ({.field ", font_bold(abx[abx %in% untreatable], collapse = NULL), "})"
|
||||
),
|
||||
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 {.code 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 {.arg with = FALSE}, see our examples at {.help [{.fun amr_selector}](AMR::amr_selector)}.",
|
||||
immediate = TRUE
|
||||
)
|
||||
cat("Class 'amr_selector'\n")
|
||||
cat(format_inline_("Class {.cls amr_selector}\n"))
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
@@ -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 `all()` or `any()` to prevent this note."
|
||||
". Wrap around {.fun all} or {.fun 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 `all()` or `any()` to prevent this note."
|
||||
". Wrap around {.fun all} or {.fun 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("'", font_bold(agents, collapse = NULL), "'")
|
||||
agents_formatted <- paste0("{.field ", 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 `", function_name, "(",
|
||||
"For {.help [", 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
|
||||
""
|
||||
)
|
||||
),
|
||||
")` using ",
|
||||
")](AMR::", function_name, ")} 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 `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."
|
||||
"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."
|
||||
)
|
||||
}
|
||||
antimicrobials <- ab_trycatch
|
||||
@@ -619,7 +619,7 @@ antibiogram.default <- function(x,
|
||||
out$n_susceptible <- out$n_susceptible + out$I + out$SDD
|
||||
}
|
||||
if (all(out$n_tested < minimum, na.rm = TRUE) && wisca == FALSE) {
|
||||
warning_("All combinations had less than {.arg minimum} = {minimum} results, returning an empty antibiogram")
|
||||
warning_("All combinations had less than {.arg minimum} = ", minimum, " results, returning an empty antibiogram")
|
||||
return(as_original_data_class(data.frame(), class(x), extra_class = "antibiogram"))
|
||||
} else if (any(out$n_tested < minimum, na.rm = TRUE)) {
|
||||
mins <- sum(out$n_tested < minimum, na.rm = TRUE)
|
||||
@@ -627,7 +627,7 @@ antibiogram.default <- function(x,
|
||||
out <- out %pm>%
|
||||
subset(n_tested >= minimum)
|
||||
if (isTRUE(info) && mins > 0) {
|
||||
message_("NOTE: {mins} combinations had less than {.arg minimum} = {minimum} results and were ignored")
|
||||
message_("NOTE: ", mins, " combinations had less than {.arg minimum} = ", minimum, " results and were ignored")
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -180,7 +180,7 @@ atc_online_property <- function(atc_code,
|
||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||
|
||||
if (length(out) == 0) {
|
||||
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}.")
|
||||
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}.")
|
||||
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 `as.av()`: these ATC codes are not (yet) in the antivirals data set: ",
|
||||
"in {.help [{.fun as.av}](AMR::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 `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
|
||||
"in {.help [{.fun as.av}](AMR::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("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
out[!is.na(x)] <- gsub("+", pillar::style_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
out[is.na(x)] <- pillar::style_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("Class 'av'\n")
|
||||
cat(format_inline_("Class {.cls 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 `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"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.",
|
||||
"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 `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"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.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
@@ -233,12 +233,12 @@ av_url <- function(x, open = FALSE, ...) {
|
||||
|
||||
NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
|
||||
if (length(NAs) > 0) {
|
||||
warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
warning_("in {.fun av_url}: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
}
|
||||
|
||||
if (open == TRUE) {
|
||||
if (length(u) > 1 && !is.na(u[1L])) {
|
||||
warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
warning_("in {.fun av_url}: only the first URL will be opened, as {.fun browseURL} only suports one string.")
|
||||
}
|
||||
if (!is.na(u[1L])) {
|
||||
utils::browseURL(u[1L])
|
||||
|
||||
@@ -82,9 +82,9 @@ bug_drug_combinations <- function(x,
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
stop_if(is.null(col_mo), "{.arg col_mo} must be set")
|
||||
} else {
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
stop_ifnot(col_mo %in% colnames(x), "column {.field ", font_bold(col_mo), "} ({.arg col_mo}) not found")
|
||||
}
|
||||
|
||||
x.bak <- x
|
||||
@@ -226,7 +226,7 @@ format.bug_drug_combinations <- function(x,
|
||||
x.bak <- x
|
||||
if (inherits(x, "grouped")) {
|
||||
# bug_drug_combinations() has been run on groups, so de-group here
|
||||
warning_("in `format()`: formatting the output of `bug_drug_combinations()` does not support grouped variables, they were ignored")
|
||||
warning_("in {.fun format}: formatting the output of {.fun bug_drug_combinations} does not support grouped variables, they were ignored")
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
|
||||
x <- data.frame(
|
||||
|
||||
@@ -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 `antimicrobials` data set.")
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.help [antimicrobials](AMR::antimicrobials)} data set.")
|
||||
}
|
||||
|
||||
@@ -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(" ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
|
||||
cat("\u00a0\u00a0", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
|
||||
}
|
||||
cat(" ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
|
||||
cat("\u00a0\u00a0", 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,14 +260,14 @@ 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,
|
||||
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
||||
" ({.code ", as.character(guideline[[i]]$query), "}) was ignored because of this error message: ",
|
||||
AMR_env$err_msg,
|
||||
call = FALSE
|
||||
)
|
||||
next
|
||||
}
|
||||
stop_ifnot(is.logical(qry), "in {.help [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i, " (`", guideline[[i]]$query,
|
||||
"`) must return {.code TRUE} or {.code FALSE}, not ",
|
||||
stop_ifnot(is.logical(qry), "in {.help [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i, " ({.code ", guideline[[i]]$query,
|
||||
"}) must return {.code TRUE} or {.code FALSE}, not ",
|
||||
format_class(class(qry), plural = FALSE),
|
||||
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)), paste0("`x` must contain column 'genus'."))
|
||||
stop_ifnot("genus" %in% tolower(colnames(x)), "{.arg x} must contain column {.code 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 `as.disk()`: ", na_after - na_before, " result",
|
||||
warning_("in {.help [{.fun as.disk}](AMR::as.disk)}: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
" 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)] <- font_na(NA)
|
||||
out[is.na(x)] <- pillar::style_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("Class 'disk'\n")
|
||||
cat(format_inline_("Class {.cls 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 '{column}' not found.",
|
||||
"Column {.code ", column, "} not found.",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
@@ -373,7 +373,7 @@ first_isolate <- function(x = NULL,
|
||||
if (!is.null(specimen_group)) {
|
||||
check_columns_existance(col_specimen, x)
|
||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "excludingspecimen")) {
|
||||
message_("Excluding other than specimen group '{specimen_group}'")
|
||||
message_("Excluding other than specimen group '", specimen_group, "'")
|
||||
}
|
||||
}
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
@@ -430,7 +430,8 @@ first_isolate <- function(x = NULL,
|
||||
}
|
||||
if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) {
|
||||
if (isTRUE(info)) {
|
||||
message_("=> Found {.strong {length(c(row.start:row.end))} first isolates}, as all isolates were different microbial species",
|
||||
n_rows <- length(c(row.start:row.end))
|
||||
message_("=> Found {.strong ", n_rows, " first isolates}, as all isolates were different microbial species",
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
@@ -447,13 +448,15 @@ 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
|
||||
)
|
||||
}
|
||||
@@ -537,7 +540,7 @@ first_isolate <- function(x = NULL,
|
||||
paste0('"', x, '"')
|
||||
}
|
||||
})
|
||||
message_("\nGroup: {toString(paste0(names(group), ' = ', group))}\n",
|
||||
message_("\nGroup: ", toString(paste0(names(group), " = ", group)), "\n",
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
@@ -551,7 +554,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 '", font_bold(col_mo), "')"
|
||||
" isolates with a microbial ID 'UNKNOWN' (in column {.field ", font_bold(col_mo), "})"
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
|
||||
@@ -562,7 +565,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 '", font_bold(col_mo), "')"
|
||||
" isolates with a microbial ID `NA` (in column {.field ", font_bold(col_mo), "})"
|
||||
)
|
||||
}
|
||||
x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
|
||||
|
||||
@@ -215,7 +215,7 @@ is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
|
||||
|
||||
exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
stop_ifnot(is.null(episode_days) || is.null(case_free_days),
|
||||
"either argument `episode_days` or argument `case_free_days` must be set.",
|
||||
"either argument {.arg episode_days} or argument {.arg case_free_days} must be set.",
|
||||
call = -2
|
||||
)
|
||||
|
||||
|
||||
@@ -295,7 +295,7 @@ geom_sir <- function(position = NULL,
|
||||
...) {
|
||||
x <- x[1]
|
||||
stop_ifnot_installed("ggplot2")
|
||||
stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%>%' instead of '+'?")
|
||||
stop_if(is.data.frame(position), "{.arg position} is invalid. Did you accidentally use {.code %>%} instead of {.code +}?")
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(fill, allow_class = "character", has_length = 1)
|
||||
|
||||
@@ -86,7 +86,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_s
|
||||
} else {
|
||||
if (isTRUE(verbose)) {
|
||||
message_(
|
||||
"Using column '", font_bold(ab_result), "' as input for ", search_string,
|
||||
"Using column {.field ", font_bold(ab_result), "} as input for ", search_string,
|
||||
" (", ab_name(search_string, language = NULL, tolower = TRUE), ")."
|
||||
)
|
||||
}
|
||||
@@ -267,7 +267,7 @@ get_column_abx <- function(x,
|
||||
if (all_okay == TRUE) {
|
||||
message_(" OK.", as_note = FALSE)
|
||||
} else if (!isFALSE(dups)) {
|
||||
message_("WARNING: some results from {.help [{.fun as.ab}](AMR::as.ab)} are duplicated: ", vector_and(dups, quotes = "`"), as_note = FALSE)
|
||||
message_("WARNING: some results from {.help [{.fun as.ab}](AMR::as.ab)} are duplicated: ", vector_and(dups, quotes = FALSE), as_note = FALSE)
|
||||
} else {
|
||||
message_(" WARNING.", 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 '", font_bold(out[i]), "' as input for ", names(out)[i],
|
||||
"Using column {.field ", 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 '", font_bold(out[i]), "' will not be used for ",
|
||||
"Column {.field ", 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."
|
||||
)
|
||||
|
||||
@@ -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 '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
|
||||
message_("Using column {.field ", font_bold(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], " (`", col_base, "`) = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " (`", col_enzyme, "`) = R"
|
||||
ab_enzyme$base_name[i], " ({.field ", font_bold(col_base), "}) = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " ({.field ", font_bold(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], " (`", col_enzyme, "`) = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " (`", col_base, "`) = S"
|
||||
ab_enzyme$enzyme_name[i], " ({.field ", font_bold(col_enzyme), "}) = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " ({.field ", font_bold(col_base), "}) = S"
|
||||
)
|
||||
|
||||
if (isTRUE(info)) {
|
||||
@@ -661,9 +661,10 @@ 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 '", 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"
|
||||
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"
|
||||
)
|
||||
}
|
||||
cols_ab <- c(cols_ab, stats::setNames(unname(cols_ab[names(cols_ab) == ab]), ab_s))
|
||||
@@ -805,7 +806,7 @@ interpretive_rules <- function(x,
|
||||
")$"
|
||||
)
|
||||
} else if (like_is_one_of != "like") {
|
||||
stop("invalid value for column 'like.is.one_of'", call. = FALSE)
|
||||
stop("invalid value for column {.field like.is.one_of}", call. = FALSE)
|
||||
}
|
||||
|
||||
if (is.na(source_antibiotics)) {
|
||||
@@ -1062,7 +1063,7 @@ interpretive_rules <- function(x,
|
||||
warn_lacking_sir_class <- warn_lacking_sir_class[order(colnames(x.bak))]
|
||||
warn_lacking_sir_class <- warn_lacking_sir_class[!is.na(warn_lacking_sir_class)]
|
||||
warning_(
|
||||
"in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: not all columns with antimicrobial results are of class 'sir'. Transform them on beforehand, with e.g.:\n",
|
||||
"in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: not all columns with antimicrobial results are of class {.cls sir}. Transform them on beforehand, e.g.:\n",
|
||||
" - ", highlight_code(paste0(x_deparsed, " %>% as.sir(", ifelse(length(warn_lacking_sir_class) == 1,
|
||||
warn_lacking_sir_class,
|
||||
paste0(warn_lacking_sir_class[1], ":", warn_lacking_sir_class[length(warn_lacking_sir_class)])
|
||||
|
||||
@@ -145,7 +145,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||
} else {
|
||||
stop_if(is.null(by), "no column with microorganism names or codes found, set this column with {.arg by}", call = -2)
|
||||
}
|
||||
message_('Joining, by = "{by}"', as_note = FALSE) # message same as dplyr::join functions
|
||||
message_("Joining, by = \"", by, "\"", as_note = FALSE) # message same as dplyr::join functions
|
||||
}
|
||||
if (!all(x[, by, drop = TRUE] %in% AMR_env$MO_lookup$mo, na.rm = TRUE)) {
|
||||
x$join.mo <- as.mo(x[, by, drop = TRUE])
|
||||
@@ -185,7 +185,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||
}
|
||||
|
||||
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
|
||||
warning_("in `{type}_microorganisms()`: the newly joined data set contains {nrow(joined) - nrow(x)} rows more than the number of rows of {.arg x}.")
|
||||
warning_("in {.fun ", type, "_microorganisms}: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of {.arg x}.")
|
||||
}
|
||||
|
||||
as_original_data_class(joined, class(x.bak)) # will remove tibble groups
|
||||
|
||||
@@ -159,7 +159,7 @@ key_antimicrobials <- function(x = NULL,
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
|
||||
}
|
||||
if (is.null(col_mo)) {
|
||||
warning_("in `key_antimicrobials()`: no column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`")
|
||||
warning_("in {.fun key_antimicrobials}: no column found for {.arg col_mo}, ignoring antibiotics set in {.arg gram_negative} and {.arg gram_positive}, and antimycotics set in {.arg antifungal}")
|
||||
gramstain <- NA_character_
|
||||
kingdom <- NA_character_
|
||||
} else {
|
||||
@@ -182,7 +182,7 @@ key_antimicrobials <- function(x = NULL,
|
||||
any(filter, na.rm = TRUE) &&
|
||||
message_not_thrown_before("key_antimicrobials", name)) {
|
||||
warning_(
|
||||
"in `key_antimicrobials()`: ",
|
||||
"in {.help [{.fun key_antimicrobials}](AMR::key_antimicrobials)}: ",
|
||||
ifelse(values_new_length == 0,
|
||||
"No columns available ",
|
||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
||||
@@ -237,7 +237,7 @@ key_antimicrobials <- function(x = NULL,
|
||||
)
|
||||
|
||||
if (length(unique(key_ab)) == 1) {
|
||||
warning_("in `key_antimicrobials()`: no distinct key antibiotics determined.")
|
||||
warning_("in {.fun key_antimicrobials}: no distinct key antibiotics determined.")
|
||||
}
|
||||
|
||||
key_ab
|
||||
@@ -310,7 +310,7 @@ antimicrobials_equal <- function(y,
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
|
||||
stop_ifnot(length(y) == length(z), "length of {.arg y} and {.arg z} must be equal")
|
||||
|
||||
key2sir <- function(val) {
|
||||
val <- strsplit(val, "", fixed = TRUE)[[1L]]
|
||||
|
||||
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 '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.")
|
||||
message_("Using column {.field ", font_bold(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 `mdro()`: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
|
||||
percentage(pct_required_classes), " (set with `pct_required_classes`)"
|
||||
"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})"
|
||||
)
|
||||
}
|
||||
# set these -1s to NA
|
||||
|
||||
31
R/mic.R
31
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")
|
||||
@@ -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 `as.mic()`: ", na_after - na_before, " result",
|
||||
warning_("in {.help [{.fun as.mic}](AMR::as.mic)}: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
@@ -322,6 +322,7 @@ 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)
|
||||
@@ -331,7 +332,7 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, r
|
||||
}
|
||||
stop_ifnot(
|
||||
all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
"Values in `mic_range` must be valid MIC values. ",
|
||||
"Values in {.arg 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), "."
|
||||
)
|
||||
@@ -441,23 +442,19 @@ all_valid_mics <- function(x) {
|
||||
#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mic)
|
||||
pillar_shaft.mic <- function(x, ...) {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
|
||||
warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
|
||||
warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with {.fun as.mic} to update",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
crude_numbers <- as.double(x)
|
||||
operators <- gsub("[^<=>]+", "", as.character(x))
|
||||
# colourise operators
|
||||
operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL)
|
||||
operators[!is.na(operators) & operators != ""] <- pillar::style_subtle(operators[!is.na(operators) & operators != ""])
|
||||
out <- trimws(paste0(operators, trimws(format(crude_numbers))))
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
# make trailing zeroes less visible
|
||||
if (is_dark()) {
|
||||
fn <- font_silver
|
||||
} else {
|
||||
fn <- font_white
|
||||
}
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", fn("\\1"), out[out %like% "[.]"], perl = TRUE)
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", pillar::style_subtle("\\1"), out[out %like% "[.]"], perl = TRUE)
|
||||
|
||||
create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
|
||||
}
|
||||
|
||||
@@ -475,7 +472,7 @@ type_sum.mic <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mic <- function(x, ...) {
|
||||
cat("Class 'mic'")
|
||||
cat(format_inline_("Class {.cls mic}"))
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
|
||||
}
|
||||
@@ -508,7 +505,7 @@ as.vector.mic <- function(x, mode = "numneric", ...) {
|
||||
y <- as.mic(y)
|
||||
calls <- unlist(lapply(sys.calls(), as.character))
|
||||
if (any(calls %in% c("rbind", "cbind")) && message_not_thrown_before("as.vector.mic")) {
|
||||
warning_("Functions `rbind()` and `cbind()` cannot preserve the structure of MIC values. Use dplyr's `bind_rows()` or `bind_cols()` instead.", call = FALSE)
|
||||
warning_("Functions {.fun rbind} and {.fun cbind} cannot preserve the structure of MIC values. Use {.pkg dplyr}'s {.fun bind_rows} or {.fun bind_cols} instead.", call = FALSE)
|
||||
}
|
||||
y
|
||||
}
|
||||
@@ -601,7 +598,7 @@ sort.mic <- function(x, decreasing = FALSE, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
hist.mic <- function(x, ...) {
|
||||
warning_("in `hist()`: use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values")
|
||||
warning_("in {.fun hist}: use {.fun plot} or {.pkg ggplot2}'s {.fun autoplot} for optimal plotting of MIC values")
|
||||
hist(log2(x))
|
||||
}
|
||||
|
||||
|
||||
157
R/mo.R
157
R/mo.R
@@ -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 `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 {.help [{.fun mo_reset_session}](AMR::mo_reset_session)} to reset this. This note will be shown once per session for this input."
|
||||
)
|
||||
}
|
||||
|
||||
@@ -407,7 +407,9 @@ 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)]
|
||||
@@ -453,8 +455,8 @@ as.mo <- function(x,
|
||||
if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
|
||||
examples <- vector_and(
|
||||
paste0(
|
||||
'"', AMR_env$mo_uncertainties$original_input,
|
||||
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||
"{.val ", AMR_env$mo_uncertainties$original_input,
|
||||
"} (assumed ", italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||
),
|
||||
quotes = FALSE
|
||||
)
|
||||
@@ -463,7 +465,7 @@ as.mo <- function(x,
|
||||
}
|
||||
msg <- c(msg, paste0(
|
||||
"Microorganism translation was uncertain for ", examples,
|
||||
". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add custom entries."
|
||||
". 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."
|
||||
))
|
||||
|
||||
for (m in msg) {
|
||||
@@ -479,11 +481,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 `keep_synonyms = TRUE` to leave uncorrected)")
|
||||
print(mo_renamed(), extra_txt = " (use {.arg 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 ", 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)
|
||||
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)
|
||||
}
|
||||
|
||||
# Apply Becker ----
|
||||
@@ -500,7 +502,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 `as.mo()`: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
|
||||
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: ",
|
||||
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
|
||||
@@ -545,7 +547,7 @@ as.mo <- function(x,
|
||||
out[is.na(out) & !is.na(x)] <- "UNKNOWN"
|
||||
AMR_env$mo_failures <- unique(x[out == "UNKNOWN" & !toupper(x) %in% c("UNKNOWN", "CON", "UNK") & !x %like_case% "^[(]unknown [a-z]+[)]$" & !is.na(x)])
|
||||
if (length(AMR_env$mo_failures) > 0) {
|
||||
warning_("The following input could not be coerced and was returned as \"UNKNOWN\": ", vector_and(AMR_env$mo_failures, quotes = TRUE), ".\nYou can retrieve this list with `mo_failures()`.", call = FALSE)
|
||||
warning_("The following input could not be coerced and was returned as \"UNKNOWN\": ", vector_and(AMR_env$mo_failures, quotes = TRUE), ".\nYou can retrieve this list with {.fun mo_failures}.", call = FALSE)
|
||||
}
|
||||
|
||||
# Return class ----
|
||||
@@ -646,13 +648,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(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
||||
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
||||
# and grey out every _
|
||||
out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)])
|
||||
out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
|
||||
|
||||
# markup NA and UNKNOWN
|
||||
out[is.na(x)] <- font_na(" NA")
|
||||
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
|
||||
out[is.na(x)] <- pillar::style_na(" NA")
|
||||
out[x == "UNKNOWN"] <- pillar::style_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)
|
||||
@@ -671,14 +673,14 @@ 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(
|
||||
font_na(x[!x %in% all_mos],
|
||||
pillar::style_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(colnames(df)[mo_cols], quotes = TRUE, sort = FALSE))
|
||||
col <- paste0("Column ", vector_or(paste0("{.field ", font_bold(colnames(df)[mo_cols], collapse = NULL), "}"), quotes = TRUE, sort = FALSE))
|
||||
} else {
|
||||
col <- "The data"
|
||||
}
|
||||
@@ -781,7 +783,7 @@ get_skimmers.mo <- function(column) {
|
||||
#' @noRd
|
||||
print.mo <- function(x, print.shortnames = FALSE, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
cat("Class 'mo'\n")
|
||||
cat(format_inline_("Class {.cls mo}\n"))
|
||||
x_names <- names(x)
|
||||
if (is.null(x_names) & print.shortnames == TRUE) {
|
||||
x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
|
||||
@@ -907,14 +909,16 @@ rep.mo <- function(x, ...) {
|
||||
print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
more_than_50 <- FALSE
|
||||
if (NROW(x) == 0) {
|
||||
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")))
|
||||
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.")
|
||||
return(invisible(NULL))
|
||||
} else if (NROW(x) > 50) {
|
||||
more_than_50 <- TRUE
|
||||
x <- x[1:50, , drop = 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")))
|
||||
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
|
||||
)
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
@@ -924,12 +928,13 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
col_green <- function(x) font_green_bg(x, collapse = NULL)
|
||||
|
||||
if (has_colour()) {
|
||||
cat(font_blue(word_wrap("Colour keys: ",
|
||||
cat(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) {
|
||||
@@ -960,21 +965,6 @@ 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 <- ""
|
||||
}
|
||||
@@ -984,46 +974,54 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
n = x[i, ]$fullname
|
||||
)
|
||||
score_formatted <- trimws(formatC(round(score, 3), format = "f", digits = 3))
|
||||
txt <- paste(txt,
|
||||
|
||||
out <- paste0(
|
||||
paste0(
|
||||
"", strrep(font_grey("-"), times = getOption("width", 100) - 1), "\n",
|
||||
"{.val ", x[i, ]$original_input, "}",
|
||||
" -> ",
|
||||
paste0(
|
||||
"", 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), ")"
|
||||
)
|
||||
),
|
||||
collapse = "\n"
|
||||
font_bold(italicise(x[i, ]$fullname)),
|
||||
" (", x[i, ]$mo, ", ", score_set_colour(score_formatted, score), ")"
|
||||
)
|
||||
),
|
||||
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"
|
||||
collapse = "\n"
|
||||
)
|
||||
txt <- gsub("[\n]+", "\n", txt)
|
||||
# remove first and last break
|
||||
txt <- gsub("(^[\n]|[\n]$)", "", txt)
|
||||
txt <- paste0("\n", txt, "\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)
|
||||
),
|
||||
quotes = FALSE, sort = FALSE
|
||||
)
|
||||
)
|
||||
message_(other_matches, as_note = FALSE)
|
||||
}
|
||||
|
||||
cat(txt)
|
||||
if (isTRUE(any_maxed_out)) {
|
||||
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.")))
|
||||
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.")
|
||||
}
|
||||
if (isTRUE(more_than_50)) {
|
||||
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.")))
|
||||
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.")
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1032,7 +1030,7 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
||||
#' @noRd
|
||||
print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) {
|
||||
if (NROW(x) == 0) {
|
||||
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")))
|
||||
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.")
|
||||
return(invisible(NULL))
|
||||
}
|
||||
|
||||
@@ -1043,14 +1041,17 @@ 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, ":\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 `print(mo_renamed(), n = ...)` to view more entries (might be slow), or save `mo_renamed()` to an object."), "")
|
||||
)
|
||||
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
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
# UNDOCUMENTED HELPER FUNCTIONS -------------------------------------------
|
||||
@@ -1255,14 +1256,14 @@ replace_old_mo_codes <- function(x, property) {
|
||||
}
|
||||
if (property != "mo") {
|
||||
warning_(
|
||||
"in `mo_", property, "()`: the input contained ", n_matched,
|
||||
"in {.help [{.fun mo_", property, "}](AMR::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 `as.mo()` to increase speed."
|
||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)} to increase speed."
|
||||
)
|
||||
} else {
|
||||
warning_(
|
||||
"in `as.mo()`: the input contained ", n_matched,
|
||||
"in {.help [{.fun as.mo}](AMR::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,7 +270,6 @@ 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), ...) {
|
||||
@@ -584,7 +583,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_s
|
||||
ab <- rep(ab, length(x))
|
||||
}
|
||||
if (length(x) != length(ab)) {
|
||||
stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
|
||||
stop_("length of {.arg x} and {.arg ab} must be equal, or one of them must be of length 1.")
|
||||
}
|
||||
|
||||
# show used version number once per session (AMR_env will reload every session)
|
||||
@@ -943,7 +942,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
|
||||
|
||||
if (isTRUE(open)) {
|
||||
if (length(u) > 1) {
|
||||
warning_("in `mo_url()`: only the first URL will be opened, as R's built-in function `browseURL()` only suports one string.")
|
||||
warning_("in {.fun mo_url}: only the first URL will be opened, as R's built-in function {.fun browseURL} only suports one string.")
|
||||
}
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
@@ -1043,7 +1042,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 '", font_bold(mo), "' as input for {.help [{.fun ", fn, "}](AMR::", fn, ")}")
|
||||
message_("Using column {.field ", 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")
|
||||
@@ -249,7 +249,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
|
||||
current_ext <- regexpr("\\.([[:alnum:]]+)$", destination)
|
||||
current_ext <- ifelse(current_ext > -1L, substring(destination, current_ext + 1L), "")
|
||||
vowel <- ifelse(current_ext %like% "^[AEFHILMNORSX]", "n", "")
|
||||
stop_("The AMR mo source must be an RDS file, not a{vowel} {toupper(current_ext)} file. If \"{basename(destination)}\" was meant as your input file, use {.help [{.fun set_mo_source}](AMR::set_mo_source)} on this file. In any case, the option {.code AMR_mo_source} must be set to another path.")
|
||||
stop_("The AMR mo source must be an RDS file, not a", vowel, " ", toupper(current_ext), " file. If \"", basename(destination), "\" was meant as your input file, use {.help [{.fun set_mo_source}](AMR::set_mo_source)} on this file. In any case, the option {.code AMR_mo_source} must be set to another path.")
|
||||
}
|
||||
if (is.null(AMR_env$mo_source)) {
|
||||
AMR_env$mo_source <- readRDS_AMR(path.expand(destination))
|
||||
@@ -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 {.field mo}", call = FALSE)
|
||||
stop_(refer_to_name, " must contain a column {.code 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 '", colnames(x)[1], "'", call = FALSE)
|
||||
stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(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 '", colnames(x)[2], "'", call = FALSE)
|
||||
stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(colnames(x)[2]), "}", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
|
||||
2
R/pca.R
2
R/pca.R
@@ -114,7 +114,7 @@ pca <- function(x,
|
||||
|
||||
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
||||
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
||||
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in `?pca`.", call = FALSE)
|
||||
warning_("in {.fun pca}: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See {.help [{.fun pca}](AMR::pca)}.", call = FALSE)
|
||||
}
|
||||
|
||||
# set column names
|
||||
|
||||
51
R/plotting.R
51
R/plotting.R
@@ -258,15 +258,15 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
} else if (any(other_x %in% colnames(df))) {
|
||||
aest_val <- intersect(other_x, colnames(df))[1]
|
||||
} else {
|
||||
stop_("No support for plotting df with `scale_", aest, "_mic()` with columns ", vector_and(colnames(df), sort = FALSE))
|
||||
stop_("No support for plotting df with {.fun scale_", aest, "_mic} with columns ", vector_and(colnames(df), sort = FALSE))
|
||||
}
|
||||
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 `", aest_val, "` is outside the plotted MIC range, consider using/updating the `mic_range` argument in `scale_", aest, "_mic()`.")
|
||||
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}.")
|
||||
}
|
||||
out[[aest_val]] <- log2(as.double(mics))
|
||||
} else {
|
||||
self$mic_values_rescaled <- rescale_mic(x = as.double(as.mic(df[[aest]])), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
|
||||
self$mic_values_rescaled <- rescale_mic(x = as.character(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,11 +280,21 @@ 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)))
|
||||
|
||||
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)])
|
||||
# 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)])
|
||||
}
|
||||
}
|
||||
|
||||
self$mic_values_log <- log2(as.double(self$mic_values_rescaled))
|
||||
|
||||
if (aest == "y" && "group" %in% colnames(df)) {
|
||||
@@ -312,7 +322,26 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
|
||||
}
|
||||
scale$labels <- function(..., self) {
|
||||
if (is.null(self$mic_breaks_set)) {
|
||||
self$mic_values_levels
|
||||
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
|
||||
}
|
||||
} else {
|
||||
breaks <- tryCatch(scale$breaks(), error = function(e) NULL)
|
||||
if (!is.null(breaks)) {
|
||||
@@ -412,7 +441,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 'sir', see {.help [{.fun as.sir}](AMR::as.sir)}.",
|
||||
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class {.cls sir}, see {.help [{.fun as.sir}](AMR::as.sir)}.",
|
||||
call = FALSE
|
||||
)
|
||||
x <- as.character(x)
|
||||
@@ -1443,10 +1472,10 @@ scale_sir_colours <- function(...,
|
||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
||||
|
||||
if ("fill" %in% aesthetics && message_not_thrown_before("scale_sir_colours", "fill", entire_session = TRUE)) {
|
||||
warning_("Using `scale_sir_colours()` for the `fill` aesthetic has been superseded by `scale_fill_sir()`, please use that instead. This warning will be shown once per session.")
|
||||
warning_("Using {.fun scale_sir_colours} for the {.code fill} aesthetic has been superseded by {.fun scale_fill_sir}, please use that instead. This warning will be shown once per session.")
|
||||
}
|
||||
if (any(c("colour", "color") %in% aesthetics) && message_not_thrown_before("scale_sir_colours", "colour", entire_session = TRUE)) {
|
||||
warning_("Using `scale_sir_colours()` for the `colour` aesthetic has been superseded by `scale_colour_sir()`, please use that instead. This warning will be shown once per session.")
|
||||
warning_("Using {.fun scale_sir_colours} for the {.code colour} aesthetic has been superseded by {.fun scale_colour_sir}, please use that instead. This warning will be shown once per session.")
|
||||
}
|
||||
|
||||
if ("colours" %in% names(list(...))) {
|
||||
@@ -1590,7 +1619,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 `colours_SIR`. Expected any of: ", vector_or(levels(NA_sir_), quotes = FALSE, sort = FALSE), "."
|
||||
"Unknown names in {.arg 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 `sir_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
" results available for {.help [{.fun sir_confidence_interval}](AMR::sir_confidence_interval)} (whilst {.arg minimum = ", minimum, "}).",
|
||||
call = FALSE
|
||||
)
|
||||
if (is.character(out)) {
|
||||
|
||||
@@ -138,7 +138,7 @@ resistance_predict <- function(x,
|
||||
extra_msg = paste0("Use the tidymodels framework instead, for which we have written a basic and short introduction on our website: ", font_url("https://amr-for-r.org/articles/AMR_with_tidymodels.html", txt = font_bold("AMR with tidymodels")))
|
||||
)
|
||||
|
||||
stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
|
||||
stop_if(is.null(model), 'choose a regression model with the {.arg model} argument, e.g. {.code resistance_predict(..., model = "binomial")}')
|
||||
|
||||
x.bak <- x
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
@@ -146,11 +146,11 @@ resistance_predict <- function(x,
|
||||
# -- date
|
||||
if (is.null(col_date)) {
|
||||
col_date <- search_type_in_df(x = x, type = "date")
|
||||
stop_if(is.null(col_date), "`col_date` must be set")
|
||||
stop_if(is.null(col_date), "{.arg col_date} must be set")
|
||||
}
|
||||
stop_ifnot(
|
||||
col_date %in% colnames(x),
|
||||
"column '", col_date, "' not found"
|
||||
"column {.code ", col_date, "} not found"
|
||||
)
|
||||
|
||||
year <- function(x) {
|
||||
@@ -357,7 +357,7 @@ ggplot_sir_predict <- function(x,
|
||||
meet_criteria(ribbon, allow_class = "logical", has_length = 1)
|
||||
|
||||
stop_ifnot_installed("ggplot2")
|
||||
stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
|
||||
stop_ifnot(inherits(x, "resistance_predict"), "{.arg x} must be a resistance prediction model created with {.fun resistance_predict}")
|
||||
|
||||
if (attributes(x)$I_as_S == TRUE) {
|
||||
ylab <- "%R"
|
||||
|
||||
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 '", font_bold(cur_col), "' is SIR eligible (despite only having empty values), since it seems to be ",
|
||||
"Column {.field ", 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_("in {.help [{.fun as.sir}](AMR::as.sir)}: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE))
|
||||
message_("{.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 '", cur_col, "'")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid antimicrobial interpretations: ",
|
||||
@@ -759,6 +759,10 @@ 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 {
|
||||
@@ -816,7 +820,7 @@ as.sir.data.frame <- function(x,
|
||||
# column found, transform to logical
|
||||
stop_if(
|
||||
length(col_uti) != 1 | !col_uti %in% colnames(x),
|
||||
"argument `uti` must be a [logical] vector, of must be a single column name of `x`"
|
||||
"argument {.arg uti} must be a [logical] vector, or must be a single column name of {.arg x}"
|
||||
)
|
||||
uti <- as.logical(x[, col_uti, drop = TRUE])
|
||||
}
|
||||
@@ -835,8 +839,7 @@ as.sir.data.frame <- function(x,
|
||||
message_(
|
||||
"Assuming value", plural[1], " ",
|
||||
vector_and(col_values, quotes = TRUE),
|
||||
" in column '", font_bold(col_specimen),
|
||||
"' reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
" in column ", paste0("{.field ", font_bold(col_specimen), "}"), " reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
|
||||
".\n Use `as.sir(uti = FALSE)` to prevent this."
|
||||
)
|
||||
}
|
||||
@@ -858,7 +861,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 = info))
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
if (is.na(ab_coerced) || (length(sel) > 0 & !ab %in% sel)) {
|
||||
# not even a valid AB code
|
||||
return(FALSE)
|
||||
@@ -908,6 +911,11 @@ 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)
|
||||
@@ -970,12 +978,12 @@ as.sir.data.frame <- function(x,
|
||||
return(out)
|
||||
} else if (types[i] == "sir") {
|
||||
ab <- ab_col
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = info))
|
||||
ab_coerced <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
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_("Cleaning values in column '", font_bold(ab), "' (",
|
||||
message_("\u00a0\u00a0", AMR_env$bullet_icon, " Cleaning values in column ", paste0("{.field ", font_bold(ab), "}"), " (",
|
||||
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE, info = info), ")... ",
|
||||
appendLF = FALSE,
|
||||
@@ -985,7 +993,7 @@ as.sir.data.frame <- function(x,
|
||||
} else if (!is.sir(x.bak[, ab, drop = TRUE])) {
|
||||
show_message <- TRUE
|
||||
if (isTRUE(info)) {
|
||||
message_("Assigning class {.cls sir} to already clean column '", font_bold(ab), "' (",
|
||||
message_("\u00a0\u00a0", AMR_env$bullet_icon, " Assigning class {.cls sir} to already clean column ", paste0("{.field ", font_bold(ab), "}"), " (",
|
||||
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE, language = NULL, info = info), ")... ",
|
||||
appendLF = FALSE,
|
||||
@@ -995,7 +1003,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(" OK "))
|
||||
message_(font_green_bg("\u00a0OK\u00a0"), as_note = FALSE)
|
||||
}
|
||||
out$result <- result
|
||||
out$log <- NULL
|
||||
@@ -1007,7 +1015,7 @@ as.sir.data.frame <- function(x,
|
||||
|
||||
if (isTRUE(parallel) && n_cores > 1 && length(ab_cols) > 1) {
|
||||
if (isTRUE(info)) {
|
||||
message()
|
||||
message_(as_note = FALSE)
|
||||
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") {
|
||||
@@ -1027,15 +1035,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(" DONE "), as_note = FALSE)
|
||||
message()
|
||||
message_(font_green_bg("\u00aDONE\u00a"), as_note = FALSE)
|
||||
message_(as_note = FALSE)
|
||||
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()
|
||||
message_(as_note = FALSE)
|
||||
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
|
||||
@@ -1222,7 +1230,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() # new line
|
||||
message_(as_note = FALSE) # 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")) {
|
||||
@@ -1247,7 +1255,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 '", font_bold(mo), "'")
|
||||
mo_var_found <- paste0(" based on column {.field ", font_bold(mo), "}")
|
||||
mo <- current_df[[mo]]
|
||||
} else if (length(mo) != length(x)) {
|
||||
mo_var_found <- ""
|
||||
@@ -1263,7 +1271,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 '", font_bold(mo), "'")
|
||||
mo_var_found <- paste0(" based on column {.field ", font_bold(mo), "}")
|
||||
mo <- df[, mo, drop = TRUE]
|
||||
}
|
||||
},
|
||||
@@ -1316,7 +1324,7 @@ as_sir_method <- function(method_short,
|
||||
}
|
||||
|
||||
ab.bak <- trimws2(ab)
|
||||
ab <- suppressWarnings(as.ab(ab, info = info))
|
||||
ab <- suppressWarnings(as.ab(ab, info = FALSE))
|
||||
if (!is.null(list(...)$mo.bak)) {
|
||||
mo.bak <- list(...)$mo.bak
|
||||
} else {
|
||||
@@ -1352,12 +1360,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_("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.")
|
||||
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.")
|
||||
}
|
||||
}
|
||||
|
||||
# format agents ----
|
||||
agent_formatted <- paste0("'", font_bold(ab.bak, collapse = NULL), "'")
|
||||
agent_formatted <- paste0("{.field ", 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)
|
||||
@@ -1373,7 +1381,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(
|
||||
"Interpreting ", method_long, ": ", ifelse(isTRUE(list(...)$is_data.frame), "column ", ""),
|
||||
"\u00a0\u00a0", AMR_env$bullet_icon, " 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),
|
||||
@@ -1391,7 +1399,7 @@ as_sir_method <- function(method_short,
|
||||
rise_warning <- FALSE
|
||||
rise_notes <- FALSE
|
||||
method_coerced <- toupper(method)
|
||||
ab_coerced <- as.ab(ab, info = info)
|
||||
ab_coerced <- as.ab(ab, info = FALSE)
|
||||
|
||||
if (identical(reference_data, AMR::clinical_breakpoints)) {
|
||||
breakpoints <- reference_data %pm>%
|
||||
@@ -1488,14 +1496,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 = font_blue(intro_txt), only_bar_percent = TRUE)
|
||||
p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = 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 ")))
|
||||
message_(font_grey_bg(font_black(" NO BREAKPOINTS ")), as_note = FALSE)
|
||||
}
|
||||
|
||||
load_mo_uncertainties(metadata_mo)
|
||||
@@ -1721,7 +1729,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 {.help [{.fun as.sir}](AMR::as.sir)}.")
|
||||
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`.")
|
||||
)
|
||||
} 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
|
||||
@@ -1911,7 +1919,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), # vectorise_log_entry(paste0(font_stripstyle(notes_current), collapse = "\n"), length(rows)),
|
||||
notes = font_stripstyle(notes_current),
|
||||
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)),
|
||||
@@ -1936,21 +1944,21 @@ 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(" WARNING "))
|
||||
message_(font_rose_bg("\u00a0WARNING\u00a0"), as_note = FALSE)
|
||||
} else {
|
||||
message(font_yellow_bg(" NOTE "))
|
||||
message_(font_yellow_bg("\u00a0NOTE\u00a0"), as_note = FALSE)
|
||||
}
|
||||
notes <- unique(notes)
|
||||
# if (isTRUE(verbose) || length(notes) == 1 || NROW(AMR_env$sir_interpretation_history) == 0) {
|
||||
if (isTRUE(verbose)) {
|
||||
for (i in seq_along(notes)) {
|
||||
message(word_wrap(" ", AMR_env$bullet_icon, " ", notes[i]))
|
||||
message_(notes[i], as_note = FALSE)
|
||||
}
|
||||
} else {
|
||||
# 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))
|
||||
# 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))
|
||||
}
|
||||
} else {
|
||||
message(font_green_bg(" OK "))
|
||||
message_(font_green_bg("\u00a0OK\u00a0"), as_note = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2002,15 +2010,19 @@ 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)] <- 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 "))
|
||||
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
|
||||
}
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
@@ -2088,7 +2100,7 @@ get_skimmers.sir <- function(column) {
|
||||
#' @noRd
|
||||
print.sir <- function(x, ...) {
|
||||
x_name <- deparse(substitute(x))
|
||||
cat("Class 'sir'\n")
|
||||
cat(format_inline_("Class {.cls 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 ",
|
||||
@@ -2227,10 +2239,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 {.code clinical_breakpoints} data set.", call = .call_depth)
|
||||
stop_("{.arg reference_data} must have the same column names as the {.help [clinical_breakpoints](AMR::clinical_breakpoints)} data set.", call = .call_depth)
|
||||
}
|
||||
if (!all(class_sir == class_ref)) {
|
||||
stop_("{.arg reference_data} must be the same structure as the {.code clinical_breakpoints} data set. Column '", names(class_ref[class_sir != class_ref][1]), "' is of class ", class_ref[class_sir != class_ref][1], ", but should be of class ", class_sir[class_sir != class_ref][1], ".", call = .call_depth)
|
||||
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)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
11
R/sir_calc.R
11
R/sir_calc.R
@@ -60,11 +60,6 @@ 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)) {
|
||||
@@ -144,7 +139,7 @@ sir_calc <- function(...,
|
||||
FUN = min
|
||||
)
|
||||
if ("SDD" %in% ab_result && "SDD" %in% y && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
|
||||
message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE)
|
||||
message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE)
|
||||
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y))))
|
||||
@@ -152,7 +147,7 @@ sir_calc <- function(...,
|
||||
# may contain NAs in any column
|
||||
other_values <- setdiff(c(NA, denominator_vals), ab_result)
|
||||
if ("SDD" %in% ab_result && "SDD" %in% unlist(x_transposed) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
|
||||
message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE)
|
||||
message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE)))
|
||||
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & anyNA(y))))
|
||||
@@ -209,7 +204,7 @@ sir_calc <- function(...,
|
||||
ifelse(denominator == 0, "no", paste("only", denominator)),
|
||||
" results available",
|
||||
data_vars,
|
||||
" (`minimum` = ", minimum, ").",
|
||||
" (whilst {.arg minimum = ", minimum, "}).",
|
||||
call = FALSE
|
||||
)
|
||||
fraction <- NA_real_
|
||||
|
||||
@@ -62,7 +62,7 @@ top_n_microorganisms <- function(x, n, property = "species", n_for_each = NULL,
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = TRUE)
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
stop_if(is.null(col_mo), "{.arg col_mo} must be set")
|
||||
}
|
||||
|
||||
x.bak <- x
|
||||
|
||||
20
R/zzz.R
20
R/zzz.R
@@ -116,42 +116,40 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
|
||||
|
||||
.onAttach <- function(libname, pkgname) {
|
||||
if (interactive() && is.null(getOption("AMR_guideline"))) {
|
||||
packageStartupMessage(
|
||||
word_wrap(
|
||||
"Assuming ", AMR::clinical_breakpoints$guideline[1], " as the default AMR guideline, see `?AMR-options` to change this."
|
||||
)
|
||||
)
|
||||
packageStartupMessage(format_inline_(
|
||||
"Assuming ", AMR::clinical_breakpoints$guideline[1], " as the default AMR guideline, see {.topic [AMR-options](AMR::AMR-options)} to change this."
|
||||
))
|
||||
}
|
||||
|
||||
# if custom ab option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
|
||||
if (getOption("AMR_custom_ab") %unlike% "[.]rds$") {
|
||||
packageStartupMessage("The file with custom antimicrobials must be an RDS file. Set the option `AMR_custom_ab` to another path.")
|
||||
packageStartupMessage(format_inline_("The file with custom antimicrobials must be an RDS file. Set the option {.code AMR_custom_ab} to another path."))
|
||||
} else {
|
||||
packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
|
||||
packageStartupMessage(format_inline_("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'..."), appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_ab"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
|
||||
error = function(e) packageStartupMessage(format_inline_("Failed: ", conditionMessage(e)))
|
||||
)
|
||||
}
|
||||
}
|
||||
# if custom mo option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
|
||||
if (getOption("AMR_custom_mo") %unlike% "[.]rds$") {
|
||||
packageStartupMessage("The file with custom microorganisms must be an RDS file. Set the option `AMR_custom_mo` to another path.")
|
||||
packageStartupMessage(format_inline_("The file with custom microorganisms must be an RDS file. Set the option {.code AMR_custom_mo} to another path."))
|
||||
} else {
|
||||
packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
|
||||
packageStartupMessage(format_inline_("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'..."), appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_mo"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
|
||||
error = function(e) packageStartupMessage(format_inline_("Failed: ", conditionMessage(e)))
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
@@ -141,6 +141,32 @@ import numpy as np
|
||||
# Import the AMR R package
|
||||
amr_r = importr('AMR')
|
||||
|
||||
def convert_to_r(value):
|
||||
"""Convert Python lists/tuples to typed R vectors.
|
||||
|
||||
rpy2's default_converter passes Python lists to R as R lists, not as
|
||||
character/numeric vectors. This causes element-wise type-check functions
|
||||
such as is.mic(), is.sir(), and is.disk() to return a logical vector
|
||||
rather than a single logical, breaking R's scalar && operator.
|
||||
|
||||
This helper converts Python lists and tuples to the appropriate R vector
|
||||
type based on the element types, so R always receives a proper vector."""
|
||||
if isinstance(value, (list, tuple)):
|
||||
if len(value) == 0:
|
||||
return StrVector([])
|
||||
# bool must be checked before int because bool is a subclass of int
|
||||
if all(isinstance(v, bool) for v in value):
|
||||
return robjects.vectors.BoolVector(value)
|
||||
if all(isinstance(v, int) for v in value):
|
||||
return IntVector(value)
|
||||
if all(isinstance(v, float) for v in value):
|
||||
return FloatVector(value)
|
||||
if all(isinstance(v, str) for v in value):
|
||||
return StrVector(value)
|
||||
# Mixed types: coerce all to string
|
||||
return StrVector([str(v) for v in value])
|
||||
return value
|
||||
|
||||
def convert_to_python(r_output):
|
||||
# Check if it's a StrVector (R character vector)
|
||||
if isinstance(r_output, StrVector):
|
||||
@@ -166,10 +192,13 @@ def convert_to_python(r_output):
|
||||
return r_output
|
||||
|
||||
def r_to_python(r_func):
|
||||
"""Decorator that runs an rpy2 function under a localconverter
|
||||
and then applies convert_to_python to its output."""
|
||||
"""Decorator that converts Python list/tuple inputs to typed R vectors,
|
||||
runs the rpy2 function under a localconverter, and converts the output
|
||||
to a Python type."""
|
||||
@functools.wraps(r_func)
|
||||
def wrapper(*args, **kwargs):
|
||||
args = tuple(convert_to_r(a) for a in args)
|
||||
kwargs = {k: convert_to_r(v) for k, v in kwargs.items()}
|
||||
with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
|
||||
return convert_to_python(r_func(*args, **kwargs))
|
||||
return wrapper
|
||||
@@ -312,4 +341,3 @@ cd ../PythonPackage/AMR
|
||||
pip3 install build
|
||||
python3 -m build
|
||||
# python3 setup.py sdist bdist_wheel
|
||||
|
||||
|
||||
@@ -56,7 +56,7 @@ This class for MIC values is a quite a special data type: formally it is an orde
|
||||
|
||||
\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")
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -219,7 +219,6 @@ 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,10 +270,8 @@ 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,7 +138,6 @@ 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(
|
||||
|
||||
@@ -36,6 +36,7 @@ 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",
|
||||
@@ -79,6 +80,12 @@ 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",
|
||||
@@ -124,6 +131,8 @@ 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",
|
||||
@@ -161,7 +170,9 @@ test_that("test-zzz.R", {
|
||||
"vec_math" = "vctrs",
|
||||
"vec_ptype2" = "vctrs",
|
||||
"vec_ptype_abbr" = "vctrs",
|
||||
"vec_ptype_full" = "vctrs"
|
||||
"vec_ptype_full" = "vctrs",
|
||||
# usethis
|
||||
"use_course" = "usethis"
|
||||
)
|
||||
|
||||
import_functions <- c(import_functions, call_functions)
|
||||
|
||||
Reference in New Issue
Block a user