diff --git a/DESCRIPTION b/DESCRIPTION index 327fef431..f74b02082 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9036 -Date: 2026-03-19 +Version: 3.0.1.9037 +Date: 2026-03-22 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 e3faf456c..d9410f675 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` diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 5b8090ab0..e22c9d8bb 100644 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -383,27 +383,6 @@ pkg_is_available <- function(pkg, also_load = FALSE, min_version = NULL) { isTRUE(out) } -highlight_code <- function(code) { - if (pkg_is_available("cli", min_version = "3.0.0")) { - cli::code_highlight(code) - } else { - code - } -} - -# Format a cli-markup string for output, with a plain-text fallback when cli is -# unavailable. Unlike message_() / warning_() / stop_(), this function returns -# the formatted string rather than emitting it, so it can be passed to any -# output function (e.g. packageStartupMessage()). -format_inline_ <- function(...) { - msg <- paste0(c(...), collapse = "") - if (pkg_is_available("cli", min_version = "3.0.0")) { - cli::format_inline(msg) - } else { - cli_to_plain(msg, envir = parent.frame()) - } -} - import_fn <- function(name, pkg, error_on_fail = TRUE) { if (isTRUE(error_on_fail)) { stop_ifnot_installed(pkg) @@ -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. # Called by message_(), warning_(), and stop_() when cli is not available. cli_to_plain <- function(msg, envir = parent.frame()) { @@ -552,11 +552,39 @@ 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)} -> display (plain text) + msg <- gsub( + "\\{\\.topic \\[([^]]+)\\]\\([^)]+\\)\\}", + "\\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 { @@ -573,6 +601,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()) @@ -585,6 +616,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) diff --git a/R/ab.R b/R/ab.R index a67b53cb4..c8bad4fce 100755 --- a/R/ab.R +++ b/R/ab.R @@ -574,7 +574,7 @@ print.ab <- function(x, ...) { ), as_note = TRUE)) } } - cat("Class 'ab'\n") + cat(format_inline_("Class {.cls ab}\n")) print(as.character(x), quote = FALSE) } diff --git a/R/amr_selectors.R b/R/amr_selectors.R index c27f0f791..cb165a3c0 100755 --- a/R/amr_selectors.R +++ b/R/amr_selectors.R @@ -804,7 +804,7 @@ amr_select_exec <- function(function_name, language = NULL, tolower = TRUE ), - " (`", abx[abx %in% untreatable], "`)" + " ({.field ", abx[abx %in% untreatable], "})" ), quotes = FALSE, sort = TRUE, @@ -837,10 +837,10 @@ amr_select_exec <- function(function_name, #' @export #' @noRd print.amr_selector <- function(x, ...) { - warning_("It should never be needed to print an antimicrobial selector class. Are you using {.pkg data.table}? Then add the argument {.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) ) diff --git a/R/atc_online.R b/R/atc_online.R index 833a72144..dcc588000 100755 --- a/R/atc_online.R +++ b/R/atc_online.R @@ -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 } diff --git a/R/av.R b/R/av.R index a5d3509a5..beb2d6176 100755 --- a/R/av.R +++ b/R/av.R @@ -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) } diff --git a/R/custom_mdro_guideline.R b/R/custom_mdro_guideline.R index 4db6b6cff..bfa181644 100755 --- a/R/custom_mdro_guideline.R +++ b/R/custom_mdro_guideline.R @@ -260,7 +260,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) { ) if (identical(qry, "error")) { warning_("in {.help [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i, - " (`", 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 ) diff --git a/R/disk.R b/R/disk.R index 62e9d82c4..9bb873b8a 100755 --- a/R/disk.R +++ b/R/disk.R @@ -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) } diff --git a/R/interpretive_rules.R b/R/interpretive_rules.R index bbcf798ae..36145e0fa 100755 --- a/R/interpretive_rules.R +++ b/R/interpretive_rules.R @@ -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 ", col_base, "}) = R if ", + tolower(ab_enzyme$enzyme_name[i]), " ({.field ", 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 ", col_enzyme, "}) = S if ", + tolower(ab_enzyme$base_name[i]), " ({.field ", col_base, "}) = S" ) if (isTRUE(info)) { diff --git a/R/mic.R b/R/mic.R index 74e3d8d25..3294cbfe8 100644 --- a/R/mic.R +++ b/R/mic.R @@ -72,7 +72,7 @@ COMMON_MIC_VALUES <- c( #' ``` #' x <- random_mic(10) #' x -#' #> Class 'mic' +#' #> Class #' #> [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 #' #> [1] 16 8 8 64 >=128 32 32 16 #' #' df <- data.frame(x, hospital = "A") @@ -475,7 +475,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")) } diff --git a/R/mo.R b/R/mo.R index 2dd8cc9c6..bfb783ced 100755 --- a/R/mo.R +++ b/R/mo.R @@ -783,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) diff --git a/R/mo_source.R b/R/mo_source.R index 89bc7a238..43f06f5bc 100755 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -75,7 +75,7 @@ #' #' ``` #' as.mo("lab_mo_ecoli") -#' #> Class 'mo' +#' #> Class #' #> [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 #' #> [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 #' #> [1] B_ESCHR_COLI #' #' mo_genus("lab_Staph_aureus") diff --git a/R/plotting.R b/R/plotting.R index 39fb877d9..598864421 100755 --- a/R/plotting.R +++ b/R/plotting.R @@ -412,7 +412,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) { scale$labels <- function(x) { stop_ifnot(all(x %in% c(levels(NA_sir_), "SI", "IR", NA)), - "Apply `scale_", aesthetics[1], "_sir()` to a variable of class '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) diff --git a/R/proportion.R b/R/proportion.R index 573430210..f54d5a2d9 100644 --- a/R/proportion.R +++ b/R/proportion.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)) { diff --git a/R/sir.R b/R/sir.R index e09561dec..e4332e0d9 100755 --- a/R/sir.R +++ b/R/sir.R @@ -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) { @@ -1351,7 +1351,7 @@ 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.") } } @@ -2087,7 +2087,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 ", diff --git a/R/sir_calc.R b/R/sir_calc.R index 5c6129e88..c836d9599 100755 --- a/R/sir_calc.R +++ b/R/sir_calc.R @@ -204,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_ diff --git a/man/as.mic.Rd b/man/as.mic.Rd index b7161a00c..c1a07b2c8 100644 --- a/man/as.mic.Rd +++ b/man/as.mic.Rd @@ -56,7 +56,7 @@ This class for MIC values is a quite a special data type: formally it is an orde \if{html}{\out{
}}\preformatted{x <- random_mic(10) x -#> Class 'mic' +#> Class #> [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{
}}\preformatted{x[x > 4] -#> Class 'mic' +#> Class #> [1] 16 8 8 64 >=128 32 32 16 df <- data.frame(x, hospital = "A") diff --git a/man/mo_source.Rd b/man/mo_source.Rd index 17b83755f..ab47408d7 100644 --- a/man/mo_source.Rd +++ b/man/mo_source.Rd @@ -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{
}}\preformatted{as.mo("lab_mo_ecoli") -#> Class 'mo' +#> Class #> [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 #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI }\if{html}{\out{
}} @@ -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 #> [1] B_ESCHR_COLI mo_genus("lab_Staph_aureus") diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R index 602ac21fa..8b2f7ab80 100644 --- a/tests/testthat/test-zzz.R +++ b/tests/testthat/test-zzz.R @@ -80,6 +80,7 @@ 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",