P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 06:06:12 +01:00
Code Releases Activity

(v1.6.0.9023) new unit test flow

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

2
DESCRIPTION
View File

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

3
NEWS.md
View File

@ -1,4 +1,4 @@
# `AMR` 1.6.0.9022 # `AMR` 1.6.0.9023
## <small>Last updated: 13 May 2021</small> ## <small>Last updated: 13 May 2021</small>
### New ### 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` * 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. * 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. * The documentation of the `first_isolate()` and `key_antimicrobials()` functions has been completely rewritten.
* Added `ggplot()` method for `resistance_predict()`
### Changed ### Changed
* Custom MDRO guidelines (`mdro()`, `custom_mdro_guideline()`): * Custom MDRO guidelines (`mdro()`, `custom_mdro_guideline()`):

18
R/resistance_predict.R
View File

@ -347,6 +347,20 @@ plot.resistance_predict <- function(x, main = paste("Resistance Prediction of",
col = "grey40") 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 #' @rdname resistance_predict
#' @export #' @export
ggplot_rsi_predict <- function(x, ggplot_rsi_predict <- function(x,
@ -360,14 +374,14 @@ ggplot_rsi_predict <- function(x,
stop_ifnot_installed("ggplot2") stop_ifnot_installed("ggplot2")
stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()") stop_ifnot(inherits(x, "resistance_predict"), "`x` must be a resistance prediction model created with resistance_predict()")
if (attributes(x)$I_as_S == TRUE) { if (attributes(x)$I_as_S == TRUE) {
ylab <- "%R" ylab <- "%R"
} else { } else {
ylab <- "%IR" 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)), ggplot2::geom_point(data = subset(x, !is.na(observations)),
size = 2) + size = 2) +
scale_y_percent(limits = c(0, 1)) + scale_y_percent(limits = c(0, 1)) +

1
R/zzz.R
View File

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

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

Binary file not shown.

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a> <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> </span>
</div> </div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <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> </span>
</div> </div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <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> </span>
</div> </div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <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> </span>
</div> </div>

2
docs/index.html
View File

@ -42,7 +42,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <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> </span>
</div> </div>

16
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <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> </span>
</div> </div>
@ -236,9 +236,9 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small> <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div> </div>
<div id="amr-1609022" class="section level1"> <div id="amr-1609023" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9022"> <h1 class="page-header" data-toc-text="1.6.0.9023">
<a href="#amr-1609022" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9022</h1> <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"> <div id="last-updated-13-may-2021" class="section level2">
<h2 class="hasAnchor"> <h2 class="hasAnchor">
<a href="#last-updated-13-may-2021" class="anchor"></a><small>Last updated: 13 May 2021</small> <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> <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> </ul>
</li> </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> </ul>
</div> </div>
<div id="changed" class="section level3"> <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> <span class="co">#&gt; Filtering on oxazolidinones: value in column `LNZ` (linezolid) is either "R", "S" or "I"</span></code></pre></div>
</li> </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>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> <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> <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"> <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>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>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>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> </ul>
</li> </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> <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> <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>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>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>
<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>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> <li>Fix for <code><a href="../reference/mo_property.html">mo_name()</a></code> when used in other languages than English</li>

2
docs/pkgdown.yml
View File

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

4
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <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> </span>
</div> </div>
@ -538,7 +538,7 @@
</tr><tr> </tr><tr>
<td> <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>
<td><p>Predict antimicrobial resistance</p></td> <td><p>Predict antimicrobial resistance</p></td>
</tr><tr> </tr><tr>

8
docs/reference/plot.html
View File

@ -82,7 +82,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <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> </span>
</div> </div>
@ -258,7 +258,7 @@
<span class='op'>)</span> <span class='op'>)</span>
<span class='co'># S3 method for mic</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>, <span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</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>, 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='op'>)</span>
<span class='co'># S3 method for disk</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>, <span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</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>, 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='op'>)</span>
<span class='co'># S3 method for rsi</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>, <span class='va'>data</span>,
mapping <span class='op'>=</span> <span class='cn'>NULL</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>, 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>,

5
docs/reference/resistance_predict.html
View File

@ -82,7 +82,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <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> </span>
</div> </div>
@ -275,6 +275,9 @@
<span class='co'># S3 method for resistance_predict</span> <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='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='fu'>ggplot_rsi_predict</span><span class='op'>(</span>
<span class='va'>x</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>, 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>,

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <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> </span>
</div> </div>

3
man/resistance_predict.Rd
View File

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

3
tests/testthat.R
View File

@ -26,8 +26,7 @@
# the testthat package is in Suggests, but very old R versions will not be # 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 # 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: # as well, so only run unit tests in later R versions:
if (require("testthat")) { if (require("testthat", warn.conflicts = FALSE)) {
library(testthat, warn.conflicts = FALSE)
library(AMR) library(AMR)
test_check("AMR") test_check("AMR")
} }

5
tests/testthat/test-_misc.R
View File

@ -57,9 +57,10 @@ test_that("looking up ab columns works", {
test_that("looking up ab columns works", { test_that("looking up ab columns works", {
skip_on_cran() skip_on_cran()
library(dplyr)
# we rely on "grouped_tbl" being a class of grouped tibbles, so: # 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))) expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
}
}) })

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

@ -41,7 +41,24 @@ test_that("counts work", {
expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX), expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX)) count_SI(example_isolates$AMX))
library(dplyr, warn.conflicts = FALSE)
# warning for speed loss
reset_all_thrown_messages()
expect_warning(count_resistant(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(count_resistant(example_isolates$AMC,
as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
if (require("dplyr")) {
expect_equal(example_isolates %>% count_susceptible(AMC), 1433) 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 = TRUE), 1687)
expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764) expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764)
@ -78,27 +95,12 @@ test_that("counts work", {
example_isolates$AMX %>% count_R()) example_isolates$AMX %>% count_R())
) )
# warning for speed loss
reset_all_thrown_messages()
expect_warning(count_resistant(as.character(example_isolates$AMC)))
reset_all_thrown_messages()
expect_warning(count_resistant(example_isolates$AMC,
as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"]))
# grouping in rsi_calc_df() (= backbone of rsi_df()) # grouping in rsi_calc_df() (= backbone of rsi_df())
expect_true("hospital_id" %in% (example_isolates %>% expect_true("hospital_id" %in% (example_isolates %>%
group_by(hospital_id) %>% group_by(hospital_id) %>%
select(hospital_id, AMX, CIP, gender) %>% select(hospital_id, AMX, CIP, gender) %>%
rsi_df() %>% rsi_df() %>%
colnames())) colnames()))
}
}) })

3
tests/testthat/test-disk.R
View File

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

4
tests/testthat/test-episode.R
View File

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

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

@ -28,7 +28,7 @@ context("filter_ab_class.R")
test_that("ATC-group filtering works", { test_that("ATC-group filtering works", {
skip_on_cran() skip_on_cran()
library(dplyr) if (require("dplyr")) {
expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0) expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0)
expect_gt(example_isolates %>% filter_aminoglycosides() %>% ncol(), 0) expect_gt(example_isolates %>% filter_aminoglycosides() %>% ncol(), 0)
expect_gt(example_isolates %>% filter_carbapenems() %>% ncol(), 0) expect_gt(example_isolates %>% filter_carbapenems() %>% ncol(), 0)
@ -50,4 +50,5 @@ test_that("ATC-group filtering works", {
expect_error(example_isolates %>% filter_carbapenems(result = "test")) expect_error(example_isolates %>% filter_carbapenems(result = "test"))
expect_error(example_isolates %>% filter_carbapenems(scope = "test")) expect_error(example_isolates %>% filter_carbapenems(scope = "test"))
expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems()) expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems())
}
}) })

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

@ -30,9 +30,9 @@ test_that("ggplot_rsi works", {
skip_on_cran() skip_on_cran()
skip_if_not_installed("ggplot2") skip_if_not_installed("ggplot2")
skip_if_not_installed("dplyr")
library(dplyr, warn.conflicts = FALSE) if (require("dplyr") & require("ggplot2")) {
library(ggplot2)
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
@ -86,4 +86,5 @@ test_that("ggplot_rsi works", {
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data), scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data),
"data.frame") "data.frame")
}
}) })

3
tests/testthat/test-key_antimicrobials.R
View File

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

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

@ -44,7 +44,6 @@ test_that("mdro works", {
# check class # check class
expect_equal(class(outcome), c("ordered", "factor")) expect_equal(class(outcome), c("ordered", "factor"))
library(dplyr)
# example_isolates should have these finding using Dutch guidelines # example_isolates should have these finding using Dutch guidelines
expect_equal(as.double(table(outcome)), expect_equal(as.double(table(outcome)),
c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos
@ -245,8 +244,8 @@ test_that("mdro works", {
info = FALSE)) info = FALSE))
# print groups # print groups
library(dplyr) 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), info = TRUE))
expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE)) expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
}
}) })

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

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

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

@ -29,9 +29,7 @@ test_that("as.mo works", {
skip_on_cran() skip_on_cran()
library(dplyr, warn.conflicts = FALSE) MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
MOs <- microorganisms %>% filter(!is.na(mo), nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo))) expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo)))
expect_identical( expect_identical(
@ -152,6 +150,7 @@ 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 = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
if (require("dplyr")) {
# select with one column # select with one column
expect_identical( expect_identical(
example_isolates[1:10, ] %>% example_isolates[1:10, ] %>%
@ -171,18 +170,23 @@ test_that("as.mo works", {
select(genus, species) %>% select(genus, species) %>%
as.mo()) as.mo())
# unknown results
expect_warning(as.mo(c("INVALID", "Yeah, unknown")))
# too many columns # too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo()) expect_error(example_isolates %>% select(1:3) %>% as.mo())
# print
expect_output(print(as.mo(c("B_ESCHR_COLI", NA))))
# test pull # test pull
expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))), expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000) 2000)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
# unknown results
expect_warning(as.mo(c("INVALID", "Yeah, unknown")))
# print
expect_output(print(as.mo(c("B_ESCHR_COLI", NA))))
# test data.frame # test data.frame
expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))), expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
@ -265,7 +269,6 @@ test_that("as.mo works", {
rep("UNKNOWN", 3)) rep("UNKNOWN", 3))
expect_null(mo_failures()) expect_null(mo_failures())
expect_true(example_isolates %>% pull(mo) %>% is.mo())
expect_error(translate_allow_uncertain(5)) expect_error(translate_allow_uncertain(5))

3
tests/testthat/test-mo_property.R
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")), expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli") "Escherichia coli")
library(dplyr) if (require("dplyr")) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(), expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730) 730)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(), expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238) 1238)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(), expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710) 710)
}
}) })

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

@ -52,7 +52,7 @@ test_that("proportions works", {
0.9382647, 0.9382647,
tolerance = 0.0001) tolerance = 0.0001)
library(dplyr) if (require("dplyr")) {
# percentages # percentages
expect_equal(example_isolates %>% expect_equal(example_isolates %>%
group_by(hospital_id) %>% group_by(hospital_id) %>%
@ -77,6 +77,25 @@ test_that("proportions works", {
pull(combination_n), pull(combination_n),
c(305, 617, 241, 711)) 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() reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$AMC))) expect_warning(proportion_R(as.character(example_isolates$AMC)))
reset_all_thrown_messages() reset_all_thrown_messages()
@ -116,24 +135,6 @@ test_that("proportions works", {
reset_all_thrown_messages() reset_all_thrown_messages()
expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN))) 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(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date"])) expect_error(proportion_df(example_isolates[, "date"]))
}) })

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

@ -28,7 +28,7 @@ context("resistance_predict.R")
test_that("prediction of rsi works", { test_that("prediction of rsi works", {
skip_on_cran() skip_on_cran()
library(dplyr) if (require("dplyr")) {
expect_output(AMX_R <- example_isolates %>% expect_output(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>% filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(col_ab = "AMX", rsi_predict(col_ab = "AMX",
@ -39,54 +39,60 @@ test_that("prediction of rsi works", {
pull("value")) pull("value"))
# AMX resistance will increase according to data set `example_isolates` # AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20]) 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 pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x)) expect_silent(plot(x))
expect_silent(ggplot_rsi_predict(x)) expect_silent(ggplot_rsi_predict(x))
expect_silent(ggplot(x))
expect_error(ggplot_rsi_predict(example_isolates)) 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", model = "binomial",
col_ab = "AMX", col_ab = "AMX",
col_date = "date", col_date = "date",
info = TRUE)) 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", model = "loglin",
col_ab = "AMX", col_ab = "AMX",
col_date = "date", col_date = "date",
info = TRUE)) 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", model = "lin",
col_ab = "AMX", col_ab = "AMX",
col_date = "date", col_date = "date",
info = TRUE)) 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", model = "INVALID MODEL",
col_ab = "AMX", col_ab = "AMX",
col_date = "date", col_date = "date",
info = TRUE)) 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", model = "binomial",
col_ab = "NOT EXISTING COLUMN", col_ab = "NOT EXISTING COLUMN",
col_date = "date", col_date = "date",
info = TRUE)) 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", model = "binomial",
col_ab = "AMX", col_ab = "AMX",
col_date = "NOT EXISTING COLUMN", col_date = "NOT EXISTING COLUMN",
info = TRUE)) 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_ab = "AMX",
col_date = "NOT EXISTING COLUMN", col_date = "NOT EXISTING COLUMN",
info = TRUE)) 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_ab = "AMX",
col_date = "date", col_date = "date",
info = TRUE)) info = TRUE))
# almost all E. coli are MEM S in the Netherlands :) # 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", model = "binomial",
col_ab = "MEM", col_ab = "MEM",
col_date = "date", col_date = "date",

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

@ -59,7 +59,12 @@ test_that("rsi works", {
expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)), expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
rep(FALSE, length(example_isolates))) rep(FALSE, length(example_isolates)))
library(dplyr, warn.conflicts = FALSE) expect_error(as.rsi.mic(as.mic(16)))
expect_error(as.rsi.disk(as.disk(16)))
expect_error(get_guideline("this one does not exist"))
if (require("dplyr")) {
# 40 rsi columns # 40 rsi columns
expect_equal(example_isolates %>% expect_equal(example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>% mutate_at(vars(PEN:RIF), as.character) %>%
@ -67,21 +72,22 @@ test_that("rsi works", {
as.logical() %>% as.logical() %>%
sum(), sum(),
40) 40)
expect_equal(sum(is.rsi(example_isolates)), 40)
expect_output(print(tibble(ab = as.rsi("S")))) expect_output(print(tibble(ab = as.rsi("S"))))
}
expect_error(as.rsi.mic(as.mic(16))) if (require("skimr")) {
expect_error(as.rsi.disk(as.disk(16))) expect_s3_class(skim(example_isolates),
"data.frame")
expect_error(get_guideline("this one does not exist")) if (require("dplyr")) {
expect_s3_class(example_isolates %>% expect_s3_class(example_isolates %>%
mutate(m = as.mic(2), mutate(m = as.mic(2),
d = as.disk(20)) %>% d = as.disk(20)) %>%
skimr::skim(), skim(),
"data.frame")
expect_s3_class(skimr::skim(example_isolates),
"data.frame") "data.frame")
}
}
}) })
@ -110,12 +116,14 @@ test_that("mic2rsi works", {
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"), expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R")) as.rsi("R"))
if (require("dplyr")) {
expect_true(suppressWarnings(example_isolates %>% expect_true(suppressWarnings(example_isolates %>%
mutate(amox_mic = as.mic(2)) %>% mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>% select(mo, amox_mic) %>%
as.rsi() %>% as.rsi() %>%
pull(amox_mic) %>% pull(amox_mic) %>%
is.rsi())) is.rsi()))
}
}) })
test_that("disk2rsi works", { test_that("disk2rsi works", {
@ -141,12 +149,14 @@ test_that("disk2rsi works", {
guideline = "CLSI")), guideline = "CLSI")),
"R") "R")
if (require("dplyr")) {
expect_true(example_isolates %>% expect_true(example_isolates %>%
mutate(amox_disk = as.disk(15)) %>% mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>% select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>% as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>% pull(amox_disk) %>%
is.rsi()) is.rsi())
}
# frequency tables # frequency tables
if (require("cleaner")) { if (require("cleaner")) {
@ -165,20 +175,18 @@ test_that("data.frame2rsi works", {
TOB = as.disk(16), TOB = as.disk(16),
ERY = "R", # note about assigning <rsi> class ERY = "R", # note about assigning <rsi> class
CLR = "V") # note about cleaning 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", expect_s3_class(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")))$amoxi), "rsi") amoxi = c("R", "S", "I", "invalid")))$amoxi),
expect_warning(data.frame(mo = "E. coli", "rsi")
NIT = c("<= 2", 32)) %>% expect_warning(as.rsi(data.frame(mo = "E. coli",
as.rsi()) NIT = c("<= 2", 32))))
expect_message(data.frame(mo = "E. coli", expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32), NIT = c("<= 2", 32),
uti = TRUE) %>% uti = TRUE)))
as.rsi()) expect_message(as.rsi(data.frame(mo = "E. coli",
expect_message(
data.frame(mo = "E. coli",
NIT = c("<= 2", 32), NIT = c("<= 2", 32),
specimen = c("urine", "blood")) %>% specimen = c("urine", "blood"))))
as.rsi())
}) })

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

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