diff --git a/DESCRIPTION b/DESCRIPTION index 411375f9a..cf7388753 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9036 -Date: 2026-03-18 +Version: 3.0.1.9037 +Date: 2026-03-19 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NEWS.md b/NEWS.md index df3731f2e..b937b423b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9036 +# AMR 3.0.1.9037 ### New * Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes` @@ -30,6 +30,7 @@ * Fixed SIR and MIC coercion of combined values, e.g. `as.sir("<= 0.002; S") ` or `as.mic("S; 0.002")` (#252) ### Updates +* Replaced all bare backtick-quoted text in `message_()`, `warning_()`, and `stop_()` calls with proper cli inline markup (`{.arg}`, `{.cls}`, `{.fun}`, `{.pkg}`, `{.code}`); rewrote `print.ab` to use a cli named-vector with `*` bullets and code highlighting when cli is available * `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`) diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 776609e26..f2e9c8ec4 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -304,8 +304,8 @@ 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 '", 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 } @@ -771,7 +771,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 +780,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 +820,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 +834,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 +877,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 +888,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 +898,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 +908,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 +943,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 +1047,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 {.code 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 +1647,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 +1662,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) diff --git a/R/ab.R b/R/ab.R index dce560a07..9380fdc51 100755 --- a/R/ab.R +++ b/R/ab.R @@ -551,14 +551,28 @@ 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" = "This {.cls ab} vector was retrieved using {.fun {function_name}}, which should normally be used inside a {.pkg dplyr} verb or {.code data.frame} call, e.g.:", + "*" = "{.code your_data %>% select({function_name}())}", + "*" = "{.code your_data %>% select(column_a, column_b, {function_name}())}", + "*" = "{.code your_data %>% filter(any({function_name}() == \"R\"))}", + "*" = "{.code your_data[, {function_name}()]}", + "*" = "{.code your_data[, c(\"column_a\", \"column_b\", {function_name}())]}" + ), + .envir = environment() + ) + } 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", + " ", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n", + " ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n", + " ", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n", + " ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n", + " ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]" + ), as_note = TRUE)) + } } cat("Class '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 {.topic [antimicrobials](AMR::antimicrobials)} data set\n", + "or {.code TRUE} (equals {.val name}) or {.code FALSE} to not translate at all.", call = FALSE ) translate_ab diff --git a/R/ab_property.R b/R/ab_property.R index d31a2ea3e..b91541566 100755 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -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 { diff --git a/R/age.R b/R/age.R index 9fb436466..1f6a5b6b0 100755 --- a/R/age.R +++ b/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 } diff --git a/R/av_property.R b/R/av_property.R index 92bb1d9c1..b46f683fb 100755 --- a/R/av_property.R +++ b/R/av_property.R @@ -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]) diff --git a/R/bug_drug_combinations.R b/R/bug_drug_combinations.R index 6eb9a9beb..d98630a5a 100755 --- a/R/bug_drug_combinations.R +++ b/R/bug_drug_combinations.R @@ -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 '", 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( diff --git a/R/custom_antimicrobials.R b/R/custom_antimicrobials.R index e00bca55c..2f6995ffc 100755 --- a/R/custom_antimicrobials.R +++ b/R/custom_antimicrobials.R @@ -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 {.topic [antimicrobials](AMR::antimicrobials)} data set.") } diff --git a/R/custom_mdro_guideline.R b/R/custom_mdro_guideline.R index fd2e57724..d415b998a 100755 --- a/R/custom_mdro_guideline.R +++ b/R/custom_mdro_guideline.R @@ -266,8 +266,8 @@ run_custom_mdro_guideline <- function(df, guideline, info) { ) 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 ) diff --git a/R/custom_microorganisms.R b/R/custom_microorganisms.R index 5535de31f..ec28f9113 100755 --- a/R/custom_microorganisms.R +++ b/R/custom_microorganisms.R @@ -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 'genus'.") add_MO_lookup_to_AMR_env() diff --git a/R/disk.R b/R/disk.R index 284bca47e..62e9d82c4 100755 --- a/R/disk.R +++ b/R/disk.R @@ -119,7 +119,7 @@ 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 {.fun as.disk}: ", na_after - na_before, " result", ifelse(na_after - na_before > 1, "s", ""), ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), " truncated (", diff --git a/R/get_episode.R b/R/get_episode.R index 1fb33f292..bc9dc58eb 100644 --- a/R/get_episode.R +++ b/R/get_episode.R @@ -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 ) diff --git a/R/ggplot_sir.R b/R/ggplot_sir.R index f9c89fc96..b275bb8b3 100755 --- a/R/ggplot_sir.R +++ b/R/ggplot_sir.R @@ -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) diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index 47a450bc2..f63f95ab8 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -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) } diff --git a/R/interpretive_rules.R b/R/interpretive_rules.R index 947ae6e10..fa596a816 100755 --- a/R/interpretive_rules.R +++ b/R/interpretive_rules.R @@ -1062,7 +1062,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)]) diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index 7ac67e712..d97a9e1ae 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -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 diff --git a/R/key_antimicrobials.R b/R/key_antimicrobials.R index 4a1adbe14..20b949ed2 100755 --- a/R/key_antimicrobials.R +++ b/R/key_antimicrobials.R @@ -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 { @@ -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]] diff --git a/R/mic.R b/R/mic.R index 6b2eaad0b..ae0ff7813 100644 --- a/R/mic.R +++ b/R/mic.R @@ -269,7 +269,7 @@ 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 {.fun as.mic}: ", na_after - na_before, " result", ifelse(na_after - na_before > 1, "s", ""), ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), " truncated (", @@ -441,7 +441,7 @@ 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 ) } @@ -508,7 +508,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 +601,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)) } diff --git a/R/mo.R b/R/mo.R index dd7b4abf3..a204f3574 100755 --- a/R/mo.R +++ b/R/mo.R @@ -500,7 +500,7 @@ as.mo <- function(x, ) if (any(out %in% AMR_env$MO_lookup$mo[match(post_Becker, AMR_env$MO_lookup$fullname)])) { if (message_not_thrown_before("as.mo", "becker")) { - warning_("in `as.mo()`: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ", + warning_("in {.fun as.mo}: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ", vector_and(font_italic(gsub("Staphylococcus", "S.", post_Becker, fixed = TRUE), collapse = NULL), quotes = FALSE), ". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).", immediate = TRUE, call = FALSE @@ -545,7 +545,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 ---- @@ -1049,7 +1049,7 @@ print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) { " -> ", 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."), "") + ifelse(NROW(x) > n, paste0("\n\nOnly the first ", n, " (out of ", NROW(x), ") are shown. Run {.code print(mo_renamed(), n = ...)} to view more entries (might be slow), or save {.fun mo_renamed} to an object."), "") ) } diff --git a/R/mo_property.R b/R/mo_property.R index 522e57fbc..54bc9ca3d 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -584,7 +584,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 +943,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]) } diff --git a/R/pca.R b/R/pca.R index 1c7bcf2a3..24c6a2e87 100755 --- a/R/pca.R +++ b/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 diff --git a/R/plotting.R b/R/plotting.R index 36cdb1072..cae705f53 100755 --- a/R/plotting.R +++ b/R/plotting.R @@ -258,11 +258,11 @@ 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 ", 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 { @@ -1443,10 +1443,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(...))) { diff --git a/R/resistance_predict.R b/R/resistance_predict.R index dd6467711..b473c575e 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -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,7 +146,7 @@ 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), @@ -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" diff --git a/R/sir.R b/R/sir.R index 5e217e9fa..1f66477aa 100755 --- a/R/sir.R +++ b/R/sir.R @@ -816,7 +816,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]) } @@ -1720,7 +1720,7 @@ as_sir_method <- function(method_short, pm_filter(uti == FALSE) notes_current <- paste0( notes_current, "\n", - paste0("Breakpoints for UTI ", font_bold("and"), " non-UTI available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ". Use argument `uti` to set which isolates are from urine. See {.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 {.arg uti} to set which isolates are from urine. See {.help [{.fun as.sir}](AMR::as.sir)}.") ) } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && all(breakpoints_current$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteOther", mo_current, ab_current)) { # breakpoints for multiple body sites available @@ -1943,7 +1943,7 @@ as_sir_method <- function(method_short, # 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)) diff --git a/R/sir_calc.R b/R/sir_calc.R index 6378a2dd4..0d26ba953 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -144,7 +144,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 +152,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)))) diff --git a/R/top_n_microorganisms.R b/R/top_n_microorganisms.R index 873003dc8..4b08f2c85 100755 --- a/R/top_n_microorganisms.R +++ b/R/top_n_microorganisms.R @@ -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