v3.0.1

.Rbuildignore

@@ -40,3 +40,4 @@
 ^CRAN-SUBMISSION$
 ^PythonPackage$
 ^README\.Rmd$
+\.no_include$

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

@@ -42,7 +42,7 @@ body:
       multiple: false
       options:
         - ''
-        - Latest CRAN version (2.1.1)
-        - One of the latest GitHub versions (2.1.1.9xxx)
+        - Latest CRAN version (3.0.0)
+        - One of the latest GitHub versions (3.0.0.9xxx)
     validations:
       required: true

.github/prehooks/pre-commit

@@ -48,7 +48,6 @@ 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/*
@@ -57,60 +56,62 @@ 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 ""
 
 # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 echo "Updating semantic versioning and date..."
 
-# Get tags from remote and remove tags not on remote
-git fetch origin --prune --prune-tags --quiet
-currenttagfull=$(git describe --tags --abbrev=0)
-currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
-
-# Assume main branch to be 'main' or 'master'
-defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
-if [ "$currenttag" = "" ]; then
-  currenttag="0.0.1"
-  currentcommit=$(git rev-list --count ${defaultbranch})
-  echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
+current_branch=$(git rev-parse --abbrev-ref HEAD)
+if [ "$current_branch" != "main" ]; then
+  echo "- Current branch is '$current_branch'; skipping version/date update (only runs on 'main')"
 else
-  currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
-  echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
-fi
-
-# Combine tag and commit number
-currentversion="$currenttag.$((currentcommit + 9001))"
-echo "- ${currentpkg} pkg version set to ${currentversion}"
-
-# Update version number and date in DESCRIPTION
-sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
-sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
-echo "- Updated version number and date in ./DESCRIPTION"
-rm -f DESCRIPTION--
-git add DESCRIPTION
-
-# Update version number in NEWS.md
-if [ -e "NEWS.md" ]; then
-  if [ "$currentpkg" = "your" ]; then
-    currentpkg=""
+  # Version update logic begins here
+  
+  # Get tags from remote and remove tags not on remote
+  git fetch origin --prune --prune-tags --quiet
+  currenttagfull=$(git describe --tags --abbrev=0)
+  currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
+  
+  # Assume main branch to be 'main' or 'master'
+  defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
+  if [ "$currenttag" = "" ]; then
+    currenttag="0.0.1"
+    currentcommit=$(git rev-list --count ${defaultbranch})
+    echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
+  else
+    currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
+    echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
   fi
-  sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
-  echo "- Updated version number in ./NEWS.md"
-  rm -f NEWS.md--
-  git add NEWS.md
-else
-  echo "- No NEWS.md found!"
+  
+  # Combine tag and commit number
+  currentversion="$currenttag.$((currentcommit + 9001))"
+  echo "- AMR pkg version set to ${currentversion}"
+  
+  # Update version number and date in DESCRIPTION
+  sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
+  sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
+  echo "- Updated version number and date in ./DESCRIPTION"
+  rm -f DESCRIPTION--
+  git add DESCRIPTION
+  
+  # Update version number in NEWS.md
+  if [ -e "NEWS.md" ]; then
+    sed -i -- "1s/.*/# AMR ${currentversion}/" NEWS.md
+    echo "- Updated version number in ./NEWS.md"
+    rm -f NEWS.md--
+    git add NEWS.md
+  else
+    echo "- No NEWS.md found!"
+  fi
+  echo ""
+  
+  # Save the version number for use in the commit-msg hook
+  echo "${currentversion}" > .git/commit_version.tmp
 fi
-echo ""
-
-# Save the version number for use in the commit-msg hook
-echo "${currentversion}" > .git/commit_version.tmp
 
 git add data-raw/*
 git add data/*

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

@@ -18,7 +18,7 @@
 # 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.              #
@@ -28,18 +28,37 @@
 # ==================================================================== #
 
 on:
+  pull_request:
+    # run in each PR in this repo
+    branches: '**'
   push:
     branches: '**'
-  pull_request:
-    branches: '**'
+  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: lintr
+name: check-recent-dev-pkgs
 
 jobs:
-  lintr:
-    runs-on: ubuntu-latest
+  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
 
@@ -47,39 +66,21 @@ jobs:
 
       - uses: r-lib/actions/setup-r@v2
         with:
-          r-version: release
-          # use RStudio Package Manager to quickly install packages
-          use-public-rspm: true
+          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::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}
+          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-old-tinytest.yaml

@@ -50,17 +50,24 @@ jobs:
           # For these old versions, dependencies and vignettes will not be checked.
           # 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: 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}
           - {os: ubuntu-latest, r: '3.0', allowfail: false}
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      LANG: en_US.UTF-8
+      LC_ALL: en_US.UTF-8
 
     steps:
+      - name: Set up locales
+        run: |
+          sudo locale-gen en_US.UTF-8
+          sudo update-locale LANG=en_US.UTF-8
+
       - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2
@@ -69,9 +76,14 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v2
 
-      - name: Install tinytest from CRAN
+      - name: Install suggested pkgs (and tinytest) from CRAN
         run: |
-          install.packages("tinytest", repos = "https://cran.r-project.org")
+          desc_lines <- readLines('DESCRIPTION')
+          suggests <- readLines('DESCRIPTION')[grepl("^(Suggests:|  )", readLines('DESCRIPTION'))]
+          suggests <- suggests[(which(grepl("^Suggests", suggests)) + 1):length(suggests)]
+          suggests <- gsub("[ ,]", "", suggests)
+          pkgs <- unique(c(suggests, "tinytest"))
+          for (p in pkgs) try(install.packages(p, repos = "https://cran.r-project.org"), silent = TRUE)
         shell: Rscript {0}
 
       - name: Show session info

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

@@ -39,7 +39,7 @@ jobs:
     runs-on: ubuntu-latest
     
     env:
-      PYPI_PAT: ${{ secrets.PYPI_PAT }}
+      GH_REPO_SCOPE: ${{ secrets.GH_REPO_SCOPE }}
     
     steps:
       - name: Checkout code
@@ -78,6 +78,7 @@ jobs:
           cd PythonPackage/AMR
           python -m twine upload --repository-url https://test.pypi.org/legacy/ dist/*
 
+      # TODO - Support Miniconda and Anaconda too
       # - name: Set up Miniconda
       #   continue-on-error: true
       #   uses: conda-incubator/setup-miniconda@v2
@@ -117,7 +118,7 @@ jobs:
           rm -rf PythonPackage
 
           git init
-          git remote add origin https://$PYPI_PAT@github.com/msberends/AMR
+          git remote add origin https://$GH_REPO_SCOPE@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"
@@ -125,4 +126,4 @@ jobs:
           git rm -rf . || true
           git add .
           git commit -m "Python wrapper update"
-          git push https://$PYPI_PAT@github.com/msberends/AMR.git python-wrapper --force
+          git push https://$GH_REPO_SCOPE@github.com/msberends/AMR.git python-wrapper --force

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

@@ -39,7 +39,7 @@ jobs:
     runs-on: ubuntu-latest
     
     env:
-      PYPI_PAT: ${{ secrets.PYPI_PAT }}
+      GH_REPO_SCOPE: ${{ secrets.GH_REPO_SCOPE }}
     
     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://$PYPI_PAT@github.com/msberends/amr-for-r-assistant.git main --force
+          git push https://$GH_REPO_SCOPE@github.com/msberends/amr-for-r-assistant.git main --force

.github/workflows/todo-tracker.yml

@@ -0,0 +1,80 @@
+# ==================================================================== #
+# 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:
+    # only on main
+    branches: "main"
+
+name: Update TODO Tracker
+
+jobs:
+  update-todo:
+    runs-on: ubuntu-latest
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Generate TODO list from R/
+        run: |
+          echo "## \`TODO\` Report" > todo.md
+          echo "" >> todo.md
+          echo "_This overview is automatically updated on each push to \`main\`. It provides an automated overview of all mentions of the text \`TODO\`._" >> todo.md
+          echo "" >> todo.md
+          todos=$(grep -rn --include=\*.{R,Rmd,yaml,yml,md,css,js}  --exclude={todo-tracker.yml,todo.md} "TODO" . || true)
+          if [ -z "$todos" ]; then
+            echo "✅ No TODOs found." >> todo.md
+          else
+            echo "$todos" | awk -F: -v repo="https://github.com/msberends/AMR/blob/main/" '
+              {
+                file = $1
+                gsub("^\\./", "", file)  # remove leading ./ if present
+                line = $2
+                text = substr($0, index($0,$3))
+                if (file != last_file) {
+                  if (last_file != "") print "```"
+                  print ""
+                  print "### [`" file "`](" repo file ")"
+                  print "```r"
+                  last_file = file
+                }
+                printf "L%s: %s\n", line, text
+              }
+            ' >> todo.md
+            echo "\`\`\`" >> todo.md
+          fi
+
+      - 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

.github/workflows/website.yaml

@@ -42,16 +42,15 @@ jobs:
     runs-on: ubuntu-latest
     steps:
 
-      - uses: actions/checkout@v4
+      - name: checkout
+        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: Preserve timestamps
-        run: |
-          sudo apt install git-restore-mtime
-          git restore-mtime
+      - name: restore timestamps
+        uses: chetan/git-restore-mtime-action@v2
 
       - uses: r-lib/actions/setup-pandoc@v2
 

.gitignore

@@ -1,5 +1,6 @@
 Meta
 doc
+docs
 .Renviron
 .Rproj.user
 .Rhistory

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 3.0.0
-Date: 2025-06-01 16:52:53 UTC
-SHA: 79038fed2169a25a7fc067c80bb25d9d78be21d9
+Version: 3.0.1
+Date: 2025-09-20 10:56:46 UTC
+SHA: 33fb1849eb5aa6d33828e643c8f5047dd93447e3

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.0.0
-Date: 2025-06-01
+Version: 3.0.1
+Date: 2025-09-20
 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
@@ -51,6 +51,8 @@ Suggests:
   pillar,
   progress,
   readxl,
+  recipes,
+  rlang,
   rmarkdown,
   rstudioapi,
   rvest,
@@ -68,5 +70,5 @@ BugReports: https://github.com/msberends/AMR/issues
 License: GPL-2 | file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Roxygen: list(markdown = TRUE, old_usage = TRUE)

NAMESPACE

@@ -373,6 +373,8 @@ 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)
@@ -388,6 +390,7 @@ if(getRversion() >= "3.0.0") S3method(pillar::type_sum, av)
 if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic)
 if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo)
 if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir)
+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)

NEWS.md

@@ -1,3 +1,34 @@
+# 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
+* Fixed a bug in `eucast_rules()` for using specific custom rules
+* 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
+
+
 # AMR 3.0.0
 
 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.
@@ -122,7 +153,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
 
 ## Older Versions
 
-This changelog only contains changes from AMR v3.0 (March 2025) and later.
+This changelog only contains changes from AMR v3.0 (June 2025) and later.
 
 * For prior v2 versions, please see [our v2 archive](https://github.com/msberends/AMR/blob/v2.1.1/NEWS.md).
 * For prior v1 versions, please see [our v1 archive](https://github.com/msberends/AMR/blob/v1.8.2/NEWS.md).

R/aa_globals.R

@@ -233,6 +233,7 @@ globalVariables(c(
   "uti_index",
   "value",
   "varname",
+  "where",
   "x",
   "xvar",
   "y",

R/aa_helper_functions.R

@@ -63,31 +63,6 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
   merged
 }
 
-# support where() like tidyverse (this function will also be used when running `antibiogram()`):
-where <- function(fn) {
-  # based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
-  if (!is.function(fn)) {
-    stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
-  }
-  df <- pm_select_env$.data
-  cols <- pm_select_env$get_colnames()
-  if (is.null(df)) {
-    df <- get_current_data("where", call = FALSE)
-    cols <- colnames(df)
-  }
-  preds <- unlist(lapply(
-    df,
-    function(x, fn) {
-      do.call("fn", list(x))
-    },
-    fn
-  ))
-  if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
-  data_cols <- cols
-  cols <- data_cols[preds]
-  which(data_cols %in% cols)
-}
-
 # copied and slightly rewritten from {poorman} under permissive license (2021-10-15)
 # https://github.com/nathaneastwood/poorman, MIT licensed, Nathan Eastwood, 2020
 case_when_AMR <- function(...) {
@@ -510,11 +485,7 @@ word_wrap <- function(...,
   }
 
   # format backticks
-  if (pkg_is_available("cli") &&
-    tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE) &&
-    tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
-      return(FALSE)
-    }) &&
+  if (pkg_is_available("cli") && in_rstudio() &&
     tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) {
       return(FALSE)
     })) {
@@ -544,7 +515,7 @@ word_wrap <- function(...,
     )
     msg <- paste0(parts, collapse = "`")
   }
-  msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
+  msg <- gsub("`(.+?)`", font_grey_bg("`\\1`"), msg)
 
   # clean introduced whitespace in between fullstops
   msg <- gsub("[.] +[.]", "..", msg)
@@ -814,7 +785,7 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
 
   # if object is missing, or another error:
   tryCatch(invisible(object),
-    error = function(e) AMR_env$meet_criteria_error_txt <- e$message
+    error = function(e) AMR_env$meet_criteria_error_txt <- conditionMessage(e)
   )
   if (!is.null(AMR_env$meet_criteria_error_txt)) {
     error_txt <- AMR_env$meet_criteria_error_txt
@@ -1213,6 +1184,13 @@ reset_all_thrown_messages <- function() {
   )
 }
 
+in_rstudio <- function() {
+  identical(Sys.getenv("RSTUDIO"), "1")
+}
+in_positron <- function() {
+  identical(Sys.getenv("POSITRON"), "1")
+}
+
 has_colour <- function() {
   if (is.null(AMR_env$supports_colour)) {
     if (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") {
@@ -1244,8 +1222,10 @@ try_colour <- function(..., before, after, collapse = " ") {
   }
 }
 is_dark <- function() {
-  if (is.null(AMR_env$is_dark_theme)) {
-    AMR_env$is_dark_theme <- !has_colour() || tryCatch(isTRUE(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$dark), error = function(e) FALSE)
+  AMR_env$current_theme <- tryCatch(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$editor, error = function(e) NULL)
+  if (!identical(AMR_env$current_theme, AMR_env$former_theme) || is.null(AMR_env$is_dark_theme)) {
+    AMR_env$former_theme <- AMR_env$current_theme
+    AMR_env$is_dark_theme <- !has_colour() || tryCatch(isTRUE(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$dark), error = function(e) TRUE)
   }
   isTRUE(AMR_env$is_dark_theme)
 }
@@ -1317,6 +1297,10 @@ font_green_bg <- function(..., collapse = " ") {
   # this is #3caea3 (picked to be colourblind-safe with other SIR colours)
   try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
 }
+font_green_lighter_bg <- function(..., collapse = " ") {
+  # this is #8FD6C4 (picked to be colourblind-safe with other SIR colours)
+  try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;158m", after = "\033[49m", collapse = collapse)
+}
 font_purple_bg <- function(..., collapse = " ") {
   try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
 }
@@ -1634,6 +1618,36 @@ get_n_cores <- function(max_cores = Inf) {
   n_cores
 }
 
+# Support `where()` if tidyselect not installed ----
+if (!is.null(import_fn("where", "tidyselect", error_on_fail = FALSE))) {
+  # tidyselect::where() exists, load the namespace to make `where()`s work across the package in default arguments
+  loadNamespace("tidyselect")
+} else {
+  where <- function(fn) {
+    # based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
+    if (!is.function(fn)) {
+      stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
+    }
+    df <- pm_select_env$.data
+    cols <- pm_select_env$get_colnames()
+    if (is.null(df)) {
+      df <- get_current_data("where", call = FALSE)
+      cols <- colnames(df)
+    }
+    preds <- unlist(lapply(
+      df,
+      function(x, fn) {
+        do.call("fn", list(x))
+      },
+      fn
+    ))
+    if (!is.logical(preds)) stop_("`where()` must be used with functions that return `TRUE` or `FALSE`.")
+    data_cols <- cols
+    cols <- data_cols[preds]
+    which(data_cols %in% cols)
+  }
+}
+
 # Faster data.table implementations ----
 
 match <- function(x, table, ...) {
@@ -1653,52 +1667,6 @@ match <- function(x, table, ...) {
   }
 }
 
-# nolint start
-
-# Register S3 methods ----
-# copied from vctrs::s3_register by their permission:
-# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
-s3_register <- function(generic, class, method = NULL) {
-  stopifnot(is.character(generic), length(generic) == 1)
-  stopifnot(is.character(class), length(class) == 1)
-  pieces <- strsplit(generic, "::")[[1]]
-  stopifnot(length(pieces) == 2)
-  package <- pieces[[1]]
-  generic <- pieces[[2]]
-  caller <- parent.frame()
-  get_method_env <- function() {
-    top <- topenv(caller)
-    if (isNamespace(top)) {
-      asNamespace(environmentName(top))
-    } else {
-      caller
-    }
-  }
-  get_method <- function(method, env) {
-    if (is.null(method)) {
-      get(paste0(generic, ".", class), envir = get_method_env())
-    } else {
-      method
-    }
-  }
-  method_fn <- get_method(method)
-  stopifnot(is.function(method_fn))
-  setHook(packageEvent(package, "onLoad"), function(...) {
-    ns <- asNamespace(package)
-    method_fn <- get_method(method)
-    registerS3method(generic, class, method_fn, envir = ns)
-  })
-  if (!isNamespaceLoaded(package)) {
-    return(invisible())
-  }
-  envir <- asNamespace(package)
-  if (exists(generic, envir)) {
-    registerS3method(generic, class, method_fn, envir = envir)
-  }
-  invisible()
-}
-
-
 # Support old R versions ----
 # these functions were not available in previous versions of R
 # see here for the full list: https://github.com/r-lib/backports

R/aa_helper_pm_functions.R

@@ -952,7 +952,19 @@ pm_select_env$get_nrow <- function() nrow(pm_select_env$.data)
 pm_select_env$get_ncol <- function() ncol(pm_select_env$.data)
 
 pm_select <- function(.data, ...) {
-  col_pos <- pm_select_positions(.data, ..., .group_pos = TRUE)
+  # col_pos <- pm_select_positions(.data, ..., .group_pos = TRUE),
+  col_pos <- tryCatch(pm_select_positions(.data, ..., .group_pos = TRUE), error = function(e) NULL)
+  if (is.null(col_pos)) {
+    # try with tidyverse
+    select_dplyr <- import_fn("select", "dplyr", error_on_fail = FALSE)
+    if (!is.null(select_dplyr)) {
+      col_pos <- which(colnames(.data) %in% colnames(select_dplyr(.data, ...)))
+    } else {
+      # this will throw an error as it did, but dplyr is not available, so no other option
+      col_pos <- pm_select_positions(.data, ..., .group_pos = TRUE)
+    }
+  }
+
   map_names <- names(col_pos)
   map_names_length <- nchar(map_names)
   if (any(map_names_length == 0L)) {

R/ab.R

@@ -184,7 +184,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
   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)]
-  if (any(previously_coerced) && isTRUE(info) && message_not_thrown_before("as.ab", entire_session = TRUE)) {
+  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)) {
     message_(
       "Returning previously coerced ",
       ifelse(length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) > 1, "value for an antimicrobial", "values for various antimicrobials"),
@@ -201,6 +202,9 @@ 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 `as.ab()`: some input seems to resemble antiviral drugs - use `as.av()` or e.g. `av_name()` for these, not `as.ab()` or e.g. `ab_name()`.")
+    }
   }
 
   for (i in which(!already_known)) {
@@ -447,7 +451,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
   x_unknown <- x_unknown[!x_unknown %in% c("", NA)]
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
-      "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
+      "in `as.ab()`: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ",
       vector_and(x_unknown), "."
     )
   }
@@ -510,7 +514,7 @@ pillar_shaft.ab <- function(x, ...) {
   out[is.na(x)] <- font_na(NA)
 
   # add the names to the drugs as mouse-over!
-  if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
+  if (in_rstudio()) {
     out[!is.na(x)] <- font_url(
       url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
       txt = out[!is.na(x)]
@@ -626,6 +630,20 @@ 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
@@ -655,7 +673,9 @@ generalise_antibiotic_name <- function(x) {
   x <- trimws(gsub(" +", " ", x, perl = TRUE))
   # remove last couple of words if they numbers or units
   x <- gsub("( ([0-9]{3,}|U?M?C?G|L))+$", "", x, perl = TRUE)
-  # move HIGH to end
+  # remove whitespace prior to numbers if preceded by A-Z
+  x <- gsub("([A-Z]+) +([0-9]+)", "\\1\\2", x, perl = TRUE)
+  # move HIGH to the end
   x <- trimws(gsub("(.*) HIGH(.*)", "\\1\\2 HIGH", x, perl = TRUE))
   x
 }

R/ab_property.R

@@ -445,7 +445,7 @@ ab_validate <- function(x, property, ...) {
     # try to catch an error when inputting an invalid argument
     # so the 'call.' can be set to FALSE
     tryCatch(x[1L] %in% AMR_env$AB_lookup[1, property, drop = TRUE],
-      error = function(e) stop(e$message, call. = FALSE)
+      error = function(e) stop(conditionMessage(e), call. = FALSE)
     )
 
     if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) {

R/age.R

@@ -128,9 +128,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 
 #' Split Ages into Age Groups
 #'
-#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis.
+#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis. The function returns an ordered [factor].
 #' @param x Age, e.g. calculated with [age()].
 #' @param split_at Values to split `x` at - the default is age groups 0-11, 12-24, 25-54, 55-74 and 75+. See *Details*.
+#' @param names Optional names to be given to the various age groups.
 #' @param na.rm A [logical] to indicate whether missing values should be removed.
 #' @details To split ages, the input for the `split_at` argument can be:
 #'
@@ -152,6 +153,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 #'
 #' # split into 0-19, 20-49 and 50+
 #' age_groups(ages, c(20, 50))
+#' age_groups(ages, c(20, 50), names = c("Under 20 years", "20 to 50 years", "Over 50 years"))
 #'
 #' # split into groups of ten years
 #' age_groups(ages, 1:10 * 10)
@@ -181,9 +183,10 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 #'     )
 #' }
 #' }
-age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
+age_groups <- function(x, split_at = c(0, 12, 25, 55, 75), names = NULL, na.rm = FALSE) {
   meet_criteria(x, allow_class = c("numeric", "integer"), is_positive_or_zero = TRUE, is_finite = TRUE)
   meet_criteria(split_at, allow_class = c("numeric", "integer", "character"), is_positive_or_zero = TRUE, is_finite = TRUE)
+  meet_criteria(names, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(na.rm, allow_class = "logical", has_length = 1)
 
   if (any(x < 0, na.rm = TRUE)) {
@@ -208,7 +211,7 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
     split_at <- c(0, split_at)
   }
   split_at <- split_at[!is.na(split_at)]
-  stop_if(length(split_at) == 1, "invalid value for `split_at`") # only 0 is available
+  stop_if(length(split_at) == 1, "invalid value for `split_at`.") # only 0 is available
 
   # turn input values to 'split_at' indices
   y <- x
@@ -224,6 +227,11 @@ age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
 
   agegroups <- factor(lbls[y], levels = lbls, ordered = TRUE)
 
+  if (!is.null(names)) {
+    stop_ifnot(length(names) == length(levels(agegroups)), "`names` must have the same length as the number of age groups (", length(levels(agegroups)), ").")
+    levels(agegroups) <- names
+  }
+
   if (isTRUE(na.rm)) {
     agegroups <- agegroups[!is.na(agegroups)]
   }

R/amr_selectors.R

@@ -527,7 +527,7 @@ amr_selector <- function(filter,
   )
   call <- substitute(filter)
   agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE],
-    error = function(e) stop_(e$message, call = -5)
+    error = function(e) stop_(conditionMessage(e), call = -5)
   )
   agents <- ab_in_data[ab_in_data %in% agents]
   message_agent_names(
@@ -640,7 +640,7 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
         )
       }
     ),
-    error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE)
+    error = function(e) stop_("in not_intrinsic_resistant(): ", conditionMessage(e), call = FALSE)
   )
 
   agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])]

R/antibiogram.R

@@ -40,6 +40,7 @@
 #'   - A combination of the above, using `c()`, e.g.:
 #'     - `c(aminoglycosides(), "AMP", "AMC")`
 #'     - `c(aminoglycosides(), carbapenems())`
+#'   - Column indices using numbers
 #'   - Combination therapy, indicated by using `"+"`, with or without [antimicrobial selectors][antimicrobial_selectors], e.g.:
 #'     - `"cipro + genta"`
 #'     - `"TZP+TOB"`
@@ -452,7 +453,7 @@ antibiogram.default <- function(x,
     deprecation_warning("antibiotics", "antimicrobials", fn = "antibiogram", is_argument = TRUE)
     antimicrobials <- list(...)$antibiotics
   }
-  meet_criteria(antimicrobials, allow_class = "character", allow_NA = FALSE, allow_NULL = FALSE)
+  meet_criteria(antimicrobials, allow_class = c("character", "numeric", "integer"), allow_NA = FALSE, allow_NULL = FALSE)
   if (!is.function(mo_transform)) {
     meet_criteria(mo_transform, allow_class = "character", has_length = 1, is_in = c("name", "shortname", "gramstain", colnames(AMR::microorganisms)), allow_NULL = TRUE, allow_NA = TRUE)
   }
@@ -575,6 +576,15 @@ antibiogram.default <- function(x,
     }
     antimicrobials <- unlist(antimicrobials)
   } else {
+    existing_ab_combined_cols <- ab_trycatch[ab_trycatch %like% "[+]" & ab_trycatch %in% colnames(x)]
+    if (length(existing_ab_combined_cols) > 0 && !is.null(ab_transform)) {
+      ab_transform <- NULL
+      warning_(
+        "Detected column name(s) containing the '+' character, which conflicts with the expected syntax in `antibiogram()`: the '+' is used to combine separate antimicrobial agent columns (e.g., \"AMP+GEN\").\n\n",
+        "To avoid incorrectly guessing which antimicrobials this represents, `ab_transform` was automatically set to `NULL`.\n\n",
+        "If this is unintended, please rename the column(s) to avoid using '+' in the name, or set `ab_transform = NULL` explicitly to suppress this message."
+      )
+    }
     antimicrobials <- ab_trycatch
   }
 
@@ -1194,12 +1204,13 @@ retrieve_wisca_parameters <- function(wisca_model, ...) {
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_sum, antibiogram)
 tbl_sum.antibiogram <- function(x, ...) {
   dims <- paste(format(NROW(x), big.mark = ","), AMR_env$cross_icon, format(NCOL(x), big.mark = ","))
+  names(dims) <- "An Antibiogram"
   if (isTRUE(attributes(x)$wisca)) {
-    names(dims) <- paste0("An Antibiogram (WISCA / ", attributes(x)$conf_interval * 100, "% CI)")
+    dims <- c(dims, Type = paste0("WISCA with ", attributes(x)$conf_interval * 100, "% CI"))
   } else if (isTRUE(attributes(x)$formatting_type >= 13)) {
-    names(dims) <- paste0("An Antibiogram (non-WISCA / ", attributes(x)$conf_interval * 100, "% CI)")
+    dims <- c(dims, Type = paste0("Non-WISCA with ", attributes(x)$conf_interval * 100, "% CI"))
   } else {
-    names(dims) <- paste0("An Antibiogram (non-WISCA)")
+    dims <- c(dims, Type = paste0("Non-WISCA without CI"))
   }
   dims
 }

R/av_property.R

@@ -264,7 +264,7 @@ av_validate <- function(x, property, ...) {
     # try to catch an error when inputting an invalid argument
     # so the 'call.' can be set to FALSE
     tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
-      error = function(e) stop(e$message, call. = FALSE)
+      error = function(e) stop(conditionMessage(e), call. = FALSE)
     )
 
     if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {

R/count.R

@@ -126,7 +126,7 @@ count_resistant <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -139,7 +139,7 @@ count_susceptible <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -152,7 +152,7 @@ count_S <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -165,7 +165,7 @@ count_SI <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -178,7 +178,7 @@ count_I <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -191,7 +191,7 @@ count_IR <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -204,7 +204,7 @@ count_R <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -217,7 +217,7 @@ count_all <- function(..., only_all_tested = FALSE) {
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -240,6 +240,6 @@ count_df <- function(data,
       combine_SI = combine_SI,
       confidence_level = 0.95 # doesn't matter, will be removed
     ),
-    error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }

R/custom_mdro_guideline.R

@@ -175,7 +175,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
 
     # Value
     val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL)
-    stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) e$message))
+    stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) conditionMessage(e)))
     stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
     out[[i]]$value <- as.character(val)
   }
@@ -254,7 +254,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
   for (i in seq_len(n_dots)) {
     qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
       error = function(e) {
-        AMR_env$err_msg <- e$message
+        AMR_env$err_msg <- conditionMessage(e)
         return("error")
       }
     )

R/data.R

@@ -361,3 +361,15 @@
 #' @examples
 #' dosage
 "dosage"
+
+# TODO #' Data Set with `r format(nrow(esbl_isolates), big.mark = " ")` ESBL Isolates
+# TODO #'
+# TODO #' A data set containing `r format(nrow(esbl_isolates), big.mark = " ")` microbial isolates with MIC values of common antibiotics and a binary `esbl` column for extended-spectrum beta-lactamase (ESBL) production. This data set contains randomised fictitious data but reflects reality and can be used to practise AMR-related machine learning, e.g., classification modelling with [tidymodels](https://amr-for-r.org/articles/AMR_with_tidymodels.html).
+# TODO #' @format A [tibble][tibble::tibble] with `r format(nrow(esbl_isolates), big.mark = " ")` observations and `r ncol(esbl_isolates)` variables:
+# TODO #' - `esbl`\cr Logical indicator if the isolate is ESBL-producing
+# TODO #' - `genus`\cr Genus of the microorganism
+# TODO #' - `AMC:COL`\cr MIC values for 17 antimicrobial agents, transformed to class [`mic`] (see [as.mic()])
+# TODO #' @details See our [tidymodels integration][amr-tidymodels] for an example using this data set.
+# TODO #' @examples
+# TODO #' esbl_isolates
+# TODO "esbl_isolates"

R/disk.R

@@ -236,12 +236,14 @@ 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",
-    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(.)))
+    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)
   )
 }

R/eucast_rules.R

@@ -442,7 +442,7 @@ eucast_rules <- function(x,
     # big speed gain! only analyse unique rows:
     pm_distinct(`.rowid`, .keep_all = TRUE) %pm>%
     as.data.frame(stringsAsFactors = FALSE)
-  x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]), info = info)
+  x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]), info = FALSE)
   # rename col_mo to prevent interference with joined columns
   colnames(x)[colnames(x) == col_mo] <- ".col_mo"
   col_mo <- ".col_mo"
@@ -450,13 +450,20 @@ eucast_rules <- function(x,
   x <- left_join_microorganisms(x, by = col_mo, suffix = c("_oldcols", ""))
   x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL, info = FALSE)
   x$genus_species <- trimws(paste(x$genus, x$species))
-  if (isTRUE(info) && NROW(x) > 10000) {
-    message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
+  if (isTRUE(info) && NROW(x.bak) > 10000) {
+    message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
   }
 
   n_added <- 0
   n_changed <- 0
 
+  rule_current <- ""
+  rule_group_current <- ""
+  rule_group_previous <- ""
+  rule_next <- ""
+  rule_previous <- ""
+  rule_text <- ""
+
   # >>> Apply Other rules: enzyme inhibitors <<< ------------------------------------------
   if (any(c("all", "other") %in% rules)) {
     if (isTRUE(info)) {
@@ -617,31 +624,16 @@ eucast_rules <- function(x,
     eucast_rules_df <- eucast_rules_df %pm>%
       rbind_AMR(eucast_rules_df_total %pm>%
         subset(reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints))
-    # eucast_rules_df <- subset(
-    #   eucast_rules_df,
-    #   reference.rule_group %unlike% "breakpoint" |
-    #     (reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints)
-    # )
   }
   if (any(c("all", "expected_phenotypes") %in% rules)) {
     eucast_rules_df <- eucast_rules_df %pm>%
       rbind_AMR(eucast_rules_df_total %pm>%
         subset(reference.rule_group %like% "expected" & reference.version == version_expected_phenotypes))
-    # eucast_rules_df <- subset(
-    #   eucast_rules_df,
-    #   reference.rule_group %unlike% "expected" |
-    #     (reference.rule_group %like% "expected" & reference.version == version_expected_phenotypes)
-    # )
   }
   if (any(c("all", "expert") %in% rules)) {
     eucast_rules_df <- eucast_rules_df %pm>%
       rbind_AMR(eucast_rules_df_total %pm>%
         subset(reference.rule_group %like% "expert" & reference.version == version_expertrules))
-    # eucast_rules_df <- subset(
-    #   eucast_rules_df,
-    #   reference.rule_group %unlike% "expert" |
-    #     (reference.rule_group %like% "expert" & reference.version == version_expertrules)
-    # )
   }
   ## filter out AmpC de-repressed cephalosporin-resistant mutants ----
   # no need to filter on version number here - the rules contain these version number, so are inherently filtered
@@ -664,6 +656,9 @@ eucast_rules <- function(x,
   # we only hints on remaining rows in `eucast_rules_df`
   screening_abx <- as.character(AMR::antimicrobials$ab[which(AMR::antimicrobials$ab %like% "-S$")])
   screening_abx <- screening_abx[screening_abx %in% unique(unlist(strsplit(EUCAST_RULES_DF$and_these_antibiotics[!is.na(EUCAST_RULES_DF$and_these_antibiotics)], ", *")))]
+  if (isTRUE(info)) {
+    cat("\n")
+  }
   for (ab_s in screening_abx) {
     ab <- gsub("-S$", "", ab_s)
     if (ab %in% names(cols_ab) && !ab_s %in% names(cols_ab)) {
@@ -894,7 +889,9 @@ eucast_rules <- function(x,
     }
     for (i in seq_len(length(custom_rules))) {
       rule <- custom_rules[[i]]
-      rows <- which(eval(parse(text = rule$query), envir = x))
+      rows <- tryCatch(which(eval(parse(text = rule$query), envir = x)),
+        error = function(e) stop_(paste0(conditionMessage(e), font_red(" (check available data and compare with the custom rules set)")), call = FALSE)
+      )
       cols <- as.character(rule$result_group)
       cols <- c(
         cols[cols %in% colnames(x)], # direct column names
@@ -908,9 +905,8 @@ eucast_rules <- function(x,
         get_antibiotic_names(cols)
       )
       if (isTRUE(info)) {
-        # print rule
         cat(italicise_taxonomy(
-          word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
+          word_wrap(rule_text,
             width = getOption("width") - 30,
             extra_indent = 6
           ),
@@ -1182,7 +1178,7 @@ edit_sir <- function(x,
             ifelse(length(rows) > 10, "...", ""),
             " while writing value '", to,
             "' to column(s) `", paste(cols, collapse = "`, `"),
-            "`:\n", e$message
+            "`:\n", conditionMessage(e)
           ),
           call. = FALSE
         )

R/first_isolate.R

@@ -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,21 +89,29 @@
 #' | - Major difference in any antimicrobial result   | - `first_isolate(x, type = "points")`                 |
 #' | - Any difference in key antimicrobial results    | - `first_isolate(x, type = "keyantimicrobials")`      |
 #'
-#' ### Isolate-based
+#' **Isolate-based**
+#'
+#' _Minimum variables required: Microorganism identifier_
 #'
 #' 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**
 #'
-#' 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.
+#' _Minimum variables required: Microorganism identifier, Patient identifier_
 #'
-#' ### Episode-based
+#' 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.
 #'
-#' 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.
+#' **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.
 #'
 #' 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
+#' **Phenotype-based**
+#'
+#' _Minimum variables required: Microorganism identifier, Patient identifier, Date, Antimicrobial test results_
 #'
 #' 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:
 #'

R/ggplot_sir.R

@@ -177,6 +177,7 @@ ggplot_sir <- function(data,
                        nrow = NULL,
                        colours = c(
                          S = "#3CAEA3",
+                         SDD = "#8FD6C4",
                          SI = "#3CAEA3",
                          I = "#F6D55C",
                          IR = "#ED553B",
@@ -205,7 +206,7 @@ ggplot_sir <- function(data,
   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)
-  meet_criteria(colours, allow_class = c("character", "logical"))
+  meet_criteria(colours, allow_class = c("character", "logical"), allow_NULL = TRUE)
   meet_criteria(datalabels, allow_class = "logical", has_length = 1)
   meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
   meet_criteria(datalabels.colour, allow_class = "character", has_length = 1)
@@ -245,7 +246,7 @@ ggplot_sir <- function(data,
     ) +
     theme_sir()
 
-  if (fill == "interpretation") {
+  if (fill == "interpretation" && !is.null(colours) && !isFALSE(colours)) {
     p <- suppressWarnings(p + scale_sir_colours(aesthetics = "fill", colours = colours))
   }
 

R/mdro.R

@@ -41,7 +41,7 @@
 #' @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.
-#' @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.
+#' @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.
 #' @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*.
 #'
@@ -174,48 +174,23 @@ mdro <- function(x = NULL,
   }
 
   # get gene values as TRUE/FALSE
-  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))
+  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
   }
+  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
@@ -772,7 +747,7 @@ mdro <- function(x = NULL,
         )
       }
       x[rows_to_change, "MDRO"] <<- to
-      x[rows_to_change, "reason"] <<- reason
+      x[rows_to_change, "reason"] <<- paste0(x[rows_to_change, "reason", drop = TRUE], "; ", reason)
       x[rows_not_to_change, "reason"] <<- "guideline criteria not met"
     }
   }
@@ -854,7 +829,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 <- NA_character_
+  x$reason <- ""
   x$all_nonsusceptible_columns <- ""
 
   if (guideline$code == "cmi2012") {
@@ -1498,7 +1473,7 @@ mdro <- function(x = NULL,
     }
     trans_tbl(
       3, # positive
-      rows = which(x$order == "Enterobacterales" & esbl == TRUE),
+      rows = which(x$order == "Enterobacterales" & x$esbl == TRUE),
       cols = "any",
       any_all = "any",
       reason = "Enterobacterales: ESBL"
@@ -1519,17 +1494,18 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      rows = which(x$order == "Enterobacterales" & carbapenemase == TRUE),
+      rows = which(x$order == "Enterobacterales" & x$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"]
     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$genus %in% c("Enterobacter", "Providencia") | paste(x$genus, x$species) %in% c("Citrobacter freundii", "Klebsiella aerogenes", "Hafnia alvei", "Morganella morganii"))),
+        (x$genus %in% c("Enterobacter", "Providencia") | paste(x$genus, x$species) %in% c(c.freundii_complex, "Klebsiella aerogenes", "Hafnia alvei", "Morganella morganii"))),
       cols = c(SXT, aminoglycosides, fluoroquinolones),
       any_all = "any",
       reason = "Enterobacterales group II: aminoglycoside + fluoroquinolone + cotrimoxazol"
@@ -1557,14 +1533,14 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       2, # unconfirmed
-      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & is.na(carbapenemase)),
+      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & is.na(x$carbapenemase)),
       cols = carbapenems,
       any_all = "any",
       reason = "A. baumannii-calcoaceticus complex: potential carbapenemase"
     )
     trans_tbl(
       3,
-      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & carbapenemase == TRUE),
+      rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & x$carbapenemase == TRUE),
       cols = carbapenems,
       any_all = "any",
       reason = "A. baumannii-calcoaceticus complex: carbapenemase"
@@ -1574,6 +1550,7 @@ 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)
@@ -1602,7 +1579,7 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      rows = which(x$genus == "Enterococcus" & x$species == "faecium" & (vanA == TRUE | vanB == TRUE)),
+      rows = which(x$genus == "Enterococcus" & x$species == "faecium" & (x$vanA == TRUE | x$vanB == TRUE)),
       cols = c(PEN, AMX, AMP, VAN),
       any_all = "any",
       reason = "E. faecium: vanA/vanB gene + penicillin group"
@@ -1611,14 +1588,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(mecA) | is.na(mecC))),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (is.na(x$mecA) | is.na(x$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") & (mecA == TRUE | mecC == TRUE)),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (x$mecA == TRUE | x$mecC == TRUE)),
       cols = "any",
       any_all = "any",
       reason = "S. aureus complex: mecA/mecC gene"
@@ -1899,6 +1876,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)

R/mean_amr_distance.R

@@ -31,7 +31,7 @@
 #'
 #' Calculates a normalised mean for antimicrobial resistance between multiple observations, to help to identify similar isolates without comparing antibiograms by hand.
 #' @param x A vector of class [sir][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes.
-#' @param ... Variables to select. Supports [tidyselect language][tidyselect::language] (such as `column1:column4` and `where(is.mic)`), and can thus also be [antimicrobial selectors][amr_selector()].
+#' @param ... Variables to select. Supports [tidyselect language][tidyselect::starts_with()] such as `where(is.mic)`, `starts_with(...)`, or `column1:column4`, and can thus also be [antimicrobial selectors][amr_selector()].
 #' @param combine_SI A [logical] to indicate whether all values of S, SDD, and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`.
 #' @details The mean AMR distance is effectively [the Z-score](https://en.wikipedia.org/wiki/Standard_score); a normalised numeric value to compare AMR test results which can help to identify similar isolates, without comparing antibiograms by hand.
 #'

R/mic.R

@@ -432,11 +432,17 @@ pillar_shaft.mic <- function(x, ...) {
   }
   crude_numbers <- as.double(x)
   operators <- gsub("[^<=>]+", "", as.character(x))
+  # colourise 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)] <- font_na(NA)
   # make trailing zeroes less visible
-  out[out %like% "[.]"] <- gsub("([.]?0+)$", font_silver("\\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))))
 }
 
@@ -590,12 +596,12 @@ 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(., 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)
+    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)
   )
 }
 

R/mo.R

@@ -675,7 +675,7 @@ pillar_shaft.mo <- function(x, ...) {
   }
 
   # add the names to the bugs as mouse-over!
-  if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
+  if (in_rstudio()) {
     out[!x %in% c("UNKNOWN", NA)] <- font_url(
       url = paste0(
         x[!x %in% c("UNKNOWN", NA)], ": ",
@@ -747,13 +747,17 @@ 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",
-    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]
+    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],
   )
 }
 
@@ -1186,7 +1190,7 @@ parse_and_convert <- function(x) {
         parsed <- gsub('"', "", parsed, fixed = TRUE)
         parsed
       },
-      error = function(e) stop(e$message, call. = FALSE)
+      error = function(e) stop(conditionMessage(e), call. = FALSE)
     ) # this will also be thrown when running `as.mo(no_existing_object)`
   }
   out <- trimws2(out)

R/mo_property.R

@@ -974,7 +974,7 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
   # try to catch an error when inputting an invalid argument
   # so the 'call.' can be set to FALSE
   tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]),
-    error = function(e) stop(e$message, call. = FALSE)
+    error = function(e) stop(conditionMessage(e), call. = FALSE)
   )
 
   dots <- list(...)

R/pca.R

@@ -99,7 +99,7 @@ pca <- function(x,
     new_list <- list(0)
     for (i in seq_len(length(dots) - 1)) {
       new_list[[i]] <- tryCatch(eval(dots[[i + 1]], envir = x),
-        error = function(e) stop(e$message, call. = FALSE)
+        error = function(e) stop(conditionMessage(e), call. = FALSE)
       )
       if (length(new_list[[i]]) == 1) {
         if (is.character(new_list[[i]]) && new_list[[i]] %in% colnames(x)) {

R/plotting.R

@@ -52,11 +52,19 @@
 #' @details
 #' ### The `scale_*_mic()` Functions
 #'
-#' The functions [scale_x_mic()], [scale_y_mic()], [scale_colour_mic()], and [scale_fill_mic()] functions allow to plot the [mic][as.mic()] class (MIC values) on a continuous, logarithmic scale. They also allow to rescale the MIC range with an 'inside' or 'outside' range if required, and retain the operators in MIC values (such as `>=`) if desired. Missing intermediate log2 levels will be plotted too.
+#' The functions [scale_x_mic()], [scale_y_mic()], [scale_colour_mic()], and [scale_fill_mic()] functions allow to plot the [mic][as.mic()] class (MIC values) on a continuous, logarithmic scale.
+#' 
+#' There is normally no need to add these scale functions to your plot, as they are applied automatically when plotting values of class [mic][as.mic()].
+#' 
+#' When manually added though, they allow to rescale the MIC range with an 'inside' or 'outside' range if required, and provide the option to retain the operators in MIC values (such as `>=`). Missing intermediate log2 levels will always be plotted too.
 #'
 #' ### The `scale_*_sir()` Functions
 #'
-#' The functions [scale_x_sir()], [scale_colour_sir()], and [scale_fill_sir()] functions allow to plot the [sir][as.sir()] class in the right order (`r paste(levels(NA_sir_), collapse = " < ")`). At default, they translate the S/I/R values to an interpretative text ("Susceptible", "Resistant", etc.) in any of the `r length(AMR:::LANGUAGES_SUPPORTED)` supported languages (use `language = NULL` to keep S/I/R). Also, except for [scale_x_sir()], they set colour-blind friendly colours to the `colour` and `fill` aesthetics.
+#' The functions [scale_x_sir()], [scale_colour_sir()], and [scale_fill_sir()] functions allow to plot the [sir][as.sir()] class in the right order (`r paste(levels(NA_sir_), collapse = " < ")`).
+#' 
+#' There is normally no need to add these scale functions to your plot, as they are applied automatically when plotting values of class [sir][as.sir()].
+#' 
+#' At default, they translate the S/I/R values to an interpretative text ("Susceptible", "Resistant", etc.) in any of the `r length(AMR:::LANGUAGES_SUPPORTED)` supported languages (use `language = NULL` to keep S/I/R). Also, except for [scale_x_sir()], they set colour-blind friendly colours to the `colour` and `fill` aesthetics.
 #'
 #' ### Additional `ggplot2` Functions
 #'
@@ -90,6 +98,10 @@
 #'   autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro")
 #' }
 #' if (require("ggplot2")) {
+#'   autoplot(some_mic_values, mo = "Staph aureus", ab = "Ceftaroline", guideline = "CLSI")
+#' }
+#'
+#' if (require("ggplot2")) {
 #'   # support for 27 languages, various guidelines, and many options
 #'   autoplot(some_disk_values,
 #'     mo = "Escherichia coli", ab = "cipro",
@@ -110,17 +122,12 @@
 #'   ) +
 #'     geom_col()
 #'   mic_plot +
-#'     labs(title = "without scale_x_mic()")
+#'     labs(title = "scale_x_mic() automatically applied")
 #' }
 #' if (require("ggplot2")) {
 #'   mic_plot +
-#'     scale_x_mic() +
-#'     labs(title = "with scale_x_mic()")
-#' }
-#' if (require("ggplot2")) {
-#'   mic_plot +
-#'     scale_x_mic(keep_operators = "all") +
-#'     labs(title = "with scale_x_mic() keeping all operators")
+#'     scale_x_mic(keep_operators = "none") +
+#'     labs(title = "with scale_x_mic() keeping no operators")
 #' }
 #' if (require("ggplot2")) {
 #'   mic_plot +
@@ -146,8 +153,8 @@
 #'     aes(group, mic)
 #'   ) +
 #'     geom_boxplot() +
-#'     geom_violin(linetype = 2, colour = "grey", fill = NA) +
-#'     scale_y_mic()
+#'     geom_violin(linetype = 2, colour = "grey30", fill = NA) +
+#'     labs(title = "scale_y_mic() automatically applied")
 #' }
 #' if (require("ggplot2")) {
 #'   ggplot(
@@ -158,7 +165,7 @@
 #'     aes(group, mic)
 #'   ) +
 #'     geom_boxplot() +
-#'     geom_violin(linetype = 2, colour = "grey", fill = NA) +
+#'     geom_violin(linetype = 2, colour = "grey30", fill = NA) +
 #'     scale_y_mic(mic_range = c(NA, 0.25))
 #' }
 #'
@@ -179,7 +186,7 @@
 #'
 #' # Plotting using scale_y_mic() and scale_colour_sir() ------------------
 #' if (require("ggplot2")) {
-#'   plain <- ggplot(
+#'   mic_sir_plot <- ggplot(
 #'     data.frame(
 #'       mic = some_mic_values,
 #'       group = some_groups,
@@ -191,23 +198,18 @@
 #'     aes(x = group, y = mic, colour = sir)
 #'   ) +
 #'     theme_minimal() +
-#'     geom_boxplot(fill = NA, colour = "grey") +
+#'     geom_boxplot(fill = NA, colour = "grey30") +
 #'     geom_jitter(width = 0.25)
-#'
-#'   plain
+#'     labs(title = "scale_y_mic()/scale_colour_sir() automatically applied")
+#'     
+#'   mic_sir_plot
 #' }
 #' if (require("ggplot2")) {
-#'   # and now with our MIC and SIR scale functions:
-#'   plain +
-#'     scale_y_mic() +
-#'     scale_colour_sir()
-#' }
-#' if (require("ggplot2")) {
-#'   plain +
+#'   mic_sir_plot +
 #'     scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
 #'     scale_colour_sir(
-#'       language = "pt",
-#'       name = "Support in 27 languages"
+#'       language = "pt", # Portuguese
+#'       name = "Support in 28 languages"
 #'     )
 #' }
 #' }
@@ -225,6 +227,9 @@
 #' plot(some_sir_values)
 NULL
 
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::scale_type, mic)
+scale_type.mic <- function(x) c("mic", "discrete")
+
 create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
   ggplot_fn <- getExportedValue(paste0("scale_", aest, "_continuous"),
     ns = asNamespace("ggplot2")
@@ -243,6 +248,7 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
     as.double(rescale_mic(x = as.double(as.mic(x)), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE))
   }
   scale$transform_df <- function(self, df) {
+    out <- list()
     if (!aest %in% colnames(df)) {
       # support for geom_hline(), geom_vline(), etc
       other_x <- c("xintercept", "xmin", "xmax", "xend", "width")
@@ -254,11 +260,11 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
       } else {
         stop_("No support for plotting df with `scale_", aest, "_mic()` with columns ", vector_and(colnames(df), sort = FALSE))
       }
-      out <- rescale_mic(x = as.double(as.mic(df[[aest_val]])), keep_operators = "none", mic_range = NULL, as.mic = TRUE)
-      if (!is.null(self$mic_values_rescaled) && any(out < min(self$mic_values_rescaled, na.rm = TRUE) | out > max(self$mic_values_rescaled, na.rm = TRUE), na.rm = TRUE)) {
+      mics <- rescale_mic(x = as.double(as.mic(df[[aest_val]])), keep_operators = "none", mic_range = NULL, as.mic = TRUE)
+      if (!is.null(self$mic_values_rescaled) && any(mics < min(self$mic_values_rescaled, na.rm = TRUE) | mics > max(self$mic_values_rescaled, na.rm = TRUE), na.rm = TRUE)) {
         warning_("The value for `", aest_val, "` is outside the plotted MIC range, consider using/updating the `mic_range` argument in `scale_", aest, "_mic()`.")
       }
-      df[[aest_val]] <- log2(as.double(out))
+      out[[aest_val]] <- log2(as.double(mics))
     } else {
       self$mic_values_rescaled <- rescale_mic(x = as.double(as.mic(df[[aest]])), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
       # create new breaks and labels here
@@ -279,14 +285,18 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
         self$mic_values_levels[1] <- paste0("<=", self$mic_values_levels[1])
         self$mic_values_levels[length(self$mic_values_levels)] <- paste0(">=", self$mic_values_levels[length(self$mic_values_levels)])
       }
-
       self$mic_values_log <- log2(as.double(self$mic_values_rescaled))
-      if (aest == "y" && "group" %in% colnames(df) && "x" %in% colnames(df)) {
-        df$group <- as.integer(factor(df$x))
+
+      if (aest == "y" && "group" %in% colnames(df)) {
+        if (!"x" %in% colnames(df) || all(is.na(df$x))) {
+          out$group <- 1
+        } else {
+          out$group <- as.integer(factor(df$x))
+        }
       }
-      df[[aest]] <- self$mic_values_log
+      out[[aest]] <- self$mic_values_log
     }
-    df
+    out
   }
 
   scale$breaks <- function(..., self) {
@@ -313,7 +323,6 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
       }
     }
   }
-
   scale$limits <- function(x, ..., self) {
     if (!is.null(self$mic_limits_set)) {
       if (is.function(self$mic_limits_set)) {
@@ -325,7 +334,7 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
       rng <- range(log2(as.mic(self$mic_values_levels)))
       # add 0.5 extra space
       rng <- c(rng[1] - 0.5, rng[2] + 0.5)
-      if (!is.na(x[1]) && x[1] == 0) {
+      if (!is.null(x) && !is.na(x[1]) && x[1] == 0) {
         # scale that start at 0 must remain so, e.g. in case of geom_col()
         rng[1] <- 0
       }
@@ -373,10 +382,15 @@ scale_fill_mic <- function(keep_operators = "edges", mic_range = NULL, ...) {
   create_scale_mic("fill", keep_operators = keep_operators, mic_range = mic_range, ...)
 }
 
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::scale_type, sir)
+scale_type.sir <- function(x) c("sir", "discrete")
+
 create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
   args <- list(...)
   args[c("value", "labels", "limits")] <- NULL
 
+  colours_SIR <- expand_SIR_colours(colours_SIR, unname = FALSE)
+
   if (identical(aesthetics, "x")) {
     ggplot_fn <- ggplot2::scale_x_discrete
   } else {
@@ -385,24 +399,19 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
       args,
       list(
         aesthetics = aesthetics,
-        values = c(
-          S = colours_SIR[1],
-          SDD = colours_SIR[2],
-          I = colours_SIR[2],
-          R = colours_SIR[3],
-          NI = "grey30"
-        )
+        values = c(colours_SIR, NI = "grey30")
       )
     )
   }
   scale <- do.call(ggplot_fn, args)
 
   scale$labels <- function(x) {
-    stop_ifnot(all(x %in% c(levels(NA_sir_), NA)),
+    stop_ifnot(all(x %in% c(levels(NA_sir_), "SI", "IR", NA)),
       "Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.",
       call = FALSE
     )
-    x <- as.character(as.sir(x))
+    x <- as.character(x)
+    x[!x %in% c("SI", "IR")] <- as.character(as.sir(x[!x %in% c("SI", "IR")]))
     if (!is.null(language)) {
       x[x == "S"] <- "(S) Susceptible"
       x[x == "SDD"] <- "(SDD) Susceptible dose-dependent"
@@ -412,6 +421,8 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
         x[x == "I"] <- "(I) Intermediate"
       }
       x[x == "R"] <- "(R) Resistant"
+      x[x == "SI"] <- "(S/I) Susceptible"
+      x[x == "IR"] <- "(I/R) Non-susceptible"
       x[x == "NI"] <- "(NI) Non-interpretable"
       x <- translate_AMR(x, language = language)
     }
@@ -419,7 +430,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
   }
   scale$limits <- function(x, ...) {
     # force SIR in the right order
-    as.character(sort(factor(x, levels = levels(NA_sir_))))
+    as.character(sort(factor(x, levels = c(levels(NA_sir_), "SI", "IR"))))
   }
 
   scale
@@ -427,11 +438,16 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
 
 #' @rdname plot
 #' @export
-scale_x_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+scale_x_sir <- function(colours_SIR = c(
+                          S = "#3CAEA3",
+                          SDD = "#8FD6C4",
+                          I = "#F6D55C",
+                          R = "#ED553B"
+                        ),
                         language = get_AMR_locale(),
                         eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
                         ...) {
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
   create_scale_sir(aesthetics = "x", colours_SIR = colours_SIR, language = language, eucast_I = eucast_I)
@@ -439,11 +455,16 @@ scale_x_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
 
 #' @rdname plot
 #' @export
-scale_colour_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+scale_colour_sir <- function(colours_SIR = c(
+                               S = "#3CAEA3",
+                               SDD = "#8FD6C4",
+                               I = "#F6D55C",
+                               R = "#ED553B"
+                             ),
                              language = get_AMR_locale(),
                              eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
                              ...) {
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
   args <- list(...)
@@ -463,11 +484,16 @@ scale_color_sir <- scale_colour_sir
 
 #' @rdname plot
 #' @export
-scale_fill_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+scale_fill_sir <- function(colours_SIR = c(
+                             S = "#3CAEA3",
+                             SDD = "#8FD6C4",
+                             I = "#F6D55C",
+                             R = "#ED553B"
+                           ),
                            language = get_AMR_locale(),
                            eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
                            ...) {
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
   args <- list(...)
@@ -491,7 +517,12 @@ plot.mic <- function(x,
                      main = deparse(substitute(x)),
                      ylab = translate_AMR("Frequency", language = language),
                      xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
-                     colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                     colours_SIR = c(
+                       S = "#3CAEA3",
+                       SDD = "#8FD6C4",
+                       I = "#F6D55C",
+                       R = "#ED553B"
+                     ),
                      language = get_AMR_locale(),
                      expand = TRUE,
                      include_PKPD = getOption("AMR_include_PKPD", TRUE),
@@ -503,16 +534,13 @@ plot.mic <- function(x,
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
   x <- as.mic(x) # make sure that currently implemented MIC levels are used
-
-  if (length(colours_SIR) == 1) {
-    colours_SIR <- rep(colours_SIR, 3)
-  }
   main <- gsub(" +", " ", paste0(main, collapse = " "))
+  colours_SIR <- expand_SIR_colours(colours_SIR)
 
   x <- plotrange_as_table(x, expand = expand)
   cols_sub <- plot_colours_subtitle_guideline(
@@ -549,13 +577,17 @@ plot.mic <- function(x,
       legend_col <- colours_SIR[1]
     }
     if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
+      legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent")
       legend_col <- c(legend_col, colours_SIR[2])
     }
     if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, "(R) Resistant")
+      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
       legend_col <- c(legend_col, colours_SIR[3])
     }
+    if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) {
+      legend_txt <- c(legend_txt, "(R) Resistant")
+      legend_col <- c(legend_col, colours_SIR[4])
+    }
 
     legend("top",
       x.intersp = 0.5,
@@ -580,7 +612,12 @@ barplot.mic <- function(height,
                         main = deparse(substitute(height)),
                         ylab = translate_AMR("Frequency", language = language),
                         xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
-                        colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                        colours_SIR = c(
+                          S = "#3CAEA3",
+                          SDD = "#8FD6C4",
+                          I = "#F6D55C",
+                          R = "#ED553B"
+                        ),
                         language = get_AMR_locale(),
                         expand = TRUE,
                         ...) {
@@ -590,7 +627,7 @@ barplot.mic <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
@@ -622,7 +659,12 @@ autoplot.mic <- function(object,
                          title = deparse(substitute(object)),
                          ylab = translate_AMR("Frequency", language = language),
                          xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
-                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                         colours_SIR = c(
+                           S = "#3CAEA3",
+                           SDD = "#8FD6C4",
+                           I = "#F6D55C",
+                           R = "#ED553B"
+                         ),
                          language = get_AMR_locale(),
                          expand = TRUE,
                          include_PKPD = getOption("AMR_include_PKPD", TRUE),
@@ -635,7 +677,7 @@ autoplot.mic <- function(object,
   meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
@@ -646,6 +688,8 @@ autoplot.mic <- function(object,
     title <- gsub(" +", " ", paste0(title, collapse = " "))
   }
 
+  colours_SIR <- expand_SIR_colours(colours_SIR)
+
   object <- as.mic(object) # make sure that currently implemented MIC levels are used
   x <- plotrange_as_table(object, expand = expand)
   cols_sub <- plot_colours_subtitle_guideline(
@@ -665,12 +709,14 @@ autoplot.mic <- function(object,
   colnames(df) <- c("mic", "count")
   df$cols <- cols_sub$cols
   df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
-  df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
-  df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
+  df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent"
+  df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
+  df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
     levels = translate_into_language(
       c(
         "(S) Susceptible",
+        "(SDD) Susceptible dose-dependent",
         paste("(I)", plot_name_of_I(cols_sub$guideline)),
         "(R) Resistant"
       ),
@@ -684,10 +730,10 @@ autoplot.mic <- function(object,
     vals <- c(
       "(S) Susceptible" = colours_SIR[1],
       "(SDD) Susceptible dose-dependent" = colours_SIR[2],
-      "(I) Susceptible, incr. exp." = colours_SIR[2],
-      "(I) Intermediate" = colours_SIR[2],
-      "(R) Resistant" = colours_SIR[3],
-      "(NI) Non-interpretable" = "grey"
+      "(I) Susceptible, incr. exp." = colours_SIR[3],
+      "(I) Intermediate" = colours_SIR[3],
+      "(R) Resistant" = colours_SIR[4],
+      "(NI) Non-interpretable" = "grey30"
     )
     names(vals) <- translate_into_language(names(vals), language = language)
     p <- p +
@@ -731,7 +777,12 @@ plot.disk <- function(x,
                       mo = NULL,
                       ab = NULL,
                       guideline = getOption("AMR_guideline", "EUCAST"),
-                      colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                      colours_SIR = c(
+                        S = "#3CAEA3",
+                        SDD = "#8FD6C4",
+                        I = "#F6D55C",
+                        R = "#ED553B"
+                      ),
                       language = get_AMR_locale(),
                       expand = TRUE,
                       include_PKPD = getOption("AMR_include_PKPD", TRUE),
@@ -743,14 +794,12 @@ plot.disk <- function(x,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  if (length(colours_SIR) == 1) {
-    colours_SIR <- rep(colours_SIR, 3)
-  }
   main <- gsub(" +", " ", paste0(main, collapse = " "))
+  colours_SIR <- expand_SIR_colours(colours_SIR)
 
   x <- plotrange_as_table(x, expand = expand)
   cols_sub <- plot_colours_subtitle_guideline(
@@ -783,12 +832,16 @@ plot.disk <- function(x,
   if (any(colours_SIR %in% cols_sub$cols)) {
     legend_txt <- character(0)
     legend_col <- character(0)
-    if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
+    if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) {
       legend_txt <- "(R) Resistant"
-      legend_col <- colours_SIR[3]
+      legend_col <- colours_SIR[4]
+    }
+    if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
+      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
+      legend_col <- c(legend_col, colours_SIR[3])
     }
     if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
+      legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent")
       legend_col <- c(legend_col, colours_SIR[2])
     }
     if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
@@ -818,7 +871,12 @@ barplot.disk <- function(height,
                          mo = NULL,
                          ab = NULL,
                          guideline = getOption("AMR_guideline", "EUCAST"),
-                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                         colours_SIR = c(
+                           S = "#3CAEA3",
+                           SDD = "#8FD6C4",
+                           I = "#F6D55C",
+                           R = "#ED553B"
+                         ),
                          language = get_AMR_locale(),
                          expand = TRUE,
                          ...) {
@@ -828,7 +886,7 @@ barplot.disk <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
@@ -858,7 +916,12 @@ autoplot.disk <- function(object,
                           ylab = translate_AMR("Frequency", language = language),
                           xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                           guideline = getOption("AMR_guideline", "EUCAST"),
-                          colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                          colours_SIR = c(
+                            S = "#3CAEA3",
+                            SDD = "#8FD6C4",
+                            I = "#F6D55C",
+                            R = "#ED553B"
+                          ),
                           language = get_AMR_locale(),
                           expand = TRUE,
                           include_PKPD = getOption("AMR_include_PKPD", TRUE),
@@ -871,7 +934,7 @@ autoplot.disk <- function(object,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
@@ -882,6 +945,8 @@ autoplot.disk <- function(object,
     title <- gsub(" +", " ", paste0(title, collapse = " "))
   }
 
+  colours_SIR <- expand_SIR_colours(colours_SIR)
+
   x <- plotrange_as_table(object, expand = expand)
   cols_sub <- plot_colours_subtitle_guideline(
     x = x,
@@ -899,10 +964,10 @@ autoplot.disk <- function(object,
   df <- as.data.frame(x, stringsAsFactors = TRUE)
   colnames(df) <- c("disk", "count")
   df$cols <- cols_sub$cols
-
   df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
-  df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
-  df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
+  df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent"
+  df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
+  df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
     levels = translate_into_language(
       c(
@@ -920,10 +985,10 @@ autoplot.disk <- function(object,
     vals <- c(
       "(S) Susceptible" = colours_SIR[1],
       "(SDD) Susceptible dose-dependent" = colours_SIR[2],
-      "(I) Susceptible, incr. exp." = colours_SIR[2],
-      "(I) Intermediate" = colours_SIR[2],
-      "(R) Resistant" = colours_SIR[3],
-      "(NI) Non-interpretable" = "grey"
+      "(I) Susceptible, incr. exp." = colours_SIR[3],
+      "(I) Intermediate" = colours_SIR[3],
+      "(R) Resistant" = colours_SIR[4],
+      "(NI) Non-interpretable" = "grey30"
     )
     names(vals) <- translate_into_language(names(vals), language = language)
     p <- p +
@@ -1024,22 +1089,26 @@ barplot.sir <- function(height,
                         main = deparse(substitute(height)),
                         xlab = translate_AMR("Antimicrobial Interpretation", language = language),
                         ylab = translate_AMR("Frequency", language = language),
-                        colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                        colours_SIR = c(
+                          S = "#3CAEA3",
+                          SDD = "#8FD6C4",
+                          I = "#F6D55C",
+                          R = "#ED553B"
+                        ),
                         language = get_AMR_locale(),
                         expand = TRUE,
                         ...) {
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  if (length(colours_SIR) == 1) {
-    colours_SIR <- rep(colours_SIR, 3)
-  }
+  colours_SIR <- expand_SIR_colours(colours_SIR)
+
   # add SDD and N to colours
-  colours_SIR <- c(colours_SIR[1:2], colours_SIR[2], colours_SIR[3], "#888888")
+  colours_SIR <- c(colours_SIR, "grey30")
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   x <- table(height)
@@ -1065,14 +1134,19 @@ autoplot.sir <- function(object,
                          title = deparse(substitute(object)),
                          xlab = translate_AMR("Antimicrobial Interpretation", language = language),
                          ylab = translate_AMR("Frequency", language = language),
-                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+                         colours_SIR = c(
+                           S = "#3CAEA3",
+                           SDD = "#8FD6C4",
+                           I = "#F6D55C",
+                           R = "#ED553B"
+                         ),
                          language = get_AMR_locale(),
                          ...) {
   stop_ifnot_installed("ggplot2")
   meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
 
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
@@ -1081,9 +1155,7 @@ autoplot.sir <- function(object,
     title <- gsub(" +", " ", paste0(title, collapse = " "))
   }
 
-  if (length(colours_SIR) == 1) {
-    colours_SIR <- rep(colours_SIR, 3)
-  }
+  colours_SIR <- expand_SIR_colours(colours_SIR)
 
   df <- as.data.frame(table(object), stringsAsFactors = TRUE)
   colnames(df) <- c("x", "n")
@@ -1095,9 +1167,9 @@ autoplot.sir <- function(object,
       values = c(
         "S" = colours_SIR[1],
         "SDD" = colours_SIR[2],
-        "I" = colours_SIR[2],
-        "R" = colours_SIR[3],
-        "NI" = "#888888"
+        "I" = colours_SIR[3],
+        "R" = colours_SIR[4],
+        "NI" = "grey30"
       ),
       limits = force
     ) +
@@ -1223,9 +1295,9 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f
     cols[is.na(sir)] <- "#BEBEBE"
     cols[sir == "S"] <- colours_SIR[1]
     cols[sir == "SDD"] <- colours_SIR[2]
-    cols[sir == "I"] <- colours_SIR[2]
-    cols[sir == "R"] <- colours_SIR[3]
-    cols[sir == "NI"] <- "#888888"
+    cols[sir == "I"] <- colours_SIR[3]
+    cols[sir == "R"] <- colours_SIR[4]
+    cols[sir == "NI"] <- "grey30"
     sub <- bquote(.(abname) ~ "-" ~ italic(.(moname)) ~ .(guideline_txt))
   } else {
     cols <- "#BEBEBE"
@@ -1284,10 +1356,15 @@ scale_y_percent <- function(breaks = function(x) seq(0, max(x, na.rm = TRUE), 0.
 #' @export
 scale_sir_colours <- function(...,
                               aesthetics,
-                              colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B")) {
+                              colours_SIR = c(
+                                S = "#3CAEA3",
+                                SDD = "#8FD6C4",
+                                I = "#F6D55C",
+                                R = "#ED553B"
+                              )) {
   stop_ifnot_installed("ggplot2")
   meet_criteria(aesthetics, allow_class = "character", is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
-  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
+  meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
 
   if ("fill" %in% aesthetics && message_not_thrown_before("scale_sir_colours", "fill", entire_session = TRUE)) {
     warning_("Using `scale_sir_colours()` for the `fill` aesthetic has been superseded by `scale_fill_sir()`, please use that instead. This warning will be shown once per session.")
@@ -1296,67 +1373,48 @@ scale_sir_colours <- function(...,
     warning_("Using `scale_sir_colours()` for the `colour` aesthetic has been superseded by `scale_colour_sir()`, please use that instead. This warning will be shown once per session.")
   }
 
-  if (length(colours_SIR) == 1) {
-    colours_SIR <- rep(colours_SIR, 3)
-  }
-  # behaviour until AMR pkg v1.5.0 and also when coming from ggplot_sir()
   if ("colours" %in% names(list(...))) {
-    original_cols <- c(
-      S = colours_SIR[1],
-      SI = colours_SIR[1],
-      I = colours_SIR[2],
-      IR = colours_SIR[3],
-      R = colours_SIR[3]
-    )
-    colours <- replace(original_cols, names(list(...)$colours), list(...)$colours)
+    colours_SIR <- list(...)$colours
+  }
+
+  colours_SIR <- expand_SIR_colours(colours_SIR, unname = FALSE)
+
+  # behaviour when coming from ggplot_sir()
+  if ("colours" %in% names(list(...))) {
     # limits = force is needed in ggplot2 3.3.4 and 3.3.5, see here;
     # https://github.com/tidyverse/ggplot2/issues/4511#issuecomment-866185530
-    return(ggplot2::scale_fill_manual(values = colours, limits = force, aesthetics = aesthetics))
+    return(ggplot2::scale_fill_manual(values = colours_SIR, limits = force, aesthetics = aesthetics))
   }
   if (identical(unlist(list(...)), FALSE)) {
     return(invisible())
   }
 
-  names_susceptible <- c(
-    "S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible",
-    unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Susceptible"),
-      "replacement",
-      drop = TRUE
-    ])
-  )
+  colours_SIR <- unname(colours_SIR)
+
+  names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible")
+  names_susceptible_dose_dep <- c("SDD", "susceptible dose-dependent", "Susceptible dose-dependent")
   names_incr_exposure <- c(
     "I", "intermediate", "increased exposure", "incr. exposure",
-    "Increased exposure", "Incr. exposure", "Susceptible, incr. exp.",
-    unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Intermediate"),
-      "replacement",
-      drop = TRUE
-    ]),
-    unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Susceptible, incr. exp."),
-      "replacement",
-      drop = TRUE
-    ])
-  )
-  names_resistant <- c(
-    "R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant",
-    unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Resistant"),
-      "replacement",
-      drop = TRUE
-    ])
+    "Increased exposure", "Incr. exposure", "Susceptible, incr. exp."
   )
+  names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant")
 
   susceptible <- rep(colours_SIR[1], length(names_susceptible))
   names(susceptible) <- names_susceptible
-  incr_exposure <- rep(colours_SIR[2], length(names_incr_exposure))
+  susceptible_dose_dep <- rep(colours_SIR[2], length(names_susceptible_dose_dep))
+  names(susceptible_dose_dep) <- names_susceptible_dose_dep
+  incr_exposure <- rep(colours_SIR[3], length(names_incr_exposure))
   names(incr_exposure) <- names_incr_exposure
-  resistant <- rep(colours_SIR[3], length(names_resistant))
+  resistant <- rep(colours_SIR[4], length(names_resistant))
   names(resistant) <- names_resistant
 
-  original_cols <- c(susceptible, incr_exposure, resistant)
+  original_cols <- c(susceptible, susceptible_dose_dep, incr_exposure, resistant)
   dots <- c(...)
-  # replace S, I, R as colours: scale_sir_colours(mydatavalue = "S")
+  # replace S, SDD, I, R as colours: scale_sir_colours(mydatavalue = "S")
   dots[dots == "S"] <- colours_SIR[1]
-  dots[dots == "I"] <- colours_SIR[2]
-  dots[dots == "R"] <- colours_SIR[3]
+  dots[dots == "SDD"] <- colours_SIR[2]
+  dots[dots == "I"] <- colours_SIR[3]
+  dots[dots == "R"] <- colours_SIR[4]
   cols <- replace(original_cols, names(dots), dots)
   # limits = force is needed in ggplot2 3.3.4 and 3.3.5, see here;
   # https://github.com/tidyverse/ggplot2/issues/4511#issuecomment-866185530
@@ -1435,3 +1493,39 @@ labels_sir_count <- function(position = NULL,
     }
   )
 }
+
+expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
+  sir_order <- c("S", "SDD", "I", "R", "SI", "IR")
+
+  if (is.null(names(colours_SIR))) {
+    if (length(colours_SIR) == 1) {
+      colours_SIR <- rep(colours_SIR, 4)
+    } else if (length(colours_SIR) == 3) {
+      # old method for AMR < 3.0.1 which allowed for 3 colours
+      # fill in green for SDD as extra colour
+      colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
+    }
+    if (length(colours_SIR) == 4) {
+      # add colours for SI (same as S) and IR (same as R)
+      colours_SIR <- c(colours_SIR[1:4], colours_SIR[1], colours_SIR[4])
+    }
+    names(colours_SIR) <- sir_order
+  } else {
+    # named input: match and reorder
+    stop_ifnot(
+      all(names(colours_SIR) %in% sir_order),
+      "Unknown names in `colours_SIR`. Expected any of: ", vector_or(levels(NA_sir_), quotes = FALSE, sort = FALSE), "."
+    )
+    if (length(colours_SIR) == 4) {
+      # add colours for SI (same as S) and IR (same as R)
+      colours_SIR <- c(colours_SIR[1:4], SI = unname(colours_SIR[1]), IR = unname(colours_SIR[4]))
+    }
+    colours_SIR <- colours_SIR[sir_order]
+  }
+
+  if (unname) {
+    colours_SIR <- unname(colours_SIR)
+  }
+
+  return(colours_SIR)
+}

R/proportion.R

@@ -237,7 +237,7 @@ resistance <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -255,7 +255,7 @@ susceptibility <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -283,7 +283,7 @@ sir_confidence_interval <- function(...,
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
   n <- tryCatch(
     sir_calc(...,
@@ -291,7 +291,7 @@ sir_confidence_interval <- function(...,
       only_all_tested = only_all_tested,
       only_count = TRUE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 
   if (x == 0) {
@@ -347,7 +347,7 @@ proportion_R <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -365,7 +365,7 @@ proportion_IR <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -383,7 +383,7 @@ proportion_I <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -401,7 +401,7 @@ proportion_SI <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -419,7 +419,7 @@ proportion_S <- function(...,
       only_all_tested = only_all_tested,
       only_count = FALSE
     ),
-    error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }
 
@@ -443,6 +443,6 @@ proportion_df <- function(data,
       combine_SI = combine_SI,
       confidence_level = confidence_level
     ),
-    error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }

R/random.R

@@ -31,13 +31,17 @@
 #'
 #' 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.
-#' @param mo Any [character] that can be coerced to a valid microorganism code with [as.mo()].
+#' @param mo Any [character] that can be coerced to a valid microorganism code with [as.mo()]. Can be the same length as `size`.
 #' @param ab Any [character] that can be coerced to a valid antimicrobial drug code with [as.ab()].
 #' @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 ... Ignored, only in place to allow future extensions.
-#' @details The base \R function [sample()] is used for generating values.
-#'
-#' Generated values are based on the EUCAST `r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))` guideline as implemented in the [clinical_breakpoints] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument.
+#' @details
+#' 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.
 #' @return class `mic` for [random_mic()] (see [as.mic()]) and class `disk` for [random_disk()] (see [as.disk()])
 #' @name random
 #' @rdname random
@@ -47,8 +51,13 @@
 #' random_disk(25)
 #' random_sir(25)
 #'
+#' # add more skewedness, make more realistic by setting a bug and/or drug:
+#' 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 2025")
+#'
 #' \donttest{
-#' # make the random generation more realistic by setting a bug and/or drug:
 #' random_mic(25, "Klebsiella pneumoniae") # range 0.0625-64
 #' random_mic(25, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
 #' random_mic(25, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4
@@ -57,26 +66,61 @@
 #' 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, ...) {
+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 = 1, 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)
+
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
   }
-  random_exec("MIC", size = size, mo = mo, ab = ab)
+  if (length(mo) > 1) {
+    out <- rep(NA_mic_, length(size))
+    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)
+    }
+    out <- as.mic(out, keep_operators = "none")
+    if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
+      out[out == min(out)] <- paste0("<=", out[out == min(out)])
+    }
+    if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
+      out[out == max(out) & out %unlike% "<="] <- paste0(">=", out[out == max(out) & out %unlike% "<="])
+    }
+
+    return(out)
+  } else {
+    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, ...) {
+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 = 1, 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)
+
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
   }
-  random_exec("DISK", size = size, mo = mo, ab = ab)
+  if (length(mo) > 1) {
+    out <- rep(NA_mic_, length(size))
+    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)
+    }
+    out <- as.disk(out)
+    return(out)
+  } else {
+    random_exec("DISK", size = size, mo = mo, ab = ab, skew = skew, severity = severity)
+  }
 }
 
 #' @rdname random
@@ -90,78 +134,60 @@ random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
   sample(as.sir(c("S", "I", "R")), size = size, replace = TRUE, prob = prob_SIR)
 }
 
-random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
-  df <- AMR::clinical_breakpoints %pm>%
-    pm_filter(guideline %like% "EUCAST") %pm>%
-    pm_arrange(pm_desc(guideline)) %pm>%
-    subset(guideline == max(guideline) &
-      method == method_type &
-      type == "human")
+
+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")
 
   if (!is.null(mo)) {
-    mo_coerced <- as.mo(mo)
-    mo_include <- c(
-      mo_coerced,
-      as.mo(mo_genus(mo_coerced)),
-      as.mo(mo_family(mo_coerced)),
-      as.mo(mo_order(mo_coerced))
-    )
-    df_new <- df %pm>%
-      subset(mo %in% mo_include)
-    if (nrow(df_new) > 0) {
-      df <- df_new
-    } else {
-      warning_("in `random_", tolower(method_type), "()`: no rows found that match mo '", mo, "', ignoring argument `mo`")
-    }
+    mo_coerced <- as.mo(mo, info = FALSE)
+    mo_include <- c(mo_coerced, as.mo(mo_genus(mo_coerced)), as.mo(mo_family(mo_coerced)), as.mo(mo_order(mo_coerced)))
+    df_new <- df %pm>% subset(mo %in% mo_include)
+    if (nrow(df_new) > 0) df <- df_new
   }
 
   if (!is.null(ab)) {
     ab_coerced <- as.ab(ab)
-    df_new <- df %pm>%
-      subset(ab %in% ab_coerced)
-    if (nrow(df_new) > 0) {
-      df <- df_new
-    } else {
-      warning_("in `random_", tolower(method_type), "()`: no rows found that match ab '", ab, "' (", ab_name(ab_coerced, tolower = TRUE, language = NULL), "), ignoring argument `ab`")
-    }
+    df_new <- df %pm>% subset(ab %in% ab_coerced)
+    if (nrow(df_new) > 0) df <- df_new
   }
 
   if (method_type == "MIC") {
-    # set range
-    mic_range <- c(0.001, 0.002, 0.005, 0.010, 0.025, 0.0625, 0.125, 0.250, 0.5, 1, 2, 4, 8, 16, 32, 64, 128, 256)
+    lowest_mic <- min(df$breakpoint_S, na.rm = TRUE)
+    lowest_mic <- log2(lowest_mic) + sample(c(-3:2), 1)
+    lowest_mic <- 2^lowest_mic
+    highest_mic <- max(df$breakpoint_R, na.rm = TRUE)
+    highest_mic <- log2(highest_mic) + sample(c(-3:1), 1)
+    highest_mic <- max(lowest_mic * 2, 2^highest_mic)
 
-    # get highest/lowest +/- random 1 to 3 higher factors of two
-    max_range <- mic_range[min(
-      length(mic_range),
-      which(mic_range == max(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE)) + sample(c(1:3), 1)
-    )]
-    min_range <- mic_range[max(
-      1,
-      which(mic_range == min(df$breakpoint_S, na.rm = TRUE)) - sample(c(1:3), 1)
-    )]
-
-    mic_range_new <- mic_range[mic_range <= max_range & mic_range >= min_range]
-    if (length(mic_range_new) == 0) {
-      mic_range_new <- mic_range
-    }
-    out <- as.mic(sample(mic_range_new, size = size, replace = TRUE))
-    # 50% chance that lowest will get <= and highest will get >=
+    out <- skewed_values(COMMON_MIC_VALUES, size = size, min = lowest_mic, max = highest_mic, skew = skew, severity = severity)
     if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
       out[out == min(out)] <- paste0("<=", out[out == min(out)])
     }
     if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
-      out[out == max(out)] <- paste0(">=", out[out == max(out)])
+      out[out == max(out) & out %unlike% "<="] <- paste0(">=", out[out == max(out) & out %unlike% "<="])
     }
-    return(out)
+    return(as.mic(out))
   } else if (method_type == "DISK") {
-    set_range <- seq(
-      from = as.integer(min(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE) / 1.25),
-      to = as.integer(max(df$breakpoint_S, na.rm = TRUE) * 1.25),
+    disk_range <- seq(
+      from = floor(min(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE) / 1.25),
+      to = ceiling(max(df$breakpoint_S[df$breakpoint_S != 50], na.rm = TRUE) * 1.25),
       by = 1
     )
-    out <- sample(set_range, size = size, replace = TRUE)
-    out[out < 6] <- sample(c(6:10), length(out[out < 6]), replace = TRUE)
-    out[out > 50] <- sample(c(40:50), length(out[out > 50]), replace = TRUE)
+    disk_range <- disk_range[disk_range >= 6 & disk_range <= 50]
+    out <- skewed_values(disk_range, size = size, min = min(disk_range), max = max(disk_range), skew = skew, severity = severity)
     return(as.disk(out))
   }
 }
+
+skewed_values <- function(values, size, min, max, skew = c("right", "left"), severity = 1) {
+  skew <- match.arg(skew)
+  range_vals <- values[values >= min & values <= max]
+  if (length(range_vals) < 2) range_vals <- values
+  ranks <- seq_along(range_vals)
+  weights <- switch(skew,
+    right = rev(ranks)^severity,
+    left = ranks^severity
+  )
+  weights <- weights / sum(weights)
+  sample(range_vals, size = size, replace = TRUE, prob = weights)
+}

R/sir.R

@@ -69,7 +69,9 @@
 #' @param reference_data A [data.frame] to be used for interpretation, which defaults to the [clinical_breakpoints] data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the [clinical_breakpoints] data set (same column names and column types). Please note that the `guideline` argument will be ignored when `reference_data` is manually set.
 #' @param threshold Maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*.
 #' @param conserve_capped_values Deprecated, use `capped_mic_handling` instead.
-#' @param ... For using on a [data.frame]: names of columns to apply [as.sir()] on (supports tidy selection such as `column1:column4`). Otherwise: arguments passed on to methods.
+#' @param ... For using on a [data.frame]: selection of columns to apply `as.sir()` to. Supports [tidyselect language][tidyselect::starts_with()] such as `where(is.mic)`, `starts_with(...)`, or `column1:column4`, and can thus also be [antimicrobial selectors][amr_selector()] such as `as.sir(df, penicillins())`.
+#'
+#' Otherwise: arguments passed on to methods.
 #' @details
 #' *Note: The clinical breakpoints in this package were validated through, and imported from, [WHONET](https://whonet.org). The public use of this `AMR` package has been endorsed by both CLSI and EUCAST. See [clinical_breakpoints] for more information.*
 #'
@@ -159,7 +161,7 @@
 #'
 #' The function [is.sir()] detects if the input contains class `sir`. If the input is a [data.frame] or [list], it iterates over all columns/items and returns a [logical] vector.
 #'
-#' The base R function [as.double()] can be used to retrieve quantitative values from a `sir` object: `"S"` = 1, `"I"`/`"SDD"` = 2, `"R"` = 3. All other values are rendered `NA` . **Note:** Do not use `as.integer()`, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values.
+#' The base R function [as.double()] can be used to retrieve quantitative values from a `sir` object: `"S"` = 1, `"I"`/`"SDD"` = 2, `"R"` = 3. All other values are rendered `NA`. **Note:** Do not use `as.integer()`, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values.
 #'
 #' The function [is_sir_eligible()] returns `TRUE` when a column contains at most 5% potentially invalid antimicrobial interpretations, and `FALSE` otherwise. The threshold of 5% can be set with the `threshold` argument. If the input is a [data.frame], it iterates over all columns and returns a [logical] vector.
 #' @section Interpretation of SIR:
@@ -225,9 +227,12 @@
 #'   df_wide %>% mutate_if(is.mic, as.sir)
 #'   df_wide %>% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
 #'   df_wide %>% mutate(across(where(is.mic), as.sir))
+#'
 #'   df_wide %>% mutate_at(vars(amoxicillin:tobra), as.sir)
 #'   df_wide %>% mutate(across(amoxicillin:tobra, as.sir))
 #'
+#'   df_wide %>% mutate(across(aminopenicillins(), as.sir))
+#'
 #'   # approaches that all work with additional arguments:
 #'   df_long %>%
 #'     # given a certain data type, e.g. MIC values
@@ -722,8 +727,17 @@ as.sir.data.frame <- function(x,
   meet_criteria(info, allow_class = "logical", has_length = 1)
   meet_criteria(parallel, allow_class = "logical", has_length = 1)
   meet_criteria(max_cores, allow_class = c("numeric", "integer"), has_length = 1)
-
   x.bak <- x
+
+  if (tryCatch(length(list(...)) > 0, error = function(e) TRUE)) {
+    sel <- colnames(pm_select(x, ...))
+  } else {
+    sel <- colnames(x)
+  }
+  if (!is.null(col_mo)) {
+    sel <- sel[sel != col_mo]
+  }
+
   for (i in seq_len(ncol(x))) {
     # don't keep factors, overwriting them is hard
     if (is.factor(x[, i, drop = TRUE])) {
@@ -803,15 +817,6 @@ as.sir.data.frame <- function(x,
   }
 
   i <- 0
-  if (tryCatch(length(list(...)) > 0, error = function(e) TRUE)) {
-    sel <- colnames(pm_select(x, ...))
-  } else {
-    sel <- colnames(x)
-  }
-  if (!is.null(col_mo)) {
-    sel <- sel[sel != col_mo]
-  }
-
   ab_cols <- colnames(x)[vapply(FUN.VALUE = logical(1), x, function(y) {
     i <<- i + 1
     check <- is.mic(y) | is.disk(y)
@@ -863,7 +868,7 @@ as.sir.data.frame <- function(x,
     cl <- tryCatch(parallel::makeCluster(n_cores, type = "PSOCK"),
       error = function(e) {
         if (isTRUE(info)) {
-          message_("Could not create parallel cluster, using single-core computation. Error message: ", e$message, add_fn = font_red)
+          message_("Could not create parallel cluster, using single-core computation. Error message: ", conditionMessage(e), add_fn = font_red)
         }
         return(NULL)
       }
@@ -1135,7 +1140,6 @@ as_sir_method <- function(method_short,
   current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history)
 
   if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) {
-    message()
     message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all details of the breakpoint interpretations.\n\n", add_fn = font_green)
   }
 
@@ -1553,7 +1557,7 @@ as_sir_method <- function(method_short,
       ))
 
     if (breakpoint_type == "animal") {
-      # 2025-03-13 for now, only strictly follow guideline for current host, no extrapolation
+      # 2025-03-13/ for now, only strictly follow guideline for current host, no extrapolation
       breakpoints_current <- breakpoints_current[which(breakpoints_current$host == host_current), , drop = FALSE]
     }
 
@@ -1651,26 +1655,23 @@ as_sir_method <- function(method_short,
       next
     }
 
-    # sort on host and taxonomic rank
-    # (this will e.g. prefer 'species' breakpoints over 'order' breakpoints)
-    if (is.na(uti_current)) {
-      breakpoints_current <- breakpoints_current %pm>%
-        #  `uti` is a column in the data set
-        # this will put UTI = FALSE first, then UTI = NA, then UTI = TRUE
-        pm_mutate(uti_index = ifelse(!is.na(uti) & uti == FALSE, 1,
-          ifelse(is.na(uti), 2,
-            3
-          )
-        )) %pm>%
-        # be as specific as possible (i.e. prefer species over genus):
-        pm_arrange(rank_index, uti_index)
-    } else if (uti_current == TRUE) {
-      breakpoints_current <- breakpoints_current %pm>%
-        subset(uti == TRUE) %pm>%
-        # be as specific as possible (i.e. prefer species over genus):
-        pm_arrange(rank_index)
+    # if the user explicitly set uti, keep only those rows
+    if (!is.na(uti_current)) {
+      breakpoints_current <- breakpoints_current[breakpoints_current$uti == uti_current, , drop = FALSE]
     }
 
+    # build a helper factor so FALSE < NA < TRUE
+    uti_index <- factor(
+      ifelse(is.na(breakpoints_current$uti), "NA",
+        as.character(breakpoints_current$uti)
+      ),
+      levels = c("FALSE", "NA", "TRUE")
+    )
+
+    # sort on host and taxonomic rank first, then by UTI
+    # (this will e.g. prefer 'species' breakpoints over 'order' breakpoints)
+    breakpoints_current <- breakpoints_current[order(breakpoints_current$rank_index, uti_index), , drop = FALSE]
+
     # throw messages for different body sites
     site <- breakpoints_current[1L, "site", drop = FALSE] # this is the one we'll take
     if (is.na(site)) {
@@ -1682,7 +1683,7 @@ as_sir_method <- function(method_short,
       # only UTI breakpoints available
       notes_current <- paste0(
         notes_current, "\n",
-        paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI); assuming `uti = TRUE`.")
+        paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI) - assuming `uti = TRUE`.")
       )
     } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti_current)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_current, ab_current)) {
       # both UTI and Non-UTI breakpoints available
@@ -1705,7 +1706,7 @@ as_sir_method <- function(method_short,
       new_sir <- rep(as.sir("R"), length(rows))
       notes_current <- paste0(
         notes_current, "\n",
-        paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, "")
+        paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ".")
       )
     } else if (nrow(breakpoints_current) == 0) {
       # no rules available
@@ -1713,41 +1714,48 @@ as_sir_method <- function(method_short,
     } else {
       # then run the rules
       breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
+      if (breakpoints_current$rank_index > 3) {
+        # we resort to a high-level taxonomic record since there are no breakpoint on genus (rank_index = 3) or lower, so note this
+        notes_current <- paste0(
+          "No genus- or species-level breakpoint available - applying higher taxonomic level instead.\n",
+          notes_current
+        )
+      }
 
       notes_current <- paste0(
         notes_current, "\n",
         ifelse(breakpoints_current$mo == "UNKNOWN" | breakpoints_current$ref_tbl %like% "PK.*PD",
-          "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this",
+          "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this.",
           ""
         ),
         "\n",
         ifelse(breakpoints_current$site %like% "screen" | breakpoints_current$ref_tbl %like% "screen",
-          "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this",
+          "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this.",
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[<][0-9]",
-          paste0("MIC values with the operator '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values with the operator '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]",
-          paste0("MIC values with the operator '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values with the operator '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R,
-          paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^<=[0-9]" & as.double(values) == breakpoints_current$breakpoint_R,
-          paste0("MIC values at the R breakpoint with the operator '<=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values at the R breakpoint with the operator '<=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^>=[0-9]" & as.double(values) == breakpoints_current$breakpoint_S,
-          paste0("MIC values at the S breakpoint with the operator '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values at the S breakpoint with the operator '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         )
       )
@@ -1757,7 +1765,7 @@ as_sir_method <- function(method_short,
         notes_current <- paste0(
           notes_current, "\n",
           ifelse(!is.na(breakpoints_current$breakpoint_S) & is.na(breakpoints_current$breakpoint_R),
-            "NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE",
+            "NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE.",
             ""
           )
         )
@@ -1796,7 +1804,7 @@ as_sir_method <- function(method_short,
       }
 
       # write to verbose output
-      notes_current <- trimws2(notes_current)
+      notes_current <- gsub("\n\n", "\n", trimws2(notes_current), fixed = TRUE)
       notes_current[notes_current == ""] <- NA_character_
       out <- data.frame(
         # recycling 1 to 2 rows does not always seem to work, which is why vectorise_log_entry() was added
@@ -1904,11 +1912,11 @@ pillar_shaft.sir <- function(x, ...) {
     # colours will anyway not work when has_colour() == FALSE,
     # but then the indentation should also not be applied
     out[is.na(x)] <- font_grey("  NA")
-    out[x == "NI"] <- font_grey_bg(font_black("  NI "))
     out[x == "S"] <- font_green_bg("  S  ")
+    out[x == "SDD"] <- font_green_lighter_bg(" SDD ")
     out[x == "I"] <- font_orange_bg("  I  ")
-    out[x == "SDD"] <- font_orange_bg(" SDD ")
     out[x == "R"] <- font_rose_bg("  R  ")
+    out[x == "NI"] <- font_grey_bg(font_black("  NI "))
   }
   create_pillar_column(out, align = "left", width = 5)
 }
@@ -1966,33 +1974,18 @@ freq.sir <- function(x, ...) {
 # this prevents the requirement for putting the dependency in Imports:
 #' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
 get_skimmers.sir <- function(column) {
-  # get the variable name 'skim_variable'
-  name_call <- function(.data) {
-    calls <- sys.calls()
-    frms <- sys.frames()
-    calls_txt <- vapply(calls, function(x) paste(deparse(x), collapse = ""), FUN.VALUE = character(1))
-    if (any(calls_txt %like% "skim_variable", na.rm = TRUE)) {
-      ind <- which(calls_txt %like% "skim_variable")[1L]
-      vars <- tryCatch(eval(parse(text = ".data$skim_variable$sir"), envir = frms[[ind]]),
-        error = function(e) NULL
-      )
-      tryCatch(ab_name(as.character(calls[[length(calls)]][[2]]), language = NULL, info = FALSE),
-        error = function(e) NA_character_
-      )
-    } else {
-      NA_character_
-    }
-  }
-
+  # TODO add here in AMR 3.1.0 details about guideline
   skimr::sfl(
     skim_type = "sir",
-    ab_name = name_call,
-    count_R = count_R,
-    count_S = count_susceptible,
+    # guideline = function(x) "EUCAST 2025", # or "Multiple"
+    # origin = function(x) "MIC", # or "Multiple"
+    count_S = count_S,
     count_I = count_I,
-    prop_R = ~ proportion_R(., minimum = 0),
-    prop_S = ~ susceptibility(., minimum = 0),
-    prop_I = ~ proportion_I(., minimum = 0)
+    count_R = count_R,
+    prop_S = ~ round(proportion_S(., minimum = 0) * 100, 1),
+    prop_I = ~ round(proportion_I(., minimum = 0) * 100, 1),
+    prop_R = ~ round(proportion_R(., minimum = 0) * 100, 1),
+    hist = ~ skimr::inline_hist(as.double(stats::na.omit(.)), 3)
   )
 }
 

R/sir_calc.R

@@ -244,7 +244,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   translate_ab <- get_translate_ab(translate_ab)
 
   data.bak <- data
-  # select only groups and antimicrobials
+  # select only groups and antibiotics
   if (is_null_or_grouped_tbl(data)) {
     data_has_groups <- TRUE
     groups <- get_group_names(data)
@@ -255,10 +255,12 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   }
 
   data <- as.data.frame(data, stringsAsFactors = FALSE)
-  if (isTRUE(combine_SI)) {
-    for (i in seq_len(ncol(data))) {
-      if (is.sir(data[, i, drop = TRUE])) {
-        data[, i] <- as.character(data[, i, drop = TRUE])
+
+  for (i in seq_len(ncol(data))) {
+    # transform SIR columns
+    if (is.sir(data[, i, drop = TRUE])) {
+      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)
         }
@@ -364,7 +366,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   } 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
-    if (out$value[out$interpretation == "SDD"] > 0) {
+    if (any(out$value[out$interpretation == "SDD"] > 0, na.rm = TRUE)) {
       out$interpretation <- factor(out$interpretation, levels = c("S", "SDD", "I", "R"), ordered = TRUE)
     } else {
       out$interpretation <- factor(out$interpretation, levels = c("S", "I", "R"), ordered = TRUE)

R/sir_df.R

@@ -47,6 +47,6 @@ sir_df <- function(data,
       combine_SI = combine_SI,
       confidence_level = confidence_level
     ),
-    error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
+    error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
   )
 }

R/tidymodels.R.no_include

@@ -0,0 +1,265 @@
+#' AMR Extensions for Tidymodels
+#'
+#' This family of functions allows using AMR-specific data types such as `<mic>` and `<sir>` inside `tidymodels` pipelines.
+#' @inheritParams recipes::step_center
+#' @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_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_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.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.
+#'
+#'
+#'   # example data set in the AMR package
+#'   esbl_isolates
+#'
+#'   # Prepare a binary outcome and convert to ordered factor
+#'   data <- esbl_isolates %>%
+#'     mutate(esbl = factor(esbl, levels = c(FALSE, TRUE), ordered = TRUE))
+#'
+#'   # Split into training and testing sets
+#'   split <- initial_split(data)
+#'   training_data <- training(split)
+#'   testing_data <- testing(split)
+#'
+#'   # 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()
+#'
+#'   # View prepped recipe
+#'   mic_recipe
+#'
+#'   # Apply the recipe to training and testing data
+#'   out_training <- bake(mic_recipe, new_data = NULL)
+#'   out_testing <- bake(mic_recipe, new_data = testing_data)
+#'
+#'   # Fit a logistic regression model
+#'   fitted <- logistic_reg(mode = "classification") %>%
+#'     set_engine("glm") %>%
+#'     fit(esbl ~ ., data = out_training)
+#'
+#'   # Generate predictions on the test set
+#'   predictions <- predict(fitted, out_testing) %>%
+#'     bind_cols(out_testing)
+#'
+#'   # Evaluate predictions using standard classification metrics
+#'   our_metrics <- metric_set(accuracy, kap, ppv, npv)
+#'   metrics <- our_metrics(predictions, truth = esbl, estimate = .pred_class)
+#'
+#'   # Show performance
+#'   metrics
+#' }
+all_mic <- function() {
+  x <- tidymodels_amr_select(levels(NA_mic_))
+  names(x)
+}
+
+#' @rdname amr-tidymodels
+#' @export
+all_mic_predictors <- function() {
+  x <- tidymodels_amr_select(levels(NA_mic_))
+  intersect(x, recipes::has_role("predictor"))
+}
+
+#' @rdname amr-tidymodels
+#' @export
+all_sir <- function() {
+  x <- tidymodels_amr_select(levels(NA_sir_))
+  names(x)
+}
+
+#' @rdname amr-tidymodels
+#' @export
+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")) {
+  recipes::add_step(
+    recipe,
+    step_mic_log2_new(
+      terms = rlang::enquos(...),
+      role = role,
+      trained = trained,
+      columns = columns,
+      skip = skip,
+      id = id
+    )
+  )
+}
+
+step_mic_log2_new <- function(terms, role, trained, columns, skip, id) {
+  recipes::step(
+    subclass = "mic_log2",
+    terms = terms,
+    role = role,
+    trained = trained,
+    columns = columns,
+    skip = skip,
+    id = id
+  )
+}
+
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::prep, step_mic_log2)
+prep.step_mic_log2 <- function(x, training, info = NULL, ...) {
+  col_names <- recipes::recipes_eval_select(x$terms, training, info)
+  recipes::check_type(training[, col_names], types = "ordered")
+  step_mic_log2_new(
+    terms = x$terms,
+    role = x$role,
+    trained = TRUE,
+    columns = col_names,
+    skip = x$skip,
+    id = x$id
+  )
+}
+
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::bake, step_mic_log2)
+bake.step_mic_log2 <- function(object, new_data, ...) {
+  recipes::check_new_data(object$columns, object, new_data)
+  for (col in object$columns) {
+    new_data[[col]] <- log2(as.numeric(as.mic(new_data[[col]])))
+  }
+  new_data
+}
+
+#' @export
+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)
+tidy.step_mic_log2 <- function(x, ...) {
+  if (recipes::is_trained(x)) {
+    res <- tibble::tibble(terms = x$columns)
+  } else {
+    res <- tibble::tibble(terms = recipes::sel2char(x$terms))
+  }
+  res$id <- x$id
+  res
+}
+
+#' @rdname amr-tidymodels
+#' @export
+step_sir_numeric <- function(
+    recipe,
+    ...,
+    role = NA,
+    trained = FALSE,
+    columns = NULL,
+    skip = FALSE,
+    id = recipes::rand_id("sir_numeric")) {
+  recipes::add_step(
+    recipe,
+    step_sir_numeric_new(
+      terms = rlang::enquos(...),
+      role = role,
+      trained = trained,
+      columns = columns,
+      skip = skip,
+      id = id
+    )
+  )
+}
+
+step_sir_numeric_new <- function(terms, role, trained, columns, skip, id) {
+  recipes::step(
+    subclass = "sir_numeric",
+    terms = terms,
+    role = role,
+    trained = trained,
+    columns = columns,
+    skip = skip,
+    id = id
+  )
+}
+
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::prep, step_sir_numeric)
+prep.step_sir_numeric <- function(x, training, info = NULL, ...) {
+  col_names <- recipes::recipes_eval_select(x$terms, training, info)
+  recipes::check_type(training[, col_names], types = "ordered")
+  step_sir_numeric_new(
+    terms = x$terms,
+    role = x$role,
+    trained = TRUE,
+    columns = col_names,
+    skip = x$skip,
+    id = x$id
+  )
+}
+
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(recipes::bake, step_sir_numeric)
+bake.step_sir_numeric <- function(object, new_data, ...) {
+  recipes::check_new_data(object$columns, object, new_data)
+  for (col in object$columns) {
+    new_data[[col]] <- as.numeric(as.sir(new_data[[col]]))
+  }
+  new_data
+}
+
+#' @export
+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)
+tidy.step_sir_numeric <- function(x, ...) {
+  if (recipes::is_trained(x)) {
+    res <- tibble::tibble(terms = x$columns)
+  } else {
+    res <- tibble::tibble(terms = recipes::sel2char(x$terms))
+  }
+  res$id <- x$id
+  res
+}
+
+tidymodels_amr_select <- function(check_vector) {
+  df <- get_current_data()
+  ind <- which(
+    vapply(
+      FUN.VALUE = logical(1),
+      df,
+      function(x) all(x %in% c(check_vector, NA), na.rm = TRUE) & any(x %in% check_vector),
+      USE.NAMES = TRUE
+    ),
+    useNames = TRUE
+  )
+  ind
+}

R/translate.R

@@ -258,6 +258,11 @@ translate_into_language <- function(from,
     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)
+  }
+
   lapply(
     # starting with longest pattern, since more general translations are shorter, such as 'Group'
     order(nchar(df_trans$pattern), decreasing = TRUE),

R/vctrs.R

@@ -30,7 +30,6 @@
 # These are all S3 implementations for the vctrs package,
 # that is used internally by tidyverse packages such as dplyr.
 # They are to convert AMR-specific classes to bare characters and integers.
-# All of them will be exported using s3_register() in R/zzz.R when loading the package.
 
 # see https://github.com/tidyverse/dplyr/issues/5955 why this is required
 

R/zzz.R

@@ -127,7 +127,7 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
           suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
           packageStartupMessage("OK.")
         },
-        error = function(e) packageStartupMessage("Failed: ", e$message)
+        error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
       )
     }
   }
@@ -143,7 +143,7 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
           suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
           packageStartupMessage("OK.")
         },
-        error = function(e) packageStartupMessage("Failed: ", e$message)
+        error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
       )
     }
   }

README.Rmd

@@ -49,8 +49,11 @@ 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:
+If this does not work, try to install directly from GitHub using the `remotes` package:
+
+```{r, eval = FALSE}
 remotes::install_github("msberends/AMR")
 ```
 

README.md

@@ -58,8 +58,12 @@ 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:
+If this does not work, try to install directly from GitHub using the
+`remotes` package:
+
+``` r
 remotes::install_github("msberends/AMR")
 ```
 

_pkgdown.yml

@@ -234,6 +234,7 @@ reference:
     - "`antimicrobials`"
     - "`clinical_breakpoints`"
     - "`example_isolates`"
+    # TODO - "`esbl_isolates`"
     - "`microorganisms.codes`"
     - "`microorganisms.groups`"
     - "`intrinsic_resistant`"

cran-comments.md

@@ -1,3 +1,5 @@
+This version is a bugfix release (v3.0.1) following the release of v3.0.0 in June 2025.
+
 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/_generate_python_wrapper.sh

@@ -56,7 +56,8 @@ os.makedirs(r_lib_path, exist_ok=True)
 os.environ['R_LIBS_SITE'] = r_lib_path
 
 from rpy2 import robjects
-from rpy2.robjects import pandas2ri
+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
@@ -94,27 +95,26 @@ if r_amr_version != python_amr_version:
 print(f"AMR: Setting up R environment and AMR datasets...", flush=True)
 
 # Activate the automatic conversion between R and pandas DataFrames
-pandas2ri.activate()
+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"))) {
+            as.character(x)
+        } else {
+            x
+        }
+    })
+    df <- df[, !sapply(df, is.list)]
+    df
+    ''')
+    example_isolates['date'] = pd.to_datetime(example_isolates['date'])
 
-# example_isolates
-example_isolates = pandas2ri.rpy2py(robjects.r('''
-df <- AMR::example_isolates
-df[] <- lapply(df, function(x) {
-    if (inherits(x, c("Date", "POSIXt", "factor"))) {
-        as.character(x)
-    } else {
-        x
-    }
-})
-df <- df[, !sapply(df, is.list)]
-df
-'''))
-example_isolates['date'] = pd.to_datetime(example_isolates['date'])
-
-# microorganisms
-microorganisms = pandas2ri.rpy2py(robjects.r('AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]'))
-antimicrobials = pandas2ri.rpy2py(robjects.r('AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]'))
-clinical_breakpoints = pandas2ri.rpy2py(robjects.r('AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]'))
+    # 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)
 
@@ -129,16 +129,15 @@ echo "from .datasets import clinical_breakpoints" >> $init_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
 from rpy2.robjects.vectors import StrVector, FactorVector, IntVector, FloatVector, DataFrame
-from rpy2.robjects import pandas2ri
+from rpy2.robjects.conversion import localconverter
+from rpy2.robjects import default_converter, numpy2ri, pandas2ri
 import pandas as pd
 import numpy as np
 
-# Activate automatic conversion between R data frames and pandas data frames
-pandas2ri.activate()
-
 # Import the AMR R package
 amr_r = importr('AMR')
 
@@ -156,10 +155,8 @@ def convert_to_python(r_output):
         return list(r_output)  # Convert to a Python list of integers or floats
     
     # Check if it's a pandas-compatible R data frame
-    elif isinstance(r_output, pd.DataFrame):
+    elif isinstance(r_output, (pd.DataFrame, DataFrame)):
         return r_output  # Return as pandas DataFrame (already converted by pandas2ri)
-    elif isinstance(r_output, DataFrame):
-        return pandas2ri.rpy2py(r_output) # Return as pandas DataFrame
 
     # Check if the input is a NumPy array and has a string data type
     if isinstance(r_output, np.ndarray) and np.issubdtype(r_output.dtype, np.str_):
@@ -167,6 +164,15 @@ def convert_to_python(r_output):
     
     # Fall-back
     return r_output
+
+def r_to_python(r_func):
+    """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):
+        with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
+            return convert_to_python(r_func(*args, **kwargs))
+    return wrapper
 EOL
 
 # Directory where the .Rd files are stored (update path as needed)
@@ -246,11 +252,12 @@ for rd_file in "$rd_dir"/*.Rd; do
         gsub("FALSE", "False", func_args)
         gsub("NULL", "None", func_args)
 
-        # Write the Python function definition to the output file
-        print "def " func_name_py "(" func_args "):" >> "'"$functions_file"'"
-        print "    \"\"\"Please see our website of the R package for the full manual: https://amr-for-r.org\"\"\"" >> "'"$functions_file"'"
-        print "    return convert_to_python(amr_r." func_name_py "(" func_args "))" >> "'"$functions_file"'"
-        
+        # Write the Python function definition to the output file, using decorator
+        print "@r_to_python" >> "'"$functions_file"'"  
+        print "def " func_name_py "(" func_args "):" >> "'"$functions_file"'"  
+        print "    \"\"\"Please see our website of the R package for the full manual: https://amr-for-r.org\"\"\"" >> "'"$functions_file"'"  
+        print "    return amr_r." func_name_py "(" func_args ")" >> "'"$functions_file"'"  
+
         print "from .functions import " func_name_py >> "'"$init_file"'"
     }
     ' "$rd_file"

data-raw/_pre_commit_checks.R

@@ -663,7 +663,9 @@ if (files_changed()) {
 }
 
 # Update index.md and README.md -------------------------------------------
-if (files_changed("man/microorganisms.Rd") ||
+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") ||

data-raw/_reproduction_scripts/reproduction_of_poorman.R

@@ -108,3 +108,18 @@ writeLines(contents, "R/aa_helper_pm_functions.R")
 
 # note: pm_left_join() will be overwritten by aaa_helper_functions.R, which contains a faster implementation
 # replace `res <- as.data.frame(res)` with  `res <- as.data.frame(res, stringsAsFactors = FALSE)`
+
+# after running, pm_select must be altered. The line:
+# col_pos <- pm_select_positions(.data, ..., .group_pos = TRUE)
+# ... must be replaced with this to support tidyselect functionality such as `starts_with()`:
+# col_pos <- tryCatch(pm_select_positions(.data, ..., .group_pos = TRUE), error = function(e) NULL)
+# if (is.null(col_pos)) {
+#   # try with tidyverse
+#   select_dplyr <- import_fn("select", "dplyr", error_on_fail = FALSE)
+#   if (!is.null(select_dplyr)) {
+#     col_pos <- which(colnames(.data) %in% colnames(select_dplyr(.data, ...)))
+#   } else {
+#     # this will throw an error as it did, but dplyr is not available, so no other option
+#     col_pos <- pm_select_positions(.data, ..., .group_pos = TRUE)
+#   }
+# }

data-raw/ab.md5

@@ -1 +1 @@
-228840b3941753c4adee2b781d901590
+d12f1c78feaecbb4d1631f9c735ad49b

data-raw/datasets/antimicrobials.txt

@@ -116,7 +116,7 @@
 "CSU"	68718	"Cefsumide"	"Cephalosporins (unclassified gen.)"	"NA"			"NA"	"cefsulmid,cefsumido,cefsumidum"					"NA"
 "CPT"	56841980	"Ceftaroline"	"Cephalosporins (5th gen.)"	"J01DI02,QJ01DI02"			"ceftar,cfro"	"ceftaroine,teflaro,zinforo"					"73604-1,73605-8,73626-4,73627-2,73649-6,73650-4,74170-2"
 "CPA"		"Ceftaroline/avibactam"	"Cephalosporins (5th gen.)"	"NA"			"NA"	"NA"					"73604-1,73626-4,73649-6"
-"CAZ"	5481173	"Ceftazidime"	"Cephalosporins (3rd gen.)"	"J01DD02,QJ01DD02"	"Other beta-lactam antibacterials"	"Third-generation cephalosporins"	"caz,cefta,ceftaz,cfta,cftz,taz,tz,xtz"	"ceftazimide,ceptaz,fortam,fortaz,fortum,glazidim,kefazim,modacin,pentacef,tazicef,tizime"			4	"g"	"101481-0,101482-8,101483-6,132-1,133-9,134-7,135-4,18893-8,21151-6,3449-6,35774-9,35775-6,35776-4,42352-5,55648-0,55649-8,55650-6,55651-4,58705-5,6995-5,73603-3,73625-6,73648-8,80960-8,87734-0,90850-9"
+"CAZ"	5481173	"Ceftazidime"	"Cephalosporins (3rd gen.)"	"J01DD02,QJ01DD02"	"Other beta-lactam antibacterials"	"Third-generation cephalosporins"	"caz,cef,cefta,ceftaz,cfta,cftz,taz,tz,xtz"	"ceftazimide,ceptaz,fortam,fortaz,fortum,glazidim,kefazim,modacin,pentacef,tazicef,tizime"			4	"g"	"101481-0,101482-8,101483-6,132-1,133-9,134-7,135-4,18893-8,21151-6,3449-6,35774-9,35775-6,35776-4,42352-5,55648-0,55649-8,55650-6,55651-4,58705-5,6995-5,73603-3,73625-6,73648-8,80960-8,87734-0,90850-9"
 "CZA"	90643431	"Ceftazidime/avibactam"	"Cephalosporins (3rd gen.)"	"J01DD52,QJ01DD52"			"cfav"	"avycaz,zavicefta"			6	"g"	"101483-6,73603-3,73625-6,73648-8,87734-0"
 "CCV"	9575352	"Ceftazidime/clavulanic acid"	"Cephalosporins (3rd gen.)"	"J01DD52,QJ01DD52"	"Other beta-lactam antibacterials"	"Third-generation cephalosporins"	"czcl,tazcla,xtzl"	"NA"			6	"g"	"NA"
 "CEM"	6537431	"Cefteram"	"Cephalosporins (3rd gen.)"	"J01DD18,QJ01DD18"			"cefter"	"cefterame,cefteramum,ceftetrame"	0.4	"g"			"100047-0,76144-5"
@@ -162,7 +162,7 @@
 "CYC"	6234	"Cycloserine"	"Oxazolidinones"	"J04AB01,QJ04AB01"	"Drugs for treatment of tuberculosis"	"Antibiotics"	"cycl,cyclos"	"cicloserina,closina,cyclorin,cycloserin,cycloserinum,farmiserina,levcicloserina,levcycloserine,levcycloserinum,micoserina,miroserina,miroseryn,novoserin,oxamicina,oxamycin,seromycin,tebemicina,wasserina"	0.75	"g"			"16702-3,18914-2,212-1,213-9,214-7,215-4,23608-3,25207-2,25208-0,25209-8,25251-0,3519-6,55667-0"
 "DAL"	23724878	"Dalbavancin"	"Glycopeptides"	"J01XA04,QJ01XA04"	"Other antibacterials"	"Glycopeptide antibacterials"	"dalb,dalbav"	"dalbavancina,dalvance,xydalba,zeven"			1.5	"g"	"41688-3,41689-1,41690-9,41734-5"
 "DAN"	71335	"Danofloxacin"	"Fluoroquinolones"	"QJ01MA92"			"danofl"	"advocin,danofloxacine,danofloxacino,danofloxacinum"					"73601-7,73623-1,73646-2"
-"DPS"	2955	"Dapsone"	"Other antibacterials"	"D10AX05,J04BA02,QD10AX05,QJ04BA02"	"Drugs for treatment of lepra"	"Drugs for treatment of lepra"	"NA"	"aczone,atrisone,avlosulfon,avlosulfone,avlosulphone,benzenamide,benzenamine,bissulfone,bissulphone,croysulfone,croysulphone,dapson,dapsona,dapsonum,daspone,diaphenylsulfon,diaphenylsulfone,diaphenylsulphon,diaphenylsulphone,diphenasone,diphone,disulfone,disulone,disulphone,dubronax,dumitone,eporal,medapsol,novophone,servidapson,sulfadione,sulfona,sulfonyldianiline,sulphadione,sulphonyldianiline,tarimyl,udolac,undolac"	50	"mg"			"51698-9,9747-7"
+"DPS"	2955	"Dapsone"	"Other antibacterials"	"D10AX05,J04BA02,QD10AX05,QJ04BA02"	"Drugs for treatment of lepra"	"Drugs for treatment of lepra"	"dao"	"aczone,atrisone,avlosulfon,avlosulfone,avlosulphone,benzenamide,benzenamine,bissulfone,bissulphone,croysulfone,croysulphone,dapson,dapsona,dapsonum,daspone,diaphenylsulfon,diaphenylsulfone,diaphenylsulphon,diaphenylsulphone,diphenasone,diphone,disulfone,disulone,disulphone,dubronax,dumitone,eporal,medapsol,novophone,servidapson,sulfadione,sulfona,sulfonyldianiline,sulphadione,sulphonyldianiline,tarimyl,udolac,undolac"	50	"mg"			"51698-9,9747-7"
 "DAP"	16134395	"Daptomycin"	"Other antibacterials"	"J01XX09,QJ01XX09"	"Other antibacterials"	"Other antibacterials"	"dap,dapt,dapt25,dapt50,daptom"	"cidecin,cubicin,dapcin,daptomicina,daptomycine,daptomycinum,deptomycin"			0.28	"g"	"35787-1,35788-9,35789-7,41691-7"
 "DFX"	487101	"Delafloxacin"	"Fluoroquinolones"	"J01MA23,QJ01MA23"			"NA"	"baxdela,delafloxacinum,quofenix"	0.9	"g"	0.6	"g"	"88885-9,90447-4,93790-4"
 "DLM"	6480466	"Delamanid"	"Antimycobacterials"	"J04AK06,QJ04AK06"	"Drugs for treatment of tuberculosis"	"Other drugs for treatment of tuberculosis"	"dela"	"deltyba"	0.2	"g"			"93851-4,96109-4"
@@ -184,7 +184,7 @@
 "ERV"	54726192	"Eravacycline"	"Tetracyclines"	"J01AA13,QJ01AA13"	"Tetracyclines"	"Tetracyclines"	"erav"	"xerava"			0.14	"g"	"100049-6,85423-2,93767-2"
 "ETP"	150610	"Ertapenem"	"Carbapenems"	"J01DH03,QJ01DH03"	"Other beta-lactam antibacterials"	"Carbapenems"	"erta,ertape,etp"	"ertapenemsalt,invanz"			1	"g"	"101486-9,35799-6,35800-2,35801-0,35802-8"
 "ERY"	12560	"Erythromycin"	"Macrolides/lincosamides"	"D10AF02,J01FA01,QD10AF02,QJ01FA01,QJ51FA01,QS01AA17,S01AA17"	"Macrolides, lincosamides and streptogramins"	"Macrolides"	"e,em,ery,ery32,eryt,eryth"	"abboticin,abomacetin,acneryne,acnesol,aknemycin,aknin,benzamycin,derimer,deripil,dotycin,dumotrycin,emgel,emuvin,emycin,endoeritrin,erecin,erisone,eritomicina,eritrocina,eritromicina,ermycin,eryacne,eryacnen,erycen,erycette,erycinum,eryderm,erydermer,erygel,eryhexal,erymax,erymed,erysafe,erytab,erythro,erythroderm,erythrogran,erythroguent,erythromast,erythromid,erythromycine,erythromycinum,erytop,erytrociclin,ilocaps,ilosone,iloticina,ilotycin,inderm,latotryd,lederpax,mephamycin,mercina,oftamolets,pantoderm,pantodrin,pantomicina,pharyngocin,primacine,propiocine,proterytrin,retcin,robimycin,sansac,spotex,staticin,stiemicyn,stiemycin,tiprocin,torlamicina,wemid"	2	"g"	1	"g"	"100050-4,11576-6,12298-6,16829-4,16830-2,18919-1,18920-9,20380-2,232-9,233-7,234-5,235-2,236-0,23633-1,237-8,238-6,239-4,25224-7,25275-9,3597-2,7009-4"
-"ETH"	14052	"Ethambutol"	"Antimycobacterials"	"J04AK02,QJ04AK02"	"Drugs for treatment of tuberculosis"	"Other drugs for treatment of tuberculosis"	"etha,ethamb"	"aethambutolum,dadibutol,diambutol,etambutol,etambutolo,ethambutolum,myambutol,purderal,servambutol,tibutol"	1.2	"g"	1.2	"g"	"100051-2,16841-9,18921-7,20381-0,23625-7,240-2,241-0,242-8,243-6,25187-6,25194-2,25195-9,25230-4,25404-5,3607-9,42645-2,42646-0,55154-9,55674-6,56025-0,7010-2,89491-5"
+"ETH"	14052	"Ethambutol"	"Antimycobacterials"	"J04AK02,QJ04AK02"	"Drugs for treatment of tuberculosis"	"Other drugs for treatment of tuberculosis"	"emb,etha,ethamb"	"aethambutolum,dadibutol,diambutol,etambutol,etambutolo,ethambutolum,myambutol,purderal,servambutol,tibutol"	1.2	"g"	1.2	"g"	"100051-2,16841-9,18921-7,20381-0,23625-7,240-2,241-0,242-8,243-6,25187-6,25194-2,25195-9,25230-4,25404-5,3607-9,42645-2,42646-0,55154-9,55674-6,56025-0,7010-2,89491-5"
 "ETI"	456476	"Ethambutol/isoniazid"	"Antimycobacterials"	"J04AM03,QJ04AM03"	"Drugs for treatment of tuberculosis"	"Combinations of drugs for treatment of tuberculosis"	"NA"	"NA"					"NA"
 "ETI1"	2761171	"Ethionamide"	"Antimycobacterials"	"J04AD03,QJ04AD03"	"Drugs for treatment of tuberculosis"	"Thiocarbamide derivatives"	"ethi,ethion"	"aethionamidum,aetina,aetiva,amidazin,amidazine,atina,ethimide,ethina,ethinamide,ethionamidum,ethioniamide,ethylisothiamide,ethyonomide,etimid,etiocidan,etionamid,etionamida,etionamide,etioniamid,etionid,etionizin,etionizina,etionizine,fatoliamid,iridocin,iridozin,isothin,isotiamida,itiocide,nicotion,nisotin,nizotin,rigenicid,sertinon,teberus,thianid,thianide,thioamide,thiodine,thiomid,thioniden,tianid,tiomid,trecator,trekator,trescatyl,trescazide,tubenamide,tubermin,tuberoid,tuberoson"	0.75	"g"			"16099-4,16845-0,18922-5,20382-8,23617-4,25183-5,25196-7,25198-3,25231-2,41693-3,42647-8,42648-6,7011-0,96110-2"
 "ETO"	6034	"Ethopabate"	"Other antibacterials"	"QP51AX17"			"NA"	"ethopabat"					"NA"
@@ -202,7 +202,7 @@
 "FLM"	3374	"Flumequine"	"Quinolones"	"J01MB07,QJ01MB07"	"Quinolone antibacterials"	"Other quinolones"	"flumeq"	"apurone,fantacin,flumequina,flumequino,flumequinum,flumigal,flumiquil,flumisol,flumix,imequyl"	1.2	"g"			"55675-3,55676-1,55677-9,55678-7"
 "FLR1"	71260	"Flurithromycin"	"Macrolides/lincosamides"	"J01FA14,QJ01FA14"	"Macrolides, lincosamides and streptogramins"	"Macrolides"	"NA"	"abbot,beritromicina,berythromycin,berythromycine,berythromycinum,flurithromycine,flurithromycinum,fluritromicina,fluritromycinum,flurizic,mizar"	0.75	"g"			"NA"
 "FFL"	214356	"Fosfluconazole"	"Antifungals/antimycotics"	"NA"			"NA"	"fosfluconazol,procif,prodif"					"NA"
-"FOS"	446987	"Fosfomycin"	"Other antibacterials"	"J01XX01,QJ01XX01,QS02AA17,S02AA17"	"Other antibacterials"	"Other antibacterials"	"ff,fm,fo,fof,fos,fosf,fosfom,fosmyc"	"fosfocina,fosfomicin,fosfomicina,fosfomycine,fosfomycinum,fosfonomycin,infectophos,phosphonemycin,phosphonomycin,veramina"	3	"g"	8	"g"	"25596-8,25653-7,35809-3,35810-1"
+"FOS"	446987	"Fosfomycin"	"Phosphonics"	"J01XX01,QJ01XX01,QS02AA17,S02AA17"	"Other antibacterials"	"Other antibacterials"	"ff,fm,fo,fof,fos,fosf,fosfom,fosmyc"	"fosfocina,fosfomicin,fosfomicina,fosfomycine,fosfomycinum,fosfonomycin,infectophos,phosphonemycin,phosphonomycin,veramina"	3	"g"	8	"g"	"25596-8,25653-7,35809-3,35810-1"
 "FMD"	572	"Fosmidomycin"	"Other antibacterials"	"NA"			"NA"	"fosmidomicina,fosmidomycina,fosmidomycine,fosmidomycinsalt,fosmidomycinum"					"NA"
 "FRM"	8378	"Framycetin"	"Aminoglycosides"	"D09AA01,QD09AA01,QJ01GB91,QR01AX08,QS01AA07,R01AX08,S01AA07"			"fram,framyc"	"actilin,actiline,antibiotique,bycomycin,enterfram,fradiomycin,fradiomycinum,framicetina,framidal,framycetine,framycetinum,framycin,framygen,francetin,jernadex,myacyne,mycerin,mycifradin,neobrettin,neolate,neomas,neomcin,neomicina,neomin,neomycine,neomycinum,nivemycin,soframycin,soframycine"					"18926-6,257-6,258-4,259-2,260-0,55679-5"
 "FUR"	6870646	"Furazidin"	"Other antibacterials"	"J01XE03,QJ01XE03"	"Other antibacterials"	"Nitrofuran derivatives"	"NA"	"akritoin,furagin,furaginum,furamag,furazidine,hydantoin"	0.3	"g"			"NA"
@@ -268,7 +268,7 @@
 "MET"	6087	"Meticillin"	"Beta-lactams/penicillins"	"J01CF03,QJ01CF03,QJ51CF03"	"Beta-lactam antibacterials, penicillins"	"Beta-lactamase resistant penicillins"	"methic,meti"	"belfacillin,celbenin,celpilline,cinopenil,dimocillin,estafcilina,flabelline,lucopenin,metacillin,methcillin,methicillin,methicillinanhydrous,methicillinhydrate,methicillinsalt,methicillinum,methycillin,meticilina,meticillina,meticilline,meticillinsalt,meticillinum,penaureus,penysol,staficyn,staphcillin,synticillin"			4	"g"	"NA"
 "MTP"	68590	"Metioprim"	"Other antibacterials"	"NA"			"NA"	"methioprim,metioprima,metioprime,metioprimum"					"NA"
 "MXT"	3047729	"Metioxate"	"Fluoroquinolones"	"NA"			"NA"	"metioxato,metioxatum"					"NA"
-"MTR"	4173	"Metronidazole"	"Other antibacterials"	"A01AB17,D06BX01,G01AF01,J01XD01,P01AB01,QA01AB17,QD06BX01,QG01AF01,QJ01XD01,QP51CA01"	"Other antibacterials"	"Imidazole derivatives"	"metr,metron,mnz"	"acromona,anagiardil,arilin,atrivyl,bexon,clont,danizol,deflamon,donnan,efloran,elyzol,entizol,eumin,flagemona,flagesol,flagil,flagyl,flazol,flegyl,florazole,fossyol,giatricol,gineflavir,givagil,hydroxydimetridazole,hydroxymetronidazole,izoklion,klion,klont,mepagyl,meronidal,metric,metrolag,metrolyl,metromidol,metronidazolo,metronidazolum,metroplex,metrotop,mexibol,monagyl,monasin,nalox,nidagyl,noritate,novonidazol,nuvessa,orvagil,polibiotic,protostat,rathimed,rosaced,rosased,sanatrichom,satric,takimetol,trichazol,trichex,trichobrol,trichocide,trichomol,trichopal,trichopol,tricocet,tricom,trikacide,trikamon,trikhopol,trikojol,trikozol,trimeks,trivazol,vagilen,vagimid,vandazole,vertisal,wagitran,zadstat,zidoval"	2	"g"	1.5	"g"	"10991-8,18946-4,326-9,327-7,328-5,329-3,7031-8"
+"MTR"	4173	"Metronidazole"	"Other antibacterials"	"A01AB17,D06BX01,G01AF01,J01XD01,P01AB01,QA01AB17,QD06BX01,QG01AF01,QJ01XD01,QP51CA01"	"Other antibacterials"	"Imidazole derivatives"	"metr,metron,mnz,mtz"	"acromona,anagiardil,arilin,atrivyl,bexon,clont,danizol,deflamon,donnan,efloran,elyzol,entizol,eumin,flagemona,flagesol,flagil,flagyl,flazol,flegyl,florazole,fossyol,giatricol,gineflavir,givagil,hydroxydimetridazole,hydroxymetronidazole,izoklion,klion,klont,mepagyl,meronidal,metric,metrolag,metrolyl,metromidol,metronidazolo,metronidazolum,metroplex,metrotop,mexibol,monagyl,monasin,nalox,nidagyl,noritate,novonidazol,nuvessa,orvagil,polibiotic,protostat,rathimed,rosaced,rosased,sanatrichom,satric,takimetol,trichazol,trichex,trichobrol,trichocide,trichomol,trichopal,trichopol,tricocet,tricom,trikacide,trikamon,trikhopol,trikojol,trikozol,trimeks,trivazol,vagilen,vagimid,vandazole,vertisal,wagitran,zadstat,zidoval"	2	"g"	1.5	"g"	"10991-8,18946-4,326-9,327-7,328-5,329-3,7031-8"
 "MEZ"	656511	"Mezlocillin"	"Beta-lactams/penicillins"	"J01CA10,QJ01CA10"	"Beta-lactam antibacterials, penicillins"	"Penicillins with extended spectrum"	"mez,mezl,mezlo,mz"	"baycipen,baypen,mezlin,mezlocilina,mezlocilline,mezlocillinsalt,mezlocillinum,multocillin"			6	"g"	"18947-2,330-1,331-9,332-7,333-5,3820-8,41702-2,54194-6,54195-3,54196-1"
 "MSU"		"Mezlocillin/sulbactam"	"Beta-lactams/penicillins"	"NA"			"mezsul"	"NA"					"54194-6,54195-3,54196-1"
 "MIF"	477468	"Micafungin"	"Antifungals/antimycotics"	"J02AX05,QJ02AX05"	"Antimycotics for systemic use"	"Other antimycotics for systemic use"	"mica,micafu"	"fungard,funguard,micafungina,micafunginsalt,mycamine"			0.1	"g"	"53812-4,58418-5,65340-2,85048-7"
@@ -339,7 +339,7 @@
 "PMR"	5284447	"Pimaricin"	"Antifungals/antimycotics"	"NA"			"natamycin"	"delvocid,delvolan,delvopos,mycophyt,myprozine,natacyn,natafucin,natajen,natamatrix,natamax,natamicina,natamycin,natamycine,natamycinum,pimafucin,pimaracin,pimaricine,pimarizin,synogil,tennecetin"					"NA"
 "PPA"	4831	"Pipemidic acid"	"Quinolones"	"J01MB04,QJ01MB04"	"Quinolone antibacterials"	"Other quinolones"	"pipaci,pipz,pizu"	"deblaston,dolcol,filtrax,karunomazin,memento,nuril,palin,pipedac,pipemid,pipemidate,pipemidic,pipemidicacid,pipram,pipurin,tractur,uromidin,urosten,uroval"	0.8	"g"			"NA"
 "PIP"	43672	"Piperacillin"	"Beta-lactams/penicillins"	"J01CA12,QJ01CA12"	"Beta-lactam antibacterials, penicillins"	"Penicillins with extended spectrum"	"pi,pip,pipc,pipe,pipera,pp"	"penmalin,pentcillin,peperacillin,peracin,piperacilina,piperacillina,piperacilline,piperacillinhydrate,piperacillinum,pipercillin,pipracil,tazocin"			14	"g"	"101490-1,101491-9,18969-6,18970-4,25268-4,3972-7,407-7,408-5,409-3,410-1,411-9,412-7,413-5,414-3,54197-9,54198-7,54199-5,55704-1,7043-3,7044-1"
-"PIS"		"Piperacillin/sulbactam"	"Beta-lactams/penicillins"	"J01CR05,QJ01CR05"			"NA"	"NA"			14	"g"	"54197-9,54198-7,54199-5,55704-1"
+"PIS"		"Piperacillin/sulbactam"	"Beta-lactams/penicillins"	"NA"			"NA"	"NA"			14	"g"	"54197-9,54198-7,54199-5,55704-1"
 "TZP"	461573	"Piperacillin/tazobactam"	"Beta-lactams/penicillins"	"J01CR05,QJ01CR05"	"Beta-lactam antibacterials, penicillins"	"Combinations of penicillins, incl. beta-lactamase inhibitors"	"p/t,piptaz,piptazo,pit,pita,pt,ptc,ptz,tzp"	"piptazobactam,tazonam,zobactin,zosyn"			14	"g"	"101491-9,18970-4,411-9,412-7,413-5,414-3,7044-1"
 "PRC"	71978	"Piridicillin"	"Beta-lactams/penicillins"	"NA"			"NA"	"NA"					"NA"
 "PRL"	157385	"Pirlimycin"	"Macrolides/lincosamides"	"QJ51FF90"			"pirlim"	"pirlimycina,pirlimycine,pirlimycinum,pirsue"					"35829-1,35830-9,35831-7"
@@ -370,7 +370,7 @@
 "RBC"	44631912	"Ribociclib"	"Antifungals/antimycotics"	"L01EF02,QL01EF02"	"Antimycotics for systemic use"	"Triazole derivatives"	"ribo"	"kisqali"	0.45	"g"			"NA"
 "RST"	33042	"Ribostamycin"	"Aminoglycosides"	"J01GB10,QJ01GB10"	"Aminoglycoside antibacterials"	"Other aminoglycosides"	"NA"	"exaluren,hetangmycin,ribastamin,ribostamicina,ribostamycine,ribostamycinum,vistamycin,xylostatin"			1	"g"	"NA"
 "RID1"	16659285	"Ridinilazole"	"Other antibacterials"	"NA"			"NA"	"ridinilazol"					"NA"
-"RIB"	135398743	"Rifabutin"	"Antimycobacterials"	"J04AB04,QJ04AB04"	"Drugs for treatment of tuberculosis"	"Antibiotics"	"ansamy,rifb"	"alfacid,ansamicin,ansamycins,ansatipin,ansatipine,assatipin,mycobutin,rifabutinum"	0.15	"g"			"100699-8,16100-0,16386-5,16387-3,19149-4,20386-9,23630-7,24032-5,25199-1,25200-7,25201-5,42655-1,42656-9,54183-9,96113-6"
+"RIB"	135398743	"Rifabutin"	"Antimycobacterials"	"J04AB04,QJ04AB04"	"Drugs for treatment of tuberculosis"	"Antibiotics"	"ansamy,rfb,rifb"	"alfacid,ansamicin,ansamycins,ansatipin,ansatipine,assatipin,mycobutin,rifabutinum"	0.15	"g"			"100699-8,16100-0,16386-5,16387-3,19149-4,20386-9,23630-7,24032-5,25199-1,25200-7,25201-5,42655-1,42656-9,54183-9,96113-6"
 "RIF"	135398735	"Rifampicin"	"Antimycobacterials"	"J04AB02,QJ04AB02,QJ54AB02"	"Drugs for treatment of tuberculosis"	"Antibiotics"	"rifa,rifamp"	"abrifam,archidyn,arficin,arzide,benemicin,doloresum,eremfat,famcin,fenampicin,rifadin,rifadine,rifagen,rifaldazin,rifaldazine,rifaldin,rifam,rifamor,rifampicina,rifampicine,rifampicinum,rifampin,rifamsolin,rifapiam,rifaprodin,rifcin,rifinah,rifobac,rifoldin,rifoldine,riforal,rimactan,rimactane,rimactazid,rimactizid,rimazid,sinerdol,tubocin"	0.6	"g"	0.6	"g"	"NA"
 "REI"	135483893	"Rifampicin/ethambutol/isoniazid"	"Antimycobacterials"	"J04AM07,QJ04AM07"	"Drugs for treatment of tuberculosis"	"Combinations of drugs for treatment of tuberculosis"	"NA"	"isonarif,rifamate,rifamazid"					"NA"
 "RFI"		"Rifampicin/isoniazid"	"Antimycobacterials"	"J04AM02,QJ04AM02"	"Drugs for treatment of tuberculosis"	"Combinations of drugs for treatment of tuberculosis"	"NA"	"NA"					"NA"
@@ -391,7 +391,6 @@
 "SRC"	54681908	"Sarecycline"	"Tetracyclines"	"J01AA14,QJ01AA14"	"Tetracyclines"	"Tetracyclines"	"NA"	"sareciclina,seysara"	0.1	"g"			"NA"
 "SRX"	9933415	"Sarmoxicillin"	"Beta-lactams/penicillins"	"NA"			"NA"	"sarmoxillina,sarmoxilline,sarmoxillinum"					"NA"
 "SEC"	71815	"Secnidazole"	"Other antibacterials"	"P01AB07"			"NA"	"flagentyl,secnidal,secnidazolum,secnil,sindose,solosec"	2	"g"			"NA"
-"SMF"		"Simvastatin/fenofibrate"	"Antimycobacterials"	"C10BA04,QC10BA04"	"Drugs for treatment of tuberculosis"	"Other drugs for treatment of tuberculosis"	"simv"	"NA"					"NA"
 "SIS"	36119	"Sisomicin"	"Aminoglycosides"	"J01GB08,QJ01GB08"	"Aminoglycoside antibacterials"	"Other aminoglycosides"	"siso,sisomy"	"rickamicin,salvamina,sisomicina,sisomicine,sisomicinum,sisomin,sisomycin,sissomicin,sizomycin"			0.24	"g"	"18979-5,447-3,448-1,449-9,450-7,55714-0"
 "SIT"	461399	"Sitafloxacin"	"Fluoroquinolones"	"J01MA21,QJ01MA21"			"sitafl"	"gracevit"	0.1	"g"			"NA"
 "SDA"	2724368	"Sodium aminosalicylate"	"Antimycobacterials"	"J04AA02,QJ04AA02"	"Drugs for treatment of tuberculosis"	"Aminosalicylic acid and derivatives"	"NA"	"bactylan,lepasen,monopas,tubersan"	14	"g"	14	"g"	"NA"
@@ -495,4 +494,4 @@
 "VOR"	71616	"Voriconazole"	"Antifungals/antimycotics"	"J02AC03,QJ02AC03"	"Antimycotics for systemic use"	"Triazole derivatives"	"vori,vorico,vrc"	"vfend,voriconazol,voriconazolum,voriconzole,vorikonazole"	0.4	"g"	0.4	"g"	"32379-0,35862-2,35863-0,38370-3,41199-1,41200-7,53902-3,73676-9,80553-1,80651-3"
 "XBR"	72144	"Xibornol"	"Other antibacterials"	"J01XX02,QJ01XX02"	"Other antibacterials"	"Other antibacterials"	"NA"	"bactacine,bracen,nanbacine,xibornolo,xibornolum"					"NA"
 "ZID"	77846445	"Zidebactam"	"Other antibacterials"	"NA"			"NA"	"zidebactamsalt"					"NA"
-"ZFD"		"Zoliflodacin"		"NA"			"NA"	"NA"					"NA"
+"ZFD"		"Zoliflodacin"		"NA"			"zol"	"NA"					"NA"

data-raw/microorganisms.md5

@@ -1 +1 @@
-5908f9e6e7687dfb8301d27fb26d1790
+6dc4dded108052760bfb626df03435e2

data-raw/read_EUCAST.R

@@ -283,7 +283,7 @@ for (i in 2:length(sheets_to_analyse)) {
         guideline_name = guideline_name
       )
     ),
-    error = function(e) message(e$message)
+    error = function(e) message(conditionMessage(e))
   )
 }
 

index.Rmd

@@ -28,8 +28,8 @@ AMR:::reset_all_thrown_messages()
 > Now available for Python too! [Click here](./articles/AMR_for_Python.html) to read more.
 
 <div style="display: flex; font-size: 0.8em;">
-  <p style="text-align:left; width: 50%;"><small><a href="https://amr-for-r.org/">https://amr-for-r.org</a></small></p>
-  <p style="text-align:right; width: 50%;"><small><a href="https://doi.org/10.18637/jss.v104.i03" target="_blank">https://doi.org/10.18637/jss.v104.i03</a></small></p>
+  <p style="text-align:left; width: 50%;"><small><a href="https://amr-for-r.org/">amr-for-r.org</a></small></p>
+  <p style="text-align:right; width: 50%;"><small><a href="https://doi.org/10.18637/jss.v104.i03" target="_blank">doi.org/10.18637/jss.v104.i03</a></small></p>
 </div>
 
 <a href="./reference/clinical_breakpoints.html#response-from-clsi-and-eucast"><img src="./endorsement_clsi_eucast.jpg" class="endorse_img" align="right" height="120" /></a>
@@ -133,7 +133,7 @@ ggplot(data.frame(mic = some_mic_values,
                   sir = interpretation),
        aes(x = group, y = mic, colour = sir)) +
   theme_minimal() +
-  geom_boxplot(fill = NA, colour = "grey") +
+  geom_boxplot(fill = NA, colour = "grey30") +
   geom_jitter(width = 0.25) +
   
   # NEW scale function: plot MIC values to x, y, colour or fill

index.md

@@ -27,12 +27,12 @@
 
 <p style="text-align:left; width: 50%;">
 
-<small><a href="https://amr-for-r.org/">https://amr-for-r.org</a></small>
+<small><a href="https://amr-for-r.org/">amr-for-r.org</a></small>
 </p>
 
 <p style="text-align:right; width: 50%;">
 
-<small><a href="https://doi.org/10.18637/jss.v104.i03" target="_blank">https://doi.org/10.18637/jss.v104.i03</a></small>
+<small><a href="https://doi.org/10.18637/jss.v104.i03" target="_blank">doi.org/10.18637/jss.v104.i03</a></small>
 </p>
 
 </div>
@@ -171,14 +171,14 @@ example_isolates %>%
   select(bacteria,
          aminoglycosides(),
          carbapenems())
-#> ℹ Using column 'mo' as input for mo_fullname()
-#> ℹ Using column 'mo' as input for mo_is_gram_negative()
-#> ℹ Using column 'mo' as input for mo_is_intrinsic_resistant()
+#> ℹ Using column 'mo' as input for `mo_fullname()`
+#> ℹ Using column 'mo' as input for `mo_is_gram_negative()`
+#> ℹ Using column 'mo' as input for `mo_is_intrinsic_resistant()`
 #> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant
 #>   Phenotypes' v1.2 (2023). This note will be shown once per session.
-#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
+#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
 #>   (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
-#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem)
+#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
 #> # A tibble: 35 × 7
 #>    bacteria                     GEN   TOB   AMK   KAN   IPM   MEM  
 #>    <chr>                        <sir> <sir> <sir> <sir> <sir> <sir>
@@ -215,9 +215,9 @@ output format automatically (such as markdown, LaTeX, HTML, etc.).
 ``` r
 antibiogram(example_isolates,
             antimicrobials = c(aminoglycosides(), carbapenems()))
-#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
+#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
 #>   (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
-#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem)
+#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
 ```
 
 | Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin |
@@ -289,7 +289,7 @@ ggplot(data.frame(mic = some_mic_values,
                   sir = interpretation),
        aes(x = group, y = mic, colour = sir)) +
   theme_minimal() +
-  geom_boxplot(fill = NA, colour = "grey") +
+  geom_boxplot(fill = NA, colour = "grey30") +
   geom_jitter(width = 0.25) +
   
   # NEW scale function: plot MIC values to x, y, colour or fill
@@ -321,9 +321,9 @@ example_isolates %>%
 #> # A tibble: 3 × 5
 #>   ward       GEN_total_R GEN_conf_int TOB_total_R TOB_conf_int
 #>   <chr>            <dbl> <chr>              <dbl> <chr>       
-#> 1 Clinical     0.2289362 0.205-0.254    0.3147503 0.284-0.347 
-#> 2 ICU          0.2902655 0.253-0.33     0.4004739 0.353-0.449 
-#> 3 Outpatient   0.2       0.131-0.285    0.3676471 0.254-0.493
+#> 1 Clinical         0.229 0.205-0.254        0.315 0.284-0.347 
+#> 2 ICU              0.290 0.253-0.33         0.400 0.353-0.449 
+#> 3 Outpatient       0.2   0.131-0.285        0.368 0.254-0.493
 ```
 
 Or use [antimicrobial
@@ -340,44 +340,44 @@ out <- example_isolates %>%
   # calculate AMR using resistance(), over all aminoglycosides and polymyxins:
   summarise(across(c(aminoglycosides(), polymyxins()),
             resistance))
-#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
+#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
 #>   (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
-#> ℹ For polymyxins() using column 'COL' (colistin)
+#> ℹ For `polymyxins()` using column 'COL' (colistin)
 #> Warning: There was 1 warning in `summarise()`.
 #> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`.
 #> ℹ In group 3: `ward = "Outpatient"`.
 #> Caused by warning:
 #> ! Introducing NA: only 23 results available for KAN in group: ward =
-#> "Outpatient" (minimum = 30).
+#> "Outpatient" (`minimum` = 30).
 out
 #> # A tibble: 3 × 6
-#>   ward             GEN       TOB       AMK   KAN       COL
-#>   <chr>          <dbl>     <dbl>     <dbl> <dbl>     <dbl>
-#> 1 Clinical   0.2289362 0.3147503 0.6258993     1 0.7802956
-#> 2 ICU        0.2902655 0.4004739 0.6624473     1 0.8574144
-#> 3 Outpatient 0.2       0.3676471 0.6052632    NA 0.8888889
+#>   ward         GEN   TOB   AMK   KAN   COL
+#>   <chr>      <dbl> <dbl> <dbl> <dbl> <dbl>
+#> 1 Clinical   0.229 0.315 0.626     1 0.780
+#> 2 ICU        0.290 0.400 0.662     1 0.857
+#> 3 Outpatient 0.2   0.368 0.605    NA 0.889
 ```
 
 ``` r
 # transform the antibiotic columns to names:
 out %>% set_ab_names()
 #> # A tibble: 3 × 6
-#>   ward       gentamicin tobramycin  amikacin kanamycin  colistin
-#>   <chr>           <dbl>      <dbl>     <dbl>     <dbl>     <dbl>
-#> 1 Clinical    0.2289362  0.3147503 0.6258993         1 0.7802956
-#> 2 ICU         0.2902655  0.4004739 0.6624473         1 0.8574144
-#> 3 Outpatient  0.2        0.3676471 0.6052632        NA 0.8888889
+#>   ward       gentamicin tobramycin amikacin kanamycin colistin
+#>   <chr>           <dbl>      <dbl>    <dbl>     <dbl>    <dbl>
+#> 1 Clinical        0.229      0.315    0.626         1    0.780
+#> 2 ICU             0.290      0.400    0.662         1    0.857
+#> 3 Outpatient      0.2        0.368    0.605        NA    0.889
 ```
 
 ``` r
 # transform the antibiotic column to ATC codes:
 out %>% set_ab_names(property = "atc")
 #> # A tibble: 3 × 6
-#>   ward         J01GB03   J01GB01   J01GB06 J01GB04   J01XB01
-#>   <chr>          <dbl>     <dbl>     <dbl>   <dbl>     <dbl>
-#> 1 Clinical   0.2289362 0.3147503 0.6258993       1 0.7802956
-#> 2 ICU        0.2902655 0.4004739 0.6624473       1 0.8574144
-#> 3 Outpatient 0.2       0.3676471 0.6052632      NA 0.8888889
+#>   ward       J01GB03 J01GB01 J01GB06 J01GB04 J01XB01
+#>   <chr>        <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
+#> 1 Clinical     0.229   0.315   0.626       1   0.780
+#> 2 ICU          0.290   0.400   0.662       1   0.857
+#> 3 Outpatient   0.2     0.368   0.605      NA   0.889
 ```
 
 ## What else can you do with this package?

man/age_groups.Rd

@@ -4,20 +4,23 @@
 \alias{age_groups}
 \title{Split Ages into Age Groups}
 \usage{
-age_groups(x, split_at = c(12, 25, 55, 75), na.rm = FALSE)
+age_groups(x, split_at = c(0, 12, 25, 55, 75), names = NULL,
+  na.rm = FALSE)
 }
 \arguments{
 \item{x}{Age, e.g. calculated with \code{\link[=age]{age()}}.}
 
 \item{split_at}{Values to split \code{x} at - the default is age groups 0-11, 12-24, 25-54, 55-74 and 75+. See \emph{Details}.}
 
+\item{names}{Optional names to be given to the various age groups.}
+
 \item{na.rm}{A \link{logical} to indicate whether missing values should be removed.}
 }
 \value{
 Ordered \link{factor}
 }
 \description{
-Split ages into age groups defined by the \code{split} argument. This allows for easier demographic (antimicrobial resistance) analysis.
+Split ages into age groups defined by the \code{split} argument. This allows for easier demographic (antimicrobial resistance) analysis. The function returns an ordered \link{factor}.
 }
 \details{
 To split ages, the input for the \code{split_at} argument can be:
@@ -41,6 +44,7 @@ age_groups(ages, 50)
 
 # split into 0-19, 20-49 and 50+
 age_groups(ages, c(20, 50))
+age_groups(ages, c(20, 50), names = c("Under 20 years", "20 to 50 years", "Over 50 years"))
 
 # split into groups of ten years
 age_groups(ages, 1:10 * 10)

man/antibiogram.Rd

@@ -56,6 +56,7 @@ retrieve_wisca_parameters(wisca_model, ...)
 \item \code{c(aminoglycosides(), "AMP", "AMC")}
 \item \code{c(aminoglycosides(), carbapenems())}
 }
+\item Column indices using numbers
 \item Combination therapy, indicated by using \code{"+"}, with or without \link[=antimicrobial_selectors]{antimicrobial selectors}, e.g.:
 \itemize{
 \item \code{"cipro + genta"}

man/antimicrobial_selectors.Rd

@@ -181,7 +181,7 @@ The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function c
 \item \code{\link[=aminoglycosides]{aminoglycosides()}} can select: \cr amikacin (AMK), amikacin/fosfomycin (AKF), apramycin (APR), arbekacin (ARB), astromicin (AST), bekanamycin (BEK), dibekacin (DKB), framycetin (FRM), gentamicin (GEN), gentamicin-high (GEH), habekacin (HAB), hygromycin (HYG), isepamicin (ISE), kanamycin (KAN), kanamycin-high (KAH), kanamycin/cephalexin (KAC), micronomicin (MCR), neomycin (NEO), netilmicin (NET), pentisomicin (PIM), plazomicin (PLZ), propikacin (PKA), ribostamycin (RST), sisomicin (SIS), streptoduocin (STR), streptomycin (STR1), streptomycin-high (STH), tobramycin (TOB), and tobramycin-high (TOH)
 \item \code{\link[=aminopenicillins]{aminopenicillins()}} can select: \cr amoxicillin (AMX) and ampicillin (AMP)
 \item \code{\link[=antifungals]{antifungals()}} can select: \cr amorolfine (AMO), amphotericin B (AMB), amphotericin B-high (AMH), anidulafungin (ANI), butoconazole (BUT), caspofungin (CAS), ciclopirox (CIX), clotrimazole (CTR), econazole (ECO), fluconazole (FLU), flucytosine (FCT), fosfluconazole (FFL), griseofulvin (GRI), hachimycin (HCH), ibrexafungerp (IBX), isavuconazole (ISV), isoconazole (ISO), itraconazole (ITR), ketoconazole (KET), manogepix (MGX), micafungin (MIF), miconazole (MCZ), nystatin (NYS), oteseconazole (OTE), pimaricin (PMR), posaconazole (POS), rezafungin (RZF), ribociclib (RBC), sulconazole (SUC), terbinafine (TRB), terconazole (TRC), and voriconazole (VOR)
-\item \code{\link[=antimycobacterials]{antimycobacterials()}} can select: \cr 4-aminosalicylic acid (AMA), calcium aminosalicylate (CLA), capreomycin (CAP), clofazimine (CLF), delamanid (DLM), enviomycin (ENV), ethambutol (ETH), ethambutol/isoniazid (ETI), ethionamide (ETI1), isoniazid (INH), isoniazid/sulfamethoxazole/trimethoprim/pyridoxine (IST), morinamide (MRN), p-aminosalicylic acid (PAS), pretomanid (PMD), protionamide (PTH), pyrazinamide (PZA), rifabutin (RIB), rifampicin (RIF), rifampicin/ethambutol/isoniazid (REI), rifampicin/isoniazid (RFI), rifampicin/pyrazinamide/ethambutol/isoniazid (RPEI), rifampicin/pyrazinamide/isoniazid (RPI), rifamycin (RFM), rifapentine (RFP), simvastatin/fenofibrate (SMF), sodium aminosalicylate (SDA), streptomycin/isoniazid (STI), terizidone (TRZ), thioacetazone (TAT), thioacetazone/isoniazid (THI1), tiocarlide (TCR), and viomycin (VIO)
+\item \code{\link[=antimycobacterials]{antimycobacterials()}} can select: \cr 4-aminosalicylic acid (AMA), calcium aminosalicylate (CLA), capreomycin (CAP), clofazimine (CLF), delamanid (DLM), enviomycin (ENV), ethambutol (ETH), ethambutol/isoniazid (ETI), ethionamide (ETI1), isoniazid (INH), isoniazid/sulfamethoxazole/trimethoprim/pyridoxine (IST), morinamide (MRN), p-aminosalicylic acid (PAS), pretomanid (PMD), protionamide (PTH), pyrazinamide (PZA), rifabutin (RIB), rifampicin (RIF), rifampicin/ethambutol/isoniazid (REI), rifampicin/isoniazid (RFI), rifampicin/pyrazinamide/ethambutol/isoniazid (RPEI), rifampicin/pyrazinamide/isoniazid (RPI), rifamycin (RFM), rifapentine (RFP), sodium aminosalicylate (SDA), streptomycin/isoniazid (STI), terizidone (TRZ), thioacetazone (TAT), thioacetazone/isoniazid (THI1), tiocarlide (TCR), and viomycin (VIO)
 \item \code{\link[=betalactams]{betalactams()}} can select: \cr amoxicillin (AMX), amoxicillin/clavulanic acid (AMC), amoxicillin/sulbactam (AXS), ampicillin (AMP), ampicillin/sulbactam (SAM), apalcillin (APL), aspoxicillin (APX), azidocillin (AZD), azlocillin (AZL), aztreonam (ATM), aztreonam/avibactam (AZA), aztreonam/nacubactam (ANC), bacampicillin (BAM), benzathine benzylpenicillin (BNB), benzathine phenoxymethylpenicillin (BNP), benzylpenicillin (PEN), benzylpenicillin screening test (PEN-S), biapenem (BIA), carbenicillin (CRB), carindacillin (CRN), carumonam (CAR), cefacetrile (CAC), cefaclor (CEC), cefadroxil (CFR), cefalexin (LEX), cefaloridine (RID), cefalotin (CEP), cefamandole (MAN), cefapirin (HAP), cefatrizine (CTZ), cefazedone (CZD), cefazolin (CZO), cefcapene (CCP), cefcapene pivoxil (CCX), cefdinir (CDR), cefditoren (DIT), cefditoren pivoxil (DIX), cefepime (FEP), cefepime/amikacin (CFA), cefepime/clavulanic acid (CPC), cefepime/enmetazobactam (FPE), cefepime/nacubactam (FNC), cefepime/tazobactam (FPT), cefepime/zidebactam (FPZ), cefetamet (CAT), cefetamet pivoxil (CPI), cefetecol (CCL), cefetrizole (CZL), cefiderocol (FDC), cefixime (CFM), cefmenoxime (CMX), cefmetazole (CMZ), cefodizime (DIZ), cefonicid (CID), cefoperazone (CFP), cefoperazone/sulbactam (CSL), ceforanide (CND), cefoselis (CSE), cefotaxime (CTX), cefotaxime screening test (CTX-S), cefotaxime/clavulanic acid (CTC), cefotaxime/sulbactam (CTS), cefotetan (CTT), cefotiam (CTF), cefotiam hexetil (CHE), cefovecin (FOV), cefoxitin (FOX), cefoxitin screening test (FOX-S), cefozopran (ZOP), cefpimizole (CFZ), cefpiramide (CPM), cefpirome (CPO), cefpodoxime (CPD), cefpodoxime proxetil (CPX), cefpodoxime/clavulanic acid (CDC), cefprozil (CPR), cefquinome (CEQ), cefroxadine (CRD), cefsulodin (CFS), cefsumide (CSU), ceftaroline (CPT), ceftaroline/avibactam (CPA), ceftazidime (CAZ), ceftazidime/avibactam (CZA), ceftazidime/clavulanic acid (CCV), cefteram (CEM), cefteram pivoxil (CPL), ceftezole (CTL), ceftibuten (CTB), ceftiofur (TIO), ceftizoxime (CZX), ceftizoxime alapivoxil (CZP), ceftobiprole (BPR), ceftobiprole medocaril (CFM1), ceftolozane/tazobactam (CZT), ceftriaxone (CRO), ceftriaxone/beta-lactamase inhibitor (CEB), cefuroxime (CXM), cefuroxime axetil (CXA), cephradine (CED), ciclacillin (CIC), clometocillin (CLM), cloxacillin (CLO), dicloxacillin (DIC), doripenem (DOR), epicillin (EPC), ertapenem (ETP), flucloxacillin (FLC), hetacillin (HET), imipenem (IPM), imipenem/EDTA (IPE), imipenem/relebactam (IMR), latamoxef (LTM), lenampicillin (LEN), loracarbef (LOR), mecillinam (MEC), meropenem (MEM), meropenem/nacubactam (MNC), meropenem/vaborbactam (MEV), metampicillin (MTM), meticillin (MET), mezlocillin (MEZ), mezlocillin/sulbactam (MSU), nafcillin (NAF), oxacillin (OXA), oxacillin screening test (OXA-S), panipenem (PAN), penamecillin (PNM), penicillin/novobiocin (PNO), penicillin/sulbactam (PSU), pheneticillin (PHE), phenoxymethylpenicillin (PHN), piperacillin (PIP), piperacillin/sulbactam (PIS), piperacillin/tazobactam (TZP), piridicillin (PRC), pivampicillin (PVM), pivmecillinam (PME), procaine benzylpenicillin (PRB), propicillin (PRP), razupenem (RZM), ritipenem (RIT), ritipenem acoxil (RIA), sarmoxicillin (SRX), sulbenicillin (SBC), sultamicillin (SLT6), talampicillin (TAL), tebipenem (TBP), temocillin (TEM), ticarcillin (TIC), ticarcillin/clavulanic acid (TCC), and tigemonam (TMN)
 \item \code{\link[=betalactams_with_inhibitor]{betalactams_with_inhibitor()}} can select: \cr amoxicillin/clavulanic acid (AMC), amoxicillin/sulbactam (AXS), ampicillin/sulbactam (SAM), aztreonam/avibactam (AZA), aztreonam/nacubactam (ANC), cefepime/amikacin (CFA), cefepime/clavulanic acid (CPC), cefepime/enmetazobactam (FPE), cefepime/nacubactam (FNC), cefepime/tazobactam (FPT), cefepime/zidebactam (FPZ), cefoperazone/sulbactam (CSL), cefotaxime/clavulanic acid (CTC), cefotaxime/sulbactam (CTS), cefpodoxime/clavulanic acid (CDC), ceftaroline/avibactam (CPA), ceftazidime/avibactam (CZA), ceftazidime/clavulanic acid (CCV), ceftolozane/tazobactam (CZT), ceftriaxone/beta-lactamase inhibitor (CEB), imipenem/relebactam (IMR), meropenem/nacubactam (MNC), meropenem/vaborbactam (MEV), mezlocillin/sulbactam (MSU), penicillin/novobiocin (PNO), penicillin/sulbactam (PSU), piperacillin/sulbactam (PIS), piperacillin/tazobactam (TZP), and ticarcillin/clavulanic acid (TCC)
 \item \code{\link[=carbapenems]{carbapenems()}} can select: \cr biapenem (BIA), doripenem (DOR), ertapenem (ETP), imipenem (IPM), imipenem/EDTA (IPE), imipenem/relebactam (IMR), meropenem (MEM), meropenem/nacubactam (MNC), meropenem/vaborbactam (MEV), panipenem (PAN), razupenem (RZM), ritipenem (RIT), ritipenem acoxil (RIA), and tebipenem (TBP)

man/antimicrobials.Rd

@@ -5,9 +5,9 @@
 \alias{antimicrobials}
 \alias{antibiotics}
 \alias{antivirals}
-\title{Data Sets with 617 Antimicrobial Drugs}
+\title{Data Sets with 616 Antimicrobial Drugs}
 \format{
-\subsection{For the \link{antimicrobials} data set: a \link[tibble:tibble]{tibble} with 497 observations and 14 variables:}{
+\subsection{For the \link{antimicrobials} data set: a \link[tibble:tibble]{tibble} with 496 observations and 14 variables:}{
 \itemize{
 \item \code{ab}\cr antimicrobial ID as used in this package (such as \code{AMC}), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. \emph{\strong{This is a unique identifier.}}
 \item \code{cid}\cr Compound ID as found in PubChem. \emph{\strong{This is a unique identifier.}}
@@ -50,7 +50,7 @@ LOINC:
 }
 }
 
-An object of class \code{deprecated_amr_dataset} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 497 rows and 14 columns.
+An object of class \code{deprecated_amr_dataset} (inherits from \code{tbl_df}, \code{tbl}, \code{data.frame}) with 496 rows and 14 columns.
 
 An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 120 rows and 11 columns.
 }

man/as.sir.Rd

@@ -75,7 +75,9 @@ sir_interpretation_history(clean = FALSE)
 \arguments{
 \item{x}{Vector of values (for class \code{\link{mic}}: MIC values in mg/L, for class \code{\link{disk}}: a disk diffusion radius in millimetres).}
 
-\item{...}{For using on a \link{data.frame}: names of columns to apply \code{\link[=as.sir]{as.sir()}} on (supports tidy selection such as \code{column1:column4}). Otherwise: arguments passed on to methods.}
+\item{...}{For using on a \link{data.frame}: selection of columns to apply \code{as.sir()} to. Supports \link[tidyselect:starts_with]{tidyselect language} such as \code{where(is.mic)}, \code{starts_with(...)}, or \code{column1:column4}, and can thus also be \link[=amr_selector]{antimicrobial selectors} such as \code{as.sir(df, penicillins())}.
+
+Otherwise: arguments passed on to methods.}
 
 \item{threshold}{Maximum fraction of invalid antimicrobial interpretations of \code{x}, see \emph{Examples}.}
 
@@ -247,7 +249,7 @@ To determine which isolates are multi-drug resistant, be sure to run \code{\link
 
 The function \code{\link[=is.sir]{is.sir()}} detects if the input contains class \code{sir}. If the input is a \link{data.frame} or \link{list}, it iterates over all columns/items and returns a \link{logical} vector.
 
-The base R function \code{\link[=as.double]{as.double()}} can be used to retrieve quantitative values from a \code{sir} object: \code{"S"} = 1, \code{"I"}/\code{"SDD"} = 2, \code{"R"} = 3. All other values are rendered \code{NA} . \strong{Note:} Do not use \code{as.integer()}, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values.
+The base R function \code{\link[=as.double]{as.double()}} can be used to retrieve quantitative values from a \code{sir} object: \code{"S"} = 1, \code{"I"}/\code{"SDD"} = 2, \code{"R"} = 3. All other values are rendered \code{NA}. \strong{Note:} Do not use \code{as.integer()}, since that (because of how R works internally) will return the factor level indices, and not these aforementioned quantitative values.
 
 The function \code{\link[=is_sir_eligible]{is_sir_eligible()}} returns \code{TRUE} when a column contains at most 5\% potentially invalid antimicrobial interpretations, and \code{FALSE} otherwise. The threshold of 5\% can be set with the \code{threshold} argument. If the input is a \link{data.frame}, it iterates over all columns and returns a \link{logical} vector.
 }
@@ -314,9 +316,12 @@ if (require("dplyr")) {
   df_wide \%>\% mutate_if(is.mic, as.sir)
   df_wide \%>\% mutate_if(function(x) is.mic(x) | is.disk(x), as.sir)
   df_wide \%>\% mutate(across(where(is.mic), as.sir))
+
   df_wide \%>\% mutate_at(vars(amoxicillin:tobra), as.sir)
   df_wide \%>\% mutate(across(amoxicillin:tobra, as.sir))
 
+  df_wide \%>\% mutate(across(aminopenicillins(), as.sir))
+
   # approaches that all work with additional arguments:
   df_long \%>\%
     # given a certain data type, e.g. MIC values

man/custom_eucast_rules.Rd

@@ -103,7 +103,7 @@ These 35 antimicrobial groups are allowed in the rules (case-insensitive) and ca
 \item aminoglycosides\cr(amikacin, amikacin/fosfomycin, apramycin, arbekacin, astromicin, bekanamycin, dibekacin, framycetin, gentamicin, gentamicin-high, habekacin, hygromycin, isepamicin, kanamycin, kanamycin-high, kanamycin/cephalexin, micronomicin, neomycin, netilmicin, pentisomicin, plazomicin, propikacin, ribostamycin, sisomicin, streptoduocin, streptomycin, streptomycin-high, tobramycin, and tobramycin-high)
 \item aminopenicillins\cr(amoxicillin and ampicillin)
 \item antifungals\cr(amorolfine, amphotericin B, amphotericin B-high, anidulafungin, butoconazole, caspofungin, ciclopirox, clotrimazole, econazole, fluconazole, flucytosine, fosfluconazole, griseofulvin, hachimycin, ibrexafungerp, isavuconazole, isoconazole, itraconazole, ketoconazole, manogepix, micafungin, miconazole, nystatin, oteseconazole, pimaricin, posaconazole, rezafungin, ribociclib, sulconazole, terbinafine, terconazole, and voriconazole)
-\item antimycobacterials\cr(4-aminosalicylic acid, calcium aminosalicylate, capreomycin, clofazimine, delamanid, enviomycin, ethambutol, ethambutol/isoniazid, ethionamide, isoniazid, isoniazid/sulfamethoxazole/trimethoprim/pyridoxine, morinamide, p-aminosalicylic acid, pretomanid, protionamide, pyrazinamide, rifabutin, rifampicin, rifampicin/ethambutol/isoniazid, rifampicin/isoniazid, rifampicin/pyrazinamide/ethambutol/isoniazid, rifampicin/pyrazinamide/isoniazid, rifamycin, rifapentine, simvastatin/fenofibrate, sodium aminosalicylate, streptomycin/isoniazid, terizidone, thioacetazone, thioacetazone/isoniazid, tiocarlide, and viomycin)
+\item antimycobacterials\cr(4-aminosalicylic acid, calcium aminosalicylate, capreomycin, clofazimine, delamanid, enviomycin, ethambutol, ethambutol/isoniazid, ethionamide, isoniazid, isoniazid/sulfamethoxazole/trimethoprim/pyridoxine, morinamide, p-aminosalicylic acid, pretomanid, protionamide, pyrazinamide, rifabutin, rifampicin, rifampicin/ethambutol/isoniazid, rifampicin/isoniazid, rifampicin/pyrazinamide/ethambutol/isoniazid, rifampicin/pyrazinamide/isoniazid, rifamycin, rifapentine, sodium aminosalicylate, streptomycin/isoniazid, terizidone, thioacetazone, thioacetazone/isoniazid, tiocarlide, and viomycin)
 \item betalactams\cr(amoxicillin, amoxicillin/clavulanic acid, amoxicillin/sulbactam, ampicillin, ampicillin/sulbactam, apalcillin, aspoxicillin, azidocillin, azlocillin, aztreonam, aztreonam/avibactam, aztreonam/nacubactam, bacampicillin, benzathine benzylpenicillin, benzathine phenoxymethylpenicillin, benzylpenicillin, benzylpenicillin screening test, biapenem, carbenicillin, carindacillin, carumonam, cefacetrile, cefaclor, cefadroxil, cefalexin, cefaloridine, cefalotin, cefamandole, cefapirin, cefatrizine, cefazedone, cefazolin, cefcapene, cefcapene pivoxil, cefdinir, cefditoren, cefditoren pivoxil, cefepime, cefepime/amikacin, cefepime/clavulanic acid, cefepime/enmetazobactam, cefepime/nacubactam, cefepime/tazobactam, cefepime/zidebactam, cefetamet, cefetamet pivoxil, cefetecol, cefetrizole, cefiderocol, cefixime, cefmenoxime, cefmetazole, cefodizime, cefonicid, cefoperazone, cefoperazone/sulbactam, ceforanide, cefoselis, cefotaxime, cefotaxime screening test, cefotaxime/clavulanic acid, cefotaxime/sulbactam, cefotetan, cefotiam, cefotiam hexetil, cefovecin, cefoxitin, cefoxitin screening test, cefozopran, cefpimizole, cefpiramide, cefpirome, cefpodoxime, cefpodoxime proxetil, cefpodoxime/clavulanic acid, cefprozil, cefquinome, cefroxadine, cefsulodin, cefsumide, ceftaroline, ceftaroline/avibactam, ceftazidime, ceftazidime/avibactam, ceftazidime/clavulanic acid, cefteram, cefteram pivoxil, ceftezole, ceftibuten, ceftiofur, ceftizoxime, ceftizoxime alapivoxil, ceftobiprole, ceftobiprole medocaril, ceftolozane/tazobactam, ceftriaxone, ceftriaxone/beta-lactamase inhibitor, cefuroxime, cefuroxime axetil, cephradine, ciclacillin, clometocillin, cloxacillin, dicloxacillin, doripenem, epicillin, ertapenem, flucloxacillin, hetacillin, imipenem, imipenem/EDTA, imipenem/relebactam, latamoxef, lenampicillin, loracarbef, mecillinam, meropenem, meropenem/nacubactam, meropenem/vaborbactam, metampicillin, meticillin, mezlocillin, mezlocillin/sulbactam, nafcillin, oxacillin, oxacillin screening test, panipenem, penamecillin, penicillin/novobiocin, penicillin/sulbactam, pheneticillin, phenoxymethylpenicillin, piperacillin, piperacillin/sulbactam, piperacillin/tazobactam, piridicillin, pivampicillin, pivmecillinam, procaine benzylpenicillin, propicillin, razupenem, ritipenem, ritipenem acoxil, sarmoxicillin, sulbenicillin, sultamicillin, talampicillin, tebipenem, temocillin, ticarcillin, ticarcillin/clavulanic acid, and tigemonam)
 \item betalactams_with_inhibitor\cr(amoxicillin/clavulanic acid, amoxicillin/sulbactam, ampicillin/sulbactam, aztreonam/avibactam, aztreonam/nacubactam, cefepime/amikacin, cefepime/clavulanic acid, cefepime/enmetazobactam, cefepime/nacubactam, cefepime/tazobactam, cefepime/zidebactam, cefoperazone/sulbactam, cefotaxime/clavulanic acid, cefotaxime/sulbactam, cefpodoxime/clavulanic acid, ceftaroline/avibactam, ceftazidime/avibactam, ceftazidime/clavulanic acid, ceftolozane/tazobactam, ceftriaxone/beta-lactamase inhibitor, imipenem/relebactam, meropenem/nacubactam, meropenem/vaborbactam, mezlocillin/sulbactam, penicillin/novobiocin, penicillin/sulbactam, piperacillin/sulbactam, piperacillin/tazobactam, and ticarcillin/clavulanic acid)
 \item carbapenems\cr(biapenem, doripenem, ertapenem, imipenem, imipenem/EDTA, imipenem/relebactam, meropenem, meropenem/nacubactam, meropenem/vaborbactam, panipenem, razupenem, ritipenem, ritipenem acoxil, and tebipenem)

man/custom_mdro_guideline.Rd

@@ -99,7 +99,7 @@ All 35 antimicrobial selectors are supported for use in the rules:
 \item \code{\link[=aminoglycosides]{aminoglycosides()}} can select: \cr amikacin, amikacin/fosfomycin, apramycin, arbekacin, astromicin, bekanamycin, dibekacin, framycetin, gentamicin, gentamicin-high, habekacin, hygromycin, isepamicin, kanamycin, kanamycin-high, kanamycin/cephalexin, micronomicin, neomycin, netilmicin, pentisomicin, plazomicin, propikacin, ribostamycin, sisomicin, streptoduocin, streptomycin, streptomycin-high, tobramycin, and tobramycin-high
 \item \code{\link[=aminopenicillins]{aminopenicillins()}} can select: \cr amoxicillin and ampicillin
 \item \code{\link[=antifungals]{antifungals()}} can select: \cr amorolfine, amphotericin B, amphotericin B-high, anidulafungin, butoconazole, caspofungin, ciclopirox, clotrimazole, econazole, fluconazole, flucytosine, fosfluconazole, griseofulvin, hachimycin, ibrexafungerp, isavuconazole, isoconazole, itraconazole, ketoconazole, manogepix, micafungin, miconazole, nystatin, oteseconazole, pimaricin, posaconazole, rezafungin, ribociclib, sulconazole, terbinafine, terconazole, and voriconazole
-\item \code{\link[=antimycobacterials]{antimycobacterials()}} can select: \cr 4-aminosalicylic acid, calcium aminosalicylate, capreomycin, clofazimine, delamanid, enviomycin, ethambutol, ethambutol/isoniazid, ethionamide, isoniazid, isoniazid/sulfamethoxazole/trimethoprim/pyridoxine, morinamide, p-aminosalicylic acid, pretomanid, protionamide, pyrazinamide, rifabutin, rifampicin, rifampicin/ethambutol/isoniazid, rifampicin/isoniazid, rifampicin/pyrazinamide/ethambutol/isoniazid, rifampicin/pyrazinamide/isoniazid, rifamycin, rifapentine, simvastatin/fenofibrate, sodium aminosalicylate, streptomycin/isoniazid, terizidone, thioacetazone, thioacetazone/isoniazid, tiocarlide, and viomycin
+\item \code{\link[=antimycobacterials]{antimycobacterials()}} can select: \cr 4-aminosalicylic acid, calcium aminosalicylate, capreomycin, clofazimine, delamanid, enviomycin, ethambutol, ethambutol/isoniazid, ethionamide, isoniazid, isoniazid/sulfamethoxazole/trimethoprim/pyridoxine, morinamide, p-aminosalicylic acid, pretomanid, protionamide, pyrazinamide, rifabutin, rifampicin, rifampicin/ethambutol/isoniazid, rifampicin/isoniazid, rifampicin/pyrazinamide/ethambutol/isoniazid, rifampicin/pyrazinamide/isoniazid, rifamycin, rifapentine, sodium aminosalicylate, streptomycin/isoniazid, terizidone, thioacetazone, thioacetazone/isoniazid, tiocarlide, and viomycin
 \item \code{\link[=betalactams]{betalactams()}} can select: \cr amoxicillin, amoxicillin/clavulanic acid, amoxicillin/sulbactam, ampicillin, ampicillin/sulbactam, apalcillin, aspoxicillin, azidocillin, azlocillin, aztreonam, aztreonam/avibactam, aztreonam/nacubactam, bacampicillin, benzathine benzylpenicillin, benzathine phenoxymethylpenicillin, benzylpenicillin, benzylpenicillin screening test, biapenem, carbenicillin, carindacillin, carumonam, cefacetrile, cefaclor, cefadroxil, cefalexin, cefaloridine, cefalotin, cefamandole, cefapirin, cefatrizine, cefazedone, cefazolin, cefcapene, cefcapene pivoxil, cefdinir, cefditoren, cefditoren pivoxil, cefepime, cefepime/amikacin, cefepime/clavulanic acid, cefepime/enmetazobactam, cefepime/nacubactam, cefepime/tazobactam, cefepime/zidebactam, cefetamet, cefetamet pivoxil, cefetecol, cefetrizole, cefiderocol, cefixime, cefmenoxime, cefmetazole, cefodizime, cefonicid, cefoperazone, cefoperazone/sulbactam, ceforanide, cefoselis, cefotaxime, cefotaxime screening test, cefotaxime/clavulanic acid, cefotaxime/sulbactam, cefotetan, cefotiam, cefotiam hexetil, cefovecin, cefoxitin, cefoxitin screening test, cefozopran, cefpimizole, cefpiramide, cefpirome, cefpodoxime, cefpodoxime proxetil, cefpodoxime/clavulanic acid, cefprozil, cefquinome, cefroxadine, cefsulodin, cefsumide, ceftaroline, ceftaroline/avibactam, ceftazidime, ceftazidime/avibactam, ceftazidime/clavulanic acid, cefteram, cefteram pivoxil, ceftezole, ceftibuten, ceftiofur, ceftizoxime, ceftizoxime alapivoxil, ceftobiprole, ceftobiprole medocaril, ceftolozane/tazobactam, ceftriaxone, ceftriaxone/beta-lactamase inhibitor, cefuroxime, cefuroxime axetil, cephradine, ciclacillin, clometocillin, cloxacillin, dicloxacillin, doripenem, epicillin, ertapenem, flucloxacillin, hetacillin, imipenem, imipenem/EDTA, imipenem/relebactam, latamoxef, lenampicillin, loracarbef, mecillinam, meropenem, meropenem/nacubactam, meropenem/vaborbactam, metampicillin, meticillin, mezlocillin, mezlocillin/sulbactam, nafcillin, oxacillin, oxacillin screening test, panipenem, penamecillin, penicillin/novobiocin, penicillin/sulbactam, pheneticillin, phenoxymethylpenicillin, piperacillin, piperacillin/sulbactam, piperacillin/tazobactam, piridicillin, pivampicillin, pivmecillinam, procaine benzylpenicillin, propicillin, razupenem, ritipenem, ritipenem acoxil, sarmoxicillin, sulbenicillin, sultamicillin, talampicillin, tebipenem, temocillin, ticarcillin, ticarcillin/clavulanic acid, and tigemonam
 \item \code{\link[=betalactams_with_inhibitor]{betalactams_with_inhibitor()}} can select: \cr amoxicillin/clavulanic acid, amoxicillin/sulbactam, ampicillin/sulbactam, aztreonam/avibactam, aztreonam/nacubactam, cefepime/amikacin, cefepime/clavulanic acid, cefepime/enmetazobactam, cefepime/nacubactam, cefepime/tazobactam, cefepime/zidebactam, cefoperazone/sulbactam, cefotaxime/clavulanic acid, cefotaxime/sulbactam, cefpodoxime/clavulanic acid, ceftaroline/avibactam, ceftazidime/avibactam, ceftazidime/clavulanic acid, ceftolozane/tazobactam, ceftriaxone/beta-lactamase inhibitor, imipenem/relebactam, meropenem/nacubactam, meropenem/vaborbactam, mezlocillin/sulbactam, penicillin/novobiocin, penicillin/sulbactam, piperacillin/sulbactam, piperacillin/tazobactam, and ticarcillin/clavulanic acid
 \item \code{\link[=carbapenems]{carbapenems()}} can select: \cr biapenem, doripenem, ertapenem, imipenem, imipenem/EDTA, imipenem/relebactam, meropenem, meropenem/nacubactam, meropenem/vaborbactam, panipenem, razupenem, ritipenem, ritipenem acoxil, and tebipenem

man/first_isolate.Rd

@@ -108,26 +108,30 @@ All mentioned methods are covered in the \code{\link[=first_isolate]{first_isola
    - Any difference in key antimicrobial results \tab - \code{first_isolate(x, type = "keyantimicrobials")} \cr
 }
 
-}
 
-\subsection{Isolate-based}{
+\strong{Isolate-based}
+
+\emph{Minimum variables required: Microorganism identifier}
 
 This method does not require any selection, as all isolates should be included. It does, however, respect all arguments set in the \code{\link[=first_isolate]{first_isolate()}} function. For example, the default setting for \code{include_unknown} (\code{FALSE}) will omit selection of rows without a microbial ID.
-}
 
-\subsection{Patient-based}{
+\strong{Patient-based}
 
-To include every genus-species combination per patient once, set the \code{episode_days} to \code{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 \emph{excluded} that were found years after the initial isolate.
-}
+\emph{Minimum variables required: Microorganism identifier, Patient identifier}
 
-\subsection{Episode-based}{
+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 \emph{excluded} that were found years after the initial isolate.
 
-To include every genus-species combination per patient episode once, set the \code{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.
+\strong{Episode-based}
+
+\emph{Minimum variables required: Microorganism identifier, Patient identifier, Date}
+
+To include every genus-species combination per patient episode once, set the \code{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.
 
 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 \emph{Staphylococcus aureus} (MRSA) isolate cannot be differentiated from a wildtype \emph{Staphylococcus aureus} isolate.
-}
 
-\subsection{Phenotype-based}{
+\strong{Phenotype-based}
+
+\emph{Minimum variables required: Microorganism identifier, Patient identifier, Date, Antimicrobial test results}
 
 This is a more reliable method, since it also \emph{weighs} the antibiogram (antimicrobial test results) yielding so-called 'first weighted isolates'. There are two different methods to weigh the antibiogram:
 \enumerate{

man/ggplot_sir.Rd

@@ -9,10 +9,10 @@ ggplot_sir(data, position = NULL, x = "antibiotic",
   fill = "interpretation", facet = NULL, breaks = seq(0, 1, 0.1),
   limits = NULL, translate_ab = "name", combine_SI = TRUE,
   minimum = 30, language = get_AMR_locale(), nrow = NULL, colours = c(S
-  = "#3CAEA3", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B", R = "#ED553B"),
-  datalabels = TRUE, datalabels.size = 2.5, datalabels.colour = "grey15",
-  title = NULL, subtitle = NULL, caption = NULL,
-  x.title = "Antimicrobial", y.title = "Proportion", ...)
+  = "#3CAEA3", SDD = "#8FD6C4", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B",
+  R = "#ED553B"), datalabels = TRUE, datalabels.size = 2.5,
+  datalabels.colour = "grey15", title = NULL, subtitle = NULL,
+  caption = NULL, x.title = "Antimicrobial", y.title = "Proportion", ...)
 
 geom_sir(position = NULL, x = c("antibiotic", "interpretation"),
   fill = "interpretation", translate_ab = "name", minimum = 30,

man/mdro.Rd

@@ -57,7 +57,7 @@ eucast_exceptional_phenotypes(x = NULL, only_sir_columns = any(is.sir(x)),
 
 \item{combine_SI}{A \link{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 \code{\link[=mdro]{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 \code{combine_SI = FALSE}, resistance is considered when isolates are R or I.}
 
-\item{verbose}{A \link{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.}
+\item{verbose}{A \link{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.}
 
 \item{only_sir_columns}{A \link{logical} to indicate whether only antimicrobial columns must be included that were transformed to class \link[=as.sir]{sir} on beforehand. Defaults to \code{FALSE} if no columns of \code{x} have a class \link[=as.sir]{sir}.}
 

man/mean_amr_distance.Rd

@@ -18,7 +18,7 @@ amr_distance_from_row(amr_distance, row)
 \arguments{
 \item{x}{A vector of class \link[=as.sir]{sir}, \link[=as.mic]{mic} or \link[=as.disk]{disk}, or a \link{data.frame} containing columns of any of these classes.}
 
-\item{...}{Variables to select. Supports \link[tidyselect:language]{tidyselect language} (such as \code{column1:column4} and \code{where(is.mic)}), and can thus also be \link[=amr_selector]{antimicrobial selectors}.}
+\item{...}{Variables to select. Supports \link[tidyselect:starts_with]{tidyselect language} such as \code{where(is.mic)}, \code{starts_with(...)}, or \code{column1:column4}, and can thus also be \link[=amr_selector]{antimicrobial selectors}.}
 
 \item{combine_SI}{A \link{logical} to indicate whether all values of S, SDD, and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant) - the default is \code{TRUE}.}
 

man/microorganisms.Rd

@@ -18,7 +18,7 @@ A \link[tibble:tibble]{tibble} with 78 679 observations and 26 variables:
 \item \code{lpsn}\cr Identifier ('Record number') of List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, \emph{Acetobacter ascendens} has LPSN Record number 7864 and 11011. Only the first is available in the \code{microorganisms} data set. \emph{\strong{This is a unique identifier}}, though available for only ~33 000 records.
 \item \code{lpsn_parent}\cr LPSN identifier of the parent taxon
 \item \code{lpsn_renamed_to}\cr LPSN identifier of the currently valid taxon
-\item \code{mycobank}\cr Identifier ('MycoBank #') of MycoBank. \emph{\strong{This is a unique identifier}}, though available for only ~18 000 records.
+\item \code{mycobank}\cr Identifier ('MycoBank #') of MycoBank. \emph{\strong{This is a unique identifier}}, though available for only ~19 000 records.
 \item \code{mycobank_parent}\cr MycoBank identifier of the parent taxon
 \item \code{mycobank_renamed_to}\cr MycoBank identifier of the currently valid taxon
 \item \code{gbif}\cr Identifier ('taxonID') of Global Biodiversity Information Facility (GBIF). \emph{\strong{This is a unique identifier}}, though available for only ~49 000 records.
@@ -70,7 +70,7 @@ Included taxonomic data from \href{https://lpsn.dsmz.de}{LPSN}, \href{https://ww
 \item ~28 000 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 \emph{Aspergillus}, \emph{Candida}, \emph{Cryptococcus}, \emph{Histoplasma}, \emph{Pneumocystis}, \emph{Saccharomyces} and \emph{Trichophyton}).
 \item ~8 100 (sub)species from the kingdom of Protozoa
 \item ~1 600 (sub)species from 39 other relevant genera from the kingdom of Animalia (such as \emph{Strongyloides} and \emph{Taenia})
-\item All ~22 000 previously accepted names of all included (sub)species (these were taxonomically renamed)
+\item All ~26 000 previously accepted names of all included (sub)species (these were taxonomically renamed)
 \item The complete taxonomic tree of all included (sub)species: from kingdom to subspecies
 \item The identifier of the parent taxons
 \item The year and first author of the related scientific publication

man/plot.Rd

@@ -33,25 +33,25 @@ scale_colour_mic(keep_operators = "edges", mic_range = NULL, ...)
 
 scale_fill_mic(keep_operators = "edges", mic_range = NULL, ...)
 
-scale_x_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
-  "EUCAST") == "EUCAST", ...)
+scale_x_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
+  = "#ED553B"), language = get_AMR_locale(),
+  eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
 
-scale_colour_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
-  "EUCAST") == "EUCAST", ...)
+scale_colour_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I =
+  "#F6D55C", R = "#ED553B"), language = get_AMR_locale(),
+  eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
 
-scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
-  "EUCAST") == "EUCAST", ...)
+scale_fill_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C",
+  R = "#ED553B"), language = get_AMR_locale(),
+  eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
 
 \method{plot}{mic}(x, mo = NULL, ab = NULL,
   guideline = getOption("AMR_guideline", "EUCAST"),
   main = deparse(substitute(x)), ylab = translate_AMR("Frequency", language
   = language),
   xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language =
-  language), colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), expand = TRUE,
+  language), colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
+  = "#ED553B"), language = get_AMR_locale(), expand = TRUE,
   include_PKPD = getOption("AMR_include_PKPD", TRUE),
   breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
 
@@ -60,8 +60,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   title = deparse(substitute(object)), ylab = translate_AMR("Frequency",
   language = language),
   xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language =
-  language), colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), expand = TRUE,
+  language), colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
+  = "#ED553B"), language = get_AMR_locale(), expand = TRUE,
   include_PKPD = getOption("AMR_include_PKPD", TRUE),
   breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
 
@@ -69,8 +69,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   ylab = translate_AMR("Frequency", language = language),
   xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
   mo = NULL, ab = NULL, guideline = getOption("AMR_guideline", "EUCAST"),
-  colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), expand = TRUE,
+  colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R =
+  "#ED553B"), language = get_AMR_locale(), expand = TRUE,
   include_PKPD = getOption("AMR_include_PKPD", TRUE),
   breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
 
@@ -78,8 +78,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   title = deparse(substitute(object)), ylab = translate_AMR("Frequency",
   language = language), xlab = translate_AMR("Disk diffusion diameter (mm)",
   language = language), guideline = getOption("AMR_guideline", "EUCAST"),
-  colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
-  language = get_AMR_locale(), expand = TRUE,
+  colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R =
+  "#ED553B"), language = get_AMR_locale(), expand = TRUE,
   include_PKPD = getOption("AMR_include_PKPD", TRUE),
   breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
 
@@ -90,8 +90,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
 
 \method{autoplot}{sir}(object, title = deparse(substitute(object)),
   xlab = translate_AMR("Antimicrobial Interpretation", language = language),
-  ylab = translate_AMR("Frequency", language = language),
-  colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
+  ylab = translate_AMR("Frequency", language = language), colours_SIR = c(S
+  = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R = "#ED553B"),
   language = get_AMR_locale(), ...)
 
 facet_sir(facet = c("interpretation", "antibiotic"), nrow = NULL)
@@ -99,8 +99,8 @@ facet_sir(facet = c("interpretation", "antibiotic"), nrow = NULL)
 scale_y_percent(breaks = function(x) seq(0, max(x, na.rm = TRUE), 0.1),
   limits = c(0, NA))
 
-scale_sir_colours(..., aesthetics, colours_SIR = c("#3CAEA3", "#F6D55C",
-  "#ED553B"))
+scale_sir_colours(..., aesthetics, colours_SIR = c(S = "#3CAEA3", SDD =
+  "#8FD6C4", I = "#F6D55C", R = "#ED553B"))
 
 theme_sir()
 
@@ -172,12 +172,20 @@ Especially the \verb{scale_*_mic()} functions are relevant wrappers to plot MIC
 \details{
 \subsection{The \verb{scale_*_mic()} Functions}{
 
-The functions \code{\link[=scale_x_mic]{scale_x_mic()}}, \code{\link[=scale_y_mic]{scale_y_mic()}}, \code{\link[=scale_colour_mic]{scale_colour_mic()}}, and \code{\link[=scale_fill_mic]{scale_fill_mic()}} functions allow to plot the \link[=as.mic]{mic} class (MIC values) on a continuous, logarithmic scale. They also allow to rescale the MIC range with an 'inside' or 'outside' range if required, and retain the operators in MIC values (such as \code{>=}) if desired. Missing intermediate log2 levels will be plotted too.
+The functions \code{\link[=scale_x_mic]{scale_x_mic()}}, \code{\link[=scale_y_mic]{scale_y_mic()}}, \code{\link[=scale_colour_mic]{scale_colour_mic()}}, and \code{\link[=scale_fill_mic]{scale_fill_mic()}} functions allow to plot the \link[=as.mic]{mic} class (MIC values) on a continuous, logarithmic scale.
+
+There is normally no need to add these scale functions to your plot, as they are applied automatically when plotting values of class \link[=as.mic]{mic}.
+
+When manually added though, they allow to rescale the MIC range with an 'inside' or 'outside' range if required, and provide the option to retain the operators in MIC values (such as \code{>=}). Missing intermediate log2 levels will always be plotted too.
 }
 
 \subsection{The \verb{scale_*_sir()} Functions}{
 
-The functions \code{\link[=scale_x_sir]{scale_x_sir()}}, \code{\link[=scale_colour_sir]{scale_colour_sir()}}, and \code{\link[=scale_fill_sir]{scale_fill_sir()}} functions allow to plot the \link[=as.sir]{sir} class in the right order (S < SDD < I < R < NI). At default, they translate the S/I/R values to an interpretative text ("Susceptible", "Resistant", etc.) in any of the 28 supported languages (use \code{language = NULL} to keep S/I/R). Also, except for \code{\link[=scale_x_sir]{scale_x_sir()}}, they set colour-blind friendly colours to the \code{colour} and \code{fill} aesthetics.
+The functions \code{\link[=scale_x_sir]{scale_x_sir()}}, \code{\link[=scale_colour_sir]{scale_colour_sir()}}, and \code{\link[=scale_fill_sir]{scale_fill_sir()}} functions allow to plot the \link[=as.sir]{sir} class in the right order (S < SDD < I < R < NI).
+
+There is normally no need to add these scale functions to your plot, as they are applied automatically when plotting values of class \link[=as.sir]{sir}.
+
+At default, they translate the S/I/R values to an interpretative text ("Susceptible", "Resistant", etc.) in any of the 28 supported languages (use \code{language = NULL} to keep S/I/R). Also, except for \code{\link[=scale_x_sir]{scale_x_sir()}}, they set colour-blind friendly colours to the \code{colour} and \code{fill} aesthetics.
 }
 
 \subsection{Additional \code{ggplot2} Functions}{
@@ -210,6 +218,10 @@ if (require("ggplot2")) {
   # when providing the microorganism and antibiotic, colours will show interpretations:
   autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro")
 }
+if (require("ggplot2")) {
+  autoplot(some_mic_values, mo = "Staph aureus", ab = "Ceftaroline", guideline = "CLSI")
+}
+
 if (require("ggplot2")) {
   # support for 27 languages, various guidelines, and many options
   autoplot(some_disk_values,
@@ -231,17 +243,12 @@ if (require("ggplot2")) {
   ) +
     geom_col()
   mic_plot +
-    labs(title = "without scale_x_mic()")
+    labs(title = "scale_x_mic() automatically applied")
 }
 if (require("ggplot2")) {
   mic_plot +
-    scale_x_mic() +
-    labs(title = "with scale_x_mic()")
-}
-if (require("ggplot2")) {
-  mic_plot +
-    scale_x_mic(keep_operators = "all") +
-    labs(title = "with scale_x_mic() keeping all operators")
+    scale_x_mic(keep_operators = "none") +
+    labs(title = "with scale_x_mic() keeping no operators")
 }
 if (require("ggplot2")) {
   mic_plot +
@@ -267,8 +274,8 @@ if (require("ggplot2")) {
     aes(group, mic)
   ) +
     geom_boxplot() +
-    geom_violin(linetype = 2, colour = "grey", fill = NA) +
-    scale_y_mic()
+    geom_violin(linetype = 2, colour = "grey30", fill = NA) +
+    labs(title = "scale_y_mic() automatically applied")
 }
 if (require("ggplot2")) {
   ggplot(
@@ -279,7 +286,7 @@ if (require("ggplot2")) {
     aes(group, mic)
   ) +
     geom_boxplot() +
-    geom_violin(linetype = 2, colour = "grey", fill = NA) +
+    geom_violin(linetype = 2, colour = "grey30", fill = NA) +
     scale_y_mic(mic_range = c(NA, 0.25))
 }
 
@@ -300,7 +307,7 @@ if (require("ggplot2")) {
 
 # Plotting using scale_y_mic() and scale_colour_sir() ------------------
 if (require("ggplot2")) {
-  plain <- ggplot(
+  mic_sir_plot <- ggplot(
     data.frame(
       mic = some_mic_values,
       group = some_groups,
@@ -312,23 +319,18 @@ if (require("ggplot2")) {
     aes(x = group, y = mic, colour = sir)
   ) +
     theme_minimal() +
-    geom_boxplot(fill = NA, colour = "grey") +
+    geom_boxplot(fill = NA, colour = "grey30") +
     geom_jitter(width = 0.25)
-
-  plain
+    labs(title = "scale_y_mic()/scale_colour_sir() automatically applied")
+    
+  mic_sir_plot
 }
 if (require("ggplot2")) {
-  # and now with our MIC and SIR scale functions:
-  plain +
-    scale_y_mic() +
-    scale_colour_sir()
-}
-if (require("ggplot2")) {
-  plain +
+  mic_sir_plot +
     scale_y_mic(mic_range = c(0.005, 32), name = "Our MICs!") +
     scale_colour_sir(
-      language = "pt",
-      name = "Support in 27 languages"
+      language = "pt", # Portuguese
+      name = "Support in 28 languages"
     )
 }
 }

man/random.Rd

@@ -7,19 +7,25 @@
 \alias{random_sir}
 \title{Random MIC Values/Disk Zones/SIR Generation}
 \usage{
-random_mic(size = NULL, mo = NULL, ab = NULL, ...)
+random_mic(size = NULL, mo = NULL, ab = NULL, skew = "right",
+  severity = 1, ...)
 
-random_disk(size = NULL, mo = NULL, ab = NULL, ...)
+random_disk(size = NULL, mo = NULL, ab = NULL, skew = "left",
+  severity = 1, ...)
 
 random_sir(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...)
 }
 \arguments{
 \item{size}{Desired size of the returned vector. If used in a \link{data.frame} call or \code{dplyr} verb, will get the current (group) size if left blank.}
 
-\item{mo}{Any \link{character} that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}.}
+\item{mo}{Any \link{character} that can be coerced to a valid microorganism code with \code{\link[=as.mo]{as.mo()}}. Can be the same length as \code{size}.}
 
 \item{ab}{Any \link{character} that can be coerced to a valid antimicrobial drug code with \code{\link[=as.ab]{as.ab()}}.}
 
+\item{skew}{Direction of skew for MIC or disk values, either \code{"right"} or \code{"left"}. A left-skewed distribution has the majority of the data on the right.}
+
+\item{severity}{Skew severity; higher values will increase the skewedness. Default is \code{2}; use \code{0} to prevent skewedness.}
+
 \item{...}{Ignored, only in place to allow future extensions.}
 
 \item{prob_SIR}{A vector of length 3: the probabilities for "S" (1st value), "I" (2nd value) and "R" (3rd value).}
@@ -31,17 +37,25 @@ class \code{mic} for \code{\link[=random_mic]{random_mic()}} (see \code{\link[=a
 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.
 }
 \details{
-The base \R function \code{\link[=sample]{sample()}} is used for generating values.
-
-Generated values are based on the EUCAST 2025 guideline as implemented in the \link{clinical_breakpoints} data set. To create specific generated values per bug or drug, set the \code{mo} and/or \code{ab} argument.
+Internally, MIC and disk zone values are sampled based on clinical breakpoints defined in the \link{clinical_breakpoints} data set. To create specific generated values per bug or drug, set the \code{mo} and/or \code{ab} argument. The MICs are sampled on a log2 scale and disks linearly, using weighted probabilities. The weights are based on the \code{skew} and \code{severity} arguments:
+\itemize{
+\item \code{skew = "right"} places more emphasis on lower MIC or higher disk values.
+\item \code{skew = "left"} places more emphasis on higher MIC or lower disk values.
+\item \code{severity} controls the exponential bias applied.
+}
 }
 \examples{
 random_mic(25)
 random_disk(25)
 random_sir(25)
 
+# add more skewedness, make more realistic by setting a bug and/or drug:
+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 2025")
+
 \donttest{
-# make the random generation more realistic by setting a bug and/or drug:
 random_mic(25, "Klebsiella pneumoniae") # range 0.0625-64
 random_mic(25, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
 random_mic(25, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4

pkgdown/extra.css

@@ -41,7 +41,7 @@
 
   --bs-success: var(--amr-green-dark) !important;
   --bs-light: var(--amr-green-light) !important;
-  /* --bs-light was this: #128f76a6; that's success with 60% alpha */
+  /* --bs-light was this: #128f76a6; that's bs-success with 60% alpha */
   --bs-info: var(--amr-green-middle) !important;
   --bs-link-color: var(--amr-green-dark) !important;
   --bs-link-color-rgb: var(--amr-green-dark-rgb) !important;
@@ -104,6 +104,16 @@ body.amr-for-python * {
 .navbar .algolia-autocomplete .aa-dropdown-menu {
   background-color: var(--amr-green-dark) !important;
 }
+
+.version-main {
+  font-weight: bold;
+  color: var(--bs-navbar-brand-color);
+}
+.version-build {
+  font-weight: normal;
+  opacity: 0.75;
+  font-size: 0.85em;
+}
 input[type="search"] {
   color: var(--bs-tertiary-bg) !important;
   background-color: var(--amr-green-light) !important;
@@ -149,6 +159,7 @@ this shows on top of every sidebar to the right
   margin-top: 10px;
   border: 2px dashed var(--amr-green-dark);
   text-align: center;
+  background: var(--bs-body-bg);
 }
 .amr-gpt-assistant * {
   width: 90%;
@@ -179,6 +190,15 @@ this shows on top of every sidebar to the right
   }
 }
 
+.template-reference-topic h3,
+.template-reference-topic h3 code {
+  color: var(--amr-green-dark) !important;
+}
+.template-reference-topic h3 {
+  font-weight: normal;
+  margin-top: 2rem;
+}
+
 /* replace 'Developers' with 'Maintainers' */
 .developers h2 {
   display: none;

pkgdown/extra.js

@@ -29,10 +29,22 @@
 # ==================================================================== #
 */
 
-$(document).ready(function() {
+$(function () {
   // add GPT assistant info
   $('aside').prepend('<div class="amr-gpt-assistant"><a target="_blank" href="https://chat.amr-for-r.org"><img src="https://amr-for-r.org/AMRforRGPT.svg"></a></div>');
 
+  // split version number in navbar into main version and build number
+  $('.nav-text').each(function () {
+    const $el = $(this);
+    const text = $.trim($el.text());
+    const lastDotIndex = text.lastIndexOf('.');
+    if (lastDotIndex > -1) {
+      const main = text.substring(0, lastDotIndex);
+      const build = text.substring(lastDotIndex);
+      $el.html(`<span class="version-main">${main}</span><span class="version-build">${build}</span>`);
+    }
+  });
+
   // replace 'Developers' with 'Maintainers' on the main page, and "Contributors" on the Authors page
   $(".developers h2").text("Maintainers");
   $(".template-citation-authors h1:nth(0)").text("Contributors and Citation");

tests/testthat/test-_misc.R

@@ -70,14 +70,14 @@ test_that("test-misc.R", {
   }
 
   df <- example_isolates[, check_df("x")]
-  expect_true(is_right, info = "the environmental data cannot be found for base/x (1)")
+  expect_true(is_right, info = "the environmental data cannot be found for base `x`")
 
-  if (getRversion() < "4.0.0") {
+  # should work on R >=3.6.3 or so
+  df <- example_isolates[c(1:3), check_df("x")]
+  if (!is_right) {
+    # otherwise, this is needed for older versions
     df <- example_isolates[c(1:3), check_df("xx")]
-    expect_true(is_right, info = "the environmental data cannot be found for base/xx")
-  } else {
-    df <- example_isolates[c(1:3), check_df("x")]
-    expect_true(is_right, info = "the environmental data cannot be found for base/x (2)")
+    expect_true(is_right, info = "the environmental data cannot be found for base `x` or `xx`")
   }
 
   if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {

tests/testthat/test-ab.R

@@ -96,6 +96,14 @@ test_that("test-ab.R", {
     rep("GEH", 8)
   )
 
+  # skimr
+  if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
+    expect_named(
+      skim(clinical_breakpoints$ab),
+      c("skim_type", "skim_variable", "n_missing", "complete_rate", "ab.n_unique", "ab.top_ab", "ab.top_ab_name", "ab.top_group")
+    )
+  }
+
   # assigning and subsetting
   x <- AMR::antimicrobials$ab
   expect_inherits(x[1], "ab")

tests/testthat/test-disk.R

@@ -60,4 +60,12 @@ test_that("test-disk.R", {
   if (AMR:::pkg_is_available("tibble")) {
     expect_output(print(tibble::tibble(d = as.disk(12))))
   }
+
+  # skimr
+  if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
+    expect_named(
+      skim(random_disk(100)),
+      c("skim_type", "skim_variable", "n_missing", "complete_rate", "disk.p0", "disk.p25", "disk.p50", "disk.p75", "disk.p100", "disk.hist")
+    )
+  }
 })

tests/testthat/test-mic.R

@@ -81,6 +81,14 @@ test_that("test-mic.R", {
     expect_output(print(tibble::tibble(m = as.mic(2:4))))
   }
 
+  # skimr
+  if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
+    expect_named(
+      skim(random_mic(100)),
+      c("skim_type", "skim_variable", "n_missing", "complete_rate", "mic.p0", "mic.p25", "mic.p50", "mic.p75", "mic.p100", "mic.hist")
+    )
+  }
+
   # all mathematical operations
   x <- random_mic(50)
   x_double <- as.double(gsub("[<=>]+", "", as.character(x)))

tests/testthat/test-mo.R

@@ -321,4 +321,12 @@ test_that("test-mo.R", {
   if (AMR:::pkg_is_available("cleaner")) {
     expect_inherits(cleaner::freq(example_isolates$mo), "freq")
   }
+
+  # skimr
+  if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
+    expect_named(
+      skim(example_isolates$mo),
+      c("skim_type", "skim_variable", "n_missing", "complete_rate", "mo.n_unique", "mo.gram_negative", "mo.gram_positive", "mo.yeast", "mo.top_genus", "mo.top_species")
+    )
+  }
 })