P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

(v1.6.0.9031) tinytest unit tests

This commit is contained in:
dr. M.S. (Matthijs) Berends 2021-05-15 21:36:22 +02:00
parent 9a381c8d18
commit d8c91d5876
71 changed files with 2671 additions and 2901 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
.github/workflows/check.yaml vendored
View File

@ -81,7 +81,7 @@ jobs:
- {os: ubuntu-16.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
env:
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
RSPM: ${{ matrix.config.rspm }}
@ -93,29 +93,14 @@ jobs:
with:
r-version: ${{ matrix.config.r }}
- uses: r-lib/actions/setup-pandoc@master
# - uses: r-lib/actions/setup-pandoc@master
- name: Install remotes package
if: matrix.config.r != '3.0'
run: |
install.packages('remotes')
shell: Rscript {0}
- name: Query dependencies
if: matrix.config.r != '3.0'
run: |
saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
shell: Rscript {0}
# - name: Query dependencies
# if: matrix.config.r != '3.0'
# run: |
# saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
# shell: Rscript {0}
- name: Cache R packages
if: runner.os != 'Windows' && matrix.config.r != '3.0'
# && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
uses: actions/cache@v1
with:
path: ${{ env.R_LIBS_USER }}
key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('.github/depends.Rds') }}
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-
- name: Install Linux dependencies
if: runner.os == 'Linux'
# update the below with sysreqs::sysreqs("DESCRIPTION") and check the "DEB" entries (for Ubuntu).
@ -123,11 +108,18 @@ jobs:
run: |
sudo apt install -y libssl-dev pandoc pandoc-citeproc libxml2-dev libicu-dev libcurl4-openssl-dev
- name: Update package dependencies using remotes package
if: matrix.config.r != '3.0'
- name: Update package dependencies
run: |
remotes::install_deps(dependencies = TRUE)
source("data-raw/_install_deps.R")
shell: Rscript {0}
- name: Cache R packages
# if: runner.os != 'Windows'
uses: actions/cache@v1
with:
path: ${{ env.R_LIBS_USER }}
key: ${{ matrix.config.os }}-r-${{ matrix.config.r }} # -${{ hashFiles('.github/depends.Rds') }}
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}
- name: Session info
run: |
@ -145,12 +137,13 @@ jobs:
_R_CHECK_LENGTH_1_CONDITION_: verbose
_R_CHECK_LENGTH_1_LOGIC2_: verbose
R_LIBS_USER: ${{ env.R_LIBS_USER }}
R_TINYTEST: true
run: |
tar -xf data-raw/AMR_latest.tar.gz
rm -rf AMR/vignettes
R CMD check AMR
shell: bash
- name: Run R CMD check on Linux and macOS
if: runner.os != 'Windows'
env:
@ -160,6 +153,7 @@ jobs:
_R_CHECK_LENGTH_1_CONDITION_: verbose
_R_CHECK_LENGTH_1_LOGIC2_: verbose
R_LIBS_USER: ${{ env.R_LIBS_USER }}
R_TINYTEST: true
run: |
tar -xf data-raw/AMR_latest.tar.gz
rm -rf AMR/vignettes

8
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.6.0.9030
Date: 2021-05-13
Version: 1.6.0.9031
Date: 2021-05-15
Title: Antimicrobial Resistance Data Analysis
Authors@R: c(
person(role = c("aut", "cre"),
@ -55,9 +55,9 @@ Suggests:
rstudioapi,
rvest,
skimr,
testthat,
tidyr,
xml2
tinytest,
xml2,
VignetteBuilder: knitr,rmarkdown
URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR
BugReports: https://github.com/msberends/AMR/issues

9
NEWS.md
View File

@ -1,5 +1,5 @@
# `AMR` 1.6.0.9030
## <small>Last updated: 13 May 2021</small>
# `AMR` 1.6.0.9031
## <small>Last updated: 15 May 2021</small>
### New
* Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()`
@ -32,7 +32,7 @@
* Altered the RStudio addin, so it now iterates over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%` if you keep pressing your keyboard shortcut
* Fixed an installation error on R-3.0
* Added `info` argument to `as.mo()` to turn on/off the progress bar
* Fixed a bug that `col_mo` for some functions (esp. `eucast_rules()` and `mdro()`) could not be column names of the `microorganisms` data set as it would throw an error
* Fixed a bug where `col_mo` in some functions (esp. `eucast_rules()` and `mdro()`) could not be a column name of the `microorganisms` data set as it would throw an error
* Fix for transforming numeric values to RSI (`as.rsi()`) when the `vctrs` package is loaded (i.e., when using tidyverse)
* Colour fix for using `barplot()` on an RSI class
* Added 25 common system codes for bacteria to the `microorganisms.codes` data set
@ -42,6 +42,9 @@
* Fix for plotting missing MIC/disk diffusion values
* Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables
### Other
* All unit tests are now processed by the `tinytest` package, instead of the `testthat` package. The `testthat` package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the `tinytest` package is very lightweight and dependency-free.
# `AMR` 1.6.0

BIN
data-raw/AMR_latest.tar.gz
View File

Binary file not shown.

47
data-raw/_install_deps.R Normal file
View File

@ -0,0 +1,47 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
pkg_suggests <- trimws(unlist(strsplit(packageDescription("AMR")$Suggests, ",(\n)?")))
to_install <- pkg_suggests[!pkg_suggests %in% rownames(utils::installed.packages())]
to_update <- as.data.frame(old.packages(), stringsAsFactors = FALSE)
for (i in seq_len(length(to_install))) {
cat("Installing package", to_install[i], "\n")
tryCatch(install.packages(to_install[i], repos = "https://cran.rstudio.com/", dependencies = TRUE, quiet = TRUE),
message = function(m) invisible(),
warning = function(w) message(w$message),
error = function(e) message(e$message))
}
for (i in seq_len(length(to_update))) {
cat("Updating package", to_install[i], "\n")
tryCatch(update.packages(to_update[i], repos = "https://cran.rstudio.com/", ask = FALSE),
message = function(m) invisible(),
warning = function(w) message(w$message),
error = function(e) message(e$message))
}
# saveRDS(to_update, ".github/depends.Rds", version = 2)

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

2
docs/index.html
View File

@ -42,7 +42,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

85
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>
@ -236,12 +236,12 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1609030" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9030">
<a href="#amr-1609030" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9030</h1>
<div id="last-updated-13-may-2021" class="section level2">
<div id="amr-1609031" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9031">
<a href="#amr-1609031" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9031</h1>
<div id="last-updated-15-may-2021" class="section level2">
<h2 class="hasAnchor">
<a href="#last-updated-13-may-2021" class="anchor"></a><small>Last updated: 13 May 2021</small>
<a href="#last-updated-15-may-2021" class="anchor"></a><small>Last updated: 15 May 2021</small>
</h2>
<div id="new" class="section level3">
<h3 class="hasAnchor">
@ -297,7 +297,7 @@
</li>
<li>Fixed an installation error on R-3.0</li>
<li>Added <code>info</code> argument to <code><a href="../reference/as.mo.html">as.mo()</a></code> to turn on/off the progress bar</li>
<li>Fixed a bug that <code>col_mo</code> for some functions (esp. <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code> and <code><a href="../reference/mdro.html">mdro()</a></code>) could not be column names of the <code>microorganisms</code> data set as it would throw an error</li>
<li>Fixed a bug where <code>col_mo</code> in some functions (esp. <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code> and <code><a href="../reference/mdro.html">mdro()</a></code>) could not be a column name of the <code>microorganisms</code> data set as it would throw an error</li>
<li>Fix for transforming numeric values to RSI (<code><a href="../reference/as.rsi.html">as.rsi()</a></code>) when the <code>vctrs</code> package is loaded (i.e., when using tidyverse)</li>
<li>Colour fix for using <code><a href="https://rdrr.io/r/graphics/barplot.html">barplot()</a></code> on an RSI class</li>
<li>Added 25 common system codes for bacteria to the <code>microorganisms.codes</code> data set</li>
@ -308,6 +308,13 @@
<li>Updated join functions to always use <code>dplyr</code> join functions if the <code>dplyr</code> package is installed - now also preserving grouped variables</li>
</ul>
</div>
<div id="other" class="section level3">
<h3 class="hasAnchor">
<a href="#other" class="anchor"></a>Other</h3>
<ul>
<li>All unit tests are now processed by the <code>tinytest</code> package, instead of the <code>testthat</code> package. The <code>testthat</code> package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the <code>tinytest</code> package is very lightweight and dependency-free.</li>
</ul>
</div>
</div>
</div>
<div id="amr-160" class="section level1">
@ -438,9 +445,9 @@
<li>Added argument <code>include_untested_rsi</code> to the <code><a href="../reference/first_isolate.html">first_isolate()</a></code> functions (defaults to <code>TRUE</code> to keep existing behaviour), to be able to exclude rows where all R/SI values (class <code>&lt;rsi&gt;</code>, see <code><a href="../reference/as.rsi.html">as.rsi()</a></code>) are empty</li>
</ul>
</div>
<div id="other" class="section level3">
<div id="other-1" class="section level3">
<h3 class="hasAnchor">
<a href="#other" class="anchor"></a>Other</h3>
<a href="#other-1" class="anchor"></a>Other</h3>
<ul>
<li>Big documentation updates</li>
<li>Loading the package (i.e., <code><a href="https://msberends.github.io/AMR/">library(AMR)</a></code>) now is ~50 times faster than before, in costs of package size (which increased by ~3 MB)</li>
@ -545,9 +552,9 @@
<li><p>If <code><a href="../reference/as.mo.html">as.mo()</a></code> takes more than 30 seconds, some suggestions will be done to improve speed</p></li>
</ul>
</div>
<div id="other-1" class="section level3">
<div id="other-2" class="section level3">
<h3 class="hasAnchor">
<a href="#other-1" class="anchor"></a>Other</h3>
<a href="#other-2" class="anchor"></a>Other</h3>
<ul>
<li>All messages and warnings thrown by this package now break sentences on whole words</li>
<li>More extensive unit tests</li>
@ -652,9 +659,9 @@
<li><p>Added argument <code>excess</code> to the <code><a href="../reference/kurtosis.html">kurtosis()</a></code> function (defaults to <code>FALSE</code>), to return the <em>excess kurtosis</em>, defined as the kurtosis minus three.</p></li>
</ul>
</div>
<div id="other-2" class="section level3">
<div id="other-3" class="section level3">
<h3 class="hasAnchor">
<a href="#other-2" class="anchor"></a>Other</h3>
<a href="#other-3" class="anchor"></a>Other</h3>
<ul>
<li>Removed functions <code>portion_R()</code>, <code>portion_S()</code> and <code>portion_I()</code> that were deprecated since version 0.9.0 (November 2019) and were replaced with <code><a href="../reference/proportion.html">proportion_R()</a></code>, <code><a href="../reference/proportion.html">proportion_S()</a></code> and <code><a href="../reference/proportion.html">proportion_I()</a></code>
</li>
@ -737,9 +744,9 @@
<li><p>Fixed a bug where <code><a href="../reference/as.mic.html">as.mic()</a></code> could not handle dots without a leading zero (like <code>"&lt;=.25</code>)</p></li>
</ul>
</div>
<div id="other-3" class="section level3">
<div id="other-4" class="section level3">
<h3 class="hasAnchor">
<a href="#other-3" class="anchor"></a>Other</h3>
<a href="#other-4" class="anchor"></a>Other</h3>
<ul>
<li>Moved primary location of this project from GitLab to <a href="https://github.com/msberends/AMR">GitHub</a>, giving us native support for automated syntax checking without being dependent on external services such as AppVeyor and Travis CI.</li>
</ul>
@ -798,9 +805,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>Added abbreviation “cfsc” for Cefoxitin and “cfav” for Ceftazidime/avibactam</li>
</ul>
</div>
<div id="other-4" class="section level3">
<div id="other-5" class="section level3">
<h3 class="hasAnchor">
<a href="#other-4" class="anchor"></a>Other</h3>
<a href="#other-5" class="anchor"></a>Other</h3>
<ul>
<li>Removed previously deprecated function <code>p.symbol()</code> - it was replaced with <code><a href="../reference/AMR-deprecated.html">p_symbol()</a></code>
</li>
@ -839,9 +846,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>Added generic CLSI rules for R/SI interpretation using <code><a href="../reference/as.rsi.html">as.rsi()</a></code> for years 2010-2019 (thanks to Anthony Underwood)</li>
</ul>
</div>
<div id="other-5" class="section level3">
<div id="other-6" class="section level3">
<h3 class="hasAnchor">
<a href="#other-5" class="anchor"></a>Other</h3>
<a href="#other-6" class="anchor"></a>Other</h3>
<ul>
<li>Support for the upcoming <code>dplyr</code> version 1.0.0</li>
<li>More robust assigning for classes <code>rsi</code> and <code>mic</code>
@ -941,9 +948,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
</li>
</ul>
</div>
<div id="other-6" class="section level3">
<div id="other-7" class="section level3">
<h3 class="hasAnchor">
<a href="#other-6" class="anchor"></a>Other</h3>
<a href="#other-7" class="anchor"></a>Other</h3>
<ul>
<li>Add a <code>CITATION</code> file</li>
<li>Full support for the upcoming R 4.0</li>
@ -1048,9 +1055,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
</li>
</ul>
</div>
<div id="other-7" class="section level3">
<div id="other-8" class="section level3">
<h3 class="hasAnchor">
<a href="#other-7" class="anchor"></a>Other</h3>
<a href="#other-8" class="anchor"></a>Other</h3>
<ul>
<li>Rewrote the complete documentation to markdown format, to be able to use the very latest version of the great <a href="https://roxygen2.r-lib.org/index.html">Roxygen2</a>, released in November 2019. This tremously improved the documentation quality, since the rewrite forced us to go over all texts again and make changes where needed.</li>
<li>Change dependency on <code>clean</code> to <code>cleaner</code>, as this package was renamed accordingly upon CRAN request</li>
@ -1213,9 +1220,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
</li>
<li>Added more MIC factor levels (<code><a href="../reference/as.mic.html">as.mic()</a></code>)</li>
</ul>
<div id="other-8" class="section level4">
<div id="other-9" class="section level4">
<h4 class="hasAnchor">
<a href="#other-8" class="anchor"></a>Other</h4>
<a href="#other-9" class="anchor"></a>Other</h4>
<ul>
<li>Added Prof. Dr. Casper Albers as doctoral advisor and added Dr. Judith Fonville, Eric Hazenberg, Dr. Bart Meijer, Dr. Dennis Souverein and Annick Lenglet as contributors</li>
<li>Cleaned the coding style of every single syntax line in this package with the help of the <code>lintr</code> package</li>
@ -1299,9 +1306,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
</li>
</ul>
</div>
<div id="other-9" class="section level4">
<div id="other-10" class="section level4">
<h4 class="hasAnchor">
<a href="#other-9" class="anchor"></a>Other</h4>
<a href="#other-10" class="anchor"></a>Other</h4>
<ul>
<li>Fixed a note thrown by CRAN tests</li>
</ul>
@ -1394,9 +1401,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>Fix for <code><a href="../reference/mo_property.html">mo_shortname()</a></code> where species would not be determined correctly</li>
</ul>
</div>
<div id="other-10" class="section level4">
<div id="other-11" class="section level4">
<h4 class="hasAnchor">
<a href="#other-10" class="anchor"></a>Other</h4>
<a href="#other-11" class="anchor"></a>Other</h4>
<ul>
<li>Support for R 3.6.0 and later by providing support for <a href="https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html">staged install</a>
</li>
@ -1659,9 +1666,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>if using different lengths of pattern and x in <code><a href="../reference/like.html">%like%</a></code>, it will now return the call</li>
</ul>
</div>
<div id="other-11" class="section level4">
<div id="other-12" class="section level4">
<h4 class="hasAnchor">
<a href="#other-11" class="anchor"></a>Other</h4>
<a href="#other-12" class="anchor"></a>Other</h4>
<ul>
<li>Updated licence text to emphasise GPL 2.0 and that this is an R package.</li>
</ul>
@ -1780,9 +1787,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li><p>Percentages will now will rounded more logically (e.g. in <code>freq</code> function)</p></li>
</ul>
</div>
<div id="other-12" class="section level4">
<div id="other-13" class="section level4">
<h4 class="hasAnchor">
<a href="#other-12" class="anchor"></a>Other</h4>
<a href="#other-13" class="anchor"></a>Other</h4>
<ul>
<li>New dependency on package <code>crayon</code>, to support formatted text in the console</li>
<li>Dependency <code>tidyr</code> is now mandatory (went to <code>Import</code> field) since <code>portion_df</code> and <code>count_df</code> rely on it</li>
@ -1930,9 +1937,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
</li>
</ul>
</div>
<div id="other-13" class="section level4">
<div id="other-14" class="section level4">
<h4 class="hasAnchor">
<a href="#other-13" class="anchor"></a>Other</h4>
<a href="#other-14" class="anchor"></a>Other</h4>
<ul>
<li>More unit tests to ensure better integrity of functions</li>
</ul>
@ -2058,9 +2065,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>Other small fixes</li>
</ul>
</div>
<div id="other-14" class="section level4">
<div id="other-15" class="section level4">
<h4 class="hasAnchor">
<a href="#other-14" class="anchor"></a>Other</h4>
<a href="#other-15" class="anchor"></a>Other</h4>
<ul>
<li>Added integration tests (check if everything works as expected) for all releases of R 3.1 and higher
<ul>
@ -2119,9 +2126,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
<li>Functions <code>as.rsi</code> and <code>as.mic</code> now add the package name and version as attributes</li>
</ul>
</div>
<div id="other-15" class="section level4">
<div id="other-16" class="section level4">
<h4 class="hasAnchor">
<a href="#other-15" class="anchor"></a>Other</h4>
<a href="#other-16" class="anchor"></a>Other</h4>
<ul>
<li>Expanded <code>README.md</code> with more examples</li>
<li>Added <a href="https://orcid.org">ORCID</a> of authors to DESCRIPTION file</li>

2
docs/pkgdown.yml
View File

@ -12,7 +12,7 @@ articles:
datasets: datasets.html
resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html
last_built: 2021-05-13T21:04Z
last_built: 2021-05-15T19:35Z
urls:
reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles

2
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9030</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9031</span>
</span>
</div>

39
inst/tinytest/test-_deprecated.R Normal file
View File

@ -0,0 +1,39 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_identical(suppressWarnings(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3))),
c("***", "**", "*", ".", " ", NA, NA))
expect_warning(key_antibiotics(example_isolates))
expect_identical(suppressWarnings(key_antibiotics(example_isolates)),
key_antimicrobials(example_isolates, antifungal = NULL))
expect_warning(key_antibiotics_equal("S", "S"))
expect_identical(suppressWarnings(key_antibiotics_equal("S", "S")),
antimicrobials_equal("S", "S", type = "keyantimicrobials"))
expect_warning(filter_first_weighted_isolate(example_isolates))
expect_identical(suppressWarnings(filter_first_weighted_isolate(example_isolates)),
filter_first_isolate(example_isolates))

59
tests/testthat/test-_misc.R → inst/tinytest/test-_misc.R
View File

@ -22,47 +22,34 @@
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("aa_helper_functions.R")
test_that("percentages works", {
skip_on_cran()
expect_equal(percentage(0.25), "25%")
expect_equal(percentage(0.5), "50%")
expect_equal(percentage(0.500, digits = 1), "50.0%")
expect_equal(percentage(0.1234), "12.3%")
expect_equal(percentage(0.25), "25%")
expect_equal(percentage(0.5), "50%")
expect_equal(percentage(0.500, digits = 1), "50.0%")
expect_equal(percentage(0.1234), "12.3%")
# round up 0.5
expect_equal(percentage(0.0054), "0.5%")
expect_equal(percentage(0.0055), "0.6%")
})
test_that("functions missing in older R versions work", {
skip_on_cran()
expect_equal(strrep("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test")
})
test_that("looking up ab columns works", {
skip_on_cran()
expect_warning(generate_warning_abs_missing(c("AMP", "AMX")))
expect_warning(generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE))
expect_warning(get_column_abx(example_isolates, hard_dependencies = "FUS"))
expect_message(get_column_abx(example_isolates, soft_dependencies = "FUS"))
expect_equal(percentage(0.0054), "0.5%")
expect_equal(percentage(0.0055), "0.6%")
expect_equal(strrep("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test")
expect_warning(generate_warning_abs_missing(c("AMP", "AMX")))
expect_warning(generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE))
expect_warning(get_column_abx(example_isolates, hard_dependencies = "FUS"))
expect_message(get_column_abx(example_isolates, soft_dependencies = "FUS"))
if (suppressWarnings(require("dplyr"))) {
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
}
})
test_that("looking up ab columns works", {
skip_on_cran()
# we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this:
if (suppressWarnings(require("dplyr"))) {
expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
}
})

67
tests/testthat/test-join_microorganisms.R → inst/tinytest/test-ab.R
View File

@ -23,41 +23,50 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("join_microorganisms.R")
expect_equal(as.character(as.ab(c("J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
" eryt 123",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"))),
rep("ERY", 10))
test_that("joins work", {
skip_on_cran()
unjoined <- example_isolates
inner <- example_isolates %>% inner_join_microorganisms()
left <- example_isolates %>% left_join_microorganisms()
semi <- example_isolates %>% semi_join_microorganisms()
anti <- example_isolates %>% anti_join_microorganisms()
suppressWarnings(right <- example_isolates %>% right_join_microorganisms())
suppressWarnings(full <- example_isolates %>% full_join_microorganisms())
expect_identical(class(as.ab("amox")), c("ab", "character"))
expect_identical(class(antibiotics$ab), c("ab", "character"))
expect_true(is.ab(as.ab("amox")))
expect_stdout(print(as.ab("amox")))
expect_stdout(print(data.frame(a = as.ab("amox"))))
expect_true(ncol(unjoined) < ncol(inner))
expect_true(nrow(unjoined) == nrow(inner))
expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
expect_warning(as.ab("UNKNOWN"))
expect_warning(as.ab(""))
expect_true(ncol(unjoined) < ncol(left))
expect_true(nrow(unjoined) == nrow(left))
expect_stdout(print(as.ab("amox")))
expect_true(ncol(semi) == ncol(semi))
expect_true(nrow(semi) == nrow(semi))
expect_equal(as.character(as.ab("Phloxapen")),
"FLC")
expect_true(nrow(anti) == 0)
expect_equal(suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))),
c(NA, "TMP"))
expect_true(nrow(unjoined) < nrow(right))
expect_true(nrow(unjoined) < nrow(full))
expect_equal(as.character(as.ab("Amoxy + clavulaanzuur")),
"AMC")
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1)
expect_equal(as.character(as.ab(c("mreopenem", "co-maoxiclav"))),
c("MEM", "AMC"))
expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1)
expect_message(as.ab("cipro mero"))
expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0)
expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
expect_warning(full_join_microorganisms("B_ESCHR_COLI"))
})
# assigning and subsetting
x <- antibiotics$ab
expect_inherits(x[1], "ab")
expect_inherits(x[[1]], "ab")
expect_inherits(c(x[1], x[9]), "ab")
expect_inherits(unique(x[1], x[9]), "ab")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))

36
tests/testthat/test-ab_from_text.R → inst/tinytest/test-ab_class_selectors.R
View File

@ -23,24 +23,20 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("ab_from_text.R")
if (suppressWarnings(require("dplyr"))) {
expect_true(example_isolates %>% select(aminoglycosides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(carbapenems()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_1st()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_2nd()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_3rd()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_4th()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_5th()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(fluoroquinolones()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(glycopeptides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(macrolides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(oxazolidinones()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(penicillins()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(tetracyclines()) %>% ncol() < ncol(example_isolates))
}
test_that("ab_from_text works", {
skip_on_cran()
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin")
expect_identical(ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP")
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]],
500)
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral")
})

33
tests/testthat/test-_deprecated.R → inst/tinytest/test-ab_from_text.R
View File

@ -23,23 +23,18 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("deprecated.R")
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin")
expect_identical(ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP")
test_that("deprecated functions work", {
skip_on_cran()
expect_identical(suppressWarnings(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3))),
c("***", "**", "*", ".", " ", NA, NA))
expect_warning(key_antibiotics(example_isolates))
expect_identical(suppressWarnings(key_antibiotics(example_isolates)),
key_antimicrobials(example_isolates, antifungal = NULL))
expect_warning(key_antibiotics_equal("S", "S"))
expect_identical(suppressWarnings(key_antibiotics_equal("S", "S")),
antimicrobials_equal("S", "S", type = "keyantimicrobials"))
expect_warning(filter_first_weighted_isolate(example_isolates))
expect_identical(suppressWarnings(filter_first_weighted_isolate(example_isolates)),
filter_first_isolate(example_isolates))
})
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]],
500)
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral")

63
inst/tinytest/test-ab_property.R Normal file
View File

@ -0,0 +1,63 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_identical(ab_name("AMX", language = NULL), "Amoxicillin")
expect_identical(as.character(ab_atc("AMX")), "J01CA04")
expect_identical(ab_cid("AMX"), as.integer(33613))
expect_inherits(ab_tradenames("AMX"), "character")
expect_inherits(ab_tradenames(c("AMX", "AMX")), "list")
expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins")
expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins")
expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum")
expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin")
expect_identical(ab_name(21319, language = NULL), "Flucloxacillin")
expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin")
expect_identical(ab_ddd("AMX", "oral"), 1.5)
expect_identical(ab_ddd("AMX", "oral", units = TRUE), "g")
expect_identical(ab_ddd("AMX", "iv"), 3)
expect_identical(ab_ddd("AMX", "iv", units = TRUE), "g")
expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B"))
expect_inherits(ab_info("AMX"), "list")
expect_error(ab_property("amox", "invalid property"))
expect_error(ab_name("amox", language = "INVALID"))
expect_stdout(print(ab_name("amox", language = NULL)))
expect_equal(ab_name("21066-6", language = NULL), "Ampicillin")
expect_equal(ab_loinc("ampicillin"),
c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5"))
expect_true(ab_url("AMX") %like% "whocc.no")
expect_warning(ab_url("ASP"))

69
tests/testthat/test-g.test.R → inst/tinytest/test-age.R
View File

@ -23,49 +23,46 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("g.test.R")
expect_equal(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "2019-01-01"),
c(39, 34, 29))
test_that("G-test works", {
skip_on_cran()
expect_equal(age(x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01",
exact = TRUE),
c(0.6656393, 0.4191781, 0.1698630),
tolerance = 0.001)
# GOODNESS-OF-FIT
expect_error(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = c("2019-01-01", "2019-01-01")))
# example 1: clearfield rice vs. red rice
x <- c(772, 1611, 737)
expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value,
expected = 0.12574,
tolerance = 0.00001)
expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "1975-01-01"))
# example 2: red crossbills
x <- c(1752, 1895)
expect_equal(g.test(x)$p.value,
expected = 0.01787343,
tolerance = 0.00000001)
expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"),
reference = "2019-01-01"))
expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25)))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24)))
expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
expect_equal(length(age(x = c("2019-01-01", NA), na.rm = TRUE)),
1)
# INDEPENDENCE
x <- as.data.frame(
matrix(data = round(runif(4) * 100000, 0),
ncol = 2,
byrow = TRUE)
)
# fisher.test() is always better for 2x2 tables:
expect_warning(g.test(x))
expect_lt(suppressWarnings(g.test(x)$p.value),
1)
ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
expect_warning(g.test(x = c(772, 1611, 737),
y = c(780, 1560, 780),
rescale.p = TRUE))
expect_equal(length(unique(age_groups(ages, 50))),
2)
expect_equal(length(unique(age_groups(ages, c(50, 60)))),
3)
expect_identical(class(age_groups(ages, "child")),
c("ordered", "factor"))
expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE)))
expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE)))
expect_identical(class(age_groups(ages, "elderly")),
c("ordered", "factor"))
})
expect_identical(class(age_groups(ages, "tens")),
c("ordered", "factor"))
expect_identical(class(age_groups(ages, "fives")),
c("ordered", "factor"))
expect_equal(length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)),
3)

12
tests/testthat/test-atc_online.R → inst/tinytest/test-atc_online.R
View File

@ -23,15 +23,9 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("atc_online.R")
test_that("atc_online works", {
skip_on_cran()
skip_if_not_installed("curl")
skip_if_not(curl::has_internet())
expect_gte(length(atc_online_groups(ab_atc("AMX"))), 1)
if (tryCatch(curl::has_internet(), error = function(e) FALSE)) {
expect_true(length(atc_online_groups(ab_atc("AMX"))) >= 1)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "P"), 3)
expect_warning(atc_online_ddd(ab_atc("Novobiocin"), administration = "P"))
})
}

9
tests/testthat/test-availability.R → inst/tinytest/test-availability.R
View File

@ -22,10 +22,5 @@
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("availability.R")
test_that("availability works", {
skip_on_cran()
expect_equal(class(availability(example_isolates)), "data.frame")
})
expect_inherits(availability(example_isolates), "data.frame")

16
tests/testthat/test-bug_drug_combinations.R → inst/tinytest/test-bug_drug_combinations.R
View File

@ -23,14 +23,8 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("bug_drug_combinations.R")
test_that("bug_drug_combinations works", {
skip_on_cran()
b <- suppressWarnings(bug_drug_combinations(example_isolates))
expect_s3_class(b, "bug_drug_combinations")
expect_output(print(b))
expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE)))
})
b <- suppressWarnings(bug_drug_combinations(example_isolates))
expect_inherits(b, "bug_drug_combinations")
expect_stdout(print(b))
expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE)))

99
inst/tinytest/test-count.R Normal file
View File

@ -0,0 +1,99 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX))
expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX))
expect_equal(count_all(example_isolates$AMX), n_rsi(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(count_R(example_isolates$AMX), 804)
expect_equal(count_I(example_isolates$AMX), 3)
expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543)
expect_equal(count_R(example_isolates$AMX) + count_I(example_isolates$AMX),
suppressWarnings(count_IR(example_isolates$AMX)))
expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX))
# warning for speed loss
reset_all_thrown_messages()
expect_warning(count_resistant(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(count_resistant(example_isolates$AMC,
as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
if (suppressWarnings(require("dplyr"))) {
expect_equal(example_isolates %>% count_susceptible(AMC), 1433)
expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE), 1687)
expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), 1798)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936)
expect_identical(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE),
example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) +
example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE))
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)) %>%
pull(combination),
c(253, 465, 192, 558))
# count_df
expect_equal(
example_isolates %>% select(AMX) %>% count_df() %>% pull(value),
c(example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant())
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_IR = TRUE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
suppressWarnings(example_isolates$AMX %>% count_IR()))
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
example_isolates$AMX %>% count_I(),
example_isolates$AMX %>% count_R())
)
# grouping in rsi_calc_df() (= backbone of rsi_df())
expect_true("hospital_id" %in% (example_isolates %>%
group_by(hospital_id) %>%
select(hospital_id, AMX, CIP, gender) %>%
rsi_df() %>%
colnames()))
}

84
inst/tinytest/test-data.R Normal file
View File

@ -0,0 +1,84 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_true(check_dataset_integrity()) # in misc.R
# IDs should always be unique
expect_identical(nrow(microorganisms), length(unique(microorganisms$mo)))
expect_identical(class(microorganisms$mo), c("mo", "character"))
expect_identical(nrow(antibiotics), length(unique(antibiotics$ab)))
expect_identical(class(antibiotics$ab), c("ab", "character"))
# check cross table reference
expect_true(all(microorganisms.codes$mo %in% microorganisms$mo))
expect_true(all(example_isolates$mo %in% microorganisms$mo))
expect_true(all(microorganisms.translation$mo_new %in% microorganisms$mo))
expect_true(all(rsi_translation$mo %in% microorganisms$mo))
expect_true(all(rsi_translation$ab %in% antibiotics$ab))
expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant()
expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name))
expect_false(any(is.na(microorganisms.codes$code)))
expect_false(any(is.na(microorganisms.codes$mo)))
expect_false(any(microorganisms.translation$mo_old %in% microorganisms$mo))
expect_true(all(dosage$ab %in% antibiotics$ab))
expect_true(all(dosage$name %in% antibiotics$name))
# antibiotic names must always be coercible to their original AB code
expect_identical(as.ab(antibiotics$name), antibiotics$ab)
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i])
}
df <- AMR:::MO_lookup
expect_true(nrow(df[which(df$prevalence == 1), ]) < nrow(df[which(df$prevalence == 2), ]))
expect_true(nrow(df[which(df$prevalence == 2), ]) < nrow(df[which(df$prevalence == 3), ]))
expect_true(all(c("mo", "fullname",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"rank", "ref", "species_id", "source", "prevalence", "snomed",
"kingdom_index", "fullname_lower", "g_species") %in% colnames(df)))
expect_true(all(c("fullname", "fullname_new", "ref", "prevalence",
"fullname_lower", "g_species") %in% colnames(AMR:::MO.old_lookup)))
expect_inherits(AMR:::MO_CONS, "mo")
expect_identical(class(catalogue_of_life_version()),
c("catalogue_of_life_version", "list"))
expect_stdout(print(catalogue_of_life_version()))
uncategorised <- subset(microorganisms,
genus == "Staphylococcus" &
!species %in% c("", "aureus") &
!mo %in% c(MO_CONS, MO_COPS))
expect_true(NROW(uncategorised) == 0,
info = ifelse(NROW(uncategorised) == 0,
"All staphylococcal species categorised as CoNS/CoPS.",
paste0("Staphylococcal species not categorised as CoNS/CoPS: S. ",
uncategorised$species, " (", uncategorised$mo, ")")))

58
tests/testthat/test-disk.R → inst/tinytest/test-disk.R
View File

@ -23,39 +23,33 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("disk.R")
expect_true(as.disk(8) == as.disk("8"))
expect_true(is.disk(as.disk(8)))
test_that("disk works", {
skip_on_cran()
expect_true(as.disk(8) == as.disk("8"))
expect_true(is.disk(as.disk(8)))
expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA)
expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA)
# all levels should be valid disks
x <- as.disk(c(20, 40))
expect_inherits(x[1], "disk")
expect_inherits(x[[1]], "disk")
expect_inherits(c(x[1], x[9]), "disk")
expect_inherits(unique(x[1], x[9]), "disk")
expect_warning(as.disk("INVALID VALUE"))
x[2] <- 32
expect_inherits(x, "disk")
# all levels should be valid disks
x <- as.disk(c(20, 40))
expect_s3_class(x[1], "disk")
expect_s3_class(x[[1]], "disk")
expect_s3_class(c(x[1], x[9]), "disk")
expect_s3_class(unique(x[1], x[9]), "disk")
expect_warning(as.disk("INVALID VALUE"))
x[2] <- 32
expect_s3_class(x, "disk")
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) {
expect_s3_class(ggplot(as.disk(c(10, 20, 40))), "gg")
expect_s3_class(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
expect_s3_class(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg")
}
expect_output(print(as.disk(12)))
if (suppressWarnings(require("dplyr"))) {
expect_output(print(tibble(d = as.disk(12))))
}
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) {
expect_inherits(ggplot(as.disk(c(10, 20, 40))), "gg")
expect_inherits(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
expect_inherits(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg")
}
expect_stdout(print(as.disk(12)))
})
if (suppressWarnings(require("dplyr"))) {
expect_stdout(print(tibble(d = as.disk(12))))
}

40
tests/testthat/test-random.R → inst/tinytest/test-episode.R
View File

@ -23,22 +23,30 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("random.R")
test_df <- rbind(
data.frame(
date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")),
patient_id = "A"
),
data.frame(
date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")),
patient_id = "B"
))
test_that("random works", {
skip_on_cran()
expect_equal(get_episode(test_df$date, 365),
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3))
if (suppressWarnings(require("dplyr"))) {
expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE))
expect_s3_class(random_mic(100), "mic")
expect_s3_class(random_mic(100, mo = "Klebsiella pneumoniae"), "mic")
expect_s3_class(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic")
expect_s3_class(random_mic(100, ab = "meropenem"), "mic")
# no normal factors of 2
expect_s3_class(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic")
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient_id, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_s3_class(random_disk(100), "disk")
expect_s3_class(random_disk(100, mo = "Klebsiella pneumoniae"), "disk")
expect_s3_class(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk")
expect_s3_class(random_disk(100, ab = "meropenem"), "disk")
expect_s3_class(random_rsi(100), "rsi")
})
expect_identical(which(x$out), which(y$out))
}

158
inst/tinytest/test-eucast_rules.R Executable file
View File

@ -0,0 +1,158 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
# thoroughly check input table
expect_equal(colnames(eucast_rules_file),
c("if_mo_property", "like.is.one_of", "this_value",
"and_these_antibiotics", "have_these_values",
"then_change_these_antibiotics", "to_value",
"reference.rule", "reference.rule_group",
"reference.version",
"note"))
MOs_mentioned <- unique(eucast_rules_file$this_value)
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned)))
expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0)
expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing")))
expect_error(eucast_rules(x = "text"))
expect_error(eucast_rules(data.frame(a = "test")))
expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
expect_identical(colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE))))
expect_stdout(suppressMessages(eucast_rules(example_isolates, info = TRUE)))
a <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_stdout(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE))))
a <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "-", # Colistin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "R", # Colistin
stringsAsFactors = FALSE)
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
# piperacillin must be R in Enterobacteriaceae when tica is R
if (suppressWarnings(require("dplyr"))) {
expect_equal(suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(TIC = as.rsi("R"),
PIP = as.rsi("S")) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()),
"R")
}
# Azithromycin and Clarythromycin must be equal to Erythromycin
a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.rsi("R"),
CLR = factor("R"),
stringsAsFactors = FALSE),
version_expertrules = 3.1,
only_rsi_columns = FALSE)$CLR))
b <- example_isolates$ERY
expect_identical(a[!is.na(b)],
b[!is.na(b)])
# amox is inferred by benzylpenicillin in Kingella kingae
expect_equal(
suppressWarnings(
as.list(eucast_rules(
data.frame(mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE)
, info = FALSE))$AMX
),
"S")
# also test norf
if (suppressWarnings(require("dplyr"))) {
expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
}
# check verbose output
expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))
# AmpC de-repressed cephalo mutants
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = TRUE,
info = FALSE)$cefotax,
as.rsi(c("S", "R")))
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NA,
info = FALSE)$cefotax,
as.rsi(c("S", NA)))
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NULL,
info = FALSE)$cefotax,
as.rsi(c("S", "S")))
# EUCAST dosage -----------------------------------------------------------
expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3)
expect_inherits(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame")
x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
AMX == "S" ~ AMC == "S")
expect_stdout(print(x))
expect_stdout(print(c(x, x)))
expect_stdout(print(as.list(x, x)))
# this custom rules makes 8 changes
expect_equal(nrow(eucast_rules(example_isolates,
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE)),
8)

48
inst/tinytest/test-filter_ab_class.R Normal file
View File

@ -0,0 +1,48 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
if (suppressWarnings(require("dplyr"))) {
expect_true(example_isolates %>% filter_ab_class("carbapenem") %>% nrow() > 0)
expect_true(example_isolates %>% filter_aminoglycosides() %>% ncol() > 0)
expect_true(example_isolates %>% filter_carbapenems() %>% ncol() > 0)
expect_true(example_isolates %>% filter_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_1st_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_2nd_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_3rd_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_4th_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_5th_cephalosporins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_fluoroquinolones() %>% ncol() > 0)
expect_true(example_isolates %>% filter_glycopeptides() %>% ncol() > 0)
expect_true(example_isolates %>% filter_macrolides() %>% ncol() > 0)
expect_true(example_isolates %>% filter_oxazolidinones() %>% ncol() > 0)
expect_true(example_isolates %>% filter_penicillins() %>% ncol() > 0)
expect_true(example_isolates %>% filter_tetracyclines() %>% ncol() > 0)
expect_true(example_isolates %>% filter_carbapenems("R", "all") %>% nrow() > 0)
expect_error(example_isolates %>% filter_carbapenems(result = "test"))
expect_error(example_isolates %>% filter_carbapenems(scope = "test"))
expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems())
}

182
inst/tinytest/test-first_isolate.R Executable file
View File

@ -0,0 +1,182 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
# all four methods
expect_equal(sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984)
expect_equal(sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265)
expect_equal(sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300)
expect_equal(sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1379)
# Phenotype-based, using key antimicrobials
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE), na.rm = TRUE),
1395)
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE), na.rm = TRUE),
1418)
# first non-ICU isolates
expect_equal(
sum(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient_id",
col_icu = "ward_icu",
info = TRUE,
icu_exclude = TRUE),
na.rm = TRUE),
941)
# set 1500 random observations to be of specimen type 'Urine'
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
x <- example_isolates
x$specimen <- "Other"
x[random_rows, "specimen"] <- "Urine"
expect_true(
sum(first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
info = TRUE), na.rm = TRUE) < 1501)
# same, but now exclude ICU
expect_true(
sum(first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
col_icu = "ward_icu",
icu_exclude = TRUE,
info = TRUE), na.rm = TRUE) < 1501)
# "No isolates found"
test_iso <- example_isolates
test_iso$specimen <- "test"
expect_message(first_isolate(test_iso,
"date",
"patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "something_unexisting",
info = TRUE))
# printing of exclusion message
expect_message(first_isolate(example_isolates,
col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
col_testcode = "gender",
testcodes_exclude = "M",
info = TRUE))
# errors
expect_error(first_isolate("date", "patient_id", col_mo = "mo"))
expect_error(first_isolate(example_isolates,
col_date = "non-existing col",
col_mo = "mo"))
if (suppressWarnings(require("dplyr"))) {
# if mo is not an mo class, result should be the same
expect_identical(example_isolates %>%
mutate(mo = as.character(mo)) %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
info = FALSE),
example_isolates %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
info = FALSE))
# support for WHONET
expect_message(example_isolates %>%
select(-patient_id) %>%
mutate(`First name` = "test",
`Last name` = "test",
Sex = "Female") %>%
first_isolate(info = TRUE))
# groups
x <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate())
y <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate(.))
expect_identical(x, y)
}
# missing dates should be no problem
df <- example_isolates
df[1:100, "date"] <- NA
expect_equal(
sum(
first_isolate(x = df,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
info = TRUE),
na.rm = TRUE),
1382)
# unknown MOs
test_unknown <- example_isolates
test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown, include_unknown = FALSE)),
1108)
expect_equal(sum(first_isolate(test_unknown, include_unknown = TRUE)),
1591)
test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown)),
1108)
# empty rsi results
expect_equal(sum(first_isolate(example_isolates, include_untested_rsi = FALSE)),
1366)
# shortcuts
expect_identical(filter_first_isolate(example_isolates),
subset(example_isolates, first_isolate(example_isolates)))
# notice that all mo's are distinct, so all are TRUE
expect_true(all(example_isolates %pm>%
pm_distinct(mo, .keep_all = TRUE) %pm>%
first_isolate(info = TRUE) == TRUE))
# only one isolate, so return fast
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))

52
tests/testthat/test-key_antimicrobials.R → inst/tinytest/test-g.test.R
View File

@ -23,19 +23,41 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("key_antimcrobials.R")
# GOODNESS-OF-FIT
test_that("key_antimcrobials work", {
skip_on_cran()
expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates))
expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL))))
expect_true(antimicrobials_equal("SSS", "SSS", type = "points"))
expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials"))
expect_true(antimicrobials_equal("SSS", "SRS", type = "points"))
expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials"))
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ]))
})
# example 1: clearfield rice vs. red rice
x <- c(772, 1611, 737)
expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value,
0.12574,
tolerance = 0.0001)
# example 2: red crossbills
x <- c(1752, 1895)
expect_equal(g.test(x)$p.value,
0.017873,
tolerance = 0.0001)
expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25)))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24)))
expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
# INDEPENDENCE
x <- as.data.frame(
matrix(data = round(runif(4) * 100000, 0),
ncol = 2,
byrow = TRUE)
)
# fisher.test() is always better for 2x2 tables:
expect_warning(g.test(x))
expect_true(suppressWarnings(g.test(x)$p.value) < 1)
expect_warning(g.test(x = c(772, 1611, 737),
y = c(780, 1560, 780),
rescale.p = TRUE))
expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE)))
expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE)))

29
tests/testthat/test-kurtosis.R → inst/tinytest/test-get_locale.R
View File

@ -23,25 +23,12 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("kurtosis.R")
expect_identical(mo_genus("B_GRAMP", language = "pt"),
"(Gram positivos desconhecidos)")
test_that("kurtosis works", {
skip_on_cran()
expect_equal(kurtosis(example_isolates$age),
5.227999,
tolerance = 0.00001)
expect_equal(unname(kurtosis(data.frame(example_isolates$age))),
5.227999,
tolerance = 0.00001)
expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)),
2.227999,
tolerance = 0.00001)
expect_equal(kurtosis(matrix(example_isolates$age)),
5.227999,
tolerance = 0.00001)
expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE),
2.227999,
tolerance = 0.00001)
})
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")

112
inst/tinytest/test-ggplot_rsi.R Normal file
View File

@ -0,0 +1,112 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
if (suppressWarnings(require("dplyr")) & suppressWarnings(require("ggplot2"))) {
pdf(NULL) # prevent Rplots.pdf being created
# data should be equal
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi())$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_stdout(print(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic")))
expect_stdout(print(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation")))
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(count_resistant) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(count_resistant) %>%
as.double()
)
# support for scale_type ab and mo
expect_inherits((data.frame(mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data,
"data.frame")
expect_inherits((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame")
expect_inherits((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame")
# support for manual colours
expect_inherits((ggplot(data.frame(x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6"))) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data,
"data.frame")
}

42
inst/tinytest/test-guess_ab_col.R Normal file
View File

@ -0,0 +1,42 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_equal(guess_ab_col(example_isolates, "amox"),
"AMX")
expect_equal(guess_ab_col(example_isolates, "amoxicillin"),
"AMX")
expect_equal(guess_ab_col(example_isolates, "J01AA07"),
"TCY")
expect_equal(guess_ab_col(example_isolates, "tetracycline"),
"TCY")
expect_equal(guess_ab_col(example_isolates, "TETR"),
"TCY")
df <- data.frame(AMP_ND10 = "R",
AMC_ED20 = "S")
expect_equal(guess_ab_col(df, "ampicillin"),
"AMP_ND10")
expect_equal(guess_ab_col(df, "J01CR02"),
"AMC_ED20")

22
tests/testthat/test-italicise_taxonomy.R → inst/tinytest/test-italicise_taxonomy.R
View File

@ -23,17 +23,11 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("italicise_taxonomy.R")
test_that("italic taxonomy works", {
skip_on_cran()
expect_identical(italicise_taxonomy("test for E. coli"),
"test for *E. coli*")
expect_identical(italicise_taxonomy("test for E. coli"),
italicize_taxonomy("test for E. coli"))
if (has_colour()) {
expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"),
"test for \033[3mE. coli\033[23m")
}
})
expect_identical(italicise_taxonomy("test for E. coli"),
"test for *E. coli*")
expect_identical(italicise_taxonomy("test for E. coli"),
italicize_taxonomy("test for E. coli"))
if (has_colour()) {
expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"),
"test for \033[3mE. coli\033[23m")
}

63
tests/testthat/test-episode.R → inst/tinytest/test-join_microorganisms.R Normal file → Executable file
View File

@ -23,36 +23,35 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("episode.R")
unjoined <- example_isolates
inner <- example_isolates %>% inner_join_microorganisms()
left <- example_isolates %>% left_join_microorganisms()
semi <- example_isolates %>% semi_join_microorganisms()
anti <- example_isolates %>% anti_join_microorganisms()
suppressWarnings(right <- example_isolates %>% right_join_microorganisms())
suppressWarnings(full <- example_isolates %>% full_join_microorganisms())
test_that("episodes work", {
skip_on_cran()
test_df <- rbind(
data.frame(
date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")),
patient_id = "A"
),
data.frame(
date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")),
patient_id = "B"
))
expect_equal(get_episode(test_df$date, 365),
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3))
if (suppressWarnings(require("dplyr"))) {
expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE))
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient_id, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
}
})
expect_true(ncol(unjoined) < ncol(inner))
expect_true(nrow(unjoined) == nrow(inner))
expect_true(ncol(unjoined) < ncol(left))
expect_true(nrow(unjoined) == nrow(left))
expect_true(ncol(semi) == ncol(semi))
expect_true(nrow(semi) == nrow(semi))
expect_true(nrow(anti) == 0)
expect_true(nrow(unjoined) < nrow(right))
expect_true(nrow(unjoined) < nrow(full))
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1)
expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0)
expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
expect_warning(full_join_microorganisms("B_ESCHR_COLI"))

36
inst/tinytest/test-key_antimicrobials.R Normal file
View File

@ -0,0 +1,36 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates))
expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL))))
expect_true(antimicrobials_equal("SSS", "SSS", type = "points"))
expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials"))
expect_true(antimicrobials_equal("SSS", "SRS", type = "points"))
expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials"))
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ]))

37
tests/testthat/test-guess_ab_col.R → inst/tinytest/test-kurtosis.R
View File

@ -23,27 +23,20 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("guess_ab_col.R")
expect_equal(kurtosis(example_isolates$age),
5.227999,
tolerance = 0.00001)
test_that("guess_ab_col works", {
skip_on_cran()
expect_equal(unname(kurtosis(data.frame(example_isolates$age))),
5.227999,
tolerance = 0.00001)
expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)),
2.227999,
tolerance = 0.00001)
expect_equal(guess_ab_col(example_isolates, "amox"),
"AMX")
expect_equal(guess_ab_col(example_isolates, "amoxicillin"),
"AMX")
expect_equal(guess_ab_col(example_isolates, "J01AA07"),
"TCY")
expect_equal(guess_ab_col(example_isolates, "tetracycline"),
"TCY")
expect_equal(guess_ab_col(example_isolates, "TETR"),
"TCY")
df <- data.frame(AMP_ND10 = "R",
AMC_ED20 = "S")
expect_equal(guess_ab_col(df, "ampicillin"),
"AMP_ND10")
expect_equal(guess_ab_col(df, "J01CR02"),
"AMC_ED20")
})
expect_equal(kurtosis(matrix(example_isolates$age)),
5.227999,
tolerance = 0.00001)
expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE),
2.227999,
tolerance = 0.00001)

26
tests/testthat/test-get_locale.R → inst/tinytest/test-like.R
View File

@ -23,18 +23,18 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("get_locale.R")
expect_true(sum("test" %like% c("^t", "^s")) == 1)
test_that("get_locale works", {
skip_on_cran()
expect_identical(mo_genus("B_GRAMP", language = "pt"),
"(Gram positivos desconhecidos)")
expect_true("test" %like% "test")
expect_false("test" %like_case% "TEST")
expect_true(factor("test") %like% factor("t"))
expect_true(factor("test") %like% "t")
expect_true("test" %like% factor("t"))
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")
})
expect_true(as.factor("test") %like% "TEST")
expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
c(TRUE, TRUE, TRUE))
expect_identical("test" %like% c("t", "e", "s", "t"),
c(TRUE, TRUE, TRUE, TRUE))
expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")),
c(TRUE, TRUE, TRUE, TRUE))

238
inst/tinytest/test-mdro.R Executable file
View File

@ -0,0 +1,238 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_error(suppressWarnings(mdro(example_isolates, country = "invalid", col_mo = "mo", info = TRUE)))
expect_error(suppressWarnings(mdro(example_isolates, country = "fr", info = TRUE)))
expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE))
expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE))))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE))))
expect_stdout(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE))))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
expect_stdout(outcome <- mdro(example_isolates, "nl", info = TRUE))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
# example_isolates should have these finding using Dutch guidelines
expect_equal(as.double(table(outcome)),
c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos
expect_equal(brmo(example_isolates, info = FALSE),
mdro(example_isolates, guideline = "BRMO", info = FALSE))
# test Dutch P. aeruginosa MDRO
expect_equal(
as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"),
cfta = "S",
cipr = "S",
mero = "S",
imip = "S",
gent = "S",
tobr = "S",
pita = "S"),
guideline = "BRMO",
col_mo = "mo",
info = FALSE)),
"Negative")
expect_equal(
as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"),
cefta = "R",
cipr = "R",
mero = "R",
imip = "R",
gent = "R",
tobr = "R",
pita = "R"),
guideline = "BRMO",
col_mo = "mo",
info = FALSE)),
"Positive")
# German 3MRGN and 4MRGN
expect_equal(as.character(mrgn(
data.frame(mo = c("E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
PIP = c("S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"),
CTX = c("S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"),
IPM = c("S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"),
CIP = c("S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"),
stringsAsFactors = FALSE))),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN"))
# MDR TB
expect_equal(
# select only rifampicine, mo will be determined automatically (as M. tuberculosis),
# number of mono-resistant strains should be equal to number of rifampicine-resistant strains
as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2],
count_R(example_isolates$RIF))
x <- data.frame(rifampicin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
inh = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
gatifloxacin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
eth = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
pza = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
MFX = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
KAN = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)))
expect_true(length(unique(mdr_tb(x))) > 2)
# check the guideline by Magiorakos et al. (2012), the default guideline
stau <- data.frame(mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(stau)), c(1:4))
expect_inherits(mdro(stau, verbose = TRUE), "data.frame")
ente <- data.frame(mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(ente)), c(1:4))
expect_inherits(mdro(ente, verbose = TRUE), "data.frame")
entero <- data.frame(mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(entero)), c(1:4))
expect_inherits(mdro(entero, verbose = TRUE), "data.frame")
pseud <- data.frame(mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(pseud)), c(1:4))
expect_inherits(mdro(pseud, verbose = TRUE), "data.frame")
acin <- data.frame(mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(acin)), c(1:4))
expect_inherits(mdro(acin, verbose = TRUE), "data.frame")
# custom rules
custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A",
"ERY == 'R' & age > 60" ~ "Elderly Type B",
as_factor = TRUE)
expect_stdout(print(custom))
expect_stdout(print(c(custom, custom)))
expect_stdout(print(as.list(custom, custom)))
expect_stdout(x <- mdro(example_isolates, guideline = custom, info = TRUE))
expect_equal(as.double(table(x)), c(1070, 198, 732))
expect_stdout(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE)))
expect_error(custom_mdro_guideline())
expect_error(custom_mdro_guideline("test"))
expect_error(custom_mdro_guideline("test" ~ c(1:3)))
expect_error(custom_mdro_guideline("test" ~ A))
expect_warning(mdro(example_isolates,
# since `test` gives an error, it will be ignored with a warning
guideline = custom_mdro_guideline(test ~ "A"),
info = FALSE))
# print groups
if (suppressWarnings(require("dplyr"))) {
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE))
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
}

136
inst/tinytest/test-mic.R Executable file
View File

@ -0,0 +1,136 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_true(as.mic(8) == as.mic("8"))
expect_true(as.mic("1") > as.mic("<=0.0625"))
expect_true(as.mic("1") < as.mic(">=32"))
expect_true(is.mic(as.mic(8)))
expect_equal(as.double(as.mic(">=32")), 32)
expect_equal(as.numeric(as.mic(">=32")), 32)
expect_equal(as.integer(as.mic(">=32")), 32)
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA)
# all levels should be valid MICs
x <- as.mic(c(2, 4))
expect_inherits(x[1], "mic")
expect_inherits(x[[1]], "mic")
expect_inherits(c(x[1], x[9]), "mic")
expect_inherits(unique(x[1], x[9]), "mic")
expect_inherits(droplevels(c(x[1], x[9])), "mic")
x[2] <- 32
expect_inherits(x, "mic")
expect_warning(as.mic("INVALID VALUE"))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) {
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8))), "gg")
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg")
}
expect_stdout(print(as.mic(c(1, 2, 4, 8))))
expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
if (suppressWarnings(require("dplyr"))) {
expect_stdout(print(tibble(m = as.mic(2:4))))
}
# all mathematical operations
x <- random_mic(50)
x_double <- as.double(gsub("[<=>]+", "", as.character(x)))
suppressWarnings(expect_identical(mean(x), mean(x_double)))
suppressWarnings(expect_identical(median(x), median(x_double)))
suppressWarnings(expect_identical(quantile(x), quantile(x_double)))
suppressWarnings(expect_identical(abs(x), abs(x_double)))
suppressWarnings(expect_identical(sign(x), sign(x_double)))
suppressWarnings(expect_identical(sqrt(x), sqrt(x_double)))
suppressWarnings(expect_identical(floor(x), floor(x_double)))
suppressWarnings(expect_identical(ceiling(x), ceiling(x_double)))
suppressWarnings(expect_identical(trunc(x), trunc(x_double)))
suppressWarnings(expect_identical(round(x), round(x_double)))
suppressWarnings(expect_identical(signif(x), signif(x_double)))
suppressWarnings(expect_identical(exp(x), exp(x_double)))
suppressWarnings(expect_identical(log(x), log(x_double)))
suppressWarnings(expect_identical(log10(x), log10(x_double)))
suppressWarnings(expect_identical(log2(x), log2(x_double)))
suppressWarnings(expect_identical(expm1(x), expm1(x_double)))
suppressWarnings(expect_identical(log1p(x), log1p(x_double)))
suppressWarnings(expect_identical(cos(x), cos(x_double)))
suppressWarnings(expect_identical(sin(x), sin(x_double)))
suppressWarnings(expect_identical(tan(x), tan(x_double)))
suppressWarnings(expect_identical(cospi(x), cospi(x_double)))
suppressWarnings(expect_identical(sinpi(x), sinpi(x_double)))
suppressWarnings(expect_identical(tanpi(x), tanpi(x_double)))
suppressWarnings(expect_identical(acos(x), acos(x_double)))
suppressWarnings(expect_identical(asin(x), asin(x_double)))
suppressWarnings(expect_identical(atan(x), atan(x_double)))
suppressWarnings(expect_identical(cosh(x), cosh(x_double)))
suppressWarnings(expect_identical(sinh(x), sinh(x_double)))
suppressWarnings(expect_identical(tanh(x), tanh(x_double)))
suppressWarnings(expect_identical(acosh(x), acosh(x_double)))
suppressWarnings(expect_identical(asinh(x), asinh(x_double)))
suppressWarnings(expect_identical(atanh(x), atanh(x_double)))
suppressWarnings(expect_identical(lgamma(x), lgamma(x_double)))
suppressWarnings(expect_identical(gamma(x), gamma(x_double)))
suppressWarnings(expect_identical(digamma(x), digamma(x_double)))
suppressWarnings(expect_identical(trigamma(x), trigamma(x_double)))
suppressWarnings(expect_identical(cumsum(x), cumsum(x_double)))
suppressWarnings(expect_identical(cumprod(x), cumprod(x_double)))
suppressWarnings(expect_identical(cummax(x), cummax(x_double)))
suppressWarnings(expect_identical(cummin(x), cummin(x_double)))
suppressWarnings(expect_identical(!x, !(x_double)))
suppressWarnings(expect_identical(all(x), all(x_double)))
suppressWarnings(expect_identical(any(x), any(x_double)))
suppressWarnings(expect_identical(sum(x), sum(x_double)))
suppressWarnings(expect_identical(prod(x), prod(x_double)))
suppressWarnings(expect_identical(min(x), min(x_double)))
suppressWarnings(expect_identical(max(x), max(x_double)))
suppressWarnings(expect_identical(range(x), range(x_double)))
el1 <- random_mic(50)
el1_double <- as.double(gsub("[<=>]+", "", as.character(el1)))
el2 <- random_mic(50)
el2_double <- as.double(gsub("[<=>]+", "", as.character(el2)))
suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double))
suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double))
suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double))
suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double))
suppressWarnings(expect_identical(el1 ^ el2, el1_double ^ el2_double))
suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double))
suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double))
suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double))
suppressWarnings(expect_identical(el1 | el2, el1_double | el2_double))
suppressWarnings(expect_identical(el1 == el2, el1_double == el2_double))
suppressWarnings(expect_identical(el1 != el2, el1_double != el2_double))
suppressWarnings(expect_identical(el1 < el2, el1_double < el2_double))
suppressWarnings(expect_identical(el1 <= el2, el1_double <= el2_double))
suppressWarnings(expect_identical(el1 >= el2, el1_double >= el2_double))
suppressWarnings(expect_identical(el1 > el2, el1_double > el2_double))

297
inst/tinytest/test-mo.R Normal file
View File

@ -0,0 +1,297 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo)))
expect_identical(
as.character(as.mo(c("E. coli", "H. influenzae"))),
c("B_ESCHR_COLI", "B_HMPHL_INFL"))
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR")
expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR")
expect_equal(as.character(as.mo("Esch spp.")), "B_ESCHR")
expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter
expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN")
expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL")
expect_equal(as.character(as.mo("K. pneu rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis
expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL")
expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC")
expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP")
expect_equal(as.character(as.mo("Strepto")), "B_STRPT")
expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus
expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB")
expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0)
expect_equal(as.character(as.mo(c("mycobacterie", "mycobakterium"))), c("B_MYCBC", "B_MYCBC"))
expect_equal(as.character(as.mo(c("GAS", "GBS", "a MGS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_MILL", "B_STRPT_HAEM"))
expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes
# GLIMS
expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL")
expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR")
expect_equal(as.character(as.mo("VRE")), "B_ENTRC")
expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG")
expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI")
expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL")
expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP"))
# prevalent MO
expect_identical(
suppressWarnings(as.character(
as.mo(c("stau",
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureeuzz",
"Staphylococcus aureus",
"MRSA",
"VISA")))),
rep("B_STPHY_AURS", 9))
expect_identical(
as.character(
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
rep("B_ESCHR_COLI", 6))
# unprevalent MO
expect_identical(
as.character(
as.mo(c("parnod",
"P. nodosa",
"P nodosa",
"Paraburkholderia nodosa"))),
rep("B_PRBRK_NODS", 4))
# empty values
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
expect_warning(as.mo("ab"))
expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))),
c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI"))
# check for Becker classification
expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR")
expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS")
expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS")
# aureus must only be influenced if Becker = "all"
expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS")
# check for Lancefield classification
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN")
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA")
expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC")
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B
expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = FALSE)), "B_STRPT_DYSG_EQSM")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
# Enterococci must only be influenced if Lancefield = "all"
expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D
expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN")
expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN")
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
if (suppressWarnings(require("dplyr"))) {
# select with one column
expect_identical(
example_isolates[1:10, ] %>%
left_join_microorganisms() %>%
select(genus) %>%
as.mo() %>%
as.character(),
c("B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY",
"B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY"))
# select with two columns
expect_identical(
example_isolates[1:10, ] %>%
pull(mo),
example_isolates[1:10, ] %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo())
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# test pull
expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
# unknown results
expect_warning(as.mo(c("INVALID", "Yeah, unknown")))
# print
expect_stdout(print(as.mo(c("B_ESCHR_COLI", NA))))
# test data.frame
expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1)
# check empty values
expect_equal(as.character(suppressWarnings(as.mo(""))),
NA_character_)
# check less prevalent MOs
expect_equal(as.character(as.mo("Gomphosphaeria aponina delicatula")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("Gomphosphaeria apo del")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("G apo deli")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("Gomphosphaeria aponina")), "B_GMPHS_APNN")
expect_equal(as.character(as.mo("Gomphosphaeria species")), "B_GMPHS")
expect_equal(as.character(as.mo("Gomphosphaeria")), "B_GMPHS")
expect_equal(as.character(as.mo(" B_GMPHS_APNN ")), "B_GMPHS_APNN")
expect_equal(as.character(as.mo("g aponina")), "B_GMPHS_APNN")
# check old names
expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT")
print(mo_renamed())
expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT"))
# check uncertain names
expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS")
expect_equal(suppressWarnings(as.character(as.mo("staaur extratest", allow_uncertain = FALSE))), "UNKNOWN")
expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE))
expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS")
expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS")
expect_equal(suppressMessages(as.character(as.mo(c("s aur THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_ANRB", "B_STPHY_AURS_ANRB"))
# predefined reference_df
expect_equal(as.character(as.mo("TestingOwnID",
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))),
"B_ESCHR_COLI")
expect_equal(as.character(as.mo(c("TestingOwnID", "E. coli"),
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI"))
expect_warning(as.mo("TestingOwnID", reference_df = NULL))
expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID")))
# combination of existing mo and other code
expect_identical(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI"))
# from different sources
expect_equal(as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI"))),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI"))
# hard to find
expect_equal(as.character(suppressMessages(as.mo(
c("Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena")))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG"))
expect_stdout(print(mo_uncertainties()))
x <- as.mo("S. aur")
# many hits
expect_stdout(print(mo_uncertainties()))
# Salmonella (City) are all actually Salmonella enterica spp (City)
expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
c("Salmonella enterica", "Salmonella enterica", "Salmonella"))
# no virusses
expect_equal(as.character(as.mo("Virus")), NA_character_)
# summary
expect_equal(length(summary(example_isolates$mo)), 6)
# WHONET codes and NA/NaN
expect_equal(as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)),
rep(NA_character_, 3))
expect_equal(as.character(as.mo("con")), "UNKNOWN")
expect_equal(as.character(as.mo("xxx")), NA_character_)
expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI"))
expect_equal(as.character(as.mo(c("other", "none", "unknown"))),
rep("UNKNOWN", 3))
expect_null(mo_failures())
expect_error(translate_allow_uncertain(5))
# debug mode
expect_stdout(print(suppressMessages(suppressWarnings(as.mo("kshgcjkhsdgkshjdfsfvsdfv", debug = TRUE, allow_uncertain = 3)))))
# ..coccus
expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN"))
# yeasts and fungi
expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS"))
if (suppressWarnings(require("dplyr"))) {
# print tibble
expect_stdout(print(tibble(mo = as.mo("B_ESCHR_COLI"))))
}
# assigning and subsetting
x <- example_isolates$mo
expect_inherits(x[1], "mo")
expect_inherits(x[[1]], "mo")
expect_inherits(c(x[1], x[9]), "mo")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# ignoring patterns
expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA))
# frequency tables
if (suppressWarnings(require("cleaner"))) {
expect_inherits(cleaner::freq(example_isolates$mo), "freq")
}

129
inst/tinytest/test-mo_property.R Normal file
View File

@ -0,0 +1,129 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_equal(mo_kingdom("Escherichia coli"), "Bacteria")
expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli"))
expect_equal(mo_phylum("Escherichia coli"), "Proteobacteria")
expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria")
expect_equal(mo_order("Escherichia coli"), "Enterobacterales")
expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae")
expect_equal(mo_genus("Escherichia coli"), "Escherichia")
expect_equal(mo_species("Escherichia coli"), "coli")
expect_equal(mo_subspecies("Escherichia coli"), "")
expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli")
expect_equal(mo_name("Escherichia coli"), "Escherichia coli")
expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria")
expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative")
expect_inherits(mo_taxonomy("Escherichia coli"), "list")
expect_equal(names(mo_taxonomy("Escherichia coli")), c("kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies"))
expect_equal(mo_synonyms("Escherichia coli"), NULL)
expect_true(length(mo_synonyms("Candida albicans")) > 1)
expect_inherits(mo_synonyms(c("Candida albicans", "Escherichia coli")), "list")
expect_equal(names(mo_info("Escherichia coli")), c("kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies",
"synonyms", "gramstain", "url", "ref",
"snomed"))
expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
expect_equal(mo_year("Escherichia coli"), 1919)
expect_equal(mo_shortname("Escherichia coli"), "E. coli")
expect_equal(mo_shortname("Escherichia"), "Escherichia")
expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS")
expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae")
expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS")
expect_true(mo_url("Candida albicans") %like% "catalogueoflife.org")
expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
# test integrity
MOs <- microorganisms
expect_identical(MOs$fullname, mo_fullname(MOs$fullname, language = "en"))
# check languages
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien")
expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief")
expect_stdout(print(mo_gramstain("Escherichia coli", language = "en")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "de")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "nl")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "es")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "pt")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "it")))
expect_stdout(print(mo_gramstain("Escherichia coli", language = "fr")))
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
dutch <- mo_name(microorganisms$fullname, language = "nl") # should be transformable to English again
expect_identical(mo_name(dutch, language = NULL), microorganisms$fullname) # gigantic test - will run ALL names
# manual property function
expect_error(mo_property("Escherichia coli", property = c("tsn", "fullname")))
expect_error(mo_property("Escherichia coli", property = "UNKNOWN"))
expect_identical(mo_property("Escherichia coli", property = "fullname"),
mo_fullname("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "genus"),
mo_genus("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "species"),
mo_species("Escherichia coli"))
expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968")
expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999")
expect_true(112283007 %in% mo_snomed("Escherichia coli"))
# old codes must throw a warning in mo_* family
expect_message(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR")))
# outcome of mo_fullname must always return the fullname from the data set
x <- data.frame(mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en"),
stringsAsFactors = FALSE)
expect_equal(nrow(subset(x, f1 != f2)), 0)
# is gram pos/neg (also return FALSE for all non-bacteria)
expect_equal(mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE))
expect_equal(mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE))
# is intrinsic resistant
expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"),
"vanco"),
c(TRUE, FALSE, FALSE))
# with reference data
expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli")
if (suppressWarnings(require("dplyr"))) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710)
}

63
inst/tinytest/test-pca.R Normal file
View File

@ -0,0 +1,63 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
resistance_data <- structure(list(order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(list(order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE))
pca_model <- pca(resistance_data)
expect_inherits(pca_model, "pca")
pdf(NULL) # prevent Rplots.pdf being created
if (suppressWarnings(require("ggplot2"))) {
ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE)
}
if (suppressWarnings(require("dplyr"))) {
resistance_data <- example_isolates %>%
group_by(order = mo_order(mo),
genus = mo_genus(mo)) %>%
summarise_if(is.rsi, resistance, minimum = 0)
pca_result <- resistance_data %>%
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
expect_inherits(pca_result, "prcomp")
if (suppressWarnings(require("ggplot2"))) {
ggplot_pca(pca_result, ellipse = TRUE)
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
}
}

130
inst/tinytest/test-proportion.R Executable file
View File

@ -0,0 +1,130 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX))
expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001)
expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001)
expect_equal(1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX),
proportion_S(example_isolates$AMX))
expect_equal(proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_IR(example_isolates$AMX))
expect_equal(proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_SI(example_isolates$AMX))
expect_equal(example_isolates %>% proportion_SI(AMC),
0.7626397,
tolerance = 0.0001)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN),
0.9408,
tolerance = 0.0001)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE),
0.9382647,
tolerance = 0.0001)
if (suppressWarnings(require("dplyr"))) {
# percentages
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(R = proportion_R(CIP, as_percent = TRUE),
I = proportion_I(CIP, as_percent = TRUE),
S = proportion_S(CIP, as_percent = TRUE),
n = n_rsi(CIP),
total = n()) %>%
pull(n) %>%
sum(),
1409)
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_rsi(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_rsi(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_rsi(CIP, GEN)) %>%
pull(combination_n),
c(305, 617, 241, 711))
# proportion_df
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value),
c(example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R())
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_IR = TRUE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_IR())
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_I(),
example_isolates$AMX %>% proportion_R())
)
}
reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC,
example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN)))
expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN))),
1879)
# check for errors
expect_error(proportion_IR("test", minimum = "test"))
expect_error(proportion_IR("test", as_percent = "test"))
expect_error(proportion_I("test", minimum = "test"))
expect_error(proportion_I("test", as_percent = "test"))
expect_error(proportion_S("test", minimum = "test"))
expect_error(proportion_S("test", as_percent = "test"))
expect_error(proportion_S("test", also_single_tested = TRUE))
# check too low amount of isolates
expect_identical(suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
expect_identical(suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
expect_identical(suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
# warning for speed loss
reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(proportion_I(as.character(example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date"]))

31
tests/testthat/test-like.R → inst/tinytest/test-random.R
View File

@ -23,23 +23,14 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("like.R")
test_that("`like` works", {
skip_on_cran()
expect_true(sum("test" %like% c("^t", "^s")) == 1)
expect_true("test" %like% "test")
expect_false("test" %like_case% "TEST")
expect_true(factor("test") %like% factor("t"))
expect_true(factor("test") %like% "t")
expect_true("test" %like% factor("t"))
expect_true(as.factor("test") %like% "TEST")
expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
c(TRUE, TRUE, TRUE))
expect_identical("test" %like% c("t", "e", "s", "t"),
c(TRUE, TRUE, TRUE, TRUE))
expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")),
c(TRUE, TRUE, TRUE, TRUE))
})
expect_inherits(random_mic(100), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae"), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic")
expect_inherits(random_mic(100, ab = "meropenem"), "mic")
# no normal factors of 2
expect_inherits(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic")
expect_inherits(random_disk(100), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae"), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk")
expect_inherits(random_disk(100, ab = "meropenem"), "disk")
expect_inherits(random_rsi(100), "rsi")

95
inst/tinytest/test-resistance_predict.R Normal file
View File

@ -0,0 +1,95 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
if (suppressWarnings(require("dplyr"))) {
expect_stdout(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE) %>%
pull("value"))
# AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20])
}
expect_stdout(x <- suppressMessages(resistance_predict(example_isolates,
col_ab = "AMX",
year_min = 2010,
model = "binomial",
info = TRUE)))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x))
if (suppressWarnings(require("ggplot2"))) {
expect_silent(ggplot_rsi_predict(x))
expect_silent(ggplot(x))
expect_error(ggplot_rsi_predict(example_isolates))
}
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE))
# almost all E. coli are MEM S in the Netherlands :)
expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE))

157
inst/tinytest/test-rsi.R Normal file
View File

@ -0,0 +1,157 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
expect_true(as.rsi("S") < as.rsi("I"))
expect_true(as.rsi("I") < as.rsi("R"))
expect_true(is.rsi(as.rsi("S")))
x <- example_isolates$AMX
expect_inherits(x[1], "rsi")
expect_inherits(x[[1]], "rsi")
expect_inherits(c(x[1], x[9]), "rsi")
expect_inherits(unique(x[1], x[9]), "rsi")
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.rsi(c("S", "I", "R"))))
expect_silent(plot(as.rsi(c("S", "I", "R"))))
if (suppressWarnings(require("ggplot2"))) expect_inherits(ggplot(as.rsi(c("S", "I", "R"))), "gg")
expect_stdout(print(as.rsi(c("S", "I", "R"))))
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
expect_equal(summary(as.rsi(c("S", "R"))),
structure(c("Class" = "rsi",
"%R" = "50.0% (n=1)",
"%SI" = "50.0% (n=1)",
"- %S" = "50.0% (n=1)",
"- %I" = " 0.0% (n=0)"), class = c("summaryDefault", "table")))
expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
rep(FALSE, length(example_isolates)))
expect_error(as.rsi.mic(as.mic(16)))
expect_error(as.rsi.disk(as.disk(16)))
expect_error(get_guideline("this one does not exist"))
if (suppressWarnings(require("dplyr"))) {
# 40 rsi columns
expect_equal(example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is.rsi.eligible) %>%
as.logical() %>%
sum(),
40)
expect_equal(sum(is.rsi(example_isolates)), 40)
expect_stdout(print(tibble(ab = as.rsi("S"))))
}
if (suppressWarnings(require("skimr"))) {
expect_inherits(skim(example_isolates),
"data.frame")
if (suppressWarnings(require("dplyr"))) {
expect_inherits(example_isolates %>%
mutate(m = as.mic(2),
d = as.disk(20)) %>%
skim(),
"data.frame")
}
}
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
expect_equal(as.character(
as.rsi(x = as.mic(c(0.125, 0.5, 1, 2, 4)),
mo = "B_STRPT_PNMN",
ab = "AMP",
guideline = "EUCAST 2020")),
c("S", "S", "I", "I", "R"))
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
expect_equal(as.character(
as.rsi(x = as.mic(c(1, 2, 4, 8, 16)),
mo = "B_STRPT_PNMN",
ab = "AMX",
guideline = "CLSI 2019")),
c("S", "S", "I", "R", "R"))
# cutoffs at MIC = 8
expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("S"))
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R"))
if (suppressWarnings(require("dplyr"))) {
expect_true(suppressWarnings(example_isolates %>%
mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>%
as.rsi() %>%
pull(amox_mic) %>%
is.rsi()))
}
expect_equal(as.character(
as.rsi(x = as.disk(22),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"S")
expect_equal(as.character(
as.rsi(x = as.disk(18),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"I")
expect_equal(as.character(
as.rsi(x = as.disk(10),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"R")
if (suppressWarnings(require("dplyr"))) {
expect_true(example_isolates %>%
mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>%
is.rsi())
}
# frequency tables
if (suppressWarnings(require("cleaner"))) {
expect_inherits(cleaner::freq(example_isolates$AMX), "freq")
}
df <- data.frame(microorganism = "Escherichia coli",
AMP = as.mic(8),
CIP = as.mic(0.256),
GEN = as.disk(18),
TOB = as.disk(16),
ERY = "R", # note about assigning <rsi> class
CLR = "V") # note about cleaning
expect_inherits(suppressWarnings(as.rsi(df)),
"data.frame")
expect_inherits(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")))$amoxi),
"rsi")
expect_warning(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32))))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
uti = TRUE)))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood"))))

23
tests/testthat/test-skewness.R → inst/tinytest/test-skewness.R
View File

@ -23,17 +23,12 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
context("skewness.R")
test_that("skewness works", {
skip_on_cran()
expect_equal(skewness(example_isolates$age),
-1.212888,
tolerance = 0.00001)
expect_equal(unname(skewness(data.frame(example_isolates$age))),
-1.212888,
tolerance = 0.00001)
expect_equal(skewness(matrix(example_isolates$age)),
-1.212888,
tolerance = 0.00001)
})
expect_equal(skewness(example_isolates$age),
-1.212888,
tolerance = 0.00001)
expect_equal(unname(skewness(data.frame(example_isolates$age))),
-1.212888,
tolerance = 0.00001)
expect_equal(skewness(matrix(example_isolates$age)),
-1.212888,
tolerance = 0.00001)

112
inst/tinytest/test-zzz.R Normal file
View File

@ -0,0 +1,112 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
# Check if these function still exist in the package (all are in Suggests field)
# Since GitHub Action runs every night, we will get emailed when a dependency fails based on this unit test
# functions used by import_fn()
import_functions <- c(
"anti_join" = "dplyr",
"cur_column" = "dplyr",
"full_join" = "dplyr",
"has_internet" = "curl",
"html_attr" = "rvest",
"html_children" = "rvest",
"html_node" = "rvest",
"html_nodes" = "rvest",
"html_table" = "rvest",
"html_text" = "rvest",
"inner_join" = "dplyr",
"insertText" = "rstudioapi",
"left_join" = "dplyr",
"new_pillar_shaft_simple" = "pillar",
"read_html" = "xml2",
"right_join" = "dplyr",
"semi_join" = "dplyr",
"showQuestion" = "rstudioapi")
# functions that are called directly
call_functions <- c(
# cleaner
"freq.default" = "cleaner",
# skimr
"inline_hist" = "skimr",
"sfl" = "skimr",
# set_mo_source
"read_excel" = "readxl",
# ggplot_rsi
"aes_string" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"facet_wrap" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"layer" = "ggplot2",
"position_fill" = "ggplot2",
"scale_fill_manual" = "ggplot2",
"scale_y_continuous" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
# ggplot_pca
"aes" = "ggplot2",
"arrow" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"expand_limits" = "ggplot2",
"geom_path" = "ggplot2",
"geom_point" = "ggplot2",
"geom_segment" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
"unit" = "ggplot2",
"xlab" = "ggplot2",
"ylab" = "ggplot2",
# resistance_predict
"aes" = "ggplot2",
"geom_errorbar" = "ggplot2",
"geom_point" = "ggplot2",
"geom_ribbon" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2"
)
import_functions <- c(import_functions, call_functions)
for (i in seq_len(length(import_functions))) {
fn <- names(import_functions)[i]
pkg <- unname(import_functions[i])
# function should exist in foreign pkg namespace
if (pkg %in% rownames(installed.packages())) {
tst <- !is.null(import_fn(name = fn, pkg = pkg, error_on_fail = FALSE))
expect_true(tst,
info = ifelse(tst,
"All external function references exist.",
paste0("Function ", pkg, "::", fn, "() does not exist anymore")))
}
}

78
tests/testthat/test-ab.R
View File

@ -1,78 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("ab.R")
test_that("as.ab works", {
skip_on_cran()
expect_equal(as.character(as.ab(c("J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
" eryt 123",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"))),
rep("ERY", 10))
expect_identical(class(as.ab("amox")), c("ab", "character"))
expect_identical(class(antibiotics$ab), c("ab", "character"))
expect_true(is.ab(as.ab("amox")))
expect_output(print(as.ab("amox")))
expect_output(print(data.frame(a = as.ab("amox"))))
expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
expect_warning(as.ab("UNKNOWN"))
expect_warning(as.ab(""))
expect_output(print(as.ab("amox")))
expect_equal(as.character(as.ab("Phloxapen")),
"FLC")
expect_equal(suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))),
c(NA, "TMP"))
expect_equal(as.character(as.ab("Amoxy + clavulaanzuur")),
"AMC")
expect_equal(as.character(as.ab(c("mreopenem", "co-maoxiclav"))),
c("MEM", "AMC"))
expect_message(as.ab("cipro mero"))
# assigning and subsetting
x <- antibiotics$ab
expect_s3_class(x[1], "ab")
expect_s3_class(x[[1]], "ab")
expect_s3_class(c(x[1], x[9]), "ab")
expect_s3_class(unique(x[1], x[9]), "ab")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
})

47
tests/testthat/test-ab_class_selectors.R
View File

@ -1,47 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("ab_class_selectors.R")
test_that("Antibiotic class selectors work", {
skip_on_cran()
if (suppressWarnings(require("dplyr"))) {
expect_lt(example_isolates %>% select(aminoglycosides()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(carbapenems()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins_1st()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins_2nd()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins_3rd()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins_4th()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(cephalosporins_5th()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(fluoroquinolones()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(glycopeptides()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(macrolides()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(oxazolidinones()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(penicillins()) %>% ncol(), ncol(example_isolates))
expect_lt(example_isolates %>% select(tetracyclines()) %>% ncol(), ncol(example_isolates))
}
})

69
tests/testthat/test-ab_property.R
View File

@ -1,69 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("ab_property.R")
test_that("ab_property works", {
skip_on_cran()
expect_identical(ab_name("AMX", language = NULL), "Amoxicillin")
expect_identical(as.character(ab_atc("AMX")), "J01CA04")
expect_identical(ab_cid("AMX"), as.integer(33613))
expect_equal(class(ab_tradenames("AMX")), "character")
expect_equal(class(ab_tradenames(c("AMX", "AMX"))), "list")
expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins")
expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins")
expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum")
expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin")
expect_identical(ab_name(21319, language = NULL), "Flucloxacillin")
expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin")
expect_identical(ab_ddd("AMX", "oral"), 1.5)
expect_identical(ab_ddd("AMX", "oral", units = TRUE), "g")
expect_identical(ab_ddd("AMX", "iv"), 3)
expect_identical(ab_ddd("AMX", "iv", units = TRUE), "g")
expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B"))
expect_equal(class(ab_info("AMX")), "list")
expect_error(ab_property("amox", "invalid property"))
expect_error(ab_name("amox", language = "INVALID"))
expect_output(print(ab_name("amox", language = NULL)))
expect_equal(ab_name("21066-6", language = NULL), "Ampicillin")
expect_equal(ab_loinc("ampicillin"),
c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5"))
expect_true(ab_url("AMX") %like% "whocc.no")
expect_warning(ab_url("ASP"))
})

77
tests/testthat/test-age.R
View File

@ -1,77 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("age.R")
test_that("age works", {
skip_on_cran()
expect_equal(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "2019-01-01"),
c(39, 34, 29))
expect_equal(age(x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01",
exact = TRUE),
c(0.6656393, 0.4191781, 0.1698630),
tolerance = 0.001)
expect_error(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = c("2019-01-01", "2019-01-01")))
expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "1975-01-01"))
expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"),
reference = "2019-01-01"))
expect_equal(length(age(x = c("2019-01-01", NA), na.rm = TRUE)),
1)
})
test_that("age_groups works", {
skip_on_cran()
ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
expect_equal(length(unique(age_groups(ages, 50))),
2)
expect_equal(length(unique(age_groups(ages, c(50, 60)))),
3)
expect_identical(class(age_groups(ages, "child")),
c("ordered", "factor"))
expect_identical(class(age_groups(ages, "elderly")),
c("ordered", "factor"))
expect_identical(class(age_groups(ages, "tens")),
c("ordered", "factor"))
expect_identical(class(age_groups(ages, "fives")),
c("ordered", "factor"))
expect_equal(length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)),
3)
})

106
tests/testthat/test-count.R
View File

@ -1,106 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("count.R")
test_that("counts work", {
skip_on_cran()
expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX))
expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX))
expect_equal(count_all(example_isolates$AMX), n_rsi(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(count_R(example_isolates$AMX), 804)
expect_equal(count_I(example_isolates$AMX), 3)
expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543)
expect_equal(count_R(example_isolates$AMX) + count_I(example_isolates$AMX),
suppressWarnings(count_IR(example_isolates$AMX)))
expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX))
# warning for speed loss
reset_all_thrown_messages()
expect_warning(count_resistant(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(count_resistant(example_isolates$AMC,
as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
if (suppressWarnings(require("dplyr"))) {
expect_equal(example_isolates %>% count_susceptible(AMC), 1433)
expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE), 1687)
expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), 1798)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936)
expect_identical(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE),
example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) +
example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE))
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)) %>%
pull(combination),
c(253, 465, 192, 558))
# count_df
expect_equal(
example_isolates %>% select(AMX) %>% count_df() %>% pull(value),
c(example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant())
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_IR = TRUE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
suppressWarnings(example_isolates$AMX %>% count_IR()))
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
example_isolates$AMX %>% count_I(),
example_isolates$AMX %>% count_R())
)
# grouping in rsi_calc_df() (= backbone of rsi_df())
expect_true("hospital_id" %in% (example_isolates %>%
group_by(hospital_id) %>%
select(hospital_id, AMX, CIP, gender) %>%
rsi_df() %>%
colnames()))
}
})

98
tests/testthat/test-data.R
View File

@ -1,98 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("data.R")
test_that("data sets are valid", {
skip_on_cran()
expect_true(check_dataset_integrity()) # in misc.R
# IDs should always be unique
expect_identical(nrow(microorganisms), length(unique(microorganisms$mo)))
expect_identical(class(microorganisms$mo), c("mo", "character"))
expect_identical(nrow(antibiotics), length(unique(antibiotics$ab)))
expect_identical(class(antibiotics$ab), c("ab", "character"))
# check cross table reference
expect_true(all(microorganisms.codes$mo %in% microorganisms$mo))
expect_true(all(example_isolates$mo %in% microorganisms$mo))
expect_true(all(microorganisms.translation$mo_new %in% microorganisms$mo))
expect_true(all(rsi_translation$mo %in% microorganisms$mo))
expect_true(all(rsi_translation$ab %in% antibiotics$ab))
expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant()
expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name))
expect_false(any(is.na(microorganisms.codes$code)))
expect_false(any(is.na(microorganisms.codes$mo)))
expect_false(any(microorganisms.translation$mo_old %in% microorganisms$mo))
expect_true(all(dosage$ab %in% antibiotics$ab))
expect_true(all(dosage$name %in% antibiotics$name))
# antibiotic names must always be coercible to their original AB code
expect_identical(as.ab(antibiotics$name), antibiotics$ab)
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, label = datasets[i])
}
})
test_that("creation of data sets is valid", {
skip_on_cran()
df <- AMR:::MO_lookup
expect_lt(nrow(df[which(df$prevalence == 1), ]), nrow(df[which(df$prevalence == 2), ]))
expect_lt(nrow(df[which(df$prevalence == 2), ]), nrow(df[which(df$prevalence == 3), ]))
expect_true(all(c("mo", "fullname",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"rank", "ref", "species_id", "source", "prevalence", "snomed",
"kingdom_index", "fullname_lower", "g_species") %in% colnames(df)))
expect_true(all(c("fullname", "fullname_new", "ref", "prevalence",
"fullname_lower", "g_species") %in% colnames(AMR:::MO.old_lookup)))
expect_s3_class(AMR:::MO_CONS, "mo")
})
test_that("CoL version info works", {
skip_on_cran()
expect_identical(class(catalogue_of_life_version()),
c("catalogue_of_life_version", "list"))
expect_output(print(catalogue_of_life_version()))
})
test_that("CoNS/CoPS are up to date", {
uncategorised <- subset(microorganisms,
genus == "Staphylococcus" &
!species %in% c("", "aureus") &
!mo %in% c(MO_CONS, MO_COPS))
expect(NROW(uncategorised) == 0,
failure_message = paste0("Staphylococcal species not categorised as CoNS/CoPS: S. ",
uncategorised$species, " (", uncategorised$mo, ")"))
})

168
tests/testthat/test-eucast_rules.R
View File

@ -1,168 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("eucast_rules.R")
test_that("EUCAST rules work", {
skip_on_cran()
# thoroughly check input table
expect_equal(colnames(eucast_rules_file),
c("if_mo_property", "like.is.one_of", "this_value",
"and_these_antibiotics", "have_these_values",
"then_change_these_antibiotics", "to_value",
"reference.rule", "reference.rule_group",
"reference.version",
"note"))
MOs_mentioned <- unique(eucast_rules_file$this_value)
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned)))
expect_length(MOs_mentioned[MOs_test != MOs_mentioned], 0)
expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing")))
expect_error(eucast_rules(x = "text"))
expect_error(eucast_rules(data.frame(a = "test")))
expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
expect_identical(colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE))))
expect_output(suppressMessages(eucast_rules(example_isolates, info = TRUE)))
a <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_output(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE))))
a <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "-", # Colistin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "R", # Colistin
stringsAsFactors = FALSE)
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
# piperacillin must be R in Enterobacteriaceae when tica is R
if (suppressWarnings(require("dplyr"))) {
expect_equal(suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(TIC = as.rsi("R"),
PIP = as.rsi("S")) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()),
"R")
}
# Azithromycin and Clarythromycin must be equal to Erythromycin
a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.rsi("R"),
CLR = factor("R"),
stringsAsFactors = FALSE),
version_expertrules = 3.1,
only_rsi_columns = FALSE)$CLR))
b <- example_isolates$ERY
expect_identical(a[!is.na(b)],
b[!is.na(b)])
# amox is inferred by benzylpenicillin in Kingella kingae
expect_equal(
suppressWarnings(
as.list(eucast_rules(
data.frame(mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE)
, info = FALSE))$AMX
),
"S")
# also test norf
if (suppressWarnings(require("dplyr"))) {
expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
}
# check verbose output
expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))
# AmpC de-repressed cephalo mutants
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = TRUE,
info = FALSE)$cefotax,
as.rsi(c("S", "R")))
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NA,
info = FALSE)$cefotax,
as.rsi(c("S", NA)))
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NULL,
info = FALSE)$cefotax,
as.rsi(c("S", "S")))
# EUCAST dosage -----------------------------------------------------------
expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3)
expect_s3_class(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame")
})
test_that("Custom EUCAST rules work", {
skip_on_cran()
x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
AMX == "S" ~ AMC == "S")
expect_output(print(x))
expect_output(print(c(x, x)))
expect_output(print(as.list(x, x)))
# this custom rules makes 8 changes
expect_equal(nrow(eucast_rules(example_isolates,
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE)),
8)
})

54
tests/testthat/test-filter_ab_class.R
View File

@ -1,54 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("filter_ab_class.R")
test_that("ATC-group filtering works", {
skip_on_cran()
if (suppressWarnings(require("dplyr"))) {
expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0)
expect_gt(example_isolates %>% filter_aminoglycosides() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_carbapenems() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_1st_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_2nd_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_3rd_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_4th_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_5th_cephalosporins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_fluoroquinolones() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_glycopeptides() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_macrolides() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_oxazolidinones() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_penicillins() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_tetracyclines() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_carbapenems("R", "all") %>% nrow(), 0)
expect_error(example_isolates %>% filter_carbapenems(result = "test"))
expect_error(example_isolates %>% filter_carbapenems(scope = "test"))
expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems())
}
})

194
tests/testthat/test-first_isolate.R
View File

@ -1,194 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("first_isolate.R")
test_that("first isolates work", {
skip_on_cran()
# all four methods
expect_equal(sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984)
expect_equal(sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265)
expect_equal(sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300)
expect_equal(sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1379)
# Phenotype-based, using key antimicrobials
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE), na.rm = TRUE),
1395)
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE), na.rm = TRUE),
1418)
# first non-ICU isolates
expect_equal(
sum(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient_id",
col_icu = "ward_icu",
info = TRUE,
icu_exclude = TRUE),
na.rm = TRUE),
941)
# set 1500 random observations to be of specimen type 'Urine'
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
x <- example_isolates
x$specimen <- "Other"
x[random_rows, "specimen"] <- "Urine"
expect_lt(
sum(
first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
info = TRUE),
na.rm = TRUE),
1501)
# same, but now exclude ICU
expect_lt(
sum(
first_isolate(x = x,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
col_icu = "ward_icu",
icu_exclude = TRUE,
info = TRUE),
na.rm = TRUE),
1501)
# "No isolates found"
test_iso <- example_isolates
test_iso$specimen <- "test"
expect_message(first_isolate(test_iso,
"date",
"patient_id",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "something_unexisting",
info = TRUE))
# printing of exclusion message
expect_message(first_isolate(example_isolates,
col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
col_testcode = "gender",
testcodes_exclude = "M",
info = TRUE))
# errors
expect_error(first_isolate("date", "patient_id", col_mo = "mo"))
expect_error(first_isolate(example_isolates,
col_date = "non-existing col",
col_mo = "mo"))
if (suppressWarnings(require("dplyr"))) {
# if mo is not an mo class, result should be the same
expect_identical(example_isolates %>%
mutate(mo = as.character(mo)) %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
info = FALSE),
example_isolates %>%
first_isolate(col_date = "date",
col_mo = "mo",
col_patient_id = "patient_id",
info = FALSE))
# support for WHONET
expect_message(example_isolates %>%
select(-patient_id) %>%
mutate(`First name` = "test",
`Last name` = "test",
Sex = "Female") %>%
first_isolate(info = TRUE))
# groups
x <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate())
y <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate(.))
expect_identical(x, y)
}
# missing dates should be no problem
df <- example_isolates
df[1:100, "date"] <- NA
expect_equal(
sum(
first_isolate(x = df,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
info = TRUE),
na.rm = TRUE),
1382)
# unknown MOs
test_unknown <- example_isolates
test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown, include_unknown = FALSE)),
1108)
expect_equal(sum(first_isolate(test_unknown, include_unknown = TRUE)),
1591)
test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown)),
1108)
# empty rsi results
expect_equal(sum(first_isolate(example_isolates, include_untested_rsi = FALSE)),
1366)
# shortcuts
expect_identical(filter_first_isolate(example_isolates),
subset(example_isolates, first_isolate(example_isolates)))
# notice that all mo's are distinct, so all are TRUE
expect_true(all(example_isolates %pm>%
pm_distinct(mo, .keep_all = TRUE) %pm>%
first_isolate(info = TRUE) == TRUE))
# only one isolate, so return fast
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))
})

90
tests/testthat/test-ggplot_rsi.R
View File

@ -1,90 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("ggplot_rsi.R")
test_that("ggplot_rsi works", {
skip_on_cran()
skip_if_not_installed("ggplot2")
skip_if_not_installed("dplyr")
if (suppressWarnings(require("dplyr")) & suppressWarnings(require("ggplot2"))) {
pdf(NULL) # prevent Rplots.pdf being created
# data should be equal
expect_equal(
(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi())$data %>% summarise_all(resistance) %>% as.double(),
example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double()
)
print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))
print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))
expect_equal(
(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>% summarise_all(resistance) %>% as.double(),
example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double()
)
expect_equal(
(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(resistance) %>% as.double(),
example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double()
)
expect_equal(
(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(count_resistant) %>% as.double(),
example_isolates %>% select(AMC, CIP) %>% summarise_all(count_resistant) %>% as.double()
)
# support for scale_type ab and mo
expect_equal(class((data.frame(mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data),
"data.frame")
expect_equal(class((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data),
"data.frame")
expect_equal(class((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data),
"data.frame")
# support for manual colours
expect_equal(class((ggplot(data.frame(x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6"))) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data),
"data.frame")
}
})

251
tests/testthat/test-mdro.R
View File

@ -1,251 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("mdro.R")
test_that("mdro works", {
skip_on_cran()
expect_error(suppressWarnings(mdro(example_isolates, country = "invalid", col_mo = "mo", info = TRUE)))
expect_error(suppressWarnings(mdro(example_isolates, country = "fr", info = TRUE)))
expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE))
expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE))))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE))))
expect_output(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE))))
# check class
expect_equal(class(outcome), c("ordered", "factor"))
expect_output(outcome <- mdro(example_isolates, "nl", info = TRUE))
# check class
expect_equal(class(outcome), c("ordered", "factor"))
# example_isolates should have these finding using Dutch guidelines
expect_equal(as.double(table(outcome)),
c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos
expect_equal(brmo(example_isolates, info = FALSE),
mdro(example_isolates, guideline = "BRMO", info = FALSE))
# test Dutch P. aeruginosa MDRO
expect_equal(
as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"),
cfta = "S",
cipr = "S",
mero = "S",
imip = "S",
gent = "S",
tobr = "S",
pita = "S"),
guideline = "BRMO",
col_mo = "mo",
info = FALSE)),
"Negative")
expect_equal(
as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"),
cefta = "R",
cipr = "R",
mero = "R",
imip = "R",
gent = "R",
tobr = "R",
pita = "R"),
guideline = "BRMO",
col_mo = "mo",
info = FALSE)),
"Positive")
# German 3MRGN and 4MRGN
expect_equal(as.character(mrgn(
data.frame(mo = c("E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
PIP = c("S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"),
CTX = c("S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"),
IPM = c("S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"),
CIP = c("S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"),
stringsAsFactors = FALSE))),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN"))
# MDR TB
expect_equal(
# select only rifampicine, mo will be determined automatically (as M. tuberculosis),
# number of mono-resistant strains should be equal to number of rifampicine-resistant strains
as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2],
count_R(example_isolates$RIF))
sample_rsi <- function() {
sample(c("S", "I", "R"),
size = 5000,
prob = c(0.5, 0.1, 0.4),
replace = TRUE)
}
x <- data.frame(rifampicin = sample_rsi(),
inh = sample_rsi(),
gatifloxacin = sample_rsi(),
eth = sample_rsi(),
pza = sample_rsi(),
MFX = sample_rsi(),
KAN = sample_rsi())
expect_gt(length(unique(mdr_tb(x))), 2)
# check the guideline by Magiorakos et al. (2012), the default guideline
stau <- data.frame(mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(stau)), c(1:4))
expect_s3_class(mdro(stau, verbose = TRUE), "data.frame")
ente <- data.frame(mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(ente)), c(1:4))
expect_s3_class(mdro(ente, verbose = TRUE), "data.frame")
entero <- data.frame(mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(entero)), c(1:4))
expect_s3_class(mdro(entero, verbose = TRUE), "data.frame")
pseud <- data.frame(mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(pseud)), c(1:4))
expect_s3_class(mdro(pseud, verbose = TRUE), "data.frame")
acin <- data.frame(mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
expect_equal(as.integer(mdro(acin)), c(1:4))
expect_s3_class(mdro(acin, verbose = TRUE), "data.frame")
# custom rules
custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A",
"ERY == 'R' & age > 60" ~ "Elderly Type B",
as_factor = TRUE)
expect_output(print(custom))
expect_output(print(c(custom, custom)))
expect_output(print(as.list(custom, custom)))
expect_output(x <- mdro(example_isolates, guideline = custom, info = TRUE))
expect_equal(as.double(table(x)), c(1070, 198, 732))
expect_output(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE)))
expect_error(custom_mdro_guideline())
expect_error(custom_mdro_guideline("test"))
expect_error(custom_mdro_guideline("test" ~ c(1:3)))
expect_error(custom_mdro_guideline("test" ~ A))
expect_warning(mdro(example_isolates,
# since `test` gives an error, it will be ignored with a warning
guideline = custom_mdro_guideline(test ~ "A"),
info = FALSE))
# print groups
if (suppressWarnings(require("dplyr"))) {
expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE))
expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
}
})

143
tests/testthat/test-mic.R
View File

@ -1,143 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("mic.R")
test_that("mic works", {
skip_on_cran()
expect_true(as.mic(8) == as.mic("8"))
expect_true(as.mic("1") > as.mic("<=0.0625"))
expect_true(as.mic("1") < as.mic(">=32"))
expect_true(is.mic(as.mic(8)))
expect_equal(as.double(as.mic(">=32")), 32)
expect_equal(as.numeric(as.mic(">=32")), 32)
expect_equal(as.integer(as.mic(">=32")), 32)
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA)
# all levels should be valid MICs
x <- as.mic(c(2, 4))
expect_s3_class(x[1], "mic")
expect_s3_class(x[[1]], "mic")
expect_s3_class(c(x[1], x[9]), "mic")
expect_s3_class(unique(x[1], x[9]), "mic")
expect_s3_class(droplevels(c(x[1], x[9])), "mic")
x[2] <- 32
expect_s3_class(x, "mic")
expect_warning(as.mic("INVALID VALUE"))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) {
expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8))), "gg")
expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg")
}
expect_output(print(as.mic(c(1, 2, 4, 8))))
expect_s3_class(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
if (suppressWarnings(require("dplyr"))) {
expect_output(print(tibble(m = as.mic(2:4))))
}
})
test_that("mathematical functions on mic work", {
skip_on_cran()
x <- random_mic(50)
x_double <- as.double(gsub("[<=>]+", "", as.character(x)))
suppressWarnings(expect_identical(mean(x), mean(x_double)))
suppressWarnings(expect_identical(median(x), median(x_double)))
suppressWarnings(expect_identical(quantile(x), quantile(x_double)))
suppressWarnings(expect_identical(abs(x), abs(x_double)))
suppressWarnings(expect_identical(sign(x), sign(x_double)))
suppressWarnings(expect_identical(sqrt(x), sqrt(x_double)))
suppressWarnings(expect_identical(floor(x), floor(x_double)))
suppressWarnings(expect_identical(ceiling(x), ceiling(x_double)))
suppressWarnings(expect_identical(trunc(x), trunc(x_double)))
suppressWarnings(expect_identical(round(x), round(x_double)))
suppressWarnings(expect_identical(signif(x), signif(x_double)))
suppressWarnings(expect_identical(exp(x), exp(x_double)))
suppressWarnings(expect_identical(log(x), log(x_double)))
suppressWarnings(expect_identical(log10(x), log10(x_double)))
suppressWarnings(expect_identical(log2(x), log2(x_double)))
suppressWarnings(expect_identical(expm1(x), expm1(x_double)))
suppressWarnings(expect_identical(log1p(x), log1p(x_double)))
suppressWarnings(expect_identical(cos(x), cos(x_double)))
suppressWarnings(expect_identical(sin(x), sin(x_double)))
suppressWarnings(expect_identical(tan(x), tan(x_double)))
suppressWarnings(expect_identical(cospi(x), cospi(x_double)))
suppressWarnings(expect_identical(sinpi(x), sinpi(x_double)))
suppressWarnings(expect_identical(tanpi(x), tanpi(x_double)))
suppressWarnings(expect_identical(acos(x), acos(x_double)))
suppressWarnings(expect_identical(asin(x), asin(x_double)))
suppressWarnings(expect_identical(atan(x), atan(x_double)))
suppressWarnings(expect_identical(cosh(x), cosh(x_double)))
suppressWarnings(expect_identical(sinh(x), sinh(x_double)))
suppressWarnings(expect_identical(tanh(x), tanh(x_double)))
suppressWarnings(expect_identical(acosh(x), acosh(x_double)))
suppressWarnings(expect_identical(asinh(x), asinh(x_double)))
suppressWarnings(expect_identical(atanh(x), atanh(x_double)))
suppressWarnings(expect_identical(lgamma(x), lgamma(x_double)))
suppressWarnings(expect_identical(gamma(x), gamma(x_double)))
suppressWarnings(expect_identical(digamma(x), digamma(x_double)))
suppressWarnings(expect_identical(trigamma(x), trigamma(x_double)))
suppressWarnings(expect_identical(cumsum(x), cumsum(x_double)))
suppressWarnings(expect_identical(cumprod(x), cumprod(x_double)))
suppressWarnings(expect_identical(cummax(x), cummax(x_double)))
suppressWarnings(expect_identical(cummin(x), cummin(x_double)))
suppressWarnings(expect_identical(!x, !(x_double)))
suppressWarnings(expect_identical(all(x), all(x_double)))
suppressWarnings(expect_identical(any(x), any(x_double)))
suppressWarnings(expect_identical(sum(x), sum(x_double)))
suppressWarnings(expect_identical(prod(x), prod(x_double)))
suppressWarnings(expect_identical(min(x), min(x_double)))
suppressWarnings(expect_identical(max(x), max(x_double)))
suppressWarnings(expect_identical(range(x), range(x_double)))
el1 <- random_mic(50)
el1_double <- as.double(gsub("[<=>]+", "", as.character(el1)))
el2 <- random_mic(50)
el2_double <- as.double(gsub("[<=>]+", "", as.character(el2)))
suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double))
suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double))
suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double))
suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double))
suppressWarnings(expect_identical(el1 ^ el2, el1_double ^ el2_double))
suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double))
suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double))
suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double))
suppressWarnings(expect_identical(el1 | el2, el1_double | el2_double))
suppressWarnings(expect_identical(el1 == el2, el1_double == el2_double))
suppressWarnings(expect_identical(el1 != el2, el1_double != el2_double))
suppressWarnings(expect_identical(el1 < el2, el1_double < el2_double))
suppressWarnings(expect_identical(el1 <= el2, el1_double <= el2_double))
suppressWarnings(expect_identical(el1 >= el2, el1_double >= el2_double))
suppressWarnings(expect_identical(el1 > el2, el1_double > el2_double))
})

308
tests/testthat/test-mo.R
View File

@ -1,308 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("mo.R")
test_that("as.mo works", {
skip_on_cran()
MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo)))
expect_identical(
as.character(as.mo(c("E. coli", "H. influenzae"))),
c("B_ESCHR_COLI", "B_HMPHL_INFL"))
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR")
expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR")
expect_equal(as.character(as.mo("Esch spp.")), "B_ESCHR")
expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter
expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN")
expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL")
expect_equal(as.character(as.mo("K. pneu rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis
expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL")
expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC")
expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP")
expect_equal(as.character(as.mo("Strepto")), "B_STRPT")
expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus
expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB")
expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0)
expect_equal(as.character(as.mo(c("mycobacterie", "mycobakterium"))), c("B_MYCBC", "B_MYCBC"))
expect_equal(as.character(as.mo(c("GAS", "GBS", "a MGS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_MILL", "B_STRPT_HAEM"))
expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes
# GLIMS
expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL")
expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR")
expect_equal(as.character(as.mo("VRE")), "B_ENTRC")
expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG")
expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI")
expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL")
expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP"))
# prevalent MO
expect_identical(
suppressWarnings(as.character(
as.mo(c("stau",
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureeuzz",
"Staphylococcus aureus",
"MRSA",
"VISA")))),
rep("B_STPHY_AURS", 9))
expect_identical(
as.character(
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
rep("B_ESCHR_COLI", 6))
# unprevalent MO
expect_identical(
as.character(
as.mo(c("parnod",
"P. nodosa",
"P nodosa",
"Paraburkholderia nodosa"))),
rep("B_PRBRK_NODS", 4))
# empty values
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
expect_warning(as.mo("ab"))
expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))),
c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI"))
# check for Becker classification
expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR")
expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS")
expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS")
# aureus must only be influenced if Becker = "all"
expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS")
# check for Lancefield classification
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN")
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA")
expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC")
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B
expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = FALSE)), "B_STRPT_DYSG_EQSM")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
# Enterococci must only be influenced if Lancefield = "all"
expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D
expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN")
expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN")
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
if (suppressWarnings(require("dplyr"))) {
# select with one column
expect_identical(
example_isolates[1:10, ] %>%
left_join_microorganisms() %>%
select(genus) %>%
as.mo() %>%
as.character(),
c("B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY",
"B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY"))
# select with two columns
expect_identical(
example_isolates[1:10, ] %>%
pull(mo),
example_isolates[1:10, ] %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo())
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# test pull
expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
# unknown results
expect_warning(as.mo(c("INVALID", "Yeah, unknown")))
# print
expect_output(print(as.mo(c("B_ESCHR_COLI", NA))))
# test data.frame
expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1)
# check empty values
expect_equal(as.character(suppressWarnings(as.mo(""))),
NA_character_)
# check less prevalent MOs
expect_equal(as.character(as.mo("Gomphosphaeria aponina delicatula")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("Gomphosphaeria apo del")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("G apo deli")), "B_GMPHS_APNN_DLCT")
expect_equal(as.character(as.mo("Gomphosphaeria aponina")), "B_GMPHS_APNN")
expect_equal(as.character(as.mo("Gomphosphaeria species")), "B_GMPHS")
expect_equal(as.character(as.mo("Gomphosphaeria")), "B_GMPHS")
expect_equal(as.character(as.mo(" B_GMPHS_APNN ")), "B_GMPHS_APNN")
expect_equal(as.character(as.mo("g aponina")), "B_GMPHS_APNN")
# check old names
expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT")
print(mo_renamed())
expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT"))
# check uncertain names
expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS")
expect_equal(suppressWarnings(as.character(as.mo("staaur extratest", allow_uncertain = FALSE))), "UNKNOWN")
expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE))
expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS")
expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS")
expect_equal(suppressMessages(as.character(as.mo(c("s aur THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_ANRB", "B_STPHY_AURS_ANRB"))
# predefined reference_df
expect_equal(as.character(as.mo("TestingOwnID",
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))),
"B_ESCHR_COLI")
expect_equal(as.character(as.mo(c("TestingOwnID", "E. coli"),
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI"))
expect_warning(as.mo("TestingOwnID", reference_df = NULL))
expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID")))
# combination of existing mo and other code
expect_identical(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI"))
# from different sources
expect_equal(as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI"))),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI"))
# hard to find
expect_equal(as.character(suppressMessages(as.mo(
c("Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena")))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG"))
expect_output(print(mo_uncertainties()))
x <- as.mo("S. aur")
# many hits
expect_output(print(mo_uncertainties()))
# Salmonella (City) are all actually Salmonella enterica spp (City)
expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
c("Salmonella enterica", "Salmonella enterica", "Salmonella"))
# no virusses
expect_equal(as.character(as.mo("Virus")), NA_character_)
# summary
expect_equal(length(summary(example_isolates$mo)), 6)
# WHONET codes and NA/NaN
expect_equal(as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)),
rep(NA_character_, 3))
expect_equal(as.character(as.mo("con")), "UNKNOWN")
expect_equal(as.character(as.mo("xxx")), NA_character_)
expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI"))
expect_equal(as.character(as.mo(c("other", "none", "unknown"))),
rep("UNKNOWN", 3))
expect_null(mo_failures())
expect_error(translate_allow_uncertain(5))
# debug mode
expect_output(print(suppressMessages(suppressWarnings(as.mo("kshgcjkhsdgkshjdfsfvsdfv", debug = TRUE, allow_uncertain = 3)))))
# ..coccus
expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN"))
# yeasts and fungi
expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS"))
if (suppressWarnings(require("dplyr"))) {
# print tibble
expect_output(print(tibble(mo = as.mo("B_ESCHR_COLI"))))
}
# assigning and subsetting
x <- example_isolates$mo
expect_s3_class(x[1], "mo")
expect_s3_class(x[[1]], "mo")
expect_s3_class(c(x[1], x[9]), "mo")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# ignoring patterns
expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA))
# frequency tables
if (suppressWarnings(require("cleaner"))) {
expect_s3_class(cleaner::freq(example_isolates$mo), "freq")
}
})

142
tests/testthat/test-mo_property.R
View File

@ -1,142 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("mo_property.R")
test_that("mo_property works", {
skip_on_cran()
expect_equal(mo_kingdom("Escherichia coli"), "Bacteria")
expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli"))
expect_equal(mo_phylum("Escherichia coli"), "Proteobacteria")
expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria")
expect_equal(mo_order("Escherichia coli"), "Enterobacterales")
expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae")
expect_equal(mo_genus("Escherichia coli"), "Escherichia")
expect_equal(mo_species("Escherichia coli"), "coli")
expect_equal(mo_subspecies("Escherichia coli"), "")
expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli")
expect_equal(mo_name("Escherichia coli"), "Escherichia coli")
expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria")
expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative")
expect_equal(class(mo_taxonomy("Escherichia coli")), "list")
expect_equal(names(mo_taxonomy("Escherichia coli")), c("kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies"))
expect_equal(mo_synonyms("Escherichia coli"), NULL)
expect_gt(length(mo_synonyms("Candida albicans")), 1)
expect_equal(class(mo_synonyms(c("Candida albicans", "Escherichia coli"))), "list")
expect_equal(names(mo_info("Escherichia coli")), c("kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies",
"synonyms", "gramstain", "url", "ref",
"snomed"))
expect_equal(class(mo_info(c("Escherichia coli", "Staphylococcus aureus"))), "list")
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
expect_equal(mo_year("Escherichia coli"), 1919)
expect_equal(mo_shortname("Escherichia coli"), "E. coli")
expect_equal(mo_shortname("Escherichia"), "Escherichia")
expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS")
expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae")
expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS")
expect_true(mo_url("Candida albicans") %like% "catalogueoflife.org")
expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
# test integrity
MOs <- microorganisms
expect_identical(MOs$fullname, mo_fullname(MOs$fullname, language = "en"))
# check languages
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien")
expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief")
expect_output(print(mo_gramstain("Escherichia coli", language = "en")))
expect_output(print(mo_gramstain("Escherichia coli", language = "de")))
expect_output(print(mo_gramstain("Escherichia coli", language = "nl")))
expect_output(print(mo_gramstain("Escherichia coli", language = "es")))
expect_output(print(mo_gramstain("Escherichia coli", language = "pt")))
expect_output(print(mo_gramstain("Escherichia coli", language = "it")))
expect_output(print(mo_gramstain("Escherichia coli", language = "fr")))
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
dutch <- mo_name(microorganisms$fullname, language = "nl") # should be transformable to English again
expect_identical(mo_name(dutch, language = NULL), microorganisms$fullname) # gigantic test - will run ALL names
# manual property function
expect_error(mo_property("Escherichia coli", property = c("tsn", "fullname")))
expect_error(mo_property("Escherichia coli", property = "UNKNOWN"))
expect_identical(mo_property("Escherichia coli", property = "fullname"),
mo_fullname("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "genus"),
mo_genus("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "species"),
mo_species("Escherichia coli"))
expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968")
expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999")
expect_true(112283007 %in% mo_snomed("Escherichia coli"))
# old codes must throw a warning in mo_* family
expect_message(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR")))
# outcome of mo_fullname must always return the fullname from the data set
x <- data.frame(mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en"),
stringsAsFactors = FALSE)
expect_equal(nrow(subset(x, f1 != f2)), 0)
# is gram pos/neg (also return FALSE for all non-bacteria)
expect_equal(mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE))
expect_equal(mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE))
# is intrinsic resistant
expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"),
"vanco"),
c(TRUE, FALSE, FALSE))
# with reference data
expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli")
if (suppressWarnings(require("dplyr"))) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710)
}
})

70
tests/testthat/test-pca.R
View File

@ -1,70 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("pca.R")
test_that("PCA works", {
skip_on_cran()
resistance_data <- structure(list(order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(list(order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE))
pca_model <- pca(resistance_data)
expect_s3_class(pca_model, "pca")
pdf(NULL) # prevent Rplots.pdf being created
if (suppressWarnings(require("ggplot2"))) {
ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE)
}
if (suppressWarnings(require("dplyr"))) {
resistance_data <- example_isolates %>%
group_by(order = mo_order(mo),
genus = mo_genus(mo)) %>%
summarise_if(is.rsi, resistance, minimum = 0)
pca_result <- resistance_data %>%
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
expect_s3_class(pca_result, "prcomp")
if (suppressWarnings(require("ggplot2"))) {
ggplot_pca(pca_result, ellipse = TRUE)
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
}
}
})

140
tests/testthat/test-proportion.R
View File

@ -1,140 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("proportion.R")
test_that("proportions works", {
skip_on_cran()
expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX))
expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001)
expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001)
expect_equal(1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX),
proportion_S(example_isolates$AMX))
expect_equal(proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_IR(example_isolates$AMX))
expect_equal(proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_SI(example_isolates$AMX))
expect_equal(example_isolates %>% proportion_SI(AMC),
0.7626397,
tolerance = 0.0001)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN),
0.9408,
tolerance = 0.0001)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE),
0.9382647,
tolerance = 0.0001)
if (suppressWarnings(require("dplyr"))) {
# percentages
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(R = proportion_R(CIP, as_percent = TRUE),
I = proportion_I(CIP, as_percent = TRUE),
S = proportion_S(CIP, as_percent = TRUE),
n = n_rsi(CIP),
total = n()) %>%
pull(n) %>%
sum(),
1409)
# count of cases
expect_equal(example_isolates %>%
group_by(hospital_id) %>%
summarise(cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_rsi(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_rsi(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_rsi(CIP, GEN)) %>%
pull(combination_n),
c(305, 617, 241, 711))
# proportion_df
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value),
c(example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R())
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_IR = TRUE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_IR())
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_I(),
example_isolates$AMX %>% proportion_R())
)
}
reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC,
example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN)))
expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN))),
1879)
# check for errors
expect_error(proportion_IR("test", minimum = "test"))
expect_error(proportion_IR("test", as_percent = "test"))
expect_error(proportion_I("test", minimum = "test"))
expect_error(proportion_I("test", as_percent = "test"))
expect_error(proportion_S("test", minimum = "test"))
expect_error(proportion_S("test", as_percent = "test"))
expect_error(proportion_S("test", also_single_tested = TRUE))
# check too low amount of isolates
expect_identical(suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
expect_identical(suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
expect_identical(suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_)
# warning for speed loss
reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(proportion_I(as.character(example_isolates$GEN)))
reset_all_thrown_messages()
expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date"]))
})

102
tests/testthat/test-resistance_predict.R
View File

@ -1,102 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("resistance_predict.R")
test_that("prediction of rsi works", {
skip_on_cran()
if (suppressWarnings(require("dplyr"))) {
expect_output(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE) %>%
pull("value"))
# AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20])
}
expect_output(x <- suppressMessages(resistance_predict(example_isolates,
col_ab = "AMX",
year_min = 2010,
model = "binomial",
info = TRUE)))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x))
if (suppressWarnings(require("ggplot2"))) {
expect_silent(ggplot_rsi_predict(x))
expect_silent(ggplot(x))
expect_error(ggplot_rsi_predict(example_isolates))
}
expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE))
# almost all E. coli are MEM S in the Netherlands :)
expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE))
})

192
tests/testthat/test-rsi.R
View File

@ -1,192 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("rsi.R")
test_that("rsi works", {
skip_on_cran()
expect_true(as.rsi("S") < as.rsi("I"))
expect_true(as.rsi("I") < as.rsi("R"))
expect_true(is.rsi(as.rsi("S")))
x <- example_isolates$AMX
expect_s3_class(x[1], "rsi")
expect_s3_class(x[[1]], "rsi")
expect_s3_class(c(x[1], x[9]), "rsi")
expect_s3_class(unique(x[1], x[9]), "rsi")
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.rsi(c("S", "I", "R"))))
expect_silent(plot(as.rsi(c("S", "I", "R"))))
if (suppressWarnings(require("ggplot2"))) expect_s3_class(ggplot(as.rsi(c("S", "I", "R"))), "gg")
expect_output(print(as.rsi(c("S", "I", "R"))))
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
expect_equal(summary(as.rsi(c("S", "R"))),
structure(c("Class" = "rsi",
"%R" = "50.0% (n=1)",
"%SI" = "50.0% (n=1)",
"- %S" = "50.0% (n=1)",
"- %I" = " 0.0% (n=0)"), class = c("summaryDefault", "table")))
expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
rep(FALSE, length(example_isolates)))
expect_error(as.rsi.mic(as.mic(16)))
expect_error(as.rsi.disk(as.disk(16)))
expect_error(get_guideline("this one does not exist"))
if (suppressWarnings(require("dplyr"))) {
# 40 rsi columns
expect_equal(example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is.rsi.eligible) %>%
as.logical() %>%
sum(),
40)
expect_equal(sum(is.rsi(example_isolates)), 40)
expect_output(print(tibble(ab = as.rsi("S"))))
}
if (suppressWarnings(require("skimr"))) {
expect_s3_class(skim(example_isolates),
"data.frame")
if (suppressWarnings(require("dplyr"))) {
expect_s3_class(example_isolates %>%
mutate(m = as.mic(2),
d = as.disk(20)) %>%
skim(),
"data.frame")
}
}
})
test_that("mic2rsi works", {
skip_on_cran()
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
expect_equal(as.character(
as.rsi(x = as.mic(c(0.125, 0.5, 1, 2, 4)),
mo = "B_STRPT_PNMN",
ab = "AMP",
guideline = "EUCAST 2020")),
c("S", "S", "I", "I", "R"))
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
expect_equal(as.character(
as.rsi(x = as.mic(c(1, 2, 4, 8, 16)),
mo = "B_STRPT_PNMN",
ab = "AMX",
guideline = "CLSI 2019")),
c("S", "S", "I", "R", "R"))
# cutoffs at MIC = 8
expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("S"))
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R"))
if (suppressWarnings(require("dplyr"))) {
expect_true(suppressWarnings(example_isolates %>%
mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>%
as.rsi() %>%
pull(amox_mic) %>%
is.rsi()))
}
})
test_that("disk2rsi works", {
skip_on_cran()
expect_equal(as.character(
as.rsi(x = as.disk(22),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"S")
expect_equal(as.character(
as.rsi(x = as.disk(18),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"I")
expect_equal(as.character(
as.rsi(x = as.disk(10),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"R")
if (suppressWarnings(require("dplyr"))) {
expect_true(example_isolates %>%
mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>%
is.rsi())
}
# frequency tables
if (suppressWarnings(require("cleaner"))) {
expect_s3_class(cleaner::freq(example_isolates$AMX), "freq")
}
})
test_that("data.frame2rsi works", {
skip_on_cran()
df <- data.frame(microorganism = "Escherichia coli",
AMP = as.mic(8),
CIP = as.mic(0.256),
GEN = as.disk(18),
TOB = as.disk(16),
ERY = "R", # note about assigning <rsi> class
CLR = "V") # note about cleaning
expect_s3_class(suppressWarnings(as.rsi(df)),
"data.frame")
expect_s3_class(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")))$amoxi),
"rsi")
expect_warning(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32))))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
uti = TRUE)))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood"))))
})

117
tests/testthat/test-zzz.R
View File

@ -1,117 +0,0 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 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/ #
# ==================================================================== #
context("zzz.R")
test_that("imports work", {
skip_on_cran()
# Check if these function still exist in the package (all are in Suggests field)
# Since GitHub Action runs every night, we will get emailed when a dependency fails based on this unit test
# functions used by import_fn()
import_functions <- c(
"anti_join" = "dplyr",
"cur_column" = "dplyr",
"full_join" = "dplyr",
"has_internet" = "curl",
"html_attr" = "rvest",
"html_children" = "rvest",
"html_node" = "rvest",
"html_nodes" = "rvest",
"html_table" = "rvest",
"html_text" = "rvest",
"inner_join" = "dplyr",
"insertText" = "rstudioapi",
"left_join" = "dplyr",
"new_pillar_shaft_simple" = "pillar",
"read_html" = "xml2",
"right_join" = "dplyr",
"semi_join" = "dplyr",
"showQuestion" = "rstudioapi")
# functions that are called directly
call_functions <- c(
# cleaner
"freq.default" = "cleaner",
# skimr
"inline_hist" = "skimr",
"sfl" = "skimr",
# set_mo_source
"read_excel" = "readxl",
# ggplot_rsi
"aes_string" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"facet_wrap" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"layer" = "ggplot2",
"position_fill" = "ggplot2",
"scale_fill_manual" = "ggplot2",
"scale_y_continuous" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
# ggplot_pca
"aes" = "ggplot2",
"arrow" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"expand_limits" = "ggplot2",
"geom_path" = "ggplot2",
"geom_point" = "ggplot2",
"geom_segment" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
"unit" = "ggplot2",
"xlab" = "ggplot2",
"ylab" = "ggplot2",
# resistance_predict
"aes" = "ggplot2",
"geom_errorbar" = "ggplot2",
"geom_point" = "ggplot2",
"geom_ribbon" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2"
)
import_functions <- c(import_functions, call_functions)
for (i in seq_len(length(import_functions))) {
fn <- names(import_functions)[i]
pkg <- unname(import_functions[i])
# function should exist in foreign pkg namespace
if (pkg %in% rownames(installed.packages())) {
expect(!is.null(import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
failure_message = paste0("Function ", pkg, "::", fn, "() does not exist anymore"))
}
}
})

13
tests/testthat.R → tests/tinytest.R Executable file → Normal file
View File

@ -23,14 +23,9 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# the testthat package is in Suggests, but very old R versions will not be
# able to install it. Yet, we want basic R CMD CHECK's in those R versions
# as well, so only run unit tests in later R versions:
if (require("testthat", warn.conflicts = FALSE)) {
# test only on GitHub Actions and at home - not on CRAN as tests are lengthy
if (identical(Sys.getenv("R_TINYTEST"), "true")) {
library(tinytest)
library(AMR)
# print non-base packages
print(as.data.frame(utils::installed.packages())[which(is.na(as.data.frame(utils::installed.packages())$Priority)),
"Version",
drop = FALSE])
test_check("AMR")
test_package("AMR")
}