eucast_rules(): add add_if_missing argument to control NA imputation (#259)

When `add_if_missing = FALSE`, rules are only applied to cells that already
contain an SIR value; `NA` cells are left untouched. This is useful with
`overwrite = TRUE` to update reported results without imputing values for
drugs that were not tested.

https://claude.ai/code/session_01Nucc8nXGLqNUjtuC9GrhTc

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.0.1.9036
-Date: 2026-03-18
+Version: 3.0.1.9034
+Date: 2026-03-09
 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

NAMESPACE

@@ -172,7 +172,6 @@ export(all_sir_predictors)
 export(aminoglycosides)
 export(aminopenicillins)
 export(amr_class)
-export(amr_course)
 export(amr_distance_from_row)
 export(amr_selector)
 export(anti_join_microorganisms)

NEWS.md

@@ -1,12 +1,4 @@
-# AMR 3.0.1.9036
-
-### Updates
-* Modernised messaging infrastructure: `message_()`, `warning_()`, and `stop_()` now use `cli` for rich formatting (colours, inline markup, hyperlinks) when the `cli` package is installed, with a fully functional plain-text fallback when `cli` is absent
-* Removed `add_fn` parameter from `message_()`, `warning_()`, and `word_wrap()` — styling is now handled by `cli` markup or dropped from the plain-text path
-* New internal helper `cli_to_plain()` converts cli inline markup (`{.fun}`, `{.arg}`, `{.val}`, etc.) to plain-text equivalents for the non-cli fallback path
-* Call sites across all R source files updated from `paste0()`-based string construction to cli glue syntax (e.g. `{.fun as.mo}`, `{.arg col_mo}`, `{n} results`)
-
-# AMR 3.0.1.9035
+# AMR 3.0.1.9034
 
 ### New
 * Integration with the **tidymodels** framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
@@ -21,9 +13,10 @@
   - `as.sir()` gained an argument `as_wt_nwt`, which defaults to `TRUE` only when `breakpoint_type = "ECOFF"` (#254)
   - This transforms the output from S/R to WT/NWT
   - Functions such as `susceptibility()` count WT as S and NWT as R
-* Function `interpretive_rules()`, which allows future implementation of CLSI interpretive rules (#235)
+* `interpretive_rules()`, which allows future implementation of CLSI interpretive rules (#235)
   - `eucast_rules()` has become a wrapper around that function
-* Function `amr_course()`, which allows for automated download and unpacking of a GitHub repository for e.g. webinar use
+* `eucast_rules()` / `interpretive_rules()` gained argument `add_if_missing` (default: `TRUE`). When set to `FALSE`, rules are only applied to cells that already contain an SIR value; `NA` cells are left untouched. This is useful with `overwrite = TRUE` to update reported results without imputing values for drugs that were not tested (#259)
+* 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
 
 ### Fixes
 * Fixed a bug in `as.sir()` where values that were purely numeric (e.g., `"1"`) and matched the broad SIR-matching regex would be incorrectly stripped of all content by the Unicode letter filter
@@ -51,7 +44,6 @@
   * This results in more reliable behaviour compared to previous versions for capped MIC values
   * 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
 
 
 # AMR 3.0.1

R/aa_helper_functions.R

@@ -305,7 +305,8 @@ search_type_in_df <- function(x, type, info = TRUE, add_col_prefix = TRUE) {
       # 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."
+          "`, but this column does not contain 'logical' values (TRUE/FALSE) and was ignored.",
+          add_fn = font_red
         )
         found <- NULL
       }
@@ -386,18 +387,17 @@ import_fn <- function(name, pkg, error_on_fail = TRUE) {
   if (isTRUE(error_on_fail)) {
     stop_ifnot_installed(pkg)
   }
-  if (pkg == "rstudioapi" && !in_rstudio()) {
-    # only allow rstudioapi to be imported if we're in RStudio
+  if (pkg == "rstudioapi" && tryCatch(!rstudioapi::isAvailable(), error = function(e) TRUE)) {
+    # only allow rstudioapi to be imported if RStudio is available
     return(NULL)
   }
-
   tryCatch(
     # don't use get() to avoid fetching non-API functions
     getExportedValue(name = name, ns = asNamespace(pkg)),
     error = function(e) {
       if (isTRUE(error_on_fail)) {
         stop_("function `", name, "()` is not an exported object from package '", pkg,
-          "'. Please create an issue at https://github.com/msberends/AMR/issues. Many thanks!",
+          "'. Please create an issue at ", font_url("https://github.com/msberends/AMR/issues"), ". Many thanks!",
           call = FALSE
         )
       } else {
@@ -407,99 +407,30 @@ import_fn <- function(name, pkg, error_on_fail = TRUE) {
   )
 }
 
-# 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()) {
-  resolve <- function(x) {
-    # If x looks like {expr}, evaluate the inner expression
-    if (grepl("^\\{.+\\}$", x)) {
-      inner <- substring(x, 2L, nchar(x) - 1L)
-      tryCatch(
-        paste0(as.character(eval(parse(text = inner), envir = envir)), collapse = ", "),
-        error = function(e) x
-      )
-    } else {
-      x
-    }
-  }
-
-  apply_sub <- function(msg, pattern, formatter) {
-    while (grepl(pattern, msg, perl = TRUE)) {
-      m <- regexec(pattern, msg, perl = TRUE)
-      matches <- regmatches(msg, m)[[1]]
-      if (length(matches) < 2L) break
-      full_match <- matches[1L]
-      content <- matches[2L]
-      replacement <- formatter(content)
-      idx <- regexpr(full_match, msg, fixed = TRUE)
-      if (idx == -1L) break
-      msg <- paste0(
-        substr(msg, 1L, idx - 1L),
-        replacement,
-        substr(msg, idx + nchar(full_match), nchar(msg))
-      )
-    }
-    msg
-  }
-
-  # 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, "\\{\\.strong (\\{[^}]+\\}|[^}]+)\\}", function(c) paste0("*", resolve(c), "*"))
-  msg <- apply_sub(msg, "\\{\\.emph (\\{[^}]+\\}|[^}]+)\\}",   function(c) paste0("*", resolve(c), "*"))
-  msg <- apply_sub(msg, "\\{\\.help (\\{[^}]+\\}|[^}]+)\\}",   function(c) 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])
-
-  # bare {variable} or {expression} -> evaluate in caller's environment
-  while (grepl("\\{[^{}]+\\}", msg)) {
-    m <- regexec("\\{([^{}]+)\\}", msg, perl = TRUE)
-    matches <- regmatches(msg, m)[[1]]
-    if (length(matches) < 2L) break
-    full_match <- matches[1L]
-    inner <- matches[2L]
-    replacement <- tryCatch(
-      paste0(as.character(eval(parse(text = inner), envir = envir)), collapse = ", "),
-      error = function(e) full_match
-    )
-    idx <- regexpr(full_match, msg, fixed = TRUE)
-    if (idx == -1L) break
-    msg <- paste0(
-      substr(msg, 1L, idx - 1L),
-      replacement,
-      substr(msg, idx + nchar(full_match), nchar(msg))
-    )
-  }
-
-  msg
-}
-
 # this alternative wrapper to the message(), warning() and stop() functions:
-# - wraps text to never break lines within words (plain-text fallback only)
-# - adds indentation for note-style messages (plain-text fallback only)
-# When cli is available this just returns the pasted input; cli handles formatting.
+# - wraps text to never break lines within words
+# - ignores formatted text while wrapping
+# - adds indentation dependent on the type of message (such as NOTE)
+# - can add additional formatting functions like blue or bold text
 word_wrap <- function(...,
+                      add_fn = list(),
                       as_note = FALSE,
                       width = 0.95 * getOption("width"),
                       extra_indent = 0) {
-  if (pkg_is_available("cli")) {
-    return(paste0(c(...), collapse = ""))
-  }
   msg <- paste0(c(...), collapse = "")
+
   if (isTRUE(as_note)) {
     msg <- paste0(AMR_env$info_icon, " ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
   }
-  if (grepl("\n", msg, fixed = TRUE)) {
+
+  if (msg %like% "\n") {
+    # run word_wraps() over every line here, bind them and return again
     return(paste0(
       vapply(
         FUN.VALUE = character(1),
         trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
         word_wrap,
+        add_fn = add_fn,
         as_note = FALSE,
         width = width,
         extra_indent = extra_indent
@@ -507,75 +438,146 @@ word_wrap <- function(...,
       collapse = "\n"
     ))
   }
-  wrapped <- paste0(strwrap(msg, width = width), collapse = "\n")
-  if (grepl("\u2139 ", msg, fixed = TRUE)) {
-    indentation <- 2L + extra_indent
-  } else if (grepl("^=> ", msg)) {
-    indentation <- 3L + extra_indent
+
+  # correct for operators (will add the space later on)
+  ops <- "([,./><\\]\\[])"
+  msg <- gsub(paste0(ops, " ", ops), "\\1\\2", msg, perl = TRUE)
+  # we need to correct for already applied style, that adds text like "\033[31m\"
+  msg_stripped <- gsub("(.*)?\\033\\]8;;.*\\a(.*?)\\033\\]8;;\\a(.*)", "\\1\\2\\3", msg, perl = TRUE) # for font_url()
+  msg_stripped <- font_stripstyle(msg_stripped)
+  # where are the spaces now?
+  msg_stripped_wrapped <- paste0(
+    strwrap(msg_stripped,
+      simplify = TRUE,
+      width = width
+    ),
+    collapse = "\n"
+  )
+  msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
+    collapse = "\n"
+  )
+  msg_stripped_spaces <- which(unlist(strsplit(msg_stripped, "", fixed = TRUE)) == " ")
+  msg_stripped_wrapped_spaces <- which(unlist(strsplit(msg_stripped_wrapped, "", fixed = TRUE)) != "\n")
+  # so these are the indices of spaces that need to be replaced
+  replace_spaces <- which(!msg_stripped_spaces %in% msg_stripped_wrapped_spaces)
+  # put it together
+  msg <- unlist(strsplit(msg, " ", fixed = TRUE))
+  msg[replace_spaces] <- paste0(msg[replace_spaces], "\n")
+  # add space around operators again
+  msg <- gsub(paste0(ops, ops), "\\1 \\2", msg, perl = TRUE)
+  msg <- paste0(msg, collapse = " ")
+  msg <- gsub("\n ", "\n", msg, fixed = TRUE)
+
+  if (msg_stripped %like% "\u2139 ") {
+    indentation <- 2 + extra_indent
+  } else if (msg_stripped %like% "^=> ") {
+    indentation <- 3 + extra_indent
   } else {
-    indentation <- 0L + extra_indent
+    indentation <- 0 + extra_indent
   }
-  if (indentation > 0L) {
-    wrapped <- gsub("\n", paste0("\n", strrep(" ", indentation)), wrapped, fixed = TRUE)
+  msg <- gsub("\n", paste0("\n", strrep(" ", indentation)), msg, fixed = TRUE)
+  # remove trailing empty characters
+  msg <- gsub("(\n| )+$", "", msg)
+
+  if (length(add_fn) > 0) {
+    if (!is.list(add_fn)) {
+      add_fn <- list(add_fn)
+    }
+    for (i in seq_len(length(add_fn))) {
+      msg <- add_fn[[i]](msg)
+    }
   }
-  gsub("(\n| )+$", "", wrapped)
+
+  # format backticks
+  if (pkg_is_available("cli") && in_rstudio() &&
+    tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) {
+      return(FALSE)
+    })) {
+    # we are in a recent version of RStudio, so do something nice: add links to our help pages in the console.
+    parts <- strsplit(msg, "`", fixed = TRUE)[[1]]
+    cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()")
+    # functions with a dot are not allowed: https://github.com/rstudio/rstudio/issues/11273#issuecomment-1156193252
+    # lead them to the help page of our package
+    parts[cmds & parts %like% "[.]"] <- font_url(
+      url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
+      txt = parts[cmds & parts %like% "[.]"]
+    )
+    # datasets should give help page as well
+    parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")] <- font_url(
+      url = paste0("ide:help:AMR::", gsub("()", "", parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")], fixed = TRUE)),
+      txt = parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")]
+    )
+    # text starting with `?` must also lead to the help page
+    parts[parts %like% "^[?].+"] <- font_url(
+      url = paste0("ide:help:AMR::", gsub("?", "", parts[parts %like% "^[?].+"], fixed = TRUE)),
+      txt = parts[parts %like% "^[?].+"]
+    )
+    msg <- paste0(parts, collapse = "`")
+  }
+  msg <- gsub("`(.+?)`", font_grey_bg("`\\1`"), msg)
+
+  # clean introduced whitespace in between fullstops
+  msg <- gsub("[.] +[.]", "..", msg)
+  # remove extra space that was introduced (e.g. "Smith et al. , 2022")
+  msg <- gsub(". ,", ".,", msg, fixed = TRUE)
+  msg <- gsub("[ ,", "[,", msg, fixed = TRUE)
+  msg <- gsub("/ /", "//", msg, fixed = TRUE)
+
+  msg
 }
 
 message_ <- function(...,
                      appendLF = TRUE,
+                     add_fn = list(font_blue),
                      as_note = TRUE) {
-  if (pkg_is_available("cli")) {
-    msg <- paste0(c(...), collapse = "")
-    if (isTRUE(as_note)) {
-      cli::cli_inform(c("i" = msg), .envir = parent.frame())
-    } else {
-      cli::cli_inform(msg, .envir = parent.frame())
-    }
-  } else {
-    plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
-    message(word_wrap(plain_msg, as_note = as_note), appendLF = appendLF)
-  }
+  message(
+    word_wrap(...,
+      add_fn = add_fn,
+      as_note = as_note
+    ),
+    appendLF = appendLF
+  )
 }
 
 warning_ <- function(...,
+                     add_fn = list(),
                      immediate = FALSE,
                      call = FALSE) {
-  if (pkg_is_available("cli")) {
-    msg <- paste0(c(...), collapse = "")
-    cli::cli_warn(msg, .envir = parent.frame())
-  } else {
-    plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
-    warning(trimws2(word_wrap(plain_msg, as_note = FALSE)), immediate. = immediate, call. = call)
-  }
+  warning(
+    trimws2(word_wrap(...,
+      add_fn = add_fn,
+      as_note = FALSE
+    )),
+    immediate. = immediate,
+    call. = call
+  )
 }
 
 # this alternative to the stop() function:
-# - adds the function name where the error was thrown (plain-text fallback)
-# - wraps text to never break lines within words (plain-text fallback)
+# - adds the function name where the error was thrown
+# - wraps text to never break lines within words
 stop_ <- function(..., call = TRUE) {
   msg <- paste0(c(...), collapse = "")
-  if (pkg_is_available("cli")) {
+  msg_call <- ""
+  if (!isFALSE(call)) {
     if (isTRUE(call)) {
-      call_obj <- sys.call(-1)
-    } else if (!isFALSE(call)) {
-      call_obj <- sys.call(call)
+      call <- as.character(sys.call(-1)[1])
     } else {
-      call_obj <- NULL
+      # so you can go back more than 1 call, as used in sir_calc(), that now throws a reference to e.g. n_sir()
+      call <- as.character(sys.call(call)[1])
     }
-    cli::cli_abort(msg, call = call_obj, .envir = parent.frame())
+    msg_call <- paste0("in ", call, "():")
+  }
+  msg <- trimws2(word_wrap(msg, add_fn = list(), as_note = FALSE))
+  if (!is.null(AMR_env$cli_abort) && length(unlist(strsplit(msg, "\n", fixed = TRUE))) <= 1) {
+    if (is.character(call)) {
+      call <- as.call(str2lang(paste0(call, "()")))
+    } else {
+      call <- NULL
+    }
+    AMR_env$cli_abort(msg, call = call)
   } else {
-    msg_call <- ""
-    if (!isFALSE(call)) {
-      if (isTRUE(call)) {
-        call_name <- as.character(sys.call(-1)[1])
-      } else {
-        # go back more than 1 call, as used in sir_calc() to reference e.g. n_sir()
-        call_name <- as.character(sys.call(call)[1])
-      }
-      msg_call <- paste0("in ", call_name, "():")
-    }
-    plain_msg <- cli_to_plain(trimws2(word_wrap(msg, as_note = FALSE)), envir = parent.frame())
-    stop(paste(msg_call, plain_msg), call. = FALSE)
+    stop(paste(msg_call, msg), call. = FALSE)
   }
 }
 
@@ -618,7 +620,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
 
 return_after_integrity_check <- function(value, type, check_vector) {
   if (!all(value[!is.na(value)] %in% check_vector)) {
-    warning_("invalid ", type, ", NA generated")
+    warning_(paste0("invalid ", type, ", NA generated"))
     value[!value %in% check_vector] <- NA
   }
   value

R/amr_course.R

@@ -1,62 +0,0 @@
-# ==================================================================== #
-# TITLE:                                                               #
-# AMR: An R Package for Working with Antimicrobial Resistance Data     #
-#                                                                      #
-# SOURCE CODE:                                                         #
-# https://github.com/msberends/AMR                                     #
-#                                                                      #
-# PLEASE CITE THIS SOFTWARE AS:                                        #
-# Berends MS, Luz CF, Friedrich AW, et al. (2022).                     #
-# AMR: An R Package for Working with Antimicrobial Resistance Data.    #
-# Journal of Statistical Software, 104(3), 1-31.                       #
-# https://doi.org/10.18637/jss.v104.i03                                #
-#                                                                      #
-# Developed at the University of Groningen and the University Medical  #
-# Center Groningen in The Netherlands, in collaboration with many      #
-# colleagues from around the world, see our website.                   #
-#                                                                      #
-# This R package is free software; you can freely use and distribute   #
-# it for both personal and commercial purposes under the terms of the  #
-# GNU General Public License version 2.0 (GNU GPL-2), as published by  #
-# the Free Software Foundation.                                        #
-# We created this package for both routine data analysis and academic  #
-# research and it was publicly released in the hope that it will be    #
-# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY.              #
-#                                                                      #
-# Visit our website for the full manual and a complete tutorial about  #
-# how to conduct AMR data analysis: https://amr-for-r.org              #
-# ==================================================================== #
-
-#' Download and Unpack an AMR Course Repository
-#'
-#' Downloads and unpacks a GitHub repository containing course materials, using [usethis::use_course()]. This is a convenience wrapper intended for use in educational settings, such as workshops or tutorials associated with the AMR package.
-#' @param github_repo A character string specifying the GitHub repository with username and repo name, e.g. `"https://github.com/username/repo"`.
-#' @param branch A character string specifying the branch to download. Defaults to `"main"`.
-#' @param ... Additional arguments passed on to [usethis::use_course()].
-#' @details
-#' This function constructs a ZIP archive URL from the provided `github_repo` and `branch`, then delegates to [usethis::use_course()] to handle the download and extraction.
-#'
-#' The function is designed for interactive use in course or workshop settings and is not intended for use in non-interactive or automated pipelines.
-#' @return
-#' Called for its side effect. [usethis::use_course()] will prompt the user to choose a destination and open the extracted project. Returns invisibly whatever [usethis::use_course()] returns.
-#' @seealso [usethis::use_course()]
-#' @export
-#' @examples
-#' \dontrun{
-#'
-#' # Let this run by users, e.g., webinar participants
-#' amr_course("https://github.com/my_user_name/our_AMR_course")
-#' }
-amr_course <- function(github_repo, branch = "main", ...) {
-  if (!"usethis" %in% rownames(utils::installed.packages())) {
-    if ("rlang" %in% rownames(utils::installed.packages())) {
-      rlang::check_installed("usethis")
-    } else {
-      stop("Package usethis is not installed. Please run: install.packages(\"usethis\")", call. = FALSE)
-    }
-  }
-  url <- paste0(github_repo, "/archive/refs/heads/", branch, ".zip")
-  use_course <- import_fn("use_course", "usethis")
-  message("This will download and unpack the contents of a repository.\n")
-  use_course(url, ...)
-}

R/antibiogram.R

@@ -445,7 +445,7 @@ antibiogram.default <- function(x,
   meet_criteria(wisca, allow_class = "logical", has_length = 1)
   if (isTRUE(wisca)) {
     if (!is.null(mo_transform) && !missing(mo_transform)) {
-      warning_("WISCA must be based on the species level as WISCA parameters are based on this. For that reason, {.arg mo_transform} will be ignored.")
+      warning_("WISCA must be based on the species level as WISCA parameters are based on this. For that reason, `mo_transform` will be ignored.")
     }
     mo_transform <- function(x) suppressMessages(suppressWarnings(paste(mo_genus(x, keep_synonyms = TRUE, language = NULL), mo_species(x, keep_synonyms = TRUE, language = NULL))))
   }
@@ -482,7 +482,7 @@ antibiogram.default <- function(x,
   # try to find columns based on type
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo", info = info)
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+    stop_if(is.null(col_mo), "`col_mo` must be set")
   }
   # transform MOs
   x$`.mo` <- x[, col_mo, drop = TRUE]
@@ -523,7 +523,7 @@ antibiogram.default <- function(x,
     ab_trycatch <- tryCatch(colnames(dplyr::select(x, {{ antimicrobials }})), error = function(e) NULL)
   }
   if (is.null(ab_trycatch)) {
-    stop_ifnot(is.character(suppressMessages(antimicrobials)), "{.arg antimicrobials} must be an antimicrobial selector, or a character vector.")
+    stop_ifnot(is.character(suppressMessages(antimicrobials)), "`antimicrobials` must be an antimicrobial selector, or a character vector.")
     antimicrobials.bak <- antimicrobials
     # split antimicrobials on separator and make it a list
     antimicrobials <- strsplit(gsub(" ", "", antimicrobials), "+", fixed = TRUE)
@@ -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 `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 `minimum = ", minimum, "` results and were ignored", add_fn = font_red)
       }
     }
   }
@@ -812,7 +812,7 @@ antibiogram.default <- function(x,
   # 21. 5 (4-6,N=15/300)
   # 22. 5% (4-6%,N=15/300)
   if (wisca == TRUE && !formatting_type %in% c(1, 2, 13, 14) && info == TRUE && message_not_thrown_before("antibiogram", wisca, formatting_type)) {
-    message_("Using WISCA with a {.arg formatting_type} that includes the denominator is not useful")
+    message_("Using WISCA with a `formatting_type` that includes the denominator is not useful")
   }
   out$digits <- digits # since pm_sumarise() cannot work with an object outside the current frame
   if (formatting_type == 1) out <- out %pm>% pm_summarise(out_value = round(coverage * 100, digits = digits))
@@ -998,8 +998,8 @@ antibiogram.grouped_df <- function(x,
                                    interval_side = "two-tailed",
                                    info = interactive(),
                                    ...) {
-  stop_ifnot(is.null(mo_transform), "{.arg mo_transform} must not be set if creating an antibiogram using a grouped tibble. The groups will become the variables over which the antimicrobials are calculated, which could include the pathogen information (though not necessary). Nonetheless, this makes {.arg mo_transform} redundant.", call = FALSE)
-  stop_ifnot(is.null(syndromic_group), "{.arg syndromic_group} must not be set if creating an antibiogram using a grouped tibble. The groups will become the variables over which the antimicrobials are calculated, making {.arg syndromic_group} redundant.", call = FALSE)
+  stop_ifnot(is.null(mo_transform), "`mo_transform` must not be set if creating an antibiogram using a grouped tibble. The groups will become the variables over which the antimicrobials are calculated, which could include the pathogen information (though not necessary). Nonetheless, this makes `mo_transform` redundant.", call = FALSE)
+  stop_ifnot(is.null(syndromic_group), "`syndromic_group` must not be set if creating an antibiogram using a grouped tibble. The groups will become the variables over which the antimicrobials are calculated, making `syndromic_groups` redundant.", call = FALSE)
   groups <- attributes(x)$groups
   n_groups <- NROW(groups)
   progress <- progress_ticker(
@@ -1198,7 +1198,7 @@ simulate_coverage <- function(params) {
 #' @param wisca_model The outcome of [wisca()] or [`antibiogram(..., wisca = TRUE)`][antibiogram()].
 #' @rdname antibiogram
 retrieve_wisca_parameters <- function(wisca_model, ...) {
-  stop_ifnot(isTRUE(attributes(wisca_model)$wisca), "This function only applies to WISCA models. Use {.help wisca} or {.help antibiogram} (with {.code wisca = TRUE}) to create a WISCA model.")
+  stop_ifnot(isTRUE(attributes(wisca_model)$wisca), "This function only applies to WISCA models. Use `wisca()` or `antibiogram(..., wisca = TRUE)` to create a WISCA model.")
   attributes(wisca_model)$wisca_parameters
 }
 

R/atc_online.R

@@ -105,6 +105,7 @@ atc_online_property <- function(atc_code,
 
   if (!has_internet()) {
     message_("There appears to be no internet connection, returning NA.",
+      add_fn = font_red,
       as_note = FALSE
     )
     return(rep(NA, length(atc_code)))
@@ -180,7 +181,7 @@ atc_online_property <- function(atc_code,
       colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
 
       if (length(out) == 0) {
-        message_("in {.help atc_online_property}: no properties found for ATC ", atc_code[i], ". Please check {.href {atc_url} this WHOCC webpage}.")
+        message_("in `atc_online_property()`: no properties found for ATC ", atc_code[i], ". Please check ", font_url(atc_url, "this WHOCC webpage"), ".")
         returnvalue[i] <- NA
         next
       }

R/custom_mdro_guideline.R

@@ -145,15 +145,15 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
   )
   stop_if(
     identical(dots, "error"),
-    "rules must be a valid formula inputs (e.g., using '~'), see {.help mdro}"
+    "rules must be a valid formula inputs (e.g., using '~'), see `?mdro`"
   )
   n_dots <- length(dots)
-  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using {.help mdro}.")
+  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?mdro`.")
   out <- vector("list", n_dots)
   for (i in seq_len(n_dots)) {
     stop_ifnot(
       inherits(dots[[i]], "formula"),
-      "rule ", i, " must be a valid formula input (e.g., using '~'), see {.help mdro}"
+      "rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
     )
 
     # Query
@@ -202,7 +202,7 @@ c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
   }
   for (g in list(...)) {
     stop_ifnot(inherits(g, "custom_mdro_guideline"),
-      "for combining custom MDRO guidelines, all rules must be created with {.help custom_mdro_guideline}",
+      "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
       call = FALSE
     )
     vals <- attributes(x)$values
@@ -259,15 +259,16 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
       }
     )
     if (identical(qry, "error")) {
-      warning_("in {.help custom_mdro_guideline}: rule ", i,
+      warning_("in `custom_mdro_guideline()`: rule ", i,
         " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
         AMR_env$err_msg,
-        call = FALSE
+        call = FALSE,
+        add_fn = font_red
       )
       next
     }
-    stop_ifnot(is.logical(qry), "in {.help custom_mdro_guideline}: rule ", i, " (`", guideline[[i]]$query,
-      "`) must return {.code TRUE} or {.code FALSE}, not ",
+    stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
+      "`) must return `TRUE` or `FALSE`, not ",
       format_class(class(qry), plural = FALSE),
       call = FALSE
     )

R/first_isolate.R

@@ -263,7 +263,8 @@ first_isolate <- function(x = NULL,
           ),
           ""
         )
-      )
+      ),
+      add_fn = font_red
     )
   }
 
@@ -271,7 +272,7 @@ first_isolate <- function(x = NULL,
   # -- mo
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo", info = info)
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+    stop_if(is.null(col_mo), "`col_mo` must be set")
   }
 
   # methods ----
@@ -308,7 +309,7 @@ first_isolate <- function(x = NULL,
   # -- date
   if (is.null(col_date)) {
     col_date <- search_type_in_df(x = x, type = "date", info = info)
-    stop_if(is.null(col_date), "{.arg col_date} must be set")
+    stop_if(is.null(col_date), "`col_date` must be set")
   }
 
   # -- patient id
@@ -317,11 +318,11 @@ first_isolate <- function(x = NULL,
       # WHONET support
       x$patient_id <- paste(x$`First name`, x$`Last name`, x$Sex)
       col_patient_id <- "patient_id"
-      message_("Using combined columns '", font_bold("First name"), "', '", font_bold("Last name"), "' and '", font_bold("Sex"), "' as input for {.arg col_patient_id}")
+      message_("Using combined columns '", font_bold("First name"), "', '", font_bold("Last name"), "' and '", font_bold("Sex"), "' as input for `col_patient_id`")
     } else {
       col_patient_id <- search_type_in_df(x = x, type = "patient_id", info = info)
     }
-    stop_if(is.null(col_patient_id), "{.arg col_patient_id} must be set")
+    stop_if(is.null(col_patient_id), "`col_patient_id` must be set")
   }
 
   # -- specimen
@@ -333,7 +334,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 '", column, "' not found.",
         call = FALSE
       )
     }
@@ -362,7 +363,9 @@ first_isolate <- function(x = NULL,
   }
   # remove testcodes
   if (!is.null(testcodes_exclude) && isTRUE(info) && message_not_thrown_before("first_isolate", "excludingtestcodes")) {
-    message_("Excluding test codes: ", vector_and(testcodes_exclude, quotes = TRUE))
+    message_("Excluding test codes: ", vector_and(testcodes_exclude, quotes = TRUE),
+      add_fn = font_red
+    )
   }
 
   if (is.null(col_specimen)) {
@@ -373,7 +376,9 @@ 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, "'",
+        add_fn = font_red
+      )
     }
   }
   if (!is.null(col_keyantimicrobials)) {
@@ -415,6 +420,7 @@ first_isolate <- function(x = NULL,
   if (abs(row.start) == Inf || abs(row.end) == Inf) {
     if (isTRUE(info)) {
       message_("=> Found ", font_bold("no isolates"),
+        add_fn = font_black,
         as_note = FALSE
       )
     }
@@ -423,6 +429,7 @@ first_isolate <- function(x = NULL,
   if (row.start == row.end) {
     if (isTRUE(info)) {
       message_("=> Found ", font_bold("1 first isolate"), ", as the data only contained 1 row",
+        add_fn = font_black,
         as_note = FALSE
       )
     }
@@ -430,7 +437,9 @@ 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",
+      message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")),
+        ", as all isolates were different microbial species",
+        add_fn = font_black,
         as_note = FALSE
       )
     }
@@ -449,12 +458,14 @@ first_isolate <- function(x = NULL,
       if (type == "keyantimicrobials") {
         message_("Basing inclusion on key antimicrobials, ",
           ifelse(ignore_I == FALSE, "not ", ""),
-          "ignoring I"
+          "ignoring I",
+          add_fn = font_red
         )
       }
       if (type == "points") {
         message_("Basing inclusion on all antimicrobial results, using a points threshold of ",
-          points_threshold
+          points_threshold,
+          add_fn = font_red
         )
       }
     }
@@ -513,7 +524,9 @@ first_isolate <- function(x = NULL,
   if (any(!is.na(x$newvar_is_icu)) && any(x$newvar_is_icu == TRUE, na.rm = TRUE)) {
     if (icu_exclude == TRUE) {
       if (isTRUE(info)) {
-        message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.")
+        message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.",
+          add_fn = font_red
+        )
       }
       x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE
     } else if (isTRUE(info)) {
@@ -537,8 +550,9 @@ first_isolate <- function(x = NULL,
             paste0('"', x, '"')
           }
         })
-        message_("\nGroup: {toString(paste0(names(group), ' = ', group))}\n",
-          as_note = FALSE
+        message_("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n",
+          as_note = FALSE,
+          add_fn = font_red
         )
       }
     }
@@ -551,7 +565,8 @@ 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 '", font_bold(col_mo), "')",
+      add_fn = font_red
     )
   }
   x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
@@ -562,7 +577,8 @@ 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 '", font_bold(col_mo), "')",
+      add_fn = font_red
     )
   }
   x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
@@ -608,7 +624,7 @@ first_isolate <- function(x = NULL,
         ),
         p_found_total, " of total where a microbial ID was available)"
       ),
-      as_note = FALSE
+      add_fn = font_black, as_note = FALSE
     )
   }
 

R/guess_ab_col.R

@@ -79,6 +79,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_s
     if (isTRUE(verbose)) {
       message_("No column found as input for ", search_string,
         " (", ab_name(search_string, language = NULL, tolower = TRUE), ").",
+        add_fn = font_black,
         as_note = FALSE
       )
     }
@@ -210,7 +211,7 @@ get_column_abx <- function(x,
     newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
     if (anyNA(newnames)) {
       if (isTRUE(info)) {
-        message_("WARNING: some columns returned NA for {.help as.ab}", as_note = FALSE)
+        message_(paste0(font_yellow(font_bold(" WARNING: ")), "some columns returned `NA` for `as.ab()`"), as_note = FALSE)
       }
       warning_("Invalid antibiotic reference(s): ", vector_and(names(dots)[is.na(newnames)], quotes = FALSE),
         call = FALSE,
@@ -221,7 +222,7 @@ get_column_abx <- function(x,
     unexisting_cols <- which(!vapply(FUN.VALUE = logical(1), dots, function(col) all(col %in% x_columns)))
     if (length(unexisting_cols) > 0) {
       if (isTRUE(info)) {
-        message_(" ERROR", as_note = FALSE)
+        message_(" ERROR", add_fn = list(font_red, font_bold), as_note = FALSE)
       }
       stop_("Column(s) not found: ", vector_and(unlist(dots[[unexisting_cols]]), quotes = FALSE),
         call = FALSE
@@ -265,11 +266,11 @@ get_column_abx <- function(x,
 
     if (isTRUE(info)) {
       if (all_okay == TRUE) {
-        message_(" OK.", as_note = FALSE)
+        message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
       } else if (!isFALSE(dups)) {
-        message_("WARNING: some results from {.help as.ab} are duplicated: ", vector_and(dups, quotes = "`"), as_note = FALSE)
+        message_(paste0(font_yellow(font_bold(" WARNING: ")), "some results from `as.ab()` are duplicated: ", vector_and(dups, quotes = "`")), as_note = FALSE)
       } else {
-        message_(" WARNING.", as_note = FALSE)
+        message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
       }
 
       for (i in seq_len(length(out))) {
@@ -287,7 +288,8 @@ get_column_abx <- function(x,
                 "Column '", font_bold(out[i]), "' will not be used for ",
                 names(out)[i], " (", suppressMessages(ab_name(names(out)[i], tolower = TRUE, language = NULL, fast_mode = TRUE)), ")",
                 ", as this antimicrobial has already been set."
-              )
+              ),
+              add_fn = font_red
             )
           }
         }

R/interpretive_rules.R

@@ -56,6 +56,11 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
 #' Apply Interpretive Rules
 #'
 #' @description
+#' **WORK IN PROGRESS**
+#'
+# TODO Remove this remark before next release
+#' **The `interpretive_rules()` function is new, to allow CLSI 'rules' too. The old `eucast_rules()` function will stay as a wrapper, but we need to generalise more parts of the underlying code to allow more than just EUCAST.**
+#'
 #' Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by e.g. the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://www.eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
 #'
 #' To improve the interpretation of the antibiogram before CLSI/EUCAST interpretive rules are applied, some AMR-specific rules can be applied at default, see *Details*.
@@ -74,6 +79,7 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
 #' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
 #' @param custom_rules Custom rules to apply, created with [custom_eucast_rules()].
 #' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".
+#' @param add_if_missing A [logical] indicating whether rules should also be applied to missing (`NA`) values (default: `TRUE`). When `FALSE`, rules are only applied to cells that already contain an SIR value; cells with `NA` are left untouched. This is particularly useful when using `overwrite = TRUE` with custom rules and you want to update reported results without imputing values for untested drugs.
 #' @inheritParams first_isolate
 #' @details
 #' **Note:** This function does not translate MIC values to SIR values. Use [as.sir()] for that. \cr
@@ -170,6 +176,7 @@ interpretive_rules <- function(x,
                                only_sir_columns = any(is.sir(x)),
                                custom_rules = NULL,
                                overwrite = FALSE,
+                               add_if_missing = TRUE,
                                ...) {
   meet_criteria(x, allow_class = "data.frame")
   meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
@@ -184,6 +191,7 @@ interpretive_rules <- function(x,
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
   meet_criteria(overwrite, allow_class = "logical", has_length = 1)
+  meet_criteria(add_if_missing, allow_class = "logical", has_length = 1)
 
   stop_if(
     guideline == "CLSI",
@@ -192,19 +200,19 @@ interpretive_rules <- function(x,
 
   stop_if(
     !is.na(ampc_cephalosporin_resistance) && !any(c("expert", "all") %in% rules),
-    "For the {.arg ampc_cephalosporin_resistance} argument to work, the {.arg rules} argument must contain {.code \"expert\"} or {.code \"all\"}."
+    "For the `ampc_cephalosporin_resistance` argument to work, the `rules` argument must contain `\"expert\"` or `\"all\"`."
   )
 
   add_MO_lookup_to_AMR_env()
 
   if ("custom" %in% rules && is.null(custom_rules)) {
-    warning_("in {.help eucast_rules}: no custom rules were set with the {.arg custom_rules} argument",
+    warning_("in `eucast_rules()`: no custom rules were set with the `custom_rules` argument",
       immediate = TRUE
     )
     rules <- rules[rules != "custom"]
     if (length(rules) == 0) {
       if (isTRUE(info)) {
-        message_("No other rules were set, returning original data", as_note = FALSE)
+        message_("No other rules were set, returning original data", add_fn = font_red, as_note = FALSE)
       }
       return(x)
     }
@@ -232,7 +240,7 @@ interpretive_rules <- function(x,
       q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
     }
     if (q_continue %in% c(FALSE, 2)) {
-      message_("Cancelled, returning original data", as_note = FALSE)
+      message_("Cancelled, returning original data", add_fn = font_red, as_note = FALSE)
       return(x)
     }
   }
@@ -241,7 +249,7 @@ interpretive_rules <- function(x,
   # -- mo
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo", info = info)
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+    stop_if(is.null(col_mo), "`col_mo` must be set")
   }
 
   decimal.mark <- getOption("OutDec")
@@ -459,7 +467,7 @@ interpretive_rules <- function(x,
   x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL, info = FALSE)
   x$genus_species <- trimws(paste(x$genus, x$species))
   if (isTRUE(info) && NROW(x.bak) > 10000) {
-    message_("OK.", as_note = FALSE)
+    message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
   }
 
   n_added <- 0
@@ -533,7 +541,8 @@ interpretive_rules <- function(x,
           warned = warned,
           info = info,
           verbose = verbose,
-          overwrite = overwrite
+          overwrite = overwrite,
+          add_if_missing = add_if_missing
         )
         n_added <- n_added + run_changes$added
         n_changed <- n_changed + run_changes$changed
@@ -575,7 +584,8 @@ interpretive_rules <- function(x,
           warned = warned,
           info = info,
           verbose = verbose,
-          overwrite = overwrite
+          overwrite = overwrite,
+          add_if_missing = add_if_missing
         )
         n_added <- n_added + run_changes$added
         n_changed <- n_changed + run_changes$changed
@@ -595,13 +605,23 @@ interpretive_rules <- function(x,
   } else {
     if (isTRUE(info)) {
       cat("\n")
-      message_("Skipping inhibitor-inheritance rules defined by this AMR package: setting S to drug+inhibitor where drug is S, and setting R to drug where drug+inhibitor is R. Add \"other\" or \"all\" to the {.arg rules} argument to apply those rules.")
+      message_(paste0(
+        font_red("Skipping inhibitor-inheritance rules defined by this AMR package: setting "),
+        font_green_bg(" S "),
+        font_red(" to drug+inhibitor where drug is "),
+        font_green_bg(" S "),
+        font_red(", and setting "),
+        font_rose_bg(" R "),
+        font_red(" to drug where drug+inhibitor is "),
+        font_rose_bg(" R "),
+        font_red(". Add \"other\" or \"all\" to the `rules` argument to apply those rules.")
+      ))
     }
   }
 
   if (!any(c("all", "custom") %in% rules) && !is.null(custom_rules)) {
     if (isTRUE(info)) {
-      message_("Skipping custom EUCAST rules, since the {.arg rules} argument does not contain {.code \"custom\"}.")
+      message_("Skipping custom EUCAST rules, since the `rules` argument does not contain \"custom\".")
     }
     custom_rules <- NULL
   }
@@ -663,7 +683,8 @@ interpretive_rules <- function(x,
       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"
+          " since a column '", ab_s, "' is missing but required for the chosen rules",
+          add_fn = font_red
         )
       }
       cols_ab <- c(cols_ab, stats::setNames(unname(cols_ab[names(cols_ab) == ab]), ab_s))
@@ -861,7 +882,8 @@ interpretive_rules <- function(x,
       warned = warned,
       info = info,
       verbose = verbose,
-      overwrite = overwrite
+      overwrite = overwrite,
+      add_if_missing = add_if_missing
     )
     n_added <- n_added + run_changes$added
     n_changed <- n_changed + run_changes$changed
@@ -887,7 +909,7 @@ interpretive_rules <- function(x,
     for (i in seq_len(length(custom_rules))) {
       rule <- custom_rules[[i]]
       rows <- tryCatch(which(eval(parse(text = rule$query), envir = x)),
-        error = function(e) stop_(conditionMessage(e), " (check available data and compare with the custom rules set)", call = FALSE)
+        error = function(e) stop_(paste0(conditionMessage(e), font_red(" (check available data and compare with the custom rules set)")), call = FALSE)
       )
       cols <- as.character(rule$result_group)
       cols <- c(
@@ -931,7 +953,8 @@ interpretive_rules <- function(x,
         warned = warned,
         info = info,
         verbose = verbose,
-        overwrite = overwrite
+        overwrite = overwrite,
+        add_if_missing = add_if_missing
       )
       n_added <- n_added + run_changes$added
       n_changed <- n_changed + run_changes$changed
@@ -1062,7 +1085,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 eucast_rules}: not all columns with antimicrobial results are of class 'sir'. Transform them on beforehand, with e.g.:\n",
+      "in `eucast_rules()`: not all columns with antimicrobial results are of class 'sir'. Transform them on beforehand, with e.g.:\n",
       "  - ", 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)])
@@ -1097,7 +1120,7 @@ eucast_rules <- function(x,
                          rules = getOption("AMR_interpretive_rules", default = c("breakpoints", "expected_phenotypes")),
                          ...) {
   if (!is.null(getOption("AMR_eucastrules", default = NULL))) {
-    warning_("The global option {.code AMR_eucastrules} that you have set is now invalid was ignored - set {.code AMR_interpretive_rules} instead. See {.code ?AMR-options}.")
+    warning_("The global option `AMR_eucastrules` that you have set is now invalid was ignored - set `AMR_interpretive_rules` instead. See `?AMR-options`.")
   }
   interpretive_rules(x = x, col_mo = col_mo, info = info, rules = rules, guideline = "EUCAST", ...)
 }
@@ -1123,7 +1146,8 @@ edit_sir <- function(x,
                      warned,
                      info,
                      verbose,
-                     overwrite) {
+                     overwrite,
+                     add_if_missing) {
   cols <- unique(cols[!is.na(cols) & !is.null(cols)])
 
   # for Verbose Mode, keep track of all changes and return them
@@ -1154,15 +1178,17 @@ edit_sir <- function(x,
     isSIR <- !isNA & (new_edits[rows, cols] == "S" | new_edits[rows, cols] == "I" | new_edits[rows, cols] == "R" | new_edits[rows, cols] == "SDD" | new_edits[rows, cols] == "NI" | new_edits[rows, cols] == "WT" | new_edits[rows, cols] == "NWT" | new_edits[rows, cols] == "NS")
     non_SIR <- !isSIR
     if (isFALSE(overwrite) && any(isSIR) && message_not_thrown_before("edit_sir.warning_overwrite")) {
-      warning_("Some values had SIR values and were not overwritten, since {.code overwrite = FALSE}.")
+      warning_("Some values had SIR values and were not overwritten, since `overwrite = FALSE`.")
+    }
+    # determine which cells to modify based on overwrite and add_if_missing
+    apply_mask <- if (isTRUE(overwrite)) {
+      if (isFALSE(add_if_missing)) !isNA else rep(TRUE, length(isNA))
+    } else {
+      if (isFALSE(add_if_missing)) isSIR else non_SIR
     }
     tryCatch(
       # insert into original table
-      if (isTRUE(overwrite)) {
-        new_edits[rows, cols] <- to
-      } else {
-        new_edits[rows, cols][non_SIR] <- to
-      },
+      new_edits[rows, cols][apply_mask] <- to,
       warning = function(w) {
         if (w$message %like% "invalid factor level") {
           xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) {
@@ -1172,13 +1198,9 @@ edit_sir <- function(x,
             )
             TRUE
           })
-          if (isTRUE(overwrite)) {
-            suppressWarnings(new_edits[rows, cols] <<- to)
-          } else {
-            suppressWarnings(new_edits[rows, cols][non_SIR] <<- to)
-          }
+          suppressWarnings(new_edits[rows, cols][apply_mask] <<- to)
           warning_(
-            "in {.help eucast_rules}: value \"", to, "\" added to the factor levels of column",
+            "in `eucast_rules()`: value \"", to, "\" added to the factor levels of column",
             ifelse(length(cols) == 1, "", "s"),
             " ", vector_and(cols, quotes = "`", sort = FALSE),
             " because this value was not an existing factor level."
@@ -1186,7 +1208,7 @@ edit_sir <- function(x,
           txt_warning()
           warned <- FALSE
         } else {
-          warning_("in {.help eucast_rules}: ", w$message)
+          warning_("in `eucast_rules()`: ", w$message)
           txt_warning()
         }
       },

R/join_microorganisms.R

@@ -143,9 +143,9 @@ join_microorganisms <- function(type, x, by, suffix, ...) {
     if (is.null(by) && NCOL(x) == 1) {
       by <- colnames(x)[1L]
     } else {
-      stop_if(is.null(by), "no column with microorganism names or codes found, set this column with {.arg by}", call = -2)
+      stop_if(is.null(by), "no column with microorganism names or codes found, set this column with `by`", call = -2)
     }
-    message_('Joining, by = "{by}"', as_note = FALSE) # message same as dplyr::join functions
+    message_('Joining, by = "', by, '"', add_fn = font_black, 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 `", type, "_microorganisms()`: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.")
   }
 
   as_original_data_class(joined, class(x.bak)) # will remove tibble groups

R/mdro.R

@@ -170,9 +170,9 @@ mdro <- function(x = NULL,
   meet_criteria(infer_from_combinations, allow_class = "logical", has_length = 1)
 
   if (isTRUE(only_sir_columns) && !any(is.sir(x))) {
-    stop_("There were no SIR columns found in the data set, despite {.arg only_sir_columns} being {.code TRUE}. Transform columns with {.help as.sir} for valid antimicrobial interpretations.")
+    stop_("There were no SIR columns found in the data set, despite `only_sir_columns` being `TRUE`. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
   } else if (!isTRUE(only_sir_columns) && !any(is.sir(x)) && !any(is_sir_eligible(x))) {
-    stop_("There were no eligible SIR columns found in the data set. Transform columns with {.help as.sir} for valid antimicrobial interpretations.")
+    stop_("There were no eligible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
   }
 
   # get gene values as TRUE/FALSE
@@ -213,7 +213,7 @@ mdro <- function(x = NULL,
       q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
     }
     if (q_continue %in% c(FALSE, 2)) {
-      message_("Cancelled, returning original data", as_note = FALSE)
+      message_("Cancelled, returning original data", add_fn = font_red, as_note = FALSE)
       return(x)
     }
   }
@@ -251,7 +251,7 @@ mdro <- function(x = NULL,
   guideline.bak <- guideline
   if (is.list(guideline)) {
     # Custom MDRO guideline ---------------------------------------------------
-    stop_ifnot(inherits(guideline, "custom_mdro_guideline"), "use {.help custom_mdro_guideline} to create custom guidelines")
+    stop_ifnot(inherits(guideline, "custom_mdro_guideline"), "use `custom_mdro_guideline()` to create custom guidelines")
     if (isTRUE(info)) {
       txt <- paste0(
         "Determining MDROs based on custom rules",
@@ -328,13 +328,13 @@ mdro <- function(x = NULL,
   }
   if (is.null(col_mo) && guideline$code == "tb") {
     message_(
-      "No column found as input for {.arg col_mo}, ",
+      "No column found as input for `col_mo`, ",
       font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), "."))
     )
     x$mo <- as.mo("Mycobacterium tuberculosis", keep_synonyms = TRUE)
     col_mo <- "mo"
   }
-  stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+  stop_if(is.null(col_mo), "`col_mo` must be set")
 
   if (guideline$code == "cmi2012") {
     guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
@@ -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 '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.", add_fn = font_red)
     }
     cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
   }
@@ -875,7 +875,7 @@ mdro <- function(x = NULL,
     }
 
     if (isTRUE(info)) {
-      message_(" OK.", as_note = FALSE)
+      message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
     }
   }
 
@@ -1965,7 +1965,7 @@ brmo <- function(x = NULL, only_sir_columns = any(is.sir(x)), ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
-    "argument {.arg guideline} must not be set since this is a guideline-specific function"
+    "argument `guideline` must not be set since this is a guideline-specific function"
   )
   mdro(x = x, only_sir_columns = only_sir_columns, guideline = "BRMO", ...)
 }
@@ -1978,7 +1978,7 @@ mrgn <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE, .
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
-    "argument {.arg guideline} must not be set since this is a guideline-specific function"
+    "argument `guideline` must not be set since this is a guideline-specific function"
   )
   mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "MRGN", ...)
 }
@@ -1990,7 +1990,7 @@ mdr_tb <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE,
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
-    "argument {.arg guideline} must not be set since this is a guideline-specific function"
+    "argument `guideline` must not be set since this is a guideline-specific function"
   )
   mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "TB", ...)
 }
@@ -2002,7 +2002,7 @@ mdr_cmi2012 <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = F
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
-    "argument {.arg guideline} must not be set since this is a guideline-specific function"
+    "argument `guideline` must not be set since this is a guideline-specific function"
   )
   mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "CMI 2012", ...)
 }
@@ -2014,7 +2014,7 @@ eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = any(is.si
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
-    "argument {.arg guideline} must not be set since this is a guideline-specific function"
+    "argument `guideline` must not be set since this is a guideline-specific function"
   )
   mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "EUCAST", ...)
 }

R/mo.R

@@ -402,12 +402,7 @@ as.mo <- function(x,
 
       top_hits <- mo_to_search[order(m, decreasing = TRUE, na.last = NA)] # na.last = NA will remove the NAs
       if (length(top_hits) == 0) {
-        warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ",
-          ifelse(is.null(minimum_matching_score),
-            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)
+        warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), 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)
         result_mo <- NA_character_
       } else {
         result_mo <- MO_lookup_current$mo[match(top_hits[1], MO_lookup_current$fullname)]
@@ -907,14 +902,14 @@ 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 `as.mo()` or any `mo_*()` function are stored.\n\n")))
+    cat(word_wrap("No uncertainties to show. Only uncertainties of the last call to `as.mo()` or any `mo_*()` function are stored.\n\n", add_fn = font_blue))
     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 `?mo_matching_score`.\n\n")))
+  cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
 
   add_MO_lookup_to_AMR_env()
 
@@ -924,12 +919,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 = "")
+      col_green(" 0.750-1.000"),
+      add_fn = font_blue
+    ), font_green_bg(" "), "\n", sep = "")
   }
 
   score_set_colour <- function(text, scores) {
@@ -1032,7 +1028,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 `as.mo()` or any `mo_*()` function are stored.\n")))
+    cat(word_wrap("No renamed taxonomy to show. Only renamed taxonomy of the last call of `as.mo()` or any `mo_*()` function are stored.\n", add_fn = font_blue))
     return(invisible(NULL))
   }
 

R/mo_source.R

@@ -129,7 +129,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
 
   meet_criteria(path, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(destination, allow_class = "character", has_length = 1)
-  stop_ifnot(destination %like% "[.]rds$", "the {.arg destination} must be a file location with file extension .rds.")
+  stop_ifnot(destination %like% "[.]rds$", "the `destination` must be a file location with file extension .rds.")
   mo_source_destination <- path.expand(destination)
 
   if (is.null(path) || path %in% c(FALSE, "")) {
@@ -137,6 +137,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
     if (file.exists(mo_source_destination)) {
       unlink(mo_source_destination)
       message_("Removed mo_source file '", font_bold(mo_source_destination), "'",
+        add_fn = font_red,
         as_note = FALSE
       )
     }
@@ -249,7 +250,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 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 `set_mo_source()` on this file. In any case, the option `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))

R/sir.R

@@ -441,7 +441,7 @@ is_sir_eligible <- function(x, threshold = 0.05) {
     return(unname(vapply(FUN.VALUE = logical(1), x, is_sir_eligible)))
   }
 
-  stop_if(NCOL(x) > 1, "{.arg x} must be a one-dimensional vector.")
+  stop_if(NCOL(x) > 1, "`x` must be a one-dimensional vector.")
   if (any(c(
     "numeric",
     "integer",
@@ -529,10 +529,10 @@ as.sir.default <- function(x,
     if (all(x %unlike% "(S|I|R)", na.rm = TRUE) && !all(x %in% c(1, 2, 3, 4, 5), na.rm = TRUE)) {
       # check if they are actually MICs or disks
       if (all_valid_mics(x)) {
-        warning_("in {.help as.sir}: input values were guessed to be MIC values - preferably transform them with {.help as.mic} before running {.help as.sir}.")
+        warning_("in `as.sir()`: input values were guessed to be MIC values - preferably transform them with `as.mic()` before running `as.sir()`.")
         return(as.sir(as.mic(x), ...))
       } else if (all_valid_disks(x)) {
-        warning_("in {.help as.sir}: input values were guessed to be disk diffusion values - preferably transform them with {.help as.disk} before running {.help as.sir}.")
+        warning_("in `as.sir()`: input values were guessed to be disk diffusion values - preferably transform them with `as.disk()` before running `as.sir()`.")
         return(as.sir(as.disk(x), ...))
       }
     }
@@ -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 as.sir}: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE))
+        message_("in `as.sir()`: Interpreting input value ", vector_and(out[!is.na(out)], quotes = FALSE, sort = FALSE))
       }
 
       if (na_before != na_after) {
@@ -610,7 +610,7 @@ as.sir.default <- function(x,
           sort() %pm>%
           vector_and(quotes = TRUE)
         cur_col <- get_current_column()
-        warning_("in {.help as.sir}: ", na_after - na_before, " result",
+        warning_("in `as.sir()`: ", na_after - na_before, " result",
           ifelse(na_after - na_before > 1, "s", ""),
           ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
           " truncated (",
@@ -783,10 +783,10 @@ as.sir.data.frame <- function(x,
 
   # -- host
   if (missing(breakpoint_type) && any(host %in% clinical_breakpoints$host[!clinical_breakpoints$host %in% c("human", "ECOFF")], na.rm = TRUE)) {
-    if (isTRUE(info)) message_("Assuming {.code breakpoint_type = \"animal\"} since {.arg host} contains animal species.")
+    if (isTRUE(info)) message_("Assuming `breakpoint_type = \"animal\"` since `host` contains animal species.")
     breakpoint_type <- "animal"
   } else if (any(!suppressMessages(convert_host(host, lang = language)) %in% c("human", "ECOFF"), na.rm = TRUE)) {
-    if (isTRUE(info)) message_("Assuming {.code breakpoint_type = \"animal\"}.")
+    if (isTRUE(info)) message_("Assuming `breakpoint_type = \"animal\"`.")
     breakpoint_type <- "animal"
   }
   if (breakpoint_type == "animal") {
@@ -883,7 +883,7 @@ as.sir.data.frame <- function(x,
   types[types == "" & !vapply(FUN.VALUE = logical(1), x.bak[, ab_cols, drop = FALSE], is.sir)] <- "sir"
   if (any(types %in% c("mic", "disk"), na.rm = TRUE)) {
     # now we need an mo column
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+    stop_if(is.null(col_mo), "`col_mo` must be set")
     # if not null, we already found it, now find again so a message will show
     if (is.null(col_mo.bak)) {
       col_mo <- search_type_in_df(x = x, type = "mo", info = info)
@@ -898,7 +898,7 @@ as.sir.data.frame <- function(x,
     cl <- tryCatch(parallel::makeCluster(n_cores, type = "PSOCK"),
       error = function(e) {
         if (isTRUE(info)) {
-          message_("Could not create parallel cluster, using single-core computation. Error message: ", conditionMessage(e))
+          message_("Could not create parallel cluster, using single-core computation. Error message: ", conditionMessage(e), add_fn = font_red)
         }
         return(NULL)
       }
@@ -1029,14 +1029,14 @@ as.sir.data.frame <- function(x,
     if (isTRUE(info)) {
       message_(font_green_bg(" DONE "), as_note = FALSE)
       message()
-      message_("Run {.help sir_interpretation_history} to retrieve a logbook with all details of the breakpoint interpretations.")
+      message_("Run `sir_interpretation_history()` to retrieve a logbook with all details of the breakpoint interpretations.", add_fn = font_green)
     }
   } 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_("Running in sequential mode. Consider setting {.arg parallel} to {.code TRUE} to speed up processing on multiple cores.\n")
+      message_("Running in sequential mode. Consider setting `parallel = TRUE` to speed up processing on multiple cores.\n", add_fn = font_red)
     }
     # this will contain a progress bar already
     result_list <- lapply(seq_along(ab_cols), run_as_sir_column)
@@ -1168,13 +1168,13 @@ as_sir_method <- function(method_short,
   dots <- list(...)
   dots <- dots[which(!names(dots) %in% c("warn", "mo.bak", "is_data.frame"))]
   if (length(dots) != 0) {
-    warning_("These arguments in {.help as.sir} are no longer used: ", vector_and(names(dots), quotes = "`"), ".", call = FALSE)
+    warning_("These arguments in `as.sir()` are no longer used: ", vector_and(names(dots), quotes = "`"), ".", call = FALSE)
   }
 
   current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history)
 
   if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) {
-    message_("Run {.help sir_interpretation_history} afterwards to retrieve a logbook with all details of the breakpoint interpretations.\n\n")
+    message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all details of the breakpoint interpretations.\n\n", add_fn = font_green)
   }
 
   current_df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL)
@@ -1190,13 +1190,13 @@ as_sir_method <- function(method_short,
     if (is.null(host)) {
       host <- "dogs"
       if (isTRUE(info) && message_not_thrown_before("as.sir", "host_missing")) {
-        message_("Animal hosts not set in {.arg host}, assuming {.code host = \"dogs\"}, since these have the highest breakpoint availability.\n\n")
+        message_("Animal hosts not set in `host`, assuming `host = \"dogs\"`, since these have the highest breakpoint availability.\n\n")
       }
     }
   } else {
     if (!is.null(host) && !all(toupper(as.character(host)) %in% c("HUMAN", "ECOFF"))) {
       if (isTRUE(info) && message_not_thrown_before("as.sir", "assumed_breakpoint_animal")) {
-        message_("Assuming {.code breakpoint_type = \"animal\"}, since {.arg host} is set.", ifelse(guideline_coerced %like% "EUCAST", " Do you also need to set {.code guideline = \"CLSI\"}?", ""), "\n\n")
+        message_("Assuming `breakpoint_type = \"animal\"`, since `host` is set.", ifelse(guideline_coerced %like% "EUCAST", " Do you also need to set `guideline = \"CLSI\"`?", ""), "\n\n")
       }
       breakpoint_type <- "animal"
     } else {
@@ -1276,7 +1276,7 @@ as_sir_method <- function(method_short,
     mo_var_found <- ""
   }
   if (is.null(mo)) {
-    stop_("No information was supplied about the microorganisms (missing argument {.arg mo} and no column of class 'mo' found). See {.help as.sir}.\n\n",
+    stop_("No information was supplied about the microorganisms (missing argument `mo` and no column of class 'mo' found). See ?as.sir.\n\n",
       "To transform certain columns with e.g. mutate(), use `data %>% mutate(across(..., as.sir, mo = x))`, where x is your column with microorganisms.\n",
       "To transform all ", method_long, " in a data set, use `data %>% as.sir()` or `data %>% mutate_if(is.", method_short, ", as.sir)`.",
       call = FALSE
@@ -1312,7 +1312,7 @@ as_sir_method <- function(method_short,
 
 
   if (length(ab) == 1 && ab %like% paste0("as.", method_short)) {
-    stop_("No unambiguous name was supplied about the antibiotic (argument {.arg ab}). See {.help as.sir}.", call = FALSE)
+    stop_("No unambiguous name was supplied about the antibiotic (argument `ab`). See ?as.sir.", call = FALSE)
   }
 
   ab.bak <- trimws2(ab)
@@ -1328,7 +1328,8 @@ as_sir_method <- function(method_short,
   if (all(is.na(ab))) {
     if (isTRUE(info)) {
       message_("Returning NAs for unknown antibiotic: ", vector_and(ab.bak, sort = FALSE, quotes = TRUE),
-        ". Rename this column to a valid name or code, and check the output with {.help as.ab}.",
+        ". Rename this column to a valid name or code, and check the output with `as.ab()`.",
+        add_fn = font_red,
         as_note = FALSE
       )
     }
@@ -1352,7 +1353,9 @@ 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 as.sir}: using {.arg add_intrinsic_resistance} is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
+      message_("in `as.sir()`: using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.",
+        add_fn = font_red
+      )
     }
   }
 
@@ -1944,7 +1947,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(word_wrap("  ", AMR_env$bullet_icon, " ", notes[i], add_fn = font_black))
         }
       } 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))
@@ -1988,7 +1991,7 @@ sir_interpretation_history <- function(clean = FALSE) {
 #' @noRd
 print.sir_log <- function(x, ...) {
   if (NROW(x) == 0) {
-    message_("No results to print. First run {.help as.sir} on MIC values or disk diffusion zones (or on a {.cls data.frame} containing any of these) to print a 'logbook' data set here.")
+    message_("No results to print. First run `as.sir()` on MIC values or disk diffusion zones (or on a `data.frame` containing any of these) to print a 'logbook' data set here.")
     return(invisible(NULL))
   }
   class(x) <- class(x)[class(x) != "sir_log"]
@@ -2227,10 +2230,10 @@ 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 'clinical_breakpoints' data set.", call = .call_depth)
+      stop_("`reference_data` must have the same column names as the 'clinical_breakpoints' data set.", call = .call_depth)
     }
     if (!all(class_sir == class_ref)) {
-      stop_("{.arg reference_data} must be the same structure as the '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)
+      stop_("`reference_data` must be the same structure as the '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)
     }
   }
 }

R/translate.R

@@ -249,7 +249,7 @@ translate_into_language <- function(from,
   any_form_in_patterns <- tryCatch(
     any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")),
     error = function(e) {
-      warning_("Translation not possible. Please create an issue at {.url https://github.com/msberends/AMR/issues}. Many thanks!")
+      warning_("Translation not possible. Please create an issue at ", font_url("https://github.com/msberends/AMR/issues"), ". Many thanks!")
       return(FALSE)
     }
   )
@@ -293,11 +293,11 @@ translate_into_language <- function(from,
   out <- from_unique_translated[match(from.bak, from_unique)]
 
   if (!identical(from.bak, out) && get_AMR_locale() == lang && is.null(getOption("AMR_locale", default = NULL)) && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
-    message(font_blue(word_wrap(
+    message(word_wrap(
       "Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
       LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this once-per-session note.",
-      as_note = TRUE
-    )))
+      add_fn = list(font_blue), as_note = TRUE
+    ))
   }
 
   out

R/zzz.R

@@ -118,7 +118,8 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
   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."
+        "Assuming ", AMR::clinical_breakpoints$guideline[1], " as the default AMR guideline, see `?AMR-options` to change this.",
+        add_fn = NULL
       )
     )
   }

_pkgdown.yml

@@ -245,14 +245,12 @@ reference:
 
   - title: "Other: miscellaneous functions"
     desc: >
-      Miscellaneous functions that support various parts of an AMR analysis,
-      such as working with ages, joining tables, principal component analysis,
-      and other utilities. Especially the 'like' function can be useful:
-      `if (x %like% y) {...}`.
+      These functions are mostly for internal use, but some of
+      them may also be suitable for your analysis. Especially the
+      'like' function can be useful: `if (x %like% y) {...}`.
     contents:
     - "`age_groups`"
     - "`age`"
-    - "`amr_course`"
     - "`export_ncbi_biosample`"
     - "`availability`"
     - "`get_AMR_locale`"

man/amr_course.Rd

@@ -1,36 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/amr_course.R
-\name{amr_course}
-\alias{amr_course}
-\title{Download and Unpack an AMR Course Repository}
-\usage{
-amr_course(github_repo, branch = "main", ...)
-}
-\arguments{
-\item{github_repo}{A character string specifying the GitHub repository with username and repo name, e.g. \code{"https://github.com/username/repo"}.}
-
-\item{branch}{A character string specifying the branch to download. Defaults to \code{"main"}.}
-
-\item{...}{Additional arguments passed on to \code{\link[usethis:zip-utils]{usethis::use_course()}}.}
-}
-\value{
-Called for its side effect. \code{\link[usethis:zip-utils]{usethis::use_course()}} will prompt the user to choose a destination and open the extracted project. Returns invisibly whatever \code{\link[usethis:zip-utils]{usethis::use_course()}} returns.
-}
-\description{
-Downloads and unpacks a GitHub repository containing course materials, using \code{\link[usethis:zip-utils]{usethis::use_course()}}. This is a convenience wrapper intended for use in educational settings, such as workshops or tutorials associated with the AMR package.
-}
-\details{
-This function constructs a ZIP archive URL from the provided \code{github_repo} and \code{branch}, then delegates to \code{\link[usethis:zip-utils]{usethis::use_course()}} to handle the download and extraction.
-
-The function is designed for interactive use in course or workshop settings and is not intended for use in non-interactive or automated pipelines.
-}
-\examples{
-\dontrun{
-
-# Let this run by users, e.g., webinar participants
-amr_course("https://github.com/my_user_name/our_AMR_course")
-}
-}
-\seealso{
-\code{\link[usethis:zip-utils]{usethis::use_course()}}
-}

man/interpretive_rules.Rd

@@ -76,6 +76,10 @@ eucast_dosage(ab, administration = "iv", version_breakpoints = 15)
 The input of \code{x}, possibly with edited values of antimicrobials. Or, if \code{verbose = TRUE}, a \link{data.frame} with all original and new values of the affected bug-drug combinations.
 }
 \description{
+\strong{WORK IN PROGRESS}
+
+\strong{The \code{interpretive_rules()} function is new, to allow CLSI 'rules' too. The old \code{eucast_rules()} function will stay as a wrapper, but we need to generalise more parts of the underlying code to allow more than just EUCAST.}
+
 Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by e.g. the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{https://www.eucast.org}), see \emph{Source}. Use \code{\link[=eucast_dosage]{eucast_dosage()}} to get a \link{data.frame} with advised dosages of a certain bug-drug combination, which is based on the \link{dosage} data set.
 
 To improve the interpretation of the antibiogram before CLSI/EUCAST interpretive rules are applied, some AMR-specific rules can be applied at default, see \emph{Details}.