P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 22:41:52 +02:00
Code Releases Activity

New mo algorithm, prepare for 2.0

Browse Source
This commit is contained in:
Dr. Matthijs Berends
2022-10-05 09:12:22 +02:00
committed by GitHub
parent 63fe160322
commit cd2acc4a29
182 changed files with 4054 additions and 90905 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
.github/prehooks/pre-commit vendored
View File

@ -1,5 +1,34 @@
#!/bin/sh
# ==================================================================== #
# TITLE #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
echo "Running pre-commit hook..."
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@ -7,11 +36,11 @@ if command -v Rscript > /dev/null; then
if [ "$(Rscript -e 'cat(all(c('"'pkgload'"', '"'devtools'"', '"'dplyr'"', '"'styler'"') %in% rownames(installed.packages())))')" = "TRUE" ]; then
Rscript -e "source('data-raw/_pre_commit_hook.R')"
currentpkg=`Rscript -e "cat(pkgload::pkg_name())"`
echo "-> Adding all files in folders 'data-raw', 'inst', 'man', and 'R' to this git commit"
echo "-> Adding all files in 'data-raw' to this commit"
git add data-raw/*
git add inst/*
git add man/*
git add R/*
git add R/sysdata.rda
git add NAMESPACE
else
echo "- R package 'pkgload', 'devtools', 'dplyr', or 'styler' not installed!"
currentpkg="your"
@ -24,7 +53,7 @@ echo ""
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
echo ">> Updating semantic versioning and date..."
echo "Updating semantic versioning and date..."
# get tags from remote, and remove tags not on remote:
git fetch origin --prune --prune-tags --quiet
@ -32,7 +61,7 @@ currenttagfull=`git describe --tags --abbrev=0`
currenttag=`git describe --tags --abbrev=0 | sed 's/v//'`
if [ "$currenttag" = "" ]; then
# there is no tag, so set tag to 0.0.1 and commit index to current count
echo ">> - no git tags found, create one in this format: 'v(x).(y).(z)'!"
echo "- no git tags found, create one in this format: 'v(x).(y).(z)'!"
currenttag="0.0.1"
currentcommit=`git rev-list --count HEAD`
else
@ -42,18 +71,18 @@ else
# tag is new, so this must become the version number
currentversion="$currenttag"
fi
echo ">> - latest tag is '${currenttagfull}', with ${currentcommit} previous commits"
echo "- latest tag is '${currenttagfull}', with ${currentcommit} previous commits"
fi
if [ "$currentversion" = "" ]; then
# combine tag (e.g. 1.2.3) and commit number (like 5) increased by 9000 to indicate beta version
currentversion="$currenttag.$((currentcommit + 9001))" # results in e.g. 1.2.3.9005
fi
echo ">> - ${currentpkg} pkg version set to ${currentversion}"
echo "- ${currentpkg} pkg version set to ${currentversion}"
# set version number and date to DESCRIPTION file
sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
echo ">> - updated DESCRIPTION"
echo "- updated DESCRIPTION"
# remove leftover on macOS
rm -f DESCRIPTION--
# add to commit
@ -65,12 +94,12 @@ if [ -e "NEWS.md" ]; then
currentpkg=""
fi
sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
echo ">> - updated NEWS.md"
echo "- updated NEWS.md"
# remove leftover on macOS
rm -f NEWS.md--
# add to commit
git add NEWS.md
else
echo ">> - no NEWS.md found!"
echo "- no NEWS.md found!"
fi
echo ">> "
echo ""

22
.github/workflows/check-pr.yaml → .github/workflows/check-devel.yaml vendored
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -27,14 +31,13 @@ on:
pull_request:
# run in each PR in this repo
branches: '**'
push:
branches: '**'
name: R-code-check-PR
name: check-devel
jobs:
R-code-check-PR:
# do not run if we are the authors - the other checks will already run
if: ${{ github.event.comment.author_association != 'MEMBER' && github.event.comment.author_association != 'OWNER' }}
R-code-check:
runs-on: ${{ matrix.config.os }}
continue-on-error: ${{ matrix.config.allowfail }}
@ -46,11 +49,8 @@ jobs:
matrix:
config:
- {os: macOS-latest, r: 'devel', allowfail: true}
- {os: macOS-latest, r: 'release', allowfail: false}
- {os: ubuntu-latest, r: 'devel', allowfail: true}
- {os: ubuntu-latest, r: 'release', allowfail: false}
- {os: windows-latest, r: 'devel', allowfail: true}
- {os: windows-latest, r: 'release', allowfail: false}
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

19
.github/workflows/check.yaml → .github/workflows/check-release.yaml vendored
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -32,7 +36,7 @@ on:
# this is to check that all dependencies are still available (see R/zzz.R)
- cron: '0 1 * * *'
name: R-code-check
name: check-release
jobs:
R-code-check:
@ -46,13 +50,11 @@ jobs:
fail-fast: false
matrix:
config:
# test all systems against all released versions of R >= 3.0, we support them all!
- {os: macOS-latest, r: 'devel', allowfail: true}
# test all released versions of R >= 3.0, we support them all!
- {os: macOS-latest, r: '4.2', allowfail: false}
- {os: macOS-latest, r: '4.1', allowfail: false}
- {os: macOS-latest, r: '4.0', allowfail: false}
- {os: macOS-latest, r: '3.6', allowfail: false}
- {os: ubuntu-22.04, r: 'devel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: ubuntu-22.04, r: '4.2', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: ubuntu-22.04, r: '4.1', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: ubuntu-22.04, r: '4.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
@ -63,7 +65,6 @@ jobs:
- {os: ubuntu-22.04, r: '3.2', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: ubuntu-22.04, r: '3.1', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: ubuntu-22.04, r: '3.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest"}
- {os: windows-latest, r: 'devel', allowfail: true}
- {os: windows-latest, r: '4.2', allowfail: false}
- {os: windows-latest, r: '4.1', allowfail: false}
- {os: windows-latest, r: '4.0', allowfail: false}
@ -156,4 +157,4 @@ jobs:
uses: actions/upload-artifact@v2
with:
name: artifacts-${{ matrix.config.os }}-r${{ matrix.config.r }}
path: /home/runner/work/AMR.Rcheck
path: ${GITHUB_WORKSPACE}.Rcheck

10
.github/workflows/codecovr.yaml vendored
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

23
.github/workflows/lintr.yaml vendored
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -52,5 +56,16 @@ jobs:
extra-packages: any::lintr
- name: Lint
run: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R"))
run: |
# old: lintr::lint_package(linters = lintr::with_defaults(line_length_linter = NULL, trailing_whitespace_linter = NULL, object_name_linter = NULL, cyclocomp_linter = NULL, object_length_linter = lintr::object_length_linter(length = 50L)), exclusions = list("R/aa_helper_pm_functions.R"))
# now get ALL linters, not just default ones
linters <- ls(envir = asNamespace("lintr"), pattern = "_linter$")
# lose deprecated
linters <- linters[!grepl("^(closed_curly|open_curly|paren_brace|semicolon_terminator)_linter$", linters)]
# and the ones we find unnnecessary
linters <- linters[!grepl("^(extraction_operator|implicit_integer|line_length|object_name|nonportable_path|is)_linter$", linters)]
# put the functions in a list
linters <- lapply(linters, function(l) eval(parse(text = paste0("lintr::", l, "()")), envir = asNamespace("lintr")))
# run them all!
lintr::lint_package(linters = linters, exclusions = list("R/aa_helper_pm_functions.R"))
shell: Rscript {0}

10
.github/workflows/website.yaml vendored
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

2
AMR.Rproj
View File

@ -23,3 +23,5 @@ PackageCheckArgs: --no-build-vignettes --as-cran
PackageRoxygenize: rd,collate,namespace
UseNativePipeOperator: No
SpellingDictionary: en_GB

6
CRAN-SUBMISSION
View File

@ -1,3 +1,3 @@
Version: 1.8.1
Date: 2022-03-16 18:22:51 UTC
SHA: 7b0f1596bd65fbb72681a7e3a6a7e4e469a891e8
Version: 1.8.2
Date: 2022-09-27 12:18:42 UTC
SHA: ccb09706e4f168ab6133de3d2294bcaeed0d3fc8

11
DESCRIPTION
View File

@ -1,11 +1,10 @@
Package: AMR
Version: 1.8.1.9049
Date: 2022-09-01
Version: 1.8.2.9033
Date: 2022-10-05
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 and reliable reference data such as LPSN
<doi:10.1099/ijsem.0.004332>.
using evidence-based methods, as described in <doi:10.18637/jss.v104.i03>.
Authors@R: c(
person(family = "Berends", c("Matthijs", "S."), role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7620-1800"), email = "m.berends@certe.nl"),
person(family = "Luz", c("Christian", "F."), role = c("aut", "ctb"), comment = c(ORCID = "0000-0001-5809-5995")),
@ -29,12 +28,14 @@ Authors@R: c(
Depends: R (>= 3.0.0)
Enhances:
cleaner,
skimr,
ggplot2,
janitor,
skimr,
tibble,
tidyselect
Suggests:
curl,
data.table,
dplyr,
knitr,
progress,

6
NAMESPACE
View File

@ -114,7 +114,6 @@ S3method(plot,resistance_predict)
S3method(plot,rsi)
S3method(print,ab)
S3method(print,bug_drug_combinations)
S3method(print,catalogue_of_life_version)
S3method(print,custom_eucast_rules)
S3method(print,custom_mdro_guideline)
S3method(print,disk)
@ -207,7 +206,6 @@ export(betalactams)
export(brmo)
export(bug_drug_combinations)
export(carbapenems)
export(catalogue_of_life_version)
export(cephalosporins)
export(cephalosporins_1st)
export(cephalosporins_2nd)
@ -268,10 +266,12 @@ export(mdro)
export(mean_amr_distance)
export(mo_authors)
export(mo_class)
export(mo_cleaning_regex)
export(mo_domain)
export(mo_failures)
export(mo_family)
export(mo_fullname)
export(mo_gbif)
export(mo_genus)
export(mo_gramstain)
export(mo_info)
@ -289,9 +289,11 @@ 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)

44
NEWS.md
View File

@ -1,12 +1,28 @@
# AMR 1.8.1.9049
# AMR 1.8.2.9033
This version will eventually become v2.0! We're happy to reach a new major milestone soon!
### Breaking
* Removed all species of the taxonomic kingdom Chromista from the package. This was done for multiple reasons:
* CRAN allows packages to be around 5 MB maximum, some packages are exempted but this package is not one of them
* Chromista are not relevant when it comes to antimicrobial resistance, thus lacking the primary scope of this package
* Chromista are almost never clinically relevant, thus lacking the secondary scope of this package
* The `microorganisms` no longer relies on the Catalogue of Life, but now primarily on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and is supplemented with the Global Biodiversity Information Facility (GBIF). The structure of this data set has changed to include separate LPSN and GBIF identifiers. Almost all previous MO codes were retained. It contains over 1,000 taxonomic names from 2022 already.
* The `microorganisms.old` data set was removed, and all previously accepted names are now included in the `microorganisms` data set. A new column `status` contains `"accepted"` for currently accepted names and `"synonym"` for taxonomic synonyms; currently invalid names. All previously accepted names now have a microorganisms ID and - if available - an LPSN, GBIF and SNOMED CT identifier.
* The `mo_matching_score()` now count deletions and substitutions as 2 instead of 1, which impacts the outcome of `as.mo()` and any `mo_*()` function
### New
* EUCAST 2022 and CLSI 2022 guidelines have been added for `as.rsi()`. EUCAST 2022 is now the new default guideline for all MIC and disks diffusion interpretations.
* All new algorithm for `as.mo()` (and thus internally all `mo_*()` functions) while still following our original set-up as described in our paper (DOI 10.18637/jss.v104.i03).
* A new argument `keep_synonyms` allows to *not* correct for updated taxonomy, in favour of the now deleted argument `allow_uncertain`
* It has increased tremendously in speed and returns generally more consequent results
* Sequential coercion is now extremely fast as results are stored to the package environment, although coercion of unknown values must be run once per session. Previous results can be reset/removed with the new `mo_reset_session()` function.
* Function `mean_amr_distance()` to calculate the mean AMR distance. The mean AMR distance is a normalised numeric value to compare AMR test results and can help to identify similar isolates, without comparing antibiograms by hand.
* Function `rsi_interpretation_history()` to view the history of previous runs of `as.rsi()`. This returns a 'logbook' with the selected guideline, reference table and specific interpretation of each row in a data set on which `as.rsi()` was run.
* Support for `data.frame`-enhancing R packages, more specifically: `data.table`, `tibble`, and `tsibble`. AMR package functions that have a data set as output (such as `rsi_df()` and `bug_drug_combinations()`), will now return the same data type as the input. Furthermore, all our data sets are now in `tibble` format.
* Our data sets are now also continually exported to Apache Feather and Apache Parquet formats. You can find more info [in this article on our website](https://msberends.github.io/AMR/articles/datasets.html).
* Support for `data.frame`-enhancing R packages, more specifically: `data.table::data.table`, `janitor::tabyl`, `tibble::tibble`, and `tsibble::tsibble`. AMR package functions that have a data set as output (such as `rsi_df()` and `bug_drug_combinations()`), will now return the same data type as the input.
* All data sets in this package are now exported as `tibble`, instead of base R `data.frame`s. Older R versions are still supported.
* Support for the following languages: Chinese, Greek, Japanese, Polish, Turkish and Ukrainian. We are very grateful for the valuable input by our colleagues from other countries. The `AMR` package is now available in 16 languages.
* Our data sets are now also continually exported to Apache Feather and Apache Parquet formats. You can find more info [in this article on our website](https://msberends.github.io/AMR/articles/datasets.html).
### Changed
* Fix for using `as.rsi()` on certain EUCAST breakpoints for MIC values
@ -18,22 +34,30 @@
* Using any `random_*()` function (such as `random_mic()`) is now possible by directly calling the package without loading it first: `AMR::random_mic(10)`
* Added *Toxoplasma gondii* (`P_TXPL_GOND`) to the `microorganisms` data set, together with its genus, family, and order
* Changed value in column `prevalence` of the `microorganisms` data set from 3 to 2 for these genera: *Acholeplasma*, *Alistipes*, *Alloprevotella*, *Bergeyella*, *Borrelia*, *Brachyspira*, *Butyricimonas*, *Cetobacterium*, *Chlamydia*, *Chlamydophila*, *Deinococcus*, *Dysgonomonas*, *Elizabethkingia*, *Empedobacter*, *Haloarcula*, *Halobacterium*, *Halococcus*, *Myroides*, *Odoribacter*, *Ornithobacterium*, *Parabacteroides*, *Pedobacter*, *Phocaeicola*, *Porphyromonas*, *Riemerella*, *Sphingobacterium*, *Streptobacillus*, *Tenacibaculum*, *Terrimonas*, *Victivallis*, *Wautersiella*, *Weeksella*
* Fix for using the form `df[carbapenems() == "R", ]` using the latest `vctrs` package
* Fix for using the form `df[carbapenems() == "R", ]` when using the latest `vctrs` package
* Fix for using `info = FALSE` in `mdro()`
* All data sets in this package are now exported as `tibble`, instead of base R `data.frame`s. Older R versions are still supported.
* Automatic language determination will give a note once a session
* For all interpretation guidelines using `as.rsi()` on amoxicillin, the rules for ampicillin will be used if amoxicillin rules are not available
* Fix for using `ab_atc()` on non-existing ATC codes
* Black and white message texts are now reversed in colour if using an RStudio dark theme
* `mo_snomed()` now returns class `character`, not `numeric` anymore (to make long SNOMED codes readable)
### Other
* New website to make use of the new Bootstrap 5 and pkgdown v2.0. The website now contains results for all examples and will be automatically regenerated with every change to our repository, using GitHub Actions
* Added Peter Dutey-Magni and Anton Mymrikov as contributors, to thank them for their valuable input
* Set up Git Large File Storage (Git LFS) for the large SAS and SPSS file formats
* New website to make use of the new Bootstrap 5 and pkgdown 2.0. The website now contains results for all examples and will be automatically regenerated with every change to our repository, using GitHub Actions
* Added Peter Dutey-Magni, Dmytro Mykhailenko and Anton Mymrikov as contributors, to thank them for their valuable input
* All R and Rmd files in this project are now styled using the `styler` package
* Set scalar conditional expressions (`&&` and `||`) where possible to comply with the upcoming R 4.3
* An enormous lot of code cleaning, fixing some small bugs on the way
# `AMR` 1.8.1
# AMR 1.8.2
This is a small intermediate update to include the reference to our publication in the Journal of Statistical Software, DOI 10.18637/jss.v104.i03.
A major update will be released by the end of 2022 or early 2023 to include the most recent EUCAST and CLSI guidelines, updated microbial taxonomy, and support for 16 languages.
# AMR 1.8.1
### Changed
* Fix for using `as.rsi()` on values containing capped values (such as `>=`), sometimes leading to `NA`
@ -53,7 +77,7 @@
* Fix for size of some image elements, as requested by CRAN
# `AMR` 1.8.0
# AMR 1.8.0
### Breaking changes
* Removed `p_symbol()` and all `filter_*()` functions (except for `filter_first_isolate()`), which were all deprecated in a previous package version

43
R/aa_globals.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -60,21 +64,22 @@ EUCAST_VERSION_EXPERT_RULES <- list(
)
)
SNOMED_VERSION <- list(
title = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS)",
current_source = "US Edition of SNOMED CT from 1 September 2020",
current_version = 12,
current_oid = "2.16.840.1.114222.4.11.1009",
value_set_name = "Microorganism",
url = "https://phinvads.cdc.gov/vads/ViewValueSet.action?oid=2.16.840.1.114222.4.11.1009"
)
CATALOGUE_OF_LIFE <- list(
year = 2019,
version = "Catalogue of Life: {year} Annual Checklist",
url_CoL = "http://www.catalogueoflife.org",
url_LPSN = "https://lpsn.dsmz.de",
yearmonth_LPSN = "5 October 2021"
TAXONOMY_VERSION <- list(
GBIF = list(
accessed_date = as.Date("2022-09-12"),
citation = "GBIF Secretariat (November 26, 2021). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
url = "https://www.gbif.org"
),
LPSN = list(
accessed_date = as.Date("2022-09-12"),
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"
),
SNOMED = list(
accessed_date = as.Date("2021-07-01"),
citation = "Public Health Information Network Vocabulary Access and Distribution System (PHIN VADS). US Edition of SNOMED CT from 1 September 2020. Value Set Name 'Microoganism', OID 2.16.840.1.114222.4.11.1009 (v12).",
url = "https://phinvads.cdc.gov"
)
)
globalVariables(c(
@ -117,7 +122,6 @@ globalVariables(c(
"microorganism",
"microorganisms",
"microorganisms.codes",
"microorganisms.old",
"mo",
"name",
"new",
@ -138,7 +142,6 @@ globalVariables(c(
"se_max",
"se_min",
"species",
"species_id",
"total",
"txt",
"type",

412
R/aa_helper_functions.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -81,7 +85,7 @@ where <- function(fn) {
quick_case_when <- function(...) {
fs <- list(...)
lapply(fs, function(x) {
if (class(x) != "formula") {
if (!inherits(x, "formula")) {
stop("`case_when()` requires formula inputs.")
}
})
@ -208,63 +212,6 @@ addin_insert_like <- function() {
}
}
check_dataset_integrity <- function() {
# check if user overwrote our data sets in their global environment
data_in_pkg <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
data_in_globalenv <- ls(envir = globalenv())
overwritten <- data_in_pkg[data_in_pkg %in% data_in_globalenv]
# exception for example_isolates
overwritten <- overwritten[overwritten %unlike% "example_isolates"]
if (length(overwritten) > 0) {
if (length(overwritten) > 1) {
plural <- c("s are", "", "s")
} else {
plural <- c(" is", "s", "")
}
if (message_not_thrown_before("check_dataset_integrity", overwritten)) {
warning_(
"The following data set", plural[1],
" overwritten by your global environment and prevent", plural[2],
" the AMR package from working correctly: ",
vector_and(overwritten, quotes = "'"),
".\nPlease rename your object", plural[3], "."
)
}
}
# check if other packages did not overwrite our data sets
valid_microorganisms <- TRUE
valid_antibiotics <- TRUE
tryCatch(
{
valid_microorganisms <- all(c(
"mo", "fullname", "kingdom", "phylum",
"class", "order", "family", "genus",
"species", "subspecies", "rank",
"species_id", "source", "ref", "prevalence"
) %in% colnames(microorganisms),
na.rm = TRUE
)
valid_antibiotics <- all(c(
"ab", "atc", "cid", "name", "group",
"atc_group1", "atc_group2", "abbreviations",
"synonyms", "oral_ddd", "oral_units",
"iv_ddd", "iv_units", "loinc"
) %in% colnames(antibiotics),
na.rm = TRUE
)
},
error = function(e) {
# package not yet loaded
require("AMR")
}
)
stop_if(
!valid_microorganisms | !valid_antibiotics,
"the data set `microorganisms` or `antibiotics` was overwritten in your environment because another package with the same object name(s) was loaded _after_ the AMR package, preventing the AMR package from working correctly. Please load the AMR package last."
)
invisible(TRUE)
}
search_type_in_df <- function(x, type, info = TRUE) {
meet_criteria(x, allow_class = "data.frame")
meet_criteria(type, allow_class = "character", has_length = 1)
@ -281,8 +228,8 @@ search_type_in_df <- function(x, type, info = TRUE) {
if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
# take first <mo> column
found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)]
} else if ("mo" %in% colnames_formatted &
suppressWarnings(all(x$mo %in% c(NA, microorganisms$mo)))) {
} else if ("mo" %in% colnames_formatted &&
suppressWarnings(all(x$mo %in% c(NA, AMR::microorganisms$mo)))) {
found <- "mo"
} else if (any(colnames_formatted %like_case% "^(mo|microorganism|organism|bacteria|ba[ck]terie)s?$")) {
found <- sort(colnames(x)[colnames_formatted %like_case% "^(mo|microorganism|organism|bacteria|ba[ck]terie)s?$"])
@ -303,7 +250,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
if (any(colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)")) {
# WHONET support
found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"])
if (!any(class(pm_pull(x, found)) %in% c("Date", "POSIXct"))) {
if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
stop(font_red(paste0(
"Found column '", font_bold(found), "' to be used as input for `col_", type,
"`, but this column contains no valid dates. Transform its values to valid dates first."
@ -357,7 +304,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
found <- found[1]
if (!is.null(found) & info == TRUE) {
if (!is.null(found) && info == TRUE) {
if (message_not_thrown_before("search_in_type", type)) {
msg <- paste0("Using column '", font_bold(found), "' as input for `col_", type, "`.")
if (type %in% c("keyantibiotics", "keyantimicrobials", "specimen")) {
@ -372,7 +319,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
is_valid_regex <- function(x) {
regex_at_all <- tryCatch(vapply(
FUN.VALUE = logical(1),
X = strsplit(x, ""),
X = strsplit(x, "", fixed = TRUE),
FUN = function(y) {
any(y %in% c(
"$", "(", ")", "*", "+", "-",
@ -390,9 +337,7 @@ is_valid_regex <- function(x) {
FUN.VALUE = logical(1),
X = x,
FUN = function(y) {
!"try-error" %in% class(try(grepl(y, "", perl = TRUE),
silent = TRUE
))
!inherits(try(grepl(y, "", perl = TRUE), silent = TRUE), "try-error")
},
USE.NAMES = FALSE
)
@ -464,14 +409,14 @@ word_wrap <- function(...,
msg <- paste0(c(...), collapse = "")
if (isTRUE(as_note)) {
msg <- paste0(pkg_env$info_icon, " ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
msg <- paste0(AMR_env$info_icon, " ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
}
if (msg %like% "\n") {
# run word_wraps() over every line here, bind them and return again
return(paste0(vapply(
FUN.VALUE = character(1),
trimws(unlist(strsplit(msg, "\n")), which = "right"),
trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
word_wrap,
add_fn = add_fn,
as_note = FALSE,
@ -497,12 +442,12 @@ word_wrap <- function(...,
msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
collapse = "\n"
)
msg_stripped_spaces <- which(unlist(strsplit(msg_stripped, "")) == " ")
msg_stripped_wrapped_spaces <- which(unlist(strsplit(msg_stripped_wrapped, "")) != "\n")
msg_stripped_spaces <- which(unlist(strsplit(msg_stripped, "", fixed = TRUE)) == " ")
msg_stripped_wrapped_spaces <- which(unlist(strsplit(msg_stripped_wrapped, "", fixed = TRUE)) != "\n")
# so these are the indices of spaces that need to be replaced
replace_spaces <- which(!msg_stripped_spaces %in% msg_stripped_wrapped_spaces)
# put it together
msg <- unlist(strsplit(msg, " "))
msg <- unlist(strsplit(msg, " ", fixed = TRUE))
msg[replace_spaces] <- paste0(msg[replace_spaces], "\n")
# add space around operators again
msg <- gsub(paste0(ops, ops), "\\1 \\2", msg, perl = TRUE)
@ -534,6 +479,8 @@ word_wrap <- function(...,
# clean introduced whitespace between fullstops
msg <- gsub("[.] +[.]", "..", msg)
# remove extra space that was introduced (case: "Smith et al., 2022")
msg <- gsub(". ,", ".,", msg, fixed = TRUE)
msg
}
@ -608,17 +555,14 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
}
"%or%" <- function(x, y) {
if (is.null(x) | is.null(y)) {
if (is.null(x) || is.null(y)) {
if (is.null(x)) {
return(y)
} else {
return(x)
}
}
ifelse(!is.na(x),
x,
ifelse(!is.na(y), y, NA)
)
ifelse(is.na(x), y, x)
}
return_after_integrity_check <- function(value, type, check_vector) {
@ -654,9 +598,29 @@ dataset_UTF8_to_ASCII <- function(df) {
import_fn("as_tibble", "tibble")(df)
}
documentation_date <- function(d) {
paste0(trimws(format(d, "%e")), " ", month.name[as.integer(format(d, "%m"))], ", ", format(d, "%Y"))
}
format_included_data_number <- function(data) {
if (is.data.frame(data)) {
n <- nrow(data)
} else {
n <- length(unique(data))
}
if (n > 10000) {
rounder <- -3 # round on thousands
} else if (n > 1000) {
rounder <- -2 # round on hundreds
} else {
rounder <- -1 # round on tens
}
paste0("~", format(round(n, rounder), decimal.mark = ".", big.mark = ","))
}
# for eucast_rules() and mdro(), creates markdown output with URLs and names
create_eucast_ab_documentation <- function() {
x <- trimws(unique(toupper(unlist(strsplit(EUCAST_RULES_DF$then_change_these_antibiotics, ",")))))
x <- trimws(unique(toupper(unlist(strsplit(EUCAST_RULES_DF$then_change_these_antibiotics, ",", fixed = TRUE)))))
ab <- character()
for (val in x) {
if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) {
@ -731,7 +695,8 @@ format_class <- function(class, plural = FALSE) {
class[class %in% c("number", "whole number")] <- "(whole) number"
}
class[class == "character"] <- "text string"
class[class %in% c("Date", "POSIXt")] <- "date"
class[class == "Date"] <- "date"
class[class %in% c("POSIXt", "POSIXct", "POSIXlt")] <- "date/time"
class[class != class.bak] <- paste0(
ifelse(plural, "", "a "),
class[class != class.bak],
@ -777,14 +742,14 @@ meet_criteria <- function(object,
# if object is missing, or another error:
tryCatch(invisible(object),
error = function(e) pkg_env$meet_criteria_error_txt <- e$message
error = function(e) AMR_env$meet_criteria_error_txt <- e$message
)
if (!is.null(pkg_env$meet_criteria_error_txt)) {
error_txt <- pkg_env$meet_criteria_error_txt
pkg_env$meet_criteria_error_txt <- NULL
if (!is.null(AMR_env$meet_criteria_error_txt)) {
error_txt <- AMR_env$meet_criteria_error_txt
AMR_env$meet_criteria_error_txt <- NULL
stop(error_txt, call. = FALSE) # don't use stop_() here, our pkg may not be loaded yet
}
pkg_env$meet_criteria_error_txt <- NULL
AMR_env$meet_criteria_error_txt <- NULL
if (is.null(object)) {
stop_if(allow_NULL == FALSE, "argument `", obj_name, "` must not be NULL", call = call_depth)
@ -999,8 +964,8 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
# combination of environment ID (such as "0x7fed4ee8c848")
# and relevant system call (where 'match_fn' is being called in)
calls <- sys.calls()
if (!identical(Sys.getenv("R_RUN_TINYTEST"), "true") &&
!any(as.character(calls[[1]]) %like_case% "run_test_dir|run_test_file|test_all|tinytest|test_package|testthat")) {
in_test <- any(as.character(calls[[1]]) %like_case% "run_test_dir|run_test_file|test_all|tinytest|test_package|testthat", na.rm = TRUE)
if (!isTRUE(in_test)) {
for (i in seq_len(length(calls))) {
call_clean <- gsub("[^a-zA-Z0-9_().-]", "", as.character(calls[[i]]), perl = TRUE)
if (any(call_clean %like% paste0(match_fn, "\\("), na.rm = TRUE)) {
@ -1012,8 +977,8 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
}
}
c(
envir = paste0(sample(c(c(0:9), letters[1:6]), size = 32, replace = TRUE), collapse = ""),
call = paste0(sample(c(c(0:9), letters[1:6]), size = 32, replace = TRUE), collapse = "")
envir = paste0(sample(c(0:9, letters[1:6]), size = 32, replace = TRUE), collapse = ""),
call = paste0(sample(c(0:9, letters[1:6]), size = 32, replace = TRUE), collapse = "")
)
}
@ -1024,10 +989,10 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
# this is to prevent that messages/notes will be printed for every dplyr group or more than once per session
# e.g. this would show a msg 4 times: example_isolates %>% group_by(ward) %>% filter(mo_is_gram_negative())
salt <- gsub("[^a-zA-Z0-9|_-]", "?", paste(c(...), sep = "|", collapse = "|"), perl = TRUE)
not_thrown_before <- is.null(pkg_env[[paste0("thrown_msg.", fn, ".", salt)]]) ||
salt <- gsub("[^a-zA-Z0-9|_-]", "?", substr(paste(c(...), sep = "|", collapse = "|"), 1, 512), perl = TRUE)
not_thrown_before <- is.null(AMR_env[[paste0("thrown_msg.", fn, ".", salt)]]) ||
!identical(
pkg_env[[paste0("thrown_msg.", fn, ".", salt)]],
AMR_env[[paste0("thrown_msg.", fn, ".", salt)]],
unique_call_id(
entire_session = entire_session,
match_fn = fn
@ -1038,7 +1003,7 @@ message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
assign(
x = paste0("thrown_msg.", fn, ".", salt),
value = unique_call_id(entire_session = entire_session, match_fn = fn),
envir = pkg_env
envir = AMR_env
)
}
not_thrown_before
@ -1100,7 +1065,10 @@ has_colour <- function() {
# set colours if console has_colour()
try_colour <- function(..., before, after, collapse = " ") {
txt <- paste0(unlist(list(...)), collapse = collapse)
if (length(c(...)) == 0) {
return(character(0))
}
txt <- paste0(c(...), collapse = collapse)
if (isTRUE(has_colour())) {
if (is.null(collapse)) {
paste0(before, txt, after, collapse = NULL)
@ -1166,26 +1134,26 @@ font_grey_bg <- function(..., collapse = " ") {
try_colour(..., before = "\033[48;5;255m", after = "\033[49m", collapse = collapse)
}
}
font_green_bg <- function(..., collapse = " ") {
try_colour(..., before = "\033[42m", after = "\033[49m", collapse = collapse)
}
font_rsi_R_bg <- function(..., collapse = " ") {
# ED553B
try_colour(..., before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
}
font_rsi_S_bg <- function(..., collapse = " ") {
# 3CAEA3
try_colour(..., before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
}
font_rsi_I_bg <- function(..., collapse = " ") {
# F6D55C
try_colour(..., before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
}
font_red_bg <- function(..., collapse = " ") {
try_colour(..., before = "\033[41m", after = "\033[49m", collapse = collapse)
# this is #ed553b (picked to be colourblind-safe with other RSI colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
}
font_orange_bg <- function(..., collapse = " ") {
# this is #f6d55c (picked to be colourblind-safe with other RSI colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;222m", after = "\033[49m", collapse = collapse)
}
font_yellow_bg <- function(..., collapse = " ") {
try_colour(..., before = "\033[43m", after = "\033[49m", collapse = collapse)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;228m", after = "\033[49m", collapse = collapse)
}
font_green_bg <- function(..., collapse = " ") {
# this is #3caea3 (picked to be colourblind-safe with other RSI colours)
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
}
font_purple_bg <- function(..., collapse = " ") {
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
}
font_rose_bg <- function(..., collapse = " ") {
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;217m", after = "\033[49m", collapse = collapse)
}
font_na <- function(..., collapse = " ") {
font_red(..., collapse = collapse)
@ -1281,61 +1249,21 @@ as_original_data_class <- function(df, old_class = NULL) {
fn <- import_fn("as_tsibble", "tsibble")
} else if ("data.table" %in% old_class && pkg_is_available("data.table", also_load = FALSE)) {
fn <- import_fn("as.data.table", "data.table")
} else if ("tabyl" %in% old_class && pkg_is_available("janitor", also_load = FALSE)) {
fn <- import_fn("as_tabyl", "janitor")
} else {
fn <- base::as.data.frame
}
fn(df)
}
# copied from vctrs::s3_register by their permission:
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
s3_register <- function(generic, class, method = NULL) {
stopifnot(is.character(generic), length(generic) == 1)
stopifnot(is.character(class), length(class) == 1)
pieces <- strsplit(generic, "::")[[1]]
stopifnot(length(pieces) == 2)
package <- pieces[[1]]
generic <- pieces[[2]]
caller <- parent.frame()
get_method_env <- function() {
top <- topenv(caller)
if (isNamespace(top)) {
asNamespace(environmentName(top))
} else {
caller
}
}
get_method <- function(method, env) {
if (is.null(method)) {
get(paste0(generic, ".", class), envir = get_method_env())
} else {
method
}
}
method_fn <- get_method(method)
stopifnot(is.function(method_fn))
setHook(packageEvent(package, "onLoad"), function(...) {
ns <- asNamespace(package)
method_fn <- get_method(method)
registerS3method(generic, class, method_fn, envir = ns)
})
if (!isNamespaceLoaded(package)) {
return(invisible())
}
envir <- asNamespace(package)
if (exists(generic, envir)) {
registerS3method(generic, class, method_fn, envir = envir)
}
invisible()
}
# works exactly like round(), but rounds `round2(44.55, 1)` to 44.6 instead of 44.5
# and adds decimal zeroes until `digits` is reached when force_zero = TRUE
round2 <- function(x, digits = 1, force_zero = TRUE) {
x <- as.double(x)
# https://stackoverflow.com/a/12688836/4575331
val <- (trunc((abs(x) * 10^digits) + 0.5) / 10^digits) * sign(x)
if (digits > 0 & force_zero == TRUE) {
if (digits > 0 && force_zero == TRUE) {
values_trans <- val[val != as.integer(val) & !is.na(val)]
val[val != as.integer(val) & !is.na(val)] <- paste0(
values_trans,
@ -1426,17 +1354,122 @@ percentage <- function(x, digits = NULL, ...) {
}
time_start_tracking <- function() {
pkg_env$time_start <- round(as.double(Sys.time()) * 1000)
AMR_env$time_start <- round(as.double(Sys.time()) * 1000)
}
time_track <- function(name = NULL) {
paste("(until now:", trimws(round(as.double(Sys.time()) * 1000) - pkg_env$time_start), "ms)")
paste("(until now:", trimws(round(as.double(Sys.time()) * 1000) - AMR_env$time_start), "ms)")
}
# prevent dependency on package 'backports' ----
# these functions were not available in previous versions of R (last checked: R 4.1.0)
trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u0085\u00A0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u200C\u200D\u2028\u2029\u202F\u205F\u2060\u3000\uFEFF]") {
# this is even faster than trimws() itself which sets " \t\n\r".
trimws(..., whitespace = whitespace)
}
# Faster data.table implementations ----
match <- function(x, table, ...) {
if (isTRUE(AMR_env$has_data.table) && is.character(x) && is.character(table)) {
# data.table::chmatch() is 35% faster than base::match() for character
getExportedValue(name = "chmatch", ns = asNamespace("data.table"))(x, table, ...)
} else {
base::match(x, table, ...)
}
}
`%in%` <- function(x, table) {
if (isTRUE(AMR_env$has_data.table) && is.character(x) && is.character(table)) {
# data.table::`%chin%`() is 20-50% faster than base::`%in%`() for character
getExportedValue(name = "%chin%", ns = asNamespace("data.table"))(x, table)
} else {
base::`%in%`(x, table)
}
}
# nolint start
# Register S3 methods ----
# copied from vctrs::s3_register by their permission:
# https://github.com/r-lib/vctrs/blob/05968ce8e669f73213e3e894b5f4424af4f46316/R/register-s3.R
s3_register <- function(generic, class, method = NULL) {
stopifnot(is.character(generic), length(generic) == 1)
stopifnot(is.character(class), length(class) == 1)
pieces <- strsplit(generic, "::")[[1]]
stopifnot(length(pieces) == 2)
package <- pieces[[1]]
generic <- pieces[[2]]
caller <- parent.frame()
get_method_env <- function() {
top <- topenv(caller)
if (isNamespace(top)) {
asNamespace(environmentName(top))
} else {
caller
}
}
get_method <- function(method, env) {
if (is.null(method)) {
get(paste0(generic, ".", class), envir = get_method_env())
} else {
method
}
}
method_fn <- get_method(method)
stopifnot(is.function(method_fn))
setHook(packageEvent(package, "onLoad"), function(...) {
ns <- asNamespace(package)
method_fn <- get_method(method)
registerS3method(generic, class, method_fn, envir = ns)
})
if (!isNamespaceLoaded(package)) {
return(invisible())
}
envir <- asNamespace(package)
if (exists(generic, envir)) {
registerS3method(generic, class, method_fn, envir = envir)
}
invisible()
}
# Support old R versions ----
# these functions were not available in previous versions of R
# see here for the full list: https://github.com/r-lib/backports
strrep <- function(x, times) {
if (getRversion() < "3.1.0") {
# R-3.0 does not contain these functions, set them here to prevent installation failure
# (required for extension of the <mic> class)
cospi <- function(...) 1
sinpi <- function(...) 1
tanpi <- function(...) 1
}
if (getRversion() < "3.2.0") {
anyNA <- function(x, recursive = FALSE) {
if (isTRUE(recursive) && (is.list(x) || is.pairlist(x))) {
return(any(rapply(x, anyNA, how = "unlist", recursive = FALSE)))
}
any(is.na(x))
}
dir.exists <- function(paths) {
x <- base::file.info(paths)$isdir
!is.na(x) & x
}
file.size <- function(...) {
file.info(...)$size
}
file.mtime <- function(...) {
file.info(...)$mtime
}
isNamespaceLoaded <- function(pkg) {
pkg %in% loadedNamespaces()
}
lengths <- function(x, use.names = TRUE) {
vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names)
}
}
if (getRversion() < "3.3.0") {
strrep <- function(x, times) {
x <- as.character(x)
if (length(x) == 0L) {
return(x)
@ -1450,8 +1483,24 @@ strrep <- function(x, times) {
}
paste0(replicate(times, x), collapse = "")
}, list(x = x, times = times), MoreArgs = list()), use.names = FALSE)
}
}
trimws <- function(x, which = c("both", "left", "right"), whitespace = "[ \t\r\n]") {
if (getRversion() < "3.5.0") {
isFALSE <- function(x) {
is.logical(x) && length(x) == 1L && !is.na(x) && !x
}
}
if (getRversion() < "3.6.0") {
str2lang <- function(s) {
stopifnot(length(s) == 1L)
ex <- parse(text = s, keep.source = FALSE)
stopifnot(length(ex) == 1L)
ex[[1L]]
}
# trims() was introduced in 3.3.0, but its argument `whitespace` only in 3.6.0
trimws <- function(x, which = c("both", "left", "right"), whitespace = "[ \t\r\n]") {
which <- match.arg(which)
mysub <- function(re, x) sub(re, "", x, perl = TRUE)
switch(which,
@ -1459,40 +1508,13 @@ trimws <- function(x, which = c("both", "left", "right"), whitespace = "[ \t\r\n
right = mysub(paste0(whitespace, "+$"), x),
both = mysub(paste0(whitespace, "+$"), mysub(paste0("^", whitespace, "+"), x))
)
}
isFALSE <- function(x) {
is.logical(x) && length(x) == 1L && !is.na(x) && !x
}
deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
paste(deparse(expr, width.cutoff, ...), collapse = collapse)
}
file.size <- function(...) {
file.info(...)$size
}
file.mtime <- function(...) {
file.info(...)$mtime
}
str2lang <- function(s) {
stopifnot(length(s) == 1L)
ex <- parse(text = s, keep.source = FALSE)
stopifnot(length(ex) == 1L)
ex[[1L]]
}
isNamespaceLoaded <- function(pkg) {
pkg %in% loadedNamespaces()
}
lengths <- function(x, use.names = TRUE) {
vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names)
}
}
if (getRversion() < "3.1") {
# R-3.0 does not contain these functions, set them here to prevent installation failure
# (required for extension of the <mic> class)
cospi <- function(...) 1
sinpi <- function(...) 1
tanpi <- function(...) 1
}
dir.exists <- function(paths) {
x <- base::file.info(paths)$isdir
!is.na(x) & x
if (getRversion() < "4.0.0") {
deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
paste(deparse(expr, width.cutoff, ...), collapse = collapse)
}
}
# nolint end

10
R/aa_helper_pm_functions.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

51
R/ab.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -91,8 +95,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
meet_criteria(flag_multiple_results, allow_class = "logical", has_length = 1)
meet_criteria(info, allow_class = "logical", has_length = 1)
check_dataset_integrity()
if (is.ab(x)) {
return(x)
}
@ -109,7 +111,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_bak <- x
x <- toupper(x)
x_nonNA <- x[!is.na(x)]
# remove diacritics
x <- iconv(x, from = "UTF-8", to = "ASCII//TRANSLIT")
@ -128,7 +129,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_unknown_ATCs <- character(0)
note_if_more_than_one_found <- function(found, index, from_text) {
if (initial_search == TRUE & isTRUE(length(from_text) > 1)) {
if (initial_search == TRUE && isTRUE(length(from_text) > 1)) {
abnames <- ab_name(from_text, tolower = TRUE, initial_search = FALSE)
if (ab_name(found[1L], language = NULL) %like% "(clavulanic acid|avibactam)") {
abnames <- abnames[!abnames %in% c("clavulanic acid", "avibactam")]
@ -165,7 +166,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_new[known_codes_cid] <- AB_lookup$ab[match(x[known_codes_cid], AB_lookup$cid)]
already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid
if (initial_search == TRUE & sum(already_known) < length(x)) {
if (initial_search == TRUE && 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))
}
@ -175,10 +176,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
progress$tick()
}
if (is.na(x[i]) | is.null(x[i])) {
if (is.na(x[i]) || is.null(x[i])) {
next
}
if (identical(x[i], "") |
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])
@ -211,7 +212,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
AB_lookup$generalised_loinc,
function(s) x[i] %in% s
))
found <- antibiotics$ab[loinc_found == TRUE]
found <- AMR::antibiotics$ab[loinc_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
@ -222,7 +223,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
AB_lookup$generalised_synonyms,
function(s) x[i] %in% s
))
found <- antibiotics$ab[synonym_found == TRUE]
found <- AMR::antibiotics$ab[synonym_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
@ -232,9 +233,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
abbr_found <- unlist(lapply(
AB_lookup$generalised_abbreviations,
# require at least 2 characters for abbreviations
function(s) x[i] %in% s & nchar(x[i]) >= 2
function(s) x[i] %in% s && nchar(x[i]) >= 2
))
found <- antibiotics$ab[abbr_found == TRUE]
found <- AMR::antibiotics$ab[abbr_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
@ -281,14 +282,14 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
}
# try if name starts with it
found <- antibiotics[which(AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE]
found <- AMR::antibiotics[which(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 <- antibiotics[which(AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE]
if (nchar(x[i]) >= 4 & length(found) > 0) {
found <- AMR::antibiotics[which(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
}
@ -298,7 +299,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
AB_lookup$generalised_synonyms,
function(s) any(s %like% paste0("^", x_spelling))
))
found <- antibiotics$ab[synonym_found == TRUE]
found <- AMR::antibiotics$ab[synonym_found == TRUE]
if (length(found) > 0) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
@ -312,16 +313,16 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
# try by removing all spaces
if (x[i] %like% " ") {
found <- suppressWarnings(as.ab(gsub(" +", "", x[i], perl = TRUE), initial_search = FALSE))
if (length(found) > 0 & !is.na(found)) {
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]") {
if (x[i] %like% " " || x[i] %like% "[0-9]") {
found <- suppressWarnings(as.ab(gsub("[ 0-9]", "", x[i], perl = TRUE), initial_search = FALSE))
if (length(found) > 0 & !is.na(found)) {
if (length(found) > 0 && !is.na(found)) {
x_new[i] <- note_if_more_than_one_found(found, i, from_text)
next
}
@ -477,7 +478,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
x_unknown <- c(x_unknown, x_bak[x[i] == x_bak_clean][1])
}
if (initial_search == TRUE & sum(already_known) < length(x)) {
if (initial_search == TRUE && sum(already_known) < length(x)) {
close(progress)
}
@ -566,7 +567,7 @@ as.data.frame.ab <- function(x, ...) {
"[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @method [[<- ab
#' @export
@ -574,7 +575,7 @@ as.data.frame.ab <- function(x, ...) {
"[[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @method c ab
#' @export
@ -583,7 +584,7 @@ c.ab <- function(...) {
x <- list(...)[[1L]]
y <- NextMethod()
attributes(y) <- attributes(x)
return_after_integrity_check(y, "antimicrobial code", antibiotics$ab)
return_after_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @method unique ab

28
R/ab_from_text.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -110,7 +114,7 @@ ab_from_text <- function(text,
meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
meet_criteria(info, allow_class = "logical", has_length = 1)
type <- tolower(trimws(type))
type <- tolower(trimws2(type))
text <- tolower(as.character(text))
text_split_all <- strsplit(text, "[ ;.,:\\|]")
@ -120,21 +124,21 @@ ab_from_text <- function(text,
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)) {
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(
out <- as.ab(text_split, ...)
as.ab(text_split, ...)
)
})
} else {
# no thorough search
abbr <- unlist(antibiotics$abbreviations)
abbr <- unlist(AMR::antibiotics$abbreviations)
abbr <- abbr[nchar(abbr) >= 4]
names_atc <- substr(c(antibiotics$name, antibiotics$atc), 1, 5)
synonyms <- unlist(antibiotics$synonyms)
names_atc <- substr(c(AMR::antibiotics$name, AMR::antibiotics$atc), 1, 5)
synonyms <- unlist(AMR::antibiotics$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))]
@ -149,7 +153,7 @@ ab_from_text <- function(text,
result <- lapply(text_split_all, function(text_split) {
progress$tick()
suppressWarnings(
out <- as.ab(
as.ab(
unique(c(
text_split[text_split %like_case% to_regex(abbr)],
text_split[text_split %like_case% to_regex(names_atc)],
@ -176,7 +180,7 @@ ab_from_text <- function(text,
}
})
} else if (type %like% "dos") {
text_split_all <- strsplit(text, " ")
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"

36
R/ab_property.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -125,7 +129,7 @@
#' }
ab_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, 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)
@ -168,7 +172,7 @@ ab_tradenames <- function(x, ...) {
#' @export
ab_group <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
translate_into_language(ab_validate(x = x, property = "group", ...), language = language, only_affect_ab_names = TRUE)
}
@ -208,7 +212,7 @@ ab_atc <- function(x, only_first = FALSE, ...) {
#' @export
ab_atc_group1 <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
translate_into_language(ab_validate(x = x, property = "atc_group1", ...), language = language, only_affect_ab_names = TRUE)
}
@ -216,7 +220,7 @@ ab_atc_group1 <- function(x, language = get_AMR_locale(), ...) {
#' @export
ab_atc_group2 <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
translate_into_language(ab_validate(x = x, property = "atc_group2", ...), language = language, only_affect_ab_names = TRUE)
}
@ -289,7 +293,7 @@ ab_ddd_units <- function(x, administration = "oral", ...) {
#' @export
ab_info <- function(x, language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
x <- as.ab(x, ...)
list(
@ -334,7 +338,7 @@ ab_url <- function(x, open = FALSE, ...) {
}
if (open == TRUE) {
if (length(u) > 1 & !is.na(u[1L])) {
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])) {
@ -348,7 +352,7 @@ ab_url <- function(x, open = FALSE, ...) {
#' @export
ab_property <- function(x, property = "name", language = get_AMR_locale(), ...) {
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1)
meet_criteria(property, is_in = colnames(AMR::antibiotics), has_length = 1)
meet_criteria(language, is_in = c(LANGUAGES_SUPPORTED, ""), has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
translate_into_language(ab_validate(x = x, property = property, ...), language = language)
}
@ -358,8 +362,8 @@ ab_property <- function(x, property = "name", language = get_AMR_locale(), ...)
#' @export
set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale(), snake_case = NULL) {
meet_criteria(data, allow_class = c("data.frame", "character"))
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1, ignore.case = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(property, is_in = colnames(AMR::antibiotics), 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))
@ -422,7 +426,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
x <- tolower(gsub("[^a-zA-Z0-9]+", "_", x))
}
if (any(duplicated(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"
@ -433,7 +437,7 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
if (length(dups) > 1) {
# there are duplicates
dup_add_int <- dups[2:length(dups)]
x[dup_add_int] <<- paste0(x[dup_add_int], "_", c(2:length(dups)))
x[dup_add_int] <<- paste0(x[dup_add_int], "_", 2:length(dups))
}
}
))
@ -448,15 +452,13 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale
}
ab_validate <- function(x, property, ...) {
check_dataset_integrity()
if (tryCatch(all(x[!is.na(x)] %in% AB_lookup$ab), error = function(e) FALSE)) {
# special case for ab_* functions where class is already <ab>
x <- AB_lookup[match(x, 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% antibiotics[1, property, drop = TRUE],
tryCatch(x[1L] %in% AMR::antibiotics[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE)
)

49
R/ab_selectors.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -420,8 +424,8 @@ administrable_per_os <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_per_os"
)
agents_all <- antibiotics[which(!is.na(antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- antibiotics[which(antibiotics$ab %in% ab_in_data & !is.na(antibiotics$oral_ddd)), "ab", drop = TRUE]
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_per_os",
@ -458,8 +462,8 @@ administrable_iv <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_iv"
)
agents_all <- antibiotics[which(!is.na(antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- antibiotics[which(antibiotics$ab %in% ab_in_data & !is.na(antibiotics$iv_ddd)), "ab", drop = TRUE]
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_iv",
@ -539,7 +543,7 @@ ab_select_exec <- function(function_name,
)
# untreatable drugs
if (only_treatable == TRUE) {
untreatable <- antibiotics[which(antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
untreatable <- AMR::antibiotics[which(AMR::antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
if (any(untreatable %in% names(ab_in_data))) {
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
warning_(
@ -563,11 +567,18 @@ ab_select_exec <- function(function_name,
return(NULL)
}
if (is.null(ab_class_args)) {
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
ab_group <- NULL
if (isTRUE(function_name == "antifungals")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antifungals")]
} else if (isTRUE(function_name == "antimycobacterials")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")]
} else {
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
ab_group <- function_name
}
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
tolower = TRUE,
language = NULL
@ -755,12 +766,12 @@ any.ab_selector_any_all <- function(..., na.rm = FALSE) {
}
is_any <- function(el1) {
syscalls <- paste0(trimws(deparse(sys.calls())), collapse = " ")
syscalls <- paste0(trimws2(deparse(sys.calls())), collapse = " ")
el1 <- gsub("(.*),.*", "\\1", el1)
syscalls %like% paste0("[^_a-zA-Z0-9]any\\(", "(c\\()?", el1)
}
is_all <- function(el1) {
syscalls <- paste0(trimws(deparse(sys.calls())), collapse = " ")
syscalls <- paste0(trimws2(deparse(sys.calls())), collapse = " ")
el1 <- gsub("(.*),.*", "\\1", el1)
syscalls %like% paste0("[^_a-zA-Z0-9]all\\(", "(c\\()?", el1)
}
@ -782,16 +793,16 @@ find_ab_names <- function(ab_group, n = 3) {
ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group)
# try popular first, they have DDDs
drugs <- antibiotics[which((!is.na(antibiotics$iv_ddd) | !is.na(antibiotics$oral_ddd)) &
antibiotics$name %unlike% " " &
antibiotics$group %like% ab_group &
antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- AMR::antibiotics[which((!is.na(AMR::antibiotics$iv_ddd) | !is.na(AMR::antibiotics$oral_ddd)) &
AMR::antibiotics$name %unlike% " " &
AMR::antibiotics$group %like% ab_group &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
if (length(drugs) < n) {
# now try it all
drugs <- antibiotics[which((antibiotics$group %like% ab_group |
antibiotics$atc_group1 %like% ab_group |
antibiotics$atc_group2 %like% ab_group) &
antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- antibiotics[which((AMR::antibiotics$group %like% ab_group |
AMR::antibiotics$atc_group1 %like% ab_group |
AMR::antibiotics$atc_group2 %like% ab_group) &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
}
if (length(drugs) == 0) {
return("??")

10
R/age.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

41
R/amr.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -25,16 +29,19 @@
#' The `AMR` Package
#'
#' @description
#' Welcome to the `AMR` package.
#' @details
#'
#' `AMR` is a free, open-source and independent \R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. Our aim is to provide a standard for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
#'
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
#'
#' After installing this package, \R knows `r format_included_data_number(microorganisms)` distinct microbial species and all `r format_included_data_number(rbind(antibiotics[, "atc", drop = FALSE], antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-NET, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data.
#'
#' This package is fully independent of any other \R package and works on Windows, macOS and Linux with all versions of \R since R-3.0.0 (April 2013). It was designed to work in any setting, including those with very limited resources. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice and University Medical Center Groningen. This \R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.
#'
#' This package can be used for:
#' - Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the Catalogue of Life and List of Prokaryotic names with Standing in Nomenclature
#' - Reference for the taxonomy of microorganisms, since the package contains all microbial (sub)species from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF)
#' - Interpreting raw MIC and disk diffusion values, based on the latest CLSI or EUCAST guidelines
#' - Retrieving antimicrobial drug names, doses and forms of administration from clinical health care records
#' - Determining first isolates to be used for AMR data analysis
@ -53,21 +60,17 @@
#'
#' @section Reference Data Publicly Available:
#' All data sets in this `AMR` package (about microorganisms, antibiotics, R/SI interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @section Contact Us:
#' For suggestions, comments or questions, please contact us via:
#' @source
#' To cite AMR in publications use:
#'
#' Dr. Matthijs S. Berends \cr
#' m.s.berends \[at\] umcg \[dot\] nl \cr
#' University of Groningen
#' Department of Medical Microbiology and Infection Prevention \cr
#' University Medical Center Groningen \cr
#' Post Office Box 30001 \cr
#' 9700 RB Groningen \cr
#' The Netherlands
#' <https://msberends.github.io/AMR/>
#' 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}.
#'
#' If you have found a bug, please file a new issue at: \cr
#' <https://github.com/msberends/AMR/issues>
#' A BibTeX entry for LaTeX users is:
#'
#' \preformatted{
#' `r format(citation("AMR"), style = "bib")`
#' }
#' @name AMR
#' @keywords internal
#' @rdname AMR
NULL
"_PACKAGE"

18
R/atc_online.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -94,9 +98,7 @@ atc_online_property <- function(atc_code,
html_text <- import_fn("html_text", "rvest")
read_html <- import_fn("read_html", "xml2")
check_dataset_integrity()
if (!all(atc_code %in% unlist(antibiotics$atc))) {
if (!all(atc_code %in% unlist(AMR::antibiotics$atc))) {
atc_code <- as.character(ab_atc(atc_code, only_first = TRUE))
}
@ -183,7 +185,7 @@ atc_online_property <- function(atc_code,
# 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])) {
if (!"adm.r" %in% colnames(out) || is.na(out[1, "adm.r", drop = TRUE])) {
returnvalue[i] <- NA
next
} else {
@ -197,7 +199,7 @@ atc_online_property <- function(atc_code,
}
}
if (property == "groups" & length(returnvalue) == 1) {
if (property == "groups" && length(returnvalue) == 1) {
returnvalue <- returnvalue[[1]]
}

10
R/availability.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

38
R/bug_drug_combinations.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -178,7 +182,7 @@ format.bug_drug_combinations <- function(x,
...) {
meet_criteria(x, allow_class = "data.frame")
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
@ -196,10 +200,10 @@ format.bug_drug_combinations <- function(x,
x <- data.frame(
mo = gsub("(.*)%%(.*)", "\\1", names(idx)),
ab = gsub("(.*)%%(.*)", "\\2", names(idx)),
S = sapply(idx, function(i) sum(x$S[i], na.rm = TRUE)),
I = sapply(idx, function(i) sum(x$I[i], na.rm = TRUE)),
R = sapply(idx, function(i) sum(x$R[i], na.rm = TRUE)),
total = sapply(idx, function(i) {
S = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$S[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)),
total = vapply(FUN.VALUE = double(1), idx, function(i) {
sum(x$S[i], na.rm = TRUE) +
sum(x$I[i], na.rm = TRUE) +
sum(x$R[i], na.rm = TRUE)
@ -214,7 +218,7 @@ format.bug_drug_combinations <- function(x,
if (remove_intrinsic_resistant == TRUE) {
x <- subset(x, R != total)
}
if (combine_SI == TRUE | combine_IR == FALSE) {
if (combine_SI == TRUE || combine_IR == FALSE) {
x$isolates <- x$R
} else {
x$isolates <- x$R + x$I
@ -224,13 +228,13 @@ format.bug_drug_combinations <- function(x,
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])
ab_txt[i] <- gsub("cid", ab_cid(ab[i]), ab_txt[i])
ab_txt[i] <- gsub("group", ab_group(ab[i], language = language), ab_txt[i])
ab_txt[i] <- gsub("atc_group1", ab_atc_group1(ab[i], language = language), ab_txt[i])
ab_txt[i] <- gsub("atc_group2", ab_atc_group2(ab[i], language = language), ab_txt[i])
ab_txt[i] <- gsub("atc", ab_atc(ab[i], only_first = TRUE), ab_txt[i])
ab_txt[i] <- gsub("name", ab_name(ab[i], language = language), ab_txt[i])
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
@ -317,7 +321,7 @@ format.bug_drug_combinations <- function(x,
}
if (remove_intrinsic_resistant == TRUE) {
y <- y[, !vapply(FUN.VALUE = logical(1), y, function(col) all(col %like% "100", na.rm = TRUE) & !any(is.na(col))), drop = FALSE]
y <- y[, !vapply(FUN.VALUE = logical(1), y, function(col) all(col %like% "100", na.rm = TRUE) & !anyNA(col)), drop = FALSE]
}
rownames(y) <- NULL

145
R/catalogue_of_life.R
View File

@ -1,145 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
format_included_data_number <- function(data) {
if (is.data.frame(data)) {
n <- nrow(data)
} else {
n <- length(unique(data))
}
if (n > 10000) {
rounder <- -3 # round on thousands
} else if (n > 1000) {
rounder <- -2 # round on hundreds
} else {
rounder <- -1 # round on tens
}
paste0("~", format(round(n, rounder), decimal.mark = ".", big.mark = ","))
}
#' The Catalogue of Life
#'
#' This package contains the complete taxonomic tree (last updated: `r CATALOGUE_OF_LIFE$yearmonth_LPSN`) of almost all microorganisms from the authoritative and comprehensive Catalogue of Life (CoL), supplemented with data from the List of Prokaryotic names with Standing in Nomenclature (LPSN).
#' @section Catalogue of Life:
#' \if{html}{\figure{logo_col.png}{options: height="40" style=margin-bottom:"5"} \cr}
#' This package contains the complete taxonomic tree of almost all microorganisms (`r format_included_data_number(microorganisms)` species) from the authoritative and comprehensive Catalogue of Life (CoL, <http://www.catalogueoflife.org>). The CoL is the most comprehensive and authoritative global index of species currently available. Nonetheless, we supplemented the CoL data with data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, [lpsn.dsmz.de](https://lpsn.dsmz.de)). This supplementation is needed until the [CoL+ project](https://github.com/CatalogueOfLife/general) is finished, which we await.
#'
#' [Click here][catalogue_of_life] for more information about the included taxa. Check which versions of the CoL and LPSN were included in this package with [catalogue_of_life_version()].
#' @section Included Taxa:
#' Included are:
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria", "Chromista", "Protozoa")), , drop = FALSE])` (sub)species from the kingdoms of Archaea, Bacteria, Chromista and Protozoa
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), , drop = FALSE])` (sub)species from these orders of the kingdom of Fungi: Eurotiales, Microascales, Mucorales, Onygenales, Pneumocystales, Saccharomycetales, Schizosaccharomycetales and Tremellales, as well as `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi" & !microorganisms$order %in% c("Eurotiales", "Microascales", "Mucorales", "Onygenales", "Pneumocystales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales")), ])` other fungal (sub)species. 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 and including everything would tremendously slow down our algorithms too. By only including the aforementioned taxonomic orders, the most relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
#' - All `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.old)` 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 responsible author(s) and year of scientific publication
#'
#' The Catalogue of Life (<http://www.catalogueoflife.org>) is the most comprehensive and authoritative global index of species currently available. It holds essential information on the names, relationships and distributions of over 1.9 million species. The Catalogue of Life is used to support the major biodiversity and conservation information services such as the Global Biodiversity Information Facility (GBIF), Encyclopedia of Life (EoL) and the International Union for Conservation of Nature Red List. It is recognised by the Convention on Biological Diversity as a significant component of the Global Taxonomy Initiative and a contribution to Target 1 of the Global Strategy for Plant Conservation.
#'
#' The syntax used to transform the original data to a cleansed \R format, can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R>.
#' @name catalogue_of_life
#' @rdname catalogue_of_life
#' @seealso Data set [microorganisms] for the actual data. \cr
#' Function [as.mo()] to use the data for intelligent determination of microorganisms.
#' @examples
#' # Get version info of included data set
#' catalogue_of_life_version()
#'
#'
#' # Get a note when a species was renamed
#' mo_shortname("Chlamydophila psittaci")
#'
#' # Get any property from the entire taxonomic tree for all included species
#' mo_class("Escherichia coli")
#'
#' mo_family("Escherichia coli")
#'
#' mo_gramstain("Escherichia coli") # based on kingdom and phylum, see ?mo_gramstain
#'
#' mo_ref("Escherichia coli")
#'
#' # Do not get mistaken - this package is about microorganisms
#' mo_kingdom("C. elegans")
#' mo_name("C. elegans")
NULL
#' Version info of included Catalogue of Life
#'
#' This function returns information about the included data from the Catalogue of Life.
#' @seealso [microorganisms]
#' @details For LPSN, see [microorganisms].
#' @return a [list], which prints in pretty format
#' @inheritSection catalogue_of_life Catalogue of Life
#' @export
catalogue_of_life_version <- function() {
check_dataset_integrity()
# see the `CATALOGUE_OF_LIFE` list in R/globals.R
lst <- list(
CoL =
list(
version = gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$version, fixed = TRUE),
url = gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$url_CoL, fixed = TRUE),
n = nrow(pm_filter(microorganisms, source == "CoL"))
),
LPSN =
list(
version = "List of Prokaryotic names with Standing in Nomenclature",
url = CATALOGUE_OF_LIFE$url_LPSN,
yearmonth = CATALOGUE_OF_LIFE$yearmonth_LPSN,
n = nrow(pm_filter(microorganisms, source == "LPSN"))
),
total_included =
list(
n_total_species = nrow(microorganisms),
n_total_synonyms = nrow(microorganisms.old)
)
)
set_clean_class(lst,
new_class = c("catalogue_of_life_version", "list")
)
}
#' @method print catalogue_of_life_version
#' @export
#' @noRd
print.catalogue_of_life_version <- function(x, ...) {
cat(paste0(
font_bold("Included in this AMR package (v", utils::packageDescription("AMR")$Version, ") are:\n\n", collapse = ""),
font_underline(x$CoL$version), "\n",
" Available at: ", font_blue(x$CoL$url), "\n",
" Number of included microbial species: ", format(x$CoL$n, big.mark = ","), "\n",
font_underline(paste0(
x$LPSN$version, " (",
x$LPSN$yearmonth, ")"
)), "\n",
" Available at: ", font_blue(x$LPSN$url), "\n",
" Number of included bacterial species: ", format(x$LPSN$n, big.mark = ","), "\n\n",
"=> Total number of species included: ", format(x$total_included$n_total_species, big.mark = ","), "\n",
"=> Total number of synonyms included: ", format(x$total_included$n_total_synonyms, big.mark = ","), "\n\n",
"See for more info ", font_grey_bg("`?microorganisms`"), " and ", font_grey_bg("`?catalogue_of_life`"), ".\n"
))
}

10
R/count.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

46
R/custom_eucast_rules.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -35,38 +39,54 @@
#'
#' 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}
#' ```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}
#' ```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}
#' ```r
#' df <- data.frame(mo = c("Escherichia coli", "Klebsiella pneumoniae"),
#' TZP = as.rsi("R"),
#' ampi = as.rsi("S"),
#' cipro = as.rsi("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)
#' #> 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 variables 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}
#' ```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)
#' #> mo TZP ampi cipro
#' #> 1 Escherichia coli R S S
#' #> 2 Klebsiella pneumoniae R R S
#' ```
#'
#' ### Usage of antibiotic group names
@ -207,11 +227,11 @@ print.custom_eucast_rules <- function(x, ...) {
if (is.na(rule$result_value)) {
val <- font_red("<NA>")
} else if (rule$result_value == "R") {
val <- font_rsi_R_bg(font_black(" R "))
val <- font_red_bg(" R ")
} else if (rule$result_value == "S") {
val <- font_rsi_S_bg(font_black(" S "))
val <- font_green_bg(" S ")
} else {
val <- font_rsi_I_bg(font_black(" I "))
val <- font_orange_bg(" I ")
}
agents <- paste0(
font_blue(ab_name(rule$result_group, language = NULL, tolower = TRUE),
@ -248,9 +268,9 @@ format_custom_query_rule <- function(query, colours = has_colour()) {
query <- gsub(" %in% ", font_black(" is one of "), query, fixed = TRUE)
query <- gsub(" %like% ", font_black(" resembles "), query, fixed = TRUE)
if (colours == TRUE) {
query <- gsub('"R"', font_rsi_R_bg(font_black(" R ")), query, fixed = TRUE)
query <- gsub('"S"', font_rsi_S_bg(font_black(" S ")), query, fixed = TRUE)
query <- gsub('"I"', font_rsi_I_bg(font_black(" I ")), query, fixed = TRUE)
query <- gsub('"R"', font_red_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)

87
R/data.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -74,81 +78,67 @@
#' Data Set with `r format(nrow(microorganisms), big.mark = ",")` Microorganisms
#'
#' A data set containing the full microbial taxonomy (**last updated: `r CATALOGUE_OF_LIFE$yearmonth_LPSN`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms from the Catalogue of Life (CoL) and the List of Prokaryotic names with Standing in Nomenclature (LPSN). MO codes can be looked up using [as.mo()].
#' @inheritSection catalogue_of_life Catalogue of Life
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF). This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()].
#' @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
#' - `fullname`\cr Full name, like `"Escherichia coli"`
#' - `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.
#' - `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
#' - `rank`\cr Text of the taxonomic rank of the microorganism, like `"species"` or `"genus"`
#' - `ref`\cr Author(s) and year of concerning scientific publication
#' - `species_id`\cr ID of the species as used by the Catalogue of Life
#' - `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, e.g. "V`r "\u00e1\u0148ov\u00e1"`" becomes "Vanova".
#' - `lpsn`\cr Identifier ('Record number') of the List of Prokaryotic names with Standing in Nomenclature (LPSN). This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set.
#' - `lpsn_parent`\cr LPSN identifier of the parent taxon
#' - `lpsn_renamed_to`\cr LPSN identifier of the currently valid taxon
#' - `gbif`\cr Identifier ('taxonID') of the Global Biodiversity Information Facility (GBIF)
#' - `gbif_parent`\cr GBIF identifier of the parent taxon
#' - `gbif_renamed_to`\cr GBIF identifier of the currently valid taxon
#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
#' - `prevalence`\cr Prevalence of the microorganism, see [as.mo()]
#' - `snomed`\cr Systematized Nomenclature of Medicine (SNOMED) code of the microorganism, according to the `r SNOMED_VERSION$current_source` (see *Source*). Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
#' - `snomed`\cr Systematized Nomenclature of Medicine (SNOMED) code of the microorganism, version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)` (see *Source*). Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
#' @details
#' Please note that entries are only based on the Catalogue of Life and the LPSN (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
#' Please note that entries are only based on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF) (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
#'
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the `AMR` package returns 2007 for `mo_year("S. pettenkoferi")`.
#'
#' @section Included Taxa:
#' Included taxonomic data are:
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the kingdoms of Archaea and Bacteria
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi"), , drop = FALSE])` (sub)species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "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:
#'
#' - 11 entries of *Streptococcus* (beta-haemolytic: groups A, B, C, D, F, G, H, K and unspecified; other: viridans, milleri)
#' - 2 entries of *Staphylococcus* (coagulase-negative (CoNS) and coagulase-positive (CoPS))
#' - 3 entries of *Trichomonas* (*T. vaginalis*, and its family and genus)
#' - 4 entries of *Toxoplasma* (*T. gondii*, and its order, family and genus)
#' - 1 entry of *Candida* (*C. krusei*), that is not (yet) in the Catalogue of Life
#' - 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
#' - 5 other 'undefined' entries (unknown, unknown Gram negatives, unknown Gram positives, unknown yeast and unknown fungus)
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not (yet) in the Catalogue of Life
#'
#' The syntax used to transform the original data to a cleansed \R format, can be found here: <https://github.com/msberends/AMR/blob/main/data-raw/reproduction_of_microorganisms.R>.
#'
#' ## Direct download
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @section About the Records from LPSN (see *Source*):
#' LPSN is the main source for bacteriological taxonomy of this `AMR` package.
#'
#' The List of Prokaryotic names with Standing in Nomenclature (LPSN) provides comprehensive information on the nomenclature of prokaryotes. LPSN is a free to use service founded by Jean P. Euzeby in 1997 and later on maintained by Aidan C. Parte.
#'
#' As of February 2020, the regularly augmented LPSN database at DSMZ is the basis of the new LPSN service. The new database was implemented for the Type-Strain Genome Server and augmented in 2018 to store all kinds of nomenclatural information. Data from the previous version of LPSN and from the Prokaryotic Nomenclature Up-to-date (PNU) service were imported into the new system. PNU had been established in 1993 as a service of the Leibniz Institute DSMZ, and was curated by Norbert Weiss, Manfred Kracht and Dorothea Gleim.
#' @source
#' `r gsub("{year}", CATALOGUE_OF_LIFE$year, CATALOGUE_OF_LIFE$version, fixed = TRUE)` as currently implemented in this `AMR` package:
#' * `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
#'
#' * Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org>
#' * `r TAXONOMY_VERSION$GBIF$citation` Accessed from <`r TAXONOMY_VERSION$GBIF$url`> on `r documentation_date(TAXONOMY_VERSION$GBIF$accessed_date)`.
#'
#' List of Prokaryotic names with Standing in Nomenclature (`r CATALOGUE_OF_LIFE$yearmonth_LPSN`) as currently implemented in this `AMR` package:
#'
#' * Parte, A.C., Sarda Carbasse, J., Meier-Kolthoff, J.P., Reimer, L.C. and Goker, M. (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}
#' * Parte, A.C. (2018). LPSN - List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#' * Parte, A.C. (2014). LPSN - List of Prokaryotic names with Standing in Nomenclature. Nucleic Acids Research, 42, Issue D1, D613-D616; \doi{10.1093/nar/gkt1111}
#' * Euzeby, J.P. (1997). List of Bacterial Names with Standing in Nomenclature: a Folder Available on the Internet. International Journal of Systematic Bacteriology, 47, 590-592; \doi{10.1099/00207713-47-2-590}
#'
#' `r SNOMED_VERSION$current_source` as currently implemented in this `AMR` package:
#'
#' * Retrieved from the `r SNOMED_VERSION$title`, OID `r SNOMED_VERSION$current_oid`, version `r SNOMED_VERSION$current_version`; url: <`r SNOMED_VERSION$url`>
#' * `r TAXONOMY_VERSION$SNOMED$citation` URL: <`r TAXONOMY_VERSION$SNOMED$url`>
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
#' @examples
#' microorganisms
"microorganisms"
#' Data Set with Previously Accepted Taxonomic Names
#'
#' A data set containing old (previously valid or accepted) taxonomic names according to the Catalogue of Life. This data set is used internally by [as.mo()].
#' @inheritSection catalogue_of_life Catalogue of Life
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms.old), big.mark = ",")` observations and `r ncol(microorganisms.old)` variables:
#' - `fullname`\cr Old full taxonomic name of the microorganism
#' - `fullname_new`\cr New full taxonomic name of the microorganism
#' - `ref`\cr Author(s) and year of concerning scientific publication
#' - `prevalence`\cr Prevalence of the microorganism, see [as.mo()]
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @source Catalogue of Life: Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org> (check included annual version with [catalogue_of_life_version()]).
#'
#' Parte, A.C. (2018). LPSN - List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#' @seealso [as.mo()] [mo_property()] [microorganisms]
#' @examples
#' microorganisms.old
"microorganisms.old"
#' 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. Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
@ -157,7 +147,6 @@
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
#' @details
#' Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
#' @inheritSection catalogue_of_life Catalogue of Life
#' @seealso [as.mo()] [microorganisms]
#' @examples
#' microorganisms.codes

10
R/deprecated.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

16
R/disk.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -72,14 +76,14 @@ as.disk <- function(x, na.rm = FALSE) {
if (na.rm == TRUE) {
x <- x[!is.na(x)]
}
x[trimws(x) == ""] <- NA
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)
x <- gsub(",", ".", x, fixed = TRUE)
# remove ending dot/comma
x <- gsub("[,.]$", "", x)
# only keep last dot/comma
@ -131,7 +135,7 @@ all_valid_disks <- function(x) {
x_disk <- tryCatch(suppressWarnings(as.disk(x[!is.na(x)])),
error = function(e) NA
)
!any(is.na(x_disk)) && !all(is.na(x))
!anyNA(x_disk) && !all(is.na(x))
}
#' @rdname as.disk

10
R/episode.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

53
R/eucast_rules.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -46,14 +50,13 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
))
}
}
vector_and(txt, quotes = FALSE)
}
#' Apply EUCAST Rules
#'
#' @description
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
#' Apply rules for clinical breakpoints and intrinsic resistance as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, <https://www.eucast.org>), see *Source*. Use [eucast_dosage()] to get a [data.frame] with advised dosages of a certain bug-drug combination, which is based on the [dosage] data set.
#'
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
#' @param x a data set with antibiotic columns, such as `amox`, `AMX` and `AMC`
@ -73,21 +76,20 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' **Note:** This function does not translate MIC values to RSI values. Use [as.rsi()] for that. \cr
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
#'
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The file used as input for this `AMR` package contains the taxonomy updated until [`r CATALOGUE_OF_LIFE$yearmonth_LPSN`][catalogue_of_life()].
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The `AMR` package contains the full microbial taxonomy updated until `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`, see [microorganisms].
#'
#' ## Custom Rules
#' ### Custom Rules
#'
#' Custom rules can be created using [custom_eucast_rules()], e.g.:
#'
#' ```{r}
#' ```r
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
#'
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x, info = FALSE)
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x)
#' ```
#'
#'
#' ## 'Other' Rules
#' ### 'Other' Rules
#'
#' Before further processing, two non-EUCAST rules about drug combinations can be applied to improve the efficacy of the EUCAST rules, and the reliability of your data (analysis). These rules are:
#'
@ -118,7 +120,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 12.0, 2022. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_12.0_Breakpoint_Tables.xlsx)
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
#' \donttest{
#' a <- data.frame(
@ -199,8 +200,6 @@ eucast_rules <- function(x,
x_deparsed <- "your_data"
}
check_dataset_integrity()
breakpoints_info <- EUCAST_VERSION_BREAKPOINTS[[which(as.double(names(EUCAST_VERSION_BREAKPOINTS)) == version_breakpoints)]]
expertrules_info <- EUCAST_VERSION_EXPERT_RULES[[which(as.double(names(EUCAST_VERSION_EXPERT_RULES)) == version_expertrules)]]
@ -333,8 +332,8 @@ eucast_rules <- function(x,
x <- x %pm>%
strsplit(",") %pm>%
unlist() %pm>%
trimws() %pm>%
vapply(FUN.VALUE = character(1), function(x) if (x %in% antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE, fast_mode = TRUE) else x) %pm>%
trimws2() %pm>%
vapply(FUN.VALUE = character(1), function(x) if (x %in% AMR::antibiotics$ab) ab_name(x, language = NULL, tolower = TRUE, fast_mode = TRUE) else x) %pm>%
sort() %pm>%
paste(collapse = ", ")
x <- gsub("_", " ", x, fixed = TRUE)
@ -344,8 +343,8 @@ eucast_rules <- function(x,
x
}
format_antibiotic_names <- function(ab_names, ab_results) {
ab_names <- trimws(unlist(strsplit(ab_names, ",")))
ab_results <- trimws(unlist(strsplit(ab_results, ",")))
ab_names <- trimws2(unlist(strsplit(ab_names, ",")))
ab_results <- trimws2(unlist(strsplit(ab_results, ",")))
if (length(ab_results) == 1) {
if (length(ab_names) == 1) {
# like FOX S
@ -423,13 +422,13 @@ eucast_rules <- function(x,
# big speed gain! only analyse unique rows:
pm_distinct(`.rowid`, .keep_all = TRUE) %pm>%
as.data.frame(stringsAsFactors = FALSE)
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]), info = info)
# rename col_mo to prevent interference with joined columns
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
col_mo <- ".col_mo"
# join to microorganisms data set
x <- left_join_microorganisms(x, by = col_mo, suffix = c("_oldcols", ""))
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL, info = FALSE)
x$genus_species <- trimws(paste(x$genus, x$species))
if (info == TRUE & NROW(x) > 10000) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
@ -437,11 +436,11 @@ eucast_rules <- function(x,
if (any(x$genus == "Staphylococcus", na.rm = TRUE)) {
all_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), , drop = FALSE]
all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL))
all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL, info = FALSE))
}
if (any(x$genus == "Streptococcus", na.rm = TRUE)) {
all_strep <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), , drop = FALSE]
all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL))
all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL, info = FALSE))
}
n_added <- 0
@ -461,10 +460,10 @@ eucast_rules <- function(x,
))
))
}
ab_enzyme <- subset(antibiotics, name %like% "/")[, c("ab", "name"), drop = FALSE]
ab_enzyme <- subset(AMR::antibiotics, name %like% "/")[, c("ab", "name"), drop = FALSE]
colnames(ab_enzyme) <- c("enzyme_ab", "enzyme_name")
ab_enzyme$base_name <- gsub("^([a-zA-Z0-9]+).*", "\\1", ab_enzyme$enzyme_name)
ab_enzyme$base_ab <- antibiotics[match(ab_enzyme$base_name, antibiotics$name), "ab", drop = TRUE]
ab_enzyme$base_ab <- AMR::antibiotics[match(ab_enzyme$base_name, AMR::antibiotics$name), "ab", drop = TRUE]
ab_enzyme <- subset(ab_enzyme, !is.na(base_ab))
# make ampicillin and amoxicillin interchangable
ampi <- subset(ab_enzyme, base_ab == "AMX")
@ -1073,11 +1072,11 @@ edit_rsi <- function(x,
)
txt_error <- function() {
if (info == TRUE) cat("", font_red_bg(font_white(" ERROR ")), "\n\n")
if (info == TRUE) cat("", font_red_bg(" ERROR "), "\n\n")
}
txt_warning <- function() {
if (warned == FALSE) {
if (info == TRUE) cat(" ", font_rsi_I_bg(" WARNING "), sep = "")
if (info == TRUE) cat(" ", font_orange_bg(" WARNING "), sep = "")
}
warned <<- TRUE
}
@ -1179,7 +1178,7 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 11.0)
meet_criteria(administration, allow_class = "character", is_in = dosage$administration[!is.na(dosage$administration)], has_length = 1)
meet_criteria(version_breakpoints, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_BREAKPOINTS)))
# show used version_breakpoints number once per session (pkg_env will reload every session)
# show used version_breakpoints number once per session (AMR_env will reload every session)
if (message_not_thrown_before("eucast_dosage", "v", gsub("[^0-9]", "", version_breakpoints), entire_session = TRUE)) {
message_(
"Dosages for antimicrobial drugs, as meant for ",

50
R/first_isolate.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -174,18 +178,6 @@ first_isolate <- function(x = NULL,
include_unknown = FALSE,
include_untested_rsi = TRUE,
...) {
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
dots.names <- names(dots)
if ("filter_specimen" %in% dots.names) {
specimen_group <- dots[which(dots.names == "filter_specimen")]
}
if ("col_keyantibiotics" %in% dots.names) {
col_keyantimicrobials <- dots[which(dots.names == "col_keyantibiotics")]
}
}
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
# is also fix for using a grouped df as input (a dot as first argument)
@ -248,10 +240,10 @@ first_isolate <- function(x = NULL,
FUN = function(x) any(as.character(x[1:10000]) %in% c("R", "S", "I"), na.rm = TRUE),
USE.NAMES = FALSE
))
if (method == "phenotype-based" & !any_col_contains_rsi) {
if (method == "phenotype-based" && !any_col_contains_rsi) {
method <- "episode-based"
}
if (info == TRUE & message_not_thrown_before("first_isolate", "method")) {
if (info == TRUE && message_not_thrown_before("first_isolate", "method")) {
message_(paste0(
"Determining first isolates ",
ifelse(method %in% c("episode-based", "phenotype-based"),
@ -288,14 +280,14 @@ first_isolate <- function(x = NULL,
} else if (method == "episode-based") {
col_keyantimicrobials <- NULL
} else if (method == "phenotype-based") {
if (missing(type) & !is.null(col_keyantimicrobials)) {
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_rsi_columns = FALSE)
col_keyantimicrobials <- "keyantimicrobials"
} else if (type == "keyantimicrobials" & is.null(col_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
@ -325,7 +317,7 @@ first_isolate <- function(x = NULL,
}
# -- specimen
if (is.null(col_specimen) & !is.null(specimen_group)) {
if (is.null(col_specimen) && !is.null(specimen_group)) {
col_specimen <- search_type_in_df(x = x, type = "specimen", info = info)
}
@ -361,7 +353,7 @@ first_isolate <- function(x = NULL,
testcodes_exclude <- NULL
}
# remove testcodes
if (!is.null(testcodes_exclude) & info == TRUE & message_not_thrown_before("first_isolate", "excludingtestcodes")) {
if (!is.null(testcodes_exclude) && info == TRUE && message_not_thrown_before("first_isolate", "excludingtestcodes")) {
message_("Excluding test codes: ", vector_and(testcodes_exclude, quotes = TRUE),
add_fn = font_black,
as_note = FALSE
@ -375,7 +367,7 @@ first_isolate <- function(x = NULL,
# filter on specimen group and keyantibiotics when they are filled in
if (!is.null(specimen_group)) {
check_columns_existance(col_specimen, x)
if (info == TRUE & message_not_thrown_before("first_isolate", "excludingspecimen")) {
if (info == TRUE && message_not_thrown_before("first_isolate", "excludingspecimen")) {
message_("Excluding other than specimen group '", specimen_group, "'",
add_fn = font_black,
as_note = FALSE
@ -418,7 +410,7 @@ first_isolate <- function(x = NULL,
}
# speed up - return immediately if obvious
if (abs(row.start) == Inf | abs(row.end) == Inf) {
if (abs(row.start) == Inf || abs(row.end) == Inf) {
if (info == TRUE) {
message_("=> Found ", font_bold("no isolates"),
add_fn = font_black,
@ -455,7 +447,7 @@ first_isolate <- function(x = NULL,
# Analysis of first isolate ----
if (!is.null(col_keyantimicrobials)) {
if (info == TRUE & message_not_thrown_before("first_isolate", "type")) {
if (info == TRUE && message_not_thrown_before("first_isolate", "type")) {
if (type == "keyantimicrobials") {
message_("Basing inclusion on key antimicrobials, ",
ifelse(ignore_I == FALSE, "not ", ""),
@ -474,11 +466,7 @@ first_isolate <- function(x = NULL,
}
}
x$other_pat_or_mo <- ifelse(x$newvar_patient_id == pm_lag(x$newvar_patient_id) &
x$newvar_genus_species == pm_lag(x$newvar_genus_species),
FALSE,
TRUE
)
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$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
x$more_than_episode_ago <- unlist(lapply(split(
@ -570,7 +558,7 @@ first_isolate <- function(x = NULL,
}
# handle empty microorganisms
if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) & info == TRUE) {
if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) && info == TRUE) {
message_(
ifelse(include_unknown == TRUE, "Included ", "Excluded "),
format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE),
@ -582,7 +570,7 @@ first_isolate <- function(x = NULL,
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
# exclude all NAs
if (any(is.na(x$newvar_mo)) & info == TRUE) {
if (anyNA(x$newvar_mo) && info == TRUE) {
message_(
"Excluded ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
decimal.mark = decimal.mark, big.mark = big.mark

12
R/g.test.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -149,7 +153,7 @@ g.test <- function(x,
paste(DNAME2, collapse = "\n")
)
}
if (any(x < 0) || any(is.na((x)))) { # this last one was anyNA, but only introduced in R 3.1.0
if (any(x < 0) || anyNA(x)) {
stop("all entries of 'x' must be nonnegative and finite")
}
if ((n <- sum(x)) == 0) {

14
R/ggplot_pca.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -232,7 +236,7 @@ ggplot_pca <- function(x,
}
# Overlay a concentration ellipse if there are groups
if (!is.null(df.u$groups) & !is.null(ell) & isTRUE(ellipse)) {
if (!is.null(df.u$groups) && !is.null(ell) && isTRUE(ellipse)) {
g <- g + ggplot2::geom_path(
data = ell,
ggplot2::aes(colour = groups, group = groups),
@ -319,7 +323,7 @@ pca_calculations <- function(pca_model,
error = function(e) NULL
)
}
if (!is.null(groups) & is.null(labels)) {
if (!is.null(groups) && is.null(labels)) {
# turn them around
labels <- groups
groups <- NULL

18
R/ggplot_rsi.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -211,7 +215,7 @@ ggplot_rsi <- function(data,
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = 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)
@ -311,12 +315,12 @@ geom_rsi <- function(position = NULL,
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_finite = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
y <- "value"
if (missing(position) | is.null(position)) {
if (missing(position) || is.null(position)) {
position <- "fill"
}
@ -500,7 +504,7 @@ labels_rsi_count <- function(position = NULL,
meet_criteria(x, allow_class = "character", has_length = 1)
meet_criteria(translate_ab, allow_class = c("character", "logical"), has_length = 1, allow_NA = TRUE)
meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
meet_criteria(combine_IR, allow_class = "logical", has_length = 1)
meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)

46
R/guess_ab_col.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -59,7 +63,7 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE, only_r
meet_criteria(verbose, allow_class = "logical", has_length = 1)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
if (is.null(x) & is.null(search_string)) {
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)
@ -108,17 +112,17 @@ get_column_abx <- function(x,
entire_session = FALSE,
match_fn = fn
),
pkg_env$get_column_abx.call
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 <- pkg_env$get_column_abx.out
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% pkg_env$get_column_abx.checked_cols]
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_rsi <- get_column_abx(x[, new_cols, drop = FALSE], reuse_previous_result = FALSE, info = FALSE, sort = FALSE)
@ -128,11 +132,11 @@ get_column_abx <- function(x,
}
# update pkg environment to improve speed on next run
pkg_env$get_column_abx.out <- current
pkg_env$get_column_abx.checked_cols <- colnames(x)
AMR_env$get_column_abx.out <- current
AMR_env$get_column_abx.checked_cols <- colnames(x)
# and return right values
return(pkg_env$get_column_abx.out)
return(AMR_env$get_column_abx.out)
}
meet_criteria(x, allow_class = "data.frame")
@ -205,7 +209,7 @@ get_column_abx <- function(x,
dots <- dots[!vapply(FUN.VALUE = logical(1), dots, is.data.frame)]
if (length(dots) > 0) {
newnames <- suppressWarnings(as.ab(names(dots), info = FALSE))
if (any(is.na(newnames))) {
if (anyNA(newnames)) {
if (info == TRUE) {
message_(" WARNING", add_fn = list(font_yellow, font_bold), as_note = FALSE)
}
@ -236,12 +240,12 @@ get_column_abx <- function(x,
}
if (length(out) == 0) {
if (info == TRUE & all_okay == TRUE) {
if (info == TRUE && all_okay == TRUE) {
message_("No columns found.")
}
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
pkg_env$get_column_abx.checked_cols <- colnames(x.bak)
pkg_env$get_column_abx.out <- out
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)
}
@ -262,7 +266,7 @@ get_column_abx <- function(x,
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
}
for (i in seq_len(length(out))) {
if (verbose == TRUE & !names(out[i]) %in% names(duplicates)) {
if (verbose == TRUE && !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), ")."
@ -300,7 +304,7 @@ get_column_abx <- function(x,
}
if (!is.null(soft_dependencies)) {
soft_dependencies <- unique(soft_dependencies)
if (info == TRUE & !all(soft_dependencies %in% names(out))) {
if (info == TRUE && !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(
@ -316,16 +320,16 @@ get_column_abx <- function(x,
}
}
pkg_env$get_column_abx.call <- unique_call_id(entire_session = FALSE, match_fn = fn)
pkg_env$get_column_abx.checked_cols <- colnames(x.bak)
pkg_env$get_column_abx.out <- out
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 <- trimws(unique(toupper(unlist(strsplit(x, ",")))))
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"))) {

12
R/italicise_taxonomy.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -62,7 +66,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
FUN.VALUE = character(1),
string,
function(s) {
s_split <- unlist(strsplit(s, " "))
s_split <- unlist(strsplit(s, " ", fixed = TRUE))
search_strings <- gsub("[^a-zA-Z-]", "", s_split)

12
R/join_microorganisms.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -123,8 +127,6 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
}
join_microorganisms <- function(type, x, by, suffix, ...) {
check_dataset_integrity()
if (!is.data.frame(x)) {
if (pkg_is_available("tibble", also_load = FALSE)) {
x <- import_fn("tibble", "tibble")(mo = x)

21
R/key_antimicrobials.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -175,8 +179,8 @@ key_antimicrobials <- function(x = NULL,
values <- cols[names(cols) %in% values]
values_new_length <- length(values)
if (values_new_length < values_old_length &
any(filter, na.rm = TRUE) &
if (values_new_length < values_old_length &&
any(filter, na.rm = TRUE) &&
message_not_thrown_before("key_antimicrobials", name)) {
warning_(
"in `key_antimicrobials()`: ",
@ -305,7 +309,7 @@ antimicrobials_equal <- function(y,
stop_ifnot(length(y) == length(z), "length of `y` and `z` must be equal")
key2rsi <- function(val) {
val <- strsplit(val, "")[[1L]]
val <- strsplit(val, "", fixed = TRUE)[[1L]]
val.int <- rep(NA_real_, length(val))
val.int[val == "S"] <- 1
val.int[val == "I"] <- 2
@ -347,8 +351,8 @@ antimicrobials_equal <- function(y,
all(a == b, na.rm = TRUE)
}
}
out <- unlist(mapply(
FUN = determine_equality,
out <- unlist(Map(
f = determine_equality,
y,
z,
MoreArgs = list(
@ -356,7 +360,6 @@ antimicrobials_equal <- function(y,
points_threshold = points_threshold,
ignore_I = ignore_I
),
SIMPLIFY = FALSE,
USE.NAMES = FALSE
))
out[is.na(y) | is.na(z)] <- NA

10
R/kurtosis.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

15
R/like.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -102,14 +106,13 @@ like <- function(x, pattern, ignore.case = TRUE) {
)
}
unlist(
mapply(
FUN = grepl,
Map(
f = grepl,
x = x,
pattern = pattern,
fixed = fixed,
perl = !fixed,
MoreArgs = list(ignore.case = FALSE),
SIMPLIFY = FALSE,
USE.NAMES = FALSE
)
)

97
R/mdro.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -175,7 +179,7 @@ mdro <- function(x = NULL,
...) {
if (is_null_or_grouped_tbl(x)) {
# when `x` is left blank, auto determine it (get_current_data() also contains dplyr::cur_data_all())
# is also fix for using a grouped df as input (a dot as first argument)
# is also a fix for using a grouped df as input (i.e., a dot as first argument)
x <- tryCatch(get_current_data(arg_name = "x", call = -2), error = function(e) x)
}
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
@ -190,15 +194,13 @@ mdro <- function(x = NULL,
meet_criteria(verbose, allow_class = "logical", has_length = 1)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
check_dataset_integrity()
info.bak <- info
# don't thrown info's more than once per call
if (isTRUE(info)) {
info <- message_not_thrown_before("mdro")
}
if (interactive() & verbose == TRUE & info == TRUE) {
if (interactive() && isTRUE(verbose) && isTRUE(info)) {
txt <- paste0(
"WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.",
"\n\nThis may overwrite your existing data if you use e.g.:",
@ -217,7 +219,7 @@ mdro <- function(x = NULL,
}
group_msg <- ""
if (info.bak == TRUE) {
if (isTRUE(info.bak)) {
# 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)) {
@ -255,7 +257,7 @@ mdro <- function(x = NULL,
if (is.list(guideline)) {
# Custom MDRO guideline ---------------------------------------------------
stop_ifnot(inherits(guideline, "custom_mdro_guideline"), "use `custom_mdro_guideline()` to create custom guidelines")
if (info == TRUE) {
if (isTRUE(info)) {
txt <- paste0(
"Determining MDROs based on custom rules",
ifelse(isTRUE(attributes(guideline)$as_factor),
@ -268,7 +270,7 @@ mdro <- function(x = NULL,
cat(txt, "\n", sep = "")
}
x <- run_custom_mdro_guideline(df = x, guideline = guideline, info = info)
if (info.bak == TRUE) {
if (isTRUE(info.bak)) {
cat(group_msg)
if (sum(!is.na(x$MDRO)) == 0) {
cat(word_wrap(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the custom guideline"))))
@ -282,7 +284,7 @@ mdro <- function(x = NULL,
))))
}
}
if (verbose == TRUE) {
if (isTRUE(verbose)) {
return(x[, c(
"row_number",
"MDRO",
@ -319,7 +321,7 @@ mdro <- function(x = NULL,
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
}
if (is.null(col_mo) & guideline$code == "tb") {
if (is.null(col_mo) && guideline$code == "tb") {
message_(
"No column found as input for `col_mo`, ",
font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), "."))
@ -614,9 +616,9 @@ mdro <- function(x = NULL,
...
)
}
if (!"AMP" %in% names(cols_ab) & "AMX" %in% names(cols_ab)) {
if (!"AMP" %in% names(cols_ab) && "AMX" %in% names(cols_ab)) {
# ampicillin column is missing, but amoxicillin is available
if (info == TRUE) {
if (isTRUE(info)) {
message_("Using column '", cols_ab[names(cols_ab) == "AMX"], "' as input for ampicillin since many EUCAST rules depend on it.")
}
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
@ -767,14 +769,14 @@ mdro <- function(x = NULL,
stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set")
# nolint end
if (combine_SI == TRUE) {
if (isTRUE(combine_SI)) {
search_result <- "R"
} else {
search_result <- c("R", "I")
}
if (info == TRUE) {
if (combine_SI == TRUE) {
if (isTRUE(info)) {
if (isTRUE(combine_SI)) {
cat(font_red("\nOnly results with 'R' are considered as resistance. Use `combine_SI = FALSE` to also consider 'I' as resistance.\n"))
} else {
cat(font_red("\nResults with 'R' or 'I' are considered as resistance. Use `combine_SI = TRUE` to only consider 'R' as resistance.\n"))
@ -819,7 +821,7 @@ mdro <- function(x = NULL,
trans_tbl <- function(to, rows, cols, any_all) {
cols <- cols[!ab_missing(cols)]
cols <- cols[!is.na(cols)]
if (length(rows) > 0 & length(cols) > 0) {
if (length(rows) > 0 && length(cols) > 0) {
x[, cols] <- as.data.frame(lapply(
x[, cols, drop = FALSE],
function(col) as.rsi(col)
@ -836,7 +838,7 @@ mdro <- function(x = NULL,
function(y) y %in% search_result
)
paste(sort(c(
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ")),
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
names(cols_nonsus)[cols_nonsus]
)),
collapse = ", "
@ -871,7 +873,7 @@ mdro <- function(x = NULL,
}
trans_tbl2 <- function(txt, rows, lst) {
if (info == TRUE) {
if (isTRUE(info)) {
message_(txt, "...", appendLF = FALSE, as_note = FALSE)
}
if (length(rows) > 0) {
@ -896,7 +898,7 @@ mdro <- function(x = NULL,
}
)
if (verbose == TRUE) {
if (isTRUE(verbose)) {
x[rows, "columns_nonsusceptible"] <<- vapply(
FUN.VALUE = character(1),
rows,
@ -929,7 +931,7 @@ mdro <- function(x = NULL,
x[which(row_filter), "classes_affected"] <<- 999
}
if (info == TRUE) {
if (isTRUE(info)) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
}
@ -951,21 +953,21 @@ mdro <- function(x = NULL,
# (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
# take amoxicillin if ampicillin is unavailable
if (is.na(AMP) & !is.na(AMX)) {
if (verbose == TRUE) {
if (is.na(AMP) && !is.na(AMX)) {
if (isTRUE(verbose)) {
message_("Filling ampicillin (AMP) results with amoxicillin (AMX) results")
}
AMP <- AMX
}
# take ceftriaxone if cefotaxime is unavailable and vice versa
if (is.na(CRO) & !is.na(CTX)) {
if (verbose == TRUE) {
if (is.na(CRO) && !is.na(CTX)) {
if (isTRUE(verbose)) {
message_("Filling ceftriaxone (CRO) results with cefotaxime (CTX) results")
}
CRO <- CTX
}
if (is.na(CTX) & !is.na(CRO)) {
if (verbose == TRUE) {
if (is.na(CTX) && !is.na(CRO)) {
if (isTRUE(verbose)) {
message_("Filling cefotaxime (CTX) results with ceftriaxone (CRO) results")
}
CTX <- CRO
@ -1156,7 +1158,7 @@ mdro <- function(x = NULL,
# now set MDROs:
# MDR (=2): >=3 classes affected
x[which(x$classes_affected >= 3), "MDRO"] <- 2
if (verbose == TRUE) {
if (isTRUE(verbose)) {
x[which(x$classes_affected >= 3), "reason"] <- paste0(
"at least 3 classes contain R",
ifelse(!isTRUE(combine_SI), " or I", ""), ": ",
@ -1167,7 +1169,7 @@ mdro <- function(x = NULL,
# XDR (=3): all but <=2 classes affected
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
if (verbose == TRUE) {
if (isTRUE(verbose)) {
x[which(x$MDRO == 3), "reason"] <- paste0(
"less than 3 classes remain susceptible (", x$classes_in_guideline[which((x$classes_in_guideline - x$classes_affected) <= 2)] - x$classes_affected[which(x$MDRO == 3)],
" out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)"
@ -1176,7 +1178,7 @@ mdro <- function(x = NULL,
# PDR (=4): all agents are R
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
if (verbose == TRUE) {
if (isTRUE(verbose)) {
x[which(x$MDRO == 4), "reason"] <- paste(
"all antibiotics in all",
x$classes_in_guideline[which(x$MDRO == 4)],
@ -1187,7 +1189,7 @@ mdro <- function(x = NULL,
# not enough classes available
x[which(x$MDRO %in% c(1, 3) & x$classes_available < floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
if (verbose == TRUE) {
if (isTRUE(verbose)) {
x[which(x$MDRO == -1), "reason"] <- paste0(
"not enough classes available: ", x$classes_available[which(x$MDRO == -1)],
" of required ", (floor(x$classes_in_guideline * pct_required_classes))[which(x$MDRO == -1)],
@ -1615,10 +1617,10 @@ mdro <- function(x = NULL,
"all"
)
if (!ab_missing(MEM) & !ab_missing(IPM) &
!ab_missing(GEN) & !ab_missing(TOB) &
!ab_missing(CIP) &
!ab_missing(CAZ) &
if (!ab_missing(MEM) && !ab_missing(IPM) &&
!ab_missing(GEN) && !ab_missing(TOB) &&
!ab_missing(CIP) &&
!ab_missing(CAZ) &&
!ab_missing(TZP)) {
x$psae <- 0
x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"]
@ -1666,7 +1668,7 @@ mdro <- function(x = NULL,
prepare_drug <- function(ab) {
# returns vector values of drug
# if `ab` is a column name, looks up the values in `x`
if (length(ab) == 1 & is.character(ab)) {
if (length(ab) == 1 && is.character(ab)) {
if (ab %in% colnames(x)) {
ab <- x[, ab, drop = TRUE]
}
@ -1727,7 +1729,7 @@ mdro <- function(x = NULL,
}
# some more info on negative results
if (verbose == TRUE) {
if (isTRUE(verbose)) {
if (guideline$code == "cmi2012") {
x[which(x$MDRO == 1 & !is.na(x$classes_affected)), "reason"] <- paste0(
x$classes_affected[which(x$MDRO == 1 & !is.na(x$classes_affected))],
@ -1742,14 +1744,14 @@ mdro <- function(x = NULL,
}
}
if (info.bak == TRUE) {
if (isTRUE(info.bak)) {
cat(group_msg)
if (sum(!is.na(x$MDRO)) == 0) {
cat(font_bold(paste0("=> Found 0 MDROs since no isolates are covered by the guideline")))
} else {
cat(font_bold(paste0(
"=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " ", guideline$type, " out of ", sum(!is.na(x$MDRO)),
" isolates (", trimws(percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO)))), ")"
"=> Found ", sum(x$MDRO %in% 2:5, na.rm = TRUE), " ", guideline$type, " out of ", sum(!is.na(x$MDRO)),
" isolates (", trimws(percentage(sum(x$MDRO %in% 2:5, na.rm = TRUE) / sum(!is.na(x$MDRO)))), ")"
)))
}
}
@ -1819,7 +1821,7 @@ mdro <- function(x = NULL,
)
}
if (verbose == TRUE) {
if (isTRUE(verbose)) {
colnames(x)[colnames(x) == col_mo] <- "microorganism"
x$microorganism <- mo_name(x$microorganism, language = NULL)
x[, c(
@ -1953,14 +1955,14 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
for (i in seq_len(n_dots)) {
qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
error = function(e) {
pkg_env$err_msg <- e$message
AMR_env$err_msg <- e$message
return("error")
}
)
if (identical(qry, "error")) {
warning_("in `custom_mdro_guideline()`: rule ", i,
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
pkg_env$err_msg,
AMR_env$err_msg,
call = FALSE,
add_fn = font_red
)
@ -1974,7 +1976,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
new_mdros <- which(qry == TRUE & out == "")
if (info == TRUE) {
if (isTRUE(info)) {
cat(word_wrap(
"- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
"` (", length(new_mdros), " rows matched)"
@ -1982,7 +1984,10 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
}
val <- guideline[[i]]$value
out[new_mdros] <- val
reasons[new_mdros] <- paste0("matched rule ", gsub("rule", "", names(guideline)[i]), ": ", as.character(guideline[[i]]$query))
reasons[new_mdros] <- paste0(
"matched rule ",
gsub("rule", "", names(guideline)[i], fixed = TRUE), ": ", as.character(guideline[[i]]$query)
)
}
out[out == ""] <- "Negative"
reasons[out == "Negative"] <- "no rules matched"

10
R/mean_amr_distance.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

40
R/mic.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -24,23 +28,27 @@
# ==================================================================== #
# these are allowed MIC values and will become [factor] levels
ops <- c("<", "<=", "", ">=", ">")
operators <- c("<", "<=", "", ">=", ">")
valid_mic_levels <- c(
c(t(vapply(
FUN.VALUE = character(9), ops,
function(x) paste0(x, "0.00", 1:9)
FUN.VALUE = character(6), operators,
function(x) paste0(x, "0.000", c(1:4, 6, 8))
))),
c(t(vapply(
FUN.VALUE = character(90), operators,
function(x) paste0(x, "0.00", c(1:9, 11:19, 21:29, 31:39, 41:49, 51:59, 61:69, 71:79, 81:89, 91:99))
))),
unique(c(t(vapply(
FUN.VALUE = character(104), ops,
FUN.VALUE = character(106), operators,
function(x) {
paste0(x, sort(as.double(paste0(
"0.0",
sort(c(1:99, 125, 128, 256, 512, 625))
sort(c(1:99, 125, 128, 156, 165, 256, 512, 625))
))))
}
)))),
unique(c(t(vapply(
FUN.VALUE = character(103), ops,
FUN.VALUE = character(103), operators,
function(x) {
paste0(x, sort(as.double(paste0(
"0.",
@ -49,15 +57,15 @@ valid_mic_levels <- c(
}
)))),
c(t(vapply(
FUN.VALUE = character(10), ops,
FUN.VALUE = character(10), operators,
function(x) paste0(x, sort(c(1:9, 1.5)))
))),
c(t(vapply(
FUN.VALUE = character(45), ops,
FUN.VALUE = character(45), operators,
function(x) paste0(x, c(10:98)[9:98 %% 2 == TRUE])
))),
c(t(vapply(
FUN.VALUE = character(17), ops,
FUN.VALUE = character(17), operators,
function(x) paste0(x, sort(c(2^c(7:11), 192, 80 * c(2:12))))
)))
)
@ -162,12 +170,16 @@ as.mic <- function(x, na.rm = FALSE) {
if (is.mic(x)) {
x
} else {
if (is.numeric(x)) {
x <- format(x, scientific = FALSE)
} else {
x <- as.character(unlist(x))
}
if (na.rm == TRUE) {
x <- x[!is.na(x)]
}
x[trimws(x) == ""] <- NA
x[trimws2(x) == ""] <- NA
x.bak <- x
# comma to period
@ -202,7 +214,7 @@ as.mic <- function(x, na.rm = FALSE) {
# never end with dot
x <- gsub("[.]$", "", x, perl = TRUE)
# trim it
x <- trimws(x)
x <- trimws2(x)
## previously unempty values now empty - should return a warning later on
x[x.bak != "" & x == ""] <- "invalid"

2366
R/mo.R
View File

File diff suppressed because it is too large Load Diff

55
R/mo_matching_score.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -29,6 +33,7 @@
#' @author Dr. Matthijs Berends
#' @param x Any user input value(s)
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
#' @note This algorithm was 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}.
#' @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:
#'
@ -39,17 +44,21 @@
#' * \ifelse{html}{\out{<i>x</i> is the user input;}}{\eqn{x} is the user input;}
#' * \ifelse{html}{\out{<i>n</i> is a taxonomic name (genus, species, and subspecies);}}{\eqn{n} is a taxonomic name (genus, species, and subspecies);}
#' * \ifelse{html}{\out{<i>l<sub>n</sub></i> is the length of <i>n</i>;}}{l_n is the length of \eqn{n};}
#' * \ifelse{html}{\out{<i>lev</i> is the <a href="https://en.wikipedia.org/wiki/Levenshtein_distance">Levenshtein distance function</a>, which counts any insertion, deletion and substitution as 1 that is needed to change <i>x</i> into <i>n</i>;}}{lev is the Levenshtein distance function, which counts any insertion, deletion and substitution as 1 that is needed to change \eqn{x} into \eqn{n};}
#' * \ifelse{html}{\out{<i>lev</i> is the <a href="https://en.wikipedia.org/wiki/Levenshtein_distance">Levenshtein distance function</a> (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change <i>x</i> into <i>n</i>;}}{lev is the Levenshtein distance function (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change \eqn{x} into \eqn{n};}
#' * \ifelse{html}{\out{<i>p<sub>n</sub></i> is the human pathogenic prevalence group of <i>n</i>, as described below;}}{p_n is the human pathogenic prevalence group of \eqn{n}, as described below;}
#' * \ifelse{html}{\out{<i>k<sub>n</sub></i> is the taxonomic kingdom of <i>n</i>, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.}}{l_n is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.}
#'
#' The grouping into human pathogenic prevalence (\eqn{p}) is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence. **Group 1** (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Pseudomonas* and *Legionella* and all species within the order Enterobacterales. **Group 2** consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is *Absidia*, *Acremonium*, *Actinotignum*, *Alternaria*, *Anaerosalibacter*, *Apophysomyces*, *Arachnia*, *Aspergillus*, *Aureobacterium*, *Aureobasidium*, *Bacteroides*, *Basidiobolus*, *Beauveria*, *Blastocystis*, *Branhamella*, *Calymmatobacterium*, *Candida*, *Capnocytophaga*, *Catabacter*, *Chaetomium*, *Chryseobacterium*, *Chryseomonas*, *Chrysonilia*, *Cladophialophora*, *Cladosporium*, *Conidiobolus*, *Cryptococcus*, *Curvularia*, *Exophiala*, *Exserohilum*, *Flavobacterium*, *Fonsecaea*, *Fusarium*, *Fusobacterium*, *Hendersonula*, *Hypomyces*, *Koserella*, *Lelliottia*, *Leptosphaeria*, *Leptotrichia*, *Malassezia*, *Malbranchea*, *Mortierella*, *Mucor*, *Mycocentrospora*, *Mycoplasma*, *Nectria*, *Ochroconis*, *Oidiodendron*, *Phoma*, *Piedraia*, *Pithomyces*, *Pityrosporum*, *Prevotella*, *Pseudallescheria*, *Rhizomucor*, *Rhizopus*, *Rhodotorula*, *Scolecobasidium*, *Scopulariopsis*, *Scytalidium*, *Sporobolomyces*, *Stachybotrys*, *Stomatococcus*, *Treponema*, *Trichoderma*, *Trichophyton*, *Trichosporon*, *Tritirachium* or *Ureaplasma*. **Group 3** consists of all other microorganisms.
#' The grouping into human pathogenic prevalence (\eqn{p}) is based on experience from several microbiological laboratories in the Netherlands in conjunction with international reports on pathogen prevalence:
#'
#' **Group 1** (most prevalent microorganisms) consists of all microorganisms where the taxonomic class is Gammaproteobacteria or where the taxonomic genus is *Enterococcus*, *Staphylococcus* or *Streptococcus*. This group consequently contains all common Gram-negative bacteria, such as *Pseudomonas* and *Legionella* and all species within the order Enterobacterales.
#'
#' **Group 2** consists of all microorganisms where the taxonomic phylum is Proteobacteria, Firmicutes, Actinobacteria or Sarcomastigophora, or where the taxonomic genus is `r vector_or(MO_PREVALENT_GENERA, quotes = "*")`.
#'
#' **Group 3** consists of all other microorganisms.
#'
#' 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.
#'
#' Since `AMR` version 1.8.1, common microorganism abbreviations are ignored in determining the matching score. These abbreviations are currently: `r vector_and(pkg_env$mo_field_abbreviations, quotes = FALSE)`.
#' @export
#' @inheritSection AMR Reference Data Publicly Available
#' @examples
@ -68,19 +77,12 @@ mo_matching_score <- function(x, n) {
# no dots and other non-whitespace characters
x <- gsub("[^a-zA-Z0-9 \\(\\)]+", "", x)
# remove abbreviations known to the field
x <- gsub(paste0(
"(^|[^a-z0-9]+)(",
paste0(pkg_env$mo_field_abbreviations, collapse = "|"),
")([^a-z0-9]+|$)"
),
"", x,
perl = TRUE, ignore.case = TRUE
)
# 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))
@ -93,12 +95,19 @@ mo_matching_score <- function(x, n) {
l_n <- nchar(n)
lev <- double(length = length(x))
l_n.lev <- double(length = length(x))
for (i in seq_len(length(x))) {
# determine Levenshtein distance, but maximise to nchar of n
lev[i] <- utils::adist(x[i], n[i], ignore.case = FALSE, fixed = TRUE, costs = c(ins = 1, del = 1, sub = 1))
# minimum of (l_n, Levenshtein distance)
l_n.lev[i] <- min(l_n[i], as.double(lev[i]))
}
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 <- MO_lookup[match(n, MO_lookup$fullname), "prevalence", drop = TRUE]
# kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)

441
R/mo_property.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -28,14 +32,14 @@
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
#' @param language language of the returned text, defaults to system language (see [get_AMR_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'
#' @inheritParams as.mo
#' @param ... other arguments passed on to [as.mo()], such as 'minimum_matching_score', 'ignore_pattern', and 'remove_from_input'
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param open browse the URL using [`browseURL()`][utils::browseURL()]
#' @details All functions will return the most recently known taxonomic property according to the Catalogue of Life, except for [mo_ref()], [mo_authors()] and [mo_year()]. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
#' @details All functions will, at default, keep old taxonomic properties. Please refer to this example, knowing that *Escherichia blattae* was renamed to *Shimwellia blattae* in 2010:
#' - `mo_name("Escherichia blattae")` will return `"Shimwellia blattae"` (with a message about the renaming)
#' - `mo_ref("Escherichia blattae")` will return `"Burgess et al., 1973"` (with a message about the renaming)
#' - `mo_ref("Shimwellia blattae")` will return `"Priest et al., 2010"` (without a message)
#' - `mo_ref("Escherichia blattae", keep_synonyms = TRUE)` will return `"Burgess et al., 1973"` (with a warning about the renaming)
#' - `mo_ref("Shimwellia blattae", keep_synonyms = FALSE)` will return `"Priest et al., 2010"` (without a message)
#'
#' The short name - [mo_shortname()] - almost always returns the first character of the genus and the full species, like `"E. coli"`. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. In other words, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
#'
@ -51,9 +55,8 @@
#'
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species.
#'
#' SNOMED codes - [mo_snomed()] - are from the `r SNOMED_VERSION$current_source`. See *Source* and the [microorganisms] data set for more info.
#' SNOMED codes - [mo_snomed()] - are from the version of `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
#' @inheritSection mo_matching_score Matching Score for Microorganisms
#' @inheritSection catalogue_of_life Catalogue of Life
#' @inheritSection as.mo Source
#' @rdname mo_property
#' @name mo_property
@ -169,15 +172,16 @@
#' # SNOMED codes, and URL to the online database
#' mo_info("Klebsiella pneumoniae")
#' }
mo_name <- function(x, language = get_AMR_locale(), ...) {
mo_name <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_name")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "fullname", language = language, ...),
translate_into_language(mo_validate(x = x, property = "fullname", language = language, keep_synonyms = keep_synonyms, ...),
language = language,
only_unknown = FALSE,
only_affect_mo_names = TRUE
@ -190,17 +194,18 @@ mo_fullname <- mo_name
#' @rdname mo_property
#' @export
mo_shortname <- function(x, language = get_AMR_locale(), ...) {
mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_shortname")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
replace_empty <- function(x) {
x[x == ""] <- "spp."
@ -208,8 +213,8 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
}
# get first char of genus and complete species in English
genera <- mo_genus(x.mo, language = NULL)
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL)))
genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms)
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms)))
# exceptions for where no species is known
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
@ -219,10 +224,10 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
# exceptions for streptococci: Group A Streptococcus -> GAS
shortnames[shortnames %like% "S. group [ABCDFGHK]"] <- paste0("G", gsub("S. group ([ABCDFGHK])", "\\1", shortnames[shortnames %like% "S. group [ABCDFGHK]"], perl = TRUE), "S")
# unknown species etc.
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
shortnames[is.na(x.mo)] <- NA_character_
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
translate_into_language(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE)
}
@ -230,106 +235,114 @@ mo_shortname <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_subspecies <- function(x, language = get_AMR_locale(), ...) {
mo_subspecies <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_subspecies")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "subspecies", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_species <- function(x, language = get_AMR_locale(), ...) {
mo_species <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_species")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "species", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "species", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_genus <- function(x, language = get_AMR_locale(), ...) {
mo_genus <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_genus")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "genus", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "genus", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_family <- function(x, language = get_AMR_locale(), ...) {
mo_family <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_family")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "family", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "family", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_order <- function(x, language = get_AMR_locale(), ...) {
mo_order <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_order")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "order", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "order", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_class <- function(x, language = get_AMR_locale(), ...) {
mo_class <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_class")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "class", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "class", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_phylum <- function(x, language = get_AMR_locale(), ...) {
mo_phylum <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_phylum")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "phylum", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "phylum", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_kingdom <- function(x, language = get_AMR_locale(), ...) {
mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_kingdom")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
@ -338,67 +351,85 @@ mo_domain <- mo_kingdom
#' @rdname mo_property
#' @export
mo_type <- function(x, language = get_AMR_locale(), ...) {
mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_type")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
out <- mo_kingdom(x.mo, language = NULL)
out[which(mo_is_yeast(x.mo))] <- "Yeasts"
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
out <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
translate_into_language(out, language = language, only_unknown = FALSE)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_AMR_locale(), ...) {
mo_status <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_status")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = "status", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
#' @rdname mo_property
#' @export
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_gramstain")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
x <- rep(NA_character_, length(x))
# make all bacteria Gram negative
x[mo_kingdom(x.mo) == "Bacteria"] <- "Gram-negative"
x[mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
# overwrite these 4 phyla with Gram-positives
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
x[(mo_phylum(x.mo) %in% c(
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
"Actinobacteria",
"Chloroflexi",
"Firmicutes",
"Tenericutes"
"Tenericutes",
"Bacillota" # this one is new! It was renamed from Firmicutes by Gibbons et al., 2021
) &
# but class Negativicutes (of phylum Firmicutes) are Gram-negative!
mo_class(x.mo) != "Negativicutes")
mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms) != "Negativicutes")
# and of course our own ID for Gram-positives
| x.mo == "B_GRAMP"] <- "Gram-positive"
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
translate_into_language(x, language = language, only_unknown = FALSE)
}
#' @rdname mo_property
#' @export
mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_negative")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
grams <- mo_gramstain(x.mo, language = NULL)
load_mo_failures_uncertainties_renamed(metadata)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_uncertainties(metadata)
out <- grams == "Gram-negative" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
@ -406,18 +437,19 @@ mo_is_gram_negative <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_gram_positive")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
grams <- mo_gramstain(x.mo, language = NULL)
load_mo_failures_uncertainties_renamed(metadata)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_uncertainties(metadata)
out <- grams == "Gram-positive" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
@ -425,21 +457,22 @@ mo_is_gram_positive <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_yeast")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
x.kingdom <- mo_kingdom(x.mo, language = NULL)
x.class <- mo_class(x.mo, language = NULL)
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out <- rep(FALSE, length(x))
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
@ -449,16 +482,17 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_is_intrinsic_resistant")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(ab, allow_NA = FALSE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
ab <- as.ab(ab, language = NULL, flag_multiple_results = FALSE, info = FALSE)
if (length(x) == 1 & length(ab) > 1) {
@ -470,7 +504,7 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
}
# show used version number once per session (pkg_env will reload every session)
# show used version number once per session (AMR_env will reload every session)
if (message_not_thrown_before("mo_is_intrinsic_resistant", "version.mo", entire_session = TRUE)) {
message_(
"Determining intrinsic resistance based on ",
@ -485,41 +519,44 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_snomed <- function(x, language = get_AMR_locale(), ...) {
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_snomed")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "snomed", language = language, ...)
mo_validate(x = x, property = "snomed", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_ref <- function(x, language = get_AMR_locale(), ...) {
mo_ref <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_ref")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "ref", language = language, ...)
mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_authors <- function(x, language = get_AMR_locale(), ...) {
mo_authors <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_authors")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- mo_validate(x = x, property = "ref", language = language, ...)
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
# remove last 4 digits and presumably the comma and space that preceed them
x[!is.na(x)] <- gsub(",? ?[0-9]{4}", "", x[!is.na(x)], perl = TRUE)
suppressWarnings(x)
@ -527,15 +564,16 @@ mo_authors <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_year <- function(x, language = get_AMR_locale(), ...) {
mo_year <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_year")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- mo_validate(x = x, property = "ref", language = language, ...)
x <- mo_validate(x = x, property = "ref", language = language, keep_synonyms = keep_synonyms, ...)
# get last 4 digits
x[!is.na(x)] <- gsub(".*([0-9]{4})$", "\\1", x[!is.na(x)], perl = TRUE)
suppressWarnings(as.integer(x))
@ -543,80 +581,100 @@ mo_year <- function(x, language = get_AMR_locale(), ...) {
#' @rdname mo_property
#' @export
mo_lpsn <- function(x, language = get_AMR_locale(), ...) {
mo_lpsn <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_lpsn")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "lpsn", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_gbif <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_gbif")
}
meet_criteria(x, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "gbif", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_rank <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
mo_validate(x = x, property = "species_id", language = language, ...)
mo_validate(x = x, property = "rank", language = language, keep_synonyms = keep_synonyms, ...)
}
#' @rdname mo_property
#' @export
mo_rank <- function(x, language = get_AMR_locale(), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_rank")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
mo_validate(x = x, property = "rank", language = language, ...)
}
#' @rdname mo_property
#' @export
mo_taxonomy <- function(x, language = get_AMR_locale(), ...) {
mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_taxonomy")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
out <- list(
kingdom = mo_kingdom(x, language = language),
phylum = mo_phylum(x, language = language),
class = mo_class(x, language = language),
order = mo_order(x, language = language),
family = mo_family(x, language = language),
genus = mo_genus(x, language = language),
species = mo_species(x, language = language),
subspecies = mo_subspecies(x, language = language)
kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
phylum = mo_phylum(x, language = language, keep_synonyms = keep_synonyms),
class = mo_class(x, language = language, keep_synonyms = keep_synonyms),
order = mo_order(x, language = language, keep_synonyms = keep_synonyms),
family = mo_family(x, language = language, keep_synonyms = keep_synonyms),
genus = mo_genus(x, language = language, keep_synonyms = keep_synonyms),
species = mo_species(x, language = language, keep_synonyms = keep_synonyms),
subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out
}
#' @rdname mo_property
#' @export
mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_synonyms")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
IDs <- mo_name(x = x, language = NULL)
syns <- lapply(IDs, function(newname) {
res <- sort(microorganisms.old[which(microorganisms.old$fullname_new == newname), "fullname", drop = TRUE])
if (length(res) == 0) {
syns <- lapply(x.mo, function(y) {
gbif <- AMR::microorganisms$gbif[match(y, AMR::microorganisms$mo)]
lpsn <- AMR::microorganisms$lpsn[match(y, AMR::microorganisms$mo)]
out <- AMR::microorganisms[which(AMR::microorganisms$lpsn_renamed_to == lpsn | AMR::microorganisms$gbif_renamed_to == gbif), "fullname", drop = TRUE]
if (length(out) == 0) {
NULL
} else {
res
out
}
})
if (length(syns) > 1) {
names(syns) <- mo_name(x)
result <- syns
@ -624,32 +682,34 @@ mo_synonyms <- function(x, language = get_AMR_locale(), ...) {
result <- unlist(syns)
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
result
}
#' @rdname mo_property
#' @export
mo_info <- function(x, language = get_AMR_locale(), ...) {
mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_info")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, ...)
metadata <- get_mo_failures_uncertainties_renamed()
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_uncertainties()
info <- lapply(x, function(y) {
c(
mo_taxonomy(y, language = language),
mo_taxonomy(y, language = language, keep_synonyms = keep_synonyms),
list(
synonyms = mo_synonyms(y),
gramstain = mo_gramstain(y, language = language),
url = unname(mo_url(y, open = FALSE)),
ref = mo_ref(y),
snomed = unlist(mo_snomed(y))
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
ref = mo_ref(y, keep_synonyms = keep_synonyms),
snomed = unlist(mo_snomed(y, keep_synonyms = keep_synonyms))
)
)
})
@ -660,37 +720,36 @@ mo_info <- function(x, language = get_AMR_locale(), ...) {
result <- info[[1L]]
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
result
}
#' @rdname mo_property
#' @export
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_url")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(open, allow_class = "logical", has_length = 1)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x = x, language = language, ... = ...)
metadata <- get_mo_failures_uncertainties_renamed()
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
metadata <- get_mo_uncertainties()
df <- microorganisms[match(x.mo, microorganisms$mo), c("mo", "fullname", "source", "kingdom", "rank"), drop = FALSE]
df$url <- ifelse(df$source == "LPSN",
paste0(CATALOGUE_OF_LIFE$url_LPSN, "/species/", gsub(" ", "-", tolower(df$fullname), fixed = TRUE)),
paste0(CATALOGUE_OF_LIFE$url_CoL, "/data/search?type=EXACT&q=", gsub(" ", "%20", df$fullname, fixed = TRUE))
)
x.rank <- AMR::microorganisms$rank[match(x.mo, AMR::microorganisms$mo)]
x.name <- AMR::microorganisms$fullname[match(x.mo, AMR::microorganisms$mo)]
x.lpsn <- AMR::microorganisms$lpsn[match(x.mo, AMR::microorganisms$mo)]
x.gbif <- AMR::microorganisms$gbif[match(x.mo, AMR::microorganisms$mo)]
genera <- which(df$kingdom == "Bacteria" & df$rank == "genus")
df$url[genera] <- gsub("/species/", "/genus/", df$url[genera], fixed = TRUE)
subsp <- which(df$kingdom == "Bacteria" & df$rank %in% c("subsp.", "infraspecies"))
df$url[subsp] <- gsub("/species/", "/subspecies/", df$url[subsp], fixed = TRUE)
u <- character(length(x))
u[!is.na(x.gbif)] <- paste0(TAXONOMY_VERSION$GBIF$url, "/species/", x.gbif[!is.na(x.gbif)])
# overwrite with LPSN:
u[!is.na(x.lpsn)] <- paste0(TAXONOMY_VERSION$LPSN$url, "/", x.rank[!is.na(x.lpsn)], "/", gsub(" ", "-", tolower(x.name[!is.na(x.lpsn)]), fixed = TRUE))
u <- df$url
names(u) <- df$fullname
names(u) <- x.name
if (isTRUE(open)) {
if (length(u) > 1) {
@ -699,61 +758,69 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), ...) {
utils::browseURL(u[1L])
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
u
}
#' @rdname mo_property
#' @export
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), ...) {
mo_property <- function(x, property = "fullname", language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
if (missing(x)) {
# this tries to find the data and an <mo> column
x <- find_mo_col(fn = "mo_property")
}
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(microorganisms))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
language <- validate_language(language)
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
translate_into_language(mo_validate(x = x, property = property, language = language, ...), language = language, only_unknown = TRUE)
translate_into_language(mo_validate(x = x, property = property, language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
}
mo_validate <- function(x, property, language, ...) {
check_dataset_integrity()
dots <- list(...)
Becker <- dots$Becker
if (is.null(Becker) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
Becker <- FALSE
}
Lancefield <- dots$Lancefield
if (is.null(Lancefield) | property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
Lancefield <- FALSE
}
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") | Lancefield %in% c(TRUE, "all")
mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) {
if (tryCatch(all(x[!is.na(x)] %in% MO_lookup$mo) & !has_Becker_or_Lancefield, error = function(e) FALSE)) {
# special case for mo_* functions where class is already <mo>
x <- MO_lookup[match(x, MO_lookup$mo), 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% MO_lookup[1, property, drop = TRUE],
tryCatch(x[1L] %in% unlist(AMR::microorganisms[1, property, drop = TRUE]),
error = function(e) stop(e$message, call. = FALSE)
)
if (!all(x[!is.na(x)] %in% MO_lookup[, property, drop = TRUE]) | has_Becker_or_Lancefield) {
x <- exec_as.mo(x, property = property, language = language, ...)
dots <- list(...)
Becker <- dots$Becker
if (is.null(Becker) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
Becker <- FALSE
}
Lancefield <- dots$Lancefield
if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
Lancefield <- FALSE
}
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
mo_data_check <- AMR::microorganisms[which(AMR::microorganisms$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
# do nothing, just don't run the other if-else's
} else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
# no need to do anything, just return it
return(x)
} else {
# we need to get MO codes now
x <- replace_old_mo_codes(x, property = property)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
}
# get property reeaaally fast using match()
x <- AMR::microorganisms[[property]][match(x, AMR::microorganisms$mo)]
if (property == "mo") {
return(set_clean_class(x, new_class = c("mo", "character")))
} else if (property == "species_id") {
return(as.double(x))
} else if (property == "snomed") {
return(as.double(eval(parse(text = x))))
return(sort(as.character(eval(parse(text = x)))))
} else {
return(x)
# everything else is character
return(as.character(x))
}
}

44
R/mo_source.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -127,10 +131,10 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
mo_source_destination <- path.expand(destination)
stop_ifnot(interactive(), "this function can only be used in interactive mode, since it must ask for the user's permission to write a file to their home folder.")
stop_ifnot(interactive(), "this function can only be used in interactive mode, since it must ask for the user's permission to write a file to their file system.")
if (is.null(path) || path %in% c(FALSE, "")) {
pkg_env$mo_source <- NULL
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), "'",
@ -204,14 +208,14 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
word_wrap(paste0(
"This will write create the new file '",
mo_source_destination,
"', for which your permission is needed."
"', 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 in home directory", txt)
q_continue <- showQuestion("Create new file", txt)
} else {
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
}
@ -223,7 +227,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
attr(df, "mo_source_destination") <- mo_source_destination
attr(df, "mo_source_timestamp") <- file.mtime(path)
saveRDS(df, mo_source_destination)
pkg_env$mo_source <- df
AMR_env$mo_source <- df
message_(
action, " mo_source file '", font_bold(mo_source_destination),
"' (", formatted_filesize(mo_source_destination),
@ -243,26 +247,24 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
}
return(NULL)
}
if (is.null(pkg_env$mo_source)) {
pkg_env$mo_source <- readRDS(path.expand(destination))
if (is.null(AMR_env$mo_source)) {
AMR_env$mo_source <- readRDS(path.expand(destination))
}
old_time <- attributes(pkg_env$mo_source)$mo_source_timestamp
new_time <- file.mtime(attributes(pkg_env$mo_source)$mo_source_location)
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(pkg_env$mo_source)$mo_source_location)
set_mo_source(attributes(AMR_env$mo_source)$mo_source_location)
}
pkg_env$mo_source
AMR_env$mo_source
}
check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
check_dataset_integrity()
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
return(TRUE)
}
if (is.null(pkg_env$mo_source) && (identical(x, get_mo_source()))) {
if (is.null(AMR_env$mo_source) && (identical(x, get_mo_source()))) {
return(TRUE)
}
if (is.null(x)) {
@ -286,9 +288,9 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
return(FALSE)
}
}
if (!all(x$mo %in% c("", microorganisms$mo, microorganisms$fullname), na.rm = TRUE)) {
if (!all(x$mo %in% c("", AMR::microorganisms$mo, AMR::microorganisms$fullname), na.rm = TRUE)) {
if (stop_on_error == TRUE) {
invalid <- x[which(!x$mo %in% c("", microorganisms$mo, microorganisms$fullname)), , drop = FALSE]
invalid <- x[which(!x$mo %in% c("", AMR::microorganisms$mo, AMR::microorganisms$fullname)), , drop = FALSE]
if (nrow(invalid) > 1) {
plural <- "s"
} else {
@ -303,14 +305,14 @@ check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_o
return(FALSE)
}
}
if (colnames(x)[1] != "mo" & nrow(x) > length(unique(x[, 1, drop = TRUE]))) {
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 (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 {

12
R/pca.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -97,7 +101,7 @@ pca <- function(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)) {
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 {

24
R/plot.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -97,7 +101,7 @@ plot.mic <- function(x,
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -188,7 +192,7 @@ barplot.mic <- function(height,
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -236,7 +240,7 @@ autoplot.mic <- function(object,
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -336,7 +340,7 @@ plot.disk <- function(x,
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -427,7 +431,7 @@ barplot.disk <- function(height,
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -475,7 +479,7 @@ autoplot.disk <- function(object,
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set
@ -639,7 +643,7 @@ barplot.rsi <- function(height,
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
# translate if not specifically set

10
R/proportion.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

11
R/random.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -87,7 +91,6 @@ random_rsi <- function(size = NULL, prob_RSI = c(0.33, 0.33, 0.33), ...) {
}
random_exec <- function(type, size, mo = NULL, ab = NULL) {
check_dataset_integrity()
df <- rsi_translation %pm>%
pm_filter(guideline %like% "EUCAST") %pm>%
pm_arrange(pm_desc(guideline)) %pm>%

32
R/resistance_predict.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -132,18 +136,6 @@ resistance_predict <- function(x,
x.bak <- x
x <- as.data.frame(x, stringsAsFactors = FALSE)
dots <- unlist(list(...))
if (length(dots) != 0) {
# backwards compatibility with old arguments
dots.names <- names(dots)
if ("tbl" %in% dots.names) {
x <- dots[which(dots.names == "tbl")]
}
if ("I_as_R" %in% dots.names) {
warning_("in `resistance_predict()`: I_as_R is deprecated - use I_as_S instead.")
}
}
# -- date
if (is.null(col_date)) {
col_date <- search_type_in_df(x = x, type = "date")
@ -167,10 +159,10 @@ resistance_predict <- function(x,
df[, col_ab] <- droplevels(as.rsi(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])
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])
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])
@ -257,10 +249,10 @@ resistance_predict <- function(x,
df_prediction$se_max <- as.integer(df_prediction$se_max)
} else {
# se_max not above 1
df_prediction$se_max <- ifelse(df_prediction$se_max > 1, 1, df_prediction$se_max)
df_prediction$se_max <- pmin(df_prediction$se_max, 1)
}
# se_min not below 0
df_prediction$se_min <- ifelse(df_prediction$se_min < 0, 0, df_prediction$se_min)
df_prediction$se_min <- pmax(df_prediction$se_min, 0)
df_observations <- data.frame(
year = df$year,
@ -279,7 +271,7 @@ resistance_predict <- function(x,
df_prediction$se_max <- ifelse(!is.na(df_prediction$observed), NA, df_prediction$se_max)
}
df_prediction$value <- ifelse(df_prediction$value > 1, 1, ifelse(df_prediction$value < 0, 0, df_prediction$value))
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))

48
R/rsi.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -160,7 +164,7 @@
#' as.rsi() # automatically determines urine isolates
#'
#' df %>%
#' mutate_at(vars(AMP:NIT), as.rsi, mo = "E. coli", uti = TRUE)
#' mutate_at(vars(AMP:TOB), as.rsi, mo = "E. coli", uti = TRUE)
#' }
#'
#' # For CLEANING existing R/SI values ------------------------------------
@ -327,13 +331,13 @@ as.rsi.default <- function(x, ...) {
# remove other invalid characters
# set to capitals
x <- toupper(x)
x <- gsub("[^RSIHDU]+", "", x, perl = TRUE)
x <- gsub("[^A-Z]+", "", x, perl = TRUE)
# some labs now report "H" instead of "I" to not interfere with EUCAST prior to 2019
x <- gsub("^H$", "I", x, perl = TRUE)
x <- gsub("H", "I", x, fixed = TRUE)
# and MIPS uses D for Dose-dependent (which is I, but it will throw a note)
x <- gsub("^D$", "I", x, perl = TRUE)
x <- gsub("D", "I", x, fixed = TRUE)
# and MIPS uses U for "susceptible urine"
x <- gsub("^U$", "S", x, perl = TRUE)
x <- gsub("U", "S", x, fixed = TRUE)
# in cases of "S;S" keep S, but in case of "S;I" make it NA
x <- gsub("^S+$", "S", x)
x <- gsub("^I+$", "I", x)
@ -347,7 +351,11 @@ as.rsi.default <- function(x, ...) {
unique() %pm>%
sort() %pm>%
vector_and(quotes = TRUE)
warning_("in `as.rsi()`: ", na_after - na_before, " results truncated (",
cur_col <- get_current_column()
warning_("in `as.rsi()`: ", na_after - na_before, " result",
ifelse(na_after - na_before > 1, "s", ""),
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
" truncated (",
round(((na_after - na_before) / length(x)) * 100),
"%) that were invalid antimicrobial interpretations: ",
list_missing,
@ -753,7 +761,7 @@ as_rsi_method <- function(method_short,
method <- method_short
metadata_mo <- get_mo_failures_uncertainties_renamed()
metadata_mo <- get_mo_uncertainties()
x_bak <- data.frame(x_mo = paste0(x, mo), stringsAsFactors = FALSE)
df <- unique(data.frame(x, mo, x_mo = paste0(x, mo), stringsAsFactors = FALSE))
@ -806,7 +814,7 @@ as_rsi_method <- function(method_short,
if (nrow(trans) == 0) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
load_mo_failures_uncertainties_renamed(metadata_mo)
load_mo_uncertainties(metadata_mo)
return(set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
new_class = c("rsi", "ordered", "factor")
))
@ -898,8 +906,8 @@ as_rsi_method <- function(method_short,
}
# write to verbose output
pkg_env$rsi_interpretation_history <- rbind(
pkg_env$rsi_interpretation_history,
AMR_env$rsi_interpretation_history <- rbind(
AMR_env$rsi_interpretation_history,
data.frame(
datetime = Sys.time(),
index = i,
@ -943,7 +951,7 @@ as_rsi_method <- function(method_short,
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
load_mo_failures_uncertainties_renamed(metadata_mo)
load_mo_uncertainties(metadata_mo)
set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
new_class = c("rsi", "ordered", "factor")
@ -956,7 +964,7 @@ as_rsi_method <- function(method_short,
rsi_interpretation_history <- function(clean = FALSE) {
meet_criteria(clean, allow_class = "logical", has_length = 1)
out.bak <- pkg_env$rsi_interpretation_history
out.bak <- AMR_env$rsi_interpretation_history
out <- out.bak
if (NROW(out) == 0) {
message_("No results to return. Run `as.rsi()` on MIC values or disk diffusion zones first to see a 'logbook' data set here.")
@ -967,9 +975,9 @@ rsi_interpretation_history <- function(clean = FALSE) {
out$interpretation <- as.rsi(out$interpretation)
# keep stored for next use
if (isTRUE(clean)) {
pkg_env$rsi_interpretation_history <- pkg_env$rsi_interpretation_history[0, , drop = FALSE]
AMR_env$rsi_interpretation_history <- AMR_env$rsi_interpretation_history[0, , drop = FALSE]
} else {
pkg_env$rsi_interpretation_history <- out.bak
AMR_env$rsi_interpretation_history <- out.bak
}
if (pkg_is_available("tibble", also_load = FALSE)) {
@ -986,9 +994,9 @@ pillar_shaft.rsi <- function(x, ...) {
# colours will anyway not work when has_colour() == FALSE,
# but then the indentation should also not be applied
out[is.na(x)] <- font_grey(" NA")
out[x == "R"] <- font_rsi_R_bg(font_black(" R "))
out[x == "S"] <- font_rsi_S_bg(font_black(" S "))
out[x == "I"] <- font_rsi_I_bg(font_black(" I "))
out[x == "R"] <- font_red_bg(" R ")
out[x == "S"] <- font_green_bg(" S ")
out[x == "I"] <- font_orange_bg(" I ")
}
create_pillar_column(out, align = "left", width = 5)
}

22
R/rsi_calc.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -72,7 +76,7 @@ rsi_calc <- function(...,
} else {
dots <- dots[2:length(dots)]
}
if (length(dots) == 0 | all(dots == "df")) {
if (length(dots) == 0 || all(dots == "df")) {
# for complete data.frames, like example_isolates %pm>% select(AMC, GEN) %pm>% proportion_S()
# and the old rsi function, which has "df" as name of the first argument
x <- dots_df
@ -137,12 +141,12 @@ rsi_calc <- function(...,
FUN = min
)
numerator <- sum(as.integer(y) %in% as.integer(ab_result), na.rm = TRUE)
denominator <- sum(vapply(FUN.VALUE = logical(1), x_transposed, function(y) !(any(is.na(y)))))
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)
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) & any(is.na(y)))))
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
@ -228,9 +232,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
meet_criteria(combine_SI, allow_class = "logical", has_length = 1, .call_depth = 1)
meet_criteria(combine_SI_missing, allow_class = "logical", has_length = 1, .call_depth = 1)
check_dataset_integrity()
if (isTRUE(combine_IR) & isTRUE(combine_SI_missing)) {
if (isTRUE(combine_IR) && isTRUE(combine_SI_missing)) {
combine_SI <- FALSE
}
stop_if(isTRUE(combine_SI) & isTRUE(combine_IR), "either `combine_SI` or `combine_IR` can be TRUE, not both", call = -2)
@ -249,7 +251,7 @@ rsi_calc_df <- function(type, # "proportion", "count" or "both"
}
data <- as.data.frame(data, stringsAsFactors = FALSE)
if (isTRUE(combine_SI) | isTRUE(combine_IR)) {
if (isTRUE(combine_SI) || isTRUE(combine_IR)) {
for (i in seq_len(ncol(data))) {
if (is.rsi(data[, i, drop = TRUE])) {
data[, i] <- as.character(data[, i, drop = TRUE])

10
R/rsi_df.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

10
R/skewness.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

BIN
R/sysdata.rda
View File

Binary file not shown.

86
R/translate.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -27,17 +31,31 @@
#'
#' For language-dependent output of AMR functions, like [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: `r paste0('"', sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), '" ("' , LANGUAGES_SUPPORTED, '")', collapse = ", ")`.
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_and(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#' @param language language to choose. Use one of these supported language names or ISO-639-1 codes: `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`.
#' @details The currently `r length(LANGUAGES_SUPPORTED)` supported languages are `r vector_or(paste0(sapply(LANGUAGES_SUPPORTED_NAMES, function(x) x[[1]]), " (" , LANGUAGES_SUPPORTED, ")"), quotes = FALSE, sort = FALSE)`. All these languages have translations available for all antimicrobial agents and colloquial microorganism names.
#'
#' **To silence language notes when this package loads** on a non-English operating system, you can set the option `AMR_locale` in your `.Rprofile` file like this:
#'
#' ```r
#' # Open .Rprofile file
#' utils::file.edit("~/.Rprofile")
#'
#' # Add e.g. Italian support to that file using:
#' options(AMR_locale = "Italian")
#' # or using:
#' AMR::set_AMR_locale("Italian")
#'
#' # And 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 R option `AMR_locale`, either by using `set_AMR_locale()` or by running e.g. `options(AMR_locale = "de")`.
#' 1. Setting the R option `AMR_locale`, 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.
#' 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 R option `AMR_locale` is set, the system variables `LANGUAGE` and `LANG` will be ignored.
@ -47,16 +65,22 @@
#' @examples
#' # Current settings (based on system language)
#' ab_name("Ciprofloxacin")
#' mo_name("Coagulase-negative Staphylococcus")
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
#'
#' # setting another language
#' set_AMR_locale("Greek")
#' ab_name("Ciprofloxacin")
#' mo_name("Coagulase-negative Staphylococcus")
#'
#' set_AMR_locale("Spanish")
#' ab_name("Ciprofloxacin")
#' mo_name("Coagulase-negative Staphylococcus")
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
#'
#' # setting yet another language
#' set_AMR_locale("Greek")
#' ab_name("Ciprofloxacin")
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
#'
#' # setting yet another language
#' set_AMR_locale("Ukrainian")
#' ab_name("Ciprofloxacin")
#' mo_name("Coagulase-negative Staphylococcus (CoNS)")
#'
#' # set_AMR_locale() understands endonyms, English exonyms, and ISO-639-1:
#' set_AMR_locale("Deutsch")
@ -87,7 +111,7 @@ get_AMR_locale <- function() {
message_(
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
LANGUAGES_SUPPORTED_NAMES[[lang]]$endonym, ") for the AMR package. Change this with `set_AMR_locale()`. ",
"This note will be shown once per session."
"This note will be shown once per session but can be silenced, see `?set_AMR_locale()`."
)
}
lang
@ -98,13 +122,28 @@ get_AMR_locale <- function() {
set_AMR_locale <- function(language) {
language <- validate_language(language)
options(AMR_locale = language)
message_("Using the ", LANGUAGES_SUPPORTED_NAMES[[language]]$exonym, " language (", LANGUAGES_SUPPORTED_NAMES[[language]]$endonym, ") for the AMR package for this session.")
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
@ -115,10 +154,10 @@ translate_AMR <- function(x, language = get_AMR_locale()) {
validate_language <- function(language, extra_txt = character(0)) {
if (trimws(tolower(language)) %in% c("en", "english", "", "false", NA)) {
if (isTRUE(trimws2(tolower(language[1])) %in% c("en", "english", "", "false", NA)) || length(language) == 0) {
return("en")
}
lang <- find_language(language, fallback = FALSE)
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]]),
@ -131,19 +170,19 @@ validate_language <- function(language, extra_txt = character(0)) {
}
find_language <- function(language, fallback = TRUE) {
language <- Map(function(l, n, check = language) {
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 = FALSE,
ignore.case = TRUE,
perl = TRUE,
useBytes = FALSE
)
},
LANGUAGES_SUPPORTED_NAMES,
LANGUAGES_SUPPORTED,
USE.NAMES = TRUE
)
language <- names(which(language == TRUE))
@ -160,10 +199,7 @@ translate_into_language <- function(from,
only_unknown = FALSE,
only_affect_ab_names = FALSE,
only_affect_mo_names = FALSE) {
if (is.null(language)) {
return(from)
}
if (language %in% c("en", "", NA)) {
if (is.null(language) || language[1] %in% c("en", "", NA)) {
return(from)
}

10
R/vctrs.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

10
R/whocc.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

91
R/zzz.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -24,16 +28,24 @@
# ==================================================================== #
# set up package environment, used by numerous AMR functions
pkg_env <- new.env(hash = FALSE)
pkg_env$mo_failed <- character(0)
pkg_env$mo_field_abbreviations <- c(
"AIEC", "ATEC", "BORSA", "CRSM", "DAEC", "EAEC",
"EHEC", "EIEC", "EPEC", "ETEC", "GISA", "MRPA",
"MRSA", "MRSE", "MSSA", "MSSE", "NMEC", "PISP",
"PRSP", "STEC", "UPEC", "VISA", "VISP", "VRE",
"VRSA", "VRSP"
AMR_env <- new.env(hash = FALSE)
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
)
pkg_env$rsi_interpretation_history <- data.frame(
AMR_env$mo_renamed <- list()
AMR_env$mo_previously_coerced <- data.frame(
x = character(0),
mo = character(0),
stringsAsFactors = FALSE
)
AMR_env$rsi_interpretation_history <- data.frame(
datetime = Sys.time()[0],
index = integer(0),
ab_input = character(0),
@ -49,6 +61,7 @@ pkg_env$rsi_interpretation_history <- data.frame(
interpretation = character(0),
stringsAsFactors = FALSE
)
AMR_env$has_data.table <- pkg_is_available("data.table", also_load = FALSE)
# determine info icon for messages
utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)
@ -57,12 +70,12 @@ is_latex <- tryCatch(import_fn("is_latex_output", "knitr", error_on_fail = FALSE
)
if (utf8_supported && !is_latex) {
# \u2139 is a symbol officially named 'information source'
pkg_env$info_icon <- "\u2139"
AMR_env$info_icon <- "\u2139"
} else {
pkg_env$info_icon <- "i"
AMR_env$info_icon <- "i"
}
.onLoad <- function(...) {
.onLoad <- function(lib, pkg) {
# 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:
@ -117,14 +130,9 @@ if (utf8_supported && !is_latex) {
s3_register("vctrs::vec_math", "mic")
# if mo source exists, fire it up (see mo_source())
try(
{
if (file.exists(getOption("AMR_mo_source", "~/mo_source.rds"))) {
if (tryCatch(file.exists(getOption("AMR_mo_source", "~/mo_source.rds")), error = function(e) FALSE)) {
invisible(get_mo_source())
}
},
silent = TRUE
)
# be sure to print tibbles as tibbles
if (pkg_is_available("tibble", also_load = FALSE)) {
@ -135,7 +143,6 @@ if (utf8_supported && !is_latex) {
# they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
assign(x = "AB_lookup", value = create_AB_lookup(), envir = asNamespace("AMR"))
assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR"))
assign(x = "MO.old_lookup", value = create_MO.old_lookup(), envir = asNamespace("AMR"))
# for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
assign(x = "INTRINSIC_R", value = create_intr_resistance(), envir = asNamespace("AMR"))
}
@ -157,30 +164,34 @@ create_MO_lookup <- function() {
# all the rest
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
if (length(MO_FULLNAME_LOWER) == nrow(MO_lookup)) {
MO_lookup$fullname_lower <- MO_FULLNAME_LOWER
} else {
MO_lookup$fullname_lower <- ""
warning("MO table updated - Run: source(\"data-raw/_pre_commit_hook.R\")", call. = FALSE)
}
# # use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
# if (length(MO_FULLNAME_LOWER) == nrow(MO_lookup)) {
# MO_lookup$fullname_lower <- MO_FULLNAME_LOWER
# } else {
# MO_lookup$fullname_lower <- ""
# warning("MO table updated - Run: source(\"data-raw/_pre_commit_hook.R\")", call. = FALSE)
# }
# add a column with only "e coli" like combinations
MO_lookup$g_species <- gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO_lookup$fullname_lower, perl = TRUE)
MO_lookup$fullname_lower <- create_MO_fullname_lower()
MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1)
MO_lookup$species_first <- substr(MO_lookup$species, 1, 1)
# so arrange data on prevalence first, then kingdom, then full name
MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), , drop = FALSE]
}
create_MO.old_lookup <- function() {
MO.old_lookup <- AMR::microorganisms.old
MO.old_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", tolower(trimws(MO.old_lookup$fullname))))
# add a column with only "e coli"-like combinations
MO.old_lookup$g_species <- trimws(gsub("^([a-z])[a-z]+ ([a-z]+) ?.*", "\\1 \\2", MO.old_lookup$fullname_lower))
# so arrange data on prevalence first, then full name
MO.old_lookup[order(MO.old_lookup$prevalence, MO.old_lookup$fullname_lower), , drop = FALSE]
create_MO_fullname_lower <- function() {
MO_lookup <- AMR::microorganisms
# use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
MO_lookup$fullname_lower <- tolower(trimws(paste(
MO_lookup$genus,
MO_lookup$species,
MO_lookup$subspecies
)))
ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE])
MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
MO_lookup$fullname_lower
}
create_intr_resistance <- function() {

8
README.md
View File

@ -2,15 +2,13 @@
# `AMR` (for R)
![R-code-check](https://github.com/msberends/AMR/workflows/R-code-check/badge.svg?branch=main)
[![CodeFactor](https://www.codefactor.io/repository/github/msberends/amr/badge)](https://www.codefactor.io/repository/github/msberends/amr)
[![Codecov](https://codecov.io/gh/msberends/AMR/branch/main/graph/badge.svg)](https://app.codecov.io/gh/msberends/AMR?branch=main)
<img src="https://msberends.github.io/AMR/AMR_intro.svg" align="center" height="300px" />
This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)).
`AMR` is a free, open-source and independent R package to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. Our aim is to provide a standard for clean and reproducible antimicrobial resistance data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. It is currently being used in over 175 countries.
After installing this package, R knows ~71,000 distinct microbial species and all ~570 antibiotic, antimycotic, and antiviral drugs by name and code (including ATC, WHONET/EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.
After installing this package, R knows ~49,000 distinct microbial species and all ~570 antibiotic, antimycotic, and antiviral drugs by name and code (including ATC, WHONET/EARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid R/SI and MIC values. It supports any data format, including WHONET/EARS-Net data. Antimicrobial names and group names are available in Danish, Dutch, English, French, German, Italian, Portuguese and Spanish.
This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0.0 (April 2013). It was designed to work in any setting, including those with very limited resources. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the University of Groningen, in collaboration with non-profit organisations Certe Medical Diagnostics and Advice Foundation and University Medical Center Groningen. This R package is actively maintained and free software; you can freely use and distribute it for both personal and commercial (but not patent) purposes under the terms of the GNU General Public License version 2.0 (GPL-2), as published by the Free Software Foundation.

13
_pkgdown.yml
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -41,7 +45,6 @@ template:
opengraph:
twitter:
creator: "@msberends"
site: "@univgroningen"
card: summary_large_image
news:
@ -54,7 +57,7 @@ footer:
right: [logo]
components:
devtext: '<code>AMR</code> (for R). Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> in collaboration with non-profit organisations<br><a target="_blank" href="https://www.certe.nl">Certe Medical Diagnostics and Advice Foundation</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a>.'
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/logos/logo_rug.svg" style="max-width: 200px;"></a>'
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://github.com/msberends/AMR/raw/main/pkgdown/logos/logo_rug.svg" style="max-width: 150px;"></a>'
home:
sidebar:

10
codecov.yml
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

12
data-raw/_install_deps.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -28,7 +32,7 @@ install.packages("data-raw/tinytest_1.3.1.tar.gz", dependencies = c("Depends", "
install.packages(getwd(), repos = NULL, type = "source")
pkg_suggests <- gsub(
"[^a-zA-Z0-9]+", "",
"[^a-zA-Z0-9.]+", "",
unlist(strsplit(unlist(packageDescription("AMR",
fields = c("Suggests", "Enhances", "LinkingTo")
)),

10
data-raw/_language_update.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

77
data-raw/_pre_commit_hook.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -100,7 +104,7 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
MO_staph[which(MO_staph$species %in% c(
"coagulase-negative", "argensis", "arlettae",
"auricularis", "borealis", "caeli", "capitis", "caprae",
"carnosus", "casei", "chromogenes", "cohnii", "condimenti",
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
"croceilyticus",
"debuckii", "devriesei", "edaphicus", "epidermidis",
"equorum", "felis", "fleurettii", "gallinarum",
@ -113,8 +117,10 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
"ureilyticus",
"vitulinus", "vitulus", "warneri", "xylosus",
"caledonicus", "canis",
"durrellii", "lloydii"
"durrellii", "lloydii",
"ratti", "taiwanensis", "veratri", "urealyticus"
) |
# old, now renamed to S. schleiferi (but still as synonym in our data of course):
(MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
"mo",
drop = TRUE
@ -128,8 +134,10 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
"hyicus", "intermedius",
"pseudintermedius", "pseudointermedius",
"schweitzeri", "simiae",
"roterodami"
"roterodami",
"singaporensis"
) |
# old, now renamed to S. coagulans (but still as synonym in our data of course):
(MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
"mo",
drop = TRUE
@ -151,31 +159,35 @@ create_MO_fullname_lower <- function() {
}
MO_CONS <- create_species_cons_cops("CoNS")
MO_COPS <- create_species_cons_cops("CoPS")
MO_STREP_ABCG <- as.mo(MO_lookup[which(MO_lookup$genus == "Streptococcus"), "mo", drop = TRUE], Lancefield = TRUE) %in% c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_GRPC", "B_STRPT_GRPG")
MO_STREP_ABCG <- MO_lookup$mo[which(MO_lookup$genus == "Streptococcus" &
MO_lookup$species %in% c(
"pyogenes", "agalactiae", "dysgalactiae", "equi", "anginosus", "sanguinis", "salivarius",
"group A", "group B", "group C", "group D", "group F", "group G", "group H", "group K", "group L"
))]
MO_FULLNAME_LOWER <- create_MO_fullname_lower()
MO_PREVALENT_GENERA <- c(
"Absidia", "Acholeplasma", "Acremonium", "Actinotignum", "Aedes", "Alistipes", "Alloprevotella",
"Alternaria", "Anaerosalibacter", "Ancylostoma", "Angiostrongylus", "Anisakis", "Anopheles",
"Absidia", "Acanthamoeba", "Acholeplasma", "Acremonium", "Actinotignum", "Aedes", "Alistipes", "Alloprevotella",
"Alternaria", "Amoeba", "Anaerosalibacter", "Ancylostoma", "Angiostrongylus", "Anisakis", "Anopheles",
"Apophysomyces", "Arachnia", "Aspergillus", "Aureobasidium", "Bacteroides", "Basidiobolus",
"Beauveria", "Bergeyella", "Blastocystis", "Blastomyces", "Borrelia", "Brachyspira", "Branhamella",
"Butyricimonas", "Candida", "Capillaria", "Capnocytophaga", "Catabacter", "Cetobacterium", "Chaetomium",
"Chlamydia", "Chlamydophila", "Chryseobacterium", "Chrysonilia", "Cladophialophora", "Cladosporium",
"Conidiobolus", "Contracaecum", "Cordylobia", "Cryptococcus", "Curvularia", "Deinococcus", "Demodex",
"Dermatobia", "Diphyllobothrium", "Dirofilaria", "Dysgonomonas", "Echinostoma", "Elizabethkingia",
"Empedobacter", "Enterobius", "Exophiala", "Exserohilum", "Fasciola", "Flavobacterium", "Fonsecaea",
"Dermatobia", "Dientamoeba", "Diphyllobothrium", "Dirofilaria", "Dysgonomonas", "Echinostoma", "Elizabethkingia",
"Empedobacter", "Entamoeba", "Enterobius", "Exophiala", "Exserohilum", "Fasciola", "Flavobacterium", "Fonsecaea",
"Fusarium", "Fusobacterium", "Giardia", "Haloarcula", "Halobacterium", "Halococcus", "Hendersonula",
"Heterophyes", "Histoplasma", "Hymenolepis", "Hypomyces", "Hysterothylacium", "Lelliottia",
"Leptosphaeria", "Leptotrichia", "Lucilia", "Lumbricus", "Malassezia", "Malbranchea", "Metagonimus",
"Microsporum", "Mortierella", "Mucor", "Mycocentrospora", "Mycoplasma", "Myroides", "Necator",
"Heterophyes", "Histomonas", "Histoplasma", "Hymenolepis", "Hypomyces", "Hysterothylacium", "Leishmania", "Lelliottia",
"Leptosphaeria", "Leptotrichia", "Lucilia", "Lumbricus", "Malassezia", "Malbranchea", "Metagonimus", "Meyerozyma",
"Microsporidium", "Microsporum", "Mortierella", "Mucor", "Mycocentrospora", "Mycoplasma", "Myroides", "Necator",
"Nectria", "Ochroconis", "Odoribacter", "Oesophagostomum", "Oidiodendron", "Opisthorchis",
"Ornithobacterium", "Parabacteroides", "Pediculus", "Pedobacter", "Phlebotomus", "Phocaeicola",
"Phocanema", "Phoma", "Piedraia", "Pithomyces", "Pityrosporum", "Porphyromonas", "Prevotella",
"Phocanema", "Phoma", "Pichia", "Piedraia", "Pithomyces", "Pityrosporum", "Pneumocystis", "Porphyromonas", "Prevotella",
"Pseudallescheria", "Pseudoterranova", "Pulex", "Rhizomucor", "Rhizopus", "Rhodotorula", "Riemerella",
"Saccharomyces", "Sarcoptes", "Scolecobasidium", "Scopulariopsis", "Scytalidium", "Sphingobacterium",
"Spirometra", "Spiroplasma", "Sporobolomyces", "Stachybotrys", "Streptobacillus", "Strongyloides",
"Syngamus", "Taenia", "Tannerella", "Tenacibaculum", "Terrimonas", "Toxocara", "Treponema", "Trichinella",
"Trichobilharzia", "Trichoderma", "Trichomonas", "Trichophyton", "Trichosporon", "Trichostrongylus",
"Trichuris", "Tritirachium", "Trombicula", "Tunga", "Ureaplasma", "Victivallis", "Wautersiella",
"Trichuris", "Tritirachium", "Trypanosoma", "Trombicula", "Tunga", "Ureaplasma", "Victivallis", "Wautersiella",
"Weeksella", "Wuchereria"
)
@ -281,7 +293,7 @@ create_AB_lookup <- function() {
AB_LOOKUP <- create_AB_lookup()
# Export to package as internal data ----
usethis::ui_info(paste0("Saving {usethis::ui_value('sysdata.rda')} to {usethis::ui_value('R/')}"))
usethis::ui_info(paste0("Updating internal package data"))
suppressMessages(usethis::use_data(EUCAST_RULES_DF,
TRANSLATIONS,
LANGUAGES_SUPPORTED_NAMES,
@ -360,7 +372,7 @@ changed_md5 <- function(object) {
# give official names to ABs and MOs
rsi <- rsi_translation %>%
mutate(mo_name = mo_name(mo, language = NULL), .after = mo) %>%
mutate(mo_name = mo_name(mo, language = NULL, keep_synonyms = TRUE, info = FALSE), .after = mo) %>%
mutate(ab_name = ab_name(ab, language = NULL), .after = ab)
if (changed_md5(rsi)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('rsi_translation')} to {usethis::ui_value('data-raw/')}"))
@ -392,19 +404,6 @@ if (changed_md5(microorganisms)) {
try(arrow::write_parquet(microorganisms, "data-raw/microorganisms.parquet"), silent = TRUE)
}
if (changed_md5(microorganisms.old)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms.old')} to {usethis::ui_value('data-raw/')}"))
write_md5(microorganisms.old)
try(saveRDS(microorganisms.old, "data-raw/microorganisms.old.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(microorganisms.old, "data-raw/microorganisms.old.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
try(arrow::write_feather(microorganisms.old, "data-raw/microorganisms.old.feather"), silent = TRUE)
try(arrow::write_parquet(microorganisms.old, "data-raw/microorganisms.old.parquet"), silent = TRUE)
}
ab <- dplyr::mutate_if(antibiotics, ~ !is.numeric(.), as.character)
if (changed_md5(ab)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('antibiotics')} to {usethis::ui_value('data-raw/')}"))
@ -435,7 +434,7 @@ if (changed_md5(av)) {
# give official names to ABs and MOs
intrinsicR <- data.frame(
microorganism = mo_name(intrinsic_resistant$mo, language = NULL),
microorganism = mo_name(intrinsic_resistant$mo, language = NULL, keep_synonyms = TRUE, info = FALSE),
antibiotic = ab_name(intrinsic_resistant$ab, language = NULL),
stringsAsFactors = FALSE
)
@ -486,16 +485,14 @@ suppressMessages(devtools::document(quiet = TRUE))
# Style pkg ---------------------------------------------------------------
usethis::ui_info("Styling package")
invisible(capture.output(styler::style_pkg(
if (interactive()) {
# only when sourcing this file ourselves
usethis::ui_info("Styling package")
styler::style_pkg(
style = styler::tidyverse_style,
filetype = c("R", "Rmd")
)))
invisible(capture.output(styler::style_dir(
path = "inst", # unit tests
style = styler::tidyverse_style,
filetype = c("R", "Rmd")
)))
)
}
# Finished ----------------------------------------------------------------

2
data-raw/intrinsicR.md5
View File

@ -1 +1 @@
56b3cea0e28d8a54e0fcbd3e50af96fc
a6dcb362ffa737670ed4663968fbff26

BIN
data-raw/intrinsic_resistant.dta
View File

Binary file not shown.

BIN
data-raw/intrinsic_resistant.feather
View File

Binary file not shown.

BIN
data-raw/intrinsic_resistant.parquet
View File

Binary file not shown.

BIN
data-raw/intrinsic_resistant.rds
View File

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sas
View File

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sav
View File

Binary file not shown.

355
data-raw/intrinsic_resistant.txt
View File

@ -7617,11 +7617,11 @@
"Actinoalloteichus spitiensis" "Nalidixic acid"
"Actinoalloteichus spitiensis" "Polymyxin B"
"Actinoalloteichus spitiensis" "Temocillin"
"Actinobacteria" "Aztreonam"
"Actinobacteria" "Colistin"
"Actinobacteria" "Nalidixic acid"
"Actinobacteria" "Polymyxin B"
"Actinobacteria" "Temocillin"
"Actinobacteriota" "Aztreonam"
"Actinobacteriota" "Colistin"
"Actinobacteriota" "Nalidixic acid"
"Actinobacteriota" "Polymyxin B"
"Actinobacteriota" "Temocillin"
"Actinobaculum" "Aztreonam"
"Actinobaculum" "Colistin"
"Actinobaculum" "Nalidixic acid"
@ -8877,11 +8877,6 @@
"Actinopolysporaceae" "Nalidixic acid"
"Actinopolysporaceae" "Polymyxin B"
"Actinopolysporaceae" "Temocillin"
"Actinopolysporales" "Aztreonam"
"Actinopolysporales" "Colistin"
"Actinopolysporales" "Nalidixic acid"
"Actinopolysporales" "Polymyxin B"
"Actinopolysporales" "Temocillin"
"Actinorectispora" "Aztreonam"
"Actinorectispora" "Colistin"
"Actinorectispora" "Nalidixic acid"
@ -9272,16 +9267,6 @@
"Aestuariimicrobium" "Nalidixic acid"
"Aestuariimicrobium" "Polymyxin B"
"Aestuariimicrobium" "Temocillin"
"Aestuariimicrobium kwangyangense" "Aztreonam"
"Aestuariimicrobium kwangyangense" "Colistin"
"Aestuariimicrobium kwangyangense" "Nalidixic acid"
"Aestuariimicrobium kwangyangense" "Polymyxin B"
"Aestuariimicrobium kwangyangense" "Temocillin"
"Aestuariimicrobium soli" "Aztreonam"
"Aestuariimicrobium soli" "Colistin"
"Aestuariimicrobium soli" "Nalidixic acid"
"Aestuariimicrobium soli" "Polymyxin B"
"Aestuariimicrobium soli" "Temocillin"
"Agathobacter" "Aztreonam"
"Agathobacter" "Colistin"
"Agathobacter" "Nalidixic acid"
@ -11265,11 +11250,11 @@
"Amycolatopsis alba" "Nalidixic acid"
"Amycolatopsis alba" "Polymyxin B"
"Amycolatopsis alba" "Temocillin"
"Amycolatopsis albidiflava" "Aztreonam"
"Amycolatopsis albidiflava" "Colistin"
"Amycolatopsis albidiflava" "Nalidixic acid"
"Amycolatopsis albidiflava" "Polymyxin B"
"Amycolatopsis albidiflava" "Temocillin"
"Amycolatopsis albidoflava" "Aztreonam"
"Amycolatopsis albidoflava" "Colistin"
"Amycolatopsis albidoflava" "Nalidixic acid"
"Amycolatopsis albidoflava" "Polymyxin B"
"Amycolatopsis albidoflava" "Temocillin"
"Amycolatopsis albispora" "Aztreonam"
"Amycolatopsis albispora" "Colistin"
"Amycolatopsis albispora" "Nalidixic acid"
@ -22103,11 +22088,6 @@
"Catabacter honkongensis" "Nalidixic acid"
"Catabacter honkongensis" "Polymyxin B"
"Catabacter honkongensis" "Temocillin"
"Catabacteraceae" "Aztreonam"
"Catabacteraceae" "Colistin"
"Catabacteraceae" "Nalidixic acid"
"Catabacteraceae" "Polymyxin B"
"Catabacteraceae" "Temocillin"
"Catellatospora" "Aztreonam"
"Catellatospora" "Colistin"
"Catellatospora" "Nalidixic acid"
@ -23053,11 +23033,6 @@
"Chloroflexales" "Nalidixic acid"
"Chloroflexales" "Polymyxin B"
"Chloroflexales" "Temocillin"
"Chloroflexi" "Aztreonam"
"Chloroflexi" "Colistin"
"Chloroflexi" "Nalidixic acid"
"Chloroflexi" "Polymyxin B"
"Chloroflexi" "Temocillin"
"Chloroflexia" "Aztreonam"
"Chloroflexia" "Colistin"
"Chloroflexia" "Nalidixic acid"
@ -30752,12 +30727,6 @@
"Corynebacterium appendicis" "Nalidixic acid"
"Corynebacterium appendicis" "Polymyxin B"
"Corynebacterium appendicis" "Temocillin"
"Corynebacterium aquaticum" "Aztreonam"
"Corynebacterium aquaticum" "Colistin"
"Corynebacterium aquaticum" "Fosfomycin"
"Corynebacterium aquaticum" "Nalidixic acid"
"Corynebacterium aquaticum" "Polymyxin B"
"Corynebacterium aquaticum" "Temocillin"
"Corynebacterium aquatimens" "Aztreonam"
"Corynebacterium aquatimens" "Colistin"
"Corynebacterium aquatimens" "Fosfomycin"
@ -32711,11 +32680,6 @@
"Dehalococcoides mccartyi" "Nalidixic acid"
"Dehalococcoides mccartyi" "Polymyxin B"
"Dehalococcoides mccartyi" "Temocillin"
"Dehalococcoidetes" "Aztreonam"
"Dehalococcoidetes" "Colistin"
"Dehalococcoidetes" "Nalidixic acid"
"Dehalococcoidetes" "Polymyxin B"
"Dehalococcoidetes" "Temocillin"
"Dehalogenimonas" "Aztreonam"
"Dehalogenimonas" "Colistin"
"Dehalogenimonas" "Nalidixic acid"
@ -33146,11 +33110,6 @@
"Desulfofundulus thermobenzoicus thermobenzoicus" "Nalidixic acid"
"Desulfofundulus thermobenzoicus thermobenzoicus" "Polymyxin B"
"Desulfofundulus thermobenzoicus thermobenzoicus" "Temocillin"
"Desulfofundulus thermobenzoicus thermosyntrophicus" "Aztreonam"
"Desulfofundulus thermobenzoicus thermosyntrophicus" "Colistin"
"Desulfofundulus thermobenzoicus thermosyntrophicus" "Nalidixic acid"
"Desulfofundulus thermobenzoicus thermosyntrophicus" "Polymyxin B"
"Desulfofundulus thermobenzoicus thermosyntrophicus" "Temocillin"
"Desulfofundulus thermocisternus" "Aztreonam"
"Desulfofundulus thermocisternus" "Colistin"
"Desulfofundulus thermocisternus" "Nalidixic acid"
@ -60316,11 +60275,6 @@
"Geobacillus thermodenitrificans calidus" "Nalidixic acid"
"Geobacillus thermodenitrificans calidus" "Polymyxin B"
"Geobacillus thermodenitrificans calidus" "Temocillin"
"Geobacillus thermodenitrificans thermodenitrificans" "Aztreonam"
"Geobacillus thermodenitrificans thermodenitrificans" "Colistin"
"Geobacillus thermodenitrificans thermodenitrificans" "Nalidixic acid"
"Geobacillus thermodenitrificans thermodenitrificans" "Polymyxin B"
"Geobacillus thermodenitrificans thermodenitrificans" "Temocillin"
"Geobacillus thermoleovorans" "Aztreonam"
"Geobacillus thermoleovorans" "Colistin"
"Geobacillus thermoleovorans" "Nalidixic acid"
@ -62185,11 +62139,6 @@
"Haloechinothrix" "Nalidixic acid"
"Haloechinothrix" "Polymyxin B"
"Haloechinothrix" "Temocillin"
"Haloechinothrix aidingensis" "Aztreonam"
"Haloechinothrix aidingensis" "Colistin"
"Haloechinothrix aidingensis" "Nalidixic acid"
"Haloechinothrix aidingensis" "Polymyxin B"
"Haloechinothrix aidingensis" "Temocillin"
"Haloechinothrix alba" "Aztreonam"
"Haloechinothrix alba" "Colistin"
"Haloechinothrix alba" "Nalidixic acid"
@ -67423,20 +67372,13 @@
"Lactobacillus bombicola" "Teicoplanin"
"Lactobacillus bombicola" "Temocillin"
"Lactobacillus bombicola" "Vancomycin"
"Lactobacillus casei casei" "Aztreonam"
"Lactobacillus casei casei" "Colistin"
"Lactobacillus casei casei" "Nalidixic acid"
"Lactobacillus casei casei" "Polymyxin B"
"Lactobacillus casei casei" "Teicoplanin"
"Lactobacillus casei casei" "Temocillin"
"Lactobacillus casei casei" "Vancomycin"
"Lactobacillus casei pseudoplantarum" "Aztreonam"
"Lactobacillus casei pseudoplantarum" "Colistin"
"Lactobacillus casei pseudoplantarum" "Nalidixic acid"
"Lactobacillus casei pseudoplantarum" "Polymyxin B"
"Lactobacillus casei pseudoplantarum" "Teicoplanin"
"Lactobacillus casei pseudoplantarum" "Temocillin"
"Lactobacillus casei pseudoplantarum" "Vancomycin"
"Lactobacillus casei" "Aztreonam"
"Lactobacillus casei" "Colistin"
"Lactobacillus casei" "Nalidixic acid"
"Lactobacillus casei" "Polymyxin B"
"Lactobacillus casei" "Teicoplanin"
"Lactobacillus casei" "Temocillin"
"Lactobacillus casei" "Vancomycin"
"Lactobacillus colini" "Aztreonam"
"Lactobacillus colini" "Colistin"
"Lactobacillus colini" "Nalidixic acid"
@ -67731,13 +67673,13 @@
"Lactobacillus rogosae" "Teicoplanin"
"Lactobacillus rogosae" "Temocillin"
"Lactobacillus rogosae" "Vancomycin"
"Lactobacillus sakei sake" "Aztreonam"
"Lactobacillus sakei sake" "Colistin"
"Lactobacillus sakei sake" "Nalidixic acid"
"Lactobacillus sakei sake" "Polymyxin B"
"Lactobacillus sakei sake" "Teicoplanin"
"Lactobacillus sakei sake" "Temocillin"
"Lactobacillus sakei sake" "Vancomycin"
"Lactobacillus sakei" "Aztreonam"
"Lactobacillus sakei" "Colistin"
"Lactobacillus sakei" "Nalidixic acid"
"Lactobacillus sakei" "Polymyxin B"
"Lactobacillus sakei" "Teicoplanin"
"Lactobacillus sakei" "Temocillin"
"Lactobacillus sakei" "Vancomycin"
"Lactobacillus salivarius salivarius" "Aztreonam"
"Lactobacillus salivarius salivarius" "Colistin"
"Lactobacillus salivarius salivarius" "Nalidixic acid"
@ -68824,11 +68766,6 @@
"Lentzea albidocapillata" "Nalidixic acid"
"Lentzea albidocapillata" "Polymyxin B"
"Lentzea albidocapillata" "Temocillin"
"Lentzea albidocapillata albidocapillata" "Aztreonam"
"Lentzea albidocapillata albidocapillata" "Colistin"
"Lentzea albidocapillata albidocapillata" "Nalidixic acid"
"Lentzea albidocapillata albidocapillata" "Polymyxin B"
"Lentzea albidocapillata albidocapillata" "Temocillin"
"Lentzea albidocapillata violacea" "Aztreonam"
"Lentzea albidocapillata violacea" "Colistin"
"Lentzea albidocapillata violacea" "Nalidixic acid"
@ -75113,11 +75050,6 @@
"Mycobacterium intracellulare chimaera" "Nalidixic acid"
"Mycobacterium intracellulare chimaera" "Polymyxin B"
"Mycobacterium intracellulare chimaera" "Temocillin"
"Mycobacterium intracellulare intracellulare" "Aztreonam"
"Mycobacterium intracellulare intracellulare" "Colistin"
"Mycobacterium intracellulare intracellulare" "Nalidixic acid"
"Mycobacterium intracellulare intracellulare" "Polymyxin B"
"Mycobacterium intracellulare intracellulare" "Temocillin"
"Mycobacterium iranicum" "Aztreonam"
"Mycobacterium iranicum" "Colistin"
"Mycobacterium iranicum" "Nalidixic acid"
@ -75718,11 +75650,6 @@
"Mycoplasma cavipharyngis" "Nalidixic acid"
"Mycoplasma cavipharyngis" "Polymyxin B"
"Mycoplasma cavipharyngis" "Temocillin"
"Mycoplasma coccoides" "Aztreonam"
"Mycoplasma coccoides" "Colistin"
"Mycoplasma coccoides" "Nalidixic acid"
"Mycoplasma coccoides" "Polymyxin B"
"Mycoplasma coccoides" "Temocillin"
"Mycoplasma collis" "Aztreonam"
"Mycoplasma collis" "Colistin"
"Mycoplasma collis" "Nalidixic acid"
@ -78993,11 +78920,6 @@
"Nocardioides zhouii" "Nalidixic acid"
"Nocardioides zhouii" "Polymyxin B"
"Nocardioides zhouii" "Temocillin"
"Nocardiopsaceae" "Aztreonam"
"Nocardiopsaceae" "Colistin"
"Nocardiopsaceae" "Nalidixic acid"
"Nocardiopsaceae" "Polymyxin B"
"Nocardiopsaceae" "Temocillin"
"Nocardiopsis" "Aztreonam"
"Nocardiopsis" "Colistin"
"Nocardiopsis" "Nalidixic acid"
@ -80958,11 +80880,6 @@
"Paenibacillus graminis" "Nalidixic acid"
"Paenibacillus graminis" "Polymyxin B"
"Paenibacillus graminis" "Temocillin"
"Paenibacillus granivorans" "Aztreonam"
"Paenibacillus granivorans" "Colistin"
"Paenibacillus granivorans" "Nalidixic acid"
"Paenibacillus granivorans" "Polymyxin B"
"Paenibacillus granivorans" "Temocillin"
"Paenibacillus guangzhouensis" "Aztreonam"
"Paenibacillus guangzhouensis" "Colistin"
"Paenibacillus guangzhouensis" "Nalidixic acid"
@ -90318,78 +90235,6 @@
"Pseudomonas agarici" "Tedizolid"
"Pseudomonas agarici" "Vancomycin"
"Pseudomonas agarici" "Nafithromycin"
"Pseudomonas akapageensis" "Acetylmidecamycin"
"Pseudomonas akapageensis" "Acetylspiramycin"
"Pseudomonas akapageensis" "Avoparcin"
"Pseudomonas akapageensis" "Azithromycin"
"Pseudomonas akapageensis" "Cefacetrile"
"Pseudomonas akapageensis" "Cadazolid"
"Pseudomonas akapageensis" "Cefaclor"
"Pseudomonas akapageensis" "Cephradine"
"Pseudomonas akapageensis" "Cephalothin"
"Pseudomonas akapageensis" "Cefadroxil"
"Pseudomonas akapageensis" "Cefonicid"
"Pseudomonas akapageensis" "Clindamycin"
"Pseudomonas akapageensis" "Clarithromycin"
"Pseudomonas akapageensis" "Cefmetazole"
"Pseudomonas akapageensis" "Ceforanide"
"Pseudomonas akapageensis" "Cefprozil"
"Pseudomonas akapageensis" "Cefroxadine"
"Pseudomonas akapageensis" "Cefotiam"
"Pseudomonas akapageensis" "Ceftezole"
"Pseudomonas akapageensis" "Cefotetan"
"Pseudomonas akapageensis" "Cefatrizine"
"Pseudomonas akapageensis" "Cefuroxime axetil"
"Pseudomonas akapageensis" "Cefuroxime"
"Pseudomonas akapageensis" "Cycloserine"
"Pseudomonas akapageensis" "Cefazedone"
"Pseudomonas akapageensis" "Cefazolin"
"Pseudomonas akapageensis" "Dalbavancin"
"Pseudomonas akapageensis" "Dirithromycin"
"Pseudomonas akapageensis" "Erythromycin"
"Pseudomonas akapageensis" "Flurithromycin"
"Pseudomonas akapageensis" "Cefoxitin"
"Pseudomonas akapageensis" "Fusidic acid"
"Pseudomonas akapageensis" "Gamithromycin"
"Pseudomonas akapageensis" "Cephapirin"
"Pseudomonas akapageensis" "Josamycin"
"Pseudomonas akapageensis" "Kitasamycin"
"Pseudomonas akapageensis" "Cephalexin"
"Pseudomonas akapageensis" "Lincomycin"
"Pseudomonas akapageensis" "Linezolid"
"Pseudomonas akapageensis" "Loracarbef"
"Pseudomonas akapageensis" "Cefamandole"
"Pseudomonas akapageensis" "Miocamycin"
"Pseudomonas akapageensis" "Meleumycin"
"Pseudomonas akapageensis" "Midecamycin"
"Pseudomonas akapageensis" "Norvancomycin"
"Pseudomonas akapageensis" "Oleandomycin"
"Pseudomonas akapageensis" "Oritavancin"
"Pseudomonas akapageensis" "Benzylpenicillin"
"Pseudomonas akapageensis" "Pristinamycin"
"Pseudomonas akapageensis" "Pirlimycin"
"Pseudomonas akapageensis" "Primycin"
"Pseudomonas akapageensis" "Quinupristin/dalfopristin"
"Pseudomonas akapageensis" "Ramoplanin"
"Pseudomonas akapageensis" "Cefaloridine"
"Pseudomonas akapageensis" "Rifampicin"
"Pseudomonas akapageensis" "Rokitamycin"
"Pseudomonas akapageensis" "Roxithromycin"
"Pseudomonas akapageensis" "Solithromycin"
"Pseudomonas akapageensis" "Spiramycin"
"Pseudomonas akapageensis" "Teicoplanin"
"Pseudomonas akapageensis" "Thiacetazone"
"Pseudomonas akapageensis" "Tilmicosin"
"Pseudomonas akapageensis" "Tildipirosin"
"Pseudomonas akapageensis" "Telithromycin"
"Pseudomonas akapageensis" "Telavancin"
"Pseudomonas akapageensis" "Troleandomycin"
"Pseudomonas akapageensis" "Tulathromycin"
"Pseudomonas akapageensis" "Tylosin"
"Pseudomonas akapageensis" "Tylvalosin"
"Pseudomonas akapageensis" "Tedizolid"
"Pseudomonas akapageensis" "Vancomycin"
"Pseudomonas akapageensis" "Nafithromycin"
"Pseudomonas alcaligenes" "Acetylmidecamycin"
"Pseudomonas alcaligenes" "Acetylspiramycin"
"Pseudomonas alcaligenes" "Avoparcin"
@ -114794,36 +114639,6 @@
"Sanguibacter suarezii" "Nalidixic acid"
"Sanguibacter suarezii" "Polymyxin B"
"Sanguibacter suarezii" "Temocillin"
"Sanguibacteraceae" "Aztreonam"
"Sanguibacteraceae" "Colistin"
"Sanguibacteraceae" "Nalidixic acid"
"Sanguibacteraceae" "Polymyxin B"
"Sanguibacteraceae" "Temocillin"
"Sapromyces" "Aztreonam"
"Sapromyces" "Colistin"
"Sapromyces" "Nalidixic acid"
"Sapromyces" "Polymyxin B"
"Sapromyces" "Temocillin"
"Sapromyces androgynus" "Aztreonam"
"Sapromyces androgynus" "Colistin"
"Sapromyces androgynus" "Nalidixic acid"
"Sapromyces androgynus" "Polymyxin B"
"Sapromyces androgynus" "Temocillin"
"Sapromyces dubius" "Aztreonam"
"Sapromyces dubius" "Colistin"
"Sapromyces dubius" "Nalidixic acid"
"Sapromyces dubius" "Polymyxin B"
"Sapromyces dubius" "Temocillin"
"Sapromyces elongatus" "Aztreonam"
"Sapromyces elongatus" "Colistin"
"Sapromyces elongatus" "Nalidixic acid"
"Sapromyces elongatus" "Polymyxin B"
"Sapromyces elongatus" "Temocillin"
"Sapromyces indicus" "Aztreonam"
"Sapromyces indicus" "Colistin"
"Sapromyces indicus" "Nalidixic acid"
"Sapromyces indicus" "Polymyxin B"
"Sapromyces indicus" "Temocillin"
"Sarcina" "Aztreonam"
"Sarcina" "Colistin"
"Sarcina" "Nalidixic acid"
@ -120612,38 +120427,6 @@
"Streptococcus caprae" "Streptomycin"
"Streptococcus caprae" "Temocillin"
"Streptococcus caprae" "Tobramycin"
"Streptococcus casseliflavus" "Amikacin/fosfomycin"
"Streptococcus casseliflavus" "Amikacin"
"Streptococcus casseliflavus" "Apramycin"
"Streptococcus casseliflavus" "Arbekacin"
"Streptococcus casseliflavus" "Astromicin"
"Streptococcus casseliflavus" "Aztreonam"
"Streptococcus casseliflavus" "Bekanamycin"
"Streptococcus casseliflavus" "Ceftazidime"
"Streptococcus casseliflavus" "Colistin"
"Streptococcus casseliflavus" "Dibekacin"
"Streptococcus casseliflavus" "Framycetin"
"Streptococcus casseliflavus" "Fusidic acid"
"Streptococcus casseliflavus" "Gentamicin"
"Streptococcus casseliflavus" "Habekacin"
"Streptococcus casseliflavus" "Hygromycin"
"Streptococcus casseliflavus" "Isepamicin"
"Streptococcus casseliflavus" "Kanamycin/cephalexin"
"Streptococcus casseliflavus" "Kanamycin"
"Streptococcus casseliflavus" "Micronomicin"
"Streptococcus casseliflavus" "Nalidixic acid"
"Streptococcus casseliflavus" "Neomycin"
"Streptococcus casseliflavus" "Netilmicin"
"Streptococcus casseliflavus" "Pentisomicin"
"Streptococcus casseliflavus" "Propikacin"
"Streptococcus casseliflavus" "Polymyxin B"
"Streptococcus casseliflavus" "Plazomicin"
"Streptococcus casseliflavus" "Ribostamycin"
"Streptococcus casseliflavus" "Sisomicin"
"Streptococcus casseliflavus" "Streptoduocin"
"Streptococcus casseliflavus" "Streptomycin"
"Streptococcus casseliflavus" "Temocillin"
"Streptococcus casseliflavus" "Tobramycin"
"Streptococcus castoreus" "Amikacin/fosfomycin"
"Streptococcus castoreus" "Amikacin"
"Streptococcus castoreus" "Apramycin"
@ -124918,11 +124701,6 @@
"Streptomyces albospinus" "Nalidixic acid"
"Streptomyces albospinus" "Polymyxin B"
"Streptomyces albospinus" "Temocillin"
"Streptomyces albosporeus albosporeus" "Aztreonam"
"Streptomyces albosporeus albosporeus" "Colistin"
"Streptomyces albosporeus albosporeus" "Nalidixic acid"
"Streptomyces albosporeus albosporeus" "Polymyxin B"
"Streptomyces albosporeus albosporeus" "Temocillin"
"Streptomyces albosporeus labilomyceticus" "Aztreonam"
"Streptomyces albosporeus labilomyceticus" "Colistin"
"Streptomyces albosporeus labilomyceticus" "Nalidixic acid"
@ -125468,11 +125246,6 @@
"Streptomyces cavourensis" "Nalidixic acid"
"Streptomyces cavourensis" "Polymyxin B"
"Streptomyces cavourensis" "Temocillin"
"Streptomyces cavourensis cavourensis" "Aztreonam"
"Streptomyces cavourensis cavourensis" "Colistin"
"Streptomyces cavourensis cavourensis" "Nalidixic acid"
"Streptomyces cavourensis cavourensis" "Polymyxin B"
"Streptomyces cavourensis cavourensis" "Temocillin"
"Streptomyces cellostaticus" "Aztreonam"
"Streptomyces cellostaticus" "Colistin"
"Streptomyces cellostaticus" "Nalidixic acid"
@ -125548,11 +125321,6 @@
"Streptomyces chryseus" "Nalidixic acid"
"Streptomyces chryseus" "Polymyxin B"
"Streptomyces chryseus" "Temocillin"
"Streptomyces chrysomallus chrysomallus" "Aztreonam"
"Streptomyces chrysomallus chrysomallus" "Colistin"
"Streptomyces chrysomallus chrysomallus" "Nalidixic acid"
"Streptomyces chrysomallus chrysomallus" "Polymyxin B"
"Streptomyces chrysomallus chrysomallus" "Temocillin"
"Streptomyces chrysomallus fumigatus" "Aztreonam"
"Streptomyces chrysomallus fumigatus" "Colistin"
"Streptomyces chrysomallus fumigatus" "Nalidixic acid"
@ -125613,11 +125381,6 @@
"Streptomyces cinnamoneus albosporus" "Nalidixic acid"
"Streptomyces cinnamoneus albosporus" "Polymyxin B"
"Streptomyces cinnamoneus albosporus" "Temocillin"
"Streptomyces cinnamoneus cinnamoneus" "Aztreonam"
"Streptomyces cinnamoneus cinnamoneus" "Colistin"
"Streptomyces cinnamoneus cinnamoneus" "Nalidixic acid"
"Streptomyces cinnamoneus cinnamoneus" "Polymyxin B"
"Streptomyces cinnamoneus cinnamoneus" "Temocillin"
"Streptomyces cirratus" "Aztreonam"
"Streptomyces cirratus" "Colistin"
"Streptomyces cirratus" "Nalidixic acid"
@ -126088,11 +125851,6 @@
"Streptomyces globisporus" "Nalidixic acid"
"Streptomyces globisporus" "Polymyxin B"
"Streptomyces globisporus" "Temocillin"
"Streptomyces globisporus globisporus" "Aztreonam"
"Streptomyces globisporus globisporus" "Colistin"
"Streptomyces globisporus globisporus" "Nalidixic acid"
"Streptomyces globisporus globisporus" "Polymyxin B"
"Streptomyces globisporus globisporus" "Temocillin"
"Streptomyces globosus" "Aztreonam"
"Streptomyces globosus" "Colistin"
"Streptomyces globosus" "Nalidixic acid"
@ -126233,11 +125991,6 @@
"Streptomyces griseus" "Nalidixic acid"
"Streptomyces griseus" "Polymyxin B"
"Streptomyces griseus" "Temocillin"
"Streptomyces griseus griseus" "Aztreonam"
"Streptomyces griseus griseus" "Colistin"
"Streptomyces griseus griseus" "Nalidixic acid"
"Streptomyces griseus griseus" "Polymyxin B"
"Streptomyces griseus griseus" "Temocillin"
"Streptomyces guanduensis" "Aztreonam"
"Streptomyces guanduensis" "Colistin"
"Streptomyces guanduensis" "Nalidixic acid"
@ -126608,11 +126361,6 @@
"Streptomyces lavendulae grasserius" "Nalidixic acid"
"Streptomyces lavendulae grasserius" "Polymyxin B"
"Streptomyces lavendulae grasserius" "Temocillin"
"Streptomyces lavendulae lavendulae" "Aztreonam"
"Streptomyces lavendulae lavendulae" "Colistin"
"Streptomyces lavendulae lavendulae" "Nalidixic acid"
"Streptomyces lavendulae lavendulae" "Polymyxin B"
"Streptomyces lavendulae lavendulae" "Temocillin"
"Streptomyces lavenduligriseus" "Aztreonam"
"Streptomyces lavenduligriseus" "Colistin"
"Streptomyces lavenduligriseus" "Nalidixic acid"
@ -127883,11 +127631,6 @@
"Streptomyces thermoviolaceus apingens" "Nalidixic acid"
"Streptomyces thermoviolaceus apingens" "Polymyxin B"
"Streptomyces thermoviolaceus apingens" "Temocillin"
"Streptomyces thermoviolaceus thermoviolaceus" "Aztreonam"
"Streptomyces thermoviolaceus thermoviolaceus" "Colistin"
"Streptomyces thermoviolaceus thermoviolaceus" "Nalidixic acid"
"Streptomyces thermoviolaceus thermoviolaceus" "Polymyxin B"
"Streptomyces thermoviolaceus thermoviolaceus" "Temocillin"
"Streptomyces thermovulgaris" "Aztreonam"
"Streptomyces thermovulgaris" "Colistin"
"Streptomyces thermovulgaris" "Nalidixic acid"
@ -128463,36 +128206,11 @@
"Streptoverticillium" "Nalidixic acid"
"Streptoverticillium" "Polymyxin B"
"Streptoverticillium" "Temocillin"
"Streptoverticillium cinnamoneum lanosum" "Aztreonam"
"Streptoverticillium cinnamoneum lanosum" "Colistin"
"Streptoverticillium cinnamoneum lanosum" "Nalidixic acid"
"Streptoverticillium cinnamoneum lanosum" "Polymyxin B"
"Streptoverticillium cinnamoneum lanosum" "Temocillin"
"Streptoverticillium cinnamoneum sparsum" "Aztreonam"
"Streptoverticillium cinnamoneum sparsum" "Colistin"
"Streptoverticillium cinnamoneum sparsum" "Nalidixic acid"
"Streptoverticillium cinnamoneum sparsum" "Polymyxin B"
"Streptoverticillium cinnamoneum sparsum" "Temocillin"
"Streptoverticillium olivoreticuli olivoreticuli" "Aztreonam"
"Streptoverticillium olivoreticuli olivoreticuli" "Colistin"
"Streptoverticillium olivoreticuli olivoreticuli" "Nalidixic acid"
"Streptoverticillium olivoreticuli olivoreticuli" "Polymyxin B"
"Streptoverticillium olivoreticuli olivoreticuli" "Temocillin"
"Streptoverticillium reticulum protomycicum" "Aztreonam"
"Streptoverticillium reticulum protomycicum" "Colistin"
"Streptoverticillium reticulum protomycicum" "Nalidixic acid"
"Streptoverticillium reticulum protomycicum" "Polymyxin B"
"Streptoverticillium reticulum protomycicum" "Temocillin"
"Streptoverticillium verticillium quintum" "Aztreonam"
"Streptoverticillium verticillium quintum" "Colistin"
"Streptoverticillium verticillium quintum" "Nalidixic acid"
"Streptoverticillium verticillium quintum" "Polymyxin B"
"Streptoverticillium verticillium quintum" "Temocillin"
"Streptoverticillium verticillium tsukushiense" "Aztreonam"
"Streptoverticillium verticillium tsukushiense" "Colistin"
"Streptoverticillium verticillium tsukushiense" "Nalidixic acid"
"Streptoverticillium verticillium tsukushiense" "Polymyxin B"
"Streptoverticillium verticillium tsukushiense" "Temocillin"
"Streptoverticillium cinnamoneum" "Aztreonam"
"Streptoverticillium cinnamoneum" "Colistin"
"Streptoverticillium cinnamoneum" "Nalidixic acid"
"Streptoverticillium cinnamoneum" "Polymyxin B"
"Streptoverticillium cinnamoneum" "Temocillin"
"Subdoligranulum" "Aztreonam"
"Subdoligranulum" "Colistin"
"Subdoligranulum" "Nalidixic acid"
@ -129109,11 +128827,6 @@
"Tatumella terrea" "Tedizolid"
"Tatumella terrea" "Vancomycin"
"Tatumella terrea" "Nafithromycin"
"Tenericutes" "Aztreonam"
"Tenericutes" "Colistin"
"Tenericutes" "Nalidixic acid"
"Tenericutes" "Polymyxin B"
"Tenericutes" "Temocillin"
"Tenggerimyces" "Aztreonam"
"Tenggerimyces" "Colistin"
"Tenggerimyces" "Nalidixic acid"
@ -130753,11 +130466,6 @@
"Tropheryma whipplei" "Nalidixic acid"
"Tropheryma whipplei" "Polymyxin B"
"Tropheryma whipplei" "Temocillin"
"Tropherymataceae" "Aztreonam"
"Tropherymataceae" "Colistin"
"Tropherymataceae" "Nalidixic acid"
"Tropherymataceae" "Polymyxin B"
"Tropherymataceae" "Temocillin"
"Tropicihabitans" "Aztreonam"
"Tropicihabitans" "Colistin"
"Tropicihabitans" "Nalidixic acid"
@ -133267,11 +132975,6 @@
"Yaniella soli" "Nalidixic acid"
"Yaniella soli" "Polymyxin B"
"Yaniella soli" "Temocillin"
"Yaniellaceae" "Aztreonam"
"Yaniellaceae" "Colistin"
"Yaniellaceae" "Nalidixic acid"
"Yaniellaceae" "Polymyxin B"
"Yaniellaceae" "Temocillin"
"Yersinia" "Acetylmidecamycin"
"Yersinia" "Acetylspiramycin"
"Yersinia" "Avoparcin"

BIN
data-raw/intrinsic_resistant.xlsx
View File

Binary file not shown.

10
data-raw/loinc.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

BIN
data-raw/microorganisms.dta
View File

Binary file not shown.

BIN
data-raw/microorganisms.feather
View File

Binary file not shown.

2
data-raw/microorganisms.md5
View File

@ -1 +1 @@
4108363bb220b8f85ab924afb8ffbbcf
5ac1152c166d5d4f5763547d948fce79

BIN
data-raw/microorganisms.old.dta
View File

Binary file not shown.

BIN
data-raw/microorganisms.old.feather
View File

Binary file not shown.

1
data-raw/microorganisms.old.md5
View File

@ -1 +0,0 @@
b57c9cc7380a233a2616a80e8e904a81

BIN
data-raw/microorganisms.old.parquet
View File

Binary file not shown.

BIN
data-raw/microorganisms.old.rds
View File

Binary file not shown.

BIN
data-raw/microorganisms.old.sas
View File

Binary file not shown.

BIN
data-raw/microorganisms.old.sav
View File

Binary file not shown.

14339
data-raw/microorganisms.old.txt
View File

File diff suppressed because it is too large Load Diff

BIN
data-raw/microorganisms.old.xlsx
View File

Binary file not shown.

BIN
data-raw/microorganisms.parquet
View File

Binary file not shown.

BIN
data-raw/microorganisms.rds
View File

Binary file not shown.

BIN
data-raw/microorganisms.sas
View File

Binary file not shown.

BIN
data-raw/microorganisms.sav
View File

Binary file not shown.

BIN
data-raw/microorganisms.translation.rds
View File

Binary file not shown.

70856
data-raw/microorganisms.txt
View File

File diff suppressed because it is too large Load Diff

BIN
data-raw/microorganisms.xlsx
View File

Binary file not shown.

10
data-raw/poorman_prepend.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

16
data-raw/read_EUCAST.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
@ -103,9 +107,9 @@ read_EUCAST <- function(sheet, file, guideline_name) {
get_mo <- function(x) {
for (i in seq_len(length(x))) {
y <- trimws(unlist(strsplit(x[i], "(,|and)")))
y <- trimws(gsub("[(].*[)]", "", y))
y <- suppressWarnings(suppressMessages(as.mo(y, allow_uncertain = FALSE)))
y <- trimws2(unlist(strsplit(x[i], "(,|and)")))
y <- trimws2(gsub("[(].*[)]", "", y))
y <- suppressWarnings(suppressMessages(as.mo(y)))
if (!is.null(mo_uncertainties())) uncertainties <<- add_uncertainties(uncertainties, mo_uncertainties())
y <- y[!is.na(y) & y != "UNKNOWN"]
x[i] <- paste(y, collapse = "|")

10
data-raw/reproduction_of_antibiotics.R
View File

@ -1,12 +1,16 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# AMR: An R Package for Working with Antimicrobial Resistance Data #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2022 Berends MS, Luz CF et al. #
# CITE AS #
# Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C #
# (2022). AMR: An R Package for Working with Antimicrobial Resistance #
# Data. Journal of Statistical Software, 104(3), 1-31. #
# doi:10.18637/jss.v104.i03 #
# #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #

Some files were not shown because too many files have changed in this diff Show More