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

(v1.6.0.9041) filter_ab_class() fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2021-05-16 10:50:00 +02:00
parent 00496e45b7
commit 916df6e90c
41 changed files with 142 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -52,7 +52,7 @@ jobs:
config: config:
- {os: macOS-latest, r: 'devel', allowfail: true} - {os: macOS-latest, r: 'devel', allowfail: true}
- {os: macOS-latest, r: 'release', allowfail: false} - {os: macOS-latest, r: 'release', allowfail: false}
- {os: macOS-latest, r: 'oldrel', allowfail: false} - {os: macOS-latest, r: 'oldrel', allowfail: true}
- {os: windows-latest, r: 'devel', allowfail: false} - {os: windows-latest, r: 'devel', allowfail: false}
- {os: windows-latest, r: 'release', allowfail: false} - {os: windows-latest, r: 'release', allowfail: false}
@ -106,8 +106,7 @@ jobs:
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 key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-v4
restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3
- name: Update AMR package dependencies - name: Update AMR package dependencies
run: | run: |

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 1.6.0.9040 Version: 1.6.0.9041
Date: 2021-05-16 Date: 2021-05-16
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Authors@R: c( Authors@R: c(

5
NEWS.md
View File

@ -1,4 +1,4 @@
# `AMR` 1.6.0.9040 # `AMR` 1.6.0.9041
## <small>Last updated: 16 May 2021</small> ## <small>Last updated: 16 May 2021</small>
### New ### New
@ -6,7 +6,7 @@
* Function `italicise_taxonomy()` to make taxonomic names within a string italic, with support for markdown and ANSI * Function `italicise_taxonomy()` to make taxonomic names within a string italic, with support for markdown and ANSI
* Support for all four methods to determine first isolates as summarised by Hindler *et al.* (doi: [10.1086/511864](https://doi.org/10.1086/511864)): isolate-based, patient-based, episode-based and phenotype-based. The last method is now the default. * Support for all four methods to determine first isolates as summarised by Hindler *et al.* (doi: [10.1086/511864](https://doi.org/10.1086/511864)): isolate-based, patient-based, episode-based and phenotype-based. The last method is now the default.
* The `first_isolate()` function gained the argument `method` that has to be "phenotype-based", "episode-based", "patient-based", or "isolate-based". The old behaviour is equal to "episode-based". The new default is "phenotype-based" if antimicrobial test results are available, and "episode-based" otherwise. This new default will yield slightly more isolates for selection (which is a good thing). * The `first_isolate()` function gained the argument `method` that has to be "phenotype-based", "episode-based", "patient-based", or "isolate-based". The old behaviour is equal to "episode-based". The new default is "phenotype-based" if antimicrobial test results are available, and "episode-based" otherwise. This new default will yield slightly more isolates for selection (which is a good thing).
* Since fungal isolates can also be selected, the functions `key_antibiotics()` and `key_antibiotics_equal()` are now deprecated in favour of the `key_antimicrobials()` and `antimicrobial_equal()` functions. Also, the new `all_antimicrobials()` function works like the old `key_antibiotics()` function, but includes any column with antimicrobial test results. Using `key_antimicrobials()` still only selects six preferred antibiotics for Gram-negatives, six for Gram-positives, and six universal antibiotics. It has a new `antifungal` argument to set antifungal agents (antimycotics). * Since fungal isolates can also be selected, the functions `key_antibiotics()` and `key_antibiotics_equal()` are now deprecated in favour of the `key_antimicrobials()` and `antimicrobials_equal()` functions. Also, the new `all_antimicrobials()` function works like the old `key_antibiotics()` function, but includes any column with antimicrobial test results. Using `key_antimicrobials()` still only selects six preferred antibiotics for Gram-negatives, six for Gram-positives, and six universal antibiotics. It has a new `antifungal` argument to set antifungal agents (antimycotics).
* Using `type == "points"` in the `first_isolate()` function for phenotype-based selection will now consider all antimicrobial drugs in the data set, using the new `all_antimicrobials()` * Using `type == "points"` in the `first_isolate()` function for phenotype-based selection will now consider all antimicrobial drugs in the data set, using the new `all_antimicrobials()`
* 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.
@ -41,6 +41,7 @@
* Updated `skimr::skim()` usage for MIC values to also include 25th and 75th percentiles * Updated `skimr::skim()` usage for MIC values to also include 25th and 75th percentiles
* Fix for plotting missing MIC/disk diffusion values * Fix for plotting missing MIC/disk diffusion values
* Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables * Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables
* Fix for filtering on antibiotic classes (such as `filter_cephalosporins()`)
### Other ### Other
* All unit tests are now processed by the `tinytest` package, instead of the `testthat` package. The `testthat` package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the `tinytest` package is very lightweight and dependency-free. * All unit tests are now processed by the `tinytest` package, instead of the `testthat` package. The `testthat` package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the `tinytest` package is very lightweight and dependency-free.

4
R/filter_ab_class.R
View File

@ -125,11 +125,11 @@ filter_ab_class <- function(x,
group %like% ab_class | group %like% ab_class |
atc_group1 %like% ab_class | atc_group1 %like% ab_class |
atc_group2 %like% ab_class) atc_group2 %like% ab_class)
ab_group <- find_ab_group(ab_class) if (nrow(ab_reference) == 0) {
if (ab_group == "") {
message_("Unknown antimicrobial class '", ab_class.bak, "', data left unchanged.") message_("Unknown antimicrobial class '", ab_class.bak, "', data left unchanged.")
return(x.bak) return(x.bak)
} }
ab_group <- find_ab_group(ab_class.bak)
# get the columns with a group names in the chosen ab class # get the columns with a group names in the chosen ab class
agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab] agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab]
if (length(agents) == 0) { if (length(agents) == 0) {

2
R/first_isolate.R
View File

@ -435,7 +435,7 @@ first_isolate <- function(x = NULL,
if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) { if (length(c(row.start:row.end)) == pm_n_distinct(x[c(row.start:row.end), col_mo, drop = TRUE])) {
if (info == TRUE) { if (info == TRUE) {
message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")), message_("=> Found ", font_bold(paste(length(c(row.start:row.end)), "first isolates")),
", as all isolates were different microorganisms", ", as all isolates were different microbial species",
add_fn = font_black, add_fn = font_black,
as_note = FALSE) as_note = FALSE)
} }

2
R/mdro.R
View File

@ -306,7 +306,7 @@ mdro <- function(x = NULL,
} }
if (is.null(col_mo) & guideline$code == "tb") { if (is.null(col_mo) & guideline$code == "tb") {
message_("No column found as input for `col_mo`, ", message_("No column found as input for `col_mo`, ",
font_bold(paste0("assuming all records contain", font_italic("Mycobacterium tuberculosis"), "."))) font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), ".")))
x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE] x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE]
col_mo <- "mo" col_mo <- "mo"
} }

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

Binary file not shown.

4
data-raw/_install_deps.R
View File

@ -26,7 +26,7 @@
pkg_suggests <- AMR:::trimws(unlist(strsplit(packageDescription("AMR")$Suggests, ",(\n)?"))) pkg_suggests <- AMR:::trimws(unlist(strsplit(packageDescription("AMR")$Suggests, ",(\n)?")))
to_install <- pkg_suggests[!pkg_suggests %in% rownames(utils::installed.packages())] to_install <- pkg_suggests[!pkg_suggests %in% rownames(utils::installed.packages())]
to_update <- as.data.frame(old.packages(), stringsAsFactors = FALSE) to_update <- as.data.frame(utils::old.packages(repos = "https://cran.rstudio.com/"), stringsAsFactors = FALSE)
for (i in seq_len(length(to_install))) { for (i in seq_len(length(to_install))) {
cat("Installing package", to_install[i], "\n") cat("Installing package", to_install[i], "\n")
@ -37,7 +37,7 @@ for (i in seq_len(length(to_install))) {
} }
for (i in seq_len(length(to_update))) { for (i in seq_len(length(to_update))) {
cat("Updating package", to_install[i], "\n") cat("Updating package", to_update[i], "\n")
tryCatch(update.packages(to_update[i], repos = "https://cran.rstudio.com/", ask = FALSE), tryCatch(update.packages(to_update[i], repos = "https://cran.rstudio.com/", ask = FALSE),
# message = function(m) invisible(), # message = function(m) invisible(),
warning = function(w) message(w$message), warning = function(w) message(w$message),

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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</span>
</span> </span>
</div> </div>

2
docs/articles/datasets.html
View File

@ -39,7 +39,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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</span>
</span> </span>
</div> </div>

11
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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</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-1609040" class="section level1"> <div id="amr-1609041" class="section level1">
<h1 class="page-header" data-toc-text="1.6.0.9040"> <h1 class="page-header" data-toc-text="1.6.0.9041">
<a href="#amr-1609040" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9040</h1> <a href="#amr-1609041" class="anchor"></a><small> Unreleased </small><code>AMR</code> 1.6.0.9041</h1>
<div id="last-updated-16-may-2021" class="section level2"> <div id="last-updated-16-may-2021" class="section level2">
<h2 class="hasAnchor"> <h2 class="hasAnchor">
<a href="#last-updated-16-may-2021" class="anchor"></a><small>Last updated: 16 May 2021</small> <a href="#last-updated-16-may-2021" class="anchor"></a><small>Last updated: 16 May 2021</small>
@ -253,7 +253,7 @@
<li>Support for all four methods to determine first isolates as summarised by Hindler <em>et al.</em> (doi: <a href="https://doi.org/10.1086/511864">10.1086/511864</a>): isolate-based, patient-based, episode-based and phenotype-based. The last method is now the default. <li>Support for all four methods to determine first isolates as summarised by Hindler <em>et al.</em> (doi: <a href="https://doi.org/10.1086/511864">10.1086/511864</a>): isolate-based, patient-based, episode-based and phenotype-based. The last method is now the default.
<ul> <ul>
<li>The <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function gained the argument <code>method</code> that has to be “phenotype-based”, “episode-based”, “patient-based”, or “isolate-based”. The old behaviour is equal to “episode-based”. The new default is “phenotype-based” if antimicrobial test results are available, and “episode-based” otherwise. This new default will yield slightly more isolates for selection (which is a good thing).</li> <li>The <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function gained the argument <code>method</code> that has to be “phenotype-based”, “episode-based”, “patient-based”, or “isolate-based”. The old behaviour is equal to “episode-based”. The new default is “phenotype-based” if antimicrobial test results are available, and “episode-based” otherwise. This new default will yield slightly more isolates for selection (which is a good thing).</li>
<li>Since fungal isolates can also be selected, the functions <code><a href="../reference/AMR-deprecated.html">key_antibiotics()</a></code> and <code><a href="../reference/AMR-deprecated.html">key_antibiotics_equal()</a></code> are now deprecated in favour of the <code><a href="../reference/key_antimicrobials.html">key_antimicrobials()</a></code> and <code>antimicrobial_equal()</code> functions. Also, the new <code><a href="../reference/key_antimicrobials.html">all_antimicrobials()</a></code> function works like the old <code><a href="../reference/AMR-deprecated.html">key_antibiotics()</a></code> function, but includes any column with antimicrobial test results. Using <code><a href="../reference/key_antimicrobials.html">key_antimicrobials()</a></code> still only selects six preferred antibiotics for Gram-negatives, six for Gram-positives, and six universal antibiotics. It has a new <code>antifungal</code> argument to set antifungal agents (antimycotics).</li> <li>Since fungal isolates can also be selected, the functions <code><a href="../reference/AMR-deprecated.html">key_antibiotics()</a></code> and <code><a href="../reference/AMR-deprecated.html">key_antibiotics_equal()</a></code> are now deprecated in favour of the <code><a href="../reference/key_antimicrobials.html">key_antimicrobials()</a></code> and <code><a href="../reference/key_antimicrobials.html">antimicrobials_equal()</a></code> functions. Also, the new <code><a href="../reference/key_antimicrobials.html">all_antimicrobials()</a></code> function works like the old <code><a href="../reference/AMR-deprecated.html">key_antibiotics()</a></code> function, but includes any column with antimicrobial test results. Using <code><a href="../reference/key_antimicrobials.html">key_antimicrobials()</a></code> still only selects six preferred antibiotics for Gram-negatives, six for Gram-positives, and six universal antibiotics. It has a new <code>antifungal</code> argument to set antifungal agents (antimycotics).</li>
<li>Using <code>type == "points"</code> in the <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function for phenotype-based selection will now consider all antimicrobial drugs in the data set, using the new <code><a href="../reference/key_antimicrobials.html">all_antimicrobials()</a></code> <li>Using <code>type == "points"</code> in the <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function for phenotype-based selection will now consider all antimicrobial drugs in the data set, using the new <code><a href="../reference/key_antimicrobials.html">all_antimicrobials()</a></code>
</li> </li>
<li>The <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function can now take a vector of values for <code>col_keyantibiotics</code> and can have an episode length of <code>Inf</code> <li>The <code><a href="../reference/first_isolate.html">first_isolate()</a></code> function can now take a vector of values for <code>col_keyantibiotics</code> and can have an episode length of <code>Inf</code>
@ -306,6 +306,7 @@
<li>Updated <code><a href="https://docs.ropensci.org/skimr/reference/skim.html">skimr::skim()</a></code> usage for MIC values to also include 25th and 75th percentiles</li> <li>Updated <code><a href="https://docs.ropensci.org/skimr/reference/skim.html">skimr::skim()</a></code> usage for MIC values to also include 25th and 75th percentiles</li>
<li>Fix for plotting missing MIC/disk diffusion values</li> <li>Fix for plotting missing MIC/disk diffusion values</li>
<li>Updated join functions to always use <code>dplyr</code> join functions if the <code>dplyr</code> package is installed - now also preserving grouped variables</li> <li>Updated join functions to always use <code>dplyr</code> join functions if the <code>dplyr</code> package is installed - now also preserving grouped variables</li>
<li>Fix for filtering on antibiotic classes (such as <code><a href="../reference/filter_ab_class.html">filter_cephalosporins()</a></code>)</li>
</ul> </ul>
</div> </div>
<div id="other" class="section level3"> <div id="other" class="section level3">

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-16T07:24Z last_built: 2021-05-16T08:48Z
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

2
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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</span>
</span> </span>
</div> </div>

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.9040</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.6.0.9041</span>
</span> </span>
</div> </div>

2
git_premaster.sh
View File

@ -133,7 +133,7 @@ echo
echo "•••••••••••••••••" echo "•••••••••••••••••"
echo "• Building site •" echo "• Building site •"
echo "•••••••••••••••••" echo "•••••••••••••••••"
Rscript -e "suppressMessages(pkgdown::build_site(lazy = $lazy, examples = FALSE))" Rscript -e "suppressMessages(pkgdown::build_site(lazy = $lazy, examples = FALSE, install = FALSE))"
# always rebuild datasets vignette # always rebuild datasets vignette
Rscript -e "pkgdown::build_article('datasets', lazy = FALSE, quiet = TRUE)" Rscript -e "pkgdown::build_article('datasets', lazy = FALSE, quiet = TRUE)"
# add the survey page # add the survey page

40
inst/tinytest/test-_misc.R
View File

@ -23,33 +23,33 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
expect_equal(percentage(0.25), "25%") expect_equal(AMR:::percentage(0.25), "25%")
expect_equal(percentage(0.5), "50%") expect_equal(AMR:::percentage(0.5), "50%")
expect_equal(percentage(0.500, digits = 1), "50.0%") expect_equal(AMR:::percentage(0.500, digits = 1), "50.0%")
expect_equal(percentage(0.1234), "12.3%") expect_equal(AMR:::percentage(0.1234), "12.3%")
# round up 0.5 # round up 0.5
expect_equal(percentage(0.0054), "0.5%") expect_equal(AMR:::percentage(0.0054), "0.5%")
expect_equal(percentage(0.0055), "0.6%") expect_equal(AMR:::percentage(0.0055), "0.6%")
expect_equal(strrep("A", 5), "AAAAA") expect_equal(AMR:::strrep("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) expect_equal(AMR:::strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test") expect_equal(AMR:::trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ") expect_equal(AMR:::trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test") expect_equal(AMR:::trimws(" test ", "r"), " test")
expect_warning(generate_warning_abs_missing(c("AMP", "AMX"))) expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX")))
expect_warning(generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE)) expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE))
expect_warning(get_column_abx(example_isolates, hard_dependencies = "FUS")) expect_warning(AMR:::get_column_abx(example_isolates, hard_dependencies = "FUS"))
expect_message(get_column_abx(example_isolates, soft_dependencies = "FUS")) expect_message(AMR:::get_column_abx(example_isolates, soft_dependencies = "FUS"))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE)) expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE)) expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
} }
# we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this: # we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this:
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id))) expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id)))
} }

30
inst/tinytest/test-ab_class_selectors.R
View File

@ -23,20 +23,20 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_true(example_isolates %>% select(aminoglycosides()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(aminoglycosides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(carbapenems()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(carbapenems()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_1st()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins_1st()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_2nd()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins_2nd()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_3rd()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins_3rd()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_4th()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins_4th()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(cephalosporins_5th()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(cephalosporins_5th()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(fluoroquinolones()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(fluoroquinolones()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(glycopeptides()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(glycopeptides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(macrolides()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(macrolides()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(oxazolidinones()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(oxazolidinones()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(penicillins()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(penicillins()) %>% ncol() < ncol(example_isolates))
expect_true(example_isolates %>% select(tetracyclines()) %>% ncol() < ncol(example_isolates)) expect_true(example_isolates %>% select(tetracyclines()) %>% ncol() < ncol(example_isolates))
} }

2
inst/tinytest/test-bug_drug_combinations.R
View File

@ -25,6 +25,6 @@
b <- suppressWarnings(bug_drug_combinations(example_isolates)) b <- suppressWarnings(bug_drug_combinations(example_isolates))
expect_inherits(b, "bug_drug_combinations") expect_inherits(b, "bug_drug_combinations")
expect_stdout(print(b)) expect_stdout(suppressMessages(print(b)))
expect_true(is.data.frame(format(b))) expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE))) expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE)))

6
inst/tinytest/test-count.R
View File

@ -38,9 +38,9 @@ expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_i
# warning for speed loss # warning for speed loss
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(count_resistant(as.character(example_isolates$AMC))) expect_warning(count_resistant(as.character(example_isolates$AMC)))
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(count_resistant(example_isolates$AMC, expect_warning(count_resistant(example_isolates$AMC,
as.character(example_isolates$GEN))) as.character(example_isolates$GEN)))
@ -53,7 +53,7 @@ expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C"))) expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date"])) expect_error(count_df(example_isolates[, "date"]))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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)

10
inst/tinytest/test-data.R
View File

@ -23,7 +23,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
expect_true(check_dataset_integrity()) # in misc.R expect_true(AMR:::check_dataset_integrity()) # in misc.R
# IDs should always be unique # IDs should always be unique
expect_identical(nrow(microorganisms), length(unique(microorganisms$mo))) expect_identical(nrow(microorganisms), length(unique(microorganisms$mo)))
@ -34,14 +34,14 @@ expect_identical(class(antibiotics$ab), c("ab", "character"))
# check cross table reference # check cross table reference
expect_true(all(microorganisms.codes$mo %in% microorganisms$mo)) expect_true(all(microorganisms.codes$mo %in% microorganisms$mo))
expect_true(all(example_isolates$mo %in% microorganisms$mo)) expect_true(all(example_isolates$mo %in% microorganisms$mo))
expect_true(all(microorganisms.translation$mo_new %in% microorganisms$mo)) expect_true(all(AMR:::microorganisms.translation$mo_new %in% microorganisms$mo))
expect_false(any(AMR:::microorganisms.translation$mo_old %in% microorganisms$mo))
expect_true(all(rsi_translation$mo %in% microorganisms$mo)) expect_true(all(rsi_translation$mo %in% microorganisms$mo))
expect_true(all(rsi_translation$ab %in% antibiotics$ab)) expect_true(all(rsi_translation$ab %in% antibiotics$ab))
expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant() expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant()
expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name)) expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name))
expect_false(any(is.na(microorganisms.codes$code))) expect_false(any(is.na(microorganisms.codes$code)))
expect_false(any(is.na(microorganisms.codes$mo))) expect_false(any(is.na(microorganisms.codes$mo)))
expect_false(any(microorganisms.translation$mo_old %in% microorganisms$mo))
expect_true(all(dosage$ab %in% antibiotics$ab)) expect_true(all(dosage$ab %in% antibiotics$ab))
expect_true(all(dosage$name %in% antibiotics$name)) expect_true(all(dosage$name %in% antibiotics$name))
@ -52,7 +52,7 @@ expect_identical(as.ab(antibiotics$name), antibiotics$ab)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"] datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"]
for (i in seq_len(length(datasets))) { for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR")) dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i]) expect_identical(AMR:::dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i])
} }
df <- AMR:::MO_lookup df <- AMR:::MO_lookup
@ -76,7 +76,7 @@ expect_stdout(print(catalogue_of_life_version()))
uncategorised <- subset(microorganisms, uncategorised <- subset(microorganisms,
genus == "Staphylococcus" & genus == "Staphylococcus" &
!species %in% c("", "aureus") & !species %in% c("", "aureus") &
!mo %in% c(MO_CONS, MO_COPS)) !mo %in% c(AMR:::MO_CONS, AMR:::MO_COPS))
expect_true(NROW(uncategorised) == 0, expect_true(NROW(uncategorised) == 0,
info = ifelse(NROW(uncategorised) == 0, info = ifelse(NROW(uncategorised) == 0,
"All staphylococcal species categorised as CoNS/CoPS.", "All staphylococcal species categorised as CoNS/CoPS.",

4
inst/tinytest/test-disk.R
View File

@ -43,13 +43,13 @@ expect_silent(barplot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)))) expect_silent(plot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE)) expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr")) expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) { if (pkg_is_available("ggplot2")) {
expect_inherits(ggplot(as.disk(c(10, 20, 40))), "gg") expect_inherits(ggplot(as.disk(c(10, 20, 40))), "gg")
expect_inherits(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg") expect_inherits(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
expect_inherits(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg") expect_inherits(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg")
} }
expect_stdout(print(as.disk(12))) expect_stdout(print(as.disk(12)))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_stdout(print(tibble(d = as.disk(12)))) expect_stdout(print(tibble(d = as.disk(12))))
} }

2
inst/tinytest/test-episode.R
View File

@ -36,7 +36,7 @@ test_df <- rbind(
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))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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))

10
inst/tinytest/test-eucast_rules.R
View File

@ -24,15 +24,15 @@
# ==================================================================== # # ==================================================================== #
# thoroughly check input table # thoroughly check input table
expect_equal(colnames(eucast_rules_file), expect_equal(colnames(AMR:::eucast_rules_file),
c("if_mo_property", "like.is.one_of", "this_value", c("if_mo_property", "like.is.one_of", "this_value",
"and_these_antibiotics", "have_these_values", "and_these_antibiotics", "have_these_values",
"then_change_these_antibiotics", "to_value", "then_change_these_antibiotics", "to_value",
"reference.rule", "reference.rule_group", "reference.rule", "reference.rule_group",
"reference.version", "reference.version",
"note")) "note"))
MOs_mentioned <- unique(eucast_rules_file$this_value) MOs_mentioned <- unique(AMR:::eucast_rules_file$this_value)
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!is_valid_regex(MOs_mentioned)], ",", fixed = TRUE)))) MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!AMR:::is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned))) MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned)))
expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0) expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0)
@ -71,7 +71,7 @@ b <- data.frame(mo = c("Staphylococcus aureus",
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
# piperacillin must be R in Enterobacteriaceae when tica is R # piperacillin must be R in Enterobacteriaceae when tica is R
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_equal(suppressWarnings( expect_equal(suppressWarnings(
example_isolates %>% example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>% filter(mo_family(mo) == "Enterobacteriaceae") %>%
@ -109,7 +109,7 @@ expect_equal(
"S") "S")
# also test norf # also test norf
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
} }

32
inst/tinytest/test-filter_ab_class.R
View File

@ -23,22 +23,22 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_true(example_isolates %>% filter_ab_class("carbapenem") %>% nrow() > 0) expect_true(example_isolates %>% filter_ab_class("carbapenem") %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_aminoglycosides() %>% ncol() > 0) expect_true(example_isolates %>% filter_aminoglycosides() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_carbapenems() %>% ncol() > 0) expect_true(example_isolates %>% filter_carbapenems() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_1st_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_1st_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_2nd_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_2nd_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_3rd_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_3rd_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_4th_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_4th_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_5th_cephalosporins() %>% ncol() > 0) expect_true(example_isolates %>% filter_5th_cephalosporins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_fluoroquinolones() %>% ncol() > 0) expect_true(example_isolates %>% filter_fluoroquinolones() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_glycopeptides() %>% ncol() > 0) expect_true(example_isolates %>% filter_glycopeptides() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_macrolides() %>% ncol() > 0) expect_true(example_isolates %>% filter_macrolides() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_oxazolidinones() %>% ncol() > 0) expect_true(example_isolates %>% filter_oxazolidinones() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_penicillins() %>% ncol() > 0) expect_true(example_isolates %>% filter_penicillins() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_tetracyclines() %>% ncol() > 0) expect_true(example_isolates %>% filter_tetracyclines() %>% nrow() < nrow(example_isolates))
expect_true(example_isolates %>% filter_carbapenems("R", "all") %>% nrow() > 0) expect_true(example_isolates %>% filter_carbapenems("R", "all") %>% nrow() > 0)

6
inst/tinytest/test-first_isolate.R
View File

@ -110,7 +110,7 @@ expect_error(first_isolate(example_isolates,
col_date = "non-existing col", col_date = "non-existing col",
col_mo = "mo")) col_mo = "mo"))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
# if mo is not an mo class, result should be the same # if mo is not an mo class, result should be the same
expect_identical(example_isolates %>% expect_identical(example_isolates %>%
mutate(mo = as.character(mo)) %>% mutate(mo = as.character(mo)) %>%
@ -174,9 +174,7 @@ expect_identical(filter_first_isolate(example_isolates),
# notice that all mo's are distinct, so all are TRUE # notice that all mo's are distinct, so all are TRUE
expect_true(all(example_isolates %pm>% expect_true(all(first_isolate(AMR:::pm_distinct(example_isolates, mo, .keep_all = TRUE), info = TRUE) == TRUE))
pm_distinct(mo, .keep_all = TRUE) %pm>%
first_isolate(info = TRUE) == TRUE))
# only one isolate, so return fast # only one isolate, so return fast
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE)) expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))

2
inst/tinytest/test-ggplot_rsi.R
View File

@ -23,7 +23,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
if (suppressWarnings(require("dplyr")) & suppressWarnings(require("ggplot2"))) { if (pkg_is_available("dplyr") & pkg_is_available("ggplot2")) {
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created

2
inst/tinytest/test-italicise_taxonomy.R
View File

@ -27,7 +27,7 @@ expect_identical(italicise_taxonomy("test for E. coli"),
"test for *E. coli*") "test for *E. coli*")
expect_identical(italicise_taxonomy("test for E. coli"), expect_identical(italicise_taxonomy("test for E. coli"),
italicize_taxonomy("test for E. coli")) italicize_taxonomy("test for E. coli"))
if (has_colour()) { if (AMR:::has_colour()) {
expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"), expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"),
"test for \033[3mE. coli\033[23m") "test for \033[3mE. coli\033[23m")
} }

2
inst/tinytest/test-mdro.R
View File

@ -232,7 +232,7 @@ expect_warning(mdro(example_isolates,
info = FALSE)) info = FALSE))
# print groups # print groups
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE)) expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE))
expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE)) expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE))
} }

4
inst/tinytest/test-mic.R
View File

@ -49,7 +49,7 @@ expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)))) expect_silent(plot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE)) expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr")) expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr"))
if (suppressWarnings(require("ggplot2"))) { if (pkg_is_available("ggplot2")) {
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8))), "gg") expect_inherits(ggplot(as.mic(c(1, 2, 4, 8))), "gg")
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg") expect_inherits(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
expect_inherits(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg") expect_inherits(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg")
@ -58,7 +58,7 @@ expect_stdout(print(as.mic(c(1, 2, 4, 8))))
expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table")) expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_stdout(print(tibble(m = as.mic(2:4)))) expect_stdout(print(tibble(m = as.mic(2:4))))
} }

6
inst/tinytest/test-mo.R
View File

@ -144,7 +144,7 @@ expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_S
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 (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
# select with one column # select with one column
expect_identical( expect_identical(
example_isolates[1:10, ] %>% example_isolates[1:10, ] %>%
@ -273,7 +273,7 @@ expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))), expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS")) c("F_YEAST", "F_FUNGUS"))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
# print tibble # print tibble
expect_stdout(print(tibble(mo = as.mo("B_ESCHR_COLI")))) expect_stdout(print(tibble(mo = as.mo("B_ESCHR_COLI"))))
} }
@ -292,6 +292,6 @@ expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_patte
c("B_ESCHR_COLI", NA)) c("B_ESCHR_COLI", NA))
# frequency tables # frequency tables
if (suppressWarnings(require("cleaner"))) { if (pkg_is_available("cleaner")) {
expect_inherits(cleaner::freq(example_isolates$mo), "freq") expect_inherits(cleaner::freq(example_isolates$mo), "freq")
} }

2
inst/tinytest/test-mo_property.R
View File

@ -119,7 +119,7 @@ expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aur
# with reference data # with reference data
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")
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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(),

6
inst/tinytest/test-pca.R
View File

@ -42,12 +42,12 @@ expect_inherits(pca_model, "pca")
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
if (suppressWarnings(require("ggplot2"))) { if (pkg_is_available("ggplot2")) {
ggplot_pca(pca_model, ellipse = TRUE) ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE) ggplot_pca(pca_model, arrows_textangled = FALSE)
} }
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
resistance_data <- example_isolates %>% resistance_data <- example_isolates %>%
group_by(order = mo_order(mo), group_by(order = mo_order(mo),
genus = mo_genus(mo)) %>% genus = mo_genus(mo)) %>%
@ -56,7 +56,7 @@ if (suppressWarnings(require("dplyr"))) {
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT") pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
expect_inherits(pca_result, "prcomp") expect_inherits(pca_result, "prcomp")
if (suppressWarnings(require("ggplot2"))) { if (pkg_is_available("ggplot2")) {
ggplot_pca(pca_result, ellipse = TRUE) ggplot_pca(pca_result, ellipse = TRUE)
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE) ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
} }

16
inst/tinytest/test-proportion.R
View File

@ -45,7 +45,7 @@ expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE
0.9382647, 0.9382647,
tolerance = 0.0001) tolerance = 0.0001)
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
# percentages # percentages
expect_equal(example_isolates %>% expect_equal(example_isolates %>%
group_by(hospital_id) %>% group_by(hospital_id) %>%
@ -88,14 +88,14 @@ if (suppressWarnings(require("dplyr"))) {
example_isolates$AMX %>% proportion_R()) example_isolates$AMX %>% proportion_R())
) )
} }
reset_all_thrown_messages() AMR:::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() AMR:::reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC))) expect_warning(proportion_S(as.character(example_isolates$AMC)))
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(proportion_S(as.character(example_isolates$AMC, expect_warning(proportion_S(as.character(example_isolates$AMC,
example_isolates$GEN))) example_isolates$GEN)))
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(n_rsi(as.character(example_isolates$AMC, expect_warning(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN))) example_isolates$GEN)))
expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC, expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC,
@ -120,11 +120,11 @@ expect_identical(suppressWarnings(proportion_S(example_isolates$AMX, minimum = n
NA_real_) NA_real_)
# warning for speed loss # warning for speed loss
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(proportion_R(as.character(example_isolates$GEN))) expect_warning(proportion_R(as.character(example_isolates$GEN)))
reset_all_thrown_messages() AMR:::reset_all_thrown_messages()
expect_warning(proportion_I(as.character(example_isolates$GEN))) expect_warning(proportion_I(as.character(example_isolates$GEN)))
reset_all_thrown_messages() AMR:::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)))
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"]))

4
inst/tinytest/test-resistance_predict.R
View File

@ -23,7 +23,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== # # ==================================================================== #
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_stdout(AMX_R <- example_isolates %>% expect_stdout(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>% filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(col_ab = "AMX", rsi_predict(col_ab = "AMX",
@ -43,7 +43,7 @@ expect_stdout(x <- suppressMessages(resistance_predict(example_isolates,
info = TRUE))) info = TRUE)))
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x)) expect_silent(plot(x))
if (suppressWarnings(require("ggplot2"))) { if (pkg_is_available("ggplot2")) {
expect_silent(ggplot_rsi_predict(x)) expect_silent(ggplot_rsi_predict(x))
expect_silent(ggplot(x)) expect_silent(ggplot(x))
expect_error(ggplot_rsi_predict(example_isolates)) expect_error(ggplot_rsi_predict(example_isolates))

14
inst/tinytest/test-rsi.R
View File

@ -34,7 +34,7 @@ expect_inherits(unique(x[1], x[9]), "rsi")
pdf(NULL) # prevent Rplots.pdf being created pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.rsi(c("S", "I", "R")))) expect_silent(barplot(as.rsi(c("S", "I", "R"))))
expect_silent(plot(as.rsi(c("S", "I", "R")))) expect_silent(plot(as.rsi(c("S", "I", "R"))))
if (suppressWarnings(require("ggplot2"))) expect_inherits(ggplot(as.rsi(c("S", "I", "R"))), "gg") if (pkg_is_available("ggplot2")) expect_inherits(ggplot(as.rsi(c("S", "I", "R"))), "gg")
expect_stdout(print(as.rsi(c("S", "I", "R")))) expect_stdout(print(as.rsi(c("S", "I", "R"))))
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R")) expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA) expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
@ -49,7 +49,7 @@ expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
expect_error(as.rsi.mic(as.mic(16))) expect_error(as.rsi.mic(as.mic(16)))
expect_error(as.rsi.disk(as.disk(16))) expect_error(as.rsi.disk(as.disk(16)))
expect_error(get_guideline("this one does not exist")) expect_error(get_guideline("this one does not exist"))
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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) %>%
@ -61,10 +61,10 @@ if (suppressWarnings(require("dplyr"))) {
expect_stdout(print(tibble(ab = as.rsi("S")))) expect_stdout(print(tibble(ab = as.rsi("S"))))
} }
if (suppressWarnings(require("skimr"))) { if (pkg_is_available("skimr")) {
expect_inherits(skim(example_isolates), expect_inherits(skim(example_isolates),
"data.frame") "data.frame")
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("dplyr")) {
expect_inherits(example_isolates %>% expect_inherits(example_isolates %>%
mutate(m = as.mic(2), mutate(m = as.mic(2),
d = as.disk(20)) %>% d = as.disk(20)) %>%
@ -94,7 +94,7 @@ expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020
as.rsi("S")) as.rsi("S"))
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 (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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) %>%
@ -121,7 +121,7 @@ expect_equal(as.character(
ab = "ERY", ab = "ERY",
guideline = "CLSI")), guideline = "CLSI")),
"R") "R")
if (suppressWarnings(require("dplyr"))) { if (pkg_is_available("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) %>%
@ -130,7 +130,7 @@ if (suppressWarnings(require("dplyr"))) {
is.rsi()) is.rsi())
} }
# frequency tables # frequency tables
if (suppressWarnings(require("cleaner"))) { if (pkg_is_available("cleaner")) {
expect_inherits(cleaner::freq(example_isolates$AMX), "freq") expect_inherits(cleaner::freq(example_isolates$AMX), "freq")
} }

2
inst/tinytest/test-zzz.R
View File

@ -103,7 +103,7 @@ for (i in seq_len(length(import_functions))) {
pkg <- unname(import_functions[i]) pkg <- unname(import_functions[i])
# function should exist in foreign pkg namespace # function should exist in foreign pkg namespace
if (pkg %in% rownames(installed.packages())) { if (pkg %in% rownames(installed.packages())) {
tst <- !is.null(import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)) tst <- !is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE))
expect_true(tst, expect_true(tst,
info = ifelse(tst, info = ifelse(tst,
"All external function references exist.", "All external function references exist.",

18
tests/tinytest.R
View File

@ -27,8 +27,18 @@
if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) { if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
# env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so: # env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so:
.libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths())) .libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths()))
print(.libPaths()) # helper function
library(tinytest) pkg_is_available <- function(pkg, also_load = TRUE) {
library(AMR) if (also_load == TRUE) {
test_package("AMR") out <- suppressWarnings(require(pkg, character.only = TRUE, warn.conflicts = FALSE, quietly = TRUE))
} else {
out <- requireNamespace(pkg, quietly = TRUE)
}
isTRUE(out)
}
if (pkg_is_available("tinytest")) {
library(AMR)
out <- test_package("AMR")
}
} }