mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 20:06:12 +01:00
(v1.6.0.9023) new unit test flow
This commit is contained in:
parent
655b813e99
commit
aeea00881e
70
.github/workflows/check.yaml
vendored
70
.github/workflows/check.yaml
vendored
@ -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: 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: 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
|
||||
# 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
|
||||
|
||||
@ -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(
|
||||
|
||||
3
NEWS.md
3
NEWS.md
@ -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()`):
|
||||
|
||||
@ -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)) +
|
||||
|
||||
1
R/zzz.R
1
R/zzz.R
@ -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.
@ -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>
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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">#> 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><mic></code> and <code><disk></code></p></li>
|
||||
<li><p><code><a href="https://ggplot2.tidyverse.org/reference/ggplot.html">ggplot()</a></code> generics for classes <code><mic></code> and <code><disk></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>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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><resistance_predict></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><resistance_predict></i>)</a></code> <code><a href="resistance_predict.html">ggplot(<i><resistance_predict></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>
|
||||
|
||||
@ -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>,
|
||||
|
||||
@ -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>,
|
||||
|
||||
@ -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>
|
||||
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -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")
|
||||
}
|
||||
|
||||
@ -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)))
|
||||
}
|
||||
|
||||
})
|
||||
|
||||
@ -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()))
|
||||
}
|
||||
|
||||
})
|
||||
|
||||
@ -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))))
|
||||
}
|
||||
|
||||
})
|
||||
|
||||
@ -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))
|
||||
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))
|
||||
)
|
||||
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))
|
||||
|
||||
y <- example_isolates %>%
|
||||
group_by(patient_id, mo) %>%
|
||||
mutate(out = is_new_episode(date, 365))
|
||||
|
||||
expect_identical(which(x$out), which(y$out))
|
||||
expect_identical(which(x$out), which(y$out))
|
||||
}
|
||||
})
|
||||
|
||||
@ -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)
|
||||
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_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())
|
||||
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())
|
||||
}
|
||||
})
|
||||
|
||||
@ -30,60 +30,61 @@ test_that("ggplot_rsi works", {
|
||||
skip_on_cran()
|
||||
|
||||
skip_if_not_installed("ggplot2")
|
||||
skip_if_not_installed("dplyr")
|
||||
|
||||
library(dplyr, warn.conflicts = FALSE)
|
||||
library(ggplot2)
|
||||
if (require("dplyr") & require("ggplot2")) {
|
||||
|
||||
pdf(NULL) # prevent Rplots.pdf being created
|
||||
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()
|
||||
)
|
||||
# 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"))
|
||||
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 = "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(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()
|
||||
)
|
||||
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")
|
||||
# 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")
|
||||
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")
|
||||
# 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")
|
||||
|
||||
}
|
||||
})
|
||||
|
||||
@ -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), ]))
|
||||
})
|
||||
|
||||
@ -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))
|
||||
}
|
||||
})
|
||||
|
||||
@ -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", {
|
||||
|
||||
@ -29,9 +29,7 @@ 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"))
|
||||
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())
|
||||
# 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))
|
||||
|
||||
|
||||
@ -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)
|
||||
}
|
||||
})
|
||||
|
||||
@ -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)
|
||||
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))
|
||||
# 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)))
|
||||
@ -116,24 +135,6 @@ test_that("proportions works", {
|
||||
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"]))
|
||||
})
|
||||
|
||||
@ -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])
|
||||
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)))
|
||||
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",
|
||||
|
||||
@ -59,29 +59,35 @@ 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")
|
||||
}
|
||||
}
|
||||
|
||||
})
|
||||
|
||||
@ -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", {
|
||||
@ -141,12 +149,14 @@ test_that("disk2rsi works", {
|
||||
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"))))
|
||||
})
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user