mirror of
https://github.com/msberends/AMR.git
synced 2024-12-24 18:46:14 +01:00
(v1.6.0.9031) tinytest unit tests
This commit is contained in:
parent
9a381c8d18
commit
d8c91d5876
42
.github/workflows/check.yaml
vendored
42
.github/workflows/check.yaml
vendored
@ -93,28 +93,13 @@ 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: 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: 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: Install Linux dependencies
|
||||
if: runner.os == 'Linux'
|
||||
@ -123,12 +108,19 @@ 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: |
|
||||
options(width = 100)
|
||||
@ -145,6 +137,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
|
||||
@ -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
|
||||
|
@ -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
9
NEWS.md
@ -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
|
||||
|
||||
|
Binary file not shown.
47
data-raw/_install_deps.R
Normal file
47
data-raw/_install_deps.R
Normal 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)
|
@ -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>
|
||||
|
||||
|
@ -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>
|
||||
|
||||
|
@ -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>
|
||||
|
||||
|
@ -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>
|
||||
|
||||
|
@ -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>
|
||||
|
||||
|
@ -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><rsi></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>"<=.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>
|
||||
|
@ -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
|
||||
|
@ -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>
|
||||
|
||||
|
@ -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
39
inst/tinytest/test-_deprecated.R
Normal 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))
|
@ -23,46 +23,33 @@
|
||||
# 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%")
|
||||
})
|
||||
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")
|
||||
})
|
||||
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_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))
|
||||
}
|
||||
})
|
||||
|
||||
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)))
|
||||
}
|
||||
|
||||
})
|
||||
|
@ -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"))
|
@ -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")
|
||||
})
|
@ -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
63
inst/tinytest/test-ab_property.R
Normal 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"))
|
@ -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))
|
||||
|
||||
# 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),
|
||||
expect_equal(length(age(x = c("2019-01-01", NA), na.rm = TRUE)),
|
||||
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)))
|
||||
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)
|
@ -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"))
|
||||
})
|
||||
}
|
@ -23,9 +23,4 @@
|
||||
# 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")
|
@ -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
99
inst/tinytest/test-count.R
Normal 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
84
inst/tinytest/test-data.R
Normal 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, ")")))
|
@ -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_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)))
|
||||
|
||||
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))))
|
||||
}
|
||||
|
||||
})
|
||||
if (suppressWarnings(require("dplyr"))) {
|
||||
expect_stdout(print(tibble(d = as.disk(12))))
|
||||
}
|
@ -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))
|
||||
|
||||
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")
|
||||
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_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")
|
||||
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_rsi(100), "rsi")
|
||||
})
|
||||
expect_identical(which(x$out), which(y$out))
|
||||
}
|
158
inst/tinytest/test-eucast_rules.R
Executable file
158
inst/tinytest/test-eucast_rules.R
Executable 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
48
inst/tinytest/test-filter_ab_class.R
Normal 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
182
inst/tinytest/test-first_isolate.R
Executable 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))
|
@ -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"))
|
||||
# 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)
|
||||
|
||||
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ]))
|
||||
})
|
||||
# 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)))
|
@ -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
112
inst/tinytest/test-ggplot_rsi.R
Normal 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
42
inst/tinytest/test-guess_ab_col.R
Normal 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")
|
@ -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"),
|
||||
expect_identical(italicise_taxonomy("test for E. coli"),
|
||||
"test for *E. coli*")
|
||||
expect_identical(italicise_taxonomy("test for E. coli"),
|
||||
expect_identical(italicise_taxonomy("test for E. coli"),
|
||||
italicize_taxonomy("test for E. coli"))
|
||||
if (has_colour()) {
|
||||
if (has_colour()) {
|
||||
expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"),
|
||||
"test for \033[3mE. coli\033[23m")
|
||||
}
|
||||
})
|
||||
}
|
53
tests/testthat/test-episode.R → inst/tinytest/test-join_microorganisms.R
Normal file → Executable file
53
tests/testthat/test-episode.R → inst/tinytest/test-join_microorganisms.R
Normal file → Executable 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()
|
||||
expect_true(ncol(unjoined) < ncol(inner))
|
||||
expect_true(nrow(unjoined) == nrow(inner))
|
||||
|
||||
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_true(ncol(unjoined) < ncol(left))
|
||||
expect_true(nrow(unjoined) == nrow(left))
|
||||
|
||||
expect_equal(get_episode(test_df$date, 365),
|
||||
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3))
|
||||
expect_true(ncol(semi) == ncol(semi))
|
||||
expect_true(nrow(semi) == nrow(semi))
|
||||
|
||||
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_true(nrow(anti) == 0)
|
||||
|
||||
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_true(nrow(unjoined) < nrow(right))
|
||||
expect_true(nrow(unjoined) < nrow(full))
|
||||
|
||||
expect_identical(which(x$out), which(y$out))
|
||||
}
|
||||
})
|
||||
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
36
inst/tinytest/test-key_antimicrobials.R
Normal 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), ]))
|
@ -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)
|
@ -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
238
inst/tinytest/test-mdro.R
Executable 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
136
inst/tinytest/test-mic.R
Executable 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
297
inst/tinytest/test-mo.R
Normal 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
129
inst/tinytest/test-mo_property.R
Normal 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
63
inst/tinytest/test-pca.R
Normal 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
130
inst/tinytest/test-proportion.R
Executable 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"]))
|
@ -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
95
inst/tinytest/test-resistance_predict.R
Normal 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
157
inst/tinytest/test-rsi.R
Normal 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,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),
|
||||
expect_equal(skewness(example_isolates$age),
|
||||
-1.212888,
|
||||
tolerance = 0.00001)
|
||||
expect_equal(unname(skewness(data.frame(example_isolates$age))),
|
||||
expect_equal(unname(skewness(data.frame(example_isolates$age))),
|
||||
-1.212888,
|
||||
tolerance = 0.00001)
|
||||
expect_equal(skewness(matrix(example_isolates$age)),
|
||||
expect_equal(skewness(matrix(example_isolates$age)),
|
||||
-1.212888,
|
||||
tolerance = 0.00001)
|
||||
})
|
112
inst/tinytest/test-zzz.R
Normal file
112
inst/tinytest/test-zzz.R
Normal 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")))
|
||||
}
|
||||
}
|
@ -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"))
|
||||
})
|
@ -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))
|
||||
}
|
||||
})
|
@ -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"))
|
||||
})
|
@ -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)
|
||||
|
||||
})
|
@ -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()))
|
||||
}
|
||||
|
||||
})
|
@ -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, ")"))
|
||||
})
|
@ -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)
|
||||
})
|
@ -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())
|
||||
}
|
||||
})
|
@ -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))
|
||||
})
|
@ -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")
|
||||
|
||||
}
|
||||
})
|
@ -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))
|
||||
}
|
||||
})
|
@ -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))
|
||||
})
|
@ -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")
|
||||
}
|
||||
|
||||
})
|
@ -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)
|
||||
}
|
||||
})
|
@ -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)
|
||||
}
|
||||
}
|
||||
})
|
@ -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"]))
|
||||
})
|
@ -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))
|
||||
})
|
@ -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"))))
|
||||
})
|
@ -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
13
tests/testthat.R → tests/tinytest.R
Executable file → Normal 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")
|
||||
}
|
Loading…
Reference in New Issue
Block a user