mirror of
https://github.com/msberends/AMR.git
synced 2026-03-25 15:32:27 +01:00
(v3.0.1.9037) improve cli messages
This commit is contained in:
@@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 3.0.1.9036
|
Version: 3.0.1.9037
|
||||||
Date: 2026-03-19
|
Date: 2026-03-22
|
||||||
Title: Antimicrobial Resistance Data Analysis
|
Title: Antimicrobial Resistance Data Analysis
|
||||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
|
|||||||
2
NEWS.md
2
NEWS.md
@@ -1,4 +1,4 @@
|
|||||||
# AMR 3.0.1.9036
|
# AMR 3.0.1.9037
|
||||||
|
|
||||||
### New
|
### New
|
||||||
* Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
|
* Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
|
||||||
|
|||||||
@@ -383,27 +383,6 @@ pkg_is_available <- function(pkg, also_load = FALSE, min_version = NULL) {
|
|||||||
isTRUE(out)
|
isTRUE(out)
|
||||||
}
|
}
|
||||||
|
|
||||||
highlight_code <- function(code) {
|
|
||||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
|
||||||
cli::code_highlight(code)
|
|
||||||
} else {
|
|
||||||
code
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# Format a cli-markup string for output, with a plain-text fallback when cli is
|
|
||||||
# unavailable. Unlike message_() / warning_() / stop_(), this function returns
|
|
||||||
# the formatted string rather than emitting it, so it can be passed to any
|
|
||||||
# output function (e.g. packageStartupMessage()).
|
|
||||||
format_inline_ <- function(...) {
|
|
||||||
msg <- paste0(c(...), collapse = "")
|
|
||||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
|
||||||
cli::format_inline(msg)
|
|
||||||
} else {
|
|
||||||
cli_to_plain(msg, envir = parent.frame())
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
import_fn <- function(name, pkg, error_on_fail = TRUE) {
|
import_fn <- function(name, pkg, error_on_fail = TRUE) {
|
||||||
if (isTRUE(error_on_fail)) {
|
if (isTRUE(error_on_fail)) {
|
||||||
stop_ifnot_installed(pkg)
|
stop_ifnot_installed(pkg)
|
||||||
@@ -429,6 +408,27 @@ 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")) {
|
||||||
|
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.
|
# Convert cli glue markup to plain text for the non-cli fallback path.
|
||||||
# Called by message_(), warning_(), and stop_() when cli is not available.
|
# Called by message_(), warning_(), and stop_() when cli is not available.
|
||||||
cli_to_plain <- function(msg, envir = parent.frame()) {
|
cli_to_plain <- function(msg, envir = parent.frame()) {
|
||||||
@@ -552,11 +552,39 @@ word_wrap <- function(...,
|
|||||||
gsub("(\n| )+$", "", wrapped)
|
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)} -> display (plain text)
|
||||||
|
msg <- gsub(
|
||||||
|
"\\{\\.topic \\[([^]]+)\\]\\([^)]+\\)\\}",
|
||||||
|
"\\1",
|
||||||
|
msg,
|
||||||
|
perl = TRUE
|
||||||
|
)
|
||||||
|
msg
|
||||||
|
}
|
||||||
|
|
||||||
message_ <- function(...,
|
message_ <- function(...,
|
||||||
appendLF = TRUE,
|
appendLF = TRUE,
|
||||||
as_note = TRUE) {
|
as_note = TRUE) {
|
||||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||||
msg <- paste0(c(...), collapse = "")
|
msg <- paste0(c(...), collapse = "")
|
||||||
|
if (!cli::ansi_has_hyperlink_support()) {
|
||||||
|
msg <- simplify_help_markup(msg)
|
||||||
|
}
|
||||||
if (isTRUE(as_note)) {
|
if (isTRUE(as_note)) {
|
||||||
cli::cli_inform(c("i" = msg), .envir = parent.frame())
|
cli::cli_inform(c("i" = msg), .envir = parent.frame())
|
||||||
} else {
|
} else {
|
||||||
@@ -573,6 +601,9 @@ warning_ <- function(...,
|
|||||||
call = FALSE) {
|
call = FALSE) {
|
||||||
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
if (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||||
msg <- paste0(c(...), collapse = "")
|
msg <- paste0(c(...), collapse = "")
|
||||||
|
if (!cli::ansi_has_hyperlink_support()) {
|
||||||
|
msg <- simplify_help_markup(msg)
|
||||||
|
}
|
||||||
cli::cli_warn(msg, .envir = parent.frame())
|
cli::cli_warn(msg, .envir = parent.frame())
|
||||||
} else {
|
} else {
|
||||||
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||||
@@ -585,6 +616,9 @@ warning_ <- function(...,
|
|||||||
# - wraps text to never break lines within words (plain-text fallback)
|
# - wraps text to never break lines within words (plain-text fallback)
|
||||||
stop_ <- function(..., call = TRUE) {
|
stop_ <- function(..., call = TRUE) {
|
||||||
msg <- paste0(c(...), collapse = "")
|
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 (pkg_is_available("cli", min_version = "3.0.0")) {
|
||||||
if (isTRUE(call)) {
|
if (isTRUE(call)) {
|
||||||
call_obj <- sys.call(-1)
|
call_obj <- sys.call(-1)
|
||||||
|
|||||||
2
R/ab.R
2
R/ab.R
@@ -574,7 +574,7 @@ print.ab <- function(x, ...) {
|
|||||||
), as_note = TRUE))
|
), as_note = TRUE))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
cat("Class 'ab'\n")
|
cat(format_inline_("Class {.cls ab}\n"))
|
||||||
print(as.character(x), quote = FALSE)
|
print(as.character(x), quote = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -804,7 +804,7 @@ amr_select_exec <- function(function_name,
|
|||||||
language = NULL,
|
language = NULL,
|
||||||
tolower = TRUE
|
tolower = TRUE
|
||||||
),
|
),
|
||||||
" (`", abx[abx %in% untreatable], "`)"
|
" ({.field ", abx[abx %in% untreatable], "})"
|
||||||
),
|
),
|
||||||
quotes = FALSE,
|
quotes = FALSE,
|
||||||
sort = TRUE,
|
sort = TRUE,
|
||||||
@@ -837,10 +837,10 @@ amr_select_exec <- function(function_name,
|
|||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
print.amr_selector <- function(x, ...) {
|
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
|
immediate = TRUE
|
||||||
)
|
)
|
||||||
cat("Class 'amr_selector'\n")
|
cat(format_inline_("Class {.cls amr_selector}\n"))
|
||||||
print(as.character(x), quote = FALSE)
|
print(as.character(x), quote = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -937,7 +937,7 @@ any.amr_selector_any_all <- function(..., na.rm = FALSE) {
|
|||||||
if (length(e1) > 1) {
|
if (length(e1) > 1) {
|
||||||
message_(
|
message_(
|
||||||
"Assuming a filter on ", type, " ", length(e1), " ", gsub("[\\(\\)]", "", fn_name),
|
"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) {
|
if (length(e1) > 1) {
|
||||||
message_(
|
message_(
|
||||||
"Assuming a filter on ", type, " ", length(e1), " ", gsub("[\\(\\)]", "", fn_name),
|
"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, ".")
|
message_("No antimicrobial drugs of class '", ab_group, "' found", examples, ".")
|
||||||
}
|
}
|
||||||
} else {
|
} 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)
|
agents_names <- ab_name(names(agents), tolower = TRUE, language = NULL)
|
||||||
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
|
need_name <- generalise_antibiotic_name(agents) != generalise_antibiotic_name(agents_names)
|
||||||
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
|
agents_formatted[need_name] <- paste0(agents_formatted[need_name], " (", agents_names[need_name], ")")
|
||||||
message_(
|
message_(
|
||||||
"For `", function_name, "(",
|
"For {.help [", function_name, "(",
|
||||||
ifelse(function_name == "amr_class",
|
ifelse(function_name == "amr_class",
|
||||||
paste0("\"", amr_class_args, "\""),
|
paste0("\"", amr_class_args, "\""),
|
||||||
ifelse(!is.null(call),
|
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 "),
|
ifelse(length(agents) == 1, "column ", "columns "),
|
||||||
vector_and(agents_formatted, quotes = FALSE, sort = FALSE)
|
vector_and(agents_formatted, quotes = FALSE, sort = FALSE)
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -180,7 +180,7 @@ atc_online_property <- function(atc_code,
|
|||||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||||
|
|
||||||
if (length(out) == 0) {
|
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
|
returnvalue[i] <- NA
|
||||||
next
|
next
|
||||||
}
|
}
|
||||||
|
|||||||
2
R/av.R
2
R/av.R
@@ -526,7 +526,7 @@ type_sum.av <- function(x, ...) {
|
|||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
print.av <- function(x, ...) {
|
print.av <- function(x, ...) {
|
||||||
cat("Class 'av'\n")
|
cat(format_inline_("Class {.cls av}\n"))
|
||||||
print(as.character(x), quote = FALSE)
|
print(as.character(x), quote = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -260,7 +260,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
|||||||
)
|
)
|
||||||
if (identical(qry, "error")) {
|
if (identical(qry, "error")) {
|
||||||
warning_("in {.help [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i,
|
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,
|
AMR_env$err_msg,
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
|
|||||||
2
R/disk.R
2
R/disk.R
@@ -170,7 +170,7 @@ pillar_shaft.disk <- function(x, ...) {
|
|||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
print.disk <- function(x, ...) {
|
print.disk <- function(x, ...) {
|
||||||
cat("Class 'disk'\n")
|
cat(format_inline_("Class {.cls disk}\n"))
|
||||||
print(as.integer(x), quote = FALSE)
|
print(as.integer(x), quote = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -510,8 +510,8 @@ interpretive_rules <- function(x,
|
|||||||
|
|
||||||
## Set base to R where base + enzyme inhibitor is R ----
|
## Set base to R where base + enzyme inhibitor is R ----
|
||||||
rule_current <- paste0(
|
rule_current <- paste0(
|
||||||
ab_enzyme$base_name[i], " (`", col_base, "`) = R if ",
|
ab_enzyme$base_name[i], " ({.field ", col_base, "}) = R if ",
|
||||||
tolower(ab_enzyme$enzyme_name[i]), " (`", col_enzyme, "`) = R"
|
tolower(ab_enzyme$enzyme_name[i]), " ({.field ", col_enzyme, "}) = R"
|
||||||
)
|
)
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
cat(word_wrap(rule_current,
|
cat(word_wrap(rule_current,
|
||||||
@@ -551,8 +551,8 @@ interpretive_rules <- function(x,
|
|||||||
|
|
||||||
## Set base + enzyme inhibitor to S where base is S ----
|
## Set base + enzyme inhibitor to S where base is S ----
|
||||||
rule_current <- paste0(
|
rule_current <- paste0(
|
||||||
ab_enzyme$enzyme_name[i], " (`", col_enzyme, "`) = S if ",
|
ab_enzyme$enzyme_name[i], " ({.field ", col_enzyme, "}) = S if ",
|
||||||
tolower(ab_enzyme$base_name[i]), " (`", col_base, "`) = S"
|
tolower(ab_enzyme$base_name[i]), " ({.field ", col_base, "}) = S"
|
||||||
)
|
)
|
||||||
|
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
|
|||||||
6
R/mic.R
6
R/mic.R
@@ -72,7 +72,7 @@ COMMON_MIC_VALUES <- c(
|
|||||||
#' ```
|
#' ```
|
||||||
#' x <- random_mic(10)
|
#' x <- random_mic(10)
|
||||||
#' x
|
#' x
|
||||||
#' #> Class 'mic'
|
#' #> Class <mic>
|
||||||
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||||
#'
|
#'
|
||||||
#' is.factor(x)
|
#' is.factor(x)
|
||||||
@@ -89,7 +89,7 @@ COMMON_MIC_VALUES <- c(
|
|||||||
#'
|
#'
|
||||||
#' ```
|
#' ```
|
||||||
#' x[x > 4]
|
#' x[x > 4]
|
||||||
#' #> Class 'mic'
|
#' #> Class <mic>
|
||||||
#' #> [1] 16 8 8 64 >=128 32 32 16
|
#' #> [1] 16 8 8 64 >=128 32 32 16
|
||||||
#'
|
#'
|
||||||
#' df <- data.frame(x, hospital = "A")
|
#' df <- data.frame(x, hospital = "A")
|
||||||
@@ -475,7 +475,7 @@ type_sum.mic <- function(x, ...) {
|
|||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
print.mic <- function(x, ...) {
|
print.mic <- function(x, ...) {
|
||||||
cat("Class 'mic'")
|
cat(format_inline_("Class {.cls mic}"))
|
||||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||||
cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
|
cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
|
||||||
}
|
}
|
||||||
|
|||||||
2
R/mo.R
2
R/mo.R
@@ -783,7 +783,7 @@ get_skimmers.mo <- function(column) {
|
|||||||
#' @noRd
|
#' @noRd
|
||||||
print.mo <- function(x, print.shortnames = FALSE, ...) {
|
print.mo <- function(x, print.shortnames = FALSE, ...) {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
cat("Class 'mo'\n")
|
cat(format_inline_("Class {.cls mo}\n"))
|
||||||
x_names <- names(x)
|
x_names <- names(x)
|
||||||
if (is.null(x_names) & print.shortnames == TRUE) {
|
if (is.null(x_names) & print.shortnames == TRUE) {
|
||||||
x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
|
x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
|
||||||
|
|||||||
@@ -75,7 +75,7 @@
|
|||||||
#'
|
#'
|
||||||
#' ```
|
#' ```
|
||||||
#' as.mo("lab_mo_ecoli")
|
#' as.mo("lab_mo_ecoli")
|
||||||
#' #> Class 'mo'
|
#' #> Class <mo>
|
||||||
#' #> [1] B_ESCHR_COLI
|
#' #> [1] B_ESCHR_COLI
|
||||||
#'
|
#'
|
||||||
#' mo_genus("lab_mo_kpneumoniae")
|
#' mo_genus("lab_mo_kpneumoniae")
|
||||||
@@ -85,7 +85,7 @@
|
|||||||
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||||
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
|
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||||
#' #> Use mo_uncertainties() to review it.
|
#' #> Use mo_uncertainties() to review it.
|
||||||
#' #> Class 'mo'
|
#' #> Class <mo>
|
||||||
#' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
#' #> [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
|
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||||
#' #> "Organisation XYZ" and "mo"
|
#' #> "Organisation XYZ" and "mo"
|
||||||
#' #> Class 'mo'
|
#' #> Class <mo>
|
||||||
#' #> [1] B_ESCHR_COLI
|
#' #> [1] B_ESCHR_COLI
|
||||||
#'
|
#'
|
||||||
#' mo_genus("lab_Staph_aureus")
|
#' mo_genus("lab_Staph_aureus")
|
||||||
|
|||||||
@@ -412,7 +412,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
|
|||||||
|
|
||||||
scale$labels <- function(x) {
|
scale$labels <- function(x) {
|
||||||
stop_ifnot(all(x %in% c(levels(NA_sir_), "SI", "IR", NA)),
|
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
|
call = FALSE
|
||||||
)
|
)
|
||||||
x <- as.character(x)
|
x <- as.character(x)
|
||||||
|
|||||||
@@ -346,7 +346,7 @@ sir_confidence_interval <- function(...,
|
|||||||
if (n < minimum) {
|
if (n < minimum) {
|
||||||
warning_("Introducing NA: ",
|
warning_("Introducing NA: ",
|
||||||
ifelse(n == 0, "no", paste("only", n)),
|
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
|
call = FALSE
|
||||||
)
|
)
|
||||||
if (is.character(out)) {
|
if (is.character(out)) {
|
||||||
|
|||||||
6
R/sir.R
6
R/sir.R
@@ -601,7 +601,7 @@ as.sir.default <- function(x,
|
|||||||
ifelse(length(out7) > 0, paste0("7 as \"", out7, "\""), NA_character_),
|
ifelse(length(out7) > 0, paste0("7 as \"", out7, "\""), NA_character_),
|
||||||
ifelse(length(out8) > 0, paste0("8 as \"", out8, "\""), 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) {
|
if (na_before != na_after) {
|
||||||
@@ -1351,7 +1351,7 @@ as_sir_method <- function(method_short,
|
|||||||
}
|
}
|
||||||
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
|
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
|
||||||
if (isTRUE(info) && message_not_thrown_before("as.sir", "intrinsic")) {
|
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.")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -2087,7 +2087,7 @@ get_skimmers.sir <- function(column) {
|
|||||||
#' @noRd
|
#' @noRd
|
||||||
print.sir <- function(x, ...) {
|
print.sir <- function(x, ...) {
|
||||||
x_name <- deparse(substitute(x))
|
x_name <- deparse(substitute(x))
|
||||||
cat("Class 'sir'\n")
|
cat(format_inline_("Class {.cls sir}\n"))
|
||||||
# TODO for #170
|
# TODO for #170
|
||||||
# if (!is.null(attributes(x)$guideline) && !all(is.na(attributes(x)$guideline))) {
|
# if (!is.null(attributes(x)$guideline) && !all(is.na(attributes(x)$guideline))) {
|
||||||
# cat(font_blue(word_wrap("These values were interpreted using ",
|
# cat(font_blue(word_wrap("These values were interpreted using ",
|
||||||
|
|||||||
@@ -204,7 +204,7 @@ sir_calc <- function(...,
|
|||||||
ifelse(denominator == 0, "no", paste("only", denominator)),
|
ifelse(denominator == 0, "no", paste("only", denominator)),
|
||||||
" results available",
|
" results available",
|
||||||
data_vars,
|
data_vars,
|
||||||
" (`minimum` = ", minimum, ").",
|
" (whilst {.arg minimum = ", minimum, "}).",
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
fraction <- NA_real_
|
fraction <- NA_real_
|
||||||
|
|||||||
@@ -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)
|
\if{html}{\out{<div class="sourceCode">}}\preformatted{x <- random_mic(10)
|
||||||
x
|
x
|
||||||
#> Class 'mic'
|
#> Class <mic>
|
||||||
#> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
#> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||||
|
|
||||||
is.factor(x)
|
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.:
|
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]
|
\if{html}{\out{<div class="sourceCode">}}\preformatted{x[x > 4]
|
||||||
#> Class 'mic'
|
#> Class <mic>
|
||||||
#> [1] 16 8 8 64 >=128 32 32 16
|
#> [1] 16 8 8 64 >=128 32 32 16
|
||||||
|
|
||||||
df <- data.frame(x, hospital = "A")
|
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:
|
And now we can use it in our functions:
|
||||||
|
|
||||||
\if{html}{\out{<div class="sourceCode">}}\preformatted{as.mo("lab_mo_ecoli")
|
\if{html}{\out{<div class="sourceCode">}}\preformatted{as.mo("lab_mo_ecoli")
|
||||||
#> Class 'mo'
|
#> Class <mo>
|
||||||
#> [1] B_ESCHR_COLI
|
#> [1] B_ESCHR_COLI
|
||||||
|
|
||||||
mo_genus("lab_mo_kpneumoniae")
|
mo_genus("lab_mo_kpneumoniae")
|
||||||
@@ -68,7 +68,7 @@ mo_genus("lab_mo_kpneumoniae")
|
|||||||
as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||||
#> NOTE: Translation to one microorganism was guessed with uncertainty.
|
#> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||||
#> Use mo_uncertainties() to review it.
|
#> Use mo_uncertainties() to review it.
|
||||||
#> Class 'mo'
|
#> Class <mo>
|
||||||
#> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
#> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||||
}\if{html}{\out{</div>}}
|
}\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
|
#> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||||
#> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
#> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||||
#> "Organisation XYZ" and "mo"
|
#> "Organisation XYZ" and "mo"
|
||||||
#> Class 'mo'
|
#> Class <mo>
|
||||||
#> [1] B_ESCHR_COLI
|
#> [1] B_ESCHR_COLI
|
||||||
|
|
||||||
mo_genus("lab_Staph_aureus")
|
mo_genus("lab_Staph_aureus")
|
||||||
|
|||||||
@@ -80,6 +80,7 @@ test_that("test-zzz.R", {
|
|||||||
"freq.default" = "cleaner",
|
"freq.default" = "cleaner",
|
||||||
"percentage" = "cleaner",
|
"percentage" = "cleaner",
|
||||||
# cli
|
# cli
|
||||||
|
"ansi_has_hyperlink_support" = "cli",
|
||||||
"cli_abort" = "cli",
|
"cli_abort" = "cli",
|
||||||
"cli_inform" = "cli",
|
"cli_inform" = "cli",
|
||||||
"cli_warn" = "cli",
|
"cli_warn" = "cli",
|
||||||
|
|||||||
Reference in New Issue
Block a user