mirror of
https://github.com/msberends/AMR.git
synced 2026-09-16 10:19:38 +02:00
Compare commits
210
Commits
v2.1.1
..
ceb3e6675d
+2
-1
@@ -25,14 +25,15 @@
|
||||
^tests/testthat/_snaps$
|
||||
^vignettes/AMR\.Rmd$
|
||||
^vignettes/AMR_intro\.png$
|
||||
^vignettes/AMR_with_tidymodels\.Rmd$
|
||||
^vignettes/benchmarks\.Rmd$
|
||||
^vignettes/benchmarks\.Rmd\.not$
|
||||
^vignettes/datasets\.Rmd$
|
||||
^vignettes/EUCAST\.Rmd$
|
||||
^vignettes/MDR\.Rmd$
|
||||
^vignettes/other_pkg.*\.Rmd$
|
||||
^vignettes/PCA\.Rmd$
|
||||
^vignettes/resistance_predict\.Rmd$
|
||||
^vignettes/WHONET\.Rmd$
|
||||
^logo.svg$
|
||||
^CRAN-SUBMISSION$
|
||||
^PythonPackage$
|
||||
|
||||
@@ -0,0 +1,40 @@
|
||||
name: Bug Report
|
||||
description: I think I found a bug!
|
||||
labels: "bug"
|
||||
body:
|
||||
- type: markdown
|
||||
attributes:
|
||||
value: |
|
||||
Thanks for taking the time to fill out this bug report!
|
||||
|
||||
You're probably improving the lives of many AMR package users :)
|
||||
- type: textarea
|
||||
id: description
|
||||
attributes:
|
||||
label: Description
|
||||
description: Please provide a clear and concise description.
|
||||
placeholder: Description
|
||||
validations:
|
||||
required: true
|
||||
- type: dropdown
|
||||
id: version
|
||||
attributes:
|
||||
label: AMR Package Version
|
||||
description: Which version of the AMR package are you running? You can retrieve this by running `packageVersion("AMR")` in R. If you are not running any of these versions, then please update first and check whether the bug still persists.
|
||||
multiple: false
|
||||
options:
|
||||
- ''
|
||||
- Latest CRAN version (2.1.1)
|
||||
- One of the latest GitHub versions (2.1.1.9xxx)
|
||||
validations:
|
||||
required: true
|
||||
- type: checkboxes
|
||||
id: field-impact
|
||||
attributes:
|
||||
label: Impacted Field
|
||||
description: Which field is probably impacted by this? You may select more than one, or choose none at all.
|
||||
options:
|
||||
- label: Medical (human) microbiology
|
||||
- label: Veterinary microbiology
|
||||
- label: Environmental microbiology
|
||||
|
||||
@@ -0,0 +1,27 @@
|
||||
name: Feature or Optimisation Request
|
||||
description: I have an idea!
|
||||
labels: "enhancement"
|
||||
body:
|
||||
- type: markdown
|
||||
attributes:
|
||||
value: |
|
||||
Thanks for taking the time to make a suggestion!
|
||||
|
||||
We'll be happy to implement on a short notice if this improves the AMR package. Do note that BY FAR most of the content of the current version is because of collaborators like you! So, many thanks in advance.
|
||||
- type: textarea
|
||||
id: description
|
||||
attributes:
|
||||
label: Description
|
||||
description: Please provide a clear and concise description.
|
||||
placeholder: Description
|
||||
validations:
|
||||
required: true
|
||||
- type: checkboxes
|
||||
id: field-impact
|
||||
attributes:
|
||||
label: Impacted Field
|
||||
description: Which field is probably impacted by this? You may select more than one, or choose none at all.
|
||||
options:
|
||||
- label: Medical (human) microbiology
|
||||
- label: Veterinary microbiology
|
||||
- label: Environmental microbiology
|
||||
@@ -0,0 +1,8 @@
|
||||
blank_issues_enabled: false
|
||||
contact_links:
|
||||
- name: I Have a Question - Ask Our AMR for R Assistant
|
||||
url: https://chatgpt.com/g/g-M4UNLwFi5-amr-for-r-assistant
|
||||
about: Ask questions or code suggestions to our AMR for R Assistant, a ChatGPT manually-trained model able to answer any question about the AMR package.
|
||||
- name: I Have a Question - AMR Community Support
|
||||
url: https://github.com/msberends/AMR/discussions
|
||||
about: You can also ask (and answer) questions here to share with others.
|
||||
Executable
+65
@@ -0,0 +1,65 @@
|
||||
#!/bin/bash
|
||||
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# Path to the commit message file
|
||||
COMMIT_MSG_FILE="$1"
|
||||
|
||||
# Read the original commit message
|
||||
COMMIT_MSG=$(cat "$COMMIT_MSG_FILE")
|
||||
|
||||
# Check if commit should skip checks
|
||||
if [[ "$COMMIT_MSG" =~ no-?checks?|no-?verify ]]; then
|
||||
echo "Not modifying commit message with 'pre-commit':"
|
||||
echo "Commit message contains 'no-check' or 'no-verify'."
|
||||
echo ""
|
||||
exit 0
|
||||
fi
|
||||
|
||||
# Read the version number from the temporary file
|
||||
if [ -f ".git/commit_version.tmp" ]; then
|
||||
currentversion=$(cat .git/commit_version.tmp)
|
||||
rm -f .git/commit_version.tmp
|
||||
else
|
||||
echo "Version number file not found."
|
||||
currentversion=""
|
||||
fi
|
||||
|
||||
# Prepend the version number to the commit message if available
|
||||
if [ -n "$currentversion" ]; then
|
||||
echo "(v${currentversion}) ${COMMIT_MSG}" > "$COMMIT_MSG_FILE"
|
||||
else
|
||||
echo "No version number to prepend to commit message."
|
||||
fi
|
||||
|
||||
git add data-raw/*
|
||||
git add -u
|
||||
|
||||
exit 0
|
||||
+43
-25
@@ -1,4 +1,4 @@
|
||||
#!/bin/sh
|
||||
#!/bin/bash
|
||||
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
@@ -8,9 +8,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,12 +29,25 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
echo "Running pre-commit hook..."
|
||||
# Check if commit should skip checks
|
||||
COMMIT_MSG_FILE=".git/COMMIT_EDITMSG"
|
||||
if [ -f "$COMMIT_MSG_FILE" ]; then
|
||||
COMMIT_MSG=$(cat "$COMMIT_MSG_FILE")
|
||||
if [[ "$COMMIT_MSG" =~ no-?checks?|no-?verify ]]; then
|
||||
echo "Not running prehook 'pre-commit':"
|
||||
echo "Commit message contains 'no-check' or 'no-verify'."
|
||||
echo ""
|
||||
exit 0
|
||||
fi
|
||||
fi
|
||||
|
||||
echo "Running prehook..."
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
# Run the R script and stage the modified files
|
||||
if command -v Rscript > /dev/null; then
|
||||
if [ "$(Rscript -e 'cat(all(c('"'pkgload'"', '"'devtools'"', '"'dplyr'"') %in% rownames(installed.packages())))')" = "TRUE" ]; then
|
||||
Rscript -e "source('data-raw/_pre_commit_hook.R')"
|
||||
Rscript -e "source('data-raw/_pre_commit_checks.R')"
|
||||
currentpkg=$(Rscript -e "cat(pkgload::pkg_name())")
|
||||
echo "- Adding changed files in ./data-raw and ./man to this commit"
|
||||
git add data-raw/*
|
||||
@@ -42,7 +55,7 @@ if command -v Rscript > /dev/null; then
|
||||
git add R/sysdata.rda
|
||||
git add NAMESPACE
|
||||
else
|
||||
echo "- R package 'pkgload', 'devtools', 'dplyr', or 'styler' not installed!"
|
||||
echo "- R package 'pkgload', 'devtools', or 'dplyr' not installed!"
|
||||
currentpkg="your"
|
||||
fi
|
||||
else
|
||||
@@ -51,51 +64,56 @@ else
|
||||
fi
|
||||
echo ""
|
||||
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
echo "Updating semantic versioning and date..."
|
||||
|
||||
# get tags from remote, and remove tags not on remote:
|
||||
# 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', pick the right name:
|
||||
|
||||
# Assume main branch to be 'main' or 'master'
|
||||
defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
|
||||
if [ "$currenttag" = "" ]; then
|
||||
# there is no tag, so set tag to 0.0.1 and commit index to current count
|
||||
currenttag="0.0.1"
|
||||
currentcommit=$(git rev-list --count ${defaultbranch})
|
||||
echo "- no git tags found, create one in format 'v(x).(y).(z)' - curently ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
else
|
||||
# there is a tag, so base version number on that
|
||||
currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
|
||||
echo "- latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
fi
|
||||
# combine tag (e.g. 1.2.3) and commit number (like 5) increased by 9000 to indicate beta version
|
||||
currentversion="$currenttag.$((currentcommit + 9001))" # results in e.g. 1.2.3.9005
|
||||
|
||||
# Combine tag and commit number
|
||||
currentversion="$currenttag.$((currentcommit + 9001))"
|
||||
echo "- ${currentpkg} pkg version set to ${currentversion}"
|
||||
|
||||
# set version number and date to DESCRIPTION file
|
||||
# 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"
|
||||
# remove leftover on macOS
|
||||
echo "- Updated version number and date in ./DESCRIPTION"
|
||||
rm -f DESCRIPTION--
|
||||
# add to commit
|
||||
git add DESCRIPTION
|
||||
|
||||
# set version number to NEWS file
|
||||
# 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"
|
||||
# remove leftover on macOS
|
||||
echo "- Updated version number in ./NEWS.md"
|
||||
rm -f NEWS.md--
|
||||
# add to commit
|
||||
git add NEWS.md
|
||||
else
|
||||
echo "- no NEWS.md found!"
|
||||
echo "- No NEWS.md found!"
|
||||
fi
|
||||
echo ""
|
||||
|
||||
# Save the version number for use in the commit-msg hook
|
||||
echo "${currentversion}" > .git/commit_version.tmp
|
||||
|
||||
# Generate GPT knowledge info for our Assistant (https://chatgpt.com/g/g-M4UNLwFi5-amr-for-r-assistant)
|
||||
bash data-raw/_generate_GPT_knowledge_input.sh "${currentversion}"
|
||||
git add data-raw/*
|
||||
git add -u
|
||||
|
||||
exit 0
|
||||
|
||||
+23
-25
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -53,33 +53,34 @@ jobs:
|
||||
matrix:
|
||||
config:
|
||||
# current development version, check all major OSes:
|
||||
- {os: macOS-latest, r: 'devel', allowfail: false}
|
||||
- {os: macOS-latest, r: 'devel', allowfail: true}
|
||||
- {os: windows-latest, r: 'devel', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'devel', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'devel', allowfail: false, http-user-agent: 'release'}
|
||||
|
||||
# current 'release' version, check all major OSes:
|
||||
- {os: macOS-latest, r: '4.3', allowfail: false}
|
||||
- {os: windows-latest, r: '4.3', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '4.3', allowfail: false}
|
||||
- {os: macOS-latest, r: 'release', allowfail: true}
|
||||
- {os: windows-latest, r: 'release', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'release', allowfail: false}
|
||||
|
||||
# older versions (see also check-old.yaml for even older versions):
|
||||
- {os: ubuntu-latest, r: '4.2', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '4.1', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '4.0', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.6', allowfail: false} # when a new R releases, this one has to move to check-old.yaml
|
||||
# older versions (see also check-old-tinytest.yaml for even older versions):
|
||||
- {os: ubuntu-latest, r: 'oldrel-1', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-2', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-3', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-4', allowfail: false}
|
||||
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
R_KEEP_PKG_SOURCE: yes
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: ${{ matrix.config.r }}
|
||||
http-user-agent: ${{ matrix.config.http-user-agent }}
|
||||
# use RStudio Package Manager to quickly install packages
|
||||
use-public-rspm: true
|
||||
|
||||
@@ -87,17 +88,14 @@ jobs:
|
||||
with:
|
||||
extra-packages: any::rcmdcheck
|
||||
needs: check
|
||||
upgrade: 'TRUE'
|
||||
|
||||
- uses: r-lib/actions/check-r-package@v2
|
||||
env:
|
||||
_R_CHECK_LENGTH_1_CONDITION_: verbose
|
||||
_R_CHECK_LENGTH_1_LOGIC2_: verbose
|
||||
# during 'R CMD check', R_LIBS_USER will be overwritten, so:
|
||||
R_LIBS_USER_GH_ACTIONS: ${{ env.R_LIBS_USER }}
|
||||
R_RUN_TINYTEST: true
|
||||
|
||||
- name: Show tinytest output
|
||||
if: always()
|
||||
with:
|
||||
upload-snapshots: true
|
||||
build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
|
||||
|
||||
- name: Show files
|
||||
if: matrix.config.os == 'ubuntu-latest'
|
||||
run: |
|
||||
find . -name 'tinytest.Rout*' -exec cat '{}' \; || true
|
||||
shell: bash
|
||||
ls -lh /home/runner/work/AMR/AMR/check/**/tests*/testthat/_snaps
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -49,6 +49,7 @@ jobs:
|
||||
# Test all old versions of R >= 3.0, we support them all!
|
||||
# For these old versions, dependencies and vignettes will not be checked.
|
||||
# For recent R versions, see check-recent.yaml (r-lib and tidyverse support the latest 5 major R releases).
|
||||
- {os: ubuntu-latest, r: '3.6', allowfail: false}
|
||||
# - {os: windows-latest, r: '3.5', allowfail: true} # always fails, horrible with UTF-8
|
||||
- {os: ubuntu-latest, r: '3.4', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.3', allowfail: false}
|
||||
@@ -60,7 +61,7 @@ jobs:
|
||||
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
@@ -91,7 +92,7 @@ jobs:
|
||||
mv DESCRIPTION2 DESCRIPTION
|
||||
shell: bash
|
||||
|
||||
- name: Run R CMD check
|
||||
- name: Run R CMD check with tinytest
|
||||
if: always()
|
||||
env:
|
||||
# see https://rstudio.github.io/r-manuals/r-ints/Tools.html for an overview
|
||||
@@ -109,14 +110,18 @@ jobs:
|
||||
# this is a required value to run the unit tests:
|
||||
R_RUN_TINYTEST: true
|
||||
run: |
|
||||
mv tests/testthat inst/
|
||||
rm tests/testthat.R
|
||||
mv tests/tinytest.R.old tests/tinytest.R
|
||||
cd ..
|
||||
R CMD build AMR
|
||||
R CMD check --as-cran --no-manual --run-donttest --run-dontrun AMR_*.tar.gz
|
||||
R CMD check --as-cran --no-manual --run-donttest AMR_*.tar.gz
|
||||
shell: bash
|
||||
|
||||
- name: Show tinytest output
|
||||
if: always()
|
||||
run: |
|
||||
cd ../AMR.Rcheck
|
||||
ls
|
||||
find . -name 'tinytest.Rout*' -exec cat '{}' \; || true
|
||||
shell: bash
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -42,7 +42,7 @@ jobs:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
CODECOV_TOKEN: ${{secrets.CODECOV_TOKEN}}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -41,7 +41,7 @@ jobs:
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
@@ -53,19 +53,34 @@ jobs:
|
||||
|
||||
- uses: r-lib/actions/setup-r-dependencies@v2
|
||||
with:
|
||||
extra-packages: any::lintr
|
||||
|
||||
extra-packages: |
|
||||
any::lintr
|
||||
any::cyclocomp
|
||||
any::roxygen2
|
||||
any::devtools
|
||||
any::usethis
|
||||
|
||||
- name: Remove unneeded folders
|
||||
run: |
|
||||
# do not check these folders
|
||||
rm -rf data-raw
|
||||
rm -rf tests
|
||||
rm -rf vignettes
|
||||
|
||||
- name: Lint
|
||||
run: |
|
||||
# old: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R"))
|
||||
# now get ALL linters, not just default ones
|
||||
linters <- ls(envir = asNamespace("lintr"), pattern = "_linter$")
|
||||
linters <- getNamespaceExports(asNamespace("lintr"))
|
||||
linters <- sort(linters[grepl("_linter$", linters)])
|
||||
# lose deprecated
|
||||
linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator)_linter$", linters)]
|
||||
linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator|consecutive_stopifnot|no_tab|single_quotes|unnecessary_nested_if|unneeded_concatenation)_linter$", linters)]
|
||||
linters <- linters[linters != "linter"]
|
||||
# and the ones we find unnnecessary
|
||||
linters <- linters[!grepl("^(extraction_operator|implicit_integer|line_length|object_name|nonportable_path|is)_linter$", linters)]
|
||||
linters <- linters[!grepl("^(commented_code|extraction_operator|implicit_integer|indentation|line_length|namespace|nonportable_path|object_length|object_name|object_usage|is)_linter$", linters)]
|
||||
# put the functions in a list
|
||||
linters <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
|
||||
linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
|
||||
names(linters_list) <- linters
|
||||
# run them all!
|
||||
lintr::lint_package(linters = linters, exclusions = list("R/aa_helper_pm_functions.R"))
|
||||
lintr::lint_package(linters = linters_list, exclusions = list("R/aa_helper_pm_functions.R"))
|
||||
shell: Rscript {0}
|
||||
|
||||
@@ -0,0 +1,99 @@
|
||||
# ==================================================================== #
|
||||
# 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://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
# only on main
|
||||
branches: "main"
|
||||
|
||||
name: Publish Python Package to PyPI
|
||||
|
||||
jobs:
|
||||
update-pypi:
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Set up Python
|
||||
uses: actions/setup-python@v4
|
||||
with:
|
||||
python-version: '3.9'
|
||||
|
||||
- name: Install build dependencies
|
||||
run: |
|
||||
python -m pip install --upgrade pip
|
||||
pip install build twine wheel
|
||||
|
||||
- name: Build the Python package
|
||||
run: |
|
||||
cd data-raw/
|
||||
bash _generate_python_wrapper.sh
|
||||
|
||||
- name: Publish to PyPI
|
||||
env:
|
||||
TWINE_USERNAME: "__token__"
|
||||
TWINE_PASSWORD: ${{ secrets.PYPI_API_TOKEN }}
|
||||
run: |
|
||||
cd PythonPackage/AMR
|
||||
python -m twine upload dist/*
|
||||
|
||||
- name: Publish to PyPI Testserver
|
||||
continue-on-error: true
|
||||
env:
|
||||
TWINE_USERNAME: "__token__"
|
||||
TWINE_PASSWORD: ${{ secrets.PYPI_API_TEST_TOKEN }}
|
||||
run: |
|
||||
cd PythonPackage/AMR
|
||||
python -m twine upload --repository-url https://test.pypi.org/legacy/ dist/*
|
||||
|
||||
- name: Git push to python-wrapper branch
|
||||
run: |
|
||||
git config user.name "GitHub Actions"
|
||||
git config user.email "<>"
|
||||
|
||||
# Create and switch to python-wrapper branch (orphan if it doesn't exist)
|
||||
git fetch origin python-wrapper || true
|
||||
git checkout python-wrapper || git checkout --orphan python-wrapper
|
||||
|
||||
# Delete all existing files from the working tree (safely)
|
||||
git rm -rf . || true
|
||||
mv .git PythonPackage/AMR/
|
||||
ls -lh PythonPackage/AMR/
|
||||
find . -mindepth 1 ! -name 'PythonPackage' -exec rm -rf {} +
|
||||
|
||||
mv PythonPackage/AMR/* .
|
||||
rm -rf PythonPackage
|
||||
ls -lh
|
||||
|
||||
# Commit and push if changes exist
|
||||
git add .
|
||||
git commit -m "Python wrapper update" || echo "No changes to commit"
|
||||
git push origin python-wrapper --force
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -40,12 +40,12 @@ name: Update website
|
||||
jobs:
|
||||
update-website:
|
||||
runs-on: ubuntu-latest
|
||||
continue-on-error: true
|
||||
steps:
|
||||
|
||||
- uses: actions/checkout@v3
|
||||
- uses: actions/checkout@v4
|
||||
with:
|
||||
# this is to keep timestamps, the default fetch-depth: 1 gets the timestamps of the moment of cloning
|
||||
# we need this for the download page on our website - dates must be of the files, not of the latest git push
|
||||
fetch-depth: 0
|
||||
|
||||
- name: Preserve timestamps
|
||||
@@ -69,7 +69,6 @@ jobs:
|
||||
extra-packages: |
|
||||
any::pkgdown
|
||||
any::tidymodels
|
||||
any::data.table
|
||||
|
||||
# Send updates to repo using GH Actions bot
|
||||
- name: Create website in separate branch
|
||||
|
||||
@@ -21,6 +21,7 @@ packrat/lib*/
|
||||
packrat/src/
|
||||
data-raw/taxa.txt
|
||||
data-raw/taxon.tab
|
||||
data-raw/CLSI*.pdf
|
||||
data-raw/DSMZ_bactnames.xlsx
|
||||
data-raw/country_analysis_url_token.R
|
||||
data-raw/country_analysis2.R
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
Version: 1.0
|
||||
ProjectId: 5128c748-a412-44db-a5fb-45c68c93dd10
|
||||
|
||||
RestoreWorkspace: No
|
||||
SaveWorkspace: No
|
||||
|
||||
+43
-34
@@ -1,53 +1,62 @@
|
||||
Package: AMR
|
||||
Version: 2.1.1
|
||||
Date: 2023-10-20
|
||||
Version: 2.1.1.9210
|
||||
Date: 2025-03-15
|
||||
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
|
||||
using evidence-based methods, as described in <doi:10.18637/jss.v104.i03>.
|
||||
Authors@R: c(
|
||||
person(family = "Berends", c("Matthijs", "S."), role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800"), email = "m.s.berends@umcg.nl"),
|
||||
person(family = "Luz", c("Christian", "F."), role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-5809-5995")),
|
||||
person(family = "Souverein", c("Dennis"), role = c("aut", "ctb"), comment = c(ORCID = "0000-0003-0455-0336")),
|
||||
person(family = "Hassing", c("Erwin", "E.", "A."), role = c("aut", "ctb")),
|
||||
person(family = "Albers", c("Casper", "J."), role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
|
||||
person(family = "Dutey-Magni", c("Peter"), role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
|
||||
person(family = "Fonville", c("Judith", "M."), role = "ctb"),
|
||||
person(family = "Friedrich", c("Alex", "W."), role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
|
||||
person(family = "Glasner", c("Corinna"), role = "ths", comment = c(ORCID = "0000-0003-1241-1328")),
|
||||
person(family = "Hazenberg", c("Eric", "H.", "L.", "C.", "M."), role = "ctb"),
|
||||
person(family = "Knight", c("Gwen"), role = "ctb", comment = c(ORCID = "0000-0002-7263-9896")),
|
||||
person(family = "Lenglet", c("Annick"), role = "ctb", comment = c(ORCID = "0000-0003-2013-8405")),
|
||||
person(family = "Meijer", c("Bart", "C."), role = "ctb"),
|
||||
person(family = "Mykhailenko", c("Dmytro"), role = "ctb"),
|
||||
person(family = "Mymrikov", c("Anton"), role = "ctb"),
|
||||
person(family = "Norgan", c("Andrew", "P."), role = "ctb", comment = c(ORCID = "0000-0002-2955-2066")),
|
||||
person(family = "Ny", c("Sofia"), role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
|
||||
person(family = "Salm", c("Jonas"), role = "ctb"),
|
||||
person(family = "Schade", c("Rogier", "P."), role = "ctb"),
|
||||
person(family = "Sinha", c("Bhanu", "N.", "M."), role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
|
||||
person(family = "Underwood", c("Anthony"), role = "ctb", comment = c(ORCID = "0000-0002-8547-4277")),
|
||||
person(family = "Williams", c("Anita"), role = "ctb", comment = c(ORCID = "0000-0002-5295-8451")))
|
||||
person(given = c("Matthijs", "S."), family = "Berends", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800"), email = "m.s.berends@umcg.nl"),
|
||||
person(given = c("Dennis"), family = "Souverein", role = c("aut", "ctb"), comment = c(ORCID = "0000-0003-0455-0336")),
|
||||
person(given = c("Erwin", "E.", "A."), family = "Hassing", role = c("aut", "ctb")),
|
||||
person(given = c("Aislinn"), family = "Cook", role = "ctb", comment = c(ORCID = "0000-0002-9189-7815")),
|
||||
person(given = c("Andrew", "P."), family = "Norgan", role = "ctb", comment = c(ORCID = "0000-0002-2955-2066")),
|
||||
person(given = c("Anita"), family = "Williams", role = "ctb", comment = c(ORCID = "0000-0002-5295-8451")),
|
||||
person(given = c("Annick"), family = "Lenglet", role = "ctb", comment = c(ORCID = "0000-0003-2013-8405")),
|
||||
person(given = c("Anthony"), family = "Underwood", role = "ctb", comment = c(ORCID = "0000-0002-8547-4277")),
|
||||
person(given = c("Anton"), family = "Mymrikov", role = "ctb"),
|
||||
person(given = c("Bart", "C."), family = "Meijer", role = "ctb"),
|
||||
person(given = c("Christian", "F."), family = "Luz", role = "ctb", comment = c(ORCID = "0000-0001-5809-5995")),
|
||||
person(given = c("Dmytro"), family = "Mykhailenko", role = "ctb"),
|
||||
person(given = c("Eric", "H.", "L.", "C.", "M."), family = "Hazenberg", role = "ctb"),
|
||||
person(given = c("Gwen"), family = "Knight", role = "ctb", comment = c(ORCID = "0000-0002-7263-9896")),
|
||||
person(given = c("Jason"), family = "Stull", role = "ctb", comment = c(ORCID = "0000-0002-9028-8153")),
|
||||
person(given = c("Javier"), family = "Sanchez", role = "ctb", comment = c(ORCID = "0000-0003-2605-8094")),
|
||||
person(given = c("Jonas"), family = "Salm", role = "ctb"),
|
||||
person(given = c("Judith", "M."), family = "Fonville", role = "ctb"),
|
||||
person(given = c("Larisse"), family = "Bolton", role = "ctb", comment = c(ORCID = "0000-0001-7879-2173")),
|
||||
person(given = c("Matthew"), family = "Saab", role = "ctb"),
|
||||
person(given = c("Peter"), family = "Dutey-Magni", role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
|
||||
person(given = c("Rogier", "P."), family = "Schade", role = "ctb"),
|
||||
person(given = c("Sofia"), family = "Ny", role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
|
||||
person(given = c("Alex", "W."), family = "Friedrich", role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
|
||||
person(given = c("Bhanu", "N.", "M."), family = "Sinha", role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
|
||||
person(given = c("Casper", "J."), family = "Albers", role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
|
||||
person(given = c("Corinna"), family = "Glasner", role = "ths", comment = c(ORCID = "0000-0003-1241-1328")))
|
||||
Depends: R (>= 3.0.0)
|
||||
Enhances:
|
||||
cleaner,
|
||||
ggplot2,
|
||||
janitor,
|
||||
skimr,
|
||||
tibble,
|
||||
tidyselect,
|
||||
tsibble
|
||||
Suggests:
|
||||
cleaner,
|
||||
cli,
|
||||
crayon,
|
||||
curl,
|
||||
data.table,
|
||||
dplyr,
|
||||
ggplot2,
|
||||
knitr,
|
||||
openxlsx,
|
||||
pillar,
|
||||
progress,
|
||||
readxl,
|
||||
rmarkdown,
|
||||
rstudioapi,
|
||||
rvest,
|
||||
skimr,
|
||||
testthat,
|
||||
tibble,
|
||||
tidymodels,
|
||||
tidyselect,
|
||||
tinytest,
|
||||
vctrs,
|
||||
xml2
|
||||
VignetteBuilder: knitr,rmarkdown
|
||||
URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR
|
||||
@@ -55,5 +64,5 @@ BugReports: https://github.com/msberends/AMR/issues
|
||||
License: GPL-2 | file LICENSE
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
RoxygenNote: 7.2.3
|
||||
Roxygen: list(markdown = TRUE)
|
||||
RoxygenNote: 7.3.2
|
||||
Roxygen: list(markdown = TRUE, old_usage = TRUE)
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
S3method("!=",ab_selector)
|
||||
S3method("&",ab_selector)
|
||||
S3method("==",ab_selector)
|
||||
S3method("!=",amr_selector)
|
||||
S3method("&",amr_selector)
|
||||
S3method("==",amr_selector)
|
||||
S3method("[",ab)
|
||||
S3method("[",av)
|
||||
S3method("[",disk)
|
||||
@@ -13,7 +13,6 @@ S3method("[<-",av)
|
||||
S3method("[<-",disk)
|
||||
S3method("[<-",mic)
|
||||
S3method("[<-",mo)
|
||||
S3method("[<-",rsi)
|
||||
S3method("[<-",sir)
|
||||
S3method("[[",ab)
|
||||
S3method("[[",av)
|
||||
@@ -25,51 +24,49 @@ S3method("[[<-",av)
|
||||
S3method("[[<-",disk)
|
||||
S3method("[[<-",mic)
|
||||
S3method("[[<-",mo)
|
||||
S3method("[[<-",rsi)
|
||||
S3method("[[<-",sir)
|
||||
S3method("|",ab_selector)
|
||||
S3method("|",amr_selector)
|
||||
S3method(Complex,mic)
|
||||
S3method(Math,mic)
|
||||
S3method(Ops,mic)
|
||||
S3method(Summary,mic)
|
||||
S3method(all,ab_selector)
|
||||
S3method(all,ab_selector_any_all)
|
||||
S3method(any,ab_selector)
|
||||
S3method(any,ab_selector_any_all)
|
||||
S3method(all,amr_selector)
|
||||
S3method(all,amr_selector_any_all)
|
||||
S3method(antibiogram,default)
|
||||
S3method(antibiogram,grouped_df)
|
||||
S3method(any,amr_selector)
|
||||
S3method(any,amr_selector_any_all)
|
||||
S3method(as.data.frame,ab)
|
||||
S3method(as.data.frame,av)
|
||||
S3method(as.data.frame,mic)
|
||||
S3method(as.data.frame,mo)
|
||||
S3method(as.double,mic)
|
||||
S3method(as.double,sir)
|
||||
S3method(as.list,custom_eucast_rules)
|
||||
S3method(as.list,custom_mdro_guideline)
|
||||
S3method(as.list,mic)
|
||||
S3method(as.matrix,mic)
|
||||
S3method(as.numeric,mic)
|
||||
S3method(as.rsi,data.frame)
|
||||
S3method(as.rsi,default)
|
||||
S3method(as.rsi,disk)
|
||||
S3method(as.rsi,mic)
|
||||
S3method(as.sir,data.frame)
|
||||
S3method(as.sir,default)
|
||||
S3method(as.sir,disk)
|
||||
S3method(as.sir,mic)
|
||||
S3method(as.vector,mic)
|
||||
S3method(barplot,antibiogram)
|
||||
S3method(barplot,disk)
|
||||
S3method(barplot,mic)
|
||||
S3method(barplot,rsi)
|
||||
S3method(barplot,sir)
|
||||
S3method(c,ab)
|
||||
S3method(c,ab_selector)
|
||||
S3method(c,amr_selector)
|
||||
S3method(c,av)
|
||||
S3method(c,custom_eucast_rules)
|
||||
S3method(c,custom_mdro_guideline)
|
||||
S3method(c,disk)
|
||||
S3method(c,mic)
|
||||
S3method(c,mo)
|
||||
S3method(c,rsi)
|
||||
S3method(c,sir)
|
||||
S3method(close,progress_bar)
|
||||
S3method(droplevels,mic)
|
||||
S3method(droplevels,rsi)
|
||||
S3method(droplevels,sir)
|
||||
S3method(format,bug_drug_combinations)
|
||||
S3method(hist,mic)
|
||||
@@ -87,9 +84,9 @@ S3method(plot,antibiogram)
|
||||
S3method(plot,disk)
|
||||
S3method(plot,mic)
|
||||
S3method(plot,resistance_predict)
|
||||
S3method(plot,rsi)
|
||||
S3method(plot,sir)
|
||||
S3method(print,ab)
|
||||
S3method(print,amr_selector)
|
||||
S3method(print,av)
|
||||
S3method(print,bug_drug_combinations)
|
||||
S3method(print,custom_eucast_rules)
|
||||
@@ -100,15 +97,14 @@ S3method(print,mo)
|
||||
S3method(print,mo_renamed)
|
||||
S3method(print,mo_uncertainties)
|
||||
S3method(print,pca)
|
||||
S3method(print,rsi)
|
||||
S3method(print,sir)
|
||||
S3method(print,sir_log)
|
||||
S3method(quantile,mic)
|
||||
S3method(rep,ab)
|
||||
S3method(rep,av)
|
||||
S3method(rep,disk)
|
||||
S3method(rep,mic)
|
||||
S3method(rep,mo)
|
||||
S3method(rep,rsi)
|
||||
S3method(rep,sir)
|
||||
S3method(skewness,data.frame)
|
||||
S3method(skewness,default)
|
||||
@@ -117,14 +113,12 @@ S3method(sort,mic)
|
||||
S3method(summary,mic)
|
||||
S3method(summary,mo)
|
||||
S3method(summary,pca)
|
||||
S3method(summary,rsi)
|
||||
S3method(summary,sir)
|
||||
S3method(unique,ab)
|
||||
S3method(unique,av)
|
||||
S3method(unique,disk)
|
||||
S3method(unique,mic)
|
||||
S3method(unique,mo)
|
||||
S3method(unique,rsi)
|
||||
S3method(unique,sir)
|
||||
export("%like%")
|
||||
export("%like_case%")
|
||||
@@ -132,7 +126,6 @@ export("%unlike%")
|
||||
export("%unlike_case%")
|
||||
export(NA_disk_)
|
||||
export(NA_mic_)
|
||||
export(NA_rsi_)
|
||||
export(NA_sir_)
|
||||
export(ab_atc)
|
||||
export(ab_atc_group1)
|
||||
@@ -147,6 +140,7 @@ export(ab_info)
|
||||
export(ab_loinc)
|
||||
export(ab_name)
|
||||
export(ab_property)
|
||||
export(ab_reset_session)
|
||||
export(ab_selector)
|
||||
export(ab_synonyms)
|
||||
export(ab_tradenames)
|
||||
@@ -160,9 +154,12 @@ export(age_groups)
|
||||
export(all_antimicrobials)
|
||||
export(aminoglycosides)
|
||||
export(aminopenicillins)
|
||||
export(amr_class)
|
||||
export(amr_distance_from_row)
|
||||
export(amr_selector)
|
||||
export(anti_join_microorganisms)
|
||||
export(antibiogram)
|
||||
export(antibiotics)
|
||||
export(antifungals)
|
||||
export(antimicrobials_equal)
|
||||
export(antimycobacterials)
|
||||
@@ -171,7 +168,6 @@ export(as.av)
|
||||
export(as.disk)
|
||||
export(as.mic)
|
||||
export(as.mo)
|
||||
export(as.rsi)
|
||||
export(as.sir)
|
||||
export(atc_online_ddd)
|
||||
export(atc_online_ddd_units)
|
||||
@@ -192,6 +188,7 @@ export(av_tradenames)
|
||||
export(av_url)
|
||||
export(availability)
|
||||
export(betalactams)
|
||||
export(betalactams_with_inhibitor)
|
||||
export(brmo)
|
||||
export(bug_drug_combinations)
|
||||
export(carbapenems)
|
||||
@@ -217,21 +214,17 @@ export(custom_mdro_guideline)
|
||||
export(eucast_dosage)
|
||||
export(eucast_exceptional_phenotypes)
|
||||
export(eucast_rules)
|
||||
export(facet_rsi)
|
||||
export(facet_sir)
|
||||
export(filter_first_isolate)
|
||||
export(first_isolate)
|
||||
export(fluoroquinolones)
|
||||
export(full_join_microorganisms)
|
||||
export(g.test)
|
||||
export(geom_rsi)
|
||||
export(geom_sir)
|
||||
export(get_AMR_locale)
|
||||
export(get_episode)
|
||||
export(get_mo_source)
|
||||
export(ggplot_pca)
|
||||
export(ggplot_rsi)
|
||||
export(ggplot_rsi_predict)
|
||||
export(ggplot_sir)
|
||||
export(ggplot_sir_predict)
|
||||
export(glycopeptides)
|
||||
@@ -242,16 +235,14 @@ export(is.av)
|
||||
export(is.disk)
|
||||
export(is.mic)
|
||||
export(is.mo)
|
||||
export(is.rsi)
|
||||
export(is.rsi.eligible)
|
||||
export(is.sir)
|
||||
export(is_new_episode)
|
||||
export(is_sir_eligible)
|
||||
export(isoxazolylpenicillins)
|
||||
export(italicise_taxonomy)
|
||||
export(italicize_taxonomy)
|
||||
export(key_antimicrobials)
|
||||
export(kurtosis)
|
||||
export(labels_rsi_count)
|
||||
export(labels_sir_count)
|
||||
export(left_join_microorganisms)
|
||||
export(like)
|
||||
@@ -262,6 +253,8 @@ export(mdr_cmi2012)
|
||||
export(mdr_tb)
|
||||
export(mdro)
|
||||
export(mean_amr_distance)
|
||||
export(mic_p50)
|
||||
export(mic_p90)
|
||||
export(mo_authors)
|
||||
export(mo_class)
|
||||
export(mo_cleaning_regex)
|
||||
@@ -273,6 +266,7 @@ export(mo_fullname)
|
||||
export(mo_gbif)
|
||||
export(mo_genus)
|
||||
export(mo_gramstain)
|
||||
export(mo_group_members)
|
||||
export(mo_info)
|
||||
export(mo_is_anaerobic)
|
||||
export(mo_is_gram_negative)
|
||||
@@ -282,6 +276,7 @@ export(mo_is_yeast)
|
||||
export(mo_kingdom)
|
||||
export(mo_lpsn)
|
||||
export(mo_matching_score)
|
||||
export(mo_mycobank)
|
||||
export(mo_name)
|
||||
export(mo_order)
|
||||
export(mo_oxygen_tolerance)
|
||||
@@ -303,13 +298,15 @@ export(mo_type)
|
||||
export(mo_uncertainties)
|
||||
export(mo_url)
|
||||
export(mo_year)
|
||||
export(monobactams)
|
||||
export(mrgn)
|
||||
export(n_rsi)
|
||||
export(n_sir)
|
||||
export(nitrofurans)
|
||||
export(not_intrinsic_resistant)
|
||||
export(oxazolidinones)
|
||||
export(pca)
|
||||
export(penicillins)
|
||||
export(phenicols)
|
||||
export(polymyxins)
|
||||
export(proportion_I)
|
||||
export(proportion_IR)
|
||||
@@ -320,16 +317,25 @@ export(proportion_df)
|
||||
export(quinolones)
|
||||
export(random_disk)
|
||||
export(random_mic)
|
||||
export(random_rsi)
|
||||
export(random_sir)
|
||||
export(rescale_mic)
|
||||
export(reset_AMR_locale)
|
||||
export(resistance)
|
||||
export(resistance_predict)
|
||||
export(retrieve_wisca_parameters)
|
||||
export(rifamycins)
|
||||
export(right_join_microorganisms)
|
||||
export(rsi_df)
|
||||
export(rsi_predict)
|
||||
export(scale_rsi_colours)
|
||||
export(scale_color_mic)
|
||||
export(scale_color_sir)
|
||||
export(scale_colour_mic)
|
||||
export(scale_colour_sir)
|
||||
export(scale_fill_mic)
|
||||
export(scale_fill_sir)
|
||||
export(scale_sir_colors)
|
||||
export(scale_sir_colours)
|
||||
export(scale_x_mic)
|
||||
export(scale_x_sir)
|
||||
export(scale_y_mic)
|
||||
export(scale_y_percent)
|
||||
export(semi_join_microorganisms)
|
||||
export(set_AMR_locale)
|
||||
@@ -343,11 +349,12 @@ export(skewness)
|
||||
export(streptogramins)
|
||||
export(susceptibility)
|
||||
export(tetracyclines)
|
||||
export(theme_rsi)
|
||||
export(theme_sir)
|
||||
export(top_n_microorganisms)
|
||||
export(translate_AMR)
|
||||
export(trimethoprims)
|
||||
export(ureidopenicillins)
|
||||
export(wisca)
|
||||
importFrom(graphics,arrows)
|
||||
importFrom(graphics,axis)
|
||||
importFrom(graphics,barplot)
|
||||
|
||||
@@ -1,206 +1,113 @@
|
||||
# AMR 2.1.1
|
||||
# AMR 2.1.1.9210
|
||||
|
||||
* Fix for selecting first isolates using the phenotype-based method
|
||||
* This included too many isolates when patients had altering antibiograms within the same bacterial species
|
||||
* See for more info [our issue #122](https://github.com/msberends/AMR/issues/122)
|
||||
* Added 1,366 LOINC codes to the `antibiotics` data set and updated to the latest version (LOINC v2.76)
|
||||
* MICs can now be used in complex number calculations and allow scientific number format as input (e.g., `as.mic("1.28e-2")`)
|
||||
* Fix rounding MICs on latest R beta ('R-devel')
|
||||
* Removed unneeded note about the used language when option `AMR_locale` is set
|
||||
* Fixed non-ASCII characters in documentation, according to CRAN maintainers
|
||||
*(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://msberends.github.io/AMR/#latest-development-version).)*
|
||||
|
||||
#### A New Milestone: AMR v3.0 with One Health Support (= Human + Veterinary + Environmental)
|
||||
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.
|
||||
|
||||
# AMR 2.1.0
|
||||
## 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.
|
||||
|
||||
## New
|
||||
* Regarding clinical breakpoints:
|
||||
* Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added to the `clinical_breakpoints` data set for usage in `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations
|
||||
* The EUCAST dosage guideline of v13.0 has been added to the `dosage` data set
|
||||
* The `clinical_breakpoints` data set now also contains epidemiological cut-off (ECOFF) values and CLSI animal breakpoints. These two new breakpoint types can be used for MIC/disk interpretation using `as.sir(..., breakpoint_type = "ECOFF")` or`as.sir(..., breakpoint_type = "animal")`, which is an important new addition for veterinary microbiology.
|
||||
* Added support for 30 species groups / complexes. They are gathered in a new data set `microorganisms.groups` and are used in clinical breakpoint interpretation. For example, CLSI 2023 contains breakpoints for the RGM group (Rapidly Growing Mycobacterium, containing over 80 species) which is now supported by our package.
|
||||
* Added oxygen tolerance from BacDive to over 25,000 bacteria in the `microorganisms` data set
|
||||
* Added `mo_oxygen_tolerance()` to retrieve the values
|
||||
* Added `mo_is_anaerobic()` to determine which genera/species are obligate anaerobic bacteria
|
||||
* Added LPSN and GBIF identifiers, and oxygen tolerance to `mo_info()`
|
||||
* Added SAS Transport files (file extension `.xpt`) to [our download page](https://msberends.github.io/AMR/articles/datasets.html) to use in SAS software
|
||||
* Added microbial codes for Gram-negative/positive anaerobic bacteria
|
||||
* **One Health implementation**
|
||||
* Function `as.sir()` now has extensive support for veterinary breakpoints from CLSI. Use `breakpoint_type = "animal"` and set the `host` argument to a variable that contains animal species names.
|
||||
* The `clinical_breakpoints` data set contains all these breakpoints, and can be downloaded on our [download page](https://msberends.github.io/AMR/articles/datasets.html).
|
||||
* The (new) `antimicrobials` data set contains all veterinary antibiotics, such as pradofloxacin and enrofloxacin. All WHOCC codes for veterinary use have been added as well.
|
||||
* `ab_atc()` now supports ATC codes of veterinary antibiotics (that all start with "Q")
|
||||
* `ab_url()` now supports retrieving the WHOCC url of their ATCvet pages
|
||||
* **Support for WISCA antibiograms**
|
||||
* The `antibiogram()` function now supports creating true Weighted-Incidence Syndromic Combination Antibiograms (WISCA), a powerful Bayesian method for estimating regimen coverage probabilities using pathogen incidence and antimicrobial susceptibility data. WISCA offers improved precision for syndrome-specific treatment, even in datasets with sparse data. A dedicated `wisca()` function is also available for easy usage.
|
||||
* **Major update to fungal taxonomy and tools for mycologists**
|
||||
* MycoBank has now been integrated as the primary taxonomic source for fungi. The `microorganisms` data set has been enriched with new columns (`mycobank`, `mycobank_parent`, and `mycobank_renamed_to`) that provide detailed information for fungal species.
|
||||
* A remarkable addition of over 20,000 new fungal records
|
||||
* New function `mo_mycobank()` to retrieve the MycoBank record number, analogous to existing functions such as `mo_lpsn()` and `mo_gbif()`.
|
||||
* The `as.mo()` function and all `mo_*()` functions now include an `only_fungi` argument, allowing users to restrict results solely to fungal species. This ensures fungi are prioritised over bacteria during microorganism identification. This can also be set globally with the new `AMR_only_fungi` option.
|
||||
* Also updated other kingdoms, welcoming a total of 2,149 new records from 2023 and 927 from 2024.
|
||||
* **Updated clinical breakpoints**
|
||||
* EUCAST 2024 and CLSI 2024 are now supported, by adding all of their over 4,000 new clinical breakpoints to the `clinical_breakpoints` data set for usage in `as.sir()`. EUCAST 2024 is now the new default guideline for all MIC and disk diffusion interpretations.
|
||||
* `as.sir()` now brings additional factor levels: "NI" for non-interpretable and "SDD" for susceptible dose-dependent. Currently, the `clinical_breakpoints` data set contains 24 breakpoints that can return the value "SDD" instead of "I".
|
||||
* EUCAST interpretive rules (using `eucast_rules()`) are now available for EUCAST 12 (2022), 13 (2023), and 14 (2024).
|
||||
* **New advanced ggplot2 extensions for MIC and SIR plotting and transforming**
|
||||
* New function group `scale_*_mic()`, namely: `scale_x_mic()`, `scale_y_mic()`, `scale_colour_mic()` and `scale_fill_mic()`. They allow easy plotting of MIC values. They allow for manual range definition and plotting missing intermediate log2 levels.
|
||||
* New function group `scale_*_sir()`, namely: `scale_x_sir()`, `scale_colour_sir()` and `scale_fill_sir()`. They allow to plot the `sir` class, and translates into the system language at default. They also set colourblind-safe colours to the plots.
|
||||
* New function `rescale_mic()`, which allows users to rescale MIC values to a manually set range. This is the powerhouse behind the `scale_*_mic()` functions, but it can be used independently to, for instance, compare equality in MIC distributions by rescaling them to the same range first.
|
||||
* **Support for Python**
|
||||
* While using R for the heavy lifting, [our 'AMR' Python Package](https://pypi.org/project/AMR/) was developed to run the AMR R package natively in Python. The Python package will always have the same version number as the R package, as it is built automatically with every code change.
|
||||
* **Support for `tidymodels`**
|
||||
* All antimicrobial selectors (such as `aminoglycosides()` and `betalactams()`) are now supported in `tidymodels` packages such as `recipe` and `parsnip`. See for more info [our tutorial](https://msberends.github.io/AMR/articles/AMR_with_tidymodels.html) on using these AMR functions for predictive modelling.
|
||||
* **Other**
|
||||
* New function `top_n_microorganisms()` to filter a data set to the top *n* of any taxonomic property, e.g., filter to the top 3 species, filter to any species in the top 5 genera, or filter to the top 3 species in each of the top 5 genera
|
||||
* New function `mo_group_members()` to retrieve the member microorganisms of a microorganism group. For example, `mo_group_members("Strep group C")` returns a vector of all microorganisms that belong to that group.
|
||||
* New functions `mic_p50()` and `mic_p90()` to retrieve the 50th and 90th percentile of MIC values.
|
||||
|
||||
## Changed
|
||||
* Updated algorithm of `as.mo()` by giving more weight to fungi
|
||||
* Fixed clinical breakpoints errors introduced by the source we import the rules from
|
||||
* `mo_rank()` now returns `NA` for 'unknown' microorganisms (`B_ANAER`, `B_ANAER-NEG`, `B_ANAER-POS`, `B_GRAMN`, `B_GRAMP`, `F_FUNGUS`, `F_YEAST`, and `UNKNOWN`)
|
||||
* When printing microorganism or antibiotic codes in a tibble, a mouse-hover now shows the full name of the code
|
||||
* Plots for MIC and disk diffusion values:
|
||||
* Now have settable arguments for breakpoint type and PK/PD, like `as.sir()`
|
||||
* Will now contain the name of the guideline table in the subtitle of the plot
|
||||
* Fixed formatting for `sir_interpretation_history()`
|
||||
* Fixed some WHONET codes for microorganisms and consequently a couple of entries in `clinical_breakpoints`
|
||||
* Fixed a bug for `as.mo()` that led to coercion of `NA` values when using custom microorganism codes
|
||||
* Fixed usage of `icu_exclude` in `first_isolates()`
|
||||
* Improved `as.mo()` algorithm:
|
||||
* Now allows searching on only species names
|
||||
* Fix for using the `keep_synonyms` argument when using MO codes as input
|
||||
* Fix for using the `minimum_matching_score` argument
|
||||
* Updated the code table in `microorganisms.codes`
|
||||
* Fixed an endless loop if using `reference_df` in `as.mo()`
|
||||
* Fixed bug for indicating UTIs in `as.sir()`
|
||||
* Greatly improved speed of `as.sir()`
|
||||
|
||||
|
||||
# AMR 2.0.0
|
||||
|
||||
This is a new major release of the AMR package, with great new additions but also some breaking changes for current users. These are all listed below.
|
||||
|
||||
**[TL;DR](https://en.wikipedia.org/wiki/TL;DR)**
|
||||
|
||||
* All functions and arguments with 'rsi' were replaced with 'sir', such as the interpretation of MIC values (now `as.sir()` instead of `as.rsi()`) - all old functions still work for now
|
||||
* Many new interesting functions, such as `antibiogram()` (for generating traditional/combined/syndromic/WISCA antibiograms), `sir_confidence_interval()` and `mean_amr_distance()`, and `add_custom_microorganisms()` to add custom microorganisms to this package
|
||||
* Clinical breakpoints added for EUCAST 2022 and CLSI 2022
|
||||
* Microbiological taxonomy (`microorganisms` data set) updated to 2022 and now based on LPSN and GBIF
|
||||
* Much increased algorithms to translate user input to valid taxonomy, e.g. by using [recent scientific work](https://doi.org/10.1099/mic.0.001269) about per-species human pathogenicity
|
||||
* 20 new antibiotics added and updated all DDDs and ATC codes
|
||||
* Extended support for antiviral agents (`antivirals` data set), with many new functions
|
||||
* Now available in 20 languages
|
||||
* Many small bug fixes
|
||||
|
||||
## New
|
||||
|
||||
### SIR vs. RSI
|
||||
|
||||
For this milestone version, we replaced all mentions of RSI with SIR, to comply with what is actually being commonly used in the field of clinical microbiology when it comes to this tri-form regarding AMR.
|
||||
|
||||
While existing functions such as `as.rsi()`, `rsi_df()` and `ggplot_rsi()` still work, their replacements `as.sir()`, `sir_df()`, `ggplot_sir()` are now the current functions for AMR data analysis. A warning will be thrown once a session to remind users about this. The data set `rsi_translation` is now called `clinical_breakpoints` to better reflect its content.
|
||||
|
||||
The 'RSI functions' will be removed in a future version, but not before late 2023 / early 2024.
|
||||
|
||||
### New antibiogram function
|
||||
|
||||
With the new `antibiogram()` function, users can now generate traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA). With this, we follow the logic in the previously described work of Klinker *et al.* (2021, DOI [10.1177/20499361211011373](https://doi.org/10.1177/20499361211011373)) and Barbieri *et al.* (2021, DOI [10.1186/s13756-021-00939-2](https://doi.org/10.1186/s13756-021-00939-2)).
|
||||
|
||||
The help page for `antibiogram()` extensively elaborates on use cases, and `antibiogram()` also supports printing in R Markdown and Quarto, with support for 20 languages.
|
||||
|
||||
Furthermore, different plotting methods were implemented to allow for graphical visualisations as well.
|
||||
|
||||
### Interpretation of MIC and disk diffusion values
|
||||
|
||||
The clinical breakpoints and intrinsic resistance of EUCAST 2022 and CLSI 2022 have been added for `as.sir()`. EUCAST 2022 (v12.0) is now the new default guideline for all MIC and disks diffusion interpretations, and for `eucast_rules()` to apply EUCAST Expert Rules. The default guideline (EUCAST) can now be changed with the new `AMR_guideline` option, such as: `options(AMR_guideline = "CLSI 2020")`.
|
||||
|
||||
With the new arguments `include_PKPD` (default: `TRUE`) and `include_screening` (default: `FALSE`), users can now specify whether breakpoints for screening and from the PK/PD table should be included when interpreting MICs and disks diffusion values. These options can be set globally, which can be read in [our new manual](https://msberends.github.io/AMR/reference/AMR-options.html).
|
||||
|
||||
Interpretation guidelines older than 10 years were removed, the oldest now included guidelines of EUCAST and CLSI are from 2013.
|
||||
|
||||
### Supported languages
|
||||
|
||||
We added support for the following ten languages: Chinese (simplified), Czech, Finnish, Greek, Japanese, Norwegian (bokmål), Polish, Romanian, Turkish and Ukrainian. All antibiotic names are now available in these languages, and the AMR package will automatically determine a supported language based on the user's system language.
|
||||
|
||||
We are very grateful for the valuable input by our colleagues from other countries. The `AMR` package is now available in 20 languages in total, and according to download stats used in almost all countries in the world!
|
||||
|
||||
### Outbreak management
|
||||
|
||||
For analysis in outbreak management, we updated the `get_episode()` and `is_new_episode()` functions: they now contain an argument `case_free_days`. This argument can be used to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start.
|
||||
|
||||
This is common requirement in outbreak management, e.g. when determining the number of norovirus outbreaks in a hospital. The case-free period could then be 14 or 28 days, so that new norovirus cases after that time will be considered a different (or new) episode.
|
||||
|
||||
### Microbiological taxonomy
|
||||
|
||||
The `microorganisms` data set no longer relies on the Catalogue of Life, but on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and is supplemented with the 'backbone taxonomy' from the Global Biodiversity Information Facility (GBIF). The structure of this data set has changed to include separate LPSN and GBIF identifiers. Almost all previous MO codes were retained. It contains over 1,400 taxonomic names from 2022.
|
||||
|
||||
We previously relied on our own experience to categorise species into pathogenic groups, but we were very happy to encounter the very recent work of Bartlett *et al.* (2022, DOI [10.1099/mic.0.001269](https://doi.org/10.1099/mic.0.001269)) who extensively studied medical-scientific literature to categorise all bacterial species into groups. See `mo_matching_score()` on how their work was incorporated into the `prevalence` column of the `microorganisms` data set. Using their results, the `as.mo()` and all `mo_*()` functions are now much better capable of converting user input to valid taxonomic records.
|
||||
|
||||
The new function `add_custom_microorganisms()` allows users to add custom microorganisms to the `AMR` package.
|
||||
|
||||
We also made the following changes regarding the included taxonomy or microorganisms functions:
|
||||
|
||||
* Updated full microbiological taxonomy according to the latest daily LPSN data set (December 2022) and latest yearly GBIF taxonomy backbone (November 2022)
|
||||
* Added function `mo_current()` to get the currently valid taxonomic name of a microorganism
|
||||
* Support for all 1,516 city-like serovars of *Salmonella*, such as *Salmonella* Goldcoast. Formally, these are serovars belonging to the *S. enterica* species, but they are reported with only the name of the genus and the city. For this reason, the serovars are in the `subspecies` column of the `microorganisms` data set and "enterica" is in the `species` column, but the full name does not contain the species name (*enterica*).
|
||||
* All new algorithm for `as.mo()` (and thus all `mo_*()` functions) while still following our original set-up as described in our recently published JSS paper (DOI [10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)).
|
||||
* A new argument `keep_synonyms` allows to *not* correct for updated taxonomy, in favour of the now deleted argument `allow_uncertain`
|
||||
* It has increased tremendously in speed and returns generally more consequent results
|
||||
* Sequential coercion is now extremely fast as results are stored to the package environment, although coercion of unknown values must be run once per session. Previous results can be reset/removed with the new `mo_reset_session()` function.
|
||||
* Support for microorganism codes of the ASIan Antimicrobial Resistance Surveillance Network (ASIARS-Net)
|
||||
* The MO matching score algorithm (`mo_matching_score()`) now counts deletions and substitutions as 2 instead of 1, which impacts the outcome of `as.mo()` and any `mo_*()` function
|
||||
* **Removed all species of the taxonomic kingdom Chromista** from the package. This was done for multiple reasons:
|
||||
* CRAN allows packages to be around 5 MB maximum, some packages are exempted but this package is not one of them
|
||||
* Chromista are not relevant when it comes to antimicrobial resistance, thus lacking the primary scope of this package
|
||||
* Chromista are almost never clinically relevant, thus lacking the secondary scope of this package
|
||||
* The `microorganisms.old` data set was removed, and all previously accepted names are now included in the `microorganisms` data set. A new column `status` contains `"accepted"` for currently accepted names and `"synonym"` for taxonomic synonyms; currently invalid names. All previously accepted names now have a microorganisms ID and - if available - an LPSN, GBIF and SNOMED CT identifier.
|
||||
|
||||
### Antibiotic agents and selectors
|
||||
|
||||
The new function `add_custom_antimicrobials()` allows users to add custom antimicrobial codes and names to the `AMR` package.
|
||||
|
||||
The `antibiotics` data set was greatly updated:
|
||||
|
||||
* The following 20 antibiotics have been added (also includes the [new J01RA ATC group](https://www.whocc.no/atc_ddd_index/?code=J01RA&showdescription=no)): azithromycin/fluconazole/secnidazole (AFC), cefepime/amikacin (CFA), cefixime/ornidazole (CEO), ceftriaxone/beta-lactamase inhibitor (CEB), ciprofloxacin/metronidazole (CIM), ciprofloxacin/ornidazole (CIO), ciprofloxacin/tinidazole (CIT), furazidin (FUR), isoniazid/sulfamethoxazole/trimethoprim/pyridoxine (IST), lascufloxacin (LSC), levofloxacin/ornidazole (LEO), nemonoxacin (NEM), norfloxacin/metronidazole (NME), norfloxacin/tinidazole (NTI), ofloxacin/ornidazole (OOR), oteseconazole (OTE), rifampicin/ethambutol/isoniazid (REI), sarecycline (SRC), tetracycline/oleandomycin (TOL), and thioacetazone (TAT)
|
||||
* Added some missing ATC codes
|
||||
* Updated DDDs and PubChem Compound IDs
|
||||
* Updated some antibiotic name spelling, now used by WHOCC (such as cephalexin -> cefalexin, and phenethicillin -> pheneticillin)
|
||||
* Antibiotic code "CEI" for ceftolozane/tazobactam has been replaced with "CZT" to comply with EARS-Net and WHONET 2022. The old code will still work in all cases when using `as.ab()` or any of the `ab_*()` functions.
|
||||
* Support for antimicrobial interpretation of anaerobic bacteria, by adding a 'placeholder' code `B_ANAER` to the `microorganisms` data set and adding the breakpoints of anaerobics to the `clinical_breakpoints` data set, which is used by `as.sir()` for interpretion of MIC and disk diffusion values
|
||||
|
||||
Also, we added support for using antibiotic selectors in scoped `dplyr` verbs (with or without using `vars()`), such as in: `... %>% summarise_at(aminoglycosides(), resistance)`, please see `resistance()` for examples.
|
||||
|
||||
### Antiviral agents
|
||||
|
||||
We now added extensive support for antiviral agents! For the first time, the `AMR` package has extensive support for antiviral drugs and to work with their names, codes and other data in any way.
|
||||
|
||||
* The `antivirals` data set has been extended with 18 new drugs (also from the [new J05AJ ATC group](https://www.whocc.no/atc_ddd_index/?code=J05AJ&showdescription=no)) and now also contains antiviral identifiers and LOINC codes
|
||||
* A new data type `av` (*antivirals*) has been added, which is functionally similar to `ab` for antibiotics
|
||||
* Functions `as.av()`, `av_name()`, `av_atc()`, `av_synonyms()`, `av_from_text()` have all been added as siblings to their `ab_*()` equivalents
|
||||
|
||||
### Other new functions
|
||||
|
||||
* Function `sir_confidence_interval()` to add confidence intervals in AMR calculation. This is now also included in `sir_df()` and `proportion_df()`.
|
||||
* Function `mean_amr_distance()` to calculate the mean AMR distance. The mean AMR distance is a normalised numeric value to compare AMR test results and can help to identify similar isolates, without comparing antibiograms by hand.
|
||||
* Function `sir_interpretation_history()` to view the history of previous runs of `as.sir()` (previously `as.rsi()`). This returns a 'logbook' with the selected guideline, reference table and specific interpretation of each row in a data set on which `as.sir()` was run.
|
||||
|
||||
|
||||
## Changes
|
||||
|
||||
* `get_episode()` (and its wrapper `is_new_episode()`):
|
||||
* Fix for working with `NA` values
|
||||
* Fix for unsorted dates of length 2
|
||||
* Now returns class `integer` instead of `numeric` since they are always whole numbers
|
||||
* Argument `combine_IR` has been removed from this package (affecting functions `count_df()`, `proportion_df()`, and `sir_df()` and some plotting functions), since it was replaced with `combine_SI` three years ago
|
||||
* Using `units` in `ab_ddd(..., units = "...")` had been deprecated for some time and is now not supported anymore. Use `ab_ddd_units()` instead.
|
||||
* Support for `data.frame`-enhancing R packages, more specifically: `data.table::data.table`, `janitor::tabyl`, `tibble::tibble`, and `tsibble::tsibble`. AMR package functions that have a data set as output (such as `sir_df()` and `bug_drug_combinations()`), will now return the same data type as the input.
|
||||
* All data sets in this package are now a `tibble`, instead of base R `data.frame`s. Older R versions are still supported, even if they do not support `tibble`s.
|
||||
* Our data sets are now also continually exported to **Apache Feather and Apache Parquet formats**. You can find more info [in this article on our website](https://msberends.github.io/AMR/articles/datasets.html).
|
||||
* For `as.sir()`:
|
||||
* Fixed certain EUCAST breakpoints for MIC values
|
||||
* Allow `NA` values (e.g. `as.sir(as.disk(NA), ...)`)
|
||||
* Fix for bug-drug combinations with multiple breakpoints for different body sites
|
||||
* Interpretation from MIC and disk zones is now more informative about availability of breakpoints and more robust
|
||||
* Removed the `as.integer()` method for MIC values, since MIC are not integer values and running `table()` on MIC values consequently failed for not being able to retrieve the level position (as that's how normally `as.integer()` on `factor`s work)
|
||||
* Fixed determination of Gram stains (`mo_gramstain()`), since the taxonomic phyla Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes have been renamed to respectively Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota in 2021
|
||||
* `droplevels()` on MIC will now return a common `factor` at default and will lose the `mic` class. Use `droplevels(..., as.mic = TRUE)` to keep the `mic` class.
|
||||
* Small fix for using `ab_from_text()`
|
||||
* Fixes for reading in text files using `set_mo_source()`, which now also allows the source file to contain valid taxonomic names instead of only valid microorganism ID of this package
|
||||
* Fixed a bug for `mdro()` when using similar column names with the Magiorakos guideline
|
||||
* Using any `random_*()` function (such as `random_mic()`) is now possible by directly calling the package without loading it first: `AMR::random_mic(10)`
|
||||
* Extended support for the `vctrs` package, used internally by the tidyverse. This allows to change values of class `mic`, `disk`, `sir`, `mo` and `ab` in tibbles, and to use antibiotic selectors for selecting/filtering, e.g. `df[carbapenems() == "R", ]`
|
||||
* Fix for using `info = FALSE` in `mdro()`
|
||||
* For all interpretation guidelines using `as.sir()` on amoxicillin, the rules for ampicillin will be used if amoxicillin rules are not available
|
||||
* Fix for using `ab_atc()` on non-existing ATC codes
|
||||
* Black and white message texts are now reversed in colour if using an RStudio dark theme
|
||||
* `mo_snomed()` now returns class `character`, not `numeric` anymore (to make long SNOMED codes readable)
|
||||
* Fix for using `as.ab()` on `NA` values
|
||||
* Updated support for all WHONET 2022 microorganism codes
|
||||
* Antimicrobial interpretation 'SDD' (susceptible dose-dependent, coined by CLSI) will be interpreted as 'I' to comply with EUCAST's 'I' in `as.sir()`
|
||||
* Fix for `mo_shortname()` in case of higher taxonomic ranks (order, class, phylum)
|
||||
* Cleaning columns with `as.sir()`, `as.mic()`, or `as.disk()` will now show the column name in the warning for invalid results
|
||||
* Fix for using `g.test()` with zeroes in a 2x2 table
|
||||
* `mo_synonyns()` now contains the scientific reference as names
|
||||
* SIR interpretation
|
||||
* It is now possible to use column names for argument `ab`, `mo`, and `uti`: `as.sir(..., ab = "column1", mo = "column2", uti = "column3")`. This greatly improves the flexibility for users.
|
||||
* Users can now set their own criteria (using regular expressions) as to what should be considered S, I, R, SDD, and NI.
|
||||
* To get quantitative values, `as.double()` on a `sir` object will return 1 for S, 2 for SDD/I, and 3 for R (NI will become `NA`). Other functions using `sir` classes (e.g., `summary()`) are updated to reflect the change to contain NI and SDD.
|
||||
* The argument `conserve_capped_values` in `as.sir()` has been replaced with `capped_mic_handling`, which allows greater flexibility in handling capped MIC values (`<`, `<=`, `>`, `>=`). The four available options (`"standard"`, `"strict"`, `"relaxed"`, `"inverse"`) provide full control over whether these values should be interpreted conservatively or ignored. Using `conserve_capped_values` is now deprecated and returns a warning.
|
||||
* `antibiogram()` function
|
||||
* Argument `antibiotics` has been renamed to `antimicrobials`. Using `antibiotics` will still work, but now returns a warning.
|
||||
* Added argument `formatting_type` to set any of the 22 options for the formatting of all 'cells'. This defaults to `18` for non-WISCA and `14` for WISCA, changing the output of antibiograms to cells with more info.
|
||||
* For this reason, `add_total_n` is now `FALSE` at default since the denominators are added to the cells for non-WISCA. For WISCA, the denominator is not useful anyway.
|
||||
* The `ab_transform` argument now defaults to `"name"`, displaying antibiotic column names instead of codes
|
||||
* Antimicrobial selectors (previously: *antibiotic selectors*)
|
||||
* 'Antibiotic selectors' are now called 'antimicrobial selectors' since their scope is broader than just antibiotics. All documentation have been updated, and `ab_class()` and `ab_selector()` have been replaced with `amr_class()` and `amr_selector()`. The old functions are now deprecated and will be removed in a future version.
|
||||
* Added selectors `isoxazolylpenicillins()`, `monobactams()`, `nitrofurans()`, `phenicols()`, and `rifamycins()`
|
||||
* When using antimicrobial selectors that exclude non-treatable drugs (such as gentamicin-high when using `aminoglycosides()`), the function now always returns a warning that these can be included using `only_treatable = FALSE`
|
||||
* Added a new argument `return_all` to all selectors, which defaults to `TRUE` to include any match. With `FALSE`, the old behaviour, only the first hit for each unique antimicrobial is returned.
|
||||
* All selectors can now be run as a separate command to retrieve a vector of all possible antimicrobials that the selector can select
|
||||
* The selectors `lincosamides()` and `macrolides()` do not overlap anymore - each antibiotic is now classified as either of these and not both
|
||||
* Fixed selector `fluoroquinolones()`, which now really only selects second-generation quinolones and up (first-generation quinolones do not contain a fluorine group)
|
||||
* `antimicrobials` data set
|
||||
* Added agents used for screening, with an ID all ending with `-S`: benzylpenicillin screening test (`PEN-S`), beta-lactamase screening test (`BTL-S`), cefotaxime screening test (`CTX-S`), clindamycin inducible screening test (`CLI-S`), nalidixic acid screening test (`NAL-S`), norfloxacin screening test (`NOR-S`), oxacillin screening test (`OXA-S`), pefloxacin screening test (`PEF-S`), and tetracycline screening test (`TCY-S`). The ID of cefoxitin screening was renamed from `FOX1` to `FOX-S`, while the old code remains to work.
|
||||
* For this reason, the antimicrobial selectors `cephalosporins()`, `cephalosporins_3rd()`, `lincosamides()`, `isoxazolylpenicillins()`, `quinolones()`, `fluoroquinolones()`, and `tetracyclines()` now contain the argument `only_treatable = TRUE` (similar to other antimicrobial selectors that contain non-treatable drugs)
|
||||
* Added amorolfine (`AMO`, D01AE16), which is now also part of the `antifungals()` selector
|
||||
* Added efflux (`EFF`), to allow mapping to AMRFinderPlus
|
||||
* Added tigemonam (`TNM`), a monobactam
|
||||
* Added bleomycin (`BLM`), a glycopeptide
|
||||
* Added over 1,500 trade names
|
||||
* MICs
|
||||
* Added as valid levels: 4096, 6 powers of 0.0625, and 5 powers of 192 (192, 384, 576, 768, 960)
|
||||
* Fixed a bug in `as.mic()` that failed translation of scientifically formatted numbers
|
||||
* Added new argument `keep_operators` to `as.mic()`. This can be `"all"` (default), `"none"`, or `"edges"`. This argument is also available in the new `rescale_mic()` and `scale_*_mic()` functions.
|
||||
* Comparisons of MIC values are now more strict. For example, `>32` is higher than (and never equal to) `32`. Thus, `as.mic(">32") == as.mic(32)` now returns `FALSE`, and `as.mic(">32") > as.mic(32)` now returns `TRUE`.
|
||||
* Sorting of MIC values (using `sort()`) was fixed in the same manner; `<0.001` now gets sorted before `0.001`, and `>0.001` gets sorted after `0.001`.
|
||||
* Intermediate log2 levels used for MIC plotting are now more common values instead of following a strict dilution range
|
||||
* `eucast_rules()` now has an argument `overwrite` (default: `FALSE`) to indicate whether non-`NA` values should be overwritten
|
||||
* Disks of 0 to 5 mm are now allowed, the newly allowed range for disk diffusion (`as.disk()`) is now between 0 and 50 mm
|
||||
* Updated `italicise_taxonomy()` to support HTML output
|
||||
* `custom_eucast_rules()` now supports multiple antibiotics and antibiotic groups to be affected by a single rule
|
||||
* `mo_info()` now contains an extra element `rank` and `group_members` (with the contents of the new `mo_group_members()` function)
|
||||
* Updated all ATC codes from WHOCC
|
||||
* Updated all antibiotic 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
|
||||
* Fix for mapping 'high level' antibiotics 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.
|
||||
* Improved overall algorithm of `as.mo()` for better performance and accuracy, specifically:
|
||||
* More weight is given to genus and species combinations in cases where the subspecies is miswritten, so that the result will be the correct genus and species
|
||||
* Genera from the World Health Organization's (WHO) Priority Pathogen List now have the highest prevalence
|
||||
* Fixed a bug for `sir_confidence_interval()` when there are no isolates available
|
||||
* Updated the prevalence calculation to include genera from the World Health Organization's (WHO) Priority Pathogen List
|
||||
* 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()`)
|
||||
* 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 console colours support of `sir` class for Positron
|
||||
|
||||
## Other
|
||||
* Added Dr. Larisse Bolton and Aislinn Cook as contributors for their fantastic implementation of WISCA in a mathematically solid way
|
||||
* Added Matthew Saab, Dr. Jordan Stull, and Prof. Javier Sanchez as contributors for their tremendous input on veterinary breakpoints and interpretations
|
||||
* Greatly improved `vctrs` integration, a Tidyverse package working in the background for many Tidyverse functions. For users, this means that functions such as `dplyr`'s `bind_rows()`, `rowwise()` and `c_across()` are now supported for e.g. columns of class `mic`. Despite this, this `AMR` package is still zero-dependent on any other package, including `dplyr` and `vctrs`.
|
||||
* Greatly updated and expanded documentation
|
||||
* Stopped support for SAS (`.xpt`) files, since their file structure and extremely inefficient and requires more disk space than GitHub allows in a single commit.
|
||||
|
||||
* Added Peter Dutey-Magni, Dmytro Mykhailenko, Anton Mymrikov, Andrew Norgan, Jonas Salm, and Anita Williams as contributors, to thank them for their valuable input
|
||||
* New website to make use of the new Bootstrap 5 and pkgdown 2.0. The website now contains results for all examples and will be automatically regenerated with every change to our repository, using GitHub Actions
|
||||
* All R and Rmd files in this project are now styled using the `styler` package
|
||||
* Set scalar conditional expressions (`&&` and `||`) where possible to comply with the upcoming R 4.3
|
||||
* An enormous lot of code cleaning, fixing some small bugs along the way
|
||||
## Older Versions
|
||||
|
||||
----
|
||||
This changelog only contains changes from AMR v3.0 (March 2025) and later.
|
||||
|
||||
This changelog only contains changes from AMR v2.0 (January 2023) and later. For prior versions, please see [our archive](https://github.com/msberends/AMR/blob/v1.8.2/NEWS.md).
|
||||
* 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).
|
||||
|
||||
+5
-5
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -36,11 +36,11 @@
|
||||
#'
|
||||
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
||||
#'
|
||||
#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)` microorganisms**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated `r format(TAXONOMY_VERSION$GBIF$accessed_date, "%B %Y")`) and all [**`r format_included_data_number(nrow(AMR::antibiotics) + nrow(AMR::antivirals))` antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.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 and EUCAST 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 public [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
|
||||
#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)` microorganisms**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated `r format(TAXONOMY_VERSION$GBIF$accessed_date, "%B %Y")`) and all [**`r format_included_data_number(nrow(AMR::antimicrobials) + nrow(AMR::antivirals))` antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/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 and EUCAST 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 public [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
|
||||
#'
|
||||
#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||
#' @section Reference Data Publicly Available:
|
||||
#' All data sets in this `AMR` package (about microorganisms, antibiotics, SIR interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' All data sets in this `AMR` package (about microorganisms, antimicrobials, SIR interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @source
|
||||
#' To cite AMR in publications use:
|
||||
#'
|
||||
|
||||
+52
-17
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -28,14 +28,20 @@
|
||||
# ==================================================================== #
|
||||
|
||||
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and clinical_breakpoints
|
||||
# (sourcing "data-raw/_pre_commit_hook.R" will process the TSV file)
|
||||
# (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
|
||||
EUCAST_VERSION_BREAKPOINTS <- list(
|
||||
# "13.0" = list(
|
||||
# version_txt = "v13.0",
|
||||
# year = 2023,
|
||||
# title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
# url = "https://www.eucast.org/clinical_breakpoints/"
|
||||
# ),
|
||||
"14.0" = list(
|
||||
version_txt = "v14.0",
|
||||
year = 2024,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"
|
||||
),
|
||||
"13.1" = list(
|
||||
version_txt = "v13.1",
|
||||
year = 2023,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"
|
||||
),
|
||||
"12.0" = list(
|
||||
version_txt = "v12.0",
|
||||
year = 2022,
|
||||
@@ -86,26 +92,37 @@ EUCAST_VERSION_EXPERT_RULES <- list(
|
||||
|
||||
TAXONOMY_VERSION <- list(
|
||||
GBIF = list(
|
||||
accessed_date = as.Date("2022-12-11"),
|
||||
citation = "GBIF Secretariat (2022). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
|
||||
name = "Global Biodiversity Information Facility (GBIF)",
|
||||
accessed_date = as.Date("2024-06-24"),
|
||||
citation = "GBIF Secretariat (2023). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
|
||||
url = "https://www.gbif.org"
|
||||
),
|
||||
LPSN = list(
|
||||
accessed_date = as.Date("2022-12-11"),
|
||||
name = "List of Prokaryotic names with Standing in Nomenclature (LPSN)",
|
||||
accessed_date = as.Date("2024-06-24"),
|
||||
citation = "Parte, AC *et al.* (2020). **List of Prokaryotic names with Standing in Nomenclature (LPSN) moves to the DSMZ.** International Journal of Systematic and Evolutionary Microbiology, 70, 5607-5612; \\doi{10.1099/ijsem.0.004332}.",
|
||||
url = "https://lpsn.dsmz.de"
|
||||
),
|
||||
MycoBank = list(
|
||||
name = "MycoBank",
|
||||
accessed_date = as.Date("2024-06-24"),
|
||||
citation = "Vincent, R *et al* (2013). **MycoBank gearing up for new horizons.** IMA Fungus, 4(2), 371-9; \\doi{10.5598/imafungus.2013.04.02.16}.",
|
||||
url = "https://www.mycobank.org"
|
||||
),
|
||||
BacDive = list(
|
||||
accessed_date = as.Date("2023-05-12"),
|
||||
name = "BacDive",
|
||||
accessed_date = as.Date("2024-07-16"),
|
||||
citation = "Reimer, LC *et al.* (2022). ***BacDive* in 2022: the knowledge base for standardized bacterial and archaeal data.** Nucleic Acids Res., 50(D1):D741-D74; \\doi{10.1093/nar/gkab961}.",
|
||||
url = "https://bacdive.dsmz.de"
|
||||
),
|
||||
SNOMED = list(
|
||||
accessed_date = as.Date("2021-07-01"),
|
||||
name = "Systematized Nomenclature of Medicine - Clinical Terms (SNOMED-CT)",
|
||||
accessed_date = as.Date("2024-07-16"),
|
||||
citation = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS). US Edition of SNOMED CT from 1 September 2020. Value Set Name 'Microorganism', OID 2.16.840.1.114222.4.11.1009 (v12).",
|
||||
url = "https://phinvads.cdc.gov"
|
||||
url = "https://www.cdc.gov/phin/php/phinvads/"
|
||||
),
|
||||
LOINC = list(
|
||||
name = "Logical Observation Identifiers Names and Codes (LOINC)",
|
||||
accessed_date = as.Date("2023-10-19"),
|
||||
citation = "Logical Observation Identifiers Names and Codes (LOINC), Version 2.76 (18 September, 2023).",
|
||||
url = "https://loinc.org"
|
||||
@@ -123,16 +140,19 @@ globalVariables(c(
|
||||
"affect_mo_name",
|
||||
"angle",
|
||||
"antibiotic",
|
||||
"antibiotics",
|
||||
"antimicrobials",
|
||||
"atc_group1",
|
||||
"atc_group2",
|
||||
"base_ab",
|
||||
"beta_posterior_1",
|
||||
"beta_posterior_2",
|
||||
"ci_max",
|
||||
"ci_min",
|
||||
"clinical_breakpoints",
|
||||
"code",
|
||||
"cols",
|
||||
"count",
|
||||
"coverage",
|
||||
"data",
|
||||
"disk",
|
||||
"dosage",
|
||||
@@ -141,17 +161,22 @@ globalVariables(c(
|
||||
"fullname",
|
||||
"fullname_lower",
|
||||
"g_species",
|
||||
"gamma_posterior",
|
||||
"genus",
|
||||
"gr",
|
||||
"group",
|
||||
"guideline",
|
||||
"hjust",
|
||||
"host_index",
|
||||
"host_match",
|
||||
"input",
|
||||
"intrinsic_resistant",
|
||||
"isolates",
|
||||
"lang",
|
||||
"language",
|
||||
"lookup",
|
||||
"lower",
|
||||
"lower_ci",
|
||||
"method",
|
||||
"mic ",
|
||||
"mic",
|
||||
@@ -159,12 +184,17 @@ globalVariables(c(
|
||||
"microorganisms",
|
||||
"microorganisms.codes",
|
||||
"mo",
|
||||
"n",
|
||||
"n_susceptible",
|
||||
"n_tested",
|
||||
"n_total",
|
||||
"name",
|
||||
"new",
|
||||
"numerator",
|
||||
"observations",
|
||||
"old",
|
||||
"old_name",
|
||||
"p_susceptible",
|
||||
"pattern",
|
||||
"R",
|
||||
"rank_index",
|
||||
@@ -182,10 +212,15 @@ globalVariables(c(
|
||||
"species",
|
||||
"syndromic_group",
|
||||
"total",
|
||||
"total_rows",
|
||||
"txt",
|
||||
"type",
|
||||
"upper",
|
||||
"upper_ci",
|
||||
"uti_index",
|
||||
"value",
|
||||
"varname",
|
||||
"x",
|
||||
"xvar",
|
||||
"y",
|
||||
"year",
|
||||
|
||||
+146
-108
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -237,7 +237,7 @@ addin_insert_like <- function() {
|
||||
}
|
||||
}
|
||||
|
||||
search_type_in_df <- function(x, type, info = TRUE) {
|
||||
search_type_in_df <- function(x, type, info = TRUE, add_col_prefix = TRUE) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1)
|
||||
|
||||
@@ -266,7 +266,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "species"])
|
||||
}
|
||||
}
|
||||
# -- key antibiotics
|
||||
# -- key antimicrobials
|
||||
if (type %in% c("keyantibiotics", "keyantimicrobials")) {
|
||||
if (any(colnames_formatted %like_case% "^key.*(ab|antibiotics|antimicrobials)")) {
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "^key.*(ab|antibiotics|antimicrobials)"])
|
||||
@@ -280,7 +280,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
|
||||
stop(
|
||||
font_red(paste0(
|
||||
"Found column '", font_bold(found), "' to be used as input for `col_", type,
|
||||
"Found column '", font_bold(found), "' to be used as input for `", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"`, but this column contains no valid dates. Transform its values to valid dates first."
|
||||
)),
|
||||
call. = FALSE
|
||||
@@ -311,6 +311,14 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen)"])
|
||||
}
|
||||
}
|
||||
# -- host (animals)
|
||||
if (type == "host") {
|
||||
if (any(colnames_formatted %like_case% "^(host|animal)")) {
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "^(host|animal)"])
|
||||
} else if (any(colnames_formatted %like_case% "((^|[^A-Za-z])host($|[^A-Za-z])|animal)")) {
|
||||
found <- sort(colnames(x)[colnames_formatted %like_case% "((^|[^A-Za-z])host($|[^A-Za-z])|animal)"])
|
||||
}
|
||||
}
|
||||
# -- UTI (urinary tract infection)
|
||||
if (type == "uti") {
|
||||
if (any(colnames_formatted == "uti")) {
|
||||
@@ -321,7 +329,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
if (!is.null(found)) {
|
||||
# this column should contain logicals
|
||||
if (!is.logical(x[, found, drop = TRUE])) {
|
||||
message_("Column '", font_bold(found), "' found as input for `col_", type,
|
||||
message_("Column '", font_bold(found), "' found as input for `", ifelse(add_col_prefix, "col_", ""), type,
|
||||
"`, but this column does not contain 'logical' values (TRUE/FALSE) and was ignored.",
|
||||
add_fn = font_red
|
||||
)
|
||||
@@ -334,9 +342,9 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||
|
||||
if (!is.null(found) && isTRUE(info)) {
|
||||
if (message_not_thrown_before("search_in_type", type)) {
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.")
|
||||
msg <- paste0("Using column '", font_bold(found), "' as input for `", ifelse(add_col_prefix, "col_", ""), type, "`.")
|
||||
if (type %in% c("keyantibiotics", "keyantimicrobials", "specimen")) {
|
||||
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
|
||||
msg <- paste(msg, "Use", font_bold(paste0(ifelse(add_col_prefix, "col_", ""), type), "= FALSE"), "to prevent this.")
|
||||
}
|
||||
message_(msg)
|
||||
}
|
||||
@@ -456,7 +464,8 @@ word_wrap <- function(...,
|
||||
ops <- "([,./><\\]\\[])"
|
||||
msg <- gsub(paste0(ops, " ", ops), "\\1\\2", msg, perl = TRUE)
|
||||
# we need to correct for already applied style, that adds text like "\033[31m\"
|
||||
msg_stripped <- font_stripstyle(msg)
|
||||
msg_stripped <- gsub("(.*)?\\033\\]8;;.*\\a(.*?)\\033\\]8;;\\a(.*)", "\\1\\2\\3", msg, perl = TRUE) # for font_url()
|
||||
msg_stripped <- font_stripstyle(msg_stripped)
|
||||
# where are the spaces now?
|
||||
msg_stripped_wrapped <- paste0(
|
||||
strwrap(msg_stripped,
|
||||
@@ -502,23 +511,41 @@ word_wrap <- function(...,
|
||||
|
||||
# format backticks
|
||||
if (pkg_is_available("cli") &&
|
||||
tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE) &&
|
||||
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) return(FALSE)) &&
|
||||
tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) return(FALSE))) {
|
||||
tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE) &&
|
||||
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
|
||||
return(FALSE)
|
||||
}) &&
|
||||
tryCatch(getExportedValue("versionInfo", ns = asNamespace("rstudioapi"))()$version > "2023.6.0.0", error = function(e) {
|
||||
return(FALSE)
|
||||
})) {
|
||||
# we are in a recent version of RStudio, so do something nice: add links to our help pages in the console.
|
||||
parts <- strsplit(msg, "`", fixed = TRUE)[[1]]
|
||||
cmds <- parts %in% paste0(ls(envir = asNamespace("AMR")), "()")
|
||||
# functions with a dot are not allowed: https://github.com/rstudio/rstudio/issues/11273#issuecomment-1156193252
|
||||
# lead them to the help page of our package
|
||||
parts[cmds & parts %like% "[.]"] <- font_url(url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
|
||||
txt = parts[cmds & parts %like% "[.]"])
|
||||
parts[cmds & parts %like% "[.]"] <- font_url(
|
||||
url = paste0("ide:help:AMR::", gsub("()", "", parts[cmds & parts %like% "[.]"], fixed = TRUE)),
|
||||
txt = parts[cmds & parts %like% "[.]"]
|
||||
)
|
||||
# otherwise, give a 'click to run' popup
|
||||
parts[cmds & parts %unlike% "[.]"] <- font_url(url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
||||
txt = parts[cmds & parts %unlike% "[.]"])
|
||||
parts[cmds & parts %unlike% "[.]"] <- font_url(
|
||||
url = paste0("ide:run:AMR::", parts[cmds & parts %unlike% "[.]"]),
|
||||
txt = parts[cmds & parts %unlike% "[.]"]
|
||||
)
|
||||
# datasets should give help page as well
|
||||
parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")] <- font_url(
|
||||
url = paste0("ide:help:AMR::", gsub("()", "", parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")], fixed = TRUE)),
|
||||
txt = parts[parts %in% c("antimicrobials", "microorganisms", "microorganisms.codes", "microorganisms.groups")]
|
||||
)
|
||||
# text starting with `?` must also lead to the help page
|
||||
parts[parts %like% "^[?]"] <- font_url(
|
||||
url = paste0("ide:help:AMR::", parts[parts %like% "^[?]"]),
|
||||
txt = parts[parts %like% "^[?]"]
|
||||
)
|
||||
msg <- paste0(parts, collapse = "`")
|
||||
}
|
||||
msg <- gsub("`(.+?)`", font_grey_bg("\\1"), msg)
|
||||
|
||||
|
||||
# clean introduced whitespace in between fullstops
|
||||
msg <- gsub("[.] +[.]", "..", msg)
|
||||
# remove extra space that was introduced (e.g. "Smith et al. , 2022")
|
||||
@@ -561,6 +588,7 @@ warning_ <- function(...,
|
||||
# - wraps text to never break lines within words
|
||||
stop_ <- function(..., call = TRUE) {
|
||||
msg <- paste0(c(...), collapse = "")
|
||||
msg_call <- ""
|
||||
if (!isFALSE(call)) {
|
||||
if (isTRUE(call)) {
|
||||
call <- as.character(sys.call(-1)[1])
|
||||
@@ -568,10 +596,19 @@ stop_ <- function(..., call = TRUE) {
|
||||
# so you can go back more than 1 call, as used in sir_calc(), that now throws a reference to e.g. n_sir()
|
||||
call <- as.character(sys.call(call)[1])
|
||||
}
|
||||
msg <- paste0("in ", call, "(): ", msg)
|
||||
msg_call <- paste0("in ", call, "():")
|
||||
}
|
||||
msg <- trimws2(word_wrap(msg, add_fn = list(), as_note = FALSE))
|
||||
stop(msg, call. = FALSE)
|
||||
if (!is.null(AMR_env$cli_abort) && length(unlist(strsplit(msg, "\n", fixed = TRUE))) <= 1) {
|
||||
if (is.character(call)) {
|
||||
call <- as.call(str2lang(paste0(call, "()")))
|
||||
} else {
|
||||
call <- NULL
|
||||
}
|
||||
AMR_env$cli_abort(msg, call = call)
|
||||
} else {
|
||||
stop(paste(msg_call, msg), call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
stop_if <- function(expr, ..., call = TRUE) {
|
||||
@@ -680,7 +717,7 @@ create_eucast_ab_documentation <- function() {
|
||||
ab <- character()
|
||||
for (val in x) {
|
||||
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
|
||||
# antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `CARBAPENEMS`
|
||||
# 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`
|
||||
@@ -734,6 +771,10 @@ vector_or <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE, initial_ca
|
||||
# class 'sir' should be sorted like this
|
||||
v <- c("S", "I", "R")
|
||||
}
|
||||
if (identical(v, c("I", "NI", "R", "S", "SDD"))) {
|
||||
# class 'sir' should be sorted like this
|
||||
v <- c("S", "SDD", "I", "R", "NI")
|
||||
}
|
||||
# oxford comma
|
||||
if (last_sep %in% c(" or ", " and ") && length(v) > 2) {
|
||||
last_sep <- paste0(",", last_sep)
|
||||
@@ -796,7 +837,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
is_positive = NULL,
|
||||
is_positive_or_zero = NULL,
|
||||
is_finite = NULL,
|
||||
contains_column_class = NULL,
|
||||
allow_NULL = FALSE,
|
||||
allow_NA = FALSE,
|
||||
ignore.case = FALSE,
|
||||
@@ -826,7 +866,12 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
if (!is.null(allow_class)) {
|
||||
if (identical(class(object), "list") && !"list" %in% allow_class) {
|
||||
# coming from Python, possibly - turn lists (not data.frame) to the underlying data type
|
||||
object <- unlist(object)
|
||||
}
|
||||
|
||||
if (!is.null(allow_class) && !(suppressWarnings(all(is.na(object))) && allow_NA == TRUE)) {
|
||||
stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
|
||||
"` must be ", format_class(allow_class, plural = isTRUE(has_length > 1)),
|
||||
", i.e. not be ", format_class(class(object), plural = isTRUE(has_length > 1)),
|
||||
@@ -862,12 +907,20 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
object <- tolower(object)
|
||||
is_in <- tolower(is_in)
|
||||
}
|
||||
stop_ifnot(all(object %in% is_in, na.rm = TRUE), "argument `", obj_name, "` ",
|
||||
is_in.bak <- is_in
|
||||
if ("logical" %in% allow_class) {
|
||||
is_in <- is_in[!is_in %in% c("TRUE", "FALSE")]
|
||||
}
|
||||
or_values <- vector_or(is_in, quotes = !isTRUE(any(c("numeric", "integer") %in% allow_class)))
|
||||
if ("logical" %in% allow_class) {
|
||||
or_values <- paste0(or_values, ", or TRUE or FALSE")
|
||||
}
|
||||
stop_ifnot(all(object %in% is_in.bak, na.rm = TRUE), "argument `", obj_name, "` ",
|
||||
ifelse(!is.null(has_length) && length(has_length) == 1 && has_length == 1,
|
||||
"must be either ",
|
||||
"must only contain values "
|
||||
),
|
||||
vector_or(is_in, quotes = !isTRUE(any(c("double", "numeric", "integer") %in% allow_class))),
|
||||
or_values,
|
||||
ifelse(allow_NA == TRUE, ", or NA", ""),
|
||||
call = call_depth
|
||||
)
|
||||
@@ -903,21 +956,6 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
if (!is.null(contains_column_class)) {
|
||||
stop_ifnot(
|
||||
any(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
object,
|
||||
function(col, columns_class = contains_column_class) {
|
||||
inherits(col, columns_class)
|
||||
}
|
||||
), na.rm = TRUE),
|
||||
"the data provided in argument `", obj_name,
|
||||
"` must contain at least one column of class '", contains_column_class[1L], "'. ",
|
||||
"See `?as.", contains_column_class[1L], "`.",
|
||||
call = call_depth
|
||||
)
|
||||
}
|
||||
if (!is.null(allow_arguments_from) && !is.null(names(object))) {
|
||||
args_given <- names(object)
|
||||
if (is.function(allow_arguments_from)) {
|
||||
@@ -939,7 +977,25 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
ascertain_sir_classes <- function(x, obj_name) {
|
||||
sirs <- vapply(FUN.VALUE = logical(1), x, is.sir)
|
||||
if (!any(sirs, na.rm = TRUE)) {
|
||||
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`."
|
||||
)
|
||||
sirs_eligible <- is_sir_eligible(x)
|
||||
for (col in colnames(x)[sirs_eligible]) {
|
||||
x[[col]] <- as.sir(x[[col]])
|
||||
}
|
||||
}
|
||||
x
|
||||
}
|
||||
|
||||
get_current_data <- function(arg_name, call) {
|
||||
# This function enables AMR selectors (e.g., AMR::carbapenems()) to work seamlessly across different environments, including dplyr, base R, data.table, and tidymodels.
|
||||
# It identifies and extracts the appropriate data frame from the current execution context.
|
||||
valid_df <- function(x) {
|
||||
!is.null(x) && is.data.frame(x)
|
||||
}
|
||||
@@ -951,7 +1007,7 @@ get_current_data <- function(arg_name, call) {
|
||||
for (env in frms[which(with_mask)]) {
|
||||
if (is.function(env$mask$current_rows) && (valid_df(env$data) || valid_df(env$`.data`))) {
|
||||
# an element `.data` or `data` (containing all data) and `mask` (containing functions) will be in the environment when using dplyr verbs
|
||||
# we use their mask$current_rows() to get the group rows, since dplyr::cur_data_all() is deprecated and will be removed in the future
|
||||
# we use their mask$current_rows() below to get the group rows, since dplyr::cur_data_all() is deprecated and will be removed in the future
|
||||
# e.g. for `example_isolates %>% group_by(ward) %>% mutate(first = first_isolate(.))`
|
||||
if (valid_df(env$data)) {
|
||||
# support for dplyr 1.1.x
|
||||
@@ -965,12 +1021,18 @@ get_current_data <- function(arg_name, call) {
|
||||
}
|
||||
}
|
||||
|
||||
# now go over all underlying environments looking for other dplyr, data.table and base R selection environments
|
||||
# now go over all underlying environments looking for other dplyr, tidymodels, data.table and base R selection environments
|
||||
with_generic <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$`.Generic`))
|
||||
for (env in frms[which(with_generic)]) {
|
||||
if (valid_df(env$`.data`)) {
|
||||
# an element `.data` will be in the environment when using dplyr::select()
|
||||
return(env$`.data`)
|
||||
} else if (valid_df(env$training)) {
|
||||
# an element `training` will be in the environment when using some tidymodels functions such as `prep()`
|
||||
return(env$training)
|
||||
} else if (valid_df(env$data)) {
|
||||
# an element `data` will be in the environment when using older dplyr versions, or some tidymodels functions such as `fit()`
|
||||
return(env$data)
|
||||
} else if (valid_df(env$xx)) {
|
||||
# an element `xx` will be in the environment for rows + cols in base R, e.g. `example_isolates[c(1:3), carbapenems()]`
|
||||
return(env$xx)
|
||||
@@ -986,7 +1048,7 @@ get_current_data <- function(arg_name, call) {
|
||||
for (env in frms[which(with_tbl)]) {
|
||||
if (!is.null(names(env)) && all(c(".tbl", ".vars", ".cols") %in% names(env), na.rm = TRUE)) {
|
||||
# an element `.tbl` will be in the environment when using scoped dplyr variants, with or without `dplyr::vars()`
|
||||
# (e.g. `dplyr::summarise_at()` or `dplyr::mutate_at()`)
|
||||
# e.g. `dplyr::summarise_at(carbapenems(), ...)` or `dplyr::mutate_at(vars(carbapenems()), ...)`
|
||||
return(env$`.tbl`)
|
||||
}
|
||||
}
|
||||
@@ -997,10 +1059,11 @@ get_current_data <- function(arg_name, call) {
|
||||
fn <- as.character(sys.call(call + 1)[1])
|
||||
examples <- paste0(
|
||||
", e.g.:\n",
|
||||
" your_data %>% select(", fn, "())\n",
|
||||
" your_data %>% select(column_a, column_b, ", fn, "())\n",
|
||||
" your_data[, ", fn, "()]\n",
|
||||
' your_data[, c("column_a", "column_b", ', fn, "())]"
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(", fn, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", fn, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% filter(any(", fn, "() == \"R\"))\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, ", fn, "()]\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", fn, "())]"
|
||||
)
|
||||
} else {
|
||||
examples <- ""
|
||||
@@ -1028,10 +1091,15 @@ get_current_column <- function() {
|
||||
if (tryCatch(!is.null(env$i), error = function(e) FALSE)) {
|
||||
if (!is.null(env$tibble_vars)) {
|
||||
# for mutate_if()
|
||||
# TODO remove later, was part of older dplyr versions (at least not in dplyr 1.1.4)
|
||||
env$tibble_vars[env$i]
|
||||
} else {
|
||||
# for mutate(across())
|
||||
df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL)
|
||||
if (!is.null(env$data) && is.data.frame(env$data)) {
|
||||
df <- env$data
|
||||
} else {
|
||||
df <- tryCatch(get_current_data(NA, 0), error = function(e) NULL)
|
||||
}
|
||||
if (is.data.frame(df)) {
|
||||
colnames(df)[env$i]
|
||||
} else {
|
||||
@@ -1123,57 +1191,12 @@ message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
|
||||
}
|
||||
|
||||
has_colour <- function() {
|
||||
# this is a base R version of crayon::has_color, but disables colours on emacs
|
||||
|
||||
if (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") {
|
||||
# disable on emacs, which only supports 8 colours
|
||||
return(FALSE)
|
||||
}
|
||||
enabled <- getOption("crayon.enabled")
|
||||
if (!is.null(enabled)) {
|
||||
return(isTRUE(enabled))
|
||||
}
|
||||
rstudio_with_ansi_support <- function(x) {
|
||||
if (Sys.getenv("RSTUDIO", "") == "") {
|
||||
return(FALSE)
|
||||
}
|
||||
if ((cols <- Sys.getenv("RSTUDIO_CONSOLE_COLOR", "")) != "" && !is.na(as.double(cols))) {
|
||||
return(TRUE)
|
||||
}
|
||||
tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
|
||||
return(FALSE)
|
||||
}) &&
|
||||
tryCatch(getExportedValue("hasFun", ns = asNamespace("rstudioapi"))("getConsoleHasColor"), error = function(e) {
|
||||
return(FALSE)
|
||||
})
|
||||
}
|
||||
if (rstudio_with_ansi_support() && sink.number() == 0) {
|
||||
return(TRUE)
|
||||
}
|
||||
if (!isatty(stdout())) {
|
||||
return(FALSE)
|
||||
}
|
||||
if (tolower(Sys.info()["sysname"]) == "windows") {
|
||||
if (Sys.getenv("ConEmuANSI") == "ON") {
|
||||
return(TRUE)
|
||||
}
|
||||
if (Sys.getenv("CMDER_ROOT") != "") {
|
||||
return(TRUE)
|
||||
}
|
||||
return(FALSE)
|
||||
}
|
||||
if ("COLORTERM" %in% names(Sys.getenv())) {
|
||||
return(TRUE)
|
||||
}
|
||||
if (Sys.getenv("TERM") == "dumb") {
|
||||
return(FALSE)
|
||||
}
|
||||
grepl(
|
||||
pattern = "^screen|^xterm|^vt100|color|ansi|cygwin|linux",
|
||||
x = Sys.getenv("TERM"),
|
||||
ignore.case = TRUE,
|
||||
perl = TRUE
|
||||
)
|
||||
has_color <- import_fn("has_color", "crayon", error_on_fail = FALSE)
|
||||
!is.null(has_color) && isTRUE(has_color())
|
||||
}
|
||||
|
||||
# set colours if console has_colour()
|
||||
@@ -1193,7 +1216,13 @@ try_colour <- function(..., before, after, collapse = " ") {
|
||||
}
|
||||
}
|
||||
is_dark <- function() {
|
||||
if (is.null(AMR_env$is_dark_theme)) {
|
||||
if (is.null(AMR_env$is_dark_theme) ||
|
||||
is.null(AMR_env$current_theme) ||
|
||||
(
|
||||
!is.null(AMR_env$current_theme) &&
|
||||
AMR_env$current_theme != tryCatch(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$editor, error = function(e) "")
|
||||
)) {
|
||||
AMR_env$current_theme <- tryCatch(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$editor, error = function(e) NULL)
|
||||
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)
|
||||
@@ -1311,19 +1340,26 @@ progress_ticker <- function(n = 1, n_min = 0, print = TRUE, clear = TRUE, title
|
||||
}
|
||||
set_clean_class(pb, new_class = "txtProgressBar")
|
||||
} else if (n >= n_min) {
|
||||
# use `progress`, which also has a timer
|
||||
title <- trimws2(title)
|
||||
if (title != "") {
|
||||
title <- paste0(title, " ")
|
||||
}
|
||||
progress_bar <- import_fn("progress_bar", "progress", error_on_fail = FALSE)
|
||||
if (!is.null(progress_bar)) {
|
||||
# so we use progress::progress_bar
|
||||
# a close()-method was also added, see below for that
|
||||
pb <- progress_bar$new(
|
||||
format = paste0(title,
|
||||
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")),
|
||||
show_after = 0,
|
||||
format = paste0(
|
||||
title,
|
||||
ifelse(only_bar_percent == TRUE, "[:bar] :percent", "[:bar] :percent (:current/:total,:eta)")
|
||||
),
|
||||
clear = clear,
|
||||
total = n
|
||||
)
|
||||
} else {
|
||||
# use base R
|
||||
# use base R's txtProgressBar
|
||||
cat(title, "\n", sep = "")
|
||||
pb <- utils::txtProgressBar(max = n, style = 3)
|
||||
pb$tick <- function() {
|
||||
pb$up(pb$getVal() + 1)
|
||||
@@ -1378,16 +1414,15 @@ as_original_data_class <- function(df, old_class = NULL, extra_class = NULL) {
|
||||
if ("tbl_df" %in% old_class && pkg_is_available("tibble")) {
|
||||
# this will then also remove groups
|
||||
fn <- import_fn("as_tibble", "tibble")
|
||||
} else if ("tbl_ts" %in% old_class && pkg_is_available("tsibble")) {
|
||||
fn <- import_fn("as_tsibble", "tsibble")
|
||||
} else if ("data.table" %in% old_class && pkg_is_available("data.table")) {
|
||||
fn <- import_fn("as.data.table", "data.table")
|
||||
} else if ("tabyl" %in% old_class && pkg_is_available("janitor")) {
|
||||
fn <- import_fn("as_tabyl", "janitor")
|
||||
} else {
|
||||
fn <- function(x) base::as.data.frame(df, stringsAsFactors = FALSE)
|
||||
}
|
||||
out <- fn(df)
|
||||
# don't keep row names
|
||||
rownames(out) <- NULL
|
||||
# add additional class if needed
|
||||
if (!is.null(extra_class)) {
|
||||
class(out) <- c(extra_class, class(out))
|
||||
}
|
||||
@@ -1507,22 +1542,25 @@ add_MO_lookup_to_AMR_env <- function() {
|
||||
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
|
||||
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 1.25
|
||||
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 1.5
|
||||
MO_lookup[which(MO_lookup$kingdom == "Chromista"), "kingdom_index"] <- 1.75
|
||||
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 2
|
||||
# all the rest
|
||||
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 3
|
||||
|
||||
# the fullname lowercase, important for the internal algorithms in as.mo()
|
||||
MO_lookup$fullname_lower <- tolower(trimws(paste(
|
||||
MO_lookup$fullname_lower <- tolower(trimws2(paste(
|
||||
MO_lookup$genus,
|
||||
MO_lookup$species,
|
||||
MO_lookup$subspecies
|
||||
)))
|
||||
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
|
||||
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE])
|
||||
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
|
||||
MO_lookup$fullname_lower <- trimws2(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
|
||||
# special for Salmonella - they have cities as subspecies but not the species (enterica) in the fullname:
|
||||
MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")] <- gsub(" enterica ", " ", MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")], fixed = TRUE)
|
||||
|
||||
MO_lookup$genus_lower <- tolower(MO_lookup$genus)
|
||||
|
||||
MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1)
|
||||
MO_lookup$species_first <- tolower(substr(MO_lookup$species, 1, 1)) # tolower for groups (Streptococcus, Salmonella)
|
||||
MO_lookup$subspecies_first <- tolower(substr(MO_lookup$subspecies, 1, 1)) # tolower for Salmonella serovars
|
||||
@@ -1551,7 +1589,7 @@ readRDS_AMR <- function(file, refhook = NULL) {
|
||||
match <- function(x, table, ...) {
|
||||
if (!is.null(AMR_env$chmatch) && inherits(x, "character") && inherits(table, "character")) {
|
||||
# data.table::chmatch() is much faster than base::match() for character
|
||||
AMR_env$chmatch(x, table, ...)
|
||||
tryCatch(AMR_env$chmatch(x, table, ...), error = function(e) base::match(x, table, ...))
|
||||
} else {
|
||||
base::match(x, table, ...)
|
||||
}
|
||||
@@ -1559,7 +1597,7 @@ match <- function(x, table, ...) {
|
||||
`%in%` <- function(x, table) {
|
||||
if (!is.null(AMR_env$chin) && inherits(x, "character") && inherits(table, "character")) {
|
||||
# data.table::`%chin%`() is much faster than base::`%in%`() for character
|
||||
AMR_env$chin(x, table)
|
||||
tryCatch(AMR_env$chin(x, table), error = function(e) base::`%in%`(x, table))
|
||||
} else {
|
||||
base::`%in%`(x, table)
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+16
-13
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -31,17 +31,20 @@
|
||||
#'
|
||||
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
|
||||
#' @section Options:
|
||||
#' * `AMR_custom_ab` \cr Allows to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
|
||||
#' * `AMR_custom_mo` \cr Allows to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
|
||||
#' * `AMR_eucastrules` \cr Used for setting the default types of rules for [eucast_rules()] function, must be one or more of: `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`.
|
||||
#' * `AMR_guideline` \cr Used for setting the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
|
||||
#' * `AMR_antibiogram_formatting_type` \cr A [numeric] (1-22) to use in [antibiogram()], to indicate which formatting type to use.
|
||||
#' * `AMR_breakpoint_type` \cr A [character] to use in [as.sir()], to indicate which breakpoint type to use. This must be either `r vector_or(clinical_breakpoints$type)`.
|
||||
#' * `AMR_capped_mic_handling` \cr A [character] to use in [as.sir()], to indicate how capped MIC values (`<`, `<=`, `>`, `>=`) should be interpreted. Must be one of `"standard"`, `"strict"`, `"relaxed"`, or `"inverse"` - the default is `"standard"`.
|
||||
#' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
|
||||
#' * `AMR_custom_ab` \cr A file location to an RDS file, to use custom antimicrobial drugs with this package. This is explained in [add_custom_antimicrobials()].
|
||||
#' * `AMR_custom_mo` \cr A file location to an RDS file, to use custom microorganisms with this package. This is explained in [add_custom_microorganisms()].
|
||||
#' * `AMR_eucastrules` \cr A [character] to set the default types of rules for [eucast_rules()] function, must be one or more of: `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`.
|
||||
#' * `AMR_guideline` \cr A [character] to set the default guideline for interpreting MIC values and disk diffusion diameters with [as.sir()]. Can be only the guideline name (e.g., `"CLSI"`) or the name with a year (e.g. `"CLSI 2019"`). The default to the latest implemented EUCAST guideline, currently \code{"`r clinical_breakpoints$guideline[1]`"}. Supported guideline are currently EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
|
||||
#' * `AMR_ignore_pattern` \cr A [regular expression][base::regex] to ignore (i.e., make `NA`) any match given in [as.mo()] and all [`mo_*`][mo_property()] functions.
|
||||
#' * `AMR_include_PKPD` \cr A [logical] to use in [as.sir()], to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is `TRUE`.
|
||||
#' * `AMR_ecoff` \cr A [logical] use in [as.sir()], to indicate that ECOFF (Epidemiological Cut-Off) values must be used - the default is `FALSE`.
|
||||
#' * `AMR_substitute_missing_r_breakpoint` \cr A [logical] to use in [as.sir()], to indicate that missing R breakpoints must be substituted with `"R"` - the default is `FALSE`.
|
||||
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
|
||||
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
|
||||
#' * `AMR_cleaning_regex` \cr A [regular expression][base::regex] (case-insensitive) to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to clean the user input. The default is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar".
|
||||
#' * `AMR_locale` \cr A language to use for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported).
|
||||
#' * `AMR_locale` \cr A [character] to set the language for the `AMR` package, can be one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported, English otherwise).
|
||||
#' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
|
||||
#'
|
||||
#' @section Saving Settings Between Sessions:
|
||||
@@ -51,18 +54,18 @@
|
||||
#' utils::file.edit("~/.Rprofile")
|
||||
#' ```
|
||||
#'
|
||||
#' In this file, you can set options such as:
|
||||
#' In this file, you can set options such as...
|
||||
#'
|
||||
#' ```r
|
||||
#' options(AMR_locale = "pt")
|
||||
#' options(AMR_include_PKPD = TRUE)
|
||||
#' ```
|
||||
#'
|
||||
#' to add Portuguese language support of antibiotics, and allow PK/PD rules when interpreting MIC values with [as.sir()].
|
||||
#' ...to add Portuguese language support of antimicrobials, and allow PK/PD rules when interpreting MIC values with [as.sir()].
|
||||
#'
|
||||
#' ### Share Options Within Team
|
||||
#'
|
||||
#' For a more global approach, e.g. within a data team, save an options file to a remote file location, such as a shared network drive. This would work in this way:
|
||||
#' For a more global approach, e.g. within a (data) team, save an options file to a remote file location, such as a shared network drive, and have each user read in this file automatically at start-up. This would work in this way:
|
||||
#'
|
||||
#' 1. Save a plain text file to e.g. "X:/team_folder/R_options.R" and fill it with preferred settings.
|
||||
#'
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,14 +29,15 @@
|
||||
|
||||
#' Transform Input to an Antibiotic ID
|
||||
#'
|
||||
#' Use this function to determine the antibiotic drug code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' Use this function to determine the antimicrobial drug code of one or more antimicrobials. The data set [antimicrobials] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x a [character] vector to determine to antibiotic ID
|
||||
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antibiotic drug code or name can be retrieved from a single input value.
|
||||
#' @param language language to coerce input values from any of the `r length(LANGUAGES_SUPPORTED)` supported languages - default to the system language if supported (see [get_AMR_locale()])
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to internal functions
|
||||
#' @rdname as.ab
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @details All entries in the [antibiotics] data set have three different identifiers: a human readable EARS-Net code (column `ab`, used by ECDC and WHONET), an ATC code (column `atc`, used by WHO), and a CID code (column `cid`, Compound ID, used by PubChem). The data set contains more than 5,000 official brand names from many different countries, as found in PubChem. Not that some drugs contain multiple ATC codes.
|
||||
#' @details All entries in the [antimicrobials] data set have three different identifiers: a human readable EARS-Net code (column `ab`, used by ECDC and WHONET), an ATC code (column `atc`, used by WHO), and a CID code (column `cid`, Compound ID, used by PubChem). The data set contains more than 5,000 official brand names from many different countries, as found in PubChem. Not that some drugs contain multiple ATC codes.
|
||||
#'
|
||||
#' All these properties will be searched for the user input. The [as.ab()] can correct for different forms of misspelling:
|
||||
#'
|
||||
@@ -51,13 +52,13 @@
|
||||
#'
|
||||
#' You can add your own manual codes to be considered by [as.ab()] and all [`ab_*`][ab_property()] functions, see [add_custom_antimicrobials()].
|
||||
#' @section Source:
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://www.whocc.no/atc_ddd_index/}
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
|
||||
#'
|
||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm}
|
||||
#' @aliases ab
|
||||
#' @return A [character] [vector] with additional class [`ab`]
|
||||
#' @seealso
|
||||
#' * [antibiotics] for the [data.frame] that is being used to determine ATCs
|
||||
#' * [antimicrobials] for the [data.frame] that is being used to determine ATCs
|
||||
#' * [ab_from_text()] for a function to retrieve antimicrobial drugs from clinical text (from health care records)
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @export
|
||||
@@ -67,7 +68,6 @@
|
||||
#' as.ab("J 01 FA 01")
|
||||
#' as.ab("Erythromycin")
|
||||
#' as.ab("eryt")
|
||||
#' as.ab(" eryt 123")
|
||||
#' as.ab("ERYT")
|
||||
#' as.ab("ERY")
|
||||
#' as.ab("eritromicine") # spelled wrong, yet works
|
||||
@@ -92,22 +92,20 @@
|
||||
#' set_ab_names(where(is.sir), property = "atc")
|
||||
#' }
|
||||
#' }
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), info = interactive(), ...) {
|
||||
meet_criteria(x, allow_class = c("character", "numeric", "integer", "factor"), allow_NA = TRUE)
|
||||
meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (is.ab(x)) {
|
||||
return(x)
|
||||
}
|
||||
if (all(x %in% c(AMR_env$AB_lookup$ab, NA))) {
|
||||
# all valid AB codes, but not yet right class
|
||||
if (is.ab(x) || all(x %in% c(AMR_env$AB_lookup$ab, NA))) {
|
||||
# all valid AB codes, but not yet right class or might have additional attributes as AMR selector
|
||||
attributes(x) <- NULL
|
||||
return(set_clean_class(x,
|
||||
new_class = c("ab", "character")
|
||||
))
|
||||
}
|
||||
|
||||
initial_search <- is.null(list(...)$initial_search)
|
||||
already_regex <- isTRUE(list(...)$already_regex)
|
||||
fast_mode <- isTRUE(list(...)$fast_mode)
|
||||
|
||||
@@ -117,8 +115,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
# remove diacritics
|
||||
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
|
||||
x <- gsub('"', "", x, fixed = TRUE)
|
||||
x <- gsub("(specimen|specimen date|specimen_date|spec_date|gender|^dates?$)", "", x, ignore.case = TRUE, perl = TRUE)
|
||||
# penicillin is a special case: we call it so, but then mean benzylpenicillin
|
||||
x <- gsub("(specimen|specimen date|specimen_date|spec_date|gender|^dates?$|animal|host($|[a-z]))", "", x, ignore.case = TRUE, perl = TRUE)
|
||||
# penicillin is a special case: we call it so, but then most often mean benzylpenicillin
|
||||
x[x %like_case% "^PENICILLIN" & x %unlike_case% "[ /+-]"] <- "benzylpenicillin"
|
||||
x_bak_clean <- x
|
||||
if (already_regex == FALSE) {
|
||||
@@ -127,20 +125,26 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
|
||||
x <- unique(x_bak_clean) # this means that every x is in fact generalise_antibiotic_name(x)
|
||||
x_new <- rep(NA_character_, length(x))
|
||||
x_uncertain <- character(0)
|
||||
x_unknown <- character(0)
|
||||
x_unknown_ATCs <- character(0)
|
||||
|
||||
note_if_more_than_one_found <- function(found, index, from_text) {
|
||||
if (isTRUE(initial_search) && isTRUE(length(from_text) > 1)) {
|
||||
abnames <- ab_name(from_text, tolower = TRUE, initial_search = FALSE)
|
||||
if (isTRUE(length(from_text) > 1)) {
|
||||
abnames <- ab_name(from_text, tolower = TRUE)
|
||||
if (ab_name(found[1L], language = NULL) %like% "(clavulanic acid|(avi|tazo|mono|vabor)bactam)") {
|
||||
abnames <- abnames[!abnames %in% c("clavulanic acid", "avibactam", "tazobactam", "vaborbactam", "monobactam")]
|
||||
}
|
||||
if (length(abnames) > 1) {
|
||||
message_(
|
||||
"More than one result was found for item ", index, ": ",
|
||||
vector_and(abnames, quotes = FALSE)
|
||||
)
|
||||
if (toupper(paste(abnames, collapse = " ")) %in% AMR_env$AB_lookup$generalised_name) {
|
||||
# if the found values combined is a valid AB, return that
|
||||
found <- AMR_env$AB_lookup$ab[match(toupper(paste(abnames, collapse = " ")), AMR_env$AB_lookup$generalised_name)][1]
|
||||
} else {
|
||||
message_(
|
||||
"More than one result was found for item ", index, ": ",
|
||||
vector_and(abnames, quotes = FALSE)
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
found[1L]
|
||||
@@ -150,12 +154,12 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
known_names <- x %in% AMR_env$AB_lookup$generalised_name
|
||||
x_new[known_names] <- AMR_env$AB_lookup$ab[match(x[known_names], AMR_env$AB_lookup$generalised_name)]
|
||||
known_codes_ab <- x %in% AMR_env$AB_lookup$ab
|
||||
known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE)
|
||||
known_codes_atc <- vapply(FUN.VALUE = logical(1), gsub(" ", "", x), function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE)
|
||||
known_codes_cid <- x %in% AMR_env$AB_lookup$cid
|
||||
x_new[known_codes_ab] <- AMR_env$AB_lookup$ab[match(x[known_codes_ab], AMR_env$AB_lookup$ab)]
|
||||
x_new[known_codes_atc] <- AMR_env$AB_lookup$ab[vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
x[known_codes_atc],
|
||||
gsub(" ", "", x[known_codes_atc]),
|
||||
function(x_) {
|
||||
which(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
@@ -168,21 +172,27 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
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)) {
|
||||
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"),
|
||||
". Run `ab_reset_session()` to reset this. This note will be shown once per session."
|
||||
)
|
||||
}
|
||||
|
||||
already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid | previously_coerced
|
||||
|
||||
# fix for NAs
|
||||
x_new[is.na(x)] <- NA
|
||||
already_known[is.na(x)] <- FALSE
|
||||
|
||||
if (isTRUE(initial_search) && sum(already_known) < length(x)) {
|
||||
if (sum(already_known) < length(x)) {
|
||||
progress <- progress_ticker(n = sum(!already_known), n_min = 25, print = info) # start if n >= 25
|
||||
on.exit(close(progress))
|
||||
}
|
||||
|
||||
for (i in which(!already_known)) {
|
||||
if (isTRUE(initial_search)) {
|
||||
progress$tick()
|
||||
}
|
||||
progress$tick()
|
||||
|
||||
if (is.na(x[i]) || is.null(x[i])) {
|
||||
next
|
||||
@@ -201,8 +211,14 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
next
|
||||
}
|
||||
|
||||
# screening, but written without the hyphen, e.g., FOXS instead of FOX-S
|
||||
if (substr(x[i], 4, 4) == "S" && paste0(substr(x[i], 1, 3), "-S") %in% AMR_env$AB_lookup$ab) {
|
||||
x_new[i] <- paste0(substr(x[i], 1, 3), "-S")
|
||||
next
|
||||
}
|
||||
|
||||
if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") {
|
||||
from_text <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]]),
|
||||
from_text <- tryCatch(suppressWarnings(ab_from_text(x[i], translate_ab = FALSE)[[1]]),
|
||||
error = function(e) character(0)
|
||||
)
|
||||
} else {
|
||||
@@ -295,6 +311,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# try if name ends with it
|
||||
found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE]
|
||||
if (nchar(x[i]) >= 4 && length(found) > 0) {
|
||||
@@ -313,211 +330,104 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
next
|
||||
}
|
||||
|
||||
# INITIAL SEARCH - More uncertain results ----
|
||||
|
||||
if (isTRUE(initial_search) && fast_mode == FALSE) {
|
||||
# only run on first try
|
||||
|
||||
# try by removing all spaces
|
||||
if (x[i] %like% " ") {
|
||||
found <- suppressWarnings(as.ab(gsub(" +", "", x[i], perl = TRUE), initial_search = FALSE))
|
||||
if (length(found) > 0 && !is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# try by removing all spaces and numbers
|
||||
if (x[i] %like% " " || x[i] %like% "[0-9]") {
|
||||
found <- suppressWarnings(as.ab(gsub("[ 0-9]", "", x[i], perl = TRUE), initial_search = FALSE))
|
||||
if (length(found) > 0 && !is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# transform back from other languages and try again
|
||||
x_translated <- paste(
|
||||
lapply(
|
||||
strsplit(x[i], "[^A-Z0-9]"),
|
||||
function(y) {
|
||||
for (i in seq_len(length(y))) {
|
||||
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
||||
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
|
||||
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
|
||||
!isFALSE(TRANSLATIONS$fixed)), "pattern"],
|
||||
y[i]
|
||||
)
|
||||
}
|
||||
}
|
||||
generalise_antibiotic_name(y)
|
||||
}
|
||||
)[[1]],
|
||||
collapse = "/"
|
||||
# More uncertain results ----
|
||||
if (fast_mode == FALSE) {
|
||||
ab_df <- AMR_env$AB_lookup
|
||||
ab_df$length_name <- nchar(ab_df$generalised_name)
|
||||
# now retrieve Levensthein distance for name, synonyms, and translated names
|
||||
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 = 2),
|
||||
counts = FALSE
|
||||
))
|
||||
ab_df$lev_syn <- vapply(
|
||||
FUN.VALUE = double(1),
|
||||
ab_df$generalised_synonyms,
|
||||
function(y) {
|
||||
ifelse(length(y[nchar(y) >= 5]) == 0,
|
||||
999,
|
||||
min(as.double(utils::adist(x[i], y[nchar(y) >= 5],
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE
|
||||
)), na.rm = TRUE)
|
||||
)
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
|
||||
if (!is.na(x_translated_guess)) {
|
||||
x_new[i] <- x_translated_guess
|
||||
next
|
||||
}
|
||||
|
||||
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
|
||||
x_translated <- paste(
|
||||
lapply(
|
||||
strsplit(x_translated, "[^A-Z0-9 ]"),
|
||||
function(y) {
|
||||
for (i in seq_len(length(y))) {
|
||||
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
|
||||
y[i] <- ifelse(!is.na(y_name),
|
||||
y_name,
|
||||
y[i]
|
||||
)
|
||||
}
|
||||
generalise_antibiotic_name(y)
|
||||
}
|
||||
)[[1]],
|
||||
collapse = "/"
|
||||
)
|
||||
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
|
||||
if (!is.na(x_translated_guess)) {
|
||||
x_new[i] <- x_translated_guess
|
||||
next
|
||||
}
|
||||
|
||||
# try by removing all trailing capitals
|
||||
if (x[i] %like_case% "[a-z]+[A-Z]+$") {
|
||||
found <- suppressWarnings(as.ab(gsub("[A-Z]+$", "", x[i], perl = TRUE), initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# keep only letters
|
||||
found <- suppressWarnings(as.ab(gsub("[^A-Z]", "", x[i], perl = TRUE), initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# try from a bigger text, like from a health care record, see ?ab_from_text
|
||||
# already calculated above if flag_multiple_results = TRUE
|
||||
if (flag_multiple_results == TRUE) {
|
||||
found <- from_text[1L]
|
||||
if (!is.null(language) && language != "en") {
|
||||
ab_df$trans <- generalise_antibiotic_name(translate_AMR(ab_df$name, language = language))
|
||||
ab_df$lev_trans <- as.double(utils::adist(x[i], ab_df$trans,
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE
|
||||
))
|
||||
} else {
|
||||
found <- tryCatch(suppressWarnings(ab_from_text(x[i], initial_search = FALSE, translate_ab = FALSE)[[1]][1L]),
|
||||
error = function(e) NA_character_
|
||||
)
|
||||
}
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
ab_df$lev_trans <- ab_df$lev_name
|
||||
}
|
||||
|
||||
# first 5 except for cephalosporins, then first 7 (those cephalosporins all start quite the same!)
|
||||
found <- suppressWarnings(as.ab(substr(x[i], 1, 5), initial_search = FALSE))
|
||||
if (!is.na(found) && ab_group(found, initial_search = FALSE) %unlike% "cephalosporins") {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
if (any(ab_df$lev_name < 5, na.rm = TRUE)) {
|
||||
x_new[i] <- ab_df$ab[order(ab_df$lev_name)][1]
|
||||
x_uncertain <- c(x_uncertain, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
found <- suppressWarnings(as.ab(substr(x[i], 1, 7), initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
} else if (any(ab_df$lev_trans < 5, na.rm = TRUE)) {
|
||||
x_new[i] <- ab_df$ab[order(ab_df$lev_trans)][1]
|
||||
x_uncertain <- c(x_uncertain, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
|
||||
# make all consonants facultative
|
||||
search_str <- gsub("([BCDFGHJKLMNPQRSTVWXZ])", "\\1*", x[i], perl = TRUE)
|
||||
found <- suppressWarnings(as.ab(search_str, initial_search = FALSE, already_regex = TRUE))
|
||||
# keep at least 4 normal characters
|
||||
if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 4) {
|
||||
found <- NA
|
||||
}
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
} else if (any(ab_df$lev_syn < 5, na.rm = TRUE)) {
|
||||
x_new[i] <- ab_df$ab[order(ab_df$lev_syn)][1]
|
||||
x_uncertain <- c(x_uncertain, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
|
||||
# make all vowels facultative
|
||||
search_str <- gsub("([AEIOUY])", "\\1*", x[i], perl = TRUE)
|
||||
found <- suppressWarnings(as.ab(search_str, initial_search = FALSE, already_regex = TRUE))
|
||||
# keep at least 5 normal characters
|
||||
if (nchar(gsub(".\\*", "", search_str, perl = TRUE)) < 5) {
|
||||
found <- NA
|
||||
}
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# allow misspelling of vowels
|
||||
x_spelling <- gsub("A+", "[AEIOU]+", x_spelling, fixed = TRUE)
|
||||
x_spelling <- gsub("E+", "[AEIOU]+", x_spelling, fixed = TRUE)
|
||||
x_spelling <- gsub("I+", "[AEIOU]+", x_spelling, fixed = TRUE)
|
||||
x_spelling <- gsub("O+", "[AEIOU]+", x_spelling, fixed = TRUE)
|
||||
x_spelling <- gsub("U+", "[AEIOU]+", x_spelling, fixed = TRUE)
|
||||
found <- suppressWarnings(as.ab(x_spelling, initial_search = FALSE, already_regex = TRUE))
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# try with switched character, like "mreopenem"
|
||||
for (j in seq_len(nchar(x[i]))) {
|
||||
x_switched <- paste0(
|
||||
# beginning part:
|
||||
substr(x[i], 1, j - 1),
|
||||
# here is the switching of 2 characters:
|
||||
substr(x[i], j + 1, j + 1),
|
||||
substr(x[i], j, j),
|
||||
# ending part:
|
||||
substr(x[i], j + 2, nchar(x[i]))
|
||||
)
|
||||
found <- suppressWarnings(as.ab(x_switched, initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
break
|
||||
} else {
|
||||
# then just take name if Levensthein is max 100% of length of name
|
||||
ab_df$lev_len_ratio <- ab_df$lev_name / ab_df$length_name
|
||||
if (any(ab_df$lev_len_ratio < 1)) {
|
||||
ab_df <- ab_df[ab_df$lev_len_ratio < 1, , drop = FALSE]
|
||||
x_new[i] <- ab_df$ab[order(ab_df$lev_name)][1]
|
||||
x_uncertain <- c(x_uncertain, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
}
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
} # end of initial_search = TRUE
|
||||
}
|
||||
|
||||
# not found
|
||||
# nothing found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
||||
if (isTRUE(initial_search) && sum(already_known) < length(x)) {
|
||||
if (sum(already_known) < length(x)) {
|
||||
close(progress)
|
||||
}
|
||||
|
||||
# save to package env to save time for next time
|
||||
if (isTRUE(initial_search)) {
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
|
||||
AMR_env$ab_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$ab_previously_coerced,
|
||||
data.frame(
|
||||
x = x,
|
||||
ab = x_new,
|
||||
x_bak = x_bak[match(x, x_bak_clean)],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
))
|
||||
}
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
|
||||
AMR_env$ab_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$ab_previously_coerced,
|
||||
data.frame(
|
||||
x = x,
|
||||
ab = x_new,
|
||||
x_bak = x_bak[match(x, x_bak_clean)],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
))
|
||||
|
||||
# take failed ATC codes apart from rest
|
||||
if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in `as.ab()`: these ATC codes are not (yet) in the antibiotics data set: ",
|
||||
"in `as.ab()`: these ATC codes are not (yet) in the antimicrobials data set: ",
|
||||
vector_and(x_unknown_ATCs), "."
|
||||
)
|
||||
}
|
||||
|
||||
# Throw note about uncertainties
|
||||
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||
x_unknown <- c(
|
||||
x_unknown,
|
||||
AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))]
|
||||
)
|
||||
x_unknown <- x_unknown[!x_unknown %in% c("", NA)]
|
||||
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
|
||||
@@ -525,6 +435,29 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
)
|
||||
}
|
||||
|
||||
# Throw note about uncertainties
|
||||
if (isTRUE(info) && length(x_uncertain) > 0 && fast_mode == FALSE) {
|
||||
x_uncertain <- unique(x_uncertain)
|
||||
if (message_not_thrown_before("as.ab", "uncertainties", x_bak)) {
|
||||
if (length(x_uncertain) <= 3) {
|
||||
examples <- vector_and(
|
||||
paste0(
|
||||
'"', x_uncertain, '" (assumed ',
|
||||
ab_name(AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], language = NULL, tolower = TRUE),
|
||||
", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")"
|
||||
),
|
||||
quotes = FALSE
|
||||
)
|
||||
} else {
|
||||
examples <- paste0(nr2char(length(x_uncertain)), " antimicrobials")
|
||||
}
|
||||
message_(
|
||||
"Antimicrobial translation was uncertain for ", examples,
|
||||
". If required, use `add_custom_antimicrobials()` to add custom entries."
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
x_result <- x_new[match(x_bak_clean, x)]
|
||||
if (length(x_result) == 0) {
|
||||
x_result <- NA_character_
|
||||
@@ -541,17 +474,31 @@ is.ab <- function(x) {
|
||||
inherits(x, "ab")
|
||||
}
|
||||
|
||||
#' @rdname as.ab
|
||||
#' @export
|
||||
ab_reset_session <- function() {
|
||||
if (NROW(AMR_env$ab_previously_coerced) > 0) {
|
||||
message_("Reset ", nr2char(NROW(AMR_env$ab_previously_coerced)), " previously matched input value", ifelse(NROW(AMR_env$ab_previously_coerced) > 1, "s", ""), ".")
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[0, , drop = FALSE]
|
||||
AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
|
||||
} else {
|
||||
message_("No previously matched input values to reset.")
|
||||
}
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.ab <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
|
||||
|
||||
# add the names to the drugs as mouse-over!
|
||||
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
|
||||
out[!is.na(x)] <- font_url(url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
|
||||
txt = out[!is.na(x)])
|
||||
out[!is.na(x)] <- font_url(
|
||||
url = paste0(x[!is.na(x)], ": ", ab_name(x[!is.na(x)])),
|
||||
txt = out[!is.na(x)]
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
@@ -564,6 +511,17 @@ type_sum.ab <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.ab <- function(x, ...) {
|
||||
if (!is.null(attributes(x)$amr_selector)) {
|
||||
function_name <- attributes(x)$amr_selector
|
||||
message_(
|
||||
"This 'ab' vector was retrieved using `", function_name, "()`, which should normally be used inside a `dplyr` verb or `data.frame` call, e.g.:\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% select(column_a, column_b, ", function_name, "())\n",
|
||||
" ", AMR_env$bullet_icon, " your_data %>% filter(any(", function_name, "() == \"R\"))\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, ", function_name, "()]\n",
|
||||
" ", AMR_env$bullet_icon, " your_data[, c(\"column_a\", \"column_b\", ", function_name, "())]"
|
||||
)
|
||||
}
|
||||
cat("Class 'ab'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
@@ -645,19 +603,26 @@ generalise_antibiotic_name <- function(x) {
|
||||
x <- gsub("_(MIC|RSI|SIR|DIS[CK])$", "", x, perl = TRUE)
|
||||
# remove disk concentrations, like LVX_NM -> LVX
|
||||
x <- gsub("_[A-Z]{2}[0-9_.]{0,3}$", "", x, perl = TRUE)
|
||||
# remove part between brackets if that's followed by another string
|
||||
x <- gsub("(.*)+ [(].*[)]", "\\1", x)
|
||||
# keep only max 1 space
|
||||
x <- trimws2(gsub(" +", " ", x, perl = TRUE))
|
||||
# non-character, space or number should be a slash
|
||||
x <- gsub("[^A-Z0-9 -]", "/", x, perl = TRUE)
|
||||
# spaces around non-characters must be removed: amox + clav -> amox/clav
|
||||
x <- gsub("[^A-Z0-9 -)(]", "/", x, perl = TRUE)
|
||||
# correct for 'high level' antibiotics
|
||||
x <- trimws(gsub("([^A-Z0-9/ -]+)?(HIGH(.?LE?VE?L)?|[^A-Z0-9/]H[^A-Z0-9]?L)([^A-Z0-9 -]+)?", "-HIGH", x, perl = TRUE))
|
||||
x <- trimws(gsub("^(-HIGH)(.*)", "\\2\\1", x, perl = TRUE))
|
||||
# remove part between brackets if that's followed by another string
|
||||
x <- gsub("(.*)+ [(].*[)]", "\\1", x)
|
||||
# spaces around non-characters must be removed: amox + clav -> amox clav
|
||||
x <- gsub("(.*[A-Z0-9]) ([^A-Z0-9].*)", "\\1\\2", x, perl = TRUE)
|
||||
x <- gsub("(.*[^A-Z0-9]) ([A-Z0-9].*)", "\\1\\2", x, perl = TRUE)
|
||||
# remove hyphen after a starting "co"
|
||||
x <- gsub("^CO-", "CO", x, perl = TRUE)
|
||||
# replace operators with a space
|
||||
x <- gsub("(/| AND | WITH | W/|[+]|[-])+", " ", x, perl = TRUE)
|
||||
# replace more than 1 space
|
||||
x <- trimws(gsub(" +", " ", x, perl = TRUE))
|
||||
# move HIGH to end
|
||||
x <- trimws(gsub("(.*) HIGH(.*)", "\\1\\2 HIGH", x, perl = TRUE))
|
||||
x
|
||||
}
|
||||
|
||||
@@ -669,11 +634,38 @@ get_translate_ab <- function(translate_ab) {
|
||||
return(FALSE)
|
||||
} else {
|
||||
translate_ab <- tolower(translate_ab)
|
||||
stop_ifnot(translate_ab %in% colnames(AMR::antibiotics),
|
||||
"invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n",
|
||||
"or TRUE (equals 'name') or FALSE to not translate at all.",
|
||||
stop_ifnot(translate_ab %in% colnames(AMR::antimicrobials),
|
||||
"invalid value for 'translate_ab', this must be a column name of the `antimicrobials` data set\n",
|
||||
"or `TRUE` (equals 'name') or `FALSE` to not translate at all.",
|
||||
call = FALSE
|
||||
)
|
||||
translate_ab
|
||||
}
|
||||
}
|
||||
|
||||
create_AB_AV_lookup <- function(df) {
|
||||
new_df <- df
|
||||
new_df$generalised_name <- generalise_antibiotic_name(new_df$name)
|
||||
new_df$generalised_synonyms <- lapply(new_df$synonyms, generalise_antibiotic_name)
|
||||
if ("abbreviations" %in% colnames(df)) {
|
||||
new_df$generalised_abbreviations <- lapply(new_df$abbreviations, generalise_antibiotic_name)
|
||||
}
|
||||
new_df$generalised_loinc <- lapply(new_df$loinc, generalise_antibiotic_name)
|
||||
new_df$generalised_all <- unname(lapply(
|
||||
as.list(as.data.frame(
|
||||
t(new_df[,
|
||||
c(
|
||||
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
||||
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
||||
),
|
||||
drop = FALSE
|
||||
]),
|
||||
stringsAsFactors = FALSE
|
||||
)),
|
||||
function(x) {
|
||||
x <- generalise_antibiotic_name(unname(unlist(x)))
|
||||
x[x != ""]
|
||||
}
|
||||
))
|
||||
new_df[, colnames(new_df)[colnames(new_df) %like% "^generalised"]]
|
||||
}
|
||||
|
||||
+11
-7
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -33,7 +33,7 @@
|
||||
#' @param text text to analyse
|
||||
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
|
||||
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. The default is `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param translate_ab if `type = "drug"`: a column name of the [antimicrobials] data set to translate the antibiotic abbreviations to, using [ab_property()]. The default is `FALSE`. Using `TRUE` is equal to using "name".
|
||||
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
|
||||
#' @param info a [logical] to indicate whether a progress bar should be printed - the default is `TRUE` only in interactive mode
|
||||
#' @param ... arguments passed on to [as.ab()]
|
||||
@@ -129,16 +129,20 @@ ab_from_text <- function(text,
|
||||
text_split_all <- text_split_all[nchar(text_split_all) >= 4 & grepl("[a-z]+", text_split_all)]
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
progress$tick()
|
||||
text_split <- text_split[text_split %like% "[A-Z]" & text_split %unlike% "[0-9]"]
|
||||
if (length(text_split) == 0) {
|
||||
return(as.ab(NA_character_))
|
||||
}
|
||||
suppressWarnings(
|
||||
as.ab(text_split, ...)
|
||||
)
|
||||
})
|
||||
} else {
|
||||
# no thorough search
|
||||
abbr <- unlist(AMR::antibiotics$abbreviations)
|
||||
abbr <- unlist(AMR::antimicrobials$abbreviations)
|
||||
abbr <- abbr[nchar(abbr) >= 4]
|
||||
names_atc <- substr(c(AMR::antibiotics$name, AMR::antibiotics$atc), 1, 5)
|
||||
synonyms <- unlist(AMR::antibiotics$synonyms)
|
||||
names_atc <- substr(c(AMR::antimicrobials$name, AMR::antimicrobials$atc), 1, 5)
|
||||
synonyms <- unlist(AMR::antimicrobials$synonyms)
|
||||
synonyms <- synonyms[nchar(synonyms) >= 4]
|
||||
# regular expression must not be too long, so split synonyms in two:
|
||||
synonyms_part1 <- synonyms[seq_len(0.5 * length(synonyms))]
|
||||
|
||||
+15
-12
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,11 +29,11 @@
|
||||
|
||||
#' Get Properties of an Antibiotic
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antibiotic from the [antibiotics] data set. All input values will be evaluated internally with [as.ab()].
|
||||
#' Use these functions to return a specific property of an antibiotic from the [antimicrobials] data set. All input values will be evaluated internally with [as.ab()].
|
||||
#' @param x any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()]
|
||||
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param property one of the column names of one of the [antibiotics] data set: `vector_or(colnames(antibiotics), sort = FALSE)`.
|
||||
#' @param language language of the returned text - the default is the current system language (see [get_AMR_locale()]) and can also be set with the [package option][AMR-options] [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param property one of the column names of one of the [antimicrobials] data set: `vector_or(colnames(antimicrobials), sort = FALSE)`.
|
||||
#' @param language language of the returned text - the default is the current system language (see [get_AMR_locale()]) and can also be set with the package option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... in case of [set_ab_names()] and `data` is a [data.frame]: columns to select (supports tidy selection such as `column1:column4`), otherwise other arguments passed on to [as.ab()]
|
||||
@@ -55,7 +55,7 @@
|
||||
#' - A [data.frame] in case of [set_ab_names()]
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso [antibiotics]
|
||||
#' @seealso [antimicrobials]
|
||||
#' @inheritSection AMR Reference Data Publicly Available
|
||||
#' @examples
|
||||
#' # all properties:
|
||||
@@ -245,7 +245,7 @@ ab_ddd <- function(x, administration = "oral", ...) {
|
||||
warning_(
|
||||
"in `ab_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"www.whocc.no/ddd/list_of_ddds_combined_products/"
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
@@ -265,7 +265,7 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
|
||||
warning_(
|
||||
"in `ab_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"www.whocc.no/ddd/list_of_ddds_combined_products/"
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
@@ -310,7 +310,10 @@ ab_url <- function(x, open = FALSE, ...) {
|
||||
|
||||
ab <- as.ab(x = x, ...)
|
||||
atcs <- ab_atc(ab, only_first = TRUE)
|
||||
u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
||||
u <- character(length(atcs))
|
||||
# veterinary codes
|
||||
u[atcs %like% "^Q"] <- paste0("https://atcddd.fhi.no/atcvet/atcvet_index/?code=", atcs[atcs %like% "^Q"], "&showdescription=no")
|
||||
u[atcs %unlike% "^Q"] <- paste0("https://atcddd.fhi.no/atc_ddd_index//?code=", atcs[atcs %unlike% "^Q"], "&showdescription=no")
|
||||
u[is.na(atcs)] <- NA_character_
|
||||
names(u) <- ab_name(ab)
|
||||
|
||||
@@ -334,7 +337,7 @@ ab_url <- function(x, open = FALSE, ...) {
|
||||
#' @export
|
||||
ab_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(property, is_in = colnames(AMR::antibiotics), has_length = 1)
|
||||
meet_criteria(property, is_in = colnames(AMR::antimicrobials), has_length = 1)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(ab_validate(x = x, property = property, ...), language = language)
|
||||
}
|
||||
@@ -344,7 +347,7 @@ ab_property <- function(x, property = "name", language = get_AMR_locale(), ...)
|
||||
#' @export
|
||||
set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale(), snake_case = NULL) {
|
||||
meet_criteria(data, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(property, is_in = colnames(AMR::antibiotics), has_length = 1, ignore.case = TRUE)
|
||||
meet_criteria(property, is_in = colnames(AMR::antimicrobials), has_length = 1, ignore.case = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(snake_case, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
|
||||
-1010
File diff suppressed because it is too large
Load Diff
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
Executable
+1038
File diff suppressed because it is too large
Load Diff
+883
-159
File diff suppressed because it is too large
Load Diff
+18
-14
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,8 +29,8 @@
|
||||
|
||||
#' Get ATC Properties from WHOCC Website
|
||||
#'
|
||||
#' Gets data from the WHOCC website to determine properties of an Anatomical Therapeutic Chemical (ATC) (e.g. an antibiotic), such as the name, defined daily dose (DDD) or standard unit.
|
||||
#' @param atc_code a [character] (vector) with ATC code(s) of antibiotics, will be coerced with [as.ab()] and [ab_atc()] internally if not a valid ATC code
|
||||
#' Gets data from the WHOCC website to determine properties of an Anatomical Therapeutic Chemical (ATC) (e.g. an antimicrobial), such as the name, defined daily dose (DDD) or standard unit.
|
||||
#' @param atc_code a [character] (vector) with ATC code(s) of antimicrobials, will be coerced with [as.ab()] and [ab_atc()] internally if not a valid ATC code
|
||||
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see *Examples*.
|
||||
#' @param administration type of administration when using `property = "Adm.R"`, see *Details*
|
||||
#' @param url url of website of the WHOCC. The sign `%s` can be used as a placeholder for ATC codes.
|
||||
@@ -64,7 +64,7 @@
|
||||
#' **N.B. This function requires an internet connection and only works if the following packages are installed: `curl`, `rvest`, `xml2`.**
|
||||
#' @export
|
||||
#' @rdname atc_online
|
||||
#' @source <https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
|
||||
#' @source <https://atcddd.fhi.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' if (requireNamespace("curl") && requireNamespace("rvest") && requireNamespace("xml2")) {
|
||||
@@ -81,9 +81,9 @@
|
||||
atc_online_property <- function(atc_code,
|
||||
property,
|
||||
administration = "O",
|
||||
url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no",
|
||||
url_vet = "https://www.whocc.no/atcvet/atcvet_index/?code=%s&showdescription=no") {
|
||||
meet_criteria(atc_code, allow_class = "character")
|
||||
url = "https://atcddd.fhi.no/atc_ddd_index/?code=%s&showdescription=no",
|
||||
url_vet = "https://atcddd.fhi.no/atcvet/atcvet_index/?code=%s&showdescription=no") {
|
||||
meet_criteria(atc_code, allow_class = "character", allow_NA = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = c("ATC", "Name", "DDD", "U", "unit", "Adm.R", "Note", "groups"), ignore.case = TRUE)
|
||||
meet_criteria(administration, allow_class = "character", has_length = 1)
|
||||
meet_criteria(url, allow_class = "character", has_length = 1, looks_like = "https?://")
|
||||
@@ -98,7 +98,7 @@ atc_online_property <- function(atc_code,
|
||||
html_text <- import_fn("html_text", "rvest")
|
||||
read_html <- import_fn("read_html", "xml2")
|
||||
|
||||
if (!all(atc_code %in% unlist(AMR::antibiotics$atc))) {
|
||||
if (!all(atc_code %in% unlist(AMR::antimicrobials$atc))) {
|
||||
atc_code <- as.character(ab_atc(atc_code, only_first = TRUE))
|
||||
}
|
||||
|
||||
@@ -129,6 +129,10 @@ atc_online_property <- function(atc_code,
|
||||
for (i in seq_len(length(atc_code))) {
|
||||
progress$tick()
|
||||
|
||||
if (is.na(atc_code[i])) {
|
||||
next
|
||||
}
|
||||
|
||||
if (atc_code[i] %like% "^Q") {
|
||||
# veterinary drugs, ATC_vet codes start with a "Q"
|
||||
atc_url <- url_vet
|
||||
@@ -176,7 +180,7 @@ atc_online_property <- function(atc_code,
|
||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||
|
||||
if (length(out) == 0) {
|
||||
warning_("in `atc_online_property()`: ATC not found: ", atc_code[i], ". Please check ", atc_url, ".")
|
||||
message_("in `atc_online_property()`: no properties found for ATC ", atc_code[i], ". Please check ", font_url(atc_url, "this WHOCC webpage"), ".")
|
||||
returnvalue[i] <- NA
|
||||
next
|
||||
}
|
||||
@@ -209,20 +213,20 @@ atc_online_property <- function(atc_code,
|
||||
#' @rdname atc_online
|
||||
#' @export
|
||||
atc_online_groups <- function(atc_code, ...) {
|
||||
meet_criteria(atc_code, allow_class = "character")
|
||||
meet_criteria(atc_code, allow_class = "character", allow_NA = TRUE)
|
||||
atc_online_property(atc_code = atc_code, property = "groups", ...)
|
||||
}
|
||||
|
||||
#' @rdname atc_online
|
||||
#' @export
|
||||
atc_online_ddd <- function(atc_code, ...) {
|
||||
meet_criteria(atc_code, allow_class = "character")
|
||||
meet_criteria(atc_code, allow_class = "character", allow_NA = TRUE)
|
||||
atc_online_property(atc_code = atc_code, property = "ddd", ...)
|
||||
}
|
||||
|
||||
#' @rdname atc_online
|
||||
#' @export
|
||||
atc_online_ddd_units <- function(atc_code, ...) {
|
||||
meet_criteria(atc_code, allow_class = "character")
|
||||
meet_criteria(atc_code, allow_class = "character", allow_NA = TRUE)
|
||||
atc_online_property(atc_code = atc_code, property = "unit", ...)
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -49,7 +49,7 @@
|
||||
#'
|
||||
#' Note: the [as.av()] and [`av_*`][av_property()] functions may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems.
|
||||
#' @section Source:
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://www.whocc.no/atc_ddd_index/}
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
|
||||
#'
|
||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm}
|
||||
#' @aliases av
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+7
-7
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -33,7 +33,7 @@
|
||||
#' @param x any (vector of) text that can be coerced to a valid antiviral drug code with [as.av()]
|
||||
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character].
|
||||
#' @param property one of the column names of one of the [antivirals] data set: `vector_or(colnames(antivirals), sort = FALSE)`.
|
||||
#' @param language language of the returned text - the default is system language (see [get_AMR_locale()]) and can also be set with the [package option][AMR-options] [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param language language of the returned text - the default is system language (see [get_AMR_locale()]) and can also be set with the package option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration way of administration, either `"oral"` or `"iv"`
|
||||
#' @param open browse the URL using [utils::browseURL()]
|
||||
#' @param ... other arguments passed on to [as.av()]
|
||||
@@ -164,7 +164,7 @@ av_ddd <- function(x, administration = "oral", ...) {
|
||||
warning_(
|
||||
"in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"www.whocc.no/ddd/list_of_ddds_combined_products/"
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
@@ -184,7 +184,7 @@ av_ddd_units <- function(x, administration = "oral", ...) {
|
||||
warning_(
|
||||
"in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
||||
"Please refer to the WHOCC website:\n",
|
||||
"www.whocc.no/ddd/list_of_ddds_combined_products/"
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
@@ -227,7 +227,7 @@ av_url <- function(x, open = FALSE, ...) {
|
||||
|
||||
av <- as.av(x = x, ...)
|
||||
atcs <- av_atc(av, only_first = TRUE)
|
||||
u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
||||
u <- paste0("https://atcddd.fhi.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
||||
u[is.na(atcs)] <- NA_character_
|
||||
names(u) <- av_name(av)
|
||||
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+41
-15
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -31,18 +31,19 @@
|
||||
#'
|
||||
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publishable/printable format, see *Examples*.
|
||||
#' @inheritParams eucast_rules
|
||||
#' @param combine_SI a [logical] to indicate whether values S and I should be summed, so resistance will be based on only R - the default is `TRUE`
|
||||
#' @param combine_SI a [logical] to indicate whether values S, SDD, and I should be summed, so resistance will be based on only R - the default is `TRUE`
|
||||
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
|
||||
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
|
||||
#' @param FUN the function to call on the `mo` column to transform the microorganism codes - the default is [mo_shortname()]
|
||||
#' @param translate_ab a [character] of length 1 containing column names of the [antibiotics] data set
|
||||
#' @param translate_ab a [character] of length 1 containing column names of the [antimicrobials] data set
|
||||
#' @param include_n_rows a [logical] to indicate if the total number of rows must be included in the output
|
||||
#' @param ... arguments passed on to `FUN`
|
||||
#' @inheritParams sir_df
|
||||
#' @inheritParams base::formatC
|
||||
#' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()].
|
||||
#' @export
|
||||
#' @rdname bug_drug_combinations
|
||||
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
|
||||
#' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "SDD", "I", "R", and "total".
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' # run ?example_isolates for more info.
|
||||
@@ -70,8 +71,10 @@
|
||||
bug_drug_combinations <- function(x,
|
||||
col_mo = NULL,
|
||||
FUN = mo_shortname,
|
||||
include_n_rows = FALSE,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
x <- ascertain_sir_classes(x, "x")
|
||||
meet_criteria(col_mo, allow_class = "character", is_in = colnames(x), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(FUN, allow_class = "function", has_length = 1)
|
||||
|
||||
@@ -90,7 +93,7 @@ bug_drug_combinations <- function(x,
|
||||
|
||||
unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))
|
||||
|
||||
# select only groups and antibiotics
|
||||
# select only groups and antimicrobials
|
||||
if (is_null_or_grouped_tbl(x.bak)) {
|
||||
data_has_groups <- TRUE
|
||||
groups <- get_group_names(x.bak)
|
||||
@@ -105,9 +108,11 @@ bug_drug_combinations <- function(x,
|
||||
mo = character(0),
|
||||
ab = character(0),
|
||||
S = integer(0),
|
||||
SDD = integer(0),
|
||||
I = integer(0),
|
||||
R = integer(0),
|
||||
total = integer(0),
|
||||
total_rows = integer(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (data_has_groups) {
|
||||
@@ -121,17 +126,28 @@ bug_drug_combinations <- function(x,
|
||||
x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(vapply(FUN.VALUE = logical(1), x, is.sir))), drop = FALSE]
|
||||
# turn and merge everything
|
||||
pivot <- lapply(x_mo_filter, function(x) {
|
||||
m <- as.matrix(table(x))
|
||||
data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
|
||||
m <- as.matrix(table(as.sir(x), useNA = "always"))
|
||||
data.frame(
|
||||
S = m["S", ],
|
||||
SDD = m["SDD", ],
|
||||
I = m["I", ],
|
||||
R = m["R", ],
|
||||
NI = m["NI", ],
|
||||
na = m[which(is.na(rownames(m))), ],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
})
|
||||
merged <- do.call(rbind_AMR, pivot)
|
||||
out_group <- data.frame(
|
||||
mo = rep(unique_mo[i], NROW(merged)),
|
||||
ab = rownames(merged),
|
||||
S = merged$S,
|
||||
SDD = merged$SDD,
|
||||
I = merged$I,
|
||||
R = merged$R,
|
||||
total = merged$S + merged$I + merged$R,
|
||||
NI = merged$NI,
|
||||
total = merged$S + merged$SDD + merged$I + merged$R + merged$NI,
|
||||
total_rows = merged$S + merged$SDD + merged$I + merged$R + merged$NI + merged$na,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (data_has_groups) {
|
||||
@@ -164,10 +180,16 @@ bug_drug_combinations <- function(x,
|
||||
} else {
|
||||
out <- run_it(x)
|
||||
}
|
||||
out <- out %pm>% pm_arrange(mo, ab)
|
||||
|
||||
if (include_n_rows == FALSE) {
|
||||
out <- out[, colnames(out)[colnames(out) != "total_rows"], drop = FALSE]
|
||||
}
|
||||
|
||||
out <- as_original_data_class(out, class(x.bak)) # will remove tibble groups
|
||||
out <- out %pm>% pm_arrange(mo, ab)
|
||||
class(out) <- c("bug_drug_combinations", if (data_has_groups) "grouped" else NULL, class(out))
|
||||
rownames(out) <- NULL
|
||||
structure(out, class = c("bug_drug_combinations", ifelse(data_has_groups, "grouped", character(0)), class(out)))
|
||||
out
|
||||
}
|
||||
|
||||
#' @method format bug_drug_combinations
|
||||
@@ -203,12 +225,16 @@ format.bug_drug_combinations <- function(x,
|
||||
mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
|
||||
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
|
||||
S = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$S[i], na.rm = TRUE)),
|
||||
SDD = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$SDD[i], na.rm = TRUE)),
|
||||
I = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$I[i], na.rm = TRUE)),
|
||||
R = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$R[i], na.rm = TRUE)),
|
||||
NI = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$NI[i], na.rm = TRUE)),
|
||||
total = vapply(FUN.VALUE = double(1), idx, function(i) {
|
||||
sum(x$S[i], na.rm = TRUE) +
|
||||
sum(x$SDD[i], na.rm = TRUE) +
|
||||
sum(x$I[i], na.rm = TRUE) +
|
||||
sum(x$R[i], na.rm = TRUE)
|
||||
sum(x$R[i], na.rm = TRUE) +
|
||||
sum(x$NI[i], na.rm = TRUE)
|
||||
}),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
@@ -223,7 +249,7 @@ format.bug_drug_combinations <- function(x,
|
||||
if (combine_SI == TRUE) {
|
||||
x$isolates <- x$R
|
||||
} else {
|
||||
x$isolates <- x$R + x$I
|
||||
x$isolates <- x$R + x$I + x$SDD
|
||||
}
|
||||
|
||||
give_ab_name <- function(ab, format, language) {
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -39,7 +39,7 @@
|
||||
#'
|
||||
#' The function [count_resistant()] is equal to the function [count_R()]. The function [count_susceptible()] is equal to the function [count_SI()].
|
||||
#'
|
||||
#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antibiotics have an available result (S, I or R). Their use is equal to `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`.
|
||||
#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antimicrobials have an available result (S, I or R). Their use is equal to `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`.
|
||||
#'
|
||||
#' The function [count_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and counts the number of S's, I's and R's. It also supports grouped variables. The function [sir_df()] works exactly like [count_df()], but adds the percentage of S, I and R.
|
||||
#' @inheritSection proportion Combination Therapy
|
||||
@@ -135,7 +135,71 @@ count_resistant <- function(..., only_all_tested = FALSE) {
|
||||
count_susceptible <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I"),
|
||||
ab_result = c("S", "SDD", "I"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_S <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_S", entire_session = TRUE)) {
|
||||
message_("Using `count_S()` is discouraged; use `count_susceptible()` instead to also consider \"I\" and \"SDD\" being susceptible. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "S",
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_SI <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_SI", entire_session = TRUE)) {
|
||||
message_("Note that `count_SI()` will also count dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "SDD", "I"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_I <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_I", entire_session = TRUE)) {
|
||||
message_("Note that `count_I()` will also count dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "SDD"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_IR <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_IR", entire_session = TRUE)) {
|
||||
message_("Using `count_IR()` is discouraged; use `count_resistant()` instead to not consider \"I\" and \"SDD\" being resistant. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "SDD", "R"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
@@ -156,70 +220,12 @@ count_R <- function(..., only_all_tested = FALSE) {
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_IR <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_IR", entire_session = TRUE)) {
|
||||
message_("Using `count_IR()` is discouraged; use `count_resistant()` instead to not consider \"I\" being resistant. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "R"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_I <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "I",
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_SI <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_S <- function(..., only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("count_S", entire_session = TRUE)) {
|
||||
message_("Using `count_S()` is discouraged; use `count_susceptible()` instead to also consider \"I\" being susceptible. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "S",
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_all <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I", "R"),
|
||||
ab_result = c("S", "SDD", "I", "R", "NI"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
|
||||
+19
-21
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -30,16 +30,16 @@
|
||||
#' Add Custom Antimicrobials
|
||||
#'
|
||||
#' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes.
|
||||
#' @param x a [data.frame] resembling the [antibiotics] data set, at least containing columns "ab" and "name"
|
||||
#' @param x a [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name"
|
||||
#' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
|
||||
#'
|
||||
#' There are two ways to circumvent this and automate the process of adding antimicrobials:
|
||||
#'
|
||||
#' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
|
||||
#' **Method 1:** Using the package option [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
|
||||
#'
|
||||
#' 1. Create a data set in the structure of the [antibiotics] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
|
||||
#' 1. Create a data set in the structure of the [antimicrobials] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
|
||||
#'
|
||||
#' 2. Set the file location to the [package option][AMR-options] [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#' 2. Set the file location to the package option [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom antimicrobial codes:
|
||||
@@ -69,11 +69,8 @@
|
||||
#' @export
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#'
|
||||
#' # returns NA and throws a warning (which is suppressed here):
|
||||
#' suppressWarnings(
|
||||
#' as.ab("testab")
|
||||
#' )
|
||||
#' # returns a wildly guessed result:
|
||||
#' as.ab("testab")
|
||||
#'
|
||||
#' # now add a custom entry - it will be considered by as.ab() and
|
||||
#' # all ab_*() functions
|
||||
@@ -82,7 +79,7 @@
|
||||
#' ab = "TESTAB",
|
||||
#' name = "Test Antibiotic",
|
||||
#' # you can add any property present in the
|
||||
#' # 'antibiotics' data set, such as 'group':
|
||||
#' # 'antimicrobials' data set, such as 'group':
|
||||
#' group = "Test Group"
|
||||
#' )
|
||||
#' )
|
||||
@@ -96,7 +93,7 @@
|
||||
#'
|
||||
#'
|
||||
#' # Add Co-fluampicil, which is one of the many J01CR50 codes, see
|
||||
#' # https://www.whocc.no/ddd/list_of_ddds_combined_products/
|
||||
#' # https://atcddd.fhi.no/ddd/list_of_ddds_combined_products/
|
||||
#' add_custom_antimicrobials(
|
||||
#' data.frame(
|
||||
#' ab = "COFLU",
|
||||
@@ -108,7 +105,8 @@
|
||||
#' ab_atc("Co-fluampicil")
|
||||
#' ab_name("J01CR50")
|
||||
#'
|
||||
#' # even antibiotic selectors work
|
||||
#' # even antimicrobial selectors work
|
||||
#' # see ?amr_selector
|
||||
#' x <- data.frame(
|
||||
#' random_column = "some value",
|
||||
#' coflu = as.sir("S"),
|
||||
@@ -125,11 +123,11 @@ add_custom_antimicrobials <- function(x) {
|
||||
)
|
||||
stop_if(
|
||||
any(x$ab %in% AMR_env$AB_lookup$ab),
|
||||
"Antimicrobial drug code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antibiotics` data set."
|
||||
"Antimicrobial drug code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set."
|
||||
)
|
||||
# remove any extra class/type, such as grouped tbl, or data.table:
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
# keep only columns available in the antibiotics data set
|
||||
# keep only columns available in the antimicrobials data set
|
||||
x <- x[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %in% colnames(x)], drop = FALSE]
|
||||
x$generalised_name <- generalise_antibiotic_name(x$name)
|
||||
x$generalised_all <- as.list(x$generalised_name)
|
||||
@@ -155,18 +153,18 @@ add_custom_antimicrobials <- function(x) {
|
||||
}
|
||||
AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df))
|
||||
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE]
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% c(x$ab, x$generalised_name) & !AMR_env$ab_previously_coerced$x %in% c(x$ab, x$generalised_name)), , drop = FALSE]
|
||||
class(AMR_env$AB_lookup$ab) <- c("ab", "character")
|
||||
message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.")
|
||||
message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antimicrobials` data set.")
|
||||
}
|
||||
|
||||
#' @rdname add_custom_antimicrobials
|
||||
#' @export
|
||||
clear_custom_antimicrobials <- function() {
|
||||
n <- nrow(AMR_env$AB_lookup)
|
||||
AMR_env$AB_lookup <- cbind(AMR::antibiotics, AB_LOOKUP)
|
||||
AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP)
|
||||
n2 <- nrow(AMR_env$AB_lookup)
|
||||
AMR_env$custom_ab_codes <- character(0)
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(AMR_env$ab_previously_coerced$ab %in% AMR_env$AB_lookup$ab), , drop = FALSE]
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal `antibiotics` data set.")
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal `antimicrobials` data set.")
|
||||
}
|
||||
|
||||
+50
-25
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -30,7 +30,7 @@
|
||||
#' Define Custom EUCAST Rules
|
||||
#'
|
||||
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
|
||||
#' @param ... rules in [formula][base::tilde] notation, see *Examples*
|
||||
#' @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:
|
||||
@@ -89,11 +89,24 @@
|
||||
#' #> 2 Klebsiella pneumoniae R R S
|
||||
#' ```
|
||||
#'
|
||||
#' ### Usage of antibiotic group names
|
||||
#' ### Usage of multiple antimicrobials and antimicrobial group names
|
||||
#'
|
||||
#' It is possible to define antibiotic groups instead of single antibiotics for the rule consequence, the part *after* the tilde. In above examples, the antibiotic group `aminopenicillins` is used to include ampicillin and amoxicillin. The following groups are allowed (case-insensitive). Within parentheses are the drugs that will be matched when running the rule.
|
||||
#' 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.
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("\"", tolower(gsub("^AB_", "", x)), "\"\\cr(", vector_and(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' Rules can also be applied to multiple antimicrobials and antimicrobial groups simultaneously. Use the `c()` function to combine multiple antimicrobials. For instance, the following example sets all aminopenicillins and ureidopenicillins to "R" if column TZP (piperacillin/tazobactam) is "R":
|
||||
#'
|
||||
#' ```r
|
||||
#' x <- custom_eucast_rules(TZP == "R" ~ c(aminopenicillins, ureidopenicillins) == "R")
|
||||
#' x
|
||||
#' #> A set of custom EUCAST rules:
|
||||
#' #>
|
||||
#' #> 1. If TZP is "R" then set to "R":
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP), azlocillin (AZL), mezlocillin (MEZ), piperacillin (PIP), piperacillin/tazobactam (TZP)
|
||||
#' ```
|
||||
#'
|
||||
#' These `r length(DEFINED_AB_GROUPS)` antimicrobial groups are allowed in the rules (case-insensitive) and can be used in any combination:
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0(tolower(gsub("^AB_", "", x)), "\\cr(", vector_and(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE), quotes = FALSE), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' @returns A [list] containing the custom rules
|
||||
#' @export
|
||||
#' @examples
|
||||
@@ -156,24 +169,36 @@ custom_eucast_rules <- function(...) {
|
||||
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`"
|
||||
)
|
||||
result_group <- as.character(result)[[2]]
|
||||
if (paste0("AB_", toupper(result_group), "S") %in% DEFINED_AB_GROUPS) {
|
||||
# support for e.g. 'aminopenicillin' if user meant 'aminopenicillins'
|
||||
result_group <- paste0(result_group, "s")
|
||||
}
|
||||
if (paste0("AB_", toupper(result_group)) %in% DEFINED_AB_GROUPS) {
|
||||
result_group <- eval(parse(text = paste0("AB_", toupper(result_group))), envir = asNamespace("AMR"))
|
||||
} else {
|
||||
result_group <- tryCatch(
|
||||
suppressWarnings(as.ab(result_group,
|
||||
fast_mode = TRUE,
|
||||
flag_multiple_results = FALSE
|
||||
)),
|
||||
error = function(e) NA_character_
|
||||
)
|
||||
result_group <- as.character(str2lang(result_group))
|
||||
result_group <- result_group[result_group != "c"]
|
||||
result_group_agents <- character(0)
|
||||
for (j in seq_len(length(result_group))) {
|
||||
if (paste0("AB_", toupper(result_group[j]), "S") %in% DEFINED_AB_GROUPS) {
|
||||
# support for e.g. 'aminopenicillin' if user meant 'aminopenicillins'
|
||||
result_group[j] <- paste0(result_group[j], "s")
|
||||
}
|
||||
if (paste0("AB_", toupper(result_group[j])) %in% DEFINED_AB_GROUPS) {
|
||||
result_group_agents <- c(
|
||||
result_group_agents,
|
||||
eval(parse(text = paste0("AB_", toupper(result_group[j]))), envir = asNamespace("AMR"))
|
||||
)
|
||||
} else {
|
||||
out_group <- tryCatch(
|
||||
suppressWarnings(as.ab(result_group[j],
|
||||
fast_mode = TRUE,
|
||||
flag_multiple_results = FALSE
|
||||
)),
|
||||
error = function(e) NA_character_
|
||||
)
|
||||
if (!all(is.na(out_group))) {
|
||||
result_group_agents <- c(result_group_agents, out_group)
|
||||
}
|
||||
}
|
||||
}
|
||||
result_group_agents <- result_group_agents[!is.na(result_group_agents)]
|
||||
|
||||
stop_if(
|
||||
any(is.na(result_group)),
|
||||
length(result_group_agents) == 0,
|
||||
"this result of rule ", i, " could not be translated to a single antimicrobial drug/group: \"",
|
||||
as.character(result)[[2]], "\".\n\nThe input can be a name or code of an antimicrobial drug, or be one of: ",
|
||||
vector_or(tolower(gsub("AB_", "", DEFINED_AB_GROUPS)), quotes = FALSE), "."
|
||||
@@ -181,12 +206,12 @@ custom_eucast_rules <- function(...) {
|
||||
result_value <- as.character(result)[[3]]
|
||||
result_value[result_value == "NA"] <- NA
|
||||
stop_ifnot(
|
||||
result_value %in% c("S", "I", "R", NA),
|
||||
"the resulting value of rule ", i, " must be either \"S\", \"I\", \"R\" or NA"
|
||||
result_value %in% c("S", "SDD", "I", "R", "NI", NA),
|
||||
"the resulting value of rule ", i, " must be either \"S\", \"SDD\", \"I\", \"R\", \"NI\" or NA"
|
||||
)
|
||||
result_value <- as.sir(result_value)
|
||||
|
||||
out[[i]]$result_group <- result_group
|
||||
out[[i]]$result_group <- result_group_agents
|
||||
out[[i]]$result_value <- result_value
|
||||
}
|
||||
|
||||
|
||||
+33
-24
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -37,11 +37,11 @@
|
||||
#'
|
||||
#' There are two ways to circumvent this and automate the process of adding microorganisms:
|
||||
#'
|
||||
#' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
|
||||
#' **Method 1:** Using the package option [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
|
||||
#'
|
||||
#' 1. Create a data set in the structure of the [microorganisms] data set (containing at the very least column "genus") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_mo.rds"`, or any remote location.
|
||||
#'
|
||||
#' 2. Set the file location to the [package option][AMR-options] [`AMR_custom_mo`][AMR-options]: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#' 2. Set the file location to the package option [`AMR_custom_mo`][AMR-options]: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom microorganism codes:
|
||||
@@ -250,12 +250,15 @@ add_custom_microorganisms <- function(x) {
|
||||
"_",
|
||||
trimws(
|
||||
paste(abbreviate_mo(x$genus, 5),
|
||||
abbreviate_mo(x$species, 4, hyphen_as_space = TRUE),
|
||||
abbreviate_mo(x$subspecies, 4, hyphen_as_space = TRUE),
|
||||
sep = "_"),
|
||||
whitespace = "_"))
|
||||
abbreviate_mo(x$species, 4, hyphen_as_space = TRUE),
|
||||
abbreviate_mo(x$subspecies, 4, hyphen_as_space = TRUE),
|
||||
sep = "_"
|
||||
),
|
||||
whitespace = "_"
|
||||
)
|
||||
)
|
||||
stop_if(anyDuplicated(c(as.character(AMR_env$MO_lookup$mo), x$mo)), "MO codes must be unique and not match existing MO codes of the AMR package")
|
||||
|
||||
|
||||
# add to package ----
|
||||
AMR_env$custom_mo_codes <- c(AMR_env$custom_mo_codes, x$mo)
|
||||
class(AMR_env$MO_lookup$mo) <- "character"
|
||||
@@ -309,19 +312,25 @@ abbreviate_mo <- function(x, minlength = 5, prefix = "", hyphen_as_space = FALSE
|
||||
}
|
||||
# keep a starting Latin ae
|
||||
suppressWarnings(
|
||||
gsub("(\u00C6|\u00E6)+",
|
||||
"AE",
|
||||
toupper(
|
||||
paste0(prefix,
|
||||
abbreviate(
|
||||
gsub("^ae",
|
||||
"\u00E6\u00E6",
|
||||
x,
|
||||
ignore.case = TRUE),
|
||||
minlength = minlength,
|
||||
use.classes = TRUE,
|
||||
method = "both.sides",
|
||||
...
|
||||
))))
|
||||
gsub(
|
||||
"(\u00C6|\u00E6)+",
|
||||
"AE",
|
||||
toupper(
|
||||
paste0(
|
||||
prefix,
|
||||
abbreviate(
|
||||
gsub("^ae",
|
||||
"\u00E6\u00E6",
|
||||
x,
|
||||
ignore.case = TRUE
|
||||
),
|
||||
minlength = minlength,
|
||||
use.classes = TRUE,
|
||||
method = "both.sides",
|
||||
...
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -27,31 +27,31 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Data Sets with `r format(nrow(antibiotics) + nrow(antivirals), big.mark = " ")` Antimicrobial Drugs
|
||||
#' Data Sets with `r format(nrow(antimicrobials) + nrow(antivirals), big.mark = " ")` Antimicrobial Drugs
|
||||
#'
|
||||
#' Two data sets containing all antibiotics/antimycotics and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antibiotics] data set. Three identifiers are included in this data set: an antibiotic 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.
|
||||
#' 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 antimcrobial 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.
|
||||
#' @format
|
||||
#' ### For the [antibiotics] data set: a [tibble][tibble::tibble] with `r nrow(antibiotics)` observations and `r ncol(antibiotics)` variables:
|
||||
#' - `ab`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. *This is a unique identifier.*
|
||||
#' - `cid`\cr Compound ID as found in PubChem. *This is a unique identifier.*
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. *This is a unique identifier.*
|
||||
#' ### For the [antimicrobials] data set: a [tibble][tibble::tibble] with `r nrow(antimicrobials)` observations and `r ncol(antimicrobials)` variables:
|
||||
#' - `ab`\cr antimcrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.***
|
||||
#' - `cid`\cr Compound ID as found in PubChem. ***This is a unique identifier.***
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. ***This is a unique identifier.***
|
||||
#' - `group`\cr A short and concise group name, based on WHONET and WHOCC definitions
|
||||
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02`
|
||||
#' - `atc_group1`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC, like `"Macrolides, lincosamides and streptogramins"`
|
||||
#' - `atc_group2`\cr Official chemical subgroup (4th level ATC code) as defined by the WHOCC, like `"Macrolides"`
|
||||
#' - `abbr`\cr List of abbreviations as used in many countries, also for antibiotic susceptibility testing (AST)
|
||||
#' - `abbr`\cr List of abbreviations as used in many countries, also for antimcrobial susceptibility testing (AST)
|
||||
#' - `synonyms`\cr Synonyms (often trade names) of a drug, as found in PubChem based on their compound ID
|
||||
#' - `oral_ddd`\cr Defined Daily Dose (DDD), oral treatment, currently available for `r sum(!is.na(antibiotics$oral_ddd))` drugs
|
||||
#' - `oral_ddd`\cr Defined Daily Dose (DDD), oral treatment, currently available for `r sum(!is.na(AMR::antimicrobials$oral_ddd))` drugs
|
||||
#' - `oral_units`\cr Units of `oral_ddd`
|
||||
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral (intravenous) treatment, currently available for `r sum(!is.na(antibiotics$iv_ddd))` drugs
|
||||
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral (intravenous) treatment, currently available for `r sum(!is.na(AMR::antimicrobials$iv_ddd))` drugs
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#' - `loinc`\cr All codes associated with the name of the antimicrobial drug from `r TAXONOMY_VERSION$LOINC$citation` Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
|
||||
#'
|
||||
#' ### For the [antivirals] data set: a [tibble][tibble::tibble] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
|
||||
#' - `av`\cr Antiviral ID as used in this package (such as `ACI`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. *This is a unique identifier.* Combinations are codes that contain a `+` to indicate this, such as `ATA+COBI` for atazanavir/cobicistat.
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. *This is a unique identifier.*
|
||||
#' - `av`\cr Antiviral ID as used in this package (such as `ACI`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.*** Combinations are codes that contain a `+` to indicate this, such as `ATA+COBI` for atazanavir/cobicistat.
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. ***This is a unique identifier.***
|
||||
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC
|
||||
#' - `cid`\cr Compound ID as found in PubChem. *This is a unique identifier.*
|
||||
#' - `cid`\cr Compound ID as found in PubChem. ***This is a unique identifier.***
|
||||
#' - `atc_group`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC
|
||||
#' - `synonyms`\cr Synonyms (often trade names) of a drug, as found in PubChem based on their compound ID
|
||||
#' - `oral_ddd`\cr Defined Daily Dose (DDD), oral treatment
|
||||
@@ -64,10 +64,10 @@
|
||||
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and consequently only available where a CID is available.
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @source
|
||||
#'
|
||||
#' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
|
||||
#' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://atcddd.fhi.no/atc_ddd_index/>
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
|
||||
#'
|
||||
@@ -75,42 +75,48 @@
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @seealso [microorganisms], [intrinsic_resistant]
|
||||
#' @examples
|
||||
#' antibiotics
|
||||
#' antimicrobials
|
||||
#' antivirals
|
||||
"antibiotics"
|
||||
"antimicrobials"
|
||||
|
||||
#' @rdname antibiotics
|
||||
#' @rdname antimicrobials
|
||||
"antivirals"
|
||||
|
||||
#' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Microorganisms
|
||||
#' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Taxonomic Records of Microorganisms
|
||||
#'
|
||||
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF). This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()].
|
||||
#' @description
|
||||
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
|
||||
#'
|
||||
#' This data set is carefully crafted, yet made 100% reproducible from public and authoritative taxonomic sources (using [this script](https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R)), namely: *`r TAXONOMY_VERSION$LPSN$name`* for bacteria, *`r TAXONOMY_VERSION$MycoBank$name`* for fungi, and *`r TAXONOMY_VERSION$GBIF$name`* for all others taxons.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms), big.mark = " ")` observations and `r ncol(microorganisms)` variables:
|
||||
#' - `mo`\cr ID of microorganism as used by this package. *This is a unique identifier.*
|
||||
#' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. *This is a unique identifier.*
|
||||
#' - `mo`\cr ID of microorganism as used by this package. ***This is a unique identifier.***
|
||||
#' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. ***This is a unique identifier.***
|
||||
#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status)`
|
||||
#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism
|
||||
#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism. Note that for fungi, *phylum* is equal to their taxonomic *division*. Also, for fungi, *subkingdom* and *subdivision* were left out since they do not occur in the bacterial taxonomy.
|
||||
#' - `rank`\cr Text of the taxonomic rank of the microorganism, such as `"species"` or `"genus"`
|
||||
#' - `ref`\cr Author(s) and year of related scientific publication. This contains only the *first surname* and year of the *latest* authors, e.g. "Wallis *et al.* 2006 *emend.* Smith and Jones 2018" becomes "Smith *et al.*, 2018". This field is directly retrieved from the source specified in the column `source`. Moreover, accents were removed to comply with CRAN that only allows ASCII characters.
|
||||
#' - `lpsn`\cr Identifier ('Record number') of the List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set.
|
||||
#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
|
||||
#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
|
||||
#' - `lpsn`\cr Identifier ('Record number') of `r TAXONOMY_VERSION$LPSN$name`. This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$lpsn)))` records.
|
||||
#' - `lpsn_parent`\cr LPSN identifier of the parent taxon
|
||||
#' - `lpsn_renamed_to`\cr LPSN identifier of the currently valid taxon
|
||||
#' - `gbif`\cr Identifier ('taxonID') of the Global Biodiversity Information Facility (GBIF)
|
||||
#' - `mycobank`\cr Identifier ('MycoBank #') of `r TAXONOMY_VERSION$MycoBank$name`. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$mycobank)))` records.
|
||||
#' - `mycobank_parent`\cr MycoBank identifier of the parent taxon
|
||||
#' - `mycobank_renamed_to`\cr MycoBank identifier of the currently valid taxon
|
||||
#' - `gbif`\cr Identifier ('taxonID') of `r TAXONOMY_VERSION$GBIF$name`. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$gbif)))` records.
|
||||
#' - `gbif_parent`\cr GBIF identifier of the parent taxon
|
||||
#' - `gbif_renamed_to`\cr GBIF identifier of the currently valid taxon
|
||||
#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
|
||||
#' - `prevalence`\cr Prevalence of the microorganism according to Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}), see [mo_matching_score()] for the full explanation
|
||||
#' - `prevalence`\cr Prevalence of the microorganism based on Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}), see [mo_matching_score()] for the full explanation
|
||||
#' - `snomed`\cr Systematized Nomenclature of Medicine (SNOMED) code of the microorganism, version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)` (see *Source*). Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
|
||||
#' @details
|
||||
#' Please note that entries are only based on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF) (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
|
||||
#' Please note that entries are only based on LPSN, MycoBank, and GBIF (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
|
||||
#'
|
||||
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the `AMR` package returns 2007 for `mo_year("S. pettenkoferi")`.
|
||||
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not until 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the `AMR` package returns 2007 for `mo_year("S. pettenkoferi")`.
|
||||
#'
|
||||
#' @section Included Taxa:
|
||||
#' Included taxonomic data are:
|
||||
#' Included taxonomic data from [LPSN](`r TAXONOMY_VERSION$LPSN$url`), [MycoBank](`r TAXONOMY_VERSION$MycoBank$url`), and [GBIF](`r TAXONOMY_VERSION$GBIF$url`) are:
|
||||
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the kingdoms of Archaea and Bacteria
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi"), , drop = FALSE])` (sub)species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi"), , drop = FALSE])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Protozoa"), , drop = FALSE])` (sub)species from the kingdom of Protozoa
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
|
||||
#' - All `r format_included_data_number(microorganisms[which(microorganisms$status != "accepted"), , drop = FALSE])` previously accepted names of all included (sub)species (these were taxonomically renamed)
|
||||
@@ -127,22 +133,28 @@
|
||||
#' - 1 entry of *Moraxella* (*M. catarrhalis*), which was formally named *Branhamella catarrhalis* (Catlin, 1970) though this change was never accepted within the field of clinical microbiology
|
||||
#' - 8 other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
|
||||
#'
|
||||
#' The syntax used to transform the original data to a cleansed \R format, can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R>.
|
||||
#' The syntax used to transform the original data to a cleansed \R format, can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R).
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @section About the Records from LPSN (see *Source*):
|
||||
#' LPSN is the main source for bacteriological taxonomy of this `AMR` package.
|
||||
#'
|
||||
#' The List of Prokaryotic names with Standing in Nomenclature (LPSN) provides comprehensive information on the nomenclature of prokaryotes. LPSN is a free to use service founded by Jean P. Euzeby in 1997 and later on maintained by Aidan C. Parte.
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @source
|
||||
#' * `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
|
||||
#' Taxonomic entries were imported in this order of importance:
|
||||
#' 1. `r TAXONOMY_VERSION$LPSN$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$GBIF$citation` Accessed from <`r TAXONOMY_VERSION$GBIF$url`> on `r documentation_date(TAXONOMY_VERSION$GBIF$accessed_date)`.
|
||||
#' 2. `r TAXONOMY_VERSION$MycoBank$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$MycoBank$citation` Accessed from <`r TAXONOMY_VERSION$MycoBank$url`> on `r documentation_date(TAXONOMY_VERSION$MycoBank$accessed_date)`.
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$BacDive$citation` Accessed from <`r TAXONOMY_VERSION$BacDive$url`> on `r documentation_date(TAXONOMY_VERSION$BacDive$accessed_date)`.
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$SNOMED$citation` URL: <`r TAXONOMY_VERSION$SNOMED$url`>
|
||||
#' 3. `r TAXONOMY_VERSION$GBIF$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$GBIF$citation` Accessed from <`r TAXONOMY_VERSION$GBIF$url`> on `r documentation_date(TAXONOMY_VERSION$GBIF$accessed_date)`.
|
||||
#'
|
||||
#' Furthermore, these sources were used for additional details:
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$BacDive$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$BacDive$citation` Accessed from <`r TAXONOMY_VERSION$BacDive$url`> on `r documentation_date(TAXONOMY_VERSION$BacDive$accessed_date)`.
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$SNOMED$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$SNOMED$citation` Accessed from <`r TAXONOMY_VERSION$SNOMED$url`> on `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`.
|
||||
#'
|
||||
#' * Grimont *et al.* (2007). Antigenic Formulae of the Salmonella Serovars, 9th Edition. WHO Collaborating Centre for Reference and Research on *Salmonella* (WHOCC-SALM).
|
||||
#'
|
||||
@@ -156,20 +168,20 @@
|
||||
#'
|
||||
#' A data set containing commonly used codes for microorganisms, from laboratory systems and [WHONET](https://whonet.org). Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.codes), big.mark = " ")` observations and `r ncol(microorganisms.codes)` variables:
|
||||
#' - `code`\cr Commonly used code of a microorganism. *This is a unique identifier.*
|
||||
#' - `code`\cr Commonly used code of a microorganism. ***This is a unique identifier.***
|
||||
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @seealso [as.mo()] [microorganisms]
|
||||
#' @examples
|
||||
#' microorganisms.codes
|
||||
#'
|
||||
#'
|
||||
#' # 'ECO' or 'eco' is the WHONET code for E. coli:
|
||||
#' microorganisms.codes[microorganisms.codes$code == "ECO", ]
|
||||
#'
|
||||
#'
|
||||
#' # and therefore, 'eco' will be understood as E. coli in this package:
|
||||
#' mo_info("eco")
|
||||
#'
|
||||
#'
|
||||
#' # works for all AMR functions:
|
||||
#' mo_is_intrinsic_resistant("eco", ab = "vancomycin")
|
||||
"microorganisms.codes"
|
||||
@@ -183,11 +195,11 @@
|
||||
#' - `mo_group_name`\cr Name of the species group / microbiological complex, as retrieved with [mo_name()]
|
||||
#' - `mo_name`\cr Name of the microorganism belonging in the species group / microbiological complex, as retrieved with [mo_name()]
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @seealso [as.mo()] [microorganisms]
|
||||
#' @examples
|
||||
#' microorganisms.groups
|
||||
#'
|
||||
#'
|
||||
#' # these are all species in the Bacteroides fragilis group, as per WHONET:
|
||||
#' microorganisms.groups[microorganisms.groups$mo_group == "B_BCTRD_FRGL-C", ]
|
||||
"microorganisms.groups"
|
||||
@@ -202,9 +214,9 @@
|
||||
#' - `gender`\cr Gender of the patient, either `r vector_or(example_isolates$gender)`
|
||||
#' - `ward`\cr Ward type where the patient was admitted, either `r vector_or(example_isolates$ward)`
|
||||
#' - `mo`\cr ID of microorganism created with [as.mo()], see also the [microorganisms] data set
|
||||
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.sir))` different antibiotics with class [`sir`] (see [as.sir()]); these column names occur in the [antibiotics] data set and can be translated with [set_ab_names()] or [ab_name()]
|
||||
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.sir))` different antimicrobials with class [`sir`] (see [as.sir()]); these column names occur in the [antimicrobials] data set and can be translated with [set_ab_names()] or [ab_name()]
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @examples
|
||||
#' example_isolates
|
||||
"example_isolates"
|
||||
@@ -217,16 +229,16 @@
|
||||
#' - `date`\cr date of receipt at the laboratory
|
||||
#' - `hospital`\cr ID of the hospital, from A to C
|
||||
#' - `bacteria`\cr info about microorganism that can be transformed with [as.mo()], see also [microorganisms]
|
||||
#' - `AMX:GEN`\cr 4 different antibiotics that have to be transformed with [as.sir()]
|
||||
#' - `AMX:GEN`\cr 4 different antimicrobials that have to be transformed with [as.sir()]
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @examples
|
||||
#' example_isolates_unclean
|
||||
"example_isolates_unclean"
|
||||
|
||||
#' Data Set with `r format(nrow(WHONET), big.mark = " ")` Isolates - WHONET Example
|
||||
#'
|
||||
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names were created using online surname generators and are only in place for practice purposes.
|
||||
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antimcrobial results are from our [example_isolates] data set. All patient names were created using online surname generators and are only in place for practice purposes.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(WHONET), big.mark = " ")` observations and `r ncol(WHONET)` variables:
|
||||
#' - `Identification number`\cr ID of the sample
|
||||
#' - `Specimen number`\cr ID of the specimen
|
||||
@@ -253,45 +265,56 @@
|
||||
#' - `Inducible clindamycin resistance`\cr Clindamycin can be induced?
|
||||
#' - `Comment`\cr Other comments
|
||||
#' - `Date of data entry`\cr [Date] this data was entered in WHONET
|
||||
#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.sir))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.sir()].
|
||||
#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.sir))` different antimicrobials. You can lookup the abbreviations in the [antimicrobials] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antimcrobial class, using [as.sir()].
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @examples
|
||||
#' WHONET
|
||||
"WHONET"
|
||||
|
||||
#' Data Set with Clinical Breakpoints for SIR Interpretation
|
||||
#'
|
||||
#' Data set containing clinical breakpoints to interpret MIC and disk diffusion to SIR values, according to international guidelines. Currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`). Use [as.sir()] to transform MICs or disks measurements to SIR values.
|
||||
#' @description Data set containing clinical breakpoints to interpret MIC and disk diffusion to SIR values, according to international guidelines. This dataset contain breakpoints for humans, `r length(unique(clinical_breakpoints$host[!clinical_breakpoints$host %in% clinical_breakpoints$type]))` different animal groups, and ECOFFs.
|
||||
#'
|
||||
#' These breakpoints are currently implemented:
|
||||
#' - For **clinical microbiology**: EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "human")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "human")$guideline)))` and CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "human")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "human")$guideline)))`;
|
||||
#' - For **veterinary microbiology**: EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "animal")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "animal")$guideline)))` and CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "animal")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "animal")$guideline)))`;
|
||||
#' - For **ECOFFs** (Epidemiological Cut-off Values): EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "ECOFF")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "EUCAST" & type == "ECOFF")$guideline)))` and CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "ECOFF")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI" & type == "ECOFF")$guideline)))`.
|
||||
#'
|
||||
#' Use [as.sir()] to transform MICs or disks measurements to SIR values.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(clinical_breakpoints), big.mark = " ")` observations and `r ncol(clinical_breakpoints)` variables:
|
||||
#' - `guideline`\cr Name of the guideline
|
||||
#' - `type`\cr Breakpoint type, either `r vector_or(clinical_breakpoints$type)`
|
||||
#' - `host`\cr Host of infectious agent. This is mostly useful for veterinary breakpoints and is either `r vector_or(clinical_breakpoints$host)`
|
||||
#' - `method`\cr Testing method, either `r vector_or(clinical_breakpoints$method)`
|
||||
#' - `site`\cr Body site for which the breakpoint must be applied, e.g. "Oral" or "Respiratory"
|
||||
#' - `mo`\cr Microbial ID, see [as.mo()]
|
||||
#' - `rank_index`\cr Taxonomic rank index of `mo` from 1 (subspecies/infraspecies) to 5 (unknown microorganism)
|
||||
#' - `ab`\cr Antibiotic code as used by this package, EARS-Net and WHONET, see [as.ab()]
|
||||
#' - `ab`\cr Antimcrobial code as used by this package, EARS-Net and WHONET, see [as.ab()]
|
||||
#' - `ref_tbl`\cr Info about where the guideline rule can be found
|
||||
#' - `disk_dose`\cr Dose of the used disk diffusion method
|
||||
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
|
||||
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
|
||||
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R", can be `NA`
|
||||
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
|
||||
#' - `is_SDD`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the intermediate range between "S" and "R" should be interpreted as "SDD", instead of "I". This currently applies to `r sum(clinical_breakpoints$is_SDD)` breakpoints.
|
||||
#' @details
|
||||
#' ### Different types of breakpoints
|
||||
#' Supported types of breakpoints are `r vector_and(clinical_breakpoints$type, quote = FALSE)`. ECOFF (Epidemiological cut-off) values are used in antimicrobial susceptibility testing to differentiate between wild-type and non-wild-type strains of bacteria or fungi.
|
||||
#'
|
||||
#' The default is `"human"`, which can also be set with the [package option][AMR-options] [`AMR_breakpoint_type`][AMR-options]. Use [`as.sir(..., breakpoint_type = ...)`][as.sir()] to interpret raw data using a specific breakpoint type, e.g. `as.sir(..., breakpoint_type = "ECOFF")` to use ECOFFs.
|
||||
#'
|
||||
#'
|
||||
#' The default is `"human"`, which can also be set with the package option [`AMR_breakpoint_type`][AMR-options]. Use [`as.sir(..., breakpoint_type = ...)`][as.sir()] to interpret raw data using a specific breakpoint type, e.g. `as.sir(..., breakpoint_type = "ECOFF")` to use ECOFFs.
|
||||
#'
|
||||
#' ### Imported from WHONET
|
||||
#' Clinical breakpoints in this package were validated through and imported from [WHONET](https://whonet.org), a free desktop Windows application developed and supported by the WHO Collaborating Centre for Surveillance of Antimicrobial Resistance. More can be read on [their website](https://whonet.org). The developers of WHONET and this `AMR` package have been in contact about sharing their work. We highly appreciate their development on the WHONET software.
|
||||
#'
|
||||
#' Clinical breakpoints in this package were validated through and imported from [WHONET](https://whonet.org), a free desktop Windows application developed and supported by the WHO Collaborating Centre for Surveillance of Antimicrobial Resistance. More can be read on [their website](https://whonet.org). The developers of WHONET and this `AMR` package have been in contact about sharing their work. We highly appreciate their great development on the WHONET software.
|
||||
#'
|
||||
#' Our import and reproduction script can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_clinical_breakpoints.R>.
|
||||
#'
|
||||
#' ### Response from CLSI and EUCAST
|
||||
#' The CEO of CLSI and the chairman of EUCAST have endorsed the work and public use of this `AMR` package (and consequently the use of their breakpoints) in June 2023, when future development of distributing clinical breakpoints was discussed in a meeting between CLSI, EUCAST, the WHO, and developers of WHONET and the `AMR` package.
|
||||
#'
|
||||
#' The CEO of CLSI and the chairman of EUCAST have endorsed the work and public use of this `AMR` package (and consequently the use of their breakpoints) in June 2023, when future development of distributing clinical breakpoints was discussed in a meeting between CLSI, EUCAST, WHO, developers of WHONET software, and developers of this `AMR` package.
|
||||
#'
|
||||
#' ### Download
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw). They allow for machine reading EUCAST and CLSI guidelines, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI, though initiatives have started to overcome these burdens.
|
||||
#'
|
||||
#' **NOTE:** this `AMR` package (and the WHONET software as well) contains internal methods to apply the guidelines, which is rather complex. For example, some breakpoints must be applied on certain species groups (which are in case of this package available through the [microorganisms.groups] data set). It is important that this is considered when using the breakpoints for own use.
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw). They allow for machine reading EUCAST and CLSI guidelines, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI, though initiatives have started to overcome these burdens.
|
||||
#'
|
||||
#' **NOTE:** this `AMR` package (and the WHONET software as well) contains rather complex internal methods to apply the guidelines. For example, some breakpoints must be applied on certain species groups (which are in case of this package available through the [microorganisms.groups] data set). It is important that this is considered when using the breakpoints for own use.
|
||||
#' @seealso [intrinsic_resistant]
|
||||
#' @examples
|
||||
#' clinical_breakpoints
|
||||
@@ -302,12 +325,12 @@
|
||||
#' Data set containing defined intrinsic resistance by EUCAST of all bug-drug combinations.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(intrinsic_resistant), big.mark = " ")` observations and `r ncol(intrinsic_resistant)` variables:
|
||||
#' - `mo`\cr Microorganism ID
|
||||
#' - `ab`\cr Antibiotic ID
|
||||
#' - `ab`\cr Antimcrobial ID
|
||||
#' @details
|
||||
#' This data set is based on `r format_eucast_version_nr(3.3)`.
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#'
|
||||
#' They **allow for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the MS Excel and PDF files distributed by EUCAST and CLSI.
|
||||
#' @examples
|
||||
@@ -318,7 +341,7 @@
|
||||
#'
|
||||
#' EUCAST breakpoints used in this package are based on the dosages in this data set. They can be retrieved with [eucast_dosage()].
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(dosage), big.mark = " ")` observations and `r ncol(dosage)` variables:
|
||||
#' - `ab`\cr Antibiotic ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
#' - `ab`\cr Antimcrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
#' - `name`\cr Official name of the antimicrobial drug as used by WHONET/EARS-Net or the WHO
|
||||
#' - `type`\cr Type of the dosage, either `r vector_or(dosage$type)`
|
||||
#' - `dose`\cr Dose, such as "2 g" or "25 mg/kg"
|
||||
@@ -328,7 +351,7 @@
|
||||
#' - `original_txt`\cr Original text in the PDF file of EUCAST
|
||||
#' - `eucast_version`\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply, either `r vector_or(dosage$eucast_version, quotes = FALSE, sort = TRUE, reverse = TRUE)`
|
||||
#' @details
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
|
||||
#' @examples
|
||||
#' dosage
|
||||
"dosage"
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,13 +29,13 @@
|
||||
|
||||
#' Transform Input to Disk Diffusion Diameters
|
||||
#'
|
||||
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 6 and 50.
|
||||
#' This transforms a vector to a new class [`disk`], which is a disk diffusion growth zone size (around an antibiotic disk) in millimetres between 0 and 50.
|
||||
#' @rdname as.disk
|
||||
#' @param x vector
|
||||
#' @param na.rm a [logical] indicating whether missing values should be removed
|
||||
#' @details Interpret disk values as SIR values with [as.sir()]. It supports guidelines from EUCAST and CLSI.
|
||||
#'
|
||||
#' Disk diffusion growth zone sizes must be between 6 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 6-50 range will return `NA`.
|
||||
#' Disk diffusion growth zone sizes must be between 0 and 50 millimetres. Values higher than 50 but lower than 100 will be maximised to 50. All others input values outside the 0-50 range will return `NA`.
|
||||
#' @return An [integer] with additional class [`disk`]
|
||||
#' @aliases disk
|
||||
#' @export
|
||||
@@ -108,8 +108,8 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||
# round up and make it an integer
|
||||
x <- as.integer(ceiling(clean_double2(x)))
|
||||
|
||||
# disks can never be less than 6 mm (size of smallest disk) or more than 50 mm
|
||||
x[x < 6 | x > 99] <- NA_integer_
|
||||
# disks can never be less than 0 mm or more than 50 mm
|
||||
x[x < 0 | x > 99] <- NA_integer_
|
||||
x[x > 50] <- 50L
|
||||
na_after <- length(x[is.na(x)])
|
||||
|
||||
@@ -121,7 +121,7 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||
cur_col <- get_current_column()
|
||||
warning_("in `as.disk()`: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
ifelse(is.null(cur_col), "", paste0(" in index '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
@@ -165,11 +165,6 @@ pillar_shaft.disk <- function(x, ...) {
|
||||
create_pillar_column(out, align = "right", width = 2)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
type_sum.disk <- function(x, ...) {
|
||||
"disk"
|
||||
}
|
||||
|
||||
#' @method print disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
|
||||
+114
-76
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -56,22 +56,23 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' Apply EUCAST Rules
|
||||
#'
|
||||
#' @description
|
||||
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://www.eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
|
||||
#' Apply rules from clinical breakpoints notes and expected resistant phenotypes as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://www.eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
|
||||
#'
|
||||
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
|
||||
#' @param x a data set with antibiotic columns, such as `amox`, `AMX` and `AMC`
|
||||
#' @param x a data set with antimicrobials columns, such as `amox`, `AMX` and `AMC`
|
||||
#' @param info a [logical] to indicate whether progress should be printed to the console - the default is only print while in interactive sessions
|
||||
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value using the [package option][AMR-options] [`AMR_eucastrules`][AMR-options]: `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
|
||||
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value using the package option [`AMR_eucastrules`][AMR-options]: `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
|
||||
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
|
||||
#' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Can be `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), 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 version_resistant_phenotypes the version number to use for the EUCAST Expected Resistant Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_RESISTANTPHENOTYPES), reverse = TRUE)`.
|
||||
#' @param ampc_cephalosporin_resistance 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 version 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 antibiotic, see section *Antibiotics* below
|
||||
#' @param ab any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()]
|
||||
#' @param ... column name of an antimicrobial, see section *Antimicrobials* below
|
||||
#' @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 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 detected that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`)
|
||||
#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()]
|
||||
#' @param overwrite A [logical] indicating whether to overwrite non-`NA` values (default: `FALSE`). When `FALSE`, only `NA` values are modified. 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
|
||||
#' @details
|
||||
#' **Note:** This function does not translate MIC values to SIR values. Use [as.sir()] for that. \cr
|
||||
@@ -99,17 +100,17 @@ 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-options] [`AMR_eucastrules`][AMR-options], i.e. run `options(AMR_eucastrules = "all")`.
|
||||
#' @section Antibiotics:
|
||||
#' To define antibiotics 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.
|
||||
#' 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 antibiotics are eligible for the functions [eucast_rules()] and [mdro()]. These are shown below in the format 'name (`antimicrobial ID`, [ATC code](https://www.whocc.no/atc/structure_and_principles/))', sorted alphabetically:
|
||||
#' 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
|
||||
#' @return The input of `x`, possibly with edited values of antibiotics. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations.
|
||||
#' @return The input of `x`, possibly with edited values of antimicrobials. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations.
|
||||
#' @source
|
||||
#' - EUCAST Expert Rules. Version 2.0, 2012.\cr
|
||||
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60; \doi{https://doi.org/10.1111/j.1469-0691.2011.03703.x}
|
||||
@@ -166,12 +167,13 @@ eucast_rules <- function(x,
|
||||
info = interactive(),
|
||||
rules = getOption("AMR_eucastrules", default = c("breakpoints", "expert")),
|
||||
verbose = FALSE,
|
||||
version_breakpoints = 12.0,
|
||||
version_breakpoints = 14.0,
|
||||
version_expertrules = 3.3,
|
||||
# TODO version_resistant_phenotypes = 1.2,
|
||||
ampc_cephalosporin_resistance = NA,
|
||||
only_sir_columns = FALSE,
|
||||
custom_rules = NULL,
|
||||
overwrite = FALSE,
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
@@ -184,7 +186,7 @@ eucast_rules <- function(x,
|
||||
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
||||
if ("only_rsi_columns" %in% names(list(...))) only_sir_columns <- list(...)$only_rsi_columns
|
||||
meet_criteria(overwrite, allow_class = "logical", has_length = 1)
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
@@ -209,7 +211,7 @@ eucast_rules <- function(x,
|
||||
breakpoints_info <- EUCAST_VERSION_BREAKPOINTS[[which(as.double(names(EUCAST_VERSION_BREAKPOINTS)) == version_breakpoints)]]
|
||||
expertrules_info <- EUCAST_VERSION_EXPERT_RULES[[which(as.double(names(EUCAST_VERSION_EXPERT_RULES)) == version_expertrules)]]
|
||||
# resistantphenotypes_info <- EUCAST_VERSION_RESISTANTPHENOTYPES[[which(as.double(names(EUCAST_VERSION_RESISTANTPHENOTYPES)) == version_resistant_phenotypes)]]
|
||||
|
||||
|
||||
# support old setting (until AMR v1.3.0)
|
||||
if (missing(rules) && !is.null(getOption("AMR.eucast_rules"))) {
|
||||
rules <- getOption("AMR.eucast_rules")
|
||||
@@ -255,18 +257,18 @@ eucast_rules <- function(x,
|
||||
} else {
|
||||
# opening
|
||||
if (n_added > 0 && n_changed == 0) {
|
||||
cat(font_green(" ("))
|
||||
cat(font_bold(font_green(" (")))
|
||||
} else if (n_added == 0 && n_changed > 0) {
|
||||
cat(font_blue(" ("))
|
||||
cat(font_bold(font_blue(" (")))
|
||||
} else {
|
||||
cat(font_grey(" ("))
|
||||
}
|
||||
# additions
|
||||
if (n_added > 0) {
|
||||
if (n_added == 1) {
|
||||
cat(font_green("1 value added"))
|
||||
cat(font_bold(font_green("1 value added")))
|
||||
} else {
|
||||
cat(font_green(formatnr(n_added), "values added"))
|
||||
cat(font_bold(font_green(formatnr(n_added), "values added")))
|
||||
}
|
||||
}
|
||||
# separator
|
||||
@@ -276,16 +278,16 @@ eucast_rules <- function(x,
|
||||
# changes
|
||||
if (n_changed > 0) {
|
||||
if (n_changed == 1) {
|
||||
cat(font_blue("1 value changed"))
|
||||
cat(font_bold(font_blue("1 value changed")))
|
||||
} else {
|
||||
cat(font_blue(formatnr(n_changed), "values changed"))
|
||||
cat(font_bold(font_blue(formatnr(n_changed), "values changed")))
|
||||
}
|
||||
}
|
||||
# closing
|
||||
if (n_added > 0 && n_changed == 0) {
|
||||
cat(font_green(")\n"))
|
||||
cat(font_bold(font_green(")\n")))
|
||||
} else if (n_added == 0 && n_changed > 0) {
|
||||
cat(font_blue(")\n"))
|
||||
cat(font_bold(font_blue(")\n")))
|
||||
} else {
|
||||
cat(font_grey(")\n"))
|
||||
}
|
||||
@@ -302,12 +304,13 @@ eucast_rules <- function(x,
|
||||
"AMX",
|
||||
"CIP",
|
||||
"ERY",
|
||||
"FOX1",
|
||||
"FOX-S",
|
||||
"GEN",
|
||||
"MFX",
|
||||
"NAL",
|
||||
"NOR",
|
||||
"PEN",
|
||||
"NAL-S",
|
||||
"NOR-S",
|
||||
"OXA-S",
|
||||
"PEN-S",
|
||||
"PIP",
|
||||
"TCY",
|
||||
"TIC",
|
||||
@@ -340,7 +343,7 @@ eucast_rules <- function(x,
|
||||
strsplit(",") %pm>%
|
||||
unlist() %pm>%
|
||||
trimws2() %pm>%
|
||||
vapply(FUN.VALUE = character(1), function(x) if (x %in% AMR::antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE, fast_mode = TRUE) else x) %pm>%
|
||||
vapply(FUN.VALUE = character(1), function(x) if (x %in% AMR::antimicrobials$ab) ab_name(x, language = NULL, tolower = TRUE, fast_mode = TRUE) else x) %pm>%
|
||||
sort() %pm>%
|
||||
paste(collapse = ", ")
|
||||
x <- gsub("_", " ", x, fixed = TRUE)
|
||||
@@ -360,10 +363,8 @@ eucast_rules <- function(x,
|
||||
# like PEN,FOX S
|
||||
x <- paste(paste0(ab_names, collapse = " and "), "are both")
|
||||
} else {
|
||||
# like PEN,FOX,GEN S (although dependency on > 2 ABx does not exist at the moment)
|
||||
# nolint start
|
||||
# x <- paste(paste0(ab_names, collapse = " and "), "are all")
|
||||
# nolint end
|
||||
# like PEN,FOX,GEN S
|
||||
x <- paste(paste0(ab_names, collapse = " and "), "are all")
|
||||
}
|
||||
return(paste0(x, " '", ab_results, "'"))
|
||||
} else {
|
||||
@@ -374,7 +375,7 @@ eucast_rules <- function(x,
|
||||
ab_names[2], " is '", ab_results[2], "'"
|
||||
)
|
||||
} else {
|
||||
# like PEN,FOX,GEN S,R,R (although dependency on > 2 ABx does not exist at the moment)
|
||||
# like PEN,FOX,GEN S,R,R
|
||||
paste0(
|
||||
ab_names[1], " is '", ab_results[1], "' and ",
|
||||
ab_names[2], " is '", ab_results[2], "' and ",
|
||||
@@ -453,24 +454,24 @@ eucast_rules <- function(x,
|
||||
n_added <- 0
|
||||
n_changed <- 0
|
||||
|
||||
# Other rules: enzyme inhibitors ------------------------------------------
|
||||
# >>> Apply Other rules: enzyme inhibitors <<< ------------------------------------------
|
||||
if (any(c("all", "other") %in% rules)) {
|
||||
if (isTRUE(info)) {
|
||||
cat("\n")
|
||||
cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
|
||||
cat(word_wrap(
|
||||
font_bold(paste0(
|
||||
"Rules by this AMR package (",
|
||||
font_red(paste0(
|
||||
"v", utils::packageDescription("AMR")$Version, ", ",
|
||||
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y")
|
||||
)), "), see ?eucast_rules\n"
|
||||
))
|
||||
paste0(
|
||||
"Rules by the ",
|
||||
font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)),
|
||||
" (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"),
|
||||
"), see `?eucast_rules`\n"
|
||||
)
|
||||
))
|
||||
cat("\n\n")
|
||||
}
|
||||
ab_enzyme <- subset(AMR::antibiotics, name %like% "/")[, c("ab", "name"), drop = FALSE]
|
||||
ab_enzyme <- subset(AMR::antimicrobials, name %like% "/")[, c("ab", "name"), drop = FALSE]
|
||||
colnames(ab_enzyme) <- c("enzyme_ab", "enzyme_name")
|
||||
ab_enzyme$base_name <- gsub("^([a-zA-Z0-9]+).*", "\\1", ab_enzyme$enzyme_name)
|
||||
ab_enzyme$base_ab <- AMR::antibiotics[match(ab_enzyme$base_name, AMR::antibiotics$name), "ab", drop = TRUE]
|
||||
ab_enzyme$base_ab <- AMR::antimicrobials[match(ab_enzyme$base_name, AMR::antimicrobials$name), "ab", drop = TRUE]
|
||||
ab_enzyme <- subset(ab_enzyme, !is.na(base_ab))
|
||||
# make ampicillin and amoxicillin interchangable
|
||||
ampi <- subset(ab_enzyme, base_ab == "AMX")
|
||||
@@ -489,10 +490,10 @@ eucast_rules <- function(x,
|
||||
col_base <- unname(cols_ab[ab_enzyme$base_ab[i]])
|
||||
col_enzyme <- unname(cols_ab[ab_enzyme$enzyme_ab[i]])
|
||||
|
||||
# Set base to R where base + enzyme inhibitor is R ----
|
||||
## Set base to R where base + enzyme inhibitor is R ----
|
||||
rule_current <- paste0(
|
||||
ab_enzyme$base_name[i], " ('", font_bold(col_base), "') = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " ('", font_bold(col_enzyme), "') = R"
|
||||
ab_enzyme$base_name[i], " (`", col_base, "`) = R if ",
|
||||
tolower(ab_enzyme$enzyme_name[i]), " (`", col_enzyme, "`) = R"
|
||||
)
|
||||
if (isTRUE(info)) {
|
||||
cat(word_wrap(rule_current,
|
||||
@@ -513,7 +514,8 @@ eucast_rules <- function(x,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info,
|
||||
verbose = verbose
|
||||
verbose = verbose,
|
||||
overwrite = overwrite
|
||||
)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
@@ -529,10 +531,10 @@ eucast_rules <- function(x,
|
||||
n_changed <- 0
|
||||
}
|
||||
|
||||
# Set base + enzyme inhibitor to S where base is S ----
|
||||
## Set base + enzyme inhibitor to S where base is S ----
|
||||
rule_current <- paste0(
|
||||
ab_enzyme$enzyme_name[i], " ('", font_bold(col_enzyme), "') = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " ('", font_bold(col_base), "') = S"
|
||||
ab_enzyme$enzyme_name[i], " (`", col_enzyme, "`) = S if ",
|
||||
tolower(ab_enzyme$base_name[i]), " (`", col_base, "`) = S"
|
||||
)
|
||||
|
||||
if (isTRUE(info)) {
|
||||
@@ -554,7 +556,8 @@ eucast_rules <- function(x,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info,
|
||||
verbose = verbose
|
||||
verbose = verbose,
|
||||
overwrite = overwrite
|
||||
)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
@@ -585,17 +588,17 @@ eucast_rules <- function(x,
|
||||
custom_rules <- NULL
|
||||
}
|
||||
|
||||
# Official EUCAST rules ---------------------------------------------------
|
||||
# >>> Apply Official EUCAST rules <<< ---------------------------------------------------
|
||||
eucast_notification_shown <- FALSE
|
||||
if (!is.null(list(...)$eucast_rules_df)) {
|
||||
# this allows: eucast_rules(x, eucast_rules_df = AMR:::EUCAST_RULES_DF %>% filter(is.na(have_these_values)))
|
||||
eucast_rules_df <- list(...)$eucast_rules_df
|
||||
} else {
|
||||
# otherwise internal data file, created in data-raw/_pre_commit_hook.R
|
||||
# otherwise internal data file, created in data-raw/_pre_commit_checks.R
|
||||
eucast_rules_df <- EUCAST_RULES_DF
|
||||
}
|
||||
|
||||
# filter on user-set guideline versions ----
|
||||
## filter on user-set guideline versions ----
|
||||
if (any(c("all", "breakpoints") %in% rules)) {
|
||||
eucast_rules_df <- subset(
|
||||
eucast_rules_df,
|
||||
@@ -610,7 +613,7 @@ eucast_rules <- function(x,
|
||||
(reference.rule_group %like% "expert" & reference.version == version_expertrules)
|
||||
)
|
||||
}
|
||||
# filter out AmpC de-repressed cephalosporin-resistant mutants ----
|
||||
## 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
|
||||
# cefotaxime, ceftriaxone, ceftazidime
|
||||
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
|
||||
@@ -625,7 +628,25 @@ eucast_rules <- function(x,
|
||||
eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
|
||||
}
|
||||
|
||||
# Go over all rules and apply them ----
|
||||
# sometimes, the screenings are missing but the names are actually available
|
||||
# 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)], ", *")))]
|
||||
for (ab_s in screening_abx) {
|
||||
ab <- gsub("-S$", "", ab_s)
|
||||
if (ab %in% names(cols_ab) && !ab_s %in% names(cols_ab)) {
|
||||
if (isTRUE(info)) {
|
||||
message_("Using column '", cols_ab[names(cols_ab) == ab],
|
||||
"' as ", ab_name(ab_s, language = NULL, tolower = TRUE),
|
||||
" since a column '", ab_s, "' is missing but required for the chosen rules",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
cols_ab <- c(cols_ab, stats::setNames(unname(cols_ab[names(cols_ab) == ab]), ab_s))
|
||||
}
|
||||
}
|
||||
|
||||
## Go over all rules and apply them ----
|
||||
for (i in seq_len(nrow(eucast_rules_df))) {
|
||||
rule_previous <- eucast_rules_df[max(1, i - 1), "reference.rule", drop = TRUE]
|
||||
rule_current <- eucast_rules_df[i, "reference.rule", drop = TRUE]
|
||||
@@ -665,19 +686,19 @@ eucast_rules <- function(x,
|
||||
}
|
||||
|
||||
if (isTRUE(info)) {
|
||||
# Print EUCAST intro ------------------------------------------------------
|
||||
## Print EUCAST intro ------------------------------------------------------
|
||||
if (rule_group_current %unlike% "other" && eucast_notification_shown == FALSE) {
|
||||
cat(
|
||||
paste0(
|
||||
"\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n",
|
||||
word_wrap("Rules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)")), "\n",
|
||||
font_blue("https://eucast.org/"), "\n"
|
||||
font_blue(font_url("https://eucast.org/")), "\n"
|
||||
)
|
||||
)
|
||||
eucast_notification_shown <- TRUE
|
||||
}
|
||||
|
||||
# Print rule (group) ------------------------------------------------------
|
||||
## Print rule (group) ------------------------------------------------------
|
||||
if (rule_group_current != rule_group_previous) {
|
||||
# is new rule group, one of Breakpoints, Expert Rules and Other
|
||||
cat(font_bold(
|
||||
@@ -704,7 +725,7 @@ eucast_rules <- function(x,
|
||||
)
|
||||
), "\n")
|
||||
}
|
||||
# Print rule -------------------------------------------------------------
|
||||
## Print rule -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
# is new rule within group, print its name
|
||||
cat(italicise_taxonomy(
|
||||
@@ -718,7 +739,7 @@ eucast_rules <- function(x,
|
||||
}
|
||||
}
|
||||
|
||||
# Get rule from file ------------------------------------------------------
|
||||
## Get rule from file ------------------------------------------------------
|
||||
if_mo_property <- trimws(eucast_rules_df[i, "if_mo_property", drop = TRUE])
|
||||
like_is_one_of <- trimws(eucast_rules_df[i, "like.is.one_of", drop = TRUE])
|
||||
mo_value <- trimws(eucast_rules_df[i, "this_value", drop = TRUE])
|
||||
@@ -819,13 +840,13 @@ eucast_rules <- function(x,
|
||||
# error = function(e) integer(0))
|
||||
# nolint end
|
||||
} else {
|
||||
stop_("only 2 antibiotics supported for source_antibiotics")
|
||||
stop_("only 2 antimicrobials supported for source_antibiotics")
|
||||
}
|
||||
}
|
||||
|
||||
cols <- get_ab_from_namespace(target_antibiotics, cols_ab)
|
||||
|
||||
# Apply rule on data ------------------------------------------------------
|
||||
## Apply rule on data ------------------------------------------------------
|
||||
# this will return the unique number of changes
|
||||
run_changes <- edit_sir(
|
||||
x = x,
|
||||
@@ -843,14 +864,15 @@ eucast_rules <- function(x,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info,
|
||||
verbose = verbose
|
||||
verbose = verbose,
|
||||
overwrite = overwrite
|
||||
)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
x <- run_changes$output
|
||||
warn_lacking_sir_class <- c(warn_lacking_sir_class, run_changes$sir_warn)
|
||||
# Print number of new changes ---------------------------------------------
|
||||
## Print number of new changes ---------------------------------------------
|
||||
if (isTRUE(info) && rule_next != rule_current) {
|
||||
# print only on last one of rules in this group
|
||||
txt_ok(n_added = n_added, n_changed = n_changed, warned = warned)
|
||||
@@ -860,7 +882,7 @@ eucast_rules <- function(x,
|
||||
}
|
||||
} # end of going over all rules
|
||||
|
||||
# Apply custom rules ----
|
||||
# >>> Apply custom rules <<< ----
|
||||
if (!is.null(custom_rules)) {
|
||||
if (isTRUE(info)) {
|
||||
cat("\n")
|
||||
@@ -890,6 +912,7 @@ eucast_rules <- function(x,
|
||||
),
|
||||
type = "ansi"
|
||||
))
|
||||
cat("\n")
|
||||
warned <- FALSE
|
||||
}
|
||||
run_changes <- edit_sir(
|
||||
@@ -910,14 +933,15 @@ eucast_rules <- function(x,
|
||||
original_data = x.bak,
|
||||
warned = warned,
|
||||
info = info,
|
||||
verbose = verbose
|
||||
verbose = verbose,
|
||||
overwrite = overwrite
|
||||
)
|
||||
n_added <- n_added + run_changes$added
|
||||
n_changed <- n_changed + run_changes$changed
|
||||
verbose_info <- run_changes$verbose_info
|
||||
x <- run_changes$output
|
||||
warn_lacking_sir_class <- c(warn_lacking_sir_class, run_changes$sir_warn)
|
||||
# Print number of new changes ---------------------------------------------
|
||||
## Print number of new changes ---------------------------------------------
|
||||
if (isTRUE(info) && rule_next != rule_current) {
|
||||
# print only on last one of rules in this group
|
||||
txt_ok(n_added = n_added, n_changed = n_changed, warned = warned)
|
||||
@@ -940,6 +964,10 @@ eucast_rules <- function(x,
|
||||
pm_select(row, pm_everything()) %pm>%
|
||||
pm_filter(!is.na(new) | is.na(new) & !is.na(old)) %pm>%
|
||||
pm_arrange(row, rule_group, rule_name, col)
|
||||
if (isFALSE(overwrite)) {
|
||||
verbose_info <- verbose_info %pm>%
|
||||
pm_filter(!old %in% levels(NA_sir_))
|
||||
}
|
||||
rownames(verbose_info) <- NULL
|
||||
}
|
||||
|
||||
@@ -1025,9 +1053,9 @@ eucast_rules <- function(x,
|
||||
cat(paste0(font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
|
||||
|
||||
if (isFALSE(verbose) && total_n_added + total_n_changed > 0) {
|
||||
cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a data.frame with all specified edits instead."), "\n\n", sep = "")
|
||||
cat("\n", word_wrap("Use `eucast_rules(..., verbose = TRUE)` (on your original data) to get a data.frame with all specified edits instead."), "\n\n", sep = "")
|
||||
} else if (isTRUE(verbose)) {
|
||||
cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a data.frame with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "")
|
||||
cat("\n", word_wrap("Used 'Verbose mode' (`verbose = TRUE`), which returns a data.frame with all specified edits.\nUse `verbose = FALSE` to apply the rules on your data."), "\n\n", sep = "")
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1074,7 +1102,8 @@ edit_sir <- function(x,
|
||||
original_data,
|
||||
warned,
|
||||
info,
|
||||
verbose) {
|
||||
verbose,
|
||||
overwrite) {
|
||||
cols <- unique(cols[!is.na(cols) & !is.null(cols)])
|
||||
|
||||
# for Verbose Mode, keep track of all changes and return them
|
||||
@@ -1101,9 +1130,14 @@ edit_sir <- function(x,
|
||||
if (any(!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.sir), na.rm = TRUE)) {
|
||||
track_changes$sir_warn <- cols[!vapply(FUN.VALUE = logical(1), x[, cols, drop = FALSE], is.sir)]
|
||||
}
|
||||
non_SIR <- is.na(new_edits[rows, cols]) | !(new_edits[rows, cols] == "S" | new_edits[rows, cols] == "I" | new_edits[rows, cols] == "R" | new_edits[rows, cols] == "SDD" | new_edits[rows, cols] == "NI")
|
||||
tryCatch(
|
||||
# insert into original table
|
||||
new_edits[rows, cols] <- to,
|
||||
if (isTRUE(overwrite)) {
|
||||
new_edits[rows, cols] <- to
|
||||
} else {
|
||||
new_edits[rows, cols][non_SIR] <- to
|
||||
},
|
||||
warning = function(w) {
|
||||
if (w$message %like% "invalid factor level") {
|
||||
xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) {
|
||||
@@ -1113,7 +1147,11 @@ edit_sir <- function(x,
|
||||
)
|
||||
TRUE
|
||||
})
|
||||
suppressWarnings(new_edits[rows, cols] <<- to)
|
||||
if (isTRUE(overwrite)) {
|
||||
suppressWarnings(new_edits[rows, cols] <<- to)
|
||||
} else {
|
||||
suppressWarnings(new_edits[rows, cols][non_SIR] <<- to)
|
||||
}
|
||||
warning_(
|
||||
"in `eucast_rules()`: value \"", to, "\" added to the factor levels of column",
|
||||
ifelse(length(cols) == 1, "", "s"),
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -27,54 +27,31 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
expect_equal(
|
||||
as.character(as.av(c(
|
||||
"J05AB01",
|
||||
"J 05 AB 01",
|
||||
"Aciclovir",
|
||||
"aciclo",
|
||||
" aciclo 123",
|
||||
"ACICL",
|
||||
"ACI",
|
||||
"Virorax",
|
||||
"Zovirax"
|
||||
))),
|
||||
rep("ACI", 9)
|
||||
)
|
||||
#' Export Data Set as NCBI BioSample Antibiogram
|
||||
#'
|
||||
#'
|
||||
#' @param x a data set
|
||||
#' @param filename a character string specifying the file name
|
||||
#' @param type a character string specifying the type of data set, either "pathogen MIC" or "beta-lactamase MIC", see <https://www.ncbi.nlm.nih.gov/biosample/docs/>
|
||||
#' @keywords internal
|
||||
export_ncbi_biosample <- function(x,
|
||||
filename = paste0("biosample_", format(Sys.time(), "%Y-%m-%d-%H%M%S"), ".xlsx"),
|
||||
type = "pathogen MIC",
|
||||
columns = where(is.mic),
|
||||
save_as_xlsx = TRUE) {
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(filename, allow_class = "character", has_length = 1)
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("pathogen MIC", "beta-lactamase MIC"))
|
||||
meet_criteria(save_as_xlsx, allow_class = "logical", has_length = 1)
|
||||
|
||||
expect_identical(class(as.av("acic")), c("av", "character"))
|
||||
expect_identical(class(antivirals$av), c("av", "character"))
|
||||
expect_true(is.av(as.av("acic")))
|
||||
expect_stdout(print(as.av("acic")))
|
||||
expect_stdout(print(data.frame(a = as.av("acic"))))
|
||||
out <- x %pm>%
|
||||
pm_select(columns)
|
||||
stop_if(NROW(out) == 0, "No columns found.")
|
||||
|
||||
# expect_warning(as.av("J00AA00")) # ATC not yet available in data set
|
||||
# expect_warning(as.av("UNKNOWN"))
|
||||
|
||||
expect_stdout(print(as.av("acic")))
|
||||
|
||||
expect_equal(
|
||||
as.character(as.av("zovirax")),
|
||||
"ACI"
|
||||
)
|
||||
|
||||
expect_equal(
|
||||
as.character(as.av(c("Abacaivr", "Celvudine"))),
|
||||
c("ABA", "CLE")
|
||||
)
|
||||
|
||||
# expect_warning(as.av("Abacavir Clevudine"))
|
||||
|
||||
# based on Levenshtein distance
|
||||
expect_identical(av_name("adevofir dypifo", language = NULL), "Adefovir dipivoxil")
|
||||
|
||||
# assigning and subsetting
|
||||
x <- antivirals$av
|
||||
expect_inherits(x[1], "av")
|
||||
expect_inherits(x[[1]], "av")
|
||||
expect_inherits(c(x[1], x[9]), "av")
|
||||
expect_inherits(unique(x[1], x[9]), "av")
|
||||
expect_inherits(rep(x[1], 2), "av")
|
||||
# expect_warning(x[1] <- "invalid code")
|
||||
# expect_warning(x[[1]] <- "invalid code")
|
||||
# expect_warning(c(x[1], "test"))
|
||||
if (isTRUE(save_as_xlsx)) {
|
||||
export <- import_fn("write.xlsx", pkg = "openxlsx", error_on_fail = TRUE)
|
||||
export(out, file = filename, overwrite = TRUE, asTable = FALSE)
|
||||
} else {
|
||||
out
|
||||
}
|
||||
}
|
||||
+48
-35
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -51,6 +51,8 @@
|
||||
#' @param include_untested_sir a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_sir = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `sir` and consequently requires transforming columns with antibiotic results using [as.sir()] first.
|
||||
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], otherwise arguments passed on to [key_antimicrobials()] (such as `universal`, `gram_negative`, `gram_positive`)
|
||||
#' @details
|
||||
#' The methodology implemented in these functions is strictly based on the recommendations outlined in [CLSI Guideline M39](https://clsi.org/standards/products/microbiology/documents/m39) and the research overview by Hindler *et al.* (2007, \doi{10.1086/511864}).
|
||||
#'
|
||||
#' To conduct epidemiological analyses on antimicrobial resistance data, only so-called first isolates should be included to prevent overestimation and underestimation of antimicrobial resistance. Different methods can be used to do so, see below.
|
||||
#'
|
||||
#' These functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
|
||||
@@ -61,7 +63,7 @@
|
||||
#'
|
||||
#' ### Different methods
|
||||
#'
|
||||
#' According to Hindler *et al.* (2007, \doi{10.1086/511864}), there are different methods (algorithms) to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All methods select on a combination of the taxonomic genus and species (not subspecies).
|
||||
#' According to previously-mentioned sources, there are different methods (algorithms) to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All methods select on a combination of the taxonomic genus and species (not subspecies).
|
||||
#'
|
||||
#' All mentioned methods are covered in the [first_isolate()] function:
|
||||
#'
|
||||
@@ -93,11 +95,11 @@
|
||||
#'
|
||||
#' ### Patient-based
|
||||
#'
|
||||
#' To include every genus-species combination per patient once, set the `episode_days` to `Inf`. Although often inappropriate, this method makes sure that no duplicate isolates are selected from the same patient. In a large longitudinal data set, this could mean that isolates are *excluded* that were found years after the initial isolate.
|
||||
#' To include every genus-species combination per patient once, set the `episode_days` to `Inf`. This method makes sure that no duplicate isolates are selected from the same patient. This method is preferred to e.g. identify the first MRSA finding of each patient to determine the incidence. Conversely, in a large longitudinal data set, this could mean that isolates are *excluded* that were found years after the initial isolate.
|
||||
#'
|
||||
#' ### Episode-based
|
||||
#'
|
||||
#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data, long episodes are common for analysing regional and national data.
|
||||
#' To include every genus-species combination per patient episode once, set the `episode_days` to a sensible number of days. Depending on the type of analysis, this could be 14, 30, 60 or 365. Short episodes are common for analysing specific hospital or ward data or ICU cases, long episodes are common for analysing regional and national data.
|
||||
#'
|
||||
#' This is the most common method to correct for duplicate isolates. Patients are categorised into episodes based on their ID and dates (e.g., the date of specimen receipt or laboratory result). While this is a common method, it does not take into account antimicrobial test results. This means that e.g. a methicillin-resistant *Staphylococcus aureus* (MRSA) isolate cannot be differentiated from a wildtype *Staphylococcus aureus* isolate.
|
||||
#'
|
||||
@@ -124,7 +126,7 @@
|
||||
#' @seealso [key_antimicrobials()]
|
||||
#' @export
|
||||
#' @return A [logical] vector
|
||||
#' @source Methodology of this function is strictly based on:
|
||||
#' @source Methodology of these functions is strictly based on:
|
||||
#'
|
||||
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#'
|
||||
@@ -227,10 +229,6 @@ first_isolate <- function(x = NULL,
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
|
||||
if ("include_untested_rsi" %in% names(list(...))) {
|
||||
deprecation_warning("include_untested_rsi", "include_untested_sir", is_function = FALSE)
|
||||
include_untested_sir <- list(...)$include_untested_rsi
|
||||
}
|
||||
meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
|
||||
|
||||
# remove data.table, grouping from tibbles, etc.
|
||||
@@ -240,7 +238,7 @@ first_isolate <- function(x = NULL,
|
||||
FUN.VALUE = logical(1),
|
||||
X = x,
|
||||
# check only first 10,000 rows
|
||||
FUN = function(x) any(as.character(x[1:10000]) %in% c("S", "I", "R"), na.rm = TRUE),
|
||||
FUN = function(x) any(as.character(x[1:10000]) %in% c("S", "SDD", "I", "R", "NI"), na.rm = TRUE),
|
||||
USE.NAMES = FALSE
|
||||
))
|
||||
if (method == "phenotype-based" && !any_col_contains_sir) {
|
||||
@@ -366,7 +364,7 @@ first_isolate <- function(x = NULL,
|
||||
specimen_group <- NULL
|
||||
}
|
||||
|
||||
# filter on specimen group and keyantibiotics when they are filled in
|
||||
# filter on specimen group and keyantimicrobials when they are filled in
|
||||
if (!is.null(specimen_group)) {
|
||||
check_columns_existance(col_specimen, x)
|
||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "excludingspecimen")) {
|
||||
@@ -468,7 +466,7 @@ first_isolate <- function(x = NULL,
|
||||
x$other_pat_or_mo <- !(x$newvar_patient_id == pm_lag(x$newvar_patient_id) & x$newvar_genus_species == pm_lag(x$newvar_genus_species))
|
||||
|
||||
x$newvar_episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
|
||||
|
||||
|
||||
x$more_than_episode_ago <- unlist(
|
||||
lapply(
|
||||
split(
|
||||
@@ -481,7 +479,7 @@ first_isolate <- function(x = NULL,
|
||||
),
|
||||
use.names = FALSE
|
||||
)
|
||||
|
||||
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
# using phenotypes
|
||||
x$different_antibiogram <- !unlist(
|
||||
@@ -500,15 +498,15 @@ first_isolate <- function(x = NULL,
|
||||
} else {
|
||||
x$different_antibiogram <- FALSE
|
||||
}
|
||||
|
||||
|
||||
x$newvar_first_isolate <- x$newvar_row_index_sorted >= row.start &
|
||||
x$newvar_row_index_sorted <= row.end &
|
||||
x$newvar_genus_species != "" &
|
||||
(x$other_pat_or_mo | x$more_than_episode_ago | x$different_antibiogram)
|
||||
|
||||
|
||||
decimal.mark <- getOption("OutDec")
|
||||
big.mark <- ifelse(decimal.mark != ",", ",", " ")
|
||||
|
||||
|
||||
# first one as TRUE
|
||||
x[row.start, "newvar_first_isolate"] <- TRUE
|
||||
# no tests that should be included, or ICU
|
||||
@@ -519,7 +517,8 @@ first_isolate <- function(x = NULL,
|
||||
if (icu_exclude == TRUE) {
|
||||
if (isTRUE(info)) {
|
||||
message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.",
|
||||
add_fn = font_red)
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE
|
||||
} else if (isTRUE(info)) {
|
||||
@@ -674,21 +673,28 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
|
||||
# fast return, only 1 isolate
|
||||
return(FALSE)
|
||||
}
|
||||
# first sort on data availability - count the dots and order that ascending so that highest availability of SIR is on top
|
||||
number_dots <- vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
antibiogram,
|
||||
function(x) sum(strsplit(x, "", fixed = TRUE)[[1]] == "."),
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
new_order <- order(number_dots, antibiogram)
|
||||
antibiogram.bak <- antibiogram
|
||||
antibiogram <- antibiogram[new_order]
|
||||
|
||||
out <- rep(NA, length(antibiogram))
|
||||
out[1] <- FALSE
|
||||
out[2] <- antimicrobials_equal(antibiogram[1], antibiogram[2],
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type
|
||||
)
|
||||
if (length(antibiogram) == 2) {
|
||||
# fast return, no further check required
|
||||
return(out)
|
||||
}
|
||||
|
||||
# sort after the second one (since we already determined AB equality of the first two)
|
||||
original_sort <- c(1, 2, rank(antibiogram[3:length(antibiogram)]) + 2)
|
||||
antibiogram.bak <- antibiogram
|
||||
antibiogram <- c(antibiogram[1:2], sort(antibiogram[3:length(antibiogram)]))
|
||||
|
||||
|
||||
# we can skip the duplicates - they are never unique antibiograms of course
|
||||
duplicates <- duplicated(antibiogram)
|
||||
out[3:length(out)][duplicates[3:length(out)] == TRUE] <- TRUE
|
||||
@@ -696,18 +702,25 @@ duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type
|
||||
# fast return, no further check required
|
||||
return(c(out[1:2], rep(TRUE, length(out) - 2)))
|
||||
}
|
||||
|
||||
|
||||
for (na in antibiogram[is.na(out)]) {
|
||||
# check if this antibiogram has any change with other antibiograms
|
||||
out[which(antibiogram == na)] <- all(
|
||||
vapply(FUN.VALUE = logical(1),
|
||||
antibiogram[!is.na(out) & antibiogram != na],
|
||||
function(y) antimicrobials_equal(y = y, z = na,
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type)))
|
||||
vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
antibiogram[!is.na(out) & antibiogram != na],
|
||||
function(y) {
|
||||
antimicrobials_equal(
|
||||
y = y, z = na,
|
||||
ignore_I = ignore_I, points_threshold = points_threshold,
|
||||
type = type
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
out <- out[original_sort]
|
||||
|
||||
out <- out[order(new_order)]
|
||||
# rerun duplicated again
|
||||
duplicates <- duplicated(antibiogram.bak)
|
||||
out[duplicates == TRUE] <- TRUE
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+5
-5
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -221,11 +221,11 @@ exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
|
||||
# running as.double() on a POSIXct object will return its number of seconds since 1970-01-01
|
||||
x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes
|
||||
|
||||
|
||||
# since x is now in seconds, get seconds from episode_days as well
|
||||
episode_seconds <- episode_days * 60 * 60 * 24
|
||||
case_free_seconds <- case_free_days * 60 * 60 * 24
|
||||
|
||||
|
||||
if (length(x) == 1) { # this will also match 1 NA, which is fine
|
||||
return(1)
|
||||
} else if (length(x) == 2 && all(!is.na(x))) {
|
||||
|
||||
+11
-9
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -85,16 +85,18 @@
|
||||
#' summary(pca_result)
|
||||
#'
|
||||
#' # old base R plotting method:
|
||||
#' biplot(pca_result)
|
||||
#' biplot(pca_result, main = "Base R biplot")
|
||||
#'
|
||||
#' # new ggplot2 plotting method using this package:
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot_pca(pca_result)
|
||||
#'
|
||||
#' ggplot_pca(pca_result) +
|
||||
#' labs(title = "ggplot2 biplot")
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' # still extendible with any ggplot2 function
|
||||
#' ggplot_pca(pca_result) +
|
||||
#' scale_colour_viridis_d() +
|
||||
#' labs(title = "Title here")
|
||||
#' labs(title = "ggplot2 biplot")
|
||||
#' }
|
||||
#' }
|
||||
#' }
|
||||
@@ -242,7 +244,7 @@ ggplot_pca <- function(x,
|
||||
g <- g + ggplot2::geom_path(
|
||||
data = ell,
|
||||
ggplot2::aes(colour = groups, group = groups),
|
||||
size = ellipse_size,
|
||||
linewidth = ellipse_size,
|
||||
alpha = points_alpha
|
||||
)
|
||||
}
|
||||
@@ -259,7 +261,7 @@ ggplot_pca <- function(x,
|
||||
type = "open"
|
||||
),
|
||||
colour = arrows_colour,
|
||||
size = arrows_size,
|
||||
linewidth = arrows_size,
|
||||
alpha = arrows_alpha
|
||||
)
|
||||
if (arrows_textangled == TRUE) {
|
||||
|
||||
+21
-207
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -40,7 +40,6 @@
|
||||
#' @inheritParams proportion
|
||||
#' @param nrow (when using `facet`) number of rows
|
||||
#' @param colours a named vactor with colour to be used for filling. The default colours are colour-blind friendly.
|
||||
#' @param aesthetics aesthetics to apply the colours to - the default is "fill" but can also be (a combination of) "alpha", "colour", "fill", "linetype", "shape" or "size"
|
||||
#' @param datalabels show datalabels using [labels_sir_count()]
|
||||
#' @param datalabels.size size of the datalabels
|
||||
#' @param datalabels.colour colour of the datalabels
|
||||
@@ -50,20 +49,17 @@
|
||||
#' @param x.title text to show as x axis description
|
||||
#' @param y.title text to show as y axis description
|
||||
#' @param ... other arguments passed on to [geom_sir()] or, in case of [scale_sir_colours()], named values to set colours. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red. See *Examples*.
|
||||
#' @details At default, the names of antibiotics will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
|
||||
#' @details At default, the names of antimicrobials will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
|
||||
#'
|
||||
#' ### The Functions
|
||||
#' [geom_sir()] will take any variable from the data that has an [`sir`] class (created with [as.sir()]) using [sir_df()] and will plot bars with the percentage S, I, and R. The default behaviour is to have the bars stacked and to have the different antibiotics on the x axis.
|
||||
#' [geom_sir()] will take any variable from the data that has an [`sir`] class (created with [as.sir()]) using [sir_df()] and will plot bars with the percentage S, I, and R. The default behaviour is to have the bars stacked and to have the different antimicrobials on the x axis.
|
||||
#'
|
||||
#' [facet_sir()] creates 2d plots (at default based on S/I/R) using [ggplot2::facet_wrap()].
|
||||
#' Additional functions include:
|
||||
#'
|
||||
#' [scale_y_percent()] transforms the y axis to a 0 to 100% range using [ggplot2::scale_y_continuous()].
|
||||
#'
|
||||
#' [scale_sir_colours()] sets colours to the bars (green for S, yellow for I, and red for R). with multilingual support. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red.
|
||||
#'
|
||||
#' [theme_sir()] is a [ggplot2 theme][[ggplot2::theme()] with minimal distraction.
|
||||
#'
|
||||
#' [labels_sir_count()] print datalabels on the bars with percentage and amount of isolates using [ggplot2::geom_text()].
|
||||
#' * [facet_sir()] creates 2d plots (at default based on S/I/R) using [ggplot2::facet_wrap()].
|
||||
#' * [scale_y_percent()] transforms the y axis to a 0 to 100% range using [ggplot2::scale_y_continuous()].
|
||||
#' * [scale_sir_colours()] sets colours to the bars (green for S, yellow for I, and red for R). with multilingual support. The default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red.
|
||||
#' * [theme_sir()] is a [ggplot2 theme][[ggplot2::theme()] with minimal distraction.
|
||||
#' * [labels_sir_count()] print datalabels on the bars with percentage and amount of isolates using [ggplot2::geom_text()].
|
||||
#'
|
||||
#' [ggplot_sir()] is a wrapper around all above functions that uses data as first input. This makes it possible to use this function after a pipe (`%>%`). See *Examples*.
|
||||
#' @rdname ggplot_sir
|
||||
@@ -81,7 +77,7 @@
|
||||
#' ggplot(df) +
|
||||
#' geom_sir() +
|
||||
#' scale_y_percent() +
|
||||
#' scale_sir_colours() +
|
||||
#' scale_sir_colours(aesthetics = "fill") +
|
||||
#' labels_sir_count() +
|
||||
#' theme_sir()
|
||||
#' }
|
||||
@@ -125,7 +121,10 @@
|
||||
#' ) %>%
|
||||
#' ggplot() +
|
||||
#' geom_col(aes(x = x, y = y, fill = z)) +
|
||||
#' scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
||||
#' scale_sir_colours(
|
||||
#' aesthetics = "fill",
|
||||
#' Value4 = "S", Value5 = "I", Value6 = "R"
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # resistance of ciprofloxacine per age group
|
||||
@@ -193,7 +192,8 @@ ggplot_sir <- function(data,
|
||||
y.title = "Proportion",
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(data, allow_class = "data.frame")
|
||||
data <- ascertain_sir_classes(data, "data")
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(fill, allow_class = "character", has_length = 1)
|
||||
@@ -215,7 +215,6 @@ ggplot_sir <- function(data,
|
||||
meet_criteria(x.title, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(y.title, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
# we work with aes_string later on
|
||||
x_deparse <- deparse(substitute(x))
|
||||
if (x_deparse != "x") {
|
||||
x <- x_deparse
|
||||
@@ -247,7 +246,7 @@ ggplot_sir <- function(data,
|
||||
theme_sir()
|
||||
|
||||
if (fill == "interpretation") {
|
||||
p <- p + scale_sir_colours(colours = colours)
|
||||
p <- suppressWarnings(p + scale_sir_colours(aesthetics = "fill", colours = colours))
|
||||
}
|
||||
|
||||
if (identical(position, "fill")) {
|
||||
@@ -313,7 +312,6 @@ geom_sir <- function(position = NULL,
|
||||
position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE)
|
||||
}
|
||||
|
||||
# we work with aes_string later on
|
||||
x_deparse <- deparse(substitute(x))
|
||||
if (x_deparse != "x") {
|
||||
x <- x_deparse
|
||||
@@ -322,7 +320,7 @@ geom_sir <- function(position = NULL,
|
||||
x <- substr(x, 2, nchar(x) - 1)
|
||||
}
|
||||
|
||||
if (tolower(x) %in% tolower(c("ab", "abx", "antibiotics"))) {
|
||||
if (tolower(x) %in% tolower(c("ab", "abx", "antimicrobials"))) {
|
||||
x <- "antibiotic"
|
||||
} else if (tolower(x) %in% tolower(c("SIR", "sir", "interpretations", "result"))) {
|
||||
x <- "interpretation"
|
||||
@@ -338,192 +336,8 @@ geom_sir <- function(position = NULL,
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
},
|
||||
mapping = ggplot2::aes_string(x = x, y = y, fill = fill),
|
||||
mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang(y), fill = str2lang(fill))),
|
||||
position = position,
|
||||
...
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
facet_sir <- function(facet = c("interpretation", "antibiotic"), nrow = NULL) {
|
||||
facet <- facet[1]
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(facet, allow_class = "character", has_length = 1)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
# we work with aes_string later on
|
||||
facet_deparse <- deparse(substitute(facet))
|
||||
if (facet_deparse != "facet") {
|
||||
facet <- facet_deparse
|
||||
}
|
||||
if (facet %like% '".*"') {
|
||||
facet <- substr(facet, 2, nchar(facet) - 1)
|
||||
}
|
||||
|
||||
if (tolower(facet) %in% tolower(c("SIR", "sir", "interpretations", "result"))) {
|
||||
facet <- "interpretation"
|
||||
} else if (tolower(facet) %in% tolower(c("ab", "abx", "antibiotics"))) {
|
||||
facet <- "antibiotic"
|
||||
}
|
||||
|
||||
ggplot2::facet_wrap(facets = facet, scales = "free_x", nrow = nrow)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(breaks, allow_class = c("numeric", "integer"))
|
||||
meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
|
||||
if (all(breaks[breaks != 0] > 1)) {
|
||||
breaks <- breaks / 100
|
||||
}
|
||||
ggplot2::scale_y_continuous(
|
||||
breaks = breaks,
|
||||
labels = percentage(breaks),
|
||||
limits = limits
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
scale_sir_colours <- function(...,
|
||||
aesthetics = "fill") {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(aesthetics, allow_class = "character", is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
|
||||
# behaviour until AMR pkg v1.5.0 and also when coming from ggplot_sir()
|
||||
if ("colours" %in% names(list(...))) {
|
||||
original_cols <- c(
|
||||
S = "#3CAEA3",
|
||||
SI = "#3CAEA3",
|
||||
I = "#F6D55C",
|
||||
IR = "#ED553B",
|
||||
R = "#ED553B"
|
||||
)
|
||||
colours <- replace(original_cols, names(list(...)$colours), list(...)$colours)
|
||||
# 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))
|
||||
}
|
||||
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
|
||||
])
|
||||
)
|
||||
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
|
||||
])
|
||||
)
|
||||
|
||||
susceptible <- rep("#3CAEA3", length(names_susceptible))
|
||||
names(susceptible) <- names_susceptible
|
||||
incr_exposure <- rep("#F6D55C", length(names_incr_exposure))
|
||||
names(incr_exposure) <- names_incr_exposure
|
||||
resistant <- rep("#ED553B", length(names_resistant))
|
||||
names(resistant) <- names_resistant
|
||||
|
||||
original_cols <- c(susceptible, incr_exposure, resistant)
|
||||
dots <- c(...)
|
||||
# replace S, I, R as colours: scale_sir_colours(mydatavalue = "S")
|
||||
dots[dots == "S"] <- "#3CAEA3"
|
||||
dots[dots == "I"] <- "#F6D55C"
|
||||
dots[dots == "R"] <- "#ED553B"
|
||||
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
|
||||
ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = cols, limits = force)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
theme_sir <- function() {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
ggplot2::theme_minimal(base_size = 10) +
|
||||
ggplot2::theme(
|
||||
panel.grid.major.x = ggplot2::element_blank(),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
panel.grid.major.y = ggplot2::element_line(colour = "grey75"),
|
||||
# center title and subtitle
|
||||
plot.title = ggplot2::element_text(hjust = 0.5),
|
||||
plot.subtitle = ggplot2::element_text(hjust = 0.5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
labels_sir_count <- function(position = NULL,
|
||||
x = "antibiotic",
|
||||
translate_ab = "name",
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE,
|
||||
datalabels.size = 3,
|
||||
datalabels.colour = "grey15") {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(combine_SI, 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)
|
||||
|
||||
if (is.null(position)) {
|
||||
position <- "fill"
|
||||
}
|
||||
if (identical(position, "fill")) {
|
||||
position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE)
|
||||
}
|
||||
x_name <- x
|
||||
ggplot2::geom_text(
|
||||
mapping = ggplot2::aes_string(
|
||||
label = "lbl",
|
||||
x = x,
|
||||
y = "value"
|
||||
),
|
||||
position = position,
|
||||
inherit.aes = FALSE,
|
||||
size = datalabels.size,
|
||||
colour = datalabels.colour,
|
||||
lineheight = 0.75,
|
||||
data = function(x) {
|
||||
transformed <- sir_df(
|
||||
data = x,
|
||||
translate_ab = translate_ab,
|
||||
combine_SI = combine_SI,
|
||||
minimum = minimum,
|
||||
language = language
|
||||
)
|
||||
transformed$gr <- transformed[, x_name, drop = TRUE]
|
||||
transformed %pm>%
|
||||
pm_group_by(gr) %pm>%
|
||||
pm_mutate(lbl = paste0("n=", isolates)) %pm>%
|
||||
pm_ungroup() %pm>%
|
||||
pm_select(-gr)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
+46
-40
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,12 +29,12 @@
|
||||
|
||||
#' Guess Antibiotic Column
|
||||
#'
|
||||
#' This tries to find a column name in a data set based on information from the [antibiotics] data set. Also supports WHONET abbreviations.
|
||||
#' This tries to find a column name in a data set based on information from the [antimicrobials] data set. Also supports WHONET abbreviations.
|
||||
#' @param x a [data.frame]
|
||||
#' @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`)
|
||||
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic.
|
||||
#' @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
|
||||
#' @examples
|
||||
@@ -105,7 +105,8 @@ get_column_abx <- function(x,
|
||||
only_sir_columns = FALSE,
|
||||
sort = TRUE,
|
||||
reuse_previous_result = TRUE,
|
||||
fn = NULL) {
|
||||
fn = NULL,
|
||||
return_all = FALSE) {
|
||||
# check if retrieved before, then get it from package environment
|
||||
if (isTRUE(reuse_previous_result) && identical(
|
||||
unique_call_id(
|
||||
@@ -253,45 +254,50 @@ get_column_abx <- function(x,
|
||||
if (sort == TRUE) {
|
||||
out <- out[order(names(out), out)]
|
||||
}
|
||||
# only keep the first hits, no duplicates
|
||||
duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
|
||||
if (length(duplicates) > 0) {
|
||||
all_okay <- FALSE
|
||||
}
|
||||
|
||||
if (isTRUE(info)) {
|
||||
if (all_okay == TRUE) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
} else {
|
||||
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
if (return_all == FALSE) {
|
||||
# only keep the first hits, no duplicates
|
||||
duplicates <- c(out[duplicated(names(out))], out[duplicated(unname(out))])
|
||||
if (length(duplicates) > 0) {
|
||||
all_okay <- FALSE
|
||||
}
|
||||
for (i in seq_len(length(out))) {
|
||||
if (isTRUE(verbose) && !names(out[i]) %in% names(duplicates)) {
|
||||
message_(
|
||||
"Using column '", font_bold(out[i]), "' as input for ", names(out)[i],
|
||||
" (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")."
|
||||
)
|
||||
|
||||
if (isTRUE(info)) {
|
||||
if (all_okay == TRUE) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
} else {
|
||||
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
}
|
||||
if (names(out[i]) %in% names(duplicates)) {
|
||||
already_set_as <- out[unname(out) == unname(out[i])][1L]
|
||||
warning_(
|
||||
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), ")"
|
||||
),
|
||||
add_fn = font_red,
|
||||
immediate = verbose
|
||||
)
|
||||
for (i in seq_len(length(out))) {
|
||||
if (isTRUE(verbose) && !names(out[i]) %in% names(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_(
|
||||
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), ")"
|
||||
),
|
||||
add_fn = font_red,
|
||||
immediate = verbose
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
out <- out[!duplicated(names(out))]
|
||||
out <- out[!duplicated(unname(out))]
|
||||
if (sort == TRUE) {
|
||||
out <- out[order(names(out), out)]
|
||||
out <- out[!duplicated(names(out))]
|
||||
out <- out[!duplicated(unname(out))]
|
||||
if (sort == TRUE) {
|
||||
out <- out[order(names(out), out)]
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(hard_dependencies)) {
|
||||
@@ -335,7 +341,7 @@ get_ab_from_namespace <- function(x, cols_ab) {
|
||||
x_new <- character()
|
||||
for (val in x) {
|
||||
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
|
||||
# antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `AB_CARBAPENEMS`
|
||||
# antibiotic group names, as defined in data-raw/_pre_commit_checks.R, such as `AB_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`
|
||||
|
||||
+11
-8
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -31,11 +31,11 @@
|
||||
#'
|
||||
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italics. This function finds taxonomic names within strings and makes them italic.
|
||||
#' @param string a [character] (vector)
|
||||
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
|
||||
#' @param type type of conversion of the taxonomic names, either "markdown", "html" or "ansi", see *Details*
|
||||
#' @details
|
||||
#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set.
|
||||
#'
|
||||
#' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or using ANSI colours by adding `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
|
||||
#' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or `<i>` and `</i>` when using html. When using 'ansi', ANSI colours will be added using `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
|
||||
#'
|
||||
#' This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
|
||||
#' @export
|
||||
@@ -44,18 +44,21 @@
|
||||
#' italicise_taxonomy("An overview of S. aureus isolates")
|
||||
#'
|
||||
#' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
|
||||
italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
italicise_taxonomy <- function(string, type = c("markdown", "ansi", "html")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
meet_criteria(string, allow_class = "character")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi"))
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi", "html"))
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
if (type == "markdown") {
|
||||
before <- "*"
|
||||
after <- "*"
|
||||
} else if (type == "html") {
|
||||
before <- "<i>"
|
||||
after <- "</i>"
|
||||
} else if (type == "ansi") {
|
||||
if (!has_colour() && !identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
return(string)
|
||||
@@ -134,7 +137,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
|
||||
#' @rdname italicise_taxonomy
|
||||
#' @export
|
||||
italicize_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
italicize_taxonomy <- function(string, type = c("markdown", "ansi", "html")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+12
-15
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -30,7 +30,7 @@
|
||||
#' (Key) Antimicrobials for First Weighted Isolates
|
||||
#'
|
||||
#' These functions can be used to determine first weighted isolates by considering the phenotype for isolate selection (see [first_isolate()]). Using a phenotype-based method to determine first isolates is more reliable than methods that disregard phenotypes.
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
|
||||
#' @param x a [data.frame] with antimicrobials columns, like `AMX` or `amox`. Can be left blank to determine automatically.
|
||||
#' @param y,z [character] vectors to compare
|
||||
#' @inheritParams first_isolate
|
||||
#' @param universal names of **broad-spectrum** antimicrobial drugs, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antimicrobial drugs
|
||||
@@ -73,7 +73,6 @@
|
||||
#' - Tetracycline
|
||||
#' - Vancomycin
|
||||
#'
|
||||
#'
|
||||
#' The default antimicrobial drugs used for **fungi** (set in `antifungal`) are:
|
||||
#'
|
||||
#' - Anidulafungin
|
||||
@@ -102,7 +101,7 @@
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # set key antibiotics to a new variable
|
||||
#' # set key antimicrobials to a new variable
|
||||
#' my_patients <- example_isolates %>%
|
||||
#' mutate(keyab = key_antimicrobials(antifungal = NULL)) %>% # no need to define `x`
|
||||
#' mutate(
|
||||
@@ -149,10 +148,6 @@ key_antimicrobials <- function(x = NULL,
|
||||
meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
|
||||
# force regular data.frame, not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
@@ -192,11 +187,11 @@ key_antimicrobials <- function(x = NULL,
|
||||
"No columns available ",
|
||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
||||
),
|
||||
"as key antimicrobials for ", name, "s. See ?key_antimicrobials."
|
||||
"as key antimicrobials for ", name, "s. See `?key_antimicrobials`."
|
||||
)
|
||||
}
|
||||
|
||||
generate_antimcrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
||||
generate_antimicrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
||||
}
|
||||
|
||||
if (is.null(universal)) {
|
||||
@@ -268,10 +263,10 @@ all_antimicrobials <- function(x = NULL,
|
||||
sort = FALSE, fn = "all_antimicrobials"
|
||||
)
|
||||
|
||||
generate_antimcrobials_string(x[, cols, drop = FALSE])
|
||||
generate_antimicrobials_string(x[, cols, drop = FALSE])
|
||||
}
|
||||
|
||||
generate_antimcrobials_string <- function(df) {
|
||||
generate_antimicrobials_string <- function(df) {
|
||||
if (NCOL(df) == 0) {
|
||||
return(rep("", NROW(df)))
|
||||
}
|
||||
@@ -286,6 +281,8 @@ generate_antimcrobials_string <- function(df) {
|
||||
as.list(df),
|
||||
function(x) {
|
||||
x <- toupper(as.character(x))
|
||||
x[x == "SDD"] <- "I"
|
||||
# ignore "NI" here, no use for determining first isolates
|
||||
x[!x %in% c("S", "I", "R")] <- "."
|
||||
paste(x)
|
||||
}
|
||||
@@ -316,7 +313,7 @@ antimicrobials_equal <- function(y,
|
||||
val <- strsplit(val, "", fixed = TRUE)[[1L]]
|
||||
val.int <- rep(NA_real_, length(val))
|
||||
val.int[val == "S"] <- 1
|
||||
val.int[val == "I"] <- 2
|
||||
val.int[val %in% c("I", "SDD")] <- 2
|
||||
val.int[val == "R"] <- 3
|
||||
val.int
|
||||
}
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -51,7 +51,7 @@
|
||||
#' @examples
|
||||
#' # data.table has a more limited version of %like%, so unload it:
|
||||
#' try(detach("package:data.table", unload = TRUE), silent = TRUE)
|
||||
#'
|
||||
#'
|
||||
#' a <- "This is a test"
|
||||
#' b <- "TEST"
|
||||
#' a %like% b
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,16 +29,22 @@
|
||||
|
||||
#' Determine Multidrug-Resistant Organisms (MDRO)
|
||||
#'
|
||||
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international, national and custom guidelines.
|
||||
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank for automatic determination.
|
||||
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international, national, or custom guidelines.
|
||||
#' @param x a [data.frame] with antimicrobials columns, like `AMX` or `amox`. Can be left blank for automatic determination.
|
||||
#' @param guideline a specific guideline to follow, see sections *Supported international / national guidelines* and *Using Custom Guidelines* below. When left empty, the publication by Magiorakos *et al.* (see below) will be followed.
|
||||
#' @param ... in case of [custom_mdro_guideline()]: a set of rules, see section *Using Custom Guidelines* below. Otherwise: column name of an antibiotic, see section *Antibiotics* below.
|
||||
#' @param esbl [logical] values, or a column name containing logical values, indicating the presence of an ESBL gene (or production of its proteins)
|
||||
#' @param carbapenemase [logical] values, or a column name containing logical values, indicating the presence of a carbapenemase gene (or production of its proteins)
|
||||
#' @param mecA [logical] values, or a column name containing logical values, indicating the presence of a *mecA* gene (or production of its proteins)
|
||||
#' @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 Antibiotics
|
||||
#' @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*.
|
||||
#'
|
||||
@@ -76,9 +82,15 @@
|
||||
#'
|
||||
#' * `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))
|
||||
#' The Dutch national guideline - Samenwerkingverband Richtlijnen Infectiepreventie (SRI) (2024) "Bijzonder Resistente Micro-Organismen (BRMO)" ([link](https://www.sri-richtlijnen.nl/brmo))
|
||||
#'
|
||||
#' Please suggest your own (country-specific) guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
|
||||
#' Also:
|
||||
#'
|
||||
#' * `guideline = "BRMO 2017"`
|
||||
#'
|
||||
#' 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>.
|
||||
#'
|
||||
#' @section Using Custom Guidelines:
|
||||
#'
|
||||
@@ -171,6 +183,12 @@
|
||||
mdro <- function(x = NULL,
|
||||
guideline = "CMI2012",
|
||||
col_mo = NULL,
|
||||
esbl = NA,
|
||||
carbapenemase = NA,
|
||||
mecA = NA,
|
||||
mecC = NA,
|
||||
vanA = NA,
|
||||
vanB = NA,
|
||||
info = interactive(),
|
||||
pct_required_classes = 0.5,
|
||||
combine_SI = TRUE,
|
||||
@@ -184,24 +202,68 @@ mdro <- function(x = NULL,
|
||||
}
|
||||
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)
|
||||
}
|
||||
if (!is.list(guideline)) meet_criteria(guideline, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(esbl, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(carbapenemase, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(mecA, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(mecC, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(vanA, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(vanB, allow_class = c("logical", "character"), allow_NA = TRUE)
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
if ("only_rsi_columns" %in% names(list(...))) {
|
||||
deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
|
||||
only_sir_columns <- list(...)$only_rsi_columns
|
||||
}
|
||||
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.")
|
||||
}
|
||||
|
||||
# get gene values as TRUE/FALSE
|
||||
if (is.character(esbl)) {
|
||||
meet_criteria(esbl, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
esbl <- x[[esbl]]
|
||||
meet_criteria(esbl, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(esbl) == 1) {
|
||||
esbl <- rep(esbl, NROW(x))
|
||||
}
|
||||
if (is.character(carbapenemase)) {
|
||||
meet_criteria(carbapenemase, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
carbapenemase <- x[[carbapenemase]]
|
||||
meet_criteria(carbapenemase, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(carbapenemase) == 1) {
|
||||
carbapenemase <- rep(carbapenemase, NROW(x))
|
||||
}
|
||||
if (is.character(mecA)) {
|
||||
meet_criteria(mecA, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
mecA <- x[[mecA]]
|
||||
meet_criteria(mecA, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(mecA) == 1) {
|
||||
mecA <- rep(mecA, NROW(x))
|
||||
}
|
||||
if (is.character(mecC)) {
|
||||
meet_criteria(mecC, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
mecC <- x[[mecC]]
|
||||
meet_criteria(mecC, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(mecC) == 1) {
|
||||
mecC <- rep(mecC, NROW(x))
|
||||
}
|
||||
if (is.character(vanA)) {
|
||||
meet_criteria(vanA, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
vanA <- x[[vanA]]
|
||||
meet_criteria(vanA, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(vanA) == 1) {
|
||||
vanA <- rep(vanA, NROW(x))
|
||||
}
|
||||
if (is.character(vanB)) {
|
||||
meet_criteria(vanB, is_in = colnames(x), allow_NA = FALSE, has_length = 1)
|
||||
vanB <- x[[vanB]]
|
||||
meet_criteria(vanB, allow_class = "logical", allow_NA = TRUE)
|
||||
} else if (length(vanB) == 1) {
|
||||
vanB <- rep(vanB, NROW(x))
|
||||
}
|
||||
|
||||
info.bak <- info
|
||||
# don't throw info's more than once per call
|
||||
if (isTRUE(info)) {
|
||||
@@ -337,7 +399,7 @@ mdro <- function(x = NULL,
|
||||
if (guideline$code == "cmi2012") {
|
||||
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
|
||||
guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL"
|
||||
guideline$version <- NA
|
||||
guideline$version <- NA_character_
|
||||
guideline$source_url <- paste0("Clinical Microbiology and Infection 18:3, 2012; ", font_url("https://doi.org/10.1111/j.1469-0691.2011.03570.x", "doi: 10.1111/j.1469-0691.2011.03570.x"))
|
||||
guideline$type <- "MDRs/XDRs/PDRs"
|
||||
} else if (guideline$code == "eucast3.1") {
|
||||
@@ -369,14 +431,21 @@ mdro <- function(x = NULL,
|
||||
} else if (guideline$code == "mrgn") {
|
||||
guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
|
||||
guideline$author <- "M\u00fcller J, Voss A, K\u00f6ck R, ..., Kern WV, Wendt C, Friedrich AW"
|
||||
guideline$version <- NA
|
||||
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") {
|
||||
combine_SI <- TRUE # I must not be considered resistant
|
||||
guideline$name <- "Bijzonder Resistente Micro-organismen (BRMO)"
|
||||
guideline$author <- "Samenwerkingsverband Richtlijnen Infectiepreventie (SRI)"
|
||||
guideline$version <- "November 2024"
|
||||
guideline$source_url <- font_url("https://www.sri-richtlijnen.nl/brmo", "Direct link")
|
||||
guideline$type <- "BRMOs"
|
||||
} else if (guideline$code == "brmo2017") {
|
||||
guideline$name <- "WIP-Richtlijn Bijzonder Resistente Micro-organismen (BRMO)"
|
||||
guideline$author <- "RIVM (Rijksinstituut voor de Volksgezondheid)"
|
||||
guideline$version <- "Revision as of December 2017"
|
||||
guideline$source_url <- font_url("https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH", "Direct download")
|
||||
guideline$version <- "Last revision (December 2017) - since 2024 superseded by SRI guideline"
|
||||
guideline$source_url <- NA_character_
|
||||
guideline$type <- "BRMOs"
|
||||
} else {
|
||||
stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
|
||||
@@ -433,6 +502,17 @@ mdro <- function(x = NULL,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "brmo") {
|
||||
# Dutch 2024 guideline
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
soft_dependencies = c("SXT", "GEN", "TOB", "AMK", "IPM", "MEM", "CIP", "LVX", "NOR", "PIP", "CAZ", "VAN", "PEN", "AMX", "AMP", "FLC", "OXA", "FOX", "FOX1"),
|
||||
verbose = verbose,
|
||||
info = info,
|
||||
only_sir_columns = only_sir_columns,
|
||||
fn = "mdro",
|
||||
...
|
||||
)
|
||||
} else if (guideline$code == "mrgn") {
|
||||
cols_ab <- get_column_abx(
|
||||
x = x,
|
||||
@@ -456,7 +536,7 @@ mdro <- function(x = NULL,
|
||||
if (!"AMP" %in% names(cols_ab) && "AMX" %in% names(cols_ab)) {
|
||||
# ampicillin column is missing, but amoxicillin is available
|
||||
if (isTRUE(info)) {
|
||||
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
|
||||
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many MDRO rules depend on it.")
|
||||
}
|
||||
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
||||
}
|
||||
@@ -528,6 +608,7 @@ mdro <- function(x = NULL,
|
||||
FLE <- cols_ab["FLE"]
|
||||
FOS <- cols_ab["FOS"]
|
||||
FOX <- cols_ab["FOX"]
|
||||
FOX1 <- cols_ab["FOX1"]
|
||||
FUS <- cols_ab["FUS"]
|
||||
GAT <- cols_ab["GAT"]
|
||||
GEH <- cols_ab["GEH"]
|
||||
@@ -642,6 +723,17 @@ mdro <- function(x = NULL,
|
||||
out[is.na(out)] <- FALSE
|
||||
out
|
||||
}
|
||||
col_values <- function(df, col, return_if_lacking = "") {
|
||||
if (col %in% colnames(df)) {
|
||||
df[[col]]
|
||||
} else {
|
||||
rep(return_if_lacking, NROW(df))
|
||||
}
|
||||
}
|
||||
NA_as_FALSE <- function(x) {
|
||||
x[is.na(x)] <- FALSE
|
||||
x
|
||||
}
|
||||
|
||||
# antibiotic classes
|
||||
# nolint start
|
||||
@@ -655,7 +747,11 @@ mdro <- function(x = NULL,
|
||||
# nolint end
|
||||
|
||||
# helper function for editing the table
|
||||
trans_tbl <- function(to, rows, cols, any_all) {
|
||||
trans_tbl <- function(to, rows, cols, any_all, reason = NULL) {
|
||||
cols.bak <- cols
|
||||
if (identical(cols, "any")) {
|
||||
cols <- unique(cols_ab)
|
||||
}
|
||||
cols <- cols[!ab_missing(cols)]
|
||||
cols <- cols[!is.na(cols)]
|
||||
if (length(rows) > 0 && length(cols) > 0) {
|
||||
@@ -669,7 +765,7 @@ mdro <- function(x = NULL,
|
||||
x[rows, "columns_nonsusceptible"] <<- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
rows,
|
||||
function(row, group_vct = cols) {
|
||||
function(row, group_vct = cols_ab) {
|
||||
cols_nonsus <- vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
x[row, group_vct, drop = FALSE],
|
||||
@@ -696,18 +792,24 @@ mdro <- function(x = NULL,
|
||||
rows_affected <- vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
x_transposed,
|
||||
function(y) search_function(y %in% search_result, na.rm = TRUE)
|
||||
function(y) search_function(y %in% search_result, na.rm = TRUE) | identical(cols.bak, "any")
|
||||
)
|
||||
rows_affected <- x[which(rows_affected), "row_number", drop = TRUE]
|
||||
rows_to_change <- rows[rows %in% rows_affected]
|
||||
rows_not_to_change <- rows[!rows %in% c(rows_affected, rows_to_change)]
|
||||
rows_not_to_change <- rows_not_to_change[is.na(x[rows_not_to_change, "reason"])]
|
||||
if (is.null(reason)) {
|
||||
reason <- paste0(
|
||||
any_all,
|
||||
" of the required antimicrobials ",
|
||||
ifelse(any_all == "any", "is", "are"),
|
||||
" R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", "")
|
||||
)
|
||||
}
|
||||
x[rows_to_change, "MDRO"] <<- to
|
||||
x[rows_to_change, "reason"] <<- paste0(
|
||||
any_all,
|
||||
" of the required antibiotics ",
|
||||
ifelse(any_all == "any", "is", "are"),
|
||||
" R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", "")
|
||||
)
|
||||
x[rows_to_change, "reason"] <<- reason
|
||||
x[rows_not_to_change, "reason"] <<- "guideline criteria not met"
|
||||
}
|
||||
}
|
||||
|
||||
@@ -736,7 +838,7 @@ mdro <- function(x = NULL,
|
||||
sum(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
group_tbl,
|
||||
function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "I", "R"))
|
||||
function(group) any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% c("S", "SDD", "I", "R"))
|
||||
))
|
||||
}
|
||||
)
|
||||
@@ -788,7 +890,7 @@ mdro <- function(x = NULL,
|
||||
x <- left_join_microorganisms(x, by = col_mo)
|
||||
x$MDRO <- ifelse(!is.na(x$genus), 1, NA_integer_)
|
||||
x$row_number <- seq_len(nrow(x))
|
||||
x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline")
|
||||
x$reason <- NA_character_
|
||||
x$columns_nonsusceptible <- ""
|
||||
|
||||
if (guideline$code == "cmi2012") {
|
||||
@@ -1024,7 +1126,7 @@ mdro <- function(x = NULL,
|
||||
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
|
||||
if (isTRUE(verbose)) {
|
||||
x[which(x$MDRO == 4), "reason"] <- paste(
|
||||
"all antibiotics in all",
|
||||
"all antimicrobials in all",
|
||||
x$classes_in_guideline[which(x$MDRO == 4)],
|
||||
"classes were tested R",
|
||||
ifelse(!isTRUE(combine_SI), " or I", "")
|
||||
@@ -1406,7 +1508,174 @@ mdro <- function(x = NULL,
|
||||
}
|
||||
|
||||
if (guideline$code == "brmo") {
|
||||
# Netherlands -------------------------------------------------------------
|
||||
# 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
|
||||
fluoroquinolones <- c(CIP, NOR, LVX) # note 5: ciprofloxacin or norfloxacin or levofloxacin
|
||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||
carbapenems_without_imipenem <- carbapenems[carbapenems != IPM]
|
||||
amino <- AMX %or% AMP
|
||||
third <- CAZ %or% CTX
|
||||
ESBLs <- c(amino, third)
|
||||
ESBLs <- ESBLs[!is.na(ESBLs)]
|
||||
if (length(ESBLs) != 2) {
|
||||
ESBLs <- character(0)
|
||||
}
|
||||
|
||||
# Enterobacterales
|
||||
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)),
|
||||
cols = c(AMX %or% AMP, cephalosporins_3rd),
|
||||
any_all = "all",
|
||||
reason = "Enterobacterales: potential ESBL"
|
||||
)
|
||||
}
|
||||
trans_tbl(
|
||||
3, # positive
|
||||
rows = which(x$order == "Enterobacterales" & esbl == TRUE),
|
||||
cols = "any",
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales: ESBL"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$order == "Enterobacterales" & (x$genus %in% c("Proteus", "Providencia") | paste(x$genus, x$species) %in% c("Serratia marcescens", "Morganella morganii"))),
|
||||
cols = carbapenems_without_imipenem,
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales: carbapenem resistance"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$order == "Enterobacterales" & !(x$genus %in% c("Proteus", "Providencia") | paste(x$genus, x$species) %in% c("Serratia marcescens", "Morganella morganii"))),
|
||||
cols = carbapenems,
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales: carbapenem resistance"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$order == "Enterobacterales" & carbapenemase == TRUE),
|
||||
cols = "any",
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales: carbapenemase"
|
||||
)
|
||||
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") &
|
||||
(x$genus %in% c("Enterobacter", "Providencia") | paste(x$genus, x$species) %in% c("Citrobacter freundii", "Klebsiella aerogenes", "Hafnia alvei", "Morganella morganii"))),
|
||||
cols = c(SXT, aminoglycosides, fluoroquinolones),
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales group II: aminoglycoside + fluoroquinolone + cotrimoxazol"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x[[SXT]] == "R" &
|
||||
x[[GEN]] == "R" &
|
||||
(x[[CIP]] == "R" | x[[NOR]] == "R" | x[[LVX]] == "R") &
|
||||
paste(x$genus, x$species) == "Serratia marcescens"),
|
||||
cols = c(SXT, aminoglycosides_serratia_marcescens, fluoroquinolones),
|
||||
any_all = "any",
|
||||
reason = "Enterobacterales group II: aminoglycoside + fluoroquinolone + cotrimoxazol"
|
||||
)
|
||||
|
||||
# Acinetobacter baumannii-calcoaceticus complex
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which((x[[GEN]] == "R" | x[[TOB]] == "R" | x[[AMK]] == "R") &
|
||||
(x[[CIP]] == "R" | 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",
|
||||
reason = "A. baumannii-calcoaceticus complex: aminoglycoside + ciprofloxacin or levofloxacin"
|
||||
)
|
||||
trans_tbl(
|
||||
2, # unconfirmed
|
||||
rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & is.na(carbapenemase)),
|
||||
cols = carbapenems,
|
||||
any_all = "any",
|
||||
reason = "A. baumannii-calcoaceticus complex: potential carbapenemase"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x[[col_mo]] %in% AMR::microorganisms.groups$mo[AMR::microorganisms.groups$mo_group_name == "Acinetobacter baumannii complex"] & carbapenemase == TRUE),
|
||||
cols = carbapenems,
|
||||
any_all = "any",
|
||||
reason = "A. baumannii-calcoaceticus complex: carbapenemase"
|
||||
)
|
||||
|
||||
# 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)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$genus == "Pseudomonas" & x$species == "aeruginosa"),
|
||||
cols = c(CAZ, CIP, GEN, IPM, MEM, TOB, PIP),
|
||||
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"
|
||||
)
|
||||
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
|
||||
reason = "P. aeruginosa: at least 3 classes contain R"
|
||||
)
|
||||
|
||||
# Enterococcus faecium
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$genus == "Enterococcus" & x$species == "faecium"),
|
||||
cols = c(PEN %or% AMX %or% AMP, VAN),
|
||||
any_all = "all",
|
||||
reason = "E. faecium: vancomycin + penicillin group"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$genus == "Enterococcus" & x$species == "faecium" & (vanA == TRUE | vanB == TRUE)),
|
||||
cols = c(PEN, AMX, AMP, VAN),
|
||||
any_all = "any",
|
||||
reason = "E. faecium: vanA/vanB gene + penicillin group"
|
||||
)
|
||||
|
||||
# Staphylococcus aureus
|
||||
trans_tbl(
|
||||
2,
|
||||
rows = which(x$genus == "Staphylococcus" & x$species == "aureus" & (is.na(mecA) | is.na(mecC))),
|
||||
cols = c(AMC, TZP, FLC, OXA, FOX, FOX1),
|
||||
any_all = "any",
|
||||
reason = "S. aureus: potential MRSA"
|
||||
)
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$genus == "Staphylococcus" & x$species == "aureus" & (mecA == TRUE | mecC == TRUE)),
|
||||
cols = "any",
|
||||
any_all = "any",
|
||||
reason = "S. aureus: mecA/mecC gene"
|
||||
)
|
||||
|
||||
# Candida auris
|
||||
trans_tbl(
|
||||
3,
|
||||
rows = which(x$genus == "Candida" & x$species == "auris"),
|
||||
cols = "any",
|
||||
any_all = "any",
|
||||
reason = "C. auris: regardless of resistance"
|
||||
)
|
||||
}
|
||||
|
||||
if (guideline$code == "brmo2017") {
|
||||
# Netherlands 2017 --------------------------------------------------------
|
||||
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
||||
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
|
||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||
@@ -1481,10 +1750,7 @@ mdro <- function(x = NULL,
|
||||
c(CAZ, CIP, GEN, IPM, MEM, TOB, TZP),
|
||||
"any"
|
||||
)
|
||||
x[which(
|
||||
x$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
||||
x$psae >= 3
|
||||
), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
x[which(x$genus == "Pseudomonas" & x$species == "aeruginosa" & x$psae >= 3), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||
|
||||
# Table 3
|
||||
trans_tbl(
|
||||
@@ -1584,7 +1850,7 @@ mdro <- function(x = NULL,
|
||||
" (3 required for MDR)"
|
||||
)
|
||||
} else {
|
||||
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
|
||||
# x[which(x$MDRO == 1), "reason"] <- "too few antimicrobials are R"
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1614,12 +1880,14 @@ mdro <- function(x = NULL,
|
||||
if (isTRUE(info.bak)) {
|
||||
cat(font_italic(paste0(" (", length(rows_empty), " isolates had no test results)\n")))
|
||||
}
|
||||
x[rows_empty, "MDRO"] <- NA
|
||||
x[rows_empty, "reason"] <- "none of the antibiotics have test results"
|
||||
} else if (isTRUE(info.bak)) {
|
||||
cat("\n")
|
||||
}
|
||||
|
||||
if (isTRUE(info.bak) && !isTRUE(verbose)) {
|
||||
cat("\nRerun with 'verbose = TRUE' to retrieve detailed info and reasons for every MDRO classification.\n")
|
||||
}
|
||||
|
||||
# Results ----
|
||||
if (guideline$code == "cmi2012") {
|
||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||
@@ -1667,7 +1935,12 @@ mdro <- function(x = NULL,
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
if (isTRUE(verbose)) {
|
||||
# fill in empty reasons
|
||||
x$reason[is.na(x$reason)] <- "not covered by guideline"
|
||||
x[rows_empty, "reason"] <- paste(x[rows_empty, "reason"], "(note: no available test results)")
|
||||
# format data set
|
||||
colnames(x)[colnames(x) == col_mo] <- "microorganism"
|
||||
x$microorganism <- mo_name(x$microorganism, language = NULL)
|
||||
x[, c(
|
||||
@@ -1871,50 +2144,51 @@ brmo <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, guideline = "BRMO", ...)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mrgn <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
mrgn <- function(x = NULL, only_sir_columns = FALSE, 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, guideline = "MRGN", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "MRGN", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_tb <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
mdr_tb <- function(x = NULL, only_sir_columns = FALSE, 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, guideline = "TB", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "TB", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
mdr_cmi2012 <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
mdr_cmi2012 <- function(x = NULL, only_sir_columns = FALSE, 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, guideline = "CMI2012", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "CMI2012", ...)
|
||||
}
|
||||
|
||||
#' @rdname mdro
|
||||
#' @export
|
||||
eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = FALSE, ...) {
|
||||
eucast_exceptional_phenotypes <- function(x = NULL, only_sir_columns = FALSE, 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, guideline = "EUCAST", ...)
|
||||
mdro(x = x, only_sir_columns = only_sir_columns, verbose = verbose, guideline = "EUCAST", ...)
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -31,8 +31,8 @@
|
||||
#'
|
||||
#' 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 [antibiotic selectors][ab_selector()]
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the input only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`
|
||||
#' @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 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.
|
||||
#'
|
||||
#' MIC values (see [as.mic()]) are transformed with [log2()] first; their distance is thus calculated as `(log2(x) - mean(log2(x))) / sd(log2(x))`.
|
||||
@@ -118,7 +118,7 @@ mean_amr_distance.disk <- function(x, ...) {
|
||||
mean_amr_distance.sir <- function(x, ..., combine_SI = TRUE) {
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = -1)
|
||||
if (isTRUE(combine_SI)) {
|
||||
x[x == "I"] <- "S"
|
||||
x[x %in% c("I", "SDD")] <- "S"
|
||||
}
|
||||
mean_amr_distance(as.double(x))
|
||||
}
|
||||
@@ -175,8 +175,8 @@ mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) {
|
||||
#' @param row an index, such as a row number
|
||||
#' @export
|
||||
amr_distance_from_row <- function(amr_distance, row) {
|
||||
meet_criteria(amr_distance, allow_class = c("double", "numeric"), is_finite = TRUE)
|
||||
meet_criteria(row, allow_class = c("logical", "double", "numeric"))
|
||||
meet_criteria(amr_distance, allow_class = "numeric", is_finite = TRUE)
|
||||
meet_criteria(row, allow_class = c("logical", "numeric", "integer"))
|
||||
if (is.logical(row)) {
|
||||
row <- which(row)
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -27,47 +27,33 @@
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# these are allowed MIC values and will become [factor] levels
|
||||
# these are allowed MIC values and will become factor levels
|
||||
VALID_MIC_LEVELS <- c(
|
||||
as.double(paste0("0.000", c(1:9))),
|
||||
as.double(paste0("0.00", c(1:99, 1953125, 390625, 78125))),
|
||||
as.double(paste0("0.0", c(1:99, 125, 128, 156, 165, 256, 512, 625, 3125, 15625))),
|
||||
as.double(paste0("0.", c(1:99, 125, 128, 256, 512))),
|
||||
1:9, 1.5,
|
||||
c(10:98)[9:98 %% 2 == TRUE],
|
||||
2^c(7:12), 192 * c(1:5), 80 * c(2:12)
|
||||
)
|
||||
VALID_MIC_LEVELS <- trimws(gsub("[.]?0+$", "", format(unique(sort(VALID_MIC_LEVELS)), scientific = FALSE), perl = TRUE))
|
||||
operators <- c("<", "<=", "", ">=", ">")
|
||||
valid_mic_levels <- c(
|
||||
c(t(vapply(
|
||||
FUN.VALUE = character(6), operators,
|
||||
function(x) paste0(x, "0.000", c(1:4, 6, 8))
|
||||
))),
|
||||
c(t(vapply(
|
||||
FUN.VALUE = character(90), operators,
|
||||
function(x) paste0(x, "0.00", c(1:9, 11:19, 21:29, 31:39, 41:49, 51:59, 61:69, 71:79, 81:89, 91:99))
|
||||
))),
|
||||
unique(c(t(vapply(
|
||||
FUN.VALUE = character(106), operators,
|
||||
function(x) {
|
||||
paste0(x, sort(as.double(paste0(
|
||||
"0.0",
|
||||
sort(c(1:99, 125, 128, 156, 165, 256, 512, 625))
|
||||
))))
|
||||
}
|
||||
)))),
|
||||
unique(c(t(vapply(
|
||||
FUN.VALUE = character(103), operators,
|
||||
function(x) {
|
||||
paste0(x, sort(as.double(paste0(
|
||||
"0.",
|
||||
c(1:99, 125, 128, 256, 512)
|
||||
))))
|
||||
}
|
||||
)))),
|
||||
c(t(vapply(
|
||||
FUN.VALUE = character(10), operators,
|
||||
function(x) paste0(x, sort(c(1:9, 1.5)))
|
||||
))),
|
||||
c(t(vapply(
|
||||
FUN.VALUE = character(45), operators,
|
||||
function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])
|
||||
))),
|
||||
c(t(vapply(
|
||||
FUN.VALUE = character(17), operators,
|
||||
function(x) paste0(x, sort(c(2^c(7:11), 192, 80 * c(2:12))))
|
||||
)))
|
||||
VALID_MIC_LEVELS <- c(t(vapply(
|
||||
FUN.VALUE = character(length(VALID_MIC_LEVELS)),
|
||||
c("<", "<=", "", ">=", ">"),
|
||||
paste0,
|
||||
VALID_MIC_LEVELS
|
||||
)))
|
||||
COMMON_MIC_VALUES <- c(
|
||||
0.0001, 0.0002, 0.0005,
|
||||
0.001, 0.002, 0.004, 0.008,
|
||||
0.016, 0.032, 0.064,
|
||||
0.125, 0.25, 0.5,
|
||||
1, 2, 4, 8,
|
||||
16, 32, 64,
|
||||
128, 256, 512,
|
||||
1024, 2048, 4096
|
||||
)
|
||||
|
||||
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
|
||||
@@ -76,6 +62,7 @@ valid_mic_levels <- c(
|
||||
#' @rdname as.mic
|
||||
#' @param x a [character] or [numeric] vector
|
||||
#' @param na.rm a [logical] indicating whether missing values should be removed
|
||||
#' @param keep_operators a [character] specifying how to handle operators (such as `>` and `<=`) in the input. Accepts one of three values: `"all"` (or `TRUE`) to keep all operators, `"none"` (or `FALSE`) to remove all operators, or `"edges"` to keep operators only at both ends of the range.
|
||||
#' @param ... arguments passed on to methods
|
||||
#' @details To interpret MIC values as SIR values, use [as.sir()] on MIC values. It supports guidelines from EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
|
||||
#'
|
||||
@@ -115,12 +102,16 @@ valid_mic_levels <- c(
|
||||
#' #> 10 16 A
|
||||
#' ```
|
||||
#'
|
||||
#' The following [generic functions][groupGeneric()] are implemented for the MIC class: `!`, `!=`, `%%`, `%/%`, `&`, `*`, `+`, `-`, `/`, `<`, `<=`, `==`, `>`, `>=`, `^`, `|`, [abs()], [acos()], [acosh()], [all()], [any()], [asin()], [asinh()], [atan()], [atanh()], [ceiling()], [cos()], [cosh()], [cospi()], [cummax()], [cummin()], [cumprod()], [cumsum()], [digamma()], [exp()], [expm1()], [floor()], [gamma()], [lgamma()], [log()], [log1p()], [log2()], [log10()], [max()], [mean()], [min()], [prod()], [range()], [round()], [sign()], [signif()], [sin()], [sinh()], [sinpi()], [sqrt()], [sum()], [tan()], [tanh()], [tanpi()], [trigamma()] and [trunc()]. Some functions of the `stats` package are also implemented: [median()], [quantile()], [mad()], [IQR()], [fivenum()]. Also, [boxplot.stats()] is supported. Since [sd()] and [var()] are non-generic functions, these could not be extended. Use [mad()] as an alternative, or use e.g. `sd(as.numeric(x))` where `x` is your vector of MIC values.
|
||||
#' All so-called [group generic functions][groupGeneric()] are implemented for the MIC class (such as `!`, `!=`, `<`, `>=`, [exp()], [log2()]). Some functions of the `stats` package are also implemented (such as [quantile()], [median()], [fivenum()]). Since [sd()] and [var()] are non-generic functions, these could not be extended. Use [mad()] as an alternative, or use e.g. `sd(as.numeric(x))` where `x` is your vector of MIC values.
|
||||
#'
|
||||
#' Using [as.double()] or [as.numeric()] on MIC values will remove the operators and return a numeric vector. Do **not** use [as.integer()] on MIC values as by the \R convention on [factor]s, it will return the index of the factor levels (which is often useless for regular users).
|
||||
#'
|
||||
#' Use [droplevels()] to drop unused levels. At default, it will return a plain factor. Use `droplevels(..., as.mic = TRUE)` to maintain the `mic` class.
|
||||
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
|
||||
#'
|
||||
#' With [rescale_mic()], existing MIC ranges can be limited to a defined range of MIC values. This can be useful to better compare MIC distributions.
|
||||
#'
|
||||
#' For `ggplot2`, use one of the [`scale_*_mic()`][scale_x_mic()] functions to plot MIC values. They allows custom MIC ranges and to plot intermediate log2 levels for missing MIC values.
|
||||
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as a [numeric] vector. Bear in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
|
||||
#' @aliases mic
|
||||
#' @export
|
||||
#' @seealso [as.sir()]
|
||||
@@ -137,6 +128,9 @@ valid_mic_levels <- c(
|
||||
#' quantile(mic_data)
|
||||
#' all(mic_data < 512)
|
||||
#'
|
||||
#' # rescale MICs using rescale_mic()
|
||||
#' rescale_mic(mic_data, mic_range = c(4, 16))
|
||||
#'
|
||||
#' # interpret MIC values
|
||||
#' as.sir(
|
||||
#' x = as.mic(2),
|
||||
@@ -161,112 +155,224 @@ valid_mic_levels <- c(
|
||||
#' if (require("ggplot2")) {
|
||||
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
|
||||
#' }
|
||||
as.mic <- function(x, na.rm = FALSE) {
|
||||
as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(keep_operators, allow_class = c("character", "logical"), is_in = c("all", "none", "edges", FALSE, TRUE), has_length = 1)
|
||||
if (isTRUE(keep_operators)) {
|
||||
keep_operators <- "all"
|
||||
} else if (isFALSE(keep_operators)) {
|
||||
keep_operators <- "none"
|
||||
}
|
||||
|
||||
if (is.mic(x)) {
|
||||
x
|
||||
} else {
|
||||
if (is.numeric(x)) {
|
||||
x <- format(x, scientific = FALSE)
|
||||
} else {
|
||||
x <- as.character(unlist(x))
|
||||
}
|
||||
if (isTRUE(na.rm)) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
x[trimws2(x) == ""] <- NA
|
||||
x.bak <- x
|
||||
|
||||
# comma to period
|
||||
x <- gsub(",", ".", x, fixed = TRUE)
|
||||
# transform scientific notation
|
||||
x[x %like% "[-]?[0-9]+([.][0-9]+)?e[-]?[0-9]+"] <- as.double(x[x %like% "[-]?[0-9]+([.][0-9]+)?e[-]?[0-9]+"])
|
||||
# transform Unicode for >= and <=
|
||||
x <- gsub("\u2264", "<=", x, fixed = TRUE)
|
||||
x <- gsub("\u2265", ">=", x, fixed = TRUE)
|
||||
# remove other invalid characters
|
||||
x <- gsub("[^a-zA-Z0-9.><= ]+", "", x, perl = TRUE)
|
||||
# remove space between operator and number ("<= 0.002" -> "<=0.002")
|
||||
x <- gsub("(<|=|>) +", "\\1", x, perl = TRUE)
|
||||
# transform => to >= and =< to <=
|
||||
x <- gsub("=<", "<=", x, fixed = TRUE)
|
||||
x <- gsub("=>", ">=", x, fixed = TRUE)
|
||||
# dots without a leading zero must start with 0
|
||||
x <- gsub("([^0-9]|^)[.]", "\\10.", x, perl = TRUE)
|
||||
# values like "<=0.2560.512" should be 0.512
|
||||
x <- gsub(".*[.].*[.]", "0.", x, perl = TRUE)
|
||||
# remove ending .0
|
||||
x <- gsub("[.]+0$", "", x, perl = TRUE)
|
||||
# remove all after last digit
|
||||
x <- gsub("[^0-9]+$", "", x, perl = TRUE)
|
||||
# keep only one zero before dot
|
||||
x <- gsub("0+[.]", "0.", x, perl = TRUE)
|
||||
# starting 00 is probably 0.0 if there's no dot yet
|
||||
x[x %unlike% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
||||
# remove last zeroes
|
||||
x <- gsub("([.].?)0+$", "\\1", x, perl = TRUE)
|
||||
x <- gsub("(.*[.])0+$", "\\10", x, perl = TRUE)
|
||||
# remove ending .0 again
|
||||
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
|
||||
# never end with dot
|
||||
x <- gsub("[.]$", "", x, perl = TRUE)
|
||||
# trim it
|
||||
x <- trimws2(x)
|
||||
|
||||
## previously unempty values now empty - should return a warning later on
|
||||
x[x.bak != "" & x == ""] <- "invalid"
|
||||
|
||||
na_before <- x[is.na(x) | x == ""] %pm>% length()
|
||||
x[!x %in% valid_mic_levels] <- NA
|
||||
na_after <- x[is.na(x) | x == ""] %pm>% length()
|
||||
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %pm>%
|
||||
unique() %pm>%
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
cur_col <- get_current_column()
|
||||
warning_("in `as.mic()`: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
list_missing,
|
||||
call = FALSE
|
||||
if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
# might be from an older AMR version - just update MIC factor levels
|
||||
x <- set_clean_class(factor(as.character(x), levels = VALID_MIC_LEVELS, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
)
|
||||
}
|
||||
return(x)
|
||||
}
|
||||
|
||||
set_clean_class(factor(x, levels = valid_mic_levels, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
x.bak <- NULL
|
||||
if (is.numeric(x)) {
|
||||
x.bak <- format(x, scientific = FALSE)
|
||||
# MICs never have more than 9 decimals, so:
|
||||
x <- format(round(x, 9), scientific = FALSE)
|
||||
} else {
|
||||
x <- as.character(unlist(x))
|
||||
}
|
||||
if (isTRUE(na.rm)) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
x <- trimws2(x)
|
||||
x[x == ""] <- NA
|
||||
if (is.null(x.bak)) {
|
||||
x.bak <- x
|
||||
}
|
||||
# remove NAs on beforehand to not count them
|
||||
x.bak <- gsub("(NA)+", "", x.bak)
|
||||
# and trim
|
||||
x.bak <- trimws2(x.bak)
|
||||
|
||||
# comma to period
|
||||
x <- gsub(",", ".", x, fixed = TRUE)
|
||||
# transform Unicode for >= and <=
|
||||
x <- gsub("\u2264", "<=", x, fixed = TRUE)
|
||||
x <- gsub("\u2265", ">=", x, fixed = TRUE)
|
||||
# remove other invalid characters
|
||||
x <- gsub("[^a-zA-Z0-9.><= -]+", "", x, perl = TRUE)
|
||||
# transform => to >= and =< to <=
|
||||
x <- gsub("=<", "<=", x, fixed = TRUE)
|
||||
x <- gsub("=>", ">=", x, fixed = TRUE)
|
||||
# Remove leading == and =
|
||||
x <- gsub("^=+", "", x)
|
||||
# retrieve signs and remove them from input
|
||||
x_signs <- trimws(gsub("[^>=<]", "", x))
|
||||
x <- trimws(gsub("[>=<]", "", x))
|
||||
# dots without a leading zero must start with 0
|
||||
x <- gsub("([^0-9]|^)[.]", "\\10.", x, perl = TRUE)
|
||||
# values like "<=0.2560.512" should be 0.512
|
||||
x <- gsub(".*[.].*[.]", "0.", x, perl = TRUE)
|
||||
# remove ending .0
|
||||
x <- gsub("[.]+0$", "", x, perl = TRUE)
|
||||
# remove all after last digit
|
||||
x <- gsub("[^0-9]+$", "", x, perl = TRUE)
|
||||
# keep only one zero before dot
|
||||
x <- gsub("^0+[.]", "0.", x, perl = TRUE)
|
||||
# starting 00 is probably 0.0 if there's no dot yet
|
||||
x[x %unlike% "[.]"] <- gsub("^00", "0.0", x[!x %like% "[.]"])
|
||||
# remove last zeroes
|
||||
x <- gsub("([.].?)0+$", "\\1", x, perl = TRUE)
|
||||
x <- gsub("(.*[.])0+$", "\\10", x, perl = TRUE)
|
||||
# remove ending .0 again
|
||||
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
|
||||
# never end with dot
|
||||
x <- gsub("[.]$", "", x, perl = TRUE)
|
||||
# remove scientific notation
|
||||
x[x %like% "[0-9]e[-]?[0-9]"] <- trimws(format(suppressWarnings(as.double(x[x %like% "[0-9]e[-]?[0-9]"])), scientific = FALSE))
|
||||
# add signs again
|
||||
x <- paste0(x_signs, x)
|
||||
# remove NAs introduced by format()
|
||||
x <- gsub("(NA)+", "", x)
|
||||
# trim it
|
||||
x <- trimws2(x)
|
||||
|
||||
## previously unempty values now empty - should return a warning later on
|
||||
x[x.bak != "" & x == ""] <- "invalid"
|
||||
|
||||
na_before <- x[is.na(x) | x == ""] %pm>% length()
|
||||
x[!as.character(x) %in% VALID_MIC_LEVELS] <- NA
|
||||
na_after <- x[is.na(x) | x == ""] %pm>% length()
|
||||
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak) & x.bak != ""] %pm>%
|
||||
unique() %pm>%
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
cur_col <- get_current_column()
|
||||
warning_("in `as.mic()`: ", na_after - na_before, " result",
|
||||
ifelse(na_after - na_before > 1, "s", ""),
|
||||
ifelse(is.null(cur_col), "", paste0(" in index '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid MICs: ",
|
||||
list_missing,
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
if (keep_operators == "none" && !all(is.na(x))) {
|
||||
x <- gsub("[>=<]", "", x)
|
||||
} else if (keep_operators == "edges" && !all(is.na(x))) {
|
||||
dbls <- as.double(gsub("[>=<]", "", x))
|
||||
x[dbls == min(dbls, na.rm = TRUE)] <- paste0("<=", min(dbls, na.rm = TRUE))
|
||||
x[dbls == max(dbls, na.rm = TRUE)] <- paste0(">=", max(dbls, na.rm = TRUE))
|
||||
keep <- x[dbls == max(dbls, na.rm = TRUE) | dbls == min(dbls, na.rm = TRUE)]
|
||||
x[!x %in% keep] <- gsub("[>=<]", "", x[!x %in% keep])
|
||||
}
|
||||
|
||||
set_clean_class(factor(x, levels = VALID_MIC_LEVELS, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
)
|
||||
}
|
||||
|
||||
all_valid_mics <- function(x) {
|
||||
if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) {
|
||||
return(FALSE)
|
||||
}
|
||||
x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
|
||||
error = function(e) NA
|
||||
)
|
||||
!any(is.na(x_mic)) && !all(is.na(x))
|
||||
#' @rdname as.mic
|
||||
#' @export
|
||||
is.mic <- function(x) {
|
||||
inherits(x, "mic")
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @details `NA_mic_` is a missing value of the new `mic` class, analogous to e.g. base \R's [`NA_character_`][base::NA].
|
||||
#' @format NULL
|
||||
#' @export
|
||||
NA_mic_ <- set_clean_class(factor(NA, levels = valid_mic_levels, ordered = TRUE),
|
||||
NA_mic_ <- set_clean_class(factor(NA, levels = VALID_MIC_LEVELS, ordered = TRUE),
|
||||
new_class = c("mic", "ordered", "factor")
|
||||
)
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @param mic_range a manual range to rescale the MIC values, e.g., `mic_range = c(0.001, 32)`. Use `NA` to prevent rescaling on one side, e.g., `mic_range = c(NA, 32)`.
|
||||
#' @export
|
||||
is.mic <- function(x) {
|
||||
inherits(x, "mic")
|
||||
rescale_mic <- function(x, mic_range, keep_operators = "edges", as.mic = TRUE) {
|
||||
meet_criteria(mic_range, allow_class = c("numeric", "integer", "logical", "mic"), has_length = 2, allow_NA = TRUE, allow_NULL = TRUE)
|
||||
if (is.numeric(mic_range)) {
|
||||
mic_range <- trimws(format(mic_range, scientific = FALSE))
|
||||
mic_range <- gsub("[.]0+$", "", mic_range)
|
||||
mic_range[mic_range == "NA"] <- NA_character_
|
||||
} else if (is.mic(mic_range)) {
|
||||
mic_range <- as.character(mic_range)
|
||||
}
|
||||
stop_ifnot(
|
||||
all(mic_range %in% c(VALID_MIC_LEVELS, NA)),
|
||||
"Values in `mic_range` must be valid MIC values. ",
|
||||
"The allowed range is ", format(as.double(as.mic(VALID_MIC_LEVELS)[1]), scientific = FALSE), " to ", format(as.double(as.mic(VALID_MIC_LEVELS)[length(VALID_MIC_LEVELS)]), scientific = FALSE), ". ",
|
||||
"Unvalid: ", vector_and(mic_range[!mic_range %in% c(VALID_MIC_LEVELS, NA)], quotes = FALSE), "."
|
||||
)
|
||||
|
||||
x <- as.mic(x)
|
||||
if (is.null(mic_range)) {
|
||||
mic_range <- c(NA, NA)
|
||||
}
|
||||
mic_range <- as.mic(mic_range)
|
||||
|
||||
min_mic <- mic_range[1]
|
||||
max_mic <- mic_range[2]
|
||||
if (!is.na(min_mic)) {
|
||||
x[x < min_mic] <- min_mic
|
||||
}
|
||||
if (!is.na(max_mic)) {
|
||||
x[x > max_mic] <- max_mic
|
||||
}
|
||||
|
||||
x <- as.mic(x, keep_operators = ifelse(keep_operators == "edges", "none", keep_operators))
|
||||
|
||||
if (isTRUE(as.mic)) {
|
||||
if (keep_operators == "edges" && length(x) > 1) {
|
||||
x[x == min(x, na.rm = TRUE)] <- paste0("<=", x[x == min(x, na.rm = TRUE)])
|
||||
x[x == max(x, na.rm = TRUE)] <- paste0(">=", x[x == max(x, na.rm = TRUE)])
|
||||
}
|
||||
return(x)
|
||||
}
|
||||
|
||||
# create a manual factor with levels only within desired range
|
||||
expanded <- plotrange_as_table(x,
|
||||
expand = TRUE,
|
||||
keep_operators = ifelse(keep_operators == "edges", "none", keep_operators),
|
||||
mic_range = mic_range
|
||||
)
|
||||
if (keep_operators == "edges") {
|
||||
names(expanded)[1] <- paste0("<=", names(expanded)[1])
|
||||
names(expanded)[length(expanded)] <- paste0(">=", names(expanded)[length(expanded)])
|
||||
}
|
||||
# MICs contain all MIC levels, so strip this to only existing levels and their intermediate values
|
||||
out <- factor(names(expanded),
|
||||
levels = names(expanded),
|
||||
ordered = TRUE
|
||||
)
|
||||
# and only keep the ones in the data
|
||||
if (keep_operators == "edges") {
|
||||
out <- out[match(x, as.double(as.mic(out, keep_operators = "all")))]
|
||||
} else {
|
||||
out <- out[match(x, out)]
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @details Use [mic_p50()] and [mic_p90()] to get the 50th and 90th percentile of MIC values. They return 'normal' [numeric] values.
|
||||
#' @export
|
||||
mic_p50 <- function(x, na.rm = FALSE, ...) {
|
||||
x <- as.mic(x)
|
||||
as.double(stats::quantile(x, probs = 0.5, na.rm = na.rm))
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @export
|
||||
mic_p90 <- function(x, na.rm = FALSE, ...) {
|
||||
x <- as.mic(x)
|
||||
as.double(stats::quantile(x, probs = 0.9, na.rm = na.rm))
|
||||
}
|
||||
|
||||
#' @method as.double mic
|
||||
@@ -285,9 +391,10 @@ as.numeric.mic <- function(x, ...) {
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @method droplevels mic
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept - the default is `FALSE`
|
||||
#' @param as.mic a [logical] to indicate whether the `mic` class should be kept - the default is `TRUE` for [rescale_mic()] and `FALSE` for [droplevels()]. When setting this to `FALSE` in [rescale_mic()], the output will have factor levels that acknowledge `mic_range`.
|
||||
#' @export
|
||||
droplevels.mic <- function(x, as.mic = FALSE, ...) {
|
||||
x <- as.mic(x) # make sure that currently implemented MIC levels are used
|
||||
x <- droplevels.factor(x, ...)
|
||||
if (as.mic == TRUE) {
|
||||
class(x) <- c("mic", "ordered", "factor")
|
||||
@@ -295,32 +402,51 @@ droplevels.mic <- function(x, as.mic = FALSE, ...) {
|
||||
x
|
||||
}
|
||||
|
||||
all_valid_mics <- function(x) {
|
||||
if (!inherits(x, c("mic", "character", "factor", "numeric", "integer"))) {
|
||||
return(FALSE)
|
||||
}
|
||||
x_mic <- tryCatch(suppressWarnings(as.mic(x[!is.na(x)])),
|
||||
error = function(e) NA
|
||||
)
|
||||
!any(is.na(x_mic)) && !all(is.na(x))
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
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",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
crude_numbers <- as.double(x)
|
||||
operators <- gsub("[^<=>]+", "", as.character(x))
|
||||
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)
|
||||
# maketrailing zeroes almost invisible
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", font_white("\\1"), out[out %like% "[.]"], perl = TRUE)
|
||||
# make trailing zeroes less visible
|
||||
out[out %like% "[.]"] <- gsub("([.]?0+)$", font_silver("\\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
|
||||
type_sum.mic <- function(x, ...) {
|
||||
"mic"
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
paste0("mic", AMR_env$sup_1_icon)
|
||||
} else {
|
||||
"mic"
|
||||
}
|
||||
}
|
||||
|
||||
#' @method print mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.mic <- function(x, ...) {
|
||||
cat("Class 'mic'",
|
||||
ifelse(length(levels(x)) < length(valid_mic_levels), font_red(" with dropped levels"), ""),
|
||||
"\n",
|
||||
sep = ""
|
||||
)
|
||||
cat("Class 'mic'")
|
||||
if (!identical(levels(x), VALID_MIC_LEVELS)) {
|
||||
cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
|
||||
}
|
||||
cat("\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
att <- attributes(x)
|
||||
if ("na.action" %in% names(att)) {
|
||||
@@ -341,22 +467,44 @@ summary.mic <- function(object, ...) {
|
||||
as.matrix.mic <- function(x, ...) {
|
||||
as.matrix(as.double(x), ...)
|
||||
}
|
||||
#' @method as.vector mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.vector.mic <- function(x, mode = "numneric", ...) {
|
||||
y <- NextMethod()
|
||||
y <- as.mic(y)
|
||||
calls <- unlist(lapply(sys.calls(), as.character))
|
||||
if (any(calls %in% c("rbind", "cbind")) && message_not_thrown_before("as.vector.mic")) {
|
||||
warning_("Functions `rbind()` and `cbind()` cannot preserve the structure of MIC values. Use dplyr's `bind_rows()` or `bind_cols()` instead.", call = FALSE)
|
||||
}
|
||||
y
|
||||
}
|
||||
#' @method as.list mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.list.mic <- function(x, ...) {
|
||||
lapply(as.list(as.character(x), ...), as.mic)
|
||||
}
|
||||
#' @method as.data.frame mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.mic <- function(x, ...) {
|
||||
as.data.frame.vector(as.mic(x), ...)
|
||||
}
|
||||
|
||||
#' @method [ mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[.mic" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [[ mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.mic" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [<- mic
|
||||
#' @export
|
||||
@@ -364,8 +512,7 @@ as.matrix.mic <- function(x, ...) {
|
||||
"[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [[<- mic
|
||||
#' @export
|
||||
@@ -373,8 +520,7 @@ as.matrix.mic <- function(x, ...) {
|
||||
"[[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method c mic
|
||||
#' @export
|
||||
@@ -388,8 +534,7 @@ c.mic <- function(...) {
|
||||
#' @noRd
|
||||
unique.mic <- function(x, incomparables = FALSE, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
|
||||
#' @method rep mic
|
||||
@@ -397,20 +542,25 @@ unique.mic <- function(x, incomparables = FALSE, ...) {
|
||||
#' @noRd
|
||||
rep.mic <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
as.mic(y)
|
||||
}
|
||||
|
||||
#' @method sort mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
sort.mic <- function(x, decreasing = FALSE, ...) {
|
||||
x <- as.mic(x) # make sure that currently implemented MIC levels are used
|
||||
dbl <- as.double(x)
|
||||
# make sure that e.g. '<0.001' comes before '0.001', and '>0.001' comes after
|
||||
dbl[as.character(x) %like% "<[0-9]"] <- dbl[as.character(x) %like% "<[0-9]"] - 0.000002
|
||||
dbl[as.character(x) %like% "<="] <- dbl[as.character(x) %like% "<="] - 0.000001
|
||||
dbl[as.character(x) %like% ">="] <- dbl[as.character(x) %like% ">="] + 0.000001
|
||||
dbl[as.character(x) %like% ">[0-9]"] <- dbl[as.character(x) %like% ">[0-9]"] + 0.000002
|
||||
if (decreasing == TRUE) {
|
||||
ord <- order(-as.double(x))
|
||||
x[order(-dbl)]
|
||||
} else {
|
||||
ord <- order(as.double(x))
|
||||
x[order(dbl)]
|
||||
}
|
||||
x[ord]
|
||||
}
|
||||
|
||||
#' @method hist mic
|
||||
@@ -424,6 +574,7 @@ hist.mic <- function(x, ...) {
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
get_skimmers.mic <- function(column) {
|
||||
column <- as.mic(column) # make sure that currently implemented MIC levels are used
|
||||
skimr::sfl(
|
||||
skim_type = "mic",
|
||||
p0 = ~ stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
|
||||
@@ -475,12 +626,23 @@ Math.mic <- function(x, ...) {
|
||||
|
||||
#' @export
|
||||
Ops.mic <- function(e1, e2) {
|
||||
e1_chr <- as.character(e1)
|
||||
e2_chr <- character(0)
|
||||
e1 <- as.double(e1)
|
||||
if (!missing(e2)) {
|
||||
# when e1 is `!`, e2 is missing
|
||||
# when .Generic is `!`, e2 is missing
|
||||
e2_chr <- as.character(e2)
|
||||
e2 <- as.double(e2)
|
||||
}
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
if (as.character(.Generic) %in% c("<", "<=", "==", "!=", ">", ">=")) {
|
||||
# make sure that <0.002 is lower than 0.002
|
||||
# and that >32 is higher than 32, but equal to >=32
|
||||
e1[e1_chr %like% "<" & e1_chr %unlike% "="] <- e1[e1_chr %like% "<" & e1_chr %unlike% "="] - 0.000001
|
||||
e1[e1_chr %like% ">" & e1_chr %unlike% "="] <- e1[e1_chr %like% ">" & e1_chr %unlike% "="] + 0.000001
|
||||
e2[e2_chr %like% "<" & e2_chr %unlike% "="] <- e2[e2_chr %like% "<" & e2_chr %unlike% "="] - 0.000001
|
||||
e2[e2_chr %like% ">" & e2_chr %unlike% "="] <- e2[e2_chr %like% ">" & e2_chr %unlike% "="] + 0.000001
|
||||
}
|
||||
# set .Class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(e1)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
@@ -502,5 +664,6 @@ Summary.mic <- function(..., na.rm = FALSE) {
|
||||
# NextMethod() cannot be called from an anonymous function (`...`), so we get() the generic directly:
|
||||
fn <- get(.Generic, envir = .GenericCallEnv)
|
||||
fn(as.double(c(...)),
|
||||
na.rm = na.rm)
|
||||
na.rm = na.rm
|
||||
)
|
||||
}
|
||||
|
||||
+11
-13
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -30,18 +30,15 @@
|
||||
#' Calculate the Matching Score for Microorganisms
|
||||
#'
|
||||
#' This algorithm is used by [as.mo()] and all the [`mo_*`][mo_property()] functions to determine the most probable match of taxonomic records based on user input.
|
||||
#' @author Dr. Matthijs Berends, 2018
|
||||
#' @param x Any user input value(s)
|
||||
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
|
||||
#' @note This algorithm was originally described in: Berends MS *et al.* (2022). **AMR: An R Package for Working with Antimicrobial Resistance Data**. *Journal of Statistical Software*, 104(3), 1-31; \doi{10.18637/jss.v104.i03}.
|
||||
#' @note This algorithm was originally developed in 2018 and subsequently described in: Berends MS *et al.* (2022). **AMR: An R Package for Working with Antimicrobial Resistance Data**. *Journal of Statistical Software*, 104(3), 1-31; \doi{10.18637/jss.v104.i03}.
|
||||
#'
|
||||
#' Later, the work of Bartlett A *et al.* about bacterial pathogens infecting humans (2022, \doi{10.1099/mic.0.001269}) was incorporated.
|
||||
#' Later, the work of Bartlett A *et al.* about bacterial pathogens infecting humans (2022, \doi{10.1099/mic.0.001269}) was incorporated, and optimalisations to the algorithm were made.
|
||||
#' @section Matching Score for Microorganisms:
|
||||
#' With ambiguous user input in [as.mo()] and all the [`mo_*`][mo_property()] functions, the returned results are chosen based on their matching score using [mo_matching_score()]. This matching score \eqn{m}, is calculated as:
|
||||
#'
|
||||
#' \ifelse{latex}{\deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}}{
|
||||
#'
|
||||
#' \ifelse{html}{\figure{mo_matching_score.png}{options: width="300" alt="mo matching score"}}{m(x, n) = ( l_n * min(l_n, lev(x, n) ) ) / ( l_n * p_n * k_n )}}
|
||||
#' \deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}
|
||||
#'
|
||||
#' where:
|
||||
#'
|
||||
@@ -50,19 +47,20 @@
|
||||
#' * \eqn{l_n} is the length of \eqn{n};
|
||||
#' * \eqn{lev} is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance) (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change \eqn{x} into \eqn{n};
|
||||
#' * \eqn{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
|
||||
#' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Archaea = 2, others = 3.
|
||||
#' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Chromista = 1.75, Archaea = 2, others = 3.
|
||||
#'
|
||||
#' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups:
|
||||
#'
|
||||
#' - **Established**, if a taxonomic species has infected at least three persons in three or more references. These records have `prevalence = 1.0` in the [microorganisms] data set;
|
||||
#' - **Established**, if a taxonomic species has infected at least three persons in three or more references. These records have `prevalence = 1.15` in the [microorganisms] data set;
|
||||
#' - **Putative**, if a taxonomic species has fewer than three known cases. These records have `prevalence = 1.25` in the [microorganisms] data set.
|
||||
#'
|
||||
#' Furthermore,
|
||||
#'
|
||||
#' - Any genus present in the **established** list also has `prevalence = 1.0` in the [microorganisms] data set;
|
||||
#' - Genera from the World Health Organization's (WHO) Priority Pathogen List have `prevalence = 1.0` in the [microorganisms] data set;
|
||||
#' - Any genus present in the **established** list also has `prevalence = 1.15` in the [microorganisms] data set;
|
||||
#' - Any other genus present in the **putative** list has `prevalence = 1.25` in the [microorganisms] data set;
|
||||
#' - Any other species or subspecies of which the genus is present in the two aforementioned groups, has `prevalence = 1.5` in the [microorganisms] data set;
|
||||
#' - Any *non-bacterial* genus, species or subspecies of which the genus is present in the following list, has `prevalence = 1.25` in the [microorganisms] data set: `r vector_or(MO_PREVALENT_GENERA, quotes = "*")`;
|
||||
#' - Any *non-bacterial* genus, species or subspecies of which the genus is present in the following list, has `prevalence = 1.25` in the [microorganisms] data set: `r vector_or(MO_RELEVANT_GENERA, quotes = "*")`;
|
||||
#' - All other records have `prevalence = 2.0` in the [microorganisms] data set.
|
||||
#'
|
||||
#' When calculating the matching score, all characters in \eqn{x} and \eqn{n} are ignored that are other than A-Z, a-z, 0-9, spaces and parentheses.
|
||||
|
||||
+107
-34
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -39,8 +39,8 @@
|
||||
#' @details All functions will, at default, **not** keep old taxonomic properties, as synonyms are automatically replaced with the current taxonomy. Take for example *Enterobacter aerogenes*, which was initially named in 1960 but renamed to *Klebsiella aerogenes* in 2017:
|
||||
#' - `mo_genus("Enterobacter aerogenes")` will return `"Klebsiella"` (with a note about the renaming)
|
||||
#' - `mo_genus("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Enterobacter"` (with a once-per-session warning that the name is outdated)
|
||||
#' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note)
|
||||
#' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a warning)
|
||||
#' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note about the renaming)
|
||||
#' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a once-per-session warning that the name is outdated)
|
||||
#'
|
||||
#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. As a result, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
|
||||
#'
|
||||
@@ -50,15 +50,15 @@
|
||||
#'
|
||||
#' Determination of the Gram stain ([mo_gramstain()]) will be based on the taxonomic kingdom and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318/)), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were later renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, [PMID 34694987](https://pubmed.ncbi.nlm.nih.gov/34694987/)). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
||||
#'
|
||||
#' Determination of yeasts ([mo_is_yeast()]) will be based on the taxonomic kingdom and class. *Budding yeasts* are fungi of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes). *True yeasts* are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
|
||||
#' Determination of yeasts ([mo_is_yeast()]) will be based on the taxonomic kingdom and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
|
||||
#'
|
||||
#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) will be based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.3)`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antimicrobials).
|
||||
#'
|
||||
#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) will be based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(3.3)`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antibiotics).
|
||||
#'
|
||||
#' Determination of bacterial oxygen tolerance ([mo_oxygen_tolerance()]) will be based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicting an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
||||
#'
|
||||
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
|
||||
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) will be used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
|
||||
#'
|
||||
#' SNOMED codes ([mo_snomed()]) are from the version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
|
||||
#' SNOMED codes ([mo_snomed()]) was last updated on `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
|
||||
#'
|
||||
#' Old taxonomic names (so-called 'synonyms') can be retrieved with [mo_synonyms()] (which will have the scientific reference as [name][base::names()]), the current taxonomic name can be retrieved with [mo_current()]. Both functions return full names.
|
||||
#'
|
||||
@@ -71,8 +71,9 @@
|
||||
#' @return
|
||||
#' - An [integer] in case of [mo_year()]
|
||||
#' - An [ordered factor][factor] in case of [mo_pathogenicity()]
|
||||
#' - A [list] in case of [mo_taxonomy()], [mo_synonyms()], [mo_snomed()] and [mo_info()]
|
||||
#' - A named [character] in case of [mo_url()]
|
||||
#' - A [list] in case of [mo_taxonomy()], [mo_synonyms()], [mo_snomed()], and [mo_info()]
|
||||
#' - A [logical] in case of [mo_is_anaerobic()], [mo_is_gram_negative()], [mo_is_gram_positive()], [mo_is_intrinsic_resistant()], and [mo_is_yeast()]
|
||||
#' - A named [character] in case of [mo_synonyms()] and [mo_url()]
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso Data set [microorganisms]
|
||||
@@ -107,15 +108,25 @@
|
||||
#' mo_url("Klebsiella pneumoniae")
|
||||
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
||||
#'
|
||||
#' mo_group_members(c(
|
||||
#' "Streptococcus group A",
|
||||
#' "Streptococcus group C",
|
||||
#' "Streptococcus group G",
|
||||
#' "Streptococcus group L"
|
||||
#' ))
|
||||
#'
|
||||
#'
|
||||
#' # scientific reference -----------------------------------------------------
|
||||
#'
|
||||
#' mo_ref("Klebsiella aerogenes")
|
||||
#' mo_authors("Klebsiella aerogenes")
|
||||
#' mo_year("Klebsiella aerogenes")
|
||||
#' mo_synonyms("Klebsiella aerogenes")
|
||||
#' mo_lpsn("Klebsiella aerogenes")
|
||||
#' mo_gbif("Klebsiella aerogenes")
|
||||
#' mo_synonyms("Klebsiella aerogenes")
|
||||
#' mo_mycobank("Candida albicans")
|
||||
#' mo_mycobank("Candida krusei")
|
||||
#' mo_mycobank("Candida krusei", keep_synonyms = TRUE)
|
||||
#'
|
||||
#'
|
||||
#' # abbreviations known in the field -----------------------------------------
|
||||
@@ -209,7 +220,13 @@ mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_fullname <- mo_name
|
||||
mo_fullname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_fullname")
|
||||
}
|
||||
mo_name(x = x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
@@ -245,7 +262,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
||||
# unknown species etc.
|
||||
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
|
||||
|
||||
shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")], language = NULL, keep_synonyms = keep_synonyms)
|
||||
|
||||
shortnames[is.na(x.mo)] <- NA_character_
|
||||
load_mo_uncertainties(metadata)
|
||||
@@ -427,13 +444,16 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
||||
kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
|
||||
out <- factor(case_when_AMR(prev == 1 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
|
||||
(prev < 2 & kngd == "Fungi") ~ "Potentially pathogenic",
|
||||
prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
|
||||
kngd == "Bacteria" ~ "Potentially pathogenic",
|
||||
TRUE ~ "Unknown"),
|
||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||
ordered = TRUE
|
||||
out <- factor(
|
||||
case_when_AMR(
|
||||
prev <= 1.15 & kngd == "Bacteria" & rank != "genus" ~ "Pathogenic",
|
||||
prev < 2 & kngd == "Fungi" ~ "Potentially pathogenic",
|
||||
prev == 2 & kngd == "Bacteria" ~ "Non-pathogenic",
|
||||
kngd == "Bacteria" ~ "Potentially pathogenic",
|
||||
TRUE ~ "Unknown"
|
||||
),
|
||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||
ordered = TRUE
|
||||
)
|
||||
|
||||
load_mo_uncertainties(metadata)
|
||||
@@ -538,8 +558,7 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||
|
||||
load_mo_uncertainties(metadata)
|
||||
|
||||
out <- rep(FALSE, length(x))
|
||||
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
|
||||
out <- x.mo == "F_YEAST" | (x.kingdom == "Fungi" & x.class %in% c("Saccharomycetes", "Pichiomycetes"))
|
||||
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
||||
out
|
||||
}
|
||||
@@ -592,7 +611,7 @@ mo_oxygen_tolerance <- function(x, language = get_AMR_locale(), keep_synonyms =
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
|
||||
mo_validate(x = x, property = "oxygen_tolerance", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
@@ -606,7 +625,7 @@ mo_is_anaerobic <- function(x, language = get_AMR_locale(), keep_synonyms = getO
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
oxygen <- mo_oxygen_tolerance(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||
@@ -692,6 +711,21 @@ mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
mo_validate(x = x, property = "lpsn", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_mycobank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_mycobank")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
mo_validate(x = x, property = "mycobank", language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
@@ -791,11 +825,42 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||
mo_current <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
x.mo <- suppressWarnings(as.mo(x, keep_synonyms = TRUE, ...))
|
||||
x.mo <- suppressWarnings(as.mo(x, keep_synonyms = TRUE, info = FALSE, ...))
|
||||
out <- synonym_mo_to_accepted_mo(x.mo, fill_in_accepted = TRUE)
|
||||
mo_name(out, language = language)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_group_members <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
if (missing(x)) {
|
||||
# this tries to find the data and an 'mo' column
|
||||
x <- find_mo_col(fn = "mo_synonyms")
|
||||
}
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
metadata <- get_mo_uncertainties()
|
||||
|
||||
members <- lapply(x.mo, function(y) {
|
||||
AMR::microorganisms.groups$mo_name[which(AMR::microorganisms.groups$mo_group == y)]
|
||||
})
|
||||
names(members) <- mo_name(x, keep_synonyms = TRUE, language = language)
|
||||
|
||||
if (length(members) == 1) {
|
||||
members <- unname(unlist(members))
|
||||
}
|
||||
|
||||
load_mo_uncertainties(metadata)
|
||||
members
|
||||
}
|
||||
|
||||
|
||||
#' @rdname mo_property
|
||||
#' @export
|
||||
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||
@@ -812,7 +877,10 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
|
||||
info <- lapply(x, function(y) {
|
||||
c(
|
||||
list(mo = as.character(x)),
|
||||
list(
|
||||
mo = as.character(y),
|
||||
rank = mo_rank(y, language = language, keep_synonyms = keep_synonyms)
|
||||
),
|
||||
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
|
||||
list(
|
||||
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
|
||||
@@ -823,7 +891,9 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
||||
ref = mo_ref(y, keep_synonyms = keep_synonyms),
|
||||
snomed = unlist(mo_snomed(y, keep_synonyms = keep_synonyms)),
|
||||
lpsn = mo_lpsn(y, language = language, keep_synonyms = keep_synonyms),
|
||||
gbif = mo_gbif(y, language = language, keep_synonyms = keep_synonyms)
|
||||
mycobank = mo_mycobank(y, language = language, keep_synonyms = keep_synonyms),
|
||||
gbif = mo_gbif(y, language = language, keep_synonyms = keep_synonyms),
|
||||
group_members = mo_group_members(y, language = language, keep_synonyms = keep_synonyms)
|
||||
)
|
||||
)
|
||||
})
|
||||
@@ -857,19 +927,23 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
|
||||
|
||||
x.rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
x.name <- AMR_env$MO_lookup$fullname[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
|
||||
x.lpsn <- AMR_env$MO_lookup$lpsn[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
x.mycobank <- AMR_env$MO_lookup$mycobank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
x.gbif <- AMR_env$MO_lookup$gbif[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||
|
||||
u <- character(length(x))
|
||||
u[!is.na(x.gbif)] <- paste0(TAXONOMY_VERSION$GBIF$url, "/species/", x.gbif[!is.na(x.gbif)])
|
||||
# overwrite with LPSN:
|
||||
u[!is.na(x.lpsn)] <- paste0(TAXONOMY_VERSION$LPSN$url, "/", x.rank[!is.na(x.lpsn)], "/", gsub(" ", "-", tolower(x.name[!is.na(x.lpsn)]), fixed = TRUE))
|
||||
# overwrite with MycoBank (bacteria from LPSN will not be overwritten since MycoBank has no bacteria)
|
||||
u[!is.na(x.mycobank)] <- paste0(TAXONOMY_VERSION$MycoBank$url, "/mb/", gsub(" ", "%20", tolower(x.mycobank[!is.na(x.mycobank)]), fixed = TRUE))
|
||||
|
||||
names(u) <- x.name
|
||||
|
||||
if (isTRUE(open)) {
|
||||
if (length(u) > 1) {
|
||||
warning_("in `mo_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
warning_("in `mo_url()`: only the first URL will be opened, as R's built-in function `browseURL()` only suports one string.")
|
||||
}
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
@@ -913,7 +987,7 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
|
||||
|
||||
|
||||
if (isFALSE(has_Becker_or_Lancefield) && isTRUE(keep_synonyms) && all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
|
||||
# fastest way to get properties
|
||||
if (property == "snomed") {
|
||||
@@ -921,11 +995,10 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
||||
} else {
|
||||
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
|
||||
}
|
||||
|
||||
} else {
|
||||
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
|
||||
mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
|
||||
|
||||
|
||||
if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
|
||||
# do nothing, just don't run the other if-else's
|
||||
} else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
|
||||
@@ -936,7 +1009,7 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
||||
x <- replace_old_mo_codes(x, property = property)
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
|
||||
# get property reeaaally fast using match()
|
||||
if (property == "snomed") {
|
||||
x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
|
||||
|
||||
+14
-9
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -39,7 +39,7 @@
|
||||
#' @aliases set_mo_source get_mo_source
|
||||
#' @details The reference file can be a text file separated with commas (CSV) or tabs or pipes, an Excel file (either 'xls' or 'xlsx' format) or an \R object file (extension '.rds'). To use an Excel file, you will need to have the `readxl` package installed.
|
||||
#'
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] or [`microorganisms$fullname`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` argument and defaults to the user's home directory. It can also be set with the [package option][AMR-options] [`AMR_mo_source`][AMR-options], e.g. `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#' [set_mo_source()] will check the file for validity: it must be a [data.frame], must have a column named `"mo"` which contains values from [`microorganisms$mo`][microorganisms] or [`microorganisms$fullname`][microorganisms] and must have a reference column with your own defined values. If all tests pass, [set_mo_source()] will read the file into \R and will ask to export it to `"~/mo_source.rds"`. The CRAN policy disallows packages to write to the file system, although '*exceptions may be allowed in interactive sessions if the package obtains confirmation from the user*'. For this reason, this function only works in interactive sessions so that the user can **specifically confirm and allow** that this file will be created. The destination of this file can be set with the `destination` argument and defaults to the user's home directory. It can also be set with the package option [`AMR_mo_source`][AMR-options], e.g. `options(AMR_mo_source = "my/location/file.rds")`.
|
||||
#'
|
||||
#' The created compressed data file `"mo_source.rds"` will be used at default for MO determination (function [as.mo()] and consequently all `mo_*` functions like [mo_genus()] and [mo_gramstain()]). The location and timestamp of the original file will be saved as an [attribute][base::attributes()] to the compressed data file.
|
||||
#'
|
||||
@@ -60,10 +60,10 @@
|
||||
#' 4 | | |
|
||||
#' ```
|
||||
#'
|
||||
#' We save it as `"home/me/ourcodes.xlsx"`. Now we have to set it as a source:
|
||||
#' We save it as `"/Users/me/Documents/ourcodes.xlsx"`. Now we have to set it as a source:
|
||||
#'
|
||||
#' ```
|
||||
#' set_mo_source("home/me/ourcodes.xlsx")
|
||||
#' set_mo_source("/Users/me/Documents/ourcodes.xlsx")
|
||||
#' #> NOTE: Created mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> "Organisation XYZ" and "mo"
|
||||
@@ -125,14 +125,13 @@
|
||||
#' If the original file (in the previous case an Excel file) is moved or deleted, the `mo_source.rds` file will be removed upon the next use of [as.mo()] or any [`mo_*`][mo_property()] function.
|
||||
#' @export
|
||||
set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
stop_ifnot(interactive(), "this function can only be used in interactive mode, since it must ask for the user's permission to write a file to their file system.")
|
||||
|
||||
meet_criteria(path, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(destination, allow_class = "character", has_length = 1)
|
||||
stop_ifnot(destination %like% "[.]rds$", "the `destination` must be a file location with file extension .rds.")
|
||||
|
||||
mo_source_destination <- path.expand(destination)
|
||||
|
||||
stop_ifnot(interactive(), "this function can only be used in interactive mode, since it must ask for the user's permission to write a file to their file system.")
|
||||
|
||||
if (is.null(path) || path %in% c(FALSE, "")) {
|
||||
AMR_env$mo_source <- NULL
|
||||
if (file.exists(mo_source_destination)) {
|
||||
@@ -247,6 +246,12 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
|
||||
}
|
||||
return(NULL)
|
||||
}
|
||||
if (destination %unlike% "[.]rds$") {
|
||||
current_ext <- regexpr("\\.([[:alnum:]]+)$", destination)
|
||||
current_ext <- ifelse(current_ext > -1L, substring(destination, current_ext + 1L), "")
|
||||
vowel <- ifelse(current_ext %like% "^[AEFHILMNORSX]", "n", "")
|
||||
stop_("The AMR mo source must be an RDS file, not a", vowel, " ", toupper(current_ext), " file. If `\"", basename(destination), "\"` was meant as your input file, use `set_mo_source()` on this file. In any case, the option `AMR_mo_source` must be set to another path.")
|
||||
}
|
||||
if (is.null(AMR_env$mo_source)) {
|
||||
AMR_env$mo_source <- readRDS_AMR(path.expand(destination))
|
||||
}
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -113,7 +113,7 @@ pca <- function(x,
|
||||
|
||||
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
|
||||
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
|
||||
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in ?pca.", call = FALSE)
|
||||
warning_("in `pca()`: be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in `?pca`.", call = FALSE)
|
||||
}
|
||||
|
||||
# set column names
|
||||
|
||||
+677
-85
File diff suppressed because it is too large
Load Diff
+49
-34
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -35,20 +35,22 @@
|
||||
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
|
||||
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
|
||||
#' @param as_percent a [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
|
||||
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antibiotics, see section *Combination Therapy* below
|
||||
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below
|
||||
#' @param data a [data.frame] containing columns with class [`sir`] (see [as.sir()])
|
||||
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @param translate_ab a column name of the [antimicrobials] data set to translate the antibiotic abbreviations to, using [ab_property()]
|
||||
#' @inheritParams ab_property
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant) - the default is `TRUE`
|
||||
#' @param ab_result antibiotic results to test against, must be one or more values of "S", "I", or "R"
|
||||
#' @param combine_SI a [logical] to indicate whether all values of S, SDD, and I must be merged into one, so the output only consists of S+SDD+I vs. R (susceptible vs. resistant) - the default is `TRUE`
|
||||
#' @param ab_result antibiotic results to test against, must be one or more values of "S", "SDD", "I", or "R"
|
||||
#' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
|
||||
#' @param side the side of the confidence interval to return. The default is `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
|
||||
#' @param collapse a [logical] to indicate whether the output values should be 'collapsed', i.e. be merged together into one value, or a character value to use for collapsing
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details
|
||||
#' For a more automated and comprehensive analysis, consider using [antibiogram()] or [wisca()], which streamline many aspects of susceptibility reporting and, importantly, also support WISCA. The functions described here offer a more hands-on, manual approach for greater customisation.
|
||||
#'
|
||||
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
|
||||
#'
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
|
||||
#'
|
||||
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()]. Since AMR v3.0, [proportion_SI()] and [proportion_I()] include dose-dependent susceptibility ('SDD').
|
||||
#'
|
||||
#' Use [sir_confidence_interval()] to calculate the confidence interval, which relies on [binom.test()], i.e., the Clopper-Pearson method. This function returns a vector of length 2 at default for antimicrobial *resistance*. Change the `side` argument to "left"/"min" or "right"/"max" to return a single value, and change the `ab_result` argument to e.g. `c("S", "I")` to test for antimicrobial *susceptibility*, see Examples.
|
||||
#'
|
||||
@@ -56,25 +58,25 @@
|
||||
#'
|
||||
#' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates.
|
||||
#' @section Combination Therapy:
|
||||
#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antibiotics/variables that you test them for. See this example for two antibiotics, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
|
||||
#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
|
||||
#'
|
||||
#'
|
||||
#' ```
|
||||
#' --------------------------------------------------------------------
|
||||
#' only_all_tested = FALSE only_all_tested = TRUE
|
||||
#' ----------------------- -----------------------
|
||||
#' Drug A Drug B include as include as include as include as
|
||||
#' numerator denominator numerator denominator
|
||||
#' -------- -------- ---------- ----------- ---------- -----------
|
||||
#' S or I S or I X X X X
|
||||
#' R S or I X X X X
|
||||
#' <NA> S or I X X - -
|
||||
#' S or I R X X X X
|
||||
#' R R - X - X
|
||||
#' <NA> R - - - -
|
||||
#' S or I <NA> X X - -
|
||||
#' R <NA> - - - -
|
||||
#' <NA> <NA> - - - -
|
||||
#' Drug A Drug B considered considered considered considered
|
||||
#' susceptible tested susceptible tested
|
||||
#' -------- -------- ----------- ---------- ----------- ----------
|
||||
#' S or I S or I X X X X
|
||||
#' R S or I X X X X
|
||||
#' <NA> S or I X X - -
|
||||
#' S or I R X X X X
|
||||
#' R R - X - X
|
||||
#' <NA> R - - - -
|
||||
#' S or I <NA> X X - -
|
||||
#' R <NA> - - - -
|
||||
#' <NA> <NA> - - - -
|
||||
#' --------------------------------------------------------------------
|
||||
#' ```
|
||||
#'
|
||||
@@ -151,7 +153,7 @@
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # scoped dplyr verbs with antibiotic selectors
|
||||
#' # scoped dplyr verbs with antimicrobial selectors
|
||||
#' # (you could also use across() of course)
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
@@ -247,7 +249,7 @@ susceptibility <- function(...,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I"),
|
||||
ab_result = c("S", "SDD", "I"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
@@ -267,7 +269,7 @@ sir_confidence_interval <- function(...,
|
||||
confidence_level = 0.95,
|
||||
side = "both",
|
||||
collapse = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1, 2, 3), is_in = c("S", "I", "R"))
|
||||
meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1:5), is_in = c("S", "SDD", "I", "R", "NI"))
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
|
||||
@@ -285,16 +287,20 @@ sir_confidence_interval <- function(...,
|
||||
)
|
||||
n <- tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I", "R"),
|
||||
ab_result = c("S", "SDD", "I", "R", "NI"),
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
|
||||
# this applies the Clopper-Pearson method
|
||||
out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
|
||||
out <- set_clean_class(out, "double")
|
||||
if (x == 0) {
|
||||
out <- c(0, 0)
|
||||
} else {
|
||||
# this applies the Clopper-Pearson method
|
||||
out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
|
||||
}
|
||||
out <- set_clean_class(out, "numeric")
|
||||
|
||||
if (side %in% c("left", "l", "lower", "lowest", "less", "min")) {
|
||||
out <- out[1]
|
||||
@@ -302,12 +308,13 @@ sir_confidence_interval <- function(...,
|
||||
out <- out[2]
|
||||
}
|
||||
if (isTRUE(as_percent)) {
|
||||
out <- percentage(out, digits = 1)
|
||||
out <- trimws(percentage(out, digits = 1))
|
||||
}
|
||||
if (!isFALSE(collapse) && length(out) > 1) {
|
||||
if (is.numeric(out)) {
|
||||
out <- round(out, digits = 3)
|
||||
}
|
||||
# out[is.na(out)] <- 0
|
||||
out <- paste(out, collapse = ifelse(isTRUE(collapse), "-", collapse))
|
||||
}
|
||||
|
||||
@@ -323,7 +330,6 @@ sir_confidence_interval <- function(...,
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
|
||||
@@ -351,9 +357,12 @@ proportion_IR <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("proportion_IR", entire_session = TRUE)) {
|
||||
message_("Note that `proportion_IR()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "R"),
|
||||
ab_result = c("I", "SDD", "R"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
@@ -369,9 +378,12 @@ proportion_I <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("proportion_I", entire_session = TRUE)) {
|
||||
message_("Note that `proportion_I()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "I",
|
||||
ab_result = c("I", "SDD"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
@@ -387,9 +399,12 @@ proportion_SI <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
if (message_not_thrown_before("proportion_SI", entire_session = TRUE)) {
|
||||
message_("Note that `proportion_SI()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I"),
|
||||
ab_result = c("S", "I", "SDD"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
|
||||
+6
-10
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -83,10 +83,6 @@ random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
|
||||
#' @export
|
||||
random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
|
||||
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
|
||||
if ("prob_RSI" %in% names(list(...))) {
|
||||
deprecation_warning("prob_RSI", "prob_SIR", is_function = FALSE)
|
||||
prob_SIR <- list(...)$prob_RSI
|
||||
}
|
||||
meet_criteria(prob_SIR, allow_class = c("numeric", "integer"), has_length = 3)
|
||||
if (is.null(size)) {
|
||||
size <- NROW(get_current_data(arg_name = "size", call = -3))
|
||||
@@ -101,7 +97,7 @@ random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
|
||||
subset(guideline == max(guideline) &
|
||||
method == method_type &
|
||||
type == "human")
|
||||
|
||||
|
||||
if (!is.null(mo)) {
|
||||
mo_coerced <- as.mo(mo)
|
||||
mo_include <- c(
|
||||
@@ -137,7 +133,7 @@ random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
|
||||
# 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, na.rm = TRUE)) + sample(c(1:3), 1)
|
||||
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,
|
||||
@@ -159,7 +155,7 @@ random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
|
||||
return(out)
|
||||
} else if (method_type == "DISK") {
|
||||
set_range <- seq(
|
||||
from = as.integer(min(df$breakpoint_R, na.rm = TRUE) / 1.25),
|
||||
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),
|
||||
by = 1
|
||||
)
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -231,7 +231,7 @@ resistance_predict <- function(x,
|
||||
prediction <- predictmodel$fit
|
||||
se <- predictmodel$se.fit
|
||||
} else {
|
||||
stop("no valid model selected. See ?resistance_predict.")
|
||||
stop("no valid model selected. See `?resistance_predict`.")
|
||||
}
|
||||
|
||||
# prepare the output dataframe
|
||||
|
||||
+25
-15
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -41,7 +41,7 @@ sir_calc <- function(...,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
only_count = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1, 2, 3))
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1:5))
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
|
||||
@@ -137,11 +137,11 @@ sir_calc <- function(...,
|
||||
if (isTRUE(only_all_tested)) {
|
||||
# no NAs in any column
|
||||
y <- apply(
|
||||
X = as.data.frame(lapply(x, as.integer), stringsAsFactors = FALSE),
|
||||
X = as.data.frame(lapply(x, as.double), stringsAsFactors = FALSE),
|
||||
MARGIN = 1,
|
||||
FUN = min
|
||||
)
|
||||
numerator <- sum(as.integer(y) %in% as.integer(ab_result), na.rm = TRUE)
|
||||
numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE)
|
||||
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y))))
|
||||
} else {
|
||||
# may contain NAs in any column
|
||||
@@ -223,7 +223,8 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
combine_SI = TRUE,
|
||||
confidence_level = 0.95) {
|
||||
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
|
||||
meet_criteria(data, allow_class = "data.frame", contains_column_class = c("sir", "rsi"))
|
||||
meet_criteria(data, allow_class = "data.frame")
|
||||
data <- ascertain_sir_classes(data, "data")
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
@@ -234,7 +235,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
translate_ab <- get_translate_ab(translate_ab)
|
||||
|
||||
data.bak <- data
|
||||
# select only groups and antibiotics
|
||||
# select only groups and antimicrobials
|
||||
if (is_null_or_grouped_tbl(data)) {
|
||||
data_has_groups <- TRUE
|
||||
groups <- get_group_names(data)
|
||||
@@ -249,7 +250,12 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
for (i in seq_len(ncol(data))) {
|
||||
if (is.sir(data[, i, drop = TRUE])) {
|
||||
data[, i] <- as.character(data[, i, drop = TRUE])
|
||||
data[, i] <- gsub("(I|S)", "SI", data[, i, drop = TRUE])
|
||||
if ("SDD" %in% data[, i, drop = TRUE]) {
|
||||
if (message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
|
||||
message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
}
|
||||
data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -272,9 +278,9 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
for (i in seq_len(ncol(.data))) {
|
||||
values <- .data[, i, drop = TRUE]
|
||||
if (isTRUE(combine_SI)) {
|
||||
values <- factor(values, levels = c("SI", "R"), ordered = TRUE)
|
||||
values <- factor(values, levels = c("SI", "R", "NI"), ordered = TRUE)
|
||||
} else {
|
||||
values <- factor(values, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
values <- factor(values, levels = c("S", "SDD", "I", "R", "NI"), ordered = TRUE)
|
||||
}
|
||||
col_results <- as.data.frame(as.matrix(table(values)), stringsAsFactors = FALSE)
|
||||
col_results$interpretation <- rownames(col_results)
|
||||
@@ -351,9 +357,15 @@ 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
|
||||
out$interpretation <- factor(out$interpretation, levels = c("S", "I", "R"), ordered = TRUE)
|
||||
if (out$value[out$interpretation == "SDD"] > 0) {
|
||||
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)
|
||||
}
|
||||
}
|
||||
|
||||
out <- out[!is.na(out$interpretation), , drop = FALSE]
|
||||
|
||||
if (data_has_groups) {
|
||||
# ordering by the groups and two more: "antibiotic" and "interpretation"
|
||||
out <- pm_ungroup(out[do.call("order", out[, seq_len(length(groups) + 2), drop = FALSE]), , drop = FALSE])
|
||||
@@ -371,7 +383,5 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
out <- subset(out, select = -c(ci_min, ci_max, isolates))
|
||||
}
|
||||
|
||||
rownames(out) <- NULL
|
||||
out <- as_original_data_class(out, class(data.bak)) # will remove tibble groups
|
||||
structure(out, class = c("sir_df", "rsi_df", class(out)))
|
||||
as_original_data_class(out, class(data.bak), extra_class = "sir_df") # will remove tibble groups
|
||||
}
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
Binary file not shown.
Executable
+100
@@ -0,0 +1,100 @@
|
||||
# ==================================================================== #
|
||||
# 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://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Filter Top *n* Microorganisms
|
||||
#'
|
||||
#' This function filters a data set to include only the top *n* microorganisms based on a specified property, such as taxonomic family or genus. For example, it can filter a data set to the top 3 species, or to any species in the top 5 genera, or to the top 3 species in each of the top 5 genera.
|
||||
#' @param x a data frame containing microbial data
|
||||
#' @param n an integer specifying the maximum number of unique values of the `property` to include in the output
|
||||
#' @param property a character string indicating the microorganism property to use for filtering. Must be one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`. If `NULL`, the raw values from `col_mo` will be used without transformation.
|
||||
#' @param n_for_each an optional integer specifying the maximum number of rows to retain for each value of the selected property. If `NULL`, all rows within the top *n* groups will be included.
|
||||
#' @param col_mo A character string indicating the column in `x` that contains microorganism names or codes. Defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param ... Additional arguments passed on to [mo_property()] when `property` is not `NULL`.
|
||||
#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data. For example, it can filter a data set to only include isolates from the top 10 species.
|
||||
#' @export
|
||||
#' @seealso [mo_property()], [as.mo()], [antibiogram()]
|
||||
#' @examples
|
||||
#' # filter to the top 3 species:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 3
|
||||
#' )
|
||||
#'
|
||||
#' # filter to any species in the top 5 genera:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 5, property = "genus"
|
||||
#' )
|
||||
#'
|
||||
#' # filter to the top 3 species in each of the top 5 genera:
|
||||
#' top_n_microorganisms(example_isolates,
|
||||
#' n = 5, property = "genus", n_for_each = 3
|
||||
#' )
|
||||
top_n_microorganisms <- function(x, n, property = "fullname", n_for_each = NULL, col_mo = NULL, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
|
||||
meet_criteria(n_for_each, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = TRUE)
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
}
|
||||
|
||||
x.bak <- x
|
||||
|
||||
x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE)
|
||||
|
||||
if (is.null(property)) {
|
||||
x$prop_val <- x[[col_mo]]
|
||||
} else {
|
||||
x$prop_val <- mo_property(x[[col_mo]], property = property, ...)
|
||||
}
|
||||
counts <- sort(table(x$prop_val), decreasing = TRUE)
|
||||
|
||||
n <- as.integer(n)
|
||||
if (length(counts) < n) {
|
||||
n <- length(counts)
|
||||
}
|
||||
count_values <- names(counts)[seq_len(n)]
|
||||
filtered_rows <- which(x$prop_val %in% count_values)
|
||||
|
||||
if (!is.null(n_for_each)) {
|
||||
n_for_each <- as.integer(n_for_each)
|
||||
filtered_x <- x[filtered_rows, , drop = FALSE]
|
||||
filtered_rows <- do.call(
|
||||
c,
|
||||
lapply(split(filtered_x, filtered_x$prop_val), function(group) {
|
||||
top_values <- names(sort(table(group[[col_mo]]), decreasing = TRUE)[seq_len(n_for_each)])
|
||||
top_values <- top_values[!is.na(top_values)]
|
||||
which(x[[col_mo]] %in% top_values)
|
||||
})
|
||||
)
|
||||
}
|
||||
|
||||
x.bak[filtered_rows, , drop = FALSE]
|
||||
}
|
||||
+6
-6
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -34,7 +34,7 @@
|
||||
#' @param language language to choose. Use one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
|
||||
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_and(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial drugs and colloquial microorganism names.
|
||||
#'
|
||||
#' To permanently silence the once-per-session language note on a non-English operating system, you can set the [package option][AMR-options] [`AMR_locale`][AMR-options] in your `.Rprofile` file like this:
|
||||
#' To permanently silence the once-per-session language note on a non-English operating system, you can set the package option [`AMR_locale`][AMR-options] in your `.Rprofile` file like this:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Open .Rprofile file
|
||||
@@ -51,12 +51,12 @@
|
||||
#' ### Changing the Default Language
|
||||
#' The system language will be used at default (as returned by `Sys.getenv("LANG")` or, if `LANG` is not set, [`Sys.getlocale("LC_COLLATE")`][Sys.getlocale()]), if that language is supported. But the language to be used can be overwritten in two ways and will be checked in this order:
|
||||
#'
|
||||
#' 1. Setting the [package option][AMR-options] [`AMR_locale`][AMR-options], either by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
|
||||
#' 1. Setting the package option [`AMR_locale`][AMR-options], either by using e.g. `set_AMR_locale("German")` or by running e.g. `options(AMR_locale = "German")`.
|
||||
#'
|
||||
#' Note that setting an \R option only works in the same session. Save the command `options(AMR_locale = "(your language)")` to your `.Rprofile` file to apply it for every session. Run `utils::file.edit("~/.Rprofile")` to edit your `.Rprofile` file.
|
||||
#' 2. Setting the system variable `LANGUAGE` or `LANG`, e.g. by adding `LANGUAGE="de_DE.utf8"` to your `.Renviron` file in your home directory.
|
||||
#'
|
||||
#' Thus, if the [package option][AMR-options] [`AMR_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' Thus, if the package option [`AMR_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' @rdname translate
|
||||
#' @name translate
|
||||
#' @export
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -34,34 +34,36 @@
|
||||
|
||||
# see https://github.com/tidyverse/dplyr/issues/5955 why this is required
|
||||
|
||||
# S3: ab_selector
|
||||
vec_ptype2.character.ab_selector <- function(x, y, ...) {
|
||||
# S3: amr_selector ----
|
||||
# this does not need a .default method since it's used internally only
|
||||
vec_ptype2.character.amr_selector <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_ptype2.ab_selector.character <- function(x, y, ...) {
|
||||
vec_ptype2.amr_selector.character <- function(x, y, ...) {
|
||||
y
|
||||
}
|
||||
vec_cast.character.ab_selector <- function(x, to, ...) {
|
||||
vec_cast.character.amr_selector <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
|
||||
# S3: ab_selector_any_all
|
||||
vec_ptype2.logical.ab_selector_any_all <- function(x, y, ...) {
|
||||
# S3: amr_selector_any_all ----
|
||||
# this does not need a .default method since it's used internally only
|
||||
vec_ptype2.logical.amr_selector_any_all <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_ptype2.ab_selector_any_all.logical <- function(x, y, ...) {
|
||||
vec_ptype2.amr_selector_any_all.logical <- function(x, y, ...) {
|
||||
y
|
||||
}
|
||||
vec_cast.logical.ab_selector_any_all <- function(x, to, ...) {
|
||||
vec_cast.logical.amr_selector_any_all <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
|
||||
# S3: ab
|
||||
vec_ptype2.character.ab <- function(x, y, ...) {
|
||||
# S3: ab ----
|
||||
vec_ptype2.ab.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.ab.character <- function(x, y, ...) {
|
||||
y
|
||||
vec_ptype2.ab.ab <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.ab <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
@@ -70,12 +72,12 @@ vec_cast.ab.character <- function(x, to, ...) {
|
||||
return_after_integrity_check(x, "antimicrobial drug code", as.character(AMR_env$AB_lookup$ab))
|
||||
}
|
||||
|
||||
# S3: av
|
||||
vec_ptype2.character.av <- function(x, y, ...) {
|
||||
# S3: av ----
|
||||
vec_ptype2.av.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.av.character <- function(x, y, ...) {
|
||||
y
|
||||
vec_ptype2.av.av <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.av <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
@@ -84,12 +86,12 @@ vec_cast.av.character <- function(x, to, ...) {
|
||||
return_after_integrity_check(x, "antiviral drug code", as.character(AMR_env$AV_lookup$av))
|
||||
}
|
||||
|
||||
# S3: mo
|
||||
vec_ptype2.character.mo <- function(x, y, ...) {
|
||||
# S3: mo ----
|
||||
vec_ptype2.mo.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.mo.character <- function(x, y, ...) {
|
||||
y
|
||||
vec_ptype2.mo.mo <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.mo <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
@@ -99,12 +101,21 @@ vec_cast.mo.character <- function(x, to, ...) {
|
||||
return_after_integrity_check(x, "microorganism code", as.character(AMR_env$MO_lookup$mo))
|
||||
}
|
||||
|
||||
# S3: disk
|
||||
vec_ptype2.integer.disk <- function(x, y, ...) {
|
||||
x
|
||||
# S3: disk ----
|
||||
vec_ptype_full.disk <- function(x, ...) {
|
||||
"disk"
|
||||
}
|
||||
vec_ptype2.disk.integer <- function(x, y, ...) {
|
||||
y
|
||||
vec_ptype_abbr.disk <- function(x, ...) {
|
||||
"dsk"
|
||||
}
|
||||
vec_ptype2.disk.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
NA_disk_[0]
|
||||
}
|
||||
vec_ptype2.disk.disk <- function(x, y, ...) {
|
||||
NA_disk_[0]
|
||||
}
|
||||
vec_cast.disk.disk <- function(x, to, ...) {
|
||||
as.disk(x)
|
||||
}
|
||||
vec_cast.integer.disk <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
@@ -125,29 +136,63 @@ vec_cast.disk.character <- function(x, to, ...) {
|
||||
as.disk(x)
|
||||
}
|
||||
|
||||
# S3: mic
|
||||
# S3: mic ----
|
||||
vec_ptype2.mic.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
# this will make sure that currently implemented MIC levels are returned
|
||||
NA_mic_[0]
|
||||
}
|
||||
vec_ptype2.mic.mic <- function(x, y, ...) {
|
||||
# this will make sure that currently implemented MIC levels are returned
|
||||
NA_mic_[0]
|
||||
}
|
||||
vec_cast.mic.mic <- function(x, to, ...) {
|
||||
# this will make sure that currently implemented MIC levels are returned
|
||||
as.mic(x)
|
||||
}
|
||||
vec_cast.character.mic <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
}
|
||||
vec_cast.double.mic <- function(x, to, ...) {
|
||||
as.double(x)
|
||||
}
|
||||
vec_cast.integer.mic <- function(x, to, ...) {
|
||||
as.integer(x)
|
||||
}
|
||||
vec_cast.factor.mic <- function(x, to, ...) {
|
||||
factor(as.character(x))
|
||||
}
|
||||
vec_cast.mic.double <- function(x, to, ...) {
|
||||
as.mic(x)
|
||||
}
|
||||
vec_cast.mic.character <- function(x, to, ...) {
|
||||
as.mic(x)
|
||||
}
|
||||
vec_cast.mic.integer <- function(x, to, ...) {
|
||||
as.mic(x)
|
||||
}
|
||||
vec_cast.mic.factor <- function(x, to, ...) {
|
||||
as.mic(x)
|
||||
}
|
||||
vec_math.mic <- function(.fn, x, ...) {
|
||||
.fn(as.double(x), ...)
|
||||
}
|
||||
|
||||
# S3: sir
|
||||
vec_ptype2.character.sir <- function(x, y, ...) {
|
||||
x
|
||||
vec_arith.mic <- function(op, x, y, ...) {
|
||||
vctrs::vec_arith(op, as.double(x), as.double(y))
|
||||
}
|
||||
vec_ptype2.sir.character <- function(x, y, ...) {
|
||||
y
|
||||
|
||||
# S3: sir ----
|
||||
vec_ptype2.sir.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
NA_sir_[0]
|
||||
}
|
||||
vec_ptype2.sir.sir <- function(x, y, ...) {
|
||||
NA_sir_[0]
|
||||
}
|
||||
vec_ptype2.character.sir <- function(x, y, ...) {
|
||||
NA_sir_[0]
|
||||
}
|
||||
vec_cast.sir.sir <- function(x, to, ...) {
|
||||
# this makes sure that old SIR objects (with S/I/R) are converted to the current structure (S/SDD/I/R/NI)
|
||||
as.sir(x)
|
||||
}
|
||||
vec_cast.character.sir <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -31,13 +31,13 @@
|
||||
#'
|
||||
#' All antimicrobial drugs and their official names, ATC codes, ATC groups and defined daily dose (DDD) are included in this package, using the WHO Collaborating Centre for Drug Statistics Methodology.
|
||||
#' @section WHOCC:
|
||||
#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://www.whocc.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>).
|
||||
#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>).
|
||||
#'
|
||||
#' These have become the gold standard for international drug utilisation monitoring and research.
|
||||
#'
|
||||
#' The WHOCC is located in Oslo at the Norwegian Institute of Public Health and funded by the Norwegian government. The European Commission is the executive of the European Union and promotes its general interest.
|
||||
#'
|
||||
#' **NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package.** See <https://www.whocc.no/copyright_disclaimer/.>
|
||||
#' **NOTE: The WHOCC copyright does not allow use for commercial purposes, unlike any other info from this package.** See <https://atcddd.fhi.no/copyright_disclaimer/.>
|
||||
|
||||
#' @name WHOCC
|
||||
#' @rdname WHOCC
|
||||
|
||||
+43
-161
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -29,174 +29,40 @@
|
||||
|
||||
#' Deprecated Functions
|
||||
#'
|
||||
#' These functions are so-called '[Deprecated]'. **They will be removed in a future release.** Using the functions will give a warning with the name of the function it has been replaced by (if there is one).
|
||||
#' These objects are so-called '[Deprecated]'. **They will be removed in a future version of this package.** Using these will give a warning with the name of the alternative object it has been replaced by (if there is one).
|
||||
#' @keywords internal
|
||||
#' @name AMR-deprecated
|
||||
#' @rdname AMR-deprecated
|
||||
NULL
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @usage NULL
|
||||
#' @export
|
||||
NA_rsi_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
new_class = c("rsi", "ordered", "factor")
|
||||
)
|
||||
"antibiotics"
|
||||
|
||||
# REMEMBER to also remove the deprecated `antibiotics` argument in `antibiogram()`
|
||||
# REMEMBER to also remove the deprecated `converse_capped_values` argument in `as.sir()`
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
as.rsi <- function(x, ...) {
|
||||
deprecation_warning("as.rsi", "as.sir")
|
||||
UseMethod("as.rsi")
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.default <- function(...) {
|
||||
as.sir.default(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.mic <- function(...) {
|
||||
as.sir.mic(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.disk <- function(...) {
|
||||
as.sir.disk(...)
|
||||
}
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.rsi.data.frame <- function(...) {
|
||||
as.sir.data.frame(...)
|
||||
ab_class <- function(...) {
|
||||
deprecation_warning("ab_class", "amr_class", is_function = TRUE)
|
||||
amr_class(...)
|
||||
}
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
facet_rsi <- function(...) {
|
||||
deprecation_warning("facet_rsi", "facet_sir")
|
||||
facet_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
geom_rsi <- function(...) {
|
||||
deprecation_warning("geom_rsi", "geom_sir")
|
||||
geom_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ggplot_rsi <- function(...) {
|
||||
deprecation_warning("ggplot_rsi", "ggplot_sir")
|
||||
ggplot_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ggplot_rsi_predict <- function(...) {
|
||||
deprecation_warning("ggplot_rsi_predict", "ggplot_sir_predict")
|
||||
ggplot_sir_predict(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi <- function(...) {
|
||||
# REMINDER: change as.sir() to remove the deprecation warning there
|
||||
suppressWarnings(is.sir(...))
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
is.rsi.eligible <- function(...) {
|
||||
deprecation_warning("is.rsi.eligible", "is_sir_eligible")
|
||||
is_sir_eligible(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
labels_rsi_count <- function(...) {
|
||||
deprecation_warning("labels_rsi_count", "labels_sir_count")
|
||||
labels_sir_count(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
n_rsi <- function(...) {
|
||||
deprecation_warning("n_rsi", "n_sir")
|
||||
n_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
random_rsi <- function(...) {
|
||||
deprecation_warning("random_rsi", "random_sir")
|
||||
random_sir(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
rsi_df <- function(...) {
|
||||
deprecation_warning("rsi_df", "sir_df")
|
||||
sir_df(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
rsi_predict <- function(...) {
|
||||
deprecation_warning("rsi_predict", "sir_predict")
|
||||
sir_predict(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
scale_rsi_colours <- function(...) {
|
||||
deprecation_warning("scale_rsi_colours", "scale_sir_colours")
|
||||
scale_sir_colours(...)
|
||||
}
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
theme_rsi <- function(...) {
|
||||
deprecation_warning("theme_rsi", "theme_sir")
|
||||
theme_sir(...)
|
||||
ab_selector <- function(...) {
|
||||
deprecation_warning("ab_selector", "amr_selector", is_function = TRUE)
|
||||
amr_selector(...)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.rsi <- pillar_shaft.sir
|
||||
type_sum.rsi <- function(x, ...) {
|
||||
if (message_not_thrown_before("type_sum.rsi")) {
|
||||
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir'. Transform your 'rsi' columns to 'sir' with `as.sir()`, e.g.:\n your_data %>% mutate_if(is.rsi, as.sir)")
|
||||
}
|
||||
"rsi"
|
||||
}
|
||||
## Helper function ----
|
||||
|
||||
#' @method print rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.rsi <- function(x, ...) {
|
||||
deprecation_warning(extra_msg = "The 'rsi' class has been replaced with 'sir' - transform your 'rsi' data with `as.sir()`")
|
||||
cat("Class 'rsi'", font_bold(font_red("[!]\n")))
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @export
|
||||
`[<-.rsi` <- `[<-.sir`
|
||||
#' @noRd
|
||||
#' @export
|
||||
`[[<-.rsi` <- `[[<-.sir`
|
||||
#' @noRd
|
||||
#' @export
|
||||
barplot.rsi <- barplot.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
c.rsi <- c.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
droplevels.rsi <- droplevels.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
plot.rsi <- plot.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
rep.rsi <- rep.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
summary.rsi <- summary.sir
|
||||
#' @noRd
|
||||
#' @export
|
||||
unique.rsi <- unique.sir
|
||||
|
||||
# WHEN REMOVING RSI, DON'T FORGET TO REMOVE :
|
||||
# - THE "rsi_df" CLASS FROM R/sir_calc.R
|
||||
# - CODE CONTAINING only_rsi_columns, colours_RSI, include_untested_rsi, prob_RSI
|
||||
|
||||
deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
|
||||
deprecation_warning <- function(old = NULL, new = NULL, fn = NULL, extra_msg = NULL, is_function = FALSE, is_dataset = FALSE, is_argument = FALSE) {
|
||||
if (is.null(old)) {
|
||||
warning_(extra_msg)
|
||||
} else {
|
||||
} else if (message_not_thrown_before("deprecation", old, new, entire_session = TRUE)) {
|
||||
env <- paste0("deprecated_", old)
|
||||
if (!env %in% names(AMR_env)) {
|
||||
AMR_env[[paste0("deprecated_", old)]] <- 1
|
||||
@@ -204,17 +70,33 @@ deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_fun
|
||||
old <- paste0(old, "()")
|
||||
new <- paste0(new, "()")
|
||||
type <- "function"
|
||||
} else {
|
||||
} else if (isTRUE(is_dataset)) {
|
||||
type <- "dataset"
|
||||
} else if (isTRUE(is_argument)) {
|
||||
type <- "argument"
|
||||
if (is.null(fn)) {
|
||||
stop("Set 'fn' in deprecation_warning()")
|
||||
}
|
||||
} else {
|
||||
stop("Set either 'is_function', 'is_dataset', or 'is_argument' to TRUE in deprecation_warning()")
|
||||
}
|
||||
warning_(
|
||||
ifelse(is.null(new),
|
||||
paste0("The `", old, "` ", type, " is no longer in use"),
|
||||
paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
|
||||
ifelse(type == "dataset",
|
||||
paste0("The `", old, "` ", type, " has been renamed to `", new, "`"),
|
||||
ifelse(type == "argument",
|
||||
paste0("The `", old, "` ", type, " in `", fn, "()` has been renamed to `", new, "`: `", fn, "(", new, " = ...)`"),
|
||||
paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
|
||||
)
|
||||
)
|
||||
),
|
||||
ifelse(type == "argument",
|
||||
". While the old argument still works, it will be removed in a future version, so please update your code.",
|
||||
", see `?AMR-deprecated`."
|
||||
ifelse(type == "dataset",
|
||||
". The old name will be removed in future version, so please update your code.",
|
||||
ifelse(type == "argument",
|
||||
". While the old argument still works, it will be removed in a future version, so please update your code.",
|
||||
" and will be removed in a future version, see `?AMR-deprecated`."
|
||||
)
|
||||
),
|
||||
ifelse(!is.null(extra_msg),
|
||||
paste0(" ", extra_msg),
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -58,16 +58,20 @@ AMR_env$av_previously_coerced <- data.frame(
|
||||
AMR_env$sir_interpretation_history <- data.frame(
|
||||
datetime = Sys.time()[0],
|
||||
index = integer(0),
|
||||
ab_user = character(0),
|
||||
mo_user = character(0),
|
||||
ab_given = character(0),
|
||||
mo_given = character(0),
|
||||
host_given = character(0),
|
||||
ab = set_clean_class(character(0), c("ab", "character")),
|
||||
mo = set_clean_class(character(0), c("mo", "character")),
|
||||
input = double(0),
|
||||
outcome = NA_sir_[0],
|
||||
host = character(0),
|
||||
method = character(0),
|
||||
breakpoint_S_R = character(0),
|
||||
input = character(0),
|
||||
outcome = NA_sir_[0],
|
||||
notes = character(0),
|
||||
guideline = character(0),
|
||||
ref_table = character(0),
|
||||
uti = logical(0),
|
||||
breakpoint_S_R = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
@@ -77,19 +81,17 @@ AMR_env$is_dark_theme <- NULL
|
||||
AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
|
||||
AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
|
||||
|
||||
# determine info icon for messages
|
||||
if (pkg_is_available("cli")) {
|
||||
# let cli do the determination of supported symbols
|
||||
AMR_env$info_icon <- import_fn("symbol", "cli")$info
|
||||
AMR_env$bullet_icon <- import_fn("symbol", "cli")$bullet
|
||||
AMR_env$dots <- import_fn("symbol", "cli")$ellipsis
|
||||
} else {
|
||||
AMR_env$info_icon <- "i"
|
||||
AMR_env$bullet_icon <- "*"
|
||||
AMR_env$dots <- "..."
|
||||
}
|
||||
# take cli symbols and error function if available
|
||||
AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
|
||||
AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
|
||||
AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
|
||||
AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
|
||||
|
||||
.onLoad <- function(lib, pkg) {
|
||||
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:
|
||||
@@ -98,16 +100,16 @@ if (pkg_is_available("cli")) {
|
||||
s3_register("pillar::pillar_shaft", "av")
|
||||
s3_register("pillar::pillar_shaft", "mo")
|
||||
s3_register("pillar::pillar_shaft", "sir")
|
||||
s3_register("pillar::pillar_shaft", "rsi") # remove in a later version
|
||||
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", "rsi") # remove in a later version
|
||||
s3_register("pillar::type_sum", "mic")
|
||||
s3_register("pillar::type_sum", "disk")
|
||||
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")
|
||||
@@ -132,32 +134,36 @@ if (pkg_is_available("cli")) {
|
||||
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
|
||||
# S3: ab_selector
|
||||
s3_register("vctrs::vec_ptype2", "character.ab_selector")
|
||||
s3_register("vctrs::vec_ptype2", "ab_selector.character")
|
||||
s3_register("vctrs::vec_cast", "character.ab_selector")
|
||||
# S3: ab_selector_any_all
|
||||
s3_register("vctrs::vec_ptype2", "logical.ab_selector_any_all")
|
||||
s3_register("vctrs::vec_ptype2", "ab_selector_any_all.logical")
|
||||
s3_register("vctrs::vec_cast", "logical.ab_selector_any_all")
|
||||
# NOTE 2024-02-22 this is the right way - it should be 2 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", "character.ab")
|
||||
s3_register("vctrs::vec_ptype2", "ab.character")
|
||||
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", "character.av")
|
||||
s3_register("vctrs::vec_ptype2", "av.character")
|
||||
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", "character.mo")
|
||||
s3_register("vctrs::vec_ptype2", "mo.character")
|
||||
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_ptype2", "integer.disk")
|
||||
s3_register("vctrs::vec_ptype2", "disk.integer")
|
||||
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")
|
||||
@@ -165,16 +171,26 @@ if (pkg_is_available("cli")) {
|
||||
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_ptype2", "sir.character")
|
||||
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)) {
|
||||
@@ -187,33 +203,54 @@ if (pkg_is_available("cli")) {
|
||||
|
||||
# reference data - they have additional data to improve algorithm speed
|
||||
# they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
|
||||
AMR_env$AB_lookup <- cbind(AMR::antibiotics, AB_LOOKUP)
|
||||
if (NROW(AB_LOOKUP) != NROW(AMR::antimicrobials)) {
|
||||
# antimicrobials data set was updated - run create_AB_AV_lookup() again
|
||||
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)
|
||||
}
|
||||
|
||||
.onAttach <- function(lib, pkg) {
|
||||
.onAttach <- function(libname, pkgname) {
|
||||
# if custom ab option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
|
||||
packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_ab"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||
)
|
||||
if (getOption("AMR_custom_ab") %unlike% "[.]rds$") {
|
||||
packageStartupMessage("The file with custom antimicrobials must be an RDS file. Set the option `AMR_custom_ab` to another path.")
|
||||
} else {
|
||||
packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_ab"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||
)
|
||||
}
|
||||
}
|
||||
# if custom mo option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
|
||||
packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_mo"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||
)
|
||||
if (getOption("AMR_custom_mo") %unlike% "[.]rds$") {
|
||||
packageStartupMessage("The file with custom microorganisms must be an RDS file. Set the option `AMR_custom_mo` to another path.")
|
||||
} else {
|
||||
packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
|
||||
x <- readRDS_AMR(getOption("AMR_custom_mo"))
|
||||
tryCatch(
|
||||
{
|
||||
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||
packageStartupMessage("OK.")
|
||||
},
|
||||
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,31 +1,37 @@
|
||||
# `AMR` (for R)
|
||||
|
||||
<a href="https://msberends.github.io/AMR/"><img src="https://msberends.github.io/AMR/AMR_intro.png" align="center"></a>
|
||||
# The `AMR` Package for R
|
||||
|
||||
----
|
||||
|
||||
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)).
|
||||
The `AMR` package is a free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
||||
|
||||
`AMR` is a free, open-source and independent R package 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 antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. It is currently being used in over 175 countries.
|
||||
|
||||
After installing this package, R knows ~52,000 distinct microbial species and all ~600 antibiotic, antimycotic, and antiviral drugs by name and code (including ATC, WHONET/EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish, and Ukrainian.
|
||||
Overview:
|
||||
|
||||
This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.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, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice Foundation and University Medical Center Groningen. This R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
|
||||
* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach
|
||||
* Used in over 175 countries, available in 20 languages
|
||||
* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA
|
||||
* Provides the **full microbiological taxonomy** and extensive info on **all antimicrobial drugs**
|
||||
* Applies all recent **CLSI** and **EUCAST** clinical and veterinary breakpoints for MICs, disk zones and ECOFFs
|
||||
* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class
|
||||
* Integrates with **WHONET**, ATC, **EARS-Net**, PubChem, **LOINC**, **SNOMED CT**, and **NCBI**
|
||||
* 100% free of costs and dependencies, highly suitable for places with **limited resources**
|
||||
|
||||
This is the development source of the `AMR` package for R. Not a developer? Then please visit our website [https://msberends.github.io/AMR/](https://msberends.github.io/AMR/) to read more about this package.
|
||||
----
|
||||
|
||||
*NOTE: this source code is on GitHub (https://github.com/msberends/AMR), but also automatically mirrored to our university's Gitea server (https://git.web.rug.nl/P281424/AMR) and to GitLab (https://gitlab.com/msberends/AMR).*
|
||||
Please visit our extensive website [https://msberends.github.io/AMR/](https://msberends.github.io/AMR/) to read more about this package, including many examples and tutorials.
|
||||
|
||||
### How to get this package
|
||||
Please see [our website](https://msberends.github.io/AMR/#get-this-package).
|
||||
|
||||
You can install or update the `AMR` package from CRAN using:
|
||||
To install the latest 'release' version from CRAN:
|
||||
|
||||
```r
|
||||
install.packages("AMR")
|
||||
```
|
||||
|
||||
It will be downloaded and installed automatically. For RStudio, click on the menu *Tools* > *Install Packages...* and then type in "AMR" and press <kbd>Install</kbd>.
|
||||
To install the latest 'beta' version from GitHub:
|
||||
|
||||
```r
|
||||
remotes::install_github("msberends/AMR")
|
||||
```
|
||||
|
||||
----
|
||||
|
||||
|
||||
+56
-58
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -32,24 +32,21 @@ url: "https://msberends.github.io/AMR/"
|
||||
|
||||
template:
|
||||
bootstrap: 5
|
||||
includes: # support for mathematical formulas, from https://github.com/r-lib/pkgdown/issues/2704#issuecomment-2307055568
|
||||
in_header: |
|
||||
<link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/katex@0.16.11/dist/katex.min.css" integrity="sha384-nB0miv6/jRmo5UMMR1wu3Gz6NLsoTkbqJghGIsx//Rlm+ZU03BU6SQNC66uf4l5+" crossorigin="anonymous">
|
||||
<script defer src="https://cdn.jsdelivr.net/npm/katex@0.16.11/dist/katex.min.js" integrity="sha384-7zkQWkzuo3B5mTepMUcHkMB5jZaolc2xDwL6VFqjFALcbeS9Ggm/Yr2r3Dy4lfFg" crossorigin="anonymous"></script>
|
||||
<script defer src="https://cdn.jsdelivr.net/npm/katex@0.16.11/dist/contrib/auto-render.min.js" integrity="sha384-43gviWU0YVjaDtb/GhzOouOXtZMP/7XUzwPTstBeZFe/+rCMvRwr4yROQP43s0Xk" crossorigin="anonymous" onload="renderMathInElement(document.body);"></script>
|
||||
bootswatch: "flatly"
|
||||
assets: "pkgdown/logos" # use logos in this folder
|
||||
bslib:
|
||||
base_font: {google: "Lato"}
|
||||
heading_font: {google: "Lato"}
|
||||
code_font: {google: "Fira Code"}
|
||||
# body-text-align: "justify"
|
||||
line-height-base: 1.75
|
||||
# the green "success" colour of this bootstrap theme should be the same as the green in our logo
|
||||
success: "#128f76"
|
||||
link-color: "#128f76"
|
||||
light: "#128f76a6" # this is success with 60% alpha
|
||||
# the template "info" is blue - this should be a green fitting our theme
|
||||
info: "#60a799"
|
||||
# make top bar a bit wider
|
||||
navbar-padding-y: "0.5rem"
|
||||
opengraph:
|
||||
twitter:
|
||||
creator: "@msberends"
|
||||
card: summary_large_image
|
||||
|
||||
news:
|
||||
one_page: true
|
||||
@@ -61,18 +58,15 @@ footer:
|
||||
right: [logo]
|
||||
components:
|
||||
devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU General Public License version 2.0 (GPL-2)</a>.<br>Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in The Netherlands.'
|
||||
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/logos/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/logos/logo_umcg.svg" style="max-width: 150px;"></a>'
|
||||
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/assets/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/assets/logo_umcg.svg" style="max-width: 150px;"></a>'
|
||||
|
||||
home:
|
||||
sidebar:
|
||||
structure: [toc, links, authors]
|
||||
structure: [toc, authors]
|
||||
|
||||
navbar:
|
||||
title: "AMR (for R)"
|
||||
left:
|
||||
# - text: "Home"
|
||||
# icon: "fa-home"
|
||||
# href: "index.html"
|
||||
- text: "How to"
|
||||
icon: "fa-question-circle"
|
||||
menu:
|
||||
@@ -88,6 +82,9 @@ navbar:
|
||||
- text: "Download Data Sets for Own Use"
|
||||
icon: "fa-database"
|
||||
href: "articles/datasets.html"
|
||||
- text: "Use AMR for Predictive Modelling (tidymodels)"
|
||||
icon: "fa-square-root-variable"
|
||||
href: "articles/AMR_with_tidymodels.html"
|
||||
- text: "Set User- Or Team-specific Package Settings"
|
||||
icon: "fa-gear"
|
||||
href: "reference/AMR-options.html"
|
||||
@@ -100,9 +97,6 @@ navbar:
|
||||
- text: "Work with WHONET Data"
|
||||
icon: "fa-globe-americas"
|
||||
href: "articles/WHONET.html"
|
||||
# - text: "Import Data From SPSS/SAS/Stata"
|
||||
# icon: "fa-file-upload"
|
||||
# href: "articles/SPSS.html"
|
||||
- text: "Apply Eucast Rules"
|
||||
icon: "fa-exchange-alt"
|
||||
href: "articles/EUCAST.html"
|
||||
@@ -115,33 +109,25 @@ navbar:
|
||||
- text: "Get Properties of an Antiviral Drug"
|
||||
icon: "fa-capsules"
|
||||
href: "reference/av_property.html" # reference instead of an article
|
||||
- text: "With other pkgs"
|
||||
icon: "fa-layer-group"
|
||||
menu:
|
||||
- text: "AMR & dplyr/tidyverse"
|
||||
icon: "fa-layer-group"
|
||||
href: "articles/other_pkg.html"
|
||||
- text: "AMR & data.table"
|
||||
icon: "fa-layer-group"
|
||||
href: "articles/other_pkg.html"
|
||||
- text: "AMR & tidymodels"
|
||||
icon: "fa-layer-group"
|
||||
href: "articles/other_pkg.html"
|
||||
- text: "AMR & base R"
|
||||
icon: "fa-layer-group"
|
||||
href: "articles/other_pkg.html"
|
||||
- text: "AMR for Python"
|
||||
icon: "fab fa-python"
|
||||
href: "articles/AMR_for_Python.html"
|
||||
- text: "Manual"
|
||||
icon: "fa-book-open"
|
||||
href: "reference/index.html"
|
||||
- text: "Authors"
|
||||
icon: "fa-users"
|
||||
href: "authors.html"
|
||||
right:
|
||||
- text: "Changelog"
|
||||
icon: "far fa-newspaper"
|
||||
structure:
|
||||
right: [search, amrchangelog, amrgit]
|
||||
components:
|
||||
amrchangelog:
|
||||
text: "Changelog"
|
||||
icon: "fa-newspaper"
|
||||
href: "news/index.html"
|
||||
- text: "Source Code"
|
||||
icon: "fab fa-github"
|
||||
amrgit:
|
||||
text: "Source Code"
|
||||
icon: "fa-github"
|
||||
href: "https://github.com/msberends/AMR"
|
||||
|
||||
reference:
|
||||
@@ -156,16 +142,16 @@ reference:
|
||||
These functions are meant to get taxonomically valid properties of microorganisms from any input, but
|
||||
also properties derived from taxonomy, such as the Gram stain (`mo_gramstain()`) , or `mo_is_yeast()`.
|
||||
Use `mo_source()` to teach this package how to translate your own codes to valid microorganisms, and
|
||||
use `add_custom_microorganisms() to add your own custom microorganisms to this package.
|
||||
use `add_custom_microorganisms()` to add your own custom microorganisms to this package.
|
||||
contents:
|
||||
- "`as.mo`"
|
||||
- "`mo_property`"
|
||||
- "`add_custom_microorganisms`"
|
||||
- "`mo_source`"
|
||||
|
||||
- title: "Preparing data: antibiotics"
|
||||
- title: "Preparing data: antimicrobials"
|
||||
desc: >
|
||||
Use these functions to get valid properties of antibiotics from any input or to clean your input.
|
||||
Use these functions to get valid properties of antimicrobials from any input or to clean your input.
|
||||
You can even retrieve drug names and doses from clinical text records, using `ab_from_text()`.
|
||||
contents:
|
||||
- "`as.ab`"
|
||||
@@ -174,7 +160,7 @@ reference:
|
||||
- "`atc_online_property`"
|
||||
- "`add_custom_antimicrobials`"
|
||||
|
||||
- title: "Preparing data: antimicrobial resistance"
|
||||
- title: "Preparing data: antimicrobial results"
|
||||
desc: >
|
||||
With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values.
|
||||
Use `as.sir()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as SIR based on the lastest EUCAST and CLSI guidelines.
|
||||
@@ -186,13 +172,14 @@ reference:
|
||||
- "`eucast_rules`"
|
||||
- "`custom_eucast_rules`"
|
||||
|
||||
- title: "Analysing data: antimicrobial resistance"
|
||||
- title: "Analysing data"
|
||||
desc: >
|
||||
Use these function for the analysis part. You can use `susceptibility()` or `resistance()` on any antibiotic column.
|
||||
With `antibiogram()`, you can generate a traditional, combined, syndromic, or weighted-incidence syndromic combination
|
||||
antibiogram(WISCA). This function also comes with support for R Markdown and Quarto.
|
||||
antibiogram (WISCA). This function also comes with support for R Markdown and Quarto.
|
||||
Be sure to first select the isolates that are appropiate for analysis, by using `first_isolate()` or `is_new_episode()`.
|
||||
You can also filter your data on certain resistance in certain antibiotic classes (`carbapenems()`, `aminoglycosides()`), or determine multi-drug resistant microorganisms (MDRO, `mdro()`).
|
||||
You can also filter your data on certain resistance in certain antibiotic classes (`carbapenems()`, `aminoglycosides()`),
|
||||
or determine multi-drug resistant microorganisms (MDRO, `mdro()`).
|
||||
contents:
|
||||
- "`antibiogram`"
|
||||
- "`proportion`"
|
||||
@@ -201,16 +188,27 @@ reference:
|
||||
- "`first_isolate`"
|
||||
- "`key_antimicrobials`"
|
||||
- "`mdro`"
|
||||
- "`count`"
|
||||
- "`plot`"
|
||||
- "`ggplot_sir`"
|
||||
- "`bug_drug_combinations`"
|
||||
- "`antibiotic_class_selectors`"
|
||||
- "`antimicrobial_selectors`"
|
||||
- "`top_n_microorganisms`"
|
||||
- "`mean_amr_distance`"
|
||||
- "`resistance_predict`"
|
||||
- "`guess_ab_col`"
|
||||
|
||||
- title: "Other: AMR-specific options"
|
||||
- title: "Plotting data"
|
||||
desc: >
|
||||
Use these functions for the plotting part. The `scale_*_mic()` functions extend the ggplot2 package to allow plotting of
|
||||
MIC values, even within a manually set range.
|
||||
If using `plot()` (base R) or `autoplot()` (ggplot2) on MIC values or disk diffusion values, the user can
|
||||
set the interpretation guideline to give the bars the right SIR colours.
|
||||
The `ggplot_sir()` function is a short wrapper for users not much accustomed to ggplot2 yet.
|
||||
The `ggplot_pca()` function is a specific function to plot so-called biplots for PCA (principal component analysis).
|
||||
contents:
|
||||
- "`plot`"
|
||||
- "`ggplot_sir`"
|
||||
- "`ggplot_pca`"
|
||||
|
||||
- title: "AMR-specific options"
|
||||
desc: >
|
||||
The AMR package is customisable, by providing settings that can be set per user or per team. For
|
||||
example, the default interpretation guideline can be changed from EUCAST to CLSI, or a supported
|
||||
@@ -235,16 +233,16 @@ reference:
|
||||
Some pages about our package and its external sources. Be sure to read our [How To's](./../articles/index.html)
|
||||
for more information about how to work with functions in this package.
|
||||
contents:
|
||||
- "`example_isolates`"
|
||||
- "`microorganisms`"
|
||||
- "`antimicrobials`"
|
||||
- "`clinical_breakpoints`"
|
||||
- "`example_isolates`"
|
||||
- "`microorganisms.codes`"
|
||||
- "`microorganisms.groups`"
|
||||
- "`antibiotics`"
|
||||
- "`intrinsic_resistant`"
|
||||
- "`dosage`"
|
||||
- "`WHOCC`"
|
||||
- "`example_isolates_unclean`"
|
||||
- "`clinical_breakpoints`"
|
||||
- "`WHONET`"
|
||||
|
||||
- title: "Other: miscellaneous functions"
|
||||
@@ -255,9 +253,9 @@ reference:
|
||||
contents:
|
||||
- "`age_groups`"
|
||||
- "`age`"
|
||||
- "`export_ncbi_biosample`"
|
||||
- "`availability`"
|
||||
- "`get_AMR_locale`"
|
||||
- "`ggplot_pca`"
|
||||
- "`italicise_taxonomy`"
|
||||
- "`join`"
|
||||
- "`like`"
|
||||
@@ -276,7 +274,7 @@ reference:
|
||||
- title: "Other: deprecated functions"
|
||||
desc: >
|
||||
These functions are deprecated, meaning that they will still
|
||||
work but show a warning with every use and will be removed
|
||||
work but show a warning that they will be removed
|
||||
in a future version.
|
||||
contents:
|
||||
- "`AMR-deprecated`"
|
||||
|
||||
+3
-3
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
+1
-5
@@ -1,9 +1,5 @@
|
||||
**On the 15th of October, 2023, we received an email from Prof Ripley about an issue in UTF-8 strings in our documentation. This version contains a fix to this issue.**
|
||||
|
||||
Previous comments:
|
||||
|
||||
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.
|
||||
|
||||
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 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 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.
|
||||
|
||||
Thanks for maintaining and hosting CRAN! It's empowering R and its use enormously!
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 578 KiB |
@@ -0,0 +1,3 @@
|
||||
green grass #a7dbc3
|
||||
green bacteria #128F76
|
||||
blue sky #a8d5ef
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -0,0 +1,69 @@
|
||||
---
|
||||
title: "AMR Goes Vet"
|
||||
author: "Jason, Matthew, Javier, Matthijs"
|
||||
date: "2024-02-20"
|
||||
format:
|
||||
html:
|
||||
embed-resources: true
|
||||
---
|
||||
|
||||
## Import WHONET data set
|
||||
|
||||
```{r, message=FALSE, warning=FALSE}
|
||||
library(dplyr)
|
||||
library(readr)
|
||||
library(tidyr)
|
||||
|
||||
# WHONET version of 16th Feb 2024
|
||||
whonet_breakpoints <- read_tsv("WHONET/Resources/Breakpoints.txt", na = c("", "NA", "-"),
|
||||
show_col_types = FALSE, guess_max = Inf) %>%
|
||||
filter(GUIDELINES %in% c("CLSI", "EUCAST"))
|
||||
|
||||
dim(whonet_breakpoints)
|
||||
```
|
||||
|
||||
# EDA of Animal Breakpoints
|
||||
|
||||
```{r}
|
||||
whonet_breakpoints |>
|
||||
filter(BREAKPOINT_TYPE != "Human")
|
||||
whonet_breakpoints |>
|
||||
filter(BREAKPOINT_TYPE != "Human") |>
|
||||
count(BREAKPOINT_TYPE)
|
||||
whonet_breakpoints |>
|
||||
filter(BREAKPOINT_TYPE == "Animal")
|
||||
```
|
||||
|
||||
### Count of all animal breakpoints
|
||||
|
||||
```{r}
|
||||
whonet_breakpoints |>
|
||||
filter(BREAKPOINT_TYPE == "Animal") |>
|
||||
count(YEAR, HOST, REFERENCE_TABLE = gsub("VET[0-9]+ ", "", REFERENCE_TABLE)) |>
|
||||
pivot_wider(names_from = YEAR, values_from = n, values_fill = list(n = 0)) |>
|
||||
arrange(HOST, REFERENCE_TABLE)
|
||||
```
|
||||
|
||||
### Cats only
|
||||
|
||||
```{r}
|
||||
whonet_breakpoints |>
|
||||
filter(HOST == "Cats", YEAR >= 2021) |>
|
||||
select(GUIDELINES, YEAR, TEST_METHOD, ORGANISM_CODE, R, S) |>
|
||||
mutate(MO_NAME = AMR::mo_shortname(ORGANISM_CODE), .before = R) |>
|
||||
as.data.frame()
|
||||
```
|
||||
|
||||
### Site of infection in cats (2023)
|
||||
|
||||
```{r}
|
||||
whonet_breakpoints |>
|
||||
filter(HOST == "Cats", YEAR == 2023) |>
|
||||
mutate(MO = AMR::mo_shortname(ORGANISM_CODE),
|
||||
AB = AMR::ab_name(WHONET_ABX_CODE),
|
||||
SITE_OF_INFECTION = substr(SITE_OF_INFECTION, 1, 25)) |>
|
||||
arrange(MO, AB) |>
|
||||
select(MO, AB, SITE_OF_INFECTION) |>
|
||||
as.data.frame()
|
||||
```
|
||||
|
||||
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
|
After Width: | Height: | Size: 330 KiB |
Binary file not shown.
Binary file not shown.
BIN
Binary file not shown.
@@ -0,0 +1,81 @@
|
||||
#!/bin/bash
|
||||
|
||||
# Check if the current directory is named 'AMR'
|
||||
if [ "$(basename "$PWD")" != "AMR" ]; then
|
||||
echo "Error: The script must be run from the 'AMR' directory."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
rm -rf data-raw/gpt_training_text_v*
|
||||
|
||||
# Define the output file, located in ./data-raw
|
||||
version="$1"
|
||||
output_file="data-raw/gpt_training_text_v${version}.txt"
|
||||
|
||||
# Clear the output file if it exists
|
||||
echo "This knowledge base contains all context you must know about the AMR package for R. You are a GPT trained to be an assistant for the AMR package in R. You are an incredible R specialist, especially trained in this package and in the tidyverse." > "$output_file"
|
||||
echo "" >> "$output_file"
|
||||
echo "First and foremost, you are trained on version ${version}. Remember this whenever someone asks which AMR package version you’re at." >> "$output_file"
|
||||
echo "" >> "$output_file"
|
||||
echo "Below are the contents of the NAMESPACE file, the index.md file, and all the man/*.Rd files (documentation) in the package. Every file content is split using 100 hypens." >> "$output_file"
|
||||
echo "----------------------------------------------------------------------------------------------------" >> "$output_file"
|
||||
echo "" >> "$output_file"
|
||||
|
||||
# Function to remove header block (delimited by # ======)
|
||||
remove_header() {
|
||||
sed '/# =\{6,\}/,/# =\{6,\}/d' "$1"
|
||||
}
|
||||
|
||||
# # Process all .R files in the 'R' folder
|
||||
# for file in R/*.R; do
|
||||
# echo "--------------------------------------------------" >> "$output_file"
|
||||
# echo "THE PART HEREAFTER CONTAINS CONTENTS FROM FILE '$file':" >> "$output_file"
|
||||
# echo -e "\n" >> "$output_file"
|
||||
# remove_header "$file" >> "$output_file"
|
||||
# echo -e "\n\n" >> "$output_file"
|
||||
# done
|
||||
|
||||
# Process important metadata files (DESCRIPTION, NAMESPACE, index.md)
|
||||
for file in NAMESPACE index.md; do
|
||||
if [[ -f $file ]]; then
|
||||
echo "----------------------------------------------------------------------------------------------------" >> "$output_file"
|
||||
echo "THE PART HEREAFTER CONTAINS CONTENTS FROM FILE '$file':" >> "$output_file"
|
||||
echo -e "\n" >> "$output_file"
|
||||
cat "$file" >> "$output_file"
|
||||
echo -e "\n\n" >> "$output_file"
|
||||
fi
|
||||
done
|
||||
|
||||
# Process all .Rd files from the 'man' folder
|
||||
for file in man/*.Rd; do
|
||||
echo "----------------------------------------------------------------------------------------------------" >> "$output_file"
|
||||
echo "THE PART HEREAFTER CONTAINS CONTENTS FROM FILE '$file':" >> "$output_file"
|
||||
echo -e "\n" >> "$output_file"
|
||||
remove_header "$file" >> "$output_file"
|
||||
echo -e "\n\n" >> "$output_file"
|
||||
done
|
||||
|
||||
# Process all .Rmd files in the 'vignettes' folder
|
||||
for file in vignettes/*.Rmd; do
|
||||
echo "----------------------------------------------------------------------------------------------------" >> "$output_file"
|
||||
echo "THE PART HEREAFTER CONTAINS CONTENTS FROM FILE '$file':" >> "$output_file"
|
||||
echo -e "\n" >> "$output_file"
|
||||
remove_header "$file" >> "$output_file"
|
||||
echo -e "\n\n" >> "$output_file"
|
||||
done
|
||||
|
||||
# Process README.md
|
||||
# echo "THE PART HEREAFTER CONTAINS THE README OF OUR PYTHON PACKAGE" >> "$output_file"
|
||||
# echo -e "\n" >> "$output_file"
|
||||
# for file in PythonPackage/AMR/README.md; do
|
||||
# remove_header "$file" >> "$output_file"
|
||||
# echo -e "\n\n" >> "$output_file"
|
||||
# done
|
||||
|
||||
# Process test files (if available) in the 'tests' folder
|
||||
# for file in tests/*.R; do
|
||||
# echo "THE PART HEREAFTER CONTAINS CONTENTS FROM FILE '$file':" >> "$output_file"
|
||||
# echo -e "\n" >> "$output_file"
|
||||
# remove_header "$file" >> "$output_file"
|
||||
# echo -e "\n\n" >> "$output_file"
|
||||
# done
|
||||
@@ -0,0 +1,310 @@
|
||||
#!/bin/bash
|
||||
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
# Clean up
|
||||
rm -rf ../PythonPackage/AMR/*
|
||||
mkdir -p ../PythonPackage/AMR/AMR
|
||||
|
||||
# Output Python file
|
||||
setup_file="../PythonPackage/AMR/setup.py"
|
||||
functions_file="../PythonPackage/AMR/AMR/functions.py"
|
||||
datasets_file="../PythonPackage/AMR/AMR/datasets.py"
|
||||
init_file="../PythonPackage/AMR/AMR/__init__.py"
|
||||
description_file="../DESCRIPTION"
|
||||
|
||||
# Write header to the datasets Python file, including the convert_to_python function
|
||||
cat <<EOL > "$datasets_file"
|
||||
import os
|
||||
import sys
|
||||
from rpy2 import robjects
|
||||
from rpy2.robjects import pandas2ri
|
||||
from rpy2.robjects.packages import importr, isinstalled
|
||||
import pandas as pd
|
||||
import importlib.metadata as metadata
|
||||
|
||||
# Get the path to the virtual environment
|
||||
venv_path = sys.prefix
|
||||
|
||||
# Define R library path within the venv
|
||||
r_lib_path = os.path.join(venv_path, "R_libs")
|
||||
# Ensure the R library path exists
|
||||
os.makedirs(r_lib_path, exist_ok=True)
|
||||
|
||||
# Import base and utils
|
||||
base = importr('base')
|
||||
utils = importr('utils')
|
||||
|
||||
base.options(warn = -1)
|
||||
|
||||
# Override R library paths globally for the session
|
||||
robjects.r(f'.Library.site <- "{r_lib_path}"') # Replace site-specific library
|
||||
base._libPaths(r_lib_path) # Override .libPaths() as well
|
||||
|
||||
# Get the effective library path
|
||||
r_amr_lib_path = base._libPaths()[0]
|
||||
|
||||
# Check if the AMR package is installed in R
|
||||
if not isinstalled('AMR', lib_loc=r_amr_lib_path):
|
||||
print(f"AMR: Installing latest AMR R package to {r_amr_lib_path}...", flush=True)
|
||||
utils.install_packages('AMR', repos='https://msberends.r-universe.dev', quiet=True)
|
||||
|
||||
# Python package version of AMR
|
||||
try:
|
||||
python_amr_version = metadata.version('AMR')
|
||||
except metadata.PackageNotFoundError:
|
||||
python_amr_version = ''
|
||||
|
||||
# R package version of AMR
|
||||
r_amr_version = robjects.r(f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')[0]
|
||||
|
||||
# Compare R and Python package versions
|
||||
if r_amr_version != python_amr_version:
|
||||
try:
|
||||
print(f"AMR: Updating AMR package in {r_amr_lib_path}...", flush=True)
|
||||
utils.install_packages('AMR', repos='https://msberends.r-universe.dev', quiet=True)
|
||||
except Exception as e:
|
||||
print(f"AMR: Could not update: {e}", flush=True)
|
||||
|
||||
print(f"AMR: Setting up R environment and AMR datasets...", flush=True)
|
||||
|
||||
# Activate the automatic conversion between R and pandas DataFrames
|
||||
pandas2ri.activate()
|
||||
|
||||
# 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)]'))
|
||||
|
||||
base.options(warn = 0)
|
||||
|
||||
print(f"AMR: Done.", flush=True)
|
||||
EOL
|
||||
|
||||
echo "from .datasets import example_isolates" >> $init_file
|
||||
echo "from .datasets import microorganisms" >> $init_file
|
||||
echo "from .datasets import antimicrobials" >> $init_file
|
||||
echo "from .datasets import clinical_breakpoints" >> $init_file
|
||||
|
||||
|
||||
# Write header to the functions Python file, including the convert_to_python function
|
||||
cat <<EOL > "$functions_file"
|
||||
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
|
||||
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')
|
||||
|
||||
def convert_to_python(r_output):
|
||||
# Check if it's a StrVector (R character vector)
|
||||
if isinstance(r_output, StrVector):
|
||||
return list(r_output) # Convert to a Python list of strings
|
||||
|
||||
# Check if it's a FactorVector (R factor)
|
||||
elif isinstance(r_output, FactorVector):
|
||||
return list(r_output) # Convert to a list of integers (factor levels)
|
||||
|
||||
# Check if it's an IntVector or FloatVector (numeric R vectors)
|
||||
elif isinstance(r_output, (IntVector, FloatVector)):
|
||||
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):
|
||||
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_):
|
||||
return r_output.tolist() # Convert to a regular Python list
|
||||
|
||||
# Fall-back
|
||||
return r_output
|
||||
EOL
|
||||
|
||||
# Directory where the .Rd files are stored (update path as needed)
|
||||
rd_dir="../man"
|
||||
|
||||
# Iterate through each .Rd file in the man directory
|
||||
for rd_file in "$rd_dir"/*.Rd; do
|
||||
# Extract function names and their arguments from the .Rd files
|
||||
awk '
|
||||
BEGIN {
|
||||
usage_started = 0
|
||||
}
|
||||
|
||||
# Detect the start of the \usage block
|
||||
/^\\usage\{/ {
|
||||
usage_started = 1
|
||||
}
|
||||
|
||||
# Detect the end of the \usage block
|
||||
usage_started && /^\}/ {
|
||||
usage_started = 0
|
||||
}
|
||||
|
||||
# Process lines within the \usage block that look like function calls
|
||||
usage_started && /^[a-zA-Z_]+/ {
|
||||
func_line = $0
|
||||
func_line_py = $0
|
||||
|
||||
# Extract the function name (up to the first parenthesis)
|
||||
sub(/\(.*/, "", func_line)
|
||||
func_name = func_line
|
||||
func_name_py = func_name
|
||||
|
||||
# Replace dots with underscores in Python function names
|
||||
gsub(/\./, "_", func_name_py)
|
||||
|
||||
# Extract the arguments (inside the parentheses)
|
||||
sub(/^[^(]+\(/, "", $0)
|
||||
sub(/\).*/, "", $0)
|
||||
func_args = $0
|
||||
|
||||
# Count the number of arguments
|
||||
arg_count = split(func_args, arg_array, ",")
|
||||
|
||||
# Handle "..." arguments (convert them to *args, **kwargs in Python)
|
||||
gsub("\\.\\.\\.", "*args, **kwargs", func_args)
|
||||
|
||||
# Remove default values from arguments
|
||||
gsub(/ = [^,]+/, "", func_args)
|
||||
|
||||
# If no arguments, skip the function (dont print it)
|
||||
if (arg_count == 0) {
|
||||
func_args = "*args, **kwargs"
|
||||
}
|
||||
|
||||
# If more than 1 argument, replace the 2nd to nth arguments with *args, **kwargs
|
||||
if (arg_count > 1) {
|
||||
first_arg = arg_array[1]
|
||||
func_args = first_arg ", *args, **kwargs"
|
||||
}
|
||||
if (arg_array[1] == "...") {
|
||||
func_args = "*args, **kwargs"
|
||||
}
|
||||
|
||||
# Skip functions where func_name_py is identical to func_args
|
||||
if (func_name_py == func_args) {
|
||||
next
|
||||
}
|
||||
|
||||
# Skip functions matching the regex pattern
|
||||
if (func_name_py ~ /^(x |facet|scale|set|get|NA_|microorganisms|antimicrobials|clinical_breakpoints|example_isolates)/) {
|
||||
next
|
||||
}
|
||||
|
||||
# Replace TRUE/FALSE/NULL
|
||||
gsub("TRUE", "True", func_args)
|
||||
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 " \"\"\"See our website of the R package for the manual: https://msberends.github.io/AMR/index.html\"\"\"" >> "'"$functions_file"'"
|
||||
print " return convert_to_python(amr_r." func_name_py "(" func_args "))" >> "'"$functions_file"'"
|
||||
|
||||
print "from .functions import " func_name_py >> "'"$init_file"'"
|
||||
}
|
||||
' "$rd_file"
|
||||
done
|
||||
|
||||
# Output completion message
|
||||
echo "Python wrapper functions generated in $functions_file."
|
||||
echo "Python wrapper functions listed in $init_file."
|
||||
|
||||
cp ../vignettes/AMR_for_Python.Rmd ../PythonPackage/AMR/README.md
|
||||
sed -i '1,/^# Introduction$/d' ../PythonPackage/AMR/README.md
|
||||
echo "README copied"
|
||||
|
||||
# Extract the relevant fields from DESCRIPTION
|
||||
version=$(grep "^Version:" "$description_file" | awk '{print $2}')
|
||||
|
||||
# Write the setup.py file
|
||||
cat <<EOL > "$setup_file"
|
||||
from setuptools import setup, find_packages
|
||||
|
||||
setup(
|
||||
name='AMR',
|
||||
version='$version',
|
||||
packages=find_packages(),
|
||||
install_requires=[
|
||||
'rpy2',
|
||||
'numpy',
|
||||
'pandas',
|
||||
],
|
||||
author='Matthijs Berends',
|
||||
author_email='m.s.berends@umcg.nl',
|
||||
description='A Python wrapper for the AMR R package',
|
||||
long_description=open('README.md').read(),
|
||||
long_description_content_type='text/markdown',
|
||||
url='https://github.com/msberends/AMR',
|
||||
project_urls={
|
||||
'Bug Tracker': 'https://github.com/msberends/AMR/issues',
|
||||
},
|
||||
license='GPL 2',
|
||||
classifiers=[
|
||||
'Programming Language :: Python :: 3',
|
||||
'Operating System :: OS Independent',
|
||||
],
|
||||
python_requires='>=3.6',
|
||||
)
|
||||
EOL
|
||||
|
||||
# Output completion message
|
||||
echo "setup.py has been generated in $setup_file."
|
||||
|
||||
cd ../PythonPackage/AMR
|
||||
pip3 install build
|
||||
python3 -m build
|
||||
# python3 setup.py sdist bdist_wheel
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
|
||||
@@ -6,9 +6,9 @@
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
|
||||
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
|
||||
# Data. Journal of Statistical Software, 104(3), 1-31. #
|
||||
# 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 #
|
||||
@@ -28,7 +28,7 @@
|
||||
# ==================================================================== #
|
||||
|
||||
# Run this file to update the package using:
|
||||
# source("data-raw/_pre_commit_hook.R")
|
||||
# source("data-raw/_pre_commit_checks.R")
|
||||
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
try(detach("package:data.table", unload = TRUE), silent = TRUE) # to prevent like() to precede over AMR::like
|
||||
@@ -36,12 +36,14 @@ devtools::load_all(quiet = TRUE)
|
||||
|
||||
suppressMessages(set_AMR_locale("English"))
|
||||
|
||||
old_globalenv <- ls(envir = globalenv())
|
||||
pre_commit_lst <- list()
|
||||
|
||||
# Save internal data to R/sysdata.rda -------------------------------------
|
||||
|
||||
usethis::ui_info(paste0("Updating internal package data"))
|
||||
|
||||
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
|
||||
EUCAST_RULES_DF <- utils::read.delim(
|
||||
pre_commit_lst$EUCAST_RULES_DF <- utils::read.delim(
|
||||
file = "data-raw/eucast_rules.tsv",
|
||||
skip = 9,
|
||||
sep = "\t",
|
||||
@@ -67,7 +69,7 @@ EUCAST_RULES_DF <- utils::read.delim(
|
||||
mutate(reference.rule_group = as.character(reference.rule_group)) %>%
|
||||
select(-sorting_rule)
|
||||
|
||||
TRANSLATIONS <- utils::read.delim(
|
||||
pre_commit_lst$TRANSLATIONS <- utils::read.delim(
|
||||
file = "data-raw/translations.tsv",
|
||||
sep = "\t",
|
||||
stringsAsFactors = FALSE,
|
||||
@@ -82,15 +84,15 @@ TRANSLATIONS <- utils::read.delim(
|
||||
quote = ""
|
||||
)
|
||||
|
||||
LANGUAGES_SUPPORTED_NAMES <- c(
|
||||
pre_commit_lst$LANGUAGES_SUPPORTED_NAMES <- c(
|
||||
list(en = list(exonym = "English", endonym = "English")),
|
||||
lapply(
|
||||
TRANSLATIONS[, which(nchar(colnames(TRANSLATIONS)) == 2), drop = FALSE],
|
||||
TRANSLATIONS[, which(nchar(colnames(pre_commit_lst$TRANSLATIONS)) == 2), drop = FALSE],
|
||||
function(x) list(exonym = x[1], endonym = x[2])
|
||||
)
|
||||
)
|
||||
|
||||
LANGUAGES_SUPPORTED <- names(LANGUAGES_SUPPORTED_NAMES)
|
||||
pre_commit_lst$LANGUAGES_SUPPORTED <- names(pre_commit_lst$LANGUAGES_SUPPORTED_NAMES)
|
||||
|
||||
# vectors of CoNS and CoPS, improves speed in as.mo()
|
||||
create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
@@ -99,7 +101,7 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
# - Becker et al. 2019, PMID 30872103
|
||||
# - Becker et al. 2020, PMID 32056452
|
||||
# this function returns class <mo>
|
||||
MO_staph <- AMR::microorganisms
|
||||
MO_staph <- microorganisms
|
||||
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
|
||||
if (type == "CoNS") {
|
||||
MO_staph[
|
||||
@@ -120,7 +122,8 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
"vitulinus", "vitulus", "warneri", "xylosus",
|
||||
"caledonicus", "canis",
|
||||
"durrellii", "lloydii",
|
||||
"ratti", "taiwanensis", "veratri", "urealyticus"
|
||||
"ratti", "taiwanensis", "veratri", "urealyticus",
|
||||
"americanisciuri", "marylandisciuri", "shinii", "brunensis"
|
||||
) |
|
||||
# old, now renamed to S. schleiferi (but still as synonym in our data of course):
|
||||
(MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
|
||||
@@ -147,188 +150,332 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||
]
|
||||
}
|
||||
}
|
||||
MO_CONS <- create_species_cons_cops("CoNS")
|
||||
MO_COPS <- create_species_cons_cops("CoPS")
|
||||
MO_STREP_ABCG <- AMR::microorganisms$mo[which(AMR::microorganisms$genus == "Streptococcus" &
|
||||
tolower(AMR::microorganisms$species) %in% c(
|
||||
pre_commit_lst$MO_CONS <- create_species_cons_cops("CoNS")
|
||||
pre_commit_lst$MO_COPS <- create_species_cons_cops("CoPS")
|
||||
pre_commit_lst$MO_STREP_ABCG <- microorganisms$mo[which(microorganisms$genus == "Streptococcus" &
|
||||
tolower(microorganisms$species) %in% c(
|
||||
"pyogenes", "agalactiae", "dysgalactiae", "equi", "canis",
|
||||
"group a", "group b", "group c", "group g"
|
||||
))]
|
||||
MO_LANCEFIELD <- AMR::microorganisms$mo[which(AMR::microorganisms$mo %like% "^(B_STRPT_PYGN(_|$)|B_STRPT_AGLC(_|$)|B_STRPT_(DYSG|EQUI)(_|$)|B_STRPT_ANGN(_|$)|B_STRPT_(DYSG|CANS)(_|$)|B_STRPT_SNGN(_|$)|B_STRPT_SLVR(_|$))")]
|
||||
MO_PREVALENT_GENERA <- c(
|
||||
"Absidia", "Acanthamoeba", "Acremonium", "Aedes", "Alternaria", "Amoeba", "Ancylostoma", "Angiostrongylus",
|
||||
"Anisakis", "Anopheles", "Apophysomyces", "Aspergillus", "Aureobasidium", "Basidiobolus", "Beauveria",
|
||||
"Blastocystis", "Blastomyces", "Candida", "Capillaria", "Chaetomium", "Chrysonilia", "Cladophialophora",
|
||||
"Cladosporium", "Conidiobolus", "Contracaecum", "Cordylobia", "Cryptococcus", "Curvularia", "Demodex",
|
||||
"Dermatobia", "Dientamoeba", "Diphyllobothrium", "Dirofilaria", "Echinostoma", "Entamoeba", "Enterobius",
|
||||
"Exophiala", "Exserohilum", "Fasciola", "Fonsecaea", "Fusarium", "Giardia", "Haloarcula", "Halobacterium",
|
||||
"Halococcus", "Hendersonula", "Heterophyes", "Histomonas", "Histoplasma", "Hymenolepis", "Hypomyces",
|
||||
"Hysterothylacium", "Leishmania", "Malassezia", "Malbranchea", "Metagonimus", "Meyerozyma", "Microsporidium",
|
||||
"Microsporum", "Mortierella", "Mucor", "Mycocentrospora", "Necator", "Nectria", "Ochroconis", "Oesophagostomum",
|
||||
"Oidiodendron", "Opisthorchis", "Pediculus", "Penicillium", "Phlebotomus", "Phoma", "Pichia", "Piedraia", "Pithomyces",
|
||||
"Pityrosporum", "Pneumocystis", "Pseudallescheria", "Pseudoterranova", "Pulex", "Rhizomucor", "Rhizopus",
|
||||
"Rhodotorula", "Saccharomyces", "Sarcoptes", "Scolecobasidium", "Scopulariopsis", "Scytalidium", "Spirometra",
|
||||
"Sporobolomyces", "Stachybotrys", "Strongyloides", "Syngamus", "Taenia", "Talaromyces", "Toxocara", "Trichinella",
|
||||
"Trichobilharzia", "Trichoderma", "Trichomonas", "Trichophyton", "Trichosporon", "Trichostrongylus", "Trichuris",
|
||||
"Tritirachium", "Trombicula", "Trypanosoma", "Tunga", "Wuchereria"
|
||||
pre_commit_lst$MO_LANCEFIELD <- microorganisms$mo[which(microorganisms$mo %like% "^(B_STRPT_PYGN(_|$)|B_STRPT_AGLC(_|$)|B_STRPT_(DYSG|EQUI)(_|$)|B_STRPT_ANGN(_|$)|B_STRPT_(DYSG|CANS)(_|$)|B_STRPT_SNGN(_|$)|B_STRPT_SLVR(_|$))")]
|
||||
pre_commit_lst$MO_WHO_PRIORITY_GENERA <- c(
|
||||
# World Health Organization's (WHO) Priority Pathogen List (some are from the group Enterobacteriaceae)
|
||||
"Acinetobacter",
|
||||
"Aspergillus",
|
||||
"Blastomyces",
|
||||
"Campylobacter",
|
||||
"Candida",
|
||||
"Citrobacter",
|
||||
"Clostridioides",
|
||||
"Coccidioides",
|
||||
"Cryptococcus",
|
||||
"Edwardsiella",
|
||||
"Enterobacter",
|
||||
"Enterococcus",
|
||||
"Escherichia",
|
||||
"Fusarium",
|
||||
"Haemophilus",
|
||||
"Helicobacter",
|
||||
"Histoplasma",
|
||||
"Klebsiella",
|
||||
"Morganella",
|
||||
"Mycobacterium",
|
||||
"Neisseria",
|
||||
"Paracoccidioides",
|
||||
"Pneumocystis",
|
||||
"Proteus",
|
||||
"Providencia",
|
||||
"Pseudomonas",
|
||||
"Salmonella",
|
||||
"Serratia",
|
||||
"Shigella",
|
||||
"Staphylococcus",
|
||||
"Streptococcus",
|
||||
"Yersinia"
|
||||
)
|
||||
pre_commit_lst$MO_RELEVANT_GENERA <- c(
|
||||
"Absidia",
|
||||
"Acanthamoeba",
|
||||
"Acremonium",
|
||||
"Actinomucor",
|
||||
"Aedes",
|
||||
"Alternaria",
|
||||
"Amoeba",
|
||||
"Ancylostoma",
|
||||
"Angiostrongylus",
|
||||
"Anisakis",
|
||||
"Anopheles",
|
||||
"Apophysomyces",
|
||||
"Arthroderma",
|
||||
"Aspergillus",
|
||||
"Aureobasidium",
|
||||
"Basidiobolus",
|
||||
"Beauveria",
|
||||
"Bipolaris",
|
||||
"Blastobotrys",
|
||||
"Blastocystis",
|
||||
"Blastomyces",
|
||||
"Candida",
|
||||
"Capillaria",
|
||||
"Chaetomium",
|
||||
"Chilomastix",
|
||||
"Chrysonilia",
|
||||
"Chrysosporium",
|
||||
"Cladophialophora",
|
||||
"Cladosporium",
|
||||
"Clavispora",
|
||||
"Coccidioides",
|
||||
"Cokeromyces",
|
||||
"Conidiobolus",
|
||||
"Coniochaeta",
|
||||
"Contracaecum",
|
||||
"Cordylobia",
|
||||
"Cryptococcus",
|
||||
"Cryptosporidium",
|
||||
"Cunninghamella",
|
||||
"Curvularia",
|
||||
"Cyberlindnera",
|
||||
"Debaryozyma",
|
||||
"Demodex",
|
||||
"Dermatobia",
|
||||
"Dientamoeba",
|
||||
"Diphyllobothrium",
|
||||
"Dirofilaria",
|
||||
"Echinostoma",
|
||||
"Entamoeba",
|
||||
"Enterobius",
|
||||
"Epidermophyton",
|
||||
"Exidia",
|
||||
"Exophiala",
|
||||
"Exserohilum",
|
||||
"Fasciola",
|
||||
"Fonsecaea",
|
||||
"Fusarium",
|
||||
"Geotrichum",
|
||||
"Giardia",
|
||||
"Graphium",
|
||||
"Haloarcula",
|
||||
"Halobacterium",
|
||||
"Halococcus",
|
||||
"Hansenula",
|
||||
"Hendersonula",
|
||||
"Heterophyes",
|
||||
"Histomonas",
|
||||
"Histoplasma",
|
||||
"Hortaea",
|
||||
"Hymenolepis",
|
||||
"Hypomyces",
|
||||
"Hysterothylacium",
|
||||
"Kloeckera",
|
||||
"Kluyveromyces",
|
||||
"Kodamaea",
|
||||
"Lacazia",
|
||||
"Leishmania",
|
||||
"Lichtheimia",
|
||||
"Lodderomyces",
|
||||
"Lomentospora",
|
||||
"Madurella",
|
||||
"Malassezia",
|
||||
"Malbranchea",
|
||||
"Metagonimus",
|
||||
"Meyerozyma",
|
||||
"Microsporidium",
|
||||
"Microsporum",
|
||||
"Millerozyma",
|
||||
"Mortierella",
|
||||
"Mucor",
|
||||
"Mycocentrospora",
|
||||
"Nannizzia",
|
||||
"Necator",
|
||||
"Nectria",
|
||||
"Ochroconis",
|
||||
"Oesophagostomum",
|
||||
"Oidiodendron",
|
||||
"Opisthorchis",
|
||||
"Paecilomyces",
|
||||
"Paracoccidioides",
|
||||
"Pediculus",
|
||||
"Penicillium",
|
||||
"Phaeoacremonium",
|
||||
"Phaeomoniella",
|
||||
"Phialophora",
|
||||
"Phlebotomus",
|
||||
"Phoma",
|
||||
"Pichia",
|
||||
"Piedraia",
|
||||
"Pithomyces",
|
||||
"Pityrosporum",
|
||||
"Pneumocystis",
|
||||
"Pseudallescheria",
|
||||
"Pseudoscopulariopsis",
|
||||
"Pseudoterranova",
|
||||
"Pulex",
|
||||
"Purpureocillium",
|
||||
"Quambalaria",
|
||||
"Rhinocladiella",
|
||||
"Rhizomucor",
|
||||
"Rhizopus",
|
||||
"Rhodotorula",
|
||||
"Saccharomyces",
|
||||
"Saksenaea",
|
||||
"Saprochaete",
|
||||
"Sarcoptes",
|
||||
"Scedosporium",
|
||||
"Schistosoma",
|
||||
"Schizosaccharomyces",
|
||||
"Scolecobasidium",
|
||||
"Scopulariopsis",
|
||||
"Scytalidium",
|
||||
"Spirometra",
|
||||
"Sporobolomyces",
|
||||
"Sporopachydermia",
|
||||
"Sporothrix",
|
||||
"Sporotrichum",
|
||||
"Stachybotrys",
|
||||
"Strongyloides",
|
||||
"Syncephalastrum",
|
||||
"Syngamus",
|
||||
"Taenia",
|
||||
"Talaromyces",
|
||||
"Teleomorph",
|
||||
"Toxocara",
|
||||
"Trichinella",
|
||||
"Trichobilharzia",
|
||||
"Trichoderma",
|
||||
"Trichomonas",
|
||||
"Trichophyton",
|
||||
"Trichosporon",
|
||||
"Trichostrongylus",
|
||||
"Trichuris",
|
||||
"Tritirachium",
|
||||
"Trombicula",
|
||||
"Trypanosoma",
|
||||
"Tunga",
|
||||
"Ulocladium",
|
||||
"Ustilago",
|
||||
"Verticillium",
|
||||
"Wallemia",
|
||||
"Wangiella",
|
||||
"Wickerhamomyces",
|
||||
"Wuchereria",
|
||||
"Yarrowia",
|
||||
"Zygosaccharomyces"
|
||||
)
|
||||
|
||||
# antibiotic groups
|
||||
# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv)
|
||||
globalenv_before_ab <- c(ls(envir = globalenv()), "globalenv_before_ab")
|
||||
AB_AMINOGLYCOSIDES <- antibiotics %>%
|
||||
pre_commit_lst$AB_AMINOGLYCOSIDES <- antimicrobials %>%
|
||||
filter(group %like% "aminoglycoside") %>%
|
||||
pull(ab)
|
||||
AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
|
||||
AB_ANTIFUNGALS <- AMR_env$AB_lookup %>%
|
||||
pre_commit_lst$AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
|
||||
pre_commit_lst$AB_ANTIFUNGALS <- antimicrobials %>%
|
||||
filter(group %like% "antifungal") %>%
|
||||
pull(ab)
|
||||
AB_ANTIMYCOBACTERIALS <- AMR_env$AB_lookup %>%
|
||||
pre_commit_lst$AB_ANTIMYCOBACTERIALS <- antimicrobials %>%
|
||||
filter(group %like% "antimycobacterial") %>%
|
||||
pull(ab)
|
||||
AB_CARBAPENEMS <- antibiotics %>%
|
||||
pre_commit_lst$AB_CARBAPENEMS <- antimicrobials %>%
|
||||
filter(group %like% "carbapenem") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_1ST <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_1ST <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin.*1") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_2ND <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_2ND <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin.*2") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_3RD <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_3RD <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin.*3") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_4TH <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_4TH <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin.*4") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_5TH <- antibiotics %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_5TH <- antimicrobials %>%
|
||||
filter(group %like% "cephalosporin.*5") %>%
|
||||
pull(ab)
|
||||
AB_CEPHALOSPORINS_EXCEPT_CAZ <- AB_CEPHALOSPORINS[AB_CEPHALOSPORINS != "CAZ"]
|
||||
AB_FLUOROQUINOLONES <- antibiotics %>%
|
||||
filter(atc_group2 %like% "fluoroquinolone" | (group %like% "quinolone" & is.na(atc_group2))) %>%
|
||||
pre_commit_lst$AB_CEPHALOSPORINS_EXCEPT_CAZ <- pre_commit_lst$AB_CEPHALOSPORINS[pre_commit_lst$AB_CEPHALOSPORINS != "CAZ"]
|
||||
pre_commit_lst$AB_FLUOROQUINOLONES <- antimicrobials %>%
|
||||
# see DOI 10.23937/2378-3656/1410369, more specifically this table: https://www.clinmedjournals.org/articles/cmrcr/cmrcr-8-369-table1.html
|
||||
filter((group %like% "quinolone" | atc_group1 %like% "quinolone" | atc_group2 %like% "quinolone") & name %unlike% " acid|nalidixic|cinoxacin|flumequine|oxolinic|piromidic|pipemidic|rosoxacin") %>%
|
||||
pull(ab)
|
||||
AB_GLYCOPEPTIDES <- antibiotics %>%
|
||||
pre_commit_lst$AB_GLYCOPEPTIDES <- antimicrobials %>%
|
||||
filter(group %like% "glycopeptide") %>%
|
||||
pull(ab)
|
||||
AB_LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela
|
||||
AB_GLYCOPEPTIDES_EXCEPT_LIPO <- AB_GLYCOPEPTIDES[!AB_GLYCOPEPTIDES %in% AB_LIPOGLYCOPEPTIDES]
|
||||
AB_LINCOSAMIDES <- antibiotics %>%
|
||||
filter(atc_group2 %like% "lincosamide" | (group %like% "lincosamide" & is.na(atc_group2))) %>%
|
||||
pre_commit_lst$AB_ISOXAZOLYLPENICILLINS <- antimicrobials %>%
|
||||
filter(name %like% "oxacillin|cloxacillin|dicloxacillin|flucloxacillin|meth?icillin") %>%
|
||||
pull(ab)
|
||||
AB_MACROLIDES <- antibiotics %>%
|
||||
filter(atc_group2 %like% "macrolide" | (group %like% "macrolide" & is.na(atc_group2))) %>%
|
||||
pre_commit_lst$AB_LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela
|
||||
pre_commit_lst$AB_GLYCOPEPTIDES_EXCEPT_LIPO <- pre_commit_lst$AB_GLYCOPEPTIDES[!pre_commit_lst$AB_GLYCOPEPTIDES %in% pre_commit_lst$AB_LIPOGLYCOPEPTIDES]
|
||||
pre_commit_lst$AB_LINCOSAMIDES <- antimicrobials %>%
|
||||
filter(atc_group2 %like% "lincosamide" | (group %like% "lincosamide" & is.na(atc_group2) & name %like% "^(pirlimycin)" & name %unlike% "screening|inducible")) %>%
|
||||
pull(ab)
|
||||
AB_OXAZOLIDINONES <- antibiotics %>%
|
||||
pre_commit_lst$AB_MACROLIDES <- antimicrobials %>%
|
||||
filter(atc_group2 %like% "macrolide" | (group %like% "macrolide" & is.na(atc_group2) & name %like% "^(acetylmidecamycin|acetylspiramycin|gamith?romycin|kitasamycin|meleumycin|nafith?romycin|solith?romycin|tildipirosin|tilmicosin|tulath?romycin|tylosin|tylvalosin)" & name %unlike% "screening|inducible")) %>%
|
||||
pull(ab)
|
||||
pre_commit_lst$AB_MONOBACTAMS <- antimicrobials %>%
|
||||
filter(group %like% "monobactam") %>%
|
||||
pull(ab)
|
||||
pre_commit_lst$AB_NITROFURANS <- antimicrobials %>%
|
||||
filter(name %like% "^furaz|nitrofura" | atc_group2 %like% "nitrofuran") %>%
|
||||
pull(ab)
|
||||
pre_commit_lst$AB_OXAZOLIDINONES <- antimicrobials %>%
|
||||
filter(group %like% "oxazolidinone") %>%
|
||||
pull(ab)
|
||||
AB_PENICILLINS <- antibiotics %>%
|
||||
filter(group %like% "penicillin") %>%
|
||||
pre_commit_lst$AB_PENICILLINS <- antimicrobials %>%
|
||||
filter(group %like% "penicillin" & !(name %unlike% "/" & name %like% ".*bactam$")) %>%
|
||||
pull(ab)
|
||||
AB_POLYMYXINS <- antibiotics %>%
|
||||
pre_commit_lst$AB_PHENICOLS <- antimicrobials %>%
|
||||
filter(group %like% "phenicol" | atc_group1 %like% "phenicol" | atc_group2 %like% "phenicol") %>%
|
||||
pull(ab)
|
||||
pre_commit_lst$AB_POLYMYXINS <- antimicrobials %>%
|
||||
filter(group %like% "polymyxin") %>%
|
||||
pull(ab)
|
||||
AB_QUINOLONES <- antibiotics %>%
|
||||
filter(group %like% "quinolone") %>%
|
||||
pre_commit_lst$AB_QUINOLONES <- antimicrobials %>%
|
||||
filter(group %like% "quinolone" | atc_group1 %like% "quinolone" | atc_group2 %like% "quinolone") %>%
|
||||
pull(ab)
|
||||
AB_STREPTOGRAMINS <- antibiotics %>%
|
||||
pre_commit_lst$AB_RIFAMYCINS <- antimicrobials %>%
|
||||
filter(name %like% "Rifampi|Rifabutin|Rifapentine|rifamy") %>%
|
||||
pull(ab)
|
||||
pre_commit_lst$AB_STREPTOGRAMINS <- antimicrobials %>%
|
||||
filter(atc_group2 %like% "streptogramin") %>%
|
||||
pull(ab)
|
||||
AB_TETRACYCLINES <- antibiotics %>%
|
||||
pre_commit_lst$AB_TETRACYCLINES <- antimicrobials %>%
|
||||
filter(group %like% "tetracycline") %>%
|
||||
pull(ab)
|
||||
AB_TETRACYCLINES_EXCEPT_TGC <- AB_TETRACYCLINES[AB_TETRACYCLINES != "TGC"]
|
||||
AB_TRIMETHOPRIMS <- antibiotics %>%
|
||||
pre_commit_lst$AB_TETRACYCLINES_EXCEPT_TGC <- pre_commit_lst$AB_TETRACYCLINES[pre_commit_lst$AB_TETRACYCLINES != "TGC"]
|
||||
pre_commit_lst$AB_TRIMETHOPRIMS <- antimicrobials %>%
|
||||
filter(group %like% "trimethoprim") %>%
|
||||
pull(ab)
|
||||
AB_UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ"))
|
||||
AB_BETALACTAMS <- c(AB_PENICILLINS, AB_CEPHALOSPORINS, AB_CARBAPENEMS)
|
||||
pre_commit_lst$AB_UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ"))
|
||||
pre_commit_lst$AB_BETALACTAMS <- sort(c(pre_commit_lst$AB_PENICILLINS, pre_commit_lst$AB_CEPHALOSPORINS, pre_commit_lst$AB_CARBAPENEMS, pre_commit_lst$AB_MONOBACTAMS))
|
||||
pre_commit_lst$AB_BETALACTAMS_WITH_INHIBITOR <- antimicrobials %>%
|
||||
filter(name %like% "/" & name %unlike% "EDTA" & ab %in% pre_commit_lst$AB_BETALACTAMS) %>%
|
||||
pull(ab)
|
||||
# this will be used for documentation:
|
||||
DEFINED_AB_GROUPS <- ls(envir = globalenv())
|
||||
DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab]
|
||||
create_AB_AV_lookup <- function(df) {
|
||||
new_df <- df
|
||||
new_df$generalised_name <- generalise_antibiotic_name(new_df$name)
|
||||
new_df$generalised_synonyms <- lapply(new_df$synonyms, generalise_antibiotic_name)
|
||||
if ("abbreviations" %in% colnames(df)) {
|
||||
new_df$generalised_abbreviations <- lapply(new_df$abbreviations, generalise_antibiotic_name)
|
||||
}
|
||||
new_df$generalised_loinc <- lapply(new_df$loinc, generalise_antibiotic_name)
|
||||
new_df$generalised_all <- unname(lapply(
|
||||
as.list(as.data.frame(
|
||||
t(new_df[,
|
||||
c(
|
||||
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
||||
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
||||
),
|
||||
drop = FALSE
|
||||
]),
|
||||
stringsAsFactors = FALSE
|
||||
)),
|
||||
function(x) {
|
||||
x <- generalise_antibiotic_name(unname(unlist(x)))
|
||||
x[x != ""]
|
||||
}
|
||||
))
|
||||
new_df[, colnames(new_df)[colnames(new_df) %like% "^generalised"]]
|
||||
}
|
||||
AB_LOOKUP <- create_AB_AV_lookup(AMR::antibiotics)
|
||||
AV_LOOKUP <- create_AB_AV_lookup(AMR::antivirals)
|
||||
pre_commit_lst$DEFINED_AB_GROUPS <- sort(names(pre_commit_lst)[names(pre_commit_lst) %like% "^AB_" & names(pre_commit_lst) != "AB_LOOKUP"])
|
||||
|
||||
pre_commit_lst$AB_LOOKUP <- create_AB_AV_lookup(antimicrobials)
|
||||
pre_commit_lst$AV_LOOKUP <- create_AB_AV_lookup(antivirals)
|
||||
|
||||
# Export to package as internal data ----
|
||||
usethis::ui_info(paste0("Updating internal package data"))
|
||||
suppressMessages(usethis::use_data(EUCAST_RULES_DF,
|
||||
TRANSLATIONS,
|
||||
LANGUAGES_SUPPORTED_NAMES,
|
||||
LANGUAGES_SUPPORTED,
|
||||
MO_CONS,
|
||||
MO_COPS,
|
||||
MO_STREP_ABCG,
|
||||
MO_LANCEFIELD,
|
||||
MO_PREVALENT_GENERA,
|
||||
AB_LOOKUP,
|
||||
AV_LOOKUP,
|
||||
AB_AMINOGLYCOSIDES,
|
||||
AB_AMINOPENICILLINS,
|
||||
AB_ANTIFUNGALS,
|
||||
AB_ANTIMYCOBACTERIALS,
|
||||
AB_CARBAPENEMS,
|
||||
AB_CEPHALOSPORINS,
|
||||
AB_CEPHALOSPORINS_1ST,
|
||||
AB_CEPHALOSPORINS_2ND,
|
||||
AB_CEPHALOSPORINS_3RD,
|
||||
AB_CEPHALOSPORINS_4TH,
|
||||
AB_CEPHALOSPORINS_5TH,
|
||||
AB_CEPHALOSPORINS_EXCEPT_CAZ,
|
||||
AB_FLUOROQUINOLONES,
|
||||
AB_LIPOGLYCOPEPTIDES,
|
||||
AB_GLYCOPEPTIDES,
|
||||
AB_GLYCOPEPTIDES_EXCEPT_LIPO,
|
||||
AB_LINCOSAMIDES,
|
||||
AB_MACROLIDES,
|
||||
AB_OXAZOLIDINONES,
|
||||
AB_PENICILLINS,
|
||||
AB_POLYMYXINS,
|
||||
AB_QUINOLONES,
|
||||
AB_STREPTOGRAMINS,
|
||||
AB_TETRACYCLINES,
|
||||
AB_TETRACYCLINES_EXCEPT_TGC,
|
||||
AB_TRIMETHOPRIMS,
|
||||
AB_UREIDOPENICILLINS,
|
||||
AB_BETALACTAMS,
|
||||
DEFINED_AB_GROUPS,
|
||||
internal = TRUE,
|
||||
overwrite = TRUE,
|
||||
version = 2,
|
||||
compress = "xz"
|
||||
))
|
||||
# usethis::use_data() must receive unquoted object names, which is not flexible at all.
|
||||
# we'll use good old base::save() instead
|
||||
save(list = names(pre_commit_lst),
|
||||
file = "R/sysdata.rda",
|
||||
envir = as.environment(pre_commit_lst),
|
||||
compress = "xz",
|
||||
version = 2,
|
||||
ascii = FALSE)
|
||||
usethis::ui_done("Saved to {usethis::ui_value('R/sysdata.rda')}")
|
||||
|
||||
|
||||
|
||||
|
||||
# Export data sets to the repository in different formats -----------------
|
||||
|
||||
for (pkg in c("haven", "openxlsx", "arrow")) {
|
||||
for (pkg in c("haven", "openxlsx2", "arrow")) {
|
||||
if (!pkg %in% rownames(utils::installed.packages())) {
|
||||
message("NOTE: package '", pkg, "' not installed! Ignoring export where this package is required.")
|
||||
}
|
||||
@@ -346,9 +493,11 @@ write_md5 <- function(object) {
|
||||
close(conn)
|
||||
}
|
||||
changed_md5 <- function(object) {
|
||||
path <- paste0("data-raw/", deparse(substitute(object)), ".md5")
|
||||
if (!file.exists(path)) return(TRUE)
|
||||
tryCatch(
|
||||
{
|
||||
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
|
||||
conn <- file(path)
|
||||
compared <- md5(object) != readLines(con = conn)
|
||||
close(conn)
|
||||
compared
|
||||
@@ -359,17 +508,16 @@ changed_md5 <- function(object) {
|
||||
|
||||
# give official names to ABs and MOs
|
||||
clin_break <- clinical_breakpoints %>%
|
||||
mutate(mo_name = mo_name(mo, language = NULL, keep_synonyms = TRUE, info = FALSE), .after = mo) %>%
|
||||
mutate(ab_name = ab_name(ab, language = NULL), .after = ab)
|
||||
mutate(mo_name = microorganisms$fullname[match(mo, microorganisms$mo)], .after = mo) %>%
|
||||
mutate(ab_name = antimicrobials$name[match(ab, antimicrobials$ab)], .after = ab)
|
||||
if (changed_md5(clin_break)) {
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('clinical_breakpoints')} to {usethis::ui_value('data-raw/')}"))
|
||||
write_md5(clin_break)
|
||||
try(saveRDS(clin_break, "data-raw/clinical_breakpoints.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(clinical_breakpoints, "data-raw/clinical_breakpoints.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_xpt(clin_break, "data-raw/clinical_breakpoints.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(clin_break, "data-raw/clinical_breakpoints.sav"), silent = TRUE)
|
||||
try(haven::write_dta(clin_break, "data-raw/clinical_breakpoints.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(clin_break, "data-raw/clinical_breakpoints.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(clin_break, "data-raw/clinical_breakpoints.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(clin_break, "data-raw/clinical_breakpoints.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(clin_break, "data-raw/clinical_breakpoints.parquet"), silent = TRUE)
|
||||
}
|
||||
@@ -382,12 +530,11 @@ if (changed_md5(microorganisms)) {
|
||||
mo <- microorganisms
|
||||
mo$snomed <- max_50_snomed
|
||||
mo <- dplyr::mutate_if(mo, ~ !is.numeric(.), as.character)
|
||||
try(haven::write_xpt(mo, "data-raw/microorganisms.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE)
|
||||
try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE)
|
||||
mo_all_snomed <- microorganisms %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
|
||||
try(write.table(mo_all_snomed, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(mo_all_snomed, "data-raw/microorganisms.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(mo_all_snomed, "data-raw/microorganisms.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(microorganisms, "data-raw/microorganisms.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(microorganisms, "data-raw/microorganisms.parquet"), silent = TRUE)
|
||||
}
|
||||
@@ -397,10 +544,9 @@ if (changed_md5(microorganisms.codes)) {
|
||||
write_md5(microorganisms.codes)
|
||||
try(saveRDS(microorganisms.codes, "data-raw/microorganisms.codes.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(microorganisms.codes, "data-raw/microorganisms.codes.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_xpt(microorganisms.codes, "data-raw/microorganisms.codes.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(microorganisms.codes, "data-raw/microorganisms.codes.sav"), silent = TRUE)
|
||||
try(haven::write_dta(microorganisms.codes, "data-raw/microorganisms.codes.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(microorganisms.codes, "data-raw/microorganisms.codes.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(microorganisms.codes, "data-raw/microorganisms.codes.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(microorganisms.codes, "data-raw/microorganisms.codes.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(microorganisms.codes, "data-raw/microorganisms.codes.parquet"), silent = TRUE)
|
||||
}
|
||||
@@ -410,27 +556,25 @@ if (changed_md5(microorganisms.groups)) {
|
||||
write_md5(microorganisms.groups)
|
||||
try(saveRDS(microorganisms.groups, "data-raw/microorganisms.groups.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(microorganisms.groups, "data-raw/microorganisms.groups.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_xpt(microorganisms.groups, "data-raw/microorganisms.groups.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(microorganisms.groups, "data-raw/microorganisms.groups.sav"), silent = TRUE)
|
||||
try(haven::write_dta(microorganisms.groups, "data-raw/microorganisms.groups.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(microorganisms.groups, "data-raw/microorganisms.groups.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(microorganisms.groups, "data-raw/microorganisms.groups.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(microorganisms.groups, "data-raw/microorganisms.groups.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(microorganisms.groups, "data-raw/microorganisms.groups.parquet"), silent = TRUE)
|
||||
}
|
||||
|
||||
ab <- dplyr::mutate_if(antibiotics, ~ !is.numeric(.), as.character)
|
||||
ab <- dplyr::mutate_if(antimicrobials, ~ !is.numeric(.), as.character)
|
||||
if (changed_md5(ab)) {
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('antibiotics')} to {usethis::ui_value('data-raw/')}"))
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('antimicrobials')} to {usethis::ui_value('data-raw/')}"))
|
||||
write_md5(ab)
|
||||
try(saveRDS(antibiotics, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(haven::write_xpt(ab, "data-raw/antibiotics.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
|
||||
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
|
||||
ab_lists <- antibiotics %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
|
||||
try(write.table(ab_lists, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(ab_lists, "data-raw/antibiotics.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(antibiotics, "data-raw/antibiotics.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(antibiotics, "data-raw/antibiotics.parquet"), silent = TRUE)
|
||||
try(saveRDS(antimicrobials, "data-raw/antimicrobials.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(haven::write_sav(ab, "data-raw/antimicrobials.sav"), silent = TRUE)
|
||||
try(haven::write_dta(ab, "data-raw/antimicrobials.dta"), silent = TRUE)
|
||||
ab_lists <- antimicrobials %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
|
||||
try(write.table(ab_lists, "data-raw/antimicrobials.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(ab_lists, "data-raw/antimicrobials.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(antimicrobials, "data-raw/antimicrobials.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(antimicrobials, "data-raw/antimicrobials.parquet"), silent = TRUE)
|
||||
}
|
||||
|
||||
av <- dplyr::mutate_if(antivirals, ~ !is.numeric(.), as.character)
|
||||
@@ -438,12 +582,11 @@ if (changed_md5(av)) {
|
||||
usethis::ui_info(paste0("Saving {usethis::ui_value('antivirals')} to {usethis::ui_value('data-raw/')}"))
|
||||
write_md5(av)
|
||||
try(saveRDS(antivirals, "data-raw/antivirals.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(haven::write_xpt(av, "data-raw/antivirals.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
|
||||
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
|
||||
av_lists <- antivirals %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
|
||||
try(write.table(av_lists, "data-raw/antivirals.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(av_lists, "data-raw/antivirals.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(av_lists, "data-raw/antivirals.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(antivirals, "data-raw/antivirals.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(antivirals, "data-raw/antivirals.parquet"), silent = TRUE)
|
||||
}
|
||||
@@ -459,10 +602,9 @@ if (changed_md5(intrinsicR)) {
|
||||
write_md5(intrinsicR)
|
||||
try(saveRDS(intrinsicR, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(intrinsicR, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_xpt(intrinsicR, "data-raw/intrinsic_resistant.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(intrinsicR, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
|
||||
try(haven::write_dta(intrinsicR, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(intrinsicR, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(intrinsicR, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(intrinsicR, "data-raw/intrinsic_resistant.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(intrinsicR, "data-raw/intrinsic_resistant.parquet"), silent = TRUE)
|
||||
}
|
||||
@@ -472,46 +614,43 @@ if (changed_md5(dosage)) {
|
||||
write_md5(dosage)
|
||||
try(saveRDS(dosage, "data-raw/dosage.rds", version = 2, compress = "xz"), silent = TRUE)
|
||||
try(write.table(dosage, "data-raw/dosage.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
|
||||
try(haven::write_xpt(dosage, "data-raw/dosage.xpt"), silent = TRUE)
|
||||
try(haven::write_sav(dosage, "data-raw/dosage.sav"), silent = TRUE)
|
||||
try(haven::write_dta(dosage, "data-raw/dosage.dta"), silent = TRUE)
|
||||
try(openxlsx::write.xlsx(dosage, "data-raw/dosage.xlsx"), silent = TRUE)
|
||||
try(openxlsx2::write_xlsx(dosage, "data-raw/dosage.xlsx"), silent = TRUE)
|
||||
try(arrow::write_feather(dosage, "data-raw/dosage.feather"), silent = TRUE)
|
||||
try(arrow::write_parquet(dosage, "data-raw/dosage.parquet"), silent = TRUE)
|
||||
}
|
||||
|
||||
suppressMessages(reset_AMR_locale())
|
||||
|
||||
# remove leftovers from global env
|
||||
current_globalenv <- ls(envir = globalenv())
|
||||
rm(list = current_globalenv[!current_globalenv %in% old_globalenv])
|
||||
rm(current_globalenv)
|
||||
|
||||
devtools::load_all(quiet = TRUE)
|
||||
suppressMessages(set_AMR_locale("English"))
|
||||
|
||||
# Update URLs -------------------------------------------------------------
|
||||
usethis::ui_info("Checking URLs for redirects")
|
||||
invisible(capture.output(urlchecker::url_update()))
|
||||
|
||||
|
||||
# Document pkg ------------------------------------------------------------
|
||||
usethis::ui_info("Documenting package")
|
||||
suppressMessages(devtools::document(quiet = TRUE))
|
||||
|
||||
|
||||
# Style pkg ---------------------------------------------------------------
|
||||
if (!"styler" %in% rownames(utils::installed.packages())) {
|
||||
message("Package 'styler' not installed!")
|
||||
} else if (interactive()) {
|
||||
# only when sourcing this file ourselves
|
||||
# usethis::ui_info("Styling package")
|
||||
# styler::style_pkg(
|
||||
# style = styler::tidyverse_style,
|
||||
# filetype = c("R", "Rmd")
|
||||
# )
|
||||
files_changed <- function(paths = "^(R|data)/") {
|
||||
tryCatch({
|
||||
changed_files <- system("git diff --name-only", intern = TRUE)
|
||||
any(changed_files %like% paths)
|
||||
}, error = function(e) TRUE)
|
||||
}
|
||||
|
||||
# Update URLs -------------------------------------------------------------
|
||||
if (files_changed()) {
|
||||
usethis::ui_info("Checking URLs for redirects")
|
||||
invisible(urlchecker::url_update("."))
|
||||
}
|
||||
|
||||
# Style pkg ---------------------------------------------------------------
|
||||
if (files_changed(paths = "^(R|tests)/")) {
|
||||
sethis::ui_info("Styling package")
|
||||
styler::style_pkg(include_roxygen_examples = FALSE,
|
||||
exclude_dirs = list.dirs(full.names = FALSE, recursive = FALSE)[!list.dirs(full.names = FALSE, recursive = FALSE) %in% c("R", "tests")])
|
||||
}
|
||||
|
||||
# Document pkg ------------------------------------------------------------
|
||||
if (files_changed()) {
|
||||
usethis::ui_info("Documenting package")
|
||||
suppressMessages(devtools::document(quiet = TRUE))
|
||||
}
|
||||
|
||||
# Finished ----------------------------------------------------------------
|
||||
usethis::ui_done("All done")
|
||||
+1
-1
@@ -1 +1 @@
|
||||
3d8c509ec95d61889cae83af43b0e6b7
|
||||
69d8a565bed4a1cd564f313e5142ab48
|
||||
|
||||
@@ -1,54 +0,0 @@
|
||||
---
|
||||
title: "Generating antibiograms with the AMR package"
|
||||
author: "AMR package developers"
|
||||
date: "`r Sys.Date()`"
|
||||
output: pdf_document
|
||||
---
|
||||
|
||||
```{r setup, include=FALSE}
|
||||
knitr::opts_chunk$set(echo = TRUE, message = FALSE)
|
||||
library(AMR)
|
||||
```
|
||||
|
||||
This is an example R Markdown file to show the use of `antibiogram()` of the AMR package.
|
||||
|
||||
For starters, this is what our `example_isolates` data set looks like:
|
||||
|
||||
```{r}
|
||||
example_isolates
|
||||
```
|
||||
|
||||
|
||||
### Traditional Antibiogram
|
||||
|
||||
```{r trad}
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()))
|
||||
```
|
||||
|
||||
### Combined Antibiogram
|
||||
|
||||
```{r comb}
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
|
||||
```
|
||||
|
||||
### Syndromic Antibiogram
|
||||
|
||||
```{r synd}
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c(aminoglycosides(), carbapenems()),
|
||||
syndromic_group = "ward")
|
||||
```
|
||||
|
||||
### Weighted-Incidence Syndromic Combination Antibiogram (WISCA)
|
||||
|
||||
```{r wisca}
|
||||
antibiogram(example_isolates,
|
||||
antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
|
||||
mo_transform = "gramstain",
|
||||
minimum = 10, # this should be >= 30, but now just as example
|
||||
syndromic_group = ifelse(example_isolates$age >= 65 &
|
||||
example_isolates$gender == "M",
|
||||
"WISCA Group 1", "WISCA Group 2"))
|
||||
```
|
||||
File diff suppressed because one or more lines are too long
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user