mirror of
https://github.com/msberends/AMR.git
synced 2026-09-15 16:13:30 +02:00
Compare commits
1
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 github-actions[bot]
|
8e522cd988 |
@@ -1,42 +0,0 @@
|
||||
^.*\.RData$
|
||||
^.*\.Rproj$
|
||||
^\.Renviron$
|
||||
^\.Rprofile$
|
||||
^\.Rproj\.user$
|
||||
^\.travis\.yml$
|
||||
^\.zenodo\.json$
|
||||
^_noinclude$
|
||||
^_pkgdown\.yml$
|
||||
^appveyor\.yml$
|
||||
^codecov\.yml$
|
||||
^cran-comments\.md$
|
||||
^CRAN-RELEASE$
|
||||
^\.github$
|
||||
^doc$
|
||||
^docs$
|
||||
^git_.*\.sh$
|
||||
^index\.md$
|
||||
^index\.Rmd$
|
||||
^installed_deps$
|
||||
^Meta$
|
||||
^pkgdown$
|
||||
^public$
|
||||
^data-raw$
|
||||
^\.lintr$
|
||||
^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/PCA\.Rmd$
|
||||
^vignettes/resistance_predict\.Rmd$
|
||||
^vignettes/WHONET\.Rmd$
|
||||
^vignettes/WISCA\.Rmd$
|
||||
^logo.svg$
|
||||
^CRAN-SUBMISSION$
|
||||
^PythonPackage$
|
||||
^README\.Rmd$
|
||||
@@ -1,40 +0,0 @@
|
||||
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
|
||||
|
||||
@@ -1,27 +0,0 @@
|
||||
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
|
||||
@@ -1,11 +0,0 @@
|
||||
blank_issues_enabled: false
|
||||
contact_links:
|
||||
- name: I Have a Question - Ask the AMR for R Assistant
|
||||
url: https://chat.amr-for-r.org
|
||||
about: |
|
||||
Ask questions or code suggestions to our AMR for R Assistant.
|
||||
|
||||
This is a ChatGPT manually-trained model able to answer any question about the AMR package.
|
||||
- name: I Have a Question - Ask the AMR Community
|
||||
url: https://github.com/msberends/AMR/discussions
|
||||
about: You can also ask (and answer) questions here to share with others.
|
||||
@@ -1,65 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# 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
|
||||
@@ -1,117 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# 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_checks.R')"
|
||||
currentpkg=$(Rscript -e "cat(pkgload::pkg_name())")
|
||||
echo "- Adding changed files in ./data-raw and ./man to this commit"
|
||||
git add data-raw/*
|
||||
git add man/*
|
||||
git add R/sysdata.rda
|
||||
git add NAMESPACE
|
||||
else
|
||||
echo "- R package 'pkgload', 'devtools', or 'dplyr' not installed!"
|
||||
currentpkg="your"
|
||||
fi
|
||||
else
|
||||
echo "- R is not available on your system!"
|
||||
currentpkg="your"
|
||||
fi
|
||||
echo ""
|
||||
|
||||
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
echo "Updating semantic versioning and date..."
|
||||
|
||||
# Get tags from remote and remove tags not on remote
|
||||
git fetch origin --prune --prune-tags --quiet
|
||||
currenttagfull=$(git describe --tags --abbrev=0)
|
||||
currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
|
||||
|
||||
# Assume main branch to be 'main' or 'master'
|
||||
defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
|
||||
if [ "$currenttag" = "" ]; then
|
||||
currenttag="0.0.1"
|
||||
currentcommit=$(git rev-list --count ${defaultbranch})
|
||||
echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
else
|
||||
currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
|
||||
echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
|
||||
fi
|
||||
|
||||
# Combine tag and commit number
|
||||
currentversion="$currenttag.$((currentcommit + 9001))"
|
||||
echo "- ${currentpkg} pkg version set to ${currentversion}"
|
||||
|
||||
# Update version number and date in DESCRIPTION
|
||||
sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
|
||||
sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
|
||||
echo "- Updated version number and date in ./DESCRIPTION"
|
||||
rm -f DESCRIPTION--
|
||||
git add DESCRIPTION
|
||||
|
||||
# Update version number in NEWS.md
|
||||
if [ -e "NEWS.md" ]; then
|
||||
if [ "$currentpkg" = "your" ]; then
|
||||
currentpkg=""
|
||||
fi
|
||||
sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
|
||||
echo "- Updated version number in ./NEWS.md"
|
||||
rm -f NEWS.md--
|
||||
git add NEWS.md
|
||||
else
|
||||
echo "- No NEWS.md found!"
|
||||
fi
|
||||
echo ""
|
||||
|
||||
# Save the version number for use in the commit-msg hook
|
||||
echo "${currentversion}" > .git/commit_version.tmp
|
||||
|
||||
git add data-raw/*
|
||||
git add -u
|
||||
|
||||
exit 0
|
||||
@@ -1,96 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
# run in each PR in this repo
|
||||
branches: '**'
|
||||
push:
|
||||
branches: '**'
|
||||
schedule:
|
||||
# also run a schedule everyday at 1 AM.
|
||||
# this is to check that all dependencies are still available (see R/zzz.R)
|
||||
- cron: '0 1 * * *'
|
||||
|
||||
name: check-recent
|
||||
|
||||
jobs:
|
||||
R-code-check:
|
||||
runs-on: ${{ matrix.config.os }}
|
||||
|
||||
continue-on-error: ${{ matrix.config.allowfail }}
|
||||
|
||||
name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})
|
||||
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
config:
|
||||
# current development version, check all major OSes:
|
||||
# - {os: macOS-latest, r: 'devel', allowfail: true}
|
||||
- {os: windows-latest, r: 'devel', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'devel', allowfail: false, http-user-agent: 'release'}
|
||||
|
||||
# current 'release' version, check all major OSes:
|
||||
- {os: macOS-latest, r: 'release', allowfail: true}
|
||||
- {os: windows-latest, r: 'release', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'release', allowfail: false}
|
||||
|
||||
# older versions (see also check-old-tinytest.yaml for even older versions):
|
||||
- {os: ubuntu-latest, r: 'oldrel-1', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-2', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-3', allowfail: false}
|
||||
- {os: ubuntu-latest, r: 'oldrel-4', allowfail: false}
|
||||
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
R_KEEP_PKG_SOURCE: yes
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: ${{ matrix.config.r }}
|
||||
http-user-agent: ${{ matrix.config.http-user-agent }}
|
||||
# use RStudio Package Manager to quickly install packages
|
||||
use-public-rspm: true
|
||||
|
||||
- uses: r-lib/actions/setup-r-dependencies@v2
|
||||
with:
|
||||
extra-packages: any::rcmdcheck
|
||||
needs: check
|
||||
upgrade: 'TRUE'
|
||||
|
||||
- uses: r-lib/actions/check-r-package@v2
|
||||
with:
|
||||
upload-snapshots: true
|
||||
build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
|
||||
@@ -1,127 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
# only run after a git push on any branch in this repo
|
||||
branches: '**'
|
||||
|
||||
name: check-old
|
||||
|
||||
jobs:
|
||||
R-code-check:
|
||||
runs-on: ${{ matrix.config.os }}
|
||||
|
||||
continue-on-error: ${{ matrix.config.allowfail }}
|
||||
|
||||
name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})
|
||||
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
config:
|
||||
# Test all old versions of R >= 3.0, we support them all!
|
||||
# For these old versions, dependencies and vignettes will not be checked.
|
||||
# For recent R versions, see check-recent.yaml (r-lib and tidyverse support the latest 5 major R releases).
|
||||
- {os: ubuntu-latest, r: '3.6', allowfail: false}
|
||||
# - {os: windows-latest, r: '3.5', allowfail: true} # always fails, horrible with UTF-8
|
||||
- {os: ubuntu-latest, r: '3.4', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.3', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.2', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.1', allowfail: false}
|
||||
- {os: ubuntu-latest, r: '3.0', allowfail: false}
|
||||
|
||||
env:
|
||||
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: ${{ matrix.config.r }}
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- name: Install tinytest from CRAN
|
||||
run: |
|
||||
install.packages("tinytest", repos = "https://cran.r-project.org")
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Show session info
|
||||
if: always()
|
||||
run: |
|
||||
options(width = 100)
|
||||
utils::sessionInfo()
|
||||
as.data.frame(utils::installed.packages())[, "Version", drop = FALSE]
|
||||
shell: Rscript {0}
|
||||
|
||||
- name: Remove vignettes
|
||||
if: always() # matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2' || matrix.config.r == '3.3'
|
||||
# writing to DESCRIPTION2 and then moving to DESCRIPTION is required for R <= 3.3 as writeLines() cannot overwrite
|
||||
run: |
|
||||
rm -rf vignettes
|
||||
Rscript -e "writeLines(readLines('DESCRIPTION')[!grepl('VignetteBuilder', readLines('DESCRIPTION'))], 'DESCRIPTION2')"
|
||||
rm DESCRIPTION
|
||||
mv DESCRIPTION2 DESCRIPTION
|
||||
shell: bash
|
||||
|
||||
- name: Run R CMD check with tinytest
|
||||
if: always()
|
||||
env:
|
||||
# see https://rstudio.github.io/r-manuals/r-ints/Tools.html for an overview
|
||||
_R_CHECK_CRAN_INCOMING_: false
|
||||
_R_CHECK_DEPENDS_ONLY_: true
|
||||
_R_CHECK_LENGTH_1_CONDITION_: verbose
|
||||
_R_CHECK_LENGTH_1_LOGIC2_: verbose
|
||||
# no check for old R versions - these packages require higher R versions
|
||||
_R_CHECK_RD_XREFS_: false
|
||||
_R_CHECK_FORCE_SUGGESTS_: false
|
||||
R_CHECK_CONSTANTS: 5
|
||||
R_JIT_STRATEGY: 3
|
||||
# during 'R CMD check', R_LIBS_USER will be overwritten, so:
|
||||
R_LIBS_USER_GH_ACTIONS: ${{ env.R_LIBS_USER }}
|
||||
# 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 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
|
||||
@@ -1,66 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: '**'
|
||||
pull_request:
|
||||
branches: '**'
|
||||
|
||||
name: code-coverage
|
||||
|
||||
jobs:
|
||||
code-coverage:
|
||||
runs-on: ubuntu-latest
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
CODECOV_TOKEN: ${{secrets.CODECOV_TOKEN}}
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: release
|
||||
# use RStudio Package Manager to quickly install packages
|
||||
use-public-rspm: true
|
||||
|
||||
- uses: r-lib/actions/setup-r-dependencies@v2
|
||||
with:
|
||||
extra-packages: any::covr
|
||||
|
||||
- name: Test coverage
|
||||
env:
|
||||
R_LIBS_USER_GH_ACTIONS: ${{ env.R_LIBS_USER }}
|
||||
R_RUN_TINYTEST: true
|
||||
run: |
|
||||
x <- covr::codecov(line_exclusions = list("R/atc_online.R", "R/mo_source.R", "R/translate.R", "R/resistance_predict.R", "R/zz_deprecated.R", "R/aa_helper_functions.R", "R/aa_helper_pm_functions.R", "R/zzz.R"))
|
||||
print(x)
|
||||
shell: Rscript {0}
|
||||
@@ -1,85 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation.
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: '**'
|
||||
pull_request:
|
||||
branches: '**'
|
||||
|
||||
name: lintr
|
||||
|
||||
jobs:
|
||||
lintr:
|
||||
runs-on: ubuntu-latest
|
||||
env:
|
||||
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: release
|
||||
# use RStudio Package Manager to quickly install packages
|
||||
use-public-rspm: true
|
||||
|
||||
- uses: r-lib/actions/setup-r-dependencies@v2
|
||||
with:
|
||||
extra-packages: |
|
||||
any::lintr
|
||||
any::cyclocomp
|
||||
any::roxygen2
|
||||
any::devtools
|
||||
any::usethis
|
||||
|
||||
- name: Remove unneeded folders
|
||||
run: |
|
||||
# do not check these folders
|
||||
rm -rf data-raw
|
||||
rm -rf tests
|
||||
rm -rf vignettes
|
||||
|
||||
- name: Lint
|
||||
run: |
|
||||
# get ALL linters, not just default ones
|
||||
linters <- getNamespaceExports(asNamespace("lintr"))
|
||||
linters <- sort(linters[grepl("_linter$", linters)])
|
||||
# lose deprecated
|
||||
linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator|consecutive_stopifnot|no_tab|single_quotes|unnecessary_nested_if|unneeded_concatenation)_linter$", linters)]
|
||||
linters <- linters[linters != "linter"]
|
||||
# and the ones we find unnnecessary
|
||||
linters <- linters[!grepl("^(commented_code|extraction_operator|implicit_integer|indentation|line_length|namespace|nonportable_path|object_length|object_name|object_usage|is)_linter$", linters)]
|
||||
# put the functions in a list
|
||||
linters_list <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
|
||||
names(linters_list) <- linters
|
||||
# run them all!
|
||||
lintr::lint_package(linters = linters_list, exclusions = list("R/aa_helper_pm_functions.R"))
|
||||
shell: Rscript {0}
|
||||
@@ -1,96 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
# only on main
|
||||
branches: "main"
|
||||
|
||||
name: Publish Python Package to PyPI
|
||||
|
||||
jobs:
|
||||
update-pypi:
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
env:
|
||||
PYPI_PAT: ${{ secrets.PYPI_PAT }}
|
||||
|
||||
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: |
|
||||
find . -mindepth 1 ! -path './PythonPackage*' -exec rm -rf {} +
|
||||
|
||||
mv PythonPackage/AMR/* .
|
||||
rm -rf PythonPackage
|
||||
|
||||
git init
|
||||
git remote add origin https://$PYPI_PAT@github.com/msberends/AMR
|
||||
git checkout --orphan python-wrapper
|
||||
git config user.name "github-actions[bot]"
|
||||
git config user.email "github-actions[bot]@users.noreply.github.com"
|
||||
|
||||
git rm -rf . || true
|
||||
git add .
|
||||
git commit -m "Python wrapper update"
|
||||
git push https://$PYPI_PAT@github.com/msberends/AMR.git python-wrapper --force
|
||||
@@ -1,66 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
on:
|
||||
push:
|
||||
# only on main
|
||||
branches: "main"
|
||||
|
||||
name: Publish GPT Training Data to GitHub
|
||||
|
||||
jobs:
|
||||
update-amr-assistant:
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
env:
|
||||
PYPI_PAT: ${{ secrets.PYPI_PAT }}
|
||||
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Build the training data
|
||||
run: |
|
||||
bash data-raw/_generate_GPT_knowledge_input.sh
|
||||
|
||||
- name: Git push to amr-for-r-assistant repo
|
||||
run: |
|
||||
mkdir ~/other
|
||||
# to also mv hidden files:
|
||||
shopt -s dotglob
|
||||
mv ./* ~/other/
|
||||
git clone https://github.com/msberends/amr-for-r-assistant
|
||||
cd amr-for-r-assistant
|
||||
mv ~/other/data-raw/latest_training_data.txt ./
|
||||
|
||||
git config user.name "github-actions[bot]"
|
||||
git config user.email "github-actions[bot]@users.noreply.github.com"
|
||||
git add latest_training_data.txt
|
||||
git commit -m "GPT training data update"
|
||||
git push https://$PYPI_PAT@github.com/msberends/amr-for-r-assistant.git main --force
|
||||
@@ -1,82 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# Create a website from the R documentation using pkgdown
|
||||
# Git commit and push to the 'gh-pages' branch
|
||||
|
||||
on:
|
||||
push:
|
||||
# only on main
|
||||
branches: 'main'
|
||||
|
||||
name: Update website
|
||||
|
||||
jobs:
|
||||
update-website:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
|
||||
- uses: actions/checkout@v4
|
||||
with:
|
||||
# this is to keep timestamps, the default fetch-depth: 1 gets the timestamps of the moment of cloning
|
||||
# we need this for the download page on our website - dates must be of the files, not of the latest git push
|
||||
fetch-depth: 0
|
||||
|
||||
- name: Preserve timestamps
|
||||
run: |
|
||||
sudo apt install git-restore-mtime
|
||||
git restore-mtime
|
||||
|
||||
- uses: r-lib/actions/setup-pandoc@v2
|
||||
|
||||
- name: Set up R
|
||||
uses: r-lib/actions/setup-r@v2
|
||||
with:
|
||||
r-version: "release"
|
||||
# use RStudio Package Manager (RSPM) to quickly install packages
|
||||
use-public-rspm: true
|
||||
|
||||
- name: Set up R dependencies
|
||||
uses: r-lib/actions/setup-r-dependencies@v2
|
||||
with:
|
||||
# add extra packages for website articles:
|
||||
extra-packages: |
|
||||
any::pkgdown
|
||||
any::tidymodels
|
||||
|
||||
- name: Remove Welcome to AMR vignette
|
||||
run: |
|
||||
rm vignettes/welcome_to_AMR.Rmd
|
||||
|
||||
# Send updates to repo using GH Actions bot
|
||||
- name: Create website in separate branch
|
||||
run: |
|
||||
git config user.name "github-actions"
|
||||
git config user.email "41898282+github-actions[bot]@users.noreply.github.com"
|
||||
Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE, clean = TRUE, install = TRUE, branch = "gh-pages")'
|
||||
-31
@@ -1,31 +0,0 @@
|
||||
Meta
|
||||
doc
|
||||
.Renviron
|
||||
.Rproj.user
|
||||
.Rhistory
|
||||
.RData
|
||||
.Ruserdata
|
||||
tests/testthat/Rplots.pdf
|
||||
inst/doc
|
||||
/src/*.o
|
||||
/src/*.o-*
|
||||
/src/*.d
|
||||
/src/*.so
|
||||
_noinclude
|
||||
index.html
|
||||
README.html
|
||||
*.dll
|
||||
vignettes/*.R
|
||||
.DS_Store
|
||||
.Rprofile
|
||||
^CRAN-RELEASE$
|
||||
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
|
||||
data-raw/taxonomy.csv
|
||||
data-raw/WHONET/*
|
||||
@@ -1,28 +0,0 @@
|
||||
Version: 1.0
|
||||
ProjectId: 5128c748-a412-44db-a5fb-45c68c93dd10
|
||||
|
||||
RestoreWorkspace: No
|
||||
SaveWorkspace: No
|
||||
AlwaysSaveHistory: Yes
|
||||
|
||||
EnableCodeIndexing: Yes
|
||||
UseSpacesForTab: Yes
|
||||
NumSpacesForTab: 2
|
||||
Encoding: UTF-8
|
||||
|
||||
RnwWeave: Sweave
|
||||
LaTeX: pdfLaTeX
|
||||
|
||||
AutoAppendNewline: Yes
|
||||
LineEndingConversion: Posix
|
||||
|
||||
BuildType: Package
|
||||
PackageUseDevtools: Yes
|
||||
PackageInstallArgs: --no-multiarch --with-keep.source
|
||||
PackageBuildArgs: --no-build-vignettes
|
||||
PackageCheckArgs: --no-build-vignettes --as-cran
|
||||
PackageRoxygenize: rd,collate,namespace
|
||||
|
||||
UseNativePipeOperator: No
|
||||
|
||||
SpellingDictionary: en_GB
|
||||
Executable → Regular
+69
-24
@@ -1,28 +1,31 @@
|
||||
---
|
||||
title: "AMR for Python"
|
||||
output:
|
||||
rmarkdown::html_vignette:
|
||||
toc: true
|
||||
toc_depth: 3
|
||||
vignette: >
|
||||
%\VignetteIndexEntry{AMR for Python}
|
||||
%\VignetteEncoding{UTF-8}
|
||||
%\VignetteEngine{knitr::rmarkdown}
|
||||
editor_options:
|
||||
chunk_output_type: console
|
||||
---
|
||||
Metadata-Version: 2.4
|
||||
Name: AMR
|
||||
Version: 3.0.1.9091
|
||||
Summary: A Python wrapper for the AMR R package
|
||||
Home-page: https://github.com/msberends/AMR
|
||||
Author: Matthijs Berends
|
||||
Author-email: m.s.berends@umcg.nl
|
||||
License: GPL 2
|
||||
Project-URL: Bug Tracker, https://github.com/msberends/AMR/issues
|
||||
Classifier: Programming Language :: Python :: 3
|
||||
Classifier: Operating System :: OS Independent
|
||||
Requires-Python: >=3.6
|
||||
Description-Content-Type: text/markdown
|
||||
Requires-Dist: rpy2
|
||||
Requires-Dist: numpy
|
||||
Requires-Dist: pandas
|
||||
Dynamic: author
|
||||
Dynamic: author-email
|
||||
Dynamic: classifier
|
||||
Dynamic: description
|
||||
Dynamic: description-content-type
|
||||
Dynamic: home-page
|
||||
Dynamic: license
|
||||
Dynamic: project-url
|
||||
Dynamic: requires-dist
|
||||
Dynamic: requires-python
|
||||
Dynamic: summary
|
||||
|
||||
```{r setup, include = FALSE, results = 'markup'}
|
||||
knitr::opts_chunk$set(
|
||||
warning = FALSE,
|
||||
collapse = TRUE,
|
||||
comment = "#>",
|
||||
fig.width = 7.5,
|
||||
fig.height = 5
|
||||
)
|
||||
```
|
||||
|
||||
# Introduction
|
||||
|
||||
The `AMR` package for R is a powerful tool for antimicrobial resistance (AMR) analysis. It provides extensive features for handling microbial and antimicrobial data. However, for those who work primarily in Python, we now have a more intuitive option available: the [`AMR` Python package](https://pypi.org/project/AMR/).
|
||||
|
||||
@@ -200,6 +203,48 @@ AMR.antimicrobials
|
||||
| ZFD | NaN | Zoliflodacin | None | NaN | None | NaN | None |
|
||||
|
||||
|
||||
# Installation Channels
|
||||
|
||||
## Stable Release (CRAN)
|
||||
|
||||
The default `AMR` Python package uses the latest stable version of the `AMR` R package, published on CRAN. After running `pip install AMR`, import it as usual:
|
||||
|
||||
```python
|
||||
import AMR
|
||||
|
||||
AMR.example_isolates
|
||||
```
|
||||
|
||||
## Development Version (GitHub)
|
||||
|
||||
To use the latest development version of the `AMR` R package (sourced directly from GitHub), import the `beta` sub-package and alias it as `AMR`:
|
||||
|
||||
```python
|
||||
import AMR.beta as AMR
|
||||
|
||||
AMR.example_isolates
|
||||
```
|
||||
|
||||
Aliasing with `as AMR` keeps all downstream code identical to the stable import. Switching between the stable release and the development version requires changing only the import line — nothing else in your script needs to change.
|
||||
|
||||
# SIR Classification with `as_sir()`
|
||||
|
||||
## Using `enforce_method`
|
||||
|
||||
The `as_sir()` function in R uses S3 method dispatch to select the correct calculation method based on the input class: `<mic>` for MIC values and `<disk>` for disk diffusion values. Because Python objects do not carry R class attributes through the `rpy2` bridge, this automatic dispatch may not resolve correctly.
|
||||
|
||||
To explicitly specify the input type, use the `enforce_method` argument:
|
||||
|
||||
```python
|
||||
# Treat the column as MIC values — maps to R's as.sir.mic()
|
||||
AMR.as_sir(df["MIC_col"], mo="E. coli", ab="AMX", guideline="EUCAST", enforce_method="mic")
|
||||
|
||||
# Treat the column as disk diffusion values — maps to R's as.sir.disk()
|
||||
AMR.as_sir(df["disk_col"], mo="E. coli", ab="AMX", guideline="EUCAST", enforce_method="disk")
|
||||
```
|
||||
|
||||
Without `enforce_method`, R falls back to class-based dispatch on the raw Python input, which may fail or return unexpected results. Always supply `enforce_method` when calling `as_sir()` from Python.
|
||||
|
||||
# Conclusion
|
||||
|
||||
With the `AMR` Python package, Python users can now effortlessly call R functions from the `AMR` R package. This eliminates the need for complex `rpy2` configurations and provides a clean, easy-to-use interface for antimicrobial resistance analysis. The examples provided above demonstrate how this can be applied to typical workflows, such as standardising microorganism and antimicrobial names or calculating resistance.
|
||||
@@ -0,0 +1,12 @@
|
||||
README.md
|
||||
setup.py
|
||||
AMR/__init__.py
|
||||
AMR/_engine.py
|
||||
AMR/beta.py
|
||||
AMR/datasets.py
|
||||
AMR/functions.py
|
||||
AMR.egg-info/PKG-INFO
|
||||
AMR.egg-info/SOURCES.txt
|
||||
AMR.egg-info/dependency_links.txt
|
||||
AMR.egg-info/requires.txt
|
||||
AMR.egg-info/top_level.txt
|
||||
@@ -0,0 +1 @@
|
||||
|
||||
@@ -0,0 +1,3 @@
|
||||
rpy2
|
||||
numpy
|
||||
pandas
|
||||
@@ -0,0 +1 @@
|
||||
AMR
|
||||
+249
@@ -0,0 +1,249 @@
|
||||
import sys
|
||||
|
||||
_DATASETS = frozenset({
|
||||
'example_isolates', 'microorganisms',
|
||||
'antimicrobials', 'clinical_breakpoints'
|
||||
})
|
||||
|
||||
class _AMRModule(type(sys.modules[__name__])):
|
||||
"""Lazy-loading module: nothing runs until an attribute is accessed."""
|
||||
|
||||
def __getattr__(self, name):
|
||||
if name in _DATASETS:
|
||||
from .datasets import get
|
||||
return get(name, source="cran")
|
||||
try:
|
||||
from . import functions
|
||||
return getattr(functions, name)
|
||||
except AttributeError:
|
||||
raise AttributeError(
|
||||
f"module 'AMR' has no attribute '{name}'")
|
||||
|
||||
sys.modules[__name__].__class__ = _AMRModule
|
||||
from .functions import custom_eucast_rules
|
||||
from .functions import ab_class
|
||||
from .functions import ab_selector
|
||||
from .functions import ab_from_text
|
||||
from .functions import ab_name
|
||||
from .functions import ab_cid
|
||||
from .functions import ab_synonyms
|
||||
from .functions import ab_tradenames
|
||||
from .functions import ab_group
|
||||
from .functions import ab_atc
|
||||
from .functions import ab_atc_group1
|
||||
from .functions import ab_atc_group2
|
||||
from .functions import ab_loinc
|
||||
from .functions import ab_ddd
|
||||
from .functions import ab_ddd_units
|
||||
from .functions import ab_info
|
||||
from .functions import ab_url
|
||||
from .functions import ab_property
|
||||
from .functions import add_custom_antimicrobials
|
||||
from .functions import clear_custom_antimicrobials
|
||||
from .functions import add_custom_microorganisms
|
||||
from .functions import clear_custom_microorganisms
|
||||
from .functions import age
|
||||
from .functions import age_groups
|
||||
from .functions import all_sir
|
||||
from .functions import all_sir_predictors
|
||||
from .functions import all_mic
|
||||
from .functions import all_mic_predictors
|
||||
from .functions import all_disk
|
||||
from .functions import all_disk_predictors
|
||||
from .functions import step_mic_log2
|
||||
from .functions import step_sir_numeric
|
||||
from .functions import amr_course
|
||||
from .functions import wisca
|
||||
from .functions import antibiogram
|
||||
from .functions import retrieve_wisca_parameters
|
||||
from .functions import wisca_plot
|
||||
from .functions import aminoglycosides
|
||||
from .functions import aminopenicillins
|
||||
from .functions import antifungals
|
||||
from .functions import antimycobacterials
|
||||
from .functions import betalactams
|
||||
from .functions import betalactams_with_inhibitor
|
||||
from .functions import carbapenems
|
||||
from .functions import cephalosporins
|
||||
from .functions import cephalosporins_1st
|
||||
from .functions import cephalosporins_2nd
|
||||
from .functions import cephalosporins_3rd
|
||||
from .functions import cephalosporins_4th
|
||||
from .functions import cephalosporins_5th
|
||||
from .functions import fluoroquinolones
|
||||
from .functions import glycopeptides
|
||||
from .functions import ionophores
|
||||
from .functions import isoxazolylpenicillins
|
||||
from .functions import lincosamides
|
||||
from .functions import lipoglycopeptides
|
||||
from .functions import macrolides
|
||||
from .functions import monobactams
|
||||
from .functions import nitrofurans
|
||||
from .functions import oxazolidinones
|
||||
from .functions import penicillins
|
||||
from .functions import peptides
|
||||
from .functions import phenicols
|
||||
from .functions import phosphonics
|
||||
from .functions import polymyxins
|
||||
from .functions import quinolones
|
||||
from .functions import rifamycins
|
||||
from .functions import spiropyrimidinetriones
|
||||
from .functions import streptogramins
|
||||
from .functions import sulfonamides
|
||||
from .functions import tetracyclines
|
||||
from .functions import trimethoprims
|
||||
from .functions import ureidopenicillins
|
||||
from .functions import amr_class
|
||||
from .functions import amr_selector
|
||||
from .functions import administrable_per_os
|
||||
from .functions import administrable_iv
|
||||
from .functions import not_intrinsic_resistant
|
||||
from .functions import as_ab
|
||||
from .functions import is_ab
|
||||
from .functions import ab_reset_session
|
||||
from .functions import as_av
|
||||
from .functions import is_av
|
||||
from .functions import as_disk
|
||||
from .functions import is_disk
|
||||
from .functions import as_mic
|
||||
from .functions import is_mic
|
||||
from .functions import rescale_mic
|
||||
from .functions import mic_p50
|
||||
from .functions import mic_p90
|
||||
from .functions import as_mo
|
||||
from .functions import is_mo
|
||||
from .functions import mo_uncertainties
|
||||
from .functions import mo_renamed
|
||||
from .functions import mo_failures
|
||||
from .functions import mo_reset_session
|
||||
from .functions import mo_cleaning_regex
|
||||
from .functions import as_sir
|
||||
from .functions import is_sir
|
||||
from .functions import is_sir_eligible
|
||||
from .functions import sir_interpretation_history
|
||||
from .functions import atc_online_property
|
||||
from .functions import atc_online_groups
|
||||
from .functions import atc_online_ddd
|
||||
from .functions import atc_online_ddd_units
|
||||
from .functions import av_from_text
|
||||
from .functions import av_name
|
||||
from .functions import av_cid
|
||||
from .functions import av_synonyms
|
||||
from .functions import av_tradenames
|
||||
from .functions import av_group
|
||||
from .functions import av_atc
|
||||
from .functions import av_loinc
|
||||
from .functions import av_ddd
|
||||
from .functions import av_ddd_units
|
||||
from .functions import av_info
|
||||
from .functions import av_url
|
||||
from .functions import av_property
|
||||
from .functions import availability
|
||||
from .functions import bug_drug_combinations
|
||||
from .functions import count_resistant
|
||||
from .functions import count_susceptible
|
||||
from .functions import count_S
|
||||
from .functions import count_SI
|
||||
from .functions import count_I
|
||||
from .functions import count_IR
|
||||
from .functions import count_R
|
||||
from .functions import count_all
|
||||
from .functions import n_sir
|
||||
from .functions import count_df
|
||||
from .functions import custom_interpretive_rules
|
||||
from .functions import custom_mdro_guideline
|
||||
from .functions import export_ncbi_biosample
|
||||
from .functions import first_isolate
|
||||
from .functions import filter_first_isolate
|
||||
from .functions import g_test
|
||||
from .functions import is_new_episode
|
||||
from .functions import ggplot_pca
|
||||
from .functions import ggplot_sir
|
||||
from .functions import geom_sir
|
||||
from .functions import guess_ab_col
|
||||
from .functions import interpretive_rules
|
||||
from .functions import eucast_rules
|
||||
from .functions import clsi_rules
|
||||
from .functions import eucast_dosage
|
||||
from .functions import italicise_taxonomy
|
||||
from .functions import italicize_taxonomy
|
||||
from .functions import inner_join_microorganisms
|
||||
from .functions import left_join_microorganisms
|
||||
from .functions import right_join_microorganisms
|
||||
from .functions import full_join_microorganisms
|
||||
from .functions import semi_join_microorganisms
|
||||
from .functions import anti_join_microorganisms
|
||||
from .functions import key_antimicrobials
|
||||
from .functions import all_antimicrobials
|
||||
from .functions import kurtosis
|
||||
from .functions import like
|
||||
from .functions import mdro
|
||||
from .functions import brmo
|
||||
from .functions import mrgn
|
||||
from .functions import mdr_tb
|
||||
from .functions import mdr_cmi2012
|
||||
from .functions import eucast_exceptional_phenotypes
|
||||
from .functions import mean_amr_distance
|
||||
from .functions import amr_distance_from_row
|
||||
from .functions import mo_matching_score
|
||||
from .functions import mo_name
|
||||
from .functions import mo_fullname
|
||||
from .functions import mo_shortname
|
||||
from .functions import mo_subspecies
|
||||
from .functions import mo_species
|
||||
from .functions import mo_genus
|
||||
from .functions import mo_family
|
||||
from .functions import mo_order
|
||||
from .functions import mo_class
|
||||
from .functions import mo_phylum
|
||||
from .functions import mo_kingdom
|
||||
from .functions import mo_domain
|
||||
from .functions import mo_type
|
||||
from .functions import mo_status
|
||||
from .functions import mo_pathogenicity
|
||||
from .functions import mo_gramstain
|
||||
from .functions import mo_is_gram_negative
|
||||
from .functions import mo_is_gram_positive
|
||||
from .functions import mo_is_yeast
|
||||
from .functions import mo_is_intrinsic_resistant
|
||||
from .functions import mo_oxygen_tolerance
|
||||
from .functions import mo_is_anaerobic
|
||||
from .functions import mo_morphology
|
||||
from .functions import mo_snomed
|
||||
from .functions import mo_ref
|
||||
from .functions import mo_authors
|
||||
from .functions import mo_year
|
||||
from .functions import mo_lpsn
|
||||
from .functions import mo_mycobank
|
||||
from .functions import mo_gbif
|
||||
from .functions import mo_rank
|
||||
from .functions import mo_taxonomy
|
||||
from .functions import mo_synonyms
|
||||
from .functions import mo_current
|
||||
from .functions import mo_group_members
|
||||
from .functions import mo_info
|
||||
from .functions import mo_url
|
||||
from .functions import mo_property
|
||||
from .functions import pca
|
||||
from .functions import theme_sir
|
||||
from .functions import labels_sir_count
|
||||
from .functions import resistance
|
||||
from .functions import susceptibility
|
||||
from .functions import sir_confidence_interval
|
||||
from .functions import proportion_R
|
||||
from .functions import proportion_IR
|
||||
from .functions import proportion_I
|
||||
from .functions import proportion_SI
|
||||
from .functions import proportion_S
|
||||
from .functions import proportion_df
|
||||
from .functions import sir_df
|
||||
from .functions import random_mic
|
||||
from .functions import random_disk
|
||||
from .functions import random_sir
|
||||
from .functions import resistance_predict
|
||||
from .functions import sir_predict
|
||||
from .functions import ggplot_sir_predict
|
||||
from .functions import skewness
|
||||
from .functions import top_n_microorganisms
|
||||
from .functions import reset_AMR_locale
|
||||
from .functions import translate_AMR
|
||||
@@ -0,0 +1,93 @@
|
||||
import os
|
||||
import sys
|
||||
import importlib.metadata as metadata
|
||||
|
||||
# Get the path to the virtual environment
|
||||
venv_path = sys.prefix
|
||||
r_lib_path = os.path.join(venv_path, "R_libs")
|
||||
os.makedirs(r_lib_path, exist_ok=True)
|
||||
|
||||
# Set environment variable before importing rpy2
|
||||
os.environ['R_LIBS_SITE'] = r_lib_path
|
||||
|
||||
from rpy2 import robjects
|
||||
from rpy2.robjects.vectors import StrVector
|
||||
from rpy2.robjects.packages import importr, isinstalled
|
||||
|
||||
# Import base and utils once
|
||||
base = importr('base')
|
||||
utils = importr('utils')
|
||||
|
||||
# Silence R console output entirely
|
||||
robjects.r('suppressMessages(suppressWarnings(sink(tempfile())))')
|
||||
base._libPaths(r_lib_path)
|
||||
|
||||
_installed_source = None
|
||||
|
||||
def _r_version():
|
||||
"""Return the currently installed AMR R package version, or None."""
|
||||
try:
|
||||
return str(robjects.r(
|
||||
f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')[0])
|
||||
except Exception:
|
||||
return None
|
||||
|
||||
def _py_version():
|
||||
"""Return the Python AMR package version from metadata, or empty string."""
|
||||
try:
|
||||
return str(metadata.version('AMR'))
|
||||
except metadata.PackageNotFoundError:
|
||||
return ''
|
||||
|
||||
def _install_cran():
|
||||
"""Install AMR from CRAN into the isolated library."""
|
||||
print("AMR: Installing from CRAN...", flush=True)
|
||||
utils.install_packages(
|
||||
'AMR',
|
||||
repos='https://cloud.r-project.org',
|
||||
lib=r_lib_path,
|
||||
quiet=True
|
||||
)
|
||||
|
||||
def _install_github():
|
||||
"""Install AMR development version from GitHub into the isolated library."""
|
||||
print("AMR: Installing development version from GitHub...", flush=True)
|
||||
utils.install_packages(
|
||||
StrVector(['remotes', 'desc']),
|
||||
repos='https://cloud.r-project.org',
|
||||
lib=r_lib_path,
|
||||
quiet=True
|
||||
)
|
||||
remotes = importr('remotes', lib_loc=r_lib_path)
|
||||
remotes.install_github('msberends/AMR', lib=r_lib_path, quiet=True)
|
||||
|
||||
def ensure_amr(source="cran"):
|
||||
"""Ensure AMR is installed from the requested source. Idempotent per source."""
|
||||
global _installed_source
|
||||
|
||||
if _installed_source == source:
|
||||
return
|
||||
|
||||
install_fn = _install_github if source == "github" else _install_cran
|
||||
|
||||
if not isinstalled('AMR', lib_loc=r_lib_path):
|
||||
install_fn()
|
||||
else:
|
||||
# Check for version mismatch and update if needed
|
||||
r_ver = _r_version()
|
||||
py_ver = _py_version()
|
||||
if r_ver != py_ver:
|
||||
try:
|
||||
install_fn()
|
||||
except Exception as e:
|
||||
print(f"AMR: Could not update ({e})", flush=True)
|
||||
|
||||
print(f"AMR: R package version {_r_version()} ready.", flush=True)
|
||||
_installed_source = source
|
||||
|
||||
def restore_sink():
|
||||
"""Restore R console output after setup is complete."""
|
||||
try:
|
||||
robjects.r('sink()')
|
||||
except Exception:
|
||||
pass
|
||||
+22
@@ -0,0 +1,22 @@
|
||||
import sys
|
||||
|
||||
_DATASETS = frozenset({
|
||||
'example_isolates', 'microorganisms',
|
||||
'antimicrobials', 'clinical_breakpoints'
|
||||
})
|
||||
|
||||
class _BetaModule(type(sys.modules[__name__])):
|
||||
"""Lazy-loading module: installs AMR from GitHub on first access."""
|
||||
|
||||
def __getattr__(self, name):
|
||||
if name in _DATASETS:
|
||||
from .datasets import get
|
||||
return get(name, source="github")
|
||||
try:
|
||||
from . import functions
|
||||
return getattr(functions, name)
|
||||
except AttributeError:
|
||||
raise AttributeError(
|
||||
f"module 'AMR.beta' has no attribute '{name}'")
|
||||
|
||||
sys.modules[__name__].__class__ = _BetaModule
|
||||
@@ -0,0 +1,54 @@
|
||||
import pandas as pd
|
||||
from rpy2 import robjects
|
||||
from rpy2.robjects.conversion import localconverter
|
||||
from rpy2.robjects import default_converter, numpy2ri, pandas2ri
|
||||
|
||||
from ._engine import ensure_amr, restore_sink
|
||||
|
||||
_cache = {}
|
||||
_loaded_source = None
|
||||
|
||||
def _load_datasets(source="cran"):
|
||||
"""Load all AMR datasets into the module cache."""
|
||||
global _loaded_source
|
||||
|
||||
if _cache and _loaded_source == source:
|
||||
return
|
||||
|
||||
if _cache and _loaded_source != source:
|
||||
_cache.clear()
|
||||
|
||||
ensure_amr(source)
|
||||
|
||||
with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
|
||||
_cache['example_isolates'] = _load_example_isolates()
|
||||
_cache['microorganisms'] = robjects.r(
|
||||
'AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]')
|
||||
_cache['antimicrobials'] = robjects.r(
|
||||
'AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]')
|
||||
_cache['clinical_breakpoints'] = robjects.r(
|
||||
'AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]')
|
||||
|
||||
restore_sink()
|
||||
_loaded_source = source
|
||||
|
||||
def _load_example_isolates():
|
||||
df = robjects.r('''
|
||||
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
|
||||
''')
|
||||
df['date'] = pd.to_datetime(df['date'])
|
||||
return df
|
||||
|
||||
def get(name, source="cran"):
|
||||
"""Retrieve a dataset by name, installing AMR if needed."""
|
||||
_load_datasets(source)
|
||||
return _cache[name]
|
||||
@@ -0,0 +1,984 @@
|
||||
import functools
|
||||
import rpy2.robjects as robjects
|
||||
from rpy2.robjects.packages import importr
|
||||
from rpy2.robjects.vectors import StrVector, FactorVector, IntVector, FloatVector, DataFrame
|
||||
from rpy2.robjects.conversion import localconverter
|
||||
from rpy2.robjects import default_converter, numpy2ri, pandas2ri
|
||||
import pandas as pd
|
||||
import numpy as np
|
||||
|
||||
from ._engine import ensure_amr
|
||||
|
||||
# Ensure AMR is available before importing it in R
|
||||
ensure_amr("cran")
|
||||
amr_r = importr('AMR')
|
||||
|
||||
def convert_to_r(value):
|
||||
"""Convert Python lists/tuples to typed R vectors.
|
||||
|
||||
rpy2's default_converter passes Python lists to R as R lists, not as
|
||||
character/numeric vectors. This causes element-wise type-check functions
|
||||
such as is.mic(), is.sir(), and is.disk() to return a logical vector
|
||||
rather than a single logical, breaking R's scalar && operator.
|
||||
|
||||
This helper converts Python lists and tuples to the appropriate R vector
|
||||
type based on the element types, so R always receives a proper vector."""
|
||||
if isinstance(value, (list, tuple)):
|
||||
if len(value) == 0:
|
||||
return StrVector([])
|
||||
# bool must be checked before int because bool is a subclass of int
|
||||
if all(isinstance(v, bool) for v in value):
|
||||
return robjects.vectors.BoolVector(value)
|
||||
if all(isinstance(v, int) for v in value):
|
||||
return IntVector(value)
|
||||
if all(isinstance(v, float) for v in value):
|
||||
return FloatVector(value)
|
||||
if all(isinstance(v, str) for v in value):
|
||||
return StrVector(value)
|
||||
# Mixed types: coerce all to string
|
||||
return StrVector([str(v) for v in value])
|
||||
return value
|
||||
|
||||
def convert_to_python(r_output):
|
||||
# Check if it's a StrVector (R character vector)
|
||||
if isinstance(r_output, StrVector):
|
||||
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, DataFrame)):
|
||||
return r_output # Return as pandas DataFrame (already converted by pandas2ri)
|
||||
|
||||
# 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
|
||||
|
||||
def r_to_python(r_func):
|
||||
"""Decorator that converts Python list/tuple inputs to typed R vectors,
|
||||
runs the rpy2 function under a localconverter, and converts the output
|
||||
to a Python type."""
|
||||
@functools.wraps(r_func)
|
||||
def wrapper(*args, **kwargs):
|
||||
args = tuple(convert_to_r(a) for a in args)
|
||||
kwargs = {k: convert_to_r(v) for k, v in kwargs.items()}
|
||||
with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
|
||||
return convert_to_python(r_func(*args, **kwargs))
|
||||
return wrapper
|
||||
@r_to_python
|
||||
def custom_eucast_rules(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.custom_eucast_rules(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_class(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_class(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_selector(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_selector(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_from_text(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_from_text(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_name(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_name(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_cid(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_cid(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_synonyms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_synonyms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_tradenames(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_tradenames(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_group(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_group(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_atc(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_atc(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_atc_group1(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_atc_group1(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_atc_group2(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_atc_group2(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_loinc(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_loinc(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_ddd(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_ddd(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_ddd_units(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_ddd_units(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_info(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_info(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_url(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_url(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ab_property(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_property(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def add_custom_antimicrobials(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.add_custom_antimicrobials(x)
|
||||
@r_to_python
|
||||
def clear_custom_antimicrobials(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.clear_custom_antimicrobials(*args, **kwargs)
|
||||
@r_to_python
|
||||
def add_custom_microorganisms(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.add_custom_microorganisms(x)
|
||||
@r_to_python
|
||||
def clear_custom_microorganisms(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.clear_custom_microorganisms(*args, **kwargs)
|
||||
@r_to_python
|
||||
def age(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.age(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def age_groups(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.age_groups(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def all_sir(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_sir(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_sir_predictors(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_sir_predictors(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_mic(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_mic(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_mic_predictors(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_mic_predictors(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_disk(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_disk(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_disk_predictors(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_disk_predictors(*args, **kwargs)
|
||||
@r_to_python
|
||||
def step_mic_log2(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.step_mic_log2(*args, **kwargs)
|
||||
@r_to_python
|
||||
def step_sir_numeric(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.step_sir_numeric(*args, **kwargs)
|
||||
@r_to_python
|
||||
def amr_course(github_repo, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.amr_course(github_repo, *args, **kwargs)
|
||||
@r_to_python
|
||||
def wisca(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.wisca(*args, **kwargs)
|
||||
@r_to_python
|
||||
def antibiogram(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.antibiogram(*args, **kwargs)
|
||||
@r_to_python
|
||||
def retrieve_wisca_parameters(wisca_model, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.retrieve_wisca_parameters(wisca_model, *args, **kwargs)
|
||||
@r_to_python
|
||||
def wisca_plot(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.wisca_plot(*args, **kwargs)
|
||||
@r_to_python
|
||||
def aminoglycosides(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.aminoglycosides(*args, **kwargs)
|
||||
@r_to_python
|
||||
def aminopenicillins(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.aminopenicillins(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def antifungals(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.antifungals(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def antimycobacterials(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.antimycobacterials(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def betalactams(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.betalactams(*args, **kwargs)
|
||||
@r_to_python
|
||||
def betalactams_with_inhibitor(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.betalactams_with_inhibitor(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def carbapenems(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.carbapenems(*args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins(*args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins_1st(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins_1st(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins_2nd(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins_2nd(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins_3rd(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins_3rd(*args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins_4th(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins_4th(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def cephalosporins_5th(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.cephalosporins_5th(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def fluoroquinolones(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.fluoroquinolones(*args, **kwargs)
|
||||
@r_to_python
|
||||
def glycopeptides(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.glycopeptides(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ionophores(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ionophores(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def isoxazolylpenicillins(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.isoxazolylpenicillins(*args, **kwargs)
|
||||
@r_to_python
|
||||
def lincosamides(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.lincosamides(*args, **kwargs)
|
||||
@r_to_python
|
||||
def lipoglycopeptides(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.lipoglycopeptides(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def macrolides(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.macrolides(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def monobactams(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.monobactams(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def nitrofurans(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.nitrofurans(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def oxazolidinones(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.oxazolidinones(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def penicillins(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.penicillins(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def peptides(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.peptides(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def phenicols(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.phenicols(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def phosphonics(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.phosphonics(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def polymyxins(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.polymyxins(*args, **kwargs)
|
||||
@r_to_python
|
||||
def quinolones(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.quinolones(*args, **kwargs)
|
||||
@r_to_python
|
||||
def rifamycins(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.rifamycins(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def spiropyrimidinetriones(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.spiropyrimidinetriones(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def streptogramins(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.streptogramins(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def sulfonamides(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.sulfonamides(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def tetracyclines(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.tetracyclines(*args, **kwargs)
|
||||
@r_to_python
|
||||
def trimethoprims(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.trimethoprims(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ureidopenicillins(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ureidopenicillins(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def amr_class(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.amr_class(*args, **kwargs)
|
||||
@r_to_python
|
||||
def amr_selector(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.amr_selector(*args, **kwargs)
|
||||
@r_to_python
|
||||
def administrable_per_os(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.administrable_per_os(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def administrable_iv(only_sir_columns = False, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.administrable_iv(only_sir_columns = False, *args, **kwargs)
|
||||
@r_to_python
|
||||
def not_intrinsic_resistant(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.not_intrinsic_resistant(*args, **kwargs)
|
||||
@r_to_python
|
||||
def as_ab(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_ab(*args, **kwargs)
|
||||
@r_to_python
|
||||
def is_ab(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_ab(x)
|
||||
@r_to_python
|
||||
def ab_reset_session(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ab_reset_session(*args, **kwargs)
|
||||
@r_to_python
|
||||
def as_av(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_av(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def is_av(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_av(x)
|
||||
@r_to_python
|
||||
def as_disk(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_disk(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def is_disk(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_disk(x)
|
||||
@r_to_python
|
||||
def as_mic(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_mic(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def is_mic(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_mic(x)
|
||||
@r_to_python
|
||||
def rescale_mic(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.rescale_mic(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mic_p50(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mic_p50(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mic_p90(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mic_p90(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def as_mo(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_mo(*args, **kwargs)
|
||||
@r_to_python
|
||||
def is_mo(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_mo(x)
|
||||
@r_to_python
|
||||
def mo_uncertainties(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_uncertainties(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_renamed(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_renamed(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_failures(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_failures(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_reset_session(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_reset_session(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_cleaning_regex(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_cleaning_regex(*args, **kwargs)
|
||||
@r_to_python
|
||||
def as_sir(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.as_sir(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def is_sir(x):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_sir(x)
|
||||
@r_to_python
|
||||
def is_sir_eligible(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_sir_eligible(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def sir_interpretation_history(clean):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.sir_interpretation_history(clean)
|
||||
@r_to_python
|
||||
def atc_online_property(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.atc_online_property(*args, **kwargs)
|
||||
@r_to_python
|
||||
def atc_online_groups(atc_code, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.atc_online_groups(atc_code, *args, **kwargs)
|
||||
@r_to_python
|
||||
def atc_online_ddd(atc_code, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.atc_online_ddd(atc_code, *args, **kwargs)
|
||||
@r_to_python
|
||||
def atc_online_ddd_units(atc_code, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.atc_online_ddd_units(atc_code, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_from_text(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_from_text(*args, **kwargs)
|
||||
@r_to_python
|
||||
def av_name(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_name(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_cid(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_cid(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_synonyms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_synonyms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_tradenames(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_tradenames(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_group(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_group(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_atc(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_atc(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_loinc(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_loinc(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_ddd(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_ddd(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_ddd_units(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_ddd_units(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_info(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_info(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_url(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_url(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def av_property(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.av_property(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def availability(tbl, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.availability(tbl, *args, **kwargs)
|
||||
@r_to_python
|
||||
def bug_drug_combinations(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.bug_drug_combinations(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_resistant(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_resistant(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_susceptible(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_susceptible(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_S(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_S(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_SI(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_SI(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_I(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_I(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_IR(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_IR(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_R(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_R(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_all(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_all(*args, **kwargs)
|
||||
@r_to_python
|
||||
def n_sir(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.n_sir(*args, **kwargs)
|
||||
@r_to_python
|
||||
def count_df(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.count_df(*args, **kwargs)
|
||||
@r_to_python
|
||||
def custom_interpretive_rules(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.custom_interpretive_rules(*args, **kwargs)
|
||||
@r_to_python
|
||||
def custom_mdro_guideline(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.custom_mdro_guideline(*args, **kwargs)
|
||||
@r_to_python
|
||||
def export_ncbi_biosample(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.export_ncbi_biosample(*args, **kwargs)
|
||||
@r_to_python
|
||||
def first_isolate(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.first_isolate(*args, **kwargs)
|
||||
@r_to_python
|
||||
def filter_first_isolate(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.filter_first_isolate(*args, **kwargs)
|
||||
@r_to_python
|
||||
def g_test(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.g_test(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def is_new_episode(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.is_new_episode(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def ggplot_pca(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ggplot_pca(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ggplot_sir(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ggplot_sir(*args, **kwargs)
|
||||
@r_to_python
|
||||
def geom_sir(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.geom_sir(*args, **kwargs)
|
||||
@r_to_python
|
||||
def guess_ab_col(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.guess_ab_col(*args, **kwargs)
|
||||
@r_to_python
|
||||
def interpretive_rules(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.interpretive_rules(*args, **kwargs)
|
||||
@r_to_python
|
||||
def eucast_rules(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.eucast_rules(*args, **kwargs)
|
||||
@r_to_python
|
||||
def clsi_rules(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.clsi_rules(*args, **kwargs)
|
||||
@r_to_python
|
||||
def eucast_dosage(ab, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.eucast_dosage(ab, *args, **kwargs)
|
||||
@r_to_python
|
||||
def italicise_taxonomy(string, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.italicise_taxonomy(string, *args, **kwargs)
|
||||
@r_to_python
|
||||
def italicize_taxonomy(string, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.italicize_taxonomy(string, *args, **kwargs)
|
||||
@r_to_python
|
||||
def inner_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.inner_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def left_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.left_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def right_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.right_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def full_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.full_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def semi_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.semi_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def anti_join_microorganisms(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.anti_join_microorganisms(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def key_antimicrobials(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.key_antimicrobials(*args, **kwargs)
|
||||
@r_to_python
|
||||
def all_antimicrobials(x = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.all_antimicrobials(x = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def kurtosis(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.kurtosis(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def like(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.like(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mdro(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mdro(*args, **kwargs)
|
||||
@r_to_python
|
||||
def brmo(x = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.brmo(x = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mrgn(x = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mrgn(x = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mdr_tb(x = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mdr_tb(x = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mdr_cmi2012(x = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mdr_cmi2012(x = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def eucast_exceptional_phenotypes(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.eucast_exceptional_phenotypes(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mean_amr_distance(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mean_amr_distance(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def amr_distance_from_row(amr_distance, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.amr_distance_from_row(amr_distance, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_matching_score(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_matching_score(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_name(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_name(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_fullname(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_fullname(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_shortname(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_shortname(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_subspecies(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_subspecies(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_species(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_species(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_genus(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_genus(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_family(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_family(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_order(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_order(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_class(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_class(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_phylum(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_phylum(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_kingdom(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_kingdom(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_domain(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_domain(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_type(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_type(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_status(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_status(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_pathogenicity(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_pathogenicity(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_gramstain(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_gramstain(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_is_gram_negative(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_is_gram_negative(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_is_gram_positive(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_is_gram_positive(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_is_yeast(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_is_yeast(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_is_intrinsic_resistant(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_is_intrinsic_resistant(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_oxygen_tolerance(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_oxygen_tolerance(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_is_anaerobic(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_is_anaerobic(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_morphology(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_morphology(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_snomed(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_snomed(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_ref(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_ref(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_authors(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_authors(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_year(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_year(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_lpsn(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_lpsn(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_mycobank(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_mycobank(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_gbif(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_gbif(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_rank(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_rank(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_taxonomy(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_taxonomy(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_synonyms(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_synonyms(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_current(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_current(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_group_members(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_group_members(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_info(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_info(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_url(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_url(*args, **kwargs)
|
||||
@r_to_python
|
||||
def mo_property(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.mo_property(*args, **kwargs)
|
||||
@r_to_python
|
||||
def pca(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.pca(*args, **kwargs)
|
||||
@r_to_python
|
||||
def theme_sir(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.theme_sir(*args, **kwargs)
|
||||
@r_to_python
|
||||
def labels_sir_count(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.labels_sir_count(*args, **kwargs)
|
||||
@r_to_python
|
||||
def resistance(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.resistance(*args, **kwargs)
|
||||
@r_to_python
|
||||
def susceptibility(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.susceptibility(*args, **kwargs)
|
||||
@r_to_python
|
||||
def sir_confidence_interval(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.sir_confidence_interval(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_R(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_R(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_IR(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_IR(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_I(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_I(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_SI(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_SI(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_S(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_S(*args, **kwargs)
|
||||
@r_to_python
|
||||
def proportion_df(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.proportion_df(*args, **kwargs)
|
||||
@r_to_python
|
||||
def sir_df(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.sir_df(*args, **kwargs)
|
||||
@r_to_python
|
||||
def random_mic(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.random_mic(*args, **kwargs)
|
||||
@r_to_python
|
||||
def random_disk(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.random_disk(*args, **kwargs)
|
||||
@r_to_python
|
||||
def random_sir(size = None, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.random_sir(size = None, *args, **kwargs)
|
||||
@r_to_python
|
||||
def resistance_predict(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.resistance_predict(*args, **kwargs)
|
||||
@r_to_python
|
||||
def sir_predict(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.sir_predict(*args, **kwargs)
|
||||
@r_to_python
|
||||
def ggplot_sir_predict(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.ggplot_sir_predict(*args, **kwargs)
|
||||
@r_to_python
|
||||
def skewness(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.skewness(x, *args, **kwargs)
|
||||
@r_to_python
|
||||
def top_n_microorganisms(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.top_n_microorganisms(*args, **kwargs)
|
||||
@r_to_python
|
||||
def reset_AMR_locale(*args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.reset_AMR_locale(*args, **kwargs)
|
||||
@r_to_python
|
||||
def translate_AMR(x, *args, **kwargs):
|
||||
"""Please see our website of the R package for the full manual: https://amr-for-r.org"""
|
||||
return amr_r.translate_AMR(x, *args, **kwargs)
|
||||
@@ -1,3 +0,0 @@
|
||||
Version: 2.1.1
|
||||
Date: 2023-10-20 16:05:16 UTC
|
||||
SHA: ca72a646d041f7f096c4e196e8ae2fb2b176019c
|
||||
-72
@@ -1,72 +0,0 @@
|
||||
Package: AMR
|
||||
Version: 2.1.1.9270
|
||||
Date: 2025-05-04
|
||||
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(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("Jane"), family = "Hawkey", role = "ctb", comment = c(ORCID = "0000-0001-9661-5293")),
|
||||
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("Kathryn"), family = "Holt", role = "ctb", comment = c(ORCID = "0000-0003-3949-2471")),
|
||||
person(given = c("Larisse"), family = "Bolton", role = "ctb", comment = c(ORCID = "0000-0001-7879-2173")),
|
||||
person(given = c("Matthew"), family = "Saab", role = "ctb"),
|
||||
person(given = c("Natacha"), family = "Couto", role = "ctb", comment = c(ORCID = "0000-0002-9152-5464")),
|
||||
person(given = c("Peter"), family = "Dutey-Magni", role = "ctb", comment = c(ORCID = "0000-0002-8942-9836")),
|
||||
person(given = c("Rogier", "P."), family = "Schade", role = "ctb"),
|
||||
person(given = c("Sofia"), family = "Ny", role = "ctb", comment = c(ORCID = "0000-0002-2017-1363")),
|
||||
person(given = c("Alex", "W."), family = "Friedrich", role = "ths", comment = c(ORCID = "0000-0003-4881-038X")),
|
||||
person(given = c("Bhanu", "N.", "M."), family = "Sinha", role = "ths", comment = c(ORCID = "0000-0003-1634-0010")),
|
||||
person(given = c("Casper", "J."), family = "Albers", role = "ths", comment = c(ORCID = "0000-0002-9213-6743")),
|
||||
person(given = c("Corinna"), family = "Glasner", role = "ths", comment = c(ORCID = "0000-0003-1241-1328")))
|
||||
Depends: R (>= 3.0.0)
|
||||
Suggests:
|
||||
cleaner,
|
||||
cli,
|
||||
crayon,
|
||||
curl,
|
||||
data.table,
|
||||
dplyr,
|
||||
ggplot2,
|
||||
knitr,
|
||||
openxlsx,
|
||||
parallelly,
|
||||
pillar,
|
||||
progress,
|
||||
readxl,
|
||||
rmarkdown,
|
||||
rstudioapi,
|
||||
rvest,
|
||||
skimr,
|
||||
testthat,
|
||||
tibble,
|
||||
tidymodels,
|
||||
tidyselect,
|
||||
tinytest,
|
||||
vctrs,
|
||||
xml2
|
||||
VignetteBuilder: knitr,rmarkdown
|
||||
URL: https://amr-for-r.org, https://github.com/msberends/AMR
|
||||
BugReports: https://github.com/msberends/AMR/issues
|
||||
License: GPL-2 | file LICENSE
|
||||
Encoding: UTF-8
|
||||
LazyData: true
|
||||
RoxygenNote: 7.3.2
|
||||
Roxygen: list(markdown = TRUE, old_usage = TRUE)
|
||||
@@ -1,248 +0,0 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 2, June 1991
|
||||
|
||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc., <http://fsf.org/>
|
||||
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
A SUMMARY OF THIS LICENSE BY THE ORIGINAL AUTHORS OF THE AMR R PACKAGE
|
||||
|
||||
This R package, with package name 'AMR':
|
||||
- May be used for commercial purposes
|
||||
- May be used for private purposes
|
||||
- May NOT be used for patent purposes
|
||||
- May be modified, although:
|
||||
- Modifications MUST be released under the same license when distributing the package
|
||||
- Changes made to the code MUST be documented
|
||||
- May be distributed, although:
|
||||
- Source code MUST be made available when the package is distributed
|
||||
- A copy of the license and copyright notice MUST be included with the package.
|
||||
- Comes with a LIMITATION of liability
|
||||
- Comes with NO warranty
|
||||
|
||||
END OF THE SUMMARY
|
||||
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License applies to any program or other work which contains
|
||||
a notice placed by the copyright holder saying it may be distributed
|
||||
under the terms of this General Public License. The "Program", below,
|
||||
refers to any such program or work, and a "work based on the Program"
|
||||
means either the Program or any derivative work under copyright law:
|
||||
that is to say, a work containing the Program or a portion of it,
|
||||
either verbatim or with modifications and/or translated into another
|
||||
language. (Hereinafter, translation is included without limitation in
|
||||
the term "modification".) Each licensee is addressed as "you".
|
||||
|
||||
Activities other than copying, distribution and modification are not
|
||||
covered by this License; they are outside its scope. The act of
|
||||
running the Program is not restricted, and the output from the Program
|
||||
is covered only if its contents constitute a work based on the
|
||||
Program (independent of having been made by running the Program).
|
||||
Whether that is true depends on what the Program does.
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Program's
|
||||
source code as you receive it, in any medium, provided that you
|
||||
conspicuously and appropriately publish on each copy an appropriate
|
||||
copyright notice and disclaimer of warranty; keep intact all the
|
||||
notices that refer to this License and to the absence of any warranty;
|
||||
and give any other recipients of the Program a copy of this License
|
||||
along with the Program.
|
||||
|
||||
You may charge a fee for the physical act of transferring a copy, and
|
||||
you may at your option offer warranty protection in exchange for a fee.
|
||||
|
||||
2. You may modify your copy or copies of the Program or any portion
|
||||
of it, thus forming a work based on the Program, and copy and
|
||||
distribute such modifications or work under the terms of Section 1
|
||||
above, provided that you also meet all of these conditions:
|
||||
|
||||
a) You must cause the modified files to carry prominent notices
|
||||
stating that you changed the files and the date of any change.
|
||||
|
||||
b) You must cause any work that you distribute or publish, that in
|
||||
whole or in part contains or is derived from the Program or any
|
||||
part thereof, to be licensed as a whole at no charge to all third
|
||||
parties under the terms of this License.
|
||||
|
||||
c) If the modified program normally reads commands interactively
|
||||
when run, you must cause it, when started running for such
|
||||
interactive use in the most ordinary way, to print or display an
|
||||
announcement including an appropriate copyright notice and a
|
||||
notice that there is no warranty (or else, saying that you provide
|
||||
a warranty) and that users may redistribute the program under
|
||||
these conditions, and telling the user how to view a copy of this
|
||||
License. (Exception: if the Program itself is interactive but
|
||||
does not normally print such an announcement, your work based on
|
||||
the Program is not required to print an announcement.)
|
||||
|
||||
These requirements apply to the modified work as a whole. If
|
||||
identifiable sections of that work are not derived from the Program,
|
||||
and can be reasonably considered independent and separate works in
|
||||
themselves, then this License, and its terms, do not apply to those
|
||||
sections when you distribute them as separate works. But when you
|
||||
distribute the same sections as part of a whole which is a work based
|
||||
on the Program, the distribution of the whole must be on the terms of
|
||||
this License, whose permissions for other licensees extend to the
|
||||
entire whole, and thus to each and every part regardless of who wrote it.
|
||||
|
||||
Thus, it is not the intent of this section to claim rights or contest
|
||||
your rights to work written entirely by you; rather, the intent is to
|
||||
exercise the right to control the distribution of derivative or
|
||||
collective works based on the Program.
|
||||
|
||||
In addition, mere aggregation of another work not based on the Program
|
||||
with the Program (or with a work based on the Program) on a volume of
|
||||
a storage or distribution medium does not bring the other work under
|
||||
the scope of this License.
|
||||
|
||||
3. You may copy and distribute the Program (or a work based on it,
|
||||
under Section 2) in object code or executable form under the terms of
|
||||
Sections 1 and 2 above provided that you also do one of the following:
|
||||
|
||||
a) Accompany it with the complete corresponding machine-readable
|
||||
source code, which must be distributed under the terms of Sections
|
||||
1 and 2 above on a medium customarily used for software interchange; or,
|
||||
|
||||
b) Accompany it with a written offer, valid for at least three
|
||||
years, to give any third party, for a charge no more than your
|
||||
cost of physically performing source distribution, a complete
|
||||
machine-readable copy of the corresponding source code, to be
|
||||
distributed under the terms of Sections 1 and 2 above on a medium
|
||||
customarily used for software interchange; or,
|
||||
|
||||
c) Accompany it with the information you received as to the offer
|
||||
to distribute corresponding source code. (This alternative is
|
||||
allowed only for noncommercial distribution and only if you
|
||||
received the program in object code or executable form with such
|
||||
an offer, in accord with Subsection b above.)
|
||||
|
||||
The source code for a work means the preferred form of the work for
|
||||
making modifications to it. For an executable work, complete source
|
||||
code means all the source code for all modules it contains, plus any
|
||||
associated interface definition files, plus the scripts used to
|
||||
control compilation and installation of the executable. However, as a
|
||||
special exception, the source code distributed need not include
|
||||
anything that is normally distributed (in either source or binary
|
||||
form) with the major components (compiler, kernel, and so on) of the
|
||||
operating system on which the executable runs, unless that component
|
||||
itself accompanies the executable.
|
||||
|
||||
If distribution of executable or object code is made by offering
|
||||
access to copy from a designated place, then offering equivalent
|
||||
access to copy the source code from the same place counts as
|
||||
distribution of the source code, even though third parties are not
|
||||
compelled to copy the source along with the object code.
|
||||
|
||||
4. You may not copy, modify, sublicense, or distribute the Program
|
||||
except as expressly provided under this License. Any attempt
|
||||
otherwise to copy, modify, sublicense or distribute the Program is
|
||||
void, and will automatically terminate your rights under this License.
|
||||
However, parties who have received copies, or rights, from you under
|
||||
this License will not have their licenses terminated so long as such
|
||||
parties remain in full compliance.
|
||||
|
||||
5. You are not required to accept this License, since you have not
|
||||
signed it. However, nothing else grants you permission to modify or
|
||||
distribute the Program or its derivative works. These actions are
|
||||
prohibited by law if you do not accept this License. Therefore, by
|
||||
modifying or distributing the Program (or any work based on the
|
||||
Program), you indicate your acceptance of this License to do so, and
|
||||
all its terms and conditions for copying, distributing or modifying
|
||||
the Program or works based on it.
|
||||
|
||||
6. Each time you redistribute the Program (or any work based on the
|
||||
Program), the recipient automatically receives a license from the
|
||||
original licensor to copy, distribute or modify the Program subject to
|
||||
these terms and conditions. You may not impose any further
|
||||
restrictions on the recipients' exercise of the rights granted herein.
|
||||
You are not responsible for enforcing compliance by third parties to
|
||||
this License.
|
||||
|
||||
7. If, as a consequence of a court judgment or allegation of patent
|
||||
infringement or for any other reason (not limited to patent issues),
|
||||
conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot
|
||||
distribute so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you
|
||||
may not distribute the Program at all. For example, if a patent
|
||||
license would not permit royalty-free redistribution of the Program by
|
||||
all those who receive copies directly or indirectly through you, then
|
||||
the only way you could satisfy both it and this License would be to
|
||||
refrain entirely from distribution of the Program.
|
||||
|
||||
If any portion of this section is held invalid or unenforceable under
|
||||
any particular circumstance, the balance of the section is intended to
|
||||
apply and the section as a whole is intended to apply in other
|
||||
circumstances.
|
||||
|
||||
It is not the purpose of this section to induce you to infringe any
|
||||
patents or other property right claims or to contest validity of any
|
||||
such claims; this section has the sole purpose of protecting the
|
||||
integrity of the free software distribution system, which is
|
||||
implemented by public license practices. Many people have made
|
||||
generous contributions to the wide range of software distributed
|
||||
through that system in reliance on consistent application of that
|
||||
system; it is up to the author/donor to decide if he or she is willing
|
||||
to distribute software through any other system and a licensee cannot
|
||||
impose that choice.
|
||||
|
||||
This section is intended to make thoroughly clear what is believed to
|
||||
be a consequence of the rest of this License.
|
||||
|
||||
8. If the distribution and/or use of the Program is restricted in
|
||||
certain countries either by patents or by copyrighted interfaces, the
|
||||
original copyright holder who places the Program under this License
|
||||
may add an explicit geographical distribution limitation excluding
|
||||
those countries, so that distribution is permitted only in or among
|
||||
countries not thus excluded. In such case, this License incorporates
|
||||
the limitation as if written in the body of this License.
|
||||
|
||||
9. The Free Software Foundation may publish revised and/or new versions
|
||||
of the General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Program
|
||||
specifies a version number of this License which applies to it and "any
|
||||
later version", you have the option of following the terms and conditions
|
||||
either of that version or of any later version published by the Free
|
||||
Software Foundation. If the Program does not specify a version number of
|
||||
this License, you may choose any version ever published by the Free Software
|
||||
Foundation.
|
||||
|
||||
10. If you wish to incorporate parts of the Program into other free
|
||||
programs whose distribution conditions are different, write to the author
|
||||
to ask for permission. For software which is copyrighted by the Free
|
||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||
make exceptions for this. Our decision will be guided by the two goals
|
||||
of preserving the free status of all derivatives of our free software and
|
||||
of promoting the sharing and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||
REPAIR OR CORRECTION.
|
||||
|
||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
@@ -1,379 +0,0 @@
|
||||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
S3method("!=",amr_selector)
|
||||
S3method("&",amr_selector)
|
||||
S3method("+",ab)
|
||||
S3method("+",amr_selector)
|
||||
S3method("==",amr_selector)
|
||||
S3method("[",ab)
|
||||
S3method("[",av)
|
||||
S3method("[",disk)
|
||||
S3method("[",mic)
|
||||
S3method("[",mo)
|
||||
S3method("[<-",ab)
|
||||
S3method("[<-",av)
|
||||
S3method("[<-",disk)
|
||||
S3method("[<-",mic)
|
||||
S3method("[<-",mo)
|
||||
S3method("[<-",sir)
|
||||
S3method("[[",ab)
|
||||
S3method("[[",av)
|
||||
S3method("[[",disk)
|
||||
S3method("[[",mic)
|
||||
S3method("[[",mo)
|
||||
S3method("[[<-",ab)
|
||||
S3method("[[<-",av)
|
||||
S3method("[[<-",disk)
|
||||
S3method("[[<-",mic)
|
||||
S3method("[[<-",mo)
|
||||
S3method("[[<-",sir)
|
||||
S3method("|",amr_selector)
|
||||
S3method(Complex,mic)
|
||||
S3method(Math,mic)
|
||||
S3method(Ops,mic)
|
||||
S3method(Summary,mic)
|
||||
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.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,sir)
|
||||
S3method(c,ab)
|
||||
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,sir)
|
||||
S3method(close,progress_bar)
|
||||
S3method(droplevels,mic)
|
||||
S3method(droplevels,sir)
|
||||
S3method(format,bug_drug_combinations)
|
||||
S3method(hist,mic)
|
||||
S3method(kurtosis,data.frame)
|
||||
S3method(kurtosis,default)
|
||||
S3method(kurtosis,matrix)
|
||||
S3method(mean,mic)
|
||||
S3method(mean_amr_distance,data.frame)
|
||||
S3method(mean_amr_distance,default)
|
||||
S3method(mean_amr_distance,disk)
|
||||
S3method(mean_amr_distance,mic)
|
||||
S3method(mean_amr_distance,sir)
|
||||
S3method(median,mic)
|
||||
S3method(plot,antibiogram)
|
||||
S3method(plot,disk)
|
||||
S3method(plot,mic)
|
||||
S3method(plot,resistance_predict)
|
||||
S3method(plot,sir)
|
||||
S3method(print,ab)
|
||||
S3method(print,amr_selector)
|
||||
S3method(print,av)
|
||||
S3method(print,bug_drug_combinations)
|
||||
S3method(print,custom_eucast_rules)
|
||||
S3method(print,custom_mdro_guideline)
|
||||
S3method(print,disk)
|
||||
S3method(print,mic)
|
||||
S3method(print,mo)
|
||||
S3method(print,mo_renamed)
|
||||
S3method(print,mo_uncertainties)
|
||||
S3method(print,pca)
|
||||
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,sir)
|
||||
S3method(skewness,data.frame)
|
||||
S3method(skewness,default)
|
||||
S3method(skewness,matrix)
|
||||
S3method(sort,mic)
|
||||
S3method(summary,mic)
|
||||
S3method(summary,mo)
|
||||
S3method(summary,pca)
|
||||
S3method(summary,sir)
|
||||
S3method(unique,ab)
|
||||
S3method(unique,av)
|
||||
S3method(unique,disk)
|
||||
S3method(unique,mic)
|
||||
S3method(unique,mo)
|
||||
S3method(unique,sir)
|
||||
export("%like%")
|
||||
export("%like_case%")
|
||||
export("%unlike%")
|
||||
export("%unlike_case%")
|
||||
export(NA_disk_)
|
||||
export(NA_mic_)
|
||||
export(NA_sir_)
|
||||
export(ab_atc)
|
||||
export(ab_atc_group1)
|
||||
export(ab_atc_group2)
|
||||
export(ab_cid)
|
||||
export(ab_class)
|
||||
export(ab_ddd)
|
||||
export(ab_ddd_units)
|
||||
export(ab_from_text)
|
||||
export(ab_group)
|
||||
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)
|
||||
export(ab_url)
|
||||
export(add_custom_antimicrobials)
|
||||
export(add_custom_microorganisms)
|
||||
export(administrable_iv)
|
||||
export(administrable_per_os)
|
||||
export(age)
|
||||
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)
|
||||
export(as.ab)
|
||||
export(as.av)
|
||||
export(as.disk)
|
||||
export(as.mic)
|
||||
export(as.mo)
|
||||
export(as.sir)
|
||||
export(atc_online_ddd)
|
||||
export(atc_online_ddd_units)
|
||||
export(atc_online_groups)
|
||||
export(atc_online_property)
|
||||
export(av_atc)
|
||||
export(av_cid)
|
||||
export(av_ddd)
|
||||
export(av_ddd_units)
|
||||
export(av_from_text)
|
||||
export(av_group)
|
||||
export(av_info)
|
||||
export(av_loinc)
|
||||
export(av_name)
|
||||
export(av_property)
|
||||
export(av_synonyms)
|
||||
export(av_tradenames)
|
||||
export(av_url)
|
||||
export(availability)
|
||||
export(betalactams)
|
||||
export(betalactams_with_inhibitor)
|
||||
export(brmo)
|
||||
export(bug_drug_combinations)
|
||||
export(carbapenems)
|
||||
export(cephalosporins)
|
||||
export(cephalosporins_1st)
|
||||
export(cephalosporins_2nd)
|
||||
export(cephalosporins_3rd)
|
||||
export(cephalosporins_4th)
|
||||
export(cephalosporins_5th)
|
||||
export(clear_custom_antimicrobials)
|
||||
export(clear_custom_microorganisms)
|
||||
export(count_I)
|
||||
export(count_IR)
|
||||
export(count_R)
|
||||
export(count_S)
|
||||
export(count_SI)
|
||||
export(count_all)
|
||||
export(count_df)
|
||||
export(count_resistant)
|
||||
export(count_susceptible)
|
||||
export(custom_eucast_rules)
|
||||
export(custom_mdro_guideline)
|
||||
export(eucast_dosage)
|
||||
export(eucast_exceptional_phenotypes)
|
||||
export(eucast_rules)
|
||||
export(facet_sir)
|
||||
export(filter_first_isolate)
|
||||
export(first_isolate)
|
||||
export(fluoroquinolones)
|
||||
export(full_join_microorganisms)
|
||||
export(g.test)
|
||||
export(geom_sir)
|
||||
export(get_AMR_locale)
|
||||
export(get_episode)
|
||||
export(get_mo_source)
|
||||
export(ggplot_pca)
|
||||
export(ggplot_sir)
|
||||
export(ggplot_sir_predict)
|
||||
export(glycopeptides)
|
||||
export(guess_ab_col)
|
||||
export(inner_join_microorganisms)
|
||||
export(is.ab)
|
||||
export(is.av)
|
||||
export(is.disk)
|
||||
export(is.mic)
|
||||
export(is.mo)
|
||||
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_sir_count)
|
||||
export(left_join_microorganisms)
|
||||
export(like)
|
||||
export(lincosamides)
|
||||
export(lipoglycopeptides)
|
||||
export(macrolides)
|
||||
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)
|
||||
export(mo_current)
|
||||
export(mo_domain)
|
||||
export(mo_failures)
|
||||
export(mo_family)
|
||||
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)
|
||||
export(mo_is_gram_positive)
|
||||
export(mo_is_intrinsic_resistant)
|
||||
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)
|
||||
export(mo_pathogenicity)
|
||||
export(mo_phylum)
|
||||
export(mo_property)
|
||||
export(mo_rank)
|
||||
export(mo_ref)
|
||||
export(mo_renamed)
|
||||
export(mo_reset_session)
|
||||
export(mo_shortname)
|
||||
export(mo_snomed)
|
||||
export(mo_species)
|
||||
export(mo_status)
|
||||
export(mo_subspecies)
|
||||
export(mo_synonyms)
|
||||
export(mo_taxonomy)
|
||||
export(mo_type)
|
||||
export(mo_uncertainties)
|
||||
export(mo_url)
|
||||
export(mo_year)
|
||||
export(monobactams)
|
||||
export(mrgn)
|
||||
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)
|
||||
export(proportion_R)
|
||||
export(proportion_S)
|
||||
export(proportion_SI)
|
||||
export(proportion_df)
|
||||
export(quinolones)
|
||||
export(random_disk)
|
||||
export(random_mic)
|
||||
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(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)
|
||||
export(set_ab_names)
|
||||
export(set_mo_source)
|
||||
export(sir_confidence_interval)
|
||||
export(sir_df)
|
||||
export(sir_interpretation_history)
|
||||
export(sir_predict)
|
||||
export(skewness)
|
||||
export(streptogramins)
|
||||
export(sulfonamides)
|
||||
export(susceptibility)
|
||||
export(tetracyclines)
|
||||
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)
|
||||
importFrom(graphics,hist)
|
||||
importFrom(graphics,legend)
|
||||
importFrom(graphics,mtext)
|
||||
importFrom(graphics,plot)
|
||||
importFrom(graphics,points)
|
||||
importFrom(graphics,text)
|
||||
importFrom(stats,complete.cases)
|
||||
importFrom(stats,glm)
|
||||
importFrom(stats,lm)
|
||||
importFrom(stats,median)
|
||||
importFrom(stats,pchisq)
|
||||
importFrom(stats,prcomp)
|
||||
importFrom(stats,predict)
|
||||
importFrom(stats,qchisq)
|
||||
importFrom(stats,quantile)
|
||||
importFrom(stats,var)
|
||||
@@ -1,167 +0,0 @@
|
||||
# AMR 2.1.1.9270
|
||||
|
||||
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://amr-for-r.org/#get-this-package).)*
|
||||
|
||||
This package now supports not only tools for AMR data analysis in clinical settings, but also for veterinary and environmental microbiology. This was made possible through a collaboration with the [University of Prince Edward Island's Atlantic Veterinary College](https://www.upei.ca/avc), Canada. To celebrate this great improvement of the package, we also updated the package logo to reflect this change.
|
||||
|
||||
## tl;dr
|
||||
|
||||
- Scope Expansion: One Health support (Human + Veterinary + Environmental microbiology).
|
||||
- Data Updates:
|
||||
- `antibiotics` renamed to `antimicrobials`.
|
||||
- Veterinary antimicrobials and WHOCC codes added.
|
||||
- MycoBank fungal taxonomy integrated (+20,000 fungi).
|
||||
- Breakpoints & Interpretations:
|
||||
- CLSI/EUCAST 2024-2025 breakpoints added; EUCAST 2025 default.
|
||||
- `as.sir()` supports NI/SDD levels; parallel computation enabled.
|
||||
- Custom S/I/R/SDD/NI definitions allowed.
|
||||
- Improved handling of capped MICs.
|
||||
- New Tools & Functions:
|
||||
- WISCA antibiogram support (`antibiogram()`, `wisca()`).
|
||||
- New ggplot2 extensions: `scale_*_mic()`, `scale_*_sir()`, `rescale_mic()`.
|
||||
- New utility functions: `top_n_microorganisms()`, `mo_group_members()`, `mic_p50()`, `mic_p90()`.
|
||||
- Predictive Modelling:
|
||||
- Full tidymodels compatibility for antimicrobial selectors.
|
||||
- Deprecated `resistance_predict()` and `sir_predict()`.
|
||||
- Python Compatibility: AMR R package now runs in Python.
|
||||
- Selector Improvements:
|
||||
* Added selectors (`isoxazolylpenicillins()`, `monobactams()`, `nitrofurans()`, `phenicols()`, `rifamycins()`, and `sulfonamides()`)
|
||||
- Selectors renamed from `ab_*` to `amr_*`; old names deprecated.
|
||||
- MIC/Disks Handling:
|
||||
- MIC strict comparisons, added levels.
|
||||
- Disk diffusion range expanded (0–50 mm).
|
||||
- EUCAST Rules and MDROs:
|
||||
- EUCAST v12–v15 rules implemented.
|
||||
- Dutch MDRO 2024 guideline support in `mdro()`.
|
||||
- Infrastructure:
|
||||
- New website: https://amr-for-r.org.
|
||||
- Improved `vctrs` integration for tidyverse workflows.
|
||||
- Dropped SAS `.xpt` file support.
|
||||
- Other Fixes & Enhancements:
|
||||
- Support for 8 new languages, adding to a total of 28 languages.
|
||||
- Faster microorganism identification.
|
||||
- Improved antimicrobial and MIC handling.
|
||||
- Extended documentation, additional contributors acknowledged.
|
||||
|
||||
## Full Changelog
|
||||
|
||||
### Breaking
|
||||
* Dataset `antibiotics` has been renamed to `antimicrobials` as the data set contains more than just antibiotics. Using `antibiotics` will still work, but now returns a warning.
|
||||
* Removed all functions and references that used the deprecated `rsi` class, which were all replaced with their `sir` equivalents over two years ago.
|
||||
* Functions `resistance_predict()` and `sir_predict()` are now deprecated and will be removed in a future version. Use the `tidymodels` framework instead, for which we [wrote a basic introduction](https://amr-for-r.org/articles/AMR_with_tidymodels.html).
|
||||
|
||||
### New
|
||||
* **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://amr-for-r.org/articles/datasets.html).
|
||||
* The (new) `antimicrobials` data set contains all veterinary antimicrobials, such as pradofloxacin and enrofloxacin. All WHOCC codes for veterinary use have been added as well.
|
||||
* `ab_atc()` now supports ATC codes of veterinary antimicrobials (that all start with "Q")
|
||||
* `ab_url()` now supports retrieving the WHOCC url of their ATCvet pages
|
||||
* **Support for WISCA antibiograms**
|
||||
* The `antibiogram()` function now supports creating true Weighted-Incidence Syndromic Combination Antibiograms (WISCA), a powerful Bayesian method for estimating regimen coverage probabilities using pathogen incidence and antimicrobial susceptibility data. WISCA offers improved precision for syndrome-specific treatment, even in datasets with sparse data. A dedicated `wisca()` function is also available for easy usage.
|
||||
* **More global coverage of languages**
|
||||
* Added full support for 8 new languages: Arabic, Bengali, Hindi, Indonesian, Korean, Swahili, Urdu, and Vietnamese. The `AMR` package is now available in 28 languages.
|
||||
* **Major update to fungal taxonomy and tools for mycologists**
|
||||
* 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**
|
||||
* Breakpoint of 2024 and 2025 of both CLSI and EUCAST are now supported, by adding all of their over 10,000 new clinical breakpoints to the `clinical_breakpoints` data set for usage in `as.sir()`. EUCAST 2025 is now the new default guideline for all MIC and disk diffusion interpretations.
|
||||
* Added all Expected Resistant Phenotypes from EUCAST (v1.2). The default `rules` for `eucast_rules()` are now: `c("breakpoints", "expected_phenotypes")`.
|
||||
* Updated the `intrinsic_resistant` data set, which is now based on EUCAST Expected Resistant Phenotypes v1.2
|
||||
* `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), 14 (2024), and 15 (2025).
|
||||
* EUCAST dosage tables (`dosage` data set) are now available for EUCAST 13 (2023), 14 (2024), and 15 (2025).
|
||||
* **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://amr-for-r.org/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
|
||||
* SIR interpretation
|
||||
* Support for parallel computing to greatly improve speed using the `parallel` package (part of base R). Use `as.sir(your_data, parallel = TRUE)` to run SIR interpretation using multiple cores.
|
||||
* It is now possible to use column names for arguments `guideline`, `ab`, `mo`, and `uti`: `as.sir(..., ab = "column1", mo = "column2", uti = "column3")`. This greatly improves the flexibility for users.
|
||||
* Users can now set their own criteria (using regular expressions) as to what should be considered S, I, R, SDD, and NI.
|
||||
* To get quantitative values, `as.double()` on a `sir` object will return 1 for S, 2 for SDD/I, and 3 for R (NI will become `NA`). Other functions using `sir` classes (e.g., `summary()`) are updated to reflect the change to contain NI and SDD.
|
||||
* Following CLSI interpretation rules, values outside the log2-dilution range will be rounded upwards to the nearest log2-level before interpretation. Only if using a CLSI guideline.
|
||||
* Combined MIC values (e.g., from CLSI) are now supported
|
||||
* 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.
|
||||
* Added argument `info` to silence all console messages
|
||||
* `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 deprecated and `FALSE` at default since the denominators are added to the cells dependent on the `formatting_type` setting
|
||||
* 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()`, `rifamycins()`, and `sulfonamides()`
|
||||
* 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 (`BLA-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), an antimycotic, which is now also part of the `antifungals()` selector
|
||||
* Added cefepime/enmetazobactam (`FPE`), a 4th gen cephalosporin
|
||||
* Added tigemonam (`TNM`), a monobactam
|
||||
* Added bleomycin (`BLM`), a glycopeptide
|
||||
* Added efflux (`EFF`), to allow mapping to AMRFinderPlus
|
||||
* Updated all ATC codes, trade names, and DDDs
|
||||
* 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
|
||||
* `is.mic()` now returns a vector of `TRUE`/`FALSE` if the input is a `data.frame`, just like `as.sir()`
|
||||
* `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 antimicrobials and antimicrobial 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 antimicrobial DDDs from WHOCC
|
||||
* Fix for using a manual value for `mo_transform` in `antibiogram()`
|
||||
* Fixed a bug for when `antibiogram()` returns an empty data set
|
||||
* Fix for mapping 'high level' antimicrobials in `as.ab()` (amphotericin B-high, gentamicin-high, kanamycin-high, streptomycin-high, tobramycin-high)
|
||||
* Improved overall algorithm of `as.ab()` for better performance and accuracy, including the new function `as_reset_session()` to remove earlier coercions.
|
||||
* 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
|
||||
* New website domain: <https://amr-for-r.org>! The old domain will remain to work.
|
||||
* 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
|
||||
* Added Prof. Kathryn Holt, Dr. Jane Hawkey, and Dr. Natacha Couto as contributors for their many suggestions, ideas and bugfixes
|
||||
* 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.
|
||||
|
||||
## Older Versions
|
||||
|
||||
This changelog only contains changes from AMR v3.0 (March 2025) and later.
|
||||
|
||||
* For prior v2 versions, please see [our v2 archive](https://github.com/msberends/AMR/blob/v2.1.1/NEWS.md).
|
||||
* For prior v1 versions, please see [our v1 archive](https://github.com/msberends/AMR/blob/v1.8.2/NEWS.md).
|
||||
@@ -1,61 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' The `AMR` Package
|
||||
#'
|
||||
#' @description
|
||||
#' Welcome to the `AMR` package.
|
||||
#'
|
||||
#' The `AMR` package is a peer-reviewed, [free and open-source](https://amr-for-r.org/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. We are a team of [many different researchers](https://amr-for-r.org/authors.html) from around the globe to make this a successful and durable project!
|
||||
#'
|
||||
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
||||
#'
|
||||
#' After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated June 2024) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
||||
#'
|
||||
#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||
#' @section Download Our Reference Data:
|
||||
#' All reference data sets in the AMR package - including information on microorganisms, antimicrobials, and clinical breakpoints - are freely available for download in multiple formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, and Stata.
|
||||
#'
|
||||
#' For maximum compatibility, we also provide machine-readable, tab-separated plain text files suitable for use in any software, including laboratory information systems.
|
||||
#'
|
||||
#' Visit [our website for direct download links](https://amr-for-r.org/articles/datasets.html), or explore the actual files in [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw/datasets).
|
||||
#' @source
|
||||
#' To cite AMR in publications use:
|
||||
#'
|
||||
#' Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2022). "AMR: An R Package for Working with Antimicrobial Resistance Data." _Journal of Statistical Software_, *104*(3), 1-31. \doi{10.18637/jss.v104.i03}
|
||||
#'
|
||||
#' A BibTeX entry for LaTeX users is:
|
||||
#'
|
||||
#' \preformatted{
|
||||
#' `r format(citation("AMR"), style = "bib")`
|
||||
#' }
|
||||
#' @name AMR
|
||||
#' @keywords internal
|
||||
#' @rdname AMR
|
||||
"_PACKAGE"
|
||||
-241
@@ -1,241 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and clinical_breakpoints
|
||||
# (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
|
||||
EUCAST_VERSION_BREAKPOINTS <- list(
|
||||
"15.0" = list(
|
||||
version_txt = "v15.0",
|
||||
year = 2025,
|
||||
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,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"
|
||||
),
|
||||
"11.0" = list(
|
||||
version_txt = "v11.0",
|
||||
year = 2021,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/clinical_breakpoints/"
|
||||
),
|
||||
"10.0" = list(
|
||||
version_txt = "v10.0",
|
||||
year = 2020,
|
||||
title = "'EUCAST Clinical Breakpoint Tables'",
|
||||
url = "https://www.eucast.org/ast_of_bacteria/previous_versions_of_documents/"
|
||||
)
|
||||
)
|
||||
EUCAST_VERSION_EXPERT_RULES <- list(
|
||||
"3.3" = list(
|
||||
version_txt = "v3.3",
|
||||
year = 2021,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
),
|
||||
"3.2" = list(
|
||||
version_txt = "v3.2",
|
||||
year = 2020,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
),
|
||||
"3.1" = list(
|
||||
version_txt = "v3.1",
|
||||
year = 2016,
|
||||
title = "'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
)
|
||||
)
|
||||
EUCAST_VERSION_EXPECTED_PHENOTYPES <- list(
|
||||
"1.2" = list(
|
||||
version_txt = "v1.2",
|
||||
year = 2023,
|
||||
title = "'EUCAST Expected Resistant Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
)
|
||||
)
|
||||
|
||||
TAXONOMY_VERSION <- list(
|
||||
GBIF = list(
|
||||
name = "Global Biodiversity Information Facility (GBIF)",
|
||||
accessed_date = as.Date("2024-06-24"),
|
||||
citation = "GBIF Secretariat (2023). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
|
||||
url = "https://www.gbif.org"
|
||||
),
|
||||
LPSN = list(
|
||||
name = "List of Prokaryotic names with Standing in Nomenclature (LPSN)",
|
||||
accessed_date = as.Date("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(
|
||||
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(
|
||||
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://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"
|
||||
),
|
||||
ATC_DDD = list(
|
||||
name = "ATC/DDD Index",
|
||||
accessed_date = as.Date("2025-05-04"),
|
||||
citation = "WHO Collaborating Centre for Drug Statistics Methodology, Guidelines for ATC classification and DDD assignment, Oslo",
|
||||
url = "https://atcddd.fhi.no/atc_ddd_index/"
|
||||
)
|
||||
)
|
||||
|
||||
globalVariables(c(
|
||||
".GenericCallEnv",
|
||||
".mo",
|
||||
".rowid",
|
||||
".syndromic_group",
|
||||
"ab",
|
||||
"ab_txt",
|
||||
"affect_ab_name",
|
||||
"affect_mo_name",
|
||||
"angle",
|
||||
"antibiotic",
|
||||
"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",
|
||||
"dose",
|
||||
"dose_times",
|
||||
"fullname",
|
||||
"fullname_lower",
|
||||
"g_species",
|
||||
"gamma_posterior",
|
||||
"genus",
|
||||
"gr",
|
||||
"group",
|
||||
"guideline",
|
||||
"hjust",
|
||||
"host_index",
|
||||
"host_match",
|
||||
"input",
|
||||
"input_given",
|
||||
"intrinsic_resistant",
|
||||
"isolates",
|
||||
"lang",
|
||||
"language",
|
||||
"lookup",
|
||||
"lower",
|
||||
"lower_ci",
|
||||
"method",
|
||||
"mic ",
|
||||
"mic",
|
||||
"microorganism",
|
||||
"microorganisms",
|
||||
"microorganisms.codes",
|
||||
"mo",
|
||||
"n",
|
||||
"n_susceptible",
|
||||
"n_tested",
|
||||
"n_total",
|
||||
"name",
|
||||
"new",
|
||||
"numerator",
|
||||
"observations",
|
||||
"old",
|
||||
"old_name",
|
||||
"p_susceptible",
|
||||
"pattern",
|
||||
"R",
|
||||
"rank_index",
|
||||
"ref_tbl",
|
||||
"reference.rule",
|
||||
"reference.rule_group",
|
||||
"reference.version",
|
||||
"rowid",
|
||||
"rule_group",
|
||||
"rule_name",
|
||||
"se_max",
|
||||
"se_min",
|
||||
"SI",
|
||||
"sir",
|
||||
"species",
|
||||
"syndromic_group",
|
||||
"total",
|
||||
"total_rows",
|
||||
"txt",
|
||||
"type",
|
||||
"upper",
|
||||
"upper_ci",
|
||||
"uti_index",
|
||||
"value",
|
||||
"varname",
|
||||
"x",
|
||||
"xvar",
|
||||
"y",
|
||||
"year",
|
||||
"yvar"
|
||||
))
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,83 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Options for the AMR package
|
||||
#'
|
||||
#' This is an overview of all the package-specific [options()] you can set in the `AMR` package.
|
||||
#' @section Options:
|
||||
#' * `AMR_antibiogram_formatting_type` \cr A [numeric] (1-22) to use in [antibiogram()], to indicate which formatting type to use.
|
||||
#' * `AMR_breakpoint_type` \cr A [character] to use in [as.sir()], to indicate which breakpoint type to use. This must be either `r vector_or(clinical_breakpoints$type)`.
|
||||
#' * `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_substitute_missing_r_breakpoint` \cr A [logical] to use in [as.sir()], to indicate that missing R breakpoints must be substituted with `"R"` - the default is `FALSE`.
|
||||
#' * `AMR_include_screening` \cr A [logical] to use in [as.sir()], to indicate that clinical breakpoints for screening are allowed - the default is `FALSE`.
|
||||
#' * `AMR_keep_synonyms` \cr A [logical] to use in [as.mo()] and all [`mo_*`][mo_property()] functions, to indicate if old, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. The default is `FALSE`.
|
||||
#' * `AMR_locale` \cr A [character] to set the language for the `AMR` package, can be one of these supported language names or [ISO 639-1 codes](https://en.wikipedia.org/wiki/ISO_639-1): `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. The default is the current system language (if supported, English otherwise).
|
||||
#' * `AMR_mo_source` \cr A file location for a manual code list to be used in [as.mo()] and all [`mo_*`][mo_property()] functions. This is explained in [set_mo_source()].
|
||||
#'
|
||||
#' @section Saving Settings Between Sessions:
|
||||
#' Settings in \R are not saved globally and are thus lost when \R is exited. You can save your options to your own `.Rprofile` file, which is a user-specific file. You can edit it using:
|
||||
#'
|
||||
#' ```r
|
||||
#' utils::file.edit("~/.Rprofile")
|
||||
#' ```
|
||||
#'
|
||||
#' 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 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, 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.
|
||||
#'
|
||||
#' 2. For each user, open the `.Rprofile` file using `utils::file.edit("~/.Rprofile")` and put in there:
|
||||
#'
|
||||
#' ```r
|
||||
#' source("X:/team_folder/R_options.R")
|
||||
#' ```
|
||||
#'
|
||||
#' 3. Reload R/RStudio and check the settings with [getOption()], e.g. `getOption("AMR_locale")` if you have set that value.
|
||||
#'
|
||||
#' Now the team settings are configured in only one place, and can be maintained there.
|
||||
#' @keywords internal
|
||||
#' @name AMR-options
|
||||
NULL
|
||||
@@ -1,693 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform Input to an Antibiotic ID
|
||||
#'
|
||||
#' Use this function to determine the antimicrobial drug code of one or more antimicrobials. The data set [antimicrobials] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x A [character] vector to determine to antibiotic ID.
|
||||
#' @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 [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:
|
||||
#'
|
||||
#' * Wrong spelling of drug names (such as "tobramicin" or "gentamycin"), which corrects for most audible similarities such as f/ph, x/ks, c/z/s, t/th, etc.
|
||||
#' * Too few or too many vowels or consonants
|
||||
#' * Switching two characters (such as "mreopenem", often the case in clinical data, when doctors typed too fast)
|
||||
#' * Digitalised paper records, leaving artefacts like 0/o/O (zero and O's), B/8, n/r, etc.
|
||||
#'
|
||||
#' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see *Examples*.
|
||||
#'
|
||||
#' Note: the [as.ab()] and [`ab_*`][ab_property()] functions may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems.
|
||||
#'
|
||||
#' You can add your own manual codes to be considered by [as.ab()] and all [`ab_*`][ab_property()] functions, see [add_custom_antimicrobials()].
|
||||
#' @section Source:
|
||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
|
||||
#'
|
||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm}
|
||||
#' @aliases ab
|
||||
#' @return A [character] [vector] with additional class [`ab`]
|
||||
#' @seealso
|
||||
#' * [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 Download Our Reference Data
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # these examples all return "ERY", the ID of erythromycin:
|
||||
#' as.ab("J01FA01")
|
||||
#' as.ab("J 01 FA 01")
|
||||
#' as.ab("Erythromycin")
|
||||
#' as.ab("eryt")
|
||||
#' as.ab("ERYT")
|
||||
#' as.ab("ERY")
|
||||
#' as.ab("eritromicine") # spelled wrong, yet works
|
||||
#' as.ab("Erythrocin") # trade name
|
||||
#'
|
||||
#' # spelling from different languages and dyslexia are no problem
|
||||
#' ab_atc("ceftriaxon")
|
||||
#' ab_atc("cephtriaxone") # small spelling error
|
||||
#' ab_atc("cephthriaxone") # or a bit more severe
|
||||
#' ab_atc("seephthriaaksone") # and even this works
|
||||
#'
|
||||
#' # use ab_* functions to get a specific properties (see ?ab_property);
|
||||
#' # they use as.ab() internally:
|
||||
#' ab_name("J01FA01")
|
||||
#' ab_name("eryt")
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # you can quickly rename 'sir' columns using set_ab_names() with dplyr:
|
||||
#' example_isolates %>%
|
||||
#' set_ab_names(where(is.sir), property = "atc")
|
||||
#' }
|
||||
#' }
|
||||
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) || 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")
|
||||
))
|
||||
}
|
||||
|
||||
already_regex <- isTRUE(list(...)$already_regex)
|
||||
fast_mode <- isTRUE(list(...)$fast_mode)
|
||||
|
||||
x_bak <- x
|
||||
x <- toupper(x)
|
||||
|
||||
# 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?$|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) {
|
||||
x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
|
||||
}
|
||||
|
||||
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(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) {
|
||||
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 if (isTRUE(info)) {
|
||||
message_(
|
||||
"More than one result was found for item ", index, ": ",
|
||||
vector_and(abnames, quotes = FALSE)
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
found[1L]
|
||||
}
|
||||
|
||||
# Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase)
|
||||
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), gsub(" ", "", x), function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE)
|
||||
known_codes_synonyms <- vapply(FUN.VALUE = logical(1), gsub(" ", "", tolower(x)), function(x_) x_ %in% tolower(unlist(AMR_env$AB_lookup$synonyms)), USE.NAMES = FALSE)
|
||||
known_codes_cid <- x %in% AMR_env$AB_lookup$cid
|
||||
x_new[known_codes_ab] <- AMR_env$AB_lookup$ab[match(x[known_codes_ab], AMR_env$AB_lookup$ab)]
|
||||
x_new[known_codes_atc] <- AMR_env$AB_lookup$ab[vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
gsub(" ", "", x[known_codes_atc]),
|
||||
function(x_) {
|
||||
which(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
AMR_env$AB_lookup$atc,
|
||||
function(atc) x_ %in% atc
|
||||
))[1L]
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)]
|
||||
x_new[known_codes_synonyms] <- AMR_env$AB_lookup$ab[vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
gsub(" ", "", tolower(x[known_codes_synonyms])),
|
||||
function(x_) {
|
||||
which(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
AMR_env$AB_lookup$synonyms,
|
||||
function(syns) x_ %in% tolower(syns)
|
||||
))[1L]
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)]
|
||||
x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)]
|
||||
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_synonyms | known_codes_cid | previously_coerced
|
||||
|
||||
# fix for NAs
|
||||
x_new[is.na(x)] <- NA
|
||||
already_known[is.na(x)] <- FALSE
|
||||
|
||||
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)) {
|
||||
progress$tick()
|
||||
|
||||
if (is.na(x[i]) || is.null(x[i])) {
|
||||
next
|
||||
}
|
||||
if (identical(x[i], "") ||
|
||||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it:
|
||||
identical(tolower(x[i]), "bacteria")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
if (x[i] %like_case% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]") {
|
||||
# seems an ATC code, but the available ones are in `already_known`, so:
|
||||
x_unknown <- c(x_unknown, x[i])
|
||||
x_unknown_ATCs <- c(x_unknown_ATCs, x[i])
|
||||
x_new[i] <- NA_character_
|
||||
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], translate_ab = FALSE)[[1]]),
|
||||
error = function(e) character(0)
|
||||
)
|
||||
} else {
|
||||
from_text <- character(0)
|
||||
}
|
||||
|
||||
# old code for phenoxymethylpenicillin (Peni V)
|
||||
if (x[i] == "PNV") {
|
||||
x_new[i] <- "PHN"
|
||||
next
|
||||
}
|
||||
|
||||
# exact LOINC code
|
||||
loinc_found <- unlist(lapply(
|
||||
AMR_env$AB_lookup$generalised_loinc,
|
||||
function(s) x[i] %in% s
|
||||
))
|
||||
found <- AMR_env$AB_lookup$ab[loinc_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# exact synonym
|
||||
synonym_found <- unlist(lapply(
|
||||
AMR_env$AB_lookup$generalised_synonyms,
|
||||
function(s) x[i] %in% s
|
||||
))
|
||||
found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# exact abbreviation
|
||||
abbr_found <- unlist(lapply(
|
||||
AMR_env$AB_lookup$generalised_abbreviations,
|
||||
# require at least 2 characters for abbreviations
|
||||
function(s) x[i] %in% s && nchar(x[i]) >= 2
|
||||
))
|
||||
found <- AMR_env$AB_lookup$ab[abbr_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# length of input is quite long, and Levenshtein distance is only max 2
|
||||
if (nchar(x[i]) >= 10) {
|
||||
levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name))
|
||||
if (any(levenshtein <= 2)) {
|
||||
found <- AMR_env$AB_lookup$ab[which(levenshtein <= 2)]
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# allow characters that resemble others, but only continue when having more than 3 characters
|
||||
if (nchar(x[i]) <= 3) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
x_spelling <- x[i]
|
||||
if (already_regex == FALSE) {
|
||||
x_spelling <- gsub("[IY]+", "[IY]+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(TH|T)+", "(TH|T)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("A+", "A+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("E+", "E+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("O+", "O+", x_spelling, perl = TRUE)
|
||||
# allow any ending of -in/-ine and -im/-ime
|
||||
x_spelling <- gsub("(\\[IY\\]\\+(N|M)|\\[IY\\]\\+(N|M)E\\+?)$", "[IY]+(N|M)E*", x_spelling, perl = TRUE)
|
||||
# allow any ending of -ol/-ole
|
||||
x_spelling <- gsub("(O\\+L|O\\+LE\\+)$", "O+LE*", x_spelling, perl = TRUE)
|
||||
# allow any ending of -on/-one
|
||||
x_spelling <- gsub("(O\\+N|O\\+NE\\+)$", "O+NE*", x_spelling, perl = TRUE)
|
||||
# replace multiple same characters to single one with '+', like "ll" -> "l+"
|
||||
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling, perl = TRUE)
|
||||
# replace spaces and slashes with a possibility on both
|
||||
x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling, perl = TRUE)
|
||||
# correct for digital reading text (OCR)
|
||||
x_spelling <- gsub("[NRD8B]", "[NRD8B]", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("++", "+", x_spelling, fixed = TRUE)
|
||||
}
|
||||
|
||||
# try if name starts with it
|
||||
found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE]
|
||||
if (length(found) > 0) {
|
||||
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) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# and try if any synonym starts with it
|
||||
synonym_found <- unlist(lapply(
|
||||
AMR_env$AB_lookup$generalised_synonyms,
|
||||
function(s) any(s %like% paste0("^", x_spelling))
|
||||
))
|
||||
found <- AMR_env$AB_lookup$ab[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# 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(all(is.na(y)) || length(y[nchar(y) >= 5]) == 0,
|
||||
999,
|
||||
min(as.double(utils::adist(x[i], y[nchar(y) >= 5],
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 1, substitutions = 2),
|
||||
counts = FALSE
|
||||
)), na.rm = TRUE)
|
||||
)
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
if (!is.null(language) && language != "en") {
|
||||
ab_df$trans <- 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 {
|
||||
ab_df$lev_trans <- ab_df$lev_name
|
||||
}
|
||||
|
||||
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
|
||||
} 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
|
||||
} 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
|
||||
} 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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# nothing found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
||||
if (sum(already_known) < length(x)) {
|
||||
close(progress)
|
||||
}
|
||||
|
||||
# save to package env to save time for next time
|
||||
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 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: ",
|
||||
vector_and(x_unknown), "."
|
||||
)
|
||||
}
|
||||
|
||||
# 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_
|
||||
}
|
||||
|
||||
set_clean_class(x_result,
|
||||
new_class = c("ab", "character")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname as.ab
|
||||
#' @export
|
||||
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)]
|
||||
)
|
||||
}
|
||||
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
type_sum.ab <- function(x, ...) {
|
||||
"ab"
|
||||
}
|
||||
|
||||
#' @method print ab
|
||||
#' @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)
|
||||
}
|
||||
|
||||
#' @method as.data.frame ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.ab <- function(x, ...) {
|
||||
nm <- deparse1(substitute(x))
|
||||
if (!"nm" %in% names(list(...))) {
|
||||
as.data.frame.vector(as.ab(x), ..., nm = nm)
|
||||
} else {
|
||||
as.data.frame.vector(as.ab(x), ...)
|
||||
}
|
||||
}
|
||||
#' @method [ ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[.ab" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [[ ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.ab" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [<- ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
return_after_integrity_check(y, "antimicrobial drug code", AMR_env$AB_lookup$ab)
|
||||
}
|
||||
#' @method [[<- ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.ab" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
return_after_integrity_check(y, "antimicrobial drug code", AMR_env$AB_lookup$ab)
|
||||
}
|
||||
#' @method c ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.ab <- function(...) {
|
||||
x <- list(...)[[1L]]
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
return_after_integrity_check(y, "antimicrobial drug code", AMR_env$AB_lookup$ab)
|
||||
}
|
||||
|
||||
#' @method unique ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
unique.ab <- function(x, incomparables = FALSE, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
#' @method rep ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
rep.ab <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
#' @method + ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
`+.ab` <- function(e1, e2) {
|
||||
# this does not return ab class, it should just allow console usage of e.g., carbapenems() + c("", aminoglycosides())
|
||||
out <- as.character(outer(e1, e2, paste, sep = " + "))
|
||||
out <- gsub(" [+] $", "", out)
|
||||
out
|
||||
}
|
||||
|
||||
generalise_antibiotic_name <- function(x) {
|
||||
x <- toupper(x)
|
||||
# remove suffices
|
||||
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)
|
||||
# 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)
|
||||
# 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
|
||||
}
|
||||
|
||||
get_translate_ab <- function(translate_ab) {
|
||||
translate_ab <- as.character(translate_ab)[1L]
|
||||
if (translate_ab %in% c("TRUE", "official")) {
|
||||
return("name")
|
||||
} else if (translate_ab %in% c(NA_character_, "FALSE")) {
|
||||
return(FALSE)
|
||||
} else {
|
||||
translate_ab <- tolower(translate_ab)
|
||||
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"]]
|
||||
}
|
||||
@@ -1,230 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Retrieve Antimicrobial Drug Names and Doses from Clinical Text
|
||||
#'
|
||||
#' Use this function on e.g. clinical texts from health care records. It returns a [list] with all antimicrobial drugs, doses and forms of administration found in the texts.
|
||||
#' @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 [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()].
|
||||
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.ab()] function may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems.
|
||||
#'
|
||||
#' ### Argument `type`
|
||||
#' At default, the function will search for antimicrobial drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.ab()] internally, it will correct for misspelling.
|
||||
#'
|
||||
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for [numeric] values that are higher than 100 and do not resemble years. The output will be [numeric]. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' ### Argument `collapse`
|
||||
#' Without using `collapse`, this function will return a [list]. This can be convenient to use e.g. inside a `mutate()`):\cr
|
||||
#' `df %>% mutate(abx = ab_from_text(clinical_text))`
|
||||
#'
|
||||
#' The returned AB codes can be transformed to official names, groups, etc. with all [`ab_*`][ab_property()] functions such as [ab_name()] and [ab_group()], or by using the `translate_ab` argument.
|
||||
#'
|
||||
#' With using `collapse`, this function will return a [character]:\cr
|
||||
#' `df %>% mutate(abx = ab_from_text(clinical_text, collapse = "|"))`
|
||||
#' @export
|
||||
#' @return A [list], or a [character] if `collapse` is not `NULL`
|
||||
#' @examples
|
||||
#' # mind the bad spelling of amoxicillin in this line,
|
||||
#' # straight from a true health care record:
|
||||
#' ab_from_text("28/03/2020 regular amoxicilliin 500mg po tid")
|
||||
#'
|
||||
#' ab_from_text("500 mg amoxi po and 400mg cipro iv")
|
||||
#' ab_from_text("500 mg amoxi po and 400mg cipro iv", type = "dose")
|
||||
#' ab_from_text("500 mg amoxi po and 400mg cipro iv", type = "admin")
|
||||
#'
|
||||
#' ab_from_text("500 mg amoxi po and 400mg cipro iv", collapse = ", ")
|
||||
#' \donttest{
|
||||
#' # if you want to know which antibiotic groups were administered, do e.g.:
|
||||
#' abx <- ab_from_text("500 mg amoxi po and 400mg cipro iv")
|
||||
#' ab_group(abx[[1]])
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' tibble(clinical_text = c(
|
||||
#' "given 400mg cipro and 500 mg amox",
|
||||
#' "started on doxy iv today"
|
||||
#' )) %>%
|
||||
#' mutate(
|
||||
#' abx_codes = ab_from_text(clinical_text),
|
||||
#' abx_doses = ab_from_text(clinical_text, type = "doses"),
|
||||
#' abx_admin = ab_from_text(clinical_text, type = "admin"),
|
||||
#' abx_coll = ab_from_text(clinical_text, collapse = "|"),
|
||||
#' abx_coll_names = ab_from_text(clinical_text,
|
||||
#' collapse = "|",
|
||||
#' translate_ab = "name"
|
||||
#' ),
|
||||
#' abx_coll_doses = ab_from_text(clinical_text,
|
||||
#' type = "doses",
|
||||
#' collapse = "|"
|
||||
#' ),
|
||||
#' abx_coll_admin = ab_from_text(clinical_text,
|
||||
#' type = "admin",
|
||||
#' collapse = "|"
|
||||
#' )
|
||||
#' )
|
||||
#' }
|
||||
#' }
|
||||
ab_from_text <- function(text,
|
||||
type = c("drug", "dose", "administration"),
|
||||
collapse = NULL,
|
||||
translate_ab = FALSE,
|
||||
thorough_search = NULL,
|
||||
info = interactive(),
|
||||
...) {
|
||||
if (missing(type)) {
|
||||
type <- type[1L]
|
||||
}
|
||||
|
||||
meet_criteria(text)
|
||||
meet_criteria(type, allow_class = "character", has_length = 1)
|
||||
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(translate_ab, allow_NULL = FALSE) # get_translate_ab() will be more informative about what's allowed
|
||||
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
type <- tolower(trimws2(type))
|
||||
|
||||
text <- tolower(as.character(text))
|
||||
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
||||
on.exit(close(progress))
|
||||
|
||||
if (type %like% "(drug|ab|anti)") {
|
||||
translate_ab <- get_translate_ab(translate_ab)
|
||||
|
||||
if (isTRUE(thorough_search) ||
|
||||
(isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) {
|
||||
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::antimicrobials$abbreviations)
|
||||
abbr <- abbr[nchar(abbr) >= 4]
|
||||
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))]
|
||||
synonyms_part2 <- synonyms[!synonyms %in% synonyms_part1]
|
||||
to_regex <- function(x) {
|
||||
paste0(
|
||||
"^(",
|
||||
paste0(unique(gsub("[^a-z0-9]+", "", sort(tolower(x)))), collapse = "|"),
|
||||
").*"
|
||||
)
|
||||
}
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
progress$tick()
|
||||
suppressWarnings(
|
||||
as.ab(
|
||||
unique(c(
|
||||
text_split[text_split %like_case% to_regex(abbr)],
|
||||
text_split[text_split %like_case% to_regex(names_atc)],
|
||||
text_split[text_split %like_case% to_regex(synonyms_part1)],
|
||||
text_split[text_split %like_case% to_regex(synonyms_part2)]
|
||||
)),
|
||||
...
|
||||
)
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
close(progress)
|
||||
|
||||
result <- lapply(result, function(out) {
|
||||
out <- out[!is.na(out)]
|
||||
if (length(out) == 0) {
|
||||
as.ab(NA)
|
||||
} else {
|
||||
if (!isFALSE(translate_ab)) {
|
||||
out <- ab_property(out, property = translate_ab, initial_search = FALSE)
|
||||
}
|
||||
out
|
||||
}
|
||||
})
|
||||
} else if (type %like% "dos") {
|
||||
text_split_all <- strsplit(text, " ", fixed = TRUE)
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
text_split <- text_split[text_split %like% "^[0-9]{2,}(/[0-9]+)?[a-z]*$"]
|
||||
# only left part of "/", like 500 in "500/125"
|
||||
text_split <- gsub("/.*", "", text_split)
|
||||
text_split <- gsub(",", ".", text_split, fixed = TRUE) # foreign system using comma as decimal sep
|
||||
text_split <- as.double(gsub("[^0-9.]", "", text_split))
|
||||
# minimal 100 units/mg and no years that unlikely doses
|
||||
text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)]
|
||||
|
||||
if (length(text_split) > 0) {
|
||||
text_split
|
||||
} else {
|
||||
NA_real_
|
||||
}
|
||||
})
|
||||
} else if (type %like% "adm") {
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
text_split <- text_split[text_split %like% "(^iv$|intraven|^po$|per os|oral|implant|inhal|instill|nasal|paren|rectal|sublingual|buccal|trans.*dermal|vaginal)"]
|
||||
if (length(text_split) > 0) {
|
||||
text_split <- gsub("(^po$|.*per os.*)", "oral", text_split)
|
||||
text_split <- gsub("(^iv$|.*intraven.*)", "iv", text_split)
|
||||
text_split
|
||||
} else {
|
||||
NA_character_
|
||||
}
|
||||
})
|
||||
} else {
|
||||
stop_("`type` must be either 'drug', 'dose' or 'administration'")
|
||||
}
|
||||
|
||||
# collapse text if needed
|
||||
if (!is.null(collapse)) {
|
||||
result <- vapply(FUN.VALUE = character(1), result, function(x) {
|
||||
if (length(x) == 1 & all(is.na(x))) {
|
||||
NA_character_
|
||||
} else {
|
||||
paste0(x, collapse = collapse)
|
||||
}
|
||||
})
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
-471
@@ -1,471 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get Properties of an Antibiotic
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antibiotic from the [antimicrobials] data set. All input values will be evaluated internally with [as.ab()].
|
||||
#' @param x Any (vector of) text that can be coerced to a valid antibiotic drug code with [as.ab()].
|
||||
#' @param tolower A [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
|
||||
#' @param property One of the column names of one of the [antimicrobials] data set: `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()].
|
||||
#' @param data A [data.frame] of which the columns need to be renamed, or a [character] vector of column names.
|
||||
#' @param snake_case A [logical] to indicate whether the names should be in so-called [snake case](https://en.wikipedia.org/wiki/Snake_case): in lower case and all spaces/slashes replaced with an underscore (`_`).
|
||||
#' @param only_first A [logical] to indicate whether only the first ATC code must be returned, with giving preference to J0-codes (i.e., the antimicrobial drug group).
|
||||
#' @details All output [will be translated][translate] where possible.
|
||||
#'
|
||||
#' The function [ab_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
|
||||
#'
|
||||
#' The function [set_ab_names()] is a special column renaming function for [data.frame]s. It renames columns names that resemble antimicrobial drugs. It always makes sure that the new column names are unique. If `property = "atc"` is set, preference is given to ATC codes from the J-group.
|
||||
#' @inheritSection as.ab Source
|
||||
#' @rdname ab_property
|
||||
#' @name ab_property
|
||||
#' @return
|
||||
#' - An [integer] in case of [ab_cid()]
|
||||
#' - A named [list] in case of [ab_info()] and multiple [ab_atc()]/[ab_synonyms()]/[ab_tradenames()]
|
||||
#' - A [double] in case of [ab_ddd()]
|
||||
#' - A [data.frame] in case of [set_ab_names()]
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso [antimicrobials]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' # all properties:
|
||||
#' ab_name("AMX")
|
||||
#' ab_atc("AMX")
|
||||
#' ab_cid("AMX")
|
||||
#' ab_synonyms("AMX")
|
||||
#' ab_tradenames("AMX")
|
||||
#' ab_group("AMX")
|
||||
#' ab_atc_group1("AMX")
|
||||
#' ab_atc_group2("AMX")
|
||||
#' ab_url("AMX")
|
||||
#'
|
||||
#' # smart lowercase transformation
|
||||
#' ab_name(x = c("AMC", "PLB"))
|
||||
#' ab_name(x = c("AMC", "PLB"), tolower = TRUE)
|
||||
#'
|
||||
#' # defined daily doses (DDD)
|
||||
#' ab_ddd("AMX", "oral")
|
||||
#' ab_ddd_units("AMX", "oral")
|
||||
#' ab_ddd("AMX", "iv")
|
||||
#' ab_ddd_units("AMX", "iv")
|
||||
#'
|
||||
#' ab_info("AMX") # all properties as a list
|
||||
#'
|
||||
#' # all ab_* functions use as.ab() internally, so you can go from 'any' to 'any':
|
||||
#' ab_atc("AMP")
|
||||
#' ab_group("J01CA01")
|
||||
#' ab_loinc("ampicillin")
|
||||
#' ab_name("21066-6")
|
||||
#' ab_name(6249)
|
||||
#' ab_name("J01CA01")
|
||||
#'
|
||||
#' # spelling from different languages and dyslexia are no problem
|
||||
#' ab_atc("ceftriaxon")
|
||||
#' ab_atc("cephtriaxone")
|
||||
#' ab_atc("cephthriaxone")
|
||||
#' ab_atc("seephthriaaksone")
|
||||
#'
|
||||
#' # use set_ab_names() for renaming columns
|
||||
#' colnames(example_isolates)
|
||||
#' colnames(set_ab_names(example_isolates))
|
||||
#' colnames(set_ab_names(example_isolates, NIT:VAN))
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' set_ab_names()
|
||||
#'
|
||||
#' # this does the same:
|
||||
#' example_isolates %>%
|
||||
#' rename_with(set_ab_names)
|
||||
#'
|
||||
#' # set_ab_names() works with any AB property:
|
||||
#' example_isolates %>%
|
||||
#' set_ab_names(property = "atc")
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' set_ab_names(where(is.sir)) %>%
|
||||
#' colnames()
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' set_ab_names(NIT:VAN) %>%
|
||||
#' colnames()
|
||||
#' }
|
||||
#' }
|
||||
ab_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(tolower, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- translate_into_language(ab_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
|
||||
if (tolower == TRUE) {
|
||||
# use perl to only transform the first character
|
||||
# as we want "polymyxin B", not "polymyxin b"
|
||||
x <- gsub("^([A-Z])", "\\L\\1", x, perl = TRUE)
|
||||
}
|
||||
x
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_cid <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
ab_validate(x = x, property = "cid", ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_synonyms <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
syns <- ab_validate(x = x, property = "synonyms", ...)
|
||||
names(syns) <- x
|
||||
if (length(syns) == 1) {
|
||||
unname(unlist(syns))
|
||||
} else {
|
||||
syns
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_tradenames <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
ab_synonyms(x, ...)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_group <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(ab_validate(x = x, property = "group", ...), language = language, only_affect_ab_names = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @aliases ATC
|
||||
#' @export
|
||||
ab_atc <- function(x, only_first = FALSE, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(only_first, allow_class = "logical", has_length = 1)
|
||||
|
||||
atcs <- ab_validate(x = x, property = "atc", ...)
|
||||
|
||||
if (only_first == TRUE) {
|
||||
atcs <- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
# get only the first ATC code
|
||||
atcs,
|
||||
function(x) {
|
||||
# try to get the J-group
|
||||
if (any(x %like% "^J")) {
|
||||
x[x %like% "^J"][1L]
|
||||
} else {
|
||||
as.character(x[1L])
|
||||
}
|
||||
}
|
||||
)
|
||||
} else if (length(atcs) == 1) {
|
||||
atcs <- unname(unlist(atcs))
|
||||
} else {
|
||||
names(atcs) <- x
|
||||
}
|
||||
|
||||
atcs
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group1 <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(ab_validate(x = x, property = "atc_group1", ...), language = language, only_affect_ab_names = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_atc_group2 <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(ab_validate(x = x, property = "atc_group2", ...), language = language, only_affect_ab_names = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_loinc <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
loincs <- ab_validate(x = x, property = "loinc", ...)
|
||||
names(loincs) <- x
|
||||
if (length(loincs) == 1) {
|
||||
unname(unlist(loincs))
|
||||
} else {
|
||||
loincs
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_ddd <- function(x, administration = "oral", ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||
|
||||
x <- as.ab(x, ...)
|
||||
ddd_prop <- paste0(administration, "_ddd")
|
||||
out <- ab_validate(x = x, property = ddd_prop)
|
||||
|
||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
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",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_ddd_units <- function(x, administration = "oral", ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||
|
||||
x <- as.ab(x, ...)
|
||||
ddd_prop <- paste0(administration, "_units")
|
||||
out <- ab_validate(x = x, property = ddd_prop)
|
||||
|
||||
if (any(ab_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
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",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_info <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
|
||||
x <- as.ab(x, ...)
|
||||
list(
|
||||
ab = as.character(x),
|
||||
cid = ab_cid(x),
|
||||
name = ab_name(x, language = language),
|
||||
group = ab_group(x, language = language),
|
||||
atc = ab_atc(x),
|
||||
atc_group1 = ab_atc_group1(x, language = language),
|
||||
atc_group2 = ab_atc_group2(x, language = language),
|
||||
tradenames = ab_tradenames(x),
|
||||
loinc = ab_loinc(x),
|
||||
ddd = list(
|
||||
oral = list(
|
||||
amount = ab_ddd(x, administration = "oral"),
|
||||
units = ab_ddd_units(x, administration = "oral")
|
||||
),
|
||||
iv = list(
|
||||
amount = ab_ddd(x, administration = "iv"),
|
||||
units = ab_ddd_units(x, administration = "iv")
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_url <- function(x, open = FALSE, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||
|
||||
ab <- as.ab(x = x, ...)
|
||||
atcs <- ab_atc(ab, only_first = TRUE)
|
||||
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)
|
||||
|
||||
NAs <- ab_name(ab, tolower = TRUE, language = NULL)[!is.na(ab) & is.na(atcs)]
|
||||
if (length(NAs) > 0) {
|
||||
warning_("in `ab_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
}
|
||||
|
||||
if (open == TRUE) {
|
||||
if (length(u) > 1 && !is.na(u[1L])) {
|
||||
warning_("in `ab_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
}
|
||||
if (!is.na(u[1L])) {
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
}
|
||||
u
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @export
|
||||
ab_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(property, is_in = colnames(AMR::antimicrobials), has_length = 1)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(ab_validate(x = x, property = property, ...), language = language)
|
||||
}
|
||||
|
||||
#' @rdname ab_property
|
||||
#' @aliases ATC
|
||||
#' @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::antimicrobials), has_length = 1, ignore.case = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(snake_case, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
x_deparsed <- deparse(substitute(data))
|
||||
if (length(x_deparsed) > 1 || any(x_deparsed %unlike% "[a-z]+")) {
|
||||
x_deparsed <- "your_data"
|
||||
}
|
||||
|
||||
property <- tolower(property)
|
||||
if (is.null(snake_case)) {
|
||||
snake_case <- property == "name"
|
||||
}
|
||||
|
||||
if (is.data.frame(data)) {
|
||||
if (tryCatch(length(c(...)) > 1, error = function(e) TRUE)) {
|
||||
df <- tryCatch(suppressWarnings(pm_select(data, ...)),
|
||||
error = function(e) {
|
||||
data[, c(...), drop = FALSE]
|
||||
}
|
||||
)
|
||||
} else if (tryCatch(is.character(c(...)), error = function(e) FALSE)) {
|
||||
df <- data[, c(...), drop = FALSE]
|
||||
} else {
|
||||
df <- data
|
||||
}
|
||||
vars <- get_column_abx(df, info = FALSE, only_sir_columns = FALSE, sort = FALSE, fn = "set_ab_names")
|
||||
if (length(vars) == 0) {
|
||||
message_("No columns with antibiotic results found for `set_ab_names()`, leaving names unchanged.")
|
||||
return(data)
|
||||
}
|
||||
} else {
|
||||
# quickly get antibiotic drug codes
|
||||
vars_ab <- as.ab(data, fast_mode = TRUE)
|
||||
vars <- data[!is.na(vars_ab)]
|
||||
}
|
||||
x <- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
ab_property(vars, property = property, language = language),
|
||||
function(x) {
|
||||
if (property == "atc") {
|
||||
# try to get the J-group
|
||||
if (any(x %like% "^J")) {
|
||||
x[x %like% "^J"][1L]
|
||||
} else {
|
||||
as.character(x[1L])
|
||||
}
|
||||
} else {
|
||||
as.character(x[1L])
|
||||
}
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
if (any(x %in% c("", NA))) {
|
||||
warning_(
|
||||
"in `set_ab_names()`: no ", property, " found for column(s): ",
|
||||
vector_and(vars[x %in% c("", NA)], sort = FALSE)
|
||||
)
|
||||
x[x %in% c("", NA)] <- vars[x %in% c("", NA)]
|
||||
}
|
||||
|
||||
if (snake_case == TRUE) {
|
||||
x <- tolower(gsub("[^a-zA-Z0-9]+", "_", x))
|
||||
}
|
||||
|
||||
if (anyDuplicated(x)) {
|
||||
# very hacky way of adding the index to each duplicate
|
||||
# so "Amoxicillin", "Amoxicillin", "Amoxicillin"
|
||||
# will be "Amoxicillin", "Amoxicillin_2", "Amoxicillin_3"
|
||||
invisible(lapply(
|
||||
unique(x),
|
||||
function(u) {
|
||||
dups <- which(x == u)
|
||||
if (length(dups) > 1) {
|
||||
# there are duplicates
|
||||
dup_add_int <- dups[2:length(dups)]
|
||||
x[dup_add_int] <<- paste0(x[dup_add_int], "_", 2:length(dups))
|
||||
}
|
||||
}
|
||||
))
|
||||
}
|
||||
if (is.data.frame(data)) {
|
||||
colnames(data)[colnames(data) %in% vars] <- x
|
||||
data
|
||||
} else {
|
||||
data[which(!is.na(vars_ab))] <- x
|
||||
data
|
||||
}
|
||||
}
|
||||
|
||||
ab_validate <- function(x, property, ...) {
|
||||
if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AB_lookup$ab), error = function(e) FALSE)) {
|
||||
# special case for ab_* functions where class is already 'ab'
|
||||
x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE]
|
||||
} else {
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% AMR_env$AB_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE)
|
||||
)
|
||||
|
||||
if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) {
|
||||
x <- as.ab(x, ...)
|
||||
if (all(is.na(x)) && is.list(AMR_env$AB_lookup[, property, drop = TRUE])) {
|
||||
x <- rep(NA_character_, length(x))
|
||||
} else {
|
||||
x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (property == "ab") {
|
||||
return(set_clean_class(x, new_class = c("ab", "character")))
|
||||
} else if (property == "cid") {
|
||||
return(as.integer(x))
|
||||
} else if (property %like% "ddd") {
|
||||
return(as.double(x))
|
||||
} else {
|
||||
x[is.na(x)] <- NA
|
||||
return(x)
|
||||
}
|
||||
}
|
||||
@@ -1,232 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Age in Years of Individuals
|
||||
#'
|
||||
#' Calculates age in years based on a reference date, which is the system date at default.
|
||||
#' @param x Date(s), [character] (vectors) will be coerced with [as.POSIXlt()].
|
||||
#' @param reference Reference date(s) (default is today), [character] (vectors) will be coerced with [as.POSIXlt()].
|
||||
#' @param exact A [logical] to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
|
||||
#' @param na.rm A [logical] to indicate whether missing values should be removed.
|
||||
#' @param ... Arguments passed on to [as.POSIXlt()], such as `origin`.
|
||||
#' @details Ages below 0 will be returned as `NA` with a warning. Ages above 120 will only give a warning.
|
||||
#'
|
||||
#' This function vectorises over both `x` and `reference`, meaning that either can have a length of 1 while the other argument has a larger length.
|
||||
#' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise
|
||||
#' @seealso To split ages into groups, use the [age_groups()] function.
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # 10 random pre-Y2K birth dates
|
||||
#' df <- data.frame(birth_date = as.Date("2000-01-01") - runif(10) * 25000)
|
||||
#'
|
||||
#' # add ages
|
||||
#' df$age <- age(df$birth_date)
|
||||
#'
|
||||
#' # add exact ages
|
||||
#' df$age_exact <- age(df$birth_date, exact = TRUE)
|
||||
#'
|
||||
#' # add age at millenium switch
|
||||
#' df$age_at_y2k <- age(df$birth_date, "2000-01-01")
|
||||
#'
|
||||
#' df
|
||||
age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||
meet_criteria(x, allow_class = c("character", "Date", "POSIXt"))
|
||||
meet_criteria(reference, allow_class = c("character", "Date", "POSIXt"))
|
||||
meet_criteria(exact, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (length(x) != length(reference)) {
|
||||
if (length(x) == 1) {
|
||||
x <- rep(x, length(reference))
|
||||
} else if (length(reference) == 1) {
|
||||
reference <- rep(reference, length(x))
|
||||
} else {
|
||||
stop_("`x` and `reference` must be of same length, or `reference` must be of length 1.")
|
||||
}
|
||||
}
|
||||
x <- as.POSIXlt(x, ...)
|
||||
reference <- as.POSIXlt(reference, ...)
|
||||
|
||||
# from https://stackoverflow.com/a/25450756/4575331
|
||||
years_gap <- reference$year - x$year
|
||||
ages <- ifelse(reference$mon < x$mon | (reference$mon == x$mon & reference$mday < x$mday),
|
||||
as.integer(years_gap - 1),
|
||||
as.integer(years_gap)
|
||||
)
|
||||
|
||||
# add decimals
|
||||
if (exact == TRUE) {
|
||||
# get dates of `x` when `x` would have the year of `reference`
|
||||
x_in_reference_year <- as.POSIXlt(
|
||||
paste0(
|
||||
format(as.Date(reference), "%Y"),
|
||||
format(as.Date(x), "-%m-%d")
|
||||
),
|
||||
format = "%Y-%m-%d"
|
||||
)
|
||||
# get differences in days
|
||||
n_days_x_rest <- as.double(difftime(as.Date(reference),
|
||||
as.Date(x_in_reference_year),
|
||||
units = "days"
|
||||
))
|
||||
# get numbers of days the years of `reference` has for a reliable denominator
|
||||
n_days_reference_year <- as.POSIXlt(paste0(format(as.Date(reference), "%Y"), "-12-31"),
|
||||
format = "%Y-%m-%d"
|
||||
)$yday + 1
|
||||
# add decimal parts of year
|
||||
mod <- n_days_x_rest / n_days_reference_year
|
||||
# negative mods are cases where `x_in_reference_year` > `reference` - so 'add' a year
|
||||
mod[!is.na(mod) & mod < 0] <- mod[!is.na(mod) & mod < 0] + 1
|
||||
# and finally add to ages
|
||||
ages <- ages + mod
|
||||
}
|
||||
|
||||
if (any(ages < 0, na.rm = TRUE)) {
|
||||
ages[!is.na(ages) & ages < 0] <- NA
|
||||
warning_("in `age()`: NAs introduced for ages below 0.")
|
||||
}
|
||||
if (any(ages > 120, na.rm = TRUE)) {
|
||||
warning_("in `age()`: some ages are above 120.")
|
||||
}
|
||||
|
||||
if (isTRUE(na.rm)) {
|
||||
ages <- ages[!is.na(ages)]
|
||||
}
|
||||
|
||||
if (exact == TRUE) {
|
||||
as.double(ages)
|
||||
} else {
|
||||
as.integer(ages)
|
||||
}
|
||||
}
|
||||
|
||||
#' Split Ages into Age Groups
|
||||
#'
|
||||
#' Split ages into age groups defined by the `split` argument. This allows for easier demographic (antimicrobial resistance) analysis.
|
||||
#' @param x Age, e.g. calculated with [age()].
|
||||
#' @param split_at Values to split `x` at - the default is age groups 0-11, 12-24, 25-54, 55-74 and 75+. See *Details*.
|
||||
#' @param na.rm A [logical] to indicate whether missing values should be removed.
|
||||
#' @details To split ages, the input for the `split_at` argument can be:
|
||||
#'
|
||||
#' * A [numeric] vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
|
||||
#' The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+).
|
||||
#' * A character:
|
||||
#' - `"children"` or `"kids"`, equivalent of: `c(0, 1, 2, 4, 6, 13, 18)`. This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+.
|
||||
#' - `"elderly"` or `"seniors"`, equivalent of: `c(65, 75, 85)`. This will split on 0-64, 65-74, 75-84, 85+.
|
||||
#' - `"fives"`, equivalent of: `1:20 * 5`. This will split on 0-4, 5-9, ..., 95-99, 100+.
|
||||
#' - `"tens"`, equivalent of: `1:10 * 10`. This will split on 0-9, 10-19, ..., 90-99, 100+.
|
||||
#' @return Ordered [factor]
|
||||
#' @seealso To determine ages, based on one or more reference dates, use the [age()] function.
|
||||
#' @export
|
||||
#' @examples
|
||||
#' ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
|
||||
#'
|
||||
#' # split into 0-49 and 50+
|
||||
#' age_groups(ages, 50)
|
||||
#'
|
||||
#' # split into 0-19, 20-49 and 50+
|
||||
#' age_groups(ages, c(20, 50))
|
||||
#'
|
||||
#' # split into groups of ten years
|
||||
#' age_groups(ages, 1:10 * 10)
|
||||
#' age_groups(ages, split_at = "tens")
|
||||
#'
|
||||
#' # split into groups of five years
|
||||
#' age_groups(ages, 1:20 * 5)
|
||||
#' age_groups(ages, split_at = "fives")
|
||||
#'
|
||||
#' # split specifically for children
|
||||
#' age_groups(ages, c(1, 2, 4, 6, 13, 18))
|
||||
#' age_groups(ages, "children")
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # resistance of ciprofloxacin per age group
|
||||
#' if (require("dplyr") && require("ggplot2")) {
|
||||
#' example_isolates %>%
|
||||
#' filter_first_isolate() %>%
|
||||
#' filter(mo == as.mo("Escherichia coli")) %>%
|
||||
#' group_by(age_group = age_groups(age)) %>%
|
||||
#' select(age_group, CIP) %>%
|
||||
#' ggplot_sir(
|
||||
#' x = "age_group",
|
||||
#' minimum = 0,
|
||||
#' x.title = "Age Group",
|
||||
#' title = "Ciprofloxacin resistance per age group"
|
||||
#' )
|
||||
#' }
|
||||
#' }
|
||||
age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
|
||||
meet_criteria(x, allow_class = c("numeric", "integer"), is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(split_at, allow_class = c("numeric", "integer", "character"), is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (any(x < 0, na.rm = TRUE)) {
|
||||
x[x < 0] <- NA
|
||||
warning_("in `age_groups()`: NAs introduced for ages below 0.")
|
||||
}
|
||||
if (is.character(split_at)) {
|
||||
split_at <- split_at[1L]
|
||||
if (split_at %like% "^(child|kid|junior)") {
|
||||
split_at <- c(0, 1, 2, 4, 6, 13, 18)
|
||||
} else if (split_at %like% "^(elder|senior)") {
|
||||
split_at <- c(65, 75, 85)
|
||||
} else if (split_at %like% "^five") {
|
||||
split_at <- 1:20 * 5
|
||||
} else if (split_at %like% "^ten") {
|
||||
split_at <- 1:10 * 10
|
||||
}
|
||||
}
|
||||
split_at <- sort(unique(as.integer(split_at)))
|
||||
if (!split_at[1] == 0) {
|
||||
# add base number 0
|
||||
split_at <- c(0, split_at)
|
||||
}
|
||||
split_at <- split_at[!is.na(split_at)]
|
||||
stop_if(length(split_at) == 1, "invalid value for `split_at`") # only 0 is available
|
||||
|
||||
# turn input values to 'split_at' indices
|
||||
y <- x
|
||||
lbls <- split_at
|
||||
for (i in seq_len(length(split_at))) {
|
||||
y[x >= split_at[i]] <- i
|
||||
# create labels
|
||||
lbls[i - 1] <- paste0(unique(c(split_at[i - 1], split_at[i] - 1)), collapse = "-")
|
||||
}
|
||||
|
||||
# last category
|
||||
lbls[length(lbls)] <- paste0(split_at[length(split_at)], "+")
|
||||
|
||||
agegroups <- factor(lbls[y], levels = lbls, ordered = TRUE)
|
||||
|
||||
if (isTRUE(na.rm)) {
|
||||
agegroups <- agegroups[!is.na(agegroups)]
|
||||
}
|
||||
|
||||
agegroups
|
||||
}
|
||||
-1057
File diff suppressed because it is too large
Load Diff
-1344
File diff suppressed because it is too large
Load Diff
-232
@@ -1,232 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get ATC Properties from WHOCC Website
|
||||
#'
|
||||
#' 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.
|
||||
#' @param url_vet URL of website of the WHOCC for veterinary medicine. The sign `%s` can be used as a placeholder for ATC_vet codes (that all start with "Q").
|
||||
#' @param ... Arguments to pass on to `atc_property`.
|
||||
#' @details
|
||||
#' Options for argument `administration`:
|
||||
#'
|
||||
#' - `"Implant"` = Implant
|
||||
#' - `"Inhal"` = Inhalation
|
||||
#' - `"Instill"` = Instillation
|
||||
#' - `"N"` = nasal
|
||||
#' - `"O"` = oral
|
||||
#' - `"P"` = parenteral
|
||||
#' - `"R"` = rectal
|
||||
#' - `"SL"` = sublingual/buccal
|
||||
#' - `"TD"` = transdermal
|
||||
#' - `"V"` = vaginal
|
||||
#'
|
||||
#' Abbreviations of return values when using `property = "U"` (unit):
|
||||
#'
|
||||
#' - `"g"` = gram
|
||||
#' - `"mg"` = milligram
|
||||
#' - `"mcg"` = microgram
|
||||
#' - `"U"` = unit
|
||||
#' - `"TU"` = thousand units
|
||||
#' - `"MU"` = million units
|
||||
#' - `"mmol"` = millimole
|
||||
#' - `"ml"` = millilitre (e.g. eyedrops)
|
||||
#'
|
||||
#' **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://atcddd.fhi.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/>
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' if (requireNamespace("curl") && requireNamespace("rvest") && requireNamespace("xml2")) {
|
||||
#' # oral DDD (Defined Daily Dose) of amoxicillin
|
||||
#' atc_online_property("J01CA04", "DDD", "O")
|
||||
#' atc_online_ddd(ab_atc("amox"))
|
||||
#'
|
||||
#' # parenteral DDD (Defined Daily Dose) of amoxicillin
|
||||
#' atc_online_property("J01CA04", "DDD", "P")
|
||||
#'
|
||||
#' atc_online_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
|
||||
#' }
|
||||
#' }
|
||||
atc_online_property <- function(atc_code,
|
||||
property,
|
||||
administration = "O",
|
||||
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?://")
|
||||
meet_criteria(url_vet, allow_class = "character", has_length = 1, looks_like = "https?://")
|
||||
|
||||
has_internet <- import_fn("has_internet", "curl")
|
||||
html_attr <- import_fn("html_attr", "rvest")
|
||||
html_children <- import_fn("html_children", "rvest")
|
||||
html_node <- import_fn("html_node", "rvest")
|
||||
html_nodes <- import_fn("html_nodes", "rvest")
|
||||
html_table <- import_fn("html_table", "rvest")
|
||||
html_text <- import_fn("html_text", "rvest")
|
||||
read_html <- import_fn("read_html", "xml2")
|
||||
|
||||
if (!all(atc_code %in% unlist(AMR::antimicrobials$atc))) {
|
||||
atc_code <- as.character(ab_atc(atc_code, only_first = TRUE))
|
||||
}
|
||||
|
||||
if (!has_internet()) {
|
||||
message_("There appears to be no internet connection, returning NA.",
|
||||
add_fn = font_red,
|
||||
as_note = FALSE
|
||||
)
|
||||
return(rep(NA, length(atc_code)))
|
||||
}
|
||||
|
||||
property <- tolower(property)
|
||||
# also allow unit as property
|
||||
if (property == "unit") {
|
||||
property <- "u"
|
||||
}
|
||||
if (property == "ddd") {
|
||||
returnvalue <- rep(NA_real_, length(atc_code))
|
||||
} else if (property == "groups") {
|
||||
returnvalue <- list()
|
||||
} else {
|
||||
returnvalue <- rep(NA_character_, length(atc_code))
|
||||
}
|
||||
|
||||
progress <- progress_ticker(n = length(atc_code), 3)
|
||||
on.exit(close(progress))
|
||||
|
||||
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
|
||||
} else {
|
||||
atc_url <- url
|
||||
}
|
||||
atc_url <- sub("%s", atc_code[i], atc_url, fixed = TRUE)
|
||||
|
||||
if (property == "groups") {
|
||||
out <- tryCatch(
|
||||
read_html(atc_url) %pm>%
|
||||
html_node("#content") %pm>%
|
||||
html_children() %pm>%
|
||||
html_node("a"),
|
||||
error = function(e) NULL
|
||||
)
|
||||
if (is.null(out)) {
|
||||
message_("Connection to ", atc_url, " failed.")
|
||||
return(rep(NA, length(atc_code)))
|
||||
}
|
||||
|
||||
# get URLS of items
|
||||
hrefs <- out %pm>% html_attr("href")
|
||||
# get text of items
|
||||
texts <- out %pm>% html_text()
|
||||
# select only text items where URL like "code="
|
||||
texts <- texts[grepl("?code=", tolower(hrefs), fixed = TRUE)]
|
||||
# last one is antibiotics, skip it
|
||||
texts <- texts[seq_len(length(texts)) - 1]
|
||||
returnvalue <- c(list(texts), returnvalue)
|
||||
} else {
|
||||
out <- tryCatch(
|
||||
read_html(atc_url) %pm>%
|
||||
html_nodes("table") %pm>%
|
||||
html_table(header = TRUE) %pm>%
|
||||
as.data.frame(stringsAsFactors = FALSE),
|
||||
error = function(e) NULL
|
||||
)
|
||||
if (is.null(out)) {
|
||||
message_("Connection to ", atc_url, " failed.")
|
||||
return(rep(NA, length(atc_code)))
|
||||
}
|
||||
|
||||
# case insensitive column names
|
||||
colnames(out) <- gsub("^atc.*", "atc", tolower(colnames(out)))
|
||||
|
||||
if (length(out) == 0) {
|
||||
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
|
||||
}
|
||||
|
||||
if (property %in% c("atc", "name")) {
|
||||
# ATC and name are only in first row
|
||||
returnvalue[i] <- out[1, property, drop = TRUE]
|
||||
} else {
|
||||
if (!"adm.r" %in% colnames(out) || is.na(out[1, "adm.r", drop = TRUE])) {
|
||||
returnvalue[i] <- NA
|
||||
next
|
||||
} else {
|
||||
for (j in seq_len(nrow(out))) {
|
||||
if (out[j, "adm.r"] == administration) {
|
||||
returnvalue[i] <- out[j, property, drop = TRUE]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (property == "groups" && length(returnvalue) == 1) {
|
||||
returnvalue <- returnvalue[[1]]
|
||||
}
|
||||
|
||||
returnvalue
|
||||
}
|
||||
|
||||
#' @rdname atc_online
|
||||
#' @export
|
||||
atc_online_groups <- function(atc_code, ...) {
|
||||
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", 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", allow_NA = TRUE)
|
||||
atc_online_property(atc_code = atc_code, property = "unit", ...)
|
||||
}
|
||||
@@ -1,617 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Transform Input to an Antiviral Drug ID
|
||||
#'
|
||||
#' Use this function to determine the antiviral drug code of one or more antiviral drugs. The data set [antivirals] will be searched for abbreviations, official names and synonyms (brand names).
|
||||
#' @param x A [character] vector to determine to antiviral drug ID.
|
||||
#' @param flag_multiple_results A [logical] to indicate whether a note should be printed to the console that probably more than one antiviral drug code or name can be retrieved from a single input value.
|
||||
#' @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.av
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @details All entries in the [antivirals] 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.av()] can correct for different forms of misspelling:
|
||||
#'
|
||||
#' * Wrong spelling of drug names (such as "acyclovir"), which corrects for most audible similarities such as f/ph, x/ks, c/z/s, t/th, etc.
|
||||
#' * Too few or too many vowels or consonants
|
||||
#' * Switching two characters (such as "aycclovir", often the case in clinical data, when doctors typed too fast)
|
||||
#' * Digitalised paper records, leaving artefacts like 0/o/O (zero and O's), B/8, n/r, etc.
|
||||
#'
|
||||
#' Use the [`av_*`][av_property()] functions to get properties based on the returned antiviral drug ID, see *Examples*.
|
||||
#'
|
||||
#' 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://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
|
||||
#' @return A [character] [vector] with additional class [`ab`]
|
||||
#' @seealso
|
||||
#' * [antivirals] for the [data.frame] that is being used to determine ATCs
|
||||
#' * [av_from_text()] for a function to retrieve antimicrobial drugs from clinical text (from health care records)
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # these examples all return "ACI", the ID of aciclovir:
|
||||
#' as.av("J05AB01")
|
||||
#' as.av("J 05 AB 01")
|
||||
#' as.av("Aciclovir")
|
||||
#' as.av("aciclo")
|
||||
#' as.av(" aciclo 123")
|
||||
#' as.av("ACICL")
|
||||
#' as.av("ACI")
|
||||
#' as.av("Virorax") # trade name
|
||||
#' as.av("Zovirax") # trade name
|
||||
#'
|
||||
#' as.av("acyklofir") # severe spelling error, yet works
|
||||
#'
|
||||
#' # use av_* functions to get a specific properties (see ?av_property);
|
||||
#' # they use as.av() internally:
|
||||
#' av_name("J05AB01")
|
||||
#' av_name("acicl")
|
||||
as.av <- function(x, flag_multiple_results = TRUE, 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)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (is.av(x)) {
|
||||
return(x)
|
||||
}
|
||||
if (all(x %in% c(AMR_env$AV_lookup$av, NA))) {
|
||||
# all valid AB codes, but not yet right class
|
||||
return(set_clean_class(x,
|
||||
new_class = c("av", "character")
|
||||
))
|
||||
}
|
||||
|
||||
initial_search <- is.null(list(...)$initial_search)
|
||||
already_regex <- isTRUE(list(...)$already_regex)
|
||||
fast_mode <- isTRUE(list(...)$fast_mode)
|
||||
|
||||
x_bak <- x
|
||||
x <- toupper(x)
|
||||
|
||||
# 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)
|
||||
x_bak_clean <- x
|
||||
if (already_regex == FALSE) {
|
||||
x_bak_clean <- generalise_antibiotic_name(x_bak_clean)
|
||||
}
|
||||
|
||||
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_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)) {
|
||||
avnames <- av_name(from_text, tolower = TRUE, initial_search = FALSE)
|
||||
if (av_name(found[1L], language = NULL) %like% "(clavulanic acid|avibactam)") {
|
||||
avnames <- avnames[!avnames %in% c("clavulanic acid", "avibactam")]
|
||||
}
|
||||
if (length(avnames) > 1) {
|
||||
warning_(
|
||||
"More than one result was found for item ", index, ": ",
|
||||
vector_and(avnames, quotes = FALSE)
|
||||
)
|
||||
}
|
||||
}
|
||||
found[1L]
|
||||
}
|
||||
|
||||
# Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase)
|
||||
known_names <- x %in% AMR_env$AV_lookup$generalised_name
|
||||
x_new[known_names] <- AMR_env$AV_lookup$av[match(x[known_names], AMR_env$AV_lookup$generalised_name)]
|
||||
known_codes_av <- x %in% AMR_env$AV_lookup$av
|
||||
known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AMR_env$AV_lookup$atc), USE.NAMES = FALSE)
|
||||
known_codes_cid <- x %in% AMR_env$AV_lookup$cid
|
||||
x_new[known_codes_av] <- AMR_env$AV_lookup$av[match(x[known_codes_av], AMR_env$AV_lookup$av)]
|
||||
x_new[known_codes_atc] <- AMR_env$AV_lookup$av[vapply(
|
||||
FUN.VALUE = integer(1),
|
||||
x[known_codes_atc],
|
||||
function(x_) {
|
||||
which(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
AMR_env$AV_lookup$atc,
|
||||
function(atc) x_ %in% atc
|
||||
))[1L]
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)]
|
||||
x_new[known_codes_cid] <- AMR_env$AV_lookup$av[match(x[known_codes_cid], AMR_env$AV_lookup$cid)]
|
||||
previously_coerced <- x %in% AMR_env$av_previously_coerced$x
|
||||
x_new[previously_coerced & is.na(x_new)] <- AMR_env$av_previously_coerced$av[match(x[is.na(x_new) & x %in% AMR_env$av_previously_coerced$x], AMR_env$av_previously_coerced$x)]
|
||||
already_known <- known_names | known_codes_av | 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)) {
|
||||
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()
|
||||
}
|
||||
|
||||
if (is.na(x[i]) || is.null(x[i])) {
|
||||
next
|
||||
}
|
||||
if (identical(x[i], "") ||
|
||||
# prevent "bacteria" from coercing to TMP, since Bacterial is a brand name of it:
|
||||
identical(tolower(x[i]), "bacteria")) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
if (x[i] %like_case% "[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]") {
|
||||
# seems an ATC code, but the available ones are in `already_known`, so:
|
||||
x_unknown <- c(x_unknown, x[i])
|
||||
x_unknown_ATCs <- c(x_unknown_ATCs, x[i])
|
||||
x_new[i] <- NA_character_
|
||||
next
|
||||
}
|
||||
|
||||
if (fast_mode == FALSE && flag_multiple_results == TRUE && x[i] %like% "[ ]") {
|
||||
from_text <- tryCatch(suppressWarnings(av_from_text(x[i], initial_search = FALSE, translate_av = FALSE)[[1]]),
|
||||
error = function(e) character(0)
|
||||
)
|
||||
} else {
|
||||
from_text <- character(0)
|
||||
}
|
||||
|
||||
# old code for phenoxymethylpenicillin (Peni V)
|
||||
if (x[i] == "PNV") {
|
||||
x_new[i] <- "PHN"
|
||||
next
|
||||
}
|
||||
|
||||
# exact LOINC code
|
||||
loinc_found <- unlist(lapply(
|
||||
AMR_env$AV_lookup$generalised_loinc,
|
||||
function(s) x[i] %in% s
|
||||
))
|
||||
found <- AMR_env$AV_lookup$av[loinc_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# exact synonym
|
||||
synonym_found <- unlist(lapply(
|
||||
AMR_env$AV_lookup$generalised_synonyms,
|
||||
function(s) x[i] %in% s
|
||||
))
|
||||
found <- AMR_env$AV_lookup$av[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# length of input is quite long, and Levenshtein distance is only max 2
|
||||
if (nchar(x[i]) >= 10) {
|
||||
levenshtein <- as.double(utils::adist(x[i], AMR_env$AV_lookup$generalised_name))
|
||||
if (any(levenshtein <= 2)) {
|
||||
found <- AMR_env$AV_lookup$av[which(levenshtein <= 2)]
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
# allow characters that resemble others, but only continue when having more than 3 characters
|
||||
if (nchar(x[i]) <= 3) {
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
next
|
||||
}
|
||||
x_spelling <- x[i]
|
||||
if (already_regex == FALSE) {
|
||||
x_spelling <- gsub("[IY]+", "[IY]+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(C|K|Q|QU|S|Z|X|KS)+", "(C|K|Q|QU|S|Z|X|KS)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(PH|F|V)+", "(PH|F|V)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(TH|T)+", "(TH|T)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("A+", "A+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("E+", "E+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("O+", "O+", x_spelling, perl = TRUE)
|
||||
# allow any ending of -in/-ine and -im/-ime
|
||||
x_spelling <- gsub("(\\[IY\\]\\+(N|M)|\\[IY\\]\\+(N|M)E\\+?)$", "[IY]+(N|M)E*", x_spelling, perl = TRUE)
|
||||
# allow any ending of -ol/-ole
|
||||
x_spelling <- gsub("(O\\+L|O\\+LE\\+)$", "O+LE*", x_spelling, perl = TRUE)
|
||||
# allow any ending of -on/-one
|
||||
x_spelling <- gsub("(O\\+N|O\\+NE\\+)$", "O+NE*", x_spelling, perl = TRUE)
|
||||
# replace multiple same characters to single one with '+', like "ll" -> "l+"
|
||||
x_spelling <- gsub("(.)\\1+", "\\1+", x_spelling, perl = TRUE)
|
||||
# replace spaces and slashes with a possibility on both
|
||||
x_spelling <- gsub("[ /]", "( .*|.*/)", x_spelling, perl = TRUE)
|
||||
# correct for digital reading text (OCR)
|
||||
x_spelling <- gsub("[NRD8B]", "[NRD8B]", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("(O|0)", "(O|0)+", x_spelling, perl = TRUE)
|
||||
x_spelling <- gsub("++", "+", x_spelling, fixed = TRUE)
|
||||
}
|
||||
|
||||
# try if name starts with it
|
||||
found <- AMR_env$AV_lookup[which(AMR_env$AV_lookup$generalised_name %like% paste0("^", x_spelling)), "av", drop = TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
# try if name ends with it
|
||||
found <- AMR_env$AV_lookup[which(AMR_env$AV_lookup$generalised_name %like% paste0(x_spelling, "$")), "av", drop = TRUE]
|
||||
if (nchar(x[i]) >= 4 && length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# and try if any synonym starts with it
|
||||
synonym_found <- unlist(lapply(
|
||||
AMR_env$AV_lookup$generalised_synonyms,
|
||||
function(s) any(s %like% paste0("^", x_spelling))
|
||||
))
|
||||
found <- AMR_env$AV_lookup$av[synonym_found == TRUE]
|
||||
if (length(found) > 0) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
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.av(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.av(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 = "/"
|
||||
)
|
||||
x_translated_guess <- suppressWarnings(as.av(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(av_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.av(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.av(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.av(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 ?av_from_text
|
||||
# already calculated above if flag_multiple_results = TRUE
|
||||
if (flag_multiple_results == TRUE) {
|
||||
found <- from_text[1L]
|
||||
} else {
|
||||
found <- tryCatch(suppressWarnings(av_from_text(x[i], initial_search = FALSE, translate_av = 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
|
||||
}
|
||||
|
||||
# first 5
|
||||
found <- suppressWarnings(as.av(substr(x[i], 1, 5), initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
|
||||
next
|
||||
}
|
||||
|
||||
# make all consonants facultative
|
||||
search_str <- gsub("([BCDFGHJKLMNPQRSTVWXZ])", "\\1*", x[i], perl = TRUE)
|
||||
found <- suppressWarnings(as.av(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)
|
||||
next
|
||||
}
|
||||
|
||||
# make all vowels facultative
|
||||
search_str <- gsub("([AEIOUY])", "\\1*", x[i], perl = TRUE)
|
||||
found <- suppressWarnings(as.av(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.av(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.av(x_switched, initial_search = FALSE))
|
||||
if (!is.na(found)) {
|
||||
break
|
||||
}
|
||||
}
|
||||
if (!is.na(found)) {
|
||||
x_new[i] <- found[1L]
|
||||
next
|
||||
}
|
||||
} # end of initial_search = TRUE
|
||||
|
||||
# not found
|
||||
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
|
||||
}
|
||||
|
||||
if (isTRUE(initial_search) && sum(already_known) < length(x)) {
|
||||
close(progress)
|
||||
}
|
||||
|
||||
# save to package env to save time for next time
|
||||
if (isTRUE(initial_search)) {
|
||||
AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
|
||||
AMR_env$av_previously_coerced <- unique(rbind_AMR(
|
||||
AMR_env$av_previously_coerced,
|
||||
data.frame(
|
||||
x = x,
|
||||
av = 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.av()`: these ATC codes are not (yet) in the antivirals data set: ",
|
||||
vector_and(x_unknown_ATCs), "."
|
||||
)
|
||||
}
|
||||
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||
x_unknown <- c(
|
||||
x_unknown,
|
||||
AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))]
|
||||
)
|
||||
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
|
||||
vector_and(x_unknown), "."
|
||||
)
|
||||
}
|
||||
|
||||
x_result <- x_new[match(x_bak_clean, x)]
|
||||
if (length(x_result) == 0) {
|
||||
x_result <- NA_character_
|
||||
}
|
||||
|
||||
set_clean_class(x_result,
|
||||
new_class = c("av", "character")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname as.av
|
||||
#' @export
|
||||
is.av <- function(x) {
|
||||
inherits(x, "av")
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.av <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[!is.na(x)] <- gsub("+", font_subtle("+"), out[!is.na(x)], fixed = TRUE)
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
create_pillar_column(out, align = "left", min_width = 4)
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
type_sum.av <- function(x, ...) {
|
||||
"av"
|
||||
}
|
||||
|
||||
#' @method print av
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.av <- function(x, ...) {
|
||||
cat("Class 'av'\n")
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @method as.data.frame av
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.av <- function(x, ...) {
|
||||
nm <- deparse1(substitute(x))
|
||||
if (!"nm" %in% names(list(...))) {
|
||||
as.data.frame.vector(as.av(x), ..., nm = nm)
|
||||
} else {
|
||||
as.data.frame.vector(as.av(x), ...)
|
||||
}
|
||||
}
|
||||
#' @method [ av
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[.av" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [[ av
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.av" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [<- av
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.av" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
return_after_integrity_check(y, "antiviral drug code", AMR_env$AV_lookup$av)
|
||||
}
|
||||
#' @method [[<- av
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.av" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
return_after_integrity_check(y, "antiviral drug code", AMR_env$AV_lookup$av)
|
||||
}
|
||||
#' @method c av
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.av <- function(...) {
|
||||
x <- list(...)[[1L]]
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
return_after_integrity_check(y, "antiviral drug code", AMR_env$AV_lookup$av)
|
||||
}
|
||||
|
||||
#' @method unique av
|
||||
#' @export
|
||||
#' @noRd
|
||||
unique.av <- function(x, incomparables = FALSE, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
#' @method rep av
|
||||
#' @export
|
||||
#' @noRd
|
||||
rep.av <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
get_translate_av <- function(translate_av) {
|
||||
translate_av <- as.character(translate_av)[1L]
|
||||
if (translate_av %in% c("TRUE", "official")) {
|
||||
return("name")
|
||||
} else if (translate_av %in% c(NA_character_, "FALSE")) {
|
||||
return(FALSE)
|
||||
} else {
|
||||
translate_av <- tolower(translate_av)
|
||||
stop_ifnot(translate_av %in% colnames(AMR::antivirals),
|
||||
"invalid value for 'translate_av', this must be a column name of the antivirals data set\n",
|
||||
"or TRUE (equals 'name') or FALSE to not translate at all.",
|
||||
call = FALSE
|
||||
)
|
||||
translate_av
|
||||
}
|
||||
}
|
||||
@@ -1,186 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Retrieve Antiviral Drug Names and Doses from Clinical Text
|
||||
#'
|
||||
#' Use this function on e.g. clinical texts from health care records. It returns a [list] with all antiviral drugs, doses and forms of administration found in the texts.
|
||||
#' @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_av If `type = "drug"`: a column name of the [antivirals] data set to translate the antibiotic abbreviations to, using [av_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.av()].
|
||||
#' @details This function is also internally used by [as.av()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.av()] function may use very long regular expression to match brand names of antiviral drugs. This may fail on some systems.
|
||||
#'
|
||||
#' ### Argument `type`
|
||||
#' At default, the function will search for antiviral drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.av()] internally, it will correct for misspelling.
|
||||
#'
|
||||
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for [numeric] values that are higher than 100 and do not resemble years. The output will be [numeric]. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
|
||||
#'
|
||||
#' ### Argument `collapse`
|
||||
#' Without using `collapse`, this function will return a [list]. This can be convenient to use e.g. inside a `mutate()`):\cr
|
||||
#' `df %>% mutate(avx = av_from_text(clinical_text))`
|
||||
#'
|
||||
#' The returned AV codes can be transformed to official names, groups, etc. with all [`av_*`][av_property()] functions such as [av_name()] and [av_group()], or by using the `translate_av` argument.
|
||||
#'
|
||||
#' With using `collapse`, this function will return a [character]:\cr
|
||||
#' `df %>% mutate(avx = av_from_text(clinical_text, collapse = "|"))`
|
||||
#' @export
|
||||
#' @return A [list], or a [character] if `collapse` is not `NULL`
|
||||
#' @examples
|
||||
#' av_from_text("28/03/2020 valaciclovir po tid")
|
||||
#' av_from_text("28/03/2020 valaciclovir po tid", type = "admin")
|
||||
av_from_text <- function(text,
|
||||
type = c("drug", "dose", "administration"),
|
||||
collapse = NULL,
|
||||
translate_av = FALSE,
|
||||
thorough_search = NULL,
|
||||
info = interactive(),
|
||||
...) {
|
||||
if (missing(type)) {
|
||||
type <- type[1L]
|
||||
}
|
||||
|
||||
meet_criteria(text)
|
||||
meet_criteria(type, allow_class = "character", has_length = 1)
|
||||
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(translate_av, allow_NULL = FALSE) # get_translate_av() will be more informative about what's allowed
|
||||
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
type <- tolower(trimws2(type))
|
||||
|
||||
text <- tolower(as.character(text))
|
||||
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
||||
on.exit(close(progress))
|
||||
|
||||
if (type %like% "(drug|ab|anti)") {
|
||||
translate_av <- get_translate_av(translate_av)
|
||||
|
||||
if (isTRUE(thorough_search) ||
|
||||
(isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) {
|
||||
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()
|
||||
suppressWarnings(
|
||||
as.av(text_split, ...)
|
||||
)
|
||||
})
|
||||
} else {
|
||||
# no thorough search
|
||||
names_atc <- substr(c(AMR::antivirals$name, AMR::antivirals$atc), 1, 5)
|
||||
synonyms <- unlist(AMR::antivirals$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))]
|
||||
synonyms_part2 <- synonyms[!synonyms %in% synonyms_part1]
|
||||
to_regex <- function(x) {
|
||||
paste0(
|
||||
"^(",
|
||||
paste0(unique(gsub("[^a-z0-9]+", "", sort(tolower(x)))), collapse = "|"),
|
||||
").*"
|
||||
)
|
||||
}
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
progress$tick()
|
||||
suppressWarnings(
|
||||
as.av(
|
||||
unique(c(
|
||||
text_split[text_split %like_case% to_regex(names_atc)],
|
||||
text_split[text_split %like_case% to_regex(synonyms_part1)],
|
||||
text_split[text_split %like_case% to_regex(synonyms_part2)]
|
||||
)),
|
||||
...
|
||||
)
|
||||
)
|
||||
})
|
||||
}
|
||||
|
||||
close(progress)
|
||||
|
||||
result <- lapply(result, function(out) {
|
||||
out <- out[!is.na(out)]
|
||||
if (length(out) == 0) {
|
||||
as.av(NA)
|
||||
} else {
|
||||
if (!isFALSE(translate_av)) {
|
||||
out <- av_property(out, property = translate_av, initial_search = FALSE)
|
||||
}
|
||||
out
|
||||
}
|
||||
})
|
||||
} else if (type %like% "dos") {
|
||||
text_split_all <- strsplit(text, " ", fixed = TRUE)
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
text_split <- text_split[text_split %like% "^[0-9]{2,}(/[0-9]+)?[a-z]*$"]
|
||||
# only left part of "/", like 500 in "500/125"
|
||||
text_split <- gsub("/.*", "", text_split)
|
||||
text_split <- gsub(",", ".", text_split, fixed = TRUE) # foreign system using comma as decimal sep
|
||||
text_split <- as.double(gsub("[^0-9.]", "", text_split))
|
||||
# minimal 100 units/mg and no years that unlikely doses
|
||||
text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)]
|
||||
|
||||
if (length(text_split) > 0) {
|
||||
text_split
|
||||
} else {
|
||||
NA_real_
|
||||
}
|
||||
})
|
||||
} else if (type %like% "adm") {
|
||||
result <- lapply(text_split_all, function(text_split) {
|
||||
text_split <- text_split[text_split %like% "(^iv$|intraven|^po$|per os|oral|implant|inhal|instill|nasal|paren|rectal|sublingual|buccal|trans.*dermal|vaginal)"]
|
||||
if (length(text_split) > 0) {
|
||||
text_split <- gsub("(^po$|.*per os.*)", "oral", text_split)
|
||||
text_split <- gsub("(^iv$|.*intraven.*)", "iv", text_split)
|
||||
text_split
|
||||
} else {
|
||||
NA_character_
|
||||
}
|
||||
})
|
||||
} else {
|
||||
stop_("`type` must be either 'drug', 'dose' or 'administration'")
|
||||
}
|
||||
|
||||
# collapse text if needed
|
||||
if (!is.null(collapse)) {
|
||||
result <- vapply(FUN.VALUE = character(1), result, function(x) {
|
||||
if (length(x) == 1 & all(is.na(x))) {
|
||||
NA_character_
|
||||
} else {
|
||||
paste0(x, collapse = collapse)
|
||||
}
|
||||
})
|
||||
}
|
||||
|
||||
result
|
||||
}
|
||||
-290
@@ -1,290 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Get Properties of an Antiviral Drug
|
||||
#'
|
||||
#' Use these functions to return a specific property of an antiviral drug from the [antivirals] data set. All input values will be evaluated internally with [as.av()].
|
||||
#' @param x Any (vector of) text that can be coerced to a valid antiviral drug code with [as.av()].
|
||||
#' @param tolower A [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character].
|
||||
#' @param property One of the column names of one of the [antivirals] data set: `vector_or(colnames(antivirals), sort = FALSE)`.
|
||||
#' @param language Language of the returned text - the default is system language (see [get_AMR_locale()]) and can also be set with the package option [`AMR_locale`][AMR-options]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param administration Way of administration, either `"oral"` or `"iv"`.
|
||||
#' @param open Browse the URL using [utils::browseURL()].
|
||||
#' @param ... Other arguments passed on to [as.av()].
|
||||
#' @details All output [will be translated][translate] where possible.
|
||||
#'
|
||||
#' The function [av_url()] will return the direct URL to the official WHO website. A warning will be returned if the required ATC code is not available.
|
||||
#' @inheritSection as.av Source
|
||||
#' @rdname av_property
|
||||
#' @name av_property
|
||||
#' @return
|
||||
#' - An [integer] in case of [av_cid()]
|
||||
#' - A named [list] in case of [av_info()] and multiple [av_atc()]/[av_synonyms()]/[av_tradenames()]
|
||||
#' - A [double] in case of [av_ddd()]
|
||||
#' - A [character] in all other cases
|
||||
#' @export
|
||||
#' @seealso [antivirals]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' # all properties:
|
||||
#' av_name("ACI")
|
||||
#' av_atc("ACI")
|
||||
#' av_cid("ACI")
|
||||
#' av_synonyms("ACI")
|
||||
#' av_tradenames("ACI")
|
||||
#' av_group("ACI")
|
||||
#' av_url("ACI")
|
||||
#'
|
||||
#' # lowercase transformation
|
||||
#' av_name(x = c("ACI", "VALA"))
|
||||
#' av_name(x = c("ACI", "VALA"), tolower = TRUE)
|
||||
#'
|
||||
#' # defined daily doses (DDD)
|
||||
#' av_ddd("ACI", "oral")
|
||||
#' av_ddd_units("ACI", "oral")
|
||||
#' av_ddd("ACI", "iv")
|
||||
#' av_ddd_units("ACI", "iv")
|
||||
#'
|
||||
#' av_info("ACI") # all properties as a list
|
||||
#'
|
||||
#' # all av_* functions use as.av() internally, so you can go from 'any' to 'any':
|
||||
#' av_atc("ACI")
|
||||
#' av_group("J05AB01")
|
||||
#' av_loinc("abacavir")
|
||||
#' av_name("29113-8")
|
||||
#' av_name(135398513)
|
||||
#' av_name("J05AB01")
|
||||
av_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(tolower, allow_class = "logical", has_length = 1)
|
||||
|
||||
x <- translate_into_language(av_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
|
||||
if (tolower == TRUE) {
|
||||
# use perl to only transform the first character
|
||||
# as we want "polymyxin B", not "polymyxin b"
|
||||
x <- gsub("^([A-Z])", "\\L\\1", x, perl = TRUE)
|
||||
}
|
||||
x
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_cid <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
av_validate(x = x, property = "cid", ...)
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_synonyms <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
syns <- av_validate(x = x, property = "synonyms", ...)
|
||||
names(syns) <- x
|
||||
if (length(syns) == 1) {
|
||||
unname(unlist(syns))
|
||||
} else {
|
||||
syns
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_tradenames <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
av_synonyms(x, ...)
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_group <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(av_validate(x = x, property = "atc_group", ...), language = language, only_affect_ab_names = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_atc <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
# ATCs in the antivirals data set are not a list
|
||||
av_validate(x = x, property = "atc", ...)
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_loinc <- function(x, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
loincs <- av_validate(x = x, property = "loinc", ...)
|
||||
names(loincs) <- x
|
||||
if (length(loincs) == 1) {
|
||||
unname(unlist(loincs))
|
||||
} else {
|
||||
loincs
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_ddd <- function(x, administration = "oral", ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||
|
||||
x <- as.av(x, ...)
|
||||
ddd_prop <- paste0(administration, "_ddd")
|
||||
out <- av_validate(x = x, property = ddd_prop)
|
||||
|
||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
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",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_ddd_units <- function(x, administration = "oral", ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||
|
||||
x <- as.av(x, ...)
|
||||
ddd_prop <- paste0(administration, "_units")
|
||||
out <- av_validate(x = x, property = ddd_prop)
|
||||
|
||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||
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",
|
||||
"atcddd.fhi.no/ddd/list_of_ddds_combined_products/"
|
||||
)
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_info <- function(x, language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
language <- validate_language(language)
|
||||
|
||||
x <- as.av(x, ...)
|
||||
list(
|
||||
av = as.character(x),
|
||||
cid = av_cid(x),
|
||||
name = av_name(x, language = language),
|
||||
group = av_group(x, language = language),
|
||||
atc = av_atc(x),
|
||||
tradenames = av_tradenames(x),
|
||||
loinc = av_loinc(x),
|
||||
ddd = list(
|
||||
oral = list(
|
||||
amount = av_ddd(x, administration = "oral"),
|
||||
units = av_ddd_units(x, administration = "oral")
|
||||
),
|
||||
iv = list(
|
||||
amount = av_ddd(x, administration = "iv"),
|
||||
units = av_ddd_units(x, administration = "iv")
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_url <- function(x, open = FALSE, ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||
|
||||
av <- as.av(x = x, ...)
|
||||
atcs <- av_atc(av, only_first = TRUE)
|
||||
u <- paste0("https://atcddd.fhi.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
||||
u[is.na(atcs)] <- NA_character_
|
||||
names(u) <- av_name(av)
|
||||
|
||||
NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
|
||||
if (length(NAs) > 0) {
|
||||
warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||
}
|
||||
|
||||
if (open == TRUE) {
|
||||
if (length(u) > 1 && !is.na(u[1L])) {
|
||||
warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
|
||||
}
|
||||
if (!is.na(u[1L])) {
|
||||
utils::browseURL(u[1L])
|
||||
}
|
||||
}
|
||||
u
|
||||
}
|
||||
|
||||
#' @rdname av_property
|
||||
#' @export
|
||||
av_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(property, is_in = colnames(AMR::antivirals), has_length = 1)
|
||||
language <- validate_language(language)
|
||||
translate_into_language(av_validate(x = x, property = property, ...), language = language)
|
||||
}
|
||||
|
||||
av_validate <- function(x, property, ...) {
|
||||
if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AV_lookup$av), error = function(e) FALSE)) {
|
||||
# special case for av_* functions where class is already 'av'
|
||||
x <- AMR_env$AV_lookup[match(x, AMR_env$AV_lookup$av), property, drop = TRUE]
|
||||
} else {
|
||||
# try to catch an error when inputting an invalid argument
|
||||
# so the 'call.' can be set to FALSE
|
||||
tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
|
||||
error = function(e) stop(e$message, call. = FALSE)
|
||||
)
|
||||
|
||||
if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {
|
||||
x <- as.av(x, ...)
|
||||
if (all(is.na(x)) && is.list(AMR_env$AV_lookup[, property, drop = TRUE])) {
|
||||
x <- rep(NA_character_, length(x))
|
||||
} else {
|
||||
x <- AMR_env$AV_lookup[match(x, AMR_env$AV_lookup$av), property, drop = TRUE]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (property == "av") {
|
||||
return(set_clean_class(x, new_class = c("av", "character")))
|
||||
} else if (property == "cid") {
|
||||
return(as.integer(x))
|
||||
} else if (property %like% "ddd") {
|
||||
return(as.double(x))
|
||||
} else {
|
||||
x[is.na(x)] <- NA
|
||||
return(x)
|
||||
}
|
||||
}
|
||||
@@ -1,102 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Check Availability of Columns
|
||||
#'
|
||||
#' Easy check for data availability of all columns in a data set. This makes it easy to get an idea of which antimicrobial combinations can be used for calculation with e.g. [susceptibility()] and [resistance()].
|
||||
#' @param tbl A [data.frame] or [list].
|
||||
#' @param width Number of characters to present the visual availability - the default is filling the width of the console.
|
||||
#' @details The function returns a [data.frame] with columns `"resistant"` and `"visual_resistance"`. The values in that columns are calculated with [resistance()].
|
||||
#' @return [data.frame] with column names of `tbl` as row names
|
||||
#' @export
|
||||
#' @examples
|
||||
#' availability(example_isolates)
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' filter(mo == as.mo("Escherichia coli")) %>%
|
||||
#' select_if(is.sir) %>%
|
||||
#' availability()
|
||||
#' }
|
||||
#' }
|
||||
availability <- function(tbl, width = NULL) {
|
||||
meet_criteria(tbl, allow_class = "data.frame")
|
||||
meet_criteria(width, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
tbl <- as.data.frame(tbl, stringsAsFactors = FALSE)
|
||||
|
||||
x <- vapply(FUN.VALUE = double(1), tbl, function(x) {
|
||||
1 - sum(is.na(x)) / length(x)
|
||||
})
|
||||
n <- vapply(FUN.VALUE = double(1), tbl, function(x) length(x[!is.na(x)]))
|
||||
R <- vapply(FUN.VALUE = double(1), tbl, function(x) ifelse(is.sir(x), resistance(x, minimum = 0), NA_real_))
|
||||
R_print <- character(length(R))
|
||||
R_print[!is.na(R)] <- percentage(R[!is.na(R)])
|
||||
R_print[is.na(R)] <- ""
|
||||
|
||||
if (is.null(width)) {
|
||||
width <- getOption("width", 100) -
|
||||
(max(nchar(colnames(tbl))) +
|
||||
# count col
|
||||
8 +
|
||||
# available % column
|
||||
10 +
|
||||
# resistant % column
|
||||
10 +
|
||||
# extra margin
|
||||
5)
|
||||
width <- width / 2
|
||||
}
|
||||
|
||||
if (length(R[is.na(R)]) == ncol(tbl)) {
|
||||
width <- width * 2 + 10
|
||||
}
|
||||
|
||||
x_chars_R <- strrep("#", round(width * R, digits = 2))
|
||||
x_chars_SI <- strrep("-", width - nchar(x_chars_R))
|
||||
vis_resistance <- paste0("|", x_chars_R, x_chars_SI, "|")
|
||||
vis_resistance[is.na(R)] <- ""
|
||||
|
||||
x_chars <- strrep("#", round(x, digits = 2) / (1 / width))
|
||||
x_chars_empty <- strrep("-", width - nchar(x_chars))
|
||||
|
||||
df <- data.frame(
|
||||
count = n,
|
||||
available = percentage(x),
|
||||
visual_availabilty = paste0("|", x_chars, x_chars_empty, "|"),
|
||||
resistant = R_print,
|
||||
visual_resistance = vis_resistance,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (length(R[is.na(R)]) == ncol(tbl)) {
|
||||
df[, 1:3, drop = FALSE]
|
||||
} else {
|
||||
df
|
||||
}
|
||||
}
|
||||
@@ -1,381 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine Bug-Drug Combinations
|
||||
#'
|
||||
#' 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, 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 [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", "SDD", "I", "R", and "total".
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' # run ?example_isolates for more info.
|
||||
#' example_isolates
|
||||
#'
|
||||
#' \donttest{
|
||||
#' x <- bug_drug_combinations(example_isolates)
|
||||
#' head(x)
|
||||
#' format(x, translate_ab = "name (atc)")
|
||||
#'
|
||||
#' # Use FUN to change to transformation of microorganism codes
|
||||
#' bug_drug_combinations(example_isolates,
|
||||
#' FUN = mo_gramstain
|
||||
#' )
|
||||
#'
|
||||
#' bug_drug_combinations(example_isolates,
|
||||
#' FUN = function(x) {
|
||||
#' ifelse(x == as.mo("Escherichia coli"),
|
||||
#' "E. coli",
|
||||
#' "Others"
|
||||
#' )
|
||||
#' }
|
||||
#' )
|
||||
#' }
|
||||
bug_drug_combinations <- function(x,
|
||||
col_mo = NULL,
|
||||
FUN = mo_shortname,
|
||||
include_n_rows = FALSE,
|
||||
...) {
|
||||
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)
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo")
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
} else {
|
||||
stop_ifnot(col_mo %in% colnames(x), "column '", col_mo, "' (`col_mo`) not found")
|
||||
}
|
||||
|
||||
x.bak <- x
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x[, col_mo] <- FUN(x[, col_mo, drop = TRUE], ...)
|
||||
|
||||
unique_mo <- sort(unique(x[, col_mo, drop = TRUE]))
|
||||
|
||||
# select only groups and antimicrobials
|
||||
if (is_null_or_grouped_tbl(x.bak)) {
|
||||
data_has_groups <- TRUE
|
||||
groups <- get_group_names(x.bak)
|
||||
x <- x[, c(groups, col_mo, colnames(x)[vapply(FUN.VALUE = logical(1), x, is.sir)]), drop = FALSE]
|
||||
} else {
|
||||
data_has_groups <- FALSE
|
||||
x <- x[, c(col_mo, names(which(vapply(FUN.VALUE = logical(1), x, is.sir)))), drop = FALSE]
|
||||
}
|
||||
|
||||
run_it <- function(x) {
|
||||
out <- data.frame(
|
||||
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) {
|
||||
group_values <- unique(x[, which(colnames(x) %in% groups), drop = FALSE])
|
||||
rownames(group_values) <- NULL
|
||||
x <- x[, which(!colnames(x) %in% groups), drop = FALSE]
|
||||
}
|
||||
|
||||
for (i in seq_len(length(unique_mo))) {
|
||||
# filter on MO group and only select SIR columns
|
||||
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(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,
|
||||
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) {
|
||||
if (nrow(group_values) < nrow(out_group)) {
|
||||
# repeat group_values for the number of rows in out_group
|
||||
repeated <- rep(seq_len(nrow(group_values)),
|
||||
each = nrow(out_group) / nrow(group_values)
|
||||
)
|
||||
group_values <- group_values[repeated, , drop = FALSE]
|
||||
}
|
||||
out_group <- cbind(group_values, out_group)
|
||||
}
|
||||
out <- rbind_AMR(out, out_group)
|
||||
}
|
||||
out
|
||||
}
|
||||
# based on pm_apply_grouped_function
|
||||
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
|
||||
grouped <- pm_split_into_groups(.data, groups, drop)
|
||||
res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
|
||||
if (any(groups %in% colnames(res))) {
|
||||
class(res) <- c("grouped_data", class(res))
|
||||
res <- pm_set_groups(res, groups[groups %in% colnames(res)])
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
if (data_has_groups) {
|
||||
out <- apply_group(x, "run_it", groups)
|
||||
} else {
|
||||
out <- run_it(x)
|
||||
}
|
||||
|
||||
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
|
||||
out
|
||||
}
|
||||
|
||||
#' @method format bug_drug_combinations
|
||||
#' @export
|
||||
#' @rdname bug_drug_combinations
|
||||
format.bug_drug_combinations <- function(x,
|
||||
translate_ab = "name (ab, atc)",
|
||||
language = get_AMR_locale(),
|
||||
minimum = 30,
|
||||
combine_SI = TRUE,
|
||||
add_ab_group = TRUE,
|
||||
remove_intrinsic_resistant = FALSE,
|
||||
decimal.mark = getOption("OutDec"),
|
||||
big.mark = ifelse(decimal.mark == ",", ".", ","),
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
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)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(add_ab_group, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(remove_intrinsic_resistant, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(decimal.mark, allow_class = "character", has_length = 1)
|
||||
meet_criteria(big.mark, allow_class = "character", has_length = 1)
|
||||
|
||||
x.bak <- x
|
||||
if (inherits(x, "grouped")) {
|
||||
# bug_drug_combinations() has been run on groups, so de-group here
|
||||
warning_("in `format()`: formatting the output of `bug_drug_combinations()` does not support grouped variables, they were ignored")
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
idx <- split(seq_len(nrow(x)), paste0(x$mo, "%%", x$ab))
|
||||
x <- data.frame(
|
||||
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$NI[i], na.rm = TRUE)
|
||||
}),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x <- subset(x, total >= minimum)
|
||||
|
||||
if (remove_intrinsic_resistant == TRUE) {
|
||||
x <- subset(x, R != total)
|
||||
}
|
||||
if (combine_SI == TRUE) {
|
||||
x$isolates <- x$R
|
||||
} else {
|
||||
x$isolates <- x$R + x$I + x$SDD
|
||||
}
|
||||
|
||||
give_ab_name <- function(ab, format, language) {
|
||||
format <- tolower(format)
|
||||
ab_txt <- rep(format, length(ab))
|
||||
for (i in seq_len(length(ab_txt))) {
|
||||
ab_txt[i] <- gsub("ab", as.character(as.ab(ab[i])), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("cid", ab_cid(ab[i]), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("group", ab_group(ab[i], language = language), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("atc_group1", ab_atc_group1(ab[i], language = language), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("atc_group2", ab_atc_group2(ab[i], language = language), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("atc", ab_atc(ab[i], only_first = TRUE), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i] <- gsub("name", ab_name(ab[i], language = language), ab_txt[i], fixed = TRUE)
|
||||
ab_txt[i]
|
||||
}
|
||||
ab_txt
|
||||
}
|
||||
|
||||
remove_NAs <- function(.data) {
|
||||
cols <- colnames(.data)
|
||||
.data <- as.data.frame(lapply(.data, function(x) ifelse(is.na(x), "", x)),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
colnames(.data) <- cols
|
||||
.data
|
||||
}
|
||||
|
||||
create_var <- function(.data, ...) {
|
||||
dots <- list(...)
|
||||
for (i in seq_len(length(dots))) {
|
||||
.data[, names(dots)[i]] <- dots[[i]]
|
||||
}
|
||||
.data
|
||||
}
|
||||
|
||||
y <- x %pm>%
|
||||
create_var(
|
||||
ab = as.ab(x$ab),
|
||||
ab_txt = give_ab_name(ab = x$ab, format = translate_ab, language = language)
|
||||
) %pm>%
|
||||
pm_group_by(ab, ab_txt, mo) %pm>%
|
||||
pm_summarise(
|
||||
isolates = sum(isolates, na.rm = TRUE),
|
||||
total = sum(total, na.rm = TRUE)
|
||||
) %pm>%
|
||||
pm_ungroup()
|
||||
|
||||
y <- y %pm>%
|
||||
create_var(txt = paste0(
|
||||
percentage(y$isolates / y$total, decimal.mark = decimal.mark, big.mark = big.mark),
|
||||
" (", trimws(format(y$isolates, big.mark = big.mark)), "/",
|
||||
trimws(format(y$total, big.mark = big.mark)), ")"
|
||||
)) %pm>%
|
||||
pm_select(ab, ab_txt, mo, txt) %pm>%
|
||||
pm_arrange(mo)
|
||||
|
||||
# replace tidyr::pivot_wider() from here
|
||||
for (i in unique(y$mo)) {
|
||||
mo_group <- y[which(as.character(y$mo) == i), c("ab", "txt"), drop = FALSE]
|
||||
colnames(mo_group) <- c("ab", i)
|
||||
rownames(mo_group) <- NULL
|
||||
y <- y %pm>%
|
||||
pm_left_join(mo_group, by = "ab")
|
||||
}
|
||||
y <- y %pm>%
|
||||
pm_distinct(ab, .keep_all = TRUE) %pm>%
|
||||
pm_select(-mo, -txt) %pm>%
|
||||
# replace tidyr::pivot_wider() until here
|
||||
remove_NAs()
|
||||
|
||||
select_ab_vars <- function(.data) {
|
||||
.data[, c("ab_group", "ab_txt", colnames(.data)[!colnames(.data) %in% c("ab_group", "ab_txt", "ab")]), drop = FALSE]
|
||||
}
|
||||
|
||||
y <- y %pm>%
|
||||
create_var(ab_group = ab_group(y$ab, language = language)) %pm>%
|
||||
select_ab_vars() %pm>%
|
||||
pm_arrange(ab_group, ab_txt)
|
||||
y <- y %pm>%
|
||||
create_var(ab_group = ifelse(y$ab_group != pm_lag(y$ab_group) | is.na(pm_lag(y$ab_group)), y$ab_group, ""))
|
||||
|
||||
if (add_ab_group == FALSE) {
|
||||
y <- y %pm>%
|
||||
pm_select(-ab_group) %pm>%
|
||||
pm_rename("Drug" = ab_txt)
|
||||
colnames(y)[1] <- translate_into_language(colnames(y)[1], language, only_unknown = FALSE)
|
||||
} else {
|
||||
y <- y %pm>%
|
||||
pm_rename(
|
||||
"Group" = ab_group,
|
||||
"Drug" = ab_txt
|
||||
)
|
||||
}
|
||||
|
||||
if (!is.null(language)) {
|
||||
colnames(y) <- translate_into_language(colnames(y), language, only_unknown = FALSE)
|
||||
}
|
||||
|
||||
if (remove_intrinsic_resistant == TRUE) {
|
||||
y <- y[, !vapply(FUN.VALUE = logical(1), y, function(col) all(col %like% "100", na.rm = TRUE) & !anyNA(col)), drop = FALSE]
|
||||
}
|
||||
|
||||
rownames(y) <- NULL
|
||||
as_original_data_class(y, class(x.bak), extra_class = "formatted_bug_drug_combinations") # will remove tibble groups
|
||||
}
|
||||
|
||||
# will be exported in zzz.R
|
||||
knit_print.formatted_bug_drug_combinations <- function(x, ...) {
|
||||
stop_ifnot_installed("knitr")
|
||||
# make columns with MO names italic according to nomenclature
|
||||
colnames(x)[3:NCOL(x)] <- italicise_taxonomy(colnames(x)[3:NCOL(x)], type = "markdown")
|
||||
knitr::asis_output(paste("", "", knitr::kable(x, ...), collapse = "\n"))
|
||||
}
|
||||
|
||||
#' @method print bug_drug_combinations
|
||||
#' @export
|
||||
print.bug_drug_combinations <- function(x, ...) {
|
||||
x_class <- class(x)
|
||||
print(
|
||||
set_clean_class(x,
|
||||
new_class = x_class[!x_class %in% c("bug_drug_combinations", "grouped")]
|
||||
),
|
||||
...
|
||||
)
|
||||
message_("Use 'format()' on this result to get a publishable/printable format.",
|
||||
ifelse(inherits(x, "grouped"), " Note: The grouping variable(s) will be ignored.", ""),
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
@@ -1,245 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Count Available Isolates
|
||||
#'
|
||||
#' @description These functions can be used to count resistant/susceptible microbial isolates. All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
|
||||
#'
|
||||
#' [count_resistant()] should be used to count resistant isolates, [count_susceptible()] should be used to count susceptible isolates.
|
||||
#' @param ... One or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed.
|
||||
#' @inheritParams proportion
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @details These functions are meant to count isolates. Use the [resistance()]/[susceptibility()] functions to calculate microbial resistance/susceptibility.
|
||||
#'
|
||||
#' The function [count_resistant()] is equal to the function [count_R()]. The function [count_susceptible()] is equal to the function [count_SI()].
|
||||
#'
|
||||
#' The function [n_sir()] is an alias of [count_all()]. They can be used to count all available isolates, i.e. where all input antimicrobials have an available result (S, I or R). Their use is equal to `n_distinct()`. Their function is equal to `count_susceptible(...) + count_resistant(...)`.
|
||||
#'
|
||||
#' The function [count_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and counts the number of S's, I's and R's. It also supports grouped variables. The function [sir_df()] works exactly like [count_df()], but adds the percentage of S, I and R.
|
||||
#' @inheritSection proportion Combination Therapy
|
||||
#' @seealso [`proportion_*`][proportion] to calculate microbial resistance and susceptibility.
|
||||
#' @return An [integer]
|
||||
#' @rdname count
|
||||
#' @name count
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' # run ?example_isolates for more info.
|
||||
#'
|
||||
#' # base R ------------------------------------------------------------
|
||||
#' count_resistant(example_isolates$AMX) # counts "R"
|
||||
#' count_susceptible(example_isolates$AMX) # counts "S" and "I"
|
||||
#' count_all(example_isolates$AMX) # counts "S", "I" and "R"
|
||||
#'
|
||||
#' # be more specific
|
||||
#' count_S(example_isolates$AMX)
|
||||
#' count_SI(example_isolates$AMX)
|
||||
#' count_I(example_isolates$AMX)
|
||||
#' count_IR(example_isolates$AMX)
|
||||
#' count_R(example_isolates$AMX)
|
||||
#'
|
||||
#' # Count all available isolates
|
||||
#' count_all(example_isolates$AMX)
|
||||
#' n_sir(example_isolates$AMX)
|
||||
#'
|
||||
#' # n_sir() is an alias of count_all().
|
||||
#' # Since it counts all available isolates, you can
|
||||
#' # calculate back to count e.g. susceptible isolates.
|
||||
#' # These results are the same:
|
||||
#' count_susceptible(example_isolates$AMX)
|
||||
#' susceptibility(example_isolates$AMX) * n_sir(example_isolates$AMX)
|
||||
#'
|
||||
#' # dplyr -------------------------------------------------------------
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' R = count_R(CIP),
|
||||
#' I = count_I(CIP),
|
||||
#' S = count_S(CIP),
|
||||
#' n1 = count_all(CIP), # the actual total; sum of all three
|
||||
#' n2 = n_sir(CIP), # same - analogous to n_distinct
|
||||
#' total = n()
|
||||
#' ) # NOT the number of tested isolates!
|
||||
#'
|
||||
#' # Number of available isolates for a whole antibiotic class
|
||||
#' # (i.e., in this data set columns GEN, TOB, AMK, KAN)
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(across(aminoglycosides(), n_sir))
|
||||
#'
|
||||
#' # Count co-resistance between amoxicillin/clav acid and gentamicin,
|
||||
#' # so we can see that combination therapy does a lot more than mono therapy.
|
||||
#' # Please mind that `susceptibility()` calculates percentages right away instead.
|
||||
#' example_isolates %>% count_susceptible(AMC) # 1433
|
||||
#' example_isolates %>% count_all(AMC) # 1879
|
||||
#'
|
||||
#' example_isolates %>% count_susceptible(GEN) # 1399
|
||||
#' example_isolates %>% count_all(GEN) # 1855
|
||||
#'
|
||||
#' example_isolates %>% count_susceptible(AMC, GEN) # 1764
|
||||
#' example_isolates %>% count_all(AMC, GEN) # 1936
|
||||
#'
|
||||
#' # Get number of S+I vs. R immediately of selected columns
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, CIP) %>%
|
||||
#' count_df(translate = FALSE)
|
||||
#'
|
||||
#' # It also supports grouping variables
|
||||
#' example_isolates %>%
|
||||
#' select(ward, AMX, CIP) %>%
|
||||
#' group_by(ward) %>%
|
||||
#' count_df(translate = FALSE)
|
||||
#' }
|
||||
#' }
|
||||
count_resistant <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "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_susceptible <- function(..., only_all_tested = 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_S <- function(..., only_all_tested = 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) {
|
||||
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) {
|
||||
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) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "SDD", "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_R <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "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_all <- function(..., only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
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)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
n_sir <- count_all
|
||||
|
||||
#' @rdname count
|
||||
#' @export
|
||||
count_df <- function(data,
|
||||
translate_ab = "name",
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE) {
|
||||
tryCatch(
|
||||
sir_calc_df(
|
||||
type = "count",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
combine_SI = combine_SI,
|
||||
confidence_level = 0.95 # doesn't matter, will be removed
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
@@ -1,170 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Add Custom Antimicrobials
|
||||
#'
|
||||
#' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes.
|
||||
#' @param x A [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name".
|
||||
#' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
|
||||
#'
|
||||
#' There are two ways to circumvent this and automate the process of adding antimicrobials:
|
||||
#'
|
||||
#' **Method 1:** Using the package option [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
|
||||
#'
|
||||
#' 1. Create a data set in the structure of the [antimicrobials] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
|
||||
#'
|
||||
#' 2. Set the file location to the package option [`AMR_custom_ab`][AMR-options]: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom antimicrobial codes:
|
||||
#' options(AMR_custom_ab = "~/my_custom_ab.rds")
|
||||
#' ```
|
||||
#'
|
||||
#' Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
|
||||
#'
|
||||
#' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
|
||||
#'
|
||||
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||
#'
|
||||
#' 2. Add a text like below and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom antibiotic drug codes:
|
||||
#' AMR::add_custom_antimicrobials(
|
||||
#' data.frame(ab = "TESTAB",
|
||||
#' name = "Test Antibiotic",
|
||||
#' group = "Test Group")
|
||||
#' )
|
||||
#' ```
|
||||
#'
|
||||
#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials.
|
||||
#' @seealso [add_custom_microorganisms()] to add custom microorganisms.
|
||||
#' @rdname add_custom_antimicrobials
|
||||
#' @export
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' # returns a wildly guessed result:
|
||||
#' as.ab("testab")
|
||||
#'
|
||||
#' # now add a custom entry - it will be considered by as.ab() and
|
||||
#' # all ab_*() functions
|
||||
#' add_custom_antimicrobials(
|
||||
#' data.frame(
|
||||
#' ab = "TESTAB",
|
||||
#' name = "Test Antibiotic",
|
||||
#' # you can add any property present in the
|
||||
#' # 'antimicrobials' data set, such as 'group':
|
||||
#' group = "Test Group"
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#' # "testab" is now a new antibiotic:
|
||||
#' as.ab("testab")
|
||||
#' ab_name("testab")
|
||||
#' ab_group("testab")
|
||||
#'
|
||||
#' ab_info("testab")
|
||||
#'
|
||||
#'
|
||||
#' # Add Co-fluampicil, which is one of the many J01CR50 codes, see
|
||||
#' # https://atcddd.fhi.no/ddd/list_of_ddds_combined_products/
|
||||
#' add_custom_antimicrobials(
|
||||
#' data.frame(
|
||||
#' ab = "COFLU",
|
||||
#' name = "Co-fluampicil",
|
||||
#' atc = "J01CR50",
|
||||
#' group = "Beta-lactams/penicillins"
|
||||
#' )
|
||||
#' )
|
||||
#' ab_atc("Co-fluampicil")
|
||||
#' ab_name("J01CR50")
|
||||
#'
|
||||
#' # even antimicrobial selectors work
|
||||
#' # see ?amr_selector
|
||||
#' x <- data.frame(
|
||||
#' random_column = "some value",
|
||||
#' coflu = as.sir("S"),
|
||||
#' ampicillin = as.sir("R")
|
||||
#' )
|
||||
#' x
|
||||
#' x[, betalactams()]
|
||||
#' }
|
||||
add_custom_antimicrobials <- function(x) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
stop_ifnot(
|
||||
all(c("ab", "name") %in% colnames(x)),
|
||||
"`x` must contain columns \"ab\" and \"name\"."
|
||||
)
|
||||
stop_if(
|
||||
any(x$ab %in% AMR_env$AB_lookup$ab),
|
||||
"Antimicrobial drug code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set."
|
||||
)
|
||||
# remove any extra class/type, such as grouped tbl, or data.table:
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
# 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)
|
||||
for (col in colnames(x)) {
|
||||
if (is.list(AMR_env$AB_lookup[, col, drop = TRUE]) & !is.list(x[, col, drop = TRUE])) {
|
||||
x[, col] <- as.list(x[, col, drop = TRUE])
|
||||
}
|
||||
}
|
||||
|
||||
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
|
||||
class(AMR_env$AB_lookup$ab) <- "character"
|
||||
|
||||
new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
||||
rownames(new_df) <- NULL
|
||||
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
|
||||
for (l in which(list_cols)) {
|
||||
# prevent binding NULLs in lists, replace with NA
|
||||
new_df[, l] <- as.list(NA_character_)
|
||||
}
|
||||
for (col in colnames(x)) {
|
||||
# assign new values
|
||||
new_df[, col] <- x[, col, drop = TRUE]
|
||||
}
|
||||
AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df))
|
||||
|
||||
AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% c(x$ab, x$generalised_name) & !AMR_env$ab_previously_coerced$x %in% c(x$ab, x$generalised_name)), , drop = FALSE]
|
||||
class(AMR_env$AB_lookup$ab) <- c("ab", "character")
|
||||
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::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 `antimicrobials` data set.")
|
||||
}
|
||||
@@ -1,312 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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 below for instructions, and in *Examples*.
|
||||
#' @details
|
||||
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
|
||||
#' @section How it works:
|
||||
#'
|
||||
#' ### Basics
|
||||
#'
|
||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||
#'
|
||||
#' ```r
|
||||
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" ~ aminopenicillins == "R")
|
||||
#' ```
|
||||
#'
|
||||
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
|
||||
#'
|
||||
#' ```r
|
||||
#' x
|
||||
#' #> A set of custom EUCAST rules:
|
||||
#' #>
|
||||
#' #> 1. If TZP is "S" then set to S :
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' #>
|
||||
#' #> 2. If TZP is "R" then set to R :
|
||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||
#' ```
|
||||
#'
|
||||
#' The rules (the part *before* the tilde, in above example `TZP == "S"` and `TZP == "R"`) must be evaluable in your data set: it should be able to run as a filter in your data set without errors. This means for the above example that the column `TZP` must exist. We will create a sample data set and test the rules set:
|
||||
#'
|
||||
#' ```r
|
||||
#' df <- data.frame(mo = c("Escherichia coli", "Klebsiella pneumoniae"),
|
||||
#' TZP = as.sir("R"),
|
||||
#' ampi = as.sir("S"),
|
||||
#' cipro = as.sir("S"))
|
||||
#' df
|
||||
#' #> mo TZP ampi cipro
|
||||
#' #> 1 Escherichia coli R S S
|
||||
#' #> 2 Klebsiella pneumoniae R S S
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = x, info = FALSE, overwrite = TRUE)
|
||||
#' #> mo TZP ampi cipro
|
||||
#' #> 1 Escherichia coli R R S
|
||||
#' #> 2 Klebsiella pneumoniae R R S
|
||||
#' ```
|
||||
#'
|
||||
#' ### Using taxonomic properties in rules
|
||||
#'
|
||||
#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||
#'
|
||||
#' ```r
|
||||
#' y <- custom_eucast_rules(TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R")
|
||||
#'
|
||||
#' eucast_rules(df, rules = "custom", custom_rules = y, info = FALSE, overwrite = TRUE)
|
||||
#' #> mo TZP ampi cipro
|
||||
#' #> 1 Escherichia coli R S S
|
||||
#' #> 2 Klebsiella pneumoniae R R S
|
||||
#' ```
|
||||
#'
|
||||
#' ### Usage of multiple antimicrobials and antimicrobial group names
|
||||
#'
|
||||
#' You can define antimicrobial groups instead of single antimicrobials for the rule consequence, which is the part *after* the tilde (~). In the examples above, the antimicrobial group `aminopenicillins` includes both ampicillin and amoxicillin.
|
||||
#'
|
||||
#' 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
|
||||
#' x <- custom_eucast_rules(
|
||||
#' AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I"
|
||||
#' )
|
||||
#' x
|
||||
#'
|
||||
#' # run the custom rule set (verbose = TRUE will return a logbook instead of the data set):
|
||||
#' eucast_rules(example_isolates,
|
||||
#' rules = "custom",
|
||||
#' custom_rules = x,
|
||||
#' info = FALSE,
|
||||
#' overwrite = TRUE,
|
||||
#' verbose = TRUE
|
||||
#' )
|
||||
#'
|
||||
#' # combine rule sets
|
||||
#' x2 <- c(
|
||||
#' x,
|
||||
#' custom_eucast_rules(TZP == "R" ~ carbapenems == "R")
|
||||
#' )
|
||||
#' x2
|
||||
custom_eucast_rules <- function(...) {
|
||||
dots <- tryCatch(list(...),
|
||||
error = function(e) "error"
|
||||
)
|
||||
stop_if(
|
||||
identical(dots, "error"),
|
||||
"rules must be a valid formula inputs (e.g., using '~'), see `?custom_eucast_rules`"
|
||||
)
|
||||
n_dots <- length(dots)
|
||||
stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using `?custom_eucast_rules`.")
|
||||
out <- vector("list", n_dots)
|
||||
for (i in seq_len(n_dots)) {
|
||||
stop_ifnot(
|
||||
inherits(dots[[i]], "formula"),
|
||||
"rule ", i, " must be a valid formula input (e.g., using '~'), see `?custom_eucast_rules`"
|
||||
)
|
||||
|
||||
# Query
|
||||
qry <- dots[[i]][[2]]
|
||||
if (inherits(qry, "call")) {
|
||||
qry <- as.expression(qry)
|
||||
}
|
||||
qry <- as.character(qry)
|
||||
# these will prevent vectorisation, so replace them:
|
||||
qry <- gsub("&&", "&", qry, fixed = TRUE)
|
||||
qry <- gsub("||", "|", qry, fixed = TRUE)
|
||||
# format nicely, setting spaces around operators
|
||||
qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
|
||||
qry <- gsub(" ?, ?", ", ", qry)
|
||||
qry <- gsub("'", "\"", qry, fixed = TRUE)
|
||||
out[[i]]$query <- as.expression(qry)
|
||||
|
||||
# Resulting rule
|
||||
result <- dots[[i]][[3]]
|
||||
stop_ifnot(
|
||||
deparse(result) %like% "==",
|
||||
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see `?custom_eucast_rules`"
|
||||
)
|
||||
result_group <- as.character(result)[[2]]
|
||||
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(
|
||||
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), "."
|
||||
)
|
||||
result_value <- as.character(result)[[3]]
|
||||
result_value[result_value == "NA"] <- NA
|
||||
stop_ifnot(
|
||||
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_agents
|
||||
out[[i]]$result_value <- result_value
|
||||
}
|
||||
|
||||
names(out) <- paste0("rule", seq_len(n_dots))
|
||||
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||
}
|
||||
|
||||
#' @method c custom_eucast_rules
|
||||
#' @noRd
|
||||
#' @export
|
||||
c.custom_eucast_rules <- function(x, ...) {
|
||||
if (length(list(...)) == 0) {
|
||||
return(x)
|
||||
}
|
||||
out <- unclass(x)
|
||||
for (e in list(...)) {
|
||||
out <- c(out, unclass(e))
|
||||
}
|
||||
names(out) <- paste0("rule", seq_len(length(out)))
|
||||
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||
}
|
||||
|
||||
#' @method as.list custom_eucast_rules
|
||||
#' @noRd
|
||||
#' @export
|
||||
as.list.custom_eucast_rules <- function(x, ...) {
|
||||
c(x, ...)
|
||||
}
|
||||
|
||||
#' @method print custom_eucast_rules
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.custom_eucast_rules <- function(x, ...) {
|
||||
cat("A set of custom EUCAST rules:\n")
|
||||
for (i in seq_len(length(x))) {
|
||||
rule <- x[[i]]
|
||||
rule$query <- format_custom_query_rule(rule$query)
|
||||
if (is.na(rule$result_value)) {
|
||||
val <- font_red("<NA>")
|
||||
} else if (rule$result_value == "R") {
|
||||
val <- font_rose_bg(" R ")
|
||||
} else if (rule$result_value == "S") {
|
||||
val <- font_green_bg(" S ")
|
||||
} else {
|
||||
val <- font_orange_bg(" I ")
|
||||
}
|
||||
agents <- paste0(
|
||||
font_blue(ab_name(rule$result_group, language = NULL, tolower = TRUE),
|
||||
collapse = NULL
|
||||
),
|
||||
" (", rule$result_group, ")"
|
||||
)
|
||||
agents <- sort(agents)
|
||||
rule_if <- word_wrap(
|
||||
paste0(
|
||||
i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
||||
"set to {result}:"
|
||||
),
|
||||
extra_indent = 5
|
||||
)
|
||||
rule_if <- gsub("{result}", val, rule_if, fixed = TRUE)
|
||||
rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5))
|
||||
cat("\n ", rule_if, "\n", rule_then, "\n", sep = "")
|
||||
}
|
||||
}
|
||||
|
||||
format_custom_query_rule <- function(query, colours = has_colour()) {
|
||||
# font_black() is a bit expensive so do it once:
|
||||
txt <- font_black("{text}")
|
||||
query <- gsub(" & ", sub("{text}", font_bold(" and "), txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" | ", sub("{text}", " or ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" + ", sub("{text}", " plus ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" - ", sub("{text}", " minus ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" / ", sub("{text}", " divided by ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" * ", sub("{text}", " times ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" == ", sub("{text}", " is ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" > ", sub("{text}", " is higher than ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" < ", sub("{text}", " is lower than ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" >= ", sub("{text}", " is higher than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" <= ", sub("{text}", " is lower than or equal to ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" ^ ", sub("{text}", " to the power of ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
|
||||
if (colours == TRUE) {
|
||||
query <- gsub('"R"', font_rose_bg(" R "), query, fixed = TRUE)
|
||||
query <- gsub('"S"', font_green_bg(" S "), query, fixed = TRUE)
|
||||
query <- gsub('"I"', font_orange_bg(" I "), query, fixed = TRUE)
|
||||
}
|
||||
# replace the black colour 'stops' with blue colour 'starts'
|
||||
query <- gsub("\033[39m", "\033[34m", as.character(query), fixed = TRUE)
|
||||
# start with blue
|
||||
query <- paste0("\033[34m", query)
|
||||
if (colours == FALSE) {
|
||||
query <- font_stripstyle(query)
|
||||
}
|
||||
query
|
||||
}
|
||||
@@ -1,336 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Add Custom Microorganisms
|
||||
#'
|
||||
#' With [add_custom_microorganisms()] you can add your own custom microorganisms, such the non-taxonomic outcome of laboratory analysis.
|
||||
#' @param x A [data.frame] resembling the [microorganisms] data set, at least containing column "genus" (case-insensitive).
|
||||
#' @details This function will fill in missing taxonomy for you, if specific taxonomic columns are missing, see *Examples*.
|
||||
#'
|
||||
#' **Important:** Due to how \R works, the [add_custom_microorganisms()] function has to be run in every \R session - added microorganisms 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 microorganisms:
|
||||
#'
|
||||
#' **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_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:
|
||||
#' options(AMR_custom_mo = "~/my_custom_mo.rds")
|
||||
#' ```
|
||||
#'
|
||||
#' Upon package load, this file will be loaded and run through the [add_custom_microorganisms()] function.
|
||||
#'
|
||||
#' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
|
||||
#'
|
||||
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||
#'
|
||||
#' 2. Add a text like below and save the file:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Add custom antibiotic drug codes:
|
||||
#' AMR::add_custom_microorganisms(
|
||||
#' data.frame(genus = "Enterobacter",
|
||||
#' species = "asburiae/cloacae")
|
||||
#' )
|
||||
#' ```
|
||||
#'
|
||||
#' Use [clear_custom_microorganisms()] to clear the previously added microorganisms.
|
||||
#' @seealso [add_custom_antimicrobials()] to add custom antimicrobials.
|
||||
#' @rdname add_custom_microorganisms
|
||||
#' @export
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' # a combination of species is not formal taxonomy, so
|
||||
#' # this will result in "Enterobacter cloacae cloacae",
|
||||
#' # since it resembles the input best:
|
||||
#' mo_name("Enterobacter asburiae/cloacae")
|
||||
#'
|
||||
#' # now add a custom entry - it will be considered by as.mo() and
|
||||
#' # all mo_*() functions
|
||||
#' add_custom_microorganisms(
|
||||
#' data.frame(
|
||||
#' genus = "Enterobacter",
|
||||
#' species = "asburiae/cloacae"
|
||||
#' )
|
||||
#' )
|
||||
#'
|
||||
#' # E. asburiae/cloacae is now a new microorganism:
|
||||
#' mo_name("Enterobacter asburiae/cloacae")
|
||||
#'
|
||||
#' # its code:
|
||||
#' as.mo("Enterobacter asburiae/cloacae")
|
||||
#'
|
||||
#' # all internal algorithms will work as well:
|
||||
#' mo_name("Ent asburia cloacae")
|
||||
#'
|
||||
#' # and even the taxonomy was added based on the genus!
|
||||
#' mo_family("E. asburiae/cloacae")
|
||||
#' mo_gramstain("Enterobacter asburiae/cloacae")
|
||||
#'
|
||||
#' mo_info("Enterobacter asburiae/cloacae")
|
||||
#'
|
||||
#'
|
||||
#' # the function tries to be forgiving:
|
||||
#' add_custom_microorganisms(
|
||||
#' data.frame(
|
||||
#' GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
|
||||
#' SPECIES = "SPECIES"
|
||||
#' )
|
||||
#' )
|
||||
#' mo_name("BACTEROIDES / PARABACTEROIDES")
|
||||
#' mo_rank("BACTEROIDES / PARABACTEROIDES")
|
||||
#'
|
||||
#' # taxonomy still works, even though a slashline genus was given as input:
|
||||
#' mo_family("Bacteroides/Parabacteroides")
|
||||
#'
|
||||
#'
|
||||
#' # for groups and complexes, set them as species or subspecies:
|
||||
#' add_custom_microorganisms(
|
||||
#' data.frame(
|
||||
#' genus = "Citrobacter",
|
||||
#' species = c("freundii", "braakii complex"),
|
||||
#' subspecies = c("complex", "")
|
||||
#' )
|
||||
#' )
|
||||
#' mo_name(c("C. freundii complex", "C. braakii complex"))
|
||||
#' mo_species(c("C. freundii complex", "C. braakii complex"))
|
||||
#' mo_gramstain(c("C. freundii complex", "C. braakii complex"))
|
||||
#' }
|
||||
add_custom_microorganisms <- function(x) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'."))
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
# remove any extra class/type, such as grouped tbl, or data.table:
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
colnames(x) <- tolower(colnames(x))
|
||||
# rename 'name' to 'fullname' if it's in the data set
|
||||
if ("name" %in% colnames(x) && !"fullname" %in% colnames(x)) {
|
||||
colnames(x)[colnames(x) == "name"] <- "fullname"
|
||||
}
|
||||
# keep only columns available in the microorganisms data set
|
||||
x <- x[, colnames(AMR_env$MO_lookup)[colnames(AMR_env$MO_lookup) %in% colnames(x)], drop = FALSE]
|
||||
|
||||
# clean the input ----
|
||||
for (col in c("genus", "species", "subspecies")) {
|
||||
if (!col %in% colnames(x)) {
|
||||
x[, col] <- ""
|
||||
}
|
||||
if (is.factor(x[, col, drop = TRUE])) {
|
||||
x[, col] <- as.character(x[, col, drop = TRUE])
|
||||
}
|
||||
col_ <- x[, col, drop = TRUE]
|
||||
col_ <- tolower(col_)
|
||||
col_ <- gsub("slashline", "", col_, fixed = TRUE)
|
||||
col_ <- trimws2(col_)
|
||||
col_[col_ %like% "(sub)?species"] <- ""
|
||||
col_ <- gsub(" *([/-]) *", "\\1", col_, perl = TRUE)
|
||||
# groups are in our taxonomic table with a capital G
|
||||
col_ <- gsub(" group( |$)", " Group\\1", col_, perl = TRUE)
|
||||
|
||||
col_[is.na(col_)] <- ""
|
||||
if (col == "genus") {
|
||||
substr(col_, 1, 1) <- toupper(substr(col_, 1, 1))
|
||||
col_ <- gsub("/([a-z])", "/\\U\\1", col_, perl = TRUE)
|
||||
stop_if(any(col_ == ""), "the 'genus' column cannot be empty")
|
||||
stop_if(any(col_ %like% " "), "the 'genus' column must not contain spaces")
|
||||
}
|
||||
x[, col] <- col_
|
||||
}
|
||||
# if subspecies is a group or complex, add it to the species and empty the subspecies
|
||||
x$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste(
|
||||
x$species[which(x$subspecies %in% c("group", "Group", "complex"))],
|
||||
x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))]
|
||||
)
|
||||
x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))] <- ""
|
||||
|
||||
if ("rank" %in% colnames(x)) {
|
||||
stop_ifnot(
|
||||
all(x$rank %in% AMR_env$MO_lookup$rank),
|
||||
"the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank)
|
||||
)
|
||||
} else {
|
||||
x$rank <- ifelse(x$subspecies != "", "subspecies",
|
||||
ifelse(x$species != "", "species",
|
||||
ifelse(x$genus != "", "genus",
|
||||
stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added",
|
||||
call. = FALSE
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
x$source <- "Added by user"
|
||||
if (!"fullname" %in% colnames(x)) {
|
||||
x$fullname <- trimws2(paste(x$genus, x$species, x$subspecies))
|
||||
}
|
||||
if (!"kingdom" %in% colnames(x)) x$kingdom <- ""
|
||||
if (!"phylum" %in% colnames(x)) x$phylum <- ""
|
||||
if (!"class" %in% colnames(x)) x$class <- ""
|
||||
if (!"order" %in% colnames(x)) x$order <- ""
|
||||
if (!"family" %in% colnames(x)) x$family <- ""
|
||||
x$kingdom[is.na(x$kingdom)] <- ""
|
||||
x$phylum[is.na(x$phylum)] <- ""
|
||||
x$class[is.na(x$class)] <- ""
|
||||
x$order[is.na(x$order)] <- ""
|
||||
x$family[is.na(x$family)] <- ""
|
||||
|
||||
for (col in colnames(x)) {
|
||||
if (is.factor(x[, col, drop = TRUE])) {
|
||||
x[, col] <- as.character(x[, col, drop = TRUE])
|
||||
}
|
||||
if (is.list(AMR_env$MO_lookup[, col, drop = TRUE])) {
|
||||
x[, col] <- as.list(x[, col, drop = TRUE])
|
||||
}
|
||||
}
|
||||
|
||||
# fill in taxonomy based on genus
|
||||
genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
|
||||
x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
x$phylum[which(x$phylum == "" & genus_to_check != "")] <- AMR_env$MO_lookup$phylum[match(genus_to_check[which(x$phylum == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
x$order[which(x$order == "" & genus_to_check != "")] <- AMR_env$MO_lookup$order[match(genus_to_check[which(x$order == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
x$family[which(x$family == "" & genus_to_check != "")] <- AMR_env$MO_lookup$family[match(genus_to_check[which(x$family == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
|
||||
# fill in other columns that are used in internal algorithms
|
||||
x$prevalence <- NA_real_
|
||||
x$prevalence[which(genus_to_check != "")] <- AMR_env$MO_lookup$prevalence[match(genus_to_check[which(genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||
x$prevalence[is.na(x$prevalence)] <- 1.25
|
||||
x$status <- "accepted"
|
||||
x$ref <- paste("Self-added,", format(Sys.Date(), "%Y"))
|
||||
x$kingdom_index <- AMR_env$MO_lookup$kingdom_index[match(genus_to_check, AMR_env$MO_lookup$genus)]
|
||||
# complete missing kingdom index, so mo_matching_score() will not return NA
|
||||
x$kingdom_index[is.na(x$kingdom_index)] <- 1
|
||||
x$fullname_lower <- tolower(x$fullname)
|
||||
x$full_first <- substr(x$fullname_lower, 1, 1)
|
||||
x$species_first <- tolower(substr(x$species, 1, 1))
|
||||
x$subspecies_first <- tolower(substr(x$subspecies, 1, 1))
|
||||
|
||||
if (!"mo" %in% colnames(x)) {
|
||||
# create the mo code
|
||||
x$mo <- NA_character_
|
||||
}
|
||||
x$mo <- trimws2(as.character(x$mo))
|
||||
x$mo[x$mo == ""] <- NA_character_
|
||||
current <- sum(AMR_env$MO_lookup$source == "Added by user", na.rm = TRUE)
|
||||
x$mo[is.na(x$mo)] <- paste0(
|
||||
"CUSTOM",
|
||||
seq.int(from = current + 1, to = current + nrow(x), by = 1),
|
||||
"_",
|
||||
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 = "_"
|
||||
)
|
||||
)
|
||||
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"
|
||||
|
||||
new_df <- AMR_env$MO_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
||||
rownames(new_df) <- NULL
|
||||
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
|
||||
for (l in which(list_cols)) {
|
||||
# prevent binding NULLs in lists, replace with NA
|
||||
new_df[, l] <- as.list(NA_character_)
|
||||
}
|
||||
for (col in colnames(x)) {
|
||||
# assign new values
|
||||
new_df[, col] <- x[, col, drop = TRUE]
|
||||
}
|
||||
|
||||
# clear previous coercions
|
||||
suppressMessages(mo_reset_session())
|
||||
|
||||
AMR_env$MO_lookup <- unique(rbind_AMR(AMR_env$MO_lookup, new_df))
|
||||
class(AMR_env$MO_lookup$mo) <- c("mo", "character")
|
||||
if (nrow(x) <= 3) {
|
||||
message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.")
|
||||
} else {
|
||||
message_("Added ", nr2char(nrow(x)), " records to the internal `microorganisms` data set.")
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname add_custom_microorganisms
|
||||
#' @export
|
||||
clear_custom_microorganisms <- function() {
|
||||
n <- nrow(AMR_env$MO_lookup)
|
||||
|
||||
# reset
|
||||
AMR_env$MO_lookup <- NULL
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
# clear previous coercions
|
||||
suppressMessages(mo_reset_session())
|
||||
|
||||
n2 <- nrow(AMR_env$MO_lookup)
|
||||
AMR_env$custom_mo_codes <- character(0)
|
||||
AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE]
|
||||
AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE]
|
||||
message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal `microorganisms` data set.")
|
||||
}
|
||||
|
||||
abbreviate_mo <- function(x, minlength = 5, prefix = "", hyphen_as_space = FALSE, ...) {
|
||||
if (hyphen_as_space == TRUE) {
|
||||
x <- gsub("-", " ", x, fixed = TRUE)
|
||||
}
|
||||
# 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",
|
||||
...
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
}
|
||||
@@ -1,357 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Data Sets with `r format(nrow(antimicrobials) + nrow(antivirals), big.mark = " ")` Antimicrobial Drugs
|
||||
#'
|
||||
#' Two data sets containing all antimicrobials and antivirals. Use [as.ab()] or one of the [`ab_*`][ab_property()] functions to retrieve values from the [antimicrobials] data set. Three identifiers are included in this data set: an antimicrobial ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes. Note that some drugs have multiple ATC codes.
|
||||
#' @format
|
||||
#' ### For the [antimicrobials] data set: a [tibble][tibble::tibble] with `r nrow(antimicrobials)` observations and `r ncol(antimicrobials)` variables:
|
||||
#' - `ab`\cr antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.***
|
||||
#' - `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` (last updated `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`):
|
||||
#' - `atc_group1`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC, like `"Macrolides, lincosamides and streptogramins"`
|
||||
#' - `atc_group2`\cr Official chemical subgroup (4th level ATC code) as defined by the WHOCC, like `"Macrolides"`
|
||||
#' - `abbr`\cr List of abbreviations as used in many countries, also for antimicrobial susceptibility testing (AST)
|
||||
#' - `synonyms`\cr Synonyms (often trade names) of a drug, as found in PubChem based on their compound ID
|
||||
#'
|
||||
#' ATC properties (last updated `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`):
|
||||
#'
|
||||
#' - `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(AMR::antimicrobials$iv_ddd))` drugs
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#'
|
||||
#' LOINC:
|
||||
#'
|
||||
#' - `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.***
|
||||
#' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC, see *Details*
|
||||
#' - `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
|
||||
#' - `oral_units`\cr Units of `oral_ddd`
|
||||
#' - `iv_ddd`\cr Defined Daily Dose (DDD), parenteral treatment
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#' - `loinc`\cr All codes associated with the name of the antiviral drug from `r TAXONOMY_VERSION$LOINC$citation` Use [av_loinc()] to retrieve them quickly, see [av_property()].
|
||||
#' @details Properties that are based on an ATC code are only available when an ATC is available. These properties are: `atc_group1`, `atc_group2`, `oral_ddd`, `oral_units`, `iv_ddd` and `iv_units`. Do note that ATC codes are not unique. For example, J01CR02 is officially the ATC code for "amoxicillin and beta-lactamase inhibitor". Consequently, these two items from the [antimicrobials] data set both return `"J01CR02"`:
|
||||
#'
|
||||
#' ```r
|
||||
#' ab_atc("amoxicillin/clavulanic acid")
|
||||
#' ab_atc("amoxicillin/sulbactam")
|
||||
#' ```
|
||||
#'
|
||||
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and are consequently only available where a CID is available.
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @source
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$ATC_DDD$citation` Accessed from <`r TAXONOMY_VERSION$ATC_DDD$url`> on `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`.
|
||||
#'
|
||||
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
|
||||
#'
|
||||
#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
|
||||
#' @inheritSection WHOCC WHOCC
|
||||
#' @seealso [microorganisms], [intrinsic_resistant]
|
||||
#' @examples
|
||||
#' antimicrobials
|
||||
#' antivirals
|
||||
"antimicrobials"
|
||||
|
||||
#' @rdname antimicrobials
|
||||
"antivirals"
|
||||
|
||||
#' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Taxonomic Records of Microorganisms
|
||||
#'
|
||||
#' @description
|
||||
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
|
||||
#'
|
||||
#' This data set is carefully crafted, yet made 100% reproducible from public and authoritative taxonomic sources (using [this script](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R)), namely: *`r TAXONOMY_VERSION$LPSN$name`* for bacteria, *`r TAXONOMY_VERSION$MycoBank$name`* for fungi, and *`r TAXONOMY_VERSION$GBIF$name`* for all others taxons.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms), big.mark = " ")` observations and `r ncol(microorganisms)` variables:
|
||||
#' - `mo`\cr ID of microorganism as used by this package. ***This is a unique identifier.***
|
||||
#' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. ***This is a unique identifier.***
|
||||
#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status)`
|
||||
#' - `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.
|
||||
#' - `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
|
||||
#' - `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
|
||||
#' - `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 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 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 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])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Protozoa"), , drop = FALSE])` (sub)species from the kingdom of Protozoa
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
|
||||
#' - All `r format_included_data_number(microorganisms[which(microorganisms$status != "accepted"), , drop = FALSE])` previously accepted names of all included (sub)species (these were taxonomically renamed)
|
||||
#' - The complete taxonomic tree of all included (sub)species: from kingdom to subspecies
|
||||
#' - The identifier of the parent taxons
|
||||
#' - The year and first author of the related scientific publication
|
||||
#'
|
||||
#' ### Manual additions
|
||||
#' For convenience, some entries were added manually:
|
||||
#'
|
||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$source == "manually added" & microorganisms$genus == "Salmonella"), , drop = FALSE])` entries of *Salmonella*, such as the city-like serovars and groups A to H
|
||||
#' - `r format_included_data_number(length(which(microorganisms$rank == "species group")))` species groups (such as the beta-haemolytic *Streptococcus* groups A to K, coagulase-negative *Staphylococcus* (CoNS), *Mycobacterium tuberculosis* complex, etc.), of which the group compositions are stored in the [microorganisms.groups] data set
|
||||
#' - 1 entry of *Blastocystis* (*B. hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
|
||||
#' - 1 entry of *Moraxella* (*M. catarrhalis*), which was formally named *Branhamella catarrhalis* (Catlin, 1970) though this change was never accepted within the field of clinical microbiology
|
||||
#' - 8 other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
|
||||
#'
|
||||
#' The syntax used to transform the original data to a cleansed \R format, can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R).
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @source
|
||||
#' Taxonomic entries were imported in this order of importance:
|
||||
#' 1. `r TAXONOMY_VERSION$LPSN$name`:\cr\cr
|
||||
#' `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
|
||||
#'
|
||||
#' 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)`.
|
||||
#'
|
||||
#' 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).
|
||||
#'
|
||||
#' * Bartlett *et al.* (2022). **A comprehensive list of bacterial pathogens infecting humans** *Microbiology* 168:001269; \doi{10.1099/mic.0.001269}
|
||||
#' @seealso [as.mo()], [mo_property()], [microorganisms.groups], [microorganisms.codes], [intrinsic_resistant]
|
||||
#' @examples
|
||||
#' microorganisms
|
||||
"microorganisms"
|
||||
|
||||
#' Data Set with `r format(nrow(microorganisms.codes), big.mark = " ")` Common Microorganism Codes
|
||||
#'
|
||||
#' A data set containing commonly used codes for microorganisms, from laboratory systems and [WHONET](https://whonet.org). Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.codes), big.mark = " ")` observations and `r ncol(microorganisms.codes)` variables:
|
||||
#' - `code`\cr Commonly used code of a microorganism. ***This is a unique identifier.***
|
||||
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @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"
|
||||
|
||||
#' Data Set with `r format(nrow(microorganisms.groups), big.mark = " ")` Microorganisms In Species Groups
|
||||
#'
|
||||
#' A data set containing species groups and microbiological complexes, which are used in [the clinical breakpoints table][clinical_breakpoints].
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.groups), big.mark = " ")` observations and `r ncol(microorganisms.groups)` variables:
|
||||
#' - `mo_group`\cr ID of the species group / microbiological complex
|
||||
#' - `mo`\cr ID of the microorganism belonging in the species group / microbiological complex
|
||||
#' - `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()]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @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"
|
||||
|
||||
#' Data Set with `r format(nrow(example_isolates), big.mark = " ")` Example Isolates
|
||||
#'
|
||||
#' A data set containing `r format(nrow(example_isolates), big.mark = " ")` microbial isolates with their full antibiograms. This data set contains randomised fictitious data, but reflects reality and can be used to practise AMR data analysis. For examples, please read [the tutorial on our website](https://amr-for-r.org/articles/AMR.html).
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(example_isolates), big.mark = " ")` observations and `r ncol(example_isolates)` variables:
|
||||
#' - `date`\cr Date of receipt at the laboratory
|
||||
#' - `patient`\cr ID of the patient
|
||||
#' - `age`\cr Age of the patient
|
||||
#' - `gender`\cr Gender of the patient, either `r vector_or(example_isolates$gender)`
|
||||
#' - `ward`\cr Ward type where the patient was admitted, either `r vector_or(example_isolates$ward)`
|
||||
#' - `mo`\cr ID of microorganism created with [as.mo()], see also the [microorganisms] data set
|
||||
#' - `PEN:RIF`\cr `r sum(vapply(FUN.VALUE = logical(1), example_isolates, is.sir))` different antimicrobials with class [`sir`] (see [as.sir()]); these column names occur in the [antimicrobials] data set and can be translated with [set_ab_names()] or [ab_name()]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' example_isolates
|
||||
"example_isolates"
|
||||
|
||||
#' Data Set with Unclean Data
|
||||
#'
|
||||
#' A data set containing `r format(nrow(example_isolates_unclean), big.mark = " ")` microbial isolates that are not cleaned up and consequently not ready for AMR data analysis. This data set can be used for practice.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(example_isolates_unclean), big.mark = " ")` observations and `r ncol(example_isolates_unclean)` variables:
|
||||
#' - `patient_id`\cr ID of the patient
|
||||
#' - `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 antimicrobials that have to be transformed with [as.sir()]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @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 antimicrobial 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
|
||||
#' - `Organism`\cr Name of the microorganism. Before analysis, you should transform this to a valid microbial class, using [as.mo()].
|
||||
#' - `Country`\cr Country of origin
|
||||
#' - `Laboratory`\cr Name of laboratory
|
||||
#' - `Last name`\cr Fictitious last name of patient
|
||||
#' - `First name`\cr Fictitious initial of patient
|
||||
#' - `Sex`\cr Fictitious gender of patient
|
||||
#' - `Age`\cr Fictitious age of patient
|
||||
#' - `Age category`\cr Age group, can also be looked up using [age_groups()]
|
||||
#' - `Date of admission`\cr [Date] of hospital admission
|
||||
#' - `Specimen date`\cr [Date] when specimen was received at laboratory
|
||||
#' - `Specimen type`\cr Specimen type or group
|
||||
#' - `Specimen type (Numeric)`\cr Translation of `"Specimen type"`
|
||||
#' - `Reason`\cr Reason of request with Differential Diagnosis
|
||||
#' - `Isolate number`\cr ID of isolate
|
||||
#' - `Organism type`\cr Type of microorganism, can also be looked up using [mo_type()]
|
||||
#' - `Serotype`\cr Serotype of microorganism
|
||||
#' - `Beta-lactamase`\cr Microorganism produces beta-lactamase?
|
||||
#' - `ESBL`\cr Microorganism produces extended spectrum beta-lactamase?
|
||||
#' - `Carbapenemase`\cr Microorganism produces carbapenemase?
|
||||
#' - `MRSA screening test`\cr Microorganism is possible MRSA?
|
||||
#' - `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 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 antimicrobial class, using [as.sir()].
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' WHONET
|
||||
"WHONET"
|
||||
|
||||
#' Data Set with Clinical Breakpoints for SIR Interpretation
|
||||
#'
|
||||
#' @description Data set containing clinical breakpoints to interpret MIC and disk diffusion to SIR values, according to international guidelines. This 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 Antimicrobial code as used by this package, EARS-Net and WHONET, see [as.ab()]
|
||||
#' - `ref_tbl`\cr Info about where the guideline rule can be found
|
||||
#' - `disk_dose`\cr Dose of the used disk diffusion method
|
||||
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
|
||||
#' - `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_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 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_scripts/reproduction_of_clinical_breakpoints.R>.
|
||||
#'
|
||||
#' ### Response From CLSI and EUCAST
|
||||
#' The CEO of CLSI and the chairman of EUCAST have endorsed the work and public use of this `AMR` package (and consequently the use of their breakpoints) in June 2023, when future development of distributing clinical breakpoints was discussed in a meeting between CLSI, EUCAST, WHO, developers of WHONET software, and developers of this `AMR` package.
|
||||
#'
|
||||
#' ### Download 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 implementing the breakpoints for own use.
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @seealso [intrinsic_resistant]
|
||||
#' @examples
|
||||
#' clinical_breakpoints
|
||||
"clinical_breakpoints"
|
||||
|
||||
#' Data Set Denoting Bacterial Intrinsic Resistance
|
||||
#'
|
||||
#' Data set containing `r EUCAST_VERSION_EXPECTED_PHENOTYPES[[1]]$title` of *all* bug-drug combinations between the [microorganisms] and [antimicrobials] data sets.
|
||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(intrinsic_resistant), big.mark = " ")` observations and `r ncol(intrinsic_resistant)` variables:
|
||||
#' - `mo`\cr Microorganism ID which occurs in [`microorganisms$mo`][microorganisms]. Names can be retrieved using [mo_name()].
|
||||
#' - `ab`\cr Antimicrobial ID which occurs in [`antimicrobials$ab`][antimicrobials]. Names can be retrieved using [ab_name()].
|
||||
#' @details
|
||||
#' This data set is currently based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`.
|
||||
#'
|
||||
#' This data set is internally used by:
|
||||
#' * [not_intrinsic_resistant()] (an [antimicrobial selector][antimicrobial_selectors])
|
||||
#' * [mo_is_intrinsic_resistant()]
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' intrinsic_resistant
|
||||
"intrinsic_resistant"
|
||||
|
||||
#' Data Set with Treatment Dosages as Defined by EUCAST
|
||||
#'
|
||||
#' 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 Antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
#' - `name`\cr Official name of the antimicrobial drug as used by WHONET/EARS-Net or the WHO
|
||||
#' - `type`\cr Type of the dosage, either `r vector_or(dosage$type)`
|
||||
#' - `dose`\cr Dose, such as "2 g" or "25 mg/kg"
|
||||
#' - `dose_times`\cr Number of times a dose must be administered
|
||||
#' - `administration`\cr Route of administration, either `r vector_or(dosage$administration)`
|
||||
#' - `notes`\cr Additional dosage notes
|
||||
#' - `original_txt`\cr Original text in the PDF file of EUCAST
|
||||
#' - `eucast_version`\cr Version number of the EUCAST Clinical Breakpoints guideline to which these dosages apply, either `r vector_or(dosage$eucast_version, quotes = FALSE, sort = TRUE, reverse = TRUE)`
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' dosage
|
||||
"dosage"
|
||||
@@ -1,245 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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 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 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
|
||||
#' @seealso [as.sir()]
|
||||
#' @examples
|
||||
#' # transform existing disk zones to the `disk` class (using base R)
|
||||
#' df <- data.frame(
|
||||
#' microorganism = "Escherichia coli",
|
||||
#' AMP = 20,
|
||||
#' CIP = 14,
|
||||
#' GEN = 18,
|
||||
#' TOB = 16
|
||||
#' )
|
||||
#' df[, 2:5] <- lapply(df[, 2:5], as.disk)
|
||||
#' str(df)
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # transforming is easier with dplyr:
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>% mutate(across(AMP:TOB, as.disk))
|
||||
#' }
|
||||
#' }
|
||||
#'
|
||||
#' # interpret disk values, see ?as.sir
|
||||
#' as.sir(
|
||||
#' x = as.disk(18),
|
||||
#' mo = "Strep pneu", # `mo` will be coerced with as.mo()
|
||||
#' ab = "ampicillin", # and `ab` with as.ab()
|
||||
#' guideline = "EUCAST"
|
||||
#' )
|
||||
#'
|
||||
#' # interpret whole data set, pretend to be all from urinary tract infections:
|
||||
#' as.sir(df, uti = TRUE)
|
||||
as.disk <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (!is.disk(x)) {
|
||||
x <- unlist(x)
|
||||
if (isTRUE(na.rm)) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
x[trimws2(x) == ""] <- NA
|
||||
x.bak <- x
|
||||
|
||||
na_before <- length(x[is.na(x)])
|
||||
|
||||
# heavily based on cleaner::clean_double():
|
||||
clean_double2 <- function(x, remove = "[^0-9.,-]", fixed = FALSE) {
|
||||
x <- gsub(",", ".", x, fixed = TRUE)
|
||||
# remove ending dot/comma
|
||||
x <- gsub("[,.]$", "", x)
|
||||
# only keep last dot/comma
|
||||
reverse <- function(x) vapply(FUN.VALUE = character(1), lapply(strsplit(x, NULL), rev), paste, collapse = "")
|
||||
x <- sub("{{dot}}", ".",
|
||||
gsub(".", "",
|
||||
reverse(sub(".", "}}tod{{",
|
||||
reverse(x),
|
||||
fixed = TRUE
|
||||
)),
|
||||
fixed = TRUE
|
||||
),
|
||||
fixed = TRUE
|
||||
)
|
||||
x_clean <- gsub(remove, "", x, ignore.case = TRUE, fixed = fixed)
|
||||
# remove everything that is not a number or dot
|
||||
as.double(gsub("[^0-9.]+", "", x_clean))
|
||||
}
|
||||
|
||||
# round up and make it an integer
|
||||
x <- as.integer(ceiling(clean_double2(x)))
|
||||
|
||||
# disks can never be less than 0 mm or more than 50 mm
|
||||
x[x < 0 | x > 99] <- NA_integer_
|
||||
x[x > 50] <- 50L
|
||||
na_after <- length(x[is.na(x)])
|
||||
|
||||
if (na_before != na_after) {
|
||||
list_missing <- x.bak[is.na(x) & !is.na(x.bak)] %pm>%
|
||||
unique() %pm>%
|
||||
sort() %pm>%
|
||||
vector_and(quotes = TRUE)
|
||||
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 index '", cur_col, "'")),
|
||||
" truncated (",
|
||||
round(((na_after - na_before) / length(x)) * 100),
|
||||
"%) that were invalid disk zones: ",
|
||||
list_missing,
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
}
|
||||
set_clean_class(as.integer(x),
|
||||
new_class = c("disk", "integer")
|
||||
)
|
||||
}
|
||||
|
||||
all_valid_disks <- function(x) {
|
||||
if (!inherits(x, c("disk", "character", "numeric", "integer"))) {
|
||||
return(FALSE)
|
||||
}
|
||||
x_disk <- tryCatch(suppressWarnings(as.disk(x[!is.na(x)])),
|
||||
error = function(e) NA
|
||||
)
|
||||
!anyNA(x_disk) && !all(is.na(x))
|
||||
}
|
||||
|
||||
#' @rdname as.disk
|
||||
#' @details `NA_disk_` is a missing value of the new `disk` class.
|
||||
#' @export
|
||||
NA_disk_ <- set_clean_class(as.integer(NA_real_),
|
||||
new_class = c("disk", "integer")
|
||||
)
|
||||
|
||||
#' @rdname as.disk
|
||||
#' @export
|
||||
is.disk <- function(x) {
|
||||
inherits(x, "disk")
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
pillar_shaft.disk <- function(x, ...) {
|
||||
out <- trimws(format(x))
|
||||
out[is.na(x)] <- font_na(NA)
|
||||
create_pillar_column(out, align = "right", width = 2)
|
||||
}
|
||||
|
||||
#' @method print disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.disk <- function(x, ...) {
|
||||
cat("Class 'disk'\n")
|
||||
print(as.integer(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @method [ disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[.disk" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [[ disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.disk" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @method [<- disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.disk" <- function(i, j, ..., value) {
|
||||
value <- as.disk(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @method [[<- disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.disk" <- function(i, j, ..., value) {
|
||||
value <- as.disk(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @method c disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.disk <- function(...) {
|
||||
as.disk(unlist(lapply(list(...), as.character)))
|
||||
}
|
||||
|
||||
#' @method unique disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
unique.disk <- function(x, incomparables = FALSE, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
#' @method rep disk
|
||||
#' @export
|
||||
#' @noRd
|
||||
rep.disk <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
get_skimmers.disk <- function(column) {
|
||||
skimr::sfl(
|
||||
skim_type = "disk",
|
||||
min = ~ min(as.double(.), na.rm = TRUE),
|
||||
max = ~ max(as.double(.), na.rm = TRUE),
|
||||
median = ~ stats::median(as.double(.), na.rm = TRUE),
|
||||
n_unique = ~ length(unique(stats::na.omit(.))),
|
||||
hist = ~ skimr::inline_hist(stats::na.omit(as.double(.)))
|
||||
)
|
||||
}
|
||||
-1286
File diff suppressed because it is too large
Load Diff
@@ -1,57 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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)
|
||||
|
||||
out <- x %pm>%
|
||||
pm_select(columns)
|
||||
stop_if(NROW(out) == 0, "No columns found.")
|
||||
|
||||
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
|
||||
}
|
||||
}
|
||||
@@ -1,728 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine First Isolates
|
||||
#'
|
||||
#' Determine first isolates of all microorganisms of every patient per episode and (if needed) per specimen type. These functions support all four methods as summarised by Hindler *et al.* in 2007 (\doi{10.1086/511864}). To determine patient episodes not necessarily based on microorganisms, use [is_new_episode()] that also supports grouping with the `dplyr` package.
|
||||
#' @param x A [data.frame] containing isolates. Can be left blank for automatic determination, see *Examples*.
|
||||
#' @param col_date Column name of the result date (or date that is was received on the lab) - the default is the first column with a date class.
|
||||
#' @param col_patient_id Column name of the unique IDs of the patients - the default is the first column that starts with 'patient' or 'patid' (case insensitive).
|
||||
#' @param col_mo Column name of the names or codes of the microorganisms (see [as.mo()]) - the default is the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param col_testcode Column name of the test codes. Use `col_testcode = NULL` to **not** exclude certain test codes (such as test codes for screening). In that case `testcodes_exclude` will be ignored.
|
||||
#' @param col_specimen Column name of the specimen type or group.
|
||||
#' @param col_icu Column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU). This can also be a [logical] vector with the same length as rows in `x`.
|
||||
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first isolates, see [key_antimicrobials()]. The default is the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
|
||||
#' @param episode_days Episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see *Source*.
|
||||
#' @param testcodes_exclude A [character] vector with test codes that should be excluded (case-insensitive).
|
||||
#' @param icu_exclude A [logical] to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`).
|
||||
#' @param specimen_group Value in the column set with `col_specimen` to filter on.
|
||||
#' @param type Type to determine weighed isolates; can be `"keyantimicrobials"` or `"points"`, see *Details*.
|
||||
#' @param method The method to apply, either `"phenotype-based"`, `"episode-based"`, `"patient-based"` or `"isolate-based"` (can be abbreviated), see *Details*. The default is `"phenotype-based"` if antimicrobial test results are present in the data, and `"episode-based"` otherwise.
|
||||
#' @param ignore_I [logical] to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*.
|
||||
#' @param points_threshold Minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*.
|
||||
#' @param info A [logical] to indicate info should be printed - the default is `TRUE` only in interactive mode.
|
||||
#' @param include_unknown A [logical] to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
|
||||
#' @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*.
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but more efficient for data sets containing microorganism codes or names.
|
||||
#'
|
||||
#' All isolates with a microbial ID of `NA` will be excluded as first isolate.
|
||||
#'
|
||||
#' ### Different methods
|
||||
#'
|
||||
#' According to previously-mentioned sources, there are different methods (algorithms) to select first isolates with increasing reliability: isolate-based, patient-based, episode-based and phenotype-based. All methods select on a combination of the taxonomic genus and species (not subspecies).
|
||||
#'
|
||||
#' All mentioned methods are covered in the [first_isolate()] function:
|
||||
#'
|
||||
#'
|
||||
#' | **Method** | **Function to apply** |
|
||||
#' |--------------------------------------------------|-------------------------------------------------------|
|
||||
#' | **Isolate-based** | `first_isolate(x, method = "isolate-based")` |
|
||||
#' | *(= all isolates)* | |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Patient-based** | `first_isolate(x, method = "patient-based")` |
|
||||
#' | *(= first isolate per patient)* | |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Episode-based** | `first_isolate(x, method = "episode-based")`, or: |
|
||||
#' | *(= first isolate per episode)* | |
|
||||
#' | - 7-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 7)` |
|
||||
#' | - 30-Day interval from initial isolate | - `first_isolate(x, method = "e", episode_days = 30)` |
|
||||
#' | | |
|
||||
#' | | |
|
||||
#' | **Phenotype-based** | `first_isolate(x, method = "phenotype-based")`, or: |
|
||||
#' | *(= first isolate per phenotype)* | |
|
||||
#' | - Major difference in any antimicrobial result | - `first_isolate(x, type = "points")` |
|
||||
#' | - Any difference in key antimicrobial results | - `first_isolate(x, type = "keyantimicrobials")` |
|
||||
#'
|
||||
#' ### Isolate-based
|
||||
#'
|
||||
#' This method does not require any selection, as all isolates should be included. It does, however, respect all arguments set in the [first_isolate()] function. For example, the default setting for `include_unknown` (`FALSE`) will omit selection of rows without a microbial ID.
|
||||
#'
|
||||
#' ### Patient-based
|
||||
#'
|
||||
#' 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 or ICU cases, long episodes are common for analysing regional and national data.
|
||||
#'
|
||||
#' This is the most common method to correct for duplicate isolates. Patients are categorised into episodes based on their ID and dates (e.g., the date of specimen receipt or laboratory result). While this is a common method, it does not take into account antimicrobial test results. This means that e.g. a methicillin-resistant *Staphylococcus aureus* (MRSA) isolate cannot be differentiated from a wildtype *Staphylococcus aureus* isolate.
|
||||
#'
|
||||
#' ### Phenotype-based
|
||||
#'
|
||||
#' This is a more reliable method, since it also *weighs* the antibiogram (antimicrobial test results) yielding so-called 'first weighted isolates'. There are two different methods to weigh the antibiogram:
|
||||
#'
|
||||
#' 1. Using `type = "points"` and argument `points_threshold` (default)
|
||||
#'
|
||||
#' This method weighs *all* antimicrobial drugs available in the data set. Any difference from I to S or R (or vice versa) counts as `0.5` points, a difference from S to R (or vice versa) counts as `1` point. When the sum of points exceeds `points_threshold`, which defaults to `2`, an isolate will be selected as a first weighted isolate.
|
||||
#'
|
||||
#' All antimicrobials are internally selected using the [all_antimicrobials()] function. The output of this function does not need to be passed to the [first_isolate()] function.
|
||||
#'
|
||||
#'
|
||||
#' 2. Using `type = "keyantimicrobials"` and argument `ignore_I`
|
||||
#'
|
||||
#' This method only weighs specific antimicrobial drugs, called *key antimicrobials*. Any difference from S to R (or vice versa) in these key antimicrobials will select an isolate as a first weighted isolate. With `ignore_I = FALSE`, also differences from I to S or R (or vice versa) will lead to this.
|
||||
#'
|
||||
#' Key antimicrobials are internally selected using the [key_antimicrobials()] function, but can also be added manually as a variable to the data and set in the `col_keyantimicrobials` argument. Another option is to pass the output of the [key_antimicrobials()] function directly to the `col_keyantimicrobials` argument.
|
||||
#'
|
||||
#'
|
||||
#' The default method is phenotype-based (using `type = "points"`) and episode-based (using `episode_days = 365`). This makes sure that every genus-species combination is selected per patient once per year, while taking into account all antimicrobial test results. If no antimicrobial test results are available in the data set, only the episode-based method is applied at default.
|
||||
#' @rdname first_isolate
|
||||
#' @seealso [key_antimicrobials()]
|
||||
#' @export
|
||||
#' @return A [logical] vector
|
||||
#' @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/>.
|
||||
#'
|
||||
#' - Hindler JF and Stelling J (2007). **Analysis and Presentation of Cumulative Antibiograms: A New Consensus Guideline from the Clinical and Laboratory Standards Institute.** Clinical Infectious Diseases, 44(6), 867-873. \doi{10.1086/511864}
|
||||
#' @examples
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' example_isolates[first_isolate(info = TRUE), ]
|
||||
#' \donttest{
|
||||
#' # get all first Gram-negatives
|
||||
#' example_isolates[which(first_isolate(info = FALSE) & mo_is_gram_negative()), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' # filter on first isolates using dplyr:
|
||||
#' example_isolates %>%
|
||||
#' filter(first_isolate(info = TRUE))
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # short-hand version:
|
||||
#' example_isolates %>%
|
||||
#' filter_first_isolate(info = FALSE)
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # flag the first isolates per group:
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' mutate(first = first_isolate(info = TRUE)) %>%
|
||||
#' select(ward, date, patient, mo, first)
|
||||
#' }
|
||||
#' }
|
||||
first_isolate <- function(x = NULL,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
col_testcode = NULL,
|
||||
col_specimen = NULL,
|
||||
col_icu = NULL,
|
||||
col_keyantimicrobials = NULL,
|
||||
episode_days = 365,
|
||||
testcodes_exclude = NULL,
|
||||
icu_exclude = FALSE,
|
||||
specimen_group = NULL,
|
||||
type = "points",
|
||||
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
info = interactive(),
|
||||
include_unknown = FALSE,
|
||||
include_untested_sir = TRUE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_testcode, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
if (isFALSE(col_specimen)) {
|
||||
col_specimen <- NULL
|
||||
}
|
||||
meet_criteria(col_specimen, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
if (is.logical(col_icu)) {
|
||||
meet_criteria(col_icu, allow_class = "logical", has_length = c(1, nrow(x)), allow_NA = TRUE, allow_NULL = TRUE)
|
||||
x$newvar_is_icu <- col_icu
|
||||
} else if (!is.null(col_icu)) {
|
||||
# add "logical" to the allowed classes here, since it may give an error in certain user input, and should then also say that logicals can be used too
|
||||
meet_criteria(col_icu, allow_class = c("character", "logical"), has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
x$newvar_is_icu <- x[, col_icu, drop = TRUE]
|
||||
} else {
|
||||
x$newvar_is_icu <- NA
|
||||
}
|
||||
# method
|
||||
method <- coerce_method(method)
|
||||
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based"))
|
||||
# key antimicrobials
|
||||
if (length(col_keyantimicrobials) > 1) {
|
||||
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = nrow(x))
|
||||
x$keyabcol <- col_keyantimicrobials
|
||||
col_keyantimicrobials <- "keyabcol"
|
||||
} else {
|
||||
if (isFALSE(col_keyantimicrobials)) {
|
||||
col_keyantimicrobials <- NULL
|
||||
# method cannot be phenotype-based anymore
|
||||
if (method == "phenotype-based") {
|
||||
method <- "episode-based"
|
||||
}
|
||||
}
|
||||
meet_criteria(col_keyantimicrobials, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
}
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
meet_criteria(testcodes_exclude, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(icu_exclude, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(specimen_group, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
|
||||
|
||||
# remove data.table, grouping from tibbles, etc.
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
any_col_contains_sir <- any(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
X = x,
|
||||
# check only first 10,000 rows
|
||||
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) {
|
||||
method <- "episode-based"
|
||||
}
|
||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "method")) {
|
||||
message_(
|
||||
paste0(
|
||||
"Determining first isolates ",
|
||||
ifelse(method %in% c("episode-based", "phenotype-based"),
|
||||
ifelse(is.infinite(episode_days),
|
||||
paste(font_bold("without"), " a specified episode length"),
|
||||
paste("using an episode length of", font_bold(paste(episode_days, "days")))
|
||||
),
|
||||
""
|
||||
)
|
||||
),
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
|
||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||
}
|
||||
|
||||
# methods ----
|
||||
if (method == "isolate-based") {
|
||||
episode_days <- Inf
|
||||
col_keyantimicrobials <- NULL
|
||||
x$dummy_dates <- Sys.Date()
|
||||
col_date <- "dummy_dates"
|
||||
x$dummy_patients <- paste("dummy", seq_len(nrow(x))) # all 'patients' must be unique
|
||||
col_patient_id <- "dummy_patients"
|
||||
} else if (method == "patient-based") {
|
||||
episode_days <- Inf
|
||||
col_keyantimicrobials <- NULL
|
||||
} else if (method == "episode-based") {
|
||||
col_keyantimicrobials <- NULL
|
||||
} else if (method == "phenotype-based") {
|
||||
if (missing(type) && !is.null(col_keyantimicrobials)) {
|
||||
# type = "points" is default, but not set explicitly, while col_keyantimicrobials is
|
||||
type <- "keyantimicrobials"
|
||||
}
|
||||
if (type == "points") {
|
||||
x$keyantimicrobials <- all_antimicrobials(x, only_sir_columns = FALSE)
|
||||
col_keyantimicrobials <- "keyantimicrobials"
|
||||
} else if (type == "keyantimicrobials" && is.null(col_keyantimicrobials)) {
|
||||
col_keyantimicrobials <- search_type_in_df(x = x, type = "keyantimicrobials", info = info)
|
||||
if (is.null(col_keyantimicrobials)) {
|
||||
# still not found as a column, create it ourselves
|
||||
x$keyantimicrobials <- key_antimicrobials(x, only_sir_columns = FALSE, col_mo = col_mo, ...)
|
||||
col_keyantimicrobials <- "keyantimicrobials"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# -- date
|
||||
if (is.null(col_date)) {
|
||||
col_date <- search_type_in_df(x = x, type = "date", info = info)
|
||||
stop_if(is.null(col_date), "`col_date` must be set")
|
||||
}
|
||||
|
||||
# -- patient id
|
||||
if (is.null(col_patient_id)) {
|
||||
if (all(c("First name", "Last name", "Sex") %in% colnames(x))) {
|
||||
# WHONET support
|
||||
x$patient_id <- paste(x$`First name`, x$`Last name`, x$Sex)
|
||||
col_patient_id <- "patient_id"
|
||||
message_("Using combined columns '", font_bold("First name"), "', '", font_bold("Last name"), "' and '", font_bold("Sex"), "' as input for `col_patient_id`")
|
||||
} else {
|
||||
col_patient_id <- search_type_in_df(x = x, type = "patient_id", info = info)
|
||||
}
|
||||
stop_if(is.null(col_patient_id), "`col_patient_id` must be set")
|
||||
}
|
||||
|
||||
# -- specimen
|
||||
if (is.null(col_specimen) && !is.null(specimen_group)) {
|
||||
col_specimen <- search_type_in_df(x = x, type = "specimen", info = info)
|
||||
}
|
||||
|
||||
# check if columns exist
|
||||
check_columns_existance <- function(column, tblname = x) {
|
||||
if (!is.null(column)) {
|
||||
stop_ifnot(column %in% colnames(tblname),
|
||||
"Column '", column, "' not found.",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
check_columns_existance(col_date)
|
||||
check_columns_existance(col_patient_id)
|
||||
check_columns_existance(col_mo)
|
||||
check_columns_existance(col_testcode)
|
||||
check_columns_existance(col_keyantimicrobials)
|
||||
|
||||
# convert dates to Date
|
||||
dates <- as.Date(x[, col_date, drop = TRUE])
|
||||
dates[is.na(dates)] <- as.Date("1970-01-01")
|
||||
x[, col_date] <- dates
|
||||
|
||||
# create original row index
|
||||
x$newvar_row_index <- seq_len(nrow(x))
|
||||
x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE, info = FALSE)
|
||||
x$newvar_genus_species <- paste(mo_genus(x$newvar_mo, keep_synonyms = TRUE, info = FALSE), mo_species(x$newvar_mo, keep_synonyms = TRUE, info = FALSE))
|
||||
x$newvar_date <- x[, col_date, drop = TRUE]
|
||||
x$newvar_patient_id <- as.character(x[, col_patient_id, drop = TRUE])
|
||||
|
||||
if (is.null(col_testcode)) {
|
||||
testcodes_exclude <- NULL
|
||||
}
|
||||
# remove testcodes
|
||||
if (!is.null(testcodes_exclude) && isTRUE(info) && message_not_thrown_before("first_isolate", "excludingtestcodes")) {
|
||||
message_("Excluding test codes: ", vector_and(testcodes_exclude, quotes = TRUE),
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
|
||||
if (is.null(col_specimen)) {
|
||||
specimen_group <- NULL
|
||||
}
|
||||
|
||||
# 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")) {
|
||||
message_("Excluding other than specimen group '", specimen_group, "'",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
}
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
x$newvar_key_ab <- as.character(x[, col_keyantimicrobials, drop = TRUE])
|
||||
}
|
||||
|
||||
if (is.null(testcodes_exclude)) {
|
||||
testcodes_exclude <- ""
|
||||
}
|
||||
|
||||
# arrange data to the right sorting
|
||||
if (is.null(specimen_group)) {
|
||||
x <- x[order(
|
||||
x$newvar_patient_id,
|
||||
x$newvar_genus_species,
|
||||
x$newvar_date
|
||||
), ]
|
||||
rownames(x) <- NULL
|
||||
row.start <- 1
|
||||
row.end <- nrow(x)
|
||||
} else {
|
||||
# filtering on specimen and only analyse these rows to save time
|
||||
x <- x[order(
|
||||
pm_pull(x, col_specimen),
|
||||
x$newvar_patient_id,
|
||||
x$newvar_genus_species,
|
||||
x$newvar_date
|
||||
), ]
|
||||
rownames(x) <- NULL
|
||||
suppressWarnings(
|
||||
row.start <- which(x %pm>% pm_pull(col_specimen) == specimen_group) %pm>% min(na.rm = TRUE)
|
||||
)
|
||||
suppressWarnings(
|
||||
row.end <- which(x %pm>% pm_pull(col_specimen) == specimen_group) %pm>% max(na.rm = TRUE)
|
||||
)
|
||||
}
|
||||
|
||||
# speed up - return immediately if obvious
|
||||
if (abs(row.start) == Inf || abs(row.end) == Inf) {
|
||||
if (isTRUE(info)) {
|
||||
message_("=> Found ", font_bold("no isolates"),
|
||||
add_fn = font_black,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
return(rep(FALSE, nrow(x)))
|
||||
}
|
||||
if (row.start == row.end) {
|
||||
if (isTRUE(info)) {
|
||||
message_("=> Found ", font_bold("1 first isolate"), ", as the data only contained 1 row",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
return(TRUE)
|
||||
}
|
||||
if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) {
|
||||
if (isTRUE(info)) {
|
||||
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")),
|
||||
", as all isolates were different microbial species",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
return(rep(TRUE, length(c(row.start:row.end))))
|
||||
}
|
||||
|
||||
# did find some isolates - add new index numbers of rows
|
||||
x$newvar_row_index_sorted <- seq_len(nrow(x))
|
||||
|
||||
scope.size <- nrow(x[which(x$newvar_row_index_sorted %in% seq(row.start, row.end, 1) &
|
||||
!is.na(x$newvar_mo)), , drop = FALSE])
|
||||
|
||||
# Analysis of first isolate ----
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "type")) {
|
||||
if (type == "keyantimicrobials") {
|
||||
message_("Basing inclusion on key antimicrobials, ",
|
||||
ifelse(ignore_I == FALSE, "not ", ""),
|
||||
"ignoring I",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
if (type == "points") {
|
||||
message_("Basing inclusion on all antimicrobial results, using a points threshold of ",
|
||||
points_threshold,
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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(
|
||||
x$newvar_date,
|
||||
x$newvar_episode_group
|
||||
),
|
||||
is_new_episode,
|
||||
episode_days = episode_days,
|
||||
drop = FALSE
|
||||
),
|
||||
use.names = FALSE
|
||||
)
|
||||
|
||||
if (!is.null(col_keyantimicrobials)) {
|
||||
# using phenotypes
|
||||
x$different_antibiogram <- !unlist(
|
||||
lapply(
|
||||
split(
|
||||
x$newvar_key_ab,
|
||||
x$newvar_episode_group
|
||||
),
|
||||
duplicated_antibiogram,
|
||||
points_threshold = points_threshold,
|
||||
ignore_I = ignore_I,
|
||||
type = type
|
||||
),
|
||||
use.names = FALSE
|
||||
)
|
||||
} 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
|
||||
if (!is.null(col_testcode)) {
|
||||
x[which(x[, col_testcode] %in% tolower(testcodes_exclude)), "newvar_first_isolate"] <- FALSE
|
||||
}
|
||||
if (any(!is.na(x$newvar_is_icu)) && any(x$newvar_is_icu == TRUE, na.rm = TRUE)) {
|
||||
if (icu_exclude == TRUE) {
|
||||
if (isTRUE(info)) {
|
||||
message_("Excluding ", format(sum(x$newvar_is_icu, na.rm = TRUE), decimal.mark = decimal.mark, big.mark = big.mark), " isolates from ICU.",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_is_icu), "newvar_first_isolate"] <- FALSE
|
||||
} else if (isTRUE(info)) {
|
||||
message_("Including isolates from ICU.")
|
||||
}
|
||||
}
|
||||
|
||||
if (isTRUE(info)) {
|
||||
# print group name if used in dplyr::group_by()
|
||||
cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_group)) {
|
||||
group_df <- tryCatch(cur_group(), error = function(e) data.frame())
|
||||
if (NCOL(group_df) > 0) {
|
||||
# transform factors to characters
|
||||
group <- vapply(FUN.VALUE = character(1), group_df, function(x) {
|
||||
if (is.numeric(x)) {
|
||||
format(x)
|
||||
} else if (is.logical(x)) {
|
||||
as.character(x)
|
||||
} else {
|
||||
paste0('"', x, '"')
|
||||
}
|
||||
})
|
||||
message_("\nGroup: ", paste0(names(group), " = ", group, collapse = ", "), "\n",
|
||||
as_note = FALSE,
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# handle empty microorganisms
|
||||
if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) && isTRUE(info)) {
|
||||
message_(
|
||||
ifelse(include_unknown == TRUE, "Including ", "Excluding "),
|
||||
format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark
|
||||
),
|
||||
" isolates with a microbial ID 'UNKNOWN' (in column '", font_bold(col_mo), "')",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
|
||||
|
||||
# exclude all NAs
|
||||
if (anyNA(x$newvar_mo) && isTRUE(info)) {
|
||||
message_(
|
||||
"Excluding ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
|
||||
decimal.mark = decimal.mark, big.mark = big.mark
|
||||
),
|
||||
" isolates with a microbial ID `NA` (in column '", font_bold(col_mo), "')",
|
||||
add_fn = font_red
|
||||
)
|
||||
}
|
||||
x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
|
||||
|
||||
# handle isolates without antibiogram
|
||||
if (include_untested_sir == FALSE && any(is.sir(x))) {
|
||||
sir_all_NA <- which(unname(vapply(
|
||||
FUN.VALUE = logical(1),
|
||||
as.data.frame(t(x[, is.sir(x), drop = FALSE])),
|
||||
function(sir_values) all(is.na(sir_values))
|
||||
)))
|
||||
x[sir_all_NA, "newvar_first_isolate"] <- FALSE
|
||||
}
|
||||
|
||||
# arrange back according to original sorting again
|
||||
x <- x[order(x$newvar_row_index), , drop = FALSE]
|
||||
rownames(x) <- NULL
|
||||
|
||||
if (isTRUE(info)) {
|
||||
n_found <- sum(x$newvar_first_isolate, na.rm = TRUE)
|
||||
p_found_total <- percentage(n_found / nrow(x[which(!is.na(x$newvar_mo)), , drop = FALSE]), digits = 1)
|
||||
p_found_scope <- percentage(n_found / scope.size, digits = 1)
|
||||
if (p_found_total %unlike% "[.]") {
|
||||
p_found_total <- gsub("%", ".0%", p_found_total, fixed = TRUE)
|
||||
}
|
||||
if (p_found_scope %unlike% "[.]") {
|
||||
p_found_scope <- gsub("%", ".0%", p_found_scope, fixed = TRUE)
|
||||
}
|
||||
# mark up number of found
|
||||
n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
|
||||
message_(
|
||||
paste0(
|
||||
"=> Found ",
|
||||
font_bold(paste0(
|
||||
n_found,
|
||||
ifelse(method == "isolate-based", "", paste0(" '", method, "'")),
|
||||
" first isolates"
|
||||
)),
|
||||
" (",
|
||||
ifelse(p_found_total != p_found_scope,
|
||||
paste0(p_found_scope, " within scope and "),
|
||||
""
|
||||
),
|
||||
p_found_total, " of total where a microbial ID was available)"
|
||||
),
|
||||
add_fn = font_black, as_note = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
x$newvar_first_isolate
|
||||
}
|
||||
|
||||
#' @rdname first_isolate
|
||||
#' @export
|
||||
filter_first_isolate <- function(x = NULL,
|
||||
col_date = NULL,
|
||||
col_patient_id = NULL,
|
||||
col_mo = NULL,
|
||||
episode_days = 365,
|
||||
method = c("phenotype-based", "episode-based", "patient-based", "isolate-based"),
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_patient_id, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
|
||||
method <- coerce_method(method)
|
||||
meet_criteria(method, allow_class = "character", has_length = 1, is_in = c("phenotype-based", "episode-based", "patient-based", "isolate-based"))
|
||||
|
||||
subset(x, first_isolate(
|
||||
x = x,
|
||||
col_date = col_date,
|
||||
col_patient_id = col_patient_id,
|
||||
col_mo = col_mo,
|
||||
episode_days = episode_days,
|
||||
method = method,
|
||||
...
|
||||
))
|
||||
}
|
||||
|
||||
coerce_method <- function(method) {
|
||||
if (is.null(method)) {
|
||||
return(method)
|
||||
}
|
||||
method <- tolower(as.character(method[1L]))
|
||||
method[method %like% "^(p$|pheno)"] <- "phenotype-based"
|
||||
method[method %like% "^(e$|episode)"] <- "episode-based"
|
||||
method[method %like% "^pat"] <- "patient-based"
|
||||
method[method %like% "^(i$|iso)"] <- "isolate-based"
|
||||
method
|
||||
}
|
||||
|
||||
duplicated_antibiogram <- function(antibiogram, points_threshold, ignore_I, type) {
|
||||
if (length(antibiogram) == 1) {
|
||||
# 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
|
||||
)
|
||||
if (length(antibiogram) == 2) {
|
||||
# fast return, no further check required
|
||||
return(out)
|
||||
}
|
||||
|
||||
# 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
|
||||
if (all(duplicates[3:length(out)] == TRUE, na.rm = TRUE)) {
|
||||
# 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
|
||||
)
|
||||
}
|
||||
)
|
||||
)
|
||||
}
|
||||
|
||||
out <- out[order(new_order)]
|
||||
# rerun duplicated again
|
||||
duplicates <- duplicated(antibiogram.bak)
|
||||
out[duplicates == TRUE] <- TRUE
|
||||
out
|
||||
}
|
||||
-226
@@ -1,226 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' *G*-test for Count Data
|
||||
#'
|
||||
#' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**).
|
||||
#' @inherit stats::chisq.test params return
|
||||
#' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
|
||||
#'
|
||||
#' If `x` is a [matrix] with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
|
||||
#'
|
||||
#' The p-value is computed from the asymptotic chi-squared distribution of the test statistic.
|
||||
#'
|
||||
#' In the contingency table case simulation is done by random sampling from the set of all contingency tables with given marginals, and works only if the marginals are strictly positive. Note that this is not the usual sampling situation assumed for a chi-squared test (such as the *G*-test) but rather that for Fisher's exact test.
|
||||
#'
|
||||
#' In the goodness-of-fit case simulation is done by random sampling from the discrete distribution specified by `p`, each sample being of size `n = sum(x)`. This simulation is done in \R and may be slow.
|
||||
#'
|
||||
#' ### *G*-test Of Goodness-of-Fit (Likelihood Ratio Test)
|
||||
#' Use the *G*-test of goodness-of-fit when you have one nominal variable with two or more values (such as male and female, or red, pink and white flowers). You compare the observed counts of numbers of observations in each category with the expected counts, which you calculate using some kind of theoretical expectation (such as a 1:1 sex ratio or a 1:2:1 ratio in a genetic cross).
|
||||
#'
|
||||
#' If the expected number of observations in any category is too small, the *G*-test may give inaccurate results, and you should use an exact test instead ([fisher.test()]).
|
||||
#'
|
||||
#' The *G*-test of goodness-of-fit is an alternative to the chi-square test of goodness-of-fit ([chisq.test()]); each of these tests has some advantages and some disadvantages, and the results of the two tests are usually very similar.
|
||||
#'
|
||||
#' ### *G*-test of Independence
|
||||
#' Use the *G*-test of independence when you have two nominal variables, each with two or more possible values. You want to know whether the proportions for one variable are different among values of the other variable.
|
||||
#'
|
||||
#' It is also possible to do a *G*-test of independence with more than two nominal variables. For example, Jackson et al. (2013) also had data for children under 3, so you could do an analysis of old vs. young, thigh vs. arm, and reaction vs. no reaction, all analyzed together.
|
||||
#'
|
||||
#' Fisher's exact test ([fisher.test()]) is an **exact** test, where the *G*-test is still only an **approximation**. For any 2x2 table, Fisher's Exact test may be slower but will still run in seconds, even if the sum of your observations is multiple millions.
|
||||
#'
|
||||
#' The *G*-test of independence is an alternative to the chi-square test of independence ([chisq.test()]), and they will give approximately the same results.
|
||||
#'
|
||||
#' ### How the Test Works
|
||||
#' Unlike the exact test of goodness-of-fit ([fisher.test()]), the *G*-test does not directly calculate the probability of obtaining the observed results or something more extreme. Instead, like almost all statistical tests, the *G*-test has an intermediate step; it uses the data to calculate a test statistic that measures how far the observed data are from the null expectation. You then use a mathematical relationship, in this case the chi-square distribution, to estimate the probability of obtaining that value of the test statistic.
|
||||
#'
|
||||
#' The *G*-test uses the log of the ratio of two likelihoods as the test statistic, which is why it is also called a likelihood ratio test or log-likelihood ratio test. The formula to calculate a *G*-statistic is:
|
||||
#'
|
||||
#' \eqn{G = 2 * sum(x * log(x / E))}
|
||||
#'
|
||||
#' where `E` are the expected values. Since this is chi-square distributed, the p value can be calculated in \R with:
|
||||
#' ```
|
||||
#' p <- stats::pchisq(G, df, lower.tail = FALSE)
|
||||
#' ```
|
||||
#' where `df` are the degrees of freedom.
|
||||
#'
|
||||
#' If there are more than two categories and you want to find out which ones are significantly different from their null expectation, you can use the same method of testing each category vs. the sum of all categories, with the Bonferroni correction. You use *G*-tests for each category, of course.
|
||||
#' @seealso [chisq.test()]
|
||||
#' @references 1. McDonald, J.H. 2014. **Handbook of Biological Statistics (3rd ed.)**. Sparky House Publishing, Baltimore, Maryland. <http://www.biostathandbook.com/gtestgof.html>.
|
||||
#' @source The code for this function is identical to that of [chisq.test()], except that:
|
||||
#' - The calculation of the statistic was changed to \eqn{2 * sum(x * log(x / E))}
|
||||
#' - Yates' continuity correction was removed as it does not apply to a *G*-test
|
||||
#' - The possibility to simulate p values with `simulate.p.value` was removed
|
||||
#' @export
|
||||
#' @importFrom stats pchisq complete.cases
|
||||
#' @examples
|
||||
#' # = EXAMPLE 1 =
|
||||
#' # Shivrain et al. (2006) crossed clearfield rice (which are resistant
|
||||
#' # to the herbicide imazethapyr) with red rice (which are susceptible to
|
||||
#' # imazethapyr). They then crossed the hybrid offspring and examined the
|
||||
#' # F2 generation, where they found 772 resistant plants, 1611 moderately
|
||||
#' # resistant plants, and 737 susceptible plants. If resistance is controlled
|
||||
#' # by a single gene with two co-dominant alleles, you would expect a 1:2:1
|
||||
#' # ratio.
|
||||
#'
|
||||
#' x <- c(772, 1611, 737)
|
||||
#' g.test(x, p = c(1, 2, 1) / 4)
|
||||
#'
|
||||
#' # There is no significant difference from a 1:2:1 ratio.
|
||||
#' # Meaning: resistance controlled by a single gene with two co-dominant
|
||||
#' # alleles, is plausible.
|
||||
#'
|
||||
#'
|
||||
#' # = EXAMPLE 2 =
|
||||
#' # Red crossbills (Loxia curvirostra) have the tip of the upper bill either
|
||||
#' # right or left of the lower bill, which helps them extract seeds from pine
|
||||
#' # cones. Some have hypothesized that frequency-dependent selection would
|
||||
#' # keep the number of right and left-billed birds at a 1:1 ratio. Groth (1992)
|
||||
#' # observed 1752 right-billed and 1895 left-billed crossbills.
|
||||
#'
|
||||
#' x <- c(1752, 1895)
|
||||
#' g.test(x)
|
||||
#'
|
||||
#' # There is a significant difference from a 1:1 ratio.
|
||||
#' # Meaning: there are significantly more left-billed birds.
|
||||
g.test <- function(x,
|
||||
y = NULL,
|
||||
# correct = TRUE,
|
||||
p = rep(1 / length(x), length(x)),
|
||||
rescale.p = FALSE) {
|
||||
DNAME <- deparse(substitute(x))
|
||||
if (is.data.frame(x)) {
|
||||
x <- as.matrix(x)
|
||||
}
|
||||
if (is.matrix(x)) {
|
||||
if (min(dim(x)) == 1L) {
|
||||
x <- as.vector(x)
|
||||
}
|
||||
}
|
||||
if (!is.matrix(x) && !is.null(y)) {
|
||||
if (length(x) != length(y)) {
|
||||
stop("'x' and 'y' must have the same length")
|
||||
}
|
||||
DNAME2 <- deparse(substitute(y))
|
||||
xname <- if (length(DNAME) > 1L || nchar(DNAME, "w") >
|
||||
30) {
|
||||
""
|
||||
} else {
|
||||
DNAME
|
||||
}
|
||||
yname <- if (length(DNAME2) > 1L || nchar(DNAME2, "w") >
|
||||
30) {
|
||||
""
|
||||
} else {
|
||||
DNAME2
|
||||
}
|
||||
OK <- complete.cases(x, y)
|
||||
x <- factor(x[OK])
|
||||
y <- factor(y[OK])
|
||||
if ((nlevels(x) < 2L) || (nlevels(y) < 2L)) {
|
||||
stop("'x' and 'y' must have at least 2 levels")
|
||||
}
|
||||
x <- table(x, y)
|
||||
names(dimnames(x)) <- c(xname, yname)
|
||||
DNAME <- paste(
|
||||
paste(DNAME, collapse = "\n"), "and",
|
||||
paste(DNAME2, collapse = "\n")
|
||||
)
|
||||
}
|
||||
if (any(x < 0) || anyNA(x)) {
|
||||
stop("all entries of 'x' must be nonnegative and finite")
|
||||
}
|
||||
if ((n <- sum(x)) == 0) {
|
||||
stop("at least one entry of 'x' must be positive")
|
||||
}
|
||||
|
||||
|
||||
if (is.matrix(x)) {
|
||||
METHOD <- "G-test of independence"
|
||||
nr <- as.integer(nrow(x))
|
||||
nc <- as.integer(ncol(x))
|
||||
if (is.na(nr) || is.na(nc) || is.na(nr * nc)) {
|
||||
stop("invalid nrow(x) or ncol(x)", domain = NA)
|
||||
}
|
||||
# add fisher.test suggestion
|
||||
if (nr == 2 && nc == 2) {
|
||||
warning("`fisher.test()` is always more reliable for 2x2 tables and although much slower, often only takes seconds.")
|
||||
}
|
||||
sr <- rowSums(x)
|
||||
sc <- colSums(x)
|
||||
E <- outer(sr, sc, "*") / n
|
||||
v <- function(r, c, n) c * r * (n - r) * (n - c) / n^3
|
||||
V <- outer(sr, sc, v, n)
|
||||
dimnames(E) <- dimnames(x)
|
||||
|
||||
STATISTIC <- 2 * sum(x * log(x / E), na.rm = TRUE) # sum((abs(x - E) - YATES)^2/E) for chisq.test
|
||||
PARAMETER <- (nr - 1L) * (nc - 1L)
|
||||
PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
|
||||
} else {
|
||||
if (length(dim(x)) > 2L) {
|
||||
stop("invalid 'x'")
|
||||
}
|
||||
if (length(x) == 1L) {
|
||||
stop("'x' must at least have 2 elements")
|
||||
}
|
||||
if (length(x) != length(p)) {
|
||||
stop("'x' and 'p' must have the same number of elements")
|
||||
}
|
||||
if (any(p < 0)) {
|
||||
stop("probabilities must be non-negative.")
|
||||
}
|
||||
if (abs(sum(p) - 1) > sqrt(.Machine$double.eps)) {
|
||||
if (rescale.p) {
|
||||
p <- p / sum(p)
|
||||
} else {
|
||||
stop("probabilities must sum to 1.")
|
||||
}
|
||||
}
|
||||
METHOD <- "G-test of goodness-of-fit (likelihood ratio test)"
|
||||
E <- n * p
|
||||
V <- n * p * (1 - p)
|
||||
STATISTIC <- 2 * sum(x * log(x / E)) # sum((x - E)^2/E) for chisq.test
|
||||
names(E) <- names(x)
|
||||
|
||||
PARAMETER <- length(x) - 1
|
||||
PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
|
||||
}
|
||||
names(STATISTIC) <- "X-squared"
|
||||
names(PARAMETER) <- "df"
|
||||
if (any(E < 5) && is.finite(PARAMETER)) {
|
||||
warning("G-statistic approximation may be incorrect due to E < 5")
|
||||
}
|
||||
|
||||
structure(list(
|
||||
statistic = STATISTIC, argument = PARAMETER,
|
||||
p.value = PVAL, method = METHOD, data.name = DNAME,
|
||||
observed = x, expected = E, residuals = (x - E) / sqrt(E),
|
||||
stdres = (x - E) / sqrt(V)
|
||||
), class = "htest")
|
||||
}
|
||||
-268
@@ -1,268 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Determine Clinical or Epidemic Episodes
|
||||
#'
|
||||
#' These functions determine which items in a vector can be considered (the start of) a new episode. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns `TRUE` for every new [get_episode()] index. Both absolute and relative episode determination are supported.
|
||||
#' @param x Vector of dates (class `Date` or `POSIXt`), will be sorted internally to determine episodes.
|
||||
#' @param episode_days Episode length in days to specify the time period after which a new episode begins, can also be less than a day or `Inf`, see *Details*.
|
||||
#' @param case_free_days (inter-epidemic) interval length in days after which a new episode will start, can also be less than a day or `Inf`, see *Details*.
|
||||
#' @param ... Ignored, only in place to allow future extensions.
|
||||
#' @details Episodes can be determined in two ways: absolute and relative.
|
||||
#'
|
||||
#' 1. Absolute
|
||||
#'
|
||||
#' This method uses `episode_days` to define an episode length in days, after which a new episode will start. A common use case in AMR data analysis is microbial epidemiology: episodes of *S. aureus* bacteraemia in ICU patients for example. The episode length could then be 30 days, so that new *S. aureus* isolates after an ICU episode of 30 days will be considered a different (or new) episode.
|
||||
#'
|
||||
#' Thus, this method counts **since the start of the previous episode**.
|
||||
#'
|
||||
#' 2. Relative
|
||||
#'
|
||||
#' This method uses `case_free_days` to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode.
|
||||
#'
|
||||
#' Thus, this methods counts **since the last case in the previous episode**.
|
||||
#'
|
||||
#' In a table:
|
||||
#'
|
||||
#' | Date | Using `episode_days = 7` | Using `case_free_days = 7` |
|
||||
#' |:----------:|:------------------------:|:--------------------------:|
|
||||
#' | 2023-01-01 | 1 | 1 |
|
||||
#' | 2023-01-02 | 1 | 1 |
|
||||
#' | 2023-01-05 | 1 | 1 |
|
||||
#' | 2023-01-08 | 2** | 1 |
|
||||
#' | 2023-02-21 | 3 | 2*** |
|
||||
#' | 2023-02-22 | 3 | 2 |
|
||||
#' | 2023-02-23 | 3 | 2 |
|
||||
#' | 2023-02-24 | 3 | 2 |
|
||||
#' | 2023-03-01 | 4 | 2 |
|
||||
#'
|
||||
#' ** This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr
|
||||
#' *** This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023).
|
||||
#'
|
||||
#' Either `episode_days` or `case_free_days` must be provided in the function.
|
||||
#'
|
||||
#' ### Difference between `get_episode()` and `is_new_episode()`
|
||||
#'
|
||||
#' The [get_episode()] function returns the index number of the episode, so all cases/patients/isolates in the first episode will have the number 1, all cases/patients/isolates in the second episode will have the number 2, etc.
|
||||
#'
|
||||
#' The [is_new_episode()] function on the other hand, returns `TRUE` for every new [get_episode()] index.
|
||||
#'
|
||||
#' To specify, when setting `episode_days = 365` (using method 1 as explained above), this is how the two functions differ:
|
||||
#'
|
||||
#' | patient | date | `get_episode()` | `is_new_episode()` |
|
||||
#' |:---------:|:----------:|:---------------:|:------------------:|
|
||||
#' | A | 2019-01-01 | 1 | TRUE |
|
||||
#' | A | 2019-03-01 | 1 | FALSE |
|
||||
#' | A | 2021-01-01 | 2 | TRUE |
|
||||
#' | B | 2008-01-01 | 1 | TRUE |
|
||||
#' | B | 2008-01-01 | 1 | FALSE |
|
||||
#' | C | 2020-01-01 | 1 | TRUE |
|
||||
#'
|
||||
#' ### Other
|
||||
#'
|
||||
#' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
|
||||
#'
|
||||
#' The `dplyr` package is not required for these functions to work, but these episode functions do support [variable grouping][dplyr::group_by()] and work conveniently inside `dplyr` verbs such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()].
|
||||
#' @return
|
||||
#' * [get_episode()]: an [integer] vector
|
||||
#' * [is_new_episode()]: a [logical] vector
|
||||
#' @seealso [first_isolate()]
|
||||
#' @rdname get_episode
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # difference between absolute and relative determination of episodes:
|
||||
#' x <- data.frame(dates = as.Date(c(
|
||||
#' "2021-01-01",
|
||||
#' "2021-01-02",
|
||||
#' "2021-01-05",
|
||||
#' "2021-01-08",
|
||||
#' "2021-02-21",
|
||||
#' "2021-02-22",
|
||||
#' "2021-02-23",
|
||||
#' "2021-02-24",
|
||||
#' "2021-03-01",
|
||||
#' "2021-03-01"
|
||||
#' )))
|
||||
#' x$absolute <- get_episode(x$dates, episode_days = 7)
|
||||
#' x$relative <- get_episode(x$dates, case_free_days = 7)
|
||||
#' x
|
||||
#'
|
||||
#'
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates
|
||||
#' df <- example_isolates[sample(seq_len(2000), size = 100), ]
|
||||
#'
|
||||
#' get_episode(df$date, episode_days = 60) # indices
|
||||
#' is_new_episode(df$date, episode_days = 60) # TRUE/FALSE
|
||||
#'
|
||||
#' # filter on results from the third 60-day episode only, using base R
|
||||
#' df[which(get_episode(df$date, 60) == 3), ]
|
||||
#'
|
||||
#' # the functions also work for less than a day, e.g. to include one per hour:
|
||||
#' get_episode(
|
||||
#' c(
|
||||
#' Sys.time(),
|
||||
#' Sys.time() + 60 * 60
|
||||
#' ),
|
||||
#' episode_days = 1 / 24
|
||||
#' )
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # is_new_episode() can also be used in dplyr verbs to determine patient
|
||||
#' # episodes based on any (combination of) grouping variables:
|
||||
#' df %>%
|
||||
#' mutate(condition = sample(
|
||||
#' x = c("A", "B", "C"),
|
||||
#' size = 100,
|
||||
#' replace = TRUE
|
||||
#' )) %>%
|
||||
#' group_by(patient, condition) %>%
|
||||
#' mutate(new_episode = is_new_episode(date, 365)) %>%
|
||||
#' select(patient, date, condition, new_episode) %>%
|
||||
#' arrange(patient, condition, date)
|
||||
#' }
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>%
|
||||
#' group_by(ward, patient) %>%
|
||||
#' transmute(date,
|
||||
#' patient,
|
||||
#' new_index = get_episode(date, 60),
|
||||
#' new_logical = is_new_episode(date, 60)
|
||||
#' ) %>%
|
||||
#' arrange(patient, ward, date)
|
||||
#' }
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' n_patients = n_distinct(patient),
|
||||
#' n_episodes_365 = sum(is_new_episode(date, episode_days = 365)),
|
||||
#' n_episodes_60 = sum(is_new_episode(date, episode_days = 60)),
|
||||
#' n_episodes_30 = sum(is_new_episode(date, episode_days = 30))
|
||||
#' )
|
||||
#' }
|
||||
#'
|
||||
#' # grouping on patients and microorganisms leads to the same
|
||||
#' # results as first_isolate() when using 'episode-based':
|
||||
#' if (require("dplyr")) {
|
||||
#' x <- df %>%
|
||||
#' filter_first_isolate(
|
||||
#' include_unknown = TRUE,
|
||||
#' method = "episode-based"
|
||||
#' )
|
||||
#'
|
||||
#' y <- df %>%
|
||||
#' group_by(patient, mo) %>%
|
||||
#' filter(is_new_episode(date, 365)) %>%
|
||||
#' ungroup()
|
||||
#'
|
||||
#' identical(x, y)
|
||||
#' }
|
||||
#'
|
||||
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
|
||||
#' # since you can now group on anything that seems relevant:
|
||||
#' if (require("dplyr")) {
|
||||
#' df %>%
|
||||
#' group_by(patient, mo, ward) %>%
|
||||
#' mutate(flag_episode = is_new_episode(date, 365)) %>%
|
||||
#' select(group_vars(.), flag_episode)
|
||||
#' }
|
||||
#' }
|
||||
get_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
as.integer(exec_episode(x, episode_days, case_free_days, ...))
|
||||
}
|
||||
|
||||
#' @rdname get_episode
|
||||
#' @export
|
||||
is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
|
||||
meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
|
||||
!duplicated(exec_episode(x, episode_days, case_free_days, ...))
|
||||
}
|
||||
|
||||
exec_episode <- function(x, episode_days, case_free_days, ...) {
|
||||
stop_ifnot(is.null(episode_days) || is.null(case_free_days),
|
||||
"either argument `episode_days` or argument `case_free_days` must be set.",
|
||||
call = -2
|
||||
)
|
||||
|
||||
# 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))) {
|
||||
if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) ||
|
||||
(length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) {
|
||||
if (x[1] <= x[2]) {
|
||||
return(c(1, 2))
|
||||
} else {
|
||||
return(c(2, 1))
|
||||
}
|
||||
} else {
|
||||
return(c(1, 1))
|
||||
}
|
||||
}
|
||||
|
||||
run_episodes <- function(x, episode_sec, case_free_sec) {
|
||||
NAs <- which(is.na(x))
|
||||
x[NAs] <- 0
|
||||
|
||||
indices <- integer(length = length(x))
|
||||
start <- x[1]
|
||||
ind <- 1
|
||||
indices[ind] <- 1
|
||||
for (i in 2:length(x)) {
|
||||
if ((length(episode_sec) > 0 && (x[i] - start) >= episode_sec) ||
|
||||
(length(case_free_sec) > 0 && (x[i] - x[i - 1]) >= case_free_sec)) {
|
||||
ind <- ind + 1
|
||||
start <- x[i]
|
||||
}
|
||||
indices[i] <- ind
|
||||
}
|
||||
indices[NAs] <- NA
|
||||
indices
|
||||
}
|
||||
|
||||
ord <- order(x)
|
||||
out <- run_episodes(x[ord], episode_seconds, case_free_seconds)[order(ord)]
|
||||
out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA
|
||||
out
|
||||
}
|
||||
-448
@@ -1,448 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' PCA Biplot with `ggplot2`
|
||||
#'
|
||||
#' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
|
||||
#' @param x An object returned by [pca()], [prcomp()] or [princomp()].
|
||||
#' @inheritParams stats::biplot.prcomp
|
||||
#' @param labels An optional vector of labels for the observations. If set, the labels will be placed below their respective points. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
|
||||
#' @param labels_textsize The size of the text used for the labels.
|
||||
#' @param labels_text_placement Adjustment factor the placement of the variable names (`>=1` means further away from the arrow head).
|
||||
#' @param groups An optional vector of groups for the labels, with the same length as `labels`. If set, the points and labels will be coloured according to these groups. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
|
||||
#' @param ellipse A [logical] to indicate whether a normal data ellipse should be drawn for each group (set with `groups`).
|
||||
#' @param ellipse_prob Statistical size of the ellipse in normal probability.
|
||||
#' @param ellipse_size The size of the ellipse line.
|
||||
#' @param ellipse_alpha The alpha (transparency) of the ellipse line.
|
||||
#' @param points_size The size of the points.
|
||||
#' @param points_alpha The alpha (transparency) of the points.
|
||||
#' @param arrows A [logical] to indicate whether arrows should be drawn.
|
||||
#' @param arrows_textsize The size of the text for variable names.
|
||||
#' @param arrows_colour The colour of the arrow and their text.
|
||||
#' @param arrows_size The size (thickness) of the arrow lines.
|
||||
#' @param arrows_textsize The size of the text at the end of the arrows.
|
||||
#' @param arrows_textangled A [logical] whether the text at the end of the arrows should be angled.
|
||||
#' @param arrows_alpha The alpha (transparency) of the arrows and their text.
|
||||
#' @param base_textsize The text size for all plot elements except the labels and arrows.
|
||||
#' @param ... Arguments passed on to functions.
|
||||
#' @source The [ggplot_pca()] function is based on the `ggbiplot()` function from the `ggbiplot` package by Vince Vu, as found on GitHub: <https://github.com/vqv/ggbiplot> (retrieved: 2 March 2020, their latest commit: [`7325e88`](https://github.com/vqv/ggbiplot/commit/7325e880485bea4c07465a0304c470608fffb5d9); 12 February 2015).
|
||||
#'
|
||||
#' As per their GPL-2 licence that demands documentation of code changes, the changes made based on the source code were:
|
||||
#' 1. Rewritten code to remove the dependency on packages `plyr`, `scales` and `grid`
|
||||
#' 2. Parametrised more options, like arrow and ellipse settings
|
||||
#' 3. Hardened all input possibilities by defining the exact type of user input for every argument
|
||||
#' 4. Added total amount of explained variance as a caption in the plot
|
||||
#' 5. Cleaned all syntax based on the `lintr` package, fixed grammatical errors and added integrity checks
|
||||
#' 6. Updated documentation
|
||||
#' @details The colours for labels and points can be changed by adding another scale layer for colour, such as `scale_colour_viridis_d()` and `scale_colour_brewer()`.
|
||||
#' @rdname ggplot_pca
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # calculate the resistance per group first
|
||||
#' resistance_data <- example_isolates %>%
|
||||
#' group_by(
|
||||
#' order = mo_order(mo), # group on anything, like order
|
||||
#' genus = mo_genus(mo)
|
||||
#' ) %>% # and genus as we do here;
|
||||
#' filter(n() >= 30) %>% # filter on only 30 results per group
|
||||
#' summarise_if(is.sir, resistance) # then get resistance of all drugs
|
||||
#'
|
||||
#' # now conduct PCA for certain antimicrobial drugs
|
||||
#' pca_result <- resistance_data %>%
|
||||
#' pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, SXT)
|
||||
#'
|
||||
#' summary(pca_result)
|
||||
#'
|
||||
#' # old base R plotting method:
|
||||
#' biplot(pca_result, main = "Base R biplot")
|
||||
#'
|
||||
#' # new ggplot2 plotting method using this package:
|
||||
#' if (require("ggplot2")) {
|
||||
#' 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 = "ggplot2 biplot")
|
||||
#' }
|
||||
#' }
|
||||
#' }
|
||||
ggplot_pca <- function(x,
|
||||
choices = 1:2,
|
||||
scale = 1,
|
||||
pc.biplot = TRUE,
|
||||
labels = NULL,
|
||||
labels_textsize = 3,
|
||||
labels_text_placement = 1.5,
|
||||
groups = NULL,
|
||||
ellipse = TRUE,
|
||||
ellipse_prob = 0.68,
|
||||
ellipse_size = 0.5,
|
||||
ellipse_alpha = 0.5,
|
||||
points_size = 2,
|
||||
points_alpha = 0.25,
|
||||
arrows = TRUE,
|
||||
arrows_colour = "darkblue",
|
||||
arrows_size = 0.5,
|
||||
arrows_textsize = 3,
|
||||
arrows_textangled = TRUE,
|
||||
arrows_alpha = 0.75,
|
||||
base_textsize = 10,
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(x, allow_class = c("prcomp", "princomp", "PCA", "lda"))
|
||||
meet_criteria(choices, allow_class = c("numeric", "integer"), has_length = 2, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(scale, allow_class = c("numeric", "integer", "logical"), has_length = 1)
|
||||
meet_criteria(pc.biplot, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(labels, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(labels_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(labels_text_placement, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(groups, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(ellipse, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(ellipse_prob, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(ellipse_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(ellipse_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(points_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(points_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(arrows_colour, allow_class = "character", has_length = 1)
|
||||
meet_criteria(arrows_size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(arrows_textangled, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(arrows_alpha, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(base_textsize, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
|
||||
calculations <- pca_calculations(
|
||||
pca_model = x,
|
||||
groups = groups,
|
||||
groups_missing = missing(groups),
|
||||
labels = labels,
|
||||
labels_missing = missing(labels),
|
||||
choices = choices,
|
||||
scale = scale,
|
||||
pc.biplot = pc.biplot,
|
||||
ellipse_prob = ellipse_prob,
|
||||
labels_text_placement = labels_text_placement
|
||||
)
|
||||
choices <- calculations$choices
|
||||
df.u <- calculations$df.u
|
||||
df.v <- calculations$df.v
|
||||
ell <- calculations$ell
|
||||
groups <- calculations$groups
|
||||
group_name <- calculations$group_name
|
||||
labels <- calculations$labels
|
||||
|
||||
# Append the proportion of explained variance to the axis labels
|
||||
if ((1 - as.integer(scale)) == 0) {
|
||||
u.axis.labs <- paste0("Standardised PC", choices)
|
||||
} else {
|
||||
u.axis.labs <- paste0("PC", choices)
|
||||
}
|
||||
u.axis.labs <- paste0(
|
||||
u.axis.labs,
|
||||
paste0(
|
||||
"\n(explained var: ",
|
||||
percentage(x$sdev[choices]^2 / sum(x$sdev^2)),
|
||||
")"
|
||||
)
|
||||
)
|
||||
|
||||
# Score Labels
|
||||
if (!is.null(labels)) {
|
||||
df.u$labels <- labels
|
||||
}
|
||||
|
||||
# Grouping variable
|
||||
if (!is.null(groups)) {
|
||||
df.u$groups <- groups
|
||||
}
|
||||
|
||||
# Base plot
|
||||
g <- ggplot2::ggplot(
|
||||
data = df.u,
|
||||
ggplot2::aes(x = xvar, y = yvar)
|
||||
) +
|
||||
ggplot2::xlab(u.axis.labs[1]) +
|
||||
ggplot2::ylab(u.axis.labs[2]) +
|
||||
ggplot2::expand_limits(
|
||||
x = c(-1.15, 1.15),
|
||||
y = c(-1.15, 1.15)
|
||||
)
|
||||
|
||||
# Draw either labels or points
|
||||
if (!is.null(df.u$labels)) {
|
||||
if (!is.null(df.u$groups)) {
|
||||
g <- g + ggplot2::geom_point(ggplot2::aes(colour = groups),
|
||||
alpha = points_alpha,
|
||||
size = points_size
|
||||
) +
|
||||
ggplot2::geom_text(ggplot2::aes(label = labels, colour = groups),
|
||||
nudge_y = -0.05,
|
||||
size = labels_textsize
|
||||
) +
|
||||
ggplot2::labs(colour = group_name)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = points_alpha,
|
||||
size = points_size
|
||||
) +
|
||||
ggplot2::geom_text(ggplot2::aes(label = labels),
|
||||
nudge_y = -0.05,
|
||||
size = labels_textsize
|
||||
)
|
||||
}
|
||||
} else {
|
||||
if (!is.null(df.u$groups)) {
|
||||
g <- g + ggplot2::geom_point(ggplot2::aes(colour = groups),
|
||||
alpha = points_alpha,
|
||||
size = points_size
|
||||
) +
|
||||
ggplot2::labs(colour = group_name)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_point(
|
||||
alpha = points_alpha,
|
||||
size = points_size
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
# Overlay a concentration ellipse if there are groups
|
||||
if (!is.null(df.u$groups) && !is.null(ell) && isTRUE(ellipse)) {
|
||||
g <- g + ggplot2::geom_path(
|
||||
data = ell,
|
||||
ggplot2::aes(colour = groups, group = groups),
|
||||
linewidth = ellipse_size,
|
||||
alpha = points_alpha
|
||||
)
|
||||
}
|
||||
|
||||
# Label the variable axes
|
||||
if (arrows == TRUE) {
|
||||
g <- g + ggplot2::geom_segment(
|
||||
data = df.v,
|
||||
ggplot2::aes(x = 0, y = 0, xend = xvar, yend = yvar),
|
||||
arrow = ggplot2::arrow(
|
||||
length = ggplot2::unit(0.5, "picas"),
|
||||
angle = 20,
|
||||
ends = "last",
|
||||
type = "open"
|
||||
),
|
||||
colour = arrows_colour,
|
||||
linewidth = arrows_size,
|
||||
alpha = arrows_alpha
|
||||
)
|
||||
if (arrows_textangled == TRUE) {
|
||||
g <- g + ggplot2::geom_text(
|
||||
data = df.v,
|
||||
ggplot2::aes(label = varname, x = xvar, y = yvar, angle = angle, hjust = hjust),
|
||||
colour = arrows_colour,
|
||||
size = arrows_textsize,
|
||||
alpha = arrows_alpha
|
||||
)
|
||||
} else {
|
||||
g <- g + ggplot2::geom_text(
|
||||
data = df.v,
|
||||
ggplot2::aes(label = varname, x = xvar, y = yvar, hjust = hjust),
|
||||
colour = arrows_colour,
|
||||
size = arrows_textsize,
|
||||
alpha = arrows_alpha
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
# Add caption label about total explained variance
|
||||
g <- g + ggplot2::labs(caption = paste0(
|
||||
"Total explained variance: ",
|
||||
percentage(sum(x$sdev[choices]^2 / sum(x$sdev^2)))
|
||||
))
|
||||
|
||||
# mark-up nicely
|
||||
g <- g + ggplot2::theme_minimal(base_size = base_textsize) +
|
||||
ggplot2::theme(
|
||||
panel.grid.major = ggplot2::element_line(colour = "grey85"),
|
||||
panel.grid.minor = ggplot2::element_blank(),
|
||||
# centre title and subtitle
|
||||
plot.title = ggplot2::element_text(hjust = 0.5),
|
||||
plot.subtitle = ggplot2::element_text(hjust = 0.5)
|
||||
)
|
||||
|
||||
g
|
||||
}
|
||||
|
||||
#' @importFrom stats qchisq var
|
||||
pca_calculations <- function(pca_model,
|
||||
groups = NULL,
|
||||
groups_missing = TRUE,
|
||||
labels = NULL,
|
||||
labels_missing = TRUE,
|
||||
choices = 1:2,
|
||||
scale = 1,
|
||||
pc.biplot = TRUE,
|
||||
ellipse_prob = 0.68,
|
||||
labels_text_placement = 1.5) {
|
||||
non_numeric_cols <- attributes(pca_model)$non_numeric_cols
|
||||
if (groups_missing) {
|
||||
groups <- tryCatch(non_numeric_cols[[1]],
|
||||
error = function(e) NULL
|
||||
)
|
||||
group_name <- tryCatch(colnames(non_numeric_cols[1]),
|
||||
error = function(e) NULL
|
||||
)
|
||||
}
|
||||
if (labels_missing) {
|
||||
labels <- tryCatch(non_numeric_cols[[2]],
|
||||
error = function(e) NULL
|
||||
)
|
||||
}
|
||||
if (!is.null(groups) && is.null(labels)) {
|
||||
# turn them around
|
||||
labels <- groups
|
||||
groups <- NULL
|
||||
group_name <- NULL
|
||||
}
|
||||
|
||||
# Recover the SVD
|
||||
if (inherits(pca_model, "prcomp")) {
|
||||
nobs.factor <- sqrt(nrow(pca_model$x) - 1)
|
||||
d <- pca_model$sdev
|
||||
u <- sweep(pca_model$x, 2, 1 / (d * nobs.factor), FUN = "*")
|
||||
v <- pca_model$rotation
|
||||
} else if (inherits(pca_model, "princomp")) {
|
||||
nobs.factor <- sqrt(pca_model$n.obs)
|
||||
d <- pca_model$sdev
|
||||
u <- sweep(pca_model$scores, 2, 1 / (d * nobs.factor), FUN = "*")
|
||||
v <- pca_model$loadings
|
||||
} else if (inherits(pca_model, "PCA")) {
|
||||
nobs.factor <- sqrt(nrow(pca_model$call$X))
|
||||
d <- unlist(sqrt(pca_model$eig)[1])
|
||||
u <- sweep(pca_model$ind$coord, 2, 1 / (d * nobs.factor), FUN = "*")
|
||||
v <- sweep(pca_model$var$coord, 2, sqrt(pca_model$eig[seq_len(ncol(pca_model$var$coord)), 1]), FUN = "/")
|
||||
} else if (inherits(pca_model, "lda")) {
|
||||
nobs.factor <- sqrt(pca_model$N)
|
||||
d <- pca_model$svd
|
||||
u <- predict(pca_model)$x / nobs.factor
|
||||
v <- pca_model$scaling
|
||||
} else {
|
||||
stop("Expected an object of class prcomp, princomp, PCA, or lda")
|
||||
}
|
||||
|
||||
# Scores
|
||||
choices <- pmin(choices, ncol(u))
|
||||
obs.scale <- 1 - as.integer(scale)
|
||||
df.u <- as.data.frame(sweep(u[, choices], 2, d[choices]^obs.scale, FUN = "*"),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
# Directions
|
||||
v <- sweep(v, 2, d^as.integer(scale), FUN = "*")
|
||||
df.v <- as.data.frame(v[, choices],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
names(df.u) <- c("xvar", "yvar")
|
||||
names(df.v) <- names(df.u)
|
||||
|
||||
if (isTRUE(pc.biplot)) {
|
||||
df.u <- df.u * nobs.factor
|
||||
}
|
||||
|
||||
# Scale the radius of the correlation circle so that it corresponds to
|
||||
# a data ellipse for the standardized PC scores
|
||||
circle_prob <- 0.69
|
||||
r <- sqrt(qchisq(circle_prob, df = 2)) * prod(colMeans(df.u^2))^(0.25)
|
||||
|
||||
# Scale directions
|
||||
v.scale <- rowSums(v^2)
|
||||
df.v <- r * df.v / sqrt(max(v.scale))
|
||||
|
||||
# Grouping variable
|
||||
if (!is.null(groups)) {
|
||||
df.u$groups <- groups
|
||||
}
|
||||
|
||||
df.v$varname <- rownames(v)
|
||||
|
||||
# Variables for text label placement
|
||||
df.v$angle <- with(df.v, (180 / pi) * atan(yvar / xvar))
|
||||
df.v$hjust <- with(df.v, (1 - labels_text_placement * sign(xvar)) / 2)
|
||||
|
||||
if (!is.null(df.u$groups)) {
|
||||
theta <- c(seq(-pi, pi, length = 50), seq(pi, -pi, length = 50))
|
||||
circle <- cbind(cos(theta), sin(theta))
|
||||
|
||||
df.groups <- lapply(unique(df.u$groups), function(g, df = df.u) {
|
||||
x <- df[which(df$groups == g), , drop = FALSE]
|
||||
if (nrow(x) <= 2) {
|
||||
return(data.frame(
|
||||
X1 = numeric(0),
|
||||
X2 = numeric(0),
|
||||
groups = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
))
|
||||
}
|
||||
sigma <- var(cbind(x$xvar, x$yvar))
|
||||
mu <- c(mean(x$xvar), mean(x$yvar))
|
||||
ed <- sqrt(qchisq(ellipse_prob, df = 2))
|
||||
data.frame(
|
||||
sweep(circle %*% chol(sigma) * ed,
|
||||
MARGIN = 2,
|
||||
STATS = mu,
|
||||
FUN = "+"
|
||||
),
|
||||
groups = x$groups[1],
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
})
|
||||
ell <- do.call(rbind, df.groups)
|
||||
if (NROW(ell) == 0) {
|
||||
ell <- NULL
|
||||
} else {
|
||||
names(ell)[1:2] <- c("xvar", "yvar")
|
||||
}
|
||||
} else {
|
||||
ell <- NULL
|
||||
}
|
||||
|
||||
list(
|
||||
choices = choices,
|
||||
df.u = df.u,
|
||||
df.v = df.v,
|
||||
ell = ell,
|
||||
groups = groups,
|
||||
group_name = group_name,
|
||||
labels = labels
|
||||
)
|
||||
}
|
||||
-343
@@ -1,343 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' AMR Plots with `ggplot2`
|
||||
#'
|
||||
#' Use these functions to create bar plots for AMR data analysis. All functions rely on [ggplot2][ggplot2::ggplot()] functions.
|
||||
#' @param data A [data.frame] with column(s) of class [`sir`] (see [as.sir()]).
|
||||
#' @param position Position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`.
|
||||
#' @param x Variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable.
|
||||
#' @param fill Variable to categorise using the plots legend, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable.
|
||||
#' @param breaks A [numeric] vector of positions.
|
||||
#' @param limits A [numeric] vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum.
|
||||
#' @param facet Variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable.
|
||||
#' @inheritParams proportion
|
||||
#' @param nrow (when using `facet`) number of rows.
|
||||
#' @param colours A named vactor with colour to be used for filling. The default colours are colour-blind friendly.
|
||||
#' @param datalabels Show datalabels using [labels_sir_count()].
|
||||
#' @param datalabels.size Size of the datalabels.
|
||||
#' @param datalabels.colour Colour of the datalabels.
|
||||
#' @param title Text to show as title of the plot.
|
||||
#' @param subtitle Text to show as subtitle of the plot.
|
||||
#' @param caption Text to show as caption of the plot.
|
||||
#' @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 antimicrobials will be shown on the plots using [ab_name()]. This can be set with the `translate_ab` argument. See [count_df()].
|
||||
#'
|
||||
#' [geom_sir()] will take any variable from the data that has an [`sir`] class (created with [as.sir()]) using [sir_df()] and will plot bars with the percentage S, I, and R. The default behaviour is to have the bars stacked and to have the different antimicrobials on the x axis.
|
||||
#'
|
||||
#' Additional functions include:
|
||||
#'
|
||||
#' * [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
|
||||
#' @export
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # get antimicrobial results for drugs against a UTI:
|
||||
#' ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) +
|
||||
#' geom_sir()
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # prettify the plot using some additional functions:
|
||||
#' df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)
|
||||
#' ggplot(df) +
|
||||
#' geom_sir() +
|
||||
#' scale_y_percent() +
|
||||
#' scale_sir_colours(aesthetics = "fill") +
|
||||
#' labels_sir_count() +
|
||||
#' theme_sir()
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # or better yet, simplify this using the wrapper function - a single command:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_sir()
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # get only proportions and no counts:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_sir(datalabels = FALSE)
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # add other ggplot2 arguments as you like:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_sir(
|
||||
#' width = 0.5,
|
||||
#' colour = "black",
|
||||
#' size = 1,
|
||||
#' linetype = 2,
|
||||
#' alpha = 0.25
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # you can alter the colours with colour names:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX) %>%
|
||||
#' ggplot_sir(colours = c(SI = "yellow"))
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # but you can also use the built-in colour-blind friendly colours for
|
||||
#' # your plots, where "S" is green, "I" is yellow and "R" is red:
|
||||
#' data.frame(
|
||||
#' x = c("Value1", "Value2", "Value3"),
|
||||
#' y = c(1, 2, 3),
|
||||
#' z = c("Value4", "Value5", "Value6")
|
||||
#' ) %>%
|
||||
#' ggplot() +
|
||||
#' geom_col(aes(x = x, y = y, fill = z)) +
|
||||
#' scale_sir_colours(
|
||||
#' aesthetics = "fill",
|
||||
#' Value4 = "S", Value5 = "I", Value6 = "R"
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # resistance of ciprofloxacine per age group
|
||||
#' example_isolates %>%
|
||||
#' mutate(first_isolate = first_isolate()) %>%
|
||||
#' filter(
|
||||
#' first_isolate == TRUE,
|
||||
#' mo == as.mo("Escherichia coli")
|
||||
#' ) %>%
|
||||
#' # age_groups() is also a function in this AMR package:
|
||||
#' group_by(age_group = age_groups(age)) %>%
|
||||
#' select(age_group, CIP) %>%
|
||||
#' ggplot_sir(x = "age_group")
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # a shorter version which also adjusts data label colours:
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' ggplot_sir(colours = FALSE)
|
||||
#' }
|
||||
#' if (require("ggplot2") && require("dplyr")) {
|
||||
#' # it also supports groups (don't forget to use the group var on `x` or `facet`):
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_is_gram_negative(), ward != "Outpatient") %>%
|
||||
#' # select only UTI-specific drugs
|
||||
#' select(ward, AMX, NIT, FOS, TMP, CIP) %>%
|
||||
#' group_by(ward) %>%
|
||||
#' ggplot_sir(
|
||||
#' x = "ward",
|
||||
#' facet = "antibiotic",
|
||||
#' nrow = 1,
|
||||
#' title = "AMR of Anti-UTI Drugs Per Ward",
|
||||
#' x.title = "Ward",
|
||||
#' datalabels = FALSE
|
||||
#' )
|
||||
#' }
|
||||
#' }
|
||||
ggplot_sir <- function(data,
|
||||
position = NULL,
|
||||
x = "antibiotic",
|
||||
fill = "interpretation",
|
||||
# params = list(),
|
||||
facet = NULL,
|
||||
breaks = seq(0, 1, 0.1),
|
||||
limits = NULL,
|
||||
translate_ab = "name",
|
||||
combine_SI = TRUE,
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
nrow = NULL,
|
||||
colours = c(
|
||||
S = "#3CAEA3",
|
||||
SI = "#3CAEA3",
|
||||
I = "#F6D55C",
|
||||
IR = "#ED553B",
|
||||
R = "#ED553B"
|
||||
),
|
||||
datalabels = TRUE,
|
||||
datalabels.size = 2.5,
|
||||
datalabels.colour = "grey15",
|
||||
title = NULL,
|
||||
subtitle = NULL,
|
||||
caption = NULL,
|
||||
x.title = "Antimicrobial",
|
||||
y.title = "Proportion",
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
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)
|
||||
meet_criteria(facet, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(breaks, allow_class = c("numeric", "integer"))
|
||||
meet_criteria(limits, allow_class = c("numeric", "integer"), has_length = 2, allow_NULL = TRUE, allow_NA = TRUE)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(nrow, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(colours, allow_class = c("character", "logical"))
|
||||
meet_criteria(datalabels, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(datalabels.colour, allow_class = "character", has_length = 1)
|
||||
meet_criteria(title, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(subtitle, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(caption, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
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)
|
||||
|
||||
x_deparse <- deparse(substitute(x))
|
||||
if (x_deparse != "x") {
|
||||
x <- x_deparse
|
||||
}
|
||||
if (x %like% '".*"') {
|
||||
x <- substr(x, 2, nchar(x) - 1)
|
||||
}
|
||||
facet_deparse <- deparse(substitute(facet))
|
||||
if (facet_deparse != "facet") {
|
||||
facet <- facet_deparse
|
||||
}
|
||||
if (facet %like% '".*"') {
|
||||
facet <- substr(facet, 2, nchar(facet) - 1)
|
||||
}
|
||||
if (facet %in% c("NULL", "")) {
|
||||
facet <- NULL
|
||||
}
|
||||
|
||||
if (is.null(position)) {
|
||||
position <- "fill"
|
||||
}
|
||||
|
||||
p <- ggplot2::ggplot(data = data) +
|
||||
geom_sir(
|
||||
position = position, x = x, fill = fill, translate_ab = translate_ab,
|
||||
minimum = minimum, language = language,
|
||||
combine_SI = combine_SI, ...
|
||||
) +
|
||||
theme_sir()
|
||||
|
||||
if (fill == "interpretation") {
|
||||
p <- suppressWarnings(p + scale_sir_colours(aesthetics = "fill", colours = colours))
|
||||
}
|
||||
|
||||
if (identical(position, "fill")) {
|
||||
# proportions, so use y scale with percentage
|
||||
p <- p + scale_y_percent(breaks = breaks, limits = limits)
|
||||
}
|
||||
|
||||
if (datalabels == TRUE) {
|
||||
p <- p + labels_sir_count(
|
||||
position = position,
|
||||
x = x,
|
||||
translate_ab = translate_ab,
|
||||
minimum = minimum,
|
||||
language = language,
|
||||
combine_SI = combine_SI,
|
||||
datalabels.size = datalabels.size,
|
||||
datalabels.colour = datalabels.colour
|
||||
)
|
||||
}
|
||||
|
||||
if (!is.null(facet)) {
|
||||
p <- p + facet_sir(facet = facet, nrow = nrow)
|
||||
}
|
||||
|
||||
p <- p + ggplot2::labs(
|
||||
title = title,
|
||||
subtitle = subtitle,
|
||||
caption = caption,
|
||||
x = x.title,
|
||||
y = y.title
|
||||
)
|
||||
|
||||
p
|
||||
}
|
||||
|
||||
#' @rdname ggplot_sir
|
||||
#' @export
|
||||
geom_sir <- function(position = NULL,
|
||||
x = c("antibiotic", "interpretation"),
|
||||
fill = "interpretation",
|
||||
translate_ab = "name",
|
||||
minimum = 30,
|
||||
language = get_AMR_locale(),
|
||||
combine_SI = TRUE,
|
||||
...) {
|
||||
x <- x[1]
|
||||
stop_ifnot_installed("ggplot2")
|
||||
stop_if(is.data.frame(position), "`position` is invalid. Did you accidentally use '%>%' instead of '+'?")
|
||||
meet_criteria(position, allow_class = "character", has_length = 1, is_in = c("fill", "stack", "dodge"), allow_NULL = TRUE)
|
||||
meet_criteria(x, allow_class = "character", has_length = 1)
|
||||
meet_criteria(fill, allow_class = "character", has_length = 1)
|
||||
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
language <- validate_language(language)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
|
||||
y <- "value"
|
||||
if (missing(position) || is.null(position)) {
|
||||
position <- "fill"
|
||||
}
|
||||
|
||||
if (identical(position, "fill")) {
|
||||
position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE)
|
||||
}
|
||||
|
||||
x_deparse <- deparse(substitute(x))
|
||||
if (x_deparse != "x") {
|
||||
x <- x_deparse
|
||||
}
|
||||
if (x %like% '".*"') {
|
||||
x <- substr(x, 2, nchar(x) - 1)
|
||||
}
|
||||
|
||||
if (tolower(x) %in% tolower(c("ab", "abx", "antimicrobials"))) {
|
||||
x <- "antibiotic"
|
||||
} else if (tolower(x) %in% tolower(c("SIR", "sir", "interpretations", "result"))) {
|
||||
x <- "interpretation"
|
||||
}
|
||||
|
||||
ggplot2::geom_col(
|
||||
data = function(x) {
|
||||
sir_df(
|
||||
data = x,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
},
|
||||
mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang(y), fill = str2lang(fill))),
|
||||
position = position,
|
||||
...
|
||||
)
|
||||
}
|
||||
@@ -1,372 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Guess Antibiotic Column
|
||||
#'
|
||||
#' This tries to find a column name in a data set based on information from the [antimicrobials] data set. Also supports WHONET abbreviations.
|
||||
#' @param x A [data.frame].
|
||||
#' @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 [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
|
||||
#' df <- data.frame(
|
||||
#' amox = "S",
|
||||
#' tetr = "R"
|
||||
#' )
|
||||
#'
|
||||
#' guess_ab_col(df, "amoxicillin")
|
||||
#' guess_ab_col(df, "J01AA07") # ATC code of tetracycline
|
||||
#'
|
||||
#' guess_ab_col(df, "J01AA07", verbose = TRUE)
|
||||
#'
|
||||
#' # WHONET codes
|
||||
#' df <- data.frame(
|
||||
#' AMP_ND10 = "R",
|
||||
#' AMC_ED20 = "S"
|
||||
#' )
|
||||
#' guess_ab_col(df, "ampicillin")
|
||||
#' guess_ab_col(df, "J01CR02")
|
||||
#' guess_ab_col(df, "augmentin")
|
||||
guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_sir_columns = FALSE) {
|
||||
meet_criteria(x, allow_class = "data.frame", allow_NULL = TRUE)
|
||||
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (is.null(x) && is.null(search_string)) {
|
||||
return(as.name("guess_ab_col"))
|
||||
} else {
|
||||
meet_criteria(search_string, allow_class = "character", has_length = 1, allow_NULL = FALSE)
|
||||
}
|
||||
|
||||
all_found <- get_column_abx(x,
|
||||
info = verbose, only_sir_columns = only_sir_columns,
|
||||
verbose = verbose, fn = "guess_ab_col"
|
||||
)
|
||||
search_string.ab <- suppressWarnings(as.ab(search_string))
|
||||
ab_result <- unname(all_found[names(all_found) == search_string.ab])
|
||||
|
||||
if (length(ab_result) == 0) {
|
||||
if (isTRUE(verbose)) {
|
||||
message_("No column found as input for ", search_string,
|
||||
" (", ab_name(search_string, language = NULL, tolower = TRUE), ").",
|
||||
add_fn = font_black,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
return(NULL)
|
||||
} else {
|
||||
if (isTRUE(verbose)) {
|
||||
message_(
|
||||
"Using column '", font_bold(ab_result), "' as input for ", search_string,
|
||||
" (", ab_name(search_string, language = NULL, tolower = TRUE), ")."
|
||||
)
|
||||
}
|
||||
return(ab_result)
|
||||
}
|
||||
}
|
||||
|
||||
get_column_abx <- function(x,
|
||||
...,
|
||||
soft_dependencies = NULL,
|
||||
hard_dependencies = NULL,
|
||||
verbose = FALSE,
|
||||
info = TRUE,
|
||||
only_sir_columns = FALSE,
|
||||
sort = TRUE,
|
||||
reuse_previous_result = TRUE,
|
||||
fn = NULL,
|
||||
return_all = FALSE) {
|
||||
# check if retrieved before, then get it from package environment
|
||||
if (isTRUE(reuse_previous_result) && identical(
|
||||
unique_call_id(
|
||||
entire_session = FALSE,
|
||||
match_fn = fn
|
||||
),
|
||||
AMR_env$get_column_abx.call
|
||||
)) {
|
||||
# so within the same call, within the same environment, we got here again.
|
||||
# but we could've come from another function within the same call, so now only check the columns that changed
|
||||
|
||||
# first remove the columns that are not existing anymore
|
||||
previous <- AMR_env$get_column_abx.out
|
||||
current <- previous[previous %in% colnames(x)]
|
||||
|
||||
# then compare columns in current call with columns in original call
|
||||
new_cols <- colnames(x)[!colnames(x) %in% AMR_env$get_column_abx.checked_cols]
|
||||
if (length(new_cols) > 0) {
|
||||
# these columns did not exist in the last call, so add them
|
||||
new_cols_sir <- get_column_abx(x[, new_cols, drop = FALSE], reuse_previous_result = FALSE, info = FALSE, sort = FALSE)
|
||||
current <- c(current, new_cols_sir)
|
||||
# order according to columns in current call
|
||||
current <- current[match(colnames(x)[colnames(x) %in% current], current)]
|
||||
}
|
||||
|
||||
# update pkg environment to improve speed on next run
|
||||
AMR_env$get_column_abx.out <- current
|
||||
AMR_env$get_column_abx.checked_cols <- colnames(x)
|
||||
|
||||
# and return right values
|
||||
return(AMR_env$get_column_abx.out)
|
||||
}
|
||||
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(soft_dependencies, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(hard_dependencies, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(verbose, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(sort, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (isTRUE(info)) {
|
||||
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x.bak <- x
|
||||
if (only_sir_columns == TRUE) {
|
||||
x <- x[, which(is.sir(x)), drop = FALSE]
|
||||
}
|
||||
|
||||
if (NROW(x) > 10000) {
|
||||
# only test maximum of 10,000 values per column
|
||||
if (isTRUE(info)) {
|
||||
message_(" (using only ", font_bold("the first 10,000 rows"), ")...",
|
||||
appendLF = FALSE,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
x <- x[1:10000, , drop = FALSE]
|
||||
} else if (isTRUE(info)) {
|
||||
message_("...", appendLF = FALSE, as_note = FALSE)
|
||||
}
|
||||
|
||||
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
|
||||
# or already have the 'sir' class (as.sir)
|
||||
# and that they have no more than 50% invalid values
|
||||
vectr_antibiotics <- unlist(AMR_env$AB_lookup$generalised_all)
|
||||
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
|
||||
x_columns <- vapply(
|
||||
FUN.VALUE = character(1),
|
||||
colnames(x),
|
||||
function(col, df = x) {
|
||||
if (generalise_antibiotic_name(col) %in% vectr_antibiotics ||
|
||||
is.sir(x[, col, drop = TRUE]) ||
|
||||
is_sir_eligible(x[, col, drop = TRUE], threshold = 0.5)
|
||||
) {
|
||||
return(col)
|
||||
} else {
|
||||
return(NA_character_)
|
||||
}
|
||||
}, USE.NAMES = FALSE
|
||||
)
|
||||
|
||||
x_columns <- x_columns[!is.na(x_columns)]
|
||||
x <- x[, x_columns, drop = FALSE] # without drop = FALSE, x will become a vector when x_columns is length 1
|
||||
df_trans <- data.frame(
|
||||
colnames = colnames(x),
|
||||
abcode = suppressWarnings(as.ab(colnames(x), info = FALSE)),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
df_trans <- df_trans[!is.na(df_trans$abcode), , drop = FALSE]
|
||||
out <- as.character(df_trans$colnames)
|
||||
names(out) <- df_trans$abcode
|
||||
|
||||
# add from self-defined dots (...):
|
||||
# such as get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
|
||||
all_okay <- TRUE
|
||||
dots <- list(...)
|
||||
# remove data.frames, since this is also used running `eucast_rules(eucast_rules_df = df)`
|
||||
dots <- dots[!vapply(FUN.VALUE = logical(1), dots, is.data.frame)]
|
||||
if (length(dots) > 0) {
|
||||
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
|
||||
if (anyNA(newnames)) {
|
||||
if (isTRUE(info)) {
|
||||
message_(" WARNING", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
}
|
||||
warning_("Invalid antibiotic reference(s): ", vector_and(names(dots)[is.na(newnames)], quotes = FALSE),
|
||||
call = FALSE,
|
||||
immediate = TRUE
|
||||
)
|
||||
all_okay <- FALSE
|
||||
}
|
||||
unexisting_cols <- which(!vapply(FUN.VALUE = logical(1), dots, function(col) all(col %in% x_columns)))
|
||||
if (length(unexisting_cols) > 0) {
|
||||
if (isTRUE(info)) {
|
||||
message_(" ERROR", add_fn = list(font_red, font_bold), as_note = FALSE)
|
||||
}
|
||||
stop_("Column(s) not found: ", vector_and(unlist(dots[[unexisting_cols]]), quotes = FALSE),
|
||||
call = FALSE
|
||||
)
|
||||
all_okay <- FALSE
|
||||
}
|
||||
# turn all NULLs to NAs
|
||||
dots <- unlist(lapply(dots, function(dot) if (is.null(dot)) NA else dot))
|
||||
names(dots) <- newnames
|
||||
dots <- dots[!is.na(names(dots))]
|
||||
# merge, but overwrite automatically determined ones by 'dots'
|
||||
out <- c(out[!out %in% dots & !names(out) %in% names(dots)], dots)
|
||||
# delete NAs, this will make e.g. eucast_rules(... TMP = NULL) work to prevent TMP from being used
|
||||
out <- out[!is.na(out)]
|
||||
}
|
||||
|
||||
if (length(out) == 0) {
|
||||
if (isTRUE(info) && all_okay == TRUE) {
|
||||
message_("No columns found.")
|
||||
}
|
||||
AMR_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
|
||||
AMR_env$get_column_abx.checked_cols <- colnames(x.bak)
|
||||
AMR_env$get_column_abx.out <- out
|
||||
return(out)
|
||||
}
|
||||
|
||||
# sort on name
|
||||
if (sort == TRUE) {
|
||||
out <- out[order(names(out), out)]
|
||||
}
|
||||
|
||||
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
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
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)]
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(hard_dependencies)) {
|
||||
hard_dependencies <- unique(hard_dependencies)
|
||||
if (!all(hard_dependencies %in% names(out))) {
|
||||
# missing a hard dependency will return NA and consequently the data will not be analysed
|
||||
missing <- hard_dependencies[!hard_dependencies %in% names(out)]
|
||||
generate_warning_abs_missing(missing, any = FALSE)
|
||||
return(NA)
|
||||
}
|
||||
}
|
||||
if (!is.null(soft_dependencies)) {
|
||||
soft_dependencies <- unique(soft_dependencies)
|
||||
if (isTRUE(info) && !all(soft_dependencies %in% names(out))) {
|
||||
# missing a soft dependency may lower the reliability
|
||||
missing <- soft_dependencies[!soft_dependencies %in% names(out)]
|
||||
missing_msg <- vector_and(
|
||||
paste0(
|
||||
ab_name(missing, tolower = TRUE, language = NULL),
|
||||
" (", font_bold(missing, collapse = NULL), ")"
|
||||
),
|
||||
quotes = FALSE
|
||||
)
|
||||
message_(
|
||||
"Reliability would be improved if these antimicrobial results would be available too: ",
|
||||
missing_msg
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
AMR_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
|
||||
AMR_env$get_column_abx.checked_cols <- colnames(x.bak)
|
||||
AMR_env$get_column_abx.out <- out
|
||||
out
|
||||
}
|
||||
|
||||
get_ab_from_namespace <- function(x, cols_ab) {
|
||||
# cols_ab comes from get_column_abx()
|
||||
|
||||
x <- trimws2(unique(toupper(unlist(strsplit(x, ",", fixed = TRUE)))))
|
||||
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_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`
|
||||
val <- as.ab(val)
|
||||
} else {
|
||||
stop_("unknown antimicrobial drug (group): ", val, call = FALSE)
|
||||
}
|
||||
x_new <- c(x_new, val)
|
||||
}
|
||||
x_new <- unique(x_new)
|
||||
out <- cols_ab[match(x_new, names(cols_ab))]
|
||||
out[!is.na(out)]
|
||||
}
|
||||
|
||||
generate_warning_abs_missing <- function(missing, any = FALSE) {
|
||||
missing <- paste0(missing, " (", ab_name(missing, tolower = TRUE, language = NULL), ")")
|
||||
if (any == TRUE) {
|
||||
any_txt <- c(" any of", "is")
|
||||
} else {
|
||||
any_txt <- c("", "are")
|
||||
}
|
||||
warning_(
|
||||
paste0(
|
||||
"Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||
vector_and(missing, quotes = FALSE)
|
||||
),
|
||||
immediate = TRUE
|
||||
)
|
||||
}
|
||||
@@ -1,145 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Italicise Taxonomic Families, Genera, Species, Subspecies
|
||||
#'
|
||||
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italics. This function finds taxonomic names within strings and makes them italic.
|
||||
#' @param string A [character] (vector).
|
||||
#' @param type Type of conversion of the taxonomic names, either "markdown", "html" 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 `<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
|
||||
#' @examples
|
||||
#' italicise_taxonomy("An overview of Staphylococcus aureus isolates")
|
||||
#' 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", "html")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
meet_criteria(string, allow_class = "character")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi", "html"))
|
||||
|
||||
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)
|
||||
}
|
||||
before <- "\033[3m"
|
||||
after <- "\033[23m"
|
||||
}
|
||||
|
||||
vapply(
|
||||
FUN.VALUE = character(1),
|
||||
string,
|
||||
function(s) {
|
||||
s_split <- unlist(strsplit(s, " ", fixed = TRUE))
|
||||
|
||||
search_strings <- gsub("[^a-zA-Z-]", "", s_split)
|
||||
|
||||
ind_species <- search_strings != "" &
|
||||
search_strings %in% AMR_env$MO_lookup[
|
||||
which(AMR_env$MO_lookup$rank %in% c(
|
||||
"family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp."
|
||||
)),
|
||||
"species",
|
||||
drop = TRUE
|
||||
]
|
||||
|
||||
ind_fullname <- search_strings != "" &
|
||||
search_strings %in% c(
|
||||
AMR_env$MO_lookup[
|
||||
which(AMR_env$MO_lookup$rank %in% c(
|
||||
"family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp."
|
||||
)),
|
||||
"fullname",
|
||||
drop = TRUE
|
||||
],
|
||||
AMR_env$MO_lookup[
|
||||
which(AMR_env$MO_lookup$rank %in% c(
|
||||
"family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp."
|
||||
)),
|
||||
"subspecies",
|
||||
drop = TRUE
|
||||
]
|
||||
)
|
||||
|
||||
# also support E. coli, add "E." to indices
|
||||
has_previous_genera_abbr <- s_split[which(ind_species) - 1] %like_case% "^[A-Z][.]?$"
|
||||
ind_species <- c(which(ind_species), which(ind_species)[has_previous_genera_abbr] - 1)
|
||||
|
||||
ind <- c(ind_species, which(ind_fullname))
|
||||
|
||||
s_split[ind] <- paste0(before, s_split[ind], after)
|
||||
s_paste <- paste(s_split, collapse = " ")
|
||||
|
||||
# clean up a bit
|
||||
s_paste <- gsub(paste0(after, " ", before), " ", s_paste, fixed = TRUE)
|
||||
|
||||
s_paste
|
||||
},
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname italicise_taxonomy
|
||||
#' @export
|
||||
italicize_taxonomy <- function(string, type = c("markdown", "ansi", "html")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
italicise_taxonomy(string = string, type = type)
|
||||
}
|
||||
@@ -1,192 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Join [microorganisms] to a Data Set
|
||||
#'
|
||||
#' Join the data set [microorganisms] easily to an existing data set or to a [character] vector.
|
||||
#' @rdname join
|
||||
#' @name join
|
||||
#' @aliases join inner_join
|
||||
#' @param x Existing data set to join, or [character] vector. In case of a [character] vector, the resulting [data.frame] will contain a column 'x' with these values.
|
||||
#' @param by A variable to join by - if left empty will search for a column with class [`mo`] (created with [as.mo()]) or will be `"mo"` if that column name exists in `x`, could otherwise be a column name of `x` with values that exist in `microorganisms$mo` (such as `by = "bacteria_id"`), or another column in [microorganisms] (but then it should be named, like `by = c("bacteria_id" = "fullname")`).
|
||||
#' @param suffix If there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a [character] vector of length 2.
|
||||
#' @param ... Ignored, only in place to allow future extensions.
|
||||
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
|
||||
#'
|
||||
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] and [interaction()] functions from base \R will be used.
|
||||
#' @return a [data.frame]
|
||||
#' @export
|
||||
#' @examples
|
||||
#' left_join_microorganisms(as.mo("K. pneumoniae"))
|
||||
#' left_join_microorganisms("B_KLBSL_PNMN")
|
||||
#'
|
||||
#' df <- data.frame(
|
||||
#' date = seq(
|
||||
#' from = as.Date("2018-01-01"),
|
||||
#' to = as.Date("2018-01-07"),
|
||||
#' by = 1
|
||||
#' ),
|
||||
#' bacteria = as.mo(c(
|
||||
#' "S. aureus", "MRSA", "MSSA", "STAAUR",
|
||||
#' "E. coli", "E. coli", "E. coli"
|
||||
#' )),
|
||||
#' stringsAsFactors = FALSE
|
||||
#' )
|
||||
#' colnames(df)
|
||||
#'
|
||||
#' df_joined <- left_join_microorganisms(df, "bacteria")
|
||||
#' colnames(df_joined)
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' left_join_microorganisms() %>%
|
||||
#' colnames()
|
||||
#' }
|
||||
#' }
|
||||
inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
join_microorganisms(type = "inner_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
#' @export
|
||||
left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
join_microorganisms(type = "left_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
#' @export
|
||||
right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
join_microorganisms(type = "right_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
#' @export
|
||||
full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(suffix, allow_class = "character", has_length = 2)
|
||||
|
||||
join_microorganisms(type = "full_join", x = x, by = by, suffix = suffix, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
#' @export
|
||||
semi_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
|
||||
join_microorganisms(type = "semi_join", x = x, by = by, ...)
|
||||
}
|
||||
|
||||
#' @rdname join
|
||||
#' @export
|
||||
anti_join_microorganisms <- function(x, by = NULL, ...) {
|
||||
meet_criteria(x, allow_class = c("data.frame", "character"))
|
||||
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
|
||||
|
||||
join_microorganisms(type = "anti_join", x = x, by = by, ...)
|
||||
}
|
||||
|
||||
join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
if (!is.data.frame(x)) {
|
||||
if (pkg_is_available("tibble")) {
|
||||
x <- import_fn("tibble", "tibble")(mo = x)
|
||||
} else {
|
||||
x <- data.frame(mo = x, stringsAsFactors = FALSE)
|
||||
}
|
||||
by <- "mo"
|
||||
}
|
||||
x.bak <- x
|
||||
if (is.null(by)) {
|
||||
by <- search_type_in_df(x, "mo", info = FALSE)
|
||||
if (is.null(by) && NCOL(x) == 1) {
|
||||
by <- colnames(x)[1L]
|
||||
} else {
|
||||
stop_if(is.null(by), "no column with microorganism names or codes found, set this column with `by`", call = -2)
|
||||
}
|
||||
message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
|
||||
}
|
||||
if (!all(x[, by, drop = TRUE] %in% AMR_env$MO_lookup$mo, na.rm = TRUE)) {
|
||||
x$join.mo <- as.mo(x[, by, drop = TRUE])
|
||||
by <- c("join.mo" = "mo")
|
||||
} else {
|
||||
x[, by] <- as.mo(x[, by, drop = TRUE])
|
||||
}
|
||||
|
||||
if (is.null(names(by))) {
|
||||
# will always be joined to microorganisms$mo, so add name to that
|
||||
by <- stats::setNames("mo", by)
|
||||
}
|
||||
|
||||
# use dplyr if available - it's much faster than poorman alternatives
|
||||
dplyr_join <- import_fn(name = type, pkg = "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(dplyr_join)) {
|
||||
join_fn <- dplyr_join
|
||||
} else {
|
||||
# otherwise use poorman, see R/aa_helper_pm_functions.R
|
||||
join_fn <- get(paste0("pm_", type), envir = asNamespace("AMR"))
|
||||
}
|
||||
MO_df <- AMR_env$MO_lookup[, colnames(AMR::microorganisms), drop = FALSE]
|
||||
if (type %like% "full|left|right|inner") {
|
||||
joined <- join_fn(x = x, y = MO_df, by = by, suffix = suffix, ...)
|
||||
} else {
|
||||
joined <- join_fn(x = x, y = MO_df, by = by, ...)
|
||||
}
|
||||
|
||||
if ("join.mo" %in% colnames(joined)) {
|
||||
if ("mo" %in% colnames(joined)) {
|
||||
ind_mo <- which(colnames(joined) %in% c("mo", "join.mo"))
|
||||
colnames(joined)[ind_mo[1L]] <- paste0("mo", suffix[1L])
|
||||
colnames(joined)[ind_mo[2L]] <- paste0("mo", suffix[2L])
|
||||
} else {
|
||||
colnames(joined)[colnames(joined) == "join.mo"] <- "mo"
|
||||
}
|
||||
}
|
||||
|
||||
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
|
||||
warning_("in `", type, "_microorganisms()`: the newly joined data set contains ", nrow(joined) - nrow(x), " rows more than the number of rows of `x`.")
|
||||
}
|
||||
|
||||
as_original_data_class(joined, class(x.bak)) # will remove tibble groups
|
||||
}
|
||||
@@ -1,368 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' (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 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.
|
||||
#' @param gram_negative Names of antibiotic drugs for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs.
|
||||
#' @param gram_positive Names of antibiotic drugs for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antibiotic drugs.
|
||||
#' @param antifungal Names of antifungal drugs for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default antifungal drugs.
|
||||
#' @param only_sir_columns A [logical] to indicate whether only columns must be included that were transformed to class `sir` (see [as.sir()]) on beforehand (default is `FALSE`).
|
||||
#' @param ... Ignored, only in place to allow future extensions.
|
||||
#' @details
|
||||
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that the `x` argument can be left blank if used inside a [data.frame] call, see *Examples*.
|
||||
#'
|
||||
#' The function [key_antimicrobials()] returns a [character] vector with 12 antimicrobial results for every isolate. The function [all_antimicrobials()] returns a [character] vector with all antimicrobial drug results for every isolate. These vectors can then be compared using [antimicrobials_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antimicrobials()] and ignored by [antimicrobials_equal()].
|
||||
#'
|
||||
#' Please see the [first_isolate()] function how these important functions enable the 'phenotype-based' method for determination of first isolates.
|
||||
#'
|
||||
#' The default antimicrobial drugs used for **all rows** (set in `universal`) are:
|
||||
#'
|
||||
#' - Ampicillin
|
||||
#' - Amoxicillin/clavulanic acid
|
||||
#' - Cefuroxime
|
||||
#' - Ciprofloxacin
|
||||
#' - Piperacillin/tazobactam
|
||||
#' - Trimethoprim/sulfamethoxazole
|
||||
#'
|
||||
#' The default antimicrobial drugs used for **Gram-negative bacteria** (set in `gram_negative`) are:
|
||||
#'
|
||||
#' - Cefotaxime
|
||||
#' - Ceftazidime
|
||||
#' - Colistin
|
||||
#' - Gentamicin
|
||||
#' - Meropenem
|
||||
#' - Tobramycin
|
||||
#'
|
||||
#' The default antimicrobial drugs used for **Gram-positive bacteria** (set in `gram_positive`) are:
|
||||
#'
|
||||
#' - Erythromycin
|
||||
#' - Oxacillin
|
||||
#' - Rifampin
|
||||
#' - Teicoplanin
|
||||
#' - Tetracycline
|
||||
#' - Vancomycin
|
||||
#'
|
||||
#' The default antimicrobial drugs used for **fungi** (set in `antifungal`) are:
|
||||
#'
|
||||
#' - Anidulafungin
|
||||
#' - Caspofungin
|
||||
#' - Fluconazole
|
||||
#' - Miconazole
|
||||
#' - Nystatin
|
||||
#' - Voriconazole
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
#' @seealso [first_isolate()]
|
||||
#' @examples
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' # output of the `key_antimicrobials()` function could be like this:
|
||||
#' strainA <- "SSSRR.S.R..S"
|
||||
#' strainB <- "SSSIRSSSRSSS"
|
||||
#'
|
||||
#' # those strings can be compared with:
|
||||
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials")
|
||||
#' # TRUE, because I is ignored (as well as missing values)
|
||||
#'
|
||||
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials", ignore_I = FALSE)
|
||||
#' # FALSE, because I is not ignored and so the 4th [character] differs
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # set key antimicrobials to a new variable
|
||||
#' my_patients <- example_isolates %>%
|
||||
#' mutate(keyab = key_antimicrobials(antifungal = NULL)) %>% # no need to define `x`
|
||||
#' mutate(
|
||||
#' # now calculate first isolates
|
||||
#' first_regular = first_isolate(col_keyantimicrobials = FALSE),
|
||||
#' # and first WEIGHTED isolates
|
||||
#' first_weighted = first_isolate(col_keyantimicrobials = "keyab")
|
||||
#' )
|
||||
#'
|
||||
#' # Check the difference in this data set, 'weighted' results in more isolates:
|
||||
#' sum(my_patients$first_regular, na.rm = TRUE)
|
||||
#' sum(my_patients$first_weighted, na.rm = TRUE)
|
||||
#' }
|
||||
#' }
|
||||
key_antimicrobials <- function(x = NULL,
|
||||
col_mo = NULL,
|
||||
universal = c(
|
||||
"ampicillin", "amoxicillin/clavulanic acid", "cefuroxime",
|
||||
"piperacillin/tazobactam", "ciprofloxacin", "trimethoprim/sulfamethoxazole"
|
||||
),
|
||||
gram_negative = c(
|
||||
"gentamicin", "tobramycin", "colistin",
|
||||
"cefotaxime", "ceftazidime", "meropenem"
|
||||
),
|
||||
gram_positive = c(
|
||||
"vancomycin", "teicoplanin", "tetracycline",
|
||||
"erythromycin", "oxacillin", "rifampin"
|
||||
),
|
||||
antifungal = c(
|
||||
"anidulafungin", "caspofungin", "fluconazole",
|
||||
"miconazole", "nystatin", "voriconazole"
|
||||
),
|
||||
only_sir_columns = FALSE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, allow_NA = TRUE, is_in = colnames(x))
|
||||
meet_criteria(universal, allow_class = "character", allow_NULL = TRUE)
|
||||
meet_criteria(gram_negative, allow_class = "character", allow_NULL = TRUE)
|
||||
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)
|
||||
|
||||
# force regular data.frame, not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
cols <- get_column_abx(x, info = FALSE, only_sir_columns = only_sir_columns, fn = "key_antimicrobials")
|
||||
|
||||
# try to find columns based on type
|
||||
# -- mo
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(x = x, type = "mo", info = FALSE)
|
||||
}
|
||||
if (is.null(col_mo)) {
|
||||
warning_("in `key_antimicrobials()`: no column found for `col_mo`, ignoring antibiotics set in `gram_negative` and `gram_positive`, and antimycotics set in `antifungal`")
|
||||
gramstain <- NA_character_
|
||||
kingdom <- NA_character_
|
||||
} else {
|
||||
x.mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||
gramstain <- mo_gramstain(x.mo, language = NULL)
|
||||
kingdom <- mo_kingdom(x.mo, language = NULL)
|
||||
}
|
||||
|
||||
AMR_string <- function(x, values, name, filter, cols = cols) {
|
||||
if (is.null(values)) {
|
||||
return(rep(NA_character_, length(which(filter))))
|
||||
}
|
||||
|
||||
values_old_length <- length(values)
|
||||
values <- as.ab(values, flag_multiple_results = FALSE, info = FALSE)
|
||||
values <- cols[names(cols) %in% values]
|
||||
values_new_length <- length(values)
|
||||
|
||||
if (values_new_length < values_old_length &&
|
||||
any(filter, na.rm = TRUE) &&
|
||||
message_not_thrown_before("key_antimicrobials", name)) {
|
||||
warning_(
|
||||
"in `key_antimicrobials()`: ",
|
||||
ifelse(values_new_length == 0,
|
||||
"No columns available ",
|
||||
paste0("Only using ", values_new_length, " out of ", values_old_length, " defined columns ")
|
||||
),
|
||||
"as key antimicrobials for ", name, "s. See `?key_antimicrobials`."
|
||||
)
|
||||
}
|
||||
|
||||
generate_antimicrobials_string(x[which(filter), c(universal, values), drop = FALSE])
|
||||
}
|
||||
|
||||
if (is.null(universal)) {
|
||||
universal <- character(0)
|
||||
} else {
|
||||
universal <- as.ab(universal, flag_multiple_results = FALSE, info = FALSE)
|
||||
universal <- cols[names(cols) %in% universal]
|
||||
}
|
||||
|
||||
key_ab <- rep(NA_character_, nrow(x))
|
||||
|
||||
key_ab[which(gramstain == "Gram-negative")] <- AMR_string(
|
||||
x = x,
|
||||
values = gram_negative,
|
||||
name = "Gram-negative",
|
||||
filter = gramstain == "Gram-negative",
|
||||
cols = cols
|
||||
)
|
||||
|
||||
key_ab[which(gramstain == "Gram-positive")] <- AMR_string(
|
||||
x = x,
|
||||
values = gram_positive,
|
||||
name = "Gram-positive",
|
||||
filter = gramstain == "Gram-positive",
|
||||
cols = cols
|
||||
)
|
||||
|
||||
key_ab[which(kingdom == "Fungi")] <- AMR_string(
|
||||
x = x,
|
||||
values = antifungal,
|
||||
name = "antifungal",
|
||||
filter = kingdom == "Fungi",
|
||||
cols = cols
|
||||
)
|
||||
|
||||
# back-up - only use `universal`
|
||||
key_ab[which(is.na(key_ab))] <- AMR_string(
|
||||
x = x,
|
||||
values = character(0),
|
||||
name = "",
|
||||
filter = is.na(key_ab),
|
||||
cols = cols
|
||||
)
|
||||
|
||||
if (length(unique(key_ab)) == 1) {
|
||||
warning_("in `key_antimicrobials()`: no distinct key antibiotics determined.")
|
||||
}
|
||||
|
||||
key_ab
|
||||
}
|
||||
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
all_antimicrobials <- function(x = NULL,
|
||||
only_sir_columns = FALSE,
|
||||
...) {
|
||||
if (is_null_or_grouped_tbl(x)) {
|
||||
# when `x` is left blank, auto determine it (get_current_data() searches underlying data within call)
|
||||
# is also fix for using a grouped df as input (a dot as first argument)
|
||||
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
|
||||
}
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||
|
||||
# force regular data.frame, not a tibble or data.table
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
cols <- get_column_abx(x,
|
||||
only_sir_columns = only_sir_columns, info = FALSE,
|
||||
sort = FALSE, fn = "all_antimicrobials"
|
||||
)
|
||||
|
||||
generate_antimicrobials_string(x[, cols, drop = FALSE])
|
||||
}
|
||||
|
||||
generate_antimicrobials_string <- function(df) {
|
||||
if (NCOL(df) == 0) {
|
||||
return(rep("", NROW(df)))
|
||||
}
|
||||
if (NROW(df) == 0) {
|
||||
return(character(0))
|
||||
}
|
||||
tryCatch(
|
||||
{
|
||||
do.call(
|
||||
paste0,
|
||||
lapply(
|
||||
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)
|
||||
}
|
||||
)
|
||||
)
|
||||
},
|
||||
error = function(e) rep(strrep(".", NCOL(df)), NROW(df))
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname key_antimicrobials
|
||||
#' @export
|
||||
antimicrobials_equal <- function(y,
|
||||
z,
|
||||
type = c("points", "keyantimicrobials"),
|
||||
ignore_I = TRUE,
|
||||
points_threshold = 2,
|
||||
...) {
|
||||
meet_criteria(y, allow_class = "character")
|
||||
meet_criteria(z, allow_class = "character")
|
||||
stop_if(missing(type), "argument \"type\" is missing, with no default")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("points", "keyantimicrobials"))
|
||||
meet_criteria(ignore_I, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
|
||||
|
||||
key2sir <- function(val) {
|
||||
val <- strsplit(val, "", fixed = TRUE)[[1L]]
|
||||
val.int <- rep(NA_real_, length(val))
|
||||
val.int[val == "S"] <- 1
|
||||
val.int[val %in% c("I", "SDD")] <- 2
|
||||
val.int[val == "R"] <- 3
|
||||
val.int
|
||||
}
|
||||
# only run on uniques
|
||||
uniq <- unique(c(y, z))
|
||||
uniq_list <- lapply(uniq, key2sir)
|
||||
names(uniq_list) <- uniq
|
||||
|
||||
y <- uniq_list[match(y, names(uniq_list))]
|
||||
z <- uniq_list[match(z, names(uniq_list))]
|
||||
|
||||
determine_equality <- function(a, b, type, points_threshold, ignore_I) {
|
||||
if (length(a) != length(b)) {
|
||||
# incomparable, so not equal
|
||||
return(FALSE)
|
||||
}
|
||||
# ignore NAs on both sides
|
||||
NA_ind <- which(is.na(a) | is.na(b))
|
||||
a[NA_ind] <- NA_real_
|
||||
b[NA_ind] <- NA_real_
|
||||
|
||||
if (type == "points") {
|
||||
# count points for every single character:
|
||||
# - no change is 0 points
|
||||
# - I <-> S|R is 0.5 point
|
||||
# - S|R <-> R|S is 1 point
|
||||
# use the levels of as.sir (S = 1, I = 2, R = 3)
|
||||
# and divide by 2 (S = 0.5, I = 1, R = 1.5)
|
||||
(sum(abs(a - b), na.rm = TRUE) / 2) < points_threshold
|
||||
} else {
|
||||
if (ignore_I == TRUE) {
|
||||
ind <- which(a == 2 | b == 2) # since as.double(as.sir("I")) == 2
|
||||
a[ind] <- NA_real_
|
||||
b[ind] <- NA_real_
|
||||
}
|
||||
all(a == b, na.rm = TRUE)
|
||||
}
|
||||
}
|
||||
out <- unlist(Map(
|
||||
f = determine_equality,
|
||||
y,
|
||||
z,
|
||||
MoreArgs = list(
|
||||
type = type,
|
||||
points_threshold = points_threshold,
|
||||
ignore_I = ignore_I
|
||||
),
|
||||
USE.NAMES = FALSE
|
||||
))
|
||||
out[is.na(y) | is.na(z)] <- NA
|
||||
out
|
||||
}
|
||||
@@ -1,80 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Kurtosis of the Sample
|
||||
#'
|
||||
#' @description Kurtosis is a measure of the "tailedness" of the probability distribution of a real-valued random variable. A normal distribution has a kurtosis of 3 and a excess kurtosis of 0.
|
||||
#' @param x A vector of values, a [matrix] or a [data.frame].
|
||||
#' @param na.rm A [logical] to indicate whether `NA` values should be stripped before the computation proceeds.
|
||||
#' @param excess A [logical] to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
|
||||
#' @seealso [skewness()]
|
||||
#' @rdname kurtosis
|
||||
#' @export
|
||||
#' @examples
|
||||
#' kurtosis(rnorm(10000))
|
||||
#' kurtosis(rnorm(10000), excess = TRUE)
|
||||
kurtosis <- function(x, na.rm = FALSE, excess = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(excess, allow_class = "logical", has_length = 1)
|
||||
UseMethod("kurtosis")
|
||||
}
|
||||
|
||||
#' @method kurtosis default
|
||||
#' @rdname kurtosis
|
||||
#' @export
|
||||
kurtosis.default <- function(x, na.rm = FALSE, excess = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(excess, allow_class = "logical", has_length = 1)
|
||||
x <- as.vector(x)
|
||||
if (isTRUE(na.rm)) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
n <- length(x)
|
||||
k <- n * sum((x - mean(x, na.rm = na.rm))^4, na.rm = na.rm) /
|
||||
(sum((x - mean(x, na.rm = na.rm))^2, na.rm = na.rm)^2)
|
||||
k - ifelse(excess, 3, 0)
|
||||
}
|
||||
|
||||
#' @method kurtosis matrix
|
||||
#' @rdname kurtosis
|
||||
#' @export
|
||||
kurtosis.matrix <- function(x, na.rm = FALSE, excess = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(excess, allow_class = "logical", has_length = 1)
|
||||
apply(x, 2, kurtosis.default, na.rm = na.rm, excess = excess)
|
||||
}
|
||||
|
||||
#' @method kurtosis data.frame
|
||||
#' @rdname kurtosis
|
||||
#' @export
|
||||
kurtosis.data.frame <- function(x, na.rm = FALSE, excess = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(excess, allow_class = "logical", has_length = 1)
|
||||
vapply(FUN.VALUE = double(1), x, kurtosis.default, na.rm = na.rm, excess = excess)
|
||||
}
|
||||
@@ -1,147 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Vectorised Pattern Matching with Keyboard Shortcut
|
||||
#'
|
||||
#' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
|
||||
#' @param x A [character] vector where matches are sought, or an object which can be coerced by [as.character()] to a [character] vector.
|
||||
#' @param pattern A [character] vector containing regular expressions (or a [character] string for `fixed = TRUE`) to be matched in the given [character] vector. Coerced by [as.character()] to a [character] string if possible.
|
||||
#' @param ignore.case If `FALSE`, the pattern matching is *case sensitive* and if `TRUE`, case is ignored during matching.
|
||||
#' @return A [logical] vector
|
||||
#' @name like
|
||||
#' @rdname like
|
||||
#' @export
|
||||
#' @details
|
||||
#' These [like()] and `%like%`/`%unlike%` functions:
|
||||
#' * Are case-insensitive (use `%like_case%`/`%unlike_case%` for case-sensitive matching)
|
||||
#' * Support multiple patterns
|
||||
#' * Check if `pattern` is a valid regular expression and sets `fixed = TRUE` if not, to greatly improve speed (vectorised over `pattern`)
|
||||
#' * Always use compatibility with Perl unless `fixed = TRUE`, to greatly improve speed
|
||||
#'
|
||||
#' Using RStudio? The `%like%`/`%unlike%` functions can also be directly inserted in your code from the Addins menu and can have its own keyboard shortcut like `Shift+Ctrl+L` or `Shift+Cmd+L` (see menu `Tools` > `Modify Keyboard Shortcuts...`). If you keep pressing your shortcut, the inserted text will be iterated over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%`.
|
||||
#' @source Idea from the [`like` function from the `data.table` package](https://github.com/Rdatatable/data.table/blob/ec1259af1bf13fc0c96a1d3f9e84d55d8106a9a4/R/like.R), although altered as explained in *Details*.
|
||||
#' @seealso [grepl()]
|
||||
|
||||
#' @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
|
||||
#' b %like% a
|
||||
#'
|
||||
#' # also supports multiple patterns
|
||||
#' a <- c("Test case", "Something different", "Yet another thing")
|
||||
#' b <- c("case", "diff", "yet")
|
||||
#' a %like% b
|
||||
#' a %unlike% b
|
||||
#'
|
||||
#' a[1] %like% b
|
||||
#' a %like% b[1]
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # get isolates whose name start with 'Entero' (case-insensitive)
|
||||
#' example_isolates[which(mo_name() %like% "^entero"), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_name() %like% "^ent")
|
||||
#' }
|
||||
#' }
|
||||
like <- function(x, pattern, ignore.case = TRUE) {
|
||||
meet_criteria(x, allow_NA = TRUE)
|
||||
meet_criteria(pattern, allow_NA = FALSE)
|
||||
meet_criteria(ignore.case, allow_class = "logical", has_length = 1)
|
||||
|
||||
if (all(is.na(x))) {
|
||||
return(rep(FALSE, length(x)))
|
||||
}
|
||||
|
||||
# set to fixed if no valid regex (vectorised)
|
||||
fixed <- !is_valid_regex(pattern)
|
||||
|
||||
if (ignore.case == TRUE) {
|
||||
# set here, otherwise if fixed = TRUE, this warning will be thrown: argument `ignore.case = TRUE` will be ignored
|
||||
x <- tolower(x)
|
||||
pattern <- tolower(pattern)
|
||||
}
|
||||
|
||||
if (is.factor(x)) {
|
||||
x <- as.character(x)
|
||||
}
|
||||
|
||||
if (length(pattern) == 1) {
|
||||
grepl(pattern, x, ignore.case = FALSE, fixed = fixed, perl = !fixed)
|
||||
} else {
|
||||
if (length(x) == 1) {
|
||||
x <- rep(x, length(pattern))
|
||||
} else if (length(pattern) != length(x)) {
|
||||
stop_(
|
||||
"arguments `x` and `pattern` must be of same length, or either one must be 1 ",
|
||||
"(`x` has length ", length(x), " and `pattern` has length ", length(pattern), ")"
|
||||
)
|
||||
}
|
||||
unlist(
|
||||
Map(
|
||||
f = grepl,
|
||||
x = x,
|
||||
pattern = pattern,
|
||||
fixed = fixed,
|
||||
perl = !fixed,
|
||||
MoreArgs = list(ignore.case = FALSE),
|
||||
USE.NAMES = FALSE
|
||||
)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%like%" <- function(x, pattern) {
|
||||
like(x, pattern, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%unlike%" <- function(x, pattern) {
|
||||
!like(x, pattern, ignore.case = TRUE)
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%like_case%" <- function(x, pattern) {
|
||||
like(x, pattern, ignore.case = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname like
|
||||
#' @export
|
||||
"%unlike_case%" <- function(x, pattern) {
|
||||
!like(x, pattern, ignore.case = FALSE)
|
||||
}
|
||||
@@ -1,184 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Calculate the Mean AMR Distance
|
||||
#'
|
||||
#' Calculates a normalised mean for antimicrobial resistance between multiple observations, to help to identify similar isolates without comparing antibiograms by hand.
|
||||
#' @param x A vector of class [sir][as.sir()], [mic][as.mic()] or [disk][as.disk()], or a [data.frame] containing columns of any of these classes.
|
||||
#' @param ... Variables to select. Supports [tidyselect language][tidyselect::language] (such as `column1:column4` and `where(is.mic)`), and can thus also be [antimicrobial selectors][amr_selector()].
|
||||
#' @param 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))`.
|
||||
#'
|
||||
#' SIR values (see [as.sir()]) are transformed using `"S"` = 1, `"I"` = 2, and `"R"` = 3. If `combine_SI` is `TRUE` (default), the `"I"` will be considered to be 1.
|
||||
#'
|
||||
#' For data sets, the mean AMR distance will be calculated per column, after which the mean per row will be returned, see *Examples*.
|
||||
#'
|
||||
#' Use [amr_distance_from_row()] to subtract distances from the distance of one row, see *Examples*.
|
||||
#' @section Interpretation:
|
||||
#' Isolates with distances less than 0.01 difference from each other should be considered similar. Differences lower than 0.025 should be considered suspicious.
|
||||
#' @export
|
||||
#' @examples
|
||||
#' sir <- random_sir(10)
|
||||
#' sir
|
||||
#' mean_amr_distance(sir)
|
||||
#'
|
||||
#' mic <- random_mic(10)
|
||||
#' mic
|
||||
#' mean_amr_distance(mic)
|
||||
#' # equal to the Z-score of their log2:
|
||||
#' (log2(mic) - mean(log2(mic))) / sd(log2(mic))
|
||||
#'
|
||||
#' disk <- random_disk(10)
|
||||
#' disk
|
||||
#' mean_amr_distance(disk)
|
||||
#'
|
||||
#' y <- data.frame(
|
||||
#' id = LETTERS[1:10],
|
||||
#' amox = random_sir(10, ab = "amox", mo = "Escherichia coli"),
|
||||
#' cipr = random_disk(10, ab = "cipr", mo = "Escherichia coli"),
|
||||
#' gent = random_mic(10, ab = "gent", mo = "Escherichia coli"),
|
||||
#' tobr = random_mic(10, ab = "tobr", mo = "Escherichia coli")
|
||||
#' )
|
||||
#' y
|
||||
#' mean_amr_distance(y)
|
||||
#' y$amr_distance <- mean_amr_distance(y, is.mic(y))
|
||||
#' y[order(y$amr_distance), ]
|
||||
#'
|
||||
#' if (require("dplyr")) {
|
||||
#' y %>%
|
||||
#' mutate(
|
||||
#' amr_distance = mean_amr_distance(y),
|
||||
#' check_id_C = amr_distance_from_row(amr_distance, id == "C")
|
||||
#' ) %>%
|
||||
#' arrange(check_id_C)
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # support for groups
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_genus() == "Enterococcus" & mo_species() != "") %>%
|
||||
#' select(mo, TCY, carbapenems()) %>%
|
||||
#' group_by(mo) %>%
|
||||
#' mutate(dist = mean_amr_distance(.)) %>%
|
||||
#' arrange(mo, dist)
|
||||
#' }
|
||||
mean_amr_distance <- function(x, ...) {
|
||||
UseMethod("mean_amr_distance")
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @export
|
||||
mean_amr_distance.default <- function(x, ...) {
|
||||
x <- as.double(x)
|
||||
# calculate z-score
|
||||
(x - mean(x, na.rm = TRUE)) / stats::sd(x, na.rm = TRUE)
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @export
|
||||
mean_amr_distance.mic <- function(x, ...) {
|
||||
mean_amr_distance(log2(x))
|
||||
}
|
||||
|
||||
#' @noRd
|
||||
#' @export
|
||||
mean_amr_distance.disk <- function(x, ...) {
|
||||
mean_amr_distance(as.double(x))
|
||||
}
|
||||
|
||||
#' @rdname mean_amr_distance
|
||||
#' @export
|
||||
mean_amr_distance.sir <- function(x, ..., combine_SI = TRUE) {
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = -1)
|
||||
if (isTRUE(combine_SI)) {
|
||||
x[x %in% c("I", "SDD")] <- "S"
|
||||
}
|
||||
mean_amr_distance(as.double(x))
|
||||
}
|
||||
|
||||
#' @rdname mean_amr_distance
|
||||
#' @export
|
||||
mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) {
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = -1)
|
||||
df <- x
|
||||
if (is_null_or_grouped_tbl(df)) {
|
||||
df <- get_current_data("x", -2)
|
||||
}
|
||||
df <- as.data.frame(df, stringsAsFactors = FALSE)
|
||||
if (tryCatch(length(list(...)) > 0, error = function(e) TRUE)) {
|
||||
out <- tryCatch(suppressWarnings(c(...)), error = function(e) NULL)
|
||||
if (!is.null(out)) {
|
||||
df <- df[, out, drop = FALSE]
|
||||
} else {
|
||||
df <- pm_select(df, ...)
|
||||
}
|
||||
}
|
||||
df_classes <- colnames(df)[vapply(FUN.VALUE = logical(1), df, function(x) is.disk(x) | is.mic(x) | is.disk(x), USE.NAMES = FALSE)]
|
||||
df_antibiotics <- unname(get_column_abx(df, info = FALSE))
|
||||
df <- df[, colnames(df)[colnames(df) %in% union(df_classes, df_antibiotics)], drop = FALSE]
|
||||
|
||||
stop_if(ncol(df) < 2,
|
||||
"data set must contain at least two variables",
|
||||
call = -2
|
||||
)
|
||||
if (message_not_thrown_before("mean_amr_distance", "groups")) {
|
||||
message_("Calculating mean AMR distance based on columns ", vector_and(colnames(df), sort = FALSE))
|
||||
}
|
||||
|
||||
res <- vapply(
|
||||
FUN.VALUE = double(nrow(df)),
|
||||
df,
|
||||
mean_amr_distance,
|
||||
combine_SI = combine_SI
|
||||
)
|
||||
if (is.null(dim(res))) {
|
||||
if (all(is.na(res))) {
|
||||
return(NA_real_)
|
||||
} else {
|
||||
return(mean(res, na.rm = TRUE))
|
||||
}
|
||||
}
|
||||
res <- rowMeans(res, na.rm = TRUE)
|
||||
res[is.infinite(res) | is.nan(res)] <- 0
|
||||
res
|
||||
}
|
||||
|
||||
#' @rdname mean_amr_distance
|
||||
#' @param amr_distance The outcome of [mean_amr_distance()].
|
||||
#' @param row An index, such as a row number.
|
||||
#' @export
|
||||
amr_distance_from_row <- function(amr_distance, row) {
|
||||
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)
|
||||
}
|
||||
abs(amr_distance[row] - amr_distance)
|
||||
}
|
||||
@@ -1,679 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# 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(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)
|
||||
#'
|
||||
#' This transforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
|
||||
#' @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)))`).
|
||||
#'
|
||||
#' This class for MIC values is a quite a special data type: formally it is an ordered [factor] with valid MIC values as [factor] levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
|
||||
#'
|
||||
#' ```
|
||||
#' x <- random_mic(10)
|
||||
#' x
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 1 8 8 64 >=128 0.0625 32 32 16
|
||||
#'
|
||||
#' is.factor(x)
|
||||
#' #> [1] TRUE
|
||||
#'
|
||||
#' x[1] * 2
|
||||
#' #> [1] 32
|
||||
#'
|
||||
#' median(x)
|
||||
#' #> [1] 26
|
||||
#' ```
|
||||
#'
|
||||
#' This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using [numeric] values in data analysis, e.g.:
|
||||
#'
|
||||
#' ```
|
||||
#' x[x > 4]
|
||||
#' #> Class 'mic'
|
||||
#' #> [1] 16 8 8 64 >=128 32 32 16
|
||||
#'
|
||||
#' df <- data.frame(x, hospital = "A")
|
||||
#' subset(df, x > 4) # or with dplyr: df %>% filter(x > 4)
|
||||
#' #> x hospital
|
||||
#' #> 1 16 A
|
||||
#' #> 5 64 A
|
||||
#' #> 6 >=128 A
|
||||
#' #> 8 32 A
|
||||
#' #> 9 32 A
|
||||
#' #> 10 16 A
|
||||
#' ```
|
||||
#'
|
||||
#' All so-called [group generic functions][groupGeneric()] are implemented for the MIC class (such as `!`, `!=`, `<`, `>=`, [exp()], [log2()]). Some mathematical functions 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).
|
||||
#'
|
||||
#' The function [is.mic()] detects if the input contains class `mic`. If the input is a [data.frame] or [list], it iterates over all columns/items and returns a [logical] vector.
|
||||
#'
|
||||
#' Use [droplevels()] to drop unused levels. At default, it will return a plain factor. Use `droplevels(..., as.mic = TRUE)` to maintain the `mic` class.
|
||||
#'
|
||||
#' 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()]
|
||||
#' @examples
|
||||
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
||||
#' mic_data
|
||||
#' is.mic(mic_data)
|
||||
#'
|
||||
#' # this can also coerce combined MIC/SIR values:
|
||||
#' as.mic("<=0.002; S")
|
||||
#'
|
||||
#' # mathematical processing treats MICs as numeric values
|
||||
#' fivenum(mic_data)
|
||||
#' 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),
|
||||
#' mo = as.mo("Streptococcus pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#' guideline = "EUCAST"
|
||||
#' )
|
||||
#' as.sir(
|
||||
#' x = as.mic(c(0.01, 2, 4, 8)),
|
||||
#' mo = as.mo("Streptococcus pneumoniae"),
|
||||
#' ab = "AMX",
|
||||
#' guideline = "EUCAST"
|
||||
#' )
|
||||
#'
|
||||
#' # plot MIC values, see ?plot
|
||||
#' plot(mic_data)
|
||||
#' plot(mic_data, mo = "E. coli", ab = "cipro")
|
||||
#'
|
||||
#' if (require("ggplot2")) {
|
||||
#' autoplot(mic_data, mo = "E. coli", ab = "cipro")
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' autoplot(mic_data, mo = "E. coli", ab = "cipro", language = "nl") # Dutch
|
||||
#' }
|
||||
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) && (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)
|
||||
}
|
||||
|
||||
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)
|
||||
if (any(x %like% "[0-9]/.*[0-9]", na.rm = TRUE)) {
|
||||
warning_("Some MICs were combined values, only the first values are kept")
|
||||
x[x %like% "[0-9]/.*[0-9]"] <- gsub("/.*", "", x[x %like% "[0-9]/.*[0-9]"])
|
||||
}
|
||||
# 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 operators and remove them from input
|
||||
x_operators <- 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 operators again
|
||||
x <- paste0(x_operators, 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")
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @export
|
||||
is.mic <- function(x) {
|
||||
if (identical(typeof(x), "list")) {
|
||||
unname(vapply(FUN.VALUE = logical(1), x, is.mic))
|
||||
} else {
|
||||
isTRUE(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),
|
||||
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
|
||||
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(unique(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
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.double.mic <- function(x, ...) {
|
||||
as.double(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
||||
}
|
||||
|
||||
#' @method as.numeric mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.numeric.mic <- function(x, ...) {
|
||||
as.numeric(gsub("[<=>]+", "", as.character(x), perl = TRUE))
|
||||
}
|
||||
|
||||
#' @rdname as.mic
|
||||
#' @method droplevels mic
|
||||
#' @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")
|
||||
}
|
||||
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)
|
||||
# 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, ...) {
|
||||
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'")
|
||||
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)) {
|
||||
cat(font_silver(paste0("(NA ", class(att$na.action), ": ", paste0(att$na.action, collapse = ", "), ")\n")))
|
||||
}
|
||||
}
|
||||
|
||||
#' @method summary mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
summary.mic <- function(object, ...) {
|
||||
summary(as.double(object), ...)
|
||||
}
|
||||
|
||||
#' @method as.matrix mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
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()
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [[ mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.mic" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [<- mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method [[<- mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
as.mic(y)
|
||||
}
|
||||
#' @method c mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.mic <- function(...) {
|
||||
as.mic(unlist(lapply(list(...), as.character)))
|
||||
}
|
||||
|
||||
#' @method unique mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
unique.mic <- function(x, incomparables = FALSE, ...) {
|
||||
y <- NextMethod()
|
||||
as.mic(y)
|
||||
}
|
||||
|
||||
#' @method rep mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
rep.mic <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
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) {
|
||||
x[order(-dbl)]
|
||||
} else {
|
||||
x[order(dbl)]
|
||||
}
|
||||
}
|
||||
|
||||
#' @method hist mic
|
||||
#' @importFrom graphics hist
|
||||
#' @export
|
||||
#' @noRd
|
||||
hist.mic <- function(x, ...) {
|
||||
warning_("in `hist()`: use `plot()` or ggplot2's `autoplot()` for optimal plotting of MIC values")
|
||||
hist(log2(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),
|
||||
p25 = ~ stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE),
|
||||
p50 = ~ stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE),
|
||||
p75 = ~ stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE),
|
||||
p100 = ~ stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
|
||||
hist = ~ skimr::inline_hist(log2(stats::na.omit(.)), 5)
|
||||
)
|
||||
}
|
||||
|
||||
# Miscellaneous mathematical functions ------------------------------------
|
||||
|
||||
#' @method mean mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
mean.mic <- function(x, trim = 0, na.rm = FALSE, ...) {
|
||||
mean(as.double(x), trim = trim, na.rm = na.rm, ...)
|
||||
}
|
||||
|
||||
#' @method median mic
|
||||
#' @importFrom stats median
|
||||
#' @export
|
||||
#' @noRd
|
||||
median.mic <- function(x, na.rm = FALSE, ...) {
|
||||
median(as.double(x), na.rm = na.rm, ...)
|
||||
}
|
||||
|
||||
#' @method quantile mic
|
||||
#' @importFrom stats quantile
|
||||
#' @export
|
||||
#' @noRd
|
||||
quantile.mic <- function(x, probs = seq(0, 1, 0.25), na.rm = FALSE,
|
||||
names = TRUE, type = 7, ...) {
|
||||
quantile(as.double(x), probs = probs, na.rm = na.rm, names = names, type = type, ...)
|
||||
}
|
||||
|
||||
# Math (see ?groupGeneric) ------------------------------------------------
|
||||
|
||||
#' @export
|
||||
Math.mic <- function(x, ...) {
|
||||
x <- as.double(x)
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(x)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
|
||||
# Ops (see ?groupGeneric) -------------------------------------------------
|
||||
|
||||
#' @export
|
||||
Ops.mic <- function(e1, e2) {
|
||||
e1_chr <- as.character(e1)
|
||||
e2_chr <- character(0)
|
||||
e1 <- as.double(e1)
|
||||
if (!missing(e2)) {
|
||||
# when .Generic is `!`, e2 is missing
|
||||
e2_chr <- as.character(e2)
|
||||
e2 <- as.double(e2)
|
||||
}
|
||||
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)
|
||||
}
|
||||
|
||||
# Complex (see ?groupGeneric) ---------------------------------------------
|
||||
|
||||
#' @export
|
||||
Complex.mic <- function(z) {
|
||||
z <- as.double(z)
|
||||
# set class to numeric, because otherwise NextMethod will be factor (since mic is a factor)
|
||||
.Class <- class(z)
|
||||
NextMethod(.Generic)
|
||||
}
|
||||
|
||||
# Summary (see ?groupGeneric) ---------------------------------------------
|
||||
|
||||
#' @export
|
||||
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
|
||||
)
|
||||
}
|
||||
@@ -1,130 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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.
|
||||
#' @param x Any user input value(s).
|
||||
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms].
|
||||
#' @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, 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:
|
||||
#'
|
||||
#' \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:
|
||||
#'
|
||||
#' * \eqn{x} is the user input;
|
||||
#' * \eqn{n} is a taxonomic name (genus, species, and subspecies);
|
||||
#' * \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, 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.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,
|
||||
#'
|
||||
#' - 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_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.
|
||||
#'
|
||||
#' All matches are sorted descending on their matching score and for all user input values, the top match will be returned. This will lead to the effect that e.g., `"E. coli"` will return the microbial ID of *Escherichia coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Escherichia coli"), 3)`}, a highly prevalent microorganism found in humans) and not *Entamoeba coli* (\eqn{m = `r round(mo_matching_score("E. coli", "Entamoeba coli"), 3)`}, a less prevalent microorganism in humans), although the latter would alphabetically come first.
|
||||
#' @export
|
||||
#' @inheritSection AMR Download Our Reference Data
|
||||
#' @examples
|
||||
#' mo_reset_session()
|
||||
#'
|
||||
#' as.mo("E. coli")
|
||||
#' mo_uncertainties()
|
||||
#'
|
||||
#' mo_matching_score(
|
||||
#' x = "E. coli",
|
||||
#' n = c("Escherichia coli", "Entamoeba coli")
|
||||
#' )
|
||||
mo_matching_score <- function(x, n) {
|
||||
meet_criteria(x, allow_class = c("character", "data.frame", "list"))
|
||||
meet_criteria(n, allow_class = "character")
|
||||
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
x <- parse_and_convert(x)
|
||||
# no dots and other non-whitespace characters
|
||||
x <- gsub("[^a-zA-Z0-9 \\(\\)]+", "", x)
|
||||
|
||||
# only keep one space
|
||||
x <- gsub(" +", " ", x)
|
||||
|
||||
# force a capital letter, so this conversion will not count as a substitution
|
||||
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
|
||||
|
||||
# n is always a taxonomically valid full name
|
||||
if (length(n) == 1) {
|
||||
n <- rep(n, length(x))
|
||||
}
|
||||
if (length(x) == 1) {
|
||||
x <- rep(x, length(n))
|
||||
}
|
||||
|
||||
# length of fullname
|
||||
l_n <- nchar(n)
|
||||
lev <- double(length = length(x))
|
||||
l_n.lev <- double(length = length(x))
|
||||
# get Levenshtein distance
|
||||
lev <- unlist(Map(f = function(a, b) {
|
||||
as.double(utils::adist(a, b,
|
||||
ignore.case = FALSE,
|
||||
fixed = TRUE,
|
||||
costs = c(insertions = 1, deletions = 2, substitutions = 2),
|
||||
counts = FALSE
|
||||
))
|
||||
}, x, n, USE.NAMES = FALSE))
|
||||
|
||||
l_n.lev[l_n < lev] <- l_n[l_n < lev]
|
||||
l_n.lev[lev < l_n] <- lev[lev < l_n]
|
||||
l_n.lev[lev == l_n] <- lev[lev == l_n]
|
||||
|
||||
# human pathogenic prevalence (1 to 3), see ?as.mo
|
||||
p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
|
||||
# kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
|
||||
k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
|
||||
|
||||
# matching score:
|
||||
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
|
||||
}
|
||||
-1052
File diff suppressed because it is too large
Load Diff
-330
@@ -1,330 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' User-Defined Reference Data Set for Microorganisms
|
||||
#'
|
||||
#' @description These functions can be used to predefine your own reference to be used in [as.mo()] and consequently all [`mo_*`][mo_property()] functions (such as [mo_genus()] and [mo_gramstain()]).
|
||||
#'
|
||||
#' This is **the fastest way** to have your organisation (or analysis) specific codes picked up and translated by this package, since you don't have to bother about it again after setting it up once.
|
||||
#' @param path Location of your reference file, this can be any text file (comma-, tab- or pipe-separated) or an Excel file (see *Details*). Can also be `""`, `NULL` or `FALSE` to delete the reference file.
|
||||
#' @param destination Destination of the compressed data file - the default is the user's home directory.
|
||||
#' @rdname mo_source
|
||||
#' @name mo_source
|
||||
#' @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_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.
|
||||
#'
|
||||
#' The function [get_mo_source()] will return the data set by reading `"mo_source.rds"` with [readRDS()]. If the original file has changed (by checking the location and timestamp of the original file), it will call [set_mo_source()] to update the data file automatically if used in an interactive session.
|
||||
#'
|
||||
#' Reading an Excel file (`.xlsx`) with only one row has a size of 8-9 kB. The compressed file created with [set_mo_source()] will then have a size of 0.1 kB and can be read by [get_mo_source()] in only a couple of microseconds (millionths of a second).
|
||||
#'
|
||||
#' @section How to Setup:
|
||||
#'
|
||||
#' Imagine this data on a sheet of an Excel file. The first column contains the organisation specific codes, the second column contains valid taxonomic names:
|
||||
#'
|
||||
#' ```
|
||||
#' | A | B |
|
||||
#' --|--------------------|-----------------------|
|
||||
#' 1 | Organisation XYZ | mo |
|
||||
#' 2 | lab_mo_ecoli | Escherichia coli |
|
||||
#' 3 | lab_mo_kpneumoniae | Klebsiella pneumoniae |
|
||||
#' 4 | | |
|
||||
#' ```
|
||||
#'
|
||||
#' We save it as `"/Users/me/Documents/ourcodes.xlsx"`. Now we have to set it as a source:
|
||||
#'
|
||||
#' ```
|
||||
#' 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"
|
||||
#' ```
|
||||
#'
|
||||
#' It has now created a file `"~/mo_source.rds"` with the contents of our Excel file. Only the first column with foreign values and the 'mo' column will be kept when creating the RDS file.
|
||||
#'
|
||||
#' And now we can use it in our functions:
|
||||
#'
|
||||
#' ```
|
||||
#' as.mo("lab_mo_ecoli")
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_mo_kpneumoniae")
|
||||
#' #> [1] "Klebsiella"
|
||||
#'
|
||||
#' # other input values still work too
|
||||
#' as.mo(c("Escherichia coli", "E. coli", "lab_mo_ecoli"))
|
||||
#' #> NOTE: Translation to one microorganism was guessed with uncertainty.
|
||||
#' #> Use mo_uncertainties() to review it.
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI B_ESCHR_COLI B_ESCHR_COLI
|
||||
#' ```
|
||||
#'
|
||||
#' If we edit the Excel file by, let's say, adding row 4 like this:
|
||||
#'
|
||||
#' ```
|
||||
#' | A | B |
|
||||
#' --|--------------------|-----------------------|
|
||||
#' 1 | Organisation XYZ | mo |
|
||||
#' 2 | lab_mo_ecoli | Escherichia coli |
|
||||
#' 3 | lab_mo_kpneumoniae | Klebsiella pneumoniae |
|
||||
#' 4 | lab_Staph_aureus | Staphylococcus aureus |
|
||||
#' 5 | | |
|
||||
#' ```
|
||||
#'
|
||||
#' ...any new usage of an MO function in this package will update your data file:
|
||||
#'
|
||||
#' ```
|
||||
#' as.mo("lab_mo_ecoli")
|
||||
#' #> NOTE: Updated mo_source file '/Users/me/mo_source.rds' (0.3 kB) from
|
||||
#' #> '/Users/me/Documents/ourcodes.xlsx' (9 kB), columns
|
||||
#' #> "Organisation XYZ" and "mo"
|
||||
#' #> Class 'mo'
|
||||
#' #> [1] B_ESCHR_COLI
|
||||
#'
|
||||
#' mo_genus("lab_Staph_aureus")
|
||||
#' #> [1] "Staphylococcus"
|
||||
#' ```
|
||||
#'
|
||||
#' To delete the reference data file, just use `""`, `NULL` or `FALSE` as input for [set_mo_source()]:
|
||||
#'
|
||||
#' ```
|
||||
#' set_mo_source(NULL)
|
||||
#' #> Removed mo_source file '/Users/me/mo_source.rds'
|
||||
#' ```
|
||||
#'
|
||||
#' 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)
|
||||
|
||||
if (is.null(path) || path %in% c(FALSE, "")) {
|
||||
AMR_env$mo_source <- NULL
|
||||
if (file.exists(mo_source_destination)) {
|
||||
unlink(mo_source_destination)
|
||||
message_("Removed mo_source file '", font_bold(mo_source_destination), "'",
|
||||
add_fn = font_red,
|
||||
as_note = FALSE
|
||||
)
|
||||
}
|
||||
return(invisible())
|
||||
}
|
||||
|
||||
stop_ifnot(file.exists(path), "file not found: ", path)
|
||||
|
||||
df <- NULL
|
||||
if (path %like% "[.]rds$") {
|
||||
df <- readRDS_AMR(path)
|
||||
} else if (path %like% "[.]xlsx?$") {
|
||||
# is Excel file (old or new)
|
||||
stop_ifnot_installed("readxl")
|
||||
df <- readxl::read_excel(path)
|
||||
} else if (path %like% "[.]tsv$") {
|
||||
df <- utils::read.table(file = path, header = TRUE, sep = "\t", stringsAsFactors = FALSE)
|
||||
} else if (path %like% "[.]csv$") {
|
||||
df <- utils::read.table(file = path, header = TRUE, sep = ",", stringsAsFactors = FALSE)
|
||||
} else {
|
||||
# try comma first
|
||||
try(
|
||||
df <- utils::read.table(file = path, header = TRUE, sep = ",", stringsAsFactors = FALSE),
|
||||
silent = TRUE
|
||||
)
|
||||
if (!check_validity_mo_source(df, stop_on_error = FALSE)) {
|
||||
# try tab
|
||||
try(
|
||||
df <- utils::read.table(file = path, header = TRUE, sep = "\t", stringsAsFactors = FALSE),
|
||||
silent = TRUE
|
||||
)
|
||||
}
|
||||
if (!check_validity_mo_source(df, stop_on_error = FALSE)) {
|
||||
# try pipe
|
||||
try(
|
||||
df <- utils::read.table(file = path, header = TRUE, sep = "|", stringsAsFactors = FALSE),
|
||||
silent = TRUE
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
# check integrity
|
||||
if (is.null(df)) {
|
||||
stop_("the path '", path, "' could not be imported as a dataset.")
|
||||
}
|
||||
check_validity_mo_source(df)
|
||||
|
||||
df <- subset(df, !is.na(mo))
|
||||
|
||||
# keep only first two columns, second must be mo
|
||||
if (colnames(df)[1] == "mo") {
|
||||
df <- df[, c(colnames(df)[2], "mo")]
|
||||
} else {
|
||||
df <- df[, c(colnames(df)[1], "mo")]
|
||||
}
|
||||
|
||||
df <- as.data.frame(df, stringAsFactors = FALSE)
|
||||
df[, "mo"] <- as.mo(df[, "mo", drop = TRUE])
|
||||
|
||||
# success
|
||||
if (file.exists(mo_source_destination)) {
|
||||
action <- "Updated"
|
||||
} else {
|
||||
action <- "Created"
|
||||
# only ask when file is created, not when it is updated
|
||||
txt <- paste0(
|
||||
word_wrap(paste0(
|
||||
"This will write create the new file '",
|
||||
mo_source_destination,
|
||||
"', for which your permission is required."
|
||||
)),
|
||||
"\n\n",
|
||||
word_wrap("Do you agree that this file will be created?")
|
||||
)
|
||||
showQuestion <- import_fn("showQuestion", "rstudioapi", error_on_fail = FALSE)
|
||||
if (!is.null(showQuestion)) {
|
||||
q_continue <- showQuestion("Create new file", txt)
|
||||
} else {
|
||||
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
|
||||
}
|
||||
if (q_continue %in% c(FALSE, 2)) {
|
||||
return(invisible())
|
||||
}
|
||||
}
|
||||
attr(df, "mo_source_location") <- path
|
||||
attr(df, "mo_source_destination") <- mo_source_destination
|
||||
attr(df, "mo_source_timestamp") <- file.mtime(path)
|
||||
saveRDS(df, mo_source_destination)
|
||||
AMR_env$mo_source <- df
|
||||
message_(
|
||||
action, " mo_source file '", font_bold(mo_source_destination),
|
||||
"' (", formatted_filesize(mo_source_destination),
|
||||
") from '", font_bold(path),
|
||||
"' (", formatted_filesize(path),
|
||||
'), columns "', colnames(df)[1], '" and "', colnames(df)[2], '"'
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname mo_source
|
||||
#' @export
|
||||
get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.rds")) {
|
||||
if (!file.exists(path.expand(destination))) {
|
||||
if (interactive()) {
|
||||
# source file might have been deleted, so update reference
|
||||
set_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))
|
||||
}
|
||||
|
||||
old_time <- attributes(AMR_env$mo_source)$mo_source_timestamp
|
||||
new_time <- file.mtime(attributes(AMR_env$mo_source)$mo_source_location)
|
||||
if (interactive() && !identical(old_time, new_time)) {
|
||||
# source file was updated, also update reference
|
||||
set_mo_source(attributes(AMR_env$mo_source)$mo_source_location)
|
||||
}
|
||||
AMR_env$mo_source
|
||||
}
|
||||
|
||||
check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
|
||||
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
|
||||
return(TRUE)
|
||||
}
|
||||
if (is.null(AMR_env$mo_source) && (identical(x, get_mo_source()))) {
|
||||
return(TRUE)
|
||||
}
|
||||
if (is.null(x)) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " cannot be NULL", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (!is.data.frame(x)) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " must be a data.frame", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (!"mo" %in% colnames(x)) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " must contain a column 'mo'", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (!all(x$mo %in% c("", AMR_env$MO_lookup$mo, AMR_env$MO_lookup$fullname), na.rm = TRUE)) {
|
||||
if (stop_on_error == TRUE) {
|
||||
invalid <- x[which(!x$mo %in% c("", AMR_env$MO_lookup$mo, AMR_env$MO_lookup$fullname)), , drop = FALSE]
|
||||
if (nrow(invalid) > 1) {
|
||||
plural <- "s"
|
||||
} else {
|
||||
plural <- ""
|
||||
}
|
||||
stop_("Value", plural, " ", vector_and(invalid[, 1, drop = TRUE], quotes = TRUE),
|
||||
" found in ", tolower(refer_to_name),
|
||||
", but with invalid microorganism code", plural, " ", vector_and(invalid$mo, quotes = TRUE),
|
||||
call = FALSE
|
||||
)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (colnames(x)[1] != "mo" && nrow(x) > length(unique(x[, 1, drop = TRUE]))) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[1], "'", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
if (colnames(x)[2] != "mo" && nrow(x) > length(unique(x[, 2, drop = TRUE]))) {
|
||||
if (stop_on_error == TRUE) {
|
||||
stop_(refer_to_name, " contains duplicate values in column '", colnames(x)[2], "'", call = FALSE)
|
||||
} else {
|
||||
return(FALSE)
|
||||
}
|
||||
}
|
||||
return(TRUE)
|
||||
}
|
||||
@@ -1,183 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Principal Component Analysis (for AMR)
|
||||
#'
|
||||
#' Performs a principal component analysis (PCA) based on a data set with automatic determination for afterwards plotting the groups and labels, and automatic filtering on only suitable (i.e. non-empty and numeric) variables.
|
||||
#' @param x A [data.frame] containing [numeric] columns.
|
||||
#' @param ... Columns of `x` to be selected for PCA, can be unquoted since it supports quasiquotation.
|
||||
#' @inheritParams stats::prcomp
|
||||
#' @details The [pca()] function takes a [data.frame] as input and performs the actual PCA with the \R function [prcomp()].
|
||||
#'
|
||||
#' The result of the [pca()] function is a [prcomp] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain [numeric] values. These are probably the groups and labels, and will be used by [ggplot_pca()].
|
||||
#' @return An object of classes [pca] and [prcomp]
|
||||
#' @importFrom stats prcomp
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # `example_isolates` is a data set available in the AMR package.
|
||||
#' # See ?example_isolates.
|
||||
#'
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' # calculate the resistance per group first
|
||||
#' resistance_data <- example_isolates %>%
|
||||
#' group_by(
|
||||
#' order = mo_order(mo), # group on anything, like order
|
||||
#' genus = mo_genus(mo)
|
||||
#' ) %>% # and genus as we do here;
|
||||
#' filter(n() >= 30) %>% # filter on only 30 results per group
|
||||
#' summarise_if(is.sir, resistance) # then get resistance of all drugs
|
||||
#'
|
||||
#' # now conduct PCA for certain antimicrobial drugs
|
||||
#' pca_result <- resistance_data %>%
|
||||
#' pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, SXT)
|
||||
#'
|
||||
#' pca_result
|
||||
#' summary(pca_result)
|
||||
#' # old base R plotting method:
|
||||
#' biplot(pca_result)
|
||||
#' }
|
||||
#'
|
||||
#' # new ggplot2 plotting method using this package:
|
||||
#' if (require("dplyr") && require("ggplot2")) {
|
||||
#' ggplot_pca(pca_result)
|
||||
#' }
|
||||
#' if (require("dplyr") && require("ggplot2")) {
|
||||
#' ggplot_pca(pca_result) +
|
||||
#' scale_colour_viridis_d() +
|
||||
#' labs(title = "Title here")
|
||||
#' }
|
||||
#' }
|
||||
pca <- function(x,
|
||||
...,
|
||||
retx = TRUE,
|
||||
center = TRUE,
|
||||
scale. = TRUE,
|
||||
tol = NULL,
|
||||
rank. = NULL) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(retx, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(center, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(scale., allow_class = "logical", has_length = 1)
|
||||
meet_criteria(tol, allow_class = "numeric", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(rank., allow_class = "numeric", has_length = 1, allow_NULL = TRUE)
|
||||
|
||||
# unset data.table, tibble, etc.
|
||||
# also removes groups made by dplyr::group_by
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
x.bak <- x
|
||||
|
||||
# defuse R expressions, this replaces rlang::enquos()
|
||||
dots <- substitute(list(...))
|
||||
if (length(dots) > 1) {
|
||||
new_list <- list(0)
|
||||
for (i in seq_len(length(dots) - 1)) {
|
||||
new_list[[i]] <- tryCatch(eval(dots[[i + 1]], envir = x),
|
||||
error = function(e) stop(e$message, call. = FALSE)
|
||||
)
|
||||
if (length(new_list[[i]]) == 1) {
|
||||
if (is.character(new_list[[i]]) && new_list[[i]] %in% colnames(x)) {
|
||||
# this is to support quoted variables: df %pm>% pca("mycol1", "mycol2")
|
||||
new_list[[i]] <- x[, new_list[[i]]]
|
||||
} else {
|
||||
# remove item - it's an argument like `center`
|
||||
new_list[[i]] <- NULL
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
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)
|
||||
}
|
||||
|
||||
# set column names
|
||||
tryCatch(colnames(x) <- as.character(dots)[2:length(dots)],
|
||||
error = function(e) warning("column names could not be set")
|
||||
)
|
||||
|
||||
# keep only numeric columns
|
||||
x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y)), drop = FALSE]
|
||||
# bind the data set with the non-numeric columns
|
||||
x <- cbind(x.bak[, vapply(FUN.VALUE = logical(1), x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x)
|
||||
}
|
||||
|
||||
x <- pm_ungroup(x) # would otherwise select the grouping vars
|
||||
x <- x[rowSums(is.na(x)) == 0, ] # remove columns containing NAs
|
||||
|
||||
pca_data <- x[, which(vapply(FUN.VALUE = logical(1), x, function(x) is.numeric(x))), drop = FALSE]
|
||||
|
||||
message_(
|
||||
"Columns selected for PCA: ", vector_and(font_bold(colnames(pca_data), collapse = NULL), quotes = TRUE),
|
||||
". Total observations available: ", nrow(pca_data), "."
|
||||
)
|
||||
|
||||
if (getRversion() < "3.4.0") {
|
||||
# stats::prcomp prior to 3.4.0 does not have the 'rank.' argument
|
||||
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol)
|
||||
} else {
|
||||
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol, rank. = rank.)
|
||||
}
|
||||
groups <- x[, vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE]
|
||||
rownames(groups) <- NULL
|
||||
attr(pca_model, "non_numeric_cols") <- groups
|
||||
class(pca_model) <- c("pca", class(pca_model))
|
||||
pca_model
|
||||
}
|
||||
|
||||
#' @method print pca
|
||||
#' @export
|
||||
#' @noRd
|
||||
print.pca <- function(x, ...) {
|
||||
a <- attributes(x)$non_numeric_cols
|
||||
if (!is.null(a)) {
|
||||
print_pca_group(a)
|
||||
class(x) <- class(x)[class(x) != "pca"]
|
||||
}
|
||||
print(x, ...)
|
||||
}
|
||||
|
||||
#' @method summary pca
|
||||
#' @export
|
||||
#' @noRd
|
||||
summary.pca <- function(object, ...) {
|
||||
a <- attributes(object)$non_numeric_cols
|
||||
if (!is.null(a)) {
|
||||
print_pca_group(a)
|
||||
class(object) <- class(object)[class(object) != "pca"]
|
||||
}
|
||||
summary(object, ...)
|
||||
}
|
||||
|
||||
print_pca_group <- function(a) {
|
||||
grps <- sort(unique(a[, 1, drop = TRUE]))
|
||||
cat("Groups (n=", length(grps), ", named as '", colnames(a)[1], "'):\n", sep = "")
|
||||
print(grps)
|
||||
cat("\n")
|
||||
}
|
||||
-1431
File diff suppressed because it is too large
Load Diff
-448
@@ -1,448 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Calculate Antimicrobial Resistance
|
||||
#'
|
||||
#' @description These functions can be used to calculate the (co-)resistance or susceptibility of microbial isolates (i.e. percentage of S, SI, I, IR or R). All functions support quasiquotation with pipes, can be used in `summarise()` from the `dplyr` package and also support grouped variables, see *Examples*.
|
||||
#'
|
||||
#' [resistance()] should be used to calculate resistance, [susceptibility()] should be used to calculate susceptibility.\cr
|
||||
#' @param ... One or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.sir()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
|
||||
#' @param minimum The minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
|
||||
#' @param as_percent A [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
|
||||
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antimicrobials, see section *Combination Therapy* below.
|
||||
#' @param data A [data.frame] containing columns with class [`sir`] (see [as.sir()]).
|
||||
#' @param translate_ab A column name of the [antimicrobials] data set to translate the antibiotic abbreviations to, using [ab_property()].
|
||||
#' @inheritParams ab_property
|
||||
#' @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()]. 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.
|
||||
#'
|
||||
#' These functions are not meant to count isolates, but to calculate the proportion of resistance/susceptibility. Use the [`count_*()`][AMR::count()] functions to count isolates. The function [susceptibility()] is essentially equal to [count_susceptible()]` / `[count_all()]. *Low counts can influence the outcome - the `proportion_*()` functions may camouflage this, since they only return the proportion (albeit dependent on the `minimum` argument).*
|
||||
#'
|
||||
#' The function [proportion_df()] takes any variable from `data` that has an [`sir`] class (created with [as.sir()]) and calculates the proportions S, I, and R. It also supports grouped variables. The function [sir_df()] works exactly like [proportion_df()], but adds the number of isolates.
|
||||
#' @section Combination Therapy:
|
||||
#' When using more than one variable for `...` (= combination therapy), use `only_all_tested` to only count isolates that are tested for all antimicrobials/variables that you test them for. See this example for two antimicrobials, Drug A and Drug B, about how [susceptibility()] works to calculate the %SI:
|
||||
#'
|
||||
#'
|
||||
#' ```
|
||||
#' --------------------------------------------------------------------
|
||||
#' only_all_tested = FALSE only_all_tested = TRUE
|
||||
#' ----------------------- -----------------------
|
||||
#' Drug A Drug B considered considered considered considered
|
||||
#' susceptible tested susceptible tested
|
||||
#' -------- -------- ----------- ---------- ----------- ----------
|
||||
#' S or I S or I X X X X
|
||||
#' R S or I X X X X
|
||||
#' <NA> S or I X X - -
|
||||
#' S or I R X X X X
|
||||
#' R R - X - X
|
||||
#' <NA> R - - - -
|
||||
#' S or I <NA> X X - -
|
||||
#' R <NA> - - - -
|
||||
#' <NA> <NA> - - - -
|
||||
#' --------------------------------------------------------------------
|
||||
#' ```
|
||||
#'
|
||||
#' Please note that, in combination therapies, for `only_all_tested = TRUE` applies that:
|
||||
#'
|
||||
#' ```
|
||||
#' count_S() + count_I() + count_R() = count_all()
|
||||
#' proportion_S() + proportion_I() + proportion_R() = 1
|
||||
#' ```
|
||||
#'
|
||||
#' and that, in combination therapies, for `only_all_tested = FALSE` applies that:
|
||||
#'
|
||||
#' ```
|
||||
#' count_S() + count_I() + count_R() >= count_all()
|
||||
#' proportion_S() + proportion_I() + proportion_R() >= 1
|
||||
#' ```
|
||||
#'
|
||||
#' Using `only_all_tested` has no impact when only using one antibiotic as input.
|
||||
#' @source **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||
#' @seealso [AMR::count()] to count resistant and susceptible isolates.
|
||||
#' @return A [double] or, when `as_percent = TRUE`, a [character].
|
||||
#' @rdname proportion
|
||||
#' @aliases portion
|
||||
#' @name proportion
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # example_isolates is a data set available in the AMR package.
|
||||
#' # run ?example_isolates for more info.
|
||||
#' example_isolates
|
||||
#'
|
||||
#'
|
||||
#' # base R ------------------------------------------------------------
|
||||
#' # determines %R
|
||||
#' resistance(example_isolates$AMX)
|
||||
#' sir_confidence_interval(example_isolates$AMX)
|
||||
#' sir_confidence_interval(example_isolates$AMX,
|
||||
#' confidence_level = 0.975
|
||||
#' )
|
||||
#' sir_confidence_interval(example_isolates$AMX,
|
||||
#' confidence_level = 0.975,
|
||||
#' collapse = ", "
|
||||
#' )
|
||||
#'
|
||||
#' # determines %S+I:
|
||||
#' susceptibility(example_isolates$AMX)
|
||||
#' sir_confidence_interval(example_isolates$AMX,
|
||||
#' ab_result = c("S", "I")
|
||||
#' )
|
||||
#'
|
||||
#' # be more specific
|
||||
#' proportion_S(example_isolates$AMX)
|
||||
#' proportion_SI(example_isolates$AMX)
|
||||
#' proportion_I(example_isolates$AMX)
|
||||
#' proportion_IR(example_isolates$AMX)
|
||||
#' proportion_R(example_isolates$AMX)
|
||||
#'
|
||||
#' # dplyr -------------------------------------------------------------
|
||||
#' \donttest{
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' r = resistance(CIP),
|
||||
#' n = n_sir(CIP)
|
||||
#' ) # n_sir works like n_distinct in dplyr, see ?n_sir
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' cipro_R = resistance(CIP),
|
||||
#' ci_min = sir_confidence_interval(CIP, side = "min"),
|
||||
#' ci_max = sir_confidence_interval(CIP, side = "max"),
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' # scoped dplyr verbs with antimicrobial selectors
|
||||
#' # (you could also use across() of course)
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise_at(
|
||||
#' c(aminoglycosides(), carbapenems()),
|
||||
#' resistance
|
||||
#' )
|
||||
#' }
|
||||
#' if (require("dplyr")) {
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' R = resistance(CIP, as_percent = TRUE),
|
||||
#' SI = susceptibility(CIP, as_percent = TRUE),
|
||||
#' n1 = count_all(CIP), # the actual total; sum of all three
|
||||
#' n2 = n_sir(CIP), # same - analogous to n_distinct
|
||||
#' total = n()
|
||||
#' ) # NOT the number of tested isolates!
|
||||
#'
|
||||
#' # Calculate co-resistance between amoxicillin/clav acid and gentamicin,
|
||||
#' # so we can see that combination therapy does a lot more than mono therapy:
|
||||
#' example_isolates %>% susceptibility(AMC) # %SI = 76.3%
|
||||
#' example_isolates %>% count_all(AMC) # n = 1879
|
||||
#'
|
||||
#' example_isolates %>% susceptibility(GEN) # %SI = 75.4%
|
||||
#' example_isolates %>% count_all(GEN) # n = 1855
|
||||
#'
|
||||
#' example_isolates %>% susceptibility(AMC, GEN) # %SI = 94.1%
|
||||
#' example_isolates %>% count_all(AMC, GEN) # n = 1939
|
||||
#'
|
||||
#'
|
||||
#' # See Details on how `only_all_tested` works. Example:
|
||||
#' example_isolates %>%
|
||||
#' summarise(
|
||||
#' numerator = count_susceptible(AMC, GEN),
|
||||
#' denominator = count_all(AMC, GEN),
|
||||
#' proportion = susceptibility(AMC, GEN)
|
||||
#' )
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' summarise(
|
||||
#' numerator = count_susceptible(AMC, GEN, only_all_tested = TRUE),
|
||||
#' denominator = count_all(AMC, GEN, only_all_tested = TRUE),
|
||||
#' proportion = susceptibility(AMC, GEN, only_all_tested = TRUE)
|
||||
#' )
|
||||
#'
|
||||
#'
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(
|
||||
#' cipro_p = susceptibility(CIP, as_percent = TRUE),
|
||||
#' cipro_n = count_all(CIP),
|
||||
#' genta_p = susceptibility(GEN, as_percent = TRUE),
|
||||
#' genta_n = count_all(GEN),
|
||||
#' combination_p = susceptibility(CIP, GEN, as_percent = TRUE),
|
||||
#' combination_n = count_all(CIP, GEN)
|
||||
#' )
|
||||
#'
|
||||
#' # Get proportions S/I/R immediately of all sir columns
|
||||
#' example_isolates %>%
|
||||
#' select(AMX, CIP) %>%
|
||||
#' proportion_df(translate = FALSE)
|
||||
#'
|
||||
#' # It also supports grouping variables
|
||||
#' # (use sir_df to also include the count)
|
||||
#' example_isolates %>%
|
||||
#' select(ward, AMX, CIP) %>%
|
||||
#' group_by(ward) %>%
|
||||
#' sir_df(translate = FALSE)
|
||||
#' }
|
||||
#' }
|
||||
resistance <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "R",
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
susceptibility <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "SDD", "I"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
sir_confidence_interval <- function(...,
|
||||
ab_result = "R",
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
confidence_level = 0.95,
|
||||
side = "both",
|
||||
collapse = FALSE) {
|
||||
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)
|
||||
meet_criteria(confidence_level, allow_class = "numeric", is_positive = TRUE, has_length = 1)
|
||||
meet_criteria(side, allow_class = "character", has_length = 1, is_in = c("both", "b", "left", "l", "lower", "lowest", "less", "min", "right", "r", "higher", "highest", "greater", "g", "max"))
|
||||
meet_criteria(collapse, allow_class = c("logical", "character"), has_length = 1)
|
||||
|
||||
x <- tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = ab_result,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = TRUE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
n <- tryCatch(
|
||||
sir_calc(...,
|
||||
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)
|
||||
)
|
||||
|
||||
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]
|
||||
} else if (side %in% c("right", "r", "higher", "highest", "greater", "g", "max")) {
|
||||
out <- out[2]
|
||||
}
|
||||
if (isTRUE(as_percent)) {
|
||||
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))
|
||||
}
|
||||
|
||||
if (n < minimum) {
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(n == 0, "no", paste("only", n)),
|
||||
" results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
if (is.character(out)) {
|
||||
return(NA_character_)
|
||||
} else {
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_R <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "R",
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_IR <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "SDD", "R"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_I <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("I", "SDD"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_SI <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = c("S", "I", "SDD"),
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_S <- function(...,
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE) {
|
||||
tryCatch(
|
||||
sir_calc(...,
|
||||
ab_result = "S",
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
only_all_tested = only_all_tested,
|
||||
only_count = FALSE
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
proportion_df <- function(data,
|
||||
translate_ab = "name",
|
||||
language = get_AMR_locale(),
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
confidence_level = 0.95) {
|
||||
tryCatch(
|
||||
sir_calc_df(
|
||||
type = "proportion",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
confidence_level = confidence_level
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
-167
@@ -1,167 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Random MIC Values/Disk Zones/SIR Generation
|
||||
#'
|
||||
#' These functions can be used for generating random MIC values and disk diffusion diameters, for AMR data analysis practice. By providing a microorganism and antimicrobial drug, the generated results will reflect reality as much as possible.
|
||||
#' @param size Desired size of the returned vector. If used in a [data.frame] call or `dplyr` verb, will get the current (group) size if left blank.
|
||||
#' @param mo Any [character] that can be coerced to a valid microorganism code with [as.mo()].
|
||||
#' @param ab Any [character] that can be coerced to a valid antimicrobial drug code with [as.ab()].
|
||||
#' @param prob_SIR A vector of length 3: the probabilities for "S" (1st value), "I" (2nd value) and "R" (3rd value).
|
||||
#' @param ... Ignored, only in place to allow future extensions.
|
||||
#' @details The base \R function [sample()] is used for generating values.
|
||||
#'
|
||||
#' Generated values are based on the EUCAST `r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))` guideline as implemented in the [clinical_breakpoints] data set. To create specific generated values per bug or drug, set the `mo` and/or `ab` argument.
|
||||
#' @return class `mic` for [random_mic()] (see [as.mic()]) and class `disk` for [random_disk()] (see [as.disk()])
|
||||
#' @name random
|
||||
#' @rdname random
|
||||
#' @export
|
||||
#' @examples
|
||||
#' random_mic(25)
|
||||
#' random_disk(25)
|
||||
#' random_sir(25)
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # make the random generation more realistic by setting a bug and/or drug:
|
||||
#' random_mic(25, "Klebsiella pneumoniae") # range 0.0625-64
|
||||
#' random_mic(25, "Klebsiella pneumoniae", "meropenem") # range 0.0625-16
|
||||
#' random_mic(25, "Streptococcus pneumoniae", "meropenem") # range 0.0625-4
|
||||
#'
|
||||
#' random_disk(25, "Klebsiella pneumoniae") # range 8-50
|
||||
#' random_disk(25, "Klebsiella pneumoniae", "ampicillin") # range 11-17
|
||||
#' random_disk(25, "Streptococcus pneumoniae", "ampicillin") # range 12-27
|
||||
#' }
|
||||
random_mic <- function(size = NULL, mo = NULL, ab = NULL, ...) {
|
||||
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(mo, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
if (is.null(size)) {
|
||||
size <- NROW(get_current_data(arg_name = "size", call = -3))
|
||||
}
|
||||
random_exec("MIC", size = size, mo = mo, ab = ab)
|
||||
}
|
||||
|
||||
#' @rdname random
|
||||
#' @export
|
||||
random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
|
||||
meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
|
||||
meet_criteria(mo, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
if (is.null(size)) {
|
||||
size <- NROW(get_current_data(arg_name = "size", call = -3))
|
||||
}
|
||||
random_exec("DISK", size = size, mo = mo, ab = ab)
|
||||
}
|
||||
|
||||
#' @rdname random
|
||||
#' @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)
|
||||
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))
|
||||
}
|
||||
sample(as.sir(c("S", "I", "R")), size = size, replace = TRUE, prob = prob_SIR)
|
||||
}
|
||||
|
||||
random_exec <- function(method_type, size, mo = NULL, ab = NULL) {
|
||||
df <- AMR::clinical_breakpoints %pm>%
|
||||
pm_filter(guideline %like% "EUCAST") %pm>%
|
||||
pm_arrange(pm_desc(guideline)) %pm>%
|
||||
subset(guideline == max(guideline) &
|
||||
method == method_type &
|
||||
type == "human")
|
||||
|
||||
if (!is.null(mo)) {
|
||||
mo_coerced <- as.mo(mo)
|
||||
mo_include <- c(
|
||||
mo_coerced,
|
||||
as.mo(mo_genus(mo_coerced)),
|
||||
as.mo(mo_family(mo_coerced)),
|
||||
as.mo(mo_order(mo_coerced))
|
||||
)
|
||||
df_new <- df %pm>%
|
||||
subset(mo %in% mo_include)
|
||||
if (nrow(df_new) > 0) {
|
||||
df <- df_new
|
||||
} else {
|
||||
warning_("in `random_", tolower(method_type), "()`: no rows found that match mo '", mo, "', ignoring argument `mo`")
|
||||
}
|
||||
}
|
||||
|
||||
if (!is.null(ab)) {
|
||||
ab_coerced <- as.ab(ab)
|
||||
df_new <- df %pm>%
|
||||
subset(ab %in% ab_coerced)
|
||||
if (nrow(df_new) > 0) {
|
||||
df <- df_new
|
||||
} else {
|
||||
warning_("in `random_", tolower(method_type), "()`: no rows found that match ab '", ab, "' (", ab_name(ab_coerced, tolower = TRUE, language = NULL), "), ignoring argument `ab`")
|
||||
}
|
||||
}
|
||||
|
||||
if (method_type == "MIC") {
|
||||
# set range
|
||||
mic_range <- c(0.001, 0.002, 0.005, 0.010, 0.025, 0.0625, 0.125, 0.250, 0.5, 1, 2, 4, 8, 16, 32, 64, 128, 256)
|
||||
|
||||
# get highest/lowest +/- random 1 to 3 higher factors of two
|
||||
max_range <- mic_range[min(
|
||||
length(mic_range),
|
||||
which(mic_range == max(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE)) + sample(c(1:3), 1)
|
||||
)]
|
||||
min_range <- mic_range[max(
|
||||
1,
|
||||
which(mic_range == min(df$breakpoint_S, na.rm = TRUE)) - sample(c(1:3), 1)
|
||||
)]
|
||||
|
||||
mic_range_new <- mic_range[mic_range <= max_range & mic_range >= min_range]
|
||||
if (length(mic_range_new) == 0) {
|
||||
mic_range_new <- mic_range
|
||||
}
|
||||
out <- as.mic(sample(mic_range_new, size = size, replace = TRUE))
|
||||
# 50% chance that lowest will get <= and highest will get >=
|
||||
if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
|
||||
out[out == min(out)] <- paste0("<=", out[out == min(out)])
|
||||
}
|
||||
if (stats::runif(1) > 0.5 && length(unique(out)) > 1) {
|
||||
out[out == max(out)] <- paste0(">=", out[out == max(out)])
|
||||
}
|
||||
return(out)
|
||||
} else if (method_type == "DISK") {
|
||||
set_range <- seq(
|
||||
from = as.integer(min(df$breakpoint_R[!is.na(df$breakpoint_R)], na.rm = TRUE) / 1.25),
|
||||
to = as.integer(max(df$breakpoint_S, na.rm = TRUE) * 1.25),
|
||||
by = 1
|
||||
)
|
||||
out <- sample(set_range, size = size, replace = TRUE)
|
||||
out[out < 6] <- sample(c(6:10), length(out[out < 6]), replace = TRUE)
|
||||
out[out > 50] <- sample(c(40:50), length(out[out > 50]), replace = TRUE)
|
||||
return(as.disk(out))
|
||||
}
|
||||
}
|
||||
@@ -1,420 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Predict Antimicrobial Resistance
|
||||
#'
|
||||
#' @description Create a prediction model to predict antimicrobial resistance for the next years. Standard errors (SE) will be returned as columns `se_min` and `se_max`. See *Examples* for a real live example.
|
||||
#'
|
||||
#' **NOTE:** These functions are [deprecated][AMR-deprecated] and will be removed in a future version. Use the AMR package combined with the tidymodels framework instead, for which we have written a [basic and short introduction on our website](https://amr-for-r.org/articles/AMR_with_tidymodels.html).
|
||||
#' @param object Model data to be plotted.
|
||||
#' @param col_ab Column name of `x` containing antimicrobial interpretations (`"R"`, `"I"` and `"S"`).
|
||||
#' @param col_date Column name of the date, will be used to calculate years if this column doesn't consist of years already - the default is the first column of with a date class.
|
||||
#' @param year_min Lowest year to use in the prediction model, dafaults to the lowest year in `col_date`.
|
||||
#' @param year_max Highest year to use in the prediction model - the default is 10 years after today.
|
||||
#' @param year_every Unit of sequence between lowest year found in the data and `year_max`.
|
||||
#' @param minimum Minimal amount of available isolates per year to include. Years containing less observations will be estimated by the model.
|
||||
#' @param model The statistical model of choice. This could be a generalised linear regression model with binomial distribution (i.e. using `glm(..., family = binomial)`, assuming that a period of zero resistance was followed by a period of increasing resistance leading slowly to more and more resistance. See *Details* for all valid options.
|
||||
#' @param I_as_S A [logical] to indicate whether values `"I"` should be treated as `"S"` (will otherwise be treated as `"R"`). The default, `TRUE`, follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section *Interpretation of S, I and R* below.
|
||||
#' @param preserve_measurements A [logical] to indicate whether predictions of years that are actually available in the data should be overwritten by the original data. The standard errors of those years will be `NA`.
|
||||
#' @param info A [logical] to indicate whether textual analysis should be printed with the name and [summary()] of the statistical model.
|
||||
#' @param main Title of the plot.
|
||||
#' @param ribbon A [logical] to indicate whether a ribbon should be shown (default) or error bars.
|
||||
#' @param ... Arguments passed on to functions.
|
||||
#' @inheritSection as.sir Interpretation of SIR
|
||||
#' @inheritParams first_isolate
|
||||
#' @inheritParams graphics::plot
|
||||
#' @details Valid options for the statistical model (argument `model`) are:
|
||||
#' - `"binomial"` or `"binom"` or `"logit"`: a generalised linear regression model with binomial distribution
|
||||
#' - `"loglin"` or `"poisson"`: a generalised log-linear regression model with poisson distribution
|
||||
#' - `"lin"` or `"linear"`: a linear regression model
|
||||
#' @return A [data.frame] with extra class [`resistance_predict`] with columns:
|
||||
#' - `year`
|
||||
#' - `value`, the same as `estimated` when `preserve_measurements = FALSE`, and a combination of `observed` and `estimated` otherwise
|
||||
#' - `se_min`, the lower bound of the standard error with a minimum of `0` (so the standard error will never go below 0%)
|
||||
#' - `se_max` the upper bound of the standard error with a maximum of `1` (so the standard error will never go above 100%)
|
||||
#' - `observations`, the total number of available observations in that year, i.e. \eqn{S + I + R}
|
||||
#' - `observed`, the original observed resistant percentages
|
||||
#' - `estimated`, the estimated resistant percentages, calculated by the model
|
||||
#'
|
||||
#' Furthermore, the model itself is available as an attribute: `attributes(x)$model`, see *Examples*.
|
||||
#' @seealso The [proportion()] functions to calculate resistance
|
||||
#'
|
||||
#' Models: [lm()] [glm()]
|
||||
#' @rdname resistance_predict
|
||||
#' @export
|
||||
#' @importFrom stats predict glm lm
|
||||
#' @examples
|
||||
#' x <- resistance_predict(example_isolates,
|
||||
#' col_ab = "AMX",
|
||||
#' year_min = 2010,
|
||||
#' model = "binomial"
|
||||
#' )
|
||||
#' plot(x)
|
||||
#' \donttest{
|
||||
#' if (require("ggplot2")) {
|
||||
#' ggplot_sir_predict(x)
|
||||
#' }
|
||||
#'
|
||||
#' # using dplyr:
|
||||
#' if (require("dplyr")) {
|
||||
#' x <- example_isolates %>%
|
||||
#' filter_first_isolate() %>%
|
||||
#' filter(mo_genus(mo) == "Staphylococcus") %>%
|
||||
#' resistance_predict("PEN", model = "binomial")
|
||||
#' print(plot(x))
|
||||
#'
|
||||
#' # get the model from the object
|
||||
#' mymodel <- attributes(x)$model
|
||||
#' summary(mymodel)
|
||||
#' }
|
||||
#'
|
||||
#' # create nice plots with ggplot2 yourself
|
||||
#' if (require("dplyr") && require("ggplot2")) {
|
||||
#' data <- example_isolates %>%
|
||||
#' filter(mo == as.mo("E. coli")) %>%
|
||||
#' resistance_predict(
|
||||
#' col_ab = "AMX",
|
||||
#' col_date = "date",
|
||||
#' model = "binomial",
|
||||
#' info = FALSE,
|
||||
#' minimum = 15
|
||||
#' )
|
||||
#' head(data)
|
||||
#' autoplot(data)
|
||||
#' }
|
||||
#' }
|
||||
resistance_predict <- function(x,
|
||||
col_ab,
|
||||
col_date = NULL,
|
||||
year_min = NULL,
|
||||
year_max = NULL,
|
||||
year_every = 1,
|
||||
minimum = 30,
|
||||
model = NULL,
|
||||
I_as_S = TRUE,
|
||||
preserve_measurements = TRUE,
|
||||
info = interactive(),
|
||||
...) {
|
||||
meet_criteria(x, allow_class = "data.frame")
|
||||
meet_criteria(col_ab, allow_class = "character", has_length = 1, is_in = colnames(x))
|
||||
meet_criteria(col_date, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||
meet_criteria(year_min, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(year_max, allow_class = c("numeric", "integer"), has_length = 1, allow_NULL = TRUE, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(year_every, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(model, allow_class = c("character", "function"), has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(I_as_S, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(preserve_measurements, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||
|
||||
deprecation_warning(
|
||||
old = "resistance_predict", is_function = TRUE,
|
||||
extra_msg = paste0("Use the tidymodels framework instead, for which we have written a basic and short introduction on our website: ", font_url("https://amr-for-r.org/articles/AMR_with_tidymodels.html", txt = font_bold("AMR with tidymodels")))
|
||||
)
|
||||
|
||||
stop_if(is.null(model), 'choose a regression model with the `model` argument, e.g. resistance_predict(..., model = "binomial")')
|
||||
|
||||
x.bak <- x
|
||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||
|
||||
# -- date
|
||||
if (is.null(col_date)) {
|
||||
col_date <- search_type_in_df(x = x, type = "date")
|
||||
stop_if(is.null(col_date), "`col_date` must be set")
|
||||
}
|
||||
stop_ifnot(
|
||||
col_date %in% colnames(x),
|
||||
"column '", col_date, "' not found"
|
||||
)
|
||||
|
||||
year <- function(x) {
|
||||
# don't depend on lubridate or so, would be overkill for only this function
|
||||
if (all(grepl("^[0-9]{4}$", x))) {
|
||||
as.integer(x)
|
||||
} else {
|
||||
as.integer(format(as.Date(x), "%Y"))
|
||||
}
|
||||
}
|
||||
|
||||
df <- x
|
||||
df[, col_ab] <- droplevels(as.sir(df[, col_ab, drop = TRUE]))
|
||||
if (I_as_S == TRUE) {
|
||||
# then I as S
|
||||
df[, col_ab] <- gsub("I", "S", df[, col_ab, drop = TRUE], fixed = TRUE)
|
||||
} else {
|
||||
# then I as R
|
||||
df[, col_ab] <- gsub("I", "R", df[, col_ab, drop = TRUE], fixed = TRUE)
|
||||
}
|
||||
df[, col_ab] <- ifelse(is.na(df[, col_ab, drop = TRUE]), 0, df[, col_ab, drop = TRUE])
|
||||
|
||||
# remove rows with NAs
|
||||
df <- subset(df, !is.na(df[, col_ab, drop = TRUE]))
|
||||
df$year <- year(df[, col_date, drop = TRUE])
|
||||
df <- as.data.frame(rbind(table(df[, c("year", col_ab), drop = FALSE])),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
df$year <- as.integer(rownames(df))
|
||||
rownames(df) <- NULL
|
||||
|
||||
df <- subset(df, sum(df$R + df$S, na.rm = TRUE) >= minimum)
|
||||
# nolint start
|
||||
df_matrix <- as.matrix(df[, c("R", "S"), drop = FALSE])
|
||||
# nolint end
|
||||
|
||||
stop_if(NROW(df) == 0, "there are no observations")
|
||||
|
||||
year_lowest <- min(df$year)
|
||||
if (is.null(year_min)) {
|
||||
year_min <- year_lowest
|
||||
} else {
|
||||
year_min <- max(year_min, year_lowest, na.rm = TRUE)
|
||||
}
|
||||
if (is.null(year_max)) {
|
||||
year_max <- year(Sys.Date()) + 10
|
||||
}
|
||||
|
||||
years <- list(year = seq(from = year_min, to = year_max, by = year_every))
|
||||
|
||||
if (model %in% c("binomial", "binom", "logit")) {
|
||||
model <- "binomial"
|
||||
model_lm <- with(df, glm(df_matrix ~ year, family = binomial))
|
||||
if (isTRUE(info)) {
|
||||
cat("\nLogistic regression model (logit) with binomial distribution")
|
||||
cat("\n------------------------------------------------------------\n")
|
||||
print(summary(model_lm))
|
||||
}
|
||||
|
||||
predictmodel <- predict(model_lm, newdata = years, type = "response", se.fit = TRUE)
|
||||
prediction <- predictmodel$fit
|
||||
se <- predictmodel$se.fit
|
||||
} else if (model %in% c("loglin", "poisson")) {
|
||||
model <- "poisson"
|
||||
model_lm <- with(df, glm(R ~ year, family = poisson))
|
||||
if (isTRUE(info)) {
|
||||
cat("\nLog-linear regression model (loglin) with poisson distribution")
|
||||
cat("\n--------------------------------------------------------------\n")
|
||||
print(summary(model_lm))
|
||||
}
|
||||
|
||||
predictmodel <- predict(model_lm, newdata = years, type = "response", se.fit = TRUE)
|
||||
prediction <- predictmodel$fit
|
||||
se <- predictmodel$se.fit
|
||||
} else if (model %in% c("lin", "linear")) {
|
||||
model <- "linear"
|
||||
model_lm <- with(df, lm((R / (R + S)) ~ year))
|
||||
if (isTRUE(info)) {
|
||||
cat("\nLinear regression model")
|
||||
cat("\n-----------------------\n")
|
||||
print(summary(model_lm))
|
||||
}
|
||||
|
||||
predictmodel <- predict(model_lm, newdata = years, se.fit = TRUE)
|
||||
prediction <- predictmodel$fit
|
||||
se <- predictmodel$se.fit
|
||||
} else {
|
||||
stop("no valid model selected. See `?resistance_predict`.")
|
||||
}
|
||||
|
||||
# prepare the output dataframe
|
||||
df_prediction <- data.frame(
|
||||
year = unlist(years),
|
||||
value = prediction,
|
||||
se_min = prediction - se,
|
||||
se_max = prediction + se,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
if (model == "poisson") {
|
||||
df_prediction$value <- as.integer(format(df_prediction$value, scientific = FALSE))
|
||||
df_prediction$se_min <- as.integer(df_prediction$se_min)
|
||||
df_prediction$se_max <- as.integer(df_prediction$se_max)
|
||||
} else {
|
||||
# se_max not above 1
|
||||
df_prediction$se_max <- pmin(df_prediction$se_max, 1)
|
||||
}
|
||||
# se_min not below 0
|
||||
df_prediction$se_min <- pmax(df_prediction$se_min, 0)
|
||||
|
||||
df_observations <- data.frame(
|
||||
year = df$year,
|
||||
observations = df$R + df$S,
|
||||
observed = df$R / (df$R + df$S),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
df_prediction <- df_prediction %pm>%
|
||||
pm_left_join(df_observations, by = "year")
|
||||
df_prediction$estimated <- df_prediction$value
|
||||
|
||||
if (preserve_measurements == TRUE) {
|
||||
# replace estimated data by observed data
|
||||
df_prediction$value <- ifelse(!is.na(df_prediction$observed), df_prediction$observed, df_prediction$value)
|
||||
df_prediction$se_min <- ifelse(!is.na(df_prediction$observed), NA, df_prediction$se_min)
|
||||
df_prediction$se_max <- ifelse(!is.na(df_prediction$observed), NA, df_prediction$se_max)
|
||||
}
|
||||
|
||||
df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0))
|
||||
df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
|
||||
|
||||
out <- as_original_data_class(df_prediction, class(x.bak)) # will remove tibble groups
|
||||
structure(out,
|
||||
class = c("resistance_predict", class(out)),
|
||||
I_as_S = I_as_S,
|
||||
model_title = model,
|
||||
model = model_lm,
|
||||
ab = col_ab
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname resistance_predict
|
||||
#' @export
|
||||
sir_predict <- resistance_predict
|
||||
|
||||
#' @method plot resistance_predict
|
||||
#' @export
|
||||
#' @importFrom graphics plot axis arrows points
|
||||
#' @rdname resistance_predict
|
||||
plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", x_name), ...) {
|
||||
x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")")
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
|
||||
if (attributes(x)$I_as_S == TRUE) {
|
||||
ylab <- "%R"
|
||||
} else {
|
||||
ylab <- "%IR"
|
||||
}
|
||||
|
||||
plot(
|
||||
x = x$year,
|
||||
y = x$value,
|
||||
ylim = c(0, 1),
|
||||
yaxt = "n", # no y labels
|
||||
pch = 19, # closed dots
|
||||
ylab = paste0("Percentage (", ylab, ")"),
|
||||
xlab = "Year",
|
||||
main = main,
|
||||
sub = paste0(
|
||||
"(n = ", sum(x$observations, na.rm = TRUE),
|
||||
", model: ", attributes(x)$model_title, ")"
|
||||
),
|
||||
cex.sub = 0.75
|
||||
)
|
||||
|
||||
|
||||
axis(side = 2, at = seq(0, 1, 0.1), labels = paste0(0:10 * 10, "%"))
|
||||
|
||||
# hack for error bars: https://stackoverflow.com/a/22037078/4575331
|
||||
arrows(
|
||||
x0 = x$year,
|
||||
y0 = x$se_min,
|
||||
x1 = x$year,
|
||||
y1 = x$se_max,
|
||||
length = 0.05, angle = 90, code = 3, lwd = 1.5
|
||||
)
|
||||
|
||||
# overlay grey points for prediction
|
||||
points(
|
||||
x = subset(x, is.na(observations))$year,
|
||||
y = subset(x, is.na(observations))$value,
|
||||
pch = 19,
|
||||
col = "grey40"
|
||||
)
|
||||
}
|
||||
|
||||
#' @rdname resistance_predict
|
||||
#' @export
|
||||
ggplot_sir_predict <- function(x,
|
||||
main = paste("Resistance Prediction of", x_name),
|
||||
ribbon = TRUE,
|
||||
...) {
|
||||
x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")")
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ribbon, allow_class = "logical", has_length = 1)
|
||||
|
||||
stop_ifnot_installed("ggplot2")
|
||||
stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
|
||||
|
||||
if (attributes(x)$I_as_S == TRUE) {
|
||||
ylab <- "%R"
|
||||
} else {
|
||||
ylab <- "%IR"
|
||||
}
|
||||
|
||||
p <- ggplot2::ggplot(
|
||||
as.data.frame(x, stringsAsFactors = FALSE),
|
||||
ggplot2::aes(x = year, y = value)
|
||||
) +
|
||||
ggplot2::geom_point(
|
||||
data = subset(x, !is.na(observations)),
|
||||
size = 2
|
||||
) +
|
||||
scale_y_percent(limits = c(0, 1)) +
|
||||
ggplot2::labs(
|
||||
title = main,
|
||||
y = paste0("Percentage (", ylab, ")"),
|
||||
x = "Year",
|
||||
caption = paste0(
|
||||
"(n = ", sum(x$observations, na.rm = TRUE),
|
||||
", model: ", attributes(x)$model_title, ")"
|
||||
)
|
||||
)
|
||||
|
||||
if (ribbon == TRUE) {
|
||||
p <- p + ggplot2::geom_ribbon(ggplot2::aes(ymin = se_min, ymax = se_max), alpha = 0.25)
|
||||
} else {
|
||||
p <- p + ggplot2::geom_errorbar(ggplot2::aes(ymin = se_min, ymax = se_max), na.rm = TRUE, width = 0.5)
|
||||
}
|
||||
p <- p +
|
||||
# overlay grey points for prediction
|
||||
ggplot2::geom_point(
|
||||
data = subset(x, is.na(observations)),
|
||||
size = 2,
|
||||
colour = "grey40"
|
||||
)
|
||||
p
|
||||
}
|
||||
|
||||
#' @method autoplot resistance_predict
|
||||
#' @rdname resistance_predict
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
autoplot.resistance_predict <- function(object,
|
||||
main = paste("Resistance Prediction of", x_name),
|
||||
ribbon = TRUE,
|
||||
...) {
|
||||
x_name <- paste0(ab_name(attributes(object)$ab), " (", attributes(object)$ab, ")")
|
||||
meet_criteria(main, allow_class = "character", has_length = 1)
|
||||
meet_criteria(ribbon, allow_class = "logical", has_length = 1)
|
||||
ggplot_sir_predict(x = object, main = main, ribbon = ribbon, ...)
|
||||
}
|
||||
|
||||
#' @method fortify resistance_predict
|
||||
#' @noRd
|
||||
# will be exported using s3_register() in R/zzz.R
|
||||
fortify.resistance_predict <- function(model, data, ...) {
|
||||
as.data.frame(model)
|
||||
}
|
||||
-394
@@ -1,394 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
dots2vars <- function(...) {
|
||||
# this function is to give more informative output about
|
||||
# variable names in count_* and proportion_* functions
|
||||
dots <- substitute(list(...))
|
||||
dots <- as.character(dots)[2:length(dots)]
|
||||
paste0(dots[dots != "."], collapse = "+")
|
||||
}
|
||||
|
||||
sir_calc <- function(...,
|
||||
ab_result,
|
||||
minimum = 0,
|
||||
as_percent = FALSE,
|
||||
only_all_tested = FALSE,
|
||||
only_count = FALSE) {
|
||||
meet_criteria(ab_result, allow_class = c("character", "numeric", "integer"), has_length = c(1:5))
|
||||
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(only_count, allow_class = "logical", has_length = 1)
|
||||
|
||||
data_vars <- dots2vars(...)
|
||||
|
||||
dots_df <- switch(1,
|
||||
...
|
||||
)
|
||||
if (is.data.frame(dots_df)) {
|
||||
# make sure to remove all other classes like tibbles, data.tables, etc
|
||||
dots_df <- as.data.frame(dots_df, stringsAsFactors = FALSE)
|
||||
}
|
||||
|
||||
dots <- eval(substitute(alist(...)))
|
||||
stop_if(length(dots) == 0, "no variables selected", call = -2)
|
||||
|
||||
stop_if("also_single_tested" %in% names(dots),
|
||||
"`also_single_tested` was replaced by `only_all_tested`.\n",
|
||||
"Please read Details in the help page (`?proportion`) as this may have a considerable impact on your analysis.",
|
||||
call = -2
|
||||
)
|
||||
ndots <- length(dots)
|
||||
|
||||
if (is.data.frame(dots_df)) {
|
||||
# data.frame passed with other columns, like: example_isolates %pm>% proportion_S(AMC, GEN)
|
||||
|
||||
dots <- as.character(dots)
|
||||
# remove first element, it's the data.frame
|
||||
if (length(dots) == 1) {
|
||||
dots <- character(0)
|
||||
} else {
|
||||
dots <- dots[2:length(dots)]
|
||||
}
|
||||
if (length(dots) == 0 || all(dots == "df")) {
|
||||
# for complete data.frames, like example_isolates %pm>% select(AMC, GEN) %pm>% proportion_S()
|
||||
# and the old sir function, which has "df" as name of the first argument
|
||||
x <- dots_df
|
||||
} else {
|
||||
# get dots that are in column names already, and the ones that will be once evaluated using dots_df or global env
|
||||
# this is to support susceptibility(example_isolates, AMC, any_of(some_vector_with_AB_names))
|
||||
dots <- c(
|
||||
dots[dots %in% colnames(dots_df)],
|
||||
eval(parse(text = dots[!dots %in% colnames(dots_df)]), envir = dots_df, enclos = globalenv())
|
||||
)
|
||||
dots_not_exist <- dots[!dots %in% colnames(dots_df)]
|
||||
stop_if(length(dots_not_exist) > 0, "column(s) not found: ", vector_and(dots_not_exist, quotes = TRUE), call = -2)
|
||||
x <- dots_df[, dots, drop = FALSE]
|
||||
}
|
||||
} else if (ndots == 1) {
|
||||
# only 1 variable passed (can also be data.frame), like: proportion_S(example_isolates$AMC) and example_isolates$AMC %pm>% proportion_S()
|
||||
x <- dots_df
|
||||
} else {
|
||||
# multiple variables passed without pipe, like: proportion_S(example_isolates$AMC, example_isolates$GEN)
|
||||
x <- NULL
|
||||
try(x <- as.data.frame(dots, stringsAsFactors = FALSE), silent = TRUE)
|
||||
if (is.null(x)) {
|
||||
# support for example_isolates %pm>% group_by(ward) %pm>% summarise(amox = susceptibility(GEN, AMX))
|
||||
x <- as.data.frame(list(...), stringsAsFactors = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
if (is.null(x)) {
|
||||
warning_("argument is NULL (check if columns exist): returning NA")
|
||||
if (as_percent == TRUE) {
|
||||
return(NA_character_)
|
||||
} else {
|
||||
return(NA_real_)
|
||||
}
|
||||
}
|
||||
|
||||
print_warning <- FALSE
|
||||
|
||||
ab_result <- as.sir(ab_result)
|
||||
|
||||
if (is.data.frame(x)) {
|
||||
sir_integrity_check <- character(0)
|
||||
for (i in seq_len(ncol(x))) {
|
||||
# check integrity of columns: force 'sir' class
|
||||
if (!is.sir(x[, i, drop = TRUE])) {
|
||||
sir_integrity_check <- c(sir_integrity_check, as.character(x[, i, drop = TRUE]))
|
||||
x[, i] <- suppressWarnings(as.sir(x[, i, drop = TRUE])) # warning will be given later
|
||||
print_warning <- TRUE
|
||||
}
|
||||
}
|
||||
if (length(sir_integrity_check) > 0) {
|
||||
# this will give a warning for invalid results, of all input columns (so only 1 warning)
|
||||
sir_integrity_check <- as.sir(sir_integrity_check)
|
||||
}
|
||||
|
||||
x_transposed <- as.list(as.data.frame(t(x), stringsAsFactors = FALSE))
|
||||
if (isTRUE(only_all_tested)) {
|
||||
# no NAs in any column
|
||||
y <- apply(
|
||||
X = as.data.frame(lapply(x, as.double), stringsAsFactors = FALSE),
|
||||
MARGIN = 1,
|
||||
FUN = min
|
||||
)
|
||||
if ("SDD" %in% ab_result && "SDD" %in% y && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
|
||||
message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
numerator <- sum(!is.na(y) & y %in% as.double(ab_result), na.rm = TRUE)
|
||||
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(anyNA(y))))
|
||||
} else {
|
||||
# may contain NAs in any column
|
||||
other_values <- setdiff(c(NA, levels(ab_result)), ab_result)
|
||||
if ("SDD" %in% ab_result && "SDD" %in% unlist(x_transposed) && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
|
||||
message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
numerator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) any(y %in% ab_result, na.rm = TRUE)))
|
||||
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(all(y %in% other_values) & anyNA(y))))
|
||||
}
|
||||
} else {
|
||||
# x is not a data.frame
|
||||
if (!is.sir(x)) {
|
||||
x <- as.sir(x)
|
||||
print_warning <- TRUE
|
||||
}
|
||||
if ("SDD" %in% ab_result && "SDD" %in% x && message_not_thrown_before("sir_calc", only_count, ab_result, entire_session = TRUE)) {
|
||||
message_("Note that `", ifelse(only_count, "count", "proportion"), "_", ifelse("S" %in% ab_result, "S", ""), "I", ifelse("R" %in% ab_result, "R", ""), "()` will also include dose-dependent susceptibility, 'SDD'. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
numerator <- sum(x %in% ab_result, na.rm = TRUE)
|
||||
denominator <- sum(x %in% levels(ab_result), na.rm = TRUE)
|
||||
}
|
||||
|
||||
if (print_warning == TRUE) {
|
||||
if (message_not_thrown_before("sir_calc")) {
|
||||
warning_("Increase speed by transforming to class 'sir' on beforehand:\n",
|
||||
" your_data %>% mutate_if(is_sir_eligible, as.sir)",
|
||||
call = FALSE
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
if (only_count == TRUE) {
|
||||
return(numerator)
|
||||
}
|
||||
|
||||
if (denominator < minimum) {
|
||||
if (data_vars != "") {
|
||||
data_vars <- paste(" for", data_vars)
|
||||
# also add group name if used in dplyr::group_by()
|
||||
cur_group <- import_fn("cur_group", "dplyr", error_on_fail = FALSE)
|
||||
if (!is.null(cur_group)) {
|
||||
group_df <- tryCatch(cur_group(), error = function(e) data.frame())
|
||||
if (NCOL(group_df) > 0) {
|
||||
# transform factors to characters
|
||||
group <- vapply(FUN.VALUE = character(1), group_df, function(x) {
|
||||
if (is.numeric(x)) {
|
||||
format(x)
|
||||
} else if (is.logical(x)) {
|
||||
as.character(x)
|
||||
} else {
|
||||
paste0('"', x, '"')
|
||||
}
|
||||
})
|
||||
data_vars <- paste0(data_vars, " in group: ", paste0(names(group), " = ", group, collapse = ", "))
|
||||
}
|
||||
}
|
||||
}
|
||||
warning_("Introducing NA: ",
|
||||
ifelse(denominator == 0, "no", paste("only", denominator)),
|
||||
" results available",
|
||||
data_vars,
|
||||
" (`minimum` = ", minimum, ").",
|
||||
call = FALSE
|
||||
)
|
||||
fraction <- NA_real_
|
||||
} else {
|
||||
fraction <- numerator / denominator
|
||||
fraction[is.nan(fraction)] <- NA_real_
|
||||
}
|
||||
|
||||
if (as_percent == TRUE) {
|
||||
trimws(percentage(fraction, digits = 1))
|
||||
} else {
|
||||
fraction
|
||||
}
|
||||
}
|
||||
|
||||
sir_calc_df <- function(type, # "proportion", "count" or "both"
|
||||
data,
|
||||
translate_ab = "name",
|
||||
language = get_AMR_locale(),
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
confidence_level = 0.95) {
|
||||
meet_criteria(type, is_in = c("proportion", "count", "both"), has_length = 1)
|
||||
meet_criteria(data, allow_class = "data.frame")
|
||||
data <- ascertain_sir_classes(data, "data")
|
||||
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)
|
||||
meet_criteria(as_percent, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||
meet_criteria(confidence_level, allow_class = "numeric", has_length = 1)
|
||||
|
||||
translate_ab <- get_translate_ab(translate_ab)
|
||||
|
||||
data.bak <- data
|
||||
# select only groups and antimicrobials
|
||||
if (is_null_or_grouped_tbl(data)) {
|
||||
data_has_groups <- TRUE
|
||||
groups <- get_group_names(data)
|
||||
data <- data[, c(groups, colnames(data)[vapply(FUN.VALUE = logical(1), data, is.sir)]), drop = FALSE]
|
||||
} else {
|
||||
data_has_groups <- FALSE
|
||||
data <- data[, colnames(data)[vapply(FUN.VALUE = logical(1), data, is.sir)], drop = FALSE]
|
||||
}
|
||||
|
||||
data <- as.data.frame(data, stringsAsFactors = FALSE)
|
||||
if (isTRUE(combine_SI)) {
|
||||
for (i in seq_len(ncol(data))) {
|
||||
if (is.sir(data[, i, drop = TRUE])) {
|
||||
data[, i] <- as.character(data[, i, drop = TRUE])
|
||||
if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
|
||||
message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
|
||||
}
|
||||
data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sum_it <- function(.data) {
|
||||
out <- data.frame(
|
||||
antibiotic = character(0),
|
||||
interpretation = character(0),
|
||||
value = double(0),
|
||||
ci_min = double(0),
|
||||
ci_max = double(0),
|
||||
isolates = integer(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (data_has_groups) {
|
||||
group_values <- unique(.data[, which(colnames(.data) %in% groups), drop = FALSE])
|
||||
rownames(group_values) <- NULL
|
||||
.data <- .data[, which(!colnames(.data) %in% groups), drop = FALSE]
|
||||
}
|
||||
for (i in seq_len(ncol(.data))) {
|
||||
values <- .data[, i, drop = TRUE]
|
||||
if (isTRUE(combine_SI)) {
|
||||
values <- factor(values, levels = c("SI", "R", "NI"), ordered = TRUE)
|
||||
} else {
|
||||
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)
|
||||
col_results$isolates <- col_results[, 1, drop = TRUE]
|
||||
if (NROW(col_results) > 0 && sum(col_results$isolates, na.rm = TRUE) > 0) {
|
||||
if (sum(col_results$isolates, na.rm = TRUE) >= minimum) {
|
||||
col_results$value <- col_results$isolates / sum(col_results$isolates, na.rm = TRUE)
|
||||
ci <- lapply(
|
||||
col_results$isolates,
|
||||
function(x) {
|
||||
stats::binom.test(
|
||||
x = x,
|
||||
n = sum(col_results$isolates, na.rm = TRUE),
|
||||
conf.level = confidence_level
|
||||
)$conf.int
|
||||
}
|
||||
)
|
||||
col_results$ci_min <- vapply(FUN.VALUE = double(1), ci, `[`, 1)
|
||||
col_results$ci_max <- vapply(FUN.VALUE = double(1), ci, `[`, 2)
|
||||
} else {
|
||||
col_results$value <- rep(NA_real_, NROW(col_results))
|
||||
# confidence intervals also to NA
|
||||
col_results$ci_min <- col_results$value
|
||||
col_results$ci_max <- col_results$value
|
||||
}
|
||||
out_new <- data.frame(
|
||||
antibiotic = ifelse(isFALSE(translate_ab),
|
||||
colnames(.data)[i],
|
||||
ab_property(colnames(.data)[i], property = translate_ab, language = language)
|
||||
),
|
||||
interpretation = col_results$interpretation,
|
||||
value = col_results$value,
|
||||
ci_min = col_results$ci_min,
|
||||
ci_max = col_results$ci_max,
|
||||
isolates = col_results$isolates,
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
if (data_has_groups) {
|
||||
if (nrow(group_values) < nrow(out_new)) {
|
||||
# repeat group_values for the number of rows in out_new
|
||||
repeated <- rep(seq_len(nrow(group_values)),
|
||||
each = nrow(out_new) / nrow(group_values)
|
||||
)
|
||||
group_values <- group_values[repeated, , drop = FALSE]
|
||||
}
|
||||
out_new <- cbind(group_values, out_new)
|
||||
}
|
||||
out <- rbind_AMR(out, out_new)
|
||||
}
|
||||
}
|
||||
out
|
||||
}
|
||||
|
||||
# based on pm_apply_grouped_function
|
||||
apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
|
||||
grouped <- pm_split_into_groups(.data, groups, drop)
|
||||
res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
|
||||
if (any(groups %in% colnames(res))) {
|
||||
class(res) <- c("grouped_data", class(res))
|
||||
res <- pm_set_groups(res, groups[groups %in% colnames(res)])
|
||||
}
|
||||
res
|
||||
}
|
||||
|
||||
if (data_has_groups) {
|
||||
out <- apply_group(data, "sum_it", groups)
|
||||
} else {
|
||||
out <- sum_it(data)
|
||||
}
|
||||
|
||||
# apply factors for right sorting in interpretation
|
||||
if (isTRUE(combine_SI)) {
|
||||
out$interpretation <- factor(out$interpretation, levels = c("SI", "R"), ordered = TRUE)
|
||||
} else {
|
||||
# don't use as.sir() here, as it would add the class 'sir' and we would like
|
||||
# the same data structure as output, regardless of input
|
||||
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])
|
||||
} else {
|
||||
out <- out[order(out$antibiotic, out$interpretation), , drop = FALSE]
|
||||
}
|
||||
|
||||
if (type == "proportion") {
|
||||
# remove number of isolates
|
||||
out <- subset(out, select = -c(isolates))
|
||||
} else if (type == "count") {
|
||||
# set value to be number of isolates
|
||||
out$value <- out$isolates
|
||||
# remove redundant columns
|
||||
out <- subset(out, select = -c(ci_min, ci_max, isolates))
|
||||
}
|
||||
|
||||
as_original_data_class(out, class(data.bak), extra_class = "sir_df") # will remove tibble groups
|
||||
}
|
||||
-52
@@ -1,52 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' @rdname proportion
|
||||
#' @export
|
||||
sir_df <- function(data,
|
||||
translate_ab = "name",
|
||||
language = get_AMR_locale(),
|
||||
minimum = 30,
|
||||
as_percent = FALSE,
|
||||
combine_SI = TRUE,
|
||||
confidence_level = 0.95) {
|
||||
tryCatch(
|
||||
sir_calc_df(
|
||||
type = "both",
|
||||
data = data,
|
||||
translate_ab = translate_ab,
|
||||
language = language,
|
||||
minimum = minimum,
|
||||
as_percent = as_percent,
|
||||
combine_SI = combine_SI,
|
||||
confidence_level = confidence_level
|
||||
),
|
||||
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
|
||||
)
|
||||
}
|
||||
@@ -1,74 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Skewness of the Sample
|
||||
#'
|
||||
#' @description Skewness is a measure of the asymmetry of the probability distribution of a real-valued random variable about its mean.
|
||||
#'
|
||||
#' When negative ('left-skewed'): the left tail is longer; the mass of the distribution is concentrated on the right of a histogram. When positive ('right-skewed'): the right tail is longer; the mass of the distribution is concentrated on the left of a histogram. A normal distribution has a skewness of 0.
|
||||
#' @param x A vector of values, a [matrix] or a [data.frame].
|
||||
#' @param na.rm A [logical] value indicating whether `NA` values should be stripped before the computation proceeds.
|
||||
#' @seealso [kurtosis()]
|
||||
#' @rdname skewness
|
||||
#' @export
|
||||
#' @examples
|
||||
#' skewness(runif(1000))
|
||||
skewness <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
UseMethod("skewness")
|
||||
}
|
||||
|
||||
#' @method skewness default
|
||||
#' @rdname skewness
|
||||
#' @export
|
||||
skewness.default <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
x <- as.vector(x)
|
||||
if (isTRUE(na.rm)) {
|
||||
x <- x[!is.na(x)]
|
||||
}
|
||||
n <- length(x)
|
||||
(sum((x - mean(x))^3) / n) / (sum((x - mean(x))^2) / n)^(3 / 2)
|
||||
}
|
||||
|
||||
#' @method skewness matrix
|
||||
#' @rdname skewness
|
||||
#' @export
|
||||
skewness.matrix <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
apply(x, 2, skewness.default, na.rm = na.rm)
|
||||
}
|
||||
|
||||
#' @method skewness data.frame
|
||||
#' @rdname skewness
|
||||
#' @export
|
||||
skewness.data.frame <- function(x, na.rm = FALSE) {
|
||||
meet_criteria(na.rm, allow_class = "logical", has_length = 1)
|
||||
vapply(FUN.VALUE = double(1), x, skewness.default, na.rm = na.rm)
|
||||
}
|
||||
Binary file not shown.
@@ -1,104 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' 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. When using `"species"` (default) or `"subpecies"`, the genus will be added to make sure each (sub)species still belongs to the right genus.
|
||||
#' @param n_for_each An optional integer specifying the maximum number of rows to retain for each value of the selected property. If `NULL`, all rows within the top *n* groups will be included.
|
||||
#' @param col_mo A character string indicating the column in `x` that contains microorganism names or codes. Defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||
#' @param ... Additional arguments passed on to [mo_property()] when `property` is not `NULL`.
|
||||
#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data. 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 = "species", n_for_each = NULL, col_mo = NULL, ...) {
|
||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||
meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
|
||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
|
||||
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 if (property == "species") {
|
||||
x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...))
|
||||
} else if (property == "subspecies") {
|
||||
x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...), mo_subspecies(x[[col_mo]], ...))
|
||||
} else {
|
||||
x$prop_val <- mo_property(x[[col_mo]], property = property, ...)
|
||||
}
|
||||
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]
|
||||
}
|
||||
-291
@@ -1,291 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Translate Strings from the AMR Package
|
||||
#'
|
||||
#' For language-dependent output of `AMR` functions, such as [mo_name()], [mo_gramstain()], [mo_type()] and [ab_name()].
|
||||
#' @param x Text to translate.
|
||||
#' @param language Language to choose. Use one of these supported language names or [ISO 639-1 codes](https://en.wikipedia.org/wiki/ISO_639-1): `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
|
||||
#' @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_locale`][AMR-options] in your `.Rprofile` file like this:
|
||||
#'
|
||||
#' ```r
|
||||
#' # Open .Rprofile file
|
||||
#' utils::file.edit("~/.Rprofile")
|
||||
#'
|
||||
#' # Then add e.g. Italian support to that file using:
|
||||
#' options(AMR_locale = "Italian")
|
||||
#' ```
|
||||
#'
|
||||
#' And then save the file.
|
||||
#'
|
||||
#' Please read about adding or updating a language in [our Wiki](https://github.com/msberends/AMR/wiki/).
|
||||
#'
|
||||
#' ### Changing the Default Language
|
||||
#' The system language will be used at default (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_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_locale`][AMR-options] is set, the system variables `LANGUAGE` and `LANG` will be ignored.
|
||||
#' @rdname translate
|
||||
#' @name translate
|
||||
#' @export
|
||||
#' @examples
|
||||
#' # Current settings (based on system language)
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # setting another language
|
||||
#' set_AMR_locale("Dutch")
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # setting yet another language
|
||||
#' set_AMR_locale("German")
|
||||
#' ab_name("Ciprofloxacin")
|
||||
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
|
||||
#'
|
||||
#' # set_AMR_locale() understands endonyms, English exonyms, and ISO 639-1:
|
||||
#' set_AMR_locale("Deutsch")
|
||||
#' set_AMR_locale("German")
|
||||
#' set_AMR_locale("de")
|
||||
#' ab_name("amox/clav")
|
||||
#'
|
||||
#' # reset to system default
|
||||
#' reset_AMR_locale()
|
||||
#' ab_name("amox/clav")
|
||||
get_AMR_locale <- function() {
|
||||
# a message for this will be thrown in translate_into_language() if outcome is non-English
|
||||
if (!is.null(getOption("AMR_locale"))) {
|
||||
return(validate_language(getOption("AMR_locale"), extra_txt = "set with `options(AMR_locale = ...)`"))
|
||||
}
|
||||
lang <- ""
|
||||
# now check the LANGUAGE system variable - return it if set
|
||||
if (!identical("", Sys.getenv("LANGUAGE"))) {
|
||||
lang <- Sys.getenv("LANGUAGE")
|
||||
}
|
||||
if (!identical("", Sys.getenv("LANG"))) {
|
||||
lang <- Sys.getenv("LANG")
|
||||
}
|
||||
if (lang == "") {
|
||||
lang <- Sys.getlocale("LC_COLLATE")
|
||||
}
|
||||
find_language(lang)
|
||||
}
|
||||
|
||||
#' @rdname translate
|
||||
#' @export
|
||||
set_AMR_locale <- function(language) {
|
||||
language <- validate_language(language)
|
||||
options(AMR_locale = language)
|
||||
if (interactive() || identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
# show which language to use now
|
||||
message_(
|
||||
"Using ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym,
|
||||
ifelse(language != "en",
|
||||
paste0(" (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ")"),
|
||||
""
|
||||
),
|
||||
" for the AMR package for this session."
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname translate
|
||||
#' @export
|
||||
reset_AMR_locale <- function() {
|
||||
options(AMR_locale = NULL)
|
||||
if (interactive() || identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
# show which language to use now
|
||||
language <- suppressMessages(get_AMR_locale())
|
||||
message_("Using the ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym, " language (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ") for the AMR package for this session.")
|
||||
}
|
||||
}
|
||||
|
||||
#' @rdname translate
|
||||
#' @export
|
||||
translate_AMR <- function(x, language = get_AMR_locale()) {
|
||||
translate_into_language(x,
|
||||
language = language,
|
||||
only_unknown = FALSE,
|
||||
only_affect_ab_names = FALSE,
|
||||
only_affect_mo_names = FALSE
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
validate_language <- function(language, extra_txt = character(0)) {
|
||||
if (length(language) == 0 || isTRUE(trimws2(tolower(language[1])) %in% c("en", "english", "", "false", NA))) {
|
||||
return("en")
|
||||
} else if (language[1] %in% LANGUAGES_SUPPORTED) {
|
||||
return(language[1])
|
||||
}
|
||||
lang <- find_language(language[1], fallback = FALSE)
|
||||
stop_ifnot(length(lang) > 0 && lang %in% LANGUAGES_SUPPORTED,
|
||||
"unsupported language for AMR package", extra_txt, ": \"", language, "\". Use one of these language names or ISO 639-1 codes: ",
|
||||
paste0('"', vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]),
|
||||
'" ("', LANGUAGES_SUPPORTED, '")',
|
||||
collapse = ", "
|
||||
),
|
||||
call = FALSE
|
||||
)
|
||||
lang
|
||||
}
|
||||
|
||||
find_language <- function(language, fallback = TRUE) {
|
||||
language <- Map(LANGUAGES_SUPPORTED_NAMES,
|
||||
LANGUAGES_SUPPORTED,
|
||||
f = function(l, n, check = language) {
|
||||
grepl(
|
||||
paste0(
|
||||
"^(", l[1], "|", l[2], "|",
|
||||
n, "(_|$)|", toupper(n), "(_|$))"
|
||||
),
|
||||
check,
|
||||
ignore.case = TRUE,
|
||||
perl = TRUE,
|
||||
useBytes = FALSE
|
||||
)
|
||||
},
|
||||
USE.NAMES = TRUE
|
||||
)
|
||||
language <- names(which(language == TRUE))
|
||||
if (isTRUE(fallback) && length(language) == 0) {
|
||||
# other language -> set to English
|
||||
language <- "en"
|
||||
}
|
||||
language
|
||||
}
|
||||
|
||||
# translate strings based on inst/translations.tsv
|
||||
translate_into_language <- function(from,
|
||||
language = get_AMR_locale(),
|
||||
only_unknown = FALSE,
|
||||
only_affect_ab_names = FALSE,
|
||||
only_affect_mo_names = FALSE) {
|
||||
# get ISO 639-1 of language
|
||||
lang <- validate_language(language)
|
||||
if (lang == "en") {
|
||||
# don' translate
|
||||
return(from)
|
||||
}
|
||||
|
||||
df_trans <- TRANSLATIONS # internal data file
|
||||
from.bak <- from
|
||||
from_unique <- unique(from)
|
||||
from_split_combined <- function(vec) {
|
||||
sapply(vec, function(x) {
|
||||
if (grepl("/", x, fixed = TRUE)) {
|
||||
parts <- strsplit(x, "/", fixed = TRUE)[[1]]
|
||||
# Translate each part separately
|
||||
translated_parts <- translate_into_language(
|
||||
parts,
|
||||
language = lang,
|
||||
only_unknown = only_unknown,
|
||||
only_affect_ab_names = only_affect_ab_names,
|
||||
only_affect_mo_names = only_affect_mo_names
|
||||
)
|
||||
paste(translated_parts, collapse = "/")
|
||||
} else {
|
||||
x
|
||||
}
|
||||
}, USE.NAMES = FALSE)
|
||||
}
|
||||
from_unique_translated <- from_split_combined(from_unique)
|
||||
|
||||
# only keep lines where translation is available for this language
|
||||
df_trans <- df_trans[which(!is.na(df_trans[, lang, drop = TRUE])), , drop = FALSE]
|
||||
# and where the original string is not equal to the string in the target language
|
||||
df_trans <- df_trans[which(df_trans[, "pattern", drop = TRUE] != df_trans[, lang, drop = TRUE]), , drop = FALSE]
|
||||
if (only_unknown == TRUE) {
|
||||
df_trans <- subset(df_trans, pattern %like% "unknown")
|
||||
}
|
||||
if (only_affect_ab_names == TRUE) {
|
||||
df_trans <- subset(df_trans, affect_ab_name == TRUE)
|
||||
}
|
||||
if (only_affect_mo_names == TRUE) {
|
||||
df_trans <- subset(df_trans, affect_mo_name == TRUE)
|
||||
}
|
||||
if (NROW(df_trans) == 0) {
|
||||
return(from)
|
||||
}
|
||||
|
||||
# default: case sensitive if value if 'case_sensitive' is missing:
|
||||
df_trans$case_sensitive[is.na(df_trans$case_sensitive)] <- TRUE
|
||||
# default: not using regular expressions if 'regular_expr' is missing:
|
||||
df_trans$regular_expr[is.na(df_trans$regular_expr)] <- FALSE
|
||||
|
||||
# check if text to look for is in one of the patterns
|
||||
any_form_in_patterns <- tryCatch(
|
||||
any(from_unique %like% paste0("(", paste(gsub(" +\\(.*", "", df_trans$pattern), collapse = "|"), ")")),
|
||||
error = function(e) {
|
||||
warning_("Translation not possible. Please create an issue at ", font_url("https://github.com/msberends/AMR/issues"), ". Many thanks!")
|
||||
return(FALSE)
|
||||
}
|
||||
)
|
||||
|
||||
if (NROW(df_trans) == 0 | !any_form_in_patterns) {
|
||||
return(from)
|
||||
}
|
||||
|
||||
lapply(
|
||||
# starting with longest pattern, since more general translations are shorter, such as 'Group'
|
||||
order(nchar(df_trans$pattern), decreasing = TRUE),
|
||||
function(i) {
|
||||
from_unique_translated <<- gsub(
|
||||
pattern = df_trans$pattern[i],
|
||||
replacement = df_trans[i, lang, drop = TRUE],
|
||||
x = from_unique_translated,
|
||||
ignore.case = !df_trans$case_sensitive[i] & df_trans$regular_expr[i],
|
||||
fixed = !df_trans$regular_expr[i],
|
||||
perl = df_trans$regular_expr[i]
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
# force UTF-8 for diacritics
|
||||
from_unique_translated <- enc2utf8(from_unique_translated)
|
||||
|
||||
# a kind of left join to get all results back
|
||||
out <- from_unique_translated[match(from.bak, from_unique)]
|
||||
|
||||
if (!identical(from.bak, out) && get_AMR_locale() == lang && is.null(getOption("AMR_locale", default = NULL)) && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||
message(word_wrap(
|
||||
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
|
||||
LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. See `set_AMR_locale()` to change this or to silence this once-per-session note.",
|
||||
add_fn = list(font_blue), as_note = TRUE
|
||||
))
|
||||
}
|
||||
|
||||
out
|
||||
}
|
||||
@@ -1,202 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# These are all S3 implementations for the vctrs package,
|
||||
# that is used internally by tidyverse packages such as dplyr.
|
||||
# They are to convert AMR-specific classes to bare characters and integers.
|
||||
# All of them will be exported using s3_register() in R/zzz.R when loading the package.
|
||||
|
||||
# see https://github.com/tidyverse/dplyr/issues/5955 why this is required
|
||||
|
||||
# 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.amr_selector.character <- function(x, y, ...) {
|
||||
y
|
||||
}
|
||||
vec_cast.character.amr_selector <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
|
||||
# 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.amr_selector_any_all.logical <- function(x, y, ...) {
|
||||
y
|
||||
}
|
||||
vec_cast.logical.amr_selector_any_all <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
|
||||
# S3: ab ----
|
||||
vec_ptype2.ab.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.ab.ab <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.ab <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
}
|
||||
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.av.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.av.av <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.av <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
}
|
||||
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.mo.default <- function(x, y, ..., x_arg = "", y_arg = "") {
|
||||
x
|
||||
}
|
||||
vec_ptype2.mo.mo <- function(x, y, ...) {
|
||||
x
|
||||
}
|
||||
vec_cast.character.mo <- function(x, to, ...) {
|
||||
as.character(x)
|
||||
}
|
||||
vec_cast.mo.character <- function(x, to, ...) {
|
||||
add_MO_lookup_to_AMR_env()
|
||||
return_after_integrity_check(x, "microorganism code", as.character(AMR_env$MO_lookup$mo))
|
||||
}
|
||||
|
||||
# S3: disk ----
|
||||
vec_ptype_full.disk <- function(x, ...) {
|
||||
"disk"
|
||||
}
|
||||
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)
|
||||
}
|
||||
vec_cast.disk.integer <- function(x, to, ...) {
|
||||
as.disk(x)
|
||||
}
|
||||
vec_cast.double.disk <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
vec_cast.disk.double <- function(x, to, ...) {
|
||||
as.disk(x)
|
||||
}
|
||||
vec_cast.character.disk <- function(x, to, ...) {
|
||||
unclass(x)
|
||||
}
|
||||
vec_cast.disk.character <- function(x, to, ...) {
|
||||
as.disk(x)
|
||||
}
|
||||
|
||||
# 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), ...)
|
||||
}
|
||||
vec_arith.mic <- function(op, x, y, ...) {
|
||||
vctrs::vec_arith(op, as.double(x), as.double(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)
|
||||
}
|
||||
vec_cast.sir.character <- function(x, to, ...) {
|
||||
as.sir(x)
|
||||
}
|
||||
@@ -1,49 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' WHOCC: WHO Collaborating Centre for Drug Statistics Methodology
|
||||
#'
|
||||
#' All antimicrobial drugs and their official names, ATC codes, ATC groups and defined daily dose (DDD) are included in this package, using the WHO Collaborating Centre for Drug Statistics Methodology.
|
||||
#' @section WHOCC:
|
||||
#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/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://atcddd.fhi.no/copyright_disclaimer/.>
|
||||
|
||||
#' @name WHOCC
|
||||
#' @rdname WHOCC
|
||||
#' @examples
|
||||
#' as.ab("meropenem")
|
||||
#' ab_name("J01DH02")
|
||||
#'
|
||||
#' ab_tradenames("flucloxacillin")
|
||||
NULL
|
||||
@@ -1,113 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Deprecated Functions, Arguments, or Datasets
|
||||
#'
|
||||
#' These objects are so-called '[Deprecated]'. **They will be removed in a future version of this package.** Using these will give a warning with the name of the alternative object it has been replaced by (if there is one).
|
||||
#' @keywords internal
|
||||
#' @name AMR-deprecated
|
||||
#' @rdname AMR-deprecated
|
||||
NULL
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @usage NULL
|
||||
#' @export
|
||||
"antibiotics"
|
||||
|
||||
# REMEMBER to search for `deprecation_warning` in the package code to find all instances.
|
||||
# currently deprecated arguments at least:
|
||||
# - `antibiotics` in `antibiogram()`
|
||||
# - `converse_capped_values` in `as.sir()`
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ab_class <- function(...) {
|
||||
deprecation_warning("ab_class", "amr_class", is_function = TRUE)
|
||||
amr_class(...)
|
||||
}
|
||||
|
||||
#' @rdname AMR-deprecated
|
||||
#' @export
|
||||
ab_selector <- function(...) {
|
||||
deprecation_warning("ab_selector", "amr_selector", is_function = TRUE)
|
||||
amr_selector(...)
|
||||
}
|
||||
|
||||
## Helper function ----
|
||||
|
||||
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 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
|
||||
if (isTRUE(is_function)) {
|
||||
old <- paste0(old, "()")
|
||||
if (!is.null(new)) {
|
||||
new <- paste0(new, "()")
|
||||
}
|
||||
type <- "function"
|
||||
} 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 deprecated"),
|
||||
ifelse(type == "dataset",
|
||||
paste0("The `", old, "` ", type, " has been renamed to `", new, "`"),
|
||||
ifelse(type == "argument",
|
||||
paste0("The `", old, "` ", type, " in `", fn, "()` has been replaced with `", new, "`: `", fn, "(", new, " = ...)`"),
|
||||
paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
|
||||
)
|
||||
)
|
||||
),
|
||||
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),
|
||||
""
|
||||
),
|
||||
"\nThis warning will be shown once per session."
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,258 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
# set up package environment, used by numerous AMR functions
|
||||
AMR_env <- new.env(hash = TRUE, parent = emptyenv())
|
||||
AMR_env$mo_uncertainties <- data.frame(
|
||||
original_input = character(0),
|
||||
input = character(0),
|
||||
fullname = character(0),
|
||||
mo = character(0),
|
||||
candidates = character(0),
|
||||
minimum_matching_score = integer(0),
|
||||
keep_synonyms = logical(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
AMR_env$mo_renamed <- list()
|
||||
AMR_env$mo_previously_coerced <- data.frame(
|
||||
x = character(0),
|
||||
mo = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
AMR_env$ab_previously_coerced <- data.frame(
|
||||
x = character(0),
|
||||
ab = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
AMR_env$av_previously_coerced <- data.frame(
|
||||
x = character(0),
|
||||
av = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
AMR_env$sir_interpretation_history <- data.frame(
|
||||
datetime = Sys.time()[0],
|
||||
index = integer(0),
|
||||
method = character(0),
|
||||
ab_given = character(0),
|
||||
mo_given = character(0),
|
||||
host_given = character(0),
|
||||
input_given = character(0),
|
||||
ab = set_clean_class(character(0), c("ab", "character")),
|
||||
mo = set_clean_class(character(0), c("mo", "character")),
|
||||
host = 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),
|
||||
site = character(0),
|
||||
stringsAsFactors = FALSE
|
||||
)
|
||||
|
||||
|
||||
AMR_env$custom_ab_codes <- character(0)
|
||||
AMR_env$custom_mo_codes <- character(0)
|
||||
AMR_env$is_dark_theme <- NULL
|
||||
AMR_env$supports_colour <- NULL
|
||||
AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
|
||||
AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
|
||||
|
||||
# take cli symbols and error function if available
|
||||
AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
|
||||
AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
|
||||
AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
|
||||
AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
|
||||
AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
|
||||
AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
|
||||
|
||||
.onLoad <- function(libname, pkgname) {
|
||||
# Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
|
||||
# without the need to depend on other packages. This was suggested by the
|
||||
# developers of the vctrs package:
|
||||
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
|
||||
s3_register("pillar::pillar_shaft", "ab")
|
||||
s3_register("pillar::pillar_shaft", "av")
|
||||
s3_register("pillar::pillar_shaft", "mo")
|
||||
s3_register("pillar::pillar_shaft", "sir")
|
||||
s3_register("pillar::pillar_shaft", "mic")
|
||||
s3_register("pillar::pillar_shaft", "disk")
|
||||
# no type_sum of disk, that's now in vctrs::vec_ptype_full
|
||||
s3_register("pillar::type_sum", "ab")
|
||||
s3_register("pillar::type_sum", "av")
|
||||
s3_register("pillar::type_sum", "mo")
|
||||
s3_register("pillar::type_sum", "sir")
|
||||
s3_register("pillar::type_sum", "mic")
|
||||
s3_register("pillar::tbl_sum", "antibiogram")
|
||||
s3_register("pillar::tbl_format_footer", "antibiogram")
|
||||
# Support for frequency tables from the cleaner package
|
||||
s3_register("cleaner::freq", "mo")
|
||||
s3_register("cleaner::freq", "sir")
|
||||
# Support for skim() from the skimr package
|
||||
if (pkg_is_available("skimr", min_version = "2.0.0")) {
|
||||
s3_register("skimr::get_skimmers", "mo")
|
||||
s3_register("skimr::get_skimmers", "sir")
|
||||
s3_register("skimr::get_skimmers", "mic")
|
||||
s3_register("skimr::get_skimmers", "disk")
|
||||
}
|
||||
# Support for autoplot() from the ggplot2 package
|
||||
s3_register("ggplot2::autoplot", "sir")
|
||||
s3_register("ggplot2::autoplot", "mic")
|
||||
s3_register("ggplot2::autoplot", "disk")
|
||||
s3_register("ggplot2::autoplot", "resistance_predict")
|
||||
s3_register("ggplot2::autoplot", "antibiogram")
|
||||
# Support for fortify from the ggplot2 package
|
||||
s3_register("ggplot2::fortify", "sir")
|
||||
s3_register("ggplot2::fortify", "mic")
|
||||
s3_register("ggplot2::fortify", "disk")
|
||||
# Support for knitr (R Markdown/Quarto)
|
||||
s3_register("knitr::knit_print", "antibiogram")
|
||||
s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
|
||||
# Support vctrs package for use in e.g. dplyr verbs
|
||||
# (NOTE 2024-02-22 this is the right way - it should be 2 '.'-separated S3 classes in the second argument)
|
||||
# S3: amr_selector
|
||||
s3_register("vctrs::vec_ptype2", "character.amr_selector")
|
||||
s3_register("vctrs::vec_ptype2", "amr_selector.character")
|
||||
s3_register("vctrs::vec_cast", "character.amr_selector")
|
||||
# S3: amr_selector_any_all
|
||||
s3_register("vctrs::vec_ptype2", "logical.amr_selector_any_all")
|
||||
s3_register("vctrs::vec_ptype2", "amr_selector_any_all.logical")
|
||||
s3_register("vctrs::vec_cast", "logical.amr_selector_any_all")
|
||||
# S3: ab
|
||||
s3_register("vctrs::vec_ptype2", "ab.default")
|
||||
s3_register("vctrs::vec_ptype2", "ab.ab")
|
||||
s3_register("vctrs::vec_cast", "character.ab")
|
||||
s3_register("vctrs::vec_cast", "ab.character")
|
||||
# S3: av
|
||||
s3_register("vctrs::vec_ptype2", "av.default")
|
||||
s3_register("vctrs::vec_ptype2", "av.av")
|
||||
s3_register("vctrs::vec_cast", "character.av")
|
||||
s3_register("vctrs::vec_cast", "av.character")
|
||||
# S3: mo
|
||||
s3_register("vctrs::vec_ptype2", "mo.default")
|
||||
s3_register("vctrs::vec_ptype2", "mo.mo")
|
||||
s3_register("vctrs::vec_cast", "character.mo")
|
||||
s3_register("vctrs::vec_cast", "mo.character")
|
||||
# S3: disk
|
||||
s3_register("vctrs::vec_ptype_full", "disk")
|
||||
s3_register("vctrs::vec_ptype_abbr", "disk")
|
||||
s3_register("vctrs::vec_ptype2", "disk.default")
|
||||
s3_register("vctrs::vec_ptype2", "disk.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.disk")
|
||||
s3_register("vctrs::vec_cast", "integer.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.integer")
|
||||
s3_register("vctrs::vec_cast", "double.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.double")
|
||||
s3_register("vctrs::vec_cast", "character.disk")
|
||||
s3_register("vctrs::vec_cast", "disk.character")
|
||||
# S3: mic
|
||||
s3_register("vctrs::vec_ptype2", "mic.default")
|
||||
s3_register("vctrs::vec_ptype2", "mic.mic")
|
||||
s3_register("vctrs::vec_cast", "character.mic")
|
||||
s3_register("vctrs::vec_cast", "double.mic")
|
||||
s3_register("vctrs::vec_cast", "integer.mic")
|
||||
s3_register("vctrs::vec_cast", "factor.mic")
|
||||
s3_register("vctrs::vec_cast", "mic.character")
|
||||
s3_register("vctrs::vec_cast", "mic.double")
|
||||
s3_register("vctrs::vec_cast", "mic.integer")
|
||||
s3_register("vctrs::vec_cast", "mic.factor")
|
||||
s3_register("vctrs::vec_cast", "mic.mic")
|
||||
s3_register("vctrs::vec_math", "mic")
|
||||
s3_register("vctrs::vec_arith", "mic")
|
||||
# S3: sir
|
||||
s3_register("vctrs::vec_ptype2", "sir.default")
|
||||
s3_register("vctrs::vec_ptype2", "sir.sir")
|
||||
s3_register("vctrs::vec_ptype2", "character.sir")
|
||||
s3_register("vctrs::vec_cast", "character.sir")
|
||||
s3_register("vctrs::vec_cast", "sir.character")
|
||||
s3_register("vctrs::vec_cast", "sir.sir")
|
||||
|
||||
# if mo source exists, fire it up (see mo_source())
|
||||
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
|
||||
try(invisible(get_mo_source()), silent = TRUE)
|
||||
}
|
||||
# be sure to print tibbles as tibbles
|
||||
if (pkg_is_available("tibble")) {
|
||||
try(loadNamespace("tibble"), silent = TRUE)
|
||||
}
|
||||
|
||||
# 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)
|
||||
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(libname, pkgname) {
|
||||
# if custom ab option is available, load it
|
||||
if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
|
||||
if (getOption("AMR_custom_ab") %unlike% "[.]rds$") {
|
||||
packageStartupMessage("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 = ""))) {
|
||||
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)
|
||||
)
|
||||
}
|
||||
}
|
||||
}
|
||||
-61
@@ -1,61 +0,0 @@
|
||||
---
|
||||
output: github_document
|
||||
---
|
||||
|
||||
<!-- README.md is generated from README.Rmd; please edit that file. -->
|
||||
|
||||
```{r, include = FALSE}
|
||||
knitr::opts_chunk$set(
|
||||
collapse = TRUE,
|
||||
comment = "#>",
|
||||
# fig.path = "man/figures/README-",
|
||||
out.width = "100%"
|
||||
)
|
||||
AMR:::reset_all_thrown_messages()
|
||||
```
|
||||
|
||||
# The `AMR` Package for R
|
||||
|
||||
Please visit our comprehensive package website <https://amr-for-r.org> to read more about this package, including many examples and tutorials.
|
||||
|
||||
Overview:
|
||||
|
||||
* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach
|
||||
* Peer-reviewed, used in over 175 countries, available in `r length(AMR:::LANGUAGES_SUPPORTED)` languages
|
||||
* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA
|
||||
* Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs
|
||||
* Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation
|
||||
* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class
|
||||
* 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**
|
||||
|
||||
----
|
||||
|
||||
The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
||||
|
||||
The `AMR` package supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
||||
|
||||
----
|
||||
|
||||
### How to get this package
|
||||
|
||||
To install the latest 'release' version from CRAN:
|
||||
|
||||
```{r, eval = FALSE}
|
||||
install.packages("AMR")
|
||||
```
|
||||
|
||||
To install the latest 'beta' version:
|
||||
|
||||
```{r, eval = FALSE}
|
||||
install.packages("AMR", repos = "beta.amr-for-r.org")
|
||||
|
||||
# if this does not work, try to install directly from GitHub using the 'remotes' package:
|
||||
remotes::install_github("msberends/AMR")
|
||||
```
|
||||
|
||||
----
|
||||
|
||||
<small>
|
||||
This AMR package for R is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](https://amr-for-r.org/LICENSE-text.html). These requirements are consequently legally binding: modifications must be released under the same license when distributing the package, changes made to the code must be documented, source code must be made available when the package is distributed, and a copy of the license and copyright notice must be included with the package.
|
||||
</small>
|
||||
@@ -1,75 +1,226 @@
|
||||
|
||||
<!-- README.md is generated from README.Rmd; please edit that file. -->
|
||||
The `AMR` package for R is a powerful tool for antimicrobial resistance (AMR) analysis. It provides extensive features for handling microbial and antimicrobial data. However, for those who work primarily in Python, we now have a more intuitive option available: the [`AMR` Python package](https://pypi.org/project/AMR/).
|
||||
|
||||
# The `AMR` Package for R
|
||||
This Python package is a wrapper around the `AMR` R package. It uses the `rpy2` package internally. Despite the need to have R installed, Python users can now easily work with AMR data directly through Python code.
|
||||
|
||||
Please visit our comprehensive package website <https://amr-for-r.org>
|
||||
to read more about this package, including many examples and tutorials.
|
||||
# Prerequisites
|
||||
|
||||
Overview:
|
||||
This package was only tested with a [virtual environment (venv)](https://docs.python.org/3/library/venv.html). You can set up such an environment by running:
|
||||
|
||||
- Provides an **all-in-one solution** for antimicrobial resistance (AMR)
|
||||
data analysis in a One Health approach
|
||||
- Peer-reviewed, used in over 175 countries, available in 28 languages
|
||||
- Generates **antibiograms** - traditional, combined, syndromic, and
|
||||
even WISCA
|
||||
- Provides the **full microbiological taxonomy** of ~79 000 distinct
|
||||
species and extensive info of ~620 antimicrobial drugs
|
||||
- Applies **CLSI 2011-2025** and **EUCAST 2011-2025** clinical and
|
||||
veterinary breakpoints, and ECOFFs, for MIC and disk zone
|
||||
interpretation
|
||||
- Corrects for duplicate isolates, **calculates** and **predicts** AMR
|
||||
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**
|
||||
```python
|
||||
# linux and macOS:
|
||||
python -m venv /path/to/new/virtual/environment
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
The `AMR` package is a peer-reviewed, free and open-source R package
|
||||
with zero dependencies to simplify the analysis and prediction of
|
||||
Antimicrobial Resistance (AMR) and to work with microbial and
|
||||
antimicrobial data and properties, by using evidence-based methods.
|
||||
**Our aim is to provide a standard** for clean and reproducible AMR data
|
||||
analysis, that can therefore empower epidemiological analyses to
|
||||
continuously enable surveillance and treatment evaluation in any
|
||||
setting.
|
||||
|
||||
The `AMR` package supports and can read any data format, including
|
||||
WHONET data. This package works on Windows, macOS and Linux with all
|
||||
versions of R since R-3.0 (April 2013). **It was designed to work in any
|
||||
setting, including those with very limited resources**. It was created
|
||||
for both routine data analysis and academic research at the Faculty of
|
||||
Medical Sciences of the [University of Groningen](https://www.rug.nl)
|
||||
and the [University Medical Center Groningen](https://www.umcg.nl).
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
### How to get this package
|
||||
|
||||
To install the latest ‘release’ version from CRAN:
|
||||
|
||||
``` r
|
||||
install.packages("AMR")
|
||||
# Windows:
|
||||
python -m venv C:\path\to\new\virtual\environment
|
||||
```
|
||||
|
||||
To install the latest ‘beta’ version:
|
||||
Then you can [activate the environment](https://docs.python.org/3/library/venv.html#how-venvs-work), after which the venv is ready to work with.
|
||||
|
||||
``` r
|
||||
install.packages("AMR", repos = "beta.amr-for-r.org")
|
||||
# Install AMR
|
||||
|
||||
# if this does not work, try to install directly from GitHub using the 'remotes' package:
|
||||
remotes::install_github("msberends/AMR")
|
||||
1. Since the Python package is available on the official [Python Package Index](https://pypi.org/project/AMR/), you can just run:
|
||||
|
||||
```bash
|
||||
pip install AMR
|
||||
```
|
||||
|
||||
2. Make sure you have R installed. There is **no need to install the `AMR` R package**, as it will be installed automatically.
|
||||
|
||||
For Linux:
|
||||
|
||||
```bash
|
||||
# Ubuntu / Debian
|
||||
sudo apt install r-base
|
||||
# Fedora:
|
||||
sudo dnf install R
|
||||
# CentOS/RHEL
|
||||
sudo yum install R
|
||||
```
|
||||
|
||||
For macOS (using [Homebrew](https://brew.sh)):
|
||||
|
||||
```bash
|
||||
brew install r
|
||||
```
|
||||
|
||||
For Windows, visit the [CRAN download page](https://cran.r-project.org) to download and install R.
|
||||
|
||||
# Examples of Usage
|
||||
|
||||
## Cleaning Taxonomy
|
||||
|
||||
Here’s an example that demonstrates how to clean microorganism and drug names using the `AMR` Python package:
|
||||
|
||||
```python
|
||||
import pandas as pd
|
||||
import AMR
|
||||
|
||||
# Sample data
|
||||
data = {
|
||||
"MOs": ['E. coli', 'ESCCOL', 'esco', 'Esche coli'],
|
||||
"Drug": ['Cipro', 'CIP', 'J01MA02', 'Ciproxin']
|
||||
}
|
||||
df = pd.DataFrame(data)
|
||||
|
||||
# Use AMR functions to clean microorganism and drug names
|
||||
df['MO_clean'] = AMR.mo_name(df['MOs'])
|
||||
df['Drug_clean'] = AMR.ab_name(df['Drug'])
|
||||
|
||||
# Display the results
|
||||
print(df)
|
||||
```
|
||||
|
||||
------------------------------------------------------------------------
|
||||
| MOs | Drug | MO_clean | Drug_clean |
|
||||
|-------------|-----------|--------------------|---------------|
|
||||
| E. coli | Cipro | Escherichia coli | Ciprofloxacin |
|
||||
| ESCCOL | CIP | Escherichia coli | Ciprofloxacin |
|
||||
| esco | J01MA02 | Escherichia coli | Ciprofloxacin |
|
||||
| Esche coli | Ciproxin | Escherichia coli | Ciprofloxacin |
|
||||
|
||||
<small> This AMR package for R is free, open-source software and
|
||||
licensed under the [GNU General Public License v2.0
|
||||
(GPL-2)](https://amr-for-r.org/LICENSE-text.html). These requirements
|
||||
are consequently legally binding: modifications must be released under
|
||||
the same license when distributing the package, changes made to the code
|
||||
must be documented, source code must be made available when the package
|
||||
is distributed, and a copy of the license and copyright notice must be
|
||||
included with the package. </small>
|
||||
### Explanation
|
||||
|
||||
* **mo_name:** This function standardises microorganism names. Here, different variations of *Escherichia coli* (such as "E. coli", "ESCCOL", "esco", and "Esche coli") are all converted into the correct, standardised form, "Escherichia coli".
|
||||
|
||||
* **ab_name**: Similarly, this function standardises antimicrobial names. The different representations of ciprofloxacin (e.g., "Cipro", "CIP", "J01MA02", and "Ciproxin") are all converted to the standard name, "Ciprofloxacin".
|
||||
|
||||
## Calculating AMR
|
||||
|
||||
```python
|
||||
import AMR
|
||||
import pandas as pd
|
||||
|
||||
df = AMR.example_isolates
|
||||
result = AMR.resistance(df["AMX"])
|
||||
print(result)
|
||||
```
|
||||
|
||||
```
|
||||
[0.59555556]
|
||||
```
|
||||
|
||||
## Generating Antibiograms
|
||||
|
||||
One of the core functions of the `AMR` package is generating an antibiogram, a table that summarises the antimicrobial susceptibility of bacterial isolates. Here’s how you can generate an antibiogram from Python:
|
||||
|
||||
```python
|
||||
result2a = AMR.antibiogram(df[["mo", "AMX", "CIP", "TZP"]])
|
||||
print(result2a)
|
||||
```
|
||||
|
||||
| Pathogen | Amoxicillin | Ciprofloxacin | Piperacillin/tazobactam |
|
||||
|-----------------|-----------------|-----------------|--------------------------|
|
||||
| CoNS | 7% (10/142) | 73% (183/252) | 30% (10/33) |
|
||||
| E. coli | 50% (196/392) | 88% (399/456) | 94% (393/416) |
|
||||
| K. pneumoniae | 0% (0/58) | 96% (53/55) | 89% (47/53) |
|
||||
| P. aeruginosa | 0% (0/30) | 100% (30/30) | None |
|
||||
| P. mirabilis | None | 94% (34/36) | None |
|
||||
| S. aureus | 6% (8/131) | 90% (171/191) | None |
|
||||
| S. epidermidis | 1% (1/91) | 64% (87/136) | None |
|
||||
| S. hominis | None | 80% (56/70) | None |
|
||||
| S. pneumoniae | 100% (112/112) | None | 100% (112/112) |
|
||||
|
||||
|
||||
```python
|
||||
result2b = AMR.antibiogram(df[["mo", "AMX", "CIP", "TZP"]], mo_transform = "gramstain")
|
||||
print(result2b)
|
||||
```
|
||||
|
||||
| Pathogen | Amoxicillin | Ciprofloxacin | Piperacillin/tazobactam |
|
||||
|----------------|-----------------|------------------|--------------------------|
|
||||
| Gram-negative | 36% (226/631) | 91% (621/684) | 88% (565/641) |
|
||||
| Gram-positive | 43% (305/703) | 77% (560/724) | 86% (296/345) |
|
||||
|
||||
|
||||
In this example, we generate an antibiogram by selecting various antibiotics.
|
||||
|
||||
## Taxonomic Data Sets Now in Python!
|
||||
|
||||
As a Python user, you might like that the most important data sets of the `AMR` R package, `microorganisms`, `antimicrobials`, `clinical_breakpoints`, and `example_isolates`, are now available as regular Python data frames:
|
||||
|
||||
```python
|
||||
AMR.microorganisms
|
||||
```
|
||||
|
||||
| mo | fullname | status | kingdom | gbif | gbif_parent | gbif_renamed_to | prevalence |
|
||||
|--------------|------------------------------------|----------|----------|-----------|-------------|-----------------|------------|
|
||||
| B_GRAMN | (unknown Gram-negatives) | unknown | Bacteria | None | None | None | 2.0 |
|
||||
| B_GRAMP | (unknown Gram-positives) | unknown | Bacteria | None | None | None | 2.0 |
|
||||
| B_ANAER-NEG | (unknown anaerobic Gram-negatives) | unknown | Bacteria | None | None | None | 2.0 |
|
||||
| B_ANAER-POS | (unknown anaerobic Gram-positives) | unknown | Bacteria | None | None | None | 2.0 |
|
||||
| B_ANAER | (unknown anaerobic bacteria) | unknown | Bacteria | None | None | None | 2.0 |
|
||||
| ... | ... | ... | ... | ... | ... | ... | ... |
|
||||
| B_ZYMMN_POMC | Zymomonas pomaceae | accepted | Bacteria | 10744418 | 3221412 | None | 2.0 |
|
||||
| B_ZYMPH | Zymophilus | synonym | Bacteria | None | 9475166 | None | 2.0 |
|
||||
| B_ZYMPH_PCVR | Zymophilus paucivorans | synonym | Bacteria | None | None | None | 2.0 |
|
||||
| B_ZYMPH_RFFN | Zymophilus raffinosivorans | synonym | Bacteria | None | None | None | 2.0 |
|
||||
| F_ZYZYG | Zyzygomyces | unknown | Fungi | None | 7581 | None | 2.0 |
|
||||
|
||||
```python
|
||||
AMR.antimicrobials
|
||||
```
|
||||
|
||||
| ab | cid | name | group | oral_ddd | oral_units | iv_ddd | iv_units |
|
||||
|-----|-------------|----------------------|----------------------------|----------|------------|--------|----------|
|
||||
| AMA | 4649.0 | 4-aminosalicylic acid| Antimycobacterials | 12.00 | g | NaN | None |
|
||||
| ACM | 6450012.0 | Acetylmidecamycin | Macrolides/lincosamides | NaN | None | NaN | None |
|
||||
| ASP | 49787020.0 | Acetylspiramycin | Macrolides/lincosamides | NaN | None | NaN | None |
|
||||
| ALS | 8954.0 | Aldesulfone sodium | Other antibacterials | 0.33 | g | NaN | None |
|
||||
| AMK | 37768.0 | Amikacin | Aminoglycosides | NaN | None | 1.0 | g |
|
||||
| ... | ... | ... | ... | ... | ... | ... | ... |
|
||||
| VIR | 11979535.0 | Virginiamycine | Other antibacterials | NaN | None | NaN | None |
|
||||
| VOR | 71616.0 | Voriconazole | Antifungals/antimycotics | 0.40 | g | 0.4 | g |
|
||||
| XBR | 72144.0 | Xibornol | Other antibacterials | NaN | None | NaN | None |
|
||||
| ZID | 77846445.0 | Zidebactam | Other antibacterials | NaN | None | NaN | None |
|
||||
| ZFD | NaN | Zoliflodacin | None | NaN | None | NaN | None |
|
||||
|
||||
|
||||
# Installation Channels
|
||||
|
||||
## Stable Release (CRAN)
|
||||
|
||||
The default `AMR` Python package uses the latest stable version of the `AMR` R package, published on CRAN. After running `pip install AMR`, import it as usual:
|
||||
|
||||
```python
|
||||
import AMR
|
||||
|
||||
AMR.example_isolates
|
||||
```
|
||||
|
||||
## Development Version (GitHub)
|
||||
|
||||
To use the latest development version of the `AMR` R package (sourced directly from GitHub), import the `beta` sub-package and alias it as `AMR`:
|
||||
|
||||
```python
|
||||
import AMR.beta as AMR
|
||||
|
||||
AMR.example_isolates
|
||||
```
|
||||
|
||||
Aliasing with `as AMR` keeps all downstream code identical to the stable import. Switching between the stable release and the development version requires changing only the import line — nothing else in your script needs to change.
|
||||
|
||||
# SIR Classification with `as_sir()`
|
||||
|
||||
## Using `enforce_method`
|
||||
|
||||
The `as_sir()` function in R uses S3 method dispatch to select the correct calculation method based on the input class: `<mic>` for MIC values and `<disk>` for disk diffusion values. Because Python objects do not carry R class attributes through the `rpy2` bridge, this automatic dispatch may not resolve correctly.
|
||||
|
||||
To explicitly specify the input type, use the `enforce_method` argument:
|
||||
|
||||
```python
|
||||
# Treat the column as MIC values — maps to R's as.sir.mic()
|
||||
AMR.as_sir(df["MIC_col"], mo="E. coli", ab="AMX", guideline="EUCAST", enforce_method="mic")
|
||||
|
||||
# Treat the column as disk diffusion values — maps to R's as.sir.disk()
|
||||
AMR.as_sir(df["disk_col"], mo="E. coli", ab="AMX", guideline="EUCAST", enforce_method="disk")
|
||||
```
|
||||
|
||||
Without `enforce_method`, R falls back to class-based dispatch on the raw Python input, which may fail or return unexpected results. Always supply `enforce_method` when calling `as_sir()` from Python.
|
||||
|
||||
# Conclusion
|
||||
|
||||
With the `AMR` Python package, Python users can now effortlessly call R functions from the `AMR` R package. This eliminates the need for complex `rpy2` configurations and provides a clean, easy-to-use interface for antimicrobial resistance analysis. The examples provided above demonstrate how this can be applied to typical workflows, such as standardising microorganism and antimicrobial names or calculating resistance.
|
||||
|
||||
By just running `import AMR`, users can seamlessly integrate the robust features of the R `AMR` package into Python workflows.
|
||||
|
||||
Whether you're cleaning data or analysing resistance patterns, the `AMR` Python package makes it easy to work with AMR data in Python.
|
||||
|
||||
-276
@@ -1,276 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
title: "AMR (for R)"
|
||||
url: "https://amr-for-r.org/"
|
||||
|
||||
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"
|
||||
bslib:
|
||||
base_font: {google: "Lato"}
|
||||
heading_font: {google: "Lato"}
|
||||
code_font: {google: "Fira Code"}
|
||||
# body-text-align: "justify" # this is now only in `p {}` in extra.css
|
||||
line-height-base: 1.75
|
||||
# make top bar a bit wider
|
||||
navbar-padding-y: "0.5rem"
|
||||
|
||||
news:
|
||||
one_page: true
|
||||
cran_dates: true
|
||||
|
||||
footer:
|
||||
structure:
|
||||
left: [devtext]
|
||||
right: [logo]
|
||||
components:
|
||||
devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU General Public License version 2.0 (GPL-2)</a>.<br>Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in The Netherlands.'
|
||||
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://amr-for-r.org/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://amr-for-r.org/logo_umcg.svg" style="max-width: 150px;"></a>'
|
||||
|
||||
home:
|
||||
sidebar:
|
||||
structure: [toc, authors]
|
||||
|
||||
navbar:
|
||||
title: "AMR (for R)"
|
||||
left:
|
||||
- text: "How to"
|
||||
icon: "fa-question-circle"
|
||||
menu:
|
||||
- text: "Conduct AMR Analysis"
|
||||
icon: "fa-directions"
|
||||
href: "articles/AMR.html"
|
||||
- text: "Generate Antibiogram (Trad./Syndromic/WISCA)"
|
||||
icon: "fa-file-prescription"
|
||||
href: "reference/antibiogram.html" # reference instead of an article
|
||||
- text: "Use AMR for Predictive Modelling (tidymodels)"
|
||||
icon: "fa-square-root-variable"
|
||||
href: "articles/AMR_with_tidymodels.html"
|
||||
- text: "Download Data Sets for Own Use"
|
||||
icon: "fa-database"
|
||||
href: "articles/datasets.html"
|
||||
- text: "Set User- Or Team-specific Package Settings"
|
||||
icon: "fa-gear"
|
||||
href: "reference/AMR-options.html"
|
||||
- text: "Conduct Principal Component Analysis for AMR"
|
||||
icon: "fa-compress"
|
||||
href: "articles/PCA.html"
|
||||
- text: "Determine Multi-Drug Resistance (MDR)"
|
||||
icon: "fa-skull-crossbones"
|
||||
href: "articles/MDR.html"
|
||||
- text: "Work with WHONET Data"
|
||||
icon: "fa-globe-americas"
|
||||
href: "articles/WHONET.html"
|
||||
- text: "Apply EUCAST Rules"
|
||||
icon: "fa-exchange-alt"
|
||||
href: "articles/EUCAST.html"
|
||||
- text: "Get Taxonomy of a Microorganism"
|
||||
icon: "fa-bug"
|
||||
href: "reference/mo_property.html" # reference instead of an article
|
||||
- text: "Get Properties of an Antibiotic Drug"
|
||||
icon: "fa-capsules"
|
||||
href: "reference/ab_property.html" # reference instead of an article
|
||||
- text: "Get Properties of an Antiviral Drug"
|
||||
icon: "fa-capsules"
|
||||
href: "reference/av_property.html" # reference instead of an article
|
||||
- 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"
|
||||
structure:
|
||||
right: [search, amrchangelog, amrgit]
|
||||
components:
|
||||
amrchangelog:
|
||||
text: "Changelog"
|
||||
icon: "fa-newspaper"
|
||||
href: "news/index.html"
|
||||
amrgit:
|
||||
text: "Source Code"
|
||||
icon: "fa-github"
|
||||
href: "https://github.com/msberends/AMR"
|
||||
|
||||
reference:
|
||||
- title: "Introduction to the package"
|
||||
desc: >
|
||||
Please find the introduction to (and some general information about) our package here.
|
||||
contents:
|
||||
- "`AMR`"
|
||||
|
||||
- title: "Preparing data: microorganisms"
|
||||
desc: >
|
||||
These functions are meant to get taxonomically valid properties of microorganisms from any input, but
|
||||
also properties derived from taxonomy, such as the Gram stain (`mo_gramstain()`) , or `mo_is_yeast()`.
|
||||
Use `mo_source()` to teach this package how to translate your own codes to valid microorganisms, and
|
||||
use `add_custom_microorganisms()` to add your own custom microorganisms to this package.
|
||||
contents:
|
||||
- "`as.mo`"
|
||||
- "`mo_property`"
|
||||
- "`add_custom_microorganisms`"
|
||||
- "`mo_source`"
|
||||
|
||||
- title: "Preparing data: antimicrobials"
|
||||
desc: >
|
||||
Use these functions to get valid properties of antimicrobials from any input or to clean your input.
|
||||
You can even retrieve drug names and doses from clinical text records, using `ab_from_text()`.
|
||||
contents:
|
||||
- "`as.ab`"
|
||||
- "`ab_property`"
|
||||
- "`ab_from_text`"
|
||||
- "`atc_online_property`"
|
||||
- "`add_custom_antimicrobials`"
|
||||
|
||||
- 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.
|
||||
Afterwards, you can extend antibiotic interpretations by applying [EUCAST rules](https://www.eucast.org/expert_rules_and_intrinsic_resistance/) with `eucast_rules()`.
|
||||
contents:
|
||||
- "`as.sir`"
|
||||
- "`as.mic`"
|
||||
- "`as.disk`"
|
||||
- "`eucast_rules`"
|
||||
- "`custom_eucast_rules`"
|
||||
|
||||
- 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.
|
||||
Be sure to first select the isolates that are appropiate for analysis, by using `first_isolate()` or `is_new_episode()`.
|
||||
You can also filter your data on certain resistance in certain antibiotic classes (`carbapenems()`, `aminoglycosides()`),
|
||||
or determine multi-drug resistant microorganisms (MDRO, `mdro()`).
|
||||
contents:
|
||||
- "`antibiogram`"
|
||||
- "`proportion`"
|
||||
- "`count`"
|
||||
- "`is_new_episode`"
|
||||
- "`first_isolate`"
|
||||
- "`key_antimicrobials`"
|
||||
- "`mdro`"
|
||||
- "`bug_drug_combinations`"
|
||||
- "`antimicrobial_selectors`"
|
||||
- "`top_n_microorganisms`"
|
||||
- "`mean_amr_distance`"
|
||||
- "`resistance_predict`"
|
||||
- "`guess_ab_col`"
|
||||
|
||||
- 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
|
||||
language can be set for the whole team (system-language independent) for antibiotic names in a
|
||||
foreign language.
|
||||
contents:
|
||||
- "`AMR-options`"
|
||||
|
||||
- title: "Other: antiviral drugs"
|
||||
desc: >
|
||||
This package also provides extensive support for antiviral agents, even though it is not the primary
|
||||
scope of this package. Working with data containing information about antiviral drugs was never easier.
|
||||
Use these functions to get valid properties of antiviral drugs from any input or to clean your input.
|
||||
You can even retrieve drug names and doses from clinical text records, using `av_from_text()`.
|
||||
contents:
|
||||
- "`as.av`"
|
||||
- "`av_property`"
|
||||
- "`av_from_text`"
|
||||
|
||||
- title: "Other: background information on included data"
|
||||
desc: >
|
||||
Some pages about our package and its external sources. Be sure to read our [How To's](./../articles/index.html)
|
||||
for more information about how to work with functions in this package.
|
||||
contents:
|
||||
- "`microorganisms`"
|
||||
- "`antimicrobials`"
|
||||
- "`clinical_breakpoints`"
|
||||
- "`example_isolates`"
|
||||
- "`microorganisms.codes`"
|
||||
- "`microorganisms.groups`"
|
||||
- "`intrinsic_resistant`"
|
||||
- "`dosage`"
|
||||
- "`WHOCC`"
|
||||
- "`example_isolates_unclean`"
|
||||
- "`WHONET`"
|
||||
|
||||
- title: "Other: miscellaneous functions"
|
||||
desc: >
|
||||
These functions are mostly for internal use, but some of
|
||||
them may also be suitable for your analysis. Especially the
|
||||
'like' function can be useful: `if (x %like% y) {...}`.
|
||||
contents:
|
||||
- "`age_groups`"
|
||||
- "`age`"
|
||||
- "`export_ncbi_biosample`"
|
||||
- "`availability`"
|
||||
- "`get_AMR_locale`"
|
||||
- "`italicise_taxonomy`"
|
||||
- "`join`"
|
||||
- "`like`"
|
||||
- "`mo_matching_score`"
|
||||
- "`pca`"
|
||||
- "`random`"
|
||||
|
||||
- title: "Other: statistical tests"
|
||||
desc: >
|
||||
Some statistical tests or methods are not part of base R and were added to this package for convenience.
|
||||
contents:
|
||||
- "`g.test`"
|
||||
- "`kurtosis`"
|
||||
- "`skewness`"
|
||||
|
||||
- title: "Other: deprecated functions/arguments/datasets"
|
||||
desc: >
|
||||
These objects are deprecated, meaning that they will still
|
||||
work but show a warning that they will be removed
|
||||
in a future version.
|
||||
contents:
|
||||
- "`AMR-deprecated`"
|
||||
-43
@@ -1,43 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE: #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
||||
# #
|
||||
# SOURCE CODE: #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# PLEASE CITE THIS SOFTWARE AS: #
|
||||
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
||||
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
||||
# Journal of Statistical Software, 104(3), 1-31. #
|
||||
# https://doi.org/10.18637/jss.v104.i03 #
|
||||
# #
|
||||
# Developed at the University of Groningen and the University Medical #
|
||||
# Center Groningen in The Netherlands, in collaboration with many #
|
||||
# colleagues from around the world, see our website. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||
# ==================================================================== #
|
||||
|
||||
codecov:
|
||||
require_ci_to_pass: no # allow fail
|
||||
branch: main
|
||||
|
||||
comment: no
|
||||
|
||||
coverage:
|
||||
precision: 1
|
||||
round: up
|
||||
range: "0...100"
|
||||
status:
|
||||
project: no
|
||||
patch: no
|
||||
changes: no
|
||||
@@ -1,5 +0,0 @@
|
||||
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 (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.
|
Before Width: | Height: | Size: 578 KiB |
@@ -1,3 +0,0 @@
|
||||
green grass #a7dbc3
|
||||
green bacteria #128F76
|
||||
blue sky #a8d5ef
|
||||
Binary file not shown.
File diff suppressed because one or more lines are too long
@@ -1,69 +0,0 @@
|
||||
---
|
||||
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.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user