update sir to include interpretation details

.Rbuildignore

@@ -9,13 +9,8 @@
 ^_pkgdown\.yml$
 ^appveyor\.yml$
 ^codecov\.yml$
-^CLAUDE\.md$
-^\.claude$
 ^cran-comments\.md$
-^release\.md$
 ^CRAN-RELEASE$
-index\.html
-README\.html
 ^\.github$
 ^doc$
 ^docs$
@@ -45,5 +40,3 @@ README\.html
 ^CRAN-SUBMISSION$
 ^PythonPackage$
 ^README\.Rmd$
-^tools$
-\.no_include$

.github/ISSUE_TEMPLATE/1-bug-report.yml

@@ -22,9 +22,9 @@ body:
       label: Minimal Reproducible Example (optional)
       description: Please include a short R code snippet that reproduces the problem, if possible.
       placeholder: 
-        e.g.  
-        ```r  
-        ab_name("amoxicillin/clavulanic acid", language = "es")  
+        e.g.
+        ```r
+        ab_name("amoxicillin/clavulanic acid", language = "es")
         ```
     validations:
       required: false
@@ -42,7 +42,7 @@ body:
       multiple: false
       options:
         - ''
-        - Latest CRAN version (3.1.0)
-        - One of the latest GitHub versions (3.1.0.9xxx)
+        - Latest CRAN version (3.0.0)
+        - One of the latest GitHub versions (3.0.0.9xxx)
     validations:
       required: true

.github/prehooks/commit-msg

@@ -14,7 +14,7 @@
 # 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      #
+# 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   #

.github/prehooks/pre-commit

@@ -14,7 +14,7 @@
 # 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      #
+# 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   #
@@ -48,6 +48,7 @@ echo "Running prehook..."
 if command -v Rscript > /dev/null; then
   if [ "$(Rscript -e 'cat(all(c('"'pkgload'"', '"'devtools'"', '"'dplyr'"') %in% rownames(installed.packages())))')" = "TRUE" ]; then
     Rscript -e "source('data-raw/_pre_commit_checks.R')"
+    currentpkg=$(Rscript -e "cat(pkgload::pkg_name())")
     echo "- Adding changed files in ./data-raw and ./man to this commit"
     git add data-raw/*
     git add data/*
@@ -56,9 +57,11 @@ if command -v Rscript > /dev/null; then
     git add NAMESPACE
   else
     echo "- R package 'pkgload', 'devtools', or 'dplyr' not installed!"
+    currentpkg="your"
   fi
 else
   echo "- R is not available on your system!"
+  currentpkg="your"
 fi
 echo ""
 
@@ -89,7 +92,7 @@ else
   
   # Combine tag and commit number
   currentversion="$currenttag.$((currentcommit + 9001))"
-  echo "- AMR pkg version set to ${currentversion}"
+  echo "- ${currentpkg} pkg version set to ${currentversion}"
   
   # Update version number and date in DESCRIPTION
   sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
@@ -100,7 +103,10 @@ else
   
   # Update version number in NEWS.md
   if [ -e "NEWS.md" ]; then
-    sed -i -- "1s/.*/# AMR ${currentversion}/" NEWS.md
+    if [ "$currentpkg" = "your" ]; then
+      currentpkg=""
+    fi
+    sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
     echo "- Updated version number in ./NEWS.md"
     rm -f NEWS.md--
     git add NEWS.md

.github/scripts/check_revdeps.R

@@ -1,87 +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              #
-# ==================================================================== #
-
-# Run R CMD check on all CRAN packages that depend on AMR, against the INSTALLED development version of AMR.
-# Used by .github/workflows/check-revdeps.yaml; run from the root of the repository, after installing AMR from it:
-#   Rscript .github/scripts/check_revdeps.R
-# Fails if any reverse dependency returns an ERROR or WARNING.
-
-# only CRAN, also when other repositories are set, since this is about CRAN releases
-repos <- c(CRAN = "https://cloud.r-project.org")
-db <- utils::available.packages(repos = repos)
-revdeps <- sort(tools::package_dependencies("AMR", db = db, reverse = TRUE, which = "all")[["AMR"]])
-if (length(revdeps) == 0) {
-  message("No reverse dependencies on CRAN")
-  quit(status = 0)
-}
-message("Reverse dependencies: ", paste(revdeps, collapse = ", "))
-
-# all dependencies of the reverse dependencies, but never AMR itself, which is the development version installed from this repository
-deps <- unique(unlist(tools::package_dependencies(revdeps, db = db, which = "all"), use.names = FALSE))
-base_pkgs <- rownames(utils::installed.packages(priority = "base"))
-deps <- setdiff(deps, c("AMR", base_pkgs, rownames(utils::installed.packages())))
-if (length(deps) > 0) {
-  # pak also installs the system requirements of these packages
-  tryCatch(pak::pkg_install(deps, upgrade = FALSE), error = function(e) {
-    message("pak failed (", conditionMessage(e), "), falling back to install.packages()")
-    utils::install.packages(deps)
-  })
-}
-amr_version <- read.dcf("DESCRIPTION", fields = "Version")[1, 1]
-if (as.character(utils::packageVersion("AMR")) != amr_version) {
-  stop("installed AMR is v", utils::packageVersion("AMR"), ", expected the development version v", amr_version)
-}
-message("Checking against AMR v", amr_version)
-
-check_dir <- file.path(tempdir(), "revdeps")
-dir.create(check_dir, showWarnings = FALSE)
-tarballs <- utils::download.packages(revdeps, destdir = check_dir, repos = repos, type = "source")[, 2]
-
-results <- vapply(tarballs, FUN.VALUE = character(1), function(tarball) {
-  pkg <- sub("_.*", "", basename(tarball))
-  message("\n=== Checking ", pkg, " ===")
-  out <- suppressWarnings(system2(
-    file.path(R.home("bin"), "R"),
-    c("CMD", "check", "--no-manual", "--as-cran", "-o", shQuote(check_dir), shQuote(tarball)),
-    stdout = TRUE,
-    stderr = TRUE,
-    # skip the incoming checks for CRAN submission, which concern the maintainers of the reverse dependencies
-    env = c("_R_CHECK_FORCE_SUGGESTS_=false", "_R_CHECK_CRAN_INCOMING_=false")
-  ))
-  cat(out, sep = "\n")
-  status <- grep("^Status:", out, value = TRUE)
-  if (length(status) == 0) "ERROR (check did not finish)" else trimws(sub("^Status:", "", status[length(status)]))
-}, USE.NAMES = FALSE)
-names(results) <- revdeps
-
-message("\n=== Summary against AMR v", amr_version, " ===")
-message(paste0(format(names(results)), "  ", results, collapse = "\n"))
-if (any(grepl("ERROR|WARNING", results))) {
-  quit(status = 1)
-}

.github/scripts/run_tests.R

@@ -1,50 +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              #
-# ==================================================================== #
-
-# Runs all unit tests from source, see run_tests.sh. Quits with status 1 on any failure or error, and with status 2 if the tests could not be run at all.
-# Every top-level error must end in quit(), since an interactive session would otherwise continue reading "1" from stdin.
-
-status <- tryCatch(
-  {
-    if (identical(Sys.getenv("AMR_TEST_INTERACTIVE"), "true") && !interactive()) {
-      stop("AMR_TEST_INTERACTIVE is set, but this R session is not interactive")
-    }
-    cat("Interactive:", interactive(), "| LANG:", Sys.getenv("LANG"), "| AMR options:", paste(names(options())[grepl("^AMR_", names(options()))], collapse = ", "), "\n")
-    # report all failures, not only the first 10
-    options(warn = 1, testthat.summary.max_reports = Inf, testthat.progress.max_fails = Inf)
-    res <- as.data.frame(testthat::test_local(Sys.getenv("AMR_TEST_PKG_DIR", "."), reporter = "summary", stop_on_failure = FALSE))
-    cat("\nFiles:", length(unique(res$file)), "| failed:", sum(res$failed), "| errors:", sum(res$error), "| skipped:", sum(res$skipped), "| passed:", sum(res$passed), "\n")
-    as.integer(sum(res$failed) > 0 || any(res$error))
-  },
-  error = function(e) {
-    cat("Tests could not be run:", conditionMessage(e), "\n")
-    2L
-  }
-)
-quit(save = "no", status = status)

.github/scripts/run_tests.sh

@@ -1,51 +0,0 @@
-#!/bin/bash
-# ==================================================================== #
-# 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              #
-# ==================================================================== #
-
-# Runs an R script, in a real interactive R session if AMR_TEST_INTERACTIVE is "true", and exits with its status.
-# Usage: run_tests.sh <script.R>
-# R CMD check and Rscript are never interactive, so code behind interactive() is otherwise never run in CI.
-# In an interactive session, R reads both its commands and the answers to prompts from stdin, and it ignores -f. Therefore stdin holds one source() line, followed by an endless stream of "1", which means 'proceed' in every utils::menu() prompt of this package.
-# A timeout prevents an unanswerable prompt from hanging the job.
-
-set +e +o pipefail
-script="$(cd "$(dirname "$1")" && pwd)/$(basename "$1")"
-
-if [ "$AMR_TEST_INTERACTIVE" = "true" ]; then
-  { echo "source('$script')"; yes 1; } | timeout 3600 R --interactive --no-save --quiet
-  status=${PIPESTATUS[1]}
-else
-  timeout 3600 Rscript "$script"
-  status=$?
-fi
-
-if [ "$status" = "124" ]; then
-  echo "Timed out, possibly on a prompt that could not be answered"
-fi
-exit $status

.github/scripts/setup_test_scenario.R

@@ -1,67 +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              #
-# ==================================================================== #
-
-# Sets up the user environment of a test scenario in the home directory, before run_tests.sh runs the tests. Run it through run_tests.sh with AMR_TEST_INTERACTIVE=true, since set_mo_source() only works in interactive sessions.
-# AMR_TEST_SCENARIO can contain one or more of these words, separated by a comma:
-# - "user": an existing ~/mo_source.rds, and the options AMR_custom_ab and AMR_custom_mo set to RDS files
-# - "clsi": the option AMR_guideline set to "CLSI"
-# The options are written to ~/.Rprofile, so that they are set at start-up as with users.
-
-status <- tryCatch(
-  {
-    stopifnot(interactive())
-    scenarios <- trimws(strsplit(Sys.getenv("AMR_TEST_SCENARIO"), ",")[[1]])
-    stopifnot(length(scenarios) > 0, all(scenarios %in% c("user", "clsi")))
-    pkgload::load_all(Sys.getenv("AMR_TEST_PKG_DIR", "."), quiet = TRUE)
-    opts <- character(0)
-    if ("user" %in% scenarios) {
-      dir.create("~/amr_fixtures", showWarnings = FALSE)
-      write.csv(data.frame(lab_code = c("AMRTEST_ECOLI", "AMRTEST_SAUR"), mo = c("B_ESCHR_COLI", "B_STPHY_AURS")), "~/amr_fixtures/mo_source.csv", row.names = FALSE)
-      set_mo_source("~/amr_fixtures/mo_source.csv")
-      stopifnot(file.exists("~/mo_source.rds"))
-      saveRDS(data.frame(ab = "AMRTST", name = "Amrtestacillin", group = "Test antimicrobials"), "~/amr_fixtures/custom_ab.rds")
-      saveRDS(data.frame(genus = "Amrtestbacterium", species = "scenarii"), "~/amr_fixtures/custom_mo.rds")
-      opts <- c(opts, paste0("AMR_custom_ab = '", path.expand("~/amr_fixtures/custom_ab.rds"), "'"), paste0("AMR_custom_mo = '", path.expand("~/amr_fixtures/custom_mo.rds"), "'"))
-    }
-    if ("clsi" %in% scenarios) {
-      opts <- c(opts, "AMR_guideline = 'CLSI'")
-    }
-    if (length(opts) > 0) {
-      write(paste0("options(", paste(opts, collapse = ", "), ")"), "~/.Rprofile", append = TRUE)
-    }
-    cat("Scenario set up:", paste(scenarios, collapse = ", "), "\n")
-    if (file.exists("~/.Rprofile")) cat(readLines("~/.Rprofile"), sep = "\n")
-    0L
-  },
-  error = function(e) {
-    cat("Scenario could not be set up:", conditionMessage(e), "\n")
-    2L
-  }
-)
-quit(save = "no", status = status)

.github/scripts/test_installed_without.R

@@ -1,91 +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              #
-# ==================================================================== #
-
-# Run all unit tests and all examples against the INSTALLED AMR package, in a library where some suggested packages are not available.
-# Used by .github/workflows/check-without-dplyr.yaml; run from the root of the repository:
-#   Rscript .github/scripts/test_installed_without.R dplyr tidyselect
-# The package must have been installed BEFORE the listed packages were made unavailable, as binary packages from CRAN are built on machines that have all suggested packages: code that depends on what was available at installation (instead of at runtime) then fails, which R CMD check cannot detect as it reinstalls the package.
-
-unavailable <- commandArgs(trailingOnly = TRUE)
-if (length(unavailable) == 0) {
-  stop("provide the package(s) that must be unavailable, e.g.: Rscript test_installed_without.R dplyr tidyselect")
-}
-still_available <- unavailable[vapply(unavailable, requireNamespace, logical(1), quietly = TRUE)]
-if (length(still_available) > 0) {
-  stop("these packages must not be available, but are: ", paste(still_available, collapse = ", "))
-}
-cat("Not available:", paste(unavailable, collapse = ", "), "\n")
-cat("AMR", format(utils::packageVersion("AMR")), "installed in", find.package("AMR"), "\n\n")
-
-Sys.setenv(NOT_CRAN = "true")
-library(AMR)
-
-# 1. all unit tests, against the installed package
-cat("== Unit tests ==\n")
-results <- as.data.frame(testthat::test_dir(
-  "tests/testthat",
-  package = "AMR",
-  load_package = "installed",
-  reporter = "summary",
-  stop_on_failure = FALSE
-))
-n_failed <- sum(results$failed) + sum(results$error)
-cat("\nTests: ", sum(results$nb), " expectations, ", sum(results$failed), " failed, ", sum(results$error), " errored, ", sum(results$skipped), " skipped\n", sep = "")
-
-# 2. all examples, including \donttest{} (not \dontrun{}), against the installed package
-cat("\n== Examples ==\n")
-rd_db <- tools::Rd_db("AMR")
-failed_examples <- character(0)
-n_examples <- 0
-for (rd in sort(names(rd_db))) {
-  ex_file <- tempfile(fileext = ".R")
-  tools::Rd2ex(rd_db[[rd]], ex_file, commentDonttest = FALSE)
-  if (!file.exists(ex_file)) next
-  n_examples <- n_examples + 1
-  # print the name first, so that a crash of R itself shows which help page caused it
-  cat(rd, "\n")
-  ok <- tryCatch(
-    {
-      utils::capture.output(suppressMessages(suppressWarnings(source(ex_file, local = new.env(parent = globalenv()), echo = FALSE))))
-      TRUE
-    },
-    error = function(e) {
-      cat("FAILED: ", rd, ": ", conditionMessage(e), "\n", sep = "")
-      FALSE
-    }
-  )
-  if (!ok) failed_examples <- c(failed_examples, rd)
-  grDevices::graphics.off()
-}
-cat("Examples: ", length(failed_examples), " of ", n_examples, " help pages failed\n", sep = "")
-
-if (n_failed > 0 || length(failed_examples) > 0) {
-  stop(n_failed, " test(s) failed and ", length(failed_examples), " example(s) failed without ", paste(unavailable, collapse = " and "), call. = FALSE)
-}
-cat("\nAll tests and examples passed without ", paste(unavailable, collapse = " and "), ".\n", sep = "")

.github/workflows/check-current-testthat-dev-versions.yaml

@@ -1,83 +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              #
-# ==================================================================== #
-
-on:
-  push:
-    branches: [main]
-  schedule:
-    # also run a schedule everyday at 1 AM.
-    # this is to check that all dependencies are still available (see R/zzz.R)
-    - cron:  '0 1 * * *'
-
-name: check-recent-dev-pkgs
-
-jobs:
-  R-code-check:
-    runs-on: ${{ matrix.config.os }}
-
-    continue-on-error: ${{ matrix.config.allowfail }}
-
-    name: ${{ matrix.config.os }} (dev-pkgs)
-
-    strategy:
-      fail-fast: false
-      matrix:
-        config:
-          # current 'release' version on Ubuntu
-          - {os: ubuntu-latest,  r: 'release', allowfail: false}
-
-    env:
-      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-      R_KEEP_PKG_SOURCE: yes
-
-    steps:
-      - uses: actions/checkout@v4
-
-      - uses: r-lib/actions/setup-pandoc@v2
-
-      - uses: r-lib/actions/setup-r@v2
-        with:
-          r-version: ${{ matrix.config.r }}
-          use-public-rspm: false
-          extra-repositories: >
-            https://tidyverse.r-universe.dev
-            https://r-lib.r-universe.dev
-            https://tidymodels.r-universe.dev
-            https://yihui.r-universe.dev
-
-      - uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          extra-packages: any::rcmdcheck
-          needs: check
-          upgrade: 'TRUE'
-
-      - uses: r-lib/actions/check-r-package@v2
-        with:
-          upload-snapshots: true
-          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/check-current-testthat.yaml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -29,11 +29,10 @@
 
 on:
   pull_request:
-    # run in each PR in this repo (1 worker, see matrix logic below)
+    # run in each PR in this repo
     branches: '**'
   push:
-    # only on main; pushing to a PR branch is already covered by pull_request above
-    branches: [main]
+    branches: '**'
   schedule:
     # also run a schedule everyday at 1 AM.
     # this is to check that all dependencies are still available (see R/zzz.R)
@@ -41,47 +40,37 @@ on:
 
 name: check-recent
 
-# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push
-concurrency:
-  group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }}
-  cancel-in-progress: true
-
 jobs:
-  setup:
-    runs-on: ubuntu-latest
-    outputs:
-      matrix: ${{ steps.set-matrix.outputs.matrix }}
-    steps:
-      - id: set-matrix
-        shell: bash
-        # entries with "tests": true do not run R CMD check, but run the unit tests from source with .github/scripts/run_tests.sh, optionally:
-        # - "interactive": true, in a real interactive R session, so that code behind interactive() is also tested
-        # - "scenario", the user environment set up with .github/scripts/setup_test_scenario.R
-        # - "lang", the LANG environment variable
-        run: |
-          if [ "${{ github.event_name }}" = "pull_request" ]; then
-            echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive","interactive":true}]}' >> "$GITHUB_OUTPUT"
-          else
-            echo 'matrix={"config":[{"os":"windows-latest","r":"devel","allowfail":false},{"os":"ubuntu-latest","r":"devel","allowfail":false,"http-user-agent":"release"},{"os":"macOS-latest","r":"release","allowfail":true},{"os":"windows-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-1","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-2","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-3","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-4","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-5","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive","interactive":true},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive, user setup","interactive":true,"scenario":"user"},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"Dutch locale","lang":"nl_NL.UTF-8"},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"CLSI as default guideline","scenario":"clsi"}]}' >> "$GITHUB_OUTPUT"
-          fi
-
   R-code-check:
-    needs: setup
     runs-on: ${{ matrix.config.os }}
 
     continue-on-error: ${{ matrix.config.allowfail }}
 
-    name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})${{ matrix.config.label && format(' {0}', matrix.config.label) || '' }}
+    name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})
 
     strategy:
       fail-fast: false
-      matrix: ${{ fromJSON(needs.setup.outputs.matrix) }}
+      matrix:
+        config:
+          # current development version, check all major OSes:
+          # - {os: macOS-latest,   r: 'devel', allowfail: true}
+          - {os: windows-latest, r: 'devel', allowfail: false}
+          - {os: ubuntu-latest,  r: 'devel', allowfail: false, http-user-agent: 'release'}
+
+          # current 'release' version, check all major OSes:
+          - {os: macOS-latest,   r: 'release', allowfail: true}
+          - {os: windows-latest, r: 'release', allowfail: false}
+          - {os: ubuntu-latest,  r: 'release', allowfail: false}
+
+          # older versions (see also check-old-tinytest.yaml for even older versions):
+          - {os: ubuntu-latest, r: 'oldrel-1', allowfail: false}
+          - {os: ubuntu-latest, r: 'oldrel-2', allowfail: false}
+          - {os: ubuntu-latest, r: 'oldrel-3', allowfail: false}
+          - {os: ubuntu-latest, r: 'oldrel-4', allowfail: false}
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
-      AMR_TEST_INTERACTIVE: ${{ matrix.config.interactive && 'true' || 'false' }}
-      AMR_TEST_SCENARIO: ${{ matrix.config.scenario || '' }}
 
     steps:
       - uses: actions/checkout@v4
@@ -97,33 +86,11 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          # pak solves all suggested packages as one set and fails as a whole if one of them requires a newer R, so such packages are ignored on older R versions (with `pkg=?ignore-before-r=x.y.z`) and the checks run without them
-          extra-packages: ${{ matrix.config.tests && 'any::pkgload' || 'any::rcmdcheck' }} readxl=?ignore-before-r=4.2.0
+          extra-packages: any::rcmdcheck
           needs: check
           upgrade: 'TRUE'
 
-      - name: Set LANG
-        if: matrix.config.lang
-        # the package reads the language from LANG, while R needs a locale that is installed on the runner, so LC_ALL is set to the UTF-8 locale that is always available
-        run: |
-          echo "LANG=${{ matrix.config.lang }}" >> "$GITHUB_ENV"
-          echo "LC_ALL=C.UTF-8" >> "$GITHUB_ENV"
-
-      - name: Set up scenario '${{ matrix.config.scenario }}'
-        if: matrix.config.scenario
-        run: AMR_TEST_INTERACTIVE=true .github/scripts/run_tests.sh .github/scripts/setup_test_scenario.R
-
-      - name: Run unit tests
-        if: matrix.config.tests
-        env:
-          NOT_CRAN: true
-        run: .github/scripts/run_tests.sh .github/scripts/run_tests.R
-
       - uses: r-lib/actions/check-r-package@v2
-        if: ${{ !matrix.config.tests }}
-        env:
-          # suggested packages ignored on older R versions (see above) must not fail the check
-          _R_CHECK_FORCE_SUGGESTS_: false
         with:
           upload-snapshots: true
           build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/check-old-tinytest.yaml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -29,8 +29,8 @@
 
 on:
   push:
-     # only run after a git push on the main branch
-    branches: [main]
+     # only run after a git push on any branch in this repo
+    branches: '**'
 
 name: check-old
 
@@ -48,17 +48,14 @@ jobs:
         config:
           # Test all old versions of R >= 3.0, we support them all!
           # For these old versions, dependencies and vignettes will not be checked.
-          # For recent R versions, see check-current-testthat.yaml (r-lib and tidyverse support the latest 5 major R releases).
-          # R 4.0 (oldrel-6) is tested here, since current testthat and its dependencies cannot be installed on it.
-          - {os: ubuntu-latest, r: '4.0', allowfail: false}
-          # - {os: ubuntu-latest, r: '3.6', allowfail: false}
-          # - {os: windows-latest, r: '3.5', allowfail: false} # always fails, horrible with UTF-8
-          # - {os: ubuntu-latest, r: '3.4', allowfail: false}  # 3.1-3.4 now always fails with Error in grep(warn_re, lines, invert = TRUE, value = TRUE) attempt to set index 46/46 in SET_STRING_ELT
-          # - {os: ubuntu-latest, r: '3.3', allowfail: false}
-          # - {os: ubuntu-latest, r: '3.2', allowfail: false}
-          # - {os: ubuntu-latest, r: '3.1', allowfail: false}
-          # R 3.0 cannot be resolved for ubuntu-latest (Ubuntu 26.04), so use Ubuntu 24.04
-          - {os: ubuntu-24.04, r: '3.0', allowfail: false}
+          # For recent R versions, see check-recent.yaml (r-lib and tidyverse support the latest 5 major R releases).
+          - {os: ubuntu-latest, r: '3.6', allowfail: false}
+          # - {os: windows-latest, r: '3.5', allowfail: true} # always fails, horrible with UTF-8
+          - {os: ubuntu-latest, r: '3.4', allowfail: false}
+          - {os: ubuntu-latest, r: '3.3', allowfail: false}
+          - {os: ubuntu-latest, r: '3.2', allowfail: false}
+          - {os: ubuntu-latest, r: '3.1', allowfail: false}
+          - {os: ubuntu-latest, r: '3.0', allowfail: false}
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
@@ -80,16 +77,9 @@ jobs:
       - uses: r-lib/actions/setup-pandoc@v2
 
       - name: Install tinytest from CRAN
-        # R < 3.2 cannot download over HTTPS, so install.packages() fails silently on CRAN;
-        # download the source with curl instead (suggested packages require much newer R versions anyway)
         run: |
-          set -euo pipefail
-          mkdir -p "$R_LIBS_USER"
-          pkg=$(curl -sSL https://cran.r-project.org/src/contrib/ | grep -oE 'tinytest_[0-9.-]+\.tar\.gz' | head -1)
-          curl -sSLo "/tmp/$pkg" "https://cran.r-project.org/src/contrib/$pkg"
-          R CMD INSTALL -l "$R_LIBS_USER" "/tmp/$pkg"
-          Rscript -e "library(tinytest, lib.loc = Sys.getenv('R_LIBS_USER'))"
-        shell: bash
+          install.packages("tinytest", repos = "https://cran.r-project.org")
+        shell: Rscript {0}
 
       - name: Show session info
         if: always()

.github/workflows/check-without-dplyr.yaml

@@ -1,121 +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              #
-# ==================================================================== #
-
-# The AMR package must work fully without dplyr (and without tidyselect), as dplyr is only suggested.
-# This workflow mimics a user who installs the CRAN binary (built on a machine with ALL suggested packages) but does not have dplyr: AMR is installed while dplyr and tidyselect are available, after which they and all packages depending on them are removed, and all unit tests and all examples are run against the installed package. R CMD check cannot detect these problems, as it reinstalls the package itself.
-
-on:
-  pull_request:
-    # run in each PR in this repo
-    branches: '**'
-  push:
-    # only on main; pushing to a PR branch is already covered by pull_request above
-    branches: [main]
-  schedule:
-    # also run a schedule everyday at 2 AM
-    - cron:  '0 2 * * *'
-
-name: check-without-dplyr
-
-# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push
-concurrency:
-  group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }}
-  cancel-in-progress: true
-
-jobs:
-  setup:
-    runs-on: ubuntu-latest
-    outputs:
-      matrix: ${{ steps.set-matrix.outputs.matrix }}
-    steps:
-      - id: set-matrix
-        shell: bash
-        run: |
-          if [ "${{ github.event_name }}" = "pull_request" ]; then
-            echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","unavailable":"dplyr tidyselect"},{"os":"ubuntu-latest","r":"release","unavailable":"dplyr"}]}' >> "$GITHUB_OUTPUT"
-          else
-            echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","unavailable":"dplyr tidyselect"},{"os":"ubuntu-latest","r":"release","unavailable":"dplyr"},{"os":"ubuntu-latest","r":"oldrel-1","unavailable":"dplyr tidyselect"},{"os":"windows-latest","r":"release","unavailable":"dplyr tidyselect"}]}' >> "$GITHUB_OUTPUT"
-          fi
-
-  R-without-dplyr:
-    needs: setup
-    runs-on: ${{ matrix.config.os }}
-
-    name: ${{ matrix.config.os }} (R-${{ matrix.config.r }}) without ${{ matrix.config.unavailable }}
-
-    strategy:
-      fail-fast: false
-      matrix: ${{ fromJSON(needs.setup.outputs.matrix) }}
-
-    env:
-      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-      UNAVAILABLE: ${{ matrix.config.unavailable }}
-
-    steps:
-      - uses: actions/checkout@v4
-
-      - uses: r-lib/actions/setup-r@v2
-        with:
-          r-version: ${{ matrix.config.r }}
-          # use RStudio Package Manager to quickly install packages
-          use-public-rspm: true
-
-      - uses: r-lib/actions/setup-r-dependencies@v2
-        with:
-          # all dependencies, including suggested packages such as dplyr and tidyselect
-          dependencies: '"all"'
-          extra-packages: any::testthat
-
-      - name: Install AMR while dplyr and tidyselect are available
-        shell: Rscript {0}
-        run: |
-          stopifnot(requireNamespace("dplyr", quietly = TRUE), requireNamespace("tidyselect", quietly = TRUE))
-          install.packages(".", repos = NULL, type = "source")
-          stopifnot(requireNamespace("AMR", quietly = TRUE))
-
-      - name: Remove ${{ matrix.config.unavailable }} and all packages depending on them
-        shell: Rscript {0}
-        run: |
-          remove <- strsplit(Sys.getenv("UNAVAILABLE"), " ", fixed = TRUE)[[1]]
-          ip <- utils::installed.packages()
-          rev <- tools::dependsOnPkgs(remove, dependencies = c("Depends", "Imports", "LinkingTo"), recursive = TRUE, installed = ip)
-          drop <- setdiff(unique(c(remove, rev)), "AMR")
-          stopifnot(!"testthat" %in% drop)
-          cat("Removing", length(drop), "packages:", paste(sort(drop), collapse = ", "), "\n")
-          for (i in which(ip[, "Package"] %in% drop)) {
-            utils::remove.packages(ip[i, "Package"], lib = ip[i, "LibPath"])
-          }
-          for (pkg in remove) {
-            if (requireNamespace(pkg, quietly = TRUE)) stop(pkg, " is still available")
-          }
-          stopifnot(requireNamespace("testthat", quietly = TRUE), requireNamespace("AMR", quietly = TRUE))
-
-      - name: Run all unit tests and examples against the installed package
-        shell: bash
-        run: Rscript .github/scripts/test_installed_without.R $UNAVAILABLE

.github/workflows/codecovr.yaml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -28,20 +28,13 @@
 # ==================================================================== #
 
 on:
-  pull_request:
-    # run on every PR update (once per push)
-    branches: '**'
   push:
-    # only on main; PR pushes are already covered by pull_request above
-    branches: [main]
+    branches: '**'
+  pull_request:
+    branches: '**'
 
 name: code-coverage
 
-# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push
-concurrency:
-  group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }}
-  cancel-in-progress: true
-
 jobs:
   code-coverage:
     runs-on: ubuntu-latest

.github/workflows/lintr.yaml

@@ -12,13 +12,13 @@
 # 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.                  #
+# 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.                                        #
+# 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.              #
@@ -27,27 +27,19 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-# Run R CMD check on all CRAN packages that depend on AMR, against the development version of AMR installed from this repository.
-# This is informative only: it is not a required check, so a failure does not block anything, but it shows which reverse dependencies break before a CRAN release.
-
 on:
   push:
-    # only on main
-    branches: [main]
-  # allow manual runs from the Actions tab
-  workflow_dispatch:
+    branches: '**'
+  pull_request:
+    branches: '**'
 
-name: check-revdeps
+name: lintr
 
 jobs:
-  check-revdeps:
+  lintr:
     runs-on: ubuntu-latest
-
-    name: Reverse dependencies (R-release)
-
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-
     steps:
       - uses: actions/checkout@v4
 
@@ -61,14 +53,33 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          # AMR has no hard dependencies; pak is used to install the dependencies of the reverse dependencies
-          dependencies: '"hard"'
-          extra-packages: any::pak
-
-      - name: Install AMR from this repository
-        shell: bash
-        run: R CMD INSTALL .
-
-      - name: Check reverse dependencies against the installed AMR
-        shell: bash
-        run: Rscript .github/scripts/check_revdeps.R
+          extra-packages: |
+            any::lintr
+            any::cyclocomp
+            any::roxygen2
+            any::devtools
+            any::usethis
+            
+      - name: Remove unneeded folders
+        run: |
+          # do not check these folders
+          rm -rf data-raw
+          rm -rf tests
+          rm -rf vignettes
+          
+      - name: Lint
+        run: |
+          # get ALL linters, not just default ones
+          linters <- getNamespaceExports(asNamespace("lintr"))
+          linters <- sort(linters[grepl("_linter$", linters)])
+          # lose deprecated
+          linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator|consecutive_stopifnot|no_tab|single_quotes|unnecessary_nested_if|unneeded_concatenation)_linter$", linters)]
+          linters <- linters[linters != "linter"]
+          # and the ones we find unnnecessary
+          linters <- linters[!grepl("^(commented_code|extraction_operator|implicit_integer|indentation|line_length|namespace|nonportable_path|object_length|object_name|object_usage|is)_linter$", linters)]
+          # put the functions in a list
+          linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
+          names(linters_list) <- linters
+          # run them all!
+          lintr::lint_package(linters = linters_list, exclusions = list("R/aa_helper_pm_functions.R"))
+        shell: Rscript {0}

.github/workflows/publish-to-pypi.yml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -39,7 +39,7 @@ jobs:
     runs-on: ubuntu-latest
     
     env:
-      GH_REPO_SCOPE: ${{ secrets.GH_REPO_SCOPE }}
+      PYPI_PAT: ${{ secrets.PYPI_PAT }}
     
     steps:
       - name: Checkout code
@@ -48,8 +48,7 @@ jobs:
       - name: Set up Python
         uses: actions/setup-python@v4
         with:
-          # Python 3.9 is not available for ubuntu-latest (Ubuntu 26.04)
-          python-version: '3.12'
+          python-version: '3.9'
         
       - name: Install build dependencies
         run: |
@@ -79,7 +78,6 @@ jobs:
           cd PythonPackage/AMR
           python -m twine upload --repository-url https://test.pypi.org/legacy/ dist/*
 
-      # TODO #319: support Miniconda and Anaconda too
       # - name: Set up Miniconda
       #   continue-on-error: true
       #   uses: conda-incubator/setup-miniconda@v2
@@ -119,7 +117,7 @@ jobs:
           rm -rf PythonPackage
 
           git init
-          git remote add origin https://$GH_REPO_SCOPE@github.com/msberends/AMR
+          git remote add origin https://$PYPI_PAT@github.com/msberends/AMR
           git checkout --orphan python-wrapper
           git config user.name "github-actions[bot]"
           git config user.email "github-actions[bot]@users.noreply.github.com"
@@ -127,4 +125,4 @@ jobs:
           git rm -rf . || true
           git add .
           git commit -m "Python wrapper update"
-          git push https://$GH_REPO_SCOPE@github.com/msberends/AMR.git python-wrapper --force
+          git push https://$PYPI_PAT@github.com/msberends/AMR.git python-wrapper --force

.github/workflows/renew-gpt-training-data.yml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -39,7 +39,7 @@ jobs:
     runs-on: ubuntu-latest
     
     env:
-      GH_REPO_SCOPE: ${{ secrets.GH_REPO_SCOPE }}
+      PYPI_PAT: ${{ secrets.PYPI_PAT }}
     
     steps:
       - name: Checkout code
@@ -63,4 +63,4 @@ jobs:
           git config user.email "github-actions[bot]@users.noreply.github.com"
           git add latest_training_data.txt
           git commit -m "GPT training data update"
-          git push https://$GH_REPO_SCOPE@github.com/msberends/amr-for-r-assistant.git main --force
+          git push https://$PYPI_PAT@github.com/msberends/amr-for-r-assistant.git main --force

.github/workflows/todo-tracker.yml

@@ -1,284 +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              #
-# ==================================================================== #
-
-on:
-  push:
-    branches: "main"
-
-name: Update TODO Tracker
-
-jobs:
-  update-todo:
-    runs-on: ubuntu-latest
-
-    steps:
-      - uses: actions/checkout@v4
-        with:
-          fetch-depth: 0  # full history required for git blame
-
-      - name: Generate TODO report
-        id: report
-        env:
-          GH_TOKEN: ${{ secrets.GH_REPO_SCOPE }}
-        run: |
-          set -euo pipefail
-          export TZ=Europe/Amsterdam
-
-          REPO="msberends/AMR"
-          REPO_URL="https://github.com/$REPO/blob/main"
-          NOW=$(date +%s)
-          LAST_UPDATED=$(date +"%e %B %Y %H:%M:%S %Z" | sed 's/^ *//')
-          STALE_DAYS=180
-
-          # ── helper: human-readable age ──────────────────────────────
-          format_age() {
-            local d=$1
-            if [ "$d" -lt 0 ] 2>/dev/null; then echo "unknown"; return; fi
-            local y=$((d / 365)) m=$(( (d % 365) / 30 ))
-            if [ "$y" -gt 0 ] && [ "$m" -gt 0 ]; then echo "${y}y ${m}m"
-            elif [ "$y" -gt 0 ]; then echo "${y}y"
-            elif [ "$m" -gt 0 ]; then echo "${m}m"
-            else echo "${d}d"
-            fi
-          }
-
-          export -f format_age
-
-          # ── step 1: find all markers ────────────────────────────────
-          grep -rn \
-            --include='*.R' --include='*.Rmd' --include='*.yaml' \
-            --include='*.yml' --include='*.md' --include='*.css' \
-            --include='*.js' \
-            --exclude='todo-tracker.yml' --exclude='todo.md' \
-            -E '\b(TODO|FIXME|HACK|XXX)\b' . \
-            | grep -vE '"XXX"' > /tmp/raw.txt || true
-
-          if [ ! -s /tmp/raw.txt ]; then
-            echo -e "## \`TODO\` Report\n\n**Last Updated: ${LAST_UPDATED}**\n\nNo markers found." > todo.md
-            echo "unlinked=0" >> "$GITHUB_OUTPUT"
-            exit 0
-          fi
-
-          # ── step 2: enrich with git blame & extract issue refs ──────
-          > /tmp/enriched.tsv
-          > /tmp/issues_seen.txt
-
-          while IFS= read -r match; do
-            clean=$(printf '%s\n' "$match" | sed 's|^\./||')
-            file=$(printf '%s\n' "$clean" | cut -d: -f1)
-            lineno=$(printf '%s\n' "$clean" | cut -d: -f2)
-            text=$(printf '%s\n' "$clean" | cut -d: -f3-)
-
-            # determine marker type (first match wins, TODO is default)
-            marker="TODO"
-            for m in FIXME HACK XXX; do
-              if printf '%s\n' "$text" | grep -qw "$m"; then marker="$m"; break; fi
-            done
-
-            # git blame timestamp
-            blame_ts=$(git blame -L "${lineno},${lineno}" --porcelain -- "$file" 2>/dev/null \
-              | awk '/^author-time/{print $2}' || echo "0")
-            blame_ts=${blame_ts:-0}
-
-            if [ "$blame_ts" -gt 0 ] 2>/dev/null; then
-              age_days=$(( (NOW - blame_ts) / 86400 ))
-            else
-              age_days=-1
-            fi
-
-            # extract issue references (#NNN)
-            issues=$(printf '%s\n' "$text" | grep -oE '#[0-9]+' | sed 's/#//' | tr '\n' ',' | sed 's/,$//' || true)
-            if [ -n "$issues" ]; then
-              for inum in $(echo "$issues" | tr ',' ' '); do
-                echo "$inum" >> /tmp/issues_seen.txt
-              done
-            fi
-
-            printf '%s\t%s\t%s\t%s\t%s\t%s\n' \
-              "$file" "$lineno" "$marker" "$age_days" "$issues" "$text" >> /tmp/enriched.tsv
-          done < /tmp/raw.txt
-
-          # ── step 3: query GitHub API for referenced issues ──────────
-          > /tmp/issue_info.tsv
-          if [ -s /tmp/issues_seen.txt ]; then
-            sort -un /tmp/issues_seen.txt | while read -r inum; do
-              info=$(gh api "/repos/$REPO/issues/$inum" \
-                --jq '"\(.state)\t\(.title)"' 2>/dev/null \
-                || echo "unknown	(could not fetch)")
-              printf '%s\t%s\n' "$inum" "$info" >> /tmp/issue_info.tsv
-            done
-          fi
-
-          # ── step 4: build the report ────────────────────────────────
-          {
-            # ── header ──
-            echo "## \`TODO\` Report"
-            echo ""
-            echo "**Last Updated: ${LAST_UPDATED}**"
-            echo ""
-            echo "_This overview is automatically updated on each push to \`main\`. It scans for \`TODO\`, \`FIXME\`, \`HACK\`, and \`XXX\` markers across the codebase._"
-            echo ""
-
-            # ── summary table ──
-            total=$(wc -l < /tmp/enriched.tsv | tr -d ' ')
-            files_affected=$(awk -F'\t' '{print $1}' /tmp/enriched.tsv | sort -u | wc -l | tr -d ' ')
-            todo_n=$(awk -F'\t' '$3=="TODO"' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            fixme_n=$(awk -F'\t' '$3=="FIXME"' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            hack_n=$(awk -F'\t' '$3=="HACK"' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            xxx_n=$(awk -F'\t' '$3=="XXX"' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            stale_n=$(awk -F'\t' -v s="$STALE_DAYS" '$4 > s' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            linked_n=$(awk -F'\t' '$5 != ""' /tmp/enriched.tsv | wc -l | tr -d ' ')
-            unlinked_n=$(awk -F'\t' '$5 == ""' /tmp/enriched.tsv | wc -l | tr -d ' ')
-
-            # oldest marker
-            oldest_line=$(awk -F'\t' '$4 >= 0' /tmp/enriched.tsv | sort -t$'\t' -k4 -rn | head -1)
-            oldest_days=$(echo "$oldest_line" | cut -f4)
-            oldest_file=$(echo "$oldest_line" | cut -f1)
-            oldest_lineno=$(echo "$oldest_line" | cut -f2)
-            oldest_age=$(format_age "$oldest_days")
-
-            echo "### Summary"
-            echo ""
-            echo "| Metric | Value |"
-            echo "|:---|---:|"
-            echo "| Total markers | **${total}** |"
-            [ "$todo_n" -gt 0 ] && echo "| \`TODO\` | ${todo_n} |"
-            [ "$fixme_n" -gt 0 ] && echo "| \`FIXME\` | ${fixme_n} |"
-            [ "$hack_n" -gt 0 ] && echo "| \`HACK\` | ${hack_n} |"
-            [ "$xxx_n" -gt 0 ] && echo "| \`XXX\` | ${xxx_n} |"
-            echo "| Files affected | ${files_affected} |"
-            echo "| Stale (> 6 months) | ${stale_n} |"
-            echo "| Oldest marker | ${oldest_age}, \`${oldest_file}\` L${oldest_lineno} |"
-            echo "| Linked to issues | ${linked_n} |"
-            echo "| Unlinked (no issue ref) | ${unlinked_n} |"
-            echo ""
-
-            # ── by referenced issue ──
-            if [ -s /tmp/issue_info.tsv ]; then
-              echo "### By Referenced Issue"
-              echo ""
-
-              has_closed=false
-
-              while IFS=$'\t' read -r inum state title; do
-                count=$(awk -F'\t' -v n="$inum" '$5 ~ "(^|,)"n"(,|$)"' /tmp/enriched.tsv | wc -l | tr -d ' ')
-                [ "$state" = "closed" ] && has_closed=true
-
-                state_icon=""
-                [ "$state" = "closed" ] && state_icon=" :warning:"
-
-                echo "<details><summary><b>#${inum}</b> (${state}): <i>${title}</i> &mdash; ${count} marker(s)${state_icon}</summary>"
-                echo ""
-
-                awk -F'\t' -v n="$inum" '$5 ~ "(^|,)"n"(,|$)"' /tmp/enriched.tsv \
-                | while IFS=$'\t' read -r f l m d refs txt; do
-                  age_str=$(format_age "$d")
-                  flag=""
-                  [ "$d" -gt "$STALE_DAYS" ] 2>/dev/null && flag=" :warning:"
-                  # re-read the actual source line and trim leading/trailing whitespace
-                  src_text=$(sed -n "${l}p" "$f" 2>/dev/null | sed 's/^[[:space:]]*//;s/[[:space:]]*$//' || true)
-                  echo "- [\`${f}\` L${l}](${REPO_URL}/${f}#L${l}) (${age_str} ago)${flag}"
-                  [ -n "$src_text" ] && echo "  \`${src_text}\`"
-                done
-
-                echo ""
-                echo "</details>"
-                echo ""
-              done < /tmp/issue_info.tsv
-
-              if [ "$has_closed" = true ]; then
-                echo "> **Warning:** some markers reference closed issues and may be stale."
-                echo ""
-              fi
-            fi
-
-            # ── by file ──
-            echo "### By File"
-            echo ""
-
-            prev_file=""
-            prev_lineno=-99
-
-            while IFS=$'\t' read -r file lineno marker age_days issues text; do
-              if [ "$file" != "$prev_file" ]; then
-                # close previous code block
-                if [ -n "$prev_file" ]; then
-                  echo '```'
-                  echo ""
-                fi
-
-                file_count=$(awk -F'\t' -v f="$file" '$1==f' /tmp/enriched.tsv | wc -l | tr -d ' ')
-                echo "#### [\`${file}\`](${REPO_URL}/${file}) &mdash; ${file_count} marker(s)"
-                echo '```r'
-
-                prev_lineno=-99
-              fi
-
-              # blank line between non-sequential lines (visual grouping)
-              if [ "$file" = "$prev_file" ] && [ $((lineno - prev_lineno)) -gt 1 ]; then
-                echo ""
-              fi
-
-              age_str=$(format_age "$age_days")
-              flag=""
-              [ "$age_days" -gt "$STALE_DAYS" ] 2>/dev/null && flag=" !!"
-
-              # re-read the actual source line to avoid TSV round-trip corruption
-              src_line=$(sed -n "${lineno}p" "$file" 2>/dev/null | sed 's/[[:space:]]*$//' || true)
-              printf 'L%s: %s  ◁ %s ago%s\n' "$lineno" "$src_line" "$age_str" "$flag"
-
-              prev_file="$file"
-              prev_lineno="$lineno"
-            done < <(sort -t$'\t' -k1,1 -k2,2n /tmp/enriched.tsv)
-
-            # close final code block
-            if [ -n "$prev_file" ]; then
-              echo '```'
-            fi
-
-          } > todo.md
-
-          echo "unlinked=$(awk -F'\t' '$5 == ""' /tmp/enriched.tsv | wc -l | tr -d ' ')" >> "$GITHUB_OUTPUT"
-
-      - name: Update GitHub issue
-        uses: peter-evans/create-or-update-comment@v4
-        with:
-          token: ${{ secrets.GH_REPO_SCOPE }}
-          issue-number: 231
-          comment-id: 3253439219
-          body-file: todo.md
-          edit-mode: replace
-
-      # runs after the issue update, so that the overview in #231 is always current
-      - name: Fail on markers without issue reference
-        if: steps.report.outputs.unlinked != '0'
-        run: |
-          echo "::error::${{ steps.report.outputs.unlinked }} TODO/FIXME/HACK/XXX marker(s) without an issue reference (#NNN):"
-          awk -F'\t' '$5 == "" {print $1 ":" $2 ":" $6}' /tmp/enriched.tsv
-          exit 1

.github/workflows/website.yaml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -42,15 +42,16 @@ jobs:
     runs-on: ubuntu-latest
     steps:
 
-      - name: checkout
-        uses: actions/checkout@v4
+      - uses: actions/checkout@v4
         with:
           # this is to keep timestamps, the default fetch-depth: 1 gets the timestamps of the moment of cloning
           # we need this for the download page on our website - dates must be of the files, not of the latest git push
           fetch-depth: 0
 
-      - name: restore timestamps
-        uses: chetan/git-restore-mtime-action@v2
+      - name: Preserve timestamps
+        run: |
+          sudo apt install git-restore-mtime
+          git restore-mtime
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.gitignore

@@ -1,6 +1,5 @@
 Meta
 doc
-docs
 .Renviron
 .Rproj.user
 .Rhistory
@@ -22,10 +21,11 @@ vignettes/*.R
 ^CRAN-RELEASE$
 packrat/lib*/
 packrat/src/
-*~$*
-data-raw/mo_update/
+data-raw/taxa.txt
+data-raw/taxon.tab
 data-raw/CLSI*.pdf
+data-raw/DSMZ_bactnames.xlsx
 data-raw/country_analysis_url_token.R
 data-raw/country_analysis2.R
-data-raw/lpsn_scrape_cache.rds
+data-raw/taxonomy.csv
 data-raw/WHONET/*

AMR.Rproj

@@ -2,7 +2,7 @@ Version: 1.0
 ProjectId: 5128c748-a412-44db-a5fb-45c68c93dd10
 
 RestoreWorkspace: No
-SaveWorkspace: Ask
+SaveWorkspace: No
 AlwaysSaveHistory: Yes
 
 EnableCodeIndexing: Yes

CLAUDE.md

@@ -1,235 +0,0 @@
-# CLAUDE.md — AMR R Package
-
-This file provides context for Claude Code when working in this repository.
-
-## Project Overview
-
-**AMR** is a zero-dependency R package for antimicrobial resistance (AMR) data analysis using a One Health approach. It is peer-reviewed, used in 175+ countries, and supports 28 languages.
-
-Key capabilities:
-- SIR (Susceptible/Intermediate/Resistant) classification using EUCAST 2011–2025 and CLSI 2011–2025 breakpoints
-- Antibiogram generation: traditional, combined, syndromic, and WISCA
-- Microorganism taxonomy database (~79,000 species)
-- Antimicrobial drug database (~620 drugs)
-- Multi-drug resistant organism (MDRO) classification
-- First-isolate identification
-- Minimum Inhibitory Concentration (MIC) and disk diffusion handling
-- Multilingual output (28 languages)
-
-## Common Commands
-
-All commands run inside an R session:
-
-```r
-# Rebuild documentation (roxygen2 → .Rd files + NAMESPACE)
-devtools::document()
-
-# Run all tests
-devtools::test()
-
-# Full package check (CRAN-level: docs + tests + checks)
-devtools::check()
-
-# Build pkgdown website locally
-pkgdown::build_site()
-
-# Code coverage report
-covr::package_coverage()
-```
-
-From the shell:
-
-```bash
-# CRAN check from parent directory
-R CMD check AMR
-```
-
-## Repository Structure
-
-```
-R/              # All R source files (62 files, ~28,000 lines)
-man/            # Auto-generated .Rd documentation (do not edit manually)
-tests/testthat/ # testthat test files (test-*.R) and helper-functions.R
-data/           # Pre-compiled .rda datasets
-data-raw/       # Scripts used to generate data/ files
-vignettes/      # Rmd vignette articles
-inst/           # Installed files (translations, etc.)
-_pkgdown.yml    # pkgdown website configuration
-```
-
-## R Source File Conventions
-
-**Naming conventions in `R/`:**
-
-| Prefix/Name | Purpose |
-|---|---|
-| `aa_*.R` | Loaded first (helpers, globals, options, package docs) |
-| `zz_deprecated.R` | Deprecated function wrappers |
-| `zzz.R` | `.onLoad` / `.onAttach` initialization |
-
-**Key source files:**
-
-- `aa_helper_functions.R` / `aa_helper_pm_functions.R` — internal utility functions (large; ~63 KB and ~37 KB)
-- `aa_globals.R` — global constants and breakpoint lookup structures
-- `aa_options.R` — `amr_options()` / `get_AMR_option()` system
-- `mo.R` / `mo_property.R` — microorganism lookup and properties
-- `ab.R` / `ab_property.R` — antimicrobial drug functions
-- `av.R` / `av_property.R` — antiviral drug functions
-- `sir.R` / `sir_calc.R` / `sir_df.R` — SIR classification engine
-- `mic.R` / `disk.R` — MIC and disk diffusion classes
-- `antibiogram.R` — antibiogram generation (traditional, combined, syndromic, WISCA)
-- `first_isolate.R` — first-isolate identification algorithms
-- `mdro.R` — MDRO classification (EUCAST, CLSI, CDC, custom guidelines)
-- `amr_selectors.R` — tidyselect helpers for selecting AMR columns
-- `interpretive_rules.R` / `custom_eucast_rules.R` — clinical interpretation rules
-- `translate.R` — 28-language translation system
-- `ggplot_sir.R` / `ggplot_pca.R` / `plotting.R` — visualisation functions
-
-## Code Style
-
-Follow the [tidyverse style guide](https://style.tidyverse.org/) precisely. Key rules:
-
-- 2-space indentation; no tabs
-- `<-` for assignment, not `=`
-- Spaces around all binary operators and after commas; no spaces inside parentheses
-- When a function call must break across lines, place the first argument on a new line indented by 2 spaces, and put the closing `)` on its own line — **never align arguments to the opening parenthesis** (no hanging/forced mid-line indentation)
-
-```r
-# good
-stop_(
-  "some long message part one ",
-  "part two"
-)
-
-# bad — forces indentation to match the opening parenthesis
-stop_("some long message part one ",
-      "part two")
-```
-
-## Custom S3 Classes
-
-The package defines five S3 classes with full print/format/plot/vctrs support:
-
-| Class | Created by | Represents |
-|---|---|---|
-| `<mo>` | `as.mo()` | Microorganism code |
-| `<ab>` | `as.ab()` | Antimicrobial drug code |
-| `<av>` | `as.av()` | Antiviral drug code |
-| `<sir>` | `as.sir()` | SIR value (S/I/R/SDD) |
-| `<mic>` | `as.mic()` | Minimum inhibitory concentration |
-| `<disk>` | `as.disk()` | Disk diffusion diameter |
-
-## Data Files
-
-Pre-compiled in `data/` (do not edit directly; regenerate via `data-raw/` scripts):
-
-| File | Contents |
-|---|---|
-| `microorganisms.rda` | ~79,000 microbial species with full taxonomy |
-| `antimicrobials.rda` | ~620 antimicrobial drugs with ATC codes |
-| `antivirals.rda` | Antiviral drugs |
-| `clinical_breakpoints.rda` | EUCAST + CLSI breakpoints (2011–2025) |
-| `intrinsic_resistant.rda` | Intrinsic resistance patterns |
-| `example_isolates.rda` | Example AMR dataset for documentation/testing |
-| `WHONET.rda` | Example WHONET-format dataset |
-
-## Zero-Dependency Design
-
-The package has **no `Imports`** in `DESCRIPTION`. All optional integrations (ggplot2, dplyr, data.table, tidymodels, cli, crayon, etc.) are listed in `Suggests` and guarded with:
-
-```r
-if (requireNamespace("pkg", quietly = TRUE)) { ... }
-```
-
-Never add packages to `Imports`. If new functionality requires an external package, add it to `Suggests` and guard usage appropriately.
-
-## Testing
-
-- **Framework:** `testthat` (R ≥ 3.1); legacy `tinytest` used for R 3.0–3.6 CI
-- **Test files:** `tests/testthat/test-*.R`
-- **Helpers:** `tests/testthat/helper-functions.R`
-- **CI matrix:** GitHub Actions across Windows / macOS / Linux × R devel / release / oldrel-1 through oldrel-4
-- **Coverage:** `covr` (some files excluded: `atc_online.R`, `mo_source.R`, `translate.R`, `resistance_predict.R`, `zz_deprecated.R`, helper files, `zzz.R`)
-
-## Documentation
-
-- All exported functions use **roxygen2** blocks (`RoxygenNote: 7.3.3`, markdown enabled)
-- Run `devtools::document()` after any change to roxygen comments
-- Never edit files in `man/` directly — they are auto-generated
-- Vignettes live in `vignettes/` as `.Rmd` files
-- The pkgdown website is configured in `_pkgdown.yml`
-
-## Versioning
-
-Version format: `major.minor.patch.dev` (e.g., `3.0.1.9021`)
-
-- Development versions use a `.9xxx` suffix
-- Stable CRAN releases drop the dev suffix (e.g., `3.0.1`)
-- `NEWS.md` follows the style of the v3.0.0 section; see *NEWS.md style* below
-
-### NEWS.md style
-
-Each version section follows the v3.0.0 section of `NEWS.md`:
-
-- After the `# AMR <version>` heading, an optional line on the planned release, then a short intro paragraph summarising the main changes in plain prose
-- Sub-headings, in this order and only when they have content: `### Breaking`, `### New`, `### Changed`, `### Other`
-- **Breaking**: changes that can alter results or break existing code (renamed or removed arguments, options or values, changed return values, new requirements); explain what changed and how to get the old behaviour
-- **New**: new functions, arguments, data sets, columns, selectors, antimicrobials and breakpoints, grouped under bold thematic bullets (e.g. `* **Updated clinical breakpoints**`) with nested bullets beneath; end with a `* **Other**` group for items that fit no theme
-- **Changed**: improvements and bug fixes together (there is no separate fixes section), grouped by function or data set as a plain parent bullet (e.g. ``* SIR interpretation (`as.sir()`)``, ``* `microorganisms` data set``) with nested bullets beneath; items that fit no group are single top-level bullets at the end
-- **Other**: documentation, vignettes, website, contributors and console output
-- Each function or data set gets exactly one group; never scatter entries for the same function (e.g. `as.mo()`) across the section
-- Bug fixes start with "Fixed ..." or state the corrected behaviour (e.g. "now returns `NA` with a warning instead of an error")
-- Write descriptive, complete sentences, in British English; a single-sentence bullet has no final full stop, a bullet of several sentences ends with one
-- Use "e.g.," and "i.e.,", backticks for code, functions with `()`, and italics for taxonomic names
-- Add GitHub issue references at the end of the item, as `(#NNN)` or `(#NNN, #NNN)`
-- Never use em dashes
-
-### Local commits on `main`: never touch the version number
-
-When committing directly on `main` in a local clone, **never** edit the `Version:` or `Date:` field in `DESCRIPTION`, nor line 1 of `NEWS.md`, and do not add a version prefix to the commit message. The git hooks in `.github/prehooks/` do this on every commit to `main`: `pre-commit` sets the version (the number of commits since the last tag before the new commit, + 9001) and date in `DESCRIPTION` and line 1 of `NEWS.md`, and `commit-msg` prepends `(vX.Y.Z.9NNN)` to the commit message. Adding NEWS bullets is still allowed. The section below applies only to PRs.
-
-### Version and date bump required for every PR
-
-All PRs are **squash-merged**, so each PR lands as exactly **one commit** on the default branch. Version numbers are kept in sync with the cumulative commit count since the last released tag. Therefore **exactly one version bump is allowed per PR**, regardless of how many intermediate commits are made on the branch.
-
-#### Computing the correct version number
-
-**First, ensure `git` and `gh` are installed** — both are required for the version computation and for pushing changes. Install them if missing before doing anything else:
-
-```bash
-which git || apt-get install -y git
-which gh   || apt-get install -y gh
-# Also ensure all tags are fetched so git describe works
-git fetch --tags
-```
-
-Then run the following from the repo root to determine the version string to use:
-
-```bash
-currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
-currenttagfull=$(git describe --tags --abbrev=0)
-defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
-git fetch origin ${defaultbranch} --quiet
-currentcommit=$(git rev-list --count ${currenttagfull}..origin/${defaultbranch})
-currentversion="${currenttag}.$((currentcommit + 9001))"
-echo "$currentversion"
-```
-
-This matches the `pre-commit` hook, which also counts the commits before the new one: the number of commits currently on the default branch + 9001 is the version of the next commit, i.e., of this PR's squash commit. Do not add 1. Set **both** of these files to the resulting version string (and only once per PR, even across multiple commits):
-
-1. **`DESCRIPTION`** — the `Version:` field
-2. **`NEWS.md`** — **only replace line 1** (the `# AMR <version>` heading) with the new version number; do **not** create a new section. `NEWS.md` is a **continuous log** for the entire current `x.y.z.9nnn` development series: all changes since the last stable release accumulate under that single heading. After updating line 1, add the new change to the appropriate sub-heading and group, following *NEWS.md style* above. If the change belongs to an existing group (e.g. `as.mo()`), add it there or amend the existing bullet instead of adding a new top-level bullet.
-
-If `git describe` fails (e.g. no tags exist in the environment), fall back to reading the current version from `DESCRIPTION` and adding 1 to the last numeric component — but only if no bump has already been made in this PR.
-
-#### Date field
-
-The `Date:` field in `DESCRIPTION` must reflect the date of the **last commit to the PR** (not the first), in ISO format. Update it with every commit so it is always current:
-
-```
-Date: 2026-03-07
-```
-
-## Internal State
-
-The package uses a private `AMR_env` environment (created in `aa_globals.R`) for caching expensive lookups (e.g., microorganism matching scores, breakpoint tables). This avoids re-computation within a session.

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 3.1.0
-Date: 2026-10-16 10:23:00 UTC
-SHA: 6898472c8a71816cad3477ec62ac4af31227a5b1
+Version: 3.0.0
+Date: 2025-06-01 16:52:53 UTC
+SHA: 79038fed2169a25a7fc067c80bb25d9d78be21d9

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.1.0.9022
-Date: 2026-11-09
+Version: 3.0.0.9017
+Date: 2025-07-28
 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
@@ -27,28 +27,27 @@ Authors@R: c(
   person(given = c("Judith", "M."),                 family = "Fonville",    role = "ctb"),
   person(given = c("Kathryn"),                      family = "Holt",        role = "ctb", comment = c(ORCID = "0000-0003-3949-2471")),
   person(given = c("Larisse"),                      family = "Bolton",      role = "ctb", comment = c(ORCID = "0000-0001-7879-2173")),
-  person(given = c("Matthew"),                      family = "Saab",        role = "ctb", comment = c(ORCID = "0009-0008-6626-7919")),
+  person(given = c("Matthew"),                      family = "Saab",        role = "ctb"),
   person(given = c("Natacha"),                      family = "Couto",       role = "ctb", comment = c(ORCID = "0000-0002-9152-5464")),
   person(given = c("Peter"),                        family = "Dutey-Magni", role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
-  person(given = c("Rogier", "P."),                 family = "Schade",      role = "ctb", comment = c(ORCID = "0000-0002-9487-4467")),
+  person(given = c("Rogier", "P."),                 family = "Schade",      role = "ctb"),
   person(given = c("Sofia"),                        family = "Ny",          role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
   person(given = c("Alex", "W."),                   family = "Friedrich",   role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
   person(given = c("Bhanu", "N.", "M."),            family = "Sinha",       role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
   person(given = c("Casper", "J."),                 family = "Albers",      role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
   person(given = c("Corinna"),                      family = "Glasner",     role = "ths", comment = c(ORCID = "0000-0003-1241-1328")))
 Depends: R (>= 3.0.0)
-Suggests:
+Suggests: 
   cleaner,
   cli,
   crayon,
   curl,
   data.table,
   dplyr,
-  future,
-  future.apply,
   ggplot2,
   knitr,
   openxlsx,
+  parallelly,
   pillar,
   progress,
   readxl,
@@ -64,13 +63,12 @@ Suggests:
   tidyselect,
   tinytest,
   vctrs,
-  xml2,
-  usethis
+  xml2
 VignetteBuilder: knitr,rmarkdown
 URL: https://amr-for-r.org, https://github.com/msberends/AMR
 BugReports: https://github.com/msberends/AMR/issues
 License: GPL-2 | file LICENSE
 Encoding: UTF-8
 LazyData: true
-Roxygen: list(markdown = TRUE)
-Config/roxygen2/version: 8.1.0
+RoxygenNote: 7.3.2
+Roxygen: list(markdown = TRUE, old_usage = TRUE)

NAMESPACE

@@ -12,6 +12,7 @@ S3method("[",deprecated_amr_dataset)
 S3method("[",disk)
 S3method("[",mic)
 S3method("[",mo)
+S3method("[",sir)
 S3method("[<-",ab)
 S3method("[<-",av)
 S3method("[<-",disk)
@@ -24,6 +25,7 @@ S3method("[[",deprecated_amr_dataset)
 S3method("[[",disk)
 S3method("[[",mic)
 S3method("[[",mo)
+S3method("[[",sir)
 S3method("[[<-",ab)
 S3method("[[<-",av)
 S3method("[[<-",disk)
@@ -34,7 +36,6 @@ S3method("|",amr_selector)
 S3method(Complex,mic)
 S3method(Math,mic)
 S3method(Ops,mic)
-S3method(Ops,sir)
 S3method(Summary,mic)
 S3method(all,amr_selector)
 S3method(all,amr_selector_any_all)
@@ -50,7 +51,6 @@ S3method(as.data.frame,mo)
 S3method(as.double,mic)
 S3method(as.double,sir)
 S3method(as.list,custom_eucast_rules)
-S3method(as.list,custom_interpretive_rules)
 S3method(as.list,custom_mdro_guideline)
 S3method(as.list,mic)
 S3method(as.matrix,mic)
@@ -68,7 +68,6 @@ S3method(c,ab)
 S3method(c,amr_selector)
 S3method(c,av)
 S3method(c,custom_eucast_rules)
-S3method(c,custom_interpretive_rules)
 S3method(c,custom_mdro_guideline)
 S3method(c,disk)
 S3method(c,mic)
@@ -99,10 +98,10 @@ S3method(print,amr_selector)
 S3method(print,av)
 S3method(print,bug_drug_combinations)
 S3method(print,custom_eucast_rules)
-S3method(print,custom_interpretive_rules)
 S3method(print,custom_mdro_guideline)
 S3method(print,deprecated_amr_dataset)
 S3method(print,disk)
+S3method(print,interpreted_sir)
 S3method(print,mic)
 S3method(print,mo)
 S3method(print,mo_renamed)
@@ -137,10 +136,8 @@ export("%like%")
 export("%like_case%")
 export("%unlike%")
 export("%unlike_case%")
-export(NA_ab_)
 export(NA_disk_)
 export(NA_mic_)
-export(NA_mo_)
 export(NA_sir_)
 export(ab_atc)
 export(ab_atc_group1)
@@ -160,7 +157,6 @@ export(ab_selector)
 export(ab_synonyms)
 export(ab_tradenames)
 export(ab_url)
-export(add_custom_antimicrobial_synonyms)
 export(add_custom_antimicrobials)
 export(add_custom_microorganisms)
 export(administrable_iv)
@@ -168,8 +164,6 @@ export(administrable_per_os)
 export(age)
 export(age_groups)
 export(all_antimicrobials)
-export(all_disk)
-export(all_disk_predictors)
 export(all_mic)
 export(all_mic_predictors)
 export(all_sir)
@@ -177,7 +171,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)
@@ -222,7 +215,6 @@ export(cephalosporins_4th)
 export(cephalosporins_5th)
 export(clear_custom_antimicrobials)
 export(clear_custom_microorganisms)
-export(clsi_rules)
 export(count_I)
 export(count_IR)
 export(count_R)
@@ -233,7 +225,6 @@ export(count_df)
 export(count_resistant)
 export(count_susceptible)
 export(custom_eucast_rules)
-export(custom_interpretive_rules)
 export(custom_mdro_guideline)
 export(eucast_dosage)
 export(eucast_exceptional_phenotypes)
@@ -254,8 +245,6 @@ export(ggplot_sir_predict)
 export(glycopeptides)
 export(guess_ab_col)
 export(inner_join_microorganisms)
-export(interpretive_rules)
-export(ionophores)
 export(is.ab)
 export(is.av)
 export(is.disk)
@@ -270,7 +259,6 @@ export(italicize_taxonomy)
 export(key_antimicrobials)
 export(kurtosis)
 export(labels_sir_count)
-export(labels_taxonomy)
 export(left_join_microorganisms)
 export(like)
 export(lincosamides)
@@ -303,7 +291,6 @@ export(mo_is_yeast)
 export(mo_kingdom)
 export(mo_lpsn)
 export(mo_matching_score)
-export(mo_morphology)
 export(mo_mycobank)
 export(mo_name)
 export(mo_order)
@@ -334,9 +321,7 @@ export(not_intrinsic_resistant)
 export(oxazolidinones)
 export(pca)
 export(penicillins)
-export(peptides)
 export(phenicols)
-export(phosphonics)
 export(polymyxins)
 export(proportion_I)
 export(proportion_IR)
@@ -371,13 +356,11 @@ export(semi_join_microorganisms)
 export(set_AMR_locale)
 export(set_ab_names)
 export(set_mo_source)
-export(sir_combine)
 export(sir_confidence_interval)
 export(sir_df)
 export(sir_interpretation_history)
 export(sir_predict)
 export(skewness)
-export(spiropyrimidinetriones)
 export(step_mic_log2)
 export(step_sir_numeric)
 export(streptogramins)
@@ -390,7 +373,6 @@ export(translate_AMR)
 export(trimethoprims)
 export(ureidopenicillins)
 export(wisca)
-export(wisca_plot)
 if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
 if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
 if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
@@ -402,8 +384,6 @@ if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, disk)
 if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, mic)
 if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, resistance_predict)
 if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, sir)
-if(getRversion() >= "3.0.0") S3method(ggplot2::scale_type, mic)
-if(getRversion() >= "3.0.0") S3method(ggplot2::scale_type, sir)
 if(getRversion() >= "3.0.0") S3method(knitr::knit_print, antibiogram)
 if(getRversion() >= "3.0.0") S3method(knitr::knit_print, formatted_bug_drug_combinations)
 if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
@@ -425,7 +405,6 @@ if(getRversion() >= "3.0.0") S3method(recipes::prep, step_mic_log2)
 if(getRversion() >= "3.0.0") S3method(recipes::prep, step_sir_numeric)
 if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_mic_log2)
 if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_sir_numeric)
-if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab)
 if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
 if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic)
 if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
@@ -447,7 +426,6 @@ if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.integer)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.disk)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.mic)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.mic)
-if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.sir)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.disk)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.mic)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, logical.amr_selector_any_all)
@@ -458,7 +436,6 @@ if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.integer)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.mic)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mo.character)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.character)
-if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.factor)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.sir)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_math, mic)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.ab)
@@ -480,27 +457,22 @@ if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.default)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.sir)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_abbr, disk)
 if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_full, disk)
-if(getRversion() >= "4.3.0") S3method(chooseOpsMethod, sir)
-importFrom(graphics,
-  arrows,
-  axis,
-  barplot,
-  hist,
-  legend,
-  mtext,
-  plot,
-  points,
-  text
-)
-importFrom(stats,
-  complete.cases,
-  glm,
-  lm,
-  median,
-  pchisq,
-  prcomp,
-  predict,
-  qchisq,
-  quantile,
-  var
-)
+importFrom(graphics,arrows)
+importFrom(graphics,axis)
+importFrom(graphics,barplot)
+importFrom(graphics,hist)
+importFrom(graphics,legend)
+importFrom(graphics,mtext)
+importFrom(graphics,plot)
+importFrom(graphics,points)
+importFrom(graphics,text)
+importFrom(stats,complete.cases)
+importFrom(stats,glm)
+importFrom(stats,lm)
+importFrom(stats,median)
+importFrom(stats,pchisq)
+importFrom(stats,prcomp)
+importFrom(stats,predict)
+importFrom(stats,qchisq)
+importFrom(stats,quantile)
+importFrom(stats,var)

NEWS.md

@@ -1,264 +1,13 @@
-# AMR 3.1.0.9022
+# AMR 3.0.0.9017
 
-This version fixes a critical bug in WISCA that biased all coverage estimates of `wisca()` and `antibiogram(..., wisca = TRUE)` downwards since AMR 3.0.0. Users are strongly advised to re-run their WISCA analyses.
-
-It also adds a `site` argument to `as.sir()`, stores EUCAST MIC breakpoints exactly as published, stores all screening breakpoints under screening agents, removes EUCAST's breakpoints in brackets, and only keeps blocking rows that have an effect.
-
-### Breaking
-* All explicit screening breakpoints in `clinical_breakpoints` moved to screening agents, e.g., from `FOX` to `FOX-S`, including the high-level aminoglycoside tests (`GEH` and `STH` to `GEN-S` and `STR1-S`), the topical cut-off values of EUCAST, and the CLSI surrogate tests of cefoxitin for staphylococci and pefloxacin for *Salmonella*. Use `as.sir(..., include_screening = TRUE)` to interpret a regular agent with these breakpoints; `GEH` and `STH` stay valid input (#328)
-* `include_screening` in `as.sir()` now defaults to `NULL`, using screening breakpoints for screening agents only. `include_screening = FALSE` now also returns `NA`, with a note, for a screening agent (#328)
-* EUCAST's breakpoints in brackets are no longer in `clinical_breakpoints`. They were blocking rows, so `as.sir()` can now use PK/PD breakpoints or the breakpoints of a broader taxon instead, e.g., for aminoglycosides in EUCAST 2020-2023. They stay available in [`data-raw/breakpoints_eucast_raw.csv`](https://github.com/msberends/AMR/blob/main/data-raw/breakpoints_eucast_raw.csv) (#327)
-* EUCAST breakpoints of *Vibrio* now apply only to the species that EUCAST states: *V. alginolyticus*, *V. cholerae*, *V. fluvialis*, *V. parahaemolyticus* and *V. vulnificus*. Other species and isolates identified at genus level now give `NA`, or use PK/PD breakpoints in EUCAST 2022-2023
-* With unknown `uti`, a blocking row without UTI status no longer overrides a UTI breakpoint at the same taxonomic level, e.g., amikacin in *Acinetobacter* now gives S or R instead of `NA`, which is noted in `sir_interpretation_history()`. Use `uti = FALSE` to prevent this
-* If several breakpoints fit and no `site` is set, `as.sir()` now takes the one for the most systemic site, instead of the first one in the data set. This means, e.g., that a meningitis breakpoint now precedes a non-meningitis breakpoint, such as for benzylpenicillin in *S. pneumoniae*. Use `site` to choose another one
-* `mo_shortname()` now returns the serovar for *Salmonella* serovars, e.g., `"S. Typhi"` and `"S. Goldcoast"` instead of `"S. enterica"`. As this is the default for `bug_drug_combinations()` and short names in `antibiogram()`, serovars are no longer merged in their results. Use `FUN = function(x) paste(mo_genus(x), mo_species(x))` in `bug_drug_combinations()` to group them by species (#341)
-* `mo_shortname()` now returns e.g. `"S. Group B"` for *Salmonella* groups instead of the abbreviations of streptococci, such as `"GBS"`, so that they are no longer merged with streptococci in `bug_drug_combinations()` and `antibiogram()`. *Streptococcus* groups E, I, J and L are now also abbreviated, e.g., `"GES"`, and `"B_STRPT_ABCG"` now returns `"S. Group A, B, C, G"` instead of the malformed `"GA, B, C, GS"` (#341)
-* `mdro()` now applies the rule for *Salmonella* Typhi in the EUCAST guidelines, i.e., resistance to carbapenems (and fluoroquinolones in `"EUCAST3.1"`). This rule never applied before, so these isolates were wrongly classified as negative (#341)
+This is primarily a bugfix release, though we added one nice feature too.
 
 ### New
-* **Site of infection**
-  * `as.sir()` gained the argument `site`, in fixed codes such as `"meningitis"`, `"iv"`, `"uti"` and, for animals, `"mastitis"` and `"respiratory"`, which can also be a column name. A breakpoint for a contradicting site is left out, a breakpoint without a site still applies, and the result is `NA` if only contradicting sites are available, without using PK/PD breakpoints. `"other"` takes a breakpoint for other infections or without a site, and leaves out those limited to an indication. `uti = TRUE` stays available and equals `site = "uti"`
-  * `sir_interpretation_history()` now holds the site of the breakpoint used, and notes every assumption about sites
-* **Screening agents**
-  * 13 screening agents in the `antimicrobials` data set: `CHL-S`, `CIP-S`, `COL-S`, `ERY-S`, `FUS-S`, `GEN-S`, `LVX-S`, `MUP-S`, `NEO-S`, `OFX-S`, `RTP-S`, `STR1-S` and `TOB-S` (#328)
-  * EUCAST clinical breakpoints that can also be used as a screening test, e.g., erythromycin for staphylococci, have a copy under the screening agent (#328)
-* **EUCAST breakpoints stated in the Notes** (#329)
-  * Oxacillin disk for *S. pseudintermedius* and related species, and oxacillin MIC for coagulase-negative staphylococci, under `OXA-S`
-  * Mupirocin for nasal decolonisation of *S. aureus*
-  * Meropenem in other infections than meningitis for *N. meningitidis* in EUCAST 2021
-* **Taxonomic names in plots**
-  * New function `labels_taxonomy()` to print taxonomic names in axis and legend labels in italics, which can directly be used as labeller in `ggplot2` (e.g., `scale_x_discrete(labels = labels_taxonomy)`) and in base R plots
-  * `italicise_taxonomy()` gained `type = "plotmath"`, which returns an expression vector for titles, axes and legends in plots
-  * All plotting functions now print taxonomic names in italics using `labels_taxonomy()`: the facets and titles of `autoplot()` and `plot()` for antibiograms, the legend of `wisca_plot()` (which previously italicised all its entries, including e.g. "CoNS"), the axes, legends and facets of `ggplot_sir()` and `facet_sir()`, the labels and legend of `ggplot_pca()`, and the subtitles of `plot()` and `autoplot()` for MIC and disk diffusion values (which previously italicised the whole name, e.g. "Coagulase-negative Staphylococcus (CoNS)")
+* Integration with the **tidymodels** framework to allow seamless use of MIC and SIR data in modelling pipelines via `recipes`
+  - `step_mic_log2()` to transform `<mic>` columns with log2, and `step_sir_numeric()` to convert `<sir>` columns to numeric
+  - New `tidyselect` helpers: `all_mic()`, `all_mic_predictors()`, `all_sir()`, `all_sir_predictors()`
 
 ### Changed
-* SIR interpretation (`as.sir()`)
-  * MIC breakpoints are compared as dilutions, so that e.g. an MIC of 0.032 and a breakpoint of 0.03 mg/L are the same (#331)
-  * A `uti` vector mixing `NA` with `TRUE` or `FALSE` no longer gives an error
-* `clinical_breakpoints` data set
-  * EUCAST MIC breakpoints are stored exactly as published, e.g., 0.03 instead of 0.032, and 0.001 instead of 0.0001 (#331)
-  * Blocking rows of EUCAST 2019-2026 that have no effect on `as.sir()` were removed, 12 243 in total (#326)
-  * The breakpoints of *Bacteroides* now also apply to zone diameters of *Parabacteroides*, *Phocaeicola dorei* and *Phocaeicola vulgatus* (#329)
-* `italicise_taxonomy()`
-  * Species and subspecies names are now only italicised after a genus, an abbreviated genus, or another species or subspecies name, so that ordinary words such as "coli" or "major" stay upright. *Salmonella* serovars (such as Typhimurium) and groups are no longer italicised, and "subsp.", "ssp." and "var." stay upright between italicised names
-  * Fixed punctuation being italicised along with taxonomic names, e.g., `"(S. aureus)"` now gives `"(*S. aureus*)"` instead of `"(S. *aureus)*"`
-  * `NA` values now return `NA` instead of `"NA"`
-  * Taxonomic names are now looked up once per session, making the function considerably faster for long vectors
-* `ggplot_sir()`, `geom_sir()` and `labels_sir_count()`
-  * Fixed the data labels being placed on the wrong bars with `position = "dodge"` or `position = "stack"`. They are now grouped like the bars, using the new `fill` argument of `labels_sir_count()`, which `ggplot_sir()` sets automatically
-  * If the interpretation is not shown in the plot, e.g., with `fill = "species"`, only the susceptible proportion is now plotted, following the guideline: S+SDD+I for EUCAST, S+SDD for CLSI, and S with `guideline = NULL`. Previously, the bars of all interpretations were drawn on top of each other. The y axis title of `ggplot_sir()` then states the category, e.g., "Proportion SI", and the data labels show the number of tested isolates
-  * `ggplot_sir()` now splits the plot by antimicrobial if there is more than one and the antimicrobial is not shown in the plot, e.g., with `x = "species"`, as their bars were previously stacked on top of each other. This uses `facet = "antibiotic"` if `facet` is not set, and otherwise a grid of `facet` by antimicrobial
-* `ggplot_pca()`
-  * Fixed an error when setting `groups` together with `labels`, and setting `groups` without `labels` now colours the points by these groups instead of using them as labels, as documented
-* *Morganella* is interpreted as reported, with the breakpoints of Enterobacterales or Morganellaceae and not of *M. morganii*, which is now tested (#330)
-* WISCA (`wisca()` and `antibiogram(..., wisca = TRUE)`)
-  * Fixed a critical bug that systematically underestimated the coverage of every WISCA since AMR 3.0.0. Pathogens absent from a syndromic group, and pathogens without any test result for a regimen, were still included in the model with only prior information: each added a prior weight of 1 to the pathogen incidence, and untested pathogens kept their full incidence weight while counting as about 50% susceptible. The bias was largest for stratified analyses (e.g., up to 14 percentage points for meropenem in random strata of `example_isolates`). Now, only pathogens that occur in a group and have at least one test result for the regimen are included. Please re-run all WISCA analyses (#337)
-  * `retrieve_wisca_parameters()` now returns only the parameters actually used in the model, and `n_total` in the `long_numeric` attribute now counts only isolates of the pathogens included for that regimen
-  * A new warning is given when the prior weight of 1 per pathogen (Bielicki *et al.*, 2016) accounts for more than 5% of the pathogen incidence, i.e., with rare pathogens or small groups, as this can strongly lower the estimated coverage; consider `top_n_microorganisms()` or fewer and larger groups in that case
-* Microorganism coercion (`as.mo()`)
-  * Fixed the misaligned arrows in the message on taxonomically renamed microorganisms in colour-supporting consoles, for old names whose author reference lacks "*et al.*" (#336)
-* `intrinsic_resistant` data set
-  * Species groups and complexes are now listed for every antimicrobial to which all their species are intrinsically resistant. This adds 62 bug-drug combinations for the *Burkholderia cepacia* complex, coryneform bacteria, the *Enterobacter cloacae* complex (e.g., amoxicillin and amoxicillin/clavulanic acid), the *Klebsiella pneumoniae* complex, and coagulase-negative staphylococci, which affects `mo_is_intrinsic_resistant()`, `not_intrinsic_resistant()`, and the priors of `wisca()` (#338)
-
-### Other
-* The manual index on the website was rewritten to improve findability, with sections ordered by task and a filter field
-* Fixed the link to the copyright section and added MycoBank as a taxonomy source in the *Welcome to AMR* vignette (#325)
-
-# AMR 3.1.0
-
-This substantial release makes most core functions considerably faster, adds EUCAST 2026 and CLSI 2026 breakpoints, adopts the new prokaryotic kingdoms of Göker and Oren (2024), introduces WT/NWT interpretation for ECOFFs, unifies the EUCAST and CLSI interpretive rules, and supports `tidymodels` pipelines. As it contains several breaking changes, please read the *Breaking* section below before updating.
-
-### Breaking
-* The former *kingdoms* Bacteria and Archaea are now each divided into four kingdoms, with new top-level *domains* Bacteria and Archaea (Göker and Oren, 2024, DOI: 10.1099/ijsem.0.006242). Following this, a new `domain` column was added to the `microorganisms` data set, and `mo_kingdom()` now returns the formal kingdom (e.g., `"Pseudomonadati"` instead of `"Bacteria"`). Use `mo_domain()` for the old behaviour. For non-prokaryotic kingdoms (Fungi, Protozoa, etc.), `kingdom` and `domain` are identical.
-
-  | `mo_kingdom()` < 3.1.0 | `mo_kingdom()` now  | `mo_domain()` (unchanged) |
-  |------------------------|---------------------|---------------------------|
-  | Bacteria               | Bacillati           | Bacteria                  |
-  |                        | Fusobacteriati      | Bacteria                  |
-  |                        | Pseudomonadati      | Bacteria                  |
-  |                        | Thermotogati        | Bacteria                  |
-  |                        |                     |                           |
-  | Archaea                | Methanobacteriati   | Archaea                   |
-  |                        | Nanobdellati        | Archaea                   |
-  |                        | Promethearchaeati   | Archaea                   |
-  |                        | Thermoproteati      | Archaea                   |
-  |                        |                     |                           |
-  | Fungi                  | Fungi               | Fungi                     |
-  |                        |                     |                           |
-  | Protozoa               | Protozoa            | Protozoa                  |
-
-  Previously, `mo_domain()` was an alias of `mo_kingdom()`; it is now a distinct function. Its output is therefore unchanged, while `mo_kingdom()` now returns the new formal kingdom. A one-time note per session explains this change when bacterial or archaeal records are queried.
-* Parallel computing in `as.sir()`, `antibiogram()`, and `wisca()` now uses the `future` and `future.apply` packages, which is faster. A non-sequential plan (e.g., `future::plan(future::multisession)`) must be active before using `parallel = TRUE` (#281).
-* The options of `capped_mic_handling` in `as.sir()` have been redefined as `"none"`, `"conservative"`, `"standard"` (default), and `"lenient"`. The option `"inverse"` is no longer available (#243).
-* `as.sir()` now returns WT/NWT (Wildtype/Non-wildtype) instead of S/R when using ECOFF-based interpretation with `breakpoint_type = "ECOFF"`. WT/NWT results are fully supported in all resistance and susceptibility functions and in all plots (#254).
-* Aggregated analyses now follow the guideline for the 'I' category, set with the new `guideline` argument or the `AMR_guideline` option: EUCAST considers 'I' susceptible and CLSI considers 'I' resistant, while SDD and WT are always considered susceptible, and NWT and NS always resistant (see section *Interpretation of SIR* in `?as.sir`). This applies to `count_df()`, `proportion_df()`, `sir_df()`, `ggplot_sir()`, `geom_sir()`, and `labels_sir_count()`, which with CLSI now return `"S"` vs. `"IR"` instead of `"SI"` vs. `"R"`, and to `antibiogram()`, `wisca()`, and `format()` on the output of `bug_drug_combinations()`. Previously, these functions always considered 'I' susceptible, as with EUCAST. Use `guideline = "EUCAST"` for the old behaviour.
-* The `combine_SI` argument of these functions is deprecated in favour of `guideline`. While set, it is followed literally and takes precedence over `guideline`. Use `guideline = NULL` instead of `combine_SI = FALSE` to keep S, I, and R separate.
-
-### New
-* **Updated clinical breakpoints**
-  * EUCAST 2026 and CLSI 2026 are now supported, by adding over 5,700 new breakpoints to the `clinical_breakpoints` data set. EUCAST 2026 is now the default guideline for all MIC and disk diffusion interpretations.
-  * Human EUCAST breakpoints from 2019 (v9.0) onwards are now retrieved directly from the EUCAST Excel files, instead of relying on the WHONET repository. As a result:
-    * `clinical_breakpoints` now contains blocking rows (`NA` breakpoints, with the reason in `note`) where EUCAST gives no breakpoint for an organism, so that `as.sir()` no longer falls back to the breakpoint of a broader taxon. This includes infections other than UTI where EUCAST gives breakpoints in brackets or no breakpoint, but does give a breakpoint for UTI, e.g., aminoglycosides for *Acinetobacter* spp.
-    * Restrictions in EUCAST notes are applied, e.g., zone diameter breakpoints for *E. coli* only
-    * EUCAST PK-PD (non-species related) breakpoints of 2019-2023 and *H. parainfluenzae* MIC breakpoints are now included
-* **Unified interpretive rules**
-  * New function `interpretive_rules()` applies the interpretive rules of both EUCAST and CLSI. `eucast_rules()` is now a wrapper around this function (#235, #259).
-  * Species named in a rule now also match all other names of the same accepted taxon (e.g., 'Clostridium ramosum' for *Thomasclavelia ramosa*). This also updated the `intrinsic_resistant` data set.
-* **Support for `tidymodels` pipelines**
-  * New recipe steps `step_mic_log2()` and `step_sir_numeric()` to use MIC and SIR data in modelling pipelines
-  * New column selectors `all_sir()`, `all_mic()`, and `all_disk()`
-  * New `esbl_isolates` data set for practising AMR modelling
-* **Morphology of bacteria**
-  * New `morphology` column in the `microorganisms` data set, with the corresponding function `mo_morphology()` to return the cell shape of bacteria. Data are sourced from BacDive; values prefixed with "likely" are extrapolated from the consensus at genus level.
-  * New argument `add_morphology` in `mo_gramstain()` to return combined results, such as `"Gram-negative rods"`
-* **Antimicrobials**
-  * New function `sir_combine()` to combine SIR results of multiple antimicrobials into one variable, for combination therapy (`method = "most_susceptible"`) or for resistance within a group (`method = "most_resistant"`) (#321)
-  * New function `add_custom_antimicrobial_synonyms()` to add local names, such as trade names, to existing antimicrobials (#307)
-  * New antimicrobial selectors `ionophores()`, `peptides()`, `phosphonics()`, and `spiropyrimidinetriones()`
-  * New antimicrobials: cefepime/taniborbactam (`FTA`), ceftibuten/avibactam (`CTA`), clorobiocin (`CLB`), kasugamycin (`KAS`), ostreogrycin (`OST`), sulbactam/durlobactam (`SUD1`, #308), taniborbactam (`TAN`), thiostrepton (`THS`), xeruborbactam (`XER`), and zorbamycin (`ZOR`)
-* **Other**
-  * New function `wisca_plot()` to assess the distributions of susceptibility and incidence from the Monte Carlo simulations of WISCA
-  * New function `amr_course()` to download and unpack course or webinar materials from GitHub in one call
-  * New typed missing value constants `NA_ab_` and `NA_mo_`, for use in pipelines that need missing values of a specific class
-  * A registry of all MO codes since v2.0.0 now prevents existing codes from being reused or mixed up. Codes of earlier releases are translated to the current code of the same taxon.
-  * New column `source` in the `microorganisms.codes` data set, stating the source of a code and the name it refers to, e.g., `"WHONET (Enterobacter aerogenes)"`
-
-### Changed
-* SIR interpretation (`as.sir()`)
-  * New argument `enforce_method` (`"auto"`, `"mic"`, or `"disk"`) to force the interpretation method when S3 class information is lost, e.g., when called from Python (#291)
-  * When input consists of whole numbers only, disk zones are now assumed rather than MIC values (#291)
-  * Capped MICs (e.g., `<=0.5`) now return `I` instead of `S` or `NI` if there is no S category, i.e., in case of an off-scale S breakpoint such as EUCAST's 0.001 mg/L (#295)
-  * Capped MICs are no longer forced to `S` or `R` if there is no breakpoint for the drug-bug combination
-  * Fixed the documented default of `capped_mic_handling`, which is `"standard"`
-  * On data frames, already-converted SIR columns are no longer dropped on a re-run (#278)
-  * Metadata columns (e.g., `patient`, `ward`) are no longer misidentified as antimicrobial columns
-  * `info = FALSE` now suppresses all messages, including those for columns without breakpoints
-  * Combined MIC/SIR input values (e.g., `"<= 0.002; S"` or `"S; 0.002"`) are now parsed correctly (#252)
-  * Setting a year-qualified guideline, such as `options(AMR_guideline = "EUCAST 2012")`, no longer causes errors or silently wrong results in `interpretive_rules()`, `resistance()`, `susceptibility()`, `count_resistant()`, `count_susceptible()`, and the SIR plotting and printing functions (#298)
-  * With an unknown `uti` (`NA`, the default), non-UTI breakpoints are now consistently preferred over UTI breakpoints. Previously, this preference was only applied together with its note, which is shown once. UTI breakpoints are only used if there are no non-UTI breakpoints, which is now noted in `sir_interpretation_history()` for every interpretation. A blocking row of a broader taxon does not override a UTI breakpoint of the organism itself, e.g., Enterobacterales and nitroxoline for *E. coli*.
-* `clinical_breakpoints` data set
-  * Fixed EUCAST breakpoint rules for *Aerococcus* (v12 onwards), which were never applied, and for *Pasteurella*, which were partly filed under *Neisseria meningitidis* (#290)
-  * Fixed streptomycin breakpoints imported from WHONET, which were coded as streptoduocin (`STR`) instead of streptomycin (`STR1`)
-  * Fixed CLSI breakpoints for sulbactam/durlobactam, which were coded as sulfadimethoxine (`SUD`), and added the missing EUCAST 2011 breakpoints for roxithromycin (#308)
-  * Fixed some EUCAST Expert Rules, mostly on *S. pneumoniae*
-  * Zone diameters for which the guideline has no S category (coded by WHONET as an S breakpoint of 80 or 99 mm) are now blocking rows for EUCAST, e.g. cefuroxime oral in *H. influenzae* in EUCAST 2011, and keep only the R breakpoint for CLSI, e.g. fluconazole in *C. glabrata*. Previously, these S breakpoints were stored as 50 mm.
-  * Breakpoints and ECOFFs for *Salmonella* serovars Typhi, Typhimurium, and Paratyphi, and ECOFFs for the *Bacteroides fragilis* complex, are now assigned to these taxa instead of to *S. enterica* subsp. *enterica* and *B. fragilis*, and ECOFFs of amphotericin B for *Neocosmospora solani* were added
-* Microorganism coercion (`as.mo()`) and properties (`mo_*()`)
-  * Considerably faster through one consistent session cache design, which is cleared when lookup tables change, e.g., after `add_custom_microorganisms()` (#313)
-  * `mo_*()` functions now retrieve properties of valid `mo` input directly, and only for unique values
-  * Subsetting, combining, and binding rows of `mo` vectors (e.g., in `rbind()`) is now much faster, as codes are checked against a hashed set instead of the whole `microorganisms` data set
-  * The mapping of outdated taxonomic names to their current names is now remembered per code
-  * Previously coerced input is now recognised again, e.g., for an unknown species of a known genus, instead of being matched again on every call (#313)
-  * `mo_uncertainties()` now also lists uncertainties of previously coerced input
-  * Translated names in the set language are now recognised, such as the output of `mo_name(x, language = "fr")`, and cached per language
-  * Input of the form `"X complex"` now falls back to `"X"` when the complex is not a distinct taxon, preventing `NA` for valid clinical descriptions such as `"Proteus vulgaris complex"`, while a complex named after several of its species returns the complex of one of them, e.g., `"Acinetobacter calcoaceticus-baumannii complex"` returns *A. baumannii* complex (#287)
-  * Abbreviated genus input now ranks candidates with an exactly matching species epithet above more prevalent organisms, so that e.g. `"S. apiospermum"` returns *Scedosporium apiospermum* instead of a *Staphylococcus* species (#288)
-  * Abbreviated genus input for species with subspecies (e.g., `"P. ovale"`) now returns the species instead of a more prevalent organism, while explicit subspecies (e.g., `"P. ovale curtisi"`) are preserved (#288)
-  * *Salmonella* serovars written with the species, such as `"Salmonella enterica serovar Typhi"`, no longer return *Salmonella bongori* or another subspecies
-  * `as.mo()` and `mo_current()` now find the current name of synonyms with multiple sources (e.g., *Chaetomium abuense*)
-  * `mo_taxonomy()` and `mo_info()` now contain an extra element `domain`
-* Own microorganism codes (`set_mo_source()` and `get_mo_source()`)
-  * Fixed `get_mo_source()` removing the `mo_source` file at the default location in interactive sessions, when called with a `destination` that does not exist
-  * Fixed `get_mo_source()` returning the `mo_source` already loaded instead of the one at the requested `destination`
-  * Fixed `get_mo_source()`, and therefore `as.mo()` and all `mo_*()` functions, throwing an error in interactive sessions after the original file of the `mo_source` was moved or deleted. The `mo_source` file is now removed, as documented.
-  * An updated original file now updates the `mo_source` file at its own `destination` instead of at the default location
-* `microorganisms` data set
-  * Taxonomic update of all microorganisms, now based on COL 2026-04-18 XR, LPSN and BacDive of October 2026, and MycoBank of January 2026
-  * Names listed twice by a source now take the correct record (e.g., *Eggerthella lenta*, *Gordonia amarae*, and *Anisakis simplex* were synonyms without a current name)
-  * Synonyms without a current name are now linked via LPSN or removed, with their codes retired. The *M. tuberculosis* complex is always kept.
-  * Higher taxonomy and parent records are now consistent, and all data sets refer only to current names (except `intrinsic_resistant` and `microorganisms.codes`)
-  * *Erysipelatoclostridium* and its species are now synonyms of *Thomasclavelia*; *E. merdavium* is retired
-  * Author references now strip `emend.` and everything after it, so that `ref` reflects the combination authority rather than the emendation author (e.g., *Rhodococcus equi* now returns "Goodfellow et al., 1977" instead of "Nouioui et al., 2018")
-* `microorganisms.codes` data set
-  * Fixed WHONET codes that referred to an unrelated microorganism, e.g., `VAG` ("Vaginal flora") to *Vagococcus*, `PAR` ("Parasite") to *Paracoccus*, the *Leptospira interrogans* serovars to *Legionella*, and *Salmonella* O-groups to *Salmonella* Group A. Codes for organisms that are not in the `microorganisms` data set, such as viruses, now refer to `UNKNOWN`, and names that only partly exist refer to the genus.
-  * WHONET codes for *Salmonella* serovars now refer to the serovar instead of *S. enterica* subsp. *enterica*, e.g., `SAT` to *Salmonella* Typhi
-  * Codes now refer to the name they were named after, also if that name is outdated, so that the code and the microorganism code remain relatable, e.g., `EAE` refers to *Enterobacter aerogenes* (`B_ENTRBC_AERG`). `as.mo()` still returns the current name, here *Klebsiella aerogenes*.
-  * Added 271 WHONET codes
-* Antimicrobial coercion (`as.ab()`) and `antimicrobials` data set
-  * Considerably faster through the same session cache design as `as.mo()` (#313)
-  * Input that is not a known name or code is now coerced up to 70 times faster, with identical results, as LOINC codes, synonyms, and abbreviations are looked up in one step instead of per antimicrobial, and translated names are built once per language
-  * Fixed a bug where results of `fast_mode` (used internally) were remembered and reused by later regular calls, which could return `NA` for valid input (#313)
-  * Codes containing "PH" or "TH" (e.g., `ETH`, `PHE`) no longer return `NA` when mixed with unrecognised input (#245)
-  * Input that is not valid UTF-8 (e.g., text exported in a local encoding such as CP949) now returns `NA` with a warning instead of an error
-  * `ab_reset_session()` no longer clears the uncertainties of `as.mo()` (#313)
-  * `antimicrobials$group` is now a `list`, so that drugs belonging to multiple groups are fully represented. Use `ab_group(all_groups = TRUE)` to retrieve all groups of a drug (#246).
-  * Trade names of combinations (Tazocin, Timentin, Recarbrio, Exblifep) were listed under a single component, and names of screening libraries and suppliers (e.g., Prestwick, Spectrum) as synonyms. These have been corrected (#315).
-* Antibiograms (`antibiogram()` and `wisca()`)
-  * `wisca()` now follows Bielicki *et al.* (2016) more strictly by using $\text{Beta}(1, 9999)$ for intrinsically resistant pairs, forcing near-zero susceptibility regardless of observed data (based on EUCAST Expected Resistant Phenotypes)
-  * Fixed a bug where both functions failed without the `antimicrobials` argument if `tidyselect` was not available, e.g., for binary installations without `dplyr`
-  * Isolates of unknown species are now included in grouped antibiograms and in `wisca()`, as they already were in traditional antibiograms. They were previously excluded silently, with the warning "invalid microorganism code, NA generated". This can change WISCA coverage estimates.
-  * Grouped traditional antibiograms now show the (translated) pathogen names, as ungrouped antibiograms do, instead of microorganism codes
-  * `wisca()` and `wisca_plot()` are considerably faster, especially with syndromic groups, by determining intrinsic resistance and pathogen names only once per regimen and pathogen
-* Resistance and susceptibility calculation
-  * New argument `guideline` (default: the `AMR_guideline` option, otherwise EUCAST) in `susceptibility()`, `resistance()`, `count_df()`, `proportion_df()`, `sir_df()`, `ggplot_sir()`, `geom_sir()`, `labels_sir_count()`, `antibiogram()`, `wisca()`, and `bug_drug_combinations()` to interpret the 'I' category correctly per guideline. Functions that return results per category also accept `guideline = NULL` to keep S, I, and R separate, while functions that return a single proportion or count give an informative error.
-  * When EUCAST is assumed because neither the `guideline` argument nor the `AMR_guideline` option is set, a message explains how to change this, once per session and not in R Markdown or Quarto documents
-  * `count_*()` and `proportion_*()` now handle WT, NWT, NS, and NI results correctly (#321)
-* MICs and disk diffusion
-  * New argument `round_to_next_log2` in `as.mic()` and `rescale_mic()` to round values up to the nearest log2 dilution level (#255)
-  * `as.mic()` now handles values in scientific notation (e.g., `1e-3`) correctly
-  * Input validation of `as.disk()` is now more strict, rejecting values that are not recognisable as a numeric disk zone diameter. Values higher than 50 mm now return `NA` with a warning, instead of being set to 50 mm.
-* Plotting (`plot()`, `barplot()`, and `autoplot()` for MIC, disk diffusion and SIR values, and the `scale_*_mic()` and `scale_*_sir()` functions)
-  * The colours and legend labels of interpreted MIC and disk values are now based on the interpretation itself instead of matching colours, so that the legend of `plot()` no longer shows SDD when `colours_SIR` gives SDD the colour of S (e.g., with one or three colours), and NI and NS are labelled too
-  * Fixed `autoplot()` for disk diffusion values, which left SDD bars without colour and legend entry
-  * Fixed `barplot()` for MIC values, which ignored the `language` and `expand` arguments, and which now also has the `include_PKPD` and `breakpoint_type` arguments
-  * Fixed `barplot()` for SIR values, which gave NI, WT, and NWT the wrong colours, and always showed empty bars for WT, NWT, and NS. `barplot()` and `autoplot()` for SIR values now always show S and R, and all other values (such as SDD, I, WT, NWT, and NS) only when they occur. Data with only WT and NWT shows these two.
-  * `autoplot()` for disk diffusion values now validates `include_PKPD` and `breakpoint_type`, and `plot()` and `autoplot()` for SIR values now validate `language`
-  * The y axis of `plot()` and `barplot()` now has a readable number of tick marks for large counts, instead of one per count
-  * A named `colours_SIR` is now matched by name in all plotting functions, and S, I and R get their default colour if not set. SDD gets the colour of S if not set. Previously, the colours of S/I and I/R were taken by position, and a named vector of three colours gave missing colours.
-  * `keep_operators = TRUE` and `FALSE` in the `scale_*_mic()` functions now behave like `"all"` and `"none"`, as in `as.mic()`
-  * Fixed the `scale_*_sir()` functions failing when `values` was set. A named `values` (e.g., `values = c(S = "green")`) now replaces the colours of the SIR values it names, and `scale_x_sir()` warns that it ignores `values`.
-  * Fixed `scale_x_sir()` ignoring other arguments, such as `name`
-  * The `scale_*_sir()` functions now call 'I' "Intermediate" by default if the `AMR_guideline` option is set to EUCAST before 2019
-  * `facet_sir()` now accepts unquoted column names, e.g., `facet_sir(antibiotic)`
-* MDRO determination (`mdro()`)
-  * Resistance can now be inferred from a drug/inhibitor combination when the column of the base drug is absent (e.g., piperacillin inferred from piperacillin/tazobactam). This is controlled with the new argument `infer_from_combinations` (default: `TRUE`) (#209).
-  * BRMO classification now includes bacterial complexes (#275)
-  * Fixed a bug in the CMI 2012 guideline where pandrug-resistant (PDR) isolates were classified as extensively drug-resistant (XDR), and another isolate could be marked as PDR instead, if the isolate was not among the first rows of the data. This can change the PDR and XDR results of `guideline = "CMI 2012"` (the default).
-  * Considerably faster, as the classes per isolate are now determined per column instead of per cell
-* `top_n_microorganisms()`
-  * New argument `property_for_each` for sub-grouping within the top *n* groups. Rank ordering is enforced, so that only lower taxonomic ranks are allowed.
-  * `property = NULL` is now accepted
-  * The inner filter now tracks the original row indices, to prevent contamination across groups
-* Translations
-  * Improved French translations, kindly provided by Mathilde Garé (#322)
-  * Improved translations of combination names and antimicrobial groups in 20 languages
-  * Translating is now around 50 times faster, with identical results, as the translations are prepared once per language and applied to all values at once. This also makes `ab_group()` faster in other languages.
-  * Translations are no longer translated again (e.g., "Ticarcillinee" in Dutch and "groupee" in French), and parts of combination names are no longer left untranslated
-  * Fixed Italian names of CoNS and CoPS (#256), Dutch names of antimicrobials, and output of `sir_df()` in other languages (#272)
-  * Added translations of "Susceptible dose-dependent", "Non-susceptible", "Wildtype", and "Non-wildtype", which were previously shown half translated in plots
-  * Corrected the translations of the interpretation categories (S, I, R, and NI) in 18 languages, which were partly incorrect (e.g., Ukrainian words in Russian, "temporary" for Intermediate in Finnish, and "intermediate product" in Czech), and made them consistent with the newly added categories. Where available, the terms of national antimicrobial susceptibility testing committees and laboratories are used, e.g., "Sensibel bei erhöhter Exposition" (German), "Sensible, cuando se incrementa la exposición" (Spanish), and "Känslig vid ökad exponering" (Swedish).
-* Interpretive rules (`interpretive_rules()`, `eucast_rules()`, and `clsi_rules()`)
-  * Considerably faster, around 11 to 18 times, with identical results
-  * The number of added and changed values now only counts values that were actually written, so that values left untouched due to `overwrite = FALSE` or `add_if_missing = FALSE` are no longer reported as changes or additions, also not in the output of `verbose = TRUE` (#259)
-  * The changes of custom rules are now also printed when no other rules were applied
-  * The `rule` column of the output of `verbose = TRUE` no longer contains formatting markup (e.g., `{.field AMC}`) for the inhibitor-inheritance rules
-* `custom_eucast_rules()` has been renamed to `custom_interpretive_rules()`. The old name is now deprecated but still works (#268).
-*  The package option `AMR_eucastrules` has been replaced by `AMR_interpretive_rules`, which applies to `interpretive_rules()`, `eucast_rules()`, and `clsi_rules()`. Its default is now `c("breakpoints", "expected_phenotypes")`. A set `AMR_eucastrules` option is now ignored, with a warning in `eucast_rules()`.
-* Logical comparison (`==`, `!=`) of the `sir` class with a `factor` is now possible on R >= 4.3
-* New argument `guideline` in `random_mic()` and `random_disk()`, defaulting to the `AMR_guideline` option (otherwise EUCAST), so that generated values are based on the latest breakpoints of one guideline instead of those of all guidelines and years combined
-* Fixed `format()` on the output of `bug_drug_combinations()`, which counted I and SDD as resistant with the default `combine_SI = TRUE`, contrary to its documentation. It now reads the guideline used in `bug_drug_combinations()`, which can be overridden with its own `guideline` argument, and also counts NS as resistant.
-* Fixed a bug in `g.test()` that returned the degrees of freedom as `argument` instead of `parameter`, so that they were not printed
-* Fixed a bug where R could crash after unloading the `data.table` package, and where suggested packages available on the machine that built the package were used even if they were not available to the user
-
-### Other
-* Improved console messages with clickable links throughout the package, powered by `cli` if it is installed (#191, #265)
-* The section *Interpretation of SIR* (in `?as.sir`) now explains for all functions with a `guideline` argument for aggregated analyses how S, SDD, I, R, WT, NWT, NS, and NI are categorised per guideline. The handling of 'I' per MDRO guideline in `mdro()` will be revised in a future version (#323).
-* `labels_sir_count()` is now documented together with `ggplot_sir()`
-* Corrected the documentation of `colours_SIR` and `eucast_I` in the plotting functions, and an example of `scale_colour_sir()` in which the title was not applied
-* The documentation of `get_AMR_locale()` now describes the actual order in which the language is determined: the `AMR_locale` option, then the `LANG` system variable, then `LANGUAGE` only if `LANG` is not set, and then the system locale
-* Revamped console output of `interpretive_rules()`, with section headers, S/I/R values styled as in the printing of `sir` columns in tibbles, and the summary of edits sorted by SIR level, using `cli` if it is installed (#259)
-* The printing of `custom_interpretive_rules()` and `custom_mdro_guideline()` now styles SIR values as in tibbles, i.e., the colour of `I` depends on the guideline. `WT`, `NWT`, and `NS` were previously shown as `SDD`, `I`, and `R`, and values other than `S` and `R` as `I`.
-* The 'AMR for Python' vignette now contains sections on installation channels (stable from CRAN, or development from GitHub via `AMR.beta`) and on using `enforce_method` in `as_sir()` from Python
-
-
-# AMR 3.0.1
-
-This is a bugfix release following the release of v3.0.0 in June 2025.
-
-### Changed
-* Fixed bugs introduced by `ggplot2` v4.0.0 (#236)
-  * MIC scale functions (such as `scale_y_mic()`) will now be applied automatically when plotting values of class `mic`
-  * SIR scale functions (such as `scale_x_sir()`) will now be applied automatically when plotting values of class `sir`
 * Fixed a bug in `antibiogram()` for when no antimicrobials are set
 * Fixed a bug in `antibiogram()` to allow column names containing the `+` character (#222)
 * Fixed a bug in `as.ab()` for antimicrobial codes with a number in it if they are preceded by a space
@@ -266,19 +15,10 @@ This is a bugfix release following the release of v3.0.0 in June 2025.
 * Fixed a bug in `as.sir()` to allow any tidyselect language (#220)
 * Fixed a bug in `as.sir()` to pick right breakpoint when `uti = FALSE` (#216)
 * Fixed a bug in `ggplot_sir()` when using `combine_SI = FALSE` (#213)
-* Fixed a bug in `mdro()` to make sure all genes specified in arguments are acknowledged
-* Fixed a bug the `antimicrobials` data set to remove statins (#229)
-* Fixed a bug the `microorganisms` data set for MycoBank IDs and synonyms (#233)
-* Fixed ATC J01CR05 to map to piperacillin/tazobactam rather than piperacillin/sulbactam (#230)
-* Fixed skimmers (`skimr` package) of class `ab`, `sir`, and `disk` (#234)
 * Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223)
 * Fixed some specific Dutch translations for antimicrobials
-* Added a warning to `as.ab()` if input resembles antiviral codes or names (#232)
-* Added all reasons in verbose output of `mdro()` (#227)
 * Added `names` to `age_groups()` so that custom names can be given (#215)
 * Added note to `as.sir()` to make it explicit when higher-level taxonomic breakpoints are used (#218)
-* Added antibiotic codes from the Comprehensive Antibiotic Resistance Database (CARD) to the `antimicrobials` data set (#225)
-* Updated Fosfomycin to be of antibiotic class Phosphonics (#225)
 * Updated `random_mic()` and `random_disk()` to set skewedness of the distribution and allow multiple microorganisms
 
 
@@ -287,7 +27,7 @@ This is a bugfix release following the release of v3.0.0 in June 2025.
 This package now supports not only tools for AMR data analysis in clinical settings, but also for veterinary and environmental microbiology. This was made possible through a collaboration with the [University of Prince Edward Island's Atlantic Veterinary College](https://www.upei.ca/avc), Canada. To celebrate this great improvement of the package, we also updated the package logo to reflect this change.
 
 ### Breaking
-* Data set `antibiotics` has been renamed to `antimicrobials` as the data set contains more than just antibiotics. Using `antibiotics` will still work, but now returns a warning.
+* Dataset `antibiotics` has been renamed to `antimicrobials` as the data set contains more than just antibiotics. Using `antibiotics` will still work, but now returns a warning.
 * Removed all functions and references that used the deprecated `rsi` class, which were all replaced with their `sir` equivalents over two years ago.
 * Functions `resistance_predict()` and `sir_predict()` are now deprecated and will be removed in a future version. Use the `tidymodels` framework instead, for which we [wrote a basic introduction](https://amr-for-r.org/articles/AMR_with_tidymodels.html).
 
@@ -299,7 +39,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
   * `ab_atc()` now supports ATC codes of veterinary antimicrobials (that all start with "Q")
   * `ab_url()` now supports retrieving the WHOCC url of their ATCvet pages
 * **Support for WISCA antibiograms**  
-  * The `antibiogram()` function now supports creating true Weighted-Incidence Syndromic Combination Antibiograms (WISCA), a powerful Bayesian method for estimating regimen coverage probabilities using pathogen incidence and antimicrobial susceptibility data. WISCA offers improved precision for syndrome-specific treatment, even in data sets with sparse data. A dedicated `wisca()` function is also available for easy usage.
+  * The `antibiogram()` function now supports creating true Weighted-Incidence Syndromic Combination Antibiograms (WISCA), a powerful Bayesian method for estimating regimen coverage probabilities using pathogen incidence and antimicrobial susceptibility data. WISCA offers improved precision for syndrome-specific treatment, even in datasets with sparse data. A dedicated `wisca()` function is also available for easy usage.
 * **More global coverage of languages**
   * Added full support for 8 new languages: Arabic, Bengali, Hindi, Indonesian, Korean, Swahili, Urdu, and Vietnamese. The `AMR` package is now available in 28 languages.
 * **Major update to fungal taxonomy and tools for mycologists**
@@ -331,7 +71,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
 ### Changed
 * SIR interpretation
   * Support for parallel computing to greatly improve speed using the `parallel` package (part of base R). Use `as.sir(your_data, parallel = TRUE)` to run SIR interpretation using multiple cores.
-  * For `as.sir()`, it is now possible to use column names for arguments `guideline`, `ab`, `mo`, and `uti`
+  * It is now possible to use column names for arguments `guideline`, `ab`, `mo`, and `uti`: `as.sir(..., ab = "column1", mo = "column2", uti = "column3")`. This greatly improves the flexibility for users.
   * Users can now set their own criteria (using regular expressions) as to what should be considered S, I, R, SDD, and NI.
   * To get quantitative values, `as.double()` on a `sir` object will return 1 for S, 2 for SDD/I, and 3 for R (NI will become `NA`). Other functions using `sir` classes (e.g., `summary()`) are updated to reflect the change to contain NI and SDD.
   * Following CLSI interpretation rules, values outside the log2-dilution range will be rounded upwards to the nearest log2-level before interpretation. Only if using a CLSI guideline.

R/aa_amr-package.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -36,7 +36,7 @@
 #'
 #' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
 #'
-#' After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated `r paste(month.name[as.integer(format(AMR:::TAXONOMY_VERSION$GBIF$accessed_date, "%m"))], format(AMR:::TAXONOMY_VERSION$GBIF$accessed_date, "%Y"))`) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
+#' After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated June 2024) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
 #'
 #' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
 #' @section Download Our Reference Data:
@@ -45,7 +45,7 @@
 #' For maximum compatibility, we also provide machine-readable, tab-separated plain text files suitable for use in any software, including laboratory information systems.
 #'
 #' Visit [our website for direct download links](https://amr-for-r.org/articles/datasets.html), or explore the actual files in [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw/datasets).
-#' @references
+#' @source
 #' To cite AMR in publications use:
 #'
 #' Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2022). "AMR: An R Package for Working with Antimicrobial Resistance Data." _Journal of Statistical Software_, *104*(3), 1-31. \doi{10.18637/jss.v104.i03}

R/aa_globals.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,50 +27,44 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-# add new version numbers here, and add the rules themselves to "data-raw/interpretive_rules.tsv" and clinical_breakpoints
+# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and clinical_breakpoints
 # (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
 EUCAST_VERSION_BREAKPOINTS <- list(
-  "16.0" = list(
-    version_txt = "v16.0",
-    year = 2026,
-    title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
-  ),
   "15.0" = list(
     version_txt = "v15.0",
     year = 2025,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
+    url = "https://www.eucast.org/clinical_breakpoints/"
   ),
   "14.0" = list(
     version_txt = "v14.0",
     year = 2024,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
+    url = "https://www.eucast.org/clinical_breakpoints/"
   ),
   "13.1" = list(
     version_txt = "v13.1",
     year = 2023,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
+    url = "https://www.eucast.org/clinical_breakpoints/"
   ),
   "12.0" = list(
     version_txt = "v12.0",
     year = 2022,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
+    url = "https://www.eucast.org/clinical_breakpoints/"
   ),
   "11.0" = list(
     version_txt = "v11.0",
     year = 2021,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/"
+    url = "https://www.eucast.org/clinical_breakpoints/"
   ),
   "10.0" = list(
     version_txt = "v10.0",
     year = 2020,
     title = "'EUCAST Clinical Breakpoint Tables'",
-    url = "https://www.eucast.org/bacteria/document-archive/"
+    url = "https://www.eucast.org/ast_of_bacteria/previous_versions_of_documents/"
   )
 )
 EUCAST_VERSION_EXPERT_RULES <- list(
@@ -78,7 +72,19 @@ EUCAST_VERSION_EXPERT_RULES <- list(
     version_txt = "v3.3",
     year = 2021,
     title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
-    url = "https://www.eucast.org/bacteria/important-additional-information/expert-rules/"
+    url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
+  ),
+  "3.2" = list(
+    version_txt = "v3.2",
+    year = 2020,
+    title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
+    url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
+  ),
+  "3.1" = list(
+    version_txt = "v3.1",
+    year = 2016,
+    title = "'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes'",
+    url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
   )
 )
 EUCAST_VERSION_EXPECTED_PHENOTYPES <- list(
@@ -86,33 +92,32 @@ EUCAST_VERSION_EXPECTED_PHENOTYPES <- list(
     version_txt = "v1.2",
     year = 2023,
     title = "'EUCAST Expected Resistant Phenotypes'",
-    url = "https://www.eucast.org/bacteria/important-additional-information/expert-rules/"
+    url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
   )
 )
 
 TAXONOMY_VERSION <- list(
   GBIF = list(
-    name = "Global Biodiversity Information Facility (GBIF), via Catalogue of Life (COL)",
-    accessed_date = as.Date("2026-04-30"),
-    # take the citation from https://www.gbif.org/dataset/7ddf754f-d193-4cc9-b351-99906754a03b#citation
-    citation = "Banki, O. *et al.* (2026). Catalogue of Life (2026-04-18 XR). Catalogue of Life Foundation, Amsterdam, Netherlands. \\doi{10.48580/dgxjw}.",
+    name = "Global Biodiversity Information Facility (GBIF)",
+    accessed_date = as.Date("2024-06-24"),
+    citation = "GBIF Secretariat (2023). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
     url = "https://www.gbif.org"
   ),
   LPSN = list(
     name = "List of Prokaryotic names with Standing in Nomenclature (LPSN)",
-    accessed_date = as.Date("2026-10-05"),
-    citation = "Freese, HM *et al.* (2026). **TYGS and LPSN in 2025: a Global Core Biodata Resource for genome-based classification and nomenclature of prokaryotes within DSMZ Digital Diversity.** Nucleic Acids Research, 54, D884\u2013D891; \\doi{10.1093/nar/gkaf1110}.",
+    accessed_date = as.Date("2024-06-24"),
+    citation = "Parte, AC *et al.* (2020). **List of Prokaryotic names with Standing in Nomenclature (LPSN) moves to the DSMZ.** International Journal of Systematic and Evolutionary Microbiology, 70, 5607-5612; \\doi{10.1099/ijsem.0.004332}.",
     url = "https://lpsn.dsmz.de"
   ),
   MycoBank = list(
     name = "MycoBank",
-    accessed_date = as.Date("2026-01-07"),
+    accessed_date = as.Date("2024-06-24"),
     citation = "Vincent, R *et al* (2013). **MycoBank gearing up for new horizons.** IMA Fungus, 4(2), 371-9; \\doi{10.5598/imafungus.2013.04.02.16}.",
     url = "https://www.mycobank.org"
   ),
   BacDive = list(
     name = "BacDive",
-    accessed_date = as.Date("2026-10-05"),
+    accessed_date = as.Date("2024-07-16"),
     citation = "Reimer, LC *et al.* (2022). ***BacDive* in 2022: the knowledge base for standardized bacterial and archaeal data.** Nucleic Acids Res., 50(D1):D741-D74; \\doi{10.1093/nar/gkab961}.",
     url = "https://bacdive.dsmz.de"
   ),
@@ -137,14 +142,10 @@ TAXONOMY_VERSION <- list(
 )
 
 globalVariables(c(
-  ".coverage",
-  ".data",
   ".GenericCallEnv",
-  ".lower",
   ".mo",
   ".rowid",
   ".syndromic_group",
-  ".upper",
   "ab",
   "ab_txt",
   "affect_ab_name",
@@ -180,7 +181,6 @@ globalVariables(c(
   "hjust",
   "host_index",
   "host_match",
-  "incidence",
   "input",
   "input_given",
   "intrinsic_resistant",
@@ -208,7 +208,6 @@ globalVariables(c(
   "old",
   "old_name",
   "p_susceptible",
-  "pathogen",
   "pattern",
   "R",
   "rank_index",
@@ -216,8 +215,6 @@ globalVariables(c(
   "reference.rule",
   "reference.rule_group",
   "reference.version",
-  "regimen",
-  "rule.provider",
   "rowid",
   "rule_group",
   "rule_name",
@@ -236,7 +233,6 @@ globalVariables(c(
   "uti_index",
   "value",
   "varname",
-  "where",
   "x",
   "xvar",
   "y",

R/aa_helper_pm_functions.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -354,11 +354,8 @@ pm_group_data_worker <- function(.data, pm_groups) {
   class(res) <- "data.frame"
   nrow_res <- nrow(res)
   rows <- rep(list(NA), nrow_res)
-  # compute the group keys only once, instead of for every group
-  data_keys <- as.character(interaction(.data[, pm_groups]))
-  res_keys <- as.character(interaction(res[, pm_groups]))
   for (i in seq_len(nrow_res)) {
-    rows[[i]] <- which(data_keys %in% res_keys[i])
+    rows[[i]] <- which(interaction(.data[, pm_groups]) %in% interaction(res[i, pm_groups]))
   }
   res$`.rows` <- rows
   res <- res[do.call(order, lapply(pm_groups, function(x) res[, x])), , drop = FALSE]

R/aa_options.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,36 +27,25 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Options for the AMR Package
+#' Options for the AMR package
 #'
-#' @description
-#' This is an overview of all the package-specific options you can set in the `AMR` package. Set them using the [options()] function, e.g.:
-#'
-#' `options(AMR_guideline = "CLSI")`
-#' @section Options (alphabetical order):
+#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
+#' @section Options:
 #' * `AMR_antibiogram_formatting_type` \cr A [numeric] (1-22) to use in [antibiogram()], to indicate which formatting type to use.
-#' * `AMR_breakpoint_type` \cr A [character] to use in [as.sir()], to indicate which breakpoint type to use. This must be either `r vector_or(clinical_breakpoints$type, documentation = TRUE)`.
-#' * `AMR_capped_mic_handling` \cr A [character] to use in [as.sir()], to indicate how capped MIC values (`<`, `<=`, `>`, `>=`) should be interpreted. Must be one of `"none"`, `"conservative"`, `"standard"`, or `"lenient"` - the default is `"standard"`.
+#' * `AMR_breakpoint_type` \cr A [character] to use in [as.sir()], to indicate which breakpoint type to use. This must be either `r vector_or(clinical_breakpoints$type)`.
+#' * `AMR_capped_mic_handling` \cr A [character] to use in [as.sir()], to indicate how capped MIC values (`<`, `<=`, `>`, `>=`) should be interpreted. Must be one of `"standard"`, `"strict"`, `"relaxed"`, or `"inverse"` - the default is `"standard"`.
 #' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
 #' * `AMR_custom_ab` \cr A file location to an RDS file, to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
 #' * `AMR_custom_mo` \cr A file location to an RDS file, to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
-#' * `AMR_guideline` \cr A [character] to set the default guideline used throughout the `AMR` package wherever a `guideline` argument is available. This option is used as the default in e.g. [as.sir()], [resistance()], [susceptibility()], [interpretive_rules()] and many plotting functions. **While unset**, the AMR package uses the latest implemented EUCAST guideline (currently `r AMR::clinical_breakpoints$guideline[1]`). In aggregated analyses, this option determines whether the 'I' category is considered susceptible (EUCAST) or resistant (CLSI), see section *Interpretation of SIR* in [as.sir()]; setting it also silences the message that EUCAST is assumed.
-#'
-#'   - For [as.sir()], this determines which clinical breakpoint guideline is used to interpret MIC values and disk diffusion diameters. It can be either the guideline name (e.g., `"CLSI"` or `"EUCAST"`) or the name including a year (e.g., `"CLSI 2019"`). Supported guidelines are EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))` to `r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`, and CLSI `r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))` to `r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`.
-#'
-#'   - For [resistance()] and [susceptibility()], this setting determines how the `"I"` (Intermediate / Increased exposure) category is handled in calculations. Under CLSI, `"I"` is considered *resistant* in susceptibility calculations; under EUCAST, `"I"` is considered *susceptible* in susceptibility calculations. Explicitly setting this option ensures reproducible AMR proportion estimates.
-#'
-#'   - For [interpretive_rules()], this determines which guideline-specific interpretive (expert) rules are applied to antimicrobial test results, either EUCAST or CLSI.
-#'
-#'   - For many plotting functions (e.g., for MIC or disk diffusion values), supplying `mo` and `ab` enables automatic SIR-based interpretative colouring. These colours are derived from [as.sir()] in the background and therefore depend on the active `guideline` setting, which again uses `r AMR::clinical_breakpoints$guideline[1]` if not set explicitly.
+#' * `AMR_eucastrules` \cr A [character] to set the default types of rules for [eucast_rules()] function, must be one or more of: `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`.
+#' * `AMR_guideline` \cr A [character] to set the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
 #' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to ignore (i.e., make `NA`) any match given in [as.mo()] and all [`mo_*`][mo_property()] functions.
 #' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`.
-#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `NULL`, using these for screening agents only, such as `FOX-S`. See [as.sir()].
-#' * `AMR_interpretive_rules` \cr A [character] to set the default types of rules for [interpretive_rules()], [eucast_rules()] and [clsi_rules()], must be one or more of: `"breakpoints"`, `"expected_phenotypes"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expected_phenotypes")`. This option replaces the old option `AMR_eucastrules`.
+#' * `AMR_substitute_missing_r_breakpoint` \cr A [logical] to use in [as.sir()], to indicate that missing R breakpoints must be substituted with `"R"` - the default is `FALSE`.
+#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
 #' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
 #' * `AMR_locale` \cr A [character] to set the language for the `AMR` package, can be one of these supported language names or [ISO 639-1 codes](https://en.wikipedia.org/wiki/ISO_639-1): `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported, English otherwise).
 #' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
-#' * `AMR_substitute_missing_r_breakpoint` \cr A [logical] to use in [as.sir()], to indicate that missing R breakpoints must be substituted with `"R"` - the default is `FALSE`.
 #'
 #' @section Saving Settings Between Sessions:
 #' Settings in \R are not saved globally and are thus lost when \R is exited. You can save your options to your own `.Rprofile` file, which is a user-specific file. You can edit it using:
@@ -74,9 +63,9 @@
 #'
 #' ...to add Portuguese language support of antimicrobials, and allow PK/PD rules when interpreting MIC values with [as.sir()].
 #'
-#' ## Share Options Within Team
+#' ### Share Options Within Team
 #'
-#' For a more collaborative approach, e.g. within a (data) team, save an options file to a remote file location, such as a shared network drive, and have each user read in this file automatically at start-up. This would work in this way:
+#' For a more global approach, e.g. within a (data) team, save an options file to a remote file location, such as a shared network drive, and have each user read in this file automatically at start-up. This would work in this way:
 #'
 #' 1. Save a plain text file to e.g. "X:/team_folder/R_options.R" and fill it with preferred settings.
 #'

R/aa_session_cache.R

@@ -1,212 +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              #
-# ==================================================================== #
-
-
-# SESSION CACHES ------------------------------------------------------
-#
-# as.ab() and as.mo() share one cache design, kept in the package environment `AMR_env`:
-#
-# 1. Lookup indices, derived from `AMR_env$AB_lookup` and `AMR_env$MO_lookup` (e.g. all ATC codes or SNOMED
-#    codes as one flat vector). These are built lazily on first use, see get_ab_index() and get_mo_index().
-# 2. Coercion caches, `AMR_env$ab_previously_coerced` and `AMR_env$mo_previously_coerced`, that remember the
-#    outcome of earlier coercions. Both have the same structure: a `key` (the cleaned input together with the
-#    settings that affect the outcome), the original `input`, and the resulting code as `value`.
-# 3. Translated names of antimicrobials and microorganisms, built once per language, see get_ab_translated_index() and
-#    get_mo_translated_index().
-# 4. For microorganisms, the mapping from (outdated) codes to codes of currently accepted names, which is
-#    memoised per unique code, see synonym_mo_to_accepted_mo().
-#
-# All of these are invalidated with reset_ab_cache() or reset_mo_cache(), which must be called whenever the
-# lookup tables change, e.g. in add_custom_antimicrobials() and add_custom_microorganisms().
-# The prepared translation tables of translate_into_language(), see get_translation_table(), are kept for the whole
-# session, as the internal translations never change.
-
-new_coercion_cache <- function() {
-  data.frame(
-    key = character(0),
-    input = character(0),
-    value = character(0),
-    stringsAsFactors = FALSE
-  )
-}
-
-coercion_cache_key <- function(x, ...) {
-  # all arguments in `...` are settings that can change the outcome of a coercion, they become part of the key
-  if (length(x) == 0) {
-    return(character(0))
-  }
-  settings <- vapply(FUN.VALUE = character(1), list(...), function(s) paste0(s, collapse = ""))
-  paste(x, paste(settings, collapse = "|"), sep = "|")
-}
-
-coercion_cache_has <- function(type, keys) {
-  keys %in% AMR_env[[paste0(type, "_previously_coerced")]]$key
-}
-
-coercion_cache_get <- function(type, keys) {
-  cache <- AMR_env[[paste0(type, "_previously_coerced")]]
-  cache$value[match(keys, cache$key)]
-}
-
-coercion_cache_add <- function(type, keys, inputs, values) {
-  cache_name <- paste0(type, "_previously_coerced")
-  keep <- !is.na(keys) & !duplicated(keys)
-  if (!any(keep)) {
-    return(invisible(NULL))
-  }
-  keys <- keys[keep]
-  cache <- AMR_env[[cache_name]]
-  AMR_env[[cache_name]] <- rbind_AMR(
-    cache[which(!cache$key %in% keys), , drop = FALSE],
-    data.frame(
-      key = keys,
-      input = as.character(inputs[keep]),
-      value = as.character(values[keep]),
-      stringsAsFactors = FALSE
-    )
-  )
-  invisible(NULL)
-}
-
-reset_ab_cache <- function() {
-  AMR_env$AB_index <- NULL
-  AMR_env$AB_translated <- NULL
-  AMR_env$custom_ab_id_keys <- NULL
-  AMR_env$ab_previously_coerced <- new_coercion_cache()
-}
-
-mo_codes_valid <- function(x) {
-  # whether codes are in `AMR_env$MO_lookup`; a hashed set avoids scanning the whole lookup table for every check, as `[<-.mo` runs one for every piece that rbind() binds
-  x <- as.character(x)
-  if (length(x) > 1000) {
-    # for long vectors, base matching is faster than looking up every unique value
-    add_MO_lookup_to_AMR_env()
-    return(x %in% as.character(AMR_env$MO_lookup$mo))
-  }
-  if (is.null(AMR_env$MO_codes_hash)) {
-    add_MO_lookup_to_AMR_env()
-    codes <- unique(as.character(AMR_env$MO_lookup$mo))
-    AMR_env$MO_codes_hash <- list2env(stats::setNames(as.list(rep(TRUE, length(codes))), codes), hash = TRUE, size = length(codes))
-  }
-  ux <- unique(x)
-  valid <- vapply(
-    FUN.VALUE = logical(1),
-    ux,
-    function(code) !is.na(code) && nzchar(code) && exists(code, envir = AMR_env$MO_codes_hash, inherits = FALSE),
-    USE.NAMES = FALSE
-  )
-  valid[match(x, ux)]
-}
-
-reset_mo_cache <- function() {
-  AMR_env$MO_codes_hash <- NULL
-  AMR_env$MO_index <- NULL
-  AMR_env$MO_translated <- NULL
-  AMR_env$mo_accepted <- NULL
-  AMR_env$mo_previously_coerced <- new_coercion_cache()
-  AMR_env$mo_previously_uncertain <- NULL
-  AMR_env$taxonomy_names <- NULL
-}
-
-get_ab_index <- function() {
-  if (is.null(AMR_env$AB_index)) {
-    ab <- as.character(AMR_env$AB_lookup$ab)
-    atc <- unlist(AMR_env$AB_lookup$atc, use.names = FALSE)
-    atc_ab <- rep(ab, lengths(AMR_env$AB_lookup$atc))
-    synonyms <- tolower(unlist(AMR_env$AB_lookup$synonyms, use.names = FALSE))
-    synonyms_ab <- rep(ab, lengths(AMR_env$AB_lookup$synonyms))
-    # generalised LOINC codes, synonyms, and abbreviations as flat vectors, with the row number in `AMR_env$AB_lookup`
-    flat <- function(col) {
-      vals <- AMR_env$AB_lookup[[col]]
-      list(value = unlist(vals, use.names = FALSE), row = rep(seq_along(vals), lengths(vals)))
-    }
-    gen_syn <- flat("generalised_synonyms")
-    # synonyms of at least 5 characters, for the Levenshtein distance in as.ab()
-    gen_syn_long <- which(!is.na(gen_syn$value) & nchar(gen_syn$value) >= 5)
-    AMR_env$AB_index <- list(
-      atc = atc[!is.na(atc)],
-      atc_ab = atc_ab[!is.na(atc)],
-      synonyms = synonyms[!is.na(synonyms)],
-      synonyms_ab = synonyms_ab[!is.na(synonyms)],
-      generalised_loinc = flat("generalised_loinc"),
-      generalised_synonyms = gen_syn,
-      generalised_synonyms_long = list(value = gen_syn$value[gen_syn_long], row = gen_syn$row[gen_syn_long]),
-      generalised_abbreviations = flat("generalised_abbreviations")
-    )
-  }
-  AMR_env$AB_index
-}
-
-get_ab_translated_index <- function(language) {
-  # translated and generalised names of all antimicrobials, used by as.ab() for input that could not be matched otherwise
-  # this is built once per language
-  if (is.null(AMR_env$AB_translated[[language]])) {
-    AMR_env$AB_translated[[language]] <- generalise_antibiotic_name(translate_AMR(AMR_env$AB_lookup$name, language = language))
-  }
-  AMR_env$AB_translated[[language]]
-}
-
-get_mo_index <- function() {
-  add_MO_lookup_to_AMR_env()
-  if (is.null(AMR_env$MO_index)) {
-    snomed <- unlist(AMR_env$MO_lookup$snomed, use.names = FALSE)
-    snomed_mo <- rep(as.character(AMR_env$MO_lookup$mo), lengths(AMR_env$MO_lookup$snomed))
-    AMR_env$MO_index <- list(
-      snomed = snomed[!is.na(snomed)],
-      snomed_mo = snomed_mo[!is.na(snomed)]
-    )
-  }
-  AMR_env$MO_index
-}
-
-get_mo_translated_index <- function(language) {
-  # translated names of microorganisms, such as "Staphylocoque à coagulase négative (CoNS)", so that as.mo() recognises the output of mo_name() in that language
-  # this is built once per language and only contains the few names that change by translation
-  add_MO_lookup_to_AMR_env()
-  if (is.null(AMR_env$MO_translated[[language]])) {
-    trns <- TRANSLATIONS[which(TRANSLATIONS$affect_mo_name == TRUE), , drop = FALSE]
-    fullname <- AMR_env$MO_lookup$fullname
-    is_translatable <- grepl(paste0("(", paste(trns$pattern, collapse = "|"), ")"), fullname, perl = TRUE)
-    fullname <- fullname[is_translatable]
-    mo <- as.character(AMR_env$MO_lookup$mo[is_translatable])
-    translated <- translate_into_language(fullname, language = language, only_affect_mo_names = TRUE)
-    is_changed <- translated != fullname
-    translated <- translated[is_changed]
-    mo <- mo[is_changed]
-    # also without the abbreviation, such as "(CoNS)"
-    translated_short <- gsub(" +\\([^()]+\\)$", "", translated, perl = TRUE)
-    name <- tolower(c(translated, translated_short))
-    mo <- c(mo, mo)
-    AMR_env$MO_translated[[language]] <- list(
-      name = name[!duplicated(name)],
-      mo = mo[!duplicated(name)]
-    )
-  }
-  AMR_env$MO_translated[[language]]
-}

R/ab.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,7 +27,7 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Transform Input to an Antimicrobial Drug ID
+#' Transform Input to an Antibiotic ID
 #'
 #' Use this function to determine the antimicrobial drug code of one or more antimicrobials. The data set [antimicrobials] will be searched for abbreviations, official names and synonyms (brand names).
 #' @param x A [character] vector to determine to antibiotic ID.
@@ -48,15 +48,13 @@
 #'
 #' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see *Examples*.
 #'
-#' Results of non-exact input are remembered during the session, so that the same input is not matched again. Use [ab_reset_session()] to forget these results. They are also forgotten after [add_custom_antimicrobials()] or [clear_custom_antimicrobials()].
-#'
 #' Note: the [as.ab()] and [`ab_*`][ab_property()] functions may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems.
 #'
 #' You can add your own manual codes to be considered by [as.ab()] and all [`ab_*`][ab_property()] functions, see [add_custom_antimicrobials()].
 #' @section Source:
 #' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
 #'
-#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/index_en.htm}
+#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm}
 #' @aliases ab
 #' @return A [character] [vector] with additional class [`ab`]
 #' @seealso
@@ -110,62 +108,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   already_regex <- isTRUE(list(...)$already_regex)
   fast_mode <- isTRUE(list(...)$fast_mode)
 
-  # text that is not valid UTF-8 (e.g. exported in a local encoding such as CP949) makes the string
-  # functions below fail in a UTF-8 locale, so such values are returned as NA with a warning
-  # (checked on unique values only, as this runs on every call)
-  if (is.factor(x)) {
-    x <- as.character(x)
-  }
-  if (is.character(x)) {
-    x_unique <- unique(x[!is.na(x)])
-    invalid <- x %in% x_unique[!custom_ab_valid_utf8(x_unique)]
-    if (any(invalid)) {
-      warning_("in `as.ab()`: ", nr2char(sum(invalid)), " value", ifelse(sum(invalid) > 1, "s were", " was"), " not valid UTF-8 text and returned as `NA`. Convert such input first, e.g. with `iconv(x, from = \"CP949\", to = \"UTF-8\")`.")
-      x[invalid] <- NA_character_
-      if (all(is.na(x))) {
-        return(set_clean_class(rep(NA_character_, length(x)), new_class = c("ab", "character")))
-      }
-    }
-  }
-
-  # user-added synonyms (add_custom_antimicrobial_synonyms()) are matched on the input as given,
-  # before the input is transliterated to ASCII below, so that names in non-Latin scripts can be used
-  if (NROW(AMR_env$custom_ab_synonyms) > 0 && already_regex == FALSE && !isTRUE(list(...)$skip_custom_synonyms)) {
-    x_unique <- unique(x)
-    keys_unique <- custom_ab_synonym_key(x_unique)
-    hit_unique <- match(keys_unique, AMR_env$custom_ab_synonyms$key)
-    # no exact match: remove one trailing part at a time (part in parentheses or a strength such as "4.5g")
-    # and look the rest up after each removal, so that e.g. "Brand (comment) 4.5g" matches "Brand (comment)"
-    # before "Brand"; no words are removed, in any language; not for input that already identifies an antimicrobial as given
-    retry <- is.na(hit_unique) & !is.na(keys_unique) & !keys_unique %in% custom_ab_identifier_keys_cached()$key
-    if (any(retry)) {
-      idx <- which(retry)
-      cand <- custom_ab_strip_normalise(x_unique[idx])
-      repeat {
-        h <- match(custom_ab_synonym_key(cand), AMR_env$custom_ab_synonyms$key, incomparables = NA)
-        hit_unique[idx] <- h
-        left <- is.na(h)
-        if (!any(left)) break
-        idx <- idx[left]
-        stripped <- custom_ab_strip_step(cand[left])
-        moved <- stripped != cand[left]
-        if (!any(moved)) break
-        idx <- idx[moved]
-        cand <- stripped[moved]
-      }
-    }
-    hit <- hit_unique[match(x, x_unique)]
-    if (any(!is.na(hit))) {
-      out <- rep(NA_character_, length(x))
-      out[!is.na(hit)] <- AMR_env$custom_ab_synonyms$ab[hit[!is.na(hit)]]
-      rest <- is.na(hit) & !is.na(x)
-      if (any(rest)) {
-        out[rest] <- as.character(as.ab(x[rest], flag_multiple_results = flag_multiple_results, language = language, info = info, skip_custom_synonyms = TRUE, ...))
-      }
-      return(set_clean_class(out, new_class = c("ab", "character")))
-    }
-  }
-
   x_bak <- x
   x <- toupper(x)
 
@@ -177,14 +119,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   x[x %like_case% "^PENICILLIN" & x %unlike_case% "[ /+-]"] <- "benzylpenicillin"
   x_bak_clean <- x
   if (already_regex == FALSE) {
-    x_bak_clean_before_gen <- x_bak_clean
     x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
-    # generalise_antibiotic_name() rewrites "PH"->"F" and "TH"->"T", which
-    # mangles short valid AB codes (e.g. "ETH"->"ET", "PHN"->"FN", "STH"->"ST")
-    # making them unrecognisable in the lookup. Restore any values that were
-    # already valid AB codes before generalisation (#245).
-    is_valid_ab_code <- x_bak_clean_before_gen %in% AMR_env$AB_lookup$ab
-    x_bak_clean[is_valid_ab_code] <- x_bak_clean_before_gen[is_valid_ab_code]
   }
 
   x <- unique(x_bak_clean) # this means that every x is in fact generalise_antibiotic_name(x)
@@ -218,29 +153,43 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   known_names <- x %in% AMR_env$AB_lookup$generalised_name
   x_new[known_names] <- AMR_env$AB_lookup$ab[match(x[known_names], AMR_env$AB_lookup$generalised_name)]
   known_codes_ab <- x %in% AMR_env$AB_lookup$ab
-  # ATC codes and synonyms are looked up in flat vectors that are built once per session
-  ab_index <- get_ab_index()
-  x_atc <- gsub(" ", "", x, fixed = TRUE)
-  x_synonym <- gsub(" ", "", tolower(x), fixed = TRUE)
-  known_codes_atc <- x_atc %in% ab_index$atc
-  known_codes_synonyms <- x_synonym %in% ab_index$synonyms
+  known_codes_atc <- vapply(FUN.VALUE = logical(1), gsub(" ", "", x), function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE)
+  known_codes_synonyms <- vapply(FUN.VALUE = logical(1), gsub(" ", "", tolower(x)), function(x_) x_ %in% tolower(unlist(AMR_env$AB_lookup$synonyms)), USE.NAMES = FALSE)
   known_codes_cid <- x %in% AMR_env$AB_lookup$cid
   x_new[known_codes_ab] <- AMR_env$AB_lookup$ab[match(x[known_codes_ab], AMR_env$AB_lookup$ab)]
-  x_new[known_codes_atc] <- ab_index$atc_ab[match(x_atc[known_codes_atc], ab_index$atc)]
-  x_new[known_codes_synonyms] <- ab_index$synonyms_ab[match(x_synonym[known_codes_synonyms], ab_index$synonyms)]
+  x_new[known_codes_atc] <- AMR_env$AB_lookup$ab[vapply(
+    FUN.VALUE = integer(1),
+    gsub(" ", "", x[known_codes_atc]),
+    function(x_) {
+      which(vapply(
+        FUN.VALUE = logical(1),
+        AMR_env$AB_lookup$atc,
+        function(atc) x_ %in% atc
+      ))[1L]
+    },
+    USE.NAMES = FALSE
+  )]
+  x_new[known_codes_synonyms] <- AMR_env$AB_lookup$ab[vapply(
+    FUN.VALUE = integer(1),
+    gsub(" ", "", tolower(x[known_codes_synonyms])),
+    function(x_) {
+      which(vapply(
+        FUN.VALUE = logical(1),
+        AMR_env$AB_lookup$synonyms,
+        function(syns) x_ %in% tolower(syns)
+      ))[1L]
+    },
+    USE.NAMES = FALSE
+  )]
   x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
-  # From previous hits in this session ----
-  # the key contains all settings that can change the outcome, so that e.g. a `fast_mode` result is never reused otherwise
-  cache_keys <- coercion_cache_key(x, fast_mode, flag_multiple_results, language)
-  previously_coerced <- !is.na(x) & is.na(x_new) & coercion_cache_has("ab", cache_keys)
-  x_new[previously_coerced] <- coercion_cache_get("ab", cache_keys[previously_coerced])
-  previously_coerced_mention <- previously_coerced & !is.na(x_new)
+  previously_coerced <- x %in% AMR_env$ab_previously_coerced$x
+  x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)]
+  previously_coerced_mention <- x %in% AMR_env$ab_previously_coerced$x & !x %in% AMR_env$AB_lookup$ab & !x %in% AMR_env$AB_lookup$generalised_name
   if (any(previously_coerced_mention) && isTRUE(info) && message_not_thrown_before("as.ab", entire_session = TRUE)) {
-    only_one <- sum(previously_coerced_mention) == 1
     message_(
-      "Returning ", ifelse(only_one, "a ", ""), "previously coerced ",
-      ifelse(only_one, "value for an antimicrobial", "values for various antimicrobials"),
-      ". Run {.help [{.fun ab_reset_session}](AMR::ab_reset_session)} to reset this. This note will be shown once per session."
+      "Returning previously coerced ",
+      ifelse(length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) > 1, "value for an antimicrobial", "values for various antimicrobials"),
+      ". Run `ab_reset_session()` to reset this. This note will be shown once per session."
     )
   }
 
@@ -253,9 +202,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   if (sum(already_known) < length(x)) {
     progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
     on.exit(close(progress))
-    if (any(x_new[!already_known & !is.na(x_new)] %in% unlist(AMR_env$AV_lookup$generalised_all, use.names = FALSE), na.rm = TRUE)) {
-      warning_("in {.help [{.fun as.ab}](AMR::as.ab)}: some input seems to resemble antiviral drugs - use {.help [{.fun as.av}](AMR::as.av)} or e.g. {.help [{.fun av_name}](AMR::av_name)} for these, not {.help [{.fun as.ab}](AMR::as.ab)} or e.g. {.help [{.fun ab_name}](AMR::ab_name)}.")
-    }
   }
 
   for (i in which(!already_known)) {
@@ -299,25 +245,34 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
     }
 
     # exact LOINC code
-    idx <- get_ab_index()$generalised_loinc
-    found <- AMR_env$AB_lookup$ab[sort(unique(idx$row[idx$value %in% x[i]]))]
+    loinc_found <- unlist(lapply(
+      AMR_env$AB_lookup$generalised_loinc,
+      function(s) x[i] %in% s
+    ))
+    found <- AMR_env$AB_lookup$ab[loinc_found == TRUE]
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
 
     # exact synonym
-    idx <- get_ab_index()$generalised_synonyms
-    found <- AMR_env$AB_lookup$ab[sort(unique(idx$row[idx$value %in% x[i]]))]
+    synonym_found <- unlist(lapply(
+      AMR_env$AB_lookup$generalised_synonyms,
+      function(s) x[i] %in% s
+    ))
+    found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
     }
 
     # exact abbreviation
-    idx <- get_ab_index()$generalised_abbreviations
-    # require at least 2 characters for abbreviations
-    found <- AMR_env$AB_lookup$ab[sort(unique(idx$row[idx$value %in% x[i] & nchar(x[i]) >= 2]))]
+    abbr_found <- unlist(lapply(
+      AMR_env$AB_lookup$generalised_abbreviations,
+      # require at least 2 characters for abbreviations
+      function(s) x[i] %in% s && nchar(x[i]) >= 2
+    ))
+    found <- AMR_env$AB_lookup$ab[abbr_found == TRUE]
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
@@ -383,8 +338,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
     }
 
     # and try if any synonym starts with it
-    idx <- get_ab_index()$generalised_synonyms
-    found <- AMR_env$AB_lookup$ab[sort(unique(idx$row[idx$value %like% paste0("^", x_spelling)]))]
+    synonym_found <- unlist(lapply(
+      AMR_env$AB_lookup$generalised_synonyms,
+      function(s) any(s %like% paste0("^", x_spelling))
+    ))
+    found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
     if (length(found) > 0) {
       x_new[i] <- note_if_more_than_one_found(found, i, from_text)
       next
@@ -401,19 +359,24 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
         costs = c(insertions = 1, deletions = 1, substitutions = 2),
         counts = FALSE
       ))
-      # lowest distance to the synonyms of at least 5 characters, 999 if there are none
-      idx <- get_ab_index()$generalised_synonyms_long
-      lev_syn <- as.double(utils::adist(x[i], idx$value,
-        ignore.case = FALSE,
-        fixed = TRUE,
-        costs = c(insertions = 1, deletions = 1, substitutions = 2),
-        counts = FALSE
-      ))
-      ab_df$lev_syn <- 999
-      lev_syn_min <- vapply(FUN.VALUE = double(1), split(lev_syn, idx$row), min)
-      ab_df$lev_syn[as.integer(names(lev_syn_min))] <- lev_syn_min
+      ab_df$lev_syn <- vapply(
+        FUN.VALUE = double(1),
+        ab_df$generalised_synonyms,
+        function(y) {
+          ifelse(all(is.na(y)) || length(y[nchar(y) >= 5]) == 0,
+            999,
+            min(as.double(utils::adist(x[i], y[nchar(y) >= 5],
+              ignore.case = FALSE,
+              fixed = TRUE,
+              costs = c(insertions = 1, deletions = 1, substitutions = 2),
+              counts = FALSE
+            )), na.rm = TRUE)
+          )
+        },
+        USE.NAMES = FALSE
+      )
       if (!is.null(language) && language != "en") {
-        ab_df$trans <- get_ab_translated_index(language)
+        ab_df$trans <- generalise_antibiotic_name(translate_AMR(ab_df$name, language = language))
         ab_df$lev_trans <- as.double(utils::adist(x[i], ab_df$trans,
           ignore.case = FALSE,
           fixed = TRUE,
@@ -457,18 +420,21 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   }
 
   # save to package env to save time for next time
-  coerced_now <- which(!already_known & !is.na(x))
-  coercion_cache_add(
-    "ab",
-    keys = cache_keys[coerced_now],
-    inputs = x_bak[match(x[coerced_now], x_bak_clean)],
-    values = x_new[coerced_now]
-  )
+  AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
+  AMR_env$ab_previously_coerced <- unique(rbind_AMR(
+    AMR_env$ab_previously_coerced,
+    data.frame(
+      x = x,
+      ab = x_new,
+      x_bak = x_bak[match(x, x_bak_clean)],
+      stringsAsFactors = FALSE
+    )
+  ))
 
   # take failed ATC codes apart from rest
   if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
     warning_(
-      "in {.help [{.fun as.ab}](AMR::as.ab)}: these ATC codes are not (yet) in the antimicrobials data set: ",
+      "in `as.ab()`: these ATC codes are not (yet) in the antimicrobials data set: ",
       vector_and(x_unknown_ATCs), "."
     )
   }
@@ -477,28 +443,26 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
   x_unknown <- c(
     x_unknown,
-    x_bak[match(x[previously_coerced & is.na(x_new)], x_bak_clean)]
+    AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))]
   )
-  x_unknown <- unique(x_unknown[!x_unknown %in% c("", NA)])
+  x_unknown <- x_unknown[!x_unknown %in% c("", NA)]
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
-      "in {.help [{.fun as.ab}](AMR::as.ab)}: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
+      "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
       vector_and(x_unknown), "."
     )
   }
 
   # Throw note about uncertainties
-  x_uncertain <- x_uncertain[!is.na(x_uncertain)]
   if (isTRUE(info) && length(x_uncertain) > 0 && fast_mode == FALSE) {
     x_uncertain <- unique(x_uncertain)
     if (message_not_thrown_before("as.ab", "uncertainties", x_bak)) {
       if (length(x_uncertain) <= 3) {
-        ab_uncertain <- x_new[match(x_bak_clean[match(x_uncertain, x_bak)], x)]
         examples <- vector_and(
           paste0(
             '"', x_uncertain, '" (assumed ',
-            ab_name(ab_uncertain, language = NULL, tolower = TRUE),
-            ", ", ab_uncertain, ")"
+            ab_name(AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], language = NULL, tolower = TRUE),
+            ", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")"
           ),
           quotes = FALSE
         )
@@ -507,7 +471,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
       }
       message_(
         "Antimicrobial translation was uncertain for ", examples,
-        ". If required, use {.help [{.fun add_custom_antimicrobials}](AMR::add_custom_antimicrobials)} to add custom entries."
+        ". If required, use `add_custom_antimicrobials()` to add custom entries."
       )
     }
   }
@@ -533,28 +497,21 @@ is.ab <- function(x) {
 ab_reset_session <- function() {
   if (NROW(AMR_env$ab_previously_coerced) > 0) {
     message_("Reset ", nr2char(NROW(AMR_env$ab_previously_coerced)), " previously matched input value", ifelse(NROW(AMR_env$ab_previously_coerced) > 1, "s", ""), ".")
-    AMR_env$ab_previously_coerced <- new_coercion_cache()
+    AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[0, , drop = FALSE]
+    AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
   } else {
     message_("No previously matched input values to reset.")
   }
 }
 
-#' @rdname as.ab
-#' @details `NA_ab_` is a missing value of the new `ab` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
-#' @format NULL
-#' @export
-NA_ab_ <- set_clean_class(NA_character_,
-  new_class = c("ab", "character")
-)
-
 # this prevents the requirement for putting the dependency in Imports:
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
 pillar_shaft.ab <- function(x, ...) {
   out <- trimws(format(x))
-  out[is.na(x)] <- pillar::style_na(NA)
+  out[is.na(x)] <- font_na(NA)
 
   # add the names to the drugs as mouse-over!
-  if (in_rstudio()) {
+  if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
     out[!is.na(x)] <- font_url(
       url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
       txt = out[!is.na(x)]
@@ -576,27 +533,16 @@ type_sum.ab <- function(x, ...) {
 print.ab <- function(x, ...) {
   if (!is.null(attributes(x)$amr_selector)) {
     function_name <- attributes(x)$amr_selector
-    if (has_cli_rlang()) {
-      cli::cli_inform(c(
-        "i" = paste0("This {.cls ab} vector was retrieved using {.fun ", function_name, "}, which should normally be used inside a {.pkg dplyr} verb or {.cls data.frame} call, e.g.:"),
-        paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% select(", function_name, "())"))),
-        paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% select(column_a, column_b, ", function_name, "())"))),
-        paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data %>% filter(any(", function_name, "() == \"R\"))"))),
-        paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data[, ", function_name, "()]"))),
-        paste0("\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0("your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]")))
-      ))
-    } else {
-      message(word_wrap(paste0(
-        "This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a dplyr verb or data.frame call, e.g.:\n",
-        "\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
-        "\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
-        "\u00a0\u00a0", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
-        "\u00a0\u00a0", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
-        "\u00a0\u00a0", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
-      ), as_note = TRUE))
-    }
+    message_(
+      "This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a `dplyr` verb or `data.frame` call, e.g.:\n",
+      "  ", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
+      "  ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
+      "  ", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
+      "  ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
+      "  ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
+    )
   }
-  cat(format_inline_("Class {.cls ab}\n"))
+  cat("Class 'ab'\n")
   print(as.character(x), quote = FALSE)
 }
 
@@ -681,20 +627,6 @@ rep.ab <- function(x, ...) {
   out
 }
 
-# this prevents the requirement for putting the dependency in Imports:
-#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, ab)
-get_skimmers.ab <- function(column) {
-  ab <- as.ab(column, info = FALSE)
-  ab <- ab[!is.na(ab)]
-  skimr::sfl(
-    skim_type = "ab",
-    n_unique = ~ length(unique(ab)),
-    top_ab = ~ names(sort(-table(ab)))[1L],
-    top_ab_name = ~ names(sort(-table(ab_name(ab, info = FALSE))))[1L],
-    top_group = ~ names(sort(-table(ab_group(ab, info = FALSE))))[1L]
-  )
-}
-
 generalise_antibiotic_name <- function(x) {
   x <- toupper(x)
   # remove suffices
@@ -740,8 +672,8 @@ get_translate_ab <- function(translate_ab) {
   } else {
     translate_ab <- tolower(translate_ab)
     stop_ifnot(translate_ab %in% colnames(AMR::antimicrobials),
-      "invalid value for {.arg translate_ab}, this must be a column name of the {.help [antimicrobials](AMR::antimicrobials)} data set\n",
-      "or {.code TRUE} (equals {.val name}) or {.code FALSE} to not translate at all.",
+      "invalid value for 'translate_ab', this must be a column name of the `antimicrobials` data set\n",
+      "or `TRUE` (equals 'name') or `FALSE` to not translate at all.",
       call = FALSE
     )
     translate_ab

R/ab_from_text.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -212,7 +212,7 @@ ab_from_text <- function(text,
       }
     })
   } else {
-    stop_("{.arg type} must be either {.val drug}, {.val dose} or {.val administration}")
+    stop_("`type` must be either 'drug', 'dose' or 'administration'")
   }
 
   # collapse text if needed

R/ab_property.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,12 +27,12 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Get Properties of an Antimicrobial Drug
+#' Get Properties of an Antibiotic
 #'
 #' Use these functions to return a specific property of an antibiotic from the [antimicrobials] data set. All input values will be evaluated internally with [as.ab()].
 #' @param x Any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()].
 #' @param tolower A [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
-#' @param property One of the column names of one of the [antimicrobials] data set: `r vector_or(colnames(antimicrobials), documentation = TRUE, sort = FALSE)`.
+#' @param property One of the column names of one of the [antimicrobials] data set: `vector_or(colnames(antimicrobials), sort = FALSE)`.
 #' @param language Language of the returned text - the default is the current system language (see [get_AMR_locale()]) and can also be set with the package option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
 #' @param administration Way of administration, either `"oral"` or `"iv"`.
 #' @param open Browse the URL using [utils::browseURL()].
@@ -65,7 +65,6 @@
 #' ab_synonyms("AMX")
 #' ab_tradenames("AMX")
 #' ab_group("AMX")
-#' ab_group("AMX", all_groups = TRUE) # most specific to most general
 #' ab_atc_group1("AMX")
 #' ab_atc_group2("AMX")
 #' ab_url("AMX")
@@ -164,34 +163,11 @@ ab_tradenames <- function(x, ...) {
 }
 
 #' @rdname ab_property
-#' @param all_groups A [logical] to indicate whether all antimicrobial groups must be return as a vector for each input value. For example, an antibiotic in the "aminopenicillins" group, is also in the "penicillins" and "beta-lactams" groups. Setting `all_groups = TRUE` would return all three for such an antibiotic, while `all_groups = FALSE` (default) only returns the most specific group name.
 #' @export
-ab_group <- function(x, language = get_AMR_locale(), all_groups = FALSE, ...) {
+ab_group <- function(x, language = get_AMR_locale(), ...) {
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
-  meet_criteria(all_groups, allow_class = "logical", has_length = 1)
-
-  grps <- ab_validate(x = x, property = "group", ...)
-  for (i in seq_along(grps)) {
-    if (is.null(grps[[i]]) || all(is.na(grps[[i]]))) {
-      grps[[i]] <- NA_character_
-    }
-    if (all_groups == FALSE) {
-      # take the first match based on ABX_PRIORITY_LIST
-      grps[[i]] <- grps[[i]][1]
-    }
-  }
-  if (language != "en" && length(grps) > 0) {
-    # translate all groups at once
-    grps_translated <- translate_into_language(unlist(grps, use.names = FALSE), language = language, only_affect_ab_names = TRUE)
-    grps[] <- split(grps_translated, factor(rep(seq_along(grps), lengths(grps)), levels = seq_along(grps)))
-  }
-  names(grps) <- x
-  if (length(grps) == 1 || all_groups == FALSE) {
-    unname(unlist(grps))
-  } else {
-    grps
-  }
+  translate_into_language(ab_validate(x = x, property = "group", ...), language = language, only_affect_ab_names = TRUE)
 }
 
 #' @rdname ab_property
@@ -267,7 +243,7 @@ ab_ddd <- function(x, administration = "oral", ...) {
 
   if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
-      "in {.help [{.fun ab_ddd}](AMR::ab_ddd)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
+      "in `ab_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
       "Please refer to the WHOCC website:\n",
       "atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
     )
@@ -287,7 +263,7 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
 
   if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
-      "in {.help [{.fun ab_ddd_units}](AMR::ab_ddd_units)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
+      "in `ab_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
       "Please refer to the WHOCC website:\n",
       "atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
     )
@@ -306,7 +282,7 @@ ab_info <- function(x, language = get_AMR_locale(), ...) {
     ab = as.character(x),
     cid = ab_cid(x),
     name = ab_name(x, language = language),
-    group = ab_group(x, language = language, all_groups = TRUE),
+    group = ab_group(x, language = language),
     atc = ab_atc(x),
     atc_group1 = ab_atc_group1(x, language = language),
     atc_group2 = ab_atc_group2(x, language = language),
@@ -343,12 +319,12 @@ ab_url <- function(x, open = FALSE, ...) {
 
   NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(atcs)]
   if (length(NAs) > 0) {
-    warning_("in {.fun ab_url}: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
+    warning_("in `ab_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
   }
 
   if (open == TRUE) {
     if (length(u) > 1 && !is.na(u[1L])) {
-      warning_("in {.fun ab_url}: only the first URL will be opened, as {.fun browseURL} only suports one string.")
+      warning_("in `ab_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
     }
     if (!is.na(u[1L])) {
       utils::browseURL(u[1L])
@@ -363,7 +339,7 @@ ab_property <- function(x, property = "name", language = get_AMR_locale(), ...)
   meet_criteria(x, allow_NA = TRUE)
   meet_criteria(property, is_in = colnames(AMR::antimicrobials), has_length = 1)
   language <- validate_language(language)
-  translate_into_language(ab_validate(x = x, property = property, ...), language = language, only_affect_ab_names = TRUE)
+  translate_into_language(ab_validate(x = x, property = property, ...), language = language)
 }
 
 #' @rdname ab_property
@@ -399,7 +375,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
     }
     vars <- get_column_abx(df, info = FALSE, only_sir_columns = FALSE, sort = FALSE, fn = "set_ab_names")
     if (length(vars) == 0) {
-      message_("No columns with antibiotic results found for {.fun set_ab_names}, leaving names unchanged.")
+      message_("No columns with antibiotic results found for `set_ab_names()`, leaving names unchanged.")
       return(data)
     }
   } else {
@@ -426,7 +402,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
   )
   if (any(x %in% c("", NA))) {
     warning_(
-      "in {.help [{.fun set_ab_names}](AMR::set_ab_names)}: no ", property, " found for column(s): ",
+      "in `set_ab_names()`: no ", property, " found for column(s): ",
       vector_and(vars[x %in% c("", NA)], sort = FALSE)
     )
     x[x %in% c("", NA)] <- vars[x %in% c("", NA)]

R/age.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -67,7 +67,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
     } else if (length(reference) == 1) {
       reference <- rep(reference, length(x))
     } else {
-      stop_("{.arg x} and {.arg reference} must be of same length, or {.arg reference} must be of length 1.")
+      stop_("`x` and `reference` must be of same length, or `reference` must be of length 1.")
     }
   }
   x <- as.POSIXlt(x, ...)
@@ -109,10 +109,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 
   if (any(ages < 0, na.rm = TRUE)) {
     ages[!is.na(ages) & ages < 0] <- NA
-    warning_("in {.fun age}: NAs introduced for ages below 0.")
+    warning_("in `age()`: NAs introduced for ages below 0.")
   }
   if (any(ages > 120, na.rm = TRUE)) {
-    warning_("in {.fun age}: some ages are above 120.")
+    warning_("in `age()`: some ages are above 120.")
   }
 
   if (isTRUE(na.rm)) {
@@ -191,7 +191,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
 
   if (any(x < 0, na.rm = TRUE)) {
     x[x < 0] <- NA
-    warning_("in {.fun age_groups}: NAs introduced for ages below 0.")
+    warning_("in `age_groups()`: NAs introduced for ages below 0.")
   }
   if (is.character(split_at)) {
     split_at <- split_at[1L]
@@ -211,7 +211,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
     split_at <- c(0, split_at)
   }
   split_at <- split_at[!is.na(split_at)]
-  stop_if(length(split_at) == 1, "invalid value for {.arg split_at}.") # only 0 is available
+  stop_if(length(split_at) == 1, "invalid value for `split_at`.") # only 0 is available
 
   # turn input values to 'split_at' indices
   y <- x
@@ -228,7 +228,7 @@ age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm =
   agegroups <- factor(lbls[y], levels = lbls, ordered = TRUE)
 
   if (!is.null(names)) {
-    stop_ifnot(length(names) == length(levels(agegroups)), "{.arg names} must have the same length as the number of age groups (", length(levels(agegroups)), ").")
+    stop_ifnot(length(names) == length(levels(agegroups)), "`names` must have the same length as the number of age groups (", length(levels(agegroups)), ").")
     levels(agegroups) <- names
   }
 

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/amr_selectors.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -73,6 +73,7 @@
 #' # Though they are primarily intended to use for selections and filters.
 #' # Examples sections below are split into 'dplyr', 'base R', and 'data.table':
 #'
+#' \donttest{
 #' \dontrun{
 #' # dplyr -------------------------------------------------------------------
 #'
@@ -93,10 +94,8 @@
 #' # get AMR for all aminoglycosides e.g., per ward:
 #' example_isolates %>%
 #'   group_by(ward) %>%
-#'   summarise(across(
-#'     aminoglycosides(),
-#'     resistance
-#'   ))
+#'   summarise(across(aminoglycosides(),
+#'                    resistance))
 #'
 #' # You can combine selectors with '&' to be more specific:
 #' example_isolates %>%
@@ -106,10 +105,8 @@
 #' example_isolates %>%
 #'   filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
 #'   group_by(ward) %>%
-#'   summarise_at(
-#'     not_intrinsic_resistant(),
-#'     resistance
-#'   )
+#'   summarise_at(not_intrinsic_resistant(),
+#'                resistance)
 #'
 #' # get susceptibility for antimicrobials whose name contains "trim":
 #' example_isolates %>%
@@ -162,9 +159,8 @@
 #' y <- example_isolates %>% filter(carbapenems() == "R")
 #' z <- example_isolates %>% filter(if_all(carbapenems(), ~ .x == "R"))
 #' identical(x, y) && identical(y, z)
-#' }
 #'
-#' \donttest{
+#' }
 #' # base R ------------------------------------------------------------------
 #'
 #' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
@@ -206,7 +202,7 @@
 #' # data.table --------------------------------------------------------------
 #'
 #' # data.table is supported as well, just use it in the same way as with
-#' # base R, but add `with = FALSE` if using a single AMR selector.
+#' # base R, but add `with = FALSE` if using a single AB selector.
 #'
 #' if (require("data.table")) {
 #'   dt <- as.data.table(example_isolates)
@@ -219,7 +215,7 @@
 #'   dt[, carbapenems(), with = FALSE]
 #' }
 #'
-#' # for multiple selections or AMR selectors, `with = FALSE` is not needed:
+#' # for multiple selections or AB selectors, `with = FALSE` is not needed:
 #' if (require("data.table")) {
 #'   dt[, c("mo", aminoglycosides())]
 #' }
@@ -356,14 +352,6 @@ glycopeptides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("glycopeptides", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
-#' @rdname antimicrobial_selectors
-#' @export
-ionophores <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
-  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("ionophores", only_sir_columns = only_sir_columns, return_all = return_all)
-}
-
 #' @rdname antimicrobial_selectors
 #' @export
 isoxazolylpenicillins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
@@ -429,14 +417,6 @@ penicillins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("penicillins", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
-#' @rdname antimicrobial_selectors
-#' @export
-peptides <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
-  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("peptides", only_sir_columns = only_sir_columns, return_all = return_all)
-}
-
 #' @rdname antimicrobial_selectors
 #' @export
 phenicols <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
@@ -445,14 +425,6 @@ phenicols <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("phenicols", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
-#' @rdname antimicrobial_selectors
-#' @export
-phosphonics <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
-  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("phosphonics", only_sir_columns = only_sir_columns, return_all = return_all)
-}
-
 #' @rdname antimicrobial_selectors
 #' @export
 polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
@@ -478,14 +450,6 @@ rifamycins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("rifamycins", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
-#' @rdname antimicrobial_selectors
-#' @export
-spiropyrimidinetriones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
-  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  meet_criteria(return_all, allow_class = "logical", has_length = 1)
-  amr_select_exec("spiropyrimidinetriones", only_sir_columns = only_sir_columns, return_all = return_all)
-}
-
 #' @rdname antimicrobial_selectors
 #' @export
 streptogramins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
@@ -682,7 +646,7 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
   agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])]
   if (length(agents) > 0 &&
     message_not_thrown_before("not_intrinsic_resistant", sort(agents))) {
-    agents_formatted <- paste0("{.field ", font_bold(agents, collapse = NULL), "}")
+    agents_formatted <- paste0("'", 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], ")")
@@ -721,12 +685,12 @@ amr_select_exec <- function(function_name,
   }
 
   # untreatable drugs
-  untreatable <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam|inducible)")]
+  untreatable <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam)")]
   if (!is.null(vars_df) && only_treatable == TRUE) {
     if (any(untreatable %in% names(ab_in_data))) {
       if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
         warning_(
-          "in {.help [{.fun ", function_name, "}](AMR::", function_name, ")}: some drugs were ignored since they cannot be used for treatment: ",
+          "in `", function_name, "()`: some drugs were ignored since they cannot be used for treatment: ",
           vector_and(
             ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
               language = NULL,
@@ -749,9 +713,9 @@ amr_select_exec <- function(function_name,
   if (is.null(amr_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
     ab_group <- NULL
     if (isTRUE(function_name == "antifungals")) {
-      abx <- AMR_env$AB_lookup$ab[which(vapply(FUN.VALUE = logical(1), AMR_env$AB_lookup$group, function(x) "Antifungals" %in% x))]
+      abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antifungals")]
     } else if (isTRUE(function_name == "antimycobacterials")) {
-      abx <- AMR_env$AB_lookup$ab[which(vapply(FUN.VALUE = logical(1), AMR_env$AB_lookup$group, function(x) "Antimycobacterials" %in% x))]
+      abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antimycobacterials")]
     } else {
       # their upper case equivalent are vectors with class 'ab', created in data-raw/_pre_commit_checks.R
       # carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
@@ -759,11 +723,7 @@ amr_select_exec <- function(function_name,
       # manually added codes from add_custom_antimicrobials() must also be supported
       if (length(AMR_env$custom_ab_codes) > 0) {
         custom_ab <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% AMR_env$custom_ab_codes), ]
-        check_string <- paste0(
-          vapply(FUN.VALUE = character(1), custom_ab$group, function(x) paste(x, collapse = " ")),
-          custom_ab$atc_group1,
-          custom_ab$atc_group2
-        )
+        check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2)
         if (function_name == "betalactams") {
           find_group <- "beta[-]?lactams"
         } else if (function_name %like% "cephalosporins_") {
@@ -801,14 +761,14 @@ amr_select_exec <- function(function_name,
     if (only_treatable == TRUE) {
       if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
         message_(
-          "in {.help [{.fun ", function_name, "}](AMR::", function_name, ")}: ",
+          "in `", function_name, "()`: ",
           vector_and(
             paste0(
               ab_name(abx[abx %in% untreatable],
                 language = NULL,
                 tolower = TRUE
               ),
-              " ({.field ", font_bold(abx[abx %in% untreatable], collapse = NULL), "})"
+              " (`", abx[abx %in% untreatable], "`)"
             ),
             quotes = FALSE,
             sort = TRUE,
@@ -841,10 +801,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 {.arg 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 data.table? Then add the argument `with = FALSE`, see our examples at `?amr_selector`.",
     immediate = TRUE
   )
-  cat(format_inline_("Class {.cls amr_selector}\n"))
+  cat("Class 'amr_selector'\n")
   print(as.character(x), quote = FALSE)
 }
 
@@ -859,10 +819,10 @@ c.amr_selector <- function(...) {
 
 all_any_amr_selector <- function(type, ..., na.rm = TRUE) {
   cols_ab <- c(...)
-  result <- cols_ab[toupper(cols_ab) %in% VALID_SIR_LEVELS]
+  result <- cols_ab[toupper(cols_ab) %in% c("S", "SDD", "I", "R", "NI")]
   if (length(result) == 0) {
-    message_("Filtering ", type, " of columns ", vector_and(paste0("{.field ", font_bold(cols_ab, collapse = NULL), "}"), quotes = FALSE), " to only contain values ", vector_or(VALID_SIR_LEVELS))
-    result <- VALID_SIR_LEVELS
+    message_("Filtering ", type, " of columns ", vector_and(font_bold(cols_ab, collapse = NULL), quotes = "'"), ' to contain value "S", "I" or "R"')
+    result <- c("S", "SDD", "I", "R", "NI")
   }
   cols_ab <- cols_ab[!cols_ab %in% result]
   df <- get_current_data(arg_name = NA, call = -3)
@@ -941,7 +901,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 {.fun all} or {.fun any} to prevent this note."
+        ". Wrap around `all()` or `any()` to prevent this note."
       )
     }
   }
@@ -966,12 +926,12 @@ 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 {.fun all} or {.fun any} to prevent this note."
+        ". Wrap around `all()` or `any()` to prevent this note."
       )
     }
   }
   # this is `!=`, so turn around the values
-  sir <- VALID_SIR_LEVELS
+  sir <- c("S", "SDD", "I", "R", "NI")
   e2 <- sir[sir != e2]
   structure(all_any_amr_selector(type = type, e1, e2),
     class = c("amr_selector_any_all", "logical")
@@ -1041,11 +1001,11 @@ find_ab_names <- function(ab_group, n = 3) {
   # try popular first, they have DDDs
   drugs <- AMR_env$AB_lookup[which((!is.na(AMR_env$AB_lookup$iv_ddd) | !is.na(AMR_env$AB_lookup$oral_ddd)) &
     AMR_env$AB_lookup$name %unlike% " " &
-    vapply(FUN.VALUE = character(1), AMR_env$AB_lookup$group, function(x) paste(x, collapse = " ")) %like% ab_group &
+    AMR_env$AB_lookup$group %like% ab_group &
     AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
   if (length(drugs) < n) {
     # now try it all
-    drugs <- AMR_env$AB_lookup[which((vapply(FUN.VALUE = character(1), AMR_env$AB_lookup$group, function(x) paste(x, collapse = " ")) %like% ab_group |
+    drugs <- AMR_env$AB_lookup[which((AMR_env$AB_lookup$group %like% ab_group |
       AMR_env$AB_lookup$atc_group1 %like% ab_group |
       AMR_env$AB_lookup$atc_group2 %like% ab_group) &
       AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
@@ -1066,7 +1026,7 @@ message_agent_names <- function(function_name, agents, ab_group = NULL, examples
   if (message_not_thrown_before(function_name, sort(agents))) {
     if (length(agents) == 0) {
       if (is.null(ab_group)) {
-        message_("For {.help [{.fun ", function_name, "}](AMR::", function_name, ")} no antimicrobial drugs found", examples, ".")
+        message_("For `", function_name, "()` no antimicrobial drugs found", examples, ".")
       } else if (ab_group == "administrable_per_os") {
         message_("No orally administrable drugs found", examples, ".")
       } else if (ab_group == "administrable_iv") {
@@ -1075,12 +1035,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("{.field ", font_bold(agents, collapse = NULL), "}")
+      agents_formatted <- paste0("'", 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 {.help [", function_name, "(",
+        "For `", function_name, "(",
         ifelse(function_name == "amr_class",
           paste0("\"", amr_class_args, "\""),
           ifelse(!is.null(call),
@@ -1088,7 +1048,7 @@ message_agent_names <- function(function_name, agents, ab_group = NULL, examples
             ""
           )
         ),
-        ")](AMR::", function_name, ")} using ",
+        ")` using ",
         ifelse(length(agents) == 1, "column ", "columns "),
         vector_and(agents_formatted, quotes = FALSE, sort = FALSE)
       )

R/atc_online.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -99,12 +99,12 @@ atc_online_property <- function(atc_code,
   read_html <- import_fn("read_html", "xml2")
 
   if (!all(atc_code %in% unlist(AMR::antimicrobials$atc))) {
-    missing <- atc_code %unlike% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]"
-    atc_code[missing] <- as.character(ab_atc(atc_code[missing], only_first = TRUE))
+    atc_code <- as.character(ab_atc(atc_code, only_first = TRUE))
   }
 
   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 +180,7 @@ atc_online_property <- function(atc_code,
       colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
 
       if (length(out) == 0) {
-        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}.")
+        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/av.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -475,7 +475,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   # take failed ATC codes apart from rest
   if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
     warning_(
-      "in {.help [{.fun as.av}](AMR::as.av)}: these ATC codes are not (yet) in the antivirals data set: ",
+      "in `as.av()`: these ATC codes are not (yet) in the antivirals data set: ",
       vector_and(x_unknown_ATCs), "."
     )
   }
@@ -486,7 +486,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   )
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
-      "in {.help [{.fun as.av}](AMR::as.av)}: these values could not be coerced to a valid antiviral drug ID: ",
+      "in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
       vector_and(x_unknown), "."
     )
   }
@@ -511,8 +511,8 @@ is.av <- function(x) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
 pillar_shaft.av <- function(x, ...) {
   out <- trimws(format(x))
-  out[!is.na(x)] <- gsub("+", pillar::style_subtle("+"), out[!is.na(x)], fixed = TRUE)
-  out[is.na(x)] <- pillar::style_na(NA)
+  out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
+  out[is.na(x)] <- font_na(NA)
   create_pillar_column(out, align = "left", min_width = 4)
 }
 
@@ -526,7 +526,7 @@ type_sum.av <- function(x, ...) {
 #' @export
 #' @noRd
 print.av <- function(x, ...) {
-  cat(format_inline_("Class {.cls av}\n"))
+  cat("Class 'av'\n")
   print(as.character(x), quote = FALSE)
 }
 

R/av_from_text.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -168,7 +168,7 @@ av_from_text <- function(text,
       }
     })
   } else {
-    stop_("{.arg type} must be either {.val drug}, {.val dose} or {.val administration}")
+    stop_("`type` must be either 'drug', 'dose' or 'administration'")
   }
 
   # collapse text if needed

R/av_property.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -32,7 +32,7 @@
 #' Use these functions to return a specific property of an antiviral drug from the [antivirals] data set. All input values will be evaluated internally with [as.av()].
 #' @param x Any (vector of) text that can be coerced to a valid antiviral drug code with [as.av()].
 #' @param tolower A [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character].
-#' @param property One of the column names of one of the [antivirals] data set: `r vector_or(colnames(antivirals), documentation = TRUE, sort = FALSE)`.
+#' @param property One of the column names of one of the [antivirals] data set: `vector_or(colnames(antivirals), sort = FALSE)`.
 #' @param language Language of the returned text - the default is system language (see [get_AMR_locale()]) and can also be set with the package option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
 #' @param administration Way of administration, either `"oral"` or `"iv"`.
 #' @param open Browse the URL using [utils::browseURL()].
@@ -162,7 +162,7 @@ av_ddd <- function(x, administration = "oral", ...) {
 
   if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
-      "in {.help [{.fun av_ddd}](AMR::av_ddd)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
+      "in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
       "Please refer to the WHOCC website:\n",
       "atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
     )
@@ -182,7 +182,7 @@ av_ddd_units <- function(x, administration = "oral", ...) {
 
   if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
-      "in {.help [{.fun av_ddd_units}](AMR::av_ddd_units)}: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
+      "in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
       "Please refer to the WHOCC website:\n",
       "atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
     )
@@ -233,12 +233,12 @@ av_url <- function(x, open = FALSE, ...) {
 
   NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
   if (length(NAs) > 0) {
-    warning_("in {.fun av_url}: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
+    warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
   }
 
   if (open == TRUE) {
     if (length(u) > 1 && !is.na(u[1L])) {
-      warning_("in {.fun av_url}: only the first URL will be opened, as {.fun browseURL} only suports one string.")
+      warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
     }
     if (!is.na(u[1L])) {
       utils::browseURL(u[1L])

R/availability.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

R/bug_drug_combinations.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -31,8 +31,7 @@
 #'
 #' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publishable/printable format, see *Examples*.
 #' @inheritParams eucast_rules
-#' @param guideline A guideline name, `"EUCAST"` or `"CLSI"` (or any version thereof, e.g. `"CLSI 2025"`), to determine whether the 'I' category is considered susceptible (EUCAST) or resistant (CLSI) when calculating resistance with [format()]. The default is the package option [`AMR_guideline`][AMR-options], or `"EUCAST"` if it is not set. In [bug_drug_combinations()], this can also be `NULL` or `FALSE`, after which [format()] requires its own `guideline` to be set. In [format()], the default is the guideline used in [bug_drug_combinations()], which can be overridden by setting it. See section *Interpretation of SIR* below.
-#' @param combine_SI *(deprecated in favour of `guideline`)* A [logical]. If set, it takes precedence over `guideline`: `TRUE` bases resistance on R only, and `FALSE` on SDD, I, and R.
+#' @param combine_SI A [logical] to indicate whether values S, SDD, and I should be summed, so resistance will be based on only R - the default is `TRUE`.
 #' @param add_ab_group A [logical] to indicate where the group of the antimicrobials must be included as a first column.
 #' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table.
 #' @param FUN The function to call on the `mo` column to transform the microorganism codes - the default is [mo_shortname()].
@@ -41,11 +40,10 @@
 #' @param ... Arguments passed on to `FUN`.
 #' @inheritParams sir_df
 #' @inheritParams base::formatC
-#' @inheritSection as.sir Interpretation of SIR
-#' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Following the `guideline`, resistance is based on R (EUCAST) or on I and R (CLSI), see section *Interpretation of SIR* below. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()].
+#' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()].
 #' @export
 #' @rdname bug_drug_combinations
-#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "SDD", "I", "R", "NI", "WT", "NWT", "NS", and "total".
+#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "SDD", "I", "R", and "total".
 #' @examples
 #' # example_isolates is a data set available in the AMR package.
 #' # run ?example_isolates for more info.
@@ -74,11 +72,8 @@ bug_drug_combinations <- function(x,
                                   col_mo = NULL,
                                   FUN = mo_shortname,
                                   include_n_rows = FALSE,
-                                  guideline = getOption("AMR_guideline", "EUCAST"),
                                   ...) {
   meet_criteria(x, allow_class = "data.frame")
-  guideline_assumed <- missing(guideline)
-  guideline <- validate_sir_guideline(guideline, fn = "bug_drug_combinations", allow_none = TRUE)
   x <- ascertain_sir_classes(x, "x")
   meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), has_length = 1, allow_NULL = TRUE)
   meet_criteria(FUN, allow_class = "function", has_length = 1)
@@ -87,9 +82,9 @@ bug_drug_combinations <- function(x,
   # -- mo
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo")
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
+    stop_if(is.null(col_mo), "`col_mo` must be set")
   } else {
-    stop_ifnot(col_mo %in% colnames(x), "column {.field ", font_bold(col_mo), "} ({.arg col_mo}) not found")
+    stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
   }
 
   x.bak <- x
@@ -116,8 +111,6 @@ bug_drug_combinations <- function(x,
       SDD = integer(0),
       I = integer(0),
       R = integer(0),
-      WT = integer(0),
-      NWT = integer(0),
       total = integer(0),
       total_rows = integer(0),
       stringsAsFactors = FALSE
@@ -134,21 +127,13 @@ bug_drug_combinations <- function(x,
       # turn and merge everything
       pivot <- lapply(x_mo_filter, function(x) {
         m <- as.matrix(table(as.sir(x), useNA = "always"))
-        na_idx <- which(is.na(rownames(m)))
-        get_row <- function(lbl) {
-          idx <- which(rownames(m) == lbl)
-          if (length(idx) == 1L) unname(m[idx, ]) else rep(0L, ncol(m))
-        }
         data.frame(
-          S = get_row("S"),
-          SDD = get_row("SDD"),
-          I = get_row("I"),
-          R = get_row("R"),
-          NI = get_row("NI"),
-          WT = get_row("WT"),
-          NWT = get_row("NWT"),
-          NS = get_row("NS"),
-          na = if (length(na_idx) == 1L) unname(m[na_idx, ]) else rep(0L, ncol(m)),
+          S = m["S", ],
+          SDD = m["SDD", ],
+          I = m["I", ],
+          R = m["R", ],
+          NI = m["NI", ],
+          na = m[which(is.na(rownames(m))), ],
           stringsAsFactors = FALSE
         )
       })
@@ -161,11 +146,8 @@ bug_drug_combinations <- function(x,
         I = merged$I,
         R = merged$R,
         NI = merged$NI,
-        WT = merged$WT,
-        NWT = merged$NWT,
-        NS = merged$NS,
-        total = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$WT + merged$NWT + merged$NS,
-        total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$WT + merged$NWT + merged$NS + merged$na,
+        total = merged$S + merged$SDD + merged$I + merged$R + merged$NI,
+        total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$na,
         stringsAsFactors = FALSE
       )
       if (data_has_groups) {
@@ -207,9 +189,6 @@ bug_drug_combinations <- function(x,
   out <- out %pm>% pm_arrange(mo, ab)
   class(out) <- c("bug_drug_combinations", if (data_has_groups) "grouped" else NULL, class(out))
   rownames(out) <- NULL
-  # the guideline is used by format() to calculate resistance, FALSE means that 'I' must not be merged
-  attr(out, "guideline") <- if (is.null(guideline)) FALSE else guideline
-  attr(out, "guideline_assumed") <- guideline_assumed
   out
 }
 
@@ -220,8 +199,7 @@ format.bug_drug_combinations <- function(x,
                                          translate_ab = "name (ab, atc)",
                                          language = get_AMR_locale(),
                                          minimum = 30,
-                                         combine_SI,
-                                         guideline = attr(x, "guideline"),
+                                         combine_SI = TRUE,
                                          add_ab_group = TRUE,
                                          remove_intrinsic_resistant = FALSE,
                                          decimal.mark = getOption("OutDec"),
@@ -231,26 +209,7 @@ format.bug_drug_combinations <- function(x,
   meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
   language <- validate_language(language)
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
-  if (!missing(combine_SI)) {
-    # deprecated argument, if set it must be followed literally, regardless of the guideline
-    meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
-    deprecation_warning("combine_SI", "guideline", fn = "format", is_argument = TRUE, extra_msg = "As long as `combine_SI` is set, it takes precedence over `guideline`. Use `guideline = \"EUCAST\"` to base resistance on R only, or `guideline = \"CLSI\"` to base resistance on I and R.")
-    R_values <- c("R", "NWT", "NS", if (isFALSE(combine_SI)) c("SDD", "I"))
-  } else {
-    guideline_assumed <- FALSE
-    if (missing(guideline)) {
-      guideline_assumed <- !isFALSE(attr(x, "guideline_assumed"))
-      if (is.null(guideline)) {
-        # e.g., created with an older version of this package
-        guideline <- getOption("AMR_guideline", "EUCAST")
-      }
-    }
-    guideline <- validate_sir_guideline(guideline, fn = "bug_drug_combinations")
-    if (isTRUE(guideline_assumed)) {
-      message_guideline_assumed("bug_drug_combinations", txt = " when calculating resistance in {.fun format} (R vs. S+SDD+I). Use {.code guideline = \"CLSI\"} for I+R vs. S+SDD.")
-    }
-    R_values <- c("R", "NWT", "NS", if (identical(guideline, "CLSI")) "I")
-  }
+  meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(add_ab_group, allow_class = "logical", has_length = 1)
   meet_criteria(remove_intrinsic_resistant, allow_class = "logical", has_length = 1)
   meet_criteria(decimal.mark, allow_class = "character", has_length = 1)
@@ -259,7 +218,7 @@ format.bug_drug_combinations <- function(x,
   x.bak <- x
   if (inherits(x, "grouped")) {
     # bug_drug_combinations() has been run on groups, so de-group here
-    warning_("in {.fun format}: formatting the output of {.fun bug_drug_combinations} does not support grouped variables, they were ignored")
+    warning_("in `format()`: formatting the output of `bug_drug_combinations()` does not support grouped variables, they were ignored")
     x <- as.data.frame(x, stringsAsFactors = FALSE)
     idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
     x <- data.frame(
@@ -270,17 +229,12 @@ format.bug_drug_combinations <- function(x,
       I = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$I[i], na.rm = TRUE)),
       R = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$R[i], na.rm = TRUE)),
       NI = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NI[i], na.rm = TRUE)),
-      WT = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$WT[i], na.rm = TRUE)),
-      NWT = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NWT[i], na.rm = TRUE)),
-      NS = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NS[i], na.rm = TRUE)),
       total = vapply(FUN.VALUE = double(1), idx, function(i) {
         sum(x$S[i], na.rm = TRUE) +
           sum(x$SDD[i], na.rm = TRUE) +
           sum(x$I[i], na.rm = TRUE) +
           sum(x$R[i], na.rm = TRUE) +
-          sum(x$WT[i], na.rm = TRUE) +
-          sum(x$NWT[i], na.rm = TRUE) +
-          sum(x$NS[i], na.rm = TRUE)
+          sum(x$NI[i], na.rm = TRUE)
       }),
       stringsAsFactors = FALSE
     )
@@ -292,8 +246,11 @@ format.bug_drug_combinations <- function(x,
   if (remove_intrinsic_resistant == TRUE) {
     x <- subset(x, R != total)
   }
-
-  x$isolates <- rowSums(x[, R_values, drop = FALSE])
+  if (combine_SI == TRUE) {
+    x$isolates <- x$R
+  } else {
+    x$isolates <- x$R + x$I + x$SDD
+  }
 
   give_ab_name <- function(ab, format, language) {
     format <- tolower(format)

R/count.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -37,10 +37,12 @@
 #' @inheritSection as.sir Interpretation of SIR
 #' @details These functions are meant to count isolates. Use the [resistance()]/[susceptibility()] functions to calculate microbial resistance/susceptibility.
 #'
-#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where the input antimicrobial has an available result (S, I or R). For multiple antimicrobials, these are isolates with a result for any of the antimicrobials, or with `only_all_tested = TRUE`, for all of the antimicrobials (see *Combination Therapy* below). Their use is equal to `dplyr`'s `n_distinct()`. For one antimicrobial, their function is equal to `count_susceptible(...) + count_resistant(...)`.
+#' The function [count_resistant()] is equal to the function [count_R()]. The function [count_susceptible()] is equal to the function [count_SI()].
+#'
+#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antimicrobials have an available result (S, I or R). Their use is equal to `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`.
 #'
 #' The function [count_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and counts the number of S's, I's and R's. It also supports grouped variables. The function [sir_df()] works exactly like [count_df()], but adds the percentage of S, I and R.
-#' @inheritSection sir_combine Combination Therapy
+#' @inheritSection proportion Combination Therapy
 #' @seealso [`proportion_*`][proportion] to calculate microbial resistance and susceptibility.
 #' @return An [integer]
 #' @rdname count
@@ -117,22 +119,11 @@
 #'     count_df(translate = FALSE)
 #' }
 #' }
-count_resistant <- function(...,
-                            only_all_tested = FALSE,
-                            guideline = getOption("AMR_guideline", "EUCAST")) {
-  # other arguments for meet_criteria are handled by sir_calc()
-  if (missing(guideline)) {
-    message_guideline_assumed("count_resistant", txt = ". Use {.code guideline = \"CLSI\"} to consider it resistant.")
-  }
-  guideline <- validate_sir_guideline(guideline, fn = "count_resistant")
+count_resistant <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c(
-        "R", "NWT", "NS",
-        if (identical(guideline, "CLSI")) "I"
-      ),
+      ab_result = "R",
       only_all_tested = only_all_tested,
-      guideline = guideline,
       only_count = TRUE
     ),
     error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
@@ -141,22 +132,11 @@ count_resistant <- function(...,
 
 #' @rdname count
 #' @export
-count_susceptible <- function(...,
-                              only_all_tested = FALSE,
-                              guideline = getOption("AMR_guideline", "EUCAST")) {
-  # other arguments for meet_criteria are handled by sir_calc()
-  if (missing(guideline)) {
-    message_guideline_assumed("count_susceptible", txt = ". Use {.code guideline = \"CLSI\"} to consider it resistant.")
-  }
-  guideline <- validate_sir_guideline(guideline, fn = "count_susceptible")
+count_susceptible <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c(
-        "S", "SDD", "WT",
-        if (identical(guideline, "EUCAST")) "I"
-      ),
+      ab_result = c("S", "SDD", "I"),
       only_all_tested = only_all_tested,
-      guideline = guideline,
       only_count = TRUE
     ),
     error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
@@ -181,7 +161,7 @@ count_S <- function(..., only_all_tested = FALSE) {
 count_SI <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("S", "SDD", "I", "WT"),
+      ab_result = c("S", "SDD", "I"),
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
@@ -207,7 +187,7 @@ count_I <- function(..., only_all_tested = FALSE) {
 count_IR <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("I", "SDD", "R", "NWT"),
+      ab_result = c("I", "SDD", "R"),
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
@@ -220,7 +200,7 @@ count_IR <- function(..., only_all_tested = FALSE) {
 count_R <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("R", "NWT", "NS"),
+      ab_result = "R",
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
@@ -233,7 +213,7 @@ count_R <- function(..., only_all_tested = FALSE) {
 count_all <- function(..., only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = VALID_SIR_LEVELS,
+      ab_result = c("S", "SDD", "I", "R", "NI"),
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
@@ -250,17 +230,15 @@ n_sir <- count_all
 count_df <- function(data,
                      translate_ab = "name",
                      language = get_AMR_locale(),
-                     combine_SI,
-                     guideline = getOption("AMR_guideline", "EUCAST")) {
-  guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "count_df")
+                     combine_SI = TRUE) {
   tryCatch(
     sir_calc_df(
       type = "count",
       data = data,
       translate_ab = translate_ab,
       language = language,
-      confidence_level = 0.95, # doesn't matter, will be removed
-      guideline = guideline
+      combine_SI = combine_SI,
+      confidence_level = 0.95 # doesn't matter, will be removed
     ),
     error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )

R/custom_antimicrobials.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -30,16 +30,14 @@
 #' Add Custom Antimicrobials
 #'
 #' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes.
-#' @param x A [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name". To add synonyms to existing antimicrobials, columns "ab" and "synonyms" suffice (see *Details*).
-#' @param ab For [add_custom_antimicrobial_synonyms()]: a [character] vector of existing antimicrobial codes (see [as.ab()]), or a [data.frame] with columns "ab" and "synonyms" (one synonym per row).
-#' @param synonyms A [character] vector of synonyms. If `ab` has length 1, all `synonyms` are added to that antimicrobial; otherwise `ab` and `synonyms` must have the same length.
+#' @param x A [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name".
 #' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
 #'
 #' There are two ways to circumvent this and automate the process of adding antimicrobials:
 #'
 #' **Method 1:** Using the package option [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
 #'
-#'    1. Create a data set in the structure of the [antimicrobials] data set (containing at the very least columns "ab" and "name", or only columns "ab" and "synonyms" for synonyms of existing antimicrobials) and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
+#'    1. Create a data set in the structure of the [antimicrobials] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
 #'
 #'    2. Set the file location to the package option [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
 #'
@@ -50,8 +48,6 @@
 #'
 #'       Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
 #'
-#'       This file can also hold synonyms for antimicrobials that already exist, such as local trade names: rows with an existing code in column "ab" and only column "synonyms" filled (one synonym per row, codes may repeat) are passed on to [add_custom_antimicrobial_synonyms()]. Rows with an existing code that have any other column filled still give an error. Synonyms must be valid UTF-8 text; convert other encodings first, e.g. with `iconv(x, from = "CP949", to = "UTF-8")`.
-#'
 #' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
 #'
 #'    1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
@@ -67,9 +63,7 @@
 #'        )
 #'       ```
 #'
-#' Use [add_custom_antimicrobial_synonyms()] to add extra names, such as local trade names, to antimicrobials that already exist (including antimicrobials added with [add_custom_antimicrobials()]). These synonyms are recognised by [as.ab()] and all `ab_*()` functions. Synonyms may contain non-ASCII characters (e.g. trade names in other scripts): they are matched against the input as given, before [as.ab()] transliterates the input to ASCII. Matching ignores case, all white space (including no-break and ideographic spaces) and zero-width characters. If the input does not match as given, a trailing part in parentheses or brackets (such as `(piperacillin, tazobactam)`) and a trailing strength written as a number with a unit symbol (such as `4.5g`, `4/0.5 g` or `500 mg/mL`) are removed one at a time, and matching is tried again after each removal, so that the longest registered synonym wins. Full-width characters are read as their ASCII equivalents. No words are removed, in any language: to recognise a name with a dosage form (such as `Inj`), add that variant as a synonym as well. Only user-added synonyms are matched this way, there is no other fuzzy matching for them, and a strength on its own is never matched to a user-added synonym. A synonym cannot be added if it already identifies another antimicrobial as its code, name, synonym, abbreviation, ATC code, CID or LOINC code, also when written with other punctuation (such as `J01-CR05`).
-#'
-#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials and synonyms.
+#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials.
 #' @seealso [add_custom_microorganisms()] to add custom microorganisms.
 #' @rdname add_custom_antimicrobials
 #' @export
@@ -120,96 +114,19 @@
 #' )
 #' x
 #' x[, betalactams()]
-#'
-#' # add local trade names as synonyms to existing antimicrobials,
-#' # here a Korean trade name of piperacillin/tazobactam
-#' add_custom_antimicrobial_synonyms("TZP", "\uD0C0\uC870\uC2E0\uC8FC")
-#' ab_name("\uD0C0\uC870\uC2E0\uC8FC")
-#' # a trailing strength, as in many hospital exports, is ignored
-#' as.ab("\uD0C0\uC870\uC2E0\uC8FC 4.5g")
 #' }
 add_custom_antimicrobials <- function(x) {
   meet_criteria(x, allow_class = "data.frame")
+  stop_ifnot(
+    all(c("ab", "name") %in% colnames(x)),
+    "`x` must contain columns \"ab\" and \"name\"."
+  )
+  stop_if(
+    any(x$ab %in% AMR_env$AB_lookup$ab),
+    "Antimicrobial drug code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set."
+  )
   # remove any extra class/type, such as grouped tbl, or data.table:
   x <- as.data.frame(x, stringsAsFactors = FALSE)
-  stop_ifnot(
-    "ab" %in% colnames(x),
-    "`x` must contain columns \"ab\" and \"name\", or columns \"ab\" and \"synonyms\" to add synonyms to existing antimicrobials."
-  )
-  # rows that only fill in "ab" and "synonyms" add synonyms to existing antimicrobials, see add_custom_antimicrobial_synonyms()
-  synonym_rows <- custom_ab_synonym_rows(x)
-  records <- x[!synonym_rows, , drop = FALSE]
-  stop_if(
-    NROW(records) > 0 && !"name" %in% colnames(records),
-    "`x` must contain columns \"ab\" and \"name\", or columns \"ab\" and \"synonyms\" to add synonyms to existing antimicrobials."
-  )
-  stop_if(
-    any(records$ab %in% AMR_env$AB_lookup$ab),
-    "Antimicrobial drug code(s) ", vector_and(records$ab[records$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set."
-  )
-  # names of new antimicrobials must not already be in use as user-added synonyms of other antimicrobials,
-  # compared in the same ways as custom_ab_synonyms_prepare() does, so that the order of adding does not matter
-  if (NROW(records) > 0 && NROW(AMR_env$custom_ab_synonyms) > 0) {
-    syn_tab <- AMR_env$custom_ab_synonyms
-    rec_ids <- custom_ab_identifier_keys(records)
-    rec_gen <- custom_ab_generalised_punct(generalise_antibiotic_name(as.character(records$name)))
-    hits <- data.frame(
-      rec = c(rec_ids$ab, rec_ids$ab, as.character(records$ab)),
-      s = c(
-        match(rec_ids$key, syn_tab$key, incomparables = NA),
-        match(rec_ids$pkey, custom_ab_punct_key(syn_tab$key), incomparables = NA),
-        match(rec_gen, custom_ab_generalised_punct(custom_ab_generalised(syn_tab$synonym)), incomparables = NA)
-      ),
-      stringsAsFactors = FALSE
-    )
-    hits <- hits[!is.na(hits$s), , drop = FALSE]
-    clash <- syn_tab$ab[hits$s] != hits$rec
-    stop_if(
-      any(clash),
-      "The name or synonym(s) ", vector_and(unique(syn_tab$synonym[hits$s[clash]])), " of the new antimicrobial(s) are already in use as user-added synonyms of ", vector_and(unique(syn_tab$ab[hits$s[clash]])), "."
-    )
-  }
-  # validate the synonyms before anything is added, so that an error leaves the session unchanged
-  syn <- NULL
-  if (any(synonym_rows)) {
-    syn_col <- x$synonyms[synonym_rows]
-    syn_ab <- as.character(x$ab[synonym_rows])
-    if (is.list(syn_col)) {
-      syn_ab <- rep(syn_ab, vapply(FUN.VALUE = integer(1), syn_col, length))
-      syn_col <- unlist(syn_col, use.names = FALSE)
-    }
-    syn <- custom_ab_synonyms_prepare(ab = syn_ab, synonyms = syn_col, new_records = records)
-  }
-  if (NROW(records) > 0) {
-    add_custom_antimicrobials_records(records)
-  }
-  if (!is.null(syn)) {
-    custom_ab_synonyms_commit(syn)
-  }
-  invisible(NULL)
-}
-
-# rows of `x` that have a "synonyms" column and no other column filled besides "ab"
-custom_ab_synonym_rows <- function(x) {
-  if (!"synonyms" %in% colnames(x)) {
-    return(rep(FALSE, NROW(x)))
-  }
-  other_filled <- rep(FALSE, NROW(x))
-  for (col in setdiff(colnames(x), c("ab", "synonyms"))) {
-    other_filled <- other_filled | custom_ab_is_filled(x[, col, drop = TRUE])
-  }
-  !other_filled
-}
-
-custom_ab_is_filled <- function(col) {
-  if (is.list(col)) {
-    vapply(FUN.VALUE = logical(1), col, function(v) any(!is.na(v) & as.character(v) != ""))
-  } else {
-    !is.na(col) & as.character(col) != ""
-  }
-}
-
-add_custom_antimicrobials_records <- function(x) {
   # keep only columns available in the antimicrobials data set
   x <- x[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %in% colnames(x)], drop = FALSE]
   x$generalised_name <- generalise_antibiotic_name(x$name)
@@ -236,280 +153,9 @@ add_custom_antimicrobials_records <- function(x) {
   }
   AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df))
 
+  AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% c(x$ab, x$generalised_name) & !AMR_env$ab_previously_coerced$x %in% c(x$ab, x$generalised_name)), , drop = FALSE]
   class(AMR_env$AB_lookup$ab) <- c("ab", "character")
-  # the lookup table changed, so earlier coercions and lookup indices are no longer valid
-  reset_ab_cache()
-  message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal {.code antimicrobials} data set.")
-}
-
-#' @rdname add_custom_antimicrobials
-#' @export
-add_custom_antimicrobial_synonyms <- function(ab, synonyms = NULL) {
-  if (is.data.frame(ab)) {
-    stop_ifnot(
-      all(c("ab", "synonyms") %in% colnames(ab)),
-      "`ab` must contain columns \"ab\" and \"synonyms\" when it is a data.frame."
-    )
-    synonyms <- ab$synonyms
-    ab <- as.character(ab$ab)
-    if (is.list(synonyms)) {
-      ab <- rep(ab, vapply(FUN.VALUE = integer(1), synonyms, length))
-      synonyms <- unlist(synonyms, use.names = FALSE)
-    }
-  } else {
-    meet_criteria(ab, allow_class = c("character", "ab"))
-    meet_criteria(synonyms, allow_class = "character")
-    ab <- as.character(ab)
-    if (length(ab) == 1) {
-      ab <- rep(ab, length(synonyms))
-    }
-    stop_ifnot(
-      length(ab) == length(synonyms),
-      "`ab` must be of length 1 or of the same length as `synonyms`."
-    )
-  }
-  syn <- custom_ab_synonyms_prepare(ab = ab, synonyms = synonyms)
-  if (is.null(syn)) {
-    message_("No synonyms to add.")
-    return(invisible(NULL))
-  }
-  custom_ab_synonyms_commit(syn)
-  invisible(NULL)
-}
-
-# checks synonyms and returns a data.frame(ab, synonym, key), or NULL if there is nothing to add;
-# `new_records` are antimicrobials that are about to be added in the same call of add_custom_antimicrobials()
-custom_ab_synonyms_prepare <- function(ab, synonyms, new_records = NULL) {
-  ab <- as.character(ab)
-  synonyms <- as.character(synonyms)
-  invalid <- !is.na(synonyms) & !custom_ab_valid_utf8(synonyms)
-  stop_if(
-    any(invalid),
-    "Synonym(s) must be valid UTF-8 text, which does not apply to the synonym(s) at position ", vector_and(which(invalid), quotes = FALSE), ". Convert them first, e.g. with `iconv(x, from = \"CP949\", to = \"UTF-8\")`."
-  )
-  synonyms <- trimws2(enc2utf8(synonyms))
-  keep <- !is.na(ab) & !is.na(synonyms) & !is.na(custom_ab_synonym_key(synonyms))
-  ab <- ab[keep]
-  synonyms <- synonyms[keep]
-  if (length(ab) == 0) {
-    return(NULL)
-  }
-  new_codes <- if (is.null(new_records)) character(0) else as.character(new_records$ab)
-  known <- c(as.character(AMR_env$AB_lookup$ab), new_codes)
-  unknown <- unique(ab[!ab %in% known])
-  stop_if(
-    length(unknown) > 0,
-    "Antimicrobial drug code(s) ", vector_and(unknown), " do not exist. Use add_custom_antimicrobials() to add new antimicrobials first."
-  )
-  keys <- custom_ab_synonym_key(synonyms)
-  # a synonym must not already identify another antimicrobial - its code, name, synonyms, abbreviations,
-  # ATC codes, CID or LOINC codes - not with other punctuation (e.g. "J01-CR05") and not in the
-  # generalised form that as.ab() uses for its exact matches either
-  ids <- custom_ab_identifier_keys_cached()
-  gen_ids <- custom_ab_generalised_ids()
-  if (!is.null(new_records) && NROW(new_records) > 0) {
-    ids <- rbind(ids, custom_ab_identifier_keys(new_records))
-    new_gen <- data.frame(ab = as.character(new_records$ab), gen = generalise_antibiotic_name(as.character(new_records$name)), stringsAsFactors = FALSE)
-    new_gen$genp <- custom_ab_generalised_punct(new_gen$gen)
-    gen_ids <- rbind(gen_ids, new_gen[!is.na(new_gen$genp), , drop = FALSE])
-  }
-  owners_of <- function(table_keys, table_ab, k) {
-    groups <- split(table_ab, table_keys)
-    lapply(match(k, names(groups), incomparables = NA), function(j) if (is.na(j)) character(0) else groups[[j]])
-  }
-  by_key <- owners_of(ids$key, ids$ab, keys)
-  by_pkey <- owners_of(ids$pkey, ids$ab, custom_ab_punct_key(keys))
-  by_gen <- owners_of(gen_ids$genp, gen_ids$ab, custom_ab_generalised_punct(custom_ab_generalised(synonyms)))
-  owners <- lapply(seq_along(keys), function(i) setdiff(unique(c(by_key[[i]], by_pkey[[i]], by_gen[[i]])), ab[i]))
-  taken <- lengths(owners) > 0
-  stop_if(
-    any(taken),
-    "Synonym(s) already identify another antimicrobial (as its code, name, synonym, abbreviation, ATC code, CID or LOINC code): ",
-    vector_and(unique(paste0(synonyms[taken], " (", vapply(FUN.VALUE = character(1), owners[taken], paste, collapse = ", "), ")")), quotes = FALSE), "."
-  )
-  existing <- AMR_env$custom_ab_synonyms
-  clash <- keys %in% existing$key & ab != existing$ab[match(keys, existing$key)]
-  clash <- clash | (duplicated(keys) & !duplicated(paste(keys, ab)))
-  stop_if(
-    any(clash),
-    "Synonym(s) ", vector_and(unique(synonyms[clash])), " would refer to more than one antimicrobial."
-  )
-  data.frame(ab = ab, synonym = synonyms, key = keys, stringsAsFactors = FALSE)
-}
-
-custom_ab_synonyms_commit <- function(syn) {
-  class(AMR_env$AB_lookup$ab) <- "character"
-  for (code in unique(syn$ab)) {
-    i <- which(AMR_env$AB_lookup$ab == code)[1L]
-    new_syn <- syn$synonym[syn$ab == code]
-    old_syn <- AMR_env$AB_lookup$synonyms[[i]]
-    old_syn <- old_syn[!is.na(old_syn) & old_syn != ""]
-    # only added to `synonyms` (for ab_synonyms()); matching is done by the exact match at the start of as.ab(),
-    # so these synonyms are deliberately kept out of the fuzzy matching on `generalised_*`
-    AMR_env$AB_lookup$synonyms[[i]] <- unique(c(old_syn, new_syn))
-  }
-  class(AMR_env$AB_lookup$ab) <- c("ab", "character")
-  AMR_env$custom_ab_synonyms <- unique(rbind(AMR_env$custom_ab_synonyms, syn))
-  # the lookup table changed, so earlier coercions and lookup indices are no longer valid
-  reset_ab_cache()
-  n_syn <- length(unique(syn$synonym))
-  n_ab <- length(unique(syn$ab))
-  message_(
-    "Added ", nr2char(n_syn), " synonym", ifelse(n_syn > 1, "s", ""),
-    " to ", nr2char(n_ab), " antimicrobial", ifelse(n_ab > 1, "s", ""), "."
-  )
-}
-
-# validUTF8() requires R >= 3.3.0, so use iconv(), which returns NA for invalid input;
-# x must be the input as given: unmarked text in a UTF-8 locale is checked before enc2utf8(), since older
-# R versions (e.g. 4.2) let enc2utf8() replace invalid bytes with "<xx>" escapes, which are valid UTF-8
-custom_ab_valid_utf8 <- function(x) {
-  x <- as.character(x)
-  out <- !is.na(iconv(enc2utf8(x), from = "UTF-8", to = "UTF-8"))
-  unmarked <- which(Encoding(x) == "unknown" & isTRUE(l10n_info()[["UTF-8"]]))
-  out[unmarked] <- out[unmarked] & !is.na(iconv(x[unmarked], from = "UTF-8", to = "UTF-8"))
-  out
-}
-
-# white space for the user-added synonym functions: all Unicode white space, like trimws2()
-custom_ab_ws <- "[\\h\\v\\p{Z}\u200B\u200C\u200D\u2060\uFEFF]"
-
-# key for user-added synonyms: case and all white space are ignored, full-width characters are read as ASCII,
-# other characters are kept as given;
-# input that is not valid UTF-8 or that consists of white space only gets an NA key and thus never matches
-custom_ab_synonym_key <- function(x) {
-  x <- as.character(x)
-  valid <- !is.na(x) & custom_ab_valid_utf8(x)
-  x <- enc2utf8(x)
-  out <- rep(NA_character_, length(x))
-  out[valid] <- toupper(gsub(paste0(custom_ab_ws, "+"), "", custom_ab_fullwidth_to_ascii(x[valid]), perl = TRUE))
-  out[!is.na(out) & out == ""] <- NA_character_
-  out
-}
-
-# generalised form as used by the exact stage of as.ab(), or NA when the text cannot be transliterated to ASCII
-custom_ab_generalised <- function(x) {
-  out <- rep(NA_character_, length(x))
-  ascii <- suppressWarnings(iconv(toupper(enc2utf8(as.character(x))), from = "UTF-8", to = "ASCII//TRANSLIT"))
-  ok <- !is.na(ascii) & !grepl("?", ascii, fixed = TRUE)
-  if (any(ok)) {
-    # some iconv implementations transliterate diacritics to separate marks (e.g. "O" with acute to "'O")
-    gen <- generalise_antibiotic_name(gsub("['`^~\"]", "", ascii[ok]))
-    gen[!grepl("[A-Z0-9]", gen)] <- NA_character_
-    out[ok] <- gen
-  }
-  out
-}
-
-# key without punctuation (letters and digits only), so that a synonym cannot take over another
-# antimicrobial's identifier by adding punctuation, e.g. "J01-CR05" or "Zo-syn"
-custom_ab_punct_key <- function(key) {
-  out <- gsub("[^\\p{L}\\p{N}]+", "", key, perl = TRUE)
-  out[!is.na(out) & out == ""] <- NA_character_
-  out
-}
-
-# the same for generalised forms, which consist of A-Z, 0-9 and punctuation only
-custom_ab_generalised_punct <- function(gen) {
-  out <- gsub("[^A-Z0-9]+", "", gen)
-  out[!is.na(out) & out == ""] <- NA_character_
-  out
-}
-
-# parts after a product name that are removed one at a time by custom_ab_strip_step(): trailing punctuation,
-# a part in parentheses or brackets (also nested) and a strength written as a number with a unit symbol;
-# this is deliberately language-independent, so no words (such as dosage forms) are removed
-custom_ab_strip_patterns <- local({
-  num <- "[0-9]+([.,][0-9]+)*"
-  unit <- "(mg|g|mcg|ug|\u00B5g|\u03BCg|ng|kg|iu|miu|u|ml|l|meq|mmol|%|\u338E|\u338D|\u338F|\u3396|\u2113)"
-  sep <- "[ ,_*-]*"
-  per <- paste0("( ?/ ?(", num, ")? ?", unit, ")?")
-  combination <- paste0("(", num, " ?", unit, "? ?[/:] ?)?")
-  c(
-    punctuation = "[.,;:]+$",
-    parenthesised = " ?(\\((?:[^()]++|(?1))*\\))$",
-    bracketed = " ?(\\[(?:[^][]++|(?1))*\\])$",
-    strength = paste0("(?<![0-9.,])", sep, combination, num, " ?", unit, per, "\\.?$")
-  )
-})
-
-# full-width ASCII characters to ASCII
-custom_ab_fullwidth_to_ascii <- function(x) {
-  wide <- !is.na(x) & grepl("[\uFF01-\uFF5E]", x, perl = TRUE)
-  if (any(wide)) {
-    x[wide] <- vapply(FUN.VALUE = character(1), x[wide], function(s) {
-      cp <- utf8ToInt(s)
-      w <- cp >= 65281L & cp <= 65374L
-      cp[w] <- cp[w] - 65248L
-      intToUtf8(cp)
-    }, USE.NAMES = FALSE)
-  }
-  x
-}
-
-# white space to single spaces and full-width ASCII characters to ASCII
-custom_ab_strip_normalise <- function(x) {
-  x <- custom_ab_fullwidth_to_ascii(enc2utf8(as.character(x)))
-  trimws2(gsub(paste0(custom_ab_ws, "+"), " ", x, perl = TRUE))
-}
-
-# removes one trailing part (see custom_ab_strip_patterns) from each value, e.g. "Brand (comment) 4.5g" ->
-# "Brand (comment)" -> "Brand"; values that cannot be shortened (or would become empty) are returned as is;
-# only used by as.ab() to look up user-added synonyms when the input as given does not match one
-custom_ab_strip_step <- function(x) {
-  out <- x
-  todo <- !is.na(x)
-  for (p in custom_ab_strip_patterns) {
-    if (!any(todo)) break
-    y <- trimws2(gsub(p, "", out[todo], perl = TRUE, ignore.case = TRUE))
-    changed <- y != out[todo] & y != ""
-    if (any(changed)) {
-      i <- which(todo)[changed]
-      out[i] <- y[changed]
-      todo[i] <- FALSE
-    }
-  }
-  out
-}
-
-# keys of everything that identifies an antimicrobial in `lkp` (by default the internal lookup table):
-# code, name, synonyms, abbreviations, ATC codes, CID and LOINC codes
-custom_ab_identifier_keys <- function(lkp = AMR_env$AB_lookup) {
-  ab <- as.character(lkp$ab)
-  as_list <- function(col) {
-    if (!col %in% colnames(lkp)) {
-      return(vector("list", length(ab)))
-    }
-    v <- lkp[[col]]
-    if (is.list(v)) v else as.list(v)
-  }
-  parts <- list(as.list(ab), as_list("name"), as_list("synonyms"), as_list("abbreviations"), as_list("atc"), as_list("cid"), as_list("loinc"))
-  ids <- lapply(seq_along(ab), function(i) {
-    vals <- as.character(unlist(lapply(parts, function(p) p[[i]]), use.names = FALSE))
-    vals[!is.na(vals) & vals != ""]
-  })
-  out <- data.frame(ab = rep(ab, lengths(ids)), key = custom_ab_synonym_key(unlist(ids, use.names = FALSE)), stringsAsFactors = FALSE)
-  out <- out[!is.na(out$key), , drop = FALSE]
-  out$pkey <- custom_ab_punct_key(out$key)
-  out
-}
-
-# the same for the internal lookup table, kept until the lookup table changes (see reset_ab_cache())
-custom_ab_identifier_keys_cached <- function() {
-  if (is.null(AMR_env$custom_ab_id_keys)) {
-    AMR_env$custom_ab_id_keys <- custom_ab_identifier_keys()
-  }
-  AMR_env$custom_ab_id_keys
-}
-
-# generalised names and synonyms of the internal lookup table, as used by the exact stage of as.ab()
-custom_ab_generalised_ids <- function() {
-  ab <- as.character(AMR_env$AB_lookup$ab)
-  g <- AMR_env$AB_lookup$generalised_all
-  if (!is.list(g)) g <- as.list(g)
-  out <- data.frame(ab = rep(ab, lengths(g)), gen = as.character(unlist(g, use.names = FALSE)), stringsAsFactors = FALSE)
-  out$genp <- custom_ab_generalised_punct(out$gen)
-  out[!is.na(out$genp), , drop = FALSE]
+  message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antimicrobials` data set.")
 }
 
 #' @rdname add_custom_antimicrobials
@@ -519,7 +165,6 @@ clear_custom_antimicrobials <- function() {
   AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP)
   n2 <- nrow(AMR_env$AB_lookup)
   AMR_env$custom_ab_codes <- character(0)
-  AMR_env$custom_ab_synonyms <- AMR_env$custom_ab_synonyms[0, , drop = FALSE]
-  reset_ab_cache()
-  message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.help [antimicrobials](AMR::antimicrobials)} data set.")
+  AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(AMR_env$ab_previously_coerced$ab %in% AMR_env$AB_lookup$ab), , drop = FALSE]
+  message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal `antimicrobials` data set.")
 }

R/custom_eucast_rules.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,27 +27,27 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Define Custom Interpretive Rules
+#' Define Custom EUCAST Rules
 #'
-#' Define custom interpretive rules for your organisation or specific analysis and use the output of this function in [interpretive_rules()].
+#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
 #' @param ... Rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
 #' @details
-#' Some organisations have their own adoption of interpretive rules. This function can be used to define custom rules to be used in the [interpretive_rules()] function.
+#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
 #'
 #' ### Basics
 #'
 #' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
 #'
 #' ```r
-#' x <- custom_interpretive_rules(TZP == "S" ~ aminopenicillins == "S",
-#'                                TZP == "R" ~ aminopenicillins == "R")
+#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
+#'                          TZP == "R" ~ aminopenicillins == "R")
 #' ```
 #'
-#' These are two custom interpretive rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
+#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
 #'
 #' ```r
 #' x
-#' #> A set of custom interpretive rules:
+#' #> A set of custom EUCAST rules:
 #' #>
 #' #>   1. If TZP is "S" then set to  S :
 #' #>      amoxicillin (AMX), ampicillin (AMP)
@@ -68,11 +68,11 @@
 #' #> 1      Escherichia coli   R    S     S
 #' #> 2 Klebsiella pneumoniae   R    S     S
 #'
-#' interpretive_rules(df,
-#'                    rules = "custom",
-#'                    custom_rules = x,
-#'                    info = FALSE,
-#'                    overwrite = TRUE)
+#' eucast_rules(df,
+#'              rules = "custom",
+#'              custom_rules = x,
+#'              info = FALSE,
+#'              overwrite = TRUE)
 #' #>                      mo TZP ampi cipro
 #' #> 1      Escherichia coli   R    R     S
 #' #> 2 Klebsiella pneumoniae   R    R     S
@@ -80,19 +80,19 @@
 #'
 #' ### Using taxonomic properties in rules
 #'
-#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
+#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
 #'
 #' ```r
-#' y <- custom_interpretive_rules(
+#' y <- custom_eucast_rules(
 #'   TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
 #'   TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
 #' )
 #'
-#' interpretive_rules(df,
-#'                    rules = "custom",
-#'                    custom_rules = y,
-#'                    info = FALSE,
-#'                    overwrite = TRUE)
+#' eucast_rules(df,
+#'              rules = "custom",
+#'              custom_rules = y,
+#'              info = FALSE,
+#'              overwrite = TRUE)
 #' #>                      mo TZP ampi cipro
 #' #> 1      Escherichia coli   R    S     S
 #' #> 2 Klebsiella pneumoniae   R    R     S
@@ -109,9 +109,9 @@
 #' Rules can also be applied to multiple antimicrobials and antimicrobial groups simultaneously. Use the `c()` function to combine multiple antimicrobials. For instance, the following example sets all aminopenicillins and ureidopenicillins to "R" if column TZP (piperacillin/tazobactam) is "R":
 #'
 #' ```r
-#' x <- custom_interpretive_rules(TZP == "R" ~ c(aminopenicillins, ureidopenicillins) == "R")
+#' x <- custom_eucast_rules(TZP == "R" ~ c(aminopenicillins, ureidopenicillins) == "R")
 #' x
-#' #> A set of custom interpretive rules:
+#' #> A set of custom EUCAST rules:
 #' #>
 #' #>   1. If TZP is "R" then set to "R":
 #' #>      amoxicillin (AMX), ampicillin (AMP), azlocillin (AZL), mezlocillin (MEZ), piperacillin (PIP), piperacillin/tazobactam (TZP)
@@ -123,7 +123,7 @@
 #' @returns A [list] containing the custom rules
 #' @export
 #' @examples
-#' x <- custom_interpretive_rules(
+#' x <- custom_eucast_rules(
 #'   AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
 #'   AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I"
 #' )
@@ -141,24 +141,24 @@
 #' # combine rule sets
 #' x2 <- c(
 #'   x,
-#'   custom_interpretive_rules(TZP == "R" ~ carbapenems == "R")
+#'   custom_eucast_rules(TZP == "R" ~ carbapenems == "R")
 #' )
 #' x2
-custom_interpretive_rules <- function(...) {
+custom_eucast_rules <- function(...) {
   dots <- tryCatch(list(...),
     error = function(e) "error"
   )
   stop_if(
     identical(dots, "error"),
-    "rules must be a valid formula inputs (e.g., using '~'), see {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
+    "rules must be a valid formula inputs (e.g., using '~'), see `?custom_eucast_rules`"
   )
   n_dots <- length(dots)
-  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}.")
+  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?custom_eucast_rules`.")
   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 [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
+      "rule ", i, " must be a valid formula input (e.g., using '~'), see `?custom_eucast_rules`"
     )
 
     # Query
@@ -180,7 +180,7 @@ custom_interpretive_rules <- function(...) {
     result <- dots[[i]][[3]]
     stop_ifnot(
       deparse(result) %like% "==",
-      "the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
+      "the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`"
     )
     result_group <- as.character(result)[[2]]
     result_group <- as.character(str2lang(result_group))
@@ -220,8 +220,8 @@ custom_interpretive_rules <- function(...) {
     result_value <- as.character(result)[[3]]
     result_value[result_value == "NA"] <- NA
     stop_ifnot(
-      result_value %in% c(VALID_SIR_LEVELS, NA),
-      paste0("the resulting value of rule ", i, " must be either ", vector_or(c(VALID_SIR_LEVELS, NA), sort = FALSE))
+      result_value %in% c("S", "SDD", "I", "R", "NI", NA),
+      "the resulting value of rule ", i, " must be either \"S\", \"SDD\", \"I\", \"R\", \"NI\" or NA"
     )
     result_value <- as.sir(result_value)
 
@@ -230,13 +230,13 @@ custom_interpretive_rules <- function(...) {
   }
 
   names(out) <- paste0("rule", seq_len(n_dots))
-  set_clean_class(out, new_class = c("custom_interpretive_rules", "list"))
+  set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
 }
 
-#' @method c custom_interpretive_rules
+#' @method c custom_eucast_rules
 #' @noRd
 #' @export
-c.custom_interpretive_rules <- function(x, ...) {
+c.custom_eucast_rules <- function(x, ...) {
   if (length(list(...)) == 0) {
     return(x)
   }
@@ -245,25 +245,33 @@ c.custom_interpretive_rules <- function(x, ...) {
     out <- c(out, unclass(e))
   }
   names(out) <- paste0("rule", seq_len(length(out)))
-  set_clean_class(out, new_class = c("custom_interpretive_rules", "list"))
+  set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
 }
 
-#' @method as.list custom_interpretive_rules
+#' @method as.list custom_eucast_rules
 #' @noRd
 #' @export
-as.list.custom_interpretive_rules <- function(x, ...) {
+as.list.custom_eucast_rules <- function(x, ...) {
   c(x, ...)
 }
 
-#' @method print custom_interpretive_rules
+#' @method print custom_eucast_rules
 #' @export
 #' @noRd
-print.custom_interpretive_rules <- function(x, ...) {
-  cat("A set of custom interpretive rules:\n")
+print.custom_eucast_rules <- function(x, ...) {
+  cat("A set of custom EUCAST rules:\n")
   for (i in seq_len(length(x))) {
     rule <- x[[i]]
     rule$query <- format_custom_query_rule(rule$query)
-    val <- format_sir_badge(rule$result_value)
+    if (is.na(rule$result_value)) {
+      val <- font_red("<NA>")
+    } else if (rule$result_value == "R") {
+      val <- font_rose_bg(" R ")
+    } else if (rule$result_value == "S") {
+      val <- font_green_bg(" S ")
+    } else {
+      val <- font_orange_bg(" I ")
+    }
     agents <- paste0(
       font_blue(ab_name(rule$result_group, language = NULL, tolower = TRUE),
         collapse = NULL
@@ -283,19 +291,3 @@ print.custom_interpretive_rules <- function(x, ...) {
     cat("\n  ", rule_if, "\n", rule_then, "\n", sep = "")
   }
 }
-
-# Backward-compat S3 dispatch for objects created with the old custom_eucast_rules() function
-#' @method c custom_eucast_rules
-#' @noRd
-#' @export
-c.custom_eucast_rules <- function(x, ...) c.custom_interpretive_rules(x, ...)
-
-#' @method as.list custom_eucast_rules
-#' @noRd
-#' @export
-as.list.custom_eucast_rules <- function(x, ...) as.list.custom_interpretive_rules(x, ...)
-
-#' @method print custom_eucast_rules
-#' @export
-#' @noRd
-print.custom_eucast_rules <- function(x, ...) print.custom_interpretive_rules(x, ...)

R/custom_mdro_guideline.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -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 [{.fun mdro}](AMR::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 [{.fun mdro}](AMR::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 [{.fun mdro}](AMR::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 [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}",
+      "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
       call = FALSE
     )
     vals <- attributes(x)$values
@@ -235,9 +235,9 @@ print.custom_mdro_guideline <- function(x, ...) {
   for (i in seq_len(length(x))) {
     rule <- x[[i]]
     rule$query <- format_custom_query_rule(rule$query)
-    cat("\u00a0\u00a0", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
+    cat("  ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
   }
-  cat("\u00a0\u00a0", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
+  cat("  ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
   cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
   if (isTRUE(attributes(x)$as_factor)) {
     cat("Results will be of class 'factor', with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
@@ -259,15 +259,16 @@ 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,
-        " ({.code ", as.character(guideline[[i]]$query), "}) was ignored because of this error message: ",
+      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 [{.fun custom_mdro_guideline}](AMR::custom_mdro_guideline)}: rule ", i, " ({.code ", 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/custom_microorganisms.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -128,7 +128,7 @@
 #' }
 add_custom_microorganisms <- function(x) {
   meet_criteria(x, allow_class = "data.frame")
-  stop_ifnot("genus" %in% tolower(colnames(x)), "{.arg x} must contain column {.code genus}.")
+  stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'."))
 
   add_MO_lookup_to_AMR_env()
 
@@ -195,13 +195,11 @@ add_custom_microorganisms <- function(x) {
   if (!"fullname" %in% colnames(x)) {
     x$fullname <- trimws2(paste(x$genus, x$species, x$subspecies))
   }
-  if (!"domain" %in% colnames(x)) x$domain <- ""
   if (!"kingdom" %in% colnames(x)) x$kingdom <- ""
   if (!"phylum" %in% colnames(x)) x$phylum <- ""
   if (!"class" %in% colnames(x)) x$class <- ""
   if (!"order" %in% colnames(x)) x$order <- ""
   if (!"family" %in% colnames(x)) x$family <- ""
-  x$domain[is.na(x$domain)] <- ""
   x$kingdom[is.na(x$kingdom)] <- ""
   x$phylum[is.na(x$phylum)] <- ""
   x$class[is.na(x$class)] <- ""
@@ -219,7 +217,6 @@ add_custom_microorganisms <- function(x) {
 
   # fill in taxonomy based on genus
   genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
-  x$domain[which(x$domain == "" & genus_to_check != "")] <- AMR_env$MO_lookup$domain[match(genus_to_check[which(x$domain == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
   x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
   x$phylum[which(x$phylum == "" & genus_to_check != "")] <- AMR_env$MO_lookup$phylum[match(genus_to_check[which(x$phylum == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
   x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
@@ -232,9 +229,9 @@ add_custom_microorganisms <- function(x) {
   x$prevalence[is.na(x$prevalence)] <- 1.25
   x$status <- "accepted"
   x$ref <- paste("Self-added,", format(Sys.Date(), "%Y"))
-  x$domain_index <- AMR_env$MO_lookup$domain_index[match(genus_to_check, AMR_env$MO_lookup$genus)]
-  # complete missing domain index, so mo_matching_score() will not return NA
-  x$domain_index[is.na(x$domain_index)] <- 1
+  x$kingdom_index <- AMR_env$MO_lookup$kingdom_index[match(genus_to_check, AMR_env$MO_lookup$genus)]
+  # complete missing kingdom index, so mo_matching_score() will not return NA
+  x$kingdom_index[is.na(x$kingdom_index)] <- 1
   x$fullname_lower <- tolower(x$fullname)
   x$full_first <- substr(x$fullname_lower, 1, 1)
   x$species_first <- tolower(substr(x$species, 1, 1))
@@ -278,15 +275,15 @@ add_custom_microorganisms <- function(x) {
     new_df[, col] <- x[, col, drop = TRUE]
   }
 
+  # clear previous coercions
+  suppressMessages(mo_reset_session())
+
   AMR_env$MO_lookup <- unique(rbind_AMR(AMR_env$MO_lookup, new_df))
   class(AMR_env$MO_lookup$mo) <- c("mo", "character")
-  # the lookup table changed, so earlier coercions and lookup indices are no longer valid
-  reset_mo_cache()
-  AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
   if (nrow(x) <= 3) {
-    message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal {.code microorganisms} data set.")
+    message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.")
   } else {
-    message_("Added ", nr2char(nrow(x)), " records to the internal {.code microorganisms} data set.")
+    message_("Added ", nr2char(nrow(x)), " records to the internal `microorganisms` data set.")
   }
 }
 
@@ -295,14 +292,18 @@ add_custom_microorganisms <- function(x) {
 clear_custom_microorganisms <- function() {
   n <- nrow(AMR_env$MO_lookup)
 
-  # reset, which also invalidates earlier coercions and lookup indices
+  # reset
   AMR_env$MO_lookup <- NULL
   add_MO_lookup_to_AMR_env()
 
+  # clear previous coercions
+  suppressMessages(mo_reset_session())
+
   n2 <- nrow(AMR_env$MO_lookup)
   AMR_env$custom_mo_codes <- character(0)
+  AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE]
   AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
-  message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.code microorganisms} data set.")
+  message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal `microorganisms` data set.")
 }
 
 abbreviate_mo <- function(x, minlength = 5, prefix = "", hyphen_as_space = FALSE, ...) {

R/data.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -38,7 +38,7 @@
 #' - `ab`\cr antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.***
 #' - `cid`\cr Compound ID as found in PubChem. ***This is a unique identifier.***
 #' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. ***This is a unique identifier.***
-#' - `group`\cr One or more short and concise group names, based on WHONET and WHOCC definitions
+#' - `group`\cr A short and concise group name, based on WHONET and WHOCC definitions
 #' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02` (last updated `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`):
 #' - `atc_group1`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC, like `"Macrolides, lincosamides and streptogramins"`
 #' - `atc_group2`\cr Official chemical subgroup (4th level ATC code) as defined by the WHOCC, like `"Macrolides"`
@@ -77,13 +77,13 @@
 #'
 #' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and are consequently only available where a CID is available.
 #' @inheritSection AMR Download Our Reference Data
-#' @references
+#' @source
 #'
 #' * `r TAXONOMY_VERSION$ATC_DDD$citation` Accessed from <`r TAXONOMY_VERSION$ATC_DDD$url`> on `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`.
 #'
 #' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
 #'
-#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/index_en.htm>
+#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
 #' @inheritSection WHOCC WHOCC
 #' @seealso [microorganisms], [intrinsic_resistant]
 #' @examples
@@ -100,19 +100,18 @@
 #' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Taxonomic Records of Microorganisms
 #'
 #' @description
-#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$domain[!microorganisms$domain %like% "unknown"])))` domains. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
+#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
 #'
 #' This data set is carefully crafted, yet made 100% reproducible from public and authoritative taxonomic sources (using [this script](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R)), namely: *`r TAXONOMY_VERSION$LPSN$name`* for bacteria, *`r TAXONOMY_VERSION$MycoBank$name`* for fungi, and *`r TAXONOMY_VERSION$GBIF$name`* for all others taxons.
 #' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms), big.mark = " ")` observations and `r ncol(microorganisms)` variables:
 #' - `mo`\cr ID of microorganism as used by this package. ***This is a unique identifier.***
 #' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. ***This is a unique identifier.***
-#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status, documentation = TRUE)`
-#' - `domain`, `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism. Note that for fungi, *phylum* is used for their taxonomic *division*. Also, for fungi, *subkingdom* and *subdivision* were left out since they do not occur in the bacterial taxonomy. For all species outside the domains of Bacteria and Archaea, the `domain` and `kingdom` are identical.
+#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status)`
+#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism. Note that for fungi, *phylum* is equal to their taxonomic *division*. Also, for fungi, *subkingdom* and *subdivision* were left out since they do not occur in the bacterial taxonomy.
 #' - `rank`\cr Text of the taxonomic rank of the microorganism, such as `"species"` or `"genus"`
-#' - `ref`\cr Abbreviated authority citation for the nomenclatural act that established the current name combination, following ICNP conventions. For species described in their current genus (*sp. nov.*), this is the original description author(s) and year. For species transferred to a different genus (*comb. nov.*), this is the reclassification author(s) and year. Emendations are excluded. For synonyms, this is the authority under which the synonym was originally published. This field is directly retrieved from the source specified in the column `source`. Diacritics were removed to comply with CRAN, that only allows ASCII characters.
-#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance, documentation = TRUE)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
-#' - `morphology` \cr Morphology (cell shape), either `r vector_or(microorganisms$morphology, documentation = TRUE)`. These data were retrieved from BacDive (see *Source*). Genera that are clinically established as coccobacilli (the HACEK group and beyond, such as *Haemophilus* and *Acinetobacter*) are classified as such regardless of BacDive majority vote. Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus. Currently `r round(length(microorganisms$morphology[which(!is.na(microorganisms$morphology))]) / nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]))` bacteria in the data set contain a morphology.
-#' - `source`\cr Either `r vector_or(microorganisms$source, documentation = TRUE)` (see *Source*)
+#' - `ref`\cr Author(s) and year of related scientific publication. This contains only the *first surname* and year of the *latest* authors, e.g. "Wallis *et al.* 2006 *emend.* Smith and Jones 2018" becomes "Smith *et al.*, 2018". This field is directly retrieved from the source specified in the column `source`. Moreover, accents were removed to comply with CRAN that only allows ASCII characters.
+#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
+#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
 #' - `lpsn`\cr Identifier ('Record number') of `r TAXONOMY_VERSION$LPSN$name`. This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$lpsn)))` records.
 #' - `lpsn_parent`\cr LPSN identifier of the parent taxon
 #' - `lpsn_renamed_to`\cr LPSN identifier of the currently valid taxon
@@ -131,26 +130,27 @@
 #'
 #' @section Included Taxa:
 #' Included taxonomic data from [LPSN](`r TAXONOMY_VERSION$LPSN$url`), [MycoBank](`r TAXONOMY_VERSION$MycoBank$url`), and [GBIF](`r TAXONOMY_VERSION$GBIF$url`) are:
-#' - All `r format_included_data_number(microorganisms[which(microorganisms$domain %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the domains of Archaea and Bacteria
-#' - `r format_included_data_number(microorganisms[which(microorganisms$domain == "Fungi"), , drop = FALSE])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
+#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the kingdoms of Archaea and Bacteria
+#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi"), , drop = FALSE])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
 #' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Protozoa"), , drop = FALSE])` (sub)species from the kingdom of Protozoa
 #' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
 #' - All `r format_included_data_number(microorganisms[which(microorganisms$status != "accepted"), , drop = FALSE])` previously accepted names of all included (sub)species (these were taxonomically renamed)
-#' - The complete taxonomic tree of all included (sub)species: from domain to subspecies
+#' - The complete taxonomic tree of all included (sub)species: from kingdom to subspecies
 #' - The identifier of the parent taxons
 #' - The year and first author of the related scientific publication
 #'
 #' ### Manual additions
 #' For convenience, some entries were added manually:
 #'
-#' - All `r format_included_data_number(length(which(microorganisms$rank == "species group")))` groups and complexes of the [microorganisms.groups] data set, for cross-reference (examples include beta-haemolytic *Streptococcus* groups A to K, coagulase-negative *Staphylococcus* (CoNS), *Mycobacterium tuberculosis* complex, etc.)
 #' - `r format_included_data_number(microorganisms[which(microorganisms$source == "manually added" & microorganisms$genus == "Salmonella"), , drop = FALSE])` entries of *Salmonella*, such as the city-like serovars and groups A to H
+#' - `r format_included_data_number(length(which(microorganisms$rank == "species group")))` species groups (such as the beta-haemolytic *Streptococcus* groups A to K, coagulase-negative *Staphylococcus* (CoNS), *Mycobacterium tuberculosis* complex, etc.), of which the group compositions are stored in the [microorganisms.groups] data set
 #' - 1 entry of *Blastocystis* (*B.  hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
-#' - `r sum(microorganisms$fullname %like% "unknown")` other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
+#' - 1 entry of *Moraxella* (*M. catarrhalis*), which was formally named *Branhamella catarrhalis* (Catlin, 1970) though this change was never accepted within the field of clinical microbiology
+#' - 8 other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
 #'
 #' The syntax used to transform the original data to a cleansed \R format, can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R).
 #' @inheritSection AMR Download Our Reference Data
-#' @references
+#' @source
 #' Taxonomic entries were imported in this order of importance:
 #' 1. `r TAXONOMY_VERSION$LPSN$name`:\cr\cr
 #'    `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
@@ -182,8 +182,7 @@
 #' A data set containing commonly used codes for microorganisms, from laboratory systems and [WHONET](https://whonet.org). Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
 #' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.codes), big.mark = " ")` observations and `r ncol(microorganisms.codes)` variables:
 #' - `code`\cr Commonly used code of a microorganism. ***This is a unique identifier.***
-#' - `mo`\cr ID of the microorganism in the [microorganisms] data set. This is the record of the name that the code was named after, also if that name is outdated, so that the code and the microorganism ID remain relatable: e.g., the WHONET code `EAE` refers to *Enterobacter aerogenes* (`B_ENTRBC_AERG`). [as.mo()] returns the current name, here *Klebsiella aerogenes*. Codes for organisms that are not in the [microorganisms] data set, such as viruses, refer to `UNKNOWN`.
-#' - `source`\cr Source of the code, with the name it refers to, e.g. `"WHONET (Enterobacter aerogenes)"`, or `NA` if the source is unknown
+#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
 #' @inheritSection AMR Download Our Reference Data
 #' @seealso [as.mo()] [microorganisms]
 #' @examples
@@ -223,8 +222,8 @@
 #' - `date`\cr Date of receipt at the laboratory
 #' - `patient`\cr ID of the patient
 #' - `age`\cr Age of the patient
-#' - `gender`\cr Gender of the patient, either `r vector_or(example_isolates$gender, documentation = TRUE)`
-#' - `ward`\cr Ward type where the patient was admitted, either `r vector_or(example_isolates$ward, documentation = TRUE)`
+#' - `gender`\cr Gender of the patient, either `r vector_or(example_isolates$gender)`
+#' - `ward`\cr Ward type where the patient was admitted, either `r vector_or(example_isolates$ward)`
 #' - `mo`\cr ID of microorganism created with [as.mo()], see also the [microorganisms] data set
 #' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.sir))` different antimicrobials with class [`sir`] (see [as.sir()]); these column names occur in the [antimicrobials] data set and can be translated with [set_ab_names()] or [ab_name()]
 #' @inheritSection AMR Download Our Reference Data
@@ -283,7 +282,7 @@
 
 #' Data Set with Clinical Breakpoints for SIR Interpretation
 #'
-#' @description Data set containing clinical breakpoints to interpret MIC and disk diffusion to SIR values, according to international guidelines. This data set contains breakpoints for humans, `r length(unique(clinical_breakpoints$host[!clinical_breakpoints$host %in% clinical_breakpoints$type]))` different animal groups, and ECOFFs.
+#' @description Data set containing clinical breakpoints to interpret MIC and disk diffusion to SIR values, according to international guidelines. This dataset contain breakpoints for humans, `r length(unique(clinical_breakpoints$host[!clinical_breakpoints$host %in% clinical_breakpoints$type]))` different animal groups, and ECOFFs.
 #'
 #' These breakpoints are currently implemented:
 #' - For **clinical microbiology**: EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "human")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "human")$guideline)))` and CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "human")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "human")$guideline)))`;
@@ -293,46 +292,29 @@
 #' Use [as.sir()] to transform MICs or disks measurements to SIR values.
 #' @format A [tibble][tibble::tibble] with `r format(nrow(clinical_breakpoints), big.mark = " ")` observations and `r ncol(clinical_breakpoints)` variables:
 #' - `guideline`\cr Name of the guideline
-#' - `type`\cr Breakpoint type, either `r vector_or(clinical_breakpoints$type, documentation = TRUE)`
-#' - `host`\cr Host of infectious agent. This is mostly useful for veterinary breakpoints and is either `r vector_or(clinical_breakpoints$host, documentation = TRUE)`
-#' - `method`\cr Testing method, either `r vector_or(clinical_breakpoints$method, documentation = TRUE)`
+#' - `type`\cr Breakpoint type, either `r vector_or(clinical_breakpoints$type)`
+#' - `host`\cr Host of infectious agent. This is mostly useful for veterinary breakpoints and is either `r vector_or(clinical_breakpoints$host)`
+#' - `method`\cr Testing method, either `r vector_or(clinical_breakpoints$method)`
 #' - `site`\cr Body site for which the breakpoint must be applied, e.g. "Oral" or "Respiratory"
 #' - `mo`\cr Microbial ID, see [as.mo()]
-#' - `rank_index`\cr Taxonomic rank index of `mo`, used to choose the most specific breakpoint (the lowest index): 1 for subspecies and infraspecies, 2 for species, 2.5 for species groups (e.g., *Streptococcus* group A), 3 for genus, 4 for family, 5 for order, 5.5 for anaerobic bacteria, 6 for other groups (e.g., Gram-negative bacteria), and 7 for non-species related (PK-PD) breakpoints. Blocking rows (see *Details*) have the rank index of their organism + 0.1, e.g., 2.6 for a species group, so that a breakpoint for the same organism always takes precedence.
+#' - `rank_index`\cr Taxonomic rank index of `mo` from 1 (subspecies/infraspecies) to 5 (unknown microorganism)
 #' - `ab`\cr Antimicrobial code as used by this package, EARS-Net and WHONET, see [as.ab()]
 #' - `ref_tbl`\cr Info about where the guideline rule can be found
 #' - `disk_dose`\cr Dose of the used disk diffusion method
-#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S", is `NA` for blocking rows (see *Details*). EUCAST's off-scale MIC breakpoint of 0.001 mg/L, which indicates that there is no S category, is stored as 0.0001 to keep all isolates out of "S".
+#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
 #' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R", can be `NA`
 #' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
 #' - `is_SDD`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the intermediate range between "S" and "R" should be interpreted as "SDD", instead of "I". This currently applies to `r sum(clinical_breakpoints$is_SDD)` breakpoints.
-#' - `note`\cr Notes from the guideline that apply to the breakpoint, if available
 #' @details
 #' ### Different Types of Breakpoints
-#' Supported types of breakpoints are `r vector_and(clinical_breakpoints$type, quotes = FALSE)`. ECOFF (Epidemiological cut-off) values are used in antimicrobial susceptibility testing to differentiate between wild-type and non-wild-type strains of bacteria or fungi.
+#' Supported types of breakpoints are `r vector_and(clinical_breakpoints$type, quote = FALSE)`. ECOFF (Epidemiological cut-off) values are used in antimicrobial susceptibility testing to differentiate between wild-type and non-wild-type strains of bacteria or fungi.
 #'
 #' The default is `"human"`, which can also be set with the package option [`AMR_breakpoint_type`][AMR-options]. Use [`as.sir(..., breakpoint_type = ...)`][as.sir()] to interpret raw data using a specific breakpoint type, e.g. `as.sir(..., breakpoint_type = "ECOFF")` to use ECOFFs.
 #'
-#' ### Blocking Rows
-#' Where EUCAST lists an organism but gives no breakpoint for it (e.g. "IE", "-", "Note", an organism excluded with "except", or no S category for a zone diameter), [as.sir()] must not fall back to the breakpoint of a broader taxon, such as the breakpoint for *Vibrio* spp. where EUCAST gives "IE" for *V. fluvialis*. Such cases are included as "blocking rows": rows in which `breakpoint_S` and `breakpoint_R` are both `NA` and the `note` starts with `"[No breakpoint]"` followed by the reason. [as.sir()] returns `NA` for these. This currently applies to `r format(sum(is.na(clinical_breakpoints$breakpoint_S) & is.na(clinical_breakpoints$breakpoint_R)), big.mark = " ")` rows. Remove them with `subset(clinical_breakpoints, !is.na(breakpoint_S))` if only actual breakpoints are needed.
-#'
-#' **EUCAST's breakpoints in brackets** are not in this data set. EUCAST bases these on ECOFFs, and states that reporting S or I should be avoided. [as.sir()] therefore treats them as absent, and can use PK/PD breakpoints or, for unknown UTI status, UTI breakpoints instead. All bracketed values are kept in the [raw import of the EUCAST tables](https://github.com/msberends/AMR/blob/main/data-raw/breakpoints_eucast_raw.csv) (column `is_bracketed`).
-#'
-#' Where another guideline has no S category for a zone diameter, such as CLSI for fluconazole in *C. glabrata* (SDD and R only), only `breakpoint_R` is given, and the `note` starts with `"[No S category]"`. [as.sir()] then returns R where applicable, and `NA` otherwise.
-#'
 #' ### Imported From WHONET
-#' Some breakpoints in this package were validated through and imported from [WHONET](https://whonet.org), a free desktop Windows application developed and supported by the WHO Collaborating Centre for Surveillance of Antimicrobial Resistance. More can be read on [their website](https://whonet.org). The developers of WHONET and this `AMR` package have been in contact about sharing their work. We highly appreciate their great development on the WHONET software.
+#' Clinical breakpoints in this package were validated through and imported from [WHONET](https://whonet.org), a free desktop Windows application developed and supported by the WHO Collaborating Centre for Surveillance of Antimicrobial Resistance. More can be read on [their website](https://whonet.org). The developers of WHONET and this `AMR` package have been in contact about sharing their work. We highly appreciate their great development on the WHONET software.
 #'
-#' From WHONET, imported were:
-#'
-#' * All CLSI breakpoints, including ECOFF
-#' * All non-human EUCAST breakpoints, including ECOFF
-#' * Human EUCAST breakpoints between `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "human")$guideline)))` and 2018
-#' * Human EUCAST antifungal breakpoints between 2019 and 2025
-#'
-#' Human EUCAST breakpoints from 2019 onwards (antifungal breakpoints from 2026 onwards) were retrieved directly from the EUCAST Clinical Breakpoint Tables published on <https://www.eucast.org>, using [this script](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_clinical_breakpoints_eucast.R).
-#'
-#' Our WHONET import script can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_clinical_breakpoints.R).
+#' Our import and reproduction script can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_clinical_breakpoints.R>.
 #'
 #' ### Response From CLSI and EUCAST
 #' The CEO of CLSI and the chairman of EUCAST have endorsed the work and public use of this `AMR` package (and consequently the use of their breakpoints) in June 2023, when future development of distributing clinical breakpoints was discussed in a meeting between CLSI, EUCAST, WHO, developers of WHONET software, and developers of this `AMR` package.
@@ -351,14 +333,12 @@
 #' @format A [tibble][tibble::tibble] with `r format(nrow(intrinsic_resistant), big.mark = " ")` observations and `r ncol(intrinsic_resistant)` variables:
 #' - `mo`\cr Microorganism ID which occurs in [`microorganisms$mo`][microorganisms]. Names can be retrieved using [mo_name()].
 #' - `ab`\cr Antimicrobial ID which occurs in [`antimicrobials$ab`][antimicrobials]. Names can be retrieved using [ab_name()].
-#' - `version`\cr Guideline name and version.
 #' @details
-#' This data set is currently strictly follows `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`. The
+#' This data set is currently based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`.
 #'
 #' This data set is internally used by:
 #' * [not_intrinsic_resistant()] (an [antimicrobial selector][antimicrobial_selectors])
 #' * [mo_is_intrinsic_resistant()]
-#' * [wisca()] to model \eqn{\beta(1, 9999)} for resistant bug-drug combinations, per \doi{10.1093/jac/dkv397}
 #' @inheritSection AMR Download Our Reference Data
 #' @examples
 #' intrinsic_resistant
@@ -370,10 +350,10 @@
 #' @format A [tibble][tibble::tibble] with `r format(nrow(dosage), big.mark = " ")` observations and `r ncol(dosage)` variables:
 #' - `ab`\cr Antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
 #' - `name`\cr Official name of the antimicrobial drug as used by WHONET/EARS-Net or the WHO
-#' - `type`\cr Type of the dosage, either `r vector_or(dosage$type, documentation = TRUE)`
+#' - `type`\cr Type of the dosage, either `r vector_or(dosage$type)`
 #' - `dose`\cr Dose, such as "2 g" or "25 mg/kg"
 #' - `dose_times`\cr Number of times a dose must be administered
-#' - `administration`\cr Route of administration, either `r vector_or(dosage$administration, documentation = TRUE)`
+#' - `administration`\cr Route of administration, either `r vector_or(dosage$administration)`
 #' - `notes`\cr Additional dosage notes
 #' - `original_txt`\cr Original text in the PDF file of EUCAST
 #' - `eucast_version`\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply, either `r vector_or(dosage$eucast_version, quotes = FALSE, sort = TRUE, reverse = TRUE)`
@@ -388,7 +368,7 @@
 #' @format A [tibble][tibble::tibble] with `r format(nrow(esbl_isolates), big.mark = " ")` observations and `r ncol(esbl_isolates)` variables:
 #' - `esbl`\cr Logical indicator if the isolate is ESBL-producing
 #' - `genus`\cr Genus of the microorganism
-#' - `AMC:COL`\cr MIC values for 17 antimicrobial drugs, transformed to class [`mic`] (see [as.mic()])
+#' - `AMC:COL`\cr MIC values for 17 antimicrobial agents, transformed to class [`mic`] (see [as.mic()])
 #' @details See our [tidymodels integration][amr-tidymodels] for an example using this data set.
 #' @examples
 #' esbl_isolates

R/disk.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -35,7 +35,7 @@
 #' @param na.rm A [logical] indicating whether missing values should be removed.
 #' @details Interpret disk values as SIR values with [as.sir()]. It supports guidelines from EUCAST and CLSI.
 #'
-#' Disk diffusion growth zone sizes must be between 0 and 50 millimetres. Decimal values are rounded up. All input values outside the 0-50 range, including values higher than 50, return `NA` with a warning.
+#' Disk diffusion growth zone sizes must be between 0 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 0-50 range will return `NA`.
 #' @return An [integer] with additional class [`disk`]
 #' @aliases disk
 #' @export
@@ -83,31 +83,34 @@ as.disk <- function(x, na.rm = FALSE) {
 
     na_before <- length(x[is.na(x)])
 
-    # extract a plausible numeric disk zone value from character input
-    extract_disk_value <- function(x) {
-      x <- as.character(x)
-      # normalise decimal separators
+    # heavily based on cleaner::clean_double():
+    clean_double2 <- function(x, remove = "[^0-9.,-]", fixed = FALSE) {
       x <- gsub(",", ".", x, fixed = TRUE)
-      # strip known context: leading/trailing whitespace, SIR interpretations,
-      # comparison operators, semicolons, and surrounding whitespace
-      x <- trimws(x)
-      # remove trailing SIR interpretation (e.g., "42; S", "28 R")
-      x <- gsub("[;[:space:]]+[SIRsir]$", "", x)
-      # remove leading comparison operators (e.g., ">=20", "<=6")
-      x <- gsub("^[<>=]+\\s*", "", x)
-      x <- trimws(x)
-      # now the remainder must be a plausible standalone number
-      out <- rep(NA_real_, length(x))
-      is_numeric <- grepl("^[0-9]+\\.?[0-9]*$", x)
-      out[is_numeric] <- as.double(x[is_numeric])
-      out
+      # remove ending dot/comma
+      x <- gsub("[,.]$", "", x)
+      # only keep last dot/comma
+      reverse <- function(x) vapply(FUN.VALUE = character(1), lapply(strsplit(x, NULL), rev), paste, collapse = "")
+      x <- sub("{{dot}}", ".",
+        gsub(".", "",
+          reverse(sub(".", "}}tod{{",
+            reverse(x),
+            fixed = TRUE
+          )),
+          fixed = TRUE
+        ),
+        fixed = TRUE
+      )
+      x_clean <- gsub(remove, "", x, ignore.case = TRUE, fixed = fixed)
+      # remove everything that is not a number or dot
+      as.double(gsub("[^0-9.]+", "", x_clean))
     }
 
-    # round up and coerce to integer
-    x <- as.integer(ceiling(extract_disk_value(x)))
-    # valid disk diffusion zones: 0-50 mm
-    x[x < 0 | x > 50] <- NA_integer_
+    # round up and make it an integer
+    x <- as.integer(ceiling(clean_double2(x)))
 
+    # disks can never be less than 0 mm or more than 50 mm
+    x[x < 0 | x > 99] <- NA_integer_
+    x[x > 50] <- 50L
     na_after <- length(x[is.na(x)])
 
     if (na_before != na_after) {
@@ -116,9 +119,9 @@ as.disk <- function(x, na.rm = FALSE) {
         sort() %pm>%
         vector_and(quotes = TRUE)
       cur_col <- get_current_column()
-      warning_("in {.help [{.fun as.disk}](AMR::as.disk)}: ", na_after - na_before, " result",
+      warning_("in `as.disk()`: ", na_after - na_before, " result",
         ifelse(na_after - na_before > 1, "s", ""),
-        ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
+        ifelse(is.null(cur_col), "", paste0(" in index '", cur_col, "'")),
         " truncated (",
         round(((na_after - na_before) / length(x)) * 100),
         "%) that were invalid disk zones: ",
@@ -159,7 +162,7 @@ is.disk <- function(x) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
 pillar_shaft.disk <- function(x, ...) {
   out <- trimws(format(x))
-  out[is.na(x)] <- pillar::style_na(NA)
+  out[is.na(x)] <- font_na(NA)
   create_pillar_column(out, align = "right", width = 2)
 }
 
@@ -167,7 +170,7 @@ pillar_shaft.disk <- function(x, ...) {
 #' @export
 #' @noRd
 print.disk <- function(x, ...) {
-  cat(format_inline_("Class {.cls disk}\n"))
+  cat("Class 'disk'\n")
   print(as.integer(x), quote = FALSE)
 }
 
@@ -233,14 +236,12 @@ rep.disk <- function(x, ...) {
 # this prevents the requirement for putting the dependency in Imports:
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
 get_skimmers.disk <- function(column) {
-  column <- as.integer(column)
   skimr::sfl(
     skim_type = "disk",
-    p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
-    p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
-    p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
-    p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
-    p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE),
-    hist = ~ skimr::inline_hist(stats::na.omit(column), 10)
+    min = ~ min(as.double(.), na.rm = TRUE),
+    max = ~ max(as.double(.), na.rm = TRUE),
+    median = ~ stats::median(as.double(.), na.rm = TRUE),
+    n_unique = ~ length(unique(stats::na.omit(.))),
+    hist = ~ skimr::inline_hist(stats::na.omit(as.double(.)))
   )
 }

R/export_biosample.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

R/first_isolate.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -61,7 +61,7 @@
 #'
 #' All isolates with a microbial ID of `NA` will be excluded as first isolate.
 #'
-#' ## Different methods
+#' ### Different methods
 #'
 #' According to previously-mentioned sources, there are different methods (algorithms) to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All methods select on a combination of the taxonomic genus and species (not subspecies).
 #'
@@ -89,29 +89,21 @@
 #' | - Major difference in any antimicrobial result   | - `first_isolate(x, type = "points")`                 |
 #' | - Any difference in key antimicrobial results    | - `first_isolate(x, type = "keyantimicrobials")`      |
 #'
-#' **Isolate-based**
-#'
-#' _Minimum variables required: Microorganism identifier_
+#' ### Isolate-based
 #'
 #' This method does not require any selection, as all isolates should be included. It does, however, respect all arguments set in the [first_isolate()] function. For example, the default setting for `include_unknown` (`FALSE`) will omit selection of rows without a microbial ID.
 #'
-#' **Patient-based**
+#' ### Patient-based
 #'
-#' _Minimum variables required: Microorganism identifier, Patient identifier_
+#' To include every genus-species combination per patient once, set the `episode_days` to `Inf`. This method makes sure that no duplicate isolates are selected from the same patient. This method is preferred to e.g. identify the first MRSA finding of each patient to determine the incidence. Conversely, in a large longitudinal data set, this could mean that isolates are *excluded* that were found years after the initial isolate.
 #'
-#' This method includes every genus-species combination per patient once. This method makes sure that no duplicate isolates are selected from the same patient. This method is preferred to e.g. identify the first MRSA finding of each patient to determine the incidence. Conversely, in a large longitudinal data set, this could mean that isolates are *excluded* that were found years after the initial isolate.
+#' ### Episode-based
 #'
-#' **Episode-based**
-#'
-#' _Minimum variables required: Microorganism identifier, Patient identifier, Date_
-#'
-#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be e.g., 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data or ICU cases, long episodes are common for analysing regional and national data.
+#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data or ICU cases, long episodes are common for analysing regional and national data.
 #'
 #' This is the most common method to correct for duplicate isolates. Patients are categorised into episodes based on their ID and dates (e.g., the date of specimen receipt or laboratory result). While this is a common method, it does not take into account antimicrobial test results. This means that e.g. a methicillin-resistant *Staphylococcus aureus* (MRSA) isolate cannot be differentiated from a wildtype *Staphylococcus aureus* isolate.
 #'
-#' **Phenotype-based**
-#'
-#' _Minimum variables required: Microorganism identifier, Patient identifier, Date, Antimicrobial test results_
+#' ### Phenotype-based
 #'
 #' This is a more reliable method, since it also *weighs* the antibiogram (antimicrobial test results) yielding so-called 'first weighted isolates'. There are two different methods to weigh the antibiogram:
 #'
@@ -134,7 +126,7 @@
 #' @seealso [key_antimicrobials()]
 #' @export
 #' @return A [logical] vector
-#' @references Methodology of these functions is strictly based on:
+#' @source Methodology of these functions is strictly based on:
 #'
 #' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
 #'
@@ -246,7 +238,7 @@ first_isolate <- function(x = NULL,
     FUN.VALUE = logical(1),
     X = x,
     # check only first 10,000 rows
-    FUN = function(x) any(as.character(x[1:10000]) %in% VALID_SIR_LEVELS, na.rm = TRUE),
+    FUN = function(x) any(as.character(x[1:10000]) %in% c("S", "SDD", "I", "R", "NI"), na.rm = TRUE),
     USE.NAMES = FALSE
   ))
   if (method == "phenotype-based" && !any_col_contains_sir) {
@@ -263,7 +255,8 @@ first_isolate <- function(x = NULL,
           ),
           ""
         )
-      )
+      ),
+      add_fn = font_red
     )
   }
 
@@ -271,7 +264,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 +301,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 +310,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 +326,7 @@ first_isolate <- function(x = NULL,
   check_columns_existance <- function(column, tblname = x) {
     if (!is.null(column)) {
       stop_ifnot(column %in% colnames(tblname),
-        "Column {.code ", column, "} not found.",
+        "Column '", column, "' not found.",
         call = FALSE
       )
     }
@@ -362,7 +355,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 +368,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 +412,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 +421,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,8 +429,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)) {
-      n_rows <- length(c(row.start:row.end))
-      message_("=> Found {.strong ", n_rows, " 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
       )
     }
@@ -448,16 +448,16 @@ first_isolate <- function(x = NULL,
   if (!is.null(col_keyantimicrobials)) {
     if (isTRUE(info) && message_not_thrown_before("first_isolate", "type")) {
       if (type == "keyantimicrobials") {
-        message_(
-          "Basing inclusion on key antimicrobials, ",
+        message_("Basing inclusion on key antimicrobials, ",
           ifelse(ignore_I == FALSE, "not ", ""),
-          "ignoring I"
+          "ignoring I",
+          add_fn = font_red
         )
       }
       if (type == "points") {
-        message_(
-          "Basing inclusion on all antimicrobial results, using a points threshold of ",
-          points_threshold
+        message_("Basing inclusion on all antimicrobial results, using a points threshold of ",
+          points_threshold,
+          add_fn = font_red
         )
       }
     }
@@ -516,7 +516,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)) {
@@ -540,8 +542,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
         )
       }
     }
@@ -554,7 +557,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 {.field ", 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
@@ -565,7 +569,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 {.field ", 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
@@ -611,7 +616,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/g.test.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -30,17 +30,7 @@
 #' *G*-test for Count Data
 #'
 #' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**).
-#' @inherit stats::chisq.test params
-#' @return A [list] with class `"htest"` containing the following components:
-#' * `statistic`: the value of the test statistic
-#' * `parameter`: the degrees of freedom of the approximate chi-squared distribution of the test statistic, `NA` if the p-value is computed by Monte Carlo simulation
-#' * `p.value`: the p-value for the test
-#' * `method`: a character string indicating the type of test performed, and whether Monte Carlo simulation was used
-#' * `data.name`: a character string giving the name(s) of the data
-#' * `observed`: the observed counts
-#' * `expected`: the expected counts under the null hypothesis
-#' * `residuals`: the Pearson residuals, `(observed - expected) / sqrt(expected)`
-#' * `stdres`: standardised residuals, `(observed - expected) / sqrt(V)`, where `V` is the residual cell variance (Agresti 2007, section 2.4.5) for the case where `x` is a matrix, `n * p * (1 - p)` otherwise
+#' @inherit stats::chisq.test params return
 #' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
 #'
 #' If `x` is a [matrix] with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers.  Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these.  Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
@@ -83,8 +73,6 @@
 #' If there are more than two categories and you want to find out which ones are significantly different from their null expectation, you can use the same method of testing each category vs. the sum of all categories, with the Bonferroni correction. You use *G*-tests for each category, of course.
 #' @seealso [chisq.test()]
 #' @references 1. McDonald, J.H. 2014. **Handbook of Biological Statistics (3rd ed.)**. Sparky House Publishing, Baltimore, Maryland.
-#'
-#' 2. Agresti, A. 2007. **An Introduction to Categorical Data Analysis (2nd ed.)**. Wiley, New York.
 #' @source The code for this function is identical to that of [chisq.test()], except that:
 #' - The calculation of the statistic was changed to \eqn{2 * sum(x * log(x / E))}
 #' - Yates' continuity correction was removed as it does not apply to a *G*-test
@@ -230,7 +218,7 @@ g.test <- function(x,
   }
 
   structure(list(
-    statistic = STATISTIC, parameter = PARAMETER,
+    statistic = STATISTIC, argument = PARAMETER,
     p.value = PVAL, method = METHOD, data.name = DNAME,
     observed = x, expected = E, residuals = (x - E) / sqrt(E),
     stdres = (x - E) / sqrt(V)

R/get_episode.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -215,7 +215,7 @@ is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
 
 exec_episode <- function(x, episode_days, case_free_days, ...) {
   stop_ifnot(is.null(episode_days) || is.null(case_free_days),
-    "either argument {.arg episode_days} or argument {.arg case_free_days} must be set.",
+    "either argument `episode_days` or argument `case_free_days` must be set.",
     call = -2
   )
 

R/ggplot_pca.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -32,7 +32,6 @@
 #' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
 #' @param x An object returned by [pca()], [prcomp()] or [princomp()].
 #' @inheritParams stats::biplot.prcomp
-#' @param pc.biplot If `TRUE`, use what Gabriel (1971) refers to as a 'principal component biplot', with `lambda = 1` and observations scaled up by `sqrt(n)` and variables scaled down by `sqrt(n)`. Then inner products between variables approximate covariances and distances between observations approximate Mahalanobis distance.
 #' @param labels An optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
 #' @param labels_textsize The size of the text used for the labels.
 #' @param labels_text_placement Adjustment factor the placement of the variable names (`>=1` means further away from the arrow head).
@@ -52,7 +51,6 @@
 #' @param arrows_alpha The alpha (transparency) of the arrows and their text.
 #' @param base_textsize The text size for all plot elements except the labels and arrows.
 #' @param ... Arguments passed on to functions.
-#' @references Gabriel, K.R. 1971. **The biplot graphical display of matrices with application to principal component analysis**. *Biometrika* 58(3):453-467. \doi{10.1093/biomet/58.3.453}
 #' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015).
 #'
 #' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
@@ -151,7 +149,6 @@ ggplot_pca <- function(x,
     pca_model = x,
     groups = groups,
     groups_missing = missing(groups),
-    group_name = if (missing(groups)) NULL else paste(deparse(substitute(groups)), collapse = ""),
     labels = labels,
     labels_missing = missing(labels),
     choices = choices,
@@ -184,19 +181,8 @@ ggplot_pca <- function(x,
   )
 
   # Score Labels
-  labels_parse <- FALSE
   if (!is.null(labels)) {
     df.u$labels <- labels
-    if (contains_taxonomy(labels)) {
-      # italicise taxonomic names, as plotmath text to be parsed by geom_text()
-      labels_parse <- TRUE
-      df.u$labels <- vapply(
-        FUN.VALUE = character(1),
-        as.list(labels_taxonomy(labels)),
-        function(e) if (is.character(e) && is.na(e)) NA_character_ else paste(deparse(e, width.cutoff = 500L), collapse = ""),
-        USE.NAMES = FALSE
-      )
-    }
   }
 
   # Grouping variable
@@ -225,8 +211,7 @@ ggplot_pca <- function(x,
       ) +
         ggplot2::geom_text(ggplot2::aes(label = labels, colour = groups),
           nudge_y = -0.05,
-          size = labels_textsize,
-          parse = labels_parse
+          size = labels_textsize
         ) +
         ggplot2::labs(colour = group_name)
     } else {
@@ -236,8 +221,7 @@ ggplot_pca <- function(x,
       ) +
         ggplot2::geom_text(ggplot2::aes(label = labels),
           nudge_y = -0.05,
-          size = labels_textsize,
-          parse = labels_parse
+          size = labels_textsize
         )
     }
   } else {
@@ -255,11 +239,6 @@ ggplot_pca <- function(x,
     }
   }
 
-  # italicise taxonomic names in the legend
-  if (!is.null(df.u$groups) && contains_taxonomy(df.u$groups)) {
-    g <- g + ggplot2::scale_colour_discrete(labels = labels_taxonomy)
-  }
-
   # Overlay a concentration ellipse if there are groups
   if (!is.null(df.u$groups) && !is.null(ell) && isTRUE(ellipse)) {
     g <- g + ggplot2::geom_path(
@@ -327,7 +306,6 @@ ggplot_pca <- function(x,
 pca_calculations <- function(pca_model,
                              groups = NULL,
                              groups_missing = TRUE,
-                             group_name = NULL,
                              labels = NULL,
                              labels_missing = TRUE,
                              choices = 1:2,
@@ -349,8 +327,8 @@ pca_calculations <- function(pca_model,
       error = function(e) NULL
     )
   }
-  if (groups_missing && !is.null(groups) && is.null(labels)) {
-    # only one non-numeric column: use it for labels instead of groups
+  if (!is.null(groups) && is.null(labels)) {
+    # turn them around
     labels <- groups
     groups <- NULL
     group_name <- NULL

R/ggplot_sir.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -33,10 +33,10 @@
 #' @param data A [data.frame] with column(s) of class [`sir`] (see [as.sir()]).
 #' @param position Position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`.
 #' @param x Variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable.
-#' @param fill Variable to categorise using the plots legend, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable. For [labels_sir_count()], this must be the same as the `fill` of [geom_sir()], so that the labels are placed on the right bars. If the interpretation is not shown in the plot (i.e., neither in `x`, `fill`, nor `facet`), only the susceptible proportion is plotted, which follows the guideline (see `guideline`): S+SDD+I for EUCAST, S+SDD for CLSI, and S if `guideline = NULL`.
+#' @param fill Variable to categorise using the plots legend, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable.
 #' @param breaks A [numeric] vector of positions.
 #' @param limits A [numeric] vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum.
-#' @param facet Variable to split plots by, either `"interpretation"` or `"antibiotic"` or a grouping variable. If there is more than one antimicrobial and the antimicrobial is not shown in the plot (i.e., neither in `x`, `fill`, nor `facet`), [ggplot_sir()] splits the plot by antimicrobial, as their bars would otherwise be stacked: using `facet = "antibiotic"` if `facet` is not set, and otherwise using a grid of `facet` by antimicrobial. Note that [geom_sir()] cannot do this, so add [facet_sir()] in that case.
+#' @param facet Variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable.
 #' @inheritParams proportion
 #' @param nrow (when using `facet`) number of rows.
 #' @param colours A named vactor with colour to be used for filling. The default colours are colour-blind friendly.
@@ -49,7 +49,6 @@
 #' @param x.title Text to show as x axis description.
 #' @param y.title Text to show as y axis description.
 #' @param ... Other arguments passed on to [geom_sir()] or, in case of [scale_sir_colours()], named values to set colours. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red. See *Examples*.
-#' @inheritSection as.sir Interpretation of SIR
 #' @details At default, the names of antimicrobials will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
 #'
 #' [geom_sir()] will take any variable from the data that has an [`sir`] class (created with [as.sir()]) using [sir_df()] and will plot bars with the percentage S, I, and R. The default behaviour is to have the bars stacked and to have the different antimicrobials on the x axis.
@@ -172,10 +171,9 @@ ggplot_sir <- function(data,
                        breaks = seq(0, 1, 0.1),
                        limits = NULL,
                        translate_ab = "name",
-                       combine_SI,
+                       combine_SI = TRUE,
                        minimum = 30,
                        language = get_AMR_locale(),
-                       guideline = getOption("AMR_guideline", "EUCAST"),
                        nrow = NULL,
                        colours = c(
                          S = "#3CAEA3",
@@ -204,7 +202,7 @@ ggplot_sir <- function(data,
   meet_criteria(breaks, allow_class = c("numeric", "integer"))
   meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE)
   meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
-  guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "ggplot_sir")
+  meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
   language <- validate_language(language)
   meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
@@ -240,26 +238,11 @@ ggplot_sir <- function(data,
     position <- "fill"
   }
 
-  plot_df <- tryCatch(
-    sir_df(data = data, translate_ab = translate_ab, language = language, minimum = minimum, guideline = guideline),
-    error = function(e) NULL
-  )
-  shown <- c(normalise_sir_plot_var(x), normalise_sir_plot_var(fill), normalise_sir_plot_var(facet))
-  facet_grid_ab <- FALSE
-  if (!is.null(plot_df) && length(unique(plot_df$antibiotic)) > 1 && !"antibiotic" %in% shown) {
-    # the antibiotic is not shown, so the bars of all antibiotics would be stacked; split the plot by antibiotic
-    if (is.null(facet)) {
-      facet <- "antibiotic"
-    } else {
-      facet_grid_ab <- TRUE
-    }
-  }
-
   p <- ggplot2::ggplot(data = data) +
-    create_geom_sir(
-      position = position, x = x, fill = fill, facet = facet, translate_ab = translate_ab,
+    geom_sir(
+      position = position, x = x, fill = fill, translate_ab = translate_ab,
       minimum = minimum, language = language,
-      guideline = guideline, ...
+      combine_SI = combine_SI, ...
     ) +
     theme_sir()
 
@@ -273,46 +256,20 @@ ggplot_sir <- function(data,
   }
 
   if (datalabels == TRUE) {
-    p <- p + create_labels_sir_count(
+    p <- p + labels_sir_count(
       position = position,
       x = x,
-      fill = fill,
-      facet = facet,
       translate_ab = translate_ab,
       minimum = minimum,
       language = language,
-      guideline = guideline,
+      combine_SI = combine_SI,
       datalabels.size = datalabels.size,
       datalabels.colour = datalabels.colour
     )
   }
 
-  # italicise taxonomic names on the x axis and in the legend, e.g. with x = "mo" or fill = "mo"
-  if (x %in% colnames(data) && contains_taxonomy(data[[x]])) {
-    p <- p + ggplot2::scale_x_discrete(labels = labels_taxonomy)
-  }
-  if (fill != "interpretation" && fill %in% colnames(data) && contains_taxonomy(data[[fill]])) {
-    p <- p + ggplot2::scale_fill_discrete(labels = labels_taxonomy)
-  }
-
-  if (isTRUE(facet_grid_ab)) {
-    # a grid of the set facet by antibiotic
-    p <- p + ggplot2::facet_grid(
-      stats::as.formula(paste0("`", normalise_sir_plot_var(facet), "` ~ antibiotic")),
-      scales = "free_x",
-      labeller = labeller_taxonomy
-    )
-  } else if (!is.null(facet)) {
-    # pass the value, as facet_sir() takes an unquoted name as column name
-    p <- p + do.call(facet_sir, list(facet = facet, nrow = nrow))
-  }
-
-  if (missing(y.title) && !"interpretation" %in% c(normalise_sir_plot_var(x), normalise_sir_plot_var(fill), normalise_sir_plot_var(facet))) {
-    # only the susceptible proportion is shown, e.g. "Proportion SI" for EUCAST
-    susceptible <- if (is.null(plot_df)) NULL else levels(plot_df$interpretation)[1]
-    if (!is.null(susceptible)) {
-      y.title <- paste(y.title, susceptible)
-    }
+  if (!is.null(facet)) {
+    p <- p + facet_sir(facet = facet, nrow = nrow)
   }
 
   p <- p + ggplot2::labs(
@@ -334,19 +291,27 @@ geom_sir <- function(position = NULL,
                      translate_ab = "name",
                      minimum = 30,
                      language = get_AMR_locale(),
-                     combine_SI,
-                     guideline = getOption("AMR_guideline", "EUCAST"),
+                     combine_SI = TRUE,
                      ...) {
   x <- x[1]
   stop_ifnot_installed("ggplot2")
-  stop_if(is.data.frame(position), "{.arg position} is invalid. Did you accidentally use {.code %>%} instead of {.code +}?")
+  stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%>%' instead of '+'?")
   meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
   meet_criteria(x, allow_class = "character", has_length = 1)
   meet_criteria(fill, allow_class = "character", has_length = 1)
   meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
   language <- validate_language(language)
-  guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "geom_sir")
+  meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
+
+  y <- "value"
+  if (missing(position) || is.null(position)) {
+    position <- "fill"
+  }
+
+  if (identical(position, "fill")) {
+    position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE)
+  }
 
   x_deparse <- deparse(substitute(x))
   if (x_deparse != "x") {
@@ -356,63 +321,24 @@ geom_sir <- function(position = NULL,
     x <- substr(x, 2, nchar(x) - 1)
   }
 
-  create_geom_sir(
-    position = position, x = x, fill = fill, facet = NULL, translate_ab = translate_ab,
-    minimum = minimum, language = language, guideline = guideline, ...
-  )
-}
+  if (tolower(x) %in% tolower(c("ab", "abx", "antimicrobials"))) {
+    x <- "antibiotic"
+  } else if (tolower(x) %in% tolower(c("SIR", "sir", "interpretations", "result"))) {
+    x <- "interpretation"
+  }
 
-normalise_sir_plot_var <- function(v) {
-  # aliases for the columns of sir_df(), as also used by facet_sir()
-  if (is.null(v)) {
-    return(NULL)
-  }
-  if (tolower(v) %in% tolower(c("ab", "abx", "antimicrobials"))) {
-    v <- "antibiotic"
-  } else if (tolower(v) %in% tolower(c("SIR", "sir", "interpretations", "result"))) {
-    v <- "interpretation"
-  }
-  v
-}
-
-create_geom_sir <- function(position, x, fill, facet, translate_ab, minimum, language, guideline, ...) {
-  if (is.null(position)) {
-    position <- "fill"
-  }
-  if (identical(position, "fill")) {
-    position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE)
-  }
-  x <- normalise_sir_plot_var(x)
   ggplot2::geom_col(
-    data = function(data) {
-      sir_plot_data(
-        data = data, x = x, fill = fill, facet = facet, translate_ab = translate_ab,
-        minimum = minimum, language = language, guideline = guideline
+    data = function(x) {
+      sir_df(
+        data = x,
+        translate_ab = translate_ab,
+        language = language,
+        minimum = minimum,
+        combine_SI = combine_SI
       )
     },
-    mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang("value"), fill = str2lang(fill))),
+    mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang(y), fill = str2lang(fill))),
     position = position,
     ...
   )
 }
-
-sir_plot_data <- function(data, x, fill, facet, translate_ab, minimum, language, guideline) {
-  out <- sir_df(
-    data = data,
-    translate_ab = translate_ab,
-    language = language,
-    minimum = minimum,
-    guideline = guideline
-  )
-  if (!"interpretation" %in% c(normalise_sir_plot_var(x), normalise_sir_plot_var(fill), normalise_sir_plot_var(facet))) {
-    # the interpretation is not shown, so the bars of all interpretations would overlap;
-    # keep only the susceptible proportion, which is the first level and follows the guideline:
-    # S+SDD+I ("SI") for EUCAST, S+SDD ("S") for CLSI, and S for guideline = NULL
-    # the number of isolates of the data labels then becomes the number of tested isolates
-    keys <- do.call(paste, c(out[, setdiff(colnames(out), c("interpretation", "value", "ci_min", "ci_max", "isolates")), drop = FALSE], sep = "\r"))
-    totals <- tapply(out$isolates, keys, sum)
-    out$isolates <- as.integer(totals[keys])
-    out <- out[which(as.character(out$interpretation) == levels(out$interpretation)[1]), , drop = FALSE]
-  }
-  out
-}

R/guess_ab_col.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,7 +27,7 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Guess Antimicrobial Column
+#' Guess Antibiotic Column
 #'
 #' This tries to find a column name in a data set based on information from the [antimicrobials] data set. Also supports WHONET abbreviations.
 #' @param x A [data.frame].
@@ -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
       )
     }
@@ -86,7 +87,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_s
   } else {
     if (isTRUE(verbose)) {
       message_(
-        "Using column {.field ", font_bold(ab_result), "} as input for ", search_string,
+        "Using column '", font_bold(ab_result), "' as input for ", search_string,
         " (", ab_name(search_string, language = NULL, tolower = TRUE), ")."
       )
     }
@@ -146,7 +147,7 @@ get_column_abx <- function(x,
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(sort, allow_class = "logical", has_length = 1)
 
-  if (isTRUE(info) && message_not_thrown_before("get_column_abx", colnames(x))) {
+  if (isTRUE(info)) {
     message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, 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 [{.fun as.ab}](AMR::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,17 +266,17 @@ 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 [{.fun as.ab}](AMR::as.ab)} are duplicated: ", vector_and(dups, quotes = FALSE), 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))) {
         if (isTRUE(verbose) && !out[i] %in% duplicates) {
           message_(
-            "Using column {.field ", font_bold(out[i]), "} as input for ", names(out)[i],
+            "Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
             " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
           )
         }
@@ -284,10 +285,11 @@ get_column_abx <- function(x,
           if (names(out)[i] != already_set_as) {
             message_(
               paste0(
-                "Column {.field ", font_bold(out[i]), "} will not be used for ",
+                "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
             )
           }
         }
@@ -340,13 +342,14 @@ get_ab_from_namespace <- function(x, cols_ab) {
 
   x <- trimws2(unique(toupper(unlist(strsplit(x, ",", fixed = TRUE)))))
   x_new <- character()
-  ns <- asNamespace("AMR")
   for (val in x) {
-    if (exists(paste0("AB_", val), envir = ns, inherits = FALSE)) {
+    if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
       # antibiotic group names, as defined in data-raw/_pre_commit_checks.R, such as `AB_CARBAPENEMS`
-      val <- get(paste0("AB_", val), envir = ns, inherits = FALSE)
-    } else if (!val %in% AMR_env$AB_lookup$ab) {
-      # anything else must be a separate drug, such as `AMX`, which is then already a valid code
+      val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
+    } else if (val %in% AMR_env$AB_lookup$ab) {
+      # separate drugs, such as `AMX`
+      val <- as.ab(val)
+    } else {
       stop_("unknown antimicrobial drug (group): ", val, call = FALSE)
     }
     x_new <- c(x_new, val)

R/italicise_taxonomy.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,57 +27,31 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Italicise Taxonomic Families, Genera, Species, and Subspecies
+#' Italicise Taxonomic Families, Genera, Species, Subspecies
 #'
 #' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italics. This function finds taxonomic names within strings and makes them italic.
 #' @param string A [character] (vector).
-#' @param type Type of conversion of the taxonomic names, either "markdown", "html", "ansi" or "plotmath", see *Details*.
+#' @param type Type of conversion of the taxonomic names, either "markdown", "html" or "ansi", see *Details*.
 #' @details
-#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set. Family and genus names are italicised anywhere in the text. Species and subspecies names are only italicised when they follow a genus, an abbreviated genus (such as "E." in "E. coli"), or another species or subspecies name, so that ordinary words that are also species names (such as "coli" or "major") stay upright. Subspecies may also follow "subsp.", "ssp." or "var.", which stay upright themselves, e.g., "*K. pneumoniae* subsp. *ozaenae*". *Salmonella* serovars (such as Typhimurium) and groups are not italicised, as is the convention. Punctuation around the names, such as brackets and commas, stays outside the italics.
+#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set.
 #'
 #' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or `<i>` and `</i>` when using html. When using 'ansi', ANSI colours will be added using `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
 #'
-#' Use `type = "plotmath"` to get an [expression] vector for plots (see [plotmath][grDevices::plotmath]), which works for titles, axes and legends in both base \R and `ggplot2`. For axis and legend labels, the function [labels_taxonomy()] does exactly this and can directly be used as labeller, e.g., `ggplot2::scale_x_discrete(labels = labels_taxonomy)`.
-#' @return For "markdown", "html" and "ansi", a [character] vector. For "plotmath", an [expression] vector. Both have the same length as `string` and keep `NA` values.
-#' @seealso [labels_taxonomy()] to italicise taxonomic names in plot labels.
+#' This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
 #' @export
 #' @examples
 #' italicise_taxonomy("An overview of Staphylococcus aureus isolates")
 #' italicise_taxonomy("An overview of S. aureus isolates")
-#' italicise_taxonomy("Infections with E. coli (and coli bacteria in general)")
 #'
 #' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
-#'
-#' # for plots:
-#' italicise_taxonomy("An overview of S. aureus isolates", type = "plotmath")
-#' plot(1:10, main = italicise_taxonomy("Growth of S. aureus", type = "plotmath"))
-italicise_taxonomy <- function(string, type = c("markdown", "ansi", "html", "plotmath")) {
+italicise_taxonomy <- function(string, type = c("markdown", "ansi", "html")) {
   if (missing(type)) {
     type <- "markdown"
   }
   meet_criteria(string, allow_class = "character")
-  meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi", "html", "plotmath"))
+  meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi", "html"))
 
-  pieces <- taxonomy_pieces(string)
-
-  if (type == "plotmath") {
-    return(as.expression(lapply(pieces, function(p) {
-      if (is.null(p)) {
-        return(NA_character_)
-      }
-      if (!any(p$italic)) {
-        return(paste0(p$text, collapse = ""))
-      }
-      parts <- lapply(seq_along(p$text), function(i) {
-        if (p$italic[i]) call("italic", p$text[i]) else p$text[i]
-      })
-      if (length(parts) == 1) {
-        parts[[1]]
-      } else {
-        as.call(c(as.name("paste"), parts))
-      }
-    })))
-  }
+  add_MO_lookup_to_AMR_env()
 
   if (type == "markdown") {
     before <- "*"
@@ -95,144 +69,75 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi", "html", "plo
 
   vapply(
     FUN.VALUE = character(1),
-    pieces,
-    function(p) {
-      if (is.null(p)) {
-        return(NA_character_)
-      }
-      p$text[p$italic] <- paste0(before, p$text[p$italic], after)
-      paste0(p$text, collapse = "")
+    string,
+    function(s) {
+      s_split <- unlist(strsplit(s, " ", fixed = TRUE))
+
+      search_strings <- gsub("[^a-zA-Z-]", "", s_split)
+
+      ind_species <- search_strings != "" &
+        search_strings %in% AMR_env$MO_lookup[
+          which(AMR_env$MO_lookup$rank %in% c(
+            "family",
+            "genus",
+            "species",
+            "subspecies",
+            "infraspecies",
+            "subsp."
+          )),
+          "species",
+          drop = TRUE
+        ]
+
+      ind_fullname <- search_strings != "" &
+        search_strings %in% c(
+          AMR_env$MO_lookup[
+            which(AMR_env$MO_lookup$rank %in% c(
+              "family",
+              "genus",
+              "species",
+              "subspecies",
+              "infraspecies",
+              "subsp."
+            )),
+            "fullname",
+            drop = TRUE
+          ],
+          AMR_env$MO_lookup[
+            which(AMR_env$MO_lookup$rank %in% c(
+              "family",
+              "genus",
+              "species",
+              "subspecies",
+              "infraspecies",
+              "subsp."
+            )),
+            "subspecies",
+            drop = TRUE
+          ]
+        )
+
+      # also support E. coli, add "E." to indices
+      has_previous_genera_abbr <- s_split[which(ind_species) - 1] %like_case% "^[A-Z][.]?$"
+      ind_species <- c(which(ind_species), which(ind_species)[has_previous_genera_abbr] - 1)
+
+      ind <- c(ind_species, which(ind_fullname))
+
+      s_split[ind] <- paste0(before, s_split[ind], after)
+      s_paste <- paste(s_split, collapse = " ")
+
+      # clean up a bit
+      s_paste <- gsub(paste0(after, " ", before), " ", s_paste, fixed = TRUE)
+
+      s_paste
     },
     USE.NAMES = FALSE
   )
 }
 
-contains_taxonomy <- function(x) {
-  # whether any value holds a taxonomic name that would be italicised
-  x <- unique(as.character(x))
-  any(vapply(taxonomy_pieces(x[!is.na(x)]), function(p) any(p$italic), logical(1)))
-}
-
-get_taxonomy_names <- function() {
-  # cached for the session, reset by reset_mo_cache() when the lookup table changes
-  if (is.null(AMR_env$taxonomy_names)) {
-    add_MO_lookup_to_AMR_env()
-    lookup <- AMR_env$MO_lookup
-    families <- unique(lookup$family)
-    genera <- unique(lookup$genus)
-    epithets <- unique(c(
-      lookup$species[lookup$rank %in% c("species", "subspecies", "species group")],
-      lookup$subspecies[lookup$rank == "subspecies"]
-    ))
-    AMR_env$taxonomy_names <- list(
-      # only real names, so no "(unknown genus)" or similar
-      families = families[families %like_case% "^[A-Z][a-z-]+$"],
-      genera = genera[genera %like_case% "^[A-Z][a-z-]+$"],
-      # only lowercase epithets, so no Salmonella serovars ("Typhimurium") or groups ("Group A")
-      epithets = epithets[epithets %like_case% "^[a-z][a-z-]*$"]
-    )
-  }
-  AMR_env$taxonomy_names
-}
-
-taxonomy_pieces <- function(string) {
-  # returns a list with for every string NULL (if NA) or a list with `text` and `italic`
-  nms <- get_taxonomy_names()
-  out <- vector("list", length(string))
-  if (length(string) == 0) {
-    return(out)
-  }
-  # split all strings at once, so the lookups below run only once
-  words <- strsplit(string, " ", fixed = TRUE)
-  # strsplit() drops a trailing empty string
-  trailing <- which(!is.na(string) & string %like_case% " $")
-  words[trailing] <- lapply(words[trailing], c, "")
-  n_words <- lengths(words)
-  all_words <- unlist(words, use.names = FALSE)
-  all_words[is.na(all_words)] <- ""
-
-  # leading punctuation, the word itself, trailing punctuation
-  prefix <- gsub("^([^A-Za-z]*).*$", "\\1", all_words, perl = TRUE)
-  rest <- substr(all_words, nchar(prefix) + 1, nchar(all_words))
-  core <- gsub("^([A-Za-z]([A-Za-z-]*[A-Za-z])?).*$", "\\1", rest, perl = TRUE)
-  core[rest %unlike_case% "^[A-Za-z]"] <- ""
-  suffix <- substr(rest, nchar(core) + 1, nchar(rest))
-  # abbreviated genus, e.g. "E." in "E. coli"
-  is_abbr <- core %like_case% "^[A-Z]$" & suffix %like_case% "^[.]"
-  core[is_abbr] <- paste0(core[is_abbr], ".")
-  suffix[is_abbr] <- substr(suffix[is_abbr], 2, nchar(suffix[is_abbr]))
-
-  is_genus <- core != "" & core %in% nms$genera
-  is_higher <- is_genus | (core != "" & core %in% nms$families)
-  is_epithet <- core != "" & core %in% nms$epithets
-  is_connector <- all_words %in% c("subsp.", "ssp.", "var.")
-  ends <- cumsum(n_words)
-  starts <- ends - n_words + 1
-
-  for (s in which(!is.na(string))) {
-    ind <- seq.int(starts[s], length.out = n_words[s])
-    pre <- prefix[ind]
-    cr <- core[ind]
-    suf <- suffix[ind]
-    higher <- is_higher[ind]
-    genus <- is_genus[ind]
-    abbr <- is_abbr[ind]
-    epithet <- is_epithet[ind]
-    connector <- is_connector[ind]
-    n <- length(ind)
-    italic <- higher
-    # whether the next word can be a species or subspecies name
-    can_follow <- logical(n)
-    for (i in seq_len(n)) {
-      if (i > 1 && epithet[i] && pre[i] == "" && can_follow[i - 1]) {
-        italic[i] <- TRUE
-        if (abbr[i - 1]) {
-          italic[i - 1] <- TRUE
-        }
-      }
-      if (suf[i] == "" || connector[i]) {
-        can_follow[i] <- genus[i] ||
-          abbr[i] ||
-          (italic[i] && epithet[i]) ||
-          (connector[i] && i > 1 && italic[i - 1] && epithet[i - 1])
-      }
-    }
-    # connectors such as "subsp." are not part of the core, so keep them upright
-    cr[connector] <- all_words[ind][connector]
-    suf[connector] <- ""
-    italic[connector] <- FALSE
-
-    text <- character(0)
-    ital <- logical(0)
-    for (i in seq_len(n)) {
-      text <- c(text, pre[i], cr[i], suf[i])
-      ital <- c(ital, FALSE, italic[i], FALSE)
-      if (i < n) {
-        # the space between two italic words belongs to the italics
-        text <- c(text, " ")
-        ital <- c(ital, italic[i] && italic[i + 1] && suf[i] == "" && pre[i + 1] == "")
-      }
-    }
-    keep <- text != ""
-    text <- text[keep]
-    ital <- ital[keep]
-    if (length(text) == 0) {
-      out[[s]] <- list(text = "", italic = FALSE)
-      next
-    }
-    # merge adjacent pieces of the same style
-    grp <- cumsum(c(TRUE, ital[-1] != ital[-length(ital)]))
-    out[s] <- list(list(
-      text = vapply(split(text, grp), paste0, character(1), collapse = "", USE.NAMES = FALSE),
-      italic = vapply(split(ital, grp), function(x) x[1], logical(1), USE.NAMES = FALSE)
-    ))
-  }
-  out
-}
-
 #' @rdname italicise_taxonomy
 #' @export
-italicize_taxonomy <- function(string, type = c("markdown", "ansi", "html", "plotmath")) {
+italicize_taxonomy <- function(string, type = c("markdown", "ansi", "html")) {
   if (missing(type)) {
     type <- "markdown"
   }

R/join_microorganisms.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -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 {.fun ", 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/key_antimicrobials.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -159,13 +159,13 @@ key_antimicrobials <- function(x = NULL,
     col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
   }
   if (is.null(col_mo)) {
-    warning_("in {.fun key_antimicrobials}: no column found for {.arg col_mo}, ignoring antibiotics set in {.arg gram_negative} and {.arg gram_positive}, and antimycotics set in {.arg antifungal}")
+    warning_("in `key_antimicrobials()`: no column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`")
     gramstain <- NA_character_
-    domain <- NA_character_
+    kingdom <- NA_character_
   } else {
     x.mo <- as.mo(x[, col_mo, drop = TRUE])
     gramstain <- mo_gramstain(x.mo, language = NULL)
-    domain <- mo_domain(x.mo, language = NULL)
+    kingdom <- mo_kingdom(x.mo, language = NULL)
   }
 
   AMR_string <- function(x, values, name, filter, cols = cols) {
@@ -182,12 +182,12 @@ key_antimicrobials <- function(x = NULL,
       any(filter, na.rm = TRUE) &&
       message_not_thrown_before("key_antimicrobials", name)) {
       warning_(
-        "in {.help [{.fun key_antimicrobials}](AMR::key_antimicrobials)}: ",
+        "in `key_antimicrobials()`: ",
         ifelse(values_new_length == 0,
           "No columns available ",
           paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
         ),
-        "as key antimicrobials for ", name, "s. See {.help [{.fun key_antimicrobials}](AMR::key_antimicrobials)}."
+        "as key antimicrobials for ", name, "s. See `?key_antimicrobials`."
       )
     }
 
@@ -219,11 +219,11 @@ key_antimicrobials <- function(x = NULL,
     cols = cols
   )
 
-  key_ab[which(domain == "Fungi")] <- AMR_string(
+  key_ab[which(kingdom == "Fungi")] <- AMR_string(
     x = x,
     values = antifungal,
     name = "antifungal",
-    filter = domain == "Fungi",
+    filter = kingdom == "Fungi",
     cols = cols
   )
 
@@ -237,7 +237,7 @@ key_antimicrobials <- function(x = NULL,
   )
 
   if (length(unique(key_ab)) == 1) {
-    warning_("in {.fun key_antimicrobials}: no distinct key antibiotics determined.")
+    warning_("in `key_antimicrobials()`: no distinct key antibiotics determined.")
   }
 
   key_ab
@@ -282,9 +282,6 @@ generate_antimicrobials_string <- function(df) {
           function(x) {
             x <- toupper(as.character(x))
             x[x == "SDD"] <- "I"
-            x[x == "WT"] <- "S"
-            x[x == "NWT"] <- "R"
-            x[x == "NS"] <- "R"
             # ignore "NI" here, no use for determining first isolates
             x[!x %in% c("S", "I", "R")] <- "."
             paste(x)
@@ -310,12 +307,14 @@ antimicrobials_equal <- function(y,
   meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
   meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
   meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
-  stop_ifnot(length(y) == length(z), "length of {.arg y} and {.arg z} must be equal")
+  stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
 
   key2sir <- function(val) {
     val <- strsplit(val, "", fixed = TRUE)[[1L]]
     val.int <- rep(NA_real_, length(val))
-    val.int[val %in% VALID_SIR_LEVELS] <- as.double(as.sir(val[val %in% VALID_SIR_LEVELS]))
+    val.int[val == "S"] <- 1
+    val.int[val %in% c("I", "SDD")] <- 2
+    val.int[val == "R"] <- 3
     val.int
   }
   # only run on uniques

R/kurtosis.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

R/like.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -49,9 +49,8 @@
 #' @seealso [grepl()]
 
 #' @examples
-#' # data.table has a more limited version of %like%, so detach it
-#' # (without unloading it, as data.table does not support being unloaded):
-#' try(detach("package:data.table"), silent = TRUE)
+#' # data.table has a more limited version of %like%, so unload it:
+#' try(detach("package:data.table", unload = TRUE), silent = TRUE)
 #'
 #' a <- "This is a test"
 #' b <- "TEST"

R/mdro.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -31,7 +31,7 @@
 #'
 #' Determine which isolates are multidrug-resistant organisms (MDRO) according to international, national, or custom guidelines.
 #' @param x A [data.frame] with antimicrobials columns, like `AMX` or `amox`. Can be left blank for automatic determination.
-#' @param guideline A specific guideline to follow, see sections *Supported International / National Guidelines* and *Using Custom Guidelines* below. When left empty, the publication by Magiorakos *et al.* (see below) will be followed.
+#' @param guideline A specific guideline to follow, see sections *Supported international / national guidelines* and *Using Custom Guidelines* below. When left empty, the publication by Magiorakos *et al.* (see below) will be followed.
 #' @param esbl [logical] values, or a column name containing logical values, indicating the presence of an ESBL gene (or production of its proteins).
 #' @param carbapenemase [logical] values, or a column name containing logical values, indicating the presence of a carbapenemase gene (or production of its proteins).
 #' @param mecA [logical] values, or a column name containing logical values, indicating the presence of a *mecA* gene (or production of its proteins).
@@ -40,9 +40,8 @@
 #' @param vanB [logical] values, or a column name containing logical values, indicating the presence of a *vanB* gene (or production of its proteins).
 #' @inheritParams eucast_rules
 #' @param pct_required_classes Minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
-#' @param combine_SI A [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I. In a future version, the handling of 'I' will follow the selected MDRO guideline ([#323](https://github.com/msberends/AMR/issues/323)).
-#' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function returns a data set with the MDRO results in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
-#' @param infer_from_combinations A [logical] to indicate whether resistance for a missing base beta-lactam drug should be inferred from an available drug+inhibitor combination (e.g., piperacillin from piperacillin/tazobactam). The clinical basis is that resistance in a combination always implies resistance in the base drug, since the enzyme inhibitor provides no benefit when the organism is truly resistant. Only resistance is inferred; susceptibility in a combination does **not** imply susceptibility in the base drug (the inhibitor may be responsible). Defaults to `TRUE`.
+#' @param combine_SI A [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
+#' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
 #' @details
 #' These functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
 #'
@@ -84,7 +83,7 @@
 #'
 #' * `guideline = "BRMO 2024"` (or simply `guideline = "BRMO"`)
 #'
-#'   The Dutch national guideline - Samenwerkingverband Richtlijnen Infectiepreventie (SRI) (2024) "Bijzonder Resistente Micro-Organismen (BRMO)" ([link](https://richtlijnendatabase.nl/richtlijn/bijzonder_resistente_micro-organismen_brmo))
+#'   The Dutch national guideline - Samenwerkingverband Richtlijnen Infectiepreventie (SRI) (2024) "Bijzonder Resistente Micro-Organismen (BRMO)" ([link](https://www.sri-richtlijnen.nl/brmo))
 #'
 #'   Also:
 #'
@@ -144,7 +143,6 @@ mdro <- function(x = NULL,
                  combine_SI = TRUE,
                  verbose = FALSE,
                  only_sir_columns = any(is.sir(x)),
-                 infer_from_combinations = TRUE,
                  ...) {
   if (is_null_or_grouped_tbl(x)) {
     # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
@@ -167,32 +165,57 @@ mdro <- function(x = NULL,
   meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(verbose, allow_class = "logical", has_length = 1)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  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 [{.fun as.sir}](AMR::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 [{.fun as.sir}](AMR::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
-  resolve_gene_var <- function(x, gene, varname) {
-    if (is.character(gene)) {
-      meet_criteria(gene, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
-      gene <- x[[gene]]
-      meet_criteria(gene, allow_class = "logical", allow_NA = TRUE)
-    } else if (length(gene) == 1) {
-      gene <- rep(gene, NROW(x))
-    }
-    x[[varname]] <- gene
-    x
+  if (is.character(esbl)) {
+    meet_criteria(esbl, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    esbl <- x[[esbl]]
+    meet_criteria(esbl, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(esbl) == 1) {
+    esbl <- rep(esbl, NROW(x))
+  }
+  if (is.character(carbapenemase)) {
+    meet_criteria(carbapenemase, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    carbapenemase <- x[[carbapenemase]]
+    meet_criteria(carbapenemase, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(carbapenemase) == 1) {
+    carbapenemase <- rep(carbapenemase, NROW(x))
+  }
+  if (is.character(mecA)) {
+    meet_criteria(mecA, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    mecA <- x[[mecA]]
+    meet_criteria(mecA, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(mecA) == 1) {
+    mecA <- rep(mecA, NROW(x))
+  }
+  if (is.character(mecC)) {
+    meet_criteria(mecC, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    mecC <- x[[mecC]]
+    meet_criteria(mecC, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(mecC) == 1) {
+    mecC <- rep(mecC, NROW(x))
+  }
+  if (is.character(vanA)) {
+    meet_criteria(vanA, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    vanA <- x[[vanA]]
+    meet_criteria(vanA, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(vanA) == 1) {
+    vanA <- rep(vanA, NROW(x))
+  }
+  if (is.character(vanB)) {
+    meet_criteria(vanB, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
+    vanB <- x[[vanB]]
+    meet_criteria(vanB, allow_class = "logical", allow_NA = TRUE)
+  } else if (length(vanB) == 1) {
+    vanB <- rep(vanB, NROW(x))
   }
-  x <- resolve_gene_var(x, esbl, "esbl")
-  x <- resolve_gene_var(x, carbapenemase, "carbapenemase")
-  x <- resolve_gene_var(x, mecA, "mecA")
-  x <- resolve_gene_var(x, mecC, "mecC")
-  x <- resolve_gene_var(x, vanA, "vanA")
-  x <- resolve_gene_var(x, vanB, "vanB")
 
   info.bak <- info
   # don't throw info's more than once per call
@@ -213,7 +236,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 +274,7 @@ mdro <- function(x = NULL,
   guideline.bak <- guideline
   if (is.list(guideline)) {
     # Custom MDRO guideline ---------------------------------------------------
-    stop_ifnot(inherits(guideline, "custom_mdro_guideline"), "use {.help [{.fun custom_mdro_guideline}](AMR::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 +351,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."
@@ -364,7 +387,7 @@ mdro <- function(x = NULL,
     guideline$name <- "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis"
     guideline$author <- "WHO (World Health Organization)"
     guideline$version <- "WHO/HTM/TB/2014.11, 2014"
-    guideline$source_url <- NA_character_
+    guideline$source_url <- font_url("https://www.who.int/publications/i/item/9789241548809", "Direct download")
     guideline$type <- "MDR-TB's"
 
     # support per country:
@@ -379,7 +402,7 @@ mdro <- function(x = NULL,
     guideline$name <- "Bijzonder Resistente Micro-organismen (BRMO)"
     guideline$author <- "Samenwerkingsverband Richtlijnen Infectiepreventie (SRI)"
     guideline$version <- "November 2024"
-    guideline$source_url <- font_url("https://richtlijnendatabase.nl/richtlijn/bijzonder_resistente_micro-organismen_brmo", "Direct link")
+    guideline$source_url <- font_url("https://www.sri-richtlijnen.nl/brmo", "Direct link")
     guideline$type <- "BRMOs"
   } else if (guideline$code == "brmo2017") {
     guideline$name <- "WIP-Richtlijn Bijzonder Resistente Micro-organismen (BRMO)"
@@ -476,58 +499,12 @@ 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 {.field ", font_bold(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"])))
   }
   cols_ab <- cols_ab[!duplicated(cols_ab)]
 
-  # Infer resistance for missing base drugs ----
-  if (isTRUE(infer_from_combinations)) {
-    .combos_in_data <- AB_BETALACTAMS_WITH_INHIBITOR[AB_BETALACTAMS_WITH_INHIBITOR %in% names(cols_ab)]
-    if (length(.combos_in_data) > 0) {
-      .base_drugs <- suppressMessages(
-        as.ab(gsub("/.*", "", ab_name(as.character(.combos_in_data), language = NULL)))
-      )
-      .unique_bases <- unique(.base_drugs[!is.na(.base_drugs)])
-      for (.base in .unique_bases) {
-        .base_code <- as.character(.base)
-        if (!.base_code %in% names(cols_ab)) {
-          # Base drug column absent; find all available combo columns for this base drug
-          .combos <- .combos_in_data[!is.na(.base_drugs) & as.character(.base_drugs) == .base_code]
-          .combo_cols <- unname(cols_ab[as.character(.combos)])
-          .combo_cols <- .combo_cols[!is.na(.combo_cols)]
-          if (length(.combo_cols) > 0) {
-            # Vectorised: if ANY combination is R, infer base drug as R; otherwise NA
-            .sir_chars <- as.data.frame(
-              lapply(x[, .combo_cols, drop = FALSE], function(col) as.character(as.sir(col))),
-              stringsAsFactors = FALSE
-            )
-            .new_col <- paste0(.base_code, ".inferred_sir_proxy_from#", paste0(.combos, collapse = "/"), "#")
-            x[[.new_col]] <- ifelse(rowSums(.sir_chars == "R", na.rm = TRUE) > 0L, "R", NA_character_)
-            cols_ab <- c(cols_ab, stats::setNames(.new_col, .base_code))
-            if (isTRUE(info.bak)) {
-              message_(
-                "Inferring resistance for ",
-                ab_name(.base_code, language = NULL, tolower = TRUE),
-                " (", font_italic("missing"), ") from ",
-                vector_or(
-                  quotes = FALSE,
-                  last_sep = " and/or ",
-                  paste0(
-                    ab_name(.combos, language = NULL, tolower = TRUE),
-                    " ({.field ", font_bold(.combo_cols, collapse = NULL), "}, ", font_italic("available"), ")"
-                  )
-                )
-              )
-            }
-          }
-        }
-      }
-      cols_ab <- cols_ab[!duplicated(names(cols_ab))]
-    }
-  }
-
   # nolint start
   AMC <- cols_ab["AMC"]
   AMK <- cols_ab["AMK"]
@@ -722,16 +699,6 @@ mdro <- function(x = NULL,
     x
   }
 
-  ab_without_inhibitor <- function(ab_codes) {
-    # Get the base drug AB code from a drug+inhibitor combination.
-    # e.g., AMC (amoxicillin/clavulanic acid)  -> AMX (amoxicillin)
-    #        TZP (piperacillin/tazobactam)      -> PIP (piperacillin)
-    #        SAM (ampicillin/sulbactam)          -> AMP (ampicillin)
-    combo_names <- ab_name(ab_codes, language = NULL)
-    base_names <- gsub("/.*", "", combo_names)
-    suppressMessages(as.ab(base_names))
-  }
-
   # antimicrobial classes
   # nolint start
   aminoglycosides <- c(TOB, GEN)
@@ -743,19 +710,6 @@ mdro <- function(x = NULL,
   fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
   # nolint end
 
-  # helper function returning a logical matrix (rows x cols) of which cells contain any of `values`
-  column_matches <- function(df, rows, cols, values) {
-    matrix(
-      vapply(
-        FUN.VALUE = logical(length(rows)),
-        cols,
-        function(col) as.character(df[rows, col, drop = TRUE]) %in% values
-      ),
-      nrow = length(rows),
-      dimnames = list(NULL, cols)
-    )
-  }
-
   # helper function for editing the table
   trans_tbl <- function(to, rows, cols, any_all, reason = NULL) {
     cols.bak <- cols
@@ -772,18 +726,19 @@ mdro <- function(x = NULL,
         ),
         stringsAsFactors = FALSE
       )
-      # determine the non-susceptible columns per column instead of per cell, which is much faster
-      group_vct <- unique(unname(cols_ab))
-      nonsus <- column_matches(x, rows, group_vct, search_result)
-      current <- x[rows, "all_nonsusceptible_columns", drop = TRUE]
       x[rows, "all_nonsusceptible_columns"] <<- vapply(
         FUN.VALUE = character(1),
-        seq_along(rows),
-        function(i) {
+        rows,
+        function(row, group_vct = cols_ab) {
+          cols_nonsus <- vapply(
+            FUN.VALUE = logical(1),
+            x[row, group_vct, drop = FALSE],
+            function(y) y %in% search_result
+          )
           paste(
             unique(sort(c(
-              unlist(strsplit(current[i], ", ", fixed = TRUE)),
-              group_vct[nonsus[i, ]]
+              unlist(strsplit(x[row, "all_nonsusceptible_columns", drop = TRUE], ", ", fixed = TRUE)),
+              names(cols_nonsus)[cols_nonsus]
             ))),
             collapse = ", "
           )
@@ -817,7 +772,7 @@ mdro <- function(x = NULL,
         )
       }
       x[rows_to_change, "MDRO"] <<- to
-      x[rows_to_change, "reason"] <<- paste0(x[rows_to_change, "reason", drop = TRUE], "; ", reason)
+      x[rows_to_change, "reason"] <<- reason
       x[rows_not_to_change, "reason"] <<- "guideline criteria not met"
     }
   }
@@ -839,43 +794,55 @@ mdro <- function(x = NULL,
         ),
         stringsAsFactors = FALSE
       )
-      # determine the matches per column instead of per cell, which is much faster
-      lst_cols <- unique(unname(lst_vector))
-      available <- column_matches(x, rows, lst_cols, VALID_SIR_LEVELS[VALID_SIR_LEVELS != "NI"])
-      nonsus <- column_matches(x, rows, lst_cols, search_result)
-      count_groups <- function(matches) {
-        rowSums(matrix(
-          vapply(
-            FUN.VALUE = logical(length(rows)),
-            lst,
-            function(group) {
-              group <- group[!is.na(group)]
-              rowSums(matches[, lst_cols %in% group, drop = FALSE]) > 0
-            }
-          ),
-          nrow = length(rows)
-        ))
-      }
-
       x[rows, "classes_in_guideline"] <<- length(lst)
-      x[rows, "classes_available"] <<- count_groups(available)
+      x[rows, "classes_available"] <<- vapply(
+        FUN.VALUE = double(1),
+        rows,
+        function(row, group_tbl = lst) {
+          sum(vapply(
+            FUN.VALUE = logical(1),
+            group_tbl,
+            function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "SDD", "I", "R"))
+          ))
+        }
+      )
 
       if (isTRUE(verbose)) {
         x[rows, "all_nonsusceptible_columns"] <<- vapply(
           FUN.VALUE = character(1),
-          seq_along(rows),
-          function(i) paste(sort(lst_cols[nonsus[i, ]]), collapse = ", ")
+          rows,
+          function(row, group_vct = lst_vector) {
+            cols_nonsus <- vapply(FUN.VALUE = logical(1), x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
+            paste(unique(sort(names(cols_nonsus)[cols_nonsus])), collapse = ", ")
+          }
         )
       }
-      x[rows, "classes_affected"] <<- count_groups(nonsus)
+      x[rows, "classes_affected"] <<- vapply(
+        FUN.VALUE = double(1),
+        rows,
+        function(row, group_tbl = lst) {
+          sum(
+            vapply(
+              FUN.VALUE = logical(1),
+              group_tbl,
+              function(group) {
+                any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
+              }
+            ),
+            na.rm = TRUE
+          )
+        }
+      )
       # for PDR; all drugs are R (or I if combine_SI = FALSE)
-      row_filter <- rowSums(!nonsus) == 0
-      # `row_filter` is relative to `rows`, so it must be mapped back to the rows of `x`
-      x[rows[row_filter], "classes_affected"] <<- 999
+      x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE]),
+        stringsAsFactors = FALSE
+      ))
+      row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) all(y %in% search_result, na.rm = TRUE))
+      x[which(row_filter), "classes_affected"] <<- 999
     }
 
     if (isTRUE(info)) {
-      message_(" OK.", as_note = FALSE)
+      message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
     }
   }
 
@@ -887,7 +854,7 @@ mdro <- function(x = NULL,
   x <- left_join_microorganisms(x, by = col_mo)
   x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_)
   x$row_number <- seq_len(nrow(x))
-  x$reason <- ""
+  x$reason <- NA_character_
   x$all_nonsusceptible_columns <- ""
 
   if (guideline$code == "cmi2012") {
@@ -1156,7 +1123,7 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      which(x$genus == "Salmonella" & x$subspecies == "Typhi"),
+      which(x$genus == "Salmonella" & x$species == "Typhi"),
       c(carbapenems, fluoroquinolones),
       "any"
     )
@@ -1251,7 +1218,7 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      which(x$genus == "Salmonella" & x$subspecies == "Typhi"),
+      which(x$genus == "Salmonella" & x$species == "Typhi"),
       c(carbapenems),
       "any"
     )
@@ -1353,7 +1320,7 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      which(x$genus == "Salmonella" & x$subspecies == "Typhi"),
+      which(x$genus == "Salmonella" & x$species == "Typhi"),
       c(carbapenems),
       "any"
     )
@@ -1511,8 +1478,8 @@ mdro <- function(x = NULL,
     fluoroquinolones <- c(CIP, NOR, LVX) # note 5:  ciprofloxacin or norfloxacin or levofloxacin
     carbapenems <- carbapenems[!is.na(carbapenems)]
     carbapenems_without_imipenem <- carbapenems[carbapenems != IPM]
-    amino <- AMX %or_if_na% AMP
-    third <- CAZ %or_if_na% CTX
+    amino <- AMX %or% AMP
+    third <- CAZ %or% CTX
     ESBLs <- c(amino, third)
     ESBLs <- ESBLs[!is.na(ESBLs)]
     if (length(ESBLs) != 2) {
@@ -1524,14 +1491,14 @@ mdro <- function(x = NULL,
       trans_tbl(
         2, # positive, unconfirmed
         rows = which(x$order == "Enterobacterales" & col_values(x, ESBLs[1]) == "R" & col_values(x, ESBLs[2]) == "R" & is.na(esbl)),
-        cols = c(AMX %or_if_na% AMP, cephalosporins_3rd),
+        cols = c(AMX %or% AMP, cephalosporins_3rd),
         any_all = "all",
         reason = "Enterobacterales: potential ESBL"
       )
     }
     trans_tbl(
       3, # positive
-      rows = which(x$order == "Enterobacterales" & x$esbl == TRUE),
+      rows = which(x$order == "Enterobacterales" & esbl == TRUE),
       cols = "any",
       any_all = "any",
       reason = "Enterobacterales: ESBL"
@@ -1552,19 +1519,17 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      rows = which(x$order == "Enterobacterales" & x$carbapenemase == TRUE),
+      rows = which(x$order == "Enterobacterales" & carbapenemase == TRUE),
       cols = "any",
       any_all = "any",
       reason = "Enterobacterales: carbapenemase"
     )
-    c.freundii_complex <- AMR::microorganisms.groups$mo_name[AMR::microorganisms.groups$mo_group_name == "Citrobacter freundii complex"]
-    c.freundii_complex <- paste(c.freundii_complex, collapse = "|")
     trans_tbl(
       3,
       rows = which(col_values(x, SXT) == "R" &
         (col_values(x, GEN) == "R" | col_values(x, TOB) == "R" | col_values(x, AMK) == "R") &
         (col_values(x, CIP) == "R" | col_values(x, NOR) == "R" | col_values(x, LVX) == "R") &
-        (x$fullname %like_case% c.freundii_complex | x$genus %in% c("Enterobacter", "Providencia") | paste(x$genus, x$species) %in% c("Klebsiella aerogenes", "Hafnia alvei", "Morganella morganii"))),
+        (x$genus %in% c("Enterobacter", "Providencia") | paste(x$genus, x$species) %in% c("Citrobacter freundii", "Klebsiella aerogenes", "Hafnia alvei", "Morganella morganii"))),
       cols = c(SXT, aminoglycosides, fluoroquinolones),
       any_all = "any",
       reason = "Enterobacterales group II: aminoglycoside + fluoroquinolone + cotrimoxazol"
@@ -1581,27 +1546,25 @@ mdro <- function(x = NULL,
     )
 
     # Acinetobacter baumannii-calcoaceticus complex
-    a.baumannii_complex <- AMR::microorganisms.groups$mo_name[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"]
-    a.baumannii_complex <- paste(a.baumannii_complex, collapse = "|")
     trans_tbl(
       3,
       rows = which((col_values(x, GEN) == "R" | col_values(x, TOB) == "R" | col_values(x, AMK) == "R") &
         (col_values(x, CIP) == "R" | col_values(x, LVX) == "R") &
-        x$fullname %like_case% a.baumannii_complex),
+        x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"]),
       cols = c(aminoglycosides, CIP, LVX),
       any_all = "any",
       reason = "A. baumannii-calcoaceticus complex: aminoglycoside + ciprofloxacin or levofloxacin"
     )
     trans_tbl(
       2, # unconfirmed
-      rows = which(x$fullname %like_case% a.baumannii_complex & is.na(x$carbapenemase)),
+      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & is.na(carbapenemase)),
       cols = carbapenems,
       any_all = "any",
       reason = "A. baumannii-calcoaceticus complex: potential carbapenemase"
     )
     trans_tbl(
       3,
-      rows = which(x$fullname %like_case% a.baumannii_complex & x$carbapenemase == TRUE),
+      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & carbapenemase == TRUE),
       cols = carbapenems,
       any_all = "any",
       reason = "A. baumannii-calcoaceticus complex: carbapenemase"
@@ -1611,7 +1574,6 @@ mdro <- function(x = NULL,
     x$psae <- 0
     x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, TOB) == "R") | NA_as_FALSE(col_values(x, AMK) == "R"), 1, 0)
     x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, IPM) == "R") | NA_as_FALSE(col_values(x, MEM) == "R"), 1, 0)
-    x$psae <- x$psae + ifelse(NA_as_FALSE(x$carbapenemase), 1, 0)
     x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, PIP) == "R") | NA_as_FALSE(col_values(x, TZP) == "R"), 1, 0)
     x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, CAZ) == "R") | NA_as_FALSE(col_values(x, CZA) == "R"), 1, 0)
     x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, CIP) == "R") | NA_as_FALSE(col_values(x, NOR) == "R") | NA_as_FALSE(col_values(x, LVX) == "R"), 1, 0)
@@ -1634,13 +1596,13 @@ mdro <- function(x = NULL,
     trans_tbl(
       3,
       rows = which(x$genus == "Enterococcus" & x$species == "faecium"),
-      cols = c(PEN %or_if_na% AMX %or_if_na% AMP, VAN),
+      cols = c(PEN %or% AMX %or% AMP, VAN),
       any_all = "all",
       reason = "E. faecium: vancomycin + penicillin group"
     )
     trans_tbl(
       3,
-      rows = which(x$genus == "Enterococcus" & x$species == "faecium" & (x$vanA == TRUE | x$vanB == TRUE)),
+      rows = which(x$genus == "Enterococcus" & x$species == "faecium" & (vanA == TRUE | vanB == TRUE)),
       cols = c(PEN, AMX, AMP, VAN),
       any_all = "any",
       reason = "E. faecium: vanA/vanB gene + penicillin group"
@@ -1649,14 +1611,14 @@ mdro <- function(x = NULL,
     # Staphylococcus aureus complex (= aureus, argenteus or schweitzeri)
     trans_tbl(
       2,
-      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (is.na(x$mecA) | is.na(x$mecC))),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (is.na(mecA) | is.na(mecC))),
       cols = c(AMC, TZP, FLC, OXA, FOX, FOX1),
       any_all = "any",
       reason = "S. aureus complex: potential MRSA"
     )
     trans_tbl(
       3,
-      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (x$mecA == TRUE | x$mecC == TRUE)),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (mecA == TRUE | mecC == TRUE)),
       cols = "any",
       any_all = "any",
       reason = "S. aureus complex: mecA/mecC gene"
@@ -1677,8 +1639,8 @@ mdro <- function(x = NULL,
     aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
     fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
     carbapenems <- carbapenems[!is.na(carbapenems)]
-    amino <- AMX %or_if_na% AMP
-    third <- CAZ %or_if_na% CTX
+    amino <- AMX %or% AMP
+    third <- CAZ %or% CTX
     ESBLs <- c(amino, third)
     ESBLs <- ESBLs[!is.na(ESBLs)]
     if (length(ESBLs) != 2) {
@@ -1854,7 +1816,6 @@ mdro <- function(x = NULL,
 
   if (isTRUE(info.bak)) {
     cat(group_msg)
-    cat("\n")
     if (sum(!is.na(x$MDRO)) == 0) {
       cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline")))
     } else {
@@ -1877,15 +1838,14 @@ mdro <- function(x = NULL,
   ))
   if (length(rows_empty) > 0) {
     if (isTRUE(info.bak)) {
-      cat(font_italic(paste0("\n   (another ", length(rows_empty), " isolates had no test results)\n")))
+      cat(font_italic(paste0(" (", length(rows_empty), " isolates had no test results)\n")))
     }
   } else if (isTRUE(info.bak)) {
     cat("\n")
   }
 
   if (isTRUE(info.bak) && !isTRUE(verbose)) {
-    cat("\n")
-    cat(format_inline_("Rerun with {.code verbose = TRUE} to retrieve detailed info and reasons for every MDRO classification.\n"))
+    cat("\nRerun with 'verbose = TRUE' to retrieve detailed info and reasons for every MDRO classification.\n")
   }
 
   # Results ----
@@ -1893,8 +1853,8 @@ mdro <- function(x = NULL,
     if (any(x$MDRO == -1, na.rm = TRUE)) {
       if (message_not_thrown_before("mdro", "availability")) {
         warning_(
-          "in {.help [{.fun mdro}](AMR::mdro)}: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
-          percentage(pct_required_classes), " (set with {.arg pct_required_classes})"
+          "in `mdro()`: NA introduced for isolates where the available percentage of antimicrobial classes was below ",
+          percentage(pct_required_classes), " (set with `pct_required_classes`)"
         )
       }
       # set these -1s to NA
@@ -1939,15 +1899,10 @@ mdro <- function(x = NULL,
     # fill in empty reasons
     x$reason[is.na(x$reason)] <- "not covered by guideline"
     x[rows_empty, "reason"] <- paste(x[rows_empty, "reason"], "(note: no available test results)")
-    # starting semicolons must be removed
-    x$reason <- trimws(gsub("^;", "", x$reason))
-    # if criteria were not met initially, but later they were, then they have a following semicolon; remove the initial lack of meeting criteria
-    x$reason <- trimws(gsub("guideline criteria not met;", "", x$reason, fixed = TRUE))
     # format data set
     colnames(x)[colnames(x) == col_mo] <- "microorganism"
     x$microorganism <- mo_name(x$microorganism, language = NULL)
-    x$guideline <- paste0(guideline$author, " - ", guideline$name, ifelse(is.na(guideline$version), "", paste0(" (", guideline$version, ")")))
-    x$all_nonsusceptible_columns <- gsub(".inferred_sir_proxy_from#(.*?)#", " (inferred from \\1)", x$all_nonsusceptible_columns, perl = TRUE)
+    x$guideline <- paste0(guideline$author, " - ", guideline$name, ", ", guideline$version, ")")
     x[, c(
       "row_number",
       "microorganism",
@@ -1970,7 +1925,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", ...)
 }
@@ -1983,7 +1938,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", ...)
 }
@@ -1995,7 +1950,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", ...)
 }
@@ -2007,7 +1962,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", ...)
 }
@@ -2019,7 +1974,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/mean_amr_distance.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -118,7 +118,7 @@ mean_amr_distance.disk <- function(x, ...) {
 mean_amr_distance.sir <- function(x, ..., combine_SI = TRUE) {
   meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = -1)
   if (isTRUE(combine_SI)) {
-    x[x %in% c("I", "SDD")] <- "S" # do not acknowledge CLSI/EUCAST guideline here to keep the numeric mean_amr_distance consistent between systems
+    x[x %in% c("I", "SDD")] <- "S"
   }
   mean_amr_distance(as.double(x))
 }

R/mic.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -56,20 +56,6 @@ COMMON_MIC_VALUES <- c(
   1024, 2048, 4096
 )
 
-# Guidelines publish the twofold dilutions below 0.125 mg/L in rounded notations, e.g., EUCAST prints 0.03 for the dilution that this package holds as 0.032, while laboratories may report 0.03, 0.031, 0.03125 or 0.032. These all denote one dilution. This returns the value of that dilution in COMMON_MIC_VALUES, and leaves all other values as they are.
-mic_dilution_level <- function(x) {
-  notation <- c(
-    0.0039, 0.0078, 0.015, 0.0156, 0.03, 0.031, 0.0313, 0.03125, 0.06, 0.063, 0.0625, 0.12
-  )
-  level <- c(
-    0.004, 0.008, 0.016, 0.016, 0.032, 0.032, 0.032, 0.032, 0.064, 0.064, 0.064, 0.125
-  )
-  x <- as.double(x)
-  hit <- match(x, notation)
-  x[!is.na(hit)] <- level[hit[!is.na(hit)]]
-  x
-}
-
 #' Transform Input to Minimum Inhibitory Concentrations (MIC)
 #'
 #' This transforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
@@ -77,7 +63,6 @@ mic_dilution_level <- function(x) {
 #' @param x A [character] or [numeric] vector.
 #' @param na.rm A [logical] indicating whether missing values should be removed.
 #' @param keep_operators A [character] specifying how to handle operators (such as `>` and `<=`) in the input. Accepts one of three values: `"all"` (or `TRUE`) to keep all operators, `"none"` (or `FALSE`) to remove all operators, or `"edges"` to keep operators only at both ends of the range.
-#' @param round_to_next_log2 A [logical] to round up all values to the next log2 level, that are not either `r vector_or(COMMON_MIC_VALUES, quotes = F)`. Values that are already in this list (with or without operators), are left unchanged (including any operators).
 #' @param ... Arguments passed on to methods.
 #' @details To interpret MIC values as SIR values, use [as.sir()] on MIC values. It supports guidelines from EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
 #'
@@ -86,7 +71,7 @@ mic_dilution_level <- function(x) {
 #' ```
 #' x <- random_mic(10)
 #' x
-#' #> Class <mic>
+#' #> Class 'mic'
 #' #>  [1] 16     1      8      8      64     >=128  0.0625 32     32     16
 #'
 #' is.factor(x)
@@ -103,7 +88,7 @@ mic_dilution_level <- function(x) {
 #'
 #' ```
 #' x[x > 4]
-#' #> Class <mic>
+#' #> Class 'mic'
 #' #> [1] 16    8     8     64    >=128 32    32    16
 #'
 #' df <- data.frame(x, hospital = "A")
@@ -140,7 +125,7 @@ mic_dilution_level <- function(x) {
 #' # this can also coerce combined MIC/SIR values:
 #' as.mic("<=0.002; S")
 #'
-#' # mathematical processing treats MICs as, and returns, numeric values
+#' # mathematical processing treats MICs as numeric values
 #' fivenum(mic_data)
 #' quantile(mic_data)
 #' all(mic_data < 512)
@@ -148,10 +133,6 @@ mic_dilution_level <- function(x) {
 #' # rescale MICs using rescale_mic()
 #' rescale_mic(mic_data, mic_range = c(4, 16))
 #'
-#' # round up to nearest log2 level, e.g. for CLSI breakpoint interpretation:
-#' c(1:8)
-#' as.mic(c(1:8), round_to_next_log2 = TRUE)
-#'
 #' # interpret MIC values
 #' as.sir(
 #'   x = as.mic(2),
@@ -176,22 +157,17 @@ mic_dilution_level <- function(x) {
 #' if (require("ggplot2")) {
 #'   autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
 #' }
-as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2 = FALSE) {
+as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
   meet_criteria(x, allow_NA = TRUE)
   meet_criteria(na.rm, allow_class = "logical", has_length = 1)
   meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1)
-  meet_criteria(round_to_next_log2, allow_class = "logical", has_length = 1)
-
   if (isTRUE(keep_operators)) {
     keep_operators <- "all"
   } else if (isFALSE(keep_operators)) {
     keep_operators <- "none"
   }
 
-  if (any(is.mic(x)) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
-    if (isTRUE(round_to_next_log2)) {
-      x <- roundup_to_nearest_log2(x)
-    }
+  if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
     if (!identical(levels(x), VALID_MIC_LEVELS)) {
       # might be from an older AMR version - just update MIC factor levels
       x <- set_clean_class(factor(as.character(x), levels = VALID_MIC_LEVELS, ordered = TRUE),
@@ -231,9 +207,8 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2
     warning_("Some MICs were combined values, only the first values are kept")
     x[x %like% "[0-9]/.*[0-9]"] <- gsub("/.*", "", x[x %like% "[0-9]/.*[0-9]"])
   }
-  x <- trimws2(gsub("[^e\\P{L}]", "", x, perl = TRUE)) # \p{L} is the Unicode category for all letters, including those with diacritics
   # remove other invalid characters
-  x <- gsub("[^0-9e.><= -]+", "", x, perl = TRUE)
+  x <- gsub("[^a-zA-Z0-9.><= -]+", "", x, perl = TRUE)
   # transform => to >= and =< to <=
   x <- gsub("=<", "<=", x, fixed = TRUE)
   x <- gsub("=>", ">=", x, fixed = TRUE)
@@ -283,9 +258,9 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2
       sort() %pm>%
       vector_and(quotes = TRUE)
     cur_col <- get_current_column()
-    warning_("in {.help [{.fun as.mic}](AMR::as.mic)}: ", na_after - na_before, " result",
+    warning_("in `as.mic()`: ", na_after - na_before, " result",
       ifelse(na_after - na_before > 1, "s", ""),
-      ifelse(is.null(cur_col), "", paste0(" in column {.field ", font_bold(cur_col, collapse = NULL), "}")),
+      ifelse(is.null(cur_col), "", paste0(" in index '", cur_col, "'")),
       " truncated (",
       round(((na_after - na_before) / length(x)) * 100),
       "%) that were invalid MICs: ",
@@ -304,10 +279,6 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all", round_to_next_log2
     x[!x %in% keep] <- gsub("[>=<]", "", x[!x %in% keep])
   }
 
-  if (isTRUE(round_to_next_log2)) {
-    x <- roundup_to_nearest_log2(x)
-  }
-
   set_clean_class(factor(x, levels = VALID_MIC_LEVELS, ordered = TRUE),
     new_class = c("mic", "ordered", "factor")
   )
@@ -334,19 +305,18 @@ NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE)
 #' @rdname as.mic
 #' @param mic_range A manual range to rescale the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to prevent rescaling on one side, e.g., `mic_range = c(NA, 32)`.
 #' @export
-rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, round_to_next_log2 = FALSE) {
+rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
   meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical", "mic"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
-
   if (is.numeric(mic_range)) {
     mic_range <- trimws(format(mic_range, scientific = FALSE))
     mic_range <- gsub("[.]0+$", "", mic_range)
     mic_range[mic_range == "NA"] <- NA_character_
-  } else if (any(is.mic(mic_range))) {
+  } else if (is.mic(mic_range)) {
     mic_range <- as.character(mic_range)
   }
   stop_ifnot(
     all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
-    "Values in {.arg mic_range} must be valid MIC values. ",
+    "Values in `mic_range` must be valid MIC values. ",
     "The allowed range is ", format(as.double(as.mic(VALID_MIC_LEVELS)[1]), scientific = FALSE), " to ", format(as.double(as.mic(VALID_MIC_LEVELS)[length(VALID_MIC_LEVELS)]), scientific = FALSE), ". ",
     "Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), "."
   )
@@ -366,7 +336,7 @@ rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE, r
     x[x > max_mic] <- max_mic
   }
 
-  x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators), round_to_next_log2 = round_to_next_log2)
+  x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators))
 
   if (isTRUE(as.mic)) {
     if (keep_operators == "edges" && length(unique(x)) > 1) {
@@ -456,19 +426,23 @@ all_valid_mics <- function(x) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mic)
 pillar_shaft.mic <- function(x, ...) {
   if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
-    warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with {.fun as.mic} to update",
+    warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
       call = FALSE
     )
   }
   crude_numbers <- as.double(x)
   operators <- gsub("[^<=>]+", "", as.character(x))
   # colourise operators
-  operators[!is.na(operators) & operators != ""] <- pillar::style_subtle(operators[!is.na(operators) & operators != ""])
+  operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL)
   out <- trimws(paste0(operators, trimws(format(crude_numbers))))
-  out[is.na(x)] <- pillar::style_na(NA)
+  out[is.na(x)] <- font_na(NA)
   # make trailing zeroes less visible
-  out[out %like% "[.]"] <- gsub("([.]?0+)$", pillar::style_subtle("\\1"), out[out %like% "[.]"], perl = TRUE)
-
+  if (is_dark()) {
+    fn <- font_silver
+  } else {
+    fn <- font_white
+  }
+  out[out %like% "[.]"] <- gsub("([.]?0+)$", fn("\\1"), out[out %like% "[.]"], perl = TRUE)
   create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
 }
 
@@ -486,7 +460,7 @@ type_sum.mic <- function(x, ...) {
 #' @export
 #' @noRd
 print.mic <- function(x, ...) {
-  cat(format_inline_("Class {.cls mic}"))
+  cat("Class 'mic'")
   if (!identical(levels(x), VALID_MIC_LEVELS)) {
     cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
   }
@@ -519,7 +493,7 @@ as.vector.mic <- function(x, mode = "numneric", ...) {
   y <- as.mic(y)
   calls <- unlist(lapply(sys.calls(), as.character))
   if (any(calls %in% c("rbind", "cbind")) && message_not_thrown_before("as.vector.mic")) {
-    warning_("Functions {.fun rbind} and {.fun cbind} cannot preserve the structure of MIC values. Use {.pkg dplyr}'s {.fun bind_rows} or {.fun bind_cols} instead.", call = FALSE)
+    warning_("Functions `rbind()` and `cbind()` cannot preserve the structure of MIC values. Use dplyr's `bind_rows()` or `bind_cols()` instead.", call = FALSE)
   }
   y
 }
@@ -612,7 +586,7 @@ sort.mic <- function(x, decreasing = FALSE, ...) {
 #' @export
 #' @noRd
 hist.mic <- function(x, ...) {
-  warning_("in {.fun hist}: use {.fun plot} or {.pkg ggplot2}'s {.fun autoplot} for optimal plotting of MIC values")
+  warning_("in `hist()`: use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values")
   hist(log2(x))
 }
 
@@ -622,33 +596,15 @@ get_skimmers.mic <- function(column) {
   column <- as.mic(column) # make sure that currently implemented MIC levels are used
   skimr::sfl(
     skim_type = "mic",
-    p0 = ~ stats::quantile(column, probs = 0, na.rm = TRUE, names = FALSE),
-    p25 = ~ stats::quantile(column, probs = 0.25, na.rm = TRUE, names = FALSE),
-    p50 = ~ stats::quantile(column, probs = 0.5, na.rm = TRUE, names = FALSE),
-    p75 = ~ stats::quantile(column, probs = 0.75, na.rm = TRUE, names = FALSE),
-    p100 = ~ stats::quantile(column, probs = 1, na.rm = TRUE, names = FALSE),
-    hist = ~ skimr::inline_hist(log2(stats::na.omit(column)), 10)
+    p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
+    p25 = ~ stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE),
+    p50 = ~ stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE),
+    p75 = ~ stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE),
+    p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
+    hist = ~ skimr::inline_hist(log2(stats::na.omit(.)), 5)
   )
 }
 
-
-roundup_to_nearest_log2 <- function(x) {
-  x_dbl <- suppressWarnings(as.double(gsub("[>=<]", "", x)))
-  x_new <- vapply(
-    FUN.VALUE = double(1),
-    x_dbl,
-    function(val) {
-      if (is.na(val)) {
-        NA_real_
-      } else {
-        COMMON_MIC_VALUES[which(COMMON_MIC_VALUES >= val)][1]
-      }
-    }
-  )
-  x[!x_dbl %in% COMMON_MIC_VALUES] <- x_new[!x_dbl %in% COMMON_MIC_VALUES]
-  x
-}
-
 # Miscellaneous mathematical functions ------------------------------------
 
 #' @method mean mic

R/mo.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -29,7 +29,7 @@
 
 #' Transform Arbitrary Input to Valid Microbial Taxonomy
 #'
-#' Use this function to get a valid microorganism code ([`mo`]) based on arbitrary user input. Determination is done using intelligent rules and the complete taxonomic tree of the domains `r vector_and(unique(microorganisms$domain[which(!grepl("(unknown|Fungi)", microorganisms$domain))]), quotes = FALSE)`, and most microbial species from the domain Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
+#' Use this function to get a valid microorganism code ([`mo`]) based on arbitrary user input. Determination is done using intelligent rules and the complete taxonomic tree of the kingdoms `r vector_and(unique(microorganisms$kingdom[which(!grepl("(unknown|Fungi)", microorganisms$kingdom))]), quotes = FALSE)`, and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
 #' @param x A [character] vector or a [data.frame] with one or two columns.
 #' @param Becker A [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (see *Source*). Please see *Details* for a full list of staphylococcal species that will be converted.
 #'
@@ -37,16 +37,14 @@
 #' @param Lancefield A [logical] to indicate whether a beta-haemolytic *Streptococcus* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (see *Source*). These streptococci will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L. . Please see *Details* for a full list of streptococcal species that will be converted.
 #'
 #' This excludes enterococci at default (who are in group D), use `Lancefield = "all"` to also categorise all enterococci as group D.
-#' @param minimum_matching_score A numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic domain][microorganisms] and [human pathogenicity][mo_matching_score()].
-#' @param keep_synonyms A [logical] to indicate if outdated, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. Do note that the term "synonym" is in this case jargon from the field of microbial taxonomy - it is not in place to denote that e.g. "Streptococcus Group A" is a synonym of *S. pyogenes*. Though this is practically the case, taxonomically it is not as "Streptococcus Group A" is not even a valid taxonomic name.
-#'
-#' The default is `FALSE`, which will return a note if outdated taxonomic names were processed. The default can be set with the package option [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
+#' @param minimum_matching_score A numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic kingdom][microorganisms] and [human pathogenicity][mo_matching_score()].
+#' @param keep_synonyms A [logical] to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`, which will return a note if old taxonomic names were processed. The default can be set with the package option [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
 #' @param reference_df A [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
 #' @param ignore_pattern A Perl-compatible [regular expression][base::regex] (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the package option [`AMR_ignore_pattern`][AMR-options], e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
 #' @param cleaning_regex A Perl-compatible [regular expression][base::regex] (case-insensitive) to clean the input of `x`. Every matched part in `x` will be removed. At default, this is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar". The default can be set with the package option [`AMR_cleaning_regex`][AMR-options].
-#' @param only_fungi A [logical] to indicate if only fungi must be found, making sure that e.g. misspellings always return records from the domain of Fungi. This can be set globally for [all microorganism functions][mo_property()] with the package option [`AMR_only_fungi`][AMR-options], i.e. `options(AMR_only_fungi = TRUE)`.
+#' @param only_fungi A [logical] to indicate if only fungi must be found, making sure that e.g. misspellings always return records from the kingdom of Fungi. This can be set globally for [all microorganism functions][mo_property()] with the package option [`AMR_only_fungi`][AMR-options], i.e. `options(AMR_only_fungi = TRUE)`.
 #' @param language Language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()]).
-#' @param info A [logical] to indicate that info must be printed, e.g. a progress bar when more than 25 items are to be coerced, or a list with outdated taxonomic names. The default is `TRUE` only in interactive mode.
+#' @param info A [logical] to indicate that info must be printed, e.g. a progress bar when more than 25 items are to be coerced, or a list with old taxonomic names. The default is `TRUE` only in interactive mode.
 #' @param ... Other arguments passed on to functions.
 #' @rdname as.mo
 #' @aliases mo
@@ -64,7 +62,7 @@
 #'   |   |    |    \---> subspecies, a 3-5 letter acronym
 #'   |   |    \----> species, a 3-6 letter acronym
 #'   |   \----> genus, a 4-8 letter acronym
-#'   \----> domain: A (Archaea), AN (Animalia), B (Bacteria),
+#'   \----> kingdom: A (Archaea), AN (Animalia), B (Bacteria),
 #'                   C (Chromista), F (Fungi), PL (Plantae),
 #'                   P (Protozoa)
 #' ```
@@ -77,16 +75,14 @@
 #'
 #' ### Coping with Uncertain Results
 #'
-#' Results of non-exact taxonomic input are based on their [matching score][mo_matching_score()]. The lowest allowed score can be set with the `minimum_matching_score` argument. At default this will be determined based on the character length of the input, the [taxonomic domain][microorganisms], and the [human pathogenicity][mo_matching_score()] of the taxonomic outcome. If values are matched with uncertainty, a message will be shown to suggest the user to inspect the results with [mo_uncertainties()], which returns a [data.frame] with all specifications.
+#' Results of non-exact taxonomic input are based on their [matching score][mo_matching_score()]. The lowest allowed score can be set with the `minimum_matching_score` argument. At default this will be determined based on the character length of the input, the [taxonomic kingdom][microorganisms], and the [human pathogenicity][mo_matching_score()] of the taxonomic outcome. If values are matched with uncertainty, a message will be shown to suggest the user to inspect the results with [mo_uncertainties()], which returns a [data.frame] with all specifications.
 #'
 #' To increase the quality of matching, the `cleaning_regex` argument is used to clean the input. This must be a [regular expression][base::regex] that matches parts of the input that should be removed before the input is matched against the [available microbial taxonomy][microorganisms]. It will be matched Perl-compatible and case-insensitive. The default value of `cleaning_regex` is the outcome of the helper function [mo_cleaning_regex()].
 #'
 #' There are three helper functions that can be run after using the [as.mo()] function:
 #' - Use [mo_uncertainties()] to get a [data.frame] that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see *Matching Score for Microorganisms* below).
 #' - Use [mo_failures()] to get a [character] [vector] with all values that could not be coerced to a valid value.
-#' - Use [mo_renamed()] to get a [data.frame] with all values that could be coerced based on outdated, previously accepted taxonomic names.
-#'
-#' Results of non-exact input are remembered during the session, so that the same input is not matched again. This only applies to the same settings of `minimum_matching_score`, `only_fungi` and `cleaning_regex`. Use [mo_reset_session()] to forget these results. They are also forgotten when the taxonomy changes, e.g. after [add_custom_microorganisms()].
+#' - Use [mo_renamed()] to get a [data.frame] with all values that could be coerced based on old, previously accepted taxonomic names.
 #'
 #' ### For Mycologists
 #'
@@ -209,15 +205,13 @@ as.mo <- function(x,
 
   add_MO_lookup_to_AMR_env()
 
-  if (isFALSE(Becker) && isFALSE(Lancefield) && is.atomic(x) && is.null(dim(x))) {
-    # don't look into valid MO codes, just return them, unless synonyms must be replaced
+  if (tryCatch(all(x %in% c(AMR_env$MO_lookup$mo, NA)), error = function(e) FALSE) &&
+    isFALSE(Becker) &&
+    isFALSE(Lancefield) &&
+    isTRUE(keep_synonyms)) {
+    # don't look into valid MO codes, just return them
     # is.mo() won't work - MO codes might change between package versions
-    x_unique <- unique(as.character(x))
-    x_index <- match(x_unique, AMR_env$MO_lookup$mo)
-    if (all(!is.na(x_index) | is.na(x_unique)) &&
-      (isTRUE(keep_synonyms) || !any(AMR_env$MO_lookup$status[x_index] == "synonym", na.rm = TRUE))) {
-      return(set_clean_class(x, new_class = c("mo", "character")))
-    }
+    return(set_clean_class(x, new_class = c("mo", "character")))
   }
 
   # start off with replaced language-specific non-ASCII characters with ASCII characters
@@ -245,49 +239,38 @@ as.mo <- function(x,
   out[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo] <- toupper(x[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo])
   # From full name ----
   out[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower] <- AMR_env$MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower], AMR_env$MO_lookup$fullname_lower)]
-  # one exception: "Fungi" matches the domain, but instead it should return the 'unknown' code for fungi
+  # one exception: "Fungi" matches the kingdom, but instead it should return the 'unknown' code for fungi
   out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS"
-  # From translated names, such as the output of mo_name() in the set language ----
-  if (language != "en" && any(is.na(out) & !is.na(x))) {
-    mo_translated <- get_mo_translated_index(language)
-    ind <- is.na(out) & x_lower %in% mo_translated$name
-    out[ind] <- mo_translated$mo[match(x_lower[ind], mo_translated$name)]
-  }
   # From known codes ----
   ind <- is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code
   out[ind] <- AMR::microorganisms.codes$mo[match(toupper(x)[ind], AMR::microorganisms.codes$code)]
   if (length(which(ind)) > 0 && isTRUE(info) && message_not_thrown_before("as.mo_microorganisms.codes", is.na(out), toupper(x))) {
     message_(
       "Retrieved value", ifelse(sum(ind) > 1, "s", ""),
-      " from the {.help [microorganisms.codes](AMR::microorganisms.codes)} data set for ", vector_and(toupper(x)[ind]), "."
+      " from the `microorganisms.codes` data set for ", vector_and(toupper(x)[ind]), "."
     )
   }
   # From SNOMED ----
-  # SNOMED codes are looked up in a flat vector that is built once per session
-  mo_index <- get_mo_index()
-  ind <- is.na(out) & x %in% mo_index$snomed
-  out[ind] <- mo_index$snomed_mo[match(x[ind], mo_index$snomed)]
+  # based on this extremely fast gem: https://stackoverflow.com/a/11002456/4575331
+  snomeds <- unlist(AMR_env$MO_lookup$snomed)
+  snomeds <- snomeds[!is.na(snomeds)]
+  out[is.na(out) & x %in% snomeds] <- AMR_env$MO_lookup$mo[rep(seq_along(AMR_env$MO_lookup$snomed), vapply(FUN.VALUE = double(1), AMR_env$MO_lookup$snomed, length))[match(x[is.na(out) & x %in% snomeds], snomeds)]]
   # From other familiar output ----
   # such as Salmonella groups, colloquial names, etc.
   out[is.na(out)] <- convert_colloquial_input(x[is.na(out)])
   # From previous hits in this session ----
-  x_left <- unique(x[is.na(out) & !is.na(x)])
-  cache_keys_left <- coercion_cache_key(x_left, minimum_matching_score, only_fungi, cleaning_regex)
-  cache_hit <- coercion_cache_has("mo", cache_keys_left)
-  previously_coerced <- is.na(out) & x %in% x_left[cache_hit]
-  out[previously_coerced] <- coercion_cache_get("mo", cache_keys_left[cache_hit])[match(x[previously_coerced], x_left[cache_hit])]
-  previously_coerced_mention <- previously_coerced & out != "UNKNOWN"
-  if (isTRUE(info) && any(previously_coerced_mention) && message_not_thrown_before("as.mo", x[previously_coerced_mention], entire_session = TRUE)) {
+  old <- out
+  out[is.na(out) & paste(x, minimum_matching_score, only_fungi) %in% AMR_env$mo_previously_coerced$x] <- AMR_env$mo_previously_coerced$mo[match(paste(x, minimum_matching_score, only_fungi)[is.na(out) & paste(x, minimum_matching_score, only_fungi) %in% AMR_env$mo_previously_coerced$x], AMR_env$mo_previously_coerced$x)]
+  new <- out
+  if (isTRUE(info) && message_not_thrown_before("as.mo", old, new, entire_session = TRUE) && any(is.na(old) & !is.na(new), na.rm = TRUE)) {
     message_(
-      "Returning previously coerced value", ifelse(length(unique(x[previously_coerced_mention])) > 1, "s", ""),
-      " for ", vector_and(x[previously_coerced_mention]), ". Run {.help [{.fun mo_reset_session}](AMR::mo_reset_session)} to reset this. This note will be shown once per session for this input."
+      "Returning previously coerced value", ifelse(sum(is.na(old) & !is.na(new)) > 1, "s", ""),
+      " for ", vector_and(x[is.na(old) & !is.na(new)]), ". Run `mo_reset_session()` to reset this. This note will be shown once per session for this input."
     )
   }
 
   # For all other input ----
-  to_coerce <- is.na(out) & !is.na(x)
-  if (any(to_coerce)) {
-    x_before_cleaning <- x
+  if (any(is.na(out) & !is.na(x))) {
     # reset uncertainties
     AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, ]
     AMR_env$mo_failures <- NULL
@@ -315,7 +298,7 @@ as.mo <- function(x,
 
     MO_lookup_current <- AMR_env$MO_lookup
     if (isTRUE(only_fungi)) {
-      MO_lookup_current <- MO_lookup_current[MO_lookup_current$domain == "Fungi", , drop = FALSE]
+      MO_lookup_current <- MO_lookup_current[MO_lookup_current$kingdom == "Fungi", , drop = FALSE]
     }
 
     # run it
@@ -337,34 +320,6 @@ as.mo <- function(x,
         return(as.character(MO_lookup_current$mo[match(x_out, MO_lookup_current$fullname_lower)]))
       }
 
-      # Issue #287: "X complex" is not a distinct taxon - strip " complex" and try "X"
-      if (grepl(" complex$", x_out, ignore.case = FALSE)) {
-        x_out <- sub(" complex$", "", x_out)
-        x_search_cleaned <- sub(" [Cc]omplex$", "", x_search_cleaned)
-        if (x_out %in% MO_lookup_current$fullname_lower) {
-          return(as.character(MO_lookup_current$mo[match(x_out, MO_lookup_current$fullname_lower)]))
-        }
-        # a complex named after several of its species, such as 'Acinetobacter calcoaceticus-baumannii complex', must return the complex of one of these species (here 'Acinetobacter baumannii complex') instead of being matched as one of the species after the " complex" was stripped
-        x_words <- strsplit(x_out, " ", fixed = TRUE)[[1]]
-        if (length(x_words) >= 2) {
-          x_epithets <- strsplit(paste(x_words[-1], collapse = " "), "[-/ ]+", perl = TRUE)[[1]]
-          x_complexes <- paste(x_words[1], x_epithets[x_epithets != ""], "complex")
-          x_complexes <- x_complexes[x_complexes %in% MO_lookup_current$fullname_lower]
-          if (length(x_complexes) > 0) {
-            return(as.character(MO_lookup_current$mo[match(x_complexes[1], MO_lookup_current$fullname_lower)]))
-          }
-        }
-      }
-
-      # Salmonella serovars are stored without species (e.g. 'Salmonella Typhi'), but are often written with it, as in
-      # 'Salmonella enterica (subsp. enterica) serovar Typhi', which otherwise matched e.g. S. bongori
-      if (x_out %like_case% "^salmonella enterica ") {
-        x_serovar <- paste("salmonella", sub("^salmonella enterica (subsp[.]? )?(enterica )?", "", x_out, perl = TRUE))
-        if (x_serovar %in% MO_lookup_current$fullname_lower) {
-          return(as.character(MO_lookup_current$mo[match(x_serovar, MO_lookup_current$fullname_lower)]))
-        }
-      }
-
       # input must not be too short
       if (nchar(x_out) < 3) {
         return("UNKNOWN")
@@ -386,36 +341,6 @@ as.mo <- function(x,
             (MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
               MO_lookup_current$subspecies_first == substr(x_parts[2], 1, 1) |
               MO_lookup_current$subspecies_first == substr(x_parts[3], 1, 1)))
-          # Issue #288 (extended): if the species (and subspecies) word(s) in the input
-          # exactly match candidates that all belong to one and the same genus, bypass the
-          # 0.55 cutoff. A species together with its subspecies/autonyms (e.g. Plasmodium
-          # ovale + curtisi + wallikeri) is the same taxon, so for a genus+species input we
-          # collapse to the species-rank record (subspecies == ""). This prevents prevalent
-          # bacteria from outranking a rarer organism whose species epithet is an
-          # unambiguous exact match, e.g. "S. apiospermum" -> Scedosporium, "P. ovale" ->
-          # Plasmodium ovale. If two different genera share the epithet, the genus check
-          # stays FALSE and the normal matching score arbitrates.
-          sp_exact <- tolower(MO_lookup_current$species[filtr]) == x_parts[2]
-          if (length(x_parts) == 3) {
-            sp_exact <- sp_exact & tolower(MO_lookup_current$subspecies[filtr]) == x_parts[3]
-          }
-          exact_idx <- filtr[sp_exact]
-          if (length(exact_idx) >= 1 &&
-            length(unique(MO_lookup_current$genus_lower[exact_idx])) == 1) {
-            if (length(x_parts) == 2) {
-              # genus + species only: collapse to the species-rank record (subspecies == "")
-              is_species_rank <- MO_lookup_current$subspecies[exact_idx] == ""
-              if (any(is_species_rank)) {
-                filtr <- exact_idx[is_species_rank][1]
-              } else {
-                filtr <- exact_idx[1]
-              }
-            } else {
-              # explicit subspecies given, unambiguous within the genus
-              filtr <- exact_idx[1]
-            }
-            minimum_matching_score <- 0
-          }
         } else {
           filtr <- which(MO_lookup_current$full_first == substr(x_parts[1], 1, 1) |
             MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
@@ -458,8 +383,8 @@ as.mo <- function(x,
         minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08)
         # correct back for prevalence
         minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$prevalence[match(mo_to_search, MO_lookup_current$fullname)]
-        # correct back for domain
-        minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$domain_index[match(mo_to_search, MO_lookup_current$fullname)]
+        # correct back for kingdom
+        minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$kingdom_index[match(mo_to_search, MO_lookup_current$fullname)]
         minimum_matching_score_current <- pmax(minimum_matching_score_current, m)
         if (length(x_parts) > 1 && all(m <= 0.55, na.rm = TRUE)) {
           # if the highest score is 0.5, we have nothing serious - 0.5 is the lowest for pathogenic group 1
@@ -475,14 +400,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)]
@@ -499,6 +417,15 @@ as.mo <- function(x,
             stringsAsFactors = FALSE
           )
         )
+        # save to package env to save time for next time
+        AMR_env$mo_previously_coerced <- unique(rbind_AMR(
+          AMR_env$mo_previously_coerced,
+          data.frame(
+            x = paste(x_search, minimum_matching_score, only_fungi),
+            mo = result_mo,
+            stringsAsFactors = FALSE
+          )
+        ))
       }
       # the actual result:
       as.character(result_mo)
@@ -509,27 +436,6 @@ as.mo <- function(x,
     # expand from unique again
     out[is.na(out)] <- x_coerced[match(x[is.na(out)], x_unique)]
 
-    # save to package env to save time for next time, using the input from before the cleaning steps above
-    coerced_now <- which(to_coerce & !is.na(x))
-    coerced_now <- coerced_now[!duplicated(x_before_cleaning[coerced_now])]
-    cache_keys_now <- coercion_cache_key(x_before_cleaning[coerced_now], minimum_matching_score, only_fungi, cleaning_regex)
-    value_now <- out[coerced_now]
-    value_now[is.na(value_now)] <- "UNKNOWN"
-    coercion_cache_add("mo", keys = cache_keys_now, inputs = x_before_cleaning[coerced_now], values = value_now)
-    # also save the uncertainties, so that mo_uncertainties() remains complete for previously coerced input
-    uncertainty_row <- match(x[coerced_now], AMR_env$mo_uncertainties$original_input)
-    if (any(!is.na(uncertainty_row))) {
-      previously_uncertain <- AMR_env$mo_previously_uncertain
-      AMR_env$mo_previously_uncertain <- rbind_AMR(
-        previously_uncertain[which(!previously_uncertain$key %in% cache_keys_now), , drop = FALSE],
-        cbind(
-          key = cache_keys_now[!is.na(uncertainty_row)],
-          AMR_env$mo_uncertainties[uncertainty_row[!is.na(uncertainty_row)], , drop = FALSE],
-          stringsAsFactors = FALSE
-        )
-      )
-    }
-
     # Throw note about uncertainties ----
     if (isTRUE(info) && NROW(AMR_env$mo_uncertainties) > 0) {
       if (message_not_thrown_before("as.mo", "uncertainties", AMR_env$mo_uncertainties$original_input)) {
@@ -540,8 +446,8 @@ as.mo <- function(x,
         if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
           examples <- vector_and(
             paste0(
-              "{.val ", AMR_env$mo_uncertainties$original_input,
-              "} (assumed ", italicise(AMR_env$mo_uncertainties$fullname), ")"
+              '"', AMR_env$mo_uncertainties$original_input,
+              '" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
             ),
             quotes = FALSE
           )
@@ -550,7 +456,7 @@ as.mo <- function(x,
         }
         msg <- c(msg, paste0(
           "Microorganism translation was uncertain for ", examples,
-          ". Run {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to review ", plural[2], ", or use {.help [{.fun add_custom_microorganisms}](AMR::add_custom_microorganisms)} to add custom entries."
+          ". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add custom entries."
         ))
 
         for (m in msg) {
@@ -560,30 +466,17 @@ as.mo <- function(x,
     }
   } # end of loop over all yet unknowns
 
-  # Add uncertainties of previously coerced input ----
-  previously_uncertain <- AMR_env$mo_previously_uncertain
-  previously_uncertain <- previously_uncertain[which(previously_uncertain$key %in% cache_keys_left[cache_hit]), , drop = FALSE]
-  if (NROW(previously_uncertain) > 0) {
-    if (!any(to_coerce)) {
-      # uncertainties were not reset for new input, so do it here
-      AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
-    }
-    previously_uncertain$key <- NULL
-    previously_uncertain$keep_synonyms <- keep_synonyms
-    AMR_env$mo_uncertainties <- rbind_AMR(AMR_env$mo_uncertainties, previously_uncertain)
-  }
-
   # Keep or replace synonyms ----
   out_current <- synonym_mo_to_accepted_mo(out, fill_in_accepted = FALSE)
   AMR_env$mo_renamed <- list(old = out[!is.na(out_current)])
   if (isFALSE(keep_synonyms)) {
     out[!is.na(out_current)] <- out_current[!is.na(out_current)]
     if (isTRUE(info) && length(AMR_env$mo_renamed$old) > 0) {
-      print(mo_renamed(), extra_txt = " (use {.arg keep_synonyms = TRUE} to leave uncorrected)")
+      print(mo_renamed(), extra_txt = " (use `keep_synonyms = TRUE` to leave uncorrected)")
     }
   } else if (is.null(getOption("AMR_keep_synonyms")) && length(AMR_env$mo_renamed$old) > 0 && message_not_thrown_before("as.mo", "keep_synonyms_warning", entire_session = TRUE)) {
     # keep synonyms is TRUE, so check if any do have synonyms
-    warning_("{.help [{.fun as.mo}](AMR::as.mo)} returned ", nr2char(length(unique(AMR_env$mo_renamed$old))), " outdated taxonomic name", ifelse(length(unique(AMR_env$mo_renamed$old)) > 1, "s", ""), ". Use {.arg keep_synonyms = FALSE} to clean the input to currently accepted taxonomic names, or set the R option {.code AMR_keep_synonyms} to {.code FALSE}. This warning will be shown once per session.", call = FALSE)
+    warning_("Function `as.mo()` returned ", nr2char(length(unique(AMR_env$mo_renamed$old))), " old taxonomic name", ifelse(length(unique(AMR_env$mo_renamed$old)) > 1, "s", ""), ". Use `as.mo(..., keep_synonyms = FALSE)` to clean the input to currently accepted taxonomic names, or set the R option `AMR_keep_synonyms` to `FALSE`. This warning will be shown once per session.", call = FALSE)
   }
 
   # Apply Becker ----
@@ -600,7 +493,7 @@ as.mo <- function(x,
     )
     if (any(out %in% AMR_env$MO_lookup$mo[match(post_Becker, AMR_env$MO_lookup$fullname)])) {
       if (message_not_thrown_before("as.mo", "becker")) {
-        warning_("in {.help [{.fun as.mo}](AMR::as.mo)}: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
+        warning_("in `as.mo()`: Becker ", font_italic("et al."), " (2014, 2019, 2020) does not contain these species named after their publication: ",
           vector_and(font_italic(gsub("Staphylococcus", "S.", post_Becker, fixed = TRUE), collapse = NULL), quotes = FALSE),
           ". Categorisation to CoNS/CoPS was taken from the original scientific publication(s).",
           immediate = TRUE, call = FALSE
@@ -645,7 +538,7 @@ as.mo <- function(x,
   out[is.na(out) & !is.na(x)] <- "UNKNOWN"
   AMR_env$mo_failures <- unique(x[out == "UNKNOWN" & !toupper(x) %in% c("UNKNOWN", "CON", "UNK") & !x %like_case% "^[(]unknown [a-z]+[)]$" & !is.na(x)])
   if (length(AMR_env$mo_failures) > 0) {
-    warning_("The following input could not be coerced and was returned as \"UNKNOWN\": ", vector_and(AMR_env$mo_failures, quotes = TRUE), ".\nYou can retrieve this list with {.fun mo_failures}.", call = FALSE)
+    warning_("The following input could not be coerced and was returned as \"UNKNOWN\": ", vector_and(AMR_env$mo_failures, quotes = TRUE), ".\nYou can retrieve this list with `mo_failures()`.", call = FALSE)
   }
 
   # Return class ----
@@ -703,8 +596,7 @@ mo_failures <- function() {
 mo_reset_session <- function() {
   if (NROW(AMR_env$mo_previously_coerced) > 0) {
     message_("Reset ", nr2char(NROW(AMR_env$mo_previously_coerced)), " previously matched input value", ifelse(NROW(AMR_env$mo_previously_coerced) > 1, "s", ""), ".")
-    AMR_env$mo_previously_coerced <- new_coercion_cache()
-    AMR_env$mo_previously_uncertain <- NULL
+    AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[0, , drop = FALSE]
     AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
   } else {
     message_("No previously matched input values to reset.")
@@ -731,14 +623,6 @@ mo_cleaning_regex <- function() {
   )
 }
 
-#' @rdname as.mo
-#' @details `NA_mo_` is a missing value of the new `mo` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
-#' @format NULL
-#' @export
-NA_mo_ <- set_clean_class(NA_character_,
-  new_class = c("mo", "character")
-)
-
 # UNDOCUMENTED METHODS ----------------------------------------------------
 
 # this prevents the requirement for putting the dependency in Imports:
@@ -746,14 +630,14 @@ NA_mo_ <- set_clean_class(NA_character_,
 pillar_shaft.mo <- function(x, ...) {
   add_MO_lookup_to_AMR_env()
   out <- trimws(format(x))
-  # grey out the domain (part until first "_")
-  out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
+  # grey out the kingdom (part until first "_")
+  out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(font_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
   # and grey out every _
-  out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
+  out[!is.na(x)] <- gsub("_", font_subtle("_"), out[!is.na(x)])
 
   # markup NA and UNKNOWN
-  out[is.na(x)] <- pillar::style_na("  NA")
-  out[x == "UNKNOWN"] <- pillar::style_na("  UNKNOWN")
+  out[is.na(x)] <- font_na("  NA")
+  out[x == "UNKNOWN"] <- font_na("  UNKNOWN")
 
   # markup manual codes
   out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo] <- font_blue(out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo], collapse = NULL)
@@ -767,30 +651,31 @@ pillar_shaft.mo <- function(x, ...) {
     mo_cols <- NULL
   }
 
-  # as.character() prevents that c.mo() runs its integrity check on the full lookup table
-  all_mos <- c(as.character(AMR_env$MO_lookup$mo), NA)
+  all_mos <- c(AMR_env$MO_lookup$mo, NA)
   if (!all(x %in% all_mos) ||
     (!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
     # markup old mo codes
     out[!x %in% all_mos] <- font_italic(
-      pillar::style_na(x[!x %in% all_mos]),
+      font_na(x[!x %in% all_mos],
+        collapse = NULL
+      ),
       collapse = NULL
     )
     # throw a warning with the affected column name(s)
     if (!is.null(mo_cols)) {
-      col <- paste0("Column ", vector_or(paste0("{.field ", font_bold(colnames(df)[mo_cols], collapse = NULL), "}"), quotes = TRUE, sort = FALSE))
+      col <- paste0("Column ", vector_or(colnames(df)[mo_cols], quotes = TRUE, sort = FALSE))
     } else {
       col <- "The data"
     }
     warning_(
-      col, " contains old MO codes (from another AMR package version). ",
-      "Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
+      col, " contains old MO codes (from a previous AMR package version). ",
+      "Please update your MO codes with `as.mo()`.",
       call = FALSE
     )
   }
 
   # add the names to the bugs as mouse-over!
-  if (in_rstudio()) {
+  if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
     out[!x %in% c("UNKNOWN", NA)] <- font_url(
       url = paste0(
         x[!x %in% c("UNKNOWN", NA)], ": ",
@@ -862,17 +747,13 @@ freq.mo <- function(x, ...) {
 # this prevents the requirement for putting the dependency in Imports:
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
 get_skimmers.mo <- function(column) {
-  mo <- as.mo(column, keep_synonyms = TRUE, language = NULL, info = FALSE)
-  mo <- mo[!is.na(mo)]
-  spp <- mo[mo_species(mo, keep_synonyms = TRUE, language = NULL, info = FALSE) != ""]
   skimr::sfl(
     skim_type = "mo",
-    n_unique = ~ length(unique(mo)),
-    gram_negative = ~ sum(mo_is_gram_negative(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
-    gram_positive = ~ sum(mo_is_gram_positive(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
-    yeast = ~ sum(mo_is_yeast(mo, keep_synonyms = TRUE, language = NULL, info = FALSE), na.rm = TRUE),
-    top_genus = ~ names(sort(-table(mo_genus(mo, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L],
-    top_species = ~ names(sort(-table(mo_name(spp, keep_synonyms = TRUE, language = NULL, info = FALSE))))[1L],
+    unique_total = ~ length(unique(stats::na.omit(.))),
+    gram_negative = ~ sum(mo_is_gram_negative(.), na.rm = TRUE),
+    gram_positive = ~ sum(mo_is_gram_positive(.), na.rm = TRUE),
+    top_genus = ~ names(sort(-table(mo_genus(stats::na.omit(.), language = NULL))))[1L],
+    top_species = ~ names(sort(-table(mo_name(stats::na.omit(.), language = NULL))))[1L]
   )
 }
 
@@ -881,18 +762,17 @@ get_skimmers.mo <- function(column) {
 #' @noRd
 print.mo <- function(x, print.shortnames = FALSE, ...) {
   add_MO_lookup_to_AMR_env()
-  cat(format_inline_("Class {.cls mo}\n"))
+  cat("Class 'mo'\n")
   x_names <- names(x)
   if (is.null(x_names) & print.shortnames == TRUE) {
     x_names <- tryCatch(mo_shortname(x, ...), error = function(e) NULL)
   }
   x <- as.character(x)
   names(x) <- x_names
-  # as.character() prevents that c.mo() runs its integrity check on the full lookup table
-  if (!all(as.character(x) %in% c(as.character(AMR_env$MO_lookup$mo), NA))) {
+  if (!all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
     warning_(
-      "Some MO codes are from another AMR package version. ",
-      "Please update the MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
+      "Some MO codes are from a previous AMR package version. ",
+      "Please update the MO codes with `as.mo()`.",
       call = FALSE
     )
   }
@@ -923,11 +803,10 @@ summary.mo <- function(object, ...) {
 #' @noRd
 as.data.frame.mo <- function(x, ...) {
   add_MO_lookup_to_AMR_env()
-  # as.character() prevents that c.mo() runs its integrity check on the full lookup table
-  if (!all(as.character(x) %in% c(as.character(AMR_env$MO_lookup$mo), NA))) {
+  if (!all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
     warning_(
-      "The data contains old MO codes (from another AMR package version). ",
-      "Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}."
+      "The data contains old MO codes (from a previous AMR package version). ",
+      "Please update your MO codes with `as.mo()`."
     )
   }
   nm <- deparse1(substitute(x))
@@ -962,7 +841,7 @@ as.data.frame.mo <- function(x, ...) {
   attributes(y) <- attributes(i)
   # must only contain valid MOs
   add_MO_lookup_to_AMR_env()
-  return_after_mo_integrity_check(y)
+  return_after_integrity_check(y, "microorganism code", as.character(AMR_env$MO_lookup$mo))
 }
 #' @method [[<- mo
 #' @export
@@ -972,7 +851,7 @@ as.data.frame.mo <- function(x, ...) {
   attributes(y) <- attributes(i)
   # must only contain valid MOs
   add_MO_lookup_to_AMR_env()
-  return_after_mo_integrity_check(y)
+  return_after_integrity_check(y, "microorganism code", as.character(AMR_env$MO_lookup$mo))
 }
 #' @method c mo
 #' @export
@@ -982,7 +861,7 @@ c.mo <- function(...) {
   y <- NextMethod()
   attributes(y) <- attributes(x)
   add_MO_lookup_to_AMR_env()
-  return_after_mo_integrity_check(y)
+  return_after_integrity_check(y, "microorganism code", as.character(AMR_env$MO_lookup$mo))
 }
 
 #' @method unique mo
@@ -1009,16 +888,14 @@ rep.mo <- function(x, ...) {
 print.mo_uncertainties <- function(x, n = 10, ...) {
   more_than_50 <- FALSE
   if (NROW(x) == 0) {
-    message_("No uncertainties to show. Only uncertainties of the last call to {.help [{.fun as.mo}](AMR::as.mo)} or any {.help [{.fun mo_*}](AMR::mo_property)} function are stored.")
+    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]
   }
 
-  message_("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See {.help [{.fun mo_matching_score}](AMR::mo_matching_score)}.",
-    as_note = FALSE
-  )
+  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()
 
@@ -1028,12 +905,12 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
   col_green <- function(x) font_green_bg(x, collapse = NULL)
 
   if (has_colour()) {
-    cat(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")
+      col_green(" 0.750-1.000"),
+      add_fn = font_blue
     ), font_green_bg(" "), "\n", sep = "")
   }
 
@@ -1065,6 +942,21 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
       # sort on descending scores
       candidates_formatted <- candidates_formatted[order(1 - scores)]
       scores_formatted <- scores_formatted[order(1 - scores)]
+
+      candidates <- word_wrap(
+        paste0(
+          "Also matched: ",
+          vector_and(
+            paste0(
+              candidates_formatted,
+              font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
+            ),
+            quotes = FALSE, sort = FALSE
+          )
+        ),
+        extra_indent = nchar("Also matched: "),
+        width = 0.9 * getOption("width", 100)
+      )
     } else {
       candidates <- ""
     }
@@ -1074,56 +966,46 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
       n = x[i, ]$fullname
     )
     score_formatted <- trimws(formatC(round(score, 3), format = "f", digits = 3))
-
-    out <- paste0(
+    txt <- paste(txt,
       paste0(
-        "", strrep(font_grey("-"), times = getOption("width", 100) - 1), "\n",
-        "{.val ", x[i, ]$original_input, "}",
-        " -> ",
         paste0(
-          font_bold(italicise(x[i, ]$fullname)),
-          " (", x[i, ]$mo, ", ", score_set_colour(score_formatted, score), ")"
-        )
-      ),
-      collapse = "\n"
-    )
-    message_(out, as_note = FALSE)
-
-    if (x[i, ]$mo %in% AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$status == "synonym")]) {
-      out2 <- paste0(
-        strrep(" ", nchar(x[i, ]$original_input) + 6),
-        ifelse(x[i, ]$keep_synonyms == FALSE,
-          # Add note if result was coerced to accepted taxonomic name
-          font_red(paste0("This outdated taxonomic name was converted to ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", synonym_mo_to_accepted_mo(x[i, ]$mo), ")."), collapse = NULL),
-          # Or add note if result is currently another taxonomic name
-          font_red(paste0(font_bold("Note: "), "The current name is ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", AMR_env$MO_lookup$ref[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], ")."), collapse = NULL)
-        )
-      )
-      message_(out2, as_note = FALSE)
-    }
-
-    if (x[i, ]$candidates != "") {
-      other_matches <- paste0(
-        "Also matched: ",
-        vector_and(
+          "", strrep(font_grey("-"), times = getOption("width", 100)), "\n",
+          '"', x[i, ]$original_input, '"',
+          " -> ",
           paste0(
-            candidates_formatted,
-            font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
-          ),
-          quotes = FALSE, sort = FALSE
-        )
-      )
-      message_(other_matches, as_note = FALSE)
-    }
+            font_bold(italicise(x[i, ]$fullname)),
+            " (", x[i, ]$mo, ", ", score_set_colour(score_formatted, score), ")"
+          )
+        ),
+        collapse = "\n"
+      ),
+      ifelse(x[i, ]$mo %in% AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$status == "synonym")],
+        paste0(
+          strrep(" ", nchar(x[i, ]$original_input) + 6),
+          ifelse(x[i, ]$keep_synonyms == FALSE,
+            # Add note if result was coerced to accepted taxonomic name
+            font_red(paste0("This outdated taxonomic name was converted to ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", synonym_mo_to_accepted_mo(x[i, ]$mo), ")."), collapse = NULL),
+            # Or add note if result is currently another taxonomic name
+            font_red(paste0(font_bold("Note: "), "The current name is ", font_italic(AMR_env$MO_lookup$fullname[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], collapse = NULL), " (", AMR_env$MO_lookup$ref[match(synonym_mo_to_accepted_mo(x[i, ]$mo), AMR_env$MO_lookup$mo)], ")."), collapse = NULL)
+          )
+        ),
+        ""
+      ),
+      candidates,
+      sep = "\n"
+    )
+    txt <- gsub("[\n]+", "\n", txt)
+    # remove first and last break
+    txt <- gsub("(^[\n]|[\n]$)", "", txt)
+    txt <- paste0("\n", txt, "\n")
   }
 
+  cat(txt)
   if (isTRUE(any_maxed_out)) {
-    cat("\n")
-    message_("Only the first ", n, " other matches of each record are shown. Run {.help [`print(mo_uncertainties(), n = ...)`](AMR::mo_uncertainties)} to view more entries, or save {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to an object.")
+    cat(font_blue(word_wrap("\nOnly the first ", n, " other matches of each record are shown. Run `print(mo_uncertainties(), n = ...)` to view more entries, or save `mo_uncertainties()` to an object.")))
   }
   if (isTRUE(more_than_50)) {
-    cat("\n")
-    message_("Only the first 50 uncertainties are shown. Run {.help [`View(mo_uncertainties())`](AMR::mo_uncertainties)} to view all entries, or save {.help [{.fun mo_uncertainties}](AMR::mo_uncertainties)} to an object.")
+    cat(font_blue(word_wrap("\nOnly the first 50 uncertainties are shown. Run `View(mo_uncertainties())` to view all entries, or save `mo_uncertainties()` to an object.")))
   }
 }
 
@@ -1132,7 +1014,7 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
 #' @noRd
 print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) {
   if (NROW(x) == 0) {
-    message_("No renamed taxonomy to show. Only renamed taxonomy of the last call of {.help [{.fun as.mo}](AMR::as.mo)} or any {.help [{.fun mo_*}](AMR::mo_property)} function are stored.")
+    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))
   }
 
@@ -1143,20 +1025,14 @@ print.mo_renamed <- function(x, extra_txt = "", n = 25, ...) {
 
   rows <- seq_len(min(NROW(x), n))
 
-  message_("The following microorganism", ifelse(NROW(x) > 1, "s were", " was"), " taxonomically renamed", extra_txt, ":")
-  old_format <- paste0(font_italic(x$old[rows], collapse = NULL), x$ref_old[rows])
-  # pad based on the visible width, since format() counts ANSI codes as characters
-  visible_width <- nchar(font_stripstyle(old_format), type = "width")
-  old_format <- paste0(old_format, strrep(" ", max(visible_width) - visible_width))
-  old_format <- gsub(" ", "\u00a0", old_format, fixed = TRUE)
-  for (old_tax in rows) {
-    message_("\u00a0\u00a0", AMR_env$bullet_icon, " ", old_format[old_tax], " -> ", font_italic(x$new[old_tax]), x$ref_new[old_tax], as_note = FALSE)
-  }
-  if (NROW(x) > n) {
-    message_("\u00a0\u00a0Only the first ", n, " (out of ", NROW(x), ") are shown. Run {.code print(mo_renamed(), n = ...)} to view more entries (might be slow), or save {.fun mo_renamed} to an object.",
-      as_note = FALSE
-    )
-  }
+  message_(
+    "The following microorganism", ifelse(NROW(x) > 1, "s were", " was"), " taxonomically renamed", extra_txt, ":\n",
+    paste0("  ", AMR_env$bullet_icon, " ", font_italic(x$old[rows], collapse = NULL), x$ref_old[rows],
+      "  ->  ", font_italic(x$new[rows], collapse = NULL), x$ref_new[rows],
+      collapse = "\n"
+    ),
+    ifelse(NROW(x) > n, paste0("\n\nOnly the first ", n, " (out of ", NROW(x), ") are shown. Run `print(mo_renamed(), n = ...)` to view more entries (might be slow), or save `mo_renamed()` to an object."), "")
+  )
 }
 
 # UNDOCUMENTED HELPER FUNCTIONS -------------------------------------------
@@ -1189,8 +1065,6 @@ convert_colloquial_input <- function(x) {
     perl = TRUE
   )
   out[x %like_case% "ha?emoly.*strep"] <- "B_STRPT_HAEM"
-  # also in other word orders, like "streptocoque beta-hemolytique"
-  out[x %like_case% "strep.*(beta|b\u00eata|\u03b2).?h(a?e|\u00e9)moly"] <- "B_STRPT_HAEM"
   out[x %like_case% "(strepto.* [abcg, ]{2,4}$)"] <- "B_STRPT_ABCG"
   out[x %like_case% "(strepto.* mil+er+i|^mgs[^a-z]*$)"] <- "B_STRPT_MILL"
   out[x %like_case% "mil+er+i gr"] <- "B_STRPT_MILL"
@@ -1199,11 +1073,10 @@ convert_colloquial_input <- function(x) {
   out[x %like_case% "meningo[ck]o[ck](ken)?$"] <- "B_NESSR_MNNG"
   out[x %like_case% "pneumo[ck]o[ck](ken)?$"] <- "B_STRPT_PNMN"
 
-  # Salmonella in different languages, like "Salmonella grupo B" (but not the serovars Paratyphi A, B and C)
-  salmonella_group <- x %like_case% "salmonella.* [abcdefgh]$" & x %unlike_case% "paratyphi [abc]$"
-  out[salmonella_group] <- gsub(".*salmonella.* ([abcdefgh])$",
+  # Salmonella in different languages, like "Salmonella grupo B"
+  out[x %like_case% "salmonella.* [abcdefgh]$"] <- gsub(".*salmonella.* ([abcdefgh])$",
     "B_SLMNL_GRP\\U\\1",
-    x[salmonella_group],
+    x[x %like_case% "salmonella.* [abcdefgh]$"],
     perl = TRUE
   )
   out[x %like_case% "group [abcdefgh] salmonella"] <- gsub(".*group ([abcdefgh]) salmonella*",
@@ -1212,8 +1085,8 @@ convert_colloquial_input <- function(x) {
     perl = TRUE
   )
 
-  # CoNS/CoPS in different languages (support for German, Dutch, French, Spanish, Portuguese)
-  out[x %like_case% "([ck]oagulas[ea].n[e\u00e9]gatie?[vf]|^[ck]o?ns[^a-z]*$)"] <- "B_STPHY_CONS"
+  # CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese)
+  out[x %like_case% "([ck]oagulas[ea].negatie?[vf]|^[ck]o?ns[^a-z]*$)"] <- "B_STPHY_CONS"
   out[x %like_case% "([ck]oagulas[ea].positie?[vf]|^[ck]o?ps[^a-z]*$)"] <- "B_STPHY_COPS"
 
   # Gram stains
@@ -1323,68 +1196,68 @@ parse_and_convert <- function(x) {
 }
 
 replace_old_mo_codes <- function(x, property) {
-  # MO codes of earlier releases (since v2.0.0) that are not in the current data set anymore are translated
-  # with the MO code registry (internal data `MO_RETIRED_CODES`, see data-raw/microorganisms_files/README.md),
-  # e.g. a taxon that moved to another domain.
-  # MO codes are never guessed: a wrong organism is worse than NA. Codes from releases before v2.0.0 are
-  # not supported (decision by Matthijs S. Berends, 3 October 2026).
-  add_MO_lookup_to_AMR_env()
-  not_current <- !is.na(x) & !x %in% AMR_env$MO_lookup$mo
-  if (!any(not_current)) {
-    return(x)
-  }
-  # list at most 10 items, and escape curly brackets of names such as "Kapabacteria {class}" for the cli package
-  listing <- function(v) {
-    v <- gsub("}", "}}", gsub("{", "{{", v, fixed = TRUE), fixed = TRUE)
-    out <- vector_and(utils::head(v, 10), quotes = FALSE, sort = FALSE)
-    if (length(v) > 10) {
-      out <- paste0(out, ", and ", length(v) - 10, " more")
+  # this function transform old MO codes to current codes, such as:
+  # B_ESCH_COL (AMR v0.5.0) -> B_ESCHR_COLI
+  ind <- x %like_case% "^[A-Z]_[A-Z_]+$" & !x %in% AMR_env$MO_lookup$mo
+  if (any(ind, na.rm = TRUE)) {
+    add_MO_lookup_to_AMR_env()
+    # get the ones that match
+    affected <- x[ind]
+    affected_unique <- unique(affected)
+    all_direct_matches <- TRUE
+    # find their new codes, once per code
+    solved_unique <- unlist(lapply(
+      strsplit(affected_unique, ""),
+      function(m) {
+        kingdom <- paste0("^", m[1])
+        name <- m[3:length(m)]
+        name[name == "_"] <- " "
+        name <- tolower(paste0(name, ".*", collapse = ""))
+        name <- gsub(" .*", " ", name, fixed = TRUE)
+        name <- paste0("^", name)
+        results <- AMR_env$MO_lookup$mo[AMR_env$MO_lookup$kingdom %like_case% kingdom &
+          AMR_env$MO_lookup$fullname_lower %like_case% name]
+        if (length(results) > 1) {
+          all_direct_matches <<- FALSE
+        }
+        results[1L]
+      }
+    ), use.names = FALSE)
+    solved <- solved_unique[match(affected, affected_unique)]
+    # assign on places where a match was found
+    x[ind] <- solved
+    n_matched <- length(affected[!is.na(affected)])
+    n_solved <- length(affected[!is.na(solved)])
+    n_unsolved <- length(affected[is.na(solved)])
+    n_unique <- length(affected_unique[!is.na(affected_unique)])
+    if (n_unique < n_matched) {
+      n_unique <- paste0(n_unique, " unique, ")
+    } else {
+      n_unique <- ""
     }
-    out
-  }
-  in_function <- ifelse(property == "mo",
-    "in {.help [{.fun as.mo}](AMR::as.mo)}: ",
-    paste0("in {.help [{.fun mo_", property, "}](AMR::mo_", property, ")}: ")
-  )
-
-  # codes from earlier releases
-  is_retired <- not_current & x %in% MO_RETIRED_CODES$old_mo
-  if (any(is_retired)) {
-    retired <- unique(x[is_retired])
-    current <- MO_RETIRED_CODES$mo[match(retired, MO_RETIRED_CODES$old_mo)]
-    x[is_retired] <- current[match(x[is_retired], retired)]
-    msg <- paste0(
-      in_function, "the input contained ", length(retired), " MO code", ifelse(length(retired) == 1, "", "s"),
-      " from an earlier AMR package version. "
-    )
-    if (any(!is.na(current))) {
-      msg <- paste0(
-        msg, sum(!is.na(current)), ifelse(sum(!is.na(current)) == 1, " was", " were"),
-        " translated to the current MO code of the same taxon (", listing(paste0(retired[!is.na(current)], " -> ", current[!is.na(current)])), "). "
+    if (property != "mo") {
+      warning_(
+        "in `mo_", property, "()`: the input contained ", n_matched,
+        " old MO code", ifelse(n_matched == 1, "", "s"),
+        " (", n_unique, "from a previous AMR package version). ",
+        "Please update your MO codes with `as.mo()` to increase speed."
+      )
+    } else {
+      warning_(
+        "in `as.mo()`: the input contained ", n_matched,
+        " old MO code", ifelse(n_matched == 1, "", "s"),
+        " (", n_unique, "from a previous AMR package version). ",
+        n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
+        ifelse(n_solved == 1, " was", " were"),
+        ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
+        "to ", ifelse(n_solved == 1, "a ", ""),
+        "currently used MO code", ifelse(n_solved == 1, "", "s"),
+        ifelse(n_unsolved > 0,
+          paste0(" and ", n_unsolved, " old MO code", ifelse(n_unsolved == 1, "", "s"), " could not be updated."),
+          "."
+        )
       )
     }
-    if (any(is.na(current))) {
-      gone <- MO_RETIRED_CODES$fullname[match(retired[is.na(current)], MO_RETIRED_CODES$old_mo)]
-      reason <- MO_RETIRED_CODES$reason[match(retired[is.na(current)], MO_RETIRED_CODES$old_mo)]
-      gone <- ifelse(is.na(reason), gone, paste0(gone, ": ", reason))
-      msg <- paste0(
-        msg, sum(is.na(current)), ifelse(sum(is.na(current)) == 1, " was", " were"),
-        " set to NA, as the taxon is not in the current data set (", listing(paste0(retired[is.na(current)], " = ", gone)), "). "
-      )
-    }
-    warning_(msg, "Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.")
-  }
-
-  # anything else that looks like an MO code, but was never part of a release since v2.0.0
-  is_unknown_code <- not_current & !is_retired & x %like_case% "^[A-Z]{1,2}_[][A-Z0-9_-]+$"
-  if (any(is_unknown_code)) {
-    unknown <- unique(x[is_unknown_code])
-    x[is_unknown_code] <- NA_character_
-    warning_(
-      in_function, "the input contained ", length(unknown), " unknown MO code", ifelse(length(unknown) == 1, "", "s"),
-      " (", listing(unknown), "), which ", ifelse(length(unknown) == 1, "was", "were"),
-      " set to NA. MO codes of AMR package versions before v2.0.0 are not supported."
-    )
   }
   x
 }
@@ -1446,39 +1319,11 @@ load_mo_uncertainties <- function(metadata) {
 
 synonym_mo_to_accepted_mo <- function(x, fill_in_accepted = FALSE, dataset = AMR_env$MO_lookup) {
   # `dataset` is an argument so that it can be used in the regeneration of the microorganisms data set
-  if (!identical(dataset, AMR_env$MO_lookup)) {
-    return(synonym_mo_to_accepted_mo_uncached(x, fill_in_accepted = fill_in_accepted, dataset = dataset))
+  if (identical(dataset, AMR_env$MO_lookup)) {
+    add_MO_lookup_to_AMR_env()
+    dataset <- AMR_env$MO_lookup
   }
 
-  # for the internal lookup table, the outcome is memoised per unique code for the whole session
-  add_MO_lookup_to_AMR_env()
-  x <- as.character(x)
-  accepted <- AMR_env$mo_accepted
-  if (is.null(accepted)) {
-    accepted <- data.frame(mo = character(0), accepted = character(0), stringsAsFactors = FALSE)
-  }
-  x_new <- unique(x[!is.na(x) & !x %in% accepted$mo])
-  if (length(x_new) > 0) {
-    accepted <- rbind_AMR(
-      accepted,
-      data.frame(
-        mo = x_new,
-        accepted = synonym_mo_to_accepted_mo_uncached(x_new, fill_in_accepted = TRUE, dataset = AMR_env$MO_lookup),
-        stringsAsFactors = FALSE
-      )
-    )
-    AMR_env$mo_accepted <- accepted
-  }
-
-  out <- accepted$accepted[match(x, accepted$mo)]
-  if (isFALSE(fill_in_accepted)) {
-    # only return codes that were actually renamed, i.e., of synonyms with a known current name
-    out[!is.na(out) & out == x] <- NA_character_
-  }
-  out
-}
-
-synonym_mo_to_accepted_mo_uncached <- function(x, fill_in_accepted = FALSE, dataset) {
   out <- x
   is_still_synonym <- dataset$status[match(out, dataset$mo)] == "synonym"
   limit <- 0
@@ -1492,24 +1337,15 @@ synonym_mo_to_accepted_mo_uncached <- function(x, fill_in_accepted = FALSE, data
     x_mycobank <- dataset$mycobank_renamed_to[match(out, dataset$mo)]
     x_lpsn <- dataset$lpsn_renamed_to[match(out, dataset$mo)]
 
-    # priority LPSN > MycoBank > GBIF, but a source may only overwrite the result if its target exists in the
-    # data set (before 3.1.0, e.g. a MycoBank target that was not included replaced a valid GBIF target by NA)
-    by_gbif <- dataset$mo[match(x_gbif, dataset$gbif, incomparables = NA)]
-    by_mycobank <- dataset$mo[match(x_mycobank, dataset$mycobank, incomparables = NA)]
-    by_lpsn <- dataset$mo[match(x_lpsn, dataset$lpsn, incomparables = NA)]
-    out[must_be_corrected & !is.na(by_gbif)] <- by_gbif[must_be_corrected & !is.na(by_gbif)]
-    out[must_be_corrected & !is.na(by_mycobank)] <- by_mycobank[must_be_corrected & !is.na(by_mycobank)]
-    out[must_be_corrected & !is.na(by_lpsn)] <- by_lpsn[must_be_corrected & !is.na(by_lpsn)]
+    out[must_be_corrected & !is.na(x_gbif)] <- dataset$mo[match(x_gbif[must_be_corrected & !is.na(x_gbif)], dataset$gbif)]
+    out[must_be_corrected & !is.na(x_mycobank)] <- dataset$mo[match(x_mycobank[must_be_corrected & !is.na(x_mycobank)], dataset$mycobank)]
+    out[must_be_corrected & !is.na(x_lpsn)] <- dataset$mo[match(x_lpsn[must_be_corrected & !is.na(x_lpsn)], dataset$lpsn)]
 
     is_still_synonym <- dataset$status[match(out, dataset$mo)] == "synonym"
   }
 
   x_no_synonym <- dataset$status[match(x, dataset$mo)] != "synonym"
   out[x_no_synonym] <- NA_character_
-  if (isFALSE(fill_in_accepted)) {
-    # a synonym without any known current name is not 'renamed' to itself
-    out[!is.na(out) & out == x] <- NA_character_
-  }
   if (isTRUE(fill_in_accepted)) {
     out[!is.na(x_no_synonym) & x_no_synonym] <- x[!is.na(x_no_synonym) & x_no_synonym]
   }

R/mo_matching_score.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -47,7 +47,7 @@
 #' * \eqn{l_n} is the length of \eqn{n};
 #' * \eqn{lev} is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance) (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change \eqn{x} into \eqn{n};
 #' * \eqn{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
-#' * \eqn{k_n} is the taxonomic domain ('kingdom' until taxonomic reclassification of 2024) of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Chromista = 1.75, Archaea = 2, others = 3.
+#' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Chromista = 1.75, Archaea = 2, others = 3.
 #'
 #' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups:
 #'
@@ -122,8 +122,8 @@ mo_matching_score <- function(x, n) {
 
   # human pathogenic prevalence (1 to 3), see ?as.mo
   p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
-  # domain index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
-  k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "domain_index", drop = TRUE]
+  # kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
+  k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
 
   # matching score:
   (l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)

R/mo_property.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -31,7 +31,7 @@
 #'
 #' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
 #' @param x Any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
-#' @param property One of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, documentation = TRUE)`, or must be `"shortname"`.
+#' @param property One of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`.
 #' @inheritParams as.mo
 #' @param ... Other arguments passed on to [as.mo()], such as 'minimum_matching_score', 'ignore_pattern', and 'remove_from_input'.
 #' @param ab Any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()].
@@ -42,23 +42,21 @@
 #' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note about the renaming)
 #' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a once-per-session warning that the name is outdated)
 #'
-#' [mo_ref()] returns the abbreviated authority of the nomenclatural act that created the queried name combination. When `keep_synonyms = FALSE` (default), this is the authority of the currently accepted name. When `keep_synonyms = TRUE`, this is the authority under which the queried (possibly outdated) name was published. Emendations (changes to the species description without a name change) are not reflected; only the combination or original description authority is returned.
+#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. As a result, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
 #'
-#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. Exceptions are *Salmonella* serovars, which return the serovar (such as `"S. Typhi"`), and abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (domain of Bacteria) as well as *Entamoeba coli* (domain of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will always be considered *Escherichia coli*. As a result, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
-#'
-#' Following the formal introduction of the new kingdom rank into prokaryotic nomenclature in 2024 (\doi{10.1099/ijsem.0.006242}), [mo_kingdom()] and [mo_domain()] return different results for bacteria and archaea: [mo_kingdom()] returns the new formal kingdom (e.g. "Pseudomonadati", "Bacillati"), while [mo_domain()] returns the new domain (e.g. "Bacteria", "Archaea"). For non-prokaryotic organisms, both functions return identical results.
+#' Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions [mo_kingdom()] and [mo_domain()] return the exact same results.
 #'
 #' Determination of human pathogenicity ([mo_pathogenicity()]) is strongly based on Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}). This function returns a [factor] with the levels *Pathogenic*, *Potentially pathogenic*, *Non-pathogenic*, and *Unknown*.
 #'
-#' Determination of the Gram stain ([mo_gramstain()] is based on the taxonomic domain and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, \doi{10.1099/00207713-52-1-7}), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were later renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, \doi{10.1099/ijsem.0.005056}). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
+#' Determination of the Gram stain ([mo_gramstain()]) will be based on the taxonomic kingdom and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318/)), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were later renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, [PMID 34694987](https://pubmed.ncbi.nlm.nih.gov/34694987/)). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
 #'
-#' Determination of yeasts ([mo_is_yeast()]) is based on the taxonomic domain and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
+#' Determination of yeasts ([mo_is_yeast()]) will be based on the taxonomic kingdom and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
 #'
-#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) is based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antimicrobials).
+#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) will be based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antimicrobials).
 #'
-#' Determination of both bacterial oxygen tolerance ([mo_oxygen_tolerance()]) and morphology ([mo_morphology()]) are  based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicating an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic domain of Bacteria.
+#' Determination of bacterial oxygen tolerance ([mo_oxygen_tolerance()]) will be based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicting an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic kingdom of Bacteria.
 #'
-#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) is used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
+#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) will be used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
 #'
 #' SNOMED codes ([mo_snomed()]) was last updated on `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
 #'
@@ -83,7 +81,6 @@
 #' @examples
 #' # taxonomic tree -----------------------------------------------------------
 #'
-#' mo_domain("Klebsiella pneumoniae")
 #' mo_kingdom("Klebsiella pneumoniae")
 #' mo_phylum("Klebsiella pneumoniae")
 #' mo_class("Klebsiella pneumoniae")
@@ -93,8 +90,6 @@
 #' mo_species("Klebsiella pneumoniae")
 #' mo_subspecies("Klebsiella pneumoniae")
 #'
-#' # all in one go
-#' mo_taxonomy("Klebsiella pneumoniae")
 #'
 #' # full names and short names -----------------------------------------------
 #'
@@ -105,17 +100,14 @@
 #'
 #' # other properties ---------------------------------------------------------
 #'
-#' mo_morphology("Klebsiella pneumoniae")
-#' mo_gramstain("Klebsiella pneumoniae")
-#' mo_gramstain("Klebsiella pneumoniae", add_morphology = TRUE)
 #' mo_pathogenicity("Klebsiella pneumoniae")
+#' mo_gramstain("Klebsiella pneumoniae")
 #' mo_snomed("Klebsiella pneumoniae")
 #' mo_type("Klebsiella pneumoniae")
 #' mo_rank("Klebsiella pneumoniae")
 #' mo_url("Klebsiella pneumoniae")
 #' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
 #'
-#' mo_group_members("Streptococcus group A")
 #' mo_group_members(c(
 #'   "Streptococcus group A",
 #'   "Streptococcus group C",
@@ -159,7 +151,6 @@
 #'
 #' mo_fullname("Staph epidermidis")
 #' mo_fullname("Staph epidermidis", Becker = TRUE)
-#'
 #' mo_shortname("Staph epidermidis")
 #' mo_shortname("Staph epidermidis", Becker = TRUE)
 #'
@@ -168,7 +159,6 @@
 #'
 #' mo_fullname("Strep agalactiae")
 #' mo_fullname("Strep agalactiae", Lancefield = TRUE)
-#'
 #' mo_shortname("Strep agalactiae")
 #' mo_shortname("Strep agalactiae", Lancefield = TRUE)
 #'
@@ -181,10 +171,10 @@
 #' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
 #' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
 #'
-#' # mo_type is equal to mo_domain, but mo_domain will remain untranslated
-#' mo_domain("Klebsiella pneumoniae")
+#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
+#' mo_kingdom("Klebsiella pneumoniae")
 #' mo_type("Klebsiella pneumoniae")
-#' mo_domain("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
+#' mo_kingdom("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
 #' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
 #'
 #' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "de")
@@ -259,13 +249,8 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
   }
 
   # get first char of genus and complete species in English
-  genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms, ...)
-  shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms, ...)))
-
-  # exceptions for Salmonella serovars, that are stored as subspecies of S. enterica: return e.g. "S. Typhi"
-  subspecies <- mo_subspecies(x.mo, language = NULL, keep_synonyms = keep_synonyms, ...)
-  serovars <- which(genera == "Salmonella" & subspecies %like_case% "^[A-Z]")
-  shortnames[serovars] <- paste0("S. ", subspecies[serovars])
+  genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms)
+  shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms)))
 
   # exceptions for where no species is known
   shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
@@ -273,12 +258,11 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
   shortnames[shortnames == "S. coagulase-negative"] <- "CoNS"
   shortnames[shortnames == "S. coagulase-positive"] <- "CoPS"
   # exceptions for streptococci: Group A Streptococcus -> GAS
-  streptococci_groups <- which(genera == "Streptococcus" & shortnames %like_case% "^S[.] Group [A-L]$")
-  shortnames[streptococci_groups] <- paste0("G", gsub("S. Group ([A-L])", "\\1", shortnames[streptococci_groups], perl = TRUE), "S")
+  shortnames[shortnames %like_case% "S. Group [ABCDFGHK]"] <- paste0("G", gsub("S. Group ([ABCDFGHK])", "\\1", shortnames[shortnames %like_case% "S. Group [ABCDFGHK]"], perl = TRUE), "S")
   # unknown species etc.
   shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
 
-  shortnames[mo_rank(x.mo, keep_synonyms = TRUE, ...) %in% c("domain", "kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo[mo_rank(x.mo, keep_synonyms = TRUE, ...) %in% c("domain", "kingdom", "phylum", "class", "order", "family")], language = NULL, keep_synonyms = keep_synonyms, ...)
+  shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")], language = NULL, keep_synonyms = keep_synonyms)
 
   shortnames[is.na(x.mo)] <- NA_character_
   load_mo_uncertainties(metadata)
@@ -286,6 +270,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
 }
 
 
+
 #' @rdname mo_property
 #' @export
 mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
@@ -395,18 +380,7 @@ mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption
   language <- validate_language(language)
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
 
-  x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
-  for (new_kingdom in c("Archaea", "Bacteria")) {
-    if (any(mo_domain(x.mo) == new_kingdom, na.rm = TRUE) && message_not_thrown_before("mo_kingdom", new_kingdom, entire_session = TRUE)) {
-      message_(
-        "Since {.pkg AMR v3.1.0}, {.help [{.fun mo_kingdom}](AMR::mo_kingdom)} returns the taxonomic kingdom as defined by G\u00f6ker and Oren (2024), who formally introduced a new kingdom rank into prokaryotic nomenclature ({.href [DOI: 10.1099/ijsem.0.006242](https://doi.org/10.1099/ijsem.0.006242)}). ",
-        "{.strong The former kingdom of ", new_kingdom, "} was divided into four new kingdoms under the {.strong new domain of ", new_kingdom, "}. ",
-        "For the old behaviour, use {.help [{.fun mo_domain}](AMR::mo_domain)}. ",
-        "This note will be shown once per session."
-      )
-    }
-  }
-  translate_into_language(mo_validate(x = x.mo, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
+  translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
 }
 
 #' @rdname mo_property
@@ -416,11 +390,7 @@ mo_domain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
     # this tries to find the data and an 'mo' column
     x <- find_mo_col(fn = "mo_domain")
   }
-  meet_criteria(x, allow_NA = TRUE)
-  language <- validate_language(language)
-  meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
-
-  translate_into_language(mo_validate(x = x, property = "domain", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
+  mo_kingdom(x = x, language = language, keep_synonyms = keep_synonyms, ...)
 }
 
 #' @rdname mo_property
@@ -435,8 +405,7 @@ mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
 
   x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
-  out <- mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
-  out <- gsub(" \\{.*\\}", "", out) # strip curly brackets
+  out <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
   out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
   translate_into_language(out, language = language, only_unknown = FALSE)
 }
@@ -472,7 +441,7 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
   metadata <- get_mo_uncertainties()
 
   prev <- AMR_env$MO_lookup$prevalence[match(x.mo, AMR_env$MO_lookup$mo)]
-  kngd <- AMR_env$MO_lookup$domain[match(x.mo, AMR_env$MO_lookup$mo)]
+  kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
   rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
 
   out <- factor(
@@ -492,9 +461,8 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
 }
 
 #' @rdname mo_property
-#' @param add_morphology a [logical] to indicate whether the morphology (from [mo_morphology()]) should be added to the Gram stain result, e.g. `"Gram-negative rods"` instead of `"Gram-negative"`. The default is `FALSE`.
 #' @export
-mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), add_morphology = FALSE, ...) {
+mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
   if (missing(x)) {
     # this tries to find the data and an 'mo' column
     x <- find_mo_col(fn = "mo_gramstain")
@@ -502,14 +470,13 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
-  meet_criteria(add_morphology, allow_class = "logical", has_length = 1)
 
   x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
   metadata <- get_mo_uncertainties()
 
   x <- rep(NA_character_, length(x))
   # make all bacteria Gram negative
-  x[mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
+  x[mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
   # overwrite these 4 phyla with Gram-positives
   # Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
   x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
@@ -528,12 +495,6 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
   # and of course our own ID for Gram-positives
   | x.mo %in% c("B_GRAMP", "B_ANAER-POS")] <- "Gram-positive"
 
-  if (isTRUE(add_morphology)) {
-    morphs <- mo_morphology(x.mo, language = NULL)
-    morphs[is.na(x)] <- ""
-    x[!is.na(x)] <- paste(x[!is.na(x)], tolower(morphs[!is.na(x)]))
-  }
-
   load_mo_uncertainties(metadata)
   translate_into_language(x, language = language, only_unknown = FALSE)
 }
@@ -592,12 +553,12 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
   x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
   metadata <- get_mo_uncertainties()
 
-  x.domain <- mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
+  x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
   x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
 
   load_mo_uncertainties(metadata)
 
-  out <- x.mo == "F_YEAST" | (x.domain == "Fungi" & x.class %in% c("Saccharomycetes", "Pichiomycetes"))
+  out <- x.mo == "F_YEAST" | (x.kingdom == "Fungi" & x.class %in% c("Saccharomycetes", "Pichiomycetes"))
   out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
   out
 }
@@ -623,7 +584,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_s
     ab <- rep(ab, length(x))
   }
   if (length(x) != length(ab)) {
-    stop_("length of {.arg x} and {.arg ab} must be equal, or one of them must be of length 1.")
+    stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
   }
 
   # show used version number once per session (AMR_env will reload every session)
@@ -674,21 +635,6 @@ mo_is_anaerobic <- function(x, language = get_AMR_locale(), keep_synonyms = getO
   out
 }
 
-#' @rdname mo_property
-#' @export
-mo_morphology <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
-  if (missing(x)) {
-    # this tries to find the data and an 'mo' column
-    x <- find_mo_col(fn = "mo_morphology")
-  }
-  meet_criteria(x, allow_NA = TRUE)
-  language <- validate_language(language)
-  meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
-
-  out <- mo_validate(x = x, property = "morphology", language = language, keep_synonyms = keep_synonyms, ...)
-  gsub("^(\\w)", "\\U\\1", out, perl = TRUE)
-}
-
 #' @rdname mo_property
 #' @export
 mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
@@ -819,19 +765,18 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
   language <- validate_language(language)
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
 
-  x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
+  x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
   metadata <- get_mo_uncertainties()
 
   out <- list(
-    domain = mo_domain(x.mo, language = language, keep_synonyms = keep_synonyms),
-    kingdom = suppressMessages(mo_kingdom(x.mo, language = language, keep_synonyms = keep_synonyms)),
-    phylum = mo_phylum(x.mo, language = language, keep_synonyms = keep_synonyms),
-    class = mo_class(x.mo, language = language, keep_synonyms = keep_synonyms),
-    order = mo_order(x.mo, language = language, keep_synonyms = keep_synonyms),
-    family = mo_family(x.mo, language = language, keep_synonyms = keep_synonyms),
-    genus = mo_genus(x.mo, language = language, keep_synonyms = keep_synonyms),
-    species = mo_species(x.mo, language = language, keep_synonyms = keep_synonyms),
-    subspecies = mo_subspecies(x.mo, language = language, keep_synonyms = keep_synonyms)
+    kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
+    phylum = mo_phylum(x, language = language, keep_synonyms = keep_synonyms),
+    class = mo_class(x, language = language, keep_synonyms = keep_synonyms),
+    order = mo_order(x, language = language, keep_synonyms = keep_synonyms),
+    family = mo_family(x, language = language, keep_synonyms = keep_synonyms),
+    genus = mo_genus(x, language = language, keep_synonyms = keep_synonyms),
+    species = mo_species(x, language = language, keep_synonyms = keep_synonyms),
+    subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
   )
 
   load_mo_uncertainties(metadata)
@@ -941,7 +886,6 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
         status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
         synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
         gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
-        morphology = mo_morphology(y, language = language, keep_synonyms = keep_synonyms),
         oxygen_tolerance = mo_oxygen_tolerance(y, language = language, keep_synonyms = keep_synonyms),
         url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
         ref = mo_ref(y, keep_synonyms = keep_synonyms),
@@ -999,7 +943,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
 
   if (isTRUE(open)) {
     if (length(u) > 1) {
-      warning_("in {.fun mo_url}: only the first URL will be opened, as R's built-in function {.fun browseURL} only suports one string.")
+      warning_("in `mo_url()`: only the first URL will be opened, as R's built-in function `browseURL()` only suports one string.")
     }
     utils::browseURL(u[1L])
   }
@@ -1035,62 +979,43 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
 
   dots <- list(...)
   Becker <- dots$Becker
-  if (is.null(Becker) || property %in% c("domain", "kingdom", "phylum", "class", "order", "family", "genus")) {
+  if (is.null(Becker) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
     Becker <- FALSE
   }
   Lancefield <- dots$Lancefield
-  if (is.null(Lancefield) || property %in% c("domain", "kingdom", "phylum", "class", "order", "family", "genus")) {
+  if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
     Lancefield <- FALSE
   }
   has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
 
-  # properties are retrieved for unique values only, and expanded again at the end
-  x_full <- NULL
-  if (is.atomic(x) && is.null(dim(x)) && anyDuplicated(x) > 0) {
-    x_full <- x
-    x <- unique(x)
-  }
-  if (is.atomic(x) && is.null(dim(x))) {
-    x_index <- match(x, AMR_env$MO_lookup$mo)
-    is_valid_mo <- !is.na(x_index) | is.na(x)
-  } else {
-    is_valid_mo <- FALSE
-  }
-
-  if (isFALSE(has_Becker_or_Lancefield) && all(is_valid_mo) &&
-    (isTRUE(keep_synonyms) || !any(AMR_env$MO_lookup$status[x_index] == "synonym", na.rm = TRUE))) {
-    # fastest way to get properties: valid MO codes that need no further coercion
-  } else {
-    if (isFALSE(has_Becker_or_Lancefield) && !all(is_valid_mo)) {
-      # input might already contain the property, such as a genus for mo_genus(), in which case just return it
-      # (synonyms only count if keep_synonyms is TRUE)
-      allowed_status <- if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"
-      property_values <- AMR_env$MO_lookup[[property]][which(AMR_env$MO_lookup$status %in% allowed_status)]
-      if (is.list(property_values)) {
-        property_values <- unlist(property_values)
-      }
-      if (all(x %in% c(property_values, NA))) {
-        if (is.null(x_full)) {
-          return(x)
-        } else {
-          return(x_full)
-        }
-      }
+  if (isFALSE(has_Becker_or_Lancefield) && isTRUE(keep_synonyms) && all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
+    # fastest way to get properties
+    if (property == "snomed") {
+      x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
+    } else {
+      x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
     }
-    # we need to get MO codes now
-    x <- replace_old_mo_codes(x, property = property)
-    x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
-    x_index <- match(x, AMR_env$MO_lookup$mo)
-  }
-
-  # get property reeaaally fast using match()
-  if (property == "snomed") {
-    x <- lapply(x_index, function(i) unlist(AMR_env$MO_lookup$snomed[i]))
   } else {
-    x <- AMR_env$MO_lookup[[property]][x_index]
-  }
-  if (!is.null(x_full)) {
-    x <- x[match(x_full, unique(x_full))]
+    # get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
+    mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
+
+    if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
+      # do nothing, just don't run the other if-else's
+    } else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
+      # no need to do anything, just return it
+      return(x)
+    } else {
+      # we need to get MO codes now
+      x <- replace_old_mo_codes(x, property = property)
+      x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
+    }
+
+    # get property reeaaally fast using match()
+    if (property == "snomed") {
+      x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
+    } else {
+      x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
+    }
   }
 
   if (property == "mo") {
@@ -1118,10 +1043,10 @@ find_mo_col <- function(fn) {
   )
   if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
     if (message_not_thrown_before(fn = fn)) {
-      message_("Using column {.field ", font_bold(mo), "} as input for {.help [{.fun ", fn, "}](AMR::", fn, ")}")
+      message_("Using column '", font_bold(mo), "' as input for `", fn, "()`")
     }
     return(df[, mo, drop = TRUE])
   } else {
-    stop_("argument {.arg x} is missing and no column with info about microorganisms could be found.", call = -2)
+    stop_("argument `x` is missing and no column with info about microorganisms could be found.", call = -2)
   }
 }

R/mo_source.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -75,7 +75,7 @@
 #'
 #' ```
 #' as.mo("lab_mo_ecoli")
-#' #> Class <mo>
+#' #> Class 'mo'
 #' #> [1] B_ESCHR_COLI
 #'
 #' mo_genus("lab_mo_kpneumoniae")
@@ -85,7 +85,7 @@
 #' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
 #' #> NOTE: Translation to one microorganism was guessed with uncertainty.
 #' #>       Use mo_uncertainties() to review it.
-#' #> Class <mo>
+#' #> Class 'mo'
 #' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
 #' ```
 #'
@@ -108,7 +108,7 @@
 #' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
 #' #>       '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
 #' #>        "Organisation XYZ" and "mo"
-#' #> Class <mo>
+#' #> Class 'mo'
 #' #> [1] B_ESCHR_COLI
 #'
 #' mo_genus("lab_Staph_aureus")
@@ -129,18 +129,15 @@ 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, "")) {
-    if (!is.null(AMR_env$mo_source) || file.exists(mo_source_destination)) {
-      # earlier coercions might have been based on this mo_source; get_mo_source() calls this function on every as.mo() call when no mo_source exists, so only reset when there was one
-      AMR_env$mo_previously_coerced <- new_coercion_cache()
-    }
     AMR_env$mo_source <- NULL
     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
       )
     }
@@ -230,8 +227,6 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
   attr(df, "mo_source_timestamp") <- file.mtime(path)
   saveRDS(df, mo_source_destination)
   AMR_env$mo_source <- df
-  # earlier coercions might have been based on another mo_source
-  AMR_env$mo_previously_coerced <- new_coercion_cache()
   message_(
     action, " mo_source file '", font_bold(mo_source_destination),
     "' (", formatted_filesize(mo_source_destination),
@@ -245,9 +240,9 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
 #' @export
 get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
   if (!file.exists(path.expand(destination))) {
-    if (interactive() && identical(attributes(AMR_env$mo_source)$mo_source_destination, path.expand(destination))) {
-      # the mo_source file in use was deleted, so remove the reference to it; this must only concern this destination, so that no other mo_source file is removed
-      set_mo_source("", destination = destination)
+    if (interactive()) {
+      # source file might have been deleted, so update reference
+      set_mo_source("")
     }
     return(NULL)
   }
@@ -255,26 +250,17 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
     current_ext <- regexpr("\\.([[:alnum:]]+)$", destination)
     current_ext <- ifelse(current_ext > -1L, substring(destination, current_ext + 1L), "")
     vowel <- ifelse(current_ext %like% "^[AEFHILMNORSX]", "n", "")
-    stop_("The AMR mo source must be an RDS file, not a", vowel, " ", toupper(current_ext), " file. If \"", basename(destination), "\" was meant as your input file, use {.help [{.fun set_mo_source}](AMR::set_mo_source)} on this file. In any case, the option {.code AMR_mo_source} must be set to another path.")
+    stop_("The AMR mo source must be an RDS file, not a", vowel, " ", toupper(current_ext), " file. If `\"", basename(destination), "\"` was meant as your input file, use `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) || !identical(attributes(AMR_env$mo_source)$mo_source_destination, path.expand(destination))) {
-    # not loaded yet, or loaded from another destination
+  if (is.null(AMR_env$mo_source)) {
     AMR_env$mo_source <- readRDS_AMR(path.expand(destination))
-    # files created before AMR 1.5.0 lack this attribute
-    attr(AMR_env$mo_source, "mo_source_destination") <- path.expand(destination)
   }
 
-  source_location <- attributes(AMR_env$mo_source)$mo_source_location
-  if (interactive() && !is.null(source_location)) {
-    if (!file.exists(source_location)) {
-      # the original file was moved or deleted, so remove the mo_source file as documented
-      set_mo_source("", destination = destination)
-      return(NULL)
-    }
-    if (!identical(attributes(AMR_env$mo_source)$mo_source_timestamp, file.mtime(source_location))) {
-      # the original file was updated, so update the mo_source file at this destination too
-      set_mo_source(source_location, destination = destination)
-    }
+  old_time <- attributes(AMR_env$mo_source)$mo_source_timestamp
+  new_time <- file.mtime(attributes(AMR_env$mo_source)$mo_source_location)
+  if (interactive() && !identical(old_time, new_time)) {
+    # source file was updated, also update reference
+    set_mo_source(attributes(AMR_env$mo_source)$mo_source_location)
   }
   AMR_env$mo_source
 }
@@ -304,7 +290,7 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
   }
   if (!"mo" %in% colnames(x)) {
     if (stop_on_error == TRUE) {
-      stop_(refer_to_name, " must contain a column {.code mo}", call = FALSE)
+      stop_(refer_to_name, " must contain a column 'mo'", call = FALSE)
     } else {
       return(FALSE)
     }
@@ -328,14 +314,14 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
   }
   if (colnames(x)[1] != "mo" && nrow(x) > length(unique(x[, 1, drop = TRUE]))) {
     if (stop_on_error == TRUE) {
-      stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(colnames(x)[1]), "}", call = FALSE)
+      stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[1], "'", call = FALSE)
     } else {
       return(FALSE)
     }
   }
   if (colnames(x)[2] != "mo" && nrow(x) > length(unique(x[, 2, drop = TRUE]))) {
     if (stop_on_error == TRUE) {
-      stop_(refer_to_name, " contains duplicate values in column {.field ", font_bold(colnames(x)[2]), "}", call = FALSE)
+      stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[2], "'", call = FALSE)
     } else {
       return(FALSE)
     }

R/pca.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -66,12 +66,12 @@
 #'
 #' # new ggplot2 plotting method using this package:
 #' if (require("dplyr") && require("ggplot2")) {
-#'   ggplot_pca(pca_result)
+#'     ggplot_pca(pca_result)
 #' }
 #' if (require("dplyr") && require("ggplot2")) {
-#'   ggplot_pca(pca_result) +
-#'     scale_colour_viridis_d() +
-#'     labs(title = "Title here")
+#'     ggplot_pca(pca_result) +
+#'       scale_colour_viridis_d() +
+#'       labs(title = "Title here")
 #' }
 #' }
 pca <- function(x,
@@ -114,7 +114,7 @@ pca <- function(x,
 
     x <- as.data.frame(new_list, stringsAsFactors = FALSE)
     if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
-      warning_("in {.fun pca}: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See {.help [{.fun pca}](AMR::pca)}.", call = FALSE)
+      warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in `?pca`.", call = FALSE)
     }
 
     # set column names
@@ -134,7 +134,7 @@ pca <- function(x,
   pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x))), drop = FALSE]
 
   message_(
-    "Columns selected for PCA: ", vector_and(paste0("{.field ", font_bold(colnames(pca_data), collapse = NULL), "}"), quotes = FALSE),
+    "Columns selected for PCA: ", vector_and(font_bold(colnames(pca_data), collapse = NULL), quotes = TRUE),
     ". Total observations available: ", nrow(pca_data), "."
   )
 

R/proportion.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -35,12 +35,11 @@
 #' @param ... One or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
 #' @param minimum The minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
 #' @param as_percent A [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
-#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below. Use [sir_combine()] to create a new variable for a combination therapy.
+#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below.
 #' @param data A [data.frame] containing columns with class [`sir`] (see [as.sir()]).
 #' @param translate_ab A column name of the [antimicrobials] data set to translate the antibiotic abbreviations to, using [ab_property()].
-#' @param guideline A guideline name, `"EUCAST"` or `"CLSI"` (or any version thereof, e.g. `"CLSI 2025"`), to determine whether the 'I' category is considered susceptible (EUCAST) or resistant (CLSI). The default is the package option [`AMR_guideline`][AMR-options], or `"EUCAST"` if it is not set. For functions that return results per category, i.e., [count_df()], [proportion_df()], [sir_df()], [ggplot_sir()], [geom_sir()], and [labels_sir_count()], this can also be `NULL` or `FALSE` to keep S, I, and R separate. See section *Interpretation of SIR* below.
 #' @inheritParams ab_property
-#' @param combine_SI *(deprecated in favour of `guideline`)* A [logical]. If set, it takes precedence over `guideline`: `TRUE` merges S, SDD, and I into `"SI"` vs. `"R"`, and `FALSE` keeps S, I, and R separate.
+#' @param combine_SI A [logical] to indicate whether all values of S, SDD, and I must be merged into one, so the output only consists of S+SDD+I vs. R (susceptible vs. resistant) - the default is `TRUE`.
 #' @param ab_result Antibiotic results to test against, must be one or more values of "S", "SDD", "I", or "R".
 #' @param confidence_level The confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
 #' @param side The side of the confidence interval to return. The default is `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
@@ -58,8 +57,45 @@
 #' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count_*()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to [count_susceptible()]` / `[count_all()]. *Low counts can influence the outcome - the `proportion_*()` functions may camouflage this, since they only return the proportion (albeit dependent on the `minimum` argument).*
 #'
 #' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates.
-#' @inheritSection sir_combine Combination Therapy
-#' @references **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
+#' @section Combination Therapy:
+#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
+#'
+#'
+#' ```
+#' --------------------------------------------------------------------
+#'                     only_all_tested = FALSE  only_all_tested = TRUE
+#'                     -----------------------  -----------------------
+#'  Drug A    Drug B   considered   considered  considered   considered
+#'                     susceptible    tested    susceptible    tested
+#' --------  --------  -----------  ----------  -----------  ----------
+#'  S or I    S or I        X            X           X            X
+#'    R       S or I        X            X           X            X
+#'   <NA>     S or I        X            X           -            -
+#'  S or I      R           X            X           X            X
+#'    R         R           -            X           -            X
+#'   <NA>       R           -            -           -            -
+#'  S or I     <NA>         X            X           -            -
+#'    R        <NA>         -            -           -            -
+#'   <NA>      <NA>         -            -           -            -
+#' --------------------------------------------------------------------
+#' ```
+#'
+#' Please note that, in combination therapies, for `only_all_tested = TRUE` applies that:
+#'
+#' ```
+#'     count_S()    +   count_I()    +   count_R()    = count_all()
+#'   proportion_S() + proportion_I() + proportion_R() = 1
+#' ```
+#'
+#' and that, in combination therapies, for `only_all_tested = FALSE` applies that:
+#'
+#' ```
+#'     count_S()    +   count_I()    +   count_R()    >= count_all()
+#'   proportion_S() + proportion_I() + proportion_R() >= 1
+#' ```
+#'
+#' Using `only_all_tested` has no impact when only using one antibiotic as input.
+#' @source **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
 #' @seealso [AMR::count()] to count resistant and susceptible isolates.
 #' @return A [double] or, when `as_percent = TRUE`, a [character].
 #' @rdname proportion
@@ -192,23 +228,13 @@
 resistance <- function(...,
                        minimum = 30,
                        as_percent = FALSE,
-                       only_all_tested = FALSE,
-                       guideline = getOption("AMR_guideline", "EUCAST")) {
-  # other arguments for meet_criteria are handled by sir_calc()
-  if (missing(guideline)) {
-    message_guideline_assumed("resistance", txt = ". Use {.code guideline = \"CLSI\"} to consider it resistant.")
-  }
-  guideline <- validate_sir_guideline(guideline, fn = "resistance")
+                       only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c(
-        "R", "NWT", "NS",
-        if (identical(guideline, "CLSI")) "I"
-      ),
+      ab_result = "R",
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
-      guideline = guideline,
       only_count = FALSE
     ),
     error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
@@ -220,23 +246,13 @@ resistance <- function(...,
 susceptibility <- function(...,
                            minimum = 30,
                            as_percent = FALSE,
-                           only_all_tested = FALSE,
-                           guideline = getOption("AMR_guideline", "EUCAST")) {
-  # other arguments for meet_criteria are handled by sir_calc()
-  if (missing(guideline)) {
-    message_guideline_assumed("susceptibility", txt = ". Use {.code guideline = \"CLSI\"} to consider it resistant.")
-  }
-  guideline <- validate_sir_guideline(guideline, fn = "susceptibility")
+                           only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c(
-        "S", "SDD", "WT",
-        if (identical(guideline, "EUCAST")) "I"
-      ),
+      ab_result = c("S", "SDD", "I"),
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
-      guideline = guideline,
       only_count = FALSE
     ),
     error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
@@ -253,7 +269,7 @@ sir_confidence_interval <- function(...,
                                     confidence_level = 0.95,
                                     side = "both",
                                     collapse = FALSE) {
-  meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = seq_along(VALID_SIR_LEVELS), is_in = VALID_SIR_LEVELS)
+  meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1:5), is_in = c("S", "SDD", "I", "R", "NI"))
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
   meet_criteria(as_percent, allow_class = "logical", has_length = 1)
   meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
@@ -271,7 +287,7 @@ sir_confidence_interval <- function(...,
   )
   n <- tryCatch(
     sir_calc(...,
-      ab_result = VALID_SIR_LEVELS,
+      ab_result = c("S", "SDD", "I", "R", "NI"),
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
@@ -305,7 +321,7 @@ sir_confidence_interval <- function(...,
   if (n < minimum) {
     warning_("Introducing NA: ",
       ifelse(n == 0, "no", paste("only", n)),
-      " results available for {.help [{.fun sir_confidence_interval}](AMR::sir_confidence_interval)} (whilst {.arg minimum = ", minimum, "}).",
+      " results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
       call = FALSE
     )
     if (is.character(out)) {
@@ -325,7 +341,7 @@ proportion_R <- function(...,
                          only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("R", "NWT", "NS"),
+      ab_result = "R",
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
@@ -343,7 +359,7 @@ proportion_IR <- function(...,
                           only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("I", "SDD", "R", "NWT", "NS"),
+      ab_result = c("I", "SDD", "R"),
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
@@ -379,7 +395,7 @@ proportion_SI <- function(...,
                           only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("S", "I", "SDD", "WT"),
+      ab_result = c("S", "I", "SDD"),
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
@@ -397,7 +413,7 @@ proportion_S <- function(...,
                          only_all_tested = FALSE) {
   tryCatch(
     sir_calc(...,
-      ab_result = c("S", "WT"),
+      ab_result = "S",
       minimum = minimum,
       as_percent = as_percent,
       only_all_tested = only_all_tested,
@@ -414,10 +430,8 @@ proportion_df <- function(data,
                           language = get_AMR_locale(),
                           minimum = 30,
                           as_percent = FALSE,
-                          combine_SI,
-                          confidence_level = 0.95,
-                          guideline = getOption("AMR_guideline", "EUCAST")) {
-  guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "proportion_df")
+                          combine_SI = TRUE,
+                          confidence_level = 0.95) {
   tryCatch(
     sir_calc_df(
       type = "proportion",
@@ -426,8 +440,8 @@ proportion_df <- function(data,
       language = language,
       minimum = minimum,
       as_percent = as_percent,
-      confidence_level = confidence_level,
-      guideline = guideline
+      combine_SI = combine_SI,
+      confidence_level = confidence_level
     ),
     error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )

R/random.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,7 +27,7 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Generate Random MIC Values, Disk Zones, or SIR Results
+#' Random MIC Values/Disk Zones/SIR Generation
 #'
 #' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial drug, the generated results will reflect reality as much as possible.
 #' @param size Desired size of the returned vector. If used in a [data.frame] call or `dplyr` verb, will get the current (group) size if left blank.
@@ -36,10 +36,9 @@
 #' @param prob_SIR A vector of length 3: the probabilities for "S" (1st value), "I" (2nd value) and "R" (3rd value).
 #' @param skew Direction of skew for MIC or disk values, either `"right"` or `"left"`. A left-skewed distribution has the majority of the data on the right.
 #' @param severity Skew severity; higher values will increase the skewedness. Default is `2`; use `0` to prevent skewedness.
-#' @param guideline A guideline name to base the generated values on, either `"EUCAST"` (default) or `"CLSI"` for the latest implemented version, or a guideline including a year (e.g., `"CLSI 2019"`). The default can be changed with the package option [`AMR_guideline`][AMR-options], see [as.sir()].
 #' @param ... Ignored, only in place to allow future extensions.
 #' @details
-#' Internally, MIC and disk zone values are sampled based on the human clinical breakpoints of `guideline` in the [clinical_breakpoints] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument. The MICs are sampled on a log2 scale and disks linearly, using weighted probabilities. The weights are based on the `skew` and `severity` arguments:
+#' Internally, MIC and disk zone values are sampled based on clinical breakpoints defined in the [clinical_breakpoints] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument. The MICs are sampled on a log2 scale and disks linearly, using weighted probabilities. The weights are based on the `skew` and `severity` arguments:
 #' * `skew = "right"` places more emphasis on lower MIC or higher disk values.
 #' * `skew = "left"` places more emphasis on higher MIC or lower disk values.
 #' * `severity` controls the exponential bias applied.
@@ -56,7 +55,7 @@
 #' disks <- random_disk(100, severity = 2, mo = "Escherichia coli", ab = "CIP")
 #' plot(disks)
 #' # `plot()` and `ggplot2::autoplot()` allow for coloured bars if `mo` and `ab` are set
-#' plot(disks, mo = "Escherichia coli", ab = "CIP", guideline = "CLSI")
+#' plot(disks, mo = "Escherichia coli", ab = "CIP", guideline = "CLSI 2025")
 #'
 #' \donttest{
 #' random_mic(25, "Klebsiella pneumoniae") # range 0.0625-64
@@ -67,14 +66,12 @@
 #' random_disk(25, "Klebsiella pneumoniae", "ampicillin") # range 11-17
 #' random_disk(25, "Streptococcus pneumoniae", "ampicillin") # range 12-27
 #' }
-random_mic <- function(size = NULL, mo = NULL, ab = NULL, skew = "right", severity = 1, guideline = getOption("AMR_guideline", "EUCAST"), ...) {
+random_mic <- function(size = NULL, mo = NULL, ab = NULL, skew = "right", severity = 1, ...) {
   meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
   meet_criteria(mo, allow_class = "character", has_length = c(1, size), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(skew, allow_class = "character", is_in = c("right", "left"), has_length = 1)
   meet_criteria(severity, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
-  meet_criteria(guideline, allow_class = "character", has_length = 1)
-  guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
 
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
@@ -84,7 +81,7 @@ random_mic <- function(size = NULL, mo = NULL, ab = NULL, skew = "right", severi
     p <- progress_ticker(n = length(unique(mo)), n_min = 10, title = "Generating random MIC values")
     for (mo_ in unique(mo)) {
       p$tick()
-      out[which(mo == mo_)] <- random_exec("MIC", size = sum(mo == mo_), mo = mo_, ab = ab, skew = skew, severity = severity, guideline = guideline)
+      out[which(mo == mo_)] <- random_exec("MIC", size = sum(mo == mo_), mo = mo_, ab = ab, skew = skew, severity = severity)
     }
     out <- as.mic(out, keep_operators = "none")
     if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
@@ -96,35 +93,33 @@ random_mic <- function(size = NULL, mo = NULL, ab = NULL, skew = "right", severi
 
     return(out)
   } else {
-    random_exec("MIC", size = size, mo = mo, ab = ab, skew = skew, severity = severity, guideline = guideline)
+    random_exec("MIC", size = size, mo = mo, ab = ab, skew = skew, severity = severity)
   }
 }
 
 #' @rdname random
 #' @export
-random_disk <- function(size = NULL, mo = NULL, ab = NULL, skew = "left", severity = 1, guideline = getOption("AMR_guideline", "EUCAST"), ...) {
+random_disk <- function(size = NULL, mo = NULL, ab = NULL, skew = "left", severity = 1, ...) {
   meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
   meet_criteria(mo, allow_class = "character", has_length = c(1, size), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(skew, allow_class = "character", is_in = c("right", "left"), has_length = 1)
   meet_criteria(severity, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
-  meet_criteria(guideline, allow_class = "character", has_length = 1)
-  guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
 
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
   }
   if (length(mo) > 1) {
     out <- rep(NA_mic_, length(size))
-    p <- progress_ticker(n = length(unique(mo)), n_min = 10, title = "Generating random disk zones")
+    p <- progress_ticker(n = length(unique(mo)), n_min = 10, title = "Generating random MIC values")
     for (mo_ in unique(mo)) {
       p$tick()
-      out[which(mo == mo_)] <- random_exec("DISK", size = sum(mo == mo_), mo = mo_, ab = ab, skew = skew, severity = severity, guideline = guideline)
+      out[which(mo == mo_)] <- random_exec("DISK", size = sum(mo == mo_), mo = mo_, ab = ab, skew = skew, severity = severity)
     }
     out <- as.disk(out)
     return(out)
   } else {
-    random_exec("DISK", size = size, mo = mo, ab = ab, skew = skew, severity = severity, guideline = guideline)
+    random_exec("DISK", size = size, mo = mo, ab = ab, skew = skew, severity = severity)
   }
 }
 
@@ -140,12 +135,8 @@ random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
 }
 
 
-random_exec <- function(method_type, size, mo = NULL, ab = NULL, skew = "right", severity = 1, guideline = NULL) {
+random_exec <- function(method_type, size, mo = NULL, ab = NULL, skew = "right", severity = 1) {
   df <- AMR::clinical_breakpoints %pm>% subset(method == method_type & type == "human")
-  # leave out blocking rows (`NA` breakpoints), so that min() and max() below always have values
-  df <- df[which(!is.na(df$breakpoint_S) & !is.na(df$breakpoint_R)), , drop = FALSE]
-  df_new <- df[which(df$guideline %in% guideline), , drop = FALSE]
-  if (nrow(df_new) > 0) df <- df_new
 
   if (!is.null(mo)) {
     mo_coerced <- as.mo(mo, info = FALSE)

R/resistance_predict.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -138,7 +138,7 @@ resistance_predict <- function(x,
     extra_msg = paste0("Use the tidymodels framework instead, for which we have written a basic and short introduction on our website: ", font_url("https://amr-for-r.org/articles/AMR_with_tidymodels.html", txt = font_bold("AMR with tidymodels")))
   )
 
-  stop_if(is.null(model), 'choose a regression model with the {.arg model} argument, e.g. {.code resistance_predict(..., model = "binomial")}')
+  stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
 
   x.bak <- x
   x <- as.data.frame(x, stringsAsFactors = FALSE)
@@ -146,11 +146,11 @@ resistance_predict <- function(x,
   # -- date
   if (is.null(col_date)) {
     col_date <- search_type_in_df(x = x, type = "date")
-    stop_if(is.null(col_date), "{.arg col_date} must be set")
+    stop_if(is.null(col_date), "`col_date` must be set")
   }
   stop_ifnot(
     col_date %in% colnames(x),
-    "column {.code ", col_date, "} not found"
+    "column '", col_date, "' not found"
   )
 
   year <- function(x) {
@@ -238,7 +238,7 @@ resistance_predict <- function(x,
     prediction <- predictmodel$fit
     se <- predictmodel$se.fit
   } else {
-    stop("no valid model selected. See {.help [{.fun resistance_predict}](AMR::resistance_predict)}.")
+    stop("no valid model selected. See `?resistance_predict`.")
   }
 
   # prepare the output dataframe
@@ -357,7 +357,7 @@ ggplot_sir_predict <- function(x,
   meet_criteria(ribbon, allow_class = "logical", has_length = 1)
 
   stop_ifnot_installed("ggplot2")
-  stop_ifnot(inherits(x, "resistance_predict"), "{.arg x} must be a resistance prediction model created with {.fun resistance_predict}")
+  stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
 
   if (attributes(x)$I_as_S == TRUE) {
     ylab <- "%R"

R/sir_calc.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -35,63 +35,13 @@ dots2vars <- function(...) {
   paste0(dots[dots != "."], collapse = "+")
 }
 
-validate_sir_guideline <- function(guideline, fn, allow_none = FALSE) {
-  # returns "EUCAST" or "CLSI" to consider 'I' susceptible or resistant, or NULL to not merge 'I' at all, see the section 'Interpretation of SIR' in ?as.sir
-  if (is.null(guideline) || isFALSE(guideline)) {
-    stop_ifnot(
-      allow_none,
-      "{.arg guideline} must be {.val EUCAST} or {.val CLSI} in {.help [{.fun ", fn, "}](AMR::", fn, ")}, since a single proportion or count requires the 'I' category to be considered either susceptible (EUCAST) or resistant (CLSI). See the section 'Interpretation of SIR' in {.help [{.fun as.sir}](AMR::as.sir)}.",
-      call = FALSE
-    )
-    return(NULL)
-  }
-  stop_ifnot(
-    is.character(guideline) && length(guideline) == 1 && !is.na(guideline) && (guideline %like% "EUCAST" || guideline %like% "CLSI"),
-    "{.arg guideline} must be {.val EUCAST} or {.val CLSI}", ifelse(allow_none, ", or {.code NULL} to keep S, I, and R separate,", ""), " in {.help [{.fun ", fn, "}](AMR::", fn, ")}. See the section 'Interpretation of SIR' in {.help [{.fun as.sir}](AMR::as.sir)}.",
-    call = FALSE
-  )
-  if (guideline %like% "EUCAST") "EUCAST" else "CLSI"
-}
-
-message_guideline_assumed <- function(fn, txt) {
-  # informs once per session that EUCAST is assumed, only to be called when the `guideline` argument is missing
-  # - not when the AMR_guideline option is set, since that is a deliberate choice
-  # - not when knitting R Markdown or Quarto documents, so it will not end up in reports
-  if (is.null(getOption("AMR_guideline")) && !isTRUE(getOption("knitr.in.progress")) && message_not_thrown_before(fn, "guideline_assumed", entire_session = TRUE)) {
-    message_(
-      "{.help [{.fun ", fn, "}](AMR::", fn, ")} assumes the EUCAST guideline and thus considers the 'I' category susceptible", txt,
-      " Set the {.arg guideline} argument, or set the {.code AMR_guideline} option to change the default (see {.topic [AMR-options](AMR::AMR-options)}). This message is shown once per session."
-    )
-  }
-}
-
-get_aggregation_guideline <- function(guideline, guideline_missing, combine_SI, combine_SI_missing, fn) {
-  # for functions that return results per category: returns "EUCAST" ("SI" vs. "R"), "CLSI" ("S" vs. "IR"), or NULL (S, I, and R separately)
-  if (!combine_SI_missing) {
-    # deprecated argument, if set it must be followed literally, regardless of the guideline
-    meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = 1)
-    deprecation_warning("combine_SI", "guideline", fn = fn, is_argument = TRUE, extra_msg = "As long as `combine_SI` is set, it takes precedence over `guideline`. Use `guideline = \"EUCAST\"` to merge 'I' with S, `guideline = \"CLSI\"` to merge 'I' with R, or `guideline = NULL` to keep S, I, and R separate.")
-    if (isTRUE(combine_SI)) {
-      return("EUCAST")
-    } else {
-      return(NULL)
-    }
-  }
-  guideline <- validate_sir_guideline(guideline, fn = fn, allow_none = TRUE)
-  if (isTRUE(guideline_missing) && !is.null(guideline)) {
-    message_guideline_assumed(fn, txt = paste0(" (S+SDD+I vs. R). Use {.code guideline = \"CLSI\"} for S+SDD vs. I+R, or {.code guideline = NULL} to keep S, I, and R separate."))
-  }
-  guideline
-}
-
 sir_calc <- function(...,
                      ab_result,
                      minimum = 0,
                      as_percent = FALSE,
                      only_all_tested = FALSE,
-                     only_count = FALSE,
-                     guideline = getOption("AMR_guideline", "EUCAST")) {
-  meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = seq_along(VALID_SIR_LEVELS), is_in = VALID_SIR_LEVELS)
+                     only_count = FALSE) {
+  meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1:5))
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
   meet_criteria(as_percent, allow_class = "logical", has_length = 1)
   meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
@@ -110,6 +60,11 @@ sir_calc <- function(...,
   dots <- eval(substitute(alist(...)))
   stop_if(length(dots) == 0, "no variables selected", call = -2)
 
+  stop_if("also_single_tested" %in% names(dots),
+    "`also_single_tested` was replaced by `only_all_tested`.\n",
+    "Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.",
+    call = -2
+  )
   ndots <- length(dots)
 
   if (is.data.frame(dots_df)) {
@@ -162,8 +117,6 @@ sir_calc <- function(...,
   print_warning <- FALSE
 
   ab_result <- as.sir(ab_result)
-  denominator_vals <- levels(ab_result)
-  denominator_vals <- denominator_vals[denominator_vals != "NI"]
 
   if (is.data.frame(x)) {
     sir_integrity_check <- character(0)
@@ -179,38 +132,46 @@ sir_calc <- function(...,
       # this will give a warning for invalid results, of all input columns (so only 1 warning)
       sir_integrity_check <- as.sir(sir_integrity_check)
     }
-    if (ncol(x) == 1) {
-      x <- x[, 1, drop = TRUE]
-    } else if (isTRUE(only_all_tested)) {
-      # combination therapy of isolates tested for all antimicrobials, see ?sir_combine
-      x <- sir_combine_engine(as.list(x), S_values = get_susceptible_values(guideline), only_all_tested = TRUE)
-    }
-  } else if (!is.sir(x)) {
-    x <- as.sir(x)
-    print_warning <- TRUE
-  }
 
-  if ("SDD" %in% ab_result && "SDD" %in% unlist(lapply(as.list(x), as.character)) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
-    message_("Note that {.fun ", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "} will also include dose-dependent susceptibility, {.val SDD}. This note will be shown once for this session.", as_note = FALSE)
-  }
-  if (is.data.frame(x)) {
-    # multiple antimicrobials with only_all_tested = FALSE: an isolate counts if any antimicrobial has a result in `ab_result`, and is considered tested if it has such a result or was tested for all antimicrobials, see ?sir_combine
-    # this equals sir_combine(method = "most_susceptible") for susceptibility and sir_combine(method = "most_resistant") for resistance
-    # 'NI' is a missing result
-    numerator_vals <- intersect(as.character(ab_result), denominator_vals)
-    is_counted <- Reduce(`|`, lapply(x, function(col) as.character(col) %in% numerator_vals))
-    is_complete <- Reduce(`&`, lapply(x, function(col) as.character(col) %in% denominator_vals))
-    numerator <- sum(is_counted)
-    denominator <- sum(is_counted | is_complete)
+    x_transposed <- as.list(as.data.frame(t(x), stringsAsFactors = FALSE))
+    if (isTRUE(only_all_tested)) {
+      # no NAs in any column
+      y <- apply(
+        X = as.data.frame(lapply(x, as.double), stringsAsFactors = FALSE),
+        MARGIN = 1,
+        FUN = min
+      )
+      if ("SDD" %in% ab_result && "SDD" %in% y && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
+        message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
+      }
+      numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE)
+      denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y))))
+    } else {
+      # may contain NAs in any column
+      other_values <- setdiff(c(NA, levels(ab_result)), ab_result)
+      if ("SDD" %in% ab_result && "SDD" %in% unlist(x_transposed) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
+        message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
+      }
+      numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE)))
+      denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & anyNA(y))))
+    }
   } else {
+    # x is not a data.frame
+    if (!is.sir(x)) {
+      x <- as.sir(x)
+      print_warning <- TRUE
+    }
+    if ("SDD" %in% ab_result && "SDD" %in% x && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
+      message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
+    }
     numerator <- sum(x %in% ab_result, na.rm = TRUE)
-    denominator <- sum(x %in% denominator_vals, na.rm = TRUE)
+    denominator <- sum(x %in% levels(ab_result), na.rm = TRUE)
   }
 
   if (print_warning == TRUE) {
     if (message_not_thrown_before("sir_calc")) {
-      warning_("Increase speed by transforming to class {.cls sir} on beforehand:\n",
-        highlight_code("  your_data %>% mutate_if(is_sir_eligible, as.sir)"),
+      warning_("Increase speed by transforming to class 'sir' on beforehand:\n",
+        "  your_data %>% mutate_if(is_sir_eligible, as.sir)",
         call = FALSE
       )
     }
@@ -246,7 +207,7 @@ sir_calc <- function(...,
       ifelse(denominator == 0, "no", paste("only", denominator)),
       " results available",
       data_vars,
-      " (whilst {.arg minimum = ", minimum, "}).",
+      " (`minimum` = ", minimum, ").",
       call = FALSE
     )
     fraction <- NA_real_
@@ -268,8 +229,8 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
                         language = get_AMR_locale(),
                         minimum = 30,
                         as_percent = FALSE,
-                        confidence_level = 0.95,
-                        guideline = "EUCAST") { # must be "EUCAST", "CLSI", or NULL, see get_aggregation_guideline()
+                        combine_SI = TRUE,
+                        confidence_level = 0.95) {
   meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
   meet_criteria(data, allow_class = "data.frame")
   data <- ascertain_sir_classes(data, "data")
@@ -277,11 +238,8 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   language <- validate_language(language)
   meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
   meet_criteria(as_percent, allow_class = "logical", has_length = 1)
+  meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(confidence_level, allow_class = "numeric", has_length = 1)
-  meet_criteria(guideline, allow_class = "character", has_length = 1, is_in = c("EUCAST", "CLSI"), allow_NULL = TRUE)
-  # with EUCAST, 'I' is merged with S into 'SI', with CLSI, 'I' is merged with R into 'IR', and with NULL, 'I' is not merged
-  combine_SI <- !is.null(guideline)
-  combined_levels <- if (identical(guideline, "CLSI")) c("S", "IR") else c("SI", "R")
 
   translate_ab <- get_translate_ab(translate_ab)
 
@@ -301,15 +259,13 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   for (i in seq_len(ncol(data))) {
     # transform SIR columns
     if (is.sir(data[, i, drop = TRUE])) {
-      data[, i] <- as.character(as.sir(data[, i, drop = TRUE]))
-      data[which(data[, i, drop = TRUE] %in% c("S", "SDD", "WT")), i] <- "S"
-      data[which(data[, i, drop = TRUE] %in% c("R", "NWT", "NS")), i] <- "R"
-      if (isTRUE(combine_SI) && identical(guideline, "CLSI")) {
-        data[which(data[, i, drop = TRUE] %in% c("I", "R")), i] <- "IR"
-      } else if (isTRUE(combine_SI)) {
-        data[which(data[, i, drop = TRUE] %in% c("I", "S")), i] <- "SI"
+      data[, i] <- as.character(data[, i, drop = TRUE])
+      if (isTRUE(combine_SI)) {
+        if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
+          message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
+        }
+        data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
       }
-      data[which(!data[, i, drop = TRUE] %in% c("S", "SI", "I", "IR", "R")), i] <- NA_character_
     }
   }
 
@@ -331,7 +287,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
     for (i in seq_len(ncol(.data))) {
       values <- .data[, i, drop = TRUE]
       if (isTRUE(combine_SI)) {
-        values <- factor(values, levels = c(combined_levels, "NI"), ordered = TRUE)
+        values <- factor(values, levels = c("SI", "R", "NI"), ordered = TRUE)
       } else {
         values <- factor(values, levels = c("S", "SDD", "I", "R", "NI"), ordered = TRUE)
       }
@@ -406,7 +362,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
 
   # apply factors for right sorting in interpretation
   if (isTRUE(combine_SI)) {
-    out$interpretation <- factor(out$interpretation, levels = combined_levels, ordered = TRUE)
+    out$interpretation <- factor(out$interpretation, levels = c("SI", "R"), ordered = TRUE)
   } else {
     # don't use as.sir() here, as it would add the class 'sir' and we would like
     # the same data structure as output, regardless of input

R/sir_combine.R

@@ -1,219 +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              #
-# ==================================================================== #
-
-#' Combine SIR Results of Multiple Antimicrobials
-#'
-#' @description Combine the SIR results of two or more antimicrobials into one SIR result per isolate. This can answer two different questions, set with the `method` argument:
-#'
-#' * `"most_susceptible"` (default): *Is at least one of these antimicrobials expected to work?* This is the result of a combination therapy, e.g. piperacillin/tazobactam with gentamicin, which covers the isolate if any of its antimicrobials is active.
-#' * `"most_resistant"`: *Is resistance demonstrated to any of these antimicrobials?* This is the result for a group of antimicrobials, e.g. resistance to third-generation cephalosporins if an isolate is resistant to ceftazidime or ceftriaxone, as used in surveillance reports.
-#'
-#' See *Combination Therapy* below for the exact rules. The same rules are used by [antibiogram()] and [wisca()] for combination antibiograms, and by the [`count_*()`][count()] and [`proportion_*()`][proportion()] functions when more than one variable is used.
-#' @param ... Two or more vectors (or columns) with antimicrobial interpretations, or a data frame with such columns. They will be transformed internally with [as.sir()] if needed. All vectors must be of the same length.
-#' @param method Either `"most_susceptible"` (default) to return the most susceptible result, as for combination therapy, or `"most_resistant"` to return the most resistant result, as for resistance within a group of antimicrobials. See *Combination Therapy* below.
-#' @param only_all_tested A [logical] to indicate that isolates must be tested for all antimicrobials. If `TRUE`, the result is `NA` for isolates with a missing result for any of the antimicrobials. If `FALSE` (default), a missing result only leads to `NA` if a result for the missing antimicrobial could have changed the result, see *Combination Therapy* below.
-#' @param guideline A guideline name, `"EUCAST"` or `"CLSI"` (or any version thereof, e.g. `"CLSI 2025"`), to determine whether the 'I' category is considered susceptible (EUCAST) or resistant (CLSI). This only affects isolates with a missing result for any of the antimicrobials when `only_all_tested = FALSE`, see *Combination Therapy* below. The default is the package option [`AMR_guideline`][AMR-options], or `"EUCAST"` if it is not set. See section *Interpretation of SIR* below.
-#' @inheritSection as.sir Interpretation of SIR
-#' @section Combination Therapy:
-#' Results are ordered from susceptible to resistant: S (and WT), SDD, I, R (and NWT, NS). With `method = "most_susceptible"` (in [sir_combine()]), the most susceptible result of the antimicrobials is returned, and with `method = "most_resistant"`, the most resistant result. The value `"NI"` (non-interpretable) is considered a missing result.
-#'
-#' A missing result can only be ignored if it cannot change the conclusion: a susceptible result for `"most_susceptible"`, and a non-susceptible result for `"most_resistant"`. Under EUCAST, the 'I' category is considered susceptible (*susceptible, increased exposure*), and under CLSI, it is not. With `only_all_tested = TRUE`, any missing result leads to `NA`.
-#'
-#' This is an example for two antimicrobials, Drug A and Drug B, under EUCAST (the order of the antimicrobials does not matter):
-#'
-#' ```
-#' -------------------------------------------------------------------------
-#'                       Result of method =            Result of method =
-#'                      "most_susceptible"              "most_resistant"
-#'                    -----------------------  -----------------------------
-#'                     only_all_tested =        only_all_tested =
-#'  Drug A    Drug B     FALSE      TRUE          FALSE         TRUE
-#' --------  --------  ---------  ---------    -----------  -------------
-#'     S        S          S          S             S             S
-#'     S        I          S          S             I             I
-#'     S        R          S          S             R             R
-#'     I        R          I          I             R             R
-#'     R        R          R          R             R             R
-#'     S      <NA>         S        <NA>          <NA>          <NA>
-#'     I      <NA>         I        <NA>          <NA>          <NA>
-#'     R      <NA>       <NA>       <NA>            R           <NA>
-#'   <NA>     <NA>       <NA>       <NA>          <NA>          <NA>
-#' -------------------------------------------------------------------------
-#' ```
-#'
-#' Under CLSI, the combination of I with a missing result is `<NA>` for `"most_susceptible"` and I for `"most_resistant"`.
-#'
-#' The [`count_*()`][count()] and [`proportion_*()`][proportion()] functions apply these rules when more than one variable is used. With `only_all_tested = FALSE` (default), the functions for susceptibility, such as [susceptibility()] and [count_susceptible()], count an isolate as susceptible if any of the antimicrobials is susceptible (`"most_susceptible"`), and the functions for resistance, such as [resistance()] and [count_resistant()], count an isolate as resistant if any of the antimicrobials is resistant (`"most_resistant"`). An isolate is considered tested if it has such a result, or if it was tested for all antimicrobials. Therefore, for combinations with `only_all_tested = FALSE`:
-#'
-#' ```
-#'     count_S()    +   count_I()    +   count_R()    >= count_all()
-#'   proportion_S() + proportion_I() + proportion_R() >= 1
-#' ```
-#'
-#' With `only_all_tested = TRUE`, all these functions count the result of the combination therapy (`"most_susceptible"`) of isolates tested for all antimicrobials, so that:
-#'
-#' ```
-#'     count_S()    +   count_I()    +   count_R()    = count_all()
-#'   proportion_S() + proportion_I() + proportion_R() = 1
-#' ```
-#'
-#' In [antibiogram()] and [wisca()], the result of the combination therapy (`"most_susceptible"`) is used, the 'I' category is considered susceptible or not following the `guideline` argument ('SDD' is always considered susceptible), and the result is then reduced to S or R.
-#' @return A [`sir`] vector with the same length as the input.
-#' @seealso [count()] and [proportion()] for counting and calculating susceptibility of (combinations of) antimicrobials, and [antibiogram()] for combination antibiograms.
-#' @export
-#' @examples
-#' drug_a <- as.sir(c("S", "R", "R", "I", "I", NA, "R", "SDD"))
-#' drug_b <- as.sir(c("R", "S", "R", "R", NA, NA, NA, "I"))
-#'
-#' # combination therapy: is at least one of them expected to work?
-#' sir_combine(drug_a, drug_b)
-#' sir_combine(drug_a, drug_b, guideline = "CLSI")
-#' sir_combine(drug_a, drug_b, only_all_tested = TRUE)
-#'
-#' # resistance within a group: is resistance demonstrated to any of them?
-#' sir_combine(drug_a, drug_b, method = "most_resistant")
-#'
-#' # the count and proportion functions use the same rules
-#' susceptibility(drug_a, drug_b, minimum = 0)
-#' susceptibility(sir_combine(drug_a, drug_b), minimum = 0)
-#' resistance(drug_a, drug_b, minimum = 0)
-#' resistance(sir_combine(drug_a, drug_b, method = "most_resistant"), minimum = 0)
-#'
-#' \donttest{
-#' if (require("dplyr")) {
-#'   # create a new variable for piperacillin/tazobactam + gentamicin
-#'   example_isolates %>%
-#'     filter(!is.na(TZP)) %>%
-#'     mutate(TZP_GEN = sir_combine(TZP, GEN)) %>%
-#'     select(mo, TZP, GEN, TZP_GEN)
-#' }
-#' if (require("dplyr")) {
-#'   # resistance to third-generation cephalosporins
-#'   example_isolates %>%
-#'     mutate(cephalosporins_3rd = sir_combine(CAZ, CRO, method = "most_resistant")) %>%
-#'     count(cephalosporins_3rd)
-#' }
-#' if (require("dplyr")) {
-#'   # combine any number of antimicrobials
-#'   example_isolates %>%
-#'     mutate(any_aminoglycoside = sir_combine(GEN, TOB, AMK, KAN)) %>%
-#'     count(any_aminoglycoside)
-#' }
-#' if (require("dplyr")) {
-#'   # use the new variable in further analyses
-#'   # THOUGH CONSIDER wisca() FOR RELIABLE ESTIMATES
-#'   example_isolates %>%
-#'     mutate(TZP_GEN = sir_combine(TZP, GEN)) %>%
-#'     group_by(ward) %>%
-#'     summarise(
-#'       TZP_mono = susceptibility(TZP),
-#'       GEN_mono = susceptibility(GEN),
-#'       TZP_GEN = susceptibility(TZP_GEN),
-#'       # or directly, without combining first:
-#'       TZP_GEN2 = susceptibility(TZP, GEN)
-#'     )
-#' }
-#' }
-sir_combine <- function(..., method = c("most_susceptible", "most_resistant"), only_all_tested = FALSE, guideline = getOption("AMR_guideline", "EUCAST")) {
-  method <- match.arg(method)
-  meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
-  guideline_missing <- missing(guideline)
-  guideline <- validate_sir_guideline(guideline, fn = "sir_combine")
-
-  # unpack data frames, so that e.g. sir_combine(df[, c("GEN", "TOB")], CIP) works
-  cols <- list()
-  for (dot in list(...)) {
-    if (is.data.frame(dot)) {
-      cols <- c(cols, unname(as.list(dot)))
-    } else {
-      cols <- c(cols, list(dot))
-    }
-  }
-  stop_if(length(cols) < 2, "at least two vectors or columns must be provided to combine, but ", length(cols), " ", ifelse(length(cols) == 1, "was", "were"), " provided.")
-  col_lengths <- vapply(FUN.VALUE = integer(1), cols, length)
-  stop_if(length(unique(col_lengths)) > 1, "all vectors or columns must be of the same length, but they have lengths ", vector_and(sort(unique(col_lengths)), quotes = FALSE), ".")
-  cols <- lapply(cols, function(x) if (is.sir(x)) x else as.sir(x))
-
-  out <- sir_combine_engine(cols, S_values = get_susceptible_values(guideline), only_all_tested = only_all_tested, method = method)
-
-  if (isFALSE(only_all_tested) && is.null(getOption("AMR_guideline")) && guideline_missing) {
-    # only notify about the assumed guideline if it affected the result
-    out_clsi <- sir_combine_engine(cols, S_values = get_susceptible_values("CLSI"), only_all_tested = only_all_tested, method = method)
-    if (!identical(out, out_clsi)) {
-      message_guideline_assumed("sir_combine", txt = ", which affected the result for 'I' results combined with a missing result. Use {.code guideline = \"CLSI\"} to consider it resistant.")
-    }
-  }
-  out
-}
-
-get_susceptible_values <- function(guideline) {
-  # the SIR values considered susceptible, as in count_susceptible() and susceptibility()
-  if (!is.null(guideline) && guideline %like% "CLSI") {
-    c("S", "SDD", "WT")
-  } else {
-    c("S", "SDD", "I", "WT")
-  }
-}
-
-sir_combine_engine <- function(cols, S_values, only_all_tested = FALSE, method = "most_susceptible") {
-  # this is the engine for combining SIR results, used by sir_combine(), sir_calc() and antibiogram()
-  # - cols: a list of vectors of equal length, with class 'sir' or with SIR values as character
-  # - S_values: the values considered susceptible; all other values are considered non-susceptible
-  # - method: "most_susceptible" (combination therapy) or "most_resistant" (resistance within a group)
-  # the order of preference: values with equal rank are resolved by this order
-  preference <- c("S", "WT", "SDD", "I", "R", "NWT", "NS")
-  ranks <- c(1L, 1L, 2L, 3L, 4L, 4L, 4L)
-  cols <- lapply(cols, as.character)
-  if (length(cols) == 0) {
-    return(as_sir_structure(character(0)))
-  }
-  # 'NI' and NA get no rank, so they are missing results
-  col_ranks <- lapply(cols, function(x) ranks[match(x, preference)])
-  if (method == "most_susceptible") {
-    selected <- do.call(pmin, c(col_ranks, list(na.rm = TRUE)))
-    # a missing result cannot change a susceptible result
-    decisive_values <- S_values
-  } else {
-    selected <- do.call(pmax, c(col_ranks, list(na.rm = TRUE)))
-    # a missing result cannot change a non-susceptible result
-    decisive_values <- setdiff(preference, S_values)
-  }
-  out <- rep(NA_character_, length(selected))
-  for (i in seq_along(preference)) {
-    is_present <- Reduce(`|`, lapply(cols, function(x) x %in% preference[i]))
-    out[is.na(out) & selected %in% ranks[i] & is_present] <- preference[i]
-  }
-  any_missing <- Reduce(`|`, lapply(col_ranks, is.na))
-  if (isTRUE(only_all_tested)) {
-    out[any_missing] <- NA_character_
-  } else {
-    out[any_missing & !out %in% decisive_values] <- NA_character_
-  }
-  as_sir_structure(out)
-}

R/sir_df.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -34,10 +34,8 @@ sir_df <- function(data,
                    language = get_AMR_locale(),
                    minimum = 30,
                    as_percent = FALSE,
-                   combine_SI,
-                   confidence_level = 0.95,
-                   guideline = getOption("AMR_guideline", "EUCAST")) {
-  guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "sir_df")
+                   combine_SI = TRUE,
+                   confidence_level = 0.95) {
   tryCatch(
     sir_calc_df(
       type = "both",
@@ -46,8 +44,8 @@ sir_df <- function(data,
       language = language,
       minimum = minimum,
       as_percent = as_percent,
-      confidence_level = confidence_level,
-      guideline = guideline
+      combine_SI = combine_SI,
+      confidence_level = confidence_level
     ),
     error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )

R/skewness.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

R/tidymodels.R

@@ -1,26 +1,26 @@
 #' AMR Extensions for Tidymodels
 #'
-#' This family of functions allows using AMR-specific data types such as `<sir>` and `<mic>` inside `tidymodels` pipelines.
+#' This family of functions allows using AMR-specific data types such as `<mic>` and `<sir>` inside `tidymodels` pipelines.
 #' @inheritParams recipes::step_center
-#' @param columns A character string of the selected variable names. This is `NULL` until the step is trained by [recipes::prep()], and should not be set manually.
 #' @details
 #' You can read more in our online [AMR with tidymodels introduction](https://amr-for-r.org/articles/AMR_with_tidymodels.html).
 #'
 #' Tidyselect helpers include:
-#' - [all_sir()] and [all_sir_predictors()] to select [`<sir>`][as.sir()] columns
-#' - [all_mic()] and [all_mic_predictors()] to select [`<mic>`][as.mic()] columns
-#' - [all_disk()] and [all_disk_predictors()] to select [`<disk>`][as.disk()] columns
+#' - [all_mic()] and [all_mic_predictors()] to select `<mic>` columns
+#' - [all_sir()] and [all_sir_predictors()] to select `<sir>` columns
 #'
 #' Pre-processing pipeline steps include:
-#' - [step_sir_numeric()] to convert SIR columns to numeric (via `as.numeric()`), to be used with [all_sir_predictors()]: `"S"` = 1, `"I"`/`"SDD"` = 2, `"R"` = 3. All other values are rendered `NA`. Keep this in mind for further processing, especially if the model does not allow for `NA` values.
 #' - [step_mic_log2()] to convert MIC columns to numeric (via `as.numeric()`) and apply a log2 transform, to be used with [all_mic_predictors()]
+#' - [step_sir_numeric()] to convert SIR columns to numeric (via `as.numeric()`), to be used with [all_sir_predictors()]: `"S"` = 1, `"I"`/`"SDD"` = 2, `"R"` = 3. All other values are rendered `NA`. Keep this in mind for further processing, especially if the model does not allow for `NA` values.
 #'
 #' These steps integrate with `recipes::recipe()` and work like standard preprocessing steps. They are useful for preparing data for modelling, especially with classification models.
-#' @seealso [recipes::recipe()], [as.sir()], [as.mic()], [as.disk()]
+#' @seealso [recipes::recipe()], [as.mic()], [as.sir()]
 #' @name amr-tidymodels
+#' @keywords internal
 #' @export
 #' @examples
 #' if (require("tidymodels")) {
+#'
 #'   # The below approach formed the basis for this paper: DOI 10.3389/fmicb.2025.1582703
 #'   # Presence of ESBL genes was predicted based on raw MIC values.
 #'
@@ -39,10 +39,13 @@
 #'
 #'   # Create and prep a recipe with MIC log2 transformation
 #'   mic_recipe <- recipe(esbl ~ ., data = training_data) %>%
+#'
 #'     # Optionally remove non-predictive variables
 #'     remove_role(genus, old_role = "predictor") %>%
+#'
 #'     # Apply the log2 transformation to all MIC predictors
 #'     step_mic_log2(all_mic_predictors()) %>%
+#'
 #'     # And apply the preparation steps
 #'     prep()
 #'
@@ -63,71 +66,48 @@
 #'     bind_cols(out_testing)
 #'
 #'   # Evaluate predictions using standard classification metrics
-#'   our_metrics <- metric_set(
-#'     accuracy,
-#'     recall,
-#'     precision,
-#'     sensitivity,
-#'     specificity,
-#'     ppv,
-#'     npv
-#'   )
+#'   our_metrics <- metric_set(accuracy, kap, ppv, npv)
 #'   metrics <- our_metrics(predictions, truth = esbl, estimate = .pred_class)
 #'
 #'   # Show performance
 #'   metrics
 #' }
-all_sir <- function() {
-  x <- tidymodels_amr_select(class = "sir")
-  names(x)
-}
-
-#' @rdname amr-tidymodels
-#' @export
-all_sir_predictors <- function() {
-  x <- tidymodels_amr_select(class = "sir")
-  intersect(x, recipes::has_role("predictor"))
-}
-
-#' @rdname amr-tidymodels
-#' @export
 all_mic <- function() {
-  x <- tidymodels_amr_select(class = "mic")
+  x <- tidymodels_amr_select(levels(NA_mic_))
   names(x)
 }
 
 #' @rdname amr-tidymodels
 #' @export
 all_mic_predictors <- function() {
-  x <- tidymodels_amr_select(class = "mic")
+  x <- tidymodels_amr_select(levels(NA_mic_))
   intersect(x, recipes::has_role("predictor"))
 }
 
 #' @rdname amr-tidymodels
 #' @export
-all_disk <- function() {
-  x <- tidymodels_amr_select(class = "disk")
+all_sir <- function() {
+  x <- tidymodels_amr_select(levels(NA_sir_))
   names(x)
 }
 
 #' @rdname amr-tidymodels
 #' @export
-all_disk_predictors <- function() {
-  x <- tidymodels_amr_select(class = "disk")
+all_sir_predictors <- function() {
+  x <- tidymodels_amr_select(levels(NA_sir_))
   intersect(x, recipes::has_role("predictor"))
 }
 
 #' @rdname amr-tidymodels
 #' @export
 step_mic_log2 <- function(
-  recipe,
-  ...,
-  role = NA,
-  trained = FALSE,
-  columns = NULL,
-  skip = FALSE,
-  id = recipes::rand_id("mic_log2")
-) {
+    recipe,
+    ...,
+    role = NA,
+    trained = FALSE,
+    columns = NULL,
+    skip = FALSE,
+    id = recipes::rand_id("mic_log2")) {
   recipes::add_step(
     recipe,
     step_mic_log2_new(
@@ -180,6 +160,7 @@ bake.step_mic_log2 <- function(object, new_data, ...) {
 print.step_mic_log2 <- function(x, width = max(20, options()$width - 35), ...) {
   title <- "Log2 transformation of MIC columns"
   recipes::print_step(x$columns, x$terms, x$trained, title, width)
+  invisible(x)
 }
 
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_mic_log2)
@@ -196,14 +177,13 @@ tidy.step_mic_log2 <- function(x, ...) {
 #' @rdname amr-tidymodels
 #' @export
 step_sir_numeric <- function(
-  recipe,
-  ...,
-  role = NA,
-  trained = FALSE,
-  columns = NULL,
-  skip = FALSE,
-  id = recipes::rand_id("sir_numeric")
-) {
+    recipe,
+    ...,
+    role = NA,
+    trained = FALSE,
+    columns = NULL,
+    skip = FALSE,
+    id = recipes::rand_id("sir_numeric")) {
   recipes::add_step(
     recipe,
     step_sir_numeric_new(
@@ -256,6 +236,7 @@ bake.step_sir_numeric <- function(object, new_data, ...) {
 print.step_sir_numeric <- function(x, width = max(20, options()$width - 35), ...) {
   title <- "Numeric transformation of SIR columns"
   recipes::print_step(x$columns, x$terms, x$trained, title, width)
+  invisible(x)
 }
 
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_sir_numeric)
@@ -269,13 +250,13 @@ tidy.step_sir_numeric <- function(x, ...) {
   res
 }
 
-tidymodels_amr_select <- function(class) {
+tidymodels_amr_select <- function(check_vector) {
   df <- get_current_data()
   ind <- which(
     vapply(
       FUN.VALUE = logical(1),
       df,
-      function(x) inherits(x, class),
+      function(x) all(x %in% c(check_vector, NA), na.rm = TRUE) & any(x %in% check_vector),
       USE.NAMES = TRUE
     ),
     useNames = TRUE

R/top_n_microorganisms.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -29,88 +29,73 @@
 
 #' Filter Top *n* Microorganisms
 #'
-#' Filters a data set to include only the top *n* microorganisms based on a specified property, such as taxonomic family or genus. For example, it can filter a data set to the top 3 species, to any species in the top 5 genera, or to the top 3 species in each of the top 5 genera.
+#' This function filters a data set to include only the top *n* microorganisms based on a specified property, such as taxonomic family or genus. For example, it can filter a data set to the top 3 species, or to any species in the top 5 genera, or to the top 3 species in each of the top 5 genera.
 #' @param x A data frame containing microbial data.
-#' @param n A positive whole number specifying the maximum number of unique values of `property` to include in the output.
-#' @param property A character string indicating the microorganism property to use for filtering. Must be one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. If `NULL`, the raw values from `col_mo` will be used without transformation. When using `"species"` (default) or `"subspecies"`, the genus is prepended to ensure each name is unambiguous.
-#' @param n_for_each An optional positive whole number specifying the maximum number of distinct microorganism groups at the level of `property_for_each` to retain within each of the top *n* groups. Only used when `property_for_each` is also set.
-#' @param property_for_each The microorganism property to use for sub-grouping within each top *n* group. Must be one of the column names of the [microorganisms] data set and at a strictly lower taxonomic rank than `property` (allowed order: domain > kingdom > phylum > class > order > family > genus > species > subspecies). Defaults to `"species"`. Only relevant when `n_for_each` is set.
+#' @param n An integer specifying the maximum number of unique values of the `property` to include in the output.
+#' @param property A character string indicating the microorganism property to use for filtering. Must be one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`. If `NULL`, the raw values from `col_mo` will be used without transformation. When using `"species"` (default) or `"subpecies"`, the genus will be added to make sure each (sub)species still belongs to the right genus.
+#' @param n_for_each An optional integer specifying the maximum number of rows to retain for each value of the selected property. If `NULL`, all rows within the top *n* groups will be included.
 #' @param col_mo A character string indicating the column in `x` that contains microorganism names or codes. Defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
 #' @param ... Additional arguments passed on to [mo_property()] when `property` is not `NULL`.
-#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data.
+#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data. For example, it can filter a data set to only include isolates from the top 10 species.
 #' @export
 #' @seealso [mo_property()], [as.mo()], [antibiogram()]
 #' @examples
 #' # filter to the top 3 species:
-#' top_n_microorganisms(example_isolates, n = 3)
+#' top_n_microorganisms(example_isolates,
+#'   n = 3
+#' )
 #'
 #' # filter to any species in the top 5 genera:
-#' top_n_microorganisms(example_isolates, n = 5, property = "genus")
+#' top_n_microorganisms(example_isolates,
+#'   n = 5, property = "genus"
+#' )
 #'
 #' # filter to the top 3 species in each of the top 5 genera:
 #' top_n_microorganisms(example_isolates,
 #'   n = 5, property = "genus", n_for_each = 3
 #' )
-#'
-#' # filter to the top 2 genera in each of the top 3 families:
-#' top_n_microorganisms(example_isolates,
-#'   n = 3, property = "family", n_for_each = 2, property_for_each = "genus"
-#' )
-top_n_microorganisms <- function(x, n, property = "species", n_for_each = NULL, property_for_each = "species", col_mo = NULL, ...) {
+top_n_microorganisms <- function(x, n, property = "species", n_for_each = NULL, col_mo = NULL, ...) {
   meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
   meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
-  meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms), allow_NULL = TRUE)
+  meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
   meet_criteria(n_for_each, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE, allow_NULL = TRUE)
-  meet_criteria(property_for_each, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms), allow_NULL = TRUE)
   meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
-
   if (is.null(col_mo)) {
     col_mo <- search_type_in_df(x = x, type = "mo", info = TRUE)
-    stop_if(is.null(col_mo), "{.arg col_mo} must be set")
-  }
-
-  .taxonomic_ranks <- c("domain", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies")
-  if (!is.null(n_for_each) && !is.null(property) && !is.null(property_for_each)) {
-    prop_rank <- match(property, .taxonomic_ranks)
-    each_rank <- match(property_for_each, .taxonomic_ranks)
-    if (!is.na(prop_rank) && !is.na(each_rank) && each_rank <= prop_rank) {
-      stop_(
-        "`property_for_each` (\"", property_for_each, "\") must be at a lower ",
-        "taxonomic rank than `property` (\"", property, "\")"
-      )
-    }
+    stop_if(is.null(col_mo), "`col_mo` must be set")
   }
 
   x.bak <- x
+
   x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE)
 
-  get_prop_val <- function(prop) {
-    if (is.null(prop)) {
-      x[[col_mo]]
-    } else if (prop == "species") {
-      paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...))
-    } else if (prop == "subspecies") {
-      paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...), mo_subspecies(x[[col_mo]], ...))
-    } else {
-      mo_property(x[[col_mo]], property = prop, ...)
-    }
+  if (is.null(property)) {
+    x$prop_val <- x[[col_mo]]
+  } else if (property == "species") {
+    x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...))
+  } else if (property == "subspecies") {
+    x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...), mo_subspecies(x[[col_mo]], ...))
+  } else {
+    x$prop_val <- mo_property(x[[col_mo]], property = property, ...)
   }
-
-  x$prop_val <- get_prop_val(property)
   counts <- sort(table(x$prop_val), decreasing = TRUE)
-  n <- min(as.integer(n), length(counts))
-  filtered_rows <- which(x$prop_val %in% names(counts)[seq_len(n)])
+
+  n <- as.integer(n)
+  if (length(counts) < n) {
+    n <- length(counts)
+  }
+  count_values <- names(counts)[seq_len(n)]
+  filtered_rows <- which(x$prop_val %in% count_values)
 
   if (!is.null(n_for_each)) {
     n_for_each <- as.integer(n_for_each)
-    x$prop_val_each <- get_prop_val(property_for_each)
     filtered_x <- x[filtered_rows, , drop = FALSE]
-    filtered_x$.orig_row <- filtered_rows
     filtered_rows <- do.call(
       c,
       lapply(split(filtered_x, filtered_x$prop_val), function(group) {
-        top_each <- names(sort(table(group$prop_val_each), decreasing = TRUE)[seq_len(n_for_each)])
-        group$.orig_row[group$prop_val_each %in% top_each[!is.na(top_each)]]
+        top_values <- names(sort(table(group[[col_mo]]), decreasing = TRUE)[seq_len(n_for_each)])
+        top_values <- top_values[!is.na(top_values)]
+        which(x[[col_mo]] %in% top_values)
       })
     )
   }

R/translate.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -49,16 +49,14 @@
 #' Please read about adding or updating a language in [our Wiki](https://github.com/msberends/AMR/wiki/).
 #'
 #' ### Changing the Default Language
-#' The system language will be used at default, if that language is supported. The language to be used is determined in this order:
+#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [`Sys.getlocale("LC_COLLATE")`][Sys.getlocale()]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
 #'
-#'   1. The package option [`AMR_locale`][AMR-options], set by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
+#'   1. Setting the package option [`AMR_locale`][AMR-options], either by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
 #'
 #'      Note that setting an \R option only works in the same session. Save the command `options(AMR_locale = "(your language)")` to your `.Rprofile` file to apply it for every session. Run `utils::file.edit("~/.Rprofile")` to edit your `.Rprofile` file.
-#'   2. The system variable `LANG`, as returned by `Sys.getenv("LANG")`, e.g. set by adding `LANG="de_DE.utf8"` to your `.Renviron` file in your home directory.
-#'   3. The system variable `LANGUAGE`, but only if `LANG` is not set. Note that `LANG` is set on most Linux and macOS systems, in which case `LANGUAGE` has no effect.
-#'   4. The system locale, as returned by [`Sys.getlocale("LC_COLLATE")`][Sys.getlocale()], if neither `LANG` nor `LANGUAGE` is set.
+#'   2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory.
 #'
-#' Thus, if the package option [`AMR_locale`][AMR-options] is set, the system variables `LANG` and `LANGUAGE` will be ignored.
+#' Thus, if the package option [`AMR_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
 #' @rdname translate
 #' @name translate
 #' @export
@@ -92,7 +90,7 @@ get_AMR_locale <- function() {
     return(validate_language(getOption("AMR_locale"), extra_txt = "set with `options(AMR_locale = ...)`"))
   }
   lang <- ""
-  # now check the system variables, of which LANG takes precedence over LANGUAGE
+  # now check the LANGUAGE system variable - return it if set
   if (!identical("", Sys.getenv("LANGUAGE"))) {
     lang <- Sys.getenv("LANGUAGE")
   }
@@ -202,86 +200,29 @@ translate_into_language <- function(from,
     return(from)
   }
 
-  trns <- get_translation_table(lang, only_unknown = only_unknown, only_affect_ab_names = only_affect_ab_names, only_affect_mo_names = only_affect_mo_names)
-  if (is.null(trns)) {
-    return(from)
-  }
+  df_trans <- TRANSLATIONS # internal data file
   from.bak <- from
   from_unique <- unique(from)
-
-  # check if text to look for is in one of the patterns
-  any_form_in_patterns <- tryCatch(
-    # the same as `from_unique %like% trns$any_pattern`, but without validating the long pattern on every call
-    any(grepl(trns$any_pattern, tolower(from_unique), fixed = trns$any_pattern_fixed, perl = !trns$any_pattern_fixed)),
-    error = function(e) {
-      warning_("Translation not possible. Please create an issue at {.url https://github.com/msberends/AMR/issues}. Many thanks!")
-      return(FALSE)
-    }
-  )
-  if (!any_form_in_patterns) {
-    return(from)
+  from_split_combined <- function(vec) {
+    sapply(vec, function(x) {
+      if (grepl("/", x, fixed = TRUE)) {
+        parts <- strsplit(x, "/", fixed = TRUE)[[1]]
+        # Translate each part separately
+        translated_parts <- translate_into_language(
+          parts,
+          language = lang,
+          only_unknown = only_unknown,
+          only_affect_ab_names = only_affect_ab_names,
+          only_affect_mo_names = only_affect_mo_names
+        )
+        paste(translated_parts, collapse = "/")
+      } else {
+        x
+      }
+    }, USE.NAMES = FALSE)
   }
+  from_unique_translated <- from_split_combined(from_unique)
 
-  from_unique_translated <- from_unique
-  # combinations like "Ticarcillin/clavulanic acid" are translated per part, unless the combination itself is in the translations
-  is_combination <- grepl("/", from_unique, fixed = TRUE) & !from_unique %in% trns$pattern_all
-  if (any(is_combination)) {
-    # all parts of all combinations are translated at once
-    parts <- strsplit(from_unique[is_combination], "/", fixed = TRUE)
-    parts_translated <- translate_into_language(unlist(parts, use.names = FALSE), language = lang, only_unknown = only_unknown, only_affect_ab_names = only_affect_ab_names, only_affect_mo_names = only_affect_mo_names)
-    parts_translated <- split(parts_translated, factor(rep(seq_along(parts), lengths(parts)), levels = seq_along(parts)))
-    from_unique_translated[is_combination] <- vapply(FUN.VALUE = character(1), parts_translated, paste, collapse = "/", USE.NAMES = FALSE)
-  }
-  if (any(!is_combination)) {
-    # every pattern is applied to all strings at once, in order of the translation table
-    terms <- from_unique[!is_combination]
-    for (i in seq_along(trns$pattern)) {
-      terms <- gsub(
-        pattern = trns$pattern[i],
-        replacement = trns$replacement[i],
-        x = terms,
-        ignore.case = trns$ignore_case[i],
-        fixed = trns$fixed[i],
-        perl = !trns$fixed[i]
-      )
-    }
-    # replace the placeholders by their translations
-    has_placeholder <- grepl("\001", terms, fixed = TRUE)
-    if (any(has_placeholder)) {
-      found <- gregexpr("\001[^\001\002]{3}\002", terms[has_placeholder], perl = TRUE)
-      regmatches(terms[has_placeholder], found) <- lapply(regmatches(terms[has_placeholder], found), function(p) trns$literal[match(p, trns$placeholder)])
-    }
-    from_unique_translated[!is_combination] <- terms
-  }
-
-  # force UTF-8 for diacritics
-  from_unique_translated <- enc2utf8(from_unique_translated)
-
-  # a kind of left join to get all results back
-  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(
-      "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
-    )))
-  }
-
-  out
-}
-
-# the translation table for a language and the settings of translate_into_language(), built once per session as TRANSLATIONS is fixed
-get_translation_table <- function(lang, only_unknown = FALSE, only_affect_ab_names = FALSE, only_affect_mo_names = FALSE) {
-  key <- paste(lang, only_unknown, only_affect_ab_names, only_affect_mo_names, sep = "|")
-  if (!key %in% names(AMR_env$translation_tables)) {
-    AMR_env$translation_tables[key] <- list(build_translation_table(lang, only_unknown, only_affect_ab_names, only_affect_mo_names))
-  }
-  AMR_env$translation_tables[[key]]
-}
-
-build_translation_table <- function(lang, only_unknown, only_affect_ab_names, only_affect_mo_names) {
-  df_trans <- TRANSLATIONS # internal data file
   # only keep lines where translation is available for this language
   df_trans <- df_trans[which(!is.na(df_trans[, lang, drop = TRUE])), , drop = FALSE]
   # and where the original string is not equal to the string in the target language
@@ -296,7 +237,7 @@ build_translation_table <- function(lang, only_unknown, only_affect_ab_names, on
     df_trans <- subset(df_trans, affect_mo_name == TRUE)
   }
   if (NROW(df_trans) == 0) {
-    return(NULL)
+    return(from)
   }
 
   # default: case sensitive if value if 'case_sensitive' is missing:
@@ -304,38 +245,52 @@ build_translation_table <- function(lang, only_unknown, only_affect_ab_names, on
   # default: not using regular expressions if 'regular_expr' is missing:
   df_trans$regular_expr[is.na(df_trans$regular_expr)] <- FALSE
 
-  # to check if text to look for is in one of the patterns
-  any_pattern <- paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")
+  # check if text to look for is in one of the patterns
+  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 ", font_url("https://github.com/msberends/AMR/issues"), ". Many thanks!")
+      return(FALSE)
+    }
+  )
+
+  if (NROW(df_trans) == 0 | !any_form_in_patterns) {
+    return(from)
+  }
 
   if (only_affect_ab_names == TRUE) {
     df_trans$pattern[df_trans$regular_expr == TRUE] <- paste0(df_trans$pattern[df_trans$regular_expr == TRUE], "$")
     df_trans$pattern[df_trans$regular_expr == TRUE] <- gsub("$$", "$", df_trans$pattern[df_trans$regular_expr == TRUE], fixed = TRUE)
   }
 
-  # sort trans file on length of pattern, so that the longest pattern is replaced first (word boundaries of regular expressions do not count)
-  trns <- df_trans[order(nchar(gsub("\\b", "", df_trans$pattern, fixed = TRUE)), decreasing = TRUE), , drop = FALSE]
-  # every translation is first replaced by a placeholder, so that a translation is never translated again, e.g. "Ticarcillin" to "Ticarcilline" and then to "Ticarcillinee"
-  # placeholders consist of ASCII control characters only, so that no pattern can match them
-  control_chars <- vapply(FUN.VALUE = character(1), 3:31, function(i) rawToChar(as.raw(i)))
-  placeholders <- paste0("\001", control_chars[(seq_len(nrow(trns)) - 1) %/% length(control_chars) %/% length(control_chars) + 1], control_chars[(seq_len(nrow(trns)) - 1) %/% length(control_chars) %% length(control_chars) + 1], control_chars[(seq_len(nrow(trns)) - 1) %% length(control_chars) + 1], "\002")
-  replacements <- trns[, lang, drop = TRUE]
-  # keep backreferences like "\\1" of regular expressions outside the placeholder
-  literals <- gsub("\\\\[0-9]", "", replacements)
-  replacements_placeholder <- ifelse(
-    literals == "",
-    replacements,
-    vapply(FUN.VALUE = character(1), seq_along(replacements), function(i) sub(literals[i], placeholders[i], replacements[i], fixed = TRUE))
-  )
-  list(
-    # all patterns, including combinations, to check whether a combination is translated as a whole
-    pattern_all = df_trans$pattern,
-    any_pattern = tolower(any_pattern),
-    any_pattern_fixed = !is_valid_regex(any_pattern),
-    pattern = trns$pattern,
-    replacement = replacements_placeholder,
-    ignore_case = !trns$case_sensitive & trns$regular_expr,
-    fixed = !trns$regular_expr,
-    placeholder = placeholders,
-    literal = literals
+  lapply(
+    # starting with longest pattern, since more general translations are shorter, such as 'Group'
+    order(nchar(df_trans$pattern), decreasing = TRUE),
+    function(i) {
+      from_unique_translated <<- gsub(
+        pattern = df_trans$pattern[i],
+        replacement = df_trans[i, lang, drop = TRUE],
+        x = from_unique_translated,
+        ignore.case = !df_trans$case_sensitive[i] & df_trans$regular_expr[i],
+        fixed = !df_trans$regular_expr[i],
+        perl = df_trans$regular_expr[i]
+      )
+    }
   )
+
+  # force UTF-8 for diacritics
+  from_unique_translated <- enc2utf8(from_unique_translated)
+
+  # a kind of left join to get all results back
+  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(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.",
+      add_fn = list(font_blue), as_note = TRUE
+    ))
+  }
+
+  out
 }

R/vctrs.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -91,9 +91,7 @@
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.sir)
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.sir)
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.sir)
-#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.sir)
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.character)
-#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.factor)
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.sir)
 
 # S3: amr_selector ----
@@ -160,7 +158,7 @@ vec_cast.character.mo <- function(x, to, ...) {
 }
 vec_cast.mo.character <- function(x, to, ...) {
   add_MO_lookup_to_AMR_env()
-  return_after_mo_integrity_check(x)
+  return_after_integrity_check(x, "microorganism code", as.character(AMR_env$MO_lookup$mo))
 }
 
 # S3: disk ----
@@ -259,12 +257,6 @@ vec_cast.sir.sir <- function(x, to, ...) {
 vec_cast.character.sir <- function(x, to, ...) {
   as.character(x)
 }
-vec_cast.factor.sir <- function(x, to, ...) {
-  factor(as.sir(x))
-}
 vec_cast.sir.character <- function(x, to, ...) {
   as.sir(x)
 }
-vec_cast.sir.factor <- function(x, to, ...) {
-  as.sir(x)
-}

R/whocc.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -31,7 +31,7 @@
 #'
 #' All antimicrobial drugs and their official names, ATC codes, ATC groups and defined daily dose (DDD) are included in this package, using the WHO Collaborating Centre for Drug Statistics Methodology.
 #' @section WHOCC:
-#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/index_en.htm>).
+#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>).
 #'
 #' These have become the gold standard for international drug utilisation monitoring and research.
 #'

R/zz_deprecated.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -27,7 +27,7 @@
 # how to conduct AMR data analysis: https://amr-for-r.org              #
 # ==================================================================== #
 
-#' Deprecated Functions, Arguments, or Data Sets
+#' Deprecated Functions, Arguments, or Datasets
 #'
 #' These objects are so-called '[Deprecated]'. **They will be removed in a future version of this package.** Using these will give a warning with the name of the alternative object it has been replaced by (if there is one).
 #' @keywords internal
@@ -69,14 +69,6 @@ as.data.frame.deprecated_amr_dataset <- function(x, ...) {
 # currently deprecated arguments at least:
 # - `antibiotics` in `antibiogram()`
 # - `converse_capped_values` in `as.sir()`
-# - `combine_SI` in `count_df()`, `proportion_df()`, `sir_df()`, `ggplot_sir()`, `geom_sir()`, `labels_sir_count()`, `antibiogram()`, `wisca()`, and `format()` for `bug_drug_combinations()`
-
-#' @rdname AMR-deprecated
-#' @export
-custom_eucast_rules <- function(...) {
-  deprecation_warning("custom_eucast_rules", "custom_interpretive_rules", is_function = TRUE)
-  custom_interpretive_rules(...)
-}
 
 #' @rdname AMR-deprecated
 #' @export
@@ -132,7 +124,7 @@ deprecation_warning <- function(old = NULL, new = NULL, fn = NULL, extra_msg = N
           ". The old name will be removed in future version, so please update your code.",
           ifelse(type == "argument",
             ". While the old argument still works, it will be removed in a future version, so please update your code.",
-            " and will be removed in a future version, see {.topic [AMR-deprecated](AMR::AMR-deprecated)}."
+            " and will be removed in a future version, see `?AMR-deprecated`."
           )
         ),
         ifelse(!is.null(extra_msg),

R/zzz.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -40,9 +40,16 @@ AMR_env$mo_uncertainties <- data.frame(
   stringsAsFactors = FALSE
 )
 AMR_env$mo_renamed <- list()
-# session caches of as.ab() and as.mo(), see R/aa_session_cache.R
-AMR_env$mo_previously_coerced <- new_coercion_cache()
-AMR_env$ab_previously_coerced <- new_coercion_cache()
+AMR_env$mo_previously_coerced <- data.frame(
+  x = character(0),
+  mo = character(0),
+  stringsAsFactors = FALSE
+)
+AMR_env$ab_previously_coerced <- data.frame(
+  x = character(0),
+  ab = character(0),
+  stringsAsFactors = FALSE
+)
 AMR_env$av_previously_coerced <- data.frame(
   x = character(0),
   av = character(0),
@@ -72,22 +79,21 @@ AMR_env$sir_interpretation_history <- data.frame(
 
 
 AMR_env$custom_ab_codes <- character(0)
-AMR_env$custom_ab_synonyms <- data.frame(ab = character(0), synonym = character(0), key = character(0), stringsAsFactors = FALSE)
 AMR_env$custom_mo_codes <- character(0)
 AMR_env$is_dark_theme <- NULL
 AMR_env$supports_colour <- NULL
+AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
+AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
+
+# take cli symbols and error function if available
+AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
+AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
+AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
+AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
+AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
+AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
 
 .onLoad <- function(libname, pkgname) {
-  # functions and symbols from suggested packages must be retrieved here, at runtime: code outside functions runs at installation, so it would store what was available on the machine that built the package (e.g., CRAN), which fails if these packages are not available to the user
-  AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
-  AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
-  # take cli symbols and error function if available
-  AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %||% "*"
-  AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %||% "..."
-  AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %||% "i"
-  AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %||% "*"
-  AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
-
   # if mo source exists, fire it up (see mo_source())
   if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
     try(invisible(get_mo_source()), silent = TRUE)
@@ -105,46 +111,39 @@ AMR_env$supports_colour <- NULL
   }
 
   AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP)
-  reset_ab_cache()
   AMR_env$AV_lookup <- cbind(AMR::antivirals, AV_LOOKUP)
 }
 
 .onAttach <- function(libname, pkgname) {
-  if (interactive() && is.null(getOption("AMR_guideline"))) {
-    packageStartupMessage(format_inline_(
-      "Assuming ", AMR::clinical_breakpoints$guideline[1], " as the default AMR guideline, see {.topic [AMR-options](AMR::AMR-options)} to change this."
-    ))
-  }
-
   # if custom ab option is available, load it
   if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
     if (getOption("AMR_custom_ab") %unlike% "[.]rds$") {
-      packageStartupMessage(format_inline_("The file with custom antimicrobials must be an RDS file. Set the option {.code AMR_custom_ab} to another path."))
+      packageStartupMessage("The file with custom antimicrobials must be an RDS file. Set the option `AMR_custom_ab` to another path.")
     } else {
-      packageStartupMessage(format_inline_("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'..."), appendLF = FALSE)
+      packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
       x <- readRDS_AMR(getOption("AMR_custom_ab"))
       tryCatch(
         {
           suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
           packageStartupMessage("OK.")
         },
-        error = function(e) packageStartupMessage(format_inline_("Failed: ", conditionMessage(e)))
+        error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
       )
     }
   }
   # if custom mo option is available, load it
   if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
     if (getOption("AMR_custom_mo") %unlike% "[.]rds$") {
-      packageStartupMessage(format_inline_("The file with custom microorganisms must be an RDS file. Set the option {.code AMR_custom_mo} to another path."))
+      packageStartupMessage("The file with custom microorganisms must be an RDS file. Set the option `AMR_custom_mo` to another path.")
     } else {
-      packageStartupMessage(format_inline_("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'..."), appendLF = FALSE)
+      packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
       x <- readRDS_AMR(getOption("AMR_custom_mo"))
       tryCatch(
         {
           suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
           packageStartupMessage("OK.")
         },
-        error = function(e) packageStartupMessage(format_inline_("Failed: ", conditionMessage(e)))
+        error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
       )
     }
   }

README.Rmd

@@ -11,7 +11,6 @@ knitr::opts_chunk$set(
   # fig.path = "man/figures/README-",
   out.width = "100%"
 )
-options(width = 100)
 AMR:::reset_all_thrown_messages()
 ```
 
@@ -22,8 +21,8 @@ Please visit our comprehensive package website <https://amr-for-r.org> to read m
 Overview:
 
 * Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach
-* **Peer-reviewed**, used in over 175 countries, cited over 100 times, available in `r length(AMR:::LANGUAGES_SUPPORTED)` languages
-* Generates **antibiograms** - WISCA for empiric coverage estimates, or traditional/syndromic for AMR surveillance
+* Peer-reviewed, used in over 175 countries, available in `r length(AMR:::LANGUAGES_SUPPORTED)` languages
+* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA
 * Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs
 * Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation
 * Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class
@@ -32,9 +31,7 @@ Overview:
 
 ----
 
-The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods.
-
-**Our aim has always been to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
+The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
 
 The `AMR` package supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
 
@@ -52,11 +49,8 @@ To install the latest 'beta' version:
 
 ```{r, eval = FALSE}
 install.packages("AMR", repos = "beta.amr-for-r.org")
-```
 
-If this does not work, try to install directly from GitHub using the `remotes` package:
-
-```{r, eval = FALSE}
+# if this does not work, try to install directly from GitHub using the 'remotes' package:
 remotes::install_github("msberends/AMR")
 ```
 

README.md

@@ -10,13 +10,12 @@ Overview:
 
 - Provides an **all-in-one solution** for antimicrobial resistance (AMR)
   data analysis in a One Health approach
-- **Peer-reviewed**, used in over 175 countries, cited over 100 times,
-  available in 28 languages
-- Generates **antibiograms** - WISCA for empiric coverage estimates, or
-  traditional/syndromic for AMR surveillance
-- Provides the **full microbiological taxonomy** of ~103 000 distinct
-  species and extensive info of ~640 antimicrobial drugs
-- Applies **CLSI 2011-2026** and **EUCAST 2011-2026** clinical and
+- Peer-reviewed, used in over 175 countries, available in 28 languages
+- Generates **antibiograms** - traditional, combined, syndromic, and
+  even WISCA
+- Provides the **full microbiological taxonomy** of ~79 000 distinct
+  species and extensive info of ~620 antimicrobial drugs
+- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and
   veterinary breakpoints, and ECOFFs, for MIC and disk zone
   interpretation
 - Corrects for duplicate isolates, **calculates** and **predicts** AMR
@@ -32,11 +31,10 @@ The `AMR` package is a peer-reviewed, free and open-source R package
 with zero dependencies to simplify the analysis and prediction of
 Antimicrobial Resistance (AMR) and to work with microbial and
 antimicrobial data and properties, by using evidence-based methods.
-
-**Our aim has always been to provide a standard** for clean and
-reproducible AMR data analysis, that can therefore empower
-epidemiological analyses to continuously enable surveillance and
-treatment evaluation in any setting.
+**Our aim is to provide a standard** for clean and reproducible AMR data
+analysis, that can therefore empower epidemiological analyses to
+continuously enable surveillance and treatment evaluation in any
+setting.
 
 The `AMR` package supports and can read any data format, including
 WHONET data. This package works on Windows, macOS and Linux with all
@@ -60,12 +58,8 @@ To install the latest ‘beta’ version:
 
 ``` r
 install.packages("AMR", repos = "beta.amr-for-r.org")
-```
 
-If this does not work, try to install directly from GitHub using the
-`remotes` package:
-
-``` r
+# if this does not work, try to install directly from GitHub using the 'remotes' package:
 remotes::install_github("msberends/AMR")
 ```
 

_pkgdown.yml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -38,8 +38,6 @@ template:
       <script defer src="https://cdn.jsdelivr.net/npm/katex@0.16.11/dist/katex.min.js" integrity="sha384-7zkQWkzuo3B5mTepMUcHkMB5jZaolc2xDwL6VFqjFALcbeS9Ggm/Yr2r3Dy4lfFg" crossorigin="anonymous"></script>
       <script defer src="https://cdn.jsdelivr.net/npm/katex@0.16.11/dist/contrib/auto-render.min.js" integrity="sha384-43gviWU0YVjaDtb/GhzOouOXtZMP/7XUzwPTstBeZFe/+rCMvRwr4yROQP43s0Xk" crossorigin="anonymous" onload="renderMathInElement(document.body);"></script>
   bootswatch: "flatly"
-  # dark mode: the CSS in pkgdown/extra.css is prepared for it, but light mode is enforced for now
-  light-switch: false
   bslib:
     base_font: {google: "Lato"}
     heading_font: {google: "Lato"}
@@ -58,7 +56,7 @@ footer:
     left: [devtext]
     right: [logo]
   components:
-    devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU GPL 2.0</a>. Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in the Netherlands, in collaboration with <a href="https://amr-for-r.org/authors.html">many colleagues from around the world</a>.'
+    devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU General Public License version 2.0 (GPL-2)</a>.<br>Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in The Netherlands.'
     logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://amr-for-r.org/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://amr-for-r.org/logo_umcg.svg" style="max-width: 150px;"></a>'
 
 home:
@@ -129,136 +127,152 @@ navbar:
       href: "https://github.com/msberends/AMR"
 
 reference:
-  - title: "Getting started"
+  - title: "Introduction to the package"
     desc: >
-      An overview of the package, its options for users and teams, and its 28 supported languages.
+      Please find the introduction to (and some general information about) our package here.
     contents:
     - "`AMR`"
-    - "`AMR-options`"
-    - "`translate`"
-    - "`amr_course`"
-
-  - title: "Cleaning data"
+    
+  - title: "Preparing data: microorganisms"
     desc: >
-      Transform raw input of any kind into valid microorganisms with `as.mo()`, antimicrobials with `as.ab()`, and MIC values and disk diffusion zones with `as.mic()` and `as.disk()`, and retrieve their properties.
-  - subtitle: "Microorganisms"
+      These functions are meant to get taxonomically valid properties of microorganisms from any input, but
+      also properties derived from taxonomy, such as the Gram stain (`mo_gramstain()`) , or `mo_is_yeast()`.
+      Use `mo_source()` to teach this package how to translate your own codes to valid microorganisms, and
+      use `add_custom_microorganisms()` to add your own custom microorganisms to this package.
     contents:
     - "`as.mo`"
     - "`mo_property`"
-    - "`mo_source`"
     - "`add_custom_microorganisms`"
-    - "`mo_matching_score`"
-  - subtitle: "Antimicrobials"
+    - "`mo_source`"
+
+  - title: "Preparing data: antimicrobials"
+    desc: >
+      Use these functions to get valid properties of antimicrobials from any input or to clean your input.
+      You can even retrieve drug names and doses from clinical text records, using `ab_from_text()`.
     contents:
     - "`as.ab`"
     - "`ab_property`"
     - "`ab_from_text`"
-    - "`add_custom_antimicrobials`"
     - "`atc_online_property`"
-  - subtitle: "Antivirals"
-    contents:
-    - "`as.av`"
-    - "`av_property`"
-    - "`av_from_text`"
-  - subtitle: "Test results"
-    contents:
-    - "`as.mic`"
-    - "`as.disk`"
+    - "`add_custom_antimicrobials`"
 
-  - title: "Interpreting results as SIR"
+  - title: "Preparing data: antimicrobial results"
     desc: >
-      Interpret MIC values and disk diffusion zones as SIR with `as.sir()`, according to EUCAST or CLSI, for every guideline year from 2011 to 2026, and apply interpretive rules. `as.sir()` also cleans existing SIR data.
+      With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values.
+      Use `as.sir()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as SIR based on the lastest EUCAST and CLSI guidelines.
+      Afterwards, you can extend antibiotic interpretations by applying [EUCAST rules](https://www.eucast.org/expert_rules_and_intrinsic_resistance/) with `eucast_rules()`.
     contents:
     - "`as.sir`"
-    - "`interpretive_rules`"
-    - "`custom_interpretive_rules`"
+    - "`as.mic`"
+    - "`as.disk`"
+    - "`eucast_rules`"
+    - "`custom_eucast_rules`"
 
   - title: "Analysing data"
     desc: >
-      Select first isolates with `first_isolate()`, generate traditional, combination, syndromic, and WISCA antibiograms with `antibiogram()` and `wisca()`, calculate resistance, and determine multidrug-resistant organisms.
-  - subtitle: "Selecting isolates and antimicrobials"
-    contents:
-    - "`first_isolate`"
-    - "`get_episode`"
-    - "`key_antimicrobials`"
-    - "`top_n_microorganisms`"
-    - "`antimicrobial_selectors`"
-    - "`guess_ab_col`"
-    - "`availability`"
-  - subtitle: "Generating antibiograms and WISCA"
+      Use these function for the analysis part. You can use `susceptibility()` or `resistance()` on any antibiotic column.
+      With `antibiogram()`, you can generate a traditional, combined, syndromic, or weighted-incidence syndromic combination
+      antibiogram (WISCA). This function also comes with support for R Markdown and Quarto.
+      Be sure to first select the isolates that are appropiate for analysis, by using `first_isolate()` or `is_new_episode()`.
+      You can also filter your data on certain resistance in certain antibiotic classes (`carbapenems()`, `aminoglycosides()`),
+      or determine multi-drug resistant microorganisms (MDRO, `mdro()`).
     contents:
     - "`antibiogram`"
-  - subtitle: "Calculating resistance and susceptibility"
-    contents:
     - "`proportion`"
     - "`count`"
-    - "`sir_combine`"
-    - "`bug_drug_combinations`"
-  - subtitle: "Determining multidrug resistance"
-    contents:
+    - "`is_new_episode`"
+    - "`first_isolate`"
+    - "`key_antimicrobials`"
     - "`mdro`"
     - "`custom_mdro_guideline`"
-
-  - title: "Visualising data"
+    - "`bug_drug_combinations`"
+    - "`antimicrobial_selectors`"
+    - "`top_n_microorganisms`"
+    - "`mean_amr_distance`"
+    - "`resistance_predict`"
+    - "`guess_ab_col`"
+    
+  - title: "Plotting data"
     desc: >
-      Plot MIC values, disk zones, and SIR results in base R or `ggplot2`, with scales and colours tailored to AMR data, and taxonomic names in italics.
+      Use these functions for the plotting part. The `scale_*_mic()` functions extend the ggplot2 package to allow plotting of 
+      MIC values, even within a manually set range.
+      If using `plot()` (base R) or `autoplot()` (ggplot2) on MIC values or disk diffusion values, the user can
+      set the interpretation guideline to give the bars the right SIR colours.
+      The `ggplot_sir()` function is a short wrapper for users not much accustomed to ggplot2 yet.
+      The `ggplot_pca()` function is a specific function to plot so-called biplots for PCA (principal component analysis).
     contents:
     - "`plot`"
     - "`ggplot_sir`"
     - "`ggplot_pca`"
-
-  - title: "Modelling"
+    
+  - title: "AMR-specific options"
     desc: >
-      Use AMR data types in `tidymodels` pipelines, and perform principal component analysis or distance calculations on resistance profiles.
+      The AMR package is customisable, by providing settings that can be set per user or per team. For
+      example, the default interpretation guideline can be changed from EUCAST to CLSI, or a supported
+      language can be set for the whole team (system-language independent) for antibiotic names in a
+      foreign language.
     contents:
-    - "`amr-tidymodels`"
-    - "`pca`"
-    - "`mean_amr_distance`"
-
-  - title: "Reference data"
+    - "`AMR-options`"
+    
+  - title: "Other: antiviral drugs"
     desc: >
-      The data sets underlying this package, all of which can also be [downloaded in other formats](../articles/datasets.html).
-  - subtitle: "Microorganisms"
+      This package also provides extensive support for antiviral agents, even though it is not the primary
+      scope of this package. Working with data containing information about antiviral drugs was never easier.
+      Use these functions to get valid properties of antiviral drugs from any input or to clean your input.
+      You can even retrieve drug names and doses from clinical text records, using `av_from_text()`.
+    contents:
+    - "`as.av`"
+    - "`av_property`"
+    - "`av_from_text`"
+
+  - title: "Other: background information on included data"
+    desc: >
+      Some pages about our package and its external sources. Be sure to read our [How To's](./../articles/index.html)
+      for more information about how to work with functions in this package.
     contents:
     - "`microorganisms`"
+    - "`antimicrobials`"
+    - "`clinical_breakpoints`"
+    - "`example_isolates`"
+    - "`esbl_isolates`"
     - "`microorganisms.codes`"
     - "`microorganisms.groups`"
-  - subtitle: "Antimicrobials"
-    contents:
-    - "`antimicrobials`"
-    - "`WHOCC`"
-    - "`dosage`"
-  - subtitle: "Breakpoints and intrinsic resistance"
-    contents:
-    - "`clinical_breakpoints`"
     - "`intrinsic_resistant`"
-  - subtitle: "Example data"
-    contents:
-    - "`example_isolates`"
+    - "`dosage`"
+    - "`WHOCC`"
     - "`example_isolates_unclean`"
-    - "`esbl_isolates`"
     - "`WHONET`"
 
-  - title: "Utilities"
+  - title: "Other: miscellaneous functions"
     desc: >
-      Helper functions for pattern matching with `%like%`, ages, joining and italicising taxonomy, generating random test results, and data export.
+      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:
-    - "`like`"
-    - "`age`"
     - "`age_groups`"
-    - "`join`"
-    - "`italicise_taxonomy`"
-    - "`random`"
+    - "`age`"
     - "`export_ncbi_biosample`"
-  - subtitle: "Statistical tests"
+    - "`availability`"
+    - "`get_AMR_locale`"
+    - "`italicise_taxonomy`"
+    - "`join`"
+    - "`like`"
+    - "`mo_matching_score`"
+    - "`pca`"
+    - "`random`"
+
+  - title: "Other: statistical tests"
+    desc: >
+      Some statistical tests or methods are not part of base R and were added to this package for convenience.
     contents:
     - "`g.test`"
     - "`kurtosis`"
     - "`skewness`"
 
-  - title: "Deprecated functions"
+  - title: "Other: deprecated functions/arguments/datasets"
     desc: >
-      These still work, but show a warning and will be removed in a future version.
+      These objects are deprecated, meaning that they will still
+      work but show a warning that they will be removed
+      in a future version.
     contents:
     - "`AMR-deprecated`"
-    - "`resistance_predict`"

codecov.yml

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

cran-comments.md

@@ -1,8 +1,4 @@
-This version is a minor release (v3.1.0) following the bugfix release v3.0.1 in September 2025.The many improvements and bug fixes are in `NEWS.md`.
-
-This package has two reverse dependencies, `MIC` and `MIMER`, both checked against this version. `MIMER` passes. `MIC` is affected by a change in the output of `AMR::as.sir()` for interpretation based on epidemiological cut-off values (ECOFFs), which makes some of its unit tests fail; its maintainer has been informed [in advance through this issue](https://github.com/agerada/MIC/issues/15) in their GitHub repository.
-
-As with all previous >20 releases, some CHECKs may return an `INFO` for narrowly exceeding the installation size limit. The size has been reduced to a minimum in prior coordination with CRAN maintainers.
+As with all previous >20 releases, some CHECKs on `oldrel` may return a `NOTE` for narrowly exceeding the installation size limit. This has been reduced to a minimum in prior coordination with CRAN maintainers and currently returns only an `INFO` on `release` and `devel`.
 
 We treat this as a high-impact package: it was published in the *Journal of Statistical Software* (2022), is listed in the CRAN Task View "Epidemiology", and (based on cranlogs download statistics) is used globally. If there is anything to address, we would appreciate being informed before archiving the current version. We conduct extensive automated unit testing and have no indication of unresolved issues.
 

data-raw/AMR_vet.qmd

@@ -15,10 +15,8 @@ library(readr)
 library(tidyr)
 
 # WHONET version of 16th Feb 2024
-whonet_breakpoints <- read_tsv("WHONET/Resources/Breakpoints.txt",
-  na = c("", "NA", "-"),
-  show_col_types = FALSE, guess_max = Inf
-) %>%
+whonet_breakpoints <- read_tsv("WHONET/Resources/Breakpoints.txt", na = c("", "NA", "-"),
+                               show_col_types = FALSE, guess_max = Inf) %>%
   filter(GUIDELINES %in% c("CLSI", "EUCAST"))
 
 dim(whonet_breakpoints)
@@ -50,9 +48,9 @@ whonet_breakpoints |>
 
 ```{r}
 whonet_breakpoints |>
-  filter(HOST == "Cats", YEAR >= 2021) |>
-  select(GUIDELINES, YEAR, TEST_METHOD, ORGANISM_CODE, R, S) |>
-  mutate(MO_NAME = AMR::mo_shortname(ORGANISM_CODE), .before = R) |>
+  filter(HOST == "Cats", YEAR >= 2021) |> 
+  select(GUIDELINES, YEAR, TEST_METHOD, ORGANISM_CODE, R, S) |> 
+  mutate(MO_NAME = AMR::mo_shortname(ORGANISM_CODE), .before = R) |> 
   as.data.frame()
 ```
 
@@ -60,14 +58,12 @@ whonet_breakpoints |>
 
 ```{r}
 whonet_breakpoints |>
-  filter(HOST == "Cats", YEAR == 2023) |>
-  mutate(
-    MO = AMR::mo_shortname(ORGANISM_CODE),
-    AB = AMR::ab_name(WHONET_ABX_CODE),
-    SITE_OF_INFECTION = substr(SITE_OF_INFECTION, 1, 25)
-  ) |>
-  arrange(MO, AB) |>
-  select(MO, AB, SITE_OF_INFECTION) |>
+  filter(HOST == "Cats", YEAR == 2023) |> 
+  mutate(MO = AMR::mo_shortname(ORGANISM_CODE),
+         AB = AMR::ab_name(WHONET_ABX_CODE),
+         SITE_OF_INFECTION = substr(SITE_OF_INFECTION, 1, 25)) |> 
+  arrange(MO, AB) |> 
+  select(MO, AB, SITE_OF_INFECTION) |> 
   as.data.frame()
 ```
 

data-raw/_generate_python_wrapper.sh

@@ -14,7 +14,7 @@
 # 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      #
+# 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   #
@@ -33,20 +33,18 @@
 rm -rf ../PythonPackage/AMR/*
 mkdir -p ../PythonPackage/AMR/AMR
 
-# Output files
+# Output Python file
 setup_file="../PythonPackage/AMR/setup.py"
-init_file="../PythonPackage/AMR/AMR/__init__.py"
-engine_file="../PythonPackage/AMR/AMR/_engine.py"
-datasets_file="../PythonPackage/AMR/AMR/datasets.py"
 functions_file="../PythonPackage/AMR/AMR/functions.py"
-beta_file="../PythonPackage/AMR/AMR/beta.py"
+datasets_file="../PythonPackage/AMR/AMR/datasets.py"
+init_file="../PythonPackage/AMR/AMR/__init__.py"
 description_file="../DESCRIPTION"
 
-# ---- _engine.py: R environment setup and installation logic ---- #
-
-cat <<'EOL' > "$engine_file"
+# Write header to the datasets Python file, including the convert_to_python function
+cat <<EOL > "$datasets_file"
 import os
 import sys
+import pandas as pd
 import importlib.metadata as metadata
 
 # Get the path to the virtual environment
@@ -58,127 +56,48 @@ os.makedirs(r_lib_path, exist_ok=True)
 os.environ['R_LIBS_SITE'] = r_lib_path
 
 from rpy2 import robjects
-from rpy2.robjects.vectors import StrVector
+from rpy2.robjects.conversion import localconverter
+from rpy2.robjects import default_converter, numpy2ri, pandas2ri
 from rpy2.robjects.packages import importr, isinstalled
 
-# Import base and utils once
+# Import base and utils
 base = importr('base')
 utils = importr('utils')
 
-# Silence R console output entirely
-robjects.r('suppressMessages(suppressWarnings(sink(tempfile())))')
+base.options(warn=-1)
+
+# Ensure library paths explicitly
 base._libPaths(r_lib_path)
 
-_installed_source = None
+# Check if the AMR package is installed in R
+if not isinstalled('AMR', lib_loc=r_lib_path):
+    print(f"AMR: Installing latest AMR R package to {r_lib_path}...", flush=True)
+    utils.install_packages('AMR', repos='beta.amr-for-r.org', quiet=True)
 
-def _r_version():
-    """Return the currently installed AMR R package version, or None."""
+# Retrieve Python AMR version
+try:
+    python_amr_version = str(metadata.version('AMR'))
+except metadata.PackageNotFoundError:
+    python_amr_version = str('')
+
+# Retrieve R AMR version
+r_amr_version = robjects.r(f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')
+r_amr_version = str(r_amr_version[0])
+
+# Compare R and Python package versions
+if r_amr_version != python_amr_version:
     try:
-        return str(robjects.r(
-            f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')[0])
-    except Exception:
-        return None
+        print(f"AMR: Updating AMR package in {r_lib_path}...", flush=True)
+        utils.install_packages('AMR', repos='beta.amr-for-r.org', quiet=True)
+    except Exception as e:
+        print(f"AMR: Could not update: {e}", flush=True)
 
-def _py_version():
-    """Return the Python AMR package version from metadata, or empty string."""
-    try:
-        return str(metadata.version('AMR'))
-    except metadata.PackageNotFoundError:
-        return ''
+print(f"AMR: Setting up R environment and AMR datasets...", flush=True)
 
-def _install_cran():
-    """Install AMR from CRAN into the isolated library."""
-    print("AMR: Installing from CRAN...", flush=True)
-    utils.install_packages(
-        'AMR',
-        repos='https://cloud.r-project.org',
-        lib=r_lib_path,
-        quiet=True
-    )
-
-def _install_github():
-    """Install AMR development version from GitHub into the isolated library."""
-    print("AMR: Installing development version from GitHub...", flush=True)
-    utils.install_packages(
-        StrVector(['remotes', 'desc']),
-        repos='https://cloud.r-project.org',
-        lib=r_lib_path,
-        quiet=True
-    )
-    remotes = importr('remotes', lib_loc=r_lib_path)
-    remotes.install_github('msberends/AMR', lib=r_lib_path, quiet=True)
-
-def ensure_amr(source="cran"):
-    """Ensure AMR is installed from the requested source. Idempotent per source."""
-    global _installed_source
-    
-    if _installed_source == source:
-        return
-    
-    install_fn = _install_github if source == "github" else _install_cran
-    
-    if not isinstalled('AMR', lib_loc=r_lib_path):
-        install_fn()
-    else:
-        # Check for version mismatch and update if needed
-        r_ver = _r_version()
-        py_ver = _py_version()
-        if r_ver != py_ver:
-            try:
-                install_fn()
-            except Exception as e:
-                print(f"AMR: Could not update ({e})", flush=True)
-    
-    print(f"AMR: R package version {_r_version()} ready.", flush=True)
-    _installed_source = source
-
-def restore_sink():
-    """Restore R console output after setup is complete."""
-    try:
-        robjects.r('sink()')
-    except Exception:
-        pass
-EOL
-
-# ---- datasets.py: only dataset loading ---- #
-
-cat <<'EOL' > "$datasets_file"
-import pandas as pd
-from rpy2 import robjects
-from rpy2.robjects.conversion import localconverter
-from rpy2.robjects import default_converter, numpy2ri, pandas2ri
-
-from ._engine import ensure_amr, restore_sink
-
-_cache = {}
-_loaded_source = None
-
-def _load_datasets(source="cran"):
-    """Load all AMR datasets into the module cache."""
-    global _loaded_source
-    
-    if _cache and _loaded_source == source:
-        return
-    
-    if _cache and _loaded_source != source:
-        _cache.clear()
-    
-    ensure_amr(source)
-    
-    with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
-        _cache['example_isolates'] = _load_example_isolates()
-        _cache['microorganisms'] = robjects.r(
-            'AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]')
-        _cache['antimicrobials'] = robjects.r(
-            'AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]')
-        _cache['clinical_breakpoints'] = robjects.r(
-            'AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]')
-    
-    restore_sink()
-    _loaded_source = source
-
-def _load_example_isolates():
-    df = robjects.r('''
+# Activate the automatic conversion between R and pandas DataFrames
+with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
+    # example_isolates
+    example_isolates = robjects.r('''
     df <- AMR::example_isolates
     df[] <- lapply(df, function(x) {
         if (inherits(x, c("Date", "POSIXt", "factor"))) {
@@ -190,72 +109,26 @@ def _load_example_isolates():
     df <- df[, !sapply(df, is.list)]
     df
     ''')
-    df['date'] = pd.to_datetime(df['date'])
-    return df
+    example_isolates['date'] = pd.to_datetime(example_isolates['date'])
 
-def get(name, source="cran"):
-    """Retrieve a dataset by name, installing AMR if needed."""
-    _load_datasets(source)
-    return _cache[name]
+    # microorganisms
+    microorganisms = robjects.r('AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]')
+    antimicrobials = robjects.r('AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]')
+    clinical_breakpoints = robjects.r('AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]')
+
+base.options(warn = 0)
+
+print(f"AMR: Done.", flush=True)
 EOL
 
-# ---- __init__.py: lazy module, CRAN by default ---- #
+echo "from .datasets import example_isolates" >> $init_file
+echo "from .datasets import microorganisms" >> $init_file
+echo "from .datasets import antimicrobials" >> $init_file
+echo "from .datasets import clinical_breakpoints" >> $init_file
 
-cat <<'EOL' > "$init_file"
-import sys
 
-_DATASETS = frozenset({
-    'example_isolates', 'microorganisms',
-    'antimicrobials', 'clinical_breakpoints'
-})
-
-class _AMRModule(type(sys.modules[__name__])):
-    """Lazy-loading module: nothing runs until an attribute is accessed."""
-    
-    def __getattr__(self, name):
-        if name in _DATASETS:
-            from .datasets import get
-            return get(name, source="cran")
-        try:
-            from . import functions
-            return getattr(functions, name)
-        except AttributeError:
-            raise AttributeError(
-                f"module 'AMR' has no attribute '{name}'")
-
-sys.modules[__name__].__class__ = _AMRModule
-EOL
-
-# ---- beta.py: GitHub development version ---- #
-
-cat <<'EOL' > "$beta_file"
-import sys
-
-_DATASETS = frozenset({
-    'example_isolates', 'microorganisms',
-    'antimicrobials', 'clinical_breakpoints'
-})
-
-class _BetaModule(type(sys.modules[__name__])):
-    """Lazy-loading module: installs AMR from GitHub on first access."""
-    
-    def __getattr__(self, name):
-        if name in _DATASETS:
-            from .datasets import get
-            return get(name, source="github")
-        try:
-            from . import functions
-            return getattr(functions, name)
-        except AttributeError:
-            raise AttributeError(
-                f"module 'AMR.beta' has no attribute '{name}'")
-
-sys.modules[__name__].__class__ = _BetaModule
-EOL
-
-# ---- functions.py: R-to-Python wrapper functions ---- #
-
-cat <<'EOL' > "$functions_file"
+# Write header to the functions Python file, including the convert_to_python function
+cat <<EOL > "$functions_file"
 import functools
 import rpy2.robjects as robjects
 from rpy2.robjects.packages import importr
@@ -265,38 +138,9 @@ from rpy2.robjects import default_converter, numpy2ri, pandas2ri
 import pandas as pd
 import numpy as np
 
-from ._engine import ensure_amr
-
-# Ensure AMR is available before importing it in R
-ensure_amr("cran")
+# Import the AMR R package
 amr_r = importr('AMR')
 
-def convert_to_r(value):
-    """Convert Python lists/tuples to typed R vectors.
-
-    rpy2's default_converter passes Python lists to R as R lists, not as
-    character/numeric vectors. This causes element-wise type-check functions
-    such as is.mic(), is.sir(), and is.disk() to return a logical vector
-    rather than a single logical, breaking R's scalar && operator.
-
-    This helper converts Python lists and tuples to the appropriate R vector
-    type based on the element types, so R always receives a proper vector."""
-    if isinstance(value, (list, tuple)):
-        if len(value) == 0:
-            return StrVector([])
-        # bool must be checked before int because bool is a subclass of int
-        if all(isinstance(v, bool) for v in value):
-            return robjects.vectors.BoolVector(value)
-        if all(isinstance(v, int) for v in value):
-            return IntVector(value)
-        if all(isinstance(v, float) for v in value):
-            return FloatVector(value)
-        if all(isinstance(v, str) for v in value):
-            return StrVector(value)
-        # Mixed types: coerce all to string
-        return StrVector([str(v) for v in value])
-    return value
-
 def convert_to_python(r_output):
     # Check if it's a StrVector (R character vector)
     if isinstance(r_output, StrVector):
@@ -322,23 +166,21 @@ def convert_to_python(r_output):
     return r_output
 
 def r_to_python(r_func):
-    """Decorator that converts Python list/tuple inputs to typed R vectors,
-    runs the rpy2 function under a localconverter, and converts the output
-    to a Python type."""
+    """Decorator that runs an rpy2 function under a localconverter
+    and then applies convert_to_python to its output."""
     @functools.wraps(r_func)
     def wrapper(*args, **kwargs):
-        args = tuple(convert_to_r(a) for a in args)
-        kwargs = {k: convert_to_r(v) for k, v in kwargs.items()}
         with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
             return convert_to_python(r_func(*args, **kwargs))
     return wrapper
 EOL
 
-# ---- Generate wrapper functions from .Rd files ---- #
-
+# Directory where the .Rd files are stored (update path as needed)
 rd_dir="../man"
 
+# Iterate through each .Rd file in the man directory
 for rd_file in "$rd_dir"/*.Rd; do
+    # Extract function names and their arguments from the .Rd files
     awk '
     BEGIN {
         usage_started = 0
@@ -421,19 +263,18 @@ for rd_file in "$rd_dir"/*.Rd; do
     ' "$rd_file"
 done
 
+# Output completion message
 echo "Python wrapper functions generated in $functions_file."
 echo "Python wrapper functions listed in $init_file."
 
-# ---- README ---- #
-
 cp ../vignettes/AMR_for_Python.Rmd ../PythonPackage/AMR/README.md
 sed -i '1,/^# Introduction$/d' ../PythonPackage/AMR/README.md
-echo "README copied."
-
-# ---- setup.py ---- #
+echo "README copied"
 
+# Extract the relevant fields from DESCRIPTION
 version=$(grep "^Version:" "$description_file" | awk '{print $2}')
 
+# Write the setup.py file
 cat <<EOL > "$setup_file"
 from setuptools import setup, find_packages
 
@@ -464,10 +305,11 @@ setup(
 )
 EOL
 
-echo "setup.py generated."
-
-# ---- Build ---- #
+# Output completion message
+echo "setup.py has been generated in $setup_file."
 
 cd ../PythonPackage/AMR
 pip3 install build
 python3 -m build
+# python3 setup.py sdist bdist_wheel
+

data-raw/_language_update.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #

data-raw/_pre_commit_checks.R

@@ -12,7 +12,7 @@
 # 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      #
+# 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   #
@@ -42,9 +42,9 @@ pre_commit_lst <- list()
 
 usethis::ui_info(paste0("Updating internal package data"))
 
-# See 'data-raw/interpretive_rules.tsv' for the interpretive rules reference file
-pre_commit_lst$INTERPRETIVE_RULES_DF <- utils::read.delim(
-  file = "data-raw/interpretive_rules.tsv",
+# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
+pre_commit_lst$EUCAST_RULES_DF <- utils::read.delim(
+  file = "data-raw/eucast_rules.tsv",
   skip = 9,
   sep = "\t",
   stringsAsFactors = FALSE,
@@ -109,11 +109,11 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
       which(MO_staph$species %in% c(
         "coagulase-negative", "argensis", "arlettae",
         "auricularis", "borealis", "caeli", "capitis", "caprae",
-        "carnosus", "casei", "caseorum", "caseolyticus", "chromogenes", "cohnii", "condimenti",
+        "carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
         "croceilyticus",
         "debuckii", "devriesei", "edaphicus", "epidermidis",
-        "equorum", "felis", "fleurettii", "gallinarum", "halotolerans",
-        "haemolyticus", "hominis", "hsinchuensis", "jettensis", "kloosii",
+        "equorum", "felis", "fleurettii", "gallinarum",
+        "haemolyticus", "hominis", "jettensis", "kloosii",
         "lentus", "lugdunensis", "massiliensis", "microti",
         "muscae", "nepalensis", "pasteuri", "petrasii",
         "pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
@@ -124,11 +124,7 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
         "caledonicus", "canis",
         "durrellii", "lloydii",
         "ratti", "taiwanensis", "veratri", "urealyticus",
-        "americanisciuri", "marylandisciuri", "shinii", "brunensis",
-        # Kuhnert et al. 2026 (doi:10.1099/ijsem.0.007230), Baek et al. 2025 (J Microbiol, S. parequorum) and
-        # Belhout et al. 2026 (doi:10.1099/ijsem.0.007253, S. xeri); S. parequorum and S. xeri confirmed by
-        # Matthijs S. Berends
-        "dromedarii", "parequorum", "xeri"
+        "americanisciuri", "marylandisciuri", "shinii", "brunensis"
       ) |
         # old, now renamed to S. schleiferi (but still as synonym in our data of course):
         (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
@@ -146,8 +142,7 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
         "pseudintermedius", "pseudointermedius",
         "schweitzeri", "simiae",
         "roterodami",
-        "singaporensis",
-        "ursi"
+        "singaporensis"
       ) |
         # old, now renamed to S. coagulans (but still as synonym in our data of course):
         (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
@@ -164,14 +159,6 @@ pre_commit_lst$MO_STREP_ABCG <- microorganisms$mo[which(microorganisms$genus ==
     "group a", "group b", "group c", "group g"
   ))]
 pre_commit_lst$MO_LANCEFIELD <- microorganisms$mo[which(microorganisms$mo %like% "^(B_STRPT_PYGN(_|$)|B_STRPT_AGLC(_|$)|B_STRPT_(DYSG|EQUI)(_|$)|B_STRPT_ANGN(_|$)|B_STRPT_(DYSG|CANS)(_|$)|B_STRPT_SNGN(_|$)|B_STRPT_SLVR(_|$))")]
-# a synonym only belongs to these lists if its current name does as well (decision by Matthijs S. Berends, 7 October
-# 2026), e.g. not Staphylococcus caseolyticus (now Macrococcus caseolyticus) in CoNS, nor Staphylococcus roterodami
-# (now Staphylococcus aureus) in CoPS
-for (lst in c("MO_CONS", "MO_COPS", "MO_STREP_ABCG", "MO_LANCEFIELD")) {
-  current <- AMR:::synonym_mo_to_accepted_mo(as.character(pre_commit_lst[[lst]]))
-  pre_commit_lst[[lst]] <- pre_commit_lst[[lst]][is.na(current) | current %in% as.character(pre_commit_lst[[lst]])]
-}
-rm(lst, current)
 pre_commit_lst$MO_WHO_PRIORITY_GENERA <- c(
   # World Health Organization's (WHO) Priority Pathogen List (some are from the group Enterobacteriaceae)
   "Acinetobacter",
@@ -219,25 +206,17 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Angiostrongylus",
   "Anisakis",
   "Anopheles",
-  "Apiotrichum",
   "Apophysomyces",
   "Arthroderma",
-  "Ascaris",
   "Aspergillus",
   "Aureobasidium",
-  "Babesia",
-  "Balamuthia",
-  "Balantidium", # COL name of Balantioides coli (Balantidium coli)
-  "Balantioides",
   "Basidiobolus",
   "Beauveria",
   "Bipolaris",
   "Blastobotrys",
   "Blastocystis",
   "Blastomyces",
-  "Brugia",
   "Candida",
-  "Candidozyma",
   "Capillaria",
   "Chaetomium",
   "Chilomastix",
@@ -246,7 +225,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Cladophialophora",
   "Cladosporium",
   "Clavispora",
-  "Clonorchis",
   "Coccidioides",
   "Cokeromyces",
   "Conidiobolus",
@@ -257,32 +235,21 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Cryptosporidium",
   "Cunninghamella",
   "Curvularia",
-  "Cutaneotrichosporon",
   "Cyberlindnera",
-  "Cyclospora",
-  "Cystoisospora",
-  "Debaryomyces",
   "Debaryozyma",
   "Demodex",
   "Dermatobia",
   "Dientamoeba",
   "Diphyllobothrium",
   "Dirofilaria",
-  "Diutina",
-  "Echinococcus",
   "Echinostoma",
-  "Emergomyces",
-  "Emmonsia",
-  "Encephalitozoon",
   "Entamoeba",
   "Enterobius",
-  "Enterocytozoon",
   "Epidermophyton",
   "Exidia",
   "Exophiala",
   "Exserohilum",
   "Fasciola",
-  "Fasciolopsis",
   "Fonsecaea",
   "Fusarium",
   "Geotrichum",
@@ -300,45 +267,34 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Hymenolepis",
   "Hypomyces",
   "Hysterothylacium",
-  "Isospora", # COL name of Cystoisospora belli (Isospora belli)
-  "Kazachstania",
   "Kloeckera",
   "Kluyveromyces",
   "Kodamaea",
   "Lacazia",
   "Leishmania",
   "Lichtheimia",
-  "Loa",
   "Lodderomyces",
   "Lomentospora",
   "Madurella",
-  "Magnusiomyces",
   "Malassezia",
   "Malbranchea",
-  "Mansonella",
   "Metagonimus",
   "Meyerozyma",
-  "Microascus",
   "Microsporidium",
   "Microsporum",
   "Millerozyma",
   "Mortierella",
   "Mucor",
   "Mycocentrospora",
-  "Naegleria",
-  "Nakaseomyces",
   "Nannizzia",
   "Necator",
   "Nectria",
-  "Neocosmospora",
   "Ochroconis",
   "Oesophagostomum",
   "Oidiodendron",
-  "Onchocerca",
   "Opisthorchis",
   "Paecilomyces",
   "Paracoccidioides",
-  "Paragonimus",
   "Pediculus",
   "Penicillium",
   "Phaeoacremonium",
@@ -350,7 +306,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Piedraia",
   "Pithomyces",
   "Pityrosporum",
-  "Plasmodium",
   "Pneumocystis",
   "Pseudallescheria",
   "Pseudoscopulariopsis",
@@ -358,7 +313,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Pulex",
   "Purpureocillium",
   "Quambalaria",
-  "Rasamsonia",
   "Rhinocladiella",
   "Rhizomucor",
   "Rhizopus",
@@ -366,11 +320,9 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Saccharomyces",
   "Saksenaea",
   "Saprochaete",
-  "Sarcocystis",
   "Sarcoptes",
   "Scedosporium",
   "Schistosoma",
-  "Schizophyllum",
   "Schizosaccharomyces",
   "Scolecobasidium",
   "Scopulariopsis",
@@ -386,8 +338,8 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
   "Syngamus",
   "Taenia",
   "Talaromyces",
+  "Teleomorph",
   "Toxocara",
-  "Toxoplasma",
   "Trichinella",
   "Trichobilharzia",
   "Trichoderma",
@@ -412,14 +364,11 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
 )
 
 # antibiotic groups
-# (these will also be used for interpretive_rules() and understanding data-raw/interpretive_rules.tsv)
+# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv)
 pre_commit_lst$AB_AMINOGLYCOSIDES <- antimicrobials %>%
-  filter(group %like% "aminoglycoside|paromomycin|spectinomycin") %>%
-  pull(ab)
-pre_commit_lst$AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX", "AMC"))
-pre_commit_lst$AB_AMINOCOUMARINS <- antimicrobials %>%
-  filter(name %like% "novobiocin|clorobiocin") %>%
+  filter(group %like% "aminoglycoside") %>%
   pull(ab)
+pre_commit_lst$AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
 pre_commit_lst$AB_ANTIFUNGALS <- antimicrobials %>%
   filter(group %like% "antifungal") %>%
   pull(ab)
@@ -448,28 +397,26 @@ pre_commit_lst$AB_CEPHALOSPORINS_5TH <- antimicrobials %>%
   filter(group %like% "cephalosporin.*5") %>%
   pull(ab)
 pre_commit_lst$AB_CEPHALOSPORINS_EXCEPT_CAZ <- pre_commit_lst$AB_CEPHALOSPORINS[pre_commit_lst$AB_CEPHALOSPORINS != "CAZ"]
+pre_commit_lst$AB_FLUOROQUINOLONES <- antimicrobials %>%
+  # see DOI 10.23937/2378-3656/1410369, more specifically this table: https://www.clinmedjournals.org/articles/cmrcr/cmrcr-8-369-table1.html
+  filter((group %like% "quinolone" | atc_group1 %like% "quinolone" | atc_group2 %like% "quinolone") & name %unlike% " acid|nalidixic|cinoxacin|flumequine|oxolinic|piromidic|pipemidic|rosoxacin") %>%
+  pull(ab)
 pre_commit_lst$AB_GLYCOPEPTIDES <- antimicrobials %>%
   filter(group %like% "glycopeptide") %>%
   pull(ab)
-pre_commit_lst$AB_FUSIDANES <- antimicrobials %>%
-  filter(name %like% "fusi") %>%
-  pull(ab)
-pre_commit_lst$AB_IONOPHORES <- antimicrobials %>%
-  filter(name %like% "alamethicin|beauvericin|calcimycin|chloroquine|clioquinol|diiodohydroxyquinoline|dithiocarbamates|enniatin|epigallocatechin|gramicidin|hinokitiol|ionomycin|laidlomycin|lasalocid|maduramicin|monensin|narasin|nigericin|nonactin|nystatin|pyrazole|pyrithione|quercetin|salinomycin|semduramicin|valinomycin|zincophorin") %>%
-  pull(ab)
 pre_commit_lst$AB_ISOXAZOLYLPENICILLINS <- antimicrobials %>%
   filter(name %like% "oxacillin|cloxacillin|dicloxacillin|flucloxacillin|meth?icillin") %>%
   pull(ab)
 pre_commit_lst$AB_LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela
 pre_commit_lst$AB_GLYCOPEPTIDES_EXCEPT_LIPO <- pre_commit_lst$AB_GLYCOPEPTIDES[!pre_commit_lst$AB_GLYCOPEPTIDES %in% pre_commit_lst$AB_LIPOGLYCOPEPTIDES]
 pre_commit_lst$AB_LINCOSAMIDES <- antimicrobials %>%
-  filter(atc_group2 %like% "lincosamide" | (group %like% "lincosamide" & is.na(atc_group2) & name %like% "^(pirlimycin|clinda)")) %>%
+  filter(atc_group2 %like% "lincosamide" | (group %like% "lincosamide" & is.na(atc_group2) & name %like% "^(pirlimycin)" & name %unlike% "screening|inducible")) %>%
   pull(ab)
 pre_commit_lst$AB_MACROLIDES <- antimicrobials %>%
-  filter(atc_group2 %like% "macrolide" | (group %like% "macrolide" & is.na(atc_group2)) | name %like% "^(acetylmidecamycin|acetylspiramycin|gamith?romycin|kitasamycin|meleumycin|nafith?romycin|primycin|solith?romycin|tildipirosin|tilmicosin|tulath?romycin|tylosin|tylvalosin)") %>%
+  filter(atc_group2 %like% "macrolide" | (group %like% "macrolide" & is.na(atc_group2) & name %like% "^(acetylmidecamycin|acetylspiramycin|gamith?romycin|kitasamycin|meleumycin|nafith?romycin|solith?romycin|tildipirosin|tilmicosin|tulath?romycin|tylosin|tylvalosin)" & name %unlike% "screening|inducible")) %>%
   pull(ab)
 pre_commit_lst$AB_MONOBACTAMS <- antimicrobials %>%
-  filter(group %like% "monobactam" | name %like% "aztreonam|carumonam|tigemonam") %>%
+  filter(group %like% "monobactam") %>%
   pull(ab)
 pre_commit_lst$AB_NITROFURANS <- antimicrobials %>%
   filter(name %like% "^furaz|nitrofura" | atc_group2 %like% "nitrofuran") %>%
@@ -480,204 +427,56 @@ pre_commit_lst$AB_OXAZOLIDINONES <- antimicrobials %>%
 pre_commit_lst$AB_PENICILLINS <- antimicrobials %>%
   filter(group %like% "penicillin" & !(name %unlike% "/" & name %like% ".*bactam$")) %>%
   pull(ab)
-pre_commit_lst$AB_PEPTIDES <- antimicrobials %>%
-  filter(ab %in% pre_commit_lst$AB_GLYCOPEPTIDES | name %like% "thiostrepton|actinomycin|bacitracin|daptomycin|vancomycin|teixobactin|tyrocidine|gramicidin|zwittermicin|epothilone|fabclavine|bleomycin|ciclosporin|cyclosporine|siderophores|pyoverdine|enterobactin|myxochelin") %>%
-  pull(ab)
 pre_commit_lst$AB_PHENICOLS <- antimicrobials %>%
   filter(group %like% "phenicol" | atc_group1 %like% "phenicol" | atc_group2 %like% "phenicol") %>%
   pull(ab)
-pre_commit_lst$AB_PHOSPHONICS <- antimicrobials %>%
-  filter(group %like% "phosphonic" | name %like% "fosfo") %>%
-  pull(ab)
-pre_commit_lst$AB_PLEUROMUTILINS <- antimicrobials %>%
-  filter(name %like% "retapamulin|tiamulin|pleuromutilin") %>%
-  pull(ab)
 pre_commit_lst$AB_POLYMYXINS <- antimicrobials %>%
   filter(group %like% "polymyxin") %>%
   pull(ab)
 pre_commit_lst$AB_QUINOLONES <- antimicrobials %>%
-  filter(group %like% "quinolone" | atc_group1 %like% "quinolone" | atc_group2 %like% "quinolone" | name %like% "ozenoxacin") %>%
-  pull(ab)
-pre_commit_lst$AB_FLUOROQUINOLONES <- antimicrobials %>%
-  # see DOI 10.23937/2378-3656/1410369, more specifically this table: https://www.clinmedjournals.org/articles/cmrcr/cmrcr-8-369-table1.html
-  filter(ab %in% pre_commit_lst$AB_QUINOLONES & name %unlike% " acid|nalidixic|cinoxacin|flumequine|oxolinic|ozenoxacin|piromidic|pipemidic|rosoxacin") %>%
+  filter(group %like% "quinolone" | atc_group1 %like% "quinolone" | atc_group2 %like% "quinolone") %>%
   pull(ab)
 pre_commit_lst$AB_RIFAMYCINS <- antimicrobials %>%
   filter(name %like% "Rifampi|Rifabutin|Rifapentine|rifamy") %>%
   pull(ab)
-pre_commit_lst$AB_SPIROPYRIMIDINETRIONES <- antimicrobials %>%
-  filter(name %like% "zoliflodacin") %>%
-  pull(ab)
 pre_commit_lst$AB_STREPTOGRAMINS <- antimicrobials %>%
-  filter(atc_group2 %like% "streptogramin" | name %like% "streptogramin|virginiamycin|ostreogrycin") %>%
+  filter(atc_group2 %like% "streptogramin") %>%
   pull(ab)
 pre_commit_lst$AB_TETRACYCLINES <- antimicrobials %>%
-  filter(atc_group1 %like% "tetracycline" | atc_group2 %like% "tetracycline" | name %like% "chlortetracycline|cetocycline|demeclocycline|doxycycline|eravacycline|lymecycline|meclocycline|meth?acycline|minocycline|omadacycline|oxytetracycline|rolitetracycline|sarecycline|tetracycline|tigecycline") %>%
+  filter(group %like% "tetracycline") %>%
   pull(ab)
 pre_commit_lst$AB_TETRACYCLINES_EXCEPT_TGC <- pre_commit_lst$AB_TETRACYCLINES[pre_commit_lst$AB_TETRACYCLINES != "TGC"]
 pre_commit_lst$AB_TRIMETHOPRIMS <- antimicrobials %>%
-  filter(atc_group1 %like% "trimethoprim" | atc_group2 %like% "trimethoprim" | name %like% "trimethoprim|ormetroprim|iclaprim") %>%
+  filter(group %like% "trimethoprim") %>%
   pull(ab)
 pre_commit_lst$AB_SULFONAMIDES <- antimicrobials %>%
-  filter(name %like% "(^|/)sulf[oai]") %>%
+  filter(group %like% "trimethoprim" & name %unlike% "trimethoprim") %>%
   pull(ab)
 pre_commit_lst$AB_UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ"))
-pre_commit_lst$AB_BETALACTAMS <- sort(c(
-  pre_commit_lst$AB_PENICILLINS,
-  pre_commit_lst$AB_CEPHALOSPORINS,
-  pre_commit_lst$AB_CARBAPENEMS,
-  pre_commit_lst$AB_MONOBACTAMS
-))
-pre_commit_lst$AB_BETALACTAMASE_INHIBITORS <- antimicrobials %>%
-  filter(atc_group2 %like% "Beta-lactamase inhibitors" | name %like% "bactam") %>%
-  pull(ab)
-# for EUCAST:
+pre_commit_lst$AB_BETALACTAMS <- sort(c(pre_commit_lst$AB_PENICILLINS, pre_commit_lst$AB_CEPHALOSPORINS, pre_commit_lst$AB_CARBAPENEMS, pre_commit_lst$AB_MONOBACTAMS))
 pre_commit_lst$AB_BETALACTAMS_WITH_INHIBITOR <- antimicrobials %>%
-  filter(ab %in% pre_commit_lst$AB_BETALACTAMS & name %like% "/" & name %unlike% "EDTA") %>%
+  filter(name %like% "/" & name %unlike% "EDTA" & ab %in% pre_commit_lst$AB_BETALACTAMS) %>%
   pull(ab)
 # this will be used for documentation:
 pre_commit_lst$DEFINED_AB_GROUPS <- sort(names(pre_commit_lst)[names(pre_commit_lst) %like% "^AB_" & names(pre_commit_lst) != "AB_LOOKUP"])
 
-# Check that all AB_* groups with >= 4 members have a corresponding function
-for (grp in pre_commit_lst$DEFINED_AB_GROUPS[pre_commit_lst$DEFINED_AB_GROUPS %unlike% "BETALACTAMASE_INHIBITORS|EXCEPT"]) {
-  if (length(pre_commit_lst[[grp]]) >= 4) {
-    fn_name <- tolower(gsub("^AB_", "", grp))
-    if (!fn_name %in% ls(envir = asNamespace("AMR"))) {
-      stop("Group '", grp, "' has ", length(pre_commit_lst[[grp]]),
-        " members (", toString(ab_name(pre_commit_lst[[grp]], tolower = T)), ") but no corresponding function '", fn_name, "()' exists in the AMR namespace.",
-        call. = FALSE
-      )
-    }
-  }
-}
-
-# Update the antimicrobials$group column
-usethis::ui_info("Updating 'group' column in antimicrobials data set from AB_* vectors")
-prettify_group_name <- function(name) {
-  raw <- gsub("^AB_", "", name)
-  pretty <- tools::toTitleCase(gsub("_", " ", tolower(raw)))
-  pretty[pretty %like% " (except|with) "] <- ""
-  pretty <- gsub(" (1st|2nd|3rd|4th|5th|6th)", " (\\1 gen.)", pretty)
-  pretty <- gsub("([Bb])eta[-]?", "\\1eta-", pretty)
-  pretty <- gsub(" Inhibitor", " inhibitor", pretty)
-  pretty <- pretty[pretty != ""]
-  return(pretty)
-}
-group_map <- vector("list", length = nrow(antimicrobials))
-names(group_map) <- antimicrobials$ab
-for (group_name in pre_commit_lst$DEFINED_AB_GROUPS) {
-  ab_vector <- pre_commit_lst[[group_name]]
-  pretty_name <- prettify_group_name(group_name)
-  for (ab in ab_vector) {
-    ab_chr <- as.character(ab)
-    group_map[[ab_chr]] <- sort(unique(c(group_map[[ab_chr]], pretty_name)))
-  }
-}
-for (i in seq_along(group_map)) {
-  if (is.null(group_map[[i]])) {
-    group_map[[i]] <- "Other"
-    if (antimicrobials$group[i] %unlike% "other") {
-      usethis::ui_warn(paste0("AB had a group but not anymore: ", antimicrobials$name[i], " (", antimicrobials$ab[i], "), was ", toString(antimicrobials$group[i])))
-    }
-  }
-  group_map[[i]] <- group_map[[i]][order(nchar(group_map[[i]]))]
-}
-
-# create priority list for ab_group()
-pre_commit_lst$ABX_PRIORITY_LIST <- c(
-  "Aminopenicillins",
-  "Isoxazolylpenicillins",
-  "Ureidopenicillins",
-  "Oxazolidinones",
-  "Carbapenems",
-  "Cephalosporins (1st gen.)",
-  "Cephalosporins (2nd gen.)",
-  "Cephalosporins (3rd gen.)",
-  "Cephalosporins (4th gen.)",
-  "Cephalosporins (5th gen.)",
-  "Cephalosporins",
-  "Penicillins",
-  "Monobactams",
-  "Aminoglycosides",
-  "Lipoglycopeptides",
-  "Glycopeptides",
-  "Peptides",
-  "Lincosamides",
-  "Streptogramins",
-  "Macrolides",
-  "Nitrofurans",
-  "Phenicols",
-  "Phosphonics",
-  "Polymyxins",
-  "Fluoroquinolones",
-  "Quinolones",
-  "Rifamycins",
-  "Spiropyrimidinetriones",
-  "Trimethoprims",
-  "Sulfonamides",
-  "Tetracyclines",
-  "Ionophores",
-  "Antifungals",
-  "Antimycobacterials",
-  "Fusidanes",
-  "Beta-lactams",
-  "Beta-lactamase inhibitors",
-  "Pleuromutilins",
-  "Aminocoumarins",
-  "Other"
-)
-if (!all(unlist(antimicrobials$group) %in% pre_commit_lst$ABX_PRIORITY_LIST)) {
-  stop("Missing group(s) in priority list: ", paste(setdiff(unlist(antimicrobials$group), pre_commit_lst$ABX_PRIORITY_LIST), collapse = ", "))
-}
-for (i in seq_along(group_map)) {
-  group_map[[i]] <- intersect(pre_commit_lst$ABX_PRIORITY_LIST, group_map[[i]])
-}
-antimicrobials$group <- unname(group_map)
-usethis::use_data(antimicrobials, overwrite = TRUE, version = 2, compress = "xz")
-
 pre_commit_lst$AB_LOOKUP <- create_AB_AV_lookup(antimicrobials)
 pre_commit_lst$AV_LOOKUP <- create_AB_AV_lookup(antivirals)
 
-# MO codes of earlier releases that are not in the current data set anymore, with the current code of the same
-# taxon (see data-raw/microorganisms_files/README.md). as.mo() uses this to translate them, instead of guessing.
-source("tests/testthat/helper-microorganisms.R")
-mo_registry <- read_mo_registry(".")
-mo_renames <- read_mo_renames(".")
-retired <- mo_registry[!mo_registry$mo %in% as.character(microorganisms$mo), c("mo", "fullname", "rank"), drop = FALSE]
-renamed <- match(retired$mo, mo_renames$mo)
-retired$fullname[!is.na(renamed)] <- mo_renames$new_name[renamed[!is.na(renamed)]]
-# the same name, or else the same name without a rank suffix (such as "Kapabacteria {class}") and the same rank
-current_mo <- as.character(microorganisms$mo)[match(retired$fullname, microorganisms$fullname)]
-by_rank <- as.character(microorganisms$mo)[match(
-  paste(mo_name_without_suffix(retired$fullname), retired$rank),
-  paste(mo_name_without_suffix(microorganisms$fullname), microorganisms$rank)
-)]
-mo_retirements <- read_mo_retirements(".")
-pre_commit_lst$MO_RETIRED_CODES <- data.frame(
-  old_mo = retired$mo,
-  mo = ifelse(is.na(current_mo), by_rank, current_mo),
-  fullname = retired$fullname,
-  # codes retired on purpose, because their taxon was another organism, never lead to a taxon
-  reason = mo_retirements$reason[match(retired$mo, mo_retirements$mo)],
-  stringsAsFactors = FALSE
-)
-pre_commit_lst$MO_RETIRED_CODES$mo[!is.na(pre_commit_lst$MO_RETIRED_CODES$reason)] <- NA_character_
-rm(mo_registry, mo_renames, mo_retirements, retired, renamed, current_mo, by_rank)
-
 # Export to package as internal data ----
 # usethis::use_data() must receive unquoted object names, which is not flexible at all.
 # we'll use good old base::save() instead
-save(
-  list = names(pre_commit_lst),
-  file = "R/sysdata.rda",
-  envir = as.environment(pre_commit_lst),
-  compress = "xz",
-  version = 2,
-  ascii = FALSE
-)
+save(list = names(pre_commit_lst),
+     file = "R/sysdata.rda",
+     envir = as.environment(pre_commit_lst),
+     compress = "xz",
+     version = 2,
+     ascii = FALSE)
 usethis::ui_done("Saved to {usethis::ui_value('R/sysdata.rda')}")
 
 
+
+
 # Export data sets to the repository in different formats -----------------
 
 for (pkg in c("haven", "openxlsx2", "arrow")) {
@@ -699,9 +498,7 @@ write_md5 <- function(object) {
 }
 changed_md5 <- function(object) {
   path <- paste0("data-raw/", deparse(substitute(object)), ".md5")
-  if (!file.exists(path)) {
-    return(TRUE)
-  }
+  if (!file.exists(path)) return(TRUE)
   tryCatch(
     {
       conn <- file(path)
@@ -723,8 +520,7 @@ if (changed_md5(clin_break)) {
   try(saveRDS(clin_break, "data-raw/datasets/clinical_breakpoints.rds", version = 2, compress = "xz"), silent = TRUE)
   try(write.table(clinical_breakpoints, "data-raw/datasets/clinical_breakpoints.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
   try(haven::write_sav(clin_break, "data-raw/datasets/clinical_breakpoints.sav"), silent = TRUE)
-  # long notes as strL, otherwise Stata's fixed-width strings make the file exceed 100 MB; a missing string is "" in Stata
-  try(haven::write_dta(clin_break %>% mutate(note = if_else(is.na(note), "", note)), "data-raw/datasets/clinical_breakpoints.dta", strl_threshold = 255), silent = TRUE)
+  try(haven::write_dta(clin_break, "data-raw/datasets/clinical_breakpoints.dta"), silent = TRUE)
   try(openxlsx2::write_xlsx(clin_break, "data-raw/datasets/clinical_breakpoints.xlsx"), silent = TRUE)
   try(arrow::write_feather(clin_break, "data-raw/datasets/clinical_breakpoints.feather"), silent = TRUE)
   try(arrow::write_parquet(clin_break, "data-raw/datasets/clinical_breakpoints.parquet"), silent = TRUE)
@@ -739,8 +535,7 @@ if (changed_md5(microorganisms)) {
   mo$snomed <- max_50_snomed
   mo <- dplyr::mutate_if(mo, ~ !is.numeric(.), as.character)
   try(haven::write_sav(mo, "data-raw/datasets/microorganisms.sav"), silent = TRUE)
-  # (long strings as strL, as otherwise the file would exceed the file size limit of GitHub)
-  try(haven::write_dta(mo, "data-raw/datasets/microorganisms.dta", strl_threshold = 255), silent = TRUE)
+  try(haven::write_dta(mo, "data-raw/datasets/microorganisms.dta"), silent = TRUE)
   mo_all_snomed <- microorganisms %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
   try(write.table(mo_all_snomed, "data-raw/datasets/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
   try(openxlsx2::write_xlsx(mo_all_snomed, "data-raw/datasets/microorganisms.xlsx"), silent = TRUE)
@@ -841,55 +636,24 @@ devtools::load_all(quiet = TRUE)
 suppressMessages(set_AMR_locale("English"))
 
 files_changed <- function(paths = "^(R|data)/") {
-  tryCatch(
-    {
-      changed_files <- system("git status", intern = TRUE)
-      changed_files <- unlist(strsplit(changed_files, " "))
-      any(changed_files %like% paths[paths != "R/sysdata.rda"])
-    },
-    error = function(e) TRUE
-  )
+  tryCatch({
+    changed_files <- system("git status", intern = TRUE)
+    changed_files <- unlist(strsplit(changed_files, " "))
+    any(changed_files %like% paths[paths != "R/sysdata.rda"])
+  }, error = function(e) TRUE)
 }
 
 # Update URLs -------------------------------------------------------------
 if (files_changed()) {
   usethis::ui_info("Checking URLs for redirects")
-  # Step 1: Get sources from tools (excluding man/)
-  sources <- tools:::url_db_from_package_sources(".")
-  sources <- sources[!grepl("^man/", sources$Parent), ]
-  # Step 2: Get URLs from .R files in R/
-  r_files <- list.files("R", pattern = "\\.R$", full.names = TRUE)
-  # Function to extract URLs from a file
-  extract_urls_from_file <- function(file_path) {
-    lines <- readLines(file_path, warn = FALSE)
-    urls <- stringr::str_extract_all(lines, "https?://[^\\s)\"'>}]+")
-    urls <- unlist(urls)
-    if (length(urls) == 0) {
-      return(NULL)
-    }
-    # Remove trailing punctuation (e.g., .,), etc.)
-    urls <- stringr::str_replace(urls, "[\\.,;)]+$", "")
-    data.frame(
-      URL = urls,
-      Parent = gsub("^\\./", "", file_path),
-      stringsAsFactors = FALSE
-    )
-  }
-  r_file_urls <- do.call(rbind, lapply(r_files, extract_urls_from_file))
-  # Step 3: Combine the two sources
-  total <- rbind(sources, r_file_urls)
-  # Step 4: Check URLs and update
-  results <- urlchecker::url_check(db = total)
-  invisible(urlchecker::url_update(results = results))
+  invisible(urlchecker::url_update("."))
 }
 
 # Style pkg ---------------------------------------------------------------
 if (files_changed(paths = "^(R|tests)/")) {
   usethis::ui_info("Styling package")
-  styler::style_pkg(
-    include_roxygen_examples = FALSE,
-    exclude_dirs = list.dirs(full.names = FALSE, recursive = FALSE)[!list.dirs(full.names = FALSE, recursive = FALSE) %in% c("R", "tests")]
-  )
+  styler::style_pkg(include_roxygen_examples = FALSE,
+                    exclude_dirs = list.dirs(full.names = FALSE, recursive = FALSE)[!list.dirs(full.names = FALSE, recursive = FALSE) %in% c("R", "tests")])
 }
 
 # Document pkg ------------------------------------------------------------
@@ -900,13 +664,13 @@ if (files_changed()) {
 
 # Update index.md and README.md -------------------------------------------
 if (files_changed("README.Rmd") ||
-  files_changed("index.Rmd") ||
-  files_changed("man/microorganisms.Rd") ||
-  files_changed("man/antimicrobials.Rd") ||
-  files_changed("man/clinical_breakpoints.Rd") ||
-  files_changed("man/antibiogram.Rd") ||
-  files_changed("R/antibiogram.R") ||
-  files_changed("data-raw/translations.tsv")) {
+    files_changed("index.Rmd") ||
+    files_changed("man/microorganisms.Rd") ||
+    files_changed("man/antimicrobials.Rd") ||
+    files_changed("man/clinical_breakpoints.Rd") ||
+    files_changed("man/antibiogram.Rd") ||
+    files_changed("R/antibiogram.R") ||
+    files_changed("data-raw/translations.tsv")) {
   usethis::ui_info("Rendering {usethis::ui_field('index.md')} and {usethis::ui_field('README.md')}")
   suppressWarnings(rmarkdown::render("index.Rmd", quiet = TRUE))
   suppressWarnings(rmarkdown::render("README.Rmd", quiet = TRUE))
@@ -915,6 +679,5 @@ if (files_changed("README.Rmd") ||
 }
 
 # Finished ----------------------------------------------------------------
-rm(antimicrobials)
 usethis::ui_done("All done")
 suppressMessages(reset_AMR_locale())

data-raw/_reproduction_scripts/compare_clinical_breakpoints.R

@@ -1,158 +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              #
-# ==================================================================== #
-
-# Compares the results of as.sir() between two builds of clinical_breakpoints, so that every changed interpretation is seen and explained, instead of only the changed rows.
-#
-# Each step runs from the command line, and a snapshot is made with the code and the data of the package folder that it is given, so that changes to as.sir() are compared as well:
-#
-#   Rscript compare_clinical_breakpoints.R grid     <grid.rds> <pkg_folder_old> <pkg_folder_new>
-#   Rscript compare_clinical_breakpoints.R snapshot <grid.rds> <pkg_folder> <snapshot.rds> [cores]
-#   Rscript compare_clinical_breakpoints.R diff     <old.rds> <new.rds> <changes.csv> [explain.R]
-#
-# The file explain.R must define explain_change(), which takes the data.frame of changes and returns one reason per row (NA if unexplained). The diff step exits with status 1 if any change remains unexplained.
-
-suppressPackageStartupMessages(library(dplyr))
-
-# Species that test the fallback to a broader breakpoint, on top of the organisms that are in the table for an agent and method. These cover the exceptions and extensions that EUCAST and CLSI state in their tables.
-sentinels <- c(
-  "Escherichia coli", "Klebsiella pneumoniae", "Klebsiella aerogenes", "Proteus mirabilis", "Morganella", "Morganella morganii", "Salmonella enterica", "Shigella flexneri", "Enterobacter cloacae", "Serratia marcescens", "Yersinia enterocolitica",
-  "Pseudomonas aeruginosa", "Pseudomonas putida", "Acinetobacter baumannii", "Stenotrophomonas maltophilia", "Burkholderia pseudomallei", "Burkholderia cepacia",
-  "Staphylococcus aureus", "Staphylococcus epidermidis", "Staphylococcus saprophyticus", "Staphylococcus lugdunensis", "Enterococcus faecalis", "Enterococcus faecium",
-  "Streptococcus pneumoniae", "Streptococcus pyogenes", "Streptococcus agalactiae", "Streptococcus mitis", "Haemophilus influenzae", "Haemophilus parainfluenzae", "Moraxella catarrhalis", "Neisseria gonorrhoeae", "Neisseria meningitidis",
-  "Listeria monocytogenes", "Campylobacter jejuni", "Pasteurella multocida", "Vibrio cholerae", "Aeromonas hydrophila", "Kingella kingae", "Corynebacterium diphtheriae", "Nocardia asteroides", "Bacillus anthracis", "Bacillus cereus", "Brucella melitensis",
-  "Bacteroides fragilis", "Bacteroides", "Parabacteroides distasonis", "Phocaeicola vulgatus", "Prevotella bivia", "Clostridioides difficile", "Clostridium perfringens", "Cutibacterium acnes",
-  "Candida albicans", "Aspergillus fumigatus"
-)
-
-load_breakpoints <- function(pkg) {
-  env <- new.env()
-  load(file.path(pkg, "data", "clinical_breakpoints.rda"), envir = env)
-  as.data.frame(env$clinical_breakpoints, stringsAsFactors = FALSE)
-}
-
-# One line per guideline, agent and method, with the organisms and the values to test: every breakpoint, one step to either side of it, and both ends of the scale
-make_grid <- function(pkg_old, pkg_new) {
-  suppressMessages(devtools::load_all(pkg_new, quiet = TRUE))
-  sentinel_mo <- as.character(as.mo(sentinels, info = FALSE))
-  bind_rows(load_breakpoints(pkg_old), load_breakpoints(pkg_new)) |>
-    filter(type == "human") |>
-    mutate(across(c(guideline, method, ab, mo, site), as.character)) |>
-    group_by(guideline, ab, method) |>
-    summarise(
-      has_screening = any(grepl("screen", site, ignore.case = TRUE)),
-      mo = list(unique(c(setdiff(mo, "UNKNOWN"), sentinel_mo))),
-      breakpoints = list(unique(c(as.double(breakpoint_S), as.double(breakpoint_R)))),
-      .groups = "drop"
-    ) |>
-    mutate(value = Map(test_values, breakpoints, method)) |>
-    select(-breakpoints)
-}
-
-test_values <- function(breakpoints, method) {
-  breakpoints <- breakpoints[!is.na(breakpoints)]
-  if (method == "MIC") {
-    sort(unique(c(0.001, 512, breakpoints / 2, breakpoints, breakpoints * 2)))
-  } else {
-    sort(unique(c(6, 50, breakpoints - 1, breakpoints, breakpoints + 1)))
-  }
-}
-
-snapshot_key <- function(key) {
-  screening <- if (key$has_screening) c(FALSE, TRUE) else FALSE
-  combinations <- expand.grid(
-    mo = key$mo[[1]], value = key$value[[1]], uti = c(NA, FALSE, TRUE), include_screening = screening,
-    stringsAsFactors = FALSE
-  )
-  out <- lapply(split(combinations, paste(combinations$uti, combinations$include_screening)), function(part) {
-    uti <- part$uti[1]
-    # keep the interpretation log per row, it shows which breakpoint was used
-    invisible(sir_interpretation_history(clean = TRUE))
-    x <- if (key$method == "MIC") as.mic(part$value) else as.disk(part$value)
-    part$sir <- as.character(suppressWarnings(suppressMessages(as.sir(
-      x,
-      mo = part$mo, ab = key$ab, guideline = key$guideline, uti = uti, include_screening = part$include_screening[1], info = FALSE
-    ))))
-    used <- as.data.frame(sir_interpretation_history(clean = TRUE), stringsAsFactors = FALSE)
-    part$breakpoint_used <- used$breakpoint_S_R[match(seq_len(nrow(part)), used$index)]
-    part$ref_table <- used$ref_table[match(seq_len(nrow(part)), used$index)]
-    part
-  })
-  bind_rows(out) |> mutate(guideline = key$guideline, ab = key$ab, method = key$method)
-}
-
-make_snapshot <- function(grid, pkg, cores = 1L) {
-  suppressMessages(devtools::load_all(pkg, quiet = TRUE))
-  keys <- split(grid, seq_len(nrow(grid)))
-  results <- parallel::mclapply(keys, function(key) {
-    tryCatch(snapshot_key(key), error = function(e) data.frame(guideline = key$guideline, ab = key$ab, method = key$method, error = conditionMessage(e)))
-  }, mc.cores = cores, mc.preschedule = FALSE)
-  bind_rows(results)
-}
-
-compare_snapshots <- function(old, new) {
-  by <- c("guideline", "ab", "method", "mo", "value", "uti", "include_screening")
-  full_join(old, new, by = by, suffix = c("_old", "_new")) |>
-    filter(
-      paste(sir_old) != paste(sir_new) | paste(breakpoint_used_old) != paste(breakpoint_used_new)
-    )
-}
-
-args <- commandArgs(trailingOnly = TRUE)
-if (length(args) > 0) {
-  if (args[1] == "grid") {
-    saveRDS(make_grid(args[3], args[4]), args[2])
-  } else if (args[1] == "snapshot") {
-    cores <- if (length(args) >= 5) as.integer(args[5]) else 1L
-    snapshot <- make_snapshot(readRDS(args[2]), args[3], cores)
-    if ("error" %in% colnames(snapshot) && any(!is.na(snapshot$error))) {
-      print(snapshot |> filter(!is.na(error)) |> distinct(guideline, ab, method, error) |> head(50))
-      stop("the snapshot has errors, see above")
-    }
-    saveRDS(snapshot, args[4])
-    message("Snapshot of ", nrow(snapshot), " interpretations saved")
-  } else if (args[1] == "diff") {
-    old <- readRDS(args[2])
-    new <- readRDS(args[3])
-    message("Compared: ", nrow(old), " and ", nrow(new), " interpretations")
-    changes <- compare_snapshots(old, new)
-    changes$reason <- NA_character_
-    if (length(args) >= 5) {
-      source(args[5], local = TRUE)
-      changes$reason <- explain_change(changes)
-    }
-    write.csv(changes, args[4], row.names = FALSE, na = "")
-    print(as.data.frame(changes |> count(reason, guideline)), row.names = FALSE)
-    message(nrow(changes), " changes, of which ", sum(is.na(changes$reason)), " unexplained")
-    if (anyNA(changes$reason)) {
-      quit(save = "no", status = 1)
-    }
-  } else {
-    stop("unknown step: ", args[1])
-  }
-}