update sir to include interpretation details

.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/commit-msg

@@ -60,6 +60,7 @@ else
 fi
 
 git add data-raw/*
+git add data/*
 git add -u
 
 exit 0

.github/prehooks/pre-commit

@@ -51,6 +51,7 @@ if command -v Rscript > /dev/null; then
     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/*
     git add man/*
     git add R/sysdata.rda
     git add NAMESPACE
@@ -67,51 +68,59 @@ 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 "- ${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=""
+    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!"
+  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/*
 git add -u
 
 exit 0

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

@@ -59,8 +59,15 @@ jobs:
 
     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

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

@@ -60,7 +60,8 @@ jobs:
           cd data-raw/
           bash _generate_python_wrapper.sh
       
-      - name: Publish to PyPI
+      - name: Upload to PyPI
+        continue-on-error: true
         env:
           TWINE_USERNAME: "__token__"
           TWINE_PASSWORD: ${{ secrets.PYPI_API_TOKEN }}
@@ -68,7 +69,7 @@ jobs:
           cd PythonPackage/AMR
           python -m twine upload dist/*
           
-      - name: Publish to PyPI Testserver
+      - name: Upload to PyPI Testserver
         continue-on-error: true
         env:
           TWINE_USERNAME: "__token__"
@@ -77,6 +78,37 @@ jobs:
           cd PythonPackage/AMR
           python -m twine upload --repository-url https://test.pypi.org/legacy/ dist/*
 
+      # - name: Set up Miniconda
+      #   continue-on-error: true
+      #   uses: conda-incubator/setup-miniconda@v2
+      #   with:
+      #     auto-update-conda: true
+      #     miniconda-version: "latest"
+      #     channels: conda-forge,defaults
+      #     activate-environment: build-env
+      #     python-version: "3.9"
+      # 
+      # - name: Install conda-build and anaconda-client
+      #   continue-on-error: true
+      #   run: |
+      #     conda install -y conda-build anaconda-client
+      # 
+      # - name: Build conda package
+      #   continue-on-error: true
+      #   run: |
+      #     cd PythonPackage/AMR
+      #     conda skeleton pypi .  # Or use custom recipe
+      #     conda-build ./ --output-folder conda-bld
+      # 
+      # - name: Upload to Anaconda
+      #   continue-on-error: true
+      #   env:
+      #     ANACONDA_API_TOKEN: ${{ secrets.ANACONDA_TOKEN }}
+      #   run: |
+      #     anaconda login --token $ANACONDA_API_TOKEN
+      #     anaconda upload conda-bld/**/amr-*.tar.bz2 --user msberends --label main
+      #     rm -rf conda-bld
+
       - name: Git push to python-wrapper branch
         run: |
           find . -mindepth 1 ! -path './PythonPackage*' -exec rm -rf {} +

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 2.1.1
-Date: 2023-10-20 16:05:16 UTC
-SHA: ca72a646d041f7f096c4e196e8ae2fb2b176019c
+Version: 3.0.0
+Date: 2025-06-01 16:52:53 UTC
+SHA: 79038fed2169a25a7fc067c80bb25d9d78be21d9

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 2.1.1.9272
-Date: 2025-05-04
+Version: 3.0.0.9017
+Date: 2025-07-28
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)
   data analysis and to work with microbial and antimicrobial properties by
@@ -51,6 +51,8 @@ Suggests:
   pillar,
   progress,
   readxl,
+  recipes,
+  rlang,
   rmarkdown,
   rstudioapi,
   rvest,

NAMESPACE

@@ -1,15 +1,18 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("!=",amr_selector)
+S3method("$",deprecated_amr_dataset)
 S3method("&",amr_selector)
 S3method("+",ab)
 S3method("+",amr_selector)
 S3method("==",amr_selector)
 S3method("[",ab)
 S3method("[",av)
+S3method("[",deprecated_amr_dataset)
 S3method("[",disk)
 S3method("[",mic)
 S3method("[",mo)
+S3method("[",sir)
 S3method("[<-",ab)
 S3method("[<-",av)
 S3method("[<-",disk)
@@ -18,9 +21,11 @@ S3method("[<-",mo)
 S3method("[<-",sir)
 S3method("[[",ab)
 S3method("[[",av)
+S3method("[[",deprecated_amr_dataset)
 S3method("[[",disk)
 S3method("[[",mic)
 S3method("[[",mo)
+S3method("[[",sir)
 S3method("[[<-",ab)
 S3method("[[<-",av)
 S3method("[[<-",disk)
@@ -40,6 +45,7 @@ S3method(any,amr_selector)
 S3method(any,amr_selector_any_all)
 S3method(as.data.frame,ab)
 S3method(as.data.frame,av)
+S3method(as.data.frame,deprecated_amr_dataset)
 S3method(as.data.frame,mic)
 S3method(as.data.frame,mo)
 S3method(as.double,mic)
@@ -93,7 +99,9 @@ S3method(print,av)
 S3method(print,bug_drug_combinations)
 S3method(print,custom_eucast_rules)
 S3method(print,custom_mdro_guideline)
+S3method(print,deprecated_amr_dataset)
 S3method(print,disk)
+S3method(print,interpreted_sir)
 S3method(print,mic)
 S3method(print,mo)
 S3method(print,mo_renamed)
@@ -101,6 +109,8 @@ S3method(print,mo_uncertainties)
 S3method(print,pca)
 S3method(print,sir)
 S3method(print,sir_log)
+S3method(print,step_mic_log2)
+S3method(print,step_sir_numeric)
 S3method(quantile,mic)
 S3method(rep,ab)
 S3method(rep,av)
@@ -154,6 +164,10 @@ export(administrable_per_os)
 export(age)
 export(age_groups)
 export(all_antimicrobials)
+export(all_mic)
+export(all_mic_predictors)
+export(all_sir)
+export(all_sir_predictors)
 export(aminoglycosides)
 export(aminopenicillins)
 export(amr_class)
@@ -161,7 +175,6 @@ export(amr_distance_from_row)
 export(amr_selector)
 export(anti_join_microorganisms)
 export(antibiogram)
-export(antibiotics)
 export(antifungals)
 export(antimicrobials_equal)
 export(antimycobacterials)
@@ -348,6 +361,8 @@ export(sir_df)
 export(sir_interpretation_history)
 export(sir_predict)
 export(skewness)
+export(step_mic_log2)
+export(step_sir_numeric)
 export(streptogramins)
 export(sulfonamides)
 export(susceptibility)
@@ -358,6 +373,90 @@ export(translate_AMR)
 export(trimethoprims)
 export(ureidopenicillins)
 export(wisca)
+if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
+if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
+if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
+if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, disk)
+if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, mic)
+if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, resistance_predict)
+if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, sir)
+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(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)
+if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
+if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
+if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mic)
+if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mo)
+if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, sir)
+if(getRversion() >= "3.0.0") S3method(pillar::tbl_format_footer, antibiogram)
+if(getRversion() >= "3.0.0") S3method(pillar::tbl_sum, antibiogram)
+if(getRversion() >= "3.0.0") S3method(pillar::type_sum, ab)
+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(recipes::bake, step_mic_log2)
+if(getRversion() >= "3.0.0") S3method(recipes::bake, step_sir_numeric)
+if(getRversion() >= "3.0.0") S3method(recipes::prep, step_mic_log2)
+if(getRversion() >= "3.0.0") S3method(recipes::prep, step_sir_numeric)
+if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_mic_log2)
+if(getRversion() >= "3.0.0") S3method(recipes::tidy, step_sir_numeric)
+if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, disk)
+if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic)
+if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mo)
+if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, sir)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_arith, mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, ab.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, av.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.ab)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.amr_selector)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.av)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mo)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.sir)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.double)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.integer)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, logical.amr_selector_any_all)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.double)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.factor)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.integer)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mo.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.sir)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_math, mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.ab)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector.character)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector_any_all.logical)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.av)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.amr_selector)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.sir)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, logical.amr_selector_any_all)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.mic)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.mo)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.default)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.sir)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_abbr, disk)
+if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_full, disk)
 importFrom(graphics,arrows)
 importFrom(graphics,axis)
 importFrom(graphics,barplot)

NEWS.md

@@ -1,50 +1,31 @@
-# AMR 2.1.1.9272
+# AMR 3.0.0.9017
 
-*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)*
+This is primarily a bugfix release, though we added one nice feature too.
+
+### New
+* Integration with the **tidymodels** framework to allow seamless use of MIC and SIR data in modelling pipelines via `recipes`
+  - `step_mic_log2()` to transform `<mic>` columns with log2, and `step_sir_numeric()` to convert `<sir>` columns to numeric
+  - New `tidyselect` helpers: `all_mic()`, `all_mic_predictors()`, `all_sir()`, `all_sir_predictors()`
+
+### Changed
+* 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 all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223)
+* Fixed some specific Dutch translations for antimicrobials
+* 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)
+* 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.
 
-## tl;dr
-
-- Scope Expansion: One Health support (Human + Veterinary + Environmental microbiology).
-- Data Updates: 
-  - `antibiotics` renamed to `antimicrobials`.
-  - Veterinary antimicrobials and WHOCC codes added.
-  - MycoBank fungal taxonomy integrated (+20,000 fungi).
-- Breakpoints & Interpretations:
-  - CLSI/EUCAST 2024-2025 breakpoints added; EUCAST 2025 default.
-  - `as.sir()` supports NI/SDD levels; parallel computation enabled.
-  - Custom S/I/R/SDD/NI definitions allowed.
-  - Improved handling of capped MICs.
-- New Tools & Functions:
-  - WISCA antibiogram support (`antibiogram()`, `wisca()`).
-  - New ggplot2 extensions: `scale_*_mic()`, `scale_*_sir()`, `rescale_mic()`.
-  - New utility functions: `top_n_microorganisms()`, `mo_group_members()`, `mic_p50()`, `mic_p90()`.
-- Predictive Modelling:
-  - Full tidymodels compatibility for antimicrobial selectors.
-  - Deprecated `resistance_predict()` and `sir_predict()`.
-- Python Compatibility: AMR R package now runs in Python.
-- Selector Improvements:
-  * Added selectors (`isoxazolylpenicillins()`, `monobactams()`, `nitrofurans()`, `phenicols()`, `rifamycins()`, and `sulfonamides()`)
-  - Selectors renamed from `ab_*` to `amr_*`; old names deprecated.
-- MIC/Disks Handling:
-  - MIC strict comparisons, added levels.
-  - Disk diffusion range expanded (0–50 mm).
-- EUCAST Rules and MDROs:
-  - EUCAST v12–v15 rules implemented.
-  - Dutch MDRO 2024 guideline support in `mdro()`.
-- Infrastructure:
-  - New website: https://amr-for-r.org.
-  - Improved `vctrs` integration for tidyverse workflows.
-  - Dropped SAS `.xpt` file support.
-- Other Fixes & Enhancements:
-  - Support for 8 new languages, adding to a total of 28 languages.
-  - Faster microorganism identification.
-  - Improved antimicrobial and MIC handling.
-  - Extended documentation, additional contributors acknowledged.
-
-## Full Changelog
-
 ### Breaking
 * Dataset `antibiotics` has been renamed to `antimicrobials` as the data set contains more than just antibiotics. Using `antibiotics` will still work, but now returns a warning.
 * Removed all functions and references that used the deprecated `rsi` class, which were all replaced with their `sir` equivalents over two years ago.
@@ -136,6 +117,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
 * Updated all antimicrobial DDDs from WHOCC
 * Fix for using a manual value for `mo_transform` in `antibiogram()`
 * Fixed a bug for when `antibiogram()` returns an empty data set
+* Argument `only_sir_columns` now defaults to `TRUE` if any column of a data set contains a class 'sir' (functions `eucast_rules()`, `key_antimicrobials()`, `mdro()`, etc.)
 * Added Sensititre codes for animals, antimicrobials and microorganisms
 * Fix for mapping 'high level' antimicrobials in `as.ab()` (amphotericin B-high, gentamicin-high, kanamycin-high, streptomycin-high, tobramycin-high)
 * Improved overall algorithm of `as.ab()` for better performance and accuracy, including the new function `as_reset_session()` to remove earlier coercions.
@@ -147,8 +129,10 @@ This package now supports not only tools for AMR data analysis in clinical setti
 * Improved algorithm of `first_isolate()` when using the phenotype-based method, to prioritise records with the highest availability of SIR values
 * `scale_y_percent()` can now cope with ranges outside the 0-100% range
 * MDRO determination (using `mdro()`)
+  * The Verbose Mode (`verbose = TRUE`) now includes the guideline name
   * Implemented the new Dutch national MDRO guideline (SRI-richtlijn BRMO, Nov 2024)
   * Added arguments `esbl`, `carbapenemase`, `mecA`, `mecC`, `vanA`, `vanB` to denote column names or logical values indicating presence of these genes (or production of their proteins)
+  * Added upport for antimicrobial selectors to use as as a custom rule (`custom_mdro_guideline()`)
 * Added console colours support of `sir` class for Positron
 
 ### Other
@@ -162,7 +146,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_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(...) {
@@ -544,7 +519,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)
@@ -711,40 +686,6 @@ format_included_data_number <- function(data) {
   paste0(ifelse(rounder == 0, "", "~"), format(round(n, rounder), decimal.mark = ".", big.mark = " "))
 }
 
-# for eucast_rules() and mdro(), creates markdown output with URLs and names
-create_eucast_ab_documentation <- function() {
-  x <- trimws(unique(toupper(unlist(strsplit(EUCAST_RULES_DF$then_change_these_antibiotics, ",", fixed = TRUE)))))
-  ab <- character()
-  for (val in x) {
-    if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
-      # antimicrobial group names, as defined in data-raw/_pre_commit_checks.R, such as `CARBAPENEMS`
-      val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR"))
-    } else if (val %in% AMR_env$AB_lookup$ab) {
-      # separate drugs, such as `AMX`
-      val <- as.ab(val)
-    } else {
-      val <- as.sir(NA)
-    }
-    ab <- c(ab, val)
-  }
-  ab <- unique(ab)
-  atcs <- ab_atc(ab, only_first = TRUE)
-  # only keep ABx with an ATC code:
-  ab <- ab[!is.na(atcs)]
-  atcs <- atcs[!is.na(atcs)]
-
-  # sort all vectors on name:
-  ab_names <- ab_name(ab, language = NULL, tolower = TRUE)
-  ab <- ab[order(ab_names)]
-  atcs <- atcs[order(ab_names)]
-  ab_names <- ab_names[order(ab_names)]
-  # create the text:
-  atc_txt <- paste0("[", atcs, "](", ab_url(ab), ")")
-  out <- paste0(ab_names, " (`", ab, "`, ", atc_txt, ")", collapse = ", ")
-  substr(out, 1, 1) <- toupper(substr(out, 1, 1))
-  out
-}
-
 vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_captital = FALSE, last_sep = " or ") {
   # makes unique and sorts, and this also removed NAs
   v <- unique(v)
@@ -848,7 +789,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
@@ -983,7 +924,8 @@ ascertain_sir_classes <- function(x, obj_name) {
     warning_(
       "the data provided in argument `", obj_name,
       "` should contain at least one column of class 'sir'. Eligible SIR column were now guessed. ",
-      "See `?as.sir`."
+      "See `?as.sir`.",
+      immediate = TRUE
     )
     sirs_eligible <- is_sir_eligible(x)
     for (col in colnames(x)[sirs_eligible]) {
@@ -1053,6 +995,17 @@ get_current_data <- function(arg_name, call) {
     }
   }
 
+  # now check if it was run with eval(), which has arguments `expr`, `envir`, and `enclos`
+  from_eval_parse <- vapply(FUN.VALUE = logical(1), frms, function(e) all(c("expr", "envir", "enclos") %in% names(e)))
+  for (env in frms[which(from_eval_parse)]) {
+    if (valid_df(env$envir)) {
+      # the element `envir` could contain the data in case of
+      # e.g. `eval(parse(text = "any(cephalosporins_3rd() == 'R')"), envir = example_isolates)`
+      # this is also used by run_custom_mdro_guideline() to support antimicrobial selectors in the part before `~`
+      return(env$envir)
+    }
+  }
+
   # no data.frame found, so an error  must be returned:
   if (is.na(arg_name)) {
     if (isTRUE(is.numeric(call))) {
@@ -1137,6 +1090,44 @@ get_group_names <- function(x) {
   }
 }
 
+format_custom_query_rule <- function(query, colours = has_colour()) {
+  # this is used by custom EUCAST and custom MDRO rules
+
+  # font_black() is a bit expensive so do it once:
+  txt <- font_black("{text}")
+  query <- gsub(" & ", sub("{text}", font_bold(" and "), txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" | ", sub("{text}", " or ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" + ", sub("{text}", " plus ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" - ", sub("{text}", " minus ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" / ", sub("{text}", " divided by ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" * ", sub("{text}", " times ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" == ", sub("{text}", " is ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" > ", sub("{text}", " is higher than ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" < ", sub("{text}", " is lower than ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" >= ", sub("{text}", " is higher than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" <= ", sub("{text}", " is lower than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" ^ ", sub("{text}", " to the power of ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
+  query <- gsub("any\\((.*)\\)$", paste0(font_black("any of "), "\\1"), query)
+  query <- gsub("all\\((.*)\\)$", paste0(font_black("all of "), "\\1"), query)
+  if (colours == TRUE) {
+    query <- gsub("[\"']R[\"']", font_rose_bg(" R "), query)
+    query <- gsub("[\"']SDD[\"']", font_orange_bg(" SDD "), query)
+    query <- gsub("[\"']S[\"']", font_green_bg(" S "), query)
+    query <- gsub("[\"']NI[\"']", font_grey_bg(font_black(" NI ")), query)
+    query <- gsub("[\"']I[\"']", font_orange_bg(" I "), query)
+  }
+  # replace the black colour 'stops' with blue colour 'starts'
+  query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE)
+  # start with blue
+  query <- paste0("\033[34m", query)
+  if (colours == FALSE) {
+    query <- font_stripstyle(query)
+  }
+  query
+}
+
 unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
   if (entire_session == TRUE) {
     return(c(envir = "session", call = "session"))
@@ -1228,7 +1219,9 @@ try_colour <- function(..., before, after, collapse = " ") {
   }
 }
 is_dark <- function() {
-  if (is.null(AMR_env$is_dark_theme)) {
+  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) FALSE)
   }
   isTRUE(AMR_env$is_dark_theme)
@@ -1301,6 +1294,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)
 }
@@ -1618,6 +1615,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, ...) {
@@ -1637,52 +1664,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"),
@@ -282,7 +283,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
       levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name,
         ignore.case = FALSE,
         fixed = TRUE,
-        costs = c(insertions = 1, deletions = 1, substitutions = 3),
+        costs = c(insertions = 1, deletions = 1, substitutions = 2),
         counts = FALSE
       ))
       if (any(levenshtein <= 2)) {
@@ -355,7 +356,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
       ab_df$lev_name <- as.double(utils::adist(x[i], ab_df$generalised_name,
         ignore.case = FALSE,
         fixed = TRUE,
-        costs = c(insertions = 1, deletions = 1, substitutions = 3),
+        costs = c(insertions = 1, deletions = 1, substitutions = 2),
         counts = FALSE
       ))
       ab_df$lev_syn <- vapply(
@@ -367,7 +368,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
             min(as.double(utils::adist(x[i], y[nchar(y) >= 5],
               ignore.case = FALSE,
               fixed = TRUE,
-              costs = c(insertions = 1, deletions = 1, substitutions = 3),
+              costs = c(insertions = 1, deletions = 1, substitutions = 2),
               counts = FALSE
             )), na.rm = TRUE)
           )
@@ -379,7 +380,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(),
         ab_df$lev_trans <- as.double(utils::adist(x[i], ab_df$trans,
           ignore.case = FALSE,
           fixed = TRUE,
-          costs = c(insertions = 1, deletions = 1, substitutions = 3),
+          costs = c(insertions = 1, deletions = 1, substitutions = 2),
           counts = FALSE
         ))
       } else {
@@ -503,7 +504,8 @@ ab_reset_session <- function() {
   }
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, ab)
 pillar_shaft.ab <- function(x, ...) {
   out <- trimws(format(x))
   out[is.na(x)] <- font_na(NA)
@@ -519,7 +521,8 @@ pillar_shaft.ab <- function(x, ...) {
   create_pillar_column(out, align = "left", min_width = 4)
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, ab)
 type_sum.ab <- function(x, ...) {
   "ab"
 }
@@ -651,9 +654,11 @@ generalise_antibiotic_name <- function(x) {
   x <- gsub("(/| AND | WITH | W/|[+]|[-])+", " ", x, perl = TRUE)
   # replace more than 1 space
   x <- trimws(gsub(" +", " ", x, perl = TRUE))
-  # remove last couple of words if they are 1-3 characters
-  x <- gsub("( .{1,3})+$", "", x)
-  # move HIGH to end
+  # remove last couple of words if they numbers or units
+  x <- gsub("( ([0-9]{3,}|U?M?C?G|L))+$", "", x, perl = TRUE)
+  # 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

@@ -40,7 +40,7 @@
 #' ```
 #' @param amr_class An antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antimicrobials] data set will be searched (case-insensitive) for this value.
 #' @param filter An [expression] to be evaluated in the [antimicrobials] data set, such as `name %like% "trim"`.
-#' @param only_sir_columns A [logical] to indicate whether only columns of class `sir` must be selected (default is `FALSE`), see [as.sir()].
+#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE`.
 #' @param only_treatable A [logical] to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`).
 #' @param return_all A [logical] to indicate whether all matched columns must be returned (default is `TRUE`). With `FALSE`, only the first of each unique antimicrobial will be returned, e.g. if both columns `"genta"` and `"gentamicin"` exist in the data, only the first hit for gentamicin will be returned.
 #' @param ... Ignored, only in place to allow future extensions.
@@ -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"`
@@ -110,7 +111,7 @@
 #'
 #' There are various antibiogram types, as summarised by Klinker *et al.* (2021, \doi{10.1177/20499361211011373}), and they are all supported by [antibiogram()].
 #'
-#' For clinical coverage estimations, **use WISCA whenever possible**, since it provides more precise coverage estimates by accounting for pathogen incidence and antimicrobial susceptibility, as has been shown by Bielicki *et al.* (2020, \doi{10.1001.jamanetworkopen.2019.21124}). See the section *Explaining WISCA* on this page. Do note that WISCA is pathogen-agnostic, meaning that the outcome is not stratied by pathogen, but rather by syndrome.
+#' For clinical coverage estimations, **use WISCA whenever possible**, since it provides more precise coverage estimates by accounting for pathogen incidence and antimicrobial susceptibility, as has been shown by Bielicki *et al.* (2020, \doi{10.1001/jamanetworkopen.2019.21124}). See the section *Explaining WISCA* on this page. Do note that WISCA is pathogen-agnostic, meaning that the outcome is not stratied by pathogen, but rather by syndrome.
 #'
 #' 1. **Traditional Antibiogram**
 #'
@@ -266,7 +267,7 @@
 #' For more background, interpretation, and examples, see [the WISCA vignette](https://amr-for-r.org/articles/WISCA.html).
 #' @source
 #' * Bielicki JA *et al.* (2016). **Selecting appropriate empirical antibiotic regimens for paediatric bloodstream infections: application of a Bayesian decision model to local and pooled antimicrobial resistance surveillance data** *Journal of Antimicrobial Chemotherapy* 71(3); \doi{10.1093/jac/dkv397}
-#' * Bielicki JA *et al.* (2020). **Evaluation of the coverage of 3 antibiotic regimens for neonatal sepsis in the hospital setting across Asian countries** *JAMA Netw Open.* 3(2):e1921124; \doi{10.1001.jamanetworkopen.2019.21124}
+#' * Bielicki JA *et al.* (2020). **Evaluation of the coverage of 3 antibiotic regimens for neonatal sepsis in the hospital setting across Asian countries** *JAMA Netw Open.* 3(2):e1921124; \doi{10.1001/jamanetworkopen.2019.21124}
 #' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
 #' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
 #' * **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
@@ -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
   }
 
@@ -1190,20 +1200,23 @@ retrieve_wisca_parameters <- function(wisca_model, ...) {
   attributes(wisca_model)$wisca_parameters
 }
 
-# will be exported in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @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
 }
 
-# will be exported in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::tbl_format_footer, antibiogram)
 tbl_format_footer.antibiogram <- function(x, ...) {
   footer <- NextMethod()
   if (NROW(x) == 0) {
@@ -1271,7 +1284,8 @@ barplot.antibiogram <- function(height, ...) {
 
 #' @method autoplot antibiogram
 #' @rdname antibiogram
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
 autoplot.antibiogram <- function(object, ...) {
   df <- attributes(object)$long_numeric
   if (!"mo" %in% colnames(df)) {
@@ -1318,11 +1332,12 @@ autoplot.antibiogram <- function(object, ...) {
   out
 }
 
-# will be exported in zzz.R
 #' @method knit_print antibiogram
 #' @param italicise A [logical] to indicate whether the microorganism names in the [knitr][knitr::kable()] table should be made italic, using [italicise_taxonomy()].
 #' @param na Character to use for showing `NA` values.
 #' @rdname antibiogram
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(knitr::knit_print, antibiogram)
 knit_print.antibiogram <- function(x, italicise = TRUE, na = getOption("knitr.kable.NA", default = ""), ...) {
   stop_ifnot_installed("knitr")
   meet_criteria(italicise, allow_class = "logical", has_length = 1)

R/av.R

@@ -507,7 +507,8 @@ is.av <- function(x) {
   inherits(x, "av")
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, av)
 pillar_shaft.av <- function(x, ...) {
   out <- trimws(format(x))
   out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
@@ -515,7 +516,8 @@ pillar_shaft.av <- function(x, ...) {
   create_pillar_column(out, align = "left", min_width = 4)
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, av)
 type_sum.av <- function(x, ...) {
   "av"
 }

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

@@ -356,7 +356,8 @@ format.bug_drug_combinations <- function(x,
   as_original_data_class(y, class(x.bak), extra_class = "formatted_bug_drug_combinations") # will remove tibble groups
 }
 
-# will be exported in zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(knitr::knit_print, formatted_bug_drug_combinations)
 knit_print.formatted_bug_drug_combinations <- function(x, ...) {
   stop_ifnot_installed("knitr")
   # make columns with MO names italic according to nomenclature

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_eucast_rules.R

@@ -33,7 +33,6 @@
 #' @param ... Rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
 #' @details
 #' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
-#' @section How it works:
 #'
 #' ### Basics
 #'
@@ -69,7 +68,11 @@
 #' #> 1      Escherichia coli   R    S     S
 #' #> 2 Klebsiella pneumoniae   R    S     S
 #'
-#' eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE, overwrite = TRUE)
+#' eucast_rules(df,
+#'              rules = "custom",
+#'              custom_rules = x,
+#'              info = FALSE,
+#'              overwrite = TRUE)
 #' #>                      mo TZP ampi cipro
 #' #> 1      Escherichia coli   R    R     S
 #' #> 2 Klebsiella pneumoniae   R    R     S
@@ -80,15 +83,25 @@
 #' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
 #'
 #' ```r
-#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
-#'                          TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
+#' y <- custom_eucast_rules(
+#'   TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
+#'   TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
+#' )
 #'
-#' eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE, overwrite = TRUE)
+#' eucast_rules(df,
+#'              rules = "custom",
+#'              custom_rules = y,
+#'              info = FALSE,
+#'              overwrite = TRUE)
 #' #>                      mo TZP ampi cipro
 #' #> 1      Escherichia coli   R    S     S
 #' #> 2 Klebsiella pneumoniae   R    R     S
 #' ```
 #'
+#' ### Sharing rules among multiple users
+#'
+#' The rules set (the `y` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
+#'
 #' ### Usage of multiple antimicrobials and antimicrobial group names
 #'
 #' You can define antimicrobial groups instead of single antimicrobials for the rule consequence, which is the part *after* the tilde (~). In the examples above, the antimicrobial group `aminopenicillins` includes both ampicillin and amoxicillin.
@@ -278,35 +291,3 @@ print.custom_eucast_rules <- function(x, ...) {
     cat("\n  ", rule_if, "\n", rule_then, "\n", sep = "")
   }
 }
-
-format_custom_query_rule <- function(query, colours = has_colour()) {
-  # font_black() is a bit expensive so do it once:
-  txt <- font_black("{text}")
-  query <- gsub(" & ", sub("{text}", font_bold(" and "), txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" | ", sub("{text}", " or ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" + ", sub("{text}", " plus ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" - ", sub("{text}", " minus ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" / ", sub("{text}", " divided by ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" * ", sub("{text}", " times ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" == ", sub("{text}", " is ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" > ", sub("{text}", " is higher than ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" < ", sub("{text}", " is lower than ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" >= ", sub("{text}", " is higher than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" <= ", sub("{text}", " is lower than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" ^ ", sub("{text}", " to the power of ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
-  query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
-  if (colours == TRUE) {
-    query <- gsub('"R"', font_rose_bg(" R "), query, fixed = TRUE)
-    query <- gsub('"S"', font_green_bg(" S "), query, fixed = TRUE)
-    query <- gsub('"I"', font_orange_bg(" I "), query, fixed = TRUE)
-  }
-  # replace the black colour 'stops' with blue colour 'starts'
-  query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE)
-  # start with blue
-  query <- paste0("\033[34m", query)
-  if (colours == FALSE) {
-    query <- font_stripstyle(query)
-  }
-  query
-}

R/custom_mdro_guideline.R

@@ -0,0 +1,313 @@
+# ==================================================================== #
+# 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              #
+# ==================================================================== #
+
+#' Define Custom MDRO Guideline
+#'
+#' Define custom a MDRO guideline for your organisation or specific analysis and use the output of this function in [mdro()].
+#' @param ... Guideline rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
+#' @param as_factor A [logical] to indicate whether the returned value should be an ordered [factor] (`TRUE`, default), or otherwise a [character] vector. For combining rules sets (using [c()]) this value will be inherited from the first set at default.
+#' @details
+#' Using a custom MDRO guideline is of importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
+#'
+#' ### Basics
+#'
+#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
+#'
+#' ```r
+#' custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
+#'                                 ERY == "R" & age > 60 ~ "Elderly Type B")
+#' ```
+#'
+#' If a row/an isolate matches the first rule, the value after the first `~` (in this case *'Elderly Type A'*) will be set as MDRO value. Otherwise, the second rule will be tried and so on. The number of rules is unlimited.
+#'
+#' You can print the rules set in the console for an overview. Colours will help reading it if your console supports colours.
+#'
+#' ```r
+#' custom
+#' #> A set of custom MDRO rules:
+#' #>   1. If CIP is R and age is higher than 60 then: Elderly Type A
+#' #>   2. If ERY is R and age is higher than 60 then: Elderly Type B
+#' #>   3. Otherwise: Negative
+#'
+#' #> Unmatched rows will return NA.
+#' #> Results will be of class 'factor', with ordered levels: Negative < Elderly Type A < Elderly Type B
+#' ```
+#'
+#' The outcome of the function can be used for the `guideline` argument in the [mdro()] function:
+#'
+#' ```r
+#' x <- mdro(example_isolates, guideline = custom)
+#' #> Determining MDROs based on custom rules, resulting in factor levels: Negative < Elderly Type A < Elderly Type B.
+#' #> - Custom MDRO rule 1: CIP == "R" & age > 60 (198 rows matched)
+#' #> - Custom MDRO rule 2: ERY == "R" & age > 60 (732 rows matched)
+#' #> => Found 930 custom defined MDROs out of 2000 isolates (46.5%)
+#'
+#' table(x)
+#' #> x
+#' #>       Negative  Elderly Type A  Elderly Type B
+#' #>           1070             198             732
+#' ```
+#'
+#' Rules can also be combined with other custom rules by using [c()]:
+#'
+#' ```r
+#' x <- mdro(example_isolates,
+#'           guideline = c(custom,
+#'                         custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C")))
+#' #> Determining MDROs based on custom rules, resulting in factor levels: Negative < Elderly Type A < Elderly Type B < Elderly Type C.
+#' #> - Custom MDRO rule 1: CIP == "R" & age > 60 (198 rows matched)
+#' #> - Custom MDRO rule 2: ERY == "R" & age > 60 (732 rows matched)
+#' #> - Custom MDRO rule 3: ERY == "R" & age > 50 (109 rows matched)
+#' #> => Found 1039 custom defined MDROs out of 2000 isolates (52.0%)
+#'
+#' table(x)
+#' #> x
+#' #>       Negative  Elderly Type A  Elderly Type B  Elderly Type C
+#' #>            961             198             732             109
+#' ```
+#'
+#' ### Sharing rules among multiple users
+#'
+#' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
+#'
+#' ### Usage of multiple antimicrobials and antimicrobial group names
+#'
+#' You can define antimicrobial groups instead of single antimicrobials for the rule itself, which is the part *before* the tilde (~). Use [any()] or [all()] to specify the scope of the antimicrobial group:
+#'
+#' ```r
+#' custom_mdro_guideline(
+#'   AMX == "R"                       ~ "My MDRO #1",
+#'   any(cephalosporins_2nd() == "R") ~ "My MDRO #2",
+#'   all(glycopeptides() == "R")      ~ "My MDRO #3"
+#' )
+#' ```
+#'
+#' All `r length(DEFINED_AB_GROUPS)` antimicrobial selectors are supported for use in the rules:
+#'
+#' `r paste0(" * ", na.omit(sapply(DEFINED_AB_GROUPS, function(ab) ifelse(tolower(gsub("^AB_", "", ab)) %in% ls(envir = asNamespace("AMR")), paste0("[", tolower(gsub("^AB_", "", ab)), "()] can select: \\cr ", vector_and(ab_name(eval(parse(text = ab), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE, sort = TRUE)), character(0)), USE.NAMES = FALSE)), "\n", collapse = "")`
+#' @returns A [list] containing the custom rules
+#' @rdname custom_mdro_guideline
+#' @export
+#' @examples
+#' x <- custom_mdro_guideline(
+#'   CIP == "R" & age > 60 ~ "Elderly Type A",
+#'   ERY == "R" & age > 60 ~ "Elderly Type B"
+#' )
+#' x
+#'
+#' # run the custom rule set (verbose = TRUE will return a logbook instead of the data set):
+#' out <- mdro(example_isolates, guideline = x)
+#' table(out)
+#'
+#' out <- mdro(example_isolates, guideline = x, verbose = TRUE)
+#' head(out)
+#'
+#' # you can create custom guidelines using selectors (see ?antimicrobial_selectors)
+#' my_guideline <- custom_mdro_guideline(
+#'   AMX == "R" ~ "Custom MDRO 1",
+#'   all(cephalosporins_2nd() == "R") ~ "Custom MDRO 2"
+#' )
+#' my_guideline
+#'
+#' out <- mdro(example_isolates, guideline = my_guideline)
+#' table(out)
+custom_mdro_guideline <- function(..., as_factor = TRUE) {
+  meet_criteria(as_factor, allow_class = "logical", has_length = 1)
+
+  dots <- tryCatch(list(...),
+    error = function(e) "error"
+  )
+  stop_if(
+    identical(dots, "error"),
+    "rules must be a valid formula inputs (e.g., using '~'), see `?mdro`"
+  )
+  n_dots <- length(dots)
+  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?mdro`.")
+  out <- vector("list", n_dots)
+  for (i in seq_len(n_dots)) {
+    stop_ifnot(
+      inherits(dots[[i]], "formula"),
+      "rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
+    )
+
+    # Query
+    qry <- dots[[i]][[2]]
+    if (inherits(qry, "call")) {
+      qry <- as.expression(qry)
+    }
+    qry <- as.character(qry)
+    # these will prevent vectorisation, so replace them:
+    qry <- gsub("&&", "&", qry, fixed = TRUE)
+    qry <- gsub("||", "|", qry, fixed = TRUE)
+    # support filter()-like writing: custom_mdro_guideline('CIP == "R", AMX == "S"' ~ "result 1")
+    qry <- gsub(" *, *", " & ", qry)
+    # format nicely, setting spaces around operators
+    qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
+    qry <- gsub("'", "\"", qry, fixed = TRUE)
+    qry <- as.expression(qry)
+    out[[i]]$query <- qry
+
+    # 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) 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)
+  }
+
+  names(out) <- paste0("rule", seq_len(n_dots))
+  out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list"))
+  attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value)))
+  attr(out, "as_factor") <- as_factor
+  out
+}
+
+#' @method c custom_mdro_guideline
+#' @param x Existing custom MDRO rules
+#' @rdname custom_mdro_guideline
+#' @export
+c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
+  if (length(list(...)) == 0) {
+    return(x)
+  }
+  if (!is.null(as_factor)) {
+    meet_criteria(as_factor, allow_class = "logical", has_length = 1)
+  } else {
+    as_factor <- attributes(x)$as_factor
+  }
+  for (g in list(...)) {
+    stop_ifnot(inherits(g, "custom_mdro_guideline"),
+      "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
+      call = FALSE
+    )
+    vals <- attributes(x)$values
+    if (!all(attributes(g)$values %in% vals)) {
+      vals <- unname(unique(c(vals, attributes(g)$values)))
+    }
+    attributes(g) <- NULL
+    x <- c(unclass(x), unclass(g))
+    attr(x, "values") <- vals
+  }
+  names(x) <- paste0("rule", seq_len(length(x)))
+  x <- set_clean_class(x, new_class = c("custom_mdro_guideline", "list"))
+  attr(x, "values") <- vals
+  attr(x, "as_factor") <- as_factor
+  x
+}
+
+#' @method as.list custom_mdro_guideline
+#' @noRd
+#' @export
+as.list.custom_mdro_guideline <- function(x, ...) {
+  c(x, ...)
+}
+
+#' @method print custom_mdro_guideline
+#' @noRd
+#' @export
+print.custom_mdro_guideline <- function(x, ...) {
+  cat("A set of custom MDRO rules:\n")
+  for (i in seq_len(length(x))) {
+    rule <- x[[i]]
+    rule$query <- format_custom_query_rule(rule$query)
+    cat("  ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
+  }
+  cat("  ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
+  cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
+  if (isTRUE(attributes(x)$as_factor)) {
+    cat("Results will be of class 'factor', with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
+  } else {
+    cat("Results will be of class 'character'.\n")
+  }
+}
+
+run_custom_mdro_guideline <- function(df, guideline, info) {
+  n_dots <- length(guideline)
+  stop_if(n_dots == 0, "no custom guidelines set", call = -2)
+  out <- character(length = NROW(df))
+  reasons <- character(length = NROW(df))
+  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 <- conditionMessage(e)
+        return("error")
+      }
+    )
+    if (identical(qry, "error")) {
+      warning_("in `custom_mdro_guideline()`: rule ", i,
+        " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
+        AMR_env$err_msg,
+        call = FALSE,
+        add_fn = font_red
+      )
+      next
+    }
+    stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
+      "`) must return `TRUE` or `FALSE`, not ",
+      format_class(class(qry), plural = FALSE),
+      call = FALSE
+    )
+
+    new_mdros <- which(qry == TRUE & out == "")
+
+    if (isTRUE(info)) {
+      cat(word_wrap(
+        "- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
+        "` (", length(new_mdros), " rows matched)"
+      ), "\n", sep = "")
+    }
+    val <- guideline[[i]]$value
+    out[new_mdros] <- val
+    reasons[new_mdros] <- paste0(
+      "matched rule ",
+      gsub("rule", "", names(guideline)[i], fixed = TRUE), ": ", as.character(guideline[[i]]$query)
+    )
+  }
+  out[out == ""] <- "Negative"
+  reasons[out == "Negative"] <- "no rules matched"
+
+  if (isTRUE(attributes(guideline)$as_factor)) {
+    out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
+  }
+
+  all_nonsusceptible_columns <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
+  all_nonsusceptible_columns <- vapply(
+    FUN.VALUE = character(1),
+    all_nonsusceptible_columns,
+    function(x) paste0(rownames(all_nonsusceptible_columns)[which(x)], collapse = ", ")
+  )
+  all_nonsusceptible_columns[is.na(out)] <- NA_character_
+
+  data.frame(
+    row_number = seq_len(NROW(df)),
+    MDRO = out,
+    reason = reasons,
+    all_nonsusceptible_columns = all_nonsusceptible_columns,
+    stringsAsFactors = FALSE
+  )
+}

R/data.R

@@ -29,7 +29,10 @@
 
 #' Data Sets with `r format(nrow(antimicrobials) + nrow(antivirals), big.mark = " ")` Antimicrobial Drugs
 #'
+#' @description
 #' Two data sets containing all antimicrobials and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antimicrobials] data set. Three identifiers are included in this data set: an antimicrobial ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes. Note that some drugs have multiple ATC codes.
+#'
+#' **The `antibiotics` data set has been renamed to `antimicrobials`. The old name will be removed in a future version.**
 #' @format
 #' ### For the [antimicrobials] data set: a [tibble][tibble::tibble] with `r nrow(antimicrobials)` observations and `r ncol(antimicrobials)` variables:
 #' - `ab`\cr antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.***
@@ -88,6 +91,9 @@
 #' antivirals
 "antimicrobials"
 
+#' @rdname antimicrobials
+"antibiotics"
+
 #' @rdname antimicrobials
 "antivirals"
 
@@ -355,3 +361,15 @@
 #' @examples
 #' dosage
 "dosage"
+
+#' Data Set with `r format(nrow(esbl_isolates), big.mark = " ")` ESBL Isolates
+#'
+#' 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).
+#' @format A [tibble][tibble::tibble] with `r format(nrow(esbl_isolates), big.mark = " ")` observations and `r ncol(esbl_isolates)` variables:
+#' - `esbl`\cr Logical indicator if the isolate is ESBL-producing
+#' - `genus`\cr Genus of the microorganism
+#' - `AMC:COL`\cr MIC values for 17 antimicrobial agents, transformed to class [`mic`] (see [as.mic()])
+#' @details See our [tidymodels integration][amr-tidymodels] for an example using this data set.
+#' @examples
+#' esbl_isolates
+"esbl_isolates"

R/disk.R

@@ -158,7 +158,8 @@ is.disk <- function(x) {
   inherits(x, "disk")
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, disk)
 pillar_shaft.disk <- function(x, ...) {
   out <- trimws(format(x))
   out[is.na(x)] <- font_na(NA)
@@ -232,7 +233,8 @@ rep.disk <- function(x, ...) {
   y
 }
 
-# will be exported using s3_register() in R/zzz.R
+# 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) {
   skimr::sfl(
     skim_type = "disk",

R/eucast_rules.R

@@ -67,10 +67,10 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
 #' @param version_expected_phenotypes The version number to use for the EUCAST Expected Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_EXPECTED_PHENOTYPES), reverse = TRUE)`.
 #' @param version_expertrules The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`.
 #' @param ampc_cephalosporin_resistance (only applies when `rules` contains `"expert"` or `"all"`) a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these versions of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(EUCAST_RULES_DF[which(EUCAST_RULES_DF$reference.version %in% c(3.2, 3.3) & EUCAST_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
-#' @param ... Column name of an antimicrobial, see section *Antimicrobials* below.
+#' @param ... Column names of antimicrobials. To automatically detect antimicrobial column names, do not provide any named arguments; [guess_ab_col()] will then be used for detection. To manually specify a column, provide its name (case-insensitive) as an argument, e.g. `AMX = "amoxicillin"`. To skip a specific antimicrobial, set it to `NULL`, e.g. `TIC = NULL` to exclude ticarcillin. If a manually defined column does not exist in the data, it will be skipped with a warning.
 #' @param ab Any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()].
 #' @param administration Route of administration, either `r vector_or(dosage$administration)`.
-#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`).
+#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
 #' @param custom_rules Custom rules to apply, created with [custom_eucast_rules()].
 #' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".
 #' @inheritParams first_isolate
@@ -101,12 +101,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
 #' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set.
 #'
 #' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the package option [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`.
-#' @section Antimicrobials:
-#' To define antimicrobials column names, leave as it is to determine it automatically with [guess_ab_col()] or input a text (case-insensitive), or use `NULL` to skip a column (e.g. `TIC = NULL` to skip ticarcillin). Manually defined but non-existing columns will be skipped with a warning.
-#'
-#' The following antimicrobials are eligible for the functions [eucast_rules()] and [mdro()]. These are shown below in the format 'name (`antimicrobial ID`, [ATC code](https://atcddd.fhi.no/atc/structure_and_principles/))', sorted alphabetically:
-#'
-#' `r create_eucast_ab_documentation()`
 #' @aliases EUCAST
 #' @rdname eucast_rules
 #' @export
@@ -171,7 +165,7 @@ eucast_rules <- function(x,
                          version_expected_phenotypes = 1.2,
                          version_expertrules = 3.3,
                          ampc_cephalosporin_resistance = NA,
-                         only_sir_columns = FALSE,
+                         only_sir_columns = any(is.sir(x)),
                          custom_rules = NULL,
                          overwrite = FALSE,
                          ...) {
@@ -448,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"
@@ -456,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)) {
@@ -623,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
@@ -670,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)) {
@@ -900,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
@@ -914,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
           ),
@@ -1188,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/g.test.R

@@ -72,7 +72,7 @@
 #'
 #' If there are more than two categories and you want to find out which ones are significantly different from their null expectation, you can use the same method of testing each category vs. the sum of all categories, with the Bonferroni correction. You use *G*-tests for each category, of course.
 #' @seealso [chisq.test()]
-#' @references 1. McDonald, J.H. 2014. **Handbook of Biological Statistics (3rd ed.)**. Sparky House Publishing, Baltimore, Maryland. <http://www.biostathandbook.com/gtestgof.html>.
+#' @references 1. McDonald, J.H. 2014. **Handbook of Biological Statistics (3rd ed.)**. Sparky House Publishing, Baltimore, Maryland.
 #' @source The code for this function is identical to that of [chisq.test()], except that:
 #' - The calculation of the statistic was changed to \eqn{2 * sum(x * log(x / E))}
 #' - Yates' continuity correction was removed as it does not apply to a *G*-test

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

@@ -33,7 +33,7 @@
 #' @param x A [data.frame].
 #' @param search_string A text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`.
 #' @param verbose A [logical] to indicate whether additional info should be printed.
-#' @param only_sir_columns A [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`).
+#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
 #' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antimicrobials] data set for any column containing a name or code of that antibiotic.
 #' @return A column name of `x`, or `NULL` when no result is found.
 #' @export
@@ -211,7 +211,7 @@ get_column_abx <- function(x,
     newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
     if (anyNA(newnames)) {
       if (isTRUE(info)) {
-        message_(" WARNING", add_fn = list(font_yellow, font_bold), as_note = FALSE)
+        message_(paste0(font_yellow(font_bold(" WARNING: ")), "some columns returned `NA` for `as.ab()`"), as_note = FALSE)
       }
       warning_("Invalid antibiotic reference(s): ", vector_and(names(dots)[is.na(newnames)], quotes = FALSE),
         call = FALSE,
@@ -254,7 +254,10 @@ get_column_abx <- function(x,
     out <- out[order(names(out), out)]
   }
 
+  dups <- FALSE
+
   if (return_all == FALSE) {
+    dups <- names(out)[names(out) %in% names(out)[duplicated(names(out))]]
     # only keep the first hits, no duplicates
     duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
     if (length(duplicates) > 0) {
@@ -264,28 +267,29 @@ get_column_abx <- function(x,
     if (isTRUE(info)) {
       if (all_okay == TRUE) {
         message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
+      } else if (!isFALSE(dups)) {
+        message_(paste0(font_yellow(font_bold(" WARNING: ")), "some results from `as.ab()` are duplicated: ", vector_and(dups, quotes = "`")), as_note = FALSE)
       } else {
         message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
       }
+
       for (i in seq_len(length(out))) {
-        if (isTRUE(verbose) && !names(out[i]) %in% names(duplicates)) {
+        if (isTRUE(verbose) && !out[i] %in% duplicates) {
           message_(
             "Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
             " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
           )
         }
-        if (names(out[i]) %in% names(duplicates)) {
-          already_set_as <- out[unname(out) == unname(out[i])][1L]
-          if (names(out)[i] != names(already_set_as)) {
-            warning_(
+        if (out[i] %in% duplicates) {
+          already_set_as <- out[which(out == out[i])[1L]]
+          if (names(out)[i] != already_set_as) {
+            message_(
               paste0(
                 "Column '", font_bold(out[i]), "' will not be used for ",
-                names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
-                ", as it is already set for ",
-                names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"
+                names(out)[i], " (", suppressMessages(ab_name(names(out)[i], tolower = TRUE, language = NULL, fast_mode = TRUE)), ")",
+                ", as this antimicrobial has already been set."
               ),
-              add_fn = font_red,
-              immediate = verbose
+              add_fn = font_red
             )
           }
         }

R/key_antimicrobials.R

@@ -37,7 +37,7 @@
 #' @param gram_negative Names of antibiotic drugs for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs.
 #' @param gram_positive Names of antibiotic drugs for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs.
 #' @param antifungal Names of antifungal drugs for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antifungal drugs.
-#' @param only_sir_columns A [logical] to indicate whether only columns must be included that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`).
+#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
 #' @param ... Ignored, only in place to allow future extensions.
 #' @details
 #' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
@@ -134,7 +134,7 @@ key_antimicrobials <- function(x = NULL,
                                  "anidulafungin", "caspofungin", "fluconazole",
                                  "miconazole", "nystatin", "voriconazole"
                                ),
-                               only_sir_columns = FALSE,
+                               only_sir_columns = any(is.sir(x)),
                                ...) {
   if (is_null_or_grouped_tbl(x)) {
     # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
@@ -246,7 +246,7 @@ key_antimicrobials <- function(x = NULL,
 #' @rdname key_antimicrobials
 #' @export
 all_antimicrobials <- function(x = NULL,
-                               only_sir_columns = FALSE,
+                               only_sir_columns = any(is.sir(x)),
                                ...) {
   if (is_null_or_grouped_tbl(x)) {
     # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)

R/mdro.R

@@ -38,13 +38,10 @@
 #' @param mecC [logical] values, or a column name containing logical values, indicating the presence of a *mecC* gene (or production of its proteins).
 #' @param vanA [logical] values, or a column name containing logical values, indicating the presence of a *vanA* gene (or production of its proteins).
 #' @param vanB [logical] values, or a column name containing logical values, indicating the presence of a *vanB* gene (or production of its proteins).
-#' @param ... In case of [custom_mdro_guideline()]: a set of rules, see section *Using Custom Guidelines* below. Otherwise: column name of an antibiotic, see section *Antimicrobials* below.
-#' @param as_factor A [logical] to indicate whether the returned value should be an ordered [factor] (`TRUE`, default), or otherwise a [character] vector.
 #' @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.
-#' @inheritSection eucast_rules Antimicrobials
 #' @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*.
 #'
@@ -52,25 +49,29 @@
 #'
 #' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named *order* Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
 #'
-#' @section Supported International / National Guidelines:
+#' ### Supported International / National Guidelines
+#'
+#' Please suggest to implement guidelines by [letting us know](https://github.com/msberends/AMR/issues/new?template=2-feature-request.yml&title=Add%20new%20MDRO%20guideline).
 #'
 #' Currently supported guidelines are (case-insensitive):
 #'
-#' * `guideline = "CMI2012"` (default)
+#' * `guideline = "CMI 2012"` (default)
 #'
 #'   Magiorakos AP, Srinivasan A *et al.* "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." Clinical Microbiology and Infection (2012) (\doi{10.1111/j.1469-0691.2011.03570.x})
 #'
-#' * `guideline = "EUCAST3.3"` (or simply `guideline = "EUCAST"`)
+#' * `guideline = "EUCAST 3.3"` (or simply `guideline = "EUCAST"`)
 #'
 #'   The European international guideline - EUCAST Expert Rules Version 3.3 "Intrinsic Resistance and Unusual Phenotypes" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2021/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.3_20211018.pdf))
 #'
-#' * `guideline = "EUCAST3.2"`
+#'   Also:
 #'
-#'   The European international guideline - EUCAST Expert Rules Version 3.2 "Intrinsic Resistance and Unusual Phenotypes" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf))
+#'   * `guideline = "EUCAST 3.2"`
 #'
-#' * `guideline = "EUCAST3.1"`
+#'      The former European international guideline - EUCAST Expert Rules Version 3.2 "Intrinsic Resistance and Unusual Phenotypes" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf))
 #'
-#'   The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
+#'   * `guideline = "EUCAST 3.1"`
+#'
+#'      The former European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
 #'
 #' * `guideline = "TB"`
 #'
@@ -80,7 +81,7 @@
 #'
 #'   The German national guideline - Mueller et al. (2015) Antimicrobial Resistance and Infection Control 4:7; \doi{10.1186/s13756-015-0047-6}
 #'
-#' * `guideline = "BRMO"`
+#' * `guideline = "BRMO 2024"` (or simply `guideline = "BRMO"`)
 #'
 #'   The Dutch national guideline - Samenwerkingverband Richtlijnen Infectiepreventie (SRI) (2024) "Bijzonder Resistente Micro-Organismen (BRMO)" ([link](https://www.sri-richtlijnen.nl/brmo))
 #'
@@ -90,57 +91,16 @@
 #'
 #'     The former Dutch national guideline - Werkgroep Infectiepreventie (WIP), RIVM, last revision as of 2017: "Bijzonder Resistente Micro-Organismen (BRMO)"
 #'
-#' Please suggest to implement guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
+#' ### Using Custom Guidelines
 #'
-#' @section Using Custom Guidelines:
+#' Using a custom MDRO guideline is of importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
 #'
-#' Custom guidelines can be set with the [custom_mdro_guideline()] function. This is of great importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
+#' Custom guidelines can be set with the [custom_mdro_guideline()] function.
 #'
-#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
-#'
-#' ```
-#' custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
-#'                                 ERY == "R" & age > 60 ~ "Elderly Type B")
-#' ```
-#'
-#' If a row/an isolate matches the first rule, the value after the first `~` (in this case *'Elderly Type A'*) will be set as MDRO value. Otherwise, the second rule will be tried and so on. The number of rules is unlimited.
-#'
-#' You can print the rules set in the console for an overview. Colours will help reading it if your console supports colours.
-#'
-#' ```
-#' custom
-#' #> A set of custom MDRO rules:
-#' #>   1. CIP is "R" and age is higher than 60 -> Elderly Type A
-#' #>   2. ERY is "R" and age is higher than 60 -> Elderly Type B
-#' #>   3. Otherwise -> Negative
-#' #>
-#' #> Unmatched rows will return NA.
-#' ```
-#'
-#' The outcome of the function can be used for the `guideline` argument in the [mdro()] function:
-#'
-#' ```
-#' x <- mdro(example_isolates,
-#'           guideline = custom)
-#' table(x)
-#' #>       Negative Elderly Type A Elderly Type B
-#' #>           1070            198            732
-#' ```
-#'
-#' Rules can also be combined with other custom rules by using [c()]:
-#'
-#' ```
-#' x <- mdro(example_isolates,
-#'           guideline = c(custom,
-#'                         custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C")))
-#' table(x)
-#' #>       Negative Elderly Type A Elderly Type B Elderly Type C
-#' #>            961            198            732            109
-#' ```
-#'
-#' The rules set (the `custom` object in this case) could be exported to a shared file location using [saveRDS()] if you collaborate with multiple users. The custom rules set could then be imported using [readRDS()].
 #' @inheritSection as.sir Interpretation of SIR
 #' @return
+#' - If `verbose` is set to `TRUE`:\cr
+#'   A [data.frame] containing columns `row_number`, `microorganism`, `MDRO`, `reason`, `all_nonsusceptible_columns`, `guideline`
 #' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
 #'   Ordered [factor] with levels `Negative` < `Multi-drug-resistant (MDR)` < `Extensively drug-resistant (XDR)` < `Pandrug-resistant (PDR)`
 #' - TB guideline - function [mdr_tb()] or [`mdro(..., guideline = "TB")`][mdro()]:\cr
@@ -148,40 +108,29 @@
 #' - German guideline - function [mrgn()] or [`mdro(..., guideline = "MRGN")`][mdro()]:\cr
 #'   Ordered [factor] with levels `Negative` < `3MRGN` < `4MRGN`
 #' - Everything else, except for custom guidelines:\cr
-#'   Ordered [factor] with levels `Negative` < `Positive, unconfirmed` < `Positive`. The value `"Positive, unconfirmed"` means that, according to the guideline, it is not entirely sure if the isolate is multi-drug resistant and this should be confirmed with additional (e.g. molecular) tests
+#'   Ordered [factor] with levels `Negative` < `Positive, unconfirmed` < `Positive`. The value `"Positive, unconfirmed"` means that, according to the guideline, it is not entirely sure if the isolate is multi-drug resistant and this should be confirmed with additional (e.g. genotypic) tests
 #' @rdname mdro
 #' @aliases MDR XDR PDR BRMO 3MRGN 4MRGN
+#' @seealso [custom_mdro_guideline()]
 #' @export
-#' @source
-#' See the supported guidelines above for the [list] of publications used for this function.
 #' @examples
-#' out <- mdro(example_isolates, guideline = "EUCAST")
+#' out <- mdro(example_isolates)
 #' str(out)
 #' table(out)
 #'
-#' out <- mdro(example_isolates,
-#'   guideline = custom_mdro_guideline(
-#'     AMX == "R" ~ "Custom MDRO 1",
-#'     VAN == "R" ~ "Custom MDRO 2"
-#'   )
-#' )
+#' out <- mdro(example_isolates, guideline = "EUCAST 3.3")
 #' table(out)
 #'
 #' \donttest{
 #' if (require("dplyr")) {
-#'   example_isolates %>%
-#'     mdro() %>%
-#'     table()
-#'
 #'   # no need to define `x` when used inside dplyr verbs:
 #'   example_isolates %>%
 #'     mutate(MDRO = mdro()) %>%
-#'     pull(MDRO) %>%
-#'     table()
+#'     count(MDRO)
 #' }
 #' }
 mdro <- function(x = NULL,
-                 guideline = "CMI2012",
+                 guideline = "CMI 2012",
                  col_mo = NULL,
                  esbl = NA,
                  carbapenemase = NA,
@@ -193,13 +142,14 @@ mdro <- function(x = NULL,
                  pct_required_classes = 0.5,
                  combine_SI = TRUE,
                  verbose = FALSE,
-                 only_sir_columns = FALSE,
+                 only_sir_columns = any(is.sir(x)),
                  ...) {
   if (is_null_or_grouped_tbl(x)) {
     # when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
     # is also a fix for using a grouped df as input (i.e., a dot as first argument)
     x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
   }
+
   meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
   meet_criteria(guideline, allow_class = c("list", "character"), allow_NULL = TRUE)
   if (!is.list(guideline)) meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE)
@@ -216,8 +166,11 @@ mdro <- function(x = NULL,
   meet_criteria(verbose, allow_class = "logical", has_length = 1)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
 
-  if (!any(is_sir_eligible(x))) {
-    stop_("There were no possible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
+
+  if (isTRUE(only_sir_columns) && !any(is.sir(x))) {
+    stop_("There were no SIR columns found in the data set, despite `only_sir_columns` being `TRUE`. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
+  } else if (!isTRUE(only_sir_columns) && !any(is.sir(x)) && !any(is_sir_eligible(x))) {
+    stop_("There were no eligible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
   }
 
   # get gene values as TRUE/FALSE
@@ -349,17 +302,26 @@ mdro <- function(x = NULL,
         ))))
       }
     }
+
     if (isTRUE(verbose)) {
+      x$reason[is.na(x$reason)] <- "not covered by guideline"
+      x$microorganism <- NA_character_
+      x$guideline <- "Custom guideline"
       return(x[, c(
         "row_number",
+        "microorganism",
         "MDRO",
         "reason",
-        "columns_nonsusceptible"
-      )])
+        "all_nonsusceptible_columns",
+        "guideline"
+      ),
+      drop = FALSE
+      ])
     } else {
       return(x$MDRO)
     }
-  }
+  } # end of custom MDRO guideline
+
   guideline <- tolower(gsub("[^a-zA-Z0-9.]+", "", guideline))
   if (is.null(guideline)) {
     # default to the paper by Magiorakos et al. (2012)
@@ -369,14 +331,15 @@ mdro <- function(x = NULL,
     # turn into latest EUCAST guideline
     guideline <- "eucast3.3"
   }
-  if (guideline == "nl") {
-    guideline <- "brmo"
+  if (guideline %in% c("nl", "brmo")) {
+    # turn into latest BRMO guideline
+    guideline <- "brmo2024"
   }
   if (guideline == "de") {
     guideline <- "mrgn"
   }
   stop_ifnot(
-    guideline %in% c("brmo", "mrgn", "eucast3.1", "eucast3.2", "eucast3.3", "tb", "cmi2012"),
+    guideline %in% c("brmo2017", "brmo2024", "mrgn", "eucast3.1", "eucast3.2", "eucast3.3", "tb", "cmi2012"),
     "invalid guideline: ", guideline.bak
   )
   guideline <- list(code = guideline)
@@ -434,7 +397,7 @@ mdro <- function(x = NULL,
     guideline$version <- NA_character_
     guideline$source_url <- paste0("Antimicrobial Resistance and Infection Control 4:7, 2015; ", font_url("https://doi.org/10.1186/s13756-015-0047-6", "doi: 10.1186/s13756-015-0047-6"))
     guideline$type <- "MRGNs"
-  } else if (guideline$code == "brmo") {
+  } else if (guideline$code == "brmo2024") {
     combine_SI <- TRUE # I must not be considered resistant
     guideline$name <- "Bijzonder Resistente Micro-organismen (BRMO)"
     guideline$author <- "Samenwerkingsverband Richtlijnen Infectiepreventie (SRI)"
@@ -536,10 +499,11 @@ mdro <- function(x = NULL,
   if (!"AMP" %in% names(cols_ab) && "AMX" %in% names(cols_ab)) {
     # ampicillin column is missing, but amoxicillin is available
     if (isTRUE(info)) {
-      message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.")
+      message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.", add_fn = font_red)
     }
     cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
   }
+  cols_ab <- cols_ab[!duplicated(cols_ab)]
 
   # nolint start
   AMC <- cols_ab["AMC"]
@@ -589,6 +553,7 @@ mdro <- function(x = NULL,
   CTX <- cols_ab["CTX"]
   CTZ <- cols_ab["CTZ"]
   CXM <- cols_ab["CXM"]
+  CZA <- cols_ab["CZA"]
   CZD <- cols_ab["CZD"]
   CZO <- cols_ab["CZO"]
   CZX <- cols_ab["CZX"]
@@ -686,7 +651,6 @@ mdro <- function(x = NULL,
   abx_tb <- abx_tb[!is.na(abx_tb)]
   stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set")
   # nolint end
-
   if (isTRUE(combine_SI)) {
     search_result <- "R"
   } else {
@@ -735,7 +699,7 @@ mdro <- function(x = NULL,
     x
   }
 
-  # antibiotic classes
+  # antimicrobial classes
   # nolint start
   aminoglycosides <- c(TOB, GEN)
   cephalosporins <- c(CDZ, CAC, CEC, CFR, RID, MAN, CTZ, CZD, CZO, CDR, DIT, FEP, CAT, CFM, CMX, CMZ, DIZ, CID, CFP, CSL, CND, CTX, CTT, CTF, FOX, CPM, CPO, CPD, CPR, CRD, CFS, CPT, CAZ, CCV, CTL, CTB, CZX, BPR, CFM1, CEI, CRO, CXM, LEX, CEP, HAP, CED, LTM, LOR)
@@ -762,7 +726,7 @@ mdro <- function(x = NULL,
         ),
         stringsAsFactors = FALSE
       )
-      x[rows, "columns_nonsusceptible"] <<- vapply(
+      x[rows, "all_nonsusceptible_columns"] <<- vapply(
         FUN.VALUE = character(1),
         rows,
         function(row, group_vct = cols_ab) {
@@ -772,10 +736,10 @@ mdro <- function(x = NULL,
             function(y) y %in% search_result
           )
           paste(
-            sort(c(
-              unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
+            unique(sort(c(
+              unlist(strsplit(x[row, "all_nonsusceptible_columns", drop = TRUE], ", ", fixed = TRUE)),
               names(cols_nonsus)[cols_nonsus]
-            )),
+            ))),
             collapse = ", "
           )
         }
@@ -844,12 +808,12 @@ mdro <- function(x = NULL,
       )
 
       if (isTRUE(verbose)) {
-        x[rows, "columns_nonsusceptible"] <<- vapply(
+        x[rows, "all_nonsusceptible_columns"] <<- vapply(
           FUN.VALUE = character(1),
           rows,
           function(row, group_vct = lst_vector) {
             cols_nonsus <- vapply(FUN.VALUE = logical(1), x[row, group_vct, drop = FALSE], function(y) y %in% search_result)
-            paste(sort(names(cols_nonsus)[cols_nonsus]), collapse = ", ")
+            paste(unique(sort(names(cols_nonsus)[cols_nonsus])), collapse = ", ")
           }
         )
       }
@@ -891,7 +855,7 @@ mdro <- function(x = NULL,
   x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_)
   x$row_number <- seq_len(nrow(x))
   x$reason <- NA_character_
-  x$columns_nonsusceptible <- ""
+  x$all_nonsusceptible_columns <- ""
 
   if (guideline$code == "cmi2012") {
     # CMI, 2012 ---------------------------------------------------------------
@@ -1143,7 +1107,7 @@ mdro <- function(x = NULL,
       )
     }
 
-    # add antibiotic names of resistant ones to verbose output
+    # add antimicrobial names of resistant ones to verbose output
   }
 
   if (guideline$code == "eucast3.1") {
@@ -1507,7 +1471,7 @@ mdro <- function(x = NULL,
     x[which(x$MDRO == 3), "reason"] <- "4MRGN"
   }
 
-  if (guideline$code == "brmo") {
+  if (guideline$code == "brmo2024") {
     # Netherlands 2024 --------------------------------------------------------
     aminoglycosides <- c(GEN, TOB, AMK) # note 4: gentamicin or tobramycin or amikacin
     aminoglycosides_serratia_marcescens <- GEN # note 4: TOB and AMK do not count towards S. marcescens
@@ -1526,7 +1490,7 @@ mdro <- function(x = NULL,
     if (length(ESBLs) > 0) {
       trans_tbl(
         2, # positive, unconfirmed
-        rows = which(x$order == "Enterobacterales" & x[[ESBLs[1]]] == "R" & x[[ESBLs[2]]] == "R" & is.na(esbl)),
+        rows = which(x$order == "Enterobacterales" & col_values(x, ESBLs[1]) == "R" & col_values(x, ESBLs[2]) == "R" & is.na(esbl)),
         cols = c(AMX %or% AMP, cephalosporins_3rd),
         any_all = "all",
         reason = "Enterobacterales: potential ESBL"
@@ -1562,9 +1526,9 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      rows = which(x[[SXT]] == "R" &
-        (x[[GEN]] == "R" | x[[TOB]] == "R" | x[[AMK]] == "R") &
-        (x[[CIP]] == "R" | x[[NOR]] == "R" | x[[LVX]] == "R") &
+      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"))),
       cols = c(SXT, aminoglycosides, fluoroquinolones),
       any_all = "any",
@@ -1572,9 +1536,9 @@ mdro <- function(x = NULL,
     )
     trans_tbl(
       3,
-      rows = which(x[[SXT]] == "R" &
-        x[[GEN]] == "R" &
-        (x[[CIP]] == "R" | x[[NOR]] == "R" | x[[LVX]] == "R") &
+      rows = which(col_values(x, SXT) == "R" &
+        col_values(x, GEN) == "R" &
+        (col_values(x, CIP) == "R" | col_values(x, NOR) == "R" | col_values(x, LVX) == "R") &
         paste(x$genus, x$species) == "Serratia marcescens"),
       cols = c(SXT, aminoglycosides_serratia_marcescens, fluoroquinolones),
       any_all = "any",
@@ -1584,8 +1548,8 @@ mdro <- function(x = NULL,
     # Acinetobacter baumannii-calcoaceticus complex
     trans_tbl(
       3,
-      rows = which((x[[GEN]] == "R" | x[[TOB]] == "R" | x[[AMK]] == "R") &
-        (x[[CIP]] == "R" | x[[LVX]] == "R") &
+      rows = which((col_values(x, GEN) == "R" | col_values(x, TOB) == "R" | col_values(x, AMK) == "R") &
+        (col_values(x, CIP) == "R" | col_values(x, LVX) == "R") &
         x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"]),
       cols = c(aminoglycosides, CIP, LVX),
       any_all = "any",
@@ -1607,28 +1571,24 @@ mdro <- function(x = NULL,
     )
 
     # Pseudomonas aeruginosa
-    if (ab_missing(PIP) && !ab_missing(TZP)) {
-      # take pip/tazo if just pip is not available - many labs only test for pip/tazo because of availability on a Vitek card
-      PIP <- TZP
-    }
     x$psae <- 0
-    x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, TOB) == "R" | col_values(x, AMK) == "R"), 1, 0)
-    x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, IPM) == "R" | col_values(x, MEM) == "R"), 1, 0)
-    x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, PIP) == "R"), 1, 0)
-    x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, CAZ) == "R"), 1, 0)
-    x$psae <- x$psae + ifelse(NA_as_FALSE(col_values(x, CIP) == "R" | col_values(x, NOR) == "R" | col_values(x, LVX) == "R"), 1, 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(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)
     trans_tbl(
-      3,
+      1,
       rows = which(x$genus == "Pseudomonas" & x$species == "aeruginosa"),
-      cols = c(CAZ, CIP, GEN, IPM, MEM, TOB, PIP),
+      cols = "any",
       any_all = "all", # this will set all negatives to "guideline criteria not met" instead of "not covered by guideline"
-      reason = "P. aeruginosa: at least 3 classes contain R"
+      reason = "guideline criteria not met"
     )
     trans_tbl(
       3,
       rows = which(x$genus == "Pseudomonas" & x$species == "aeruginosa" & x$psae >= 3),
-      cols = c(CAZ, CIP, GEN, IPM, MEM, TOB, PIP),
-      any_all = "any", # this is the actual one, changing the ones with x$psae >= 3
+      cols = "any",
+      any_all = "any", # this is the actual one, overwriting the ones with x$psae >= 3
       reason = "P. aeruginosa: at least 3 classes contain R"
     )
 
@@ -1648,20 +1608,20 @@ mdro <- function(x = NULL,
       reason = "E. faecium: vanA/vanB gene + penicillin group"
     )
 
-    # Staphylococcus aureus
+    # Staphylococcus aureus complex (= aureus, argenteus or schweitzeri)
     trans_tbl(
       2,
-      rows = which(x$genus == "Staphylococcus" & x$species == "aureus" & (is.na(mecA) | is.na(mecC))),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (is.na(mecA) | is.na(mecC))),
       cols = c(AMC, TZP, FLC, OXA, FOX, FOX1),
       any_all = "any",
-      reason = "S. aureus: potential MRSA"
+      reason = "S. aureus complex: potential MRSA"
     )
     trans_tbl(
       3,
-      rows = which(x$genus == "Staphylococcus" & x$species == "aureus" & (mecA == TRUE | mecC == TRUE)),
+      rows = which(x$genus == "Staphylococcus" & x$species %in% c("aureus", "argenteus", "schweitzeri") & (mecA == TRUE | mecC == TRUE)),
       cols = "any",
       any_all = "any",
-      reason = "S. aureus: mecA/mecC gene"
+      reason = "S. aureus complex: mecA/mecC gene"
     )
 
     # Candida auris
@@ -1935,7 +1895,6 @@ mdro <- function(x = NULL,
     )
   }
 
-
   if (isTRUE(verbose)) {
     # fill in empty reasons
     x$reason[is.na(x$reason)] <- "not covered by guideline"
@@ -1943,12 +1902,14 @@ mdro <- function(x = NULL,
     # format data set
     colnames(x)[colnames(x) == col_mo] <- "microorganism"
     x$microorganism <- mo_name(x$microorganism, language = NULL)
+    x$guideline <- paste0(guideline$author, " - ", guideline$name, ", ", guideline$version, ")")
     x[, c(
       "row_number",
       "microorganism",
       "MDRO",
       "reason",
-      "columns_nonsusceptible"
+      "all_nonsusceptible_columns",
+      "guideline"
     ),
     drop = FALSE
     ]
@@ -1959,182 +1920,7 @@ mdro <- function(x = NULL,
 
 #' @rdname mdro
 #' @export
-custom_mdro_guideline <- function(..., as_factor = TRUE) {
-  meet_criteria(as_factor, allow_class = "logical", has_length = 1)
-
-  dots <- tryCatch(list(...),
-    error = function(e) "error"
-  )
-  stop_if(
-    identical(dots, "error"),
-    "rules must be a valid formula inputs (e.g., using '~'), see `?mdro`"
-  )
-  n_dots <- length(dots)
-  stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?mdro`.")
-  out <- vector("list", n_dots)
-  for (i in seq_len(n_dots)) {
-    stop_ifnot(
-      inherits(dots[[i]], "formula"),
-      "rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
-    )
-
-    # Query
-    qry <- dots[[i]][[2]]
-    if (inherits(qry, "call")) {
-      qry <- as.expression(qry)
-    }
-    qry <- as.character(qry)
-    # these will prevent vectorisation, so replace them:
-    qry <- gsub("&&", "&", qry, fixed = TRUE)
-    qry <- gsub("||", "|", qry, fixed = TRUE)
-    # support filter()-like writing: custom_mdro_guideline('CIP == "R", AMX == "S"' ~ "result 1")
-    qry <- gsub(" *, *", " & ", qry)
-    # format nicely, setting spaces around operators
-    qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
-    qry <- gsub("'", "\"", qry, fixed = TRUE)
-    out[[i]]$query <- as.expression(qry)
-
-    # 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(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
-    out[[i]]$value <- as.character(val)
-  }
-
-  names(out) <- paste0("rule", seq_len(n_dots))
-  out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list"))
-  attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value)))
-  attr(out, "as_factor") <- as_factor
-  out
-}
-
-#' @method c custom_mdro_guideline
-#' @noRd
-#' @export
-c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
-  if (length(list(...)) == 0) {
-    return(x)
-  }
-  if (!is.null(as_factor)) {
-    meet_criteria(as_factor, allow_class = "logical", has_length = 1)
-  } else {
-    as_factor <- attributes(x)$as_factor
-  }
-  for (g in list(...)) {
-    stop_ifnot(inherits(g, "custom_mdro_guideline"),
-      "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
-      call = FALSE
-    )
-    vals <- attributes(x)$values
-    if (!all(attributes(g)$values %in% vals)) {
-      vals <- unname(unique(c(vals, attributes(g)$values)))
-    }
-    attributes(g) <- NULL
-    x <- c(unclass(x), unclass(g))
-    attr(x, "values") <- vals
-  }
-  names(x) <- paste0("rule", seq_len(length(x)))
-  x <- set_clean_class(x, new_class = c("custom_mdro_guideline", "list"))
-  attr(x, "values") <- vals
-  attr(x, "as_factor") <- as_factor
-  x
-}
-
-#' @method as.list custom_mdro_guideline
-#' @noRd
-#' @export
-as.list.custom_mdro_guideline <- function(x, ...) {
-  c(x, ...)
-}
-
-#' @method print custom_mdro_guideline
-#' @export
-#' @noRd
-print.custom_mdro_guideline <- function(x, ...) {
-  cat("A set of custom MDRO rules:\n")
-  for (i in seq_len(length(x))) {
-    rule <- x[[i]]
-    rule$query <- format_custom_query_rule(rule$query)
-    cat("  ", i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then: "), font_red(rule$value), "\n", sep = "")
-  }
-  cat("  ", i + 1, ". ", font_bold("Otherwise: "), font_red(paste0("Negative")), "\n", sep = "")
-  cat("\nUnmatched rows will return ", font_red("NA"), ".\n", sep = "")
-  if (isTRUE(attributes(x)$as_factor)) {
-    cat("Results will be of class 'factor', with ordered levels: ", paste0(attributes(x)$values, collapse = " < "), "\n", sep = "")
-  } else {
-    cat("Results will be of class 'character'.\n")
-  }
-}
-
-run_custom_mdro_guideline <- function(df, guideline, info) {
-  n_dots <- length(guideline)
-  stop_if(n_dots == 0, "no custom guidelines set", call = -2)
-  out <- character(length = NROW(df))
-  reasons <- character(length = NROW(df))
-  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
-        return("error")
-      }
-    )
-    if (identical(qry, "error")) {
-      warning_("in `custom_mdro_guideline()`: rule ", i,
-        " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
-        AMR_env$err_msg,
-        call = FALSE,
-        add_fn = font_red
-      )
-      next
-    }
-    stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
-      "`) must return `TRUE` or `FALSE`, not ",
-      format_class(class(qry), plural = FALSE),
-      call = FALSE
-    )
-
-    new_mdros <- which(qry == TRUE & out == "")
-
-    if (isTRUE(info)) {
-      cat(word_wrap(
-        "- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
-        "` (", length(new_mdros), " rows matched)"
-      ), "\n", sep = "")
-    }
-    val <- guideline[[i]]$value
-    out[new_mdros] <- val
-    reasons[new_mdros] <- paste0(
-      "matched rule ",
-      gsub("rule", "", names(guideline)[i], fixed = TRUE), ": ", as.character(guideline[[i]]$query)
-    )
-  }
-  out[out == ""] <- "Negative"
-  reasons[out == "Negative"] <- "no rules matched"
-
-  if (isTRUE(attributes(guideline)$as_factor)) {
-    out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
-  }
-
-  columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
-  columns_nonsusceptible <- vapply(
-    FUN.VALUE = character(1),
-    columns_nonsusceptible,
-    function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ")
-  )
-  columns_nonsusceptible[is.na(out)] <- NA_character_
-
-  data.frame(
-    row_number = seq_len(NROW(df)),
-    MDRO = out,
-    reason = reasons,
-    columns_nonsusceptible = columns_nonsusceptible,
-    stringsAsFactors = FALSE
-  )
-}
-
-#' @rdname mdro
-#' @export
-brmo <- function(x = NULL, only_sir_columns = FALSE, ...) {
+brmo <- function(x = NULL, only_sir_columns = any(is.sir(x)), ...) {
   meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
@@ -2147,7 +1933,7 @@ brmo <- function(x = NULL, only_sir_columns = FALSE, ...) {
 
 #' @rdname mdro
 #' @export
-mrgn <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
+mrgn <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE, ...) {
   meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
@@ -2159,7 +1945,7 @@ mrgn <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
 
 #' @rdname mdro
 #' @export
-mdr_tb <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
+mdr_tb <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE, ...) {
   meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
@@ -2171,19 +1957,19 @@ mdr_tb <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
 
 #' @rdname mdro
 #' @export
-mdr_cmi2012 <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
+mdr_cmi2012 <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE, ...) {
   meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(
     "guideline" %in% names(list(...)),
     "argument `guideline` must not be set since this is a guideline-specific function"
   )
-  mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "CMI2012", ...)
+  mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "CMI 2012", ...)
 }
 
 #' @rdname mdro
 #' @export
-eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = FALSE, verbose = FALSE, ...) {
+eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = any(is.sir(x)), verbose = FALSE, ...) {
   meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   stop_if(

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

@@ -422,7 +422,8 @@ all_valid_mics <- function(x) {
   !any(is.na(x_mic)) && !all(is.na(x))
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mic)
 pillar_shaft.mic <- function(x, ...) {
   if (!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
     warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
@@ -431,15 +432,22 @@ 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))))
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mic)
 type_sum.mic <- function(x, ...) {
   if (!identical(levels(x), VALID_MIC_LEVELS)) {
     paste0("mic", AMR_env$sup_1_icon)
@@ -582,7 +590,8 @@ hist.mic <- function(x, ...) {
   hist(log2(x))
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(skimr::get_skimmers, mic)
 get_skimmers.mic <- function(column) {
   column <- as.mic(column) # make sure that currently implemented MIC levels are used
   skimr::sfl(

R/mo.R

@@ -276,12 +276,17 @@ as.mo <- function(x,
     AMR_env$mo_failures <- NULL
 
     # Laboratory systems: remove (translated) entries like "no growth", "not E. coli", etc.
-    x[trimws2(x) %like% translate_into_language("no .*growth", language = language)] <- NA_character_
-    x[trimws2(x) %like% paste0("^(", translate_into_language("no|not", language = language), ") ")] <- NA_character_
+    x[trimws2(x) %like% translate_AMR("no .*growth", language = language)] <- NA_character_
+    x[trimws2(x) %like% paste0("^(", translate_AMR("no|not", language = language), ") ")] <- NA_character_
 
     # groups are in our taxonomic table with a capital G
     x <- gsub(" group( |$)", " Group\\1", x, perl = TRUE)
 
+    # convert translations
+    x[x %like_case% "enter[o\u00F6]?[ck]o[ck](ken)?$"] <- gsub("(.* )?enter[o\u00F6]?[ck]o[ck](ken)?$", "enterococcus", x[x %like_case% "enter[o\u00F6]?[ck]o[ck](ken)?$"], perl = TRUE)
+    x[x %like_case% "strept[o\u00F6]?[ck]o[ck](ken)?$"] <- gsub("(.* )?strept[o\u00F6]?[ck]o[ck](ken)?$", "streptococcus", x[x %like_case% "strept[o\u00F6]?[ck]o[ck](ken)?$"], perl = TRUE)
+    x[x %like_case% "staph[yij]?[lo]*[ck]o[ck](ken)?$"] <- gsub("(.* )?staph[yij]?[lo]*[ck]o[ck](ken)?$", "staphylococcus", x[x %like_case% "staph[yij]?[lo]*[ck]o[ck](ken)?$"], perl = TRUE)
+
     # run over all unique leftovers
     x_unique <- unique(x[is.na(out) & !is.na(x)])
 
@@ -620,7 +625,8 @@ mo_cleaning_regex <- function() {
 
 # UNDOCUMENTED METHODS ----------------------------------------------------
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, mo)
 pillar_shaft.mo <- function(x, ...) {
   add_MO_lookup_to_AMR_env()
   out <- trimws(format(x))
@@ -690,12 +696,14 @@ pillar_shaft.mo <- function(x, ...) {
   )
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, mo)
 type_sum.mo <- function(x, ...) {
   "mo"
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
 freq.mo <- function(x, ...) {
   x_noNA <- as.mo(x[!is.na(x)]) # as.mo() to get the newest mo codes
   grams <- mo_gramstain(x_noNA, language = NULL)
@@ -736,7 +744,8 @@ freq.mo <- function(x, ...) {
   )
 }
 
-# will be exported using s3_register() in R/zzz.R
+# 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) {
   skimr::sfl(
     skim_type = "mo",
@@ -1061,6 +1070,8 @@ convert_colloquial_input <- function(x) {
   out[x %like_case% "mil+er+i gr"] <- "B_STRPT_MILL"
   out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
   out[x %like_case% "(viridans.* (strepto|^s).*|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
+  out[x %like_case% "meningo[ck]o[ck](ken)?$"] <- "B_NESSR_MNNG"
+  out[x %like_case% "pneumo[ck]o[ck](ken)?$"] <- "B_STRPT_PNMN"
 
   # Salmonella in different languages, like "Salmonella grupo B"
   out[x %like_case% "salmonella.* [abcdefgh]$"] <- gsub(".*salmonella.* ([abcdefgh])$",
@@ -1175,7 +1186,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

@@ -90,6 +90,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",
@@ -146,7 +150,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()
 #' }
 #' if (require("ggplot2")) {
@@ -158,7 +162,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))
 #' }
 #'
@@ -191,7 +195,7 @@
 #'     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
@@ -377,6 +381,8 @@ 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 +391,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 +413,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 +422,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 +430,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 +447,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 +476,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 +509,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 +526,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 +569,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 +604,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 +619,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)
 
@@ -613,7 +642,8 @@ barplot.mic <- function(height,
 
 #' @method autoplot mic
 #' @rdname plot
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, mic)
 autoplot.mic <- function(object,
                          mo = NULL,
                          ab = NULL,
@@ -621,7 +651,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),
@@ -634,7 +669,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)
 
@@ -645,6 +680,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(
@@ -664,12 +701,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"
       ),
@@ -683,10 +722,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 +
@@ -708,7 +747,8 @@ autoplot.mic <- function(object,
 
 #' @method fortify mic
 #' @noRd
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, mic)
 fortify.mic <- function(object, ...) {
   object <- as.mic(object) # make sure that currently implemented MIC levels are used
   stats::setNames(
@@ -729,7 +769,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),
@@ -741,14 +786,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(
@@ -781,12 +824,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)) {
@@ -816,7 +863,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,
                          ...) {
@@ -826,7 +878,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)
 
@@ -847,7 +899,8 @@ barplot.disk <- function(height,
 
 #' @method autoplot disk
 #' @rdname plot
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, disk)
 autoplot.disk <- function(object,
                           mo = NULL,
                           ab = NULL,
@@ -855,7 +908,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),
@@ -868,7 +926,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)
 
@@ -879,6 +937,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,
@@ -896,10 +956,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(
@@ -917,10 +977,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 +
@@ -942,7 +1002,8 @@ autoplot.disk <- function(object,
 
 #' @method fortify disk
 #' @noRd
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, disk)
 fortify.disk <- function(object, ...) {
   stats::setNames(
     as.data.frame(plotrange_as_table(object, expand = FALSE)),
@@ -1020,22 +1081,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)
@@ -1055,19 +1120,25 @@ barplot.sir <- function(height,
 
 #' @method autoplot sir
 #' @rdname plot
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, sir)
 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
@@ -1076,9 +1147,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")
@@ -1090,9 +1159,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
     ) +
@@ -1102,7 +1171,8 @@ autoplot.sir <- function(object,
 
 #' @method fortify sir
 #' @noRd
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, sir)
 fortify.sir <- function(object, ...) {
   stats::setNames(
     as.data.frame(table(object)),
@@ -1217,9 +1287,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"
@@ -1278,10 +1348,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.")
@@ -1290,67 +1365,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
@@ -1429,3 +1485,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/resistance_predict.R

@@ -401,7 +401,8 @@ ggplot_sir_predict <- function(x,
 
 #' @method autoplot resistance_predict
 #' @rdname resistance_predict
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, resistance_predict)
 autoplot.resistance_predict <- function(object,
                                         main = paste("Resistance Prediction of", x_name),
                                         ribbon = TRUE,
@@ -414,7 +415,8 @@ autoplot.resistance_predict <- function(object,
 
 #' @method fortify resistance_predict
 #' @noRd
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(ggplot2::fortify, resistance_predict)
 fortify.resistance_predict <- function(model, data, ...) {
   as.data.frame(model)
 }

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,9 +161,9 @@
 #'
 #' 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% invalid antimicrobial interpretations (not S and/or I and/or R and/or NI and/or SDD), 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.
+#' 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:
 #' In 2019, the European Committee on Antimicrobial Susceptibility Testing (EUCAST) has decided to change the definitions of susceptibility testing categories S, I, and R (<https://www.eucast.org/newsiandr>).
 #'
@@ -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
@@ -380,26 +385,15 @@ as.sir <- function(x, ...) {
   UseMethod("as.sir")
 }
 
-as_sir_structure <- function(x,
-                             guideline = NULL,
-                             mo = NULL,
-                             ab = NULL,
-                             method = NULL,
-                             ref_tbl = NULL,
-                             ref_breakpoints = NULL) {
-  out <- structure(
+as_sir_structure <- function(x) {
+  int <- attr(x, "interpretation_details")
+  structure(
     factor(as.character(unlist(unname(x))),
       levels = c("S", "SDD", "I", "R", "NI"),
       ordered = TRUE
     ),
-    # TODO for #170
-    # guideline = guideline,
-    # mo = mo,
-    # ab = ab,
-    # method = method,
-    # ref_tbl = ref_tbl,
-    # ref_breakpoints = ref_breakpoints,
-    class = c("sir", "ordered", "factor")
+    interpretation_details = int,
+    class = c(if (!is.null(int)) "interpreted_sir" else NULL, "sir", "ordered", "factor")
   )
 }
 
@@ -445,9 +439,9 @@ is_sir_eligible <- function(x, threshold = 0.05) {
   %in% class(x))) {
     # no transformation needed
     return(FALSE)
-  } else if (all(x %in% c("S", "SDD", "I", "R", "NI", NA)) & !all(is.na(x))) {
+  } else if (!all(is.na(x)) && all(x %in% c("S", "SDD", "I", "R", "NI", NA, "s", "sdd", "i", "r", "ni"))) {
     return(TRUE)
-  } else if (!any(c("S", "SDD", "I", "R", "NI") %in% x, na.rm = TRUE) & !all(is.na(x))) {
+  } else if (!all(is.na(x)) && !any(c("S", "SDD", "I", "R", "NI") %in% gsub("([SIR])\\1+", "\\1", gsub("[^A-Z]", "", toupper(unique(x[1:10000])), perl = TRUE), perl = TRUE), na.rm = TRUE)) {
     return(FALSE)
   } else {
     x <- x[!is.na(x) & !is.null(x) & !x %in% c("", "-", "NULL")]
@@ -722,8 +716,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 +806,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 +857,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 +1129,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 +1546,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]
     }
 
@@ -1645,32 +1638,31 @@ as_sir_method <- function(method_short,
         breakpoint_S_R = vectorise_log_entry(NA_character_, length(rows)),
         stringsAsFactors = FALSE
       )
+      attr(new_sir, "interpretation_details") <- out
       out <- subset(out, !is.na(input_given))
       AMR_env$sir_interpretation_history <- rbind_AMR(AMR_env$sir_interpretation_history, out)
       notes <- c(notes, notes_current)
+      df[rows, "result"] <- new_sir
       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 +1674,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 +1697,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 +1705,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 +1756,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 +1795,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
@@ -1819,6 +1818,7 @@ as_sir_method <- function(method_short,
         breakpoint_S_R = vectorise_log_entry(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
         stringsAsFactors = FALSE
       )
+      attr(new_sir, "interpretation_details") <- out
       out <- subset(out, !is.na(input_given))
       AMR_env$sir_interpretation_history <- rbind_AMR(AMR_env$sir_interpretation_history, out)
     }
@@ -1863,20 +1863,33 @@ as_sir_method <- function(method_short,
   new_part <- new_part[order(new_part$index), , drop = FALSE]
   AMR_env$sir_interpretation_history <- rbind_AMR(old_part, new_part)
 
-  df$result
+  as_sir_structure(df$result)
 }
 
 #' @rdname as.sir
+#' @param sir_values SIR values that were interpreted from MIC or disk diffusion values using [as.sir()].
 #' @param clean A [logical] to indicate whether previously stored results should be forgotten after returning the 'logbook' with results.
 #' @export
-sir_interpretation_history <- function(clean = FALSE) {
+sir_interpretation_history <- function(sir_values = NULL, clean = FALSE) {
+  # for AMR v3.0.0 and lower, the first argument was `clean`, so allow `sir_interpretation_history(TRUE)` to keep working
+  if (is.logical(sir_values) && missing(clean)) {
+    clean <- sir_values
+    sir_values <- NULL
+    warning_("For `sir_interpretation_history()`, the `clean` argument is no longer the first argument, please update your code to explicitly state 'clean': `sir_interpretation_history(clean = ", clean, ")`.")
+  }
+  meet_criteria(sir_values, allow_class = "sir", allow_NULL = TRUE)
   meet_criteria(clean, allow_class = "logical", has_length = 1)
-  out <- AMR_env$sir_interpretation_history
-  out <- out[which(!is.na(out$datetime)), , drop = FALSE]
-  out$outcome <- as.sir(out$outcome)
-  out$site <- as.character(out$site)
-  if (isTRUE(clean)) {
-    AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
+
+  if (!is.null(sir_values)) {
+    out <- attr(sir_values, "interpretation_details")
+  } else {
+    out <- AMR_env$sir_interpretation_history
+    out <- out[which(!is.na(out$datetime)), , drop = FALSE]
+    out$outcome <- as.sir(out$outcome)
+    out$site <- as.character(out$site)
+    if (isTRUE(clean)) {
+      AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
+    }
   }
   if (pkg_is_available("tibble")) {
     out <- import_fn("as_tibble", "tibble")(out)
@@ -1896,28 +1909,31 @@ print.sir_log <- function(x, ...) {
   print(x, ...)
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::pillar_shaft, sir)
 pillar_shaft.sir <- function(x, ...) {
   out <- trimws(format(x))
   if (has_colour()) {
     # 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("  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)
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(pillar::type_sum, sir)
 type_sum.sir <- function(x, ...) {
   "sir"
 }
 
-# will be exported using s3_register() in R/zzz.R
+# this prevents the requirement for putting the dependency in Imports:
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
 freq.sir <- function(x, ...) {
   x_name <- deparse(substitute(x))
   x_name <- gsub(".*[$]", "", x_name)
@@ -1960,8 +1976,8 @@ freq.sir <- function(x, ...) {
   }
 }
 
-
-# will be exported using s3_register() in R/zzz.R
+# 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) {
@@ -1997,21 +2013,60 @@ get_skimmers.sir <- function(column) {
 #' @export
 #' @noRd
 print.sir <- function(x, ...) {
-  x_name <- deparse(substitute(x))
   cat("Class 'sir'\n")
-  # TODO for #170
-  # if (!is.null(attributes(x)$guideline) && !all(is.na(attributes(x)$guideline))) {
-  #   cat(font_blue(word_wrap("These values were interpreted using ",
-  #                           font_bold(vector_and(attributes(x)$guideline, quotes = FALSE)),
-  #                           " based on ",
-  #                           vector_and(attributes(x)$method, quotes = FALSE),
-  #                           " values. ",
-  #                           "Use `sir_interpretation_history(", x_name, ")` to return a full logbook.")))
-  #   cat("\n")
-  # }
   print(as.character(x), quote = FALSE)
 }
 
+#' @method print interpreted_sir
+#' @export
+#' @noRd
+print.interpreted_sir <- function(x, ...) {
+  cat("Class 'sir'\n")
+  print(as.character(x), quote = FALSE)
+
+  if (length(x) == 0) {
+    return(invisible())
+  }
+
+  int <- attr(x, "interpretation_details")
+  if (NROW(int) == 0) {
+    if (length(x) == 1) {
+      cat(font_blue(word_wrap("Source data were lost for this interpreted value.")))
+    } else {
+      cat(font_blue(word_wrap("Source data were lost for these interpreted values.")))
+    }
+  } else {
+    relevant_cols <- int[, c("guideline", "method", "ab", "mo"), drop = FALSE]
+    relevant_cols <- unique(relevant_cols)
+    vals1_plural <- ifelse(length(x) == 1, "This value was", "These values were")
+    vals2_plural <- ifelse(length(x) == 1, "value", "values")
+    method_fn <- ifelse(relevant_cols$method == "MIC", "MIC", "disk diffusion")
+    if (NROW(relevant_cols) == 1) {
+      in_host <- ifelse(relevant_cols$host == "human", "", paste0(" in ", relevant_cols$host))
+      cat(font_blue(word_wrap(
+        vals1_plural, " interpreted using ",
+        relevant_cols$guideline,
+        " based on the ",
+        method_fn,
+        " ", vals2_plural, " for ",
+        ab_name(relevant_cols$ab, language = NULL, info = FALSE, tolower = TRUE), " in ",
+        italicise_taxonomy(mo_name(relevant_cols$mo, language = NULL, info = FALSE), type = "ansi"),
+        in_host,
+        "."
+      )))
+    } else {
+      cat(font_blue(word_wrap(
+        vals1_plural, " interpreted using ",
+        vector_and(relevant_cols$guideline, quotes = FALSE),
+        " based on ",
+        vector_and(method_fn, quotes = FALSE),
+        " ", vals2_plural, "."
+      )))
+    }
+    cat(font_blue(word_wrap("\nUse `sir_interpretation_history()` on this object to return a full logbook.\n")))
+  }
+}
+
 
 #' @method as.double sir
 #' @export
@@ -2067,51 +2122,132 @@ summary.sir <- function(object, ...) {
   value
 }
 
+#' @method [ sir
+#' @export
+#' @noRd
+"[.sir" <- function(x, ...) {
+  y <- NextMethod()
+  det <- attr(x, "interpretation_details")
+  if (!is.null(det)) {
+    subset_idx <- seq_along(x)[...]
+    # safer than relying on implicit eval inside NextMethod()
+    attr(y, "interpretation_details") <- det[subset_idx, , drop = FALSE]
+  }
+  y
+}
+#' @method [[ sir
+#' @export
+#' @noRd
+"[[.sir" <- function(x, i, ...) {
+  if (length(i) != 1L) {
+    stop("attempt to select more than one element with [[.", call. = FALSE)
+  }
+  x[i] # calls `[.sir`, ensures attr alignment
+}
+
 #' @method [<- sir
 #' @export
 #' @noRd
 "[<-.sir" <- function(i, j, ..., value) {
   value <- as.sir(value)
   y <- NextMethod()
-  attributes(y) <- attributes(i)
+
+  old_det <- attr(i, "interpretation_details")
+  new_det <- attr(value, "interpretation_details")
+
+  len_y <- length(y)
+
+  # Neither i nor value have details -> do nothing
+  if (is.null(old_det) && is.null(new_det)) {
+    return(y)
+  }
+
+  # Start building full_det as copy of old_det or empty
+  full_det <- if (!is.null(old_det)) old_det else data.frame(row = seq_along(i))
+
+  # Ensure full_det has correct row count and order
+  if (nrow(full_det) != length(i)) {
+    attr(y, "interpretation_details") <- NULL
+    return(y)
+  }
+
+  # Which rows are being assigned?
+  assign_idx <- if (missing(j)) seq_along(i) else j
+  assign_idx <- as.integer(assign_idx)
+
+  # If new_det is missing or too short, fill it
+  if (is.null(new_det)) {
+    new_det <- data.frame(row = assign_idx)
+  } else if (nrow(new_det) != length(value)) {
+    new_det <- data.frame(row = assign_idx)
+  }
+
+  # Add temporary .row to track positions
+  full_det$.row <- seq_len(nrow(full_det))
+  new_det$.row <- assign_idx
+
+  # Replace old rows with new rows
+  full_det <- rbind(
+    subset(full_det, !.row %in% assign_idx),
+    new_det
+  )
+  full_det <- full_det[order(full_det$.row), , drop = FALSE]
+  full_det$.row <- NULL
+
+  # Clean up: ensure right number of rows
+  if (nrow(full_det) == len_y) {
+    attr(y, "interpretation_details") <- full_det
+  } else {
+    attr(y, "interpretation_details") <- NULL
+  }
+
   y
 }
 #' @method [[<- sir
 #' @export
 #' @noRd
 "[[<-.sir" <- function(i, j, ..., value) {
-  value <- as.sir(value)
-  y <- NextMethod()
-  attributes(y) <- attributes(i)
-  y
+  if (!is.null(det) && length(i) == 1 && nrow(det) >= i) {
+    i[j] <- value
+    i
+  } else {
+    NextMethod()
+  }
 }
 #' @method c sir
 #' @export
 #' @noRd
-c.sir <- function(...) {
-  lst <- list(...)
+c.sir <- function(..., recursive = FALSE) {
+  lst <- lapply(
+    list(...),
+    function(x) {
+      list(
+        values = as.character(x),
+        interpretation_details = attr(x, "interpretation_details")
+      )
+    }
+  )
+  x <- unlist(lapply(lst, `[[`, "values"), use.names = FALSE)
+  details <- lapply(lst, `[[`, "interpretation_details")
+  has_details <- vapply(details, is.data.frame, logical(1))
+  if (!any(has_details)) {
+    return(as_sir_structure(x))
+  }
 
-  # TODO for #170
-  # guideline <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$guideline %or% NA_character_)
-  # mo <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$mo %or% NA_character_)
-  # ab <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ab %or% NA_character_)
-  # method <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$method %or% NA_character_)
-  # ref_tbl <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_tbl %or% NA_character_)
-  # ref_breakpoints <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_breakpoints %or% NA_character_)
+  # Pre-allocate details (no Map, no matrix allocation)
+  combined_details <- do.call(rbind, lapply(seq_along(details), function(i) {
+    d <- details[[i]]
+    if (is.null(d)) {
+      # generate NA rows of correct length, but fast
+      n <- length(details[[i]])
+      as.data.frame(matrix(NA, nrow = n, ncol = 0))
+    } else {
+      d
+    }
+  }))
 
-  out <- as.sir(unlist(lapply(list(...), as.character)))
-
-  # TODO for #170
-  # if (!all(is.na(guideline))) {
-  #   attributes(out)$guideline <- guideline
-  #   attributes(out)$mo <- mo
-  #   attributes(out)$ab <- ab
-  #   attributes(out)$method <- method
-  #   attributes(out)$ref_tbl <- ref_tbl
-  #   attributes(out)$ref_breakpoints <- ref_breakpoints
-  # }
-
-  out
+  attr(x, "interpretation_details") <- combined_details
+  as_sir_structure(x)
 }
 
 #' @method unique sir

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

@@ -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,10 +30,70 @@
 # 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
 
+# LIST ALL EXPORTS
+# this prevents the requirement for putting `vctrs` as a the dependency in Imports
+
+# (NOTE 2024-02-22 this is the right way - it should be 2 '.'-separated S3 classes in the second argument)
+# S3: amr_selector
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.amr_selector)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector.character)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.amr_selector)
+# S3: amr_selector_any_all
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, logical.amr_selector_any_all)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, amr_selector_any_all.logical)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, logical.amr_selector_any_all)
+# S3: ab
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, ab.ab)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.ab)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, ab.character)
+# S3: av
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, av.av)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.av)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, av.character)
+# S3: mo
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mo.mo)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mo)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mo.character)
+# S3: disk
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_full, disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype_abbr, disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, disk.disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.integer)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.double)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.disk)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, disk.character)
+# S3: mic
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, mic.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, double.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, integer.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, factor.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.character)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.double)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.integer)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.factor)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, mic.mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_math, mic)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_arith, mic)
+# S3: sir
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.default)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, sir.sir)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_ptype2, character.sir)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, character.sir)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.character)
+#' @rawNamespace if(getRversion() >= "3.0.0") S3method(vctrs::vec_cast, sir.sir)
+
 # S3: amr_selector ----
 # this does not need a .default method since it's used internally only
 vec_ptype2.character.amr_selector <- function(x, y, ...) {

R/zz_deprecated.R

@@ -35,10 +35,35 @@
 #' @rdname AMR-deprecated
 NULL
 
-#' @rdname AMR-deprecated
-#' @usage NULL
+.amr_deprecation_warn <- function() {
+  deprecation_warning(old = "antibiotics", new = "antimicrobials", is_dataset = TRUE)
+  invisible(NULL)
+}
 #' @export
-"antibiotics"
+`[.deprecated_amr_dataset` <- function(x, ...) {
+  .amr_deprecation_warn()
+  NextMethod("[")
+}
+#' @export
+`[[.deprecated_amr_dataset` <- function(x, ...) {
+  .amr_deprecation_warn()
+  NextMethod("[[")
+}
+#' @export
+`$.deprecated_amr_dataset` <- function(x, name) {
+  .amr_deprecation_warn()
+  NextMethod("$")
+}
+#' @export
+print.deprecated_amr_dataset <- function(x, ...) {
+  .amr_deprecation_warn()
+  NextMethod("print")
+}
+#' @export
+as.data.frame.deprecated_amr_dataset <- function(x, ...) {
+  .amr_deprecation_warn()
+  NextMethod("as.data.frame")
+}
 
 # REMEMBER to search for `deprecation_warning` in the package code to find all instances.
 # currently deprecated arguments at least:

R/zzz.R

@@ -94,106 +94,6 @@ AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
 AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
 
 .onLoad <- function(libname, pkgname) {
-  # Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
-  # without the need to depend on other packages. This was suggested by the
-  # developers of the vctrs package:
-  # https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
-  s3_register("pillar::pillar_shaft", "ab")
-  s3_register("pillar::pillar_shaft", "av")
-  s3_register("pillar::pillar_shaft", "mo")
-  s3_register("pillar::pillar_shaft", "sir")
-  s3_register("pillar::pillar_shaft", "mic")
-  s3_register("pillar::pillar_shaft", "disk")
-  # no type_sum of disk, that's now in vctrs::vec_ptype_full
-  s3_register("pillar::type_sum", "ab")
-  s3_register("pillar::type_sum", "av")
-  s3_register("pillar::type_sum", "mo")
-  s3_register("pillar::type_sum", "sir")
-  s3_register("pillar::type_sum", "mic")
-  s3_register("pillar::tbl_sum", "antibiogram")
-  s3_register("pillar::tbl_format_footer", "antibiogram")
-  # Support for frequency tables from the cleaner package
-  s3_register("cleaner::freq", "mo")
-  s3_register("cleaner::freq", "sir")
-  # Support for skim() from the skimr package
-  if (pkg_is_available("skimr", min_version = "2.0.0")) {
-    s3_register("skimr::get_skimmers", "mo")
-    s3_register("skimr::get_skimmers", "sir")
-    s3_register("skimr::get_skimmers", "mic")
-    s3_register("skimr::get_skimmers", "disk")
-  }
-  # Support for autoplot() from the ggplot2 package
-  s3_register("ggplot2::autoplot", "sir")
-  s3_register("ggplot2::autoplot", "mic")
-  s3_register("ggplot2::autoplot", "disk")
-  s3_register("ggplot2::autoplot", "resistance_predict")
-  s3_register("ggplot2::autoplot", "antibiogram")
-  # Support for fortify from the ggplot2 package
-  s3_register("ggplot2::fortify", "sir")
-  s3_register("ggplot2::fortify", "mic")
-  s3_register("ggplot2::fortify", "disk")
-  # Support for knitr (R Markdown/Quarto)
-  s3_register("knitr::knit_print", "antibiogram")
-  s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
-  # Support vctrs package for use in e.g. dplyr verbs
-  # (NOTE 2024-02-22 this is the right way - it should be 2 '.'-separated S3 classes in the second argument)
-  # S3: amr_selector
-  s3_register("vctrs::vec_ptype2", "character.amr_selector")
-  s3_register("vctrs::vec_ptype2", "amr_selector.character")
-  s3_register("vctrs::vec_cast", "character.amr_selector")
-  # S3: amr_selector_any_all
-  s3_register("vctrs::vec_ptype2", "logical.amr_selector_any_all")
-  s3_register("vctrs::vec_ptype2", "amr_selector_any_all.logical")
-  s3_register("vctrs::vec_cast", "logical.amr_selector_any_all")
-  # S3: ab
-  s3_register("vctrs::vec_ptype2", "ab.default")
-  s3_register("vctrs::vec_ptype2", "ab.ab")
-  s3_register("vctrs::vec_cast", "character.ab")
-  s3_register("vctrs::vec_cast", "ab.character")
-  # S3: av
-  s3_register("vctrs::vec_ptype2", "av.default")
-  s3_register("vctrs::vec_ptype2", "av.av")
-  s3_register("vctrs::vec_cast", "character.av")
-  s3_register("vctrs::vec_cast", "av.character")
-  # S3: mo
-  s3_register("vctrs::vec_ptype2", "mo.default")
-  s3_register("vctrs::vec_ptype2", "mo.mo")
-  s3_register("vctrs::vec_cast", "character.mo")
-  s3_register("vctrs::vec_cast", "mo.character")
-  # S3: disk
-  s3_register("vctrs::vec_ptype_full", "disk")
-  s3_register("vctrs::vec_ptype_abbr", "disk")
-  s3_register("vctrs::vec_ptype2", "disk.default")
-  s3_register("vctrs::vec_ptype2", "disk.disk")
-  s3_register("vctrs::vec_cast", "disk.disk")
-  s3_register("vctrs::vec_cast", "integer.disk")
-  s3_register("vctrs::vec_cast", "disk.integer")
-  s3_register("vctrs::vec_cast", "double.disk")
-  s3_register("vctrs::vec_cast", "disk.double")
-  s3_register("vctrs::vec_cast", "character.disk")
-  s3_register("vctrs::vec_cast", "disk.character")
-  # S3: mic
-  s3_register("vctrs::vec_ptype2", "mic.default")
-  s3_register("vctrs::vec_ptype2", "mic.mic")
-  s3_register("vctrs::vec_cast", "character.mic")
-  s3_register("vctrs::vec_cast", "double.mic")
-  s3_register("vctrs::vec_cast", "integer.mic")
-  s3_register("vctrs::vec_cast", "factor.mic")
-  s3_register("vctrs::vec_cast", "mic.character")
-  s3_register("vctrs::vec_cast", "mic.double")
-  s3_register("vctrs::vec_cast", "mic.integer")
-  s3_register("vctrs::vec_cast", "mic.factor")
-  s3_register("vctrs::vec_cast", "mic.mic")
-  s3_register("vctrs::vec_math", "mic")
-  s3_register("vctrs::vec_arith", "mic")
-  # S3: sir
-  s3_register("vctrs::vec_ptype2", "sir.default")
-  s3_register("vctrs::vec_ptype2", "sir.sir")
-  s3_register("vctrs::vec_ptype2", "character.sir")
-  s3_register("vctrs::vec_cast", "character.sir")
-  s3_register("vctrs::vec_cast", "sir.character")
-  s3_register("vctrs::vec_cast", "sir.sir")
-
   # if mo source exists, fire it up (see mo_source())
   if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
     try(invisible(get_mo_source()), silent = TRUE)
@@ -210,14 +110,6 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
     AB_LOOKUP <- create_AB_AV_lookup(AMR::antimicrobials)
   }
 
-  # deprecated antibiotics data set
-  makeActiveBinding("antibiotics", function() {
-    if (interactive()) {
-      deprecation_warning(old = "antibiotics", new = "antimicrobials", is_dataset = TRUE)
-    }
-    AMR::antimicrobials
-  }, env = asNamespace(pkgname))
-
   AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP)
   AMR_env$AV_lookup <- cbind(AMR::antivirals, AV_LOOKUP)
 }
@@ -235,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))
       )
     }
   }
@@ -251,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))
       )
     }
   }

_pkgdown.yml

@@ -89,7 +89,7 @@ navbar:
         href: "articles/PCA.html"
       - text: "Determine Multi-Drug Resistance (MDR)"
         icon: "fa-skull-crossbones"
-        href: "articles/MDR.html"
+        href: "reference/mdro.html"
       - text: "Work with WHONET Data"
         icon: "fa-globe-americas"
         href: "articles/WHONET.html"
@@ -184,6 +184,7 @@ reference:
     - "`first_isolate`"
     - "`key_antimicrobials`"
     - "`mdro`"
+    - "`custom_mdro_guideline`"
     - "`bug_drug_combinations`"
     - "`antimicrobial_selectors`"
     - "`top_n_microorganisms`"
@@ -233,6 +234,7 @@ reference:
     - "`antimicrobials`"
     - "`clinical_breakpoints`"
     - "`example_isolates`"
+    - "`esbl_isolates`"
     - "`microorganisms.codes`"
     - "`microorganisms.groups`"
     - "`intrinsic_resistant`"

cran-comments.md

@@ -1,5 +1,5 @@
-As with all previous >20 releases, some CHECKs might return a NOTE for *just* hitting the installation size limit, though its size has been brought down to a minimum in collaboration with CRAN maintainers previously.
+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 consider this a high-impact package: it was published in the Journal of Statistical Software (2022), is included in a CRAN Task View (Epidemiology), and is according to download stats (cranlogs) used in almost all countries in the world. If there is anything to note, please let us know up-front without directly archiving the current version. That said, we continually unit test our package extensively and have no reason to assume that anything is wrong.
+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.
 
-Thanks for maintaining and hosting CRAN! It's empowering R and its use enormously!
+Thank you for your continued maintenance of CRAN, it plays a central role in the success and growth of the R ecosystem.

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

@@ -625,6 +625,11 @@ if (changed_md5(dosage)) {
   try(arrow::write_parquet(dosage, "data-raw/datasets/dosage.parquet"), silent = TRUE)
 }
 
+# Set `antibiotics` as a deprecated data set
+antibiotics <- structure(antimicrobials, class = c("deprecated_amr_dataset", class(antimicrobials)))
+usethis::use_data(antibiotics, internal = FALSE, overwrite = TRUE, compress = "xz", version = 2)
+rm(antibiotics)
+
 suppressMessages(reset_AMR_locale())
 
 devtools::load_all(quiet = TRUE)
@@ -658,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_antimicrobials.R

@@ -948,6 +948,8 @@ get_atc_code <- function(ab) {
   # exception for imipenem
   if (ab_name == "imipenem") ab_name <- "imipenem/cilastatin"
   if (ab_name == "imipenem/relebactam") ab_name <- "imipenem/cilastatin/relebactam"
+  if (ab_name == "ceftaroline") ab_name <- "ceftaroline fosamil"
+  ab_name.bak <- ab_name
   if (ab_name %like% "/") {
     ab_name <- strsplit(ab_name, "[/ ]")[[1]]
   }
@@ -971,28 +973,33 @@ get_atc_code <- function(ab) {
   } else if (ab_name_full %like% " and " && ab_name_bla %in% atc_tbl[[2]]) {
     out <- atc_tbl[[1]][which(atc_tbl[[2]] == ab_name_bla)]
   } else {
+    if (any(atc_tbl_human$X1 %like% ab_name.bak, na.rm = TRUE)) {
+      message("returning NA, but DO MIND: ", ab_name.bak, " resembles ATC name(s) ", toString(atc_tbl_human$X1), appendLF = FALSE)
+    }
     out <- NA_character_
   }
   unique(out)
 }
 
+# update all:
+to_update <- 1:nrow(antimicrobials)
+# or just the empty ones:
+to_update <- which(sapply(antimicrobials$atc, function(x) length(x[!is.na(x)])) == 0)
+
 updated_atc <- lapply(seq_len(length(to_update)),
                       function(x) NA_character_)
 
-to_update <- 1:nrow(antimicrobials)
-# or just the empty ones:
-to_update <- which(sapply(antimicrobials$atc, length) == 0)
 
-# this takes around 10 minutes (some are skipped and go faster)
+# this takes around 10 minutes for the whole table (some ABx are skipped and go faster)
 for (i in to_update) {
-  message(percentage(i / length(updated_atc), digits = 1),
+  message(percentage(which(to_update == i) / length(updated_atc), digits = 1),
     " - Downloading ", antimicrobials$name[i],
     appendLF = FALSE
   )
   atcs <- get_atc_code(antimicrobials$name[i])
   if (length(atcs[!is.na(atcs)]) > 0) {
     updated_atc[[i]] <- atcs
-    message(" (", length(atcs[!is.na(atcs)]), " results: ", toString(atcs[!is.na(atcs)]), ")")
+    message(font_blue(paste0(" (", length(atcs[!is.na(atcs)]), " results: ", toString(atcs[!is.na(atcs)]), ")")))
     # let the WHO server rest for a second - they might have a limitation on the queries per second
     Sys.sleep(1)
   } else {
@@ -1001,7 +1008,8 @@ for (i in to_update) {
 }
 
 updated_atc <- lapply(updated_atc, function(x) sort(x[!is.na(x)]))
-antimicrobials$atc <- updated_atc
+antimicrobials$atc[to_update] <- updated_atc[to_update]
+
 # DO NOT FORGET TO UPDATE R/aa_globals.R!
 
 

data-raw/_reproduction_scripts/reproduction_of_microorganisms.R

@@ -288,7 +288,7 @@ for (page in LETTERS) {
   url <- paste0("https://lpsn.dsmz.de/genus?page=", page)
   x <- tryCatch(read_html(url),
                 error = function(e) {
-                  message("Waiting 10 seconds because of error: ", e$message)
+                  message("Waiting 10 seconds because of error: ", conditionMessage(e))
                   Sys.sleep(10)
                   read_html(url)
                 })

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 @@
-959459b92fe6ff57c02bab08381a73a8
+228840b3941753c4adee2b781d901590

data-raw/datasets/antimicrobials.txt

@@ -114,7 +114,7 @@
 "CRD"	5284529	"Cefroxadine"	"Cephalosporins (1st gen.)"	"J01DB11,QJ01DB11"	"Other beta-lactam antibacterials"	"First-generation cephalosporins"	"ceftix"	"cefroxadin,cefroxadino,cefroxadinum,oraspor"	2.1	"g"			"NA"
 "CFS"	656575	"Cefsulodin"	"Cephalosporins (3rd gen.)"	"J01DD03,QJ01DD03"	"Other beta-lactam antibacterials"	"Third-generation cephalosporins"	"cefsul,cfsl,cfsu"	"cefomonil,cefonomil,cefsulodine,cefsulodinhydrate,cefsulodino,cefsulodinum,pseudocef,pseudomonil,pyocefal,sulcephalosporin,takesulin,tilmapor,ulfaret"			4	"g"	"127-1,128-9,129-7,130-5,131-3,18892-0,25242-9,55647-2"
 "CSU"	68718	"Cefsumide"	"Cephalosporins (unclassified gen.)"	"NA"			"NA"	"cefsulmid,cefsumido,cefsumidum"					"NA"
-"CPT"	56841980	"Ceftaroline"	"Cephalosporins (5th gen.)"	"NA"			"ceftar,cfro"	"ceftaroine,teflaro,zinforo"					"73604-1,73605-8,73626-4,73627-2,73649-6,73650-4,74170-2"
+"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"
 "CZA"	90643431	"Ceftazidime/avibactam"	"Cephalosporins (3rd gen.)"	"J01DD52,QJ01DD52"			"cfav"	"avycaz,zavicefta"			6	"g"	"101483-6,73603-3,73625-6,73648-8,87734-0"

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
@@ -192,12 +192,12 @@ out %>% set_ab_names(property = "atc")
 
 This package was intended as a comprehensive toolbox for integrated AMR data analysis. This package can be used for:
 
-  * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](./reference/mo_property.html))
+  * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN](https://lpsn.dsmz.de)) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](./reference/mo_property.html))
   * Interpreting raw MIC and disk diffusion values, based on any CLSI or EUCAST guideline ([manual](./reference/as.sir.html))
   * Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records ([manual](./reference/ab_from_text.html))
   * Determining first isolates to be used for AMR data analysis ([manual](./reference/first_isolate.html))
   * Calculating antimicrobial resistance ([tutorial](./articles/AMR.html))
-  * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](./articles/MDR.html))
+  * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](./reference/mdro.html))
   * Calculating (empirical) susceptibility of both mono therapy and combination therapies ([tutorial](./articles/AMR.html))
   * Apply AMR functions in predictive modelling ([tutorial](./articles/AMR_with_tidymodels.html))
   * Getting properties for any microorganism (like Gram stain, species, genus or family) ([manual](./reference/mo_property.html))

index.md

@@ -26,10 +26,13 @@
 <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>
+
+<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>
@@ -38,7 +41,7 @@
 
 ------------------------------------------------------------------------
 
-### Introduction
+## Introduction
 
 The `AMR` package is a peer-reviewed, [free and open-source](#copyright)
 R package with [zero
@@ -75,7 +78,7 @@ research at the Faculty of Medical Sciences of the [University of
 Groningen](https://www.rug.nl) and the [University Medical Center
 Groningen](https://www.umcg.nl).
 
-##### Used in over 175 countries, available in 28 languages
+### Used in over 175 countries, available in 28 languages
 
 <a href="./countries_large.png" target="_blank"><img src="./countries.png" align="right" style="max-width: 300px;" /></a>
 
@@ -143,9 +146,9 @@ Urdu, and
 Vietnamese. Antimicrobial drug (group) names and colloquial
 microorganism names are provided in these languages.
 
-### Practical examples
+## Practical examples
 
-#### Filtering and selecting data
+### Filtering and selecting data
 
 One of the most powerful functions of this package, aside from
 calculating and plotting AMR, is selecting and filtering based on
@@ -168,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>
@@ -200,7 +203,7 @@ about [all microorganisms](./reference/microorganisms.html) and [all
 antimicrobials](./reference/antimicrobials.html) in the `AMR` package
 make sure you get what you meant.
 
-#### Generating antibiograms
+### Generating antibiograms
 
 The `AMR` package supports generating traditional, combined, syndromic,
 and even weighted-incidence syndromic combination antibiograms (WISCA).
@@ -212,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 |
@@ -261,7 +264,7 @@ antibiogram(example_isolates,
 | Грамнегативні | 96% (95-98%,N=684)  | 96% (94-97%,N=686) | 91% (88-93%,N=684) |
 | Грампозитивні | 63% (60-66%,N=1170) | 34% (31-38%,N=665) | 77% (74-80%,N=724) |
 
-#### Interpreting and plotting MIC and SIR values
+### Interpreting and plotting MIC and SIR values
 
 The `AMR` package allows interpretation of MIC and disk diffusion values
 based on CLSI and EUCAST. Moreover, the `ggplot2` package is extended
@@ -286,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
@@ -301,7 +304,7 @@ ggplot(data.frame(mic = some_mic_values,
 <img src="./plot_readme.png" style="width: 1400px; max-width: 100%;">
 </a>
 
-#### Calculating resistance per group
+### Calculating resistance per group
 
 For a manual approach, you can use the `resistance` or
 `susceptibility()` function:
@@ -318,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
@@ -337,54 +340,54 @@ 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?
+## What else can you do with this package?
 
 This package was intended as a comprehensive toolbox for integrated AMR
 data analysis. This package can be used for:
 
 - Reference for the taxonomy of microorganisms, since the package
   contains all microbial (sub)species from the List of Prokaryotic names
-  with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the
+  with Standing in Nomenclature ([LPSN](https://lpsn.dsmz.de)) and the
   Global Biodiversity Information Facility
   ([GBIF](https://www.gbif.org))
   ([manual](./reference/mo_property.html))
@@ -397,10 +400,10 @@ data analysis. This package can be used for:
   ([manual](./reference/first_isolate.html))
 - Calculating antimicrobial resistance ([tutorial](./articles/AMR.html))
 - Determining multi-drug resistance (MDR) / multi-drug resistant
-  organisms (MDRO) ([tutorial](./articles/MDR.html))
+  organisms (MDRO) ([tutorial](./reference/mdro.html))
 - Calculating (empirical) susceptibility of both mono therapy and
   combination therapies ([tutorial](./articles/AMR.html))
-- Apply AMR function in predictive modelling
+- Apply AMR functions in predictive modelling
   ([tutorial](./articles/AMR_with_tidymodels.html))
 - Getting properties for any microorganism (like Gram stain, species,
   genus or family) ([manual](./reference/mo_property.html))
@@ -420,9 +423,9 @@ data analysis. This package can be used for:
   ([link](./articles/datasets.html))
 - Principal component analysis for AMR ([tutorial](./articles/PCA.html))
 
-### Get this package
+## Get this package
 
-#### Latest official version
+### Latest official version
 
 [![CRAN](https://www.r-pkg.org/badges/version-ago/AMR)](https://cran.r-project.org/package=AMR)
 [![CRANlogs](https://cranlogs.r-pkg.org/badges/grand-total/AMR)](https://cran.r-project.org/package=AMR)
@@ -443,7 +446,7 @@ the menu *Tools* \> *Install Packages…* and then type in “AMR” and press
 latest release. To use all functions and data sets mentioned on this
 website, install the latest beta version.
 
-#### Latest beta version
+### Latest beta version
 
 [![check-old](https://github.com/msberends/AMR/actions/workflows/check-old-tinytest.yaml/badge.svg?branch=main)](https://github.com/msberends/AMR/actions/workflows/check-old-tinytest.yaml)
 [![check-recent](https://github.com/msberends/AMR/actions/workflows/check-current-testthat.yaml/badge.svg?branch=main)](https://github.com/msberends/AMR/actions/workflows/check-current-testthat.yaml)
@@ -462,13 +465,13 @@ install.packages("AMR", repos = "beta.amr-for-r.org")
 remotes::install_github("msberends/AMR")
 ```
 
-### Get started
+## Get started
 
 To find out how to conduct AMR data analysis, please [continue reading
 here to get started](./articles/AMR.html) or click a link in the [‘How
 to’ menu](./articles/).
 
-### Partners
+## Partners
 
 The initial development of this package was part of, related to, or made
 possible by the following non-profit organisations and initiatives:
@@ -483,7 +486,7 @@ possible by the following non-profit organisations and initiatives:
 
 </div>
 
-### Copyright
+## Copyright
 
 This R package is free, open-source software and licensed under the [GNU
 General Public License v2.0 (GPL-2)](./LICENSE-text.html). In a

man/AMR-deprecated.Rd

@@ -1,15 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/zz_deprecated.R
-\docType{data}
 \name{AMR-deprecated}
 \alias{AMR-deprecated}
-\alias{antibiotics}
 \alias{ab_class}
 \alias{ab_selector}
 \title{Deprecated Functions, Arguments, or Datasets}
-\format{
-An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 497 rows and 14 columns.
-}
 \usage{
 ab_class(...)
 
@@ -18,5 +13,4 @@ ab_selector(...)
 \description{
 These objects are so-called '\link{Deprecated}'. \strong{They will be removed in a future version of this package.} Using these will give a warning with the name of the alternative object it has been replaced by (if there is one).
 }
-\keyword{datasets}
 \keyword{internal}

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/amr-tidymodels.Rd

@@ -0,0 +1,125 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tidymodels.R
+\name{amr-tidymodels}
+\alias{amr-tidymodels}
+\alias{all_mic}
+\alias{all_mic_predictors}
+\alias{all_sir}
+\alias{all_sir_predictors}
+\alias{step_mic_log2}
+\alias{step_sir_numeric}
+\title{AMR Extensions for Tidymodels}
+\usage{
+all_mic()
+
+all_mic_predictors()
+
+all_sir()
+
+all_sir_predictors()
+
+step_mic_log2(recipe, ..., role = NA, trained = FALSE, columns = NULL,
+  skip = FALSE, id = recipes::rand_id("mic_log2"))
+
+step_sir_numeric(recipe, ..., role = NA, trained = FALSE, columns = NULL,
+  skip = FALSE, id = recipes::rand_id("sir_numeric"))
+}
+\arguments{
+\item{recipe}{A recipe object. The step will be added to the sequence of
+operations for this recipe.}
+
+\item{...}{One or more selector functions to choose variables for this step.
+See \code{\link[recipes:selections]{selections()}} for more details.}
+
+\item{role}{Not used by this step since no new variables are created.}
+
+\item{trained}{A logical to indicate if the quantities for preprocessing have
+been estimated.}
+
+\item{skip}{A logical. Should the step be skipped when the recipe is baked by
+\code{\link[recipes:bake]{bake()}}? While all operations are baked when \code{\link[recipes:prep]{prep()}} is run, some
+operations may not be able to be conducted on new data (e.g. processing the
+outcome variable(s)). Care should be taken when using \code{skip = TRUE} as it
+may affect the computations for subsequent operations.}
+
+\item{id}{A character string that is unique to this step to identify it.}
+}
+\description{
+This family of functions allows using AMR-specific data types such as \verb{<mic>} and \verb{<sir>} inside \code{tidymodels} pipelines.
+}
+\details{
+You can read more in our online \href{https://amr-for-r.org/articles/AMR_with_tidymodels.html}{AMR with tidymodels introduction}.
+
+Tidyselect helpers include:
+\itemize{
+\item \code{\link[=all_mic]{all_mic()}} and \code{\link[=all_mic_predictors]{all_mic_predictors()}} to select \verb{<mic>} columns
+\item \code{\link[=all_sir]{all_sir()}} and \code{\link[=all_sir_predictors]{all_sir_predictors()}} to select \verb{<sir>} columns
+}
+
+Pre-processing pipeline steps include:
+\itemize{
+\item \code{\link[=step_mic_log2]{step_mic_log2()}} to convert MIC columns to numeric (via \code{as.numeric()}) and apply a log2 transform, to be used with \code{\link[=all_mic_predictors]{all_mic_predictors()}}
+\item \code{\link[=step_sir_numeric]{step_sir_numeric()}} to convert SIR columns to numeric (via \code{as.numeric()}), to be used with \code{\link[=all_sir_predictors]{all_sir_predictors()}}: \code{"S"} = 1, \code{"I"}/\code{"SDD"} = 2, \code{"R"} = 3. All other values are rendered \code{NA}. Keep this in mind for further processing, especially if the model does not allow for \code{NA} values.
+}
+
+These steps integrate with \code{recipes::recipe()} and work like standard preprocessing steps. They are useful for preparing data for modelling, especially with classification models.
+}
+\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
+}
+}
+\seealso{
+\code{\link[recipes:recipe]{recipes::recipe()}}, \code{\link[=as.mic]{as.mic()}}, \code{\link[=as.sir]{as.sir()}}
+}
+\keyword{internal}

man/antibiogram.Rd

@@ -11,7 +11,7 @@
 \source{
 \itemize{
 \item Bielicki JA \emph{et al.} (2016). \strong{Selecting appropriate empirical antibiotic regimens for paediatric bloodstream infections: application of a Bayesian decision model to local and pooled antimicrobial resistance surveillance data} \emph{Journal of Antimicrobial Chemotherapy} 71(3); \doi{10.1093/jac/dkv397}
-\item Bielicki JA \emph{et al.} (2020). \strong{Evaluation of the coverage of 3 antibiotic regimens for neonatal sepsis in the hospital setting across Asian countries} \emph{JAMA Netw Open.} 3(2):e1921124; \doi{10.1001.jamanetworkopen.2019.21124}
+\item Bielicki JA \emph{et al.} (2020). \strong{Evaluation of the coverage of 3 antibiotic regimens for neonatal sepsis in the hospital setting across Asian countries} \emph{JAMA Netw Open.} 3(2):e1921124; \doi{10.1001/jamanetworkopen.2019.21124}
 \item Klinker KP \emph{et al.} (2021). \strong{Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms}. \emph{Therapeutic Advances in Infectious Disease}, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
 \item Barbieri E \emph{et al.} (2021). \strong{Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach} \emph{Antimicrobial Resistance & Infection Control} May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
 \item \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition}, 2022, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
@@ -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"}
@@ -163,7 +164,7 @@ Set \code{digits} (defaults to \code{0}) to alter the rounding of the susceptibi
 
 There are various antibiogram types, as summarised by Klinker \emph{et al.} (2021, \doi{10.1177/20499361211011373}), and they are all supported by \code{\link[=antibiogram]{antibiogram()}}.
 
-For clinical coverage estimations, \strong{use WISCA whenever possible}, since it provides more precise coverage estimates by accounting for pathogen incidence and antimicrobial susceptibility, as has been shown by Bielicki \emph{et al.} (2020, \doi{10.1001.jamanetworkopen.2019.21124}). See the section \emph{Explaining WISCA} on this page. Do note that WISCA is pathogen-agnostic, meaning that the outcome is not stratied by pathogen, but rather by syndrome.
+For clinical coverage estimations, \strong{use WISCA whenever possible}, since it provides more precise coverage estimates by accounting for pathogen incidence and antimicrobial susceptibility, as has been shown by Bielicki \emph{et al.} (2020, \doi{10.1001/jamanetworkopen.2019.21124}). See the section \emph{Explaining WISCA} on this page. Do note that WISCA is pathogen-agnostic, meaning that the outcome is not stratied by pathogen, but rather by syndrome.
 \enumerate{
 \item \strong{Traditional Antibiogram}
 

man/antimicrobial_selectors.Rd

@@ -131,7 +131,7 @@ not_intrinsic_resistant(only_sir_columns = FALSE, col_mo = NULL,
   version_expected_phenotypes = 1.2, ...)
 }
 \arguments{
-\item{only_sir_columns}{A \link{logical} to indicate whether only columns of class \code{sir} must be selected (default is \code{FALSE}), see \code{\link[=as.sir]{as.sir()}}.}
+\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}.}
 
 \item{only_treatable}{A \link{logical} to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is \code{TRUE}), such as gentamicin-high (\code{GEH}) and imipenem/EDTA (\code{IPE}).}
 

man/antimicrobials.Rd

@@ -3,6 +3,7 @@
 \docType{data}
 \name{antimicrobials}
 \alias{antimicrobials}
+\alias{antibiotics}
 \alias{antivirals}
 \title{Data Sets with 617 Antimicrobial Drugs}
 \format{
@@ -49,6 +50,8 @@ 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{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 120 rows and 11 columns.
 }
 \source{
@@ -61,10 +64,14 @@ An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) w
 \usage{
 antimicrobials
 
+antibiotics
+
 antivirals
 }
 \description{
 Two data sets containing all antimicrobials and antivirals. Use \code{\link[=as.ab]{as.ab()}} or one of the \code{\link[=ab_property]{ab_*}} functions to retrieve values from the \link{antimicrobials} data set. Three identifiers are included in this data set: an antimicrobial ID (\code{ab}, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (\code{atc}) as defined by the WHO, and a Compound ID (\code{cid}) as found in PubChem. Other properties in this data set are derived from one or more of these codes. Note that some drugs have multiple ATC codes.
+
+\strong{The \code{antibiotics} data set has been renamed to \code{antimicrobials}. The old name will be removed in a future version.}
 }
 \details{
 Properties that are based on an ATC code are only available when an ATC is available. These properties are: \code{atc_group1}, \code{atc_group2}, \code{oral_ddd}, \code{oral_units}, \code{iv_ddd} and \code{iv_units}. Do note that ATC codes are not unique. For example, J01CR02 is officially the ATC code for "amoxicillin and beta-lactamase inhibitor". Consequently, these two items from the \link{antimicrobials} data set both return \code{"J01CR02"}:

man/as.sir.Rd

@@ -70,12 +70,14 @@ is_sir_eligible(x, threshold = 0.05)
   language = get_AMR_locale(), verbose = FALSE, info = interactive(),
   parallel = FALSE, max_cores = -1, conserve_capped_values = NULL)
 
-sir_interpretation_history(clean = FALSE)
+sir_interpretation_history(sir_values = NULL, 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}.}
 
@@ -145,6 +147,8 @@ The default \code{"standard"} setting ensures cautious handling of uncertain val
 
 \item{max_cores}{Maximum number of cores to use if \code{parallel = TRUE}. Use a negative value to subtract that number from the available number of cores, e.g. a value of \code{-2} on an 8-core machine means that at most 6 cores will be used. Defaults to \code{-1}. There will never be used more cores than variables to analyse. The available number of cores are detected using \code{\link[parallelly:availableCores]{parallelly::availableCores()}} if that package is installed, and base \R's \code{\link[parallel:detectCores]{parallel::detectCores()}} otherwise.}
 
+\item{sir_values}{SIR values that were interpreted from MIC or disk diffusion values using \code{\link[=as.sir]{as.sir()}}.}
+
 \item{clean}{A \link{logical} to indicate whether previously stored results should be forgotten after returning the 'logbook' with results.}
 }
 \value{
@@ -247,9 +251,9 @@ 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\% invalid antimicrobial interpretations (not S and/or I and/or R and/or NI and/or SDD), 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.
+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.
 }
 
 \code{NA_sir_} is a missing value of the new \code{sir} class, analogous to e.g. base \R's \code{\link[base:NA]{NA_character_}}.
@@ -314,9 +318,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

@@ -17,9 +17,6 @@ Define custom EUCAST rules for your organisation or specific analysis and use th
 }
 \details{
 Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the \code{\link[=eucast_rules]{eucast_rules()}} function.
-}
-\section{How it works}{
-
 \subsection{Basics}{
 
 If you are familiar with the \code{\link[dplyr:case_when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde:
@@ -51,7 +48,11 @@ df
 #> 1      Escherichia coli   R    S     S
 #> 2 Klebsiella pneumoniae   R    S     S
 
-eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE, overwrite = TRUE)
+eucast_rules(df,
+             rules = "custom",
+             custom_rules = x,
+             info = FALSE,
+             overwrite = TRUE)
 #>                      mo TZP ampi cipro
 #> 1      Escherichia coli   R    R     S
 #> 2 Klebsiella pneumoniae   R    R     S
@@ -62,16 +63,27 @@ eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE, overwrite = T
 
 There is one exception in columns used for the rules: all column names of the \link{microorganisms} data set can also be used, but do not have to exist in the data set. These column names are: "mo", "fullname", "status", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", "rank", "ref", "oxygen_tolerance", "source", "lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence", and "snomed". Thus, this next example will work as well, despite the fact that the \code{df} data set does not contain a column \code{genus}:
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
-                         TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{y <- custom_eucast_rules(
+  TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
+  TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
+)
 
-eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE, overwrite = TRUE)
+eucast_rules(df,
+             rules = "custom",
+             custom_rules = y,
+             info = FALSE,
+             overwrite = TRUE)
 #>                      mo TZP ampi cipro
 #> 1      Escherichia coli   R    S     S
 #> 2 Klebsiella pneumoniae   R    R     S
 }\if{html}{\out{</div>}}
 }
 
+\subsection{Sharing rules among multiple users}{
+
+The rules set (the \code{y} object in this case) could be exported to a shared file location using \code{\link[=saveRDS]{saveRDS()}} if you collaborate with multiple users. The custom rules set could then be imported using \code{\link[=readRDS]{readRDS()}}.
+}
+
 \subsection{Usage of multiple antimicrobials and antimicrobial group names}{
 
 You can define antimicrobial groups instead of single antimicrobials for the rule consequence, which is the part \emph{after} the tilde (~). In the examples above, the antimicrobial group \code{aminopenicillins} includes both ampicillin and amoxicillin.
@@ -126,7 +138,6 @@ These 35 antimicrobial groups are allowed in the rules (case-insensitive) and ca
 }
 }
 }
-
 \examples{
 x <- custom_eucast_rules(
   AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",

man/custom_mdro_guideline.Rd

@@ -0,0 +1,157 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/custom_mdro_guideline.R
+\name{custom_mdro_guideline}
+\alias{custom_mdro_guideline}
+\alias{c.custom_mdro_guideline}
+\title{Define Custom MDRO Guideline}
+\usage{
+custom_mdro_guideline(..., as_factor = TRUE)
+
+\method{c}{custom_mdro_guideline}(x, ..., as_factor = NULL)
+}
+\arguments{
+\item{...}{Guideline rules in \link[base:tilde]{formula} notation, see below for instructions, and in \emph{Examples}.}
+
+\item{as_factor}{A \link{logical} to indicate whether the returned value should be an ordered \link{factor} (\code{TRUE}, default), or otherwise a \link{character} vector. For combining rules sets (using \code{\link[=c]{c()}}) this value will be inherited from the first set at default.}
+
+\item{x}{Existing custom MDRO rules}
+}
+\value{
+A \link{list} containing the custom rules
+}
+\description{
+Define custom a MDRO guideline for your organisation or specific analysis and use the output of this function in \code{\link[=mdro]{mdro()}}.
+}
+\details{
+Using a custom MDRO guideline is of importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
+\subsection{Basics}{
+
+If you are familiar with the \code{\link[dplyr:case_when]{case_when()}} function of the \code{dplyr} package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written \emph{before} the tilde (\code{~}) and the consequence of the rule is written \emph{after} the tilde:
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{custom <- custom_mdro_guideline(CIP == "R" & age > 60 ~ "Elderly Type A",
+                                ERY == "R" & age > 60 ~ "Elderly Type B")
+}\if{html}{\out{</div>}}
+
+If a row/an isolate matches the first rule, the value after the first \code{~} (in this case \emph{'Elderly Type A'}) will be set as MDRO value. Otherwise, the second rule will be tried and so on. The number of rules is unlimited.
+
+You can print the rules set in the console for an overview. Colours will help reading it if your console supports colours.
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{custom
+#> A set of custom MDRO rules:
+#>   1. If CIP is R and age is higher than 60 then: Elderly Type A
+#>   2. If ERY is R and age is higher than 60 then: Elderly Type B
+#>   3. Otherwise: Negative
+
+#> Unmatched rows will return NA.
+#> Results will be of class 'factor', with ordered levels: Negative < Elderly Type A < Elderly Type B
+}\if{html}{\out{</div>}}
+
+The outcome of the function can be used for the \code{guideline} argument in the \code{\link[=mdro]{mdro()}} function:
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{x <- mdro(example_isolates, guideline = custom)
+#> Determining MDROs based on custom rules, resulting in factor levels: Negative < Elderly Type A < Elderly Type B.
+#> - Custom MDRO rule 1: CIP == "R" & age > 60 (198 rows matched)
+#> - Custom MDRO rule 2: ERY == "R" & age > 60 (732 rows matched)
+#> => Found 930 custom defined MDROs out of 2000 isolates (46.5\%)
+
+table(x)
+#> x
+#>       Negative  Elderly Type A  Elderly Type B
+#>           1070             198             732
+}\if{html}{\out{</div>}}
+
+Rules can also be combined with other custom rules by using \code{\link[=c]{c()}}:
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{x <- mdro(example_isolates,
+          guideline = c(custom,
+                        custom_mdro_guideline(ERY == "R" & age > 50 ~ "Elderly Type C")))
+#> Determining MDROs based on custom rules, resulting in factor levels: Negative < Elderly Type A < Elderly Type B < Elderly Type C.
+#> - Custom MDRO rule 1: CIP == "R" & age > 60 (198 rows matched)
+#> - Custom MDRO rule 2: ERY == "R" & age > 60 (732 rows matched)
+#> - Custom MDRO rule 3: ERY == "R" & age > 50 (109 rows matched)
+#> => Found 1039 custom defined MDROs out of 2000 isolates (52.0\%)
+
+table(x)
+#> x
+#>       Negative  Elderly Type A  Elderly Type B  Elderly Type C
+#>            961             198             732             109
+}\if{html}{\out{</div>}}
+}
+
+\subsection{Sharing rules among multiple users}{
+
+The rules set (the \code{custom} object in this case) could be exported to a shared file location using \code{\link[=saveRDS]{saveRDS()}} if you collaborate with multiple users. The custom rules set could then be imported using \code{\link[=readRDS]{readRDS()}}.
+}
+
+\subsection{Usage of multiple antimicrobials and antimicrobial group names}{
+
+You can define antimicrobial groups instead of single antimicrobials for the rule itself, which is the part \emph{before} the tilde (~). Use \code{\link[=any]{any()}} or \code{\link[=all]{all()}} to specify the scope of the antimicrobial group:
+
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{custom_mdro_guideline(
+  AMX == "R"                       ~ "My MDRO #1",
+  any(cephalosporins_2nd() == "R") ~ "My MDRO #2",
+  all(glycopeptides() == "R")      ~ "My MDRO #3"
+)
+}\if{html}{\out{</div>}}
+
+All 35 antimicrobial selectors are supported for use in the rules:
+\itemize{
+\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[=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
+\item \code{\link[=cephalosporins]{cephalosporins()}} can select: \cr 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, latamoxef, and loracarbef
+\item \code{\link[=cephalosporins_1st]{cephalosporins_1st()}} can select: \cr cefacetrile, cefadroxil, cefalexin, cefaloridine, cefalotin, cefapirin, cefatrizine, cefazedone, cefazolin, cefroxadine, ceftezole, and cephradine
+\item \code{\link[=cephalosporins_2nd]{cephalosporins_2nd()}} can select: \cr cefaclor, cefamandole, cefmetazole, cefonicid, ceforanide, cefotetan, cefotiam, cefoxitin, cefoxitin screening test, cefprozil, cefuroxime, cefuroxime axetil, and loracarbef
+\item \code{\link[=cephalosporins_3rd]{cephalosporins_3rd()}} can select: \cr cefcapene, cefcapene pivoxil, cefdinir, cefditoren, cefditoren pivoxil, cefetamet, cefetamet pivoxil, cefixime, cefmenoxime, cefodizime, cefoperazone, cefoperazone/sulbactam, cefotaxime, cefotaxime screening test, cefotaxime/clavulanic acid, cefotaxime/sulbactam, cefotiam hexetil, cefovecin, cefpimizole, cefpiramide, cefpodoxime, cefpodoxime proxetil, cefpodoxime/clavulanic acid, cefsulodin, ceftazidime, ceftazidime/avibactam, ceftazidime/clavulanic acid, cefteram, cefteram pivoxil, ceftibuten, ceftiofur, ceftizoxime, ceftizoxime alapivoxil, ceftriaxone, ceftriaxone/beta-lactamase inhibitor, and latamoxef
+\item \code{\link[=cephalosporins_4th]{cephalosporins_4th()}} can select: \cr cefepime, cefepime/amikacin, cefepime/clavulanic acid, cefepime/enmetazobactam, cefepime/nacubactam, cefepime/tazobactam, cefepime/zidebactam, cefetecol, cefoselis, cefozopran, cefpirome, and cefquinome
+\item \code{\link[=cephalosporins_5th]{cephalosporins_5th()}} can select: \cr ceftaroline, ceftaroline/avibactam, ceftobiprole, ceftobiprole medocaril, and ceftolozane/tazobactam
+\item \code{\link[=fluoroquinolones]{fluoroquinolones()}} can select: \cr besifloxacin, ciprofloxacin, ciprofloxacin/metronidazole, ciprofloxacin/ornidazole, ciprofloxacin/tinidazole, clinafloxacin, danofloxacin, delafloxacin, difloxacin, enoxacin, enrofloxacin, finafloxacin, fleroxacin, garenoxacin, gatifloxacin, gemifloxacin, grepafloxacin, lascufloxacin, levofloxacin, levofloxacin/ornidazole, levonadifloxacin, lomefloxacin, marbofloxacin, metioxate, miloxacin, moxifloxacin, nadifloxacin, nemonoxacin, nifuroquine, nitroxoline, norfloxacin, norfloxacin screening test, norfloxacin/metronidazole, norfloxacin/tinidazole, ofloxacin, ofloxacin/ornidazole, orbifloxacin, pazufloxacin, pefloxacin, pefloxacin screening test, pradofloxacin, premafloxacin, prulifloxacin, rufloxacin, sarafloxacin, sitafloxacin, sparfloxacin, temafloxacin, tilbroquinol, tioxacin, tosufloxacin, and trovafloxacin
+\item \code{\link[=glycopeptides]{glycopeptides()}} can select: \cr avoparcin, bleomycin, dalbavancin, norvancomycin, oritavancin, ramoplanin, teicoplanin, teicoplanin-macromethod, telavancin, vancomycin, and vancomycin-macromethod
+\item \code{\link[=isoxazolylpenicillins]{isoxazolylpenicillins()}} can select: \cr cloxacillin, dicloxacillin, flucloxacillin, meticillin, oxacillin, and oxacillin screening test
+\item \code{\link[=lincosamides]{lincosamides()}} can select: \cr clindamycin, lincomycin, and pirlimycin
+\item \code{\link[=lipoglycopeptides]{lipoglycopeptides()}} can select: \cr dalbavancin, oritavancin, and telavancin
+\item \code{\link[=macrolides]{macrolides()}} can select: \cr acetylmidecamycin, acetylspiramycin, azithromycin, clarithromycin, dirithromycin, erythromycin, flurithromycin, gamithromycin, josamycin, kitasamycin, meleumycin, midecamycin, miocamycin, nafithromycin, oleandomycin, rokitamycin, roxithromycin, solithromycin, spiramycin, telithromycin, tildipirosin, tilmicosin, troleandomycin, tulathromycin, tylosin, and tylvalosin
+\item \code{\link[=monobactams]{monobactams()}} can select: \cr aztreonam, aztreonam/avibactam, aztreonam/nacubactam, carumonam, and tigemonam
+\item \code{\link[=nitrofurans]{nitrofurans()}} can select: \cr furazidin, furazolidone, nifurtoinol, nitrofurantoin, and nitrofurazone
+\item \code{\link[=oxazolidinones]{oxazolidinones()}} can select: \cr cadazolid, cycloserine, linezolid, tedizolid, and thiacetazone
+\item \code{\link[=penicillins]{penicillins()}} can select: \cr amoxicillin, amoxicillin/clavulanic acid, amoxicillin/sulbactam, ampicillin, ampicillin/sulbactam, apalcillin, aspoxicillin, azidocillin, azlocillin, bacampicillin, benzathine benzylpenicillin, benzathine phenoxymethylpenicillin, benzylpenicillin, benzylpenicillin screening test, carbenicillin, carindacillin, ciclacillin, clometocillin, cloxacillin, dicloxacillin, epicillin, flucloxacillin, hetacillin, lenampicillin, mecillinam, metampicillin, meticillin, mezlocillin, mezlocillin/sulbactam, nafcillin, oxacillin, oxacillin screening test, penamecillin, penicillin/novobiocin, penicillin/sulbactam, pheneticillin, phenoxymethylpenicillin, piperacillin, piperacillin/sulbactam, piperacillin/tazobactam, piridicillin, pivampicillin, pivmecillinam, procaine benzylpenicillin, propicillin, sarmoxicillin, sulbenicillin, sultamicillin, talampicillin, temocillin, ticarcillin, and ticarcillin/clavulanic acid
+\item \code{\link[=phenicols]{phenicols()}} can select: \cr chloramphenicol, florfenicol, and thiamphenicol
+\item \code{\link[=polymyxins]{polymyxins()}} can select: \cr colistin, polymyxin B, and polymyxin B/polysorbate 80
+\item \code{\link[=quinolones]{quinolones()}} can select: \cr besifloxacin, cinoxacin, ciprofloxacin, ciprofloxacin/metronidazole, ciprofloxacin/ornidazole, ciprofloxacin/tinidazole, clinafloxacin, danofloxacin, delafloxacin, difloxacin, enoxacin, enrofloxacin, finafloxacin, fleroxacin, flumequine, garenoxacin, gatifloxacin, gemifloxacin, grepafloxacin, lascufloxacin, levofloxacin, levofloxacin/ornidazole, levonadifloxacin, lomefloxacin, marbofloxacin, metioxate, miloxacin, moxifloxacin, nadifloxacin, nalidixic acid, nalidixic acid screening test, nemonoxacin, nifuroquine, nitroxoline, norfloxacin, norfloxacin screening test, norfloxacin/metronidazole, norfloxacin/tinidazole, ofloxacin, ofloxacin/ornidazole, orbifloxacin, oxolinic acid, pazufloxacin, pefloxacin, pefloxacin screening test, pipemidic acid, piromidic acid, pradofloxacin, premafloxacin, prulifloxacin, rosoxacin, rufloxacin, sarafloxacin, sitafloxacin, sparfloxacin, temafloxacin, tilbroquinol, tioxacin, tosufloxacin, and trovafloxacin
+\item \code{\link[=rifamycins]{rifamycins()}} can select: \cr rifabutin, rifampicin, rifampicin/ethambutol/isoniazid, rifampicin/isoniazid, rifampicin/pyrazinamide/ethambutol/isoniazid, rifampicin/pyrazinamide/isoniazid, rifamycin, and rifapentine
+\item \code{\link[=streptogramins]{streptogramins()}} can select: \cr pristinamycin and quinupristin/dalfopristin
+\item \code{\link[=sulfonamides]{sulfonamides()}} can select: \cr brodimoprim, sulfadiazine, sulfadiazine/tetroxoprim, sulfadimethoxine, sulfadimidine, sulfafurazole, sulfaisodimidine, sulfalene, sulfamazone, sulfamerazine, sulfamethizole, sulfamethoxazole, sulfamethoxypyridazine, sulfametomidine, sulfametoxydiazine, sulfamoxole, sulfanilamide, sulfaperin, sulfaphenazole, sulfapyridine, sulfathiazole, and sulfathiourea
+\item \code{\link[=tetracyclines]{tetracyclines()}} can select: \cr cetocycline, chlortetracycline, clomocycline, demeclocycline, doxycycline, eravacycline, lymecycline, metacycline, minocycline, omadacycline, oxytetracycline, penimepicycline, rolitetracycline, sarecycline, tetracycline, tetracycline screening test, and tigecycline
+\item \code{\link[=trimethoprims]{trimethoprims()}} can select: \cr brodimoprim, sulfadiazine, sulfadiazine/tetroxoprim, sulfadiazine/trimethoprim, sulfadimethoxine, sulfadimidine, sulfadimidine/trimethoprim, sulfafurazole, sulfaisodimidine, sulfalene, sulfamazone, sulfamerazine, sulfamerazine/trimethoprim, sulfamethizole, sulfamethoxazole, sulfamethoxypyridazine, sulfametomidine, sulfametoxydiazine, sulfametrole/trimethoprim, sulfamoxole, sulfamoxole/trimethoprim, sulfanilamide, sulfaperin, sulfaphenazole, sulfapyridine, sulfathiazole, sulfathiourea, trimethoprim, and trimethoprim/sulfamethoxazole
+\item \code{\link[=ureidopenicillins]{ureidopenicillins()}} can select: \cr azlocillin, mezlocillin, piperacillin, and piperacillin/tazobactam
+}
+}
+}
+\examples{
+x <- custom_mdro_guideline(
+  CIP == "R" & age > 60 ~ "Elderly Type A",
+  ERY == "R" & age > 60 ~ "Elderly Type B"
+)
+x
+
+# run the custom rule set (verbose = TRUE will return a logbook instead of the data set):
+out <- mdro(example_isolates, guideline = x)
+table(out)
+
+out <- mdro(example_isolates, guideline = x, verbose = TRUE)
+head(out)
+
+# you can create custom guidelines using selectors (see ?antimicrobial_selectors)
+my_guideline <- custom_mdro_guideline(
+  AMX == "R" ~ "Custom MDRO 1",
+  all(cephalosporins_2nd() == "R") ~ "Custom MDRO 2"
+)
+my_guideline
+
+out <- mdro(example_isolates, guideline = my_guideline)
+table(out)
+}

man/esbl_isolates.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{esbl_isolates}
+\alias{esbl_isolates}
+\title{Data Set with 500 ESBL Isolates}
+\format{
+A \link[tibble:tibble]{tibble} with 500 observations and 19 variables:
+\itemize{
+\item \code{esbl}\cr Logical indicator if the isolate is ESBL-producing
+\item \code{genus}\cr Genus of the microorganism
+\item \code{AMC:COL}\cr MIC values for 17 antimicrobial agents, transformed to class \code{\link{mic}} (see \code{\link[=as.mic]{as.mic()}})
+}
+}
+\usage{
+esbl_isolates
+}
+\description{
+A data set containing 500 microbial isolates with MIC values of common antibiotics and a binary \code{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 \href{https://amr-for-r.org/articles/AMR_with_tidymodels.html}{tidymodels}.
+}
+\details{
+See our \link[=amr-tidymodels]{tidymodels integration} for an example using this data set.
+}
+\examples{
+esbl_isolates
+}
+\keyword{datasets}

man/g.test.Rd

@@ -133,7 +133,7 @@ g.test(x)
 }
 \references{
 \enumerate{
-\item McDonald, J.H. 2014. \strong{Handbook of Biological Statistics (3rd ed.)}. Sparky House Publishing, Baltimore, Maryland. \url{http://www.biostathandbook.com/gtestgof.html}.
+\item McDonald, J.H. 2014. \strong{Handbook of Biological Statistics (3rd ed.)}. Sparky House Publishing, Baltimore, Maryland.
 }
 }
 \seealso{

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/guess_ab_col.Rd

@@ -14,7 +14,7 @@ guess_ab_col(x = NULL, search_string = NULL, verbose = FALSE,
 
 \item{verbose}{A \link{logical} to indicate whether additional info should be printed.}
 
-\item{only_sir_columns}{A \link{logical} to indicate whether only antibiotic columns must be detected that were transformed to class \code{sir} (see \code{\link[=as.sir]{as.sir()}}) on beforehand (default is \code{FALSE}).}
+\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}.}
 }
 \value{
 A column name of \code{x}, or \code{NULL} when no result is found.

man/key_antimicrobials.Rd

@@ -13,9 +13,9 @@ key_antimicrobials(x = NULL, col_mo = NULL, universal = c("ampicillin",
   "ceftazidime", "meropenem"), gram_positive = c("vancomycin", "teicoplanin",
   "tetracycline", "erythromycin", "oxacillin", "rifampin"),
   antifungal = c("anidulafungin", "caspofungin", "fluconazole", "miconazole",
-  "nystatin", "voriconazole"), only_sir_columns = FALSE, ...)
+  "nystatin", "voriconazole"), only_sir_columns = any(is.sir(x)), ...)
 
-all_antimicrobials(x = NULL, only_sir_columns = FALSE, ...)
+all_antimicrobials(x = NULL, only_sir_columns = any(is.sir(x)), ...)
 
 antimicrobials_equal(y, z, type = c("points", "keyantimicrobials"),
   ignore_I = TRUE, points_threshold = 2, ...)
@@ -33,7 +33,7 @@ antimicrobials_equal(y, z, type = c("points", "keyantimicrobials"),
 
 \item{antifungal}{Names of antifungal drugs for \strong{fungi}, case-insensitive. Set to \code{NULL} to ignore. See \emph{Details} for the default antifungal drugs.}
 
-\item{only_sir_columns}{A \link{logical} to indicate whether only columns must be included that were transformed to class \code{sir} (see \code{\link[=as.sir]{as.sir()}}) on beforehand (default is \code{FALSE}).}
+\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}.}
 
 \item{...}{Ignored, only in place to allow future extensions.}
 

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/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()
 
@@ -210,6 +210,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,
@@ -267,7 +271,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()
 }
 if (require("ggplot2")) {
@@ -279,7 +283,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))
 }
 
@@ -312,7 +316,7 @@ 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

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-data.R

@@ -71,6 +71,7 @@ test_that("test-data.R", {
   if (AMR:::pkg_is_available("tibble")) {
     # there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
     datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
+    datasets <- datasets[datasets != "antibiotics"]
     for (i in seq_len(length(datasets))) {
       dataset <- get(datasets[i], envir = asNamespace("AMR"))
       expect_identical(AMR:::dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i])

tests/testthat/test-mdro.R

@@ -48,7 +48,7 @@ test_that("test-mdro.R", {
   # example_isolates should have these finding using Dutch guidelines
   expect_equal(
     as.double(table(outcome)),
-    c(1977, 23, 0)
+    c(1977, 21, 2)
   )
 
   expect_equal(
@@ -282,6 +282,15 @@ test_that("test-mdro.R", {
   #   info = FALSE
   # ))
 
+  expect_equal(
+    colnames(suppressWarnings(mdro(example_isolates[1:10, ], verbose = TRUE, info = FALSE))),
+    c("row_number", "microorganism", "MDRO", "reason", "all_nonsusceptible_columns", "guideline")
+  )
+  expect_equal(
+    colnames(suppressWarnings(mdro(example_isolates[1:10, ], verbose = TRUE, info = FALSE, guideline = custom_mdro_guideline(AMX == "R" ~ "Positive")))),
+    c("row_number", "microorganism", "MDRO", "reason", "all_nonsusceptible_columns", "guideline")
+  )
+
   # print groups
   if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
     expect_output(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))

tests/testthat/test-zzz.R

@@ -63,10 +63,12 @@ test_that("test-zzz.R", {
     "progress_bar" = "progress",
     "read_html" = "xml2",
     "right_join" = "dplyr",
+    "select" = "dplyr",
     "semi_join" = "dplyr",
     "showQuestion" = "rstudioapi",
     "symbol" = "cli",
     "tibble" = "tibble",
+    "where" = "tidyselect",
     "write.xlsx" = "openxlsx"
   )
 
@@ -127,6 +129,24 @@ test_that("test-zzz.R", {
     "type_sum" = "pillar",
     # readxl
     "read_excel" = "readxl",
+    # recipes
+    "add_step" = "recipes",
+    "bake" = "recipes",
+    "check_new_data" = "recipes",
+    "check_type" = "recipes",
+    "has_role" = "recipes",
+    "is_trained" = "recipes",
+    "prep" = "recipes",
+    "print_step" = "recipes",
+    "rand_id" = "recipes",
+    "recipe" = "recipes",
+    "recipes_eval_select" = "recipes",
+    "sel2char" = "recipes",
+    "step" = "recipes",
+    "step_center" = "recipes",
+    "tidy" = "recipes",
+    # rlang
+    "enquos" = "rlang",
     # rmarkdown
     "html_vignette" = "rmarkdown",
     # skimr

vignettes/AMR_with_tidymodels.Rmd

@@ -26,7 +26,14 @@ knitr::opts_chunk$set(
 
 Antimicrobial resistance (AMR) is a global health crisis, and understanding resistance patterns is crucial for managing effective treatments. The `AMR` R package provides robust tools for analysing AMR data, including convenient antimicrobial selector functions like `aminoglycosides()` and `betalactams()`. 
 
-In this post, we will explore how to use the `tidymodels` framework to predict resistance patterns in the `example_isolates` dataset in two examples. 
+In this post, we will explore how to use the `tidymodels` framework to predict resistance patterns in the `example_isolates` dataset in two examples.
+
+This post contains the following examples:
+
+1. Using Antimicrobial Selectors
+2. Predicting ESBL Presence Using Raw MICs
+3. Predicting AMR Over Time
+
 
 ## Example 1: Using Antimicrobial Selectors
 
@@ -208,10 +215,150 @@ This workflow is extensible to other antimicrobial classes and resistance patter
 
 ---
 
+## Example 2: Predicting ESBL Presence Using Raw MICs
 
-## Example 2: Predicting AMR Over Time
+In this second example, we demonstrate how to use `<mic>` columns directly in `tidymodels` workflows using AMR-specific recipe steps. This includes a transformation to `log2` scale using `step_mic_log2()`, which prepares MIC values for use in classification models.
 
-In this second example, we aim to predict antimicrobial resistance (AMR) trends over time using `tidymodels`. We will model resistance to three antibiotics (amoxicillin `AMX`, amoxicillin-clavulanic acid `AMC`, and ciprofloxacin `CIP`), based on historical data grouped by year and hospital ward.
+This approach and idea formed the basis for the publication [DOI: 10.3389/fmicb.2025.1582703](https://doi.org/10.3389/fmicb.2025.1582703) to model the presence of extended-spectrum beta-lactamases (ESBL).
+
+### **Objective**
+
+Our goal is to:
+
+1. Use raw MIC values to predict whether a bacterial isolate produces ESBL.
+2. Apply AMR-aware preprocessing in a `tidymodels` recipe.
+3. Train a classification model and evaluate its predictive performance.
+
+### **Data Preparation**
+
+We use the `esbl_isolates` dataset that comes with the AMR package.
+
+```{r}
+# Load required libraries
+library(AMR)
+library(tidymodels)
+
+# View the esbl_isolates data set
+esbl_isolates
+
+# Prepare a binary outcome and convert to ordered factor
+data <- esbl_isolates %>%
+  mutate(esbl = factor(esbl, levels = c(FALSE, TRUE), ordered = TRUE))
+```
+
+**Explanation:**
+
+- `esbl_isolates`: Contains MIC test results and ESBL status for each isolate.
+- `mutate(esbl = ...)`: Converts the target column to an ordered factor for classification.
+
+### **Defining the Workflow**
+
+#### 1. Preprocessing with a Recipe
+
+We use our `step_mic_log2()` function to log2-transform MIC values, ensuring that MICs are numeric and properly scaled. All MIC predictors can easily and agnostically selected using the new `all_mic_predictors()`:
+
+```{r}
+# Split into training and testing sets
+set.seed(123)
+split <- initial_split(data)
+training_data <- training(split)
+testing_data <- testing(split)
+
+# Define the recipe
+mic_recipe <- recipe(esbl ~ ., data = training_data) %>%
+  remove_role(genus, old_role = "predictor") %>%  # Remove non-informative variable
+  step_mic_log2(all_mic_predictors()) #%>%         # Log2 transform all MIC predictors
+ # prep()
+
+mic_recipe
+```
+
+**Explanation:**
+
+- `remove_role()`: Removes irrelevant variables like genus.
+- `step_mic_log2()`: Applies `log2(as.numeric(...))` to all MIC predictors in one go.
+- `prep()`: Finalises the recipe based on training data.
+
+#### 2. Specifying the Model
+
+We use a simple logistic regression to model ESBL presence, though recent models such as xgboost ([link to `parsnip` manual](https://parsnip.tidymodels.org/reference/details_boost_tree_xgboost.html)) could be much more precise.
+
+```{r}
+# Define the model
+model <- logistic_reg(mode = "classification") %>%
+  set_engine("glm")
+
+model
+```
+
+**Explanation:**
+
+- `logistic_reg()`: Specifies a binary classification model.
+- `set_engine("glm")`: Uses the base R GLM engine.
+
+#### 3. Building the Workflow
+
+```{r}
+# Create workflow
+workflow_model <- workflow() %>%
+  add_recipe(mic_recipe) %>%
+  add_model(model)
+
+workflow_model
+```
+
+### **Training and Evaluating the Model**
+
+```{r}
+# Fit the model
+fitted <- fit(workflow_model, training_data)
+
+# Generate predictions
+predictions <- predict(fitted, testing_data) %>%
+  bind_cols(testing_data)
+
+# Evaluate model performance
+our_metrics <- metric_set(accuracy, kap, ppv, npv)
+metrics <- our_metrics(predictions, truth = esbl, estimate = .pred_class)
+
+metrics
+```
+
+**Explanation:**
+
+- `fit()`: Trains the model on the processed training data.
+- `predict()`: Produces predictions for unseen test data.
+- `metric_set()`: Allows evaluating multiple classification metrics.
+
+It appears we can predict ESBL gene presence with a positive predictive value (PPV) of `r round(metrics$.estimate[3], 3) * 100`% and a negative predictive value (NPV) of `r round(metrics$.estimate[4], 3) * 100` using a simplistic logistic regression model.
+
+### **Visualising Predictions**
+
+We can visualise predictions by comparing predicted and actual ESBL status.
+
+```{r}
+library(ggplot2)
+
+ggplot(predictions, aes(x = esbl, fill = .pred_class)) +
+  geom_bar(position = "stack") +
+  labs(title = "Predicted vs Actual ESBL Status",
+       x = "Actual ESBL",
+       y = "Count") +
+  theme_minimal()
+```
+
+### **Conclusion**
+
+In this example, we showcased how the new `AMR`-specific recipe steps simplify working with `<mic>` columns in `tidymodels`. The `step_mic_log2()` transformation converts ordered MICs to log2-transformed numerics, improving compatibility with classification models.
+
+This pipeline enables realistic, reproducible, and interpretable modelling of antimicrobial resistance data.
+
+---
+
+
+## Example 3: Predicting AMR Over Time
+
+In this third example, we aim to predict antimicrobial resistance (AMR) trends over time using `tidymodels`. We will model resistance to three antibiotics (amoxicillin `AMX`, amoxicillin-clavulanic acid `AMC`, and ciprofloxacin `CIP`), based on historical data grouped by year and hospital ward.
 
 ### **Objective**
 

vignettes/MDR.Rmd

@@ -1,163 +0,0 @@
----
-title: "Determine multi-drug resistance (MDR)"
-output: 
-  rmarkdown::html_vignette:
-    toc: true
-vignette: >
-  %\VignetteIndexEntry{Determine multi-drug resistance (MDR)}
-  %\VignetteEncoding{UTF-8}
-  %\VignetteEngine{knitr::rmarkdown}
-editor_options: 
-  chunk_output_type: console
----
-
-```{r setup, include = FALSE, results = 'markup'}
-knitr::opts_chunk$set(
-  collapse = TRUE,
-  comment = "#>"
-)
-library(AMR)
-```
-
-With the function `mdro()`, you can determine which micro-organisms are multi-drug resistant organisms (MDRO).
-
-### Type of input
-
-The `mdro()` function takes a data set as input, such as a regular `data.frame`. It tries to automatically determine the right columns for info about your isolates, such as the name of the species and all columns with results of antimicrobial agents. See the help page for more info about how to set the right settings for your data with the command `?mdro`. 
-
-For WHONET data (and most other data), all settings are automatically set correctly.
-
-### Guidelines
-
-The `mdro()` function support multiple guidelines. You can select a guideline with the `guideline` parameter. Currently supported guidelines are (case-insensitive):
-
-* `guideline = "CMI2012"` (default)
-  
-  Magiorakos AP, Srinivasan A *et al.* "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." Clinical Microbiology and Infection (2012) ([link](https://www.clinicalmicrobiologyandinfection.com/article/S1198-743X(14)61632-3/fulltext))
-
-* `guideline = "EUCAST3.2"` (or simply `guideline = "EUCAST"`)
-  
-  The European international guideline - EUCAST Expert Rules Version 3.2 "Intrinsic Resistance and Unusual Phenotypes" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf))
-
-* `guideline = "EUCAST3.1"`
-  
-  The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
-
-* `guideline = "TB"`
-  
-  The international guideline for multi-drug resistant tuberculosis - World Health Organization "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis" ([link](https://www.who.int/tb/publications/pmdt_companionhandbook/en/))
-
-* `guideline = "MRGN"`
-  
-  The German national guideline - Mueller *et al.* (2015) Antimicrobial Resistance and Infection Control 4:7. DOI: 10.1186/s13756-015-0047-6
-
-* `guideline = "BRMO"`
-  
-  The Dutch national guideline - Rijksinstituut voor Volksgezondheid en Milieu "WIP-richtlijn BRMO (Bijzonder Resistente Micro-Organismen) (ZKH)" ([link](https://www.rivm.nl/wip-richtlijn-brmo-bijzonder-resistente-micro-organismen-zkh))
-
-Please suggest your own (country-specific) guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
-
-#### Custom Guidelines
-
-You can also use your own custom guideline. Custom guidelines can be set with the `custom_mdro_guideline()` function. This is of great importance if you have custom rules to determine MDROs in your hospital, e.g., rules that are dependent on ward, state of contact isolation or other variables in your data.
-
-If you are familiar with `case_when()` of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what R considers to be the 'formula notation':
-
-```{r}
-custom <- custom_mdro_guideline(
-  CIP == "R" & age > 60 ~ "Elderly Type A",
-  ERY == "R" & age > 60 ~ "Elderly Type B"
-)
-```
-
-If a row/an isolate matches the first rule, the value after the first `~` (in this case *'Elderly Type A'*) will be set as MDRO value. Otherwise, the second rule will be tried and so on. The maximum number of rules is unlimited. 
-
-You can print the rules set in the console for an overview. Colours will help reading it if your console supports colours.
-
-```{r}
-custom
-```
-
-The outcome of the function can be used for the `guideline` argument in the `mdro()` function:
-
-```{r}
-x <- mdro(example_isolates, guideline = custom)
-table(x)
-```
-
-The rules set (the `custom` object in this case) could be exported to a shared file location using `saveRDS()` if you collaborate with multiple users. The custom rules set could then be imported using `readRDS()`.
-  
-### Examples
-
-The `mdro()` function always returns an ordered `factor` for predefined guidelines. For example, the output of the default guideline by Magiorakos *et al.* returns a `factor` with levels 'Negative', 'MDR', 'XDR' or 'PDR' in that order.
-
-The next example uses the `example_isolates` data set. This is a data set included with this package and contains full antibiograms of 2,000 microbial isolates. It reflects reality and can be used to practise AMR data analysis. If we test the MDR/XDR/PDR guideline on this data set, we get:
-
-```{r, message = FALSE}
-library(dplyr) # to support pipes: %>%
-library(cleaner) # to create frequency tables
-```
-```{r, results = 'hide'}
-example_isolates %>%
-  mdro() %>%
-  freq() # show frequency table of the result
-```
-```{r, echo = FALSE, results = 'asis', message = FALSE, warning = FALSE}
-example_isolates %>%
-  mdro(info = FALSE) %>%
-  freq() # show frequency table of the result
-```
-
-For another example, I will create a data set to determine multi-drug resistant TB:
-
-```{r}
-# random_sir() is a helper function to generate
-# a random vector with values S, I and R
-my_TB_data <- data.frame(
-  rifampicin = random_sir(5000),
-  isoniazid = random_sir(5000),
-  gatifloxacin = random_sir(5000),
-  ethambutol = random_sir(5000),
-  pyrazinamide = random_sir(5000),
-  moxifloxacin = random_sir(5000),
-  kanamycin = random_sir(5000)
-)
-```
-
-Because all column names are automatically verified for valid drug names or codes, this would have worked exactly the same way:
-
-```{r, eval = FALSE}
-my_TB_data <- data.frame(
-  RIF = random_sir(5000),
-  INH = random_sir(5000),
-  GAT = random_sir(5000),
-  ETH = random_sir(5000),
-  PZA = random_sir(5000),
-  MFX = random_sir(5000),
-  KAN = random_sir(5000)
-)
-```
-
-The data set now looks like this:
-
-```{r}
-head(my_TB_data)
-```
-
-We can now add the interpretation of MDR-TB to our data set. You can use:
-
-```r
-mdro(my_TB_data, guideline = "TB")
-```
-
-or its shortcut `mdr_tb()`:
-
-```{r}
-my_TB_data$mdr <- mdr_tb(my_TB_data)
-```
-
-Create a frequency table of the results:
-
-```{r, results = 'asis'}
-freq(my_TB_data$mdr)
-```

vignettes/welcome_to_AMR.Rmd

@@ -28,7 +28,7 @@ Note: to keep the package size as small as possible, we only include this vignet
 
 The `AMR` package is a peer-reviewed, [free and open-source](https://amr-for-r.org/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. We are a team of [many different researchers](https://amr-for-r.org/authors.html) from around the globe to make this a successful and durable project!
 
-This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
+This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)).
 
 After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated June 2024) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
 
@@ -36,12 +36,12 @@ The `AMR` package is available in `r AMR:::vector_and(vapply(FUN.VALUE = charact
 
 This package was intended as a comprehensive toolbox for integrated AMR data analysis. This package can be used for:
 
-  * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN]((https://lpsn.dsmz.de))) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](https://amr-for-r.org/reference/mo_property.html))
+  * Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature ([LPSN](https://lpsn.dsmz.de)) and the Global Biodiversity Information Facility ([GBIF](https://www.gbif.org)) ([manual](https://amr-for-r.org/reference/mo_property.html))
   * Interpreting raw MIC and disk diffusion values, based on any CLSI or EUCAST guideline ([manual](https://amr-for-r.org/reference/as.sir.html))
   * Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records ([manual](https://amr-for-r.org/reference/ab_from_text.html))
   * Determining first isolates to be used for AMR data analysis ([manual](https://amr-for-r.org/reference/first_isolate.html))
   * Calculating antimicrobial resistance ([tutorial](https://amr-for-r.org/articles/AMR.html))
-  * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](https://amr-for-r.org/articles/MDR.html))
+  * Determining multi-drug resistance (MDR) / multi-drug resistant organisms (MDRO) ([tutorial](https://amr-for-r.org/reference/mdro.html))
   * Calculating (empirical) susceptibility of both mono therapy and combination therapies ([tutorial](https://amr-for-r.org/articles/AMR.html))
   * Apply AMR functions in predictive modelling ([tutorial](https://amr-for-r.org/articles/AMR_with_tidymodels.html))
   * Getting properties for any microorganism (like Gram stain, species, genus or family) ([manual](https://amr-for-r.org/reference/mo_property.html))