(v1.6.0.9023) new unit test flow

This commit is contained in:
dr. M.S. (Matthijs) Berends 2021-05-13 19:31:47 +02:00
parent 655b813e99
commit aeea00881e
34 changed files with 408 additions and 355 deletions

View File

@ -96,48 +96,44 @@ jobs:
- uses: r-lib/actions/setup-pandoc@master
- name: Query dependencies
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
# if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
run: |
install.packages('remotes')
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.1' && matrix.config.r != '3.2'
if: runner.os != 'Windows'
# && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
uses: actions/cache@v1
with:
path: ${{ env.R_LIBS_USER }}
key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('.github/depends.Rds') }}
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-
- name: Install Linux dependencies
if: runner.os == 'Linux' && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
env:
RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
run: |
Rscript -e "remotes::install_github('r-hub/sysreqs')"
sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
sudo -s eval "$sysreqs"
# - name: Install Linux dependencies
# if: runner.os == 'Linux' && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
# env:
# RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
# run: |
# Rscript -e "remotes::install_github('r-hub/sysreqs')"
# sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
# sudo -s eval "$sysreqs"
- name: Install Linux dependencies on old R versions
if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
env:
RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
- name: Install Linux dependencies
if: runner.os == 'Linux'
# if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
# env:
# RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
# update the below with sysreqs::sysreqs("DESCRIPTION") and check the "DEB" entries (for Ubuntu).
# we don't want to depend on the sysreqs pkg here, as it requires a quite new R version
run: |
sudo apt install -y libssl-dev pandoc pandoc-citeproc libxml2-dev libicu-dev libcurl4-openssl-dev
- name: Install macOS dependencies
if: matrix.config.os == 'macOS-latest' && matrix.config.r == 'devel'
run: |
brew install mariadb-connector-c
- name: Install package dependencies
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
# if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
run: |
remotes::install_deps(dependencies = TRUE)
remotes::install_cran("rcmdcheck")
shell: Rscript {0}
- name: Session info
@ -147,17 +143,28 @@ jobs:
as.data.frame(utils::installed.packages())[, "Version", drop = FALSE]
shell: Rscript {0}
- name: Run R CMD check
if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
env:
_R_CHECK_CRAN_INCOMING_: false
_R_CHECK_LENGTH_1_CONDITION_: verbose
_R_CHECK_LENGTH_1_LOGIC2_: verbose
run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
shell: Rscript {0}
# - name: Run R CMD check
# if: matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2'
# env:
# _R_CHECK_CRAN_INCOMING_: false
# _R_CHECK_LENGTH_1_CONDITION_: verbose
# _R_CHECK_LENGTH_1_LOGIC2_: verbose
# run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
# shell: Rscript {0}
- name: Unpack AMR package on Linux and macOS
if: runner.os != 'Windows'
run: |
ls -lh
tar -xvf data-raw/AMR_latest.tar.gz
- name: Unpack AMR package on Windows
if: runner.os == 'Windows'
run: |
tar -xvf data-raw/AMR_latest.tar.gz
- name: Run R CMD check on older R versions
if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
- name: Run R CMD check
# if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2'
env:
_R_CHECK_CRAN_INCOMING_: false
_R_CHECK_FORCE_SUGGESTS_: false
@ -165,7 +172,6 @@ jobs:
_R_CHECK_LENGTH_1_CONDITION_: verbose
_R_CHECK_LENGTH_1_LOGIC2_: verbose
run: |
tar -xvf data-raw/AMR_latest.tar.gz
R CMD check AMR --no-manual --no-build-vignettes
- name: Show testthat output

View File

@ -1,5 +1,5 @@
Package: AMR
Version: 1.6.0.9022
Version: 1.6.0.9023
Date: 2021-05-13
Title: Antimicrobial Resistance Data Analysis
Authors@R: c(

View File

@ -1,4 +1,4 @@
# `AMR` 1.6.0.9022
# `AMR` 1.6.0.9023
## <small>Last updated: 13 May 2021</small>
### New
@ -11,6 +11,7 @@
* The `first_isolate()` function can now take a vector of values for `col_keyantibiotics` and can have an episode length of `Inf`
* Since the phenotype-based method is the new default, `filter_first_isolate()` renders the `filter_first_weighted_isolate()` function redundant. For this reason, `filter_first_weighted_isolate()` is now deprecated.
* The documentation of the `first_isolate()` and `key_antimicrobials()` functions has been completely rewritten.
* Added `ggplot()` method for `resistance_predict()`
### Changed
* Custom MDRO guidelines (`mdro()`, `custom_mdro_guideline()`):

View File

@ -347,6 +347,20 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of",
col = "grey40")
}
#' @method ggplot resistance_predict
#' @rdname resistance_predict
# will be exported using s3_register() in R/zzz.R
ggplot.resistance_predict <- function(x,
main = paste("Resistance Prediction of", x_name),
ribbon = TRUE,
...) {
x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")")
meet_criteria(main, allow_class = "character", has_length = 1)
meet_criteria(ribbon, allow_class = "logical", has_length = 1)
ggplot_rsi_predict(x = x, main = main, ribbon = ribbon, ...)
}
#' @rdname resistance_predict
#' @export
ggplot_rsi_predict <- function(x,
@ -360,14 +374,14 @@ ggplot_rsi_predict <- function(x,
stop_ifnot_installed("ggplot2")
stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
if (attributes(x)$I_as_S == TRUE) {
ylab <- "%R"
} else {
ylab <- "%IR"
}
p <- ggplot2::ggplot(x, ggplot2::aes(x = year, y = value)) +
p <- ggplot2::ggplot(as.data.frame(x, stringsAsFactors = FALSE),
ggplot2::aes(x = year, y = value)) +
ggplot2::geom_point(data = subset(x, !is.na(observations)),
size = 2) +
scale_y_percent(limits = c(0, 1)) +

View File

@ -64,6 +64,7 @@ if (utf8_supported && !is_latex) {
s3_register("ggplot2::ggplot", "rsi")
s3_register("ggplot2::ggplot", "mic")
s3_register("ggplot2::ggplot", "disk")
s3_register("ggplot2::ggplot", "resistance_predict")
# if mo source exists, fire it up (see mo_source())
try({

Binary file not shown.

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9022</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9023</span>
</span>
</div>
@ -236,9 +236,9 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1609022" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9022">
<a href="#amr-1609022" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9022</h1>
<div id="amr-1609023" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9023">
<a href="#amr-1609023" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9023</h1>
<div id="last-updated-13-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>
@ -262,6 +262,8 @@
<li>The documentation of the <code><a href="../reference/first_isolate.html">first_isolate()</a></code> and <code><a href="../reference/key_antimicrobials.html">key_antimicrobials()</a></code> functions has been completely rewritten.</li>
</ul>
</li>
<li>Added <code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> method for <code><a href="../reference/resistance_predict.html">resistance_predict()</a></code>
</li>
</ul>
</div>
<div id="changed" class="section level3">
@ -346,7 +348,7 @@
<span class="co">#&gt; Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"</span></code></pre></div>
</li>
<li><p>Support for custom MDRO guidelines, using the new <code><a href="../reference/mdro.html">custom_mdro_guideline()</a></code> function, please see <code><a href="../reference/mdro.html">mdro()</a></code> for additional info</p></li>
<li><p><code>ggplot()</code> generics for classes <code>&lt;mic&gt;</code> and <code>&lt;disk&gt;</code></p></li>
<li><p><code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> generics for classes <code>&lt;mic&gt;</code> and <code>&lt;disk&gt;</code></p></li>
<li>
<p>Function <code><a href="../reference/mo_property.html">mo_is_yeast()</a></code>, which determines whether a microorganism is a member of the taxonomic class Saccharomycetes or the taxonomic order Saccharomycetales:</p>
<div class="sourceCode" id="cb3"><pre class="downlit sourceCode r">
@ -403,7 +405,7 @@
<li>Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent</li>
<li>All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)</li>
<li>Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see <code>translate</code>)</li>
<li>Plotting is now possible with base R using <code><a href="../reference/plot.html">plot()</a></code> and with ggplot2 using <code>ggplot()</code> on any vector of MIC and disk diffusion values</li>
<li>Plotting is now possible with base R using <code><a href="../reference/plot.html">plot()</a></code> and with ggplot2 using <code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> on any vector of MIC and disk diffusion values</li>
</ul>
</li>
<li>Updated SNOMED codes to US Edition of SNOMED CT from 1 September 2020 and added the source to the help page of the <code>microorganisms</code> data set</li>
@ -420,7 +422,7 @@
<code><a href="../reference/as.rsi.html">is.rsi.eligible()</a></code> now detects if the column name resembles an antibiotic name or code and now returns <code>TRUE</code> immediately if the input contains any of the values “R”, “S” or “I”. This drastically improves speed, also for a lot of other functions that rely on automatic determination of antibiotic columns.</li>
<li>Functions <code><a href="../reference/get_episode.html">get_episode()</a></code> and <code><a href="../reference/get_episode.html">is_new_episode()</a></code> now support less than a day as value for argument <code>episode_days</code> (e.g., to include one patient/test per hour)</li>
<li>Argument <code>ampc_cephalosporin_resistance</code> in <code><a href="../reference/eucast_rules.html">eucast_rules()</a></code> now also applies to value “I” (not only “S”)</li>
<li>Functions <code><a href="https://docs.ropensci.org/skimr/reference/print.html">print()</a></code> and <code><a href="https://rdrr.io/r/base/summary.html">summary()</a></code> on a Principal Components Analysis object (<code><a href="../reference/pca.html">pca()</a></code>) now print additional group info if the original data was grouped using <code><a href="https://dplyr.tidyverse.org/reference/group_by.html">dplyr::group_by()</a></code>
<li>Functions <code><a href="https://rdrr.io/r/base/print.html">print()</a></code> and <code><a href="https://rdrr.io/r/base/summary.html">summary()</a></code> on a Principal Components Analysis object (<code><a href="../reference/pca.html">pca()</a></code>) now print additional group info if the original data was grouped using <code><a href="https://dplyr.tidyverse.org/reference/group_by.html">dplyr::group_by()</a></code>
</li>
<li>Improved speed and reliability of <code><a href="../reference/guess_ab_col.html">guess_ab_col()</a></code>. As this also internally improves the reliability of <code><a href="../reference/first_isolate.html">first_isolate()</a></code> and <code><a href="../reference/mdro.html">mdro()</a></code>, this might have a slight impact on the results of those functions.</li>
<li>Fix for <code><a href="../reference/mo_property.html">mo_name()</a></code> when used in other languages than English</li>

View File

@ -12,7 +12,7 @@ articles:
datasets: datasets.html
resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html
last_built: 2021-05-13T13:55Z
last_built: 2021-05-13T17:31Z
urls:
reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles

View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9022</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9023</span>
</span>
</div>
@ -538,7 +538,7 @@
</tr><tr>
<td>
<p><code><a href="resistance_predict.html">resistance_predict()</a></code> <code><a href="resistance_predict.html">rsi_predict()</a></code> <code><a href="resistance_predict.html">plot(<i>&lt;resistance_predict&gt;</i>)</a></code> <code><a href="resistance_predict.html">ggplot_rsi_predict()</a></code> </p>
<p><code><a href="resistance_predict.html">resistance_predict()</a></code> <code><a href="resistance_predict.html">rsi_predict()</a></code> <code><a href="resistance_predict.html">plot(<i>&lt;resistance_predict&gt;</i>)</a></code> <code><a href="resistance_predict.html">ggplot(<i>&lt;resistance_predict&gt;</i>)</a></code> <code><a href="resistance_predict.html">ggplot_rsi_predict()</a></code> </p>
</td>
<td><p>Predict antimicrobial resistance</p></td>
</tr><tr>

View File

@ -82,7 +82,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.9021</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9023</span>
</span>
</div>
@ -258,7 +258,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for mic</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/ggplot.html'>ggplot</a></span><span class='op'>(</span>
<span class='fu'>ggplot</span><span class='op'>(</span>
<span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</span>,
title <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"MIC values of"</span>, <span class='fu'><a href='https://rdrr.io/r/base/deparse.html'>deparse</a></span><span class='op'>(</span><span class='fu'><a href='https://rdrr.io/r/base/substitute.html'>substitute</a></span><span class='op'>(</span><span class='va'>data</span><span class='op'>)</span><span class='op'>)</span><span class='op'>)</span>,
@ -289,7 +289,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for disk</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/ggplot.html'>ggplot</a></span><span class='op'>(</span>
<span class='fu'>ggplot</span><span class='op'>(</span>
<span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</span>,
title <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Disk zones of"</span>, <span class='fu'><a href='https://rdrr.io/r/base/deparse.html'>deparse</a></span><span class='op'>(</span><span class='fu'><a href='https://rdrr.io/r/base/substitute.html'>substitute</a></span><span class='op'>(</span><span class='va'>data</span><span class='op'>)</span><span class='op'>)</span><span class='op'>)</span>,
@ -314,7 +314,7 @@
<span class='op'>)</span>
<span class='co'># S3 method for rsi</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/ggplot.html'>ggplot</a></span><span class='op'>(</span>
<span class='fu'>ggplot</span><span class='op'>(</span>
<span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</span>,
title <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Resistance Overview of"</span>, <span class='fu'><a href='https://rdrr.io/r/base/deparse.html'>deparse</a></span><span class='op'>(</span><span class='fu'><a href='https://rdrr.io/r/base/substitute.html'>substitute</a></span><span class='op'>(</span><span class='va'>data</span><span class='op'>)</span><span class='op'>)</span><span class='op'>)</span>,

View File

@ -82,7 +82,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.9021</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9023</span>
</span>
</div>
@ -275,6 +275,9 @@
<span class='co'># S3 method for resistance_predict</span>
<span class='fu'><a href='plot.html'>plot</a></span><span class='op'>(</span><span class='va'>x</span>, main <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Resistance Prediction of"</span>, <span class='va'>x_name</span><span class='op'>)</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='co'># S3 method for resistance_predict</span>
<span class='fu'><a href='https://ggplot2.tidyverse.org/reference/ggplot.html'>ggplot</a></span><span class='op'>(</span><span class='va'>x</span>, main <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Resistance Prediction of"</span>, <span class='va'>x_name</span><span class='op'>)</span>, ribbon <span class='op'>=</span> <span class='cn'>TRUE</span>, <span class='va'>...</span><span class='op'>)</span>
<span class='fu'>ggplot_rsi_predict</span><span class='op'>(</span>
<span class='va'>x</span>,
main <span class='op'>=</span> <span class='fu'><a href='https://rdrr.io/r/base/paste.html'>paste</a></span><span class='op'>(</span><span class='st'>"Resistance Prediction of"</span>, <span class='va'>x_name</span><span class='op'>)</span>,

View File

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

View File

@ -4,6 +4,7 @@
\alias{resistance_predict}
\alias{rsi_predict}
\alias{plot.resistance_predict}
\alias{ggplot.resistance_predict}
\alias{ggplot_rsi_predict}
\title{Predict antimicrobial resistance}
\usage{
@ -39,6 +40,8 @@ rsi_predict(
\method{plot}{resistance_predict}(x, main = paste("Resistance Prediction of", x_name), ...)
\method{ggplot}{resistance_predict}(x, main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...)
ggplot_rsi_predict(
x,
main = paste("Resistance Prediction of", x_name),

View File

@ -26,8 +26,7 @@
# 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")) {
library(testthat, warn.conflicts = FALSE)
if (require("testthat", warn.conflicts = FALSE)) {
library(AMR)
test_check("AMR")
}

View File

@ -57,9 +57,10 @@ test_that("looking up ab columns works", {
test_that("looking up ab columns works", {
skip_on_cran()
library(dplyr)
# we rely on "grouped_tbl" being a class of grouped tibbles, so:
expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
# we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this:
if (require("dplyr")) {
expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
}
})

View File

@ -41,42 +41,6 @@ test_that("counts work", {
expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX))
library(dplyr, warn.conflicts = FALSE)
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())
)
# warning for speed loss
reset_all_thrown_messages()
@ -94,11 +58,49 @@ test_that("counts work", {
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
# 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()))
if (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()))
}
})

View File

@ -54,7 +54,8 @@ test_that("disk works", {
}
expect_output(print(as.disk(12)))
library(dplyr, warn.conflicts = FALSE)
expect_output(print(tibble(d = as.disk(12))))
if (require("dplyr")) {
expect_output(print(tibble(d = as.disk(12))))
}
})

View File

@ -41,18 +41,18 @@ test_that("episodes work", {
expect_equal(get_episode(test_df$date, 365),
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3))
library(dplyr)
expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE))
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient_id, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
if (require("dplyr")) {
expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE))
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient_id, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
}
})

View File

@ -28,26 +28,27 @@ context("filter_ab_class.R")
test_that("ATC-group filtering works", {
skip_on_cran()
library(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())
if (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())
}
})

View File

@ -26,64 +26,65 @@
context("ggplot_rsi.R")
test_that("ggplot_rsi works", {
skip_on_cran()
skip_if_not_installed("ggplot2")
library(dplyr, warn.conflicts = FALSE)
library(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")
skip_if_not_installed("dplyr")
if (require("dplyr") & 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")
}
})

View File

@ -37,6 +37,5 @@ test_that("key_antimcrobials work", {
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
library(dplyr, warn.conflicts = FALSE)
expect_warning(key_antimicrobials(example_isolates %>% slice(rep(1, 10))))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ]))
})

View File

@ -44,7 +44,6 @@ test_that("mdro works", {
# check class
expect_equal(class(outcome), c("ordered", "factor"))
library(dplyr)
# 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
@ -245,8 +244,8 @@ test_that("mdro works", {
info = FALSE))
# print groups
library(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))
if (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))
}
})

View File

@ -62,8 +62,9 @@ test_that("mic works", {
expect_s3_class(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
library(dplyr, warn.conflicts = FALSE)
expect_output(print(tibble(m = as.mic(2:4))))
if (require("dplyr")) {
expect_output(print(tibble(m = as.mic(2:4))))
}
})
test_that("mathematical functions on mic work", {

View File

@ -28,10 +28,8 @@ context("mo.R")
test_that("as.mo works", {
skip_on_cran()
library(dplyr, warn.conflicts = FALSE)
MOs <- microorganisms %>% filter(!is.na(mo), nchar(mo) > 3)
MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo)))
expect_identical(
@ -152,37 +150,43 @@ test_that("as.mo works", {
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
# 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())
if (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")))
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# print
expect_output(print(as.mo(c("B_ESCHR_COLI", NA))))
# test pull
expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000)
# test data.frame
expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
@ -265,7 +269,6 @@ test_that("as.mo works", {
rep("UNKNOWN", 3))
expect_null(mo_failures())
expect_true(example_isolates %>% pull(mo) %>% is.mo())
expect_error(translate_allow_uncertain(5))

View File

@ -131,11 +131,12 @@ test_that("mo_property works", {
expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli")
library(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)
if (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)
}
})

View File

@ -52,30 +52,49 @@ test_that("proportions works", {
0.9382647,
tolerance = 0.0001)
library(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))
if (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)))
@ -115,24 +134,6 @@ test_that("proportions works", {
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)))
# 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())
)
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date"]))

View File

@ -28,65 +28,71 @@ context("resistance_predict.R")
test_that("prediction of rsi works", {
skip_on_cran()
library(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)))
if (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))
expect_silent(ggplot_rsi_predict(x))
expect_silent(ggplot(x))
expect_error(ggplot_rsi_predict(example_isolates))
expect_output(rsi_predict(x = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
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 = filter(example_isolates, mo == "B_ESCHR_COLI"),
expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",

View File

@ -59,30 +59,36 @@ test_that("rsi works", {
expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
rep(FALSE, length(example_isolates)))
library(dplyr, warn.conflicts = FALSE)
# 40 rsi columns
expect_equal(example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is.rsi.eligible) %>%
as.logical() %>%
sum(),
40)
expect_output(print(tibble(ab = as.rsi("S"))))
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"))
expect_s3_class(example_isolates %>%
mutate(m = as.mic(2),
d = as.disk(20)) %>%
skimr::skim(),
"data.frame")
expect_s3_class(skimr::skim(example_isolates),
"data.frame")
if (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 (require("skimr")) {
expect_s3_class(skim(example_isolates),
"data.frame")
if (require("dplyr")) {
expect_s3_class(example_isolates %>%
mutate(m = as.mic(2),
d = as.disk(20)) %>%
skim(),
"data.frame")
}
}
})
test_that("mic2rsi works", {
@ -110,12 +116,14 @@ test_that("mic2rsi works", {
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R"))
expect_true(suppressWarnings(example_isolates %>%
mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>%
as.rsi() %>%
pull(amox_mic) %>%
is.rsi()))
if (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", {
@ -140,13 +148,15 @@ test_that("disk2rsi works", {
ab = "ERY",
guideline = "CLSI")),
"R")
expect_true(example_isolates %>%
mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>%
is.rsi())
if (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 (require("cleaner")) {
@ -165,20 +175,18 @@ test_that("data.frame2rsi works", {
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(df)),
"data.frame")
expect_s3_class(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")))$amoxi), "rsi")
expect_warning(data.frame(mo = "E. coli",
NIT = c("<= 2", 32)) %>%
as.rsi())
expect_message(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
uti = TRUE) %>%
as.rsi())
expect_message(
data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood")) %>%
as.rsi())
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"))))
})

View File

@ -56,7 +56,7 @@ test_that("imports work", {
call_functions <- c(
# cleaner
"freq.default" = "cleaner",
# skmir
# skimr
"inline_hist" = "skimr",
"sfl" = "skimr",
# set_mo_source