diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 29053e10..4d44a918 100644 --- a/.github/workflows/check.yaml +++ b/.github/workflows/check.yaml @@ -81,7 +81,7 @@ jobs: - {os: ubuntu-16.04, r: '3.2', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.1', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - {os: ubuntu-16.04, r: '3.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} - + env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true RSPM: ${{ matrix.config.rspm }} @@ -93,29 +93,14 @@ jobs: with: r-version: ${{ matrix.config.r }} - - uses: r-lib/actions/setup-pandoc@master + # - uses: r-lib/actions/setup-pandoc@master - - name: Install remotes package - if: matrix.config.r != '3.0' - run: | - install.packages('remotes') - shell: Rscript {0} - - - name: Query dependencies - if: matrix.config.r != '3.0' - run: | - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - shell: Rscript {0} + # - name: Query dependencies + # if: matrix.config.r != '3.0' + # run: | + # saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + # shell: Rscript {0} - - name: Cache R packages - if: runner.os != 'Windows' && matrix.config.r != '3.0' - # && matrix.config.r != '3.0' && matrix.config.r != '3.1' && matrix.config.r != '3.2' - uses: actions/cache@v1 - with: - path: ${{ env.R_LIBS_USER }} - key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-3- - - name: Install Linux dependencies if: runner.os == 'Linux' # update the below with sysreqs::sysreqs("DESCRIPTION") and check the "DEB" entries (for Ubuntu). @@ -123,11 +108,18 @@ jobs: run: | sudo apt install -y libssl-dev pandoc pandoc-citeproc libxml2-dev libicu-dev libcurl4-openssl-dev - - name: Update package dependencies using remotes package - if: matrix.config.r != '3.0' + - name: Update package dependencies run: | - remotes::install_deps(dependencies = TRUE) + source("data-raw/_install_deps.R") shell: Rscript {0} + + - name: Cache R packages + # if: runner.os != 'Windows' + uses: actions/cache@v1 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ matrix.config.os }}-r-${{ matrix.config.r }} # -${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }} - name: Session info run: | @@ -145,12 +137,13 @@ jobs: _R_CHECK_LENGTH_1_CONDITION_: verbose _R_CHECK_LENGTH_1_LOGIC2_: verbose R_LIBS_USER: ${{ env.R_LIBS_USER }} + R_TINYTEST: true run: | tar -xf data-raw/AMR_latest.tar.gz rm -rf AMR/vignettes R CMD check AMR shell: bash - + - name: Run R CMD check on Linux and macOS if: runner.os != 'Windows' env: @@ -160,6 +153,7 @@ jobs: _R_CHECK_LENGTH_1_CONDITION_: verbose _R_CHECK_LENGTH_1_LOGIC2_: verbose R_LIBS_USER: ${{ env.R_LIBS_USER }} + R_TINYTEST: true run: | tar -xf data-raw/AMR_latest.tar.gz rm -rf AMR/vignettes diff --git a/DESCRIPTION b/DESCRIPTION index 85711e99..a4650e8f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.6.0.9030 -Date: 2021-05-13 +Version: 1.6.0.9031 +Date: 2021-05-15 Title: Antimicrobial Resistance Data Analysis Authors@R: c( person(role = c("aut", "cre"), @@ -55,9 +55,9 @@ Suggests: rstudioapi, rvest, skimr, - testthat, tidyr, - xml2 + tinytest, + xml2, VignetteBuilder: knitr,rmarkdown URL: https://msberends.github.io/AMR/, https://github.com/msberends/AMR BugReports: https://github.com/msberends/AMR/issues diff --git a/NEWS.md b/NEWS.md index 465c8846..2f768204 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,5 @@ -# `AMR` 1.6.0.9030 -## Last updated: 13 May 2021 +# `AMR` 1.6.0.9031 +## Last updated: 15 May 2021 ### New * Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()` @@ -32,7 +32,7 @@ * Altered the RStudio addin, so it now iterates over `%like%` -> `%unlike%` -> `%like_case%` -> `%unlike_case%` if you keep pressing your keyboard shortcut * Fixed an installation error on R-3.0 * Added `info` argument to `as.mo()` to turn on/off the progress bar -* Fixed a bug that `col_mo` for some functions (esp. `eucast_rules()` and `mdro()`) could not be column names of the `microorganisms` data set as it would throw an error +* Fixed a bug where `col_mo` in some functions (esp. `eucast_rules()` and `mdro()`) could not be a column name of the `microorganisms` data set as it would throw an error * Fix for transforming numeric values to RSI (`as.rsi()`) when the `vctrs` package is loaded (i.e., when using tidyverse) * Colour fix for using `barplot()` on an RSI class * Added 25 common system codes for bacteria to the `microorganisms.codes` data set @@ -42,6 +42,9 @@ * Fix for plotting missing MIC/disk diffusion values * Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables +### Other +* All unit tests are now processed by the `tinytest` package, instead of the `testthat` package. The `testthat` package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the `tinytest` package is very lightweight and dependency-free. + # `AMR` 1.6.0 diff --git a/data-raw/AMR_latest.tar.gz b/data-raw/AMR_latest.tar.gz index c6468c07..80fa16f5 100644 Binary files a/data-raw/AMR_latest.tar.gz and b/data-raw/AMR_latest.tar.gz differ diff --git a/data-raw/_install_deps.R b/data-raw/_install_deps.R new file mode 100644 index 00000000..b1aa9ac7 --- /dev/null +++ b/data-raw/_install_deps.R @@ -0,0 +1,47 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +pkg_suggests <- trimws(unlist(strsplit(packageDescription("AMR")$Suggests, ",(\n)?"))) + +to_install <- pkg_suggests[!pkg_suggests %in% rownames(utils::installed.packages())] +to_update <- as.data.frame(old.packages(), stringsAsFactors = FALSE) + +for (i in seq_len(length(to_install))) { + cat("Installing package", to_install[i], "\n") + tryCatch(install.packages(to_install[i], repos = "https://cran.rstudio.com/", dependencies = TRUE, quiet = TRUE), + message = function(m) invisible(), + warning = function(w) message(w$message), + error = function(e) message(e$message)) +} + +for (i in seq_len(length(to_update))) { + cat("Updating package", to_install[i], "\n") + tryCatch(update.packages(to_update[i], repos = "https://cran.rstudio.com/", ask = FALSE), + message = function(m) invisible(), + warning = function(w) message(w$message), + error = function(e) message(e$message)) +} + +# saveRDS(to_update, ".github/depends.Rds", version = 2) diff --git a/docs/404.html b/docs/404.html index 33f02b6c..6f3df78c 100644 --- a/docs/404.html +++ b/docs/404.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html index 425aa90d..e5c16bd8 100644 --- a/docs/LICENSE-text.html +++ b/docs/LICENSE-text.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 diff --git a/docs/articles/index.html b/docs/articles/index.html index 1ae9f88a..75118820 100644 --- a/docs/articles/index.html +++ b/docs/articles/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 diff --git a/docs/authors.html b/docs/authors.html index a726d9f2..b7967996 100644 --- a/docs/authors.html +++ b/docs/authors.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 diff --git a/docs/index.html b/docs/index.html index 8ea1630f..33a014f1 100644 --- a/docs/index.html +++ b/docs/index.html @@ -42,7 +42,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 diff --git a/docs/news/index.html b/docs/news/index.html index 5f95edd0..7c5e9c4f 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031 @@ -236,12 +236,12 @@ Source: NEWS.md -
-

- Unreleased AMR 1.6.0.9030

-
+
+

+ Unreleased AMR 1.6.0.9031

+

-Last updated: 13 May 2021 +Last updated: 15 May 2021

@@ -297,7 +297,7 @@
  • Fixed an installation error on R-3.0
  • Added info argument to as.mo() to turn on/off the progress bar
  • -
  • Fixed a bug that col_mo for some functions (esp. eucast_rules() and mdro()) could not be column names of the microorganisms data set as it would throw an error
  • +
  • Fixed a bug where col_mo in some functions (esp. eucast_rules() and mdro()) could not be a column name of the microorganisms data set as it would throw an error
  • Fix for transforming numeric values to RSI (as.rsi()) when the vctrs package is loaded (i.e., when using tidyverse)
  • Colour fix for using barplot() on an RSI class
  • Added 25 common system codes for bacteria to the microorganisms.codes data set
  • @@ -308,6 +308,13 @@
  • Updated join functions to always use dplyr join functions if the dplyr package is installed - now also preserving grouped variables
  • +
    +

    +Other

    +
      +
    • All unit tests are now processed by the tinytest package, instead of the testthat package. The testthat package unfortunately requires tons of dependencies that are also heavy and only usable for recent R versions, defeating the purpose to test our package under less recent R versions. On the contrary, the tinytest package is very lightweight and dependency-free.
    • +
    +
    @@ -438,9 +445,9 @@
  • Added argument include_untested_rsi to the first_isolate() functions (defaults to TRUE to keep existing behaviour), to be able to exclude rows where all R/SI values (class <rsi>, see as.rsi()) are empty
  • -
    +

    -Other

    +Other
    • Big documentation updates
    • Loading the package (i.e., library(AMR)) now is ~50 times faster than before, in costs of package size (which increased by ~3 MB)
    • @@ -545,9 +552,9 @@
    • If as.mo() takes more than 30 seconds, some suggestions will be done to improve speed

    -
    +

    -Other

    +Other
    • All messages and warnings thrown by this package now break sentences on whole words
    • More extensive unit tests
    • @@ -652,9 +659,9 @@
    • Added argument excess to the kurtosis() function (defaults to FALSE), to return the excess kurtosis, defined as the kurtosis minus three.

    -
    +

    -Other

    +Other
    • Removed functions portion_R(), portion_S() and portion_I() that were deprecated since version 0.9.0 (November 2019) and were replaced with proportion_R(), proportion_S() and proportion_I()
    • @@ -737,9 +744,9 @@
    • Fixed a bug where as.mic() could not handle dots without a leading zero (like "<=.25)

    -
    +

    -Other

    +Other
    • Moved primary location of this project from GitLab to GitHub, giving us native support for automated syntax checking without being dependent on external services such as AppVeyor and Travis CI.
    @@ -798,9 +805,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Added abbreviation “cfsc” for Cefoxitin and “cfav” for Ceftazidime/avibactam
  • -
    +

    -Other

    +Other
    • Removed previously deprecated function p.symbol() - it was replaced with p_symbol()
    • @@ -839,9 +846,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • Added generic CLSI rules for R/SI interpretation using as.rsi() for years 2010-2019 (thanks to Anthony Underwood)
    -
    +

    -Other

    +Other
    • Support for the upcoming dplyr version 1.0.0
    • More robust assigning for classes rsi and mic @@ -941,9 +948,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    -
    +

    -Other

    +Other
    • Add a CITATION file
    • Full support for the upcoming R 4.0
    • @@ -1048,9 +1055,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    -
    +

    -Other

    +Other
    • Rewrote the complete documentation to markdown format, to be able to use the very latest version of the great Roxygen2, released in November 2019. This tremously improved the documentation quality, since the rewrite forced us to go over all texts again and make changes where needed.
    • Change dependency on clean to cleaner, as this package was renamed accordingly upon CRAN request
    • @@ -1213,9 +1220,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • Added more MIC factor levels (as.mic())
    -
    +

    -Other

    +Other
    • Added Prof. Dr. Casper Albers as doctoral advisor and added Dr. Judith Fonville, Eric Hazenberg, Dr. Bart Meijer, Dr. Dennis Souverein and Annick Lenglet as contributors
    • Cleaned the coding style of every single syntax line in this package with the help of the lintr package
    • @@ -1299,9 +1306,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    -
    +

    -Other

    +Other
    • Fixed a note thrown by CRAN tests
    @@ -1394,9 +1401,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Fix for mo_shortname() where species would not be determined correctly
  • -
    +

    -Other

    +Other
    • Support for R 3.6.0 and later by providing support for staged install
    • @@ -1659,9 +1666,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    • if using different lengths of pattern and x in %like%, it will now return the call
    -
    +

    -Other

    +Other
    • Updated licence text to emphasise GPL 2.0 and that this is an R package.
    @@ -1780,9 +1787,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Percentages will now will rounded more logically (e.g. in freq function)

  • -
    +

    -Other

    +Other
    • New dependency on package crayon, to support formatted text in the console
    • Dependency tidyr is now mandatory (went to Import field) since portion_df and count_df rely on it
    • @@ -1930,9 +1937,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
    -
    +

    -Other

    +Other
    • More unit tests to ensure better integrity of functions
    @@ -2058,9 +2065,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
  • Other small fixes
  • -
    +

    -Other

    +Other
    • Added integration tests (check if everything works as expected) for all releases of R 3.1 and higher
        @@ -2119,9 +2126,9 @@ This works for all drug combinations, such as ampicillin/sulbactam, ceftazidime/
      • Functions as.rsi and as.mic now add the package name and version as attributes
    -
    +

    -Other

    +Other
    • Expanded README.md with more examples
    • Added ORCID of authors to DESCRIPTION file
    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index f0c65a8b..bfcafffb 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -12,7 +12,7 @@ articles: datasets: datasets.html resistance_predict: resistance_predict.html welcome_to_AMR: welcome_to_AMR.html -last_built: 2021-05-13T21:04Z +last_built: 2021-05-15T19:35Z urls: reference: https://msberends.github.io/AMR//reference article: https://msberends.github.io/AMR//articles diff --git a/docs/reference/index.html b/docs/reference/index.html index 0996b8d7..04e8ee42 100644 --- a/docs/reference/index.html +++ b/docs/reference/index.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031
    diff --git a/docs/survey.html b/docs/survey.html index f52d7b9b..bb803e31 100644 --- a/docs/survey.html +++ b/docs/survey.html @@ -81,7 +81,7 @@ AMR (for R) - 1.6.0.9030 + 1.6.0.9031
    diff --git a/inst/tinytest/test-_deprecated.R b/inst/tinytest/test-_deprecated.R new file mode 100644 index 00000000..80c01cce --- /dev/null +++ b/inst/tinytest/test-_deprecated.R @@ -0,0 +1,39 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_identical(suppressWarnings(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3))), + c("***", "**", "*", ".", " ", NA, NA)) + +expect_warning(key_antibiotics(example_isolates)) +expect_identical(suppressWarnings(key_antibiotics(example_isolates)), + key_antimicrobials(example_isolates, antifungal = NULL)) + +expect_warning(key_antibiotics_equal("S", "S")) +expect_identical(suppressWarnings(key_antibiotics_equal("S", "S")), + antimicrobials_equal("S", "S", type = "keyantimicrobials")) + +expect_warning(filter_first_weighted_isolate(example_isolates)) +expect_identical(suppressWarnings(filter_first_weighted_isolate(example_isolates)), + filter_first_isolate(example_isolates)) diff --git a/tests/testthat/test-_misc.R b/inst/tinytest/test-_misc.R similarity index 57% rename from tests/testthat/test-_misc.R rename to inst/tinytest/test-_misc.R index 5561429e..af898a51 100755 --- a/tests/testthat/test-_misc.R +++ b/inst/tinytest/test-_misc.R @@ -22,47 +22,34 @@ # Visit our website for the full manual and a complete tutorial about # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # - -context("aa_helper_functions.R") - -test_that("percentages works", { - skip_on_cran() - expect_equal(percentage(0.25), "25%") - expect_equal(percentage(0.5), "50%") - expect_equal(percentage(0.500, digits = 1), "50.0%") - expect_equal(percentage(0.1234), "12.3%") + +expect_equal(percentage(0.25), "25%") +expect_equal(percentage(0.5), "50%") +expect_equal(percentage(0.500, digits = 1), "50.0%") +expect_equal(percentage(0.1234), "12.3%") # round up 0.5 - expect_equal(percentage(0.0054), "0.5%") - expect_equal(percentage(0.0055), "0.6%") -}) - -test_that("functions missing in older R versions work", { - skip_on_cran() - expect_equal(strrep("A", 5), "AAAAA") - expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) - expect_equal(trimws(" test "), "test") - expect_equal(trimws(" test ", "l"), "test ") - expect_equal(trimws(" test ", "r"), " test") -}) - -test_that("looking up ab columns works", { - skip_on_cran() - expect_warning(generate_warning_abs_missing(c("AMP", "AMX"))) - expect_warning(generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE)) - expect_warning(get_column_abx(example_isolates, hard_dependencies = "FUS")) - expect_message(get_column_abx(example_isolates, soft_dependencies = "FUS")) +expect_equal(percentage(0.0054), "0.5%") +expect_equal(percentage(0.0055), "0.6%") + +expect_equal(strrep("A", 5), "AAAAA") +expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) +expect_equal(trimws(" test "), "test") +expect_equal(trimws(" test ", "l"), "test ") +expect_equal(trimws(" test ", "r"), " test") + +expect_warning(generate_warning_abs_missing(c("AMP", "AMX"))) +expect_warning(generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE)) +expect_warning(get_column_abx(example_isolates, hard_dependencies = "FUS")) +expect_message(get_column_abx(example_isolates, soft_dependencies = "FUS")) if (suppressWarnings(require("dplyr"))) { - expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE)) - expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE)) + expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE)) + expect_warning(get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE)) } -}) - -test_that("looking up ab columns works", { - skip_on_cran() + # we rely on "grouped_tbl" being a class of grouped tibbles, so implement a test that checks for this: if (suppressWarnings(require("dplyr"))) { - expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id))) + expect_true(is_null_or_grouped_tbl(example_isolates %>% group_by(hospital_id))) } -}) + diff --git a/tests/testthat/test-join_microorganisms.R b/inst/tinytest/test-ab.R similarity index 52% rename from tests/testthat/test-join_microorganisms.R rename to inst/tinytest/test-ab.R index 9e0512b2..effe6b8d 100755 --- a/tests/testthat/test-join_microorganisms.R +++ b/inst/tinytest/test-ab.R @@ -23,41 +23,50 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("join_microorganisms.R") +expect_equal(as.character(as.ab(c("J01FA01", + "J 01 FA 01", + "Erythromycin", + "eryt", + " eryt 123", + "ERYT", + "ERY", + "erytromicine", + "Erythrocin", + "Romycin"))), + rep("ERY", 10)) -test_that("joins work", { - skip_on_cran() - unjoined <- example_isolates - inner <- example_isolates %>% inner_join_microorganisms() - left <- example_isolates %>% left_join_microorganisms() - semi <- example_isolates %>% semi_join_microorganisms() - anti <- example_isolates %>% anti_join_microorganisms() - suppressWarnings(right <- example_isolates %>% right_join_microorganisms()) - suppressWarnings(full <- example_isolates %>% full_join_microorganisms()) +expect_identical(class(as.ab("amox")), c("ab", "character")) +expect_identical(class(antibiotics$ab), c("ab", "character")) +expect_true(is.ab(as.ab("amox"))) +expect_stdout(print(as.ab("amox"))) +expect_stdout(print(data.frame(a = as.ab("amox")))) - expect_true(ncol(unjoined) < ncol(inner)) - expect_true(nrow(unjoined) == nrow(inner)) +expect_warning(as.ab("J00AA00")) # ATC not yet available in data set +expect_warning(as.ab("UNKNOWN")) +expect_warning(as.ab("")) - expect_true(ncol(unjoined) < ncol(left)) - expect_true(nrow(unjoined) == nrow(left)) +expect_stdout(print(as.ab("amox"))) - expect_true(ncol(semi) == ncol(semi)) - expect_true(nrow(semi) == nrow(semi)) +expect_equal(as.character(as.ab("Phloxapen")), + "FLC") - expect_true(nrow(anti) == 0) +expect_equal(suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))), + c(NA, "TMP")) - expect_true(nrow(unjoined) < nrow(right)) - expect_true(nrow(unjoined) < nrow(full)) +expect_equal(as.character(as.ab("Amoxy + clavulaanzuur")), + "AMC") - expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1) - expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1) +expect_equal(as.character(as.ab(c("mreopenem", "co-maoxiclav"))), + c("MEM", "AMC")) - expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1) +expect_message(as.ab("cipro mero")) - expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1) - expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0) - - expect_warning(right_join_microorganisms("B_ESCHR_COLI")) - expect_warning(full_join_microorganisms("B_ESCHR_COLI")) - -}) +# assigning and subsetting +x <- antibiotics$ab +expect_inherits(x[1], "ab") +expect_inherits(x[[1]], "ab") +expect_inherits(c(x[1], x[9]), "ab") +expect_inherits(unique(x[1], x[9]), "ab") +expect_warning(x[1] <- "invalid code") +expect_warning(x[[1]] <- "invalid code") +expect_warning(c(x[1], "test")) diff --git a/tests/testthat/test-ab_from_text.R b/inst/tinytest/test-ab_class_selectors.R similarity index 55% rename from tests/testthat/test-ab_from_text.R rename to inst/tinytest/test-ab_class_selectors.R index d8c22e89..56327f57 100644 --- a/tests/testthat/test-ab_from_text.R +++ b/inst/tinytest/test-ab_class_selectors.R @@ -23,24 +23,20 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("ab_from_text.R") +if (suppressWarnings(require("dplyr"))) { +expect_true(example_isolates %>% select(aminoglycosides()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(carbapenems()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins_1st()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins_2nd()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins_3rd()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins_4th()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(cephalosporins_5th()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(fluoroquinolones()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(glycopeptides()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(macrolides()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(oxazolidinones()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(penicillins()) %>% ncol() < ncol(example_isolates)) +expect_true(example_isolates %>% select(tetracyclines()) %>% ncol() < ncol(example_isolates)) +} -test_that("ab_from_text works", { - skip_on_cran() - - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]], - as.ab("Amoxicillin")) - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]], - as.ab("Amoxicillin")) - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]], - as.ab("Amoxicillin")) - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]], - "Amoxicillin") - expect_identical(ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]], - "AMC, CIP") - - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]], - 500) - expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]], - "oral") -}) diff --git a/tests/testthat/test-_deprecated.R b/inst/tinytest/test-ab_from_text.R similarity index 65% rename from tests/testthat/test-_deprecated.R rename to inst/tinytest/test-ab_from_text.R index be465b59..aaed893b 100644 --- a/tests/testthat/test-_deprecated.R +++ b/inst/tinytest/test-ab_from_text.R @@ -23,23 +23,18 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("deprecated.R") +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]], + as.ab("Amoxicillin")) +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]], + as.ab("Amoxicillin")) +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]], + as.ab("Amoxicillin")) +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]], + "Amoxicillin") +expect_identical(ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]], + "AMC, CIP") -test_that("deprecated functions work", { - skip_on_cran() - expect_identical(suppressWarnings(p_symbol(c(0.001, 0.01, 0.05, 0.1, 1, NA, 3))), - c("***", "**", "*", ".", " ", NA, NA)) - - expect_warning(key_antibiotics(example_isolates)) - expect_identical(suppressWarnings(key_antibiotics(example_isolates)), - key_antimicrobials(example_isolates, antifungal = NULL)) - - expect_warning(key_antibiotics_equal("S", "S")) - expect_identical(suppressWarnings(key_antibiotics_equal("S", "S")), - antimicrobials_equal("S", "S", type = "keyantimicrobials")) - - expect_warning(filter_first_weighted_isolate(example_isolates)) - expect_identical(suppressWarnings(filter_first_weighted_isolate(example_isolates)), - filter_first_isolate(example_isolates)) - -}) +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]], + 500) +expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]], + "oral") diff --git a/inst/tinytest/test-ab_property.R b/inst/tinytest/test-ab_property.R new file mode 100644 index 00000000..dd3f255b --- /dev/null +++ b/inst/tinytest/test-ab_property.R @@ -0,0 +1,63 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_identical(ab_name("AMX", language = NULL), "Amoxicillin") +expect_identical(as.character(ab_atc("AMX")), "J01CA04") +expect_identical(ab_cid("AMX"), as.integer(33613)) + +expect_inherits(ab_tradenames("AMX"), "character") +expect_inherits(ab_tradenames(c("AMX", "AMX")), "list") + +expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins") +expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins") +expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum") + +expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin") +expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin") +expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin") +expect_identical(ab_name(21319, language = NULL), "Flucloxacillin") +expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin") + +expect_identical(ab_ddd("AMX", "oral"), 1.5) +expect_identical(ab_ddd("AMX", "oral", units = TRUE), "g") +expect_identical(ab_ddd("AMX", "iv"), 3) +expect_identical(ab_ddd("AMX", "iv", units = TRUE), "g") + +expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B")) +expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL), + c("amoxicillin/clavulanic acid", "polymyxin B")) + +expect_inherits(ab_info("AMX"), "list") + +expect_error(ab_property("amox", "invalid property")) +expect_error(ab_name("amox", language = "INVALID")) +expect_stdout(print(ab_name("amox", language = NULL))) + +expect_equal(ab_name("21066-6", language = NULL), "Ampicillin") +expect_equal(ab_loinc("ampicillin"), + c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5")) + +expect_true(ab_url("AMX") %like% "whocc.no") +expect_warning(ab_url("ASP")) diff --git a/tests/testthat/test-g.test.R b/inst/tinytest/test-age.R similarity index 55% rename from tests/testthat/test-g.test.R rename to inst/tinytest/test-age.R index dfc1c70b..114ef28a 100644 --- a/tests/testthat/test-g.test.R +++ b/inst/tinytest/test-age.R @@ -23,49 +23,46 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("g.test.R") +expect_equal(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), + reference = "2019-01-01"), + c(39, 34, 29)) -test_that("G-test works", { - skip_on_cran() +expect_equal(age(x = c("2019-01-01", "2019-04-01", "2019-07-01"), + reference = "2019-09-01", + exact = TRUE), + c(0.6656393, 0.4191781, 0.1698630), + tolerance = 0.001) - # GOODNESS-OF-FIT +expect_error(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), + reference = c("2019-01-01", "2019-01-01"))) - # example 1: clearfield rice vs. red rice - x <- c(772, 1611, 737) - expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value, - expected = 0.12574, - tolerance = 0.00001) +expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), + reference = "1975-01-01")) - # example 2: red crossbills - x <- c(1752, 1895) - expect_equal(g.test(x)$p.value, - expected = 0.01787343, - tolerance = 0.00000001) +expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"), + reference = "2019-01-01")) - expect_error(g.test(0)) - expect_error(g.test(c(0, 1), 0)) - expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25))) - expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24))) - expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE)) +expect_equal(length(age(x = c("2019-01-01", NA), na.rm = TRUE)), + 1) - # INDEPENDENCE - x <- as.data.frame( - matrix(data = round(runif(4) * 100000, 0), - ncol = 2, - byrow = TRUE) - ) - - # fisher.test() is always better for 2x2 tables: - expect_warning(g.test(x)) - expect_lt(suppressWarnings(g.test(x)$p.value), - 1) +ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21) - expect_warning(g.test(x = c(772, 1611, 737), - y = c(780, 1560, 780), - rescale.p = TRUE)) +expect_equal(length(unique(age_groups(ages, 50))), + 2) +expect_equal(length(unique(age_groups(ages, c(50, 60)))), + 3) +expect_identical(class(age_groups(ages, "child")), + c("ordered", "factor")) - expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE))) - expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE))) +expect_identical(class(age_groups(ages, "elderly")), + c("ordered", "factor")) -}) +expect_identical(class(age_groups(ages, "tens")), + c("ordered", "factor")) + +expect_identical(class(age_groups(ages, "fives")), + c("ordered", "factor")) + +expect_equal(length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)), + 3) diff --git a/tests/testthat/test-atc_online.R b/inst/tinytest/test-atc_online.R similarity index 90% rename from tests/testthat/test-atc_online.R rename to inst/tinytest/test-atc_online.R index f014c0bf..bd390e1a 100644 --- a/tests/testthat/test-atc_online.R +++ b/inst/tinytest/test-atc_online.R @@ -23,15 +23,9 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("atc_online.R") - -test_that("atc_online works", { - skip_on_cran() - skip_if_not_installed("curl") - skip_if_not(curl::has_internet()) - - expect_gte(length(atc_online_groups(ab_atc("AMX"))), 1) +if (tryCatch(curl::has_internet(), error = function(e) FALSE)) { + expect_true(length(atc_online_groups(ab_atc("AMX"))) >= 1) expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5) expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "P"), 3) expect_warning(atc_online_ddd(ab_atc("Novobiocin"), administration = "P")) -}) +} diff --git a/tests/testthat/test-availability.R b/inst/tinytest/test-availability.R similarity index 92% rename from tests/testthat/test-availability.R rename to inst/tinytest/test-availability.R index 171da6fd..79a97f06 100644 --- a/tests/testthat/test-availability.R +++ b/inst/tinytest/test-availability.R @@ -22,10 +22,5 @@ # Visit our website for the full manual and a complete tutorial about # # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # - -context("availability.R") - -test_that("availability works", { - skip_on_cran() - expect_equal(class(availability(example_isolates)), "data.frame") -}) + +expect_inherits(availability(example_isolates), "data.frame") diff --git a/tests/testthat/test-bug_drug_combinations.R b/inst/tinytest/test-bug_drug_combinations.R similarity index 82% rename from tests/testthat/test-bug_drug_combinations.R rename to inst/tinytest/test-bug_drug_combinations.R index 80b83886..50ae048c 100644 --- a/tests/testthat/test-bug_drug_combinations.R +++ b/inst/tinytest/test-bug_drug_combinations.R @@ -23,14 +23,8 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("bug_drug_combinations.R") - -test_that("bug_drug_combinations works", { - skip_on_cran() - - b <- suppressWarnings(bug_drug_combinations(example_isolates)) - expect_s3_class(b, "bug_drug_combinations") - expect_output(print(b)) - expect_true(is.data.frame(format(b))) - expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE))) -}) +b <- suppressWarnings(bug_drug_combinations(example_isolates)) +expect_inherits(b, "bug_drug_combinations") +expect_stdout(print(b)) +expect_true(is.data.frame(format(b))) +expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE))) diff --git a/inst/tinytest/test-count.R b/inst/tinytest/test-count.R new file mode 100644 index 00000000..38cbcd93 --- /dev/null +++ b/inst/tinytest/test-count.R @@ -0,0 +1,99 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX)) +expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX)) +expect_equal(count_all(example_isolates$AMX), n_rsi(example_isolates$AMX)) + +# AMX resistance in `example_isolates` +expect_equal(count_R(example_isolates$AMX), 804) +expect_equal(count_I(example_isolates$AMX), 3) +expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543) +expect_equal(count_R(example_isolates$AMX) + count_I(example_isolates$AMX), + suppressWarnings(count_IR(example_isolates$AMX))) +expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX), + count_SI(example_isolates$AMX)) + + +# warning for speed loss +reset_all_thrown_messages() +expect_warning(count_resistant(as.character(example_isolates$AMC))) +reset_all_thrown_messages() +expect_warning(count_resistant(example_isolates$AMC, + as.character(example_isolates$GEN))) + +# check for errors +expect_error(count_resistant("test", minimum = "test")) +expect_error(count_resistant("test", as_percent = "test")) +expect_error(count_susceptible("test", minimum = "test")) +expect_error(count_susceptible("test", as_percent = "test")) + +expect_error(count_df(c("A", "B", "C"))) +expect_error(count_df(example_isolates[, "date"])) + +if (suppressWarnings(require("dplyr"))) { + expect_equal(example_isolates %>% count_susceptible(AMC), 1433) + expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE), 1687) + expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764) + expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), 1798) + expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936) + expect_identical(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), + example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) + + example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE)) + + # count of cases + expect_equal(example_isolates %>% + group_by(hospital_id) %>% + summarise(cipro = count_susceptible(CIP), + genta = count_susceptible(GEN), + combination = count_susceptible(CIP, GEN)) %>% + pull(combination), + c(253, 465, 192, 558)) + + # count_df + expect_equal( + example_isolates %>% select(AMX) %>% count_df() %>% pull(value), + c(example_isolates$AMX %>% count_susceptible(), + example_isolates$AMX %>% count_resistant()) + ) + expect_equal( + example_isolates %>% select(AMX) %>% count_df(combine_IR = TRUE) %>% pull(value), + c(suppressWarnings(example_isolates$AMX %>% count_S()), + suppressWarnings(example_isolates$AMX %>% count_IR())) + ) + expect_equal( + example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value), + c(suppressWarnings(example_isolates$AMX %>% count_S()), + example_isolates$AMX %>% count_I(), + example_isolates$AMX %>% count_R()) + ) + + # grouping in rsi_calc_df() (= backbone of rsi_df()) + expect_true("hospital_id" %in% (example_isolates %>% + group_by(hospital_id) %>% + select(hospital_id, AMX, CIP, gender) %>% + rsi_df() %>% + colnames())) +} diff --git a/inst/tinytest/test-data.R b/inst/tinytest/test-data.R new file mode 100644 index 00000000..76be3511 --- /dev/null +++ b/inst/tinytest/test-data.R @@ -0,0 +1,84 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_true(check_dataset_integrity()) # in misc.R + +# IDs should always be unique +expect_identical(nrow(microorganisms), length(unique(microorganisms$mo))) +expect_identical(class(microorganisms$mo), c("mo", "character")) +expect_identical(nrow(antibiotics), length(unique(antibiotics$ab))) +expect_identical(class(antibiotics$ab), c("ab", "character")) + +# check cross table reference +expect_true(all(microorganisms.codes$mo %in% microorganisms$mo)) +expect_true(all(example_isolates$mo %in% microorganisms$mo)) +expect_true(all(microorganisms.translation$mo_new %in% microorganisms$mo)) +expect_true(all(rsi_translation$mo %in% microorganisms$mo)) +expect_true(all(rsi_translation$ab %in% antibiotics$ab)) +expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant() +expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name)) +expect_false(any(is.na(microorganisms.codes$code))) +expect_false(any(is.na(microorganisms.codes$mo))) +expect_false(any(microorganisms.translation$mo_old %in% microorganisms$mo)) +expect_true(all(dosage$ab %in% antibiotics$ab)) +expect_true(all(dosage$name %in% antibiotics$name)) + +# antibiotic names must always be coercible to their original AB code +expect_identical(as.ab(antibiotics$name), antibiotics$ab) + +# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy) +datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"] +for (i in seq_len(length(datasets))) { + dataset <- get(datasets[i], envir = asNamespace("AMR")) + expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i]) +} + +df <- AMR:::MO_lookup +expect_true(nrow(df[which(df$prevalence == 1), ]) < nrow(df[which(df$prevalence == 2), ])) +expect_true(nrow(df[which(df$prevalence == 2), ]) < nrow(df[which(df$prevalence == 3), ])) +expect_true(all(c("mo", "fullname", + "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", + "rank", "ref", "species_id", "source", "prevalence", "snomed", + "kingdom_index", "fullname_lower", "g_species") %in% colnames(df))) + +expect_true(all(c("fullname", "fullname_new", "ref", "prevalence", + "fullname_lower", "g_species") %in% colnames(AMR:::MO.old_lookup))) + +expect_inherits(AMR:::MO_CONS, "mo") + +expect_identical(class(catalogue_of_life_version()), + c("catalogue_of_life_version", "list")) + +expect_stdout(print(catalogue_of_life_version())) + +uncategorised <- subset(microorganisms, + genus == "Staphylococcus" & + !species %in% c("", "aureus") & + !mo %in% c(MO_CONS, MO_COPS)) +expect_true(NROW(uncategorised) == 0, + info = ifelse(NROW(uncategorised) == 0, + "All staphylococcal species categorised as CoNS/CoPS.", + paste0("Staphylococcal species not categorised as CoNS/CoPS: S. ", + uncategorised$species, " (", uncategorised$mo, ")"))) diff --git a/tests/testthat/test-disk.R b/inst/tinytest/test-disk.R similarity index 59% rename from tests/testthat/test-disk.R rename to inst/tinytest/test-disk.R index 15bb359d..5187bd7c 100755 --- a/tests/testthat/test-disk.R +++ b/inst/tinytest/test-disk.R @@ -23,39 +23,33 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("disk.R") +expect_true(as.disk(8) == as.disk("8")) +expect_true(is.disk(as.disk(8))) -test_that("disk works", { - skip_on_cran() - expect_true(as.disk(8) == as.disk("8")) - expect_true(is.disk(as.disk(8))) +expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA) - expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA) +# all levels should be valid disks +x <- as.disk(c(20, 40)) +expect_inherits(x[1], "disk") +expect_inherits(x[[1]], "disk") +expect_inherits(c(x[1], x[9]), "disk") +expect_inherits(unique(x[1], x[9]), "disk") +expect_warning(as.disk("INVALID VALUE")) +x[2] <- 32 +expect_inherits(x, "disk") - # all levels should be valid disks - x <- as.disk(c(20, 40)) - expect_s3_class(x[1], "disk") - expect_s3_class(x[[1]], "disk") - expect_s3_class(c(x[1], x[9]), "disk") - expect_s3_class(unique(x[1], x[9]), "disk") - expect_warning(as.disk("INVALID VALUE")) - x[2] <- 32 - expect_s3_class(x, "disk") - - pdf(NULL) # prevent Rplots.pdf being created - expect_silent(barplot(as.disk(c(10, 20, 40)))) - expect_silent(plot(as.disk(c(10, 20, 40)))) - expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE)) - expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr")) - if (suppressWarnings(require("ggplot2"))) { - expect_s3_class(ggplot(as.disk(c(10, 20, 40))), "gg") - expect_s3_class(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg") - expect_s3_class(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg") - } - expect_output(print(as.disk(12))) - - if (suppressWarnings(require("dplyr"))) { - expect_output(print(tibble(d = as.disk(12)))) - } +pdf(NULL) # prevent Rplots.pdf being created +expect_silent(barplot(as.disk(c(10, 20, 40)))) +expect_silent(plot(as.disk(c(10, 20, 40)))) +expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE)) +expect_silent(plot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr")) +if (suppressWarnings(require("ggplot2"))) { + expect_inherits(ggplot(as.disk(c(10, 20, 40))), "gg") + expect_inherits(ggplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg") + expect_inherits(ggplot(as.disk(c(10, 20, 40)), mo = "esco", ab = "cipr"), "gg") +} +expect_stdout(print(as.disk(12))) -}) +if (suppressWarnings(require("dplyr"))) { + expect_stdout(print(tibble(d = as.disk(12)))) +} diff --git a/tests/testthat/test-random.R b/inst/tinytest/test-episode.R similarity index 63% rename from tests/testthat/test-random.R rename to inst/tinytest/test-episode.R index 637683e8..618963f5 100644 --- a/tests/testthat/test-random.R +++ b/inst/tinytest/test-episode.R @@ -23,22 +23,30 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("random.R") +test_df <- rbind( + data.frame( + date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")), + patient_id = "A" + ), + data.frame( + date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")), + patient_id = "B" + )) -test_that("random works", { - skip_on_cran() +expect_equal(get_episode(test_df$date, 365), + c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3)) + +if (suppressWarnings(require("dplyr"))) { + expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f), + c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)) - expect_s3_class(random_mic(100), "mic") - expect_s3_class(random_mic(100, mo = "Klebsiella pneumoniae"), "mic") - expect_s3_class(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic") - expect_s3_class(random_mic(100, ab = "meropenem"), "mic") - # no normal factors of 2 - expect_s3_class(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic") + suppressMessages( + x <- example_isolates %>% + mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE)) + ) + y <- example_isolates %>% + group_by(patient_id, mo) %>% + mutate(out = is_new_episode(date, 365)) - expect_s3_class(random_disk(100), "disk") - expect_s3_class(random_disk(100, mo = "Klebsiella pneumoniae"), "disk") - expect_s3_class(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk") - expect_s3_class(random_disk(100, ab = "meropenem"), "disk") - - expect_s3_class(random_rsi(100), "rsi") -}) + expect_identical(which(x$out), which(y$out)) +} diff --git a/inst/tinytest/test-eucast_rules.R b/inst/tinytest/test-eucast_rules.R new file mode 100755 index 00000000..014f073f --- /dev/null +++ b/inst/tinytest/test-eucast_rules.R @@ -0,0 +1,158 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +# thoroughly check input table +expect_equal(colnames(eucast_rules_file), + c("if_mo_property", "like.is.one_of", "this_value", + "and_these_antibiotics", "have_these_values", + "then_change_these_antibiotics", "to_value", + "reference.rule", "reference.rule_group", + "reference.version", + "note")) +MOs_mentioned <- unique(eucast_rules_file$this_value) +MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!is_valid_regex(MOs_mentioned)], ",", fixed = TRUE)))) +MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned))) +expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0) + +expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing"))) +expect_error(eucast_rules(x = "text")) +expect_error(eucast_rules(data.frame(a = "test"))) +expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set")) + +expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE))) + +expect_identical(colnames(example_isolates), + colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE)))) +expect_stdout(suppressMessages(eucast_rules(example_isolates, info = TRUE))) + +a <- data.frame(mo = c("Klebsiella pneumoniae", + "Pseudomonas aeruginosa", + "Enterobacter cloacae"), + amox = "-", # Amoxicillin + stringsAsFactors = FALSE) +b <- data.frame(mo = c("Klebsiella pneumoniae", + "Pseudomonas aeruginosa", + "Enterobacter cloacae"), + amox = "R", # Amoxicillin + stringsAsFactors = FALSE) +expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) +expect_stdout(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE)))) + +a <- data.frame(mo = c("Staphylococcus aureus", + "Streptococcus group A"), + COL = "-", # Colistin + stringsAsFactors = FALSE) +b <- data.frame(mo = c("Staphylococcus aureus", + "Streptococcus group A"), + COL = "R", # Colistin + stringsAsFactors = FALSE) +expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) + +# piperacillin must be R in Enterobacteriaceae when tica is R +if (suppressWarnings(require("dplyr"))) { + expect_equal(suppressWarnings( + example_isolates %>% + filter(mo_family(mo) == "Enterobacteriaceae") %>% + mutate(TIC = as.rsi("R"), + PIP = as.rsi("S")) %>% + eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>% + pull(PIP) %>% + unique() %>% + as.character()), + "R") +} + +# Azithromycin and Clarythromycin must be equal to Erythromycin +a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo, + ERY = example_isolates$ERY, + AZM = as.rsi("R"), + CLR = factor("R"), + stringsAsFactors = FALSE), + version_expertrules = 3.1, + only_rsi_columns = FALSE)$CLR)) +b <- example_isolates$ERY +expect_identical(a[!is.na(b)], + b[!is.na(b)]) + +# amox is inferred by benzylpenicillin in Kingella kingae +expect_equal( + suppressWarnings( + as.list(eucast_rules( + data.frame(mo = as.mo("Kingella kingae"), + PEN = "S", + AMX = "-", + stringsAsFactors = FALSE) + , info = FALSE))$AMX + ), + "S") + +# also test norf +if (suppressWarnings(require("dplyr"))) { + expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) +} + +# check verbose output +expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE))) + +# AmpC de-repressed cephalo mutants +expect_identical( + eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), + cefotax = as.rsi(c("S", "S"))), + ampc_cephalosporin_resistance = TRUE, + info = FALSE)$cefotax, + as.rsi(c("S", "R"))) +expect_identical( + eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), + cefotax = as.rsi(c("S", "S"))), + ampc_cephalosporin_resistance = NA, + info = FALSE)$cefotax, + as.rsi(c("S", NA))) +expect_identical( + eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), + cefotax = as.rsi(c("S", "S"))), + ampc_cephalosporin_resistance = NULL, + info = FALSE)$cefotax, + as.rsi(c("S", "S"))) + +# EUCAST dosage ----------------------------------------------------------- +expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3) +expect_inherits(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame") + + + +x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", + AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I", + AMX == "S" ~ AMC == "S") +expect_stdout(print(x)) +expect_stdout(print(c(x, x))) +expect_stdout(print(as.list(x, x))) + +# this custom rules makes 8 changes +expect_equal(nrow(eucast_rules(example_isolates, + rules = "custom", + custom_rules = x, + info = FALSE, + verbose = TRUE)), + 8) diff --git a/inst/tinytest/test-filter_ab_class.R b/inst/tinytest/test-filter_ab_class.R new file mode 100644 index 00000000..1476933d --- /dev/null +++ b/inst/tinytest/test-filter_ab_class.R @@ -0,0 +1,48 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +if (suppressWarnings(require("dplyr"))) { + expect_true(example_isolates %>% filter_ab_class("carbapenem") %>% nrow() > 0) + expect_true(example_isolates %>% filter_aminoglycosides() %>% ncol() > 0) + expect_true(example_isolates %>% filter_carbapenems() %>% ncol() > 0) + expect_true(example_isolates %>% filter_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_1st_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_2nd_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_3rd_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_4th_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_5th_cephalosporins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_fluoroquinolones() %>% ncol() > 0) + expect_true(example_isolates %>% filter_glycopeptides() %>% ncol() > 0) + expect_true(example_isolates %>% filter_macrolides() %>% ncol() > 0) + expect_true(example_isolates %>% filter_oxazolidinones() %>% ncol() > 0) + expect_true(example_isolates %>% filter_penicillins() %>% ncol() > 0) + expect_true(example_isolates %>% filter_tetracyclines() %>% ncol() > 0) + + expect_true(example_isolates %>% filter_carbapenems("R", "all") %>% nrow() > 0) + + expect_error(example_isolates %>% filter_carbapenems(result = "test")) + expect_error(example_isolates %>% filter_carbapenems(scope = "test")) + expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems()) +} diff --git a/inst/tinytest/test-first_isolate.R b/inst/tinytest/test-first_isolate.R new file mode 100755 index 00000000..fa591837 --- /dev/null +++ b/inst/tinytest/test-first_isolate.R @@ -0,0 +1,182 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +# all four methods +expect_equal(sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE), + 1984) +expect_equal(sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE), + 1265) +expect_equal(sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE), + 1300) +expect_equal(sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE), + 1379) + +# Phenotype-based, using key antimicrobials +expect_equal(sum(first_isolate(x = example_isolates, + method = "phenotype-based", + type = "keyantimicrobials", + antifungal = NULL, info = TRUE), na.rm = TRUE), + 1395) +expect_equal(sum(first_isolate(x = example_isolates, + method = "phenotype-based", + type = "keyantimicrobials", + antifungal = NULL, info = TRUE, ignore_I = FALSE), na.rm = TRUE), + 1418) + + +# first non-ICU isolates +expect_equal( + sum( + first_isolate(example_isolates, + col_mo = "mo", + col_date = "date", + col_patient_id = "patient_id", + col_icu = "ward_icu", + info = TRUE, + icu_exclude = TRUE), + na.rm = TRUE), + 941) + +# set 1500 random observations to be of specimen type 'Urine' +random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE) +x <- example_isolates +x$specimen <- "Other" +x[random_rows, "specimen"] <- "Urine" +expect_true( + sum(first_isolate(x = x, + col_date = "date", + col_patient_id = "patient_id", + col_mo = "mo", + col_specimen = "specimen", + filter_specimen = "Urine", + info = TRUE), na.rm = TRUE) < 1501) +# same, but now exclude ICU +expect_true( + sum(first_isolate(x = x, + col_date = "date", + col_patient_id = "patient_id", + col_mo = "mo", + col_specimen = "specimen", + filter_specimen = "Urine", + col_icu = "ward_icu", + icu_exclude = TRUE, + info = TRUE), na.rm = TRUE) < 1501) + +# "No isolates found" +test_iso <- example_isolates +test_iso$specimen <- "test" +expect_message(first_isolate(test_iso, + "date", + "patient_id", + col_mo = "mo", + col_specimen = "specimen", + filter_specimen = "something_unexisting", + info = TRUE)) + +# printing of exclusion message +expect_message(first_isolate(example_isolates, + col_date = "date", + col_mo = "mo", + col_patient_id = "patient_id", + col_testcode = "gender", + testcodes_exclude = "M", + info = TRUE)) + +# errors +expect_error(first_isolate("date", "patient_id", col_mo = "mo")) +expect_error(first_isolate(example_isolates, + col_date = "non-existing col", + col_mo = "mo")) + +if (suppressWarnings(require("dplyr"))) { + # if mo is not an mo class, result should be the same + expect_identical(example_isolates %>% + mutate(mo = as.character(mo)) %>% + first_isolate(col_date = "date", + col_mo = "mo", + col_patient_id = "patient_id", + info = FALSE), + example_isolates %>% + first_isolate(col_date = "date", + col_mo = "mo", + col_patient_id = "patient_id", + info = FALSE)) + + # support for WHONET + expect_message(example_isolates %>% + select(-patient_id) %>% + mutate(`First name` = "test", + `Last name` = "test", + Sex = "Female") %>% + first_isolate(info = TRUE)) + + # groups + x <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate()) + y <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate(.)) + expect_identical(x, y) + +} + +# missing dates should be no problem +df <- example_isolates +df[1:100, "date"] <- NA +expect_equal( + sum( + first_isolate(x = df, + col_date = "date", + col_patient_id = "patient_id", + col_mo = "mo", + info = TRUE), + na.rm = TRUE), + 1382) + +# unknown MOs +test_unknown <- example_isolates +test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo) +expect_equal(sum(first_isolate(test_unknown, include_unknown = FALSE)), + 1108) +expect_equal(sum(first_isolate(test_unknown, include_unknown = TRUE)), + 1591) + +test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo) +expect_equal(sum(first_isolate(test_unknown)), + 1108) + +# empty rsi results +expect_equal(sum(first_isolate(example_isolates, include_untested_rsi = FALSE)), + 1366) + +# shortcuts +expect_identical(filter_first_isolate(example_isolates), + subset(example_isolates, first_isolate(example_isolates))) + + +# notice that all mo's are distinct, so all are TRUE +expect_true(all(example_isolates %pm>% + pm_distinct(mo, .keep_all = TRUE) %pm>% + first_isolate(info = TRUE) == TRUE)) + +# only one isolate, so return fast +expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE)) diff --git a/tests/testthat/test-key_antimicrobials.R b/inst/tinytest/test-g.test.R similarity index 60% rename from tests/testthat/test-key_antimicrobials.R rename to inst/tinytest/test-g.test.R index 2a5910e4..aed6f20a 100644 --- a/tests/testthat/test-key_antimicrobials.R +++ b/inst/tinytest/test-g.test.R @@ -23,19 +23,41 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("key_antimcrobials.R") +# GOODNESS-OF-FIT -test_that("key_antimcrobials work", { - skip_on_cran() - expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates)) - expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL)))) - expect_true(antimicrobials_equal("SSS", "SSS", type = "points")) - expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials")) - expect_true(antimicrobials_equal("SSS", "SRS", type = "points")) - expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials")) - expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials")) - expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials")) - expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials")) - - expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ])) -}) +# example 1: clearfield rice vs. red rice +x <- c(772, 1611, 737) +expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value, + 0.12574, + tolerance = 0.0001) + +# example 2: red crossbills +x <- c(1752, 1895) +expect_equal(g.test(x)$p.value, + 0.017873, + tolerance = 0.0001) + +expect_error(g.test(0)) +expect_error(g.test(c(0, 1), 0)) +expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25))) +expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24))) +expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE)) + +# INDEPENDENCE + +x <- as.data.frame( + matrix(data = round(runif(4) * 100000, 0), + ncol = 2, + byrow = TRUE) +) + +# fisher.test() is always better for 2x2 tables: +expect_warning(g.test(x)) +expect_true(suppressWarnings(g.test(x)$p.value) < 1) + +expect_warning(g.test(x = c(772, 1611, 737), + y = c(780, 1560, 780), + rescale.p = TRUE)) + +expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE))) +expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE))) diff --git a/tests/testthat/test-kurtosis.R b/inst/tinytest/test-get_locale.R similarity index 71% rename from tests/testthat/test-kurtosis.R rename to inst/tinytest/test-get_locale.R index e4f6848f..758e83a5 100644 --- a/tests/testthat/test-kurtosis.R +++ b/inst/tinytest/test-get_locale.R @@ -23,25 +23,12 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("kurtosis.R") +expect_identical(mo_genus("B_GRAMP", language = "pt"), + "(Gram positivos desconhecidos)") -test_that("kurtosis works", { - skip_on_cran() - expect_equal(kurtosis(example_isolates$age), - 5.227999, - tolerance = 0.00001) - - expect_equal(unname(kurtosis(data.frame(example_isolates$age))), - 5.227999, - tolerance = 0.00001) - expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)), - 2.227999, - tolerance = 0.00001) - - expect_equal(kurtosis(matrix(example_isolates$age)), - 5.227999, - tolerance = 0.00001) - expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE), - 2.227999, - tolerance = 0.00001) -}) +expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)") +expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)") +expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)") +expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)") +expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)") +expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)") diff --git a/inst/tinytest/test-ggplot_rsi.R b/inst/tinytest/test-ggplot_rsi.R new file mode 100644 index 00000000..b328ce12 --- /dev/null +++ b/inst/tinytest/test-ggplot_rsi.R @@ -0,0 +1,112 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +if (suppressWarnings(require("dplyr")) & suppressWarnings(require("ggplot2"))) { + + pdf(NULL) # prevent Rplots.pdf being created + + # data should be equal + expect_equal( + (example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi())$data %>% + summarise_all(resistance) %>% + as.double(), + example_isolates %>% + select(AMC, CIP) %>% + summarise_all(resistance) %>% + as.double() + ) + + expect_stdout(print(example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi(x = "interpretation", facet = "antibiotic"))) + expect_stdout(print(example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi(x = "antibiotic", facet = "interpretation"))) + + expect_equal( + (example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>% + summarise_all(resistance) %>% + as.double(), + example_isolates %>% + select(AMC, CIP) %>% + summarise_all(resistance) %>% + as.double() + ) + + expect_equal( + (example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% + summarise_all(resistance) %>% + as.double(), + example_isolates %>% + select(AMC, CIP) %>% + summarise_all(resistance) %>% + as.double() + ) + + expect_equal( + (example_isolates %>% + select(AMC, CIP) %>% + ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% + summarise_all(count_resistant) %>% + as.double(), + example_isolates %>% + select(AMC, CIP) %>% + summarise_all(count_resistant) %>% + as.double() + ) + + # support for scale_type ab and mo + expect_inherits((data.frame(mo = as.mo(c("e. coli", "s aureus")), + n = c(40, 100)) %>% + ggplot(aes(x = mo, y = n)) + + geom_col())$data, + "data.frame") + expect_inherits((data.frame(ab = as.ab(c("amx", "amc")), + n = c(40, 100)) %>% + ggplot(aes(x = ab, y = n)) + + geom_col())$data, + "data.frame") + + expect_inherits((data.frame(ab = as.ab(c("amx", "amc")), + n = c(40, 100)) %>% + ggplot(aes(x = ab, y = n)) + + geom_col())$data, + "data.frame") + + # support for manual colours + expect_inherits((ggplot(data.frame(x = c("Value1", "Value2", "Value3"), + y = c(1, 2, 3), + z = c("Value4", "Value5", "Value6"))) + + geom_col(aes(x = x, y = y, fill = z)) + + scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data, + "data.frame") + +} diff --git a/inst/tinytest/test-guess_ab_col.R b/inst/tinytest/test-guess_ab_col.R new file mode 100644 index 00000000..afd1f356 --- /dev/null +++ b/inst/tinytest/test-guess_ab_col.R @@ -0,0 +1,42 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_equal(guess_ab_col(example_isolates, "amox"), + "AMX") +expect_equal(guess_ab_col(example_isolates, "amoxicillin"), + "AMX") +expect_equal(guess_ab_col(example_isolates, "J01AA07"), + "TCY") +expect_equal(guess_ab_col(example_isolates, "tetracycline"), + "TCY") +expect_equal(guess_ab_col(example_isolates, "TETR"), + "TCY") + +df <- data.frame(AMP_ND10 = "R", + AMC_ED20 = "S") +expect_equal(guess_ab_col(df, "ampicillin"), + "AMP_ND10") +expect_equal(guess_ab_col(df, "J01CR02"), + "AMC_ED20") diff --git a/tests/testthat/test-italicise_taxonomy.R b/inst/tinytest/test-italicise_taxonomy.R similarity index 78% rename from tests/testthat/test-italicise_taxonomy.R rename to inst/tinytest/test-italicise_taxonomy.R index 859e84fa..5d88a775 100644 --- a/tests/testthat/test-italicise_taxonomy.R +++ b/inst/tinytest/test-italicise_taxonomy.R @@ -23,17 +23,11 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("italicise_taxonomy.R") - -test_that("italic taxonomy works", { - skip_on_cran() - - expect_identical(italicise_taxonomy("test for E. coli"), - "test for *E. coli*") - expect_identical(italicise_taxonomy("test for E. coli"), - italicize_taxonomy("test for E. coli")) - if (has_colour()) { - expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"), - "test for \033[3mE. coli\033[23m") - } -}) +expect_identical(italicise_taxonomy("test for E. coli"), + "test for *E. coli*") +expect_identical(italicise_taxonomy("test for E. coli"), + italicize_taxonomy("test for E. coli")) +if (has_colour()) { + expect_identical(italicise_taxonomy("test for E. coli", type = "ansi"), + "test for \033[3mE. coli\033[23m") +} diff --git a/tests/testthat/test-episode.R b/inst/tinytest/test-join_microorganisms.R old mode 100644 new mode 100755 similarity index 58% rename from tests/testthat/test-episode.R rename to inst/tinytest/test-join_microorganisms.R index c7005393..c79aed5f --- a/tests/testthat/test-episode.R +++ b/inst/tinytest/test-join_microorganisms.R @@ -23,36 +23,35 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("episode.R") +unjoined <- example_isolates +inner <- example_isolates %>% inner_join_microorganisms() +left <- example_isolates %>% left_join_microorganisms() +semi <- example_isolates %>% semi_join_microorganisms() +anti <- example_isolates %>% anti_join_microorganisms() +suppressWarnings(right <- example_isolates %>% right_join_microorganisms()) +suppressWarnings(full <- example_isolates %>% full_join_microorganisms()) -test_that("episodes work", { - skip_on_cran() - - test_df <- rbind( - data.frame( - date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")), - patient_id = "A" - ), - data.frame( - date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")), - patient_id = "B" - )) - - expect_equal(get_episode(test_df$date, 365), - c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3)) - - if (suppressWarnings(require("dplyr"))) { - expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f), - c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)) - - suppressMessages( - x <- example_isolates %>% - mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE)) - ) - y <- example_isolates %>% - group_by(patient_id, mo) %>% - mutate(out = is_new_episode(date, 365)) - - expect_identical(which(x$out), which(y$out)) - } -}) +expect_true(ncol(unjoined) < ncol(inner)) +expect_true(nrow(unjoined) == nrow(inner)) + +expect_true(ncol(unjoined) < ncol(left)) +expect_true(nrow(unjoined) == nrow(left)) + +expect_true(ncol(semi) == ncol(semi)) +expect_true(nrow(semi) == nrow(semi)) + +expect_true(nrow(anti) == 0) + +expect_true(nrow(unjoined) < nrow(right)) +expect_true(nrow(unjoined) < nrow(full)) + +expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1) +expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1) + +expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1) + +expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1) +expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0) + +expect_warning(right_join_microorganisms("B_ESCHR_COLI")) +expect_warning(full_join_microorganisms("B_ESCHR_COLI")) diff --git a/inst/tinytest/test-key_antimicrobials.R b/inst/tinytest/test-key_antimicrobials.R new file mode 100644 index 00000000..fc648956 --- /dev/null +++ b/inst/tinytest/test-key_antimicrobials.R @@ -0,0 +1,36 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates)) +expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL)))) +expect_true(antimicrobials_equal("SSS", "SSS", type = "points")) +expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials")) +expect_true(antimicrobials_equal("SSS", "SRS", type = "points")) +expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials")) +expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials")) +expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials")) +expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials")) + +expect_warning(key_antimicrobials(example_isolates[rep(1, 10), ])) diff --git a/tests/testthat/test-guess_ab_col.R b/inst/tinytest/test-kurtosis.R similarity index 71% rename from tests/testthat/test-guess_ab_col.R rename to inst/tinytest/test-kurtosis.R index ebcf728d..e2d0419f 100644 --- a/tests/testthat/test-guess_ab_col.R +++ b/inst/tinytest/test-kurtosis.R @@ -23,27 +23,20 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("guess_ab_col.R") +expect_equal(kurtosis(example_isolates$age), + 5.227999, + tolerance = 0.00001) -test_that("guess_ab_col works", { - skip_on_cran() +expect_equal(unname(kurtosis(data.frame(example_isolates$age))), + 5.227999, + tolerance = 0.00001) +expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)), + 2.227999, + tolerance = 0.00001) - expect_equal(guess_ab_col(example_isolates, "amox"), - "AMX") - expect_equal(guess_ab_col(example_isolates, "amoxicillin"), - "AMX") - expect_equal(guess_ab_col(example_isolates, "J01AA07"), - "TCY") - expect_equal(guess_ab_col(example_isolates, "tetracycline"), - "TCY") - expect_equal(guess_ab_col(example_isolates, "TETR"), - "TCY") - - df <- data.frame(AMP_ND10 = "R", - AMC_ED20 = "S") - expect_equal(guess_ab_col(df, "ampicillin"), - "AMP_ND10") - expect_equal(guess_ab_col(df, "J01CR02"), - "AMC_ED20") - -}) +expect_equal(kurtosis(matrix(example_isolates$age)), + 5.227999, + tolerance = 0.00001) +expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE), + 2.227999, + tolerance = 0.00001) diff --git a/tests/testthat/test-get_locale.R b/inst/tinytest/test-like.R similarity index 70% rename from tests/testthat/test-get_locale.R rename to inst/tinytest/test-like.R index 938eef21..cf3f7e73 100644 --- a/tests/testthat/test-get_locale.R +++ b/inst/tinytest/test-like.R @@ -23,18 +23,18 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("get_locale.R") +expect_true(sum("test" %like% c("^t", "^s")) == 1) -test_that("get_locale works", { - skip_on_cran() - expect_identical(mo_genus("B_GRAMP", language = "pt"), - "(Gram positivos desconhecidos)") +expect_true("test" %like% "test") +expect_false("test" %like_case% "TEST") +expect_true(factor("test") %like% factor("t")) +expect_true(factor("test") %like% "t") +expect_true("test" %like% factor("t")) - expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)") - expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)") - expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)") - expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)") - expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)") - expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)") - -}) +expect_true(as.factor("test") %like% "TEST") +expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"), + c(TRUE, TRUE, TRUE)) +expect_identical("test" %like% c("t", "e", "s", "t"), + c(TRUE, TRUE, TRUE, TRUE)) +expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")), + c(TRUE, TRUE, TRUE, TRUE)) diff --git a/inst/tinytest/test-mdro.R b/inst/tinytest/test-mdro.R new file mode 100755 index 00000000..38644726 --- /dev/null +++ b/inst/tinytest/test-mdro.R @@ -0,0 +1,238 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_error(suppressWarnings(mdro(example_isolates, country = "invalid", col_mo = "mo", info = TRUE))) +expect_error(suppressWarnings(mdro(example_isolates, country = "fr", info = TRUE))) +expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE)) +expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE)) + +expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE)))) +expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE)))) +expect_stdout(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE)))) +# check class +expect_identical(class(outcome), c("ordered", "factor")) + +expect_stdout(outcome <- mdro(example_isolates, "nl", info = TRUE)) +# check class +expect_identical(class(outcome), c("ordered", "factor")) + +# example_isolates should have these finding using Dutch guidelines +expect_equal(as.double(table(outcome)), + c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos + +expect_equal(brmo(example_isolates, info = FALSE), + mdro(example_isolates, guideline = "BRMO", info = FALSE)) + +# test Dutch P. aeruginosa MDRO +expect_equal( + as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), + cfta = "S", + cipr = "S", + mero = "S", + imip = "S", + gent = "S", + tobr = "S", + pita = "S"), + guideline = "BRMO", + col_mo = "mo", + info = FALSE)), + "Negative") +expect_equal( + as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), + cefta = "R", + cipr = "R", + mero = "R", + imip = "R", + gent = "R", + tobr = "R", + pita = "R"), + guideline = "BRMO", + col_mo = "mo", + info = FALSE)), + "Positive") + +# German 3MRGN and 4MRGN +expect_equal(as.character(mrgn( + data.frame(mo = c("E. coli", "E. coli", "K. pneumoniae", "E. coli", + "A. baumannii", "A. baumannii", "A. baumannii", + "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"), + PIP = c("S", "R", "R", "S", + "S", "R", "R", + "S", "R", "R"), + CTX = c("S", "R", "R", "S", + "R", "R", "R", + "R", "R", "R"), + IPM = c("S", "R", "S", "R", + "R", "R", "S", + "S", "R", "R"), + CIP = c("S", "R", "R", "S", + "R", "R", "R", + "R", "S", "R"), + stringsAsFactors = FALSE))), + c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN")) + +# MDR TB +expect_equal( + # select only rifampicine, mo will be determined automatically (as M. tuberculosis), + # number of mono-resistant strains should be equal to number of rifampicine-resistant strains + as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2], + count_R(example_isolates$RIF)) + +x <- data.frame(rifampicin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + inh = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + gatifloxacin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + eth = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + pza = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + MFX = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)), + KAN = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5))) +expect_true(length(unique(mdr_tb(x))) > 2) + +# check the guideline by Magiorakos et al. (2012), the default guideline +stau <- data.frame(mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"), + GEN = c("R", "R", "S", "R"), + RIF = c("S", "R", "S", "R"), + CPT = c("S", "R", "R", "R"), + OXA = c("S", "R", "R", "R"), + CIP = c("S", "S", "R", "R"), + MFX = c("S", "S", "R", "R"), + SXT = c("S", "S", "R", "R"), + FUS = c("S", "S", "R", "R"), + VAN = c("S", "S", "R", "R"), + TEC = c("S", "S", "R", "R"), + TLV = c("S", "S", "R", "R"), + TGC = c("S", "S", "R", "R"), + CLI = c("S", "S", "R", "R"), + DAP = c("S", "S", "R", "R"), + ERY = c("S", "S", "R", "R"), + LNZ = c("S", "S", "R", "R"), + CHL = c("S", "S", "R", "R"), + FOS = c("S", "S", "R", "R"), + QDA = c("S", "S", "R", "R"), + TCY = c("S", "S", "R", "R"), + DOX = c("S", "S", "R", "R"), + MNO = c("S", "S", "R", "R"), + stringsAsFactors = FALSE) +expect_equal(as.integer(mdro(stau)), c(1:4)) +expect_inherits(mdro(stau, verbose = TRUE), "data.frame") + +ente <- data.frame(mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"), + GEH = c("R", "R", "S", "R"), + STH = c("S", "R", "S", "R"), + IPM = c("S", "R", "R", "R"), + MEM = c("S", "R", "R", "R"), + DOR = c("S", "S", "R", "R"), + CIP = c("S", "S", "R", "R"), + LVX = c("S", "S", "R", "R"), + MFX = c("S", "S", "R", "R"), + VAN = c("S", "S", "R", "R"), + TEC = c("S", "S", "R", "R"), + TGC = c("S", "S", "R", "R"), + DAP = c("S", "S", "R", "R"), + LNZ = c("S", "S", "R", "R"), + AMP = c("S", "S", "R", "R"), + QDA = c("S", "S", "R", "R"), + DOX = c("S", "S", "R", "R"), + MNO = c("S", "S", "R", "R"), + stringsAsFactors = FALSE) +expect_equal(as.integer(mdro(ente)), c(1:4)) +expect_inherits(mdro(ente, verbose = TRUE), "data.frame") + +entero <- data.frame(mo = c("E. coli", "E. coli", "E. coli", "E. coli"), + GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"), + AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"), + CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"), + TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"), + IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"), + DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"), + CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"), + CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"), + FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"), + CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"), + TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"), + AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"), + SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"), + FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), + TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"), + MNO = c("S", "S", "R", "R"), + stringsAsFactors = FALSE) +expect_equal(as.integer(mdro(entero)), c(1:4)) +expect_inherits(mdro(entero, verbose = TRUE), "data.frame") + +pseud <- data.frame(mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"), + GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"), + AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"), + IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"), + DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"), + FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"), + LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"), + TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"), + FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), + PLB = c("S", "S", "R", "R"), + stringsAsFactors = FALSE) +expect_equal(as.integer(mdro(pseud)), c(1:4)) +expect_inherits(mdro(pseud, verbose = TRUE), "data.frame") + +acin <- data.frame(mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"), + GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"), + AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"), + IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"), + DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"), + LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"), + TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"), + CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"), + FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"), + SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), + PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"), + DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"), + stringsAsFactors = FALSE) +expect_equal(as.integer(mdro(acin)), c(1:4)) +expect_inherits(mdro(acin, verbose = TRUE), "data.frame") + +# custom rules +custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A", + "ERY == 'R' & age > 60" ~ "Elderly Type B", + as_factor = TRUE) +expect_stdout(print(custom)) +expect_stdout(print(c(custom, custom))) +expect_stdout(print(as.list(custom, custom))) + +expect_stdout(x <- mdro(example_isolates, guideline = custom, info = TRUE)) +expect_equal(as.double(table(x)), c(1070, 198, 732)) + +expect_stdout(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE))) +expect_error(custom_mdro_guideline()) +expect_error(custom_mdro_guideline("test")) +expect_error(custom_mdro_guideline("test" ~ c(1:3))) +expect_error(custom_mdro_guideline("test" ~ A)) +expect_warning(mdro(example_isolates, + # since `test` gives an error, it will be ignored with a warning + guideline = custom_mdro_guideline(test ~ "A"), + info = FALSE)) + +# print groups +if (suppressWarnings(require("dplyr"))) { + expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE)) + expect_stdout(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE)) +} diff --git a/inst/tinytest/test-mic.R b/inst/tinytest/test-mic.R new file mode 100755 index 00000000..acefa5e0 --- /dev/null +++ b/inst/tinytest/test-mic.R @@ -0,0 +1,136 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_true(as.mic(8) == as.mic("8")) +expect_true(as.mic("1") > as.mic("<=0.0625")) +expect_true(as.mic("1") < as.mic(">=32")) +expect_true(is.mic(as.mic(8))) + +expect_equal(as.double(as.mic(">=32")), 32) +expect_equal(as.numeric(as.mic(">=32")), 32) +expect_equal(as.integer(as.mic(">=32")), 32) +expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA) + +# all levels should be valid MICs +x <- as.mic(c(2, 4)) +expect_inherits(x[1], "mic") +expect_inherits(x[[1]], "mic") +expect_inherits(c(x[1], x[9]), "mic") +expect_inherits(unique(x[1], x[9]), "mic") +expect_inherits(droplevels(c(x[1], x[9])), "mic") +x[2] <- 32 +expect_inherits(x, "mic") +expect_warning(as.mic("INVALID VALUE")) + +pdf(NULL) # prevent Rplots.pdf being created +expect_silent(barplot(as.mic(c(1, 2, 4, 8)))) +expect_silent(plot(as.mic(c(1, 2, 4, 8)))) +expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE)) +expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr")) +if (suppressWarnings(require("ggplot2"))) { + expect_inherits(ggplot(as.mic(c(1, 2, 4, 8))), "gg") + expect_inherits(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg") + expect_inherits(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg") +} +expect_stdout(print(as.mic(c(1, 2, 4, 8)))) + +expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table")) + +if (suppressWarnings(require("dplyr"))) { + expect_stdout(print(tibble(m = as.mic(2:4)))) +} + +# all mathematical operations +x <- random_mic(50) +x_double <- as.double(gsub("[<=>]+", "", as.character(x))) +suppressWarnings(expect_identical(mean(x), mean(x_double))) +suppressWarnings(expect_identical(median(x), median(x_double))) +suppressWarnings(expect_identical(quantile(x), quantile(x_double))) +suppressWarnings(expect_identical(abs(x), abs(x_double))) +suppressWarnings(expect_identical(sign(x), sign(x_double))) +suppressWarnings(expect_identical(sqrt(x), sqrt(x_double))) +suppressWarnings(expect_identical(floor(x), floor(x_double))) +suppressWarnings(expect_identical(ceiling(x), ceiling(x_double))) +suppressWarnings(expect_identical(trunc(x), trunc(x_double))) +suppressWarnings(expect_identical(round(x), round(x_double))) +suppressWarnings(expect_identical(signif(x), signif(x_double))) +suppressWarnings(expect_identical(exp(x), exp(x_double))) +suppressWarnings(expect_identical(log(x), log(x_double))) +suppressWarnings(expect_identical(log10(x), log10(x_double))) +suppressWarnings(expect_identical(log2(x), log2(x_double))) +suppressWarnings(expect_identical(expm1(x), expm1(x_double))) +suppressWarnings(expect_identical(log1p(x), log1p(x_double))) +suppressWarnings(expect_identical(cos(x), cos(x_double))) +suppressWarnings(expect_identical(sin(x), sin(x_double))) +suppressWarnings(expect_identical(tan(x), tan(x_double))) +suppressWarnings(expect_identical(cospi(x), cospi(x_double))) +suppressWarnings(expect_identical(sinpi(x), sinpi(x_double))) +suppressWarnings(expect_identical(tanpi(x), tanpi(x_double))) +suppressWarnings(expect_identical(acos(x), acos(x_double))) +suppressWarnings(expect_identical(asin(x), asin(x_double))) +suppressWarnings(expect_identical(atan(x), atan(x_double))) +suppressWarnings(expect_identical(cosh(x), cosh(x_double))) +suppressWarnings(expect_identical(sinh(x), sinh(x_double))) +suppressWarnings(expect_identical(tanh(x), tanh(x_double))) +suppressWarnings(expect_identical(acosh(x), acosh(x_double))) +suppressWarnings(expect_identical(asinh(x), asinh(x_double))) +suppressWarnings(expect_identical(atanh(x), atanh(x_double))) +suppressWarnings(expect_identical(lgamma(x), lgamma(x_double))) +suppressWarnings(expect_identical(gamma(x), gamma(x_double))) +suppressWarnings(expect_identical(digamma(x), digamma(x_double))) +suppressWarnings(expect_identical(trigamma(x), trigamma(x_double))) +suppressWarnings(expect_identical(cumsum(x), cumsum(x_double))) +suppressWarnings(expect_identical(cumprod(x), cumprod(x_double))) +suppressWarnings(expect_identical(cummax(x), cummax(x_double))) +suppressWarnings(expect_identical(cummin(x), cummin(x_double))) +suppressWarnings(expect_identical(!x, !(x_double))) + +suppressWarnings(expect_identical(all(x), all(x_double))) +suppressWarnings(expect_identical(any(x), any(x_double))) +suppressWarnings(expect_identical(sum(x), sum(x_double))) +suppressWarnings(expect_identical(prod(x), prod(x_double))) +suppressWarnings(expect_identical(min(x), min(x_double))) +suppressWarnings(expect_identical(max(x), max(x_double))) +suppressWarnings(expect_identical(range(x), range(x_double))) + +el1 <- random_mic(50) +el1_double <- as.double(gsub("[<=>]+", "", as.character(el1))) +el2 <- random_mic(50) +el2_double <- as.double(gsub("[<=>]+", "", as.character(el2))) +suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double)) +suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double)) +suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double)) +suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double)) +suppressWarnings(expect_identical(el1 ^ el2, el1_double ^ el2_double)) +suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double)) +suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double)) +suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double)) +suppressWarnings(expect_identical(el1 | el2, el1_double | el2_double)) +suppressWarnings(expect_identical(el1 == el2, el1_double == el2_double)) +suppressWarnings(expect_identical(el1 != el2, el1_double != el2_double)) +suppressWarnings(expect_identical(el1 < el2, el1_double < el2_double)) +suppressWarnings(expect_identical(el1 <= el2, el1_double <= el2_double)) +suppressWarnings(expect_identical(el1 >= el2, el1_double >= el2_double)) +suppressWarnings(expect_identical(el1 > el2, el1_double > el2_double)) diff --git a/inst/tinytest/test-mo.R b/inst/tinytest/test-mo.R new file mode 100644 index 00000000..fedb479d --- /dev/null +++ b/inst/tinytest/test-mo.R @@ -0,0 +1,297 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3) +expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo))) + +expect_identical( + as.character(as.mo(c("E. coli", "H. influenzae"))), + c("B_ESCHR_COLI", "B_HMPHL_INFL")) + +expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI") +expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI") +expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI") +expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR") +expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR") +expect_equal(as.character(as.mo("Esch spp.")), "B_ESCHR") +expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI") +expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter +expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN") +expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL") +expect_equal(as.character(as.mo("K. pneu rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis +expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL") +expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC") +expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP") +expect_equal(as.character(as.mo("Strepto")), "B_STRPT") +expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus +expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB") +expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB") +expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0) +expect_equal(as.character(as.mo(c("mycobacterie", "mycobakterium"))), c("B_MYCBC", "B_MYCBC")) + +expect_equal(as.character(as.mo(c("GAS", "GBS", "a MGS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_MILL", "B_STRPT_HAEM")) + + +expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes + +# GLIMS +expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL") + +expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR") +expect_equal(as.character(as.mo("VRE")), "B_ENTRC") +expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG") +expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN") +expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN") +expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN") +expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN") + +expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS") +expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS") +expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS") +expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS") +expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI") +expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL") + + +expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP")) + +# prevalent MO +expect_identical( + suppressWarnings(as.character( + as.mo(c("stau", + "STAU", + "staaur", + "S. aureus", + "S aureus", + "Sthafilokkockus aureeuzz", + "Staphylococcus aureus", + "MRSA", + "VISA")))), + rep("B_STPHY_AURS", 9)) +expect_identical( + as.character( + as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))), + rep("B_ESCHR_COLI", 6)) +# unprevalent MO +expect_identical( + as.character( + as.mo(c("parnod", + "P. nodosa", + "P nodosa", + "Paraburkholderia nodosa"))), + rep("B_PRBRK_NODS", 4)) + +# empty values +expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4)) +expect_identical(as.character(as.mo(" ")), NA_character_) +# too few characters +expect_warning(as.mo("ab")) + +expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))), + c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")) + +# check for Becker classification +expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR") +expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS") +expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS") +expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR") +expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS") +expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS") +# aureus must only be influenced if Becker = "all" +expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS") +expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS") +expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS") + +# check for Lancefield classification +expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN") +expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA") +expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A +expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC") +expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B +expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB") +expect_identical(as.character(as.mo("S. equisimilis", Lancefield = FALSE)), "B_STRPT_DYSG_EQSM") +expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C +# Enterococci must only be influenced if Lancefield = "all" +expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM") +expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM") +expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D +expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN") +expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F +expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN") +expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H +expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR") +expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K + +if (suppressWarnings(require("dplyr"))) { + # select with one column + expect_identical( + example_isolates[1:10, ] %>% + left_join_microorganisms() %>% + select(genus) %>% + as.mo() %>% + as.character(), + c("B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY", + "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY")) + + # select with two columns + expect_identical( + example_isolates[1:10, ] %>% + pull(mo), + example_isolates[1:10, ] %>% + left_join_microorganisms() %>% + select(genus, species) %>% + as.mo()) + + # too many columns + expect_error(example_isolates %>% select(1:3) %>% as.mo()) + + # test pull + expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))), + 2000) + expect_true(example_isolates %>% pull(mo) %>% is.mo()) +} + +# unknown results +expect_warning(as.mo(c("INVALID", "Yeah, unknown"))) + +# print +expect_stdout(print(as.mo(c("B_ESCHR_COLI", NA)))) + +# test data.frame +expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))), + 1) + +# check empty values +expect_equal(as.character(suppressWarnings(as.mo(""))), + NA_character_) + +# check less prevalent MOs +expect_equal(as.character(as.mo("Gomphosphaeria aponina delicatula")), "B_GMPHS_APNN_DLCT") +expect_equal(as.character(as.mo("Gomphosphaeria apo del")), "B_GMPHS_APNN_DLCT") +expect_equal(as.character(as.mo("G apo deli")), "B_GMPHS_APNN_DLCT") +expect_equal(as.character(as.mo("Gomphosphaeria aponina")), "B_GMPHS_APNN") +expect_equal(as.character(as.mo("Gomphosphaeria species")), "B_GMPHS") +expect_equal(as.character(as.mo("Gomphosphaeria")), "B_GMPHS") +expect_equal(as.character(as.mo(" B_GMPHS_APNN ")), "B_GMPHS_APNN") +expect_equal(as.character(as.mo("g aponina")), "B_GMPHS_APNN") + +# check old names +expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT") +print(mo_renamed()) +expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT")) + +# check uncertain names +expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS") +expect_equal(suppressWarnings(as.character(as.mo("staaur extratest", allow_uncertain = FALSE))), "UNKNOWN") +expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE)) +expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS") +expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS") +expect_equal(suppressMessages(as.character(as.mo(c("s aur THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_ANRB", "B_STPHY_AURS_ANRB")) + +# predefined reference_df +expect_equal(as.character(as.mo("TestingOwnID", + reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))), + "B_ESCHR_COLI") +expect_equal(as.character(as.mo(c("TestingOwnID", "E. coli"), + reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))), + c("B_ESCHR_COLI", "B_ESCHR_COLI")) +expect_warning(as.mo("TestingOwnID", reference_df = NULL)) +expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID"))) + +# combination of existing mo and other code +expect_identical(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))), + c("B_ESCHR_COLI", "B_ESCHR_COLI")) + +# from different sources +expect_equal(as.character(as.mo( + c("PRTMIR", "bclcer", "B_ESCHR_COLI"))), + c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI")) + +# hard to find +expect_equal(as.character(suppressMessages(as.mo( + c("Microbacterium paraoxidans", + "Streptococcus suis (bovis gr)", + "Raoultella (here some text) terrigena")))), + c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG")) +expect_stdout(print(mo_uncertainties())) +x <- as.mo("S. aur") +# many hits +expect_stdout(print(mo_uncertainties())) + +# Salmonella (City) are all actually Salmonella enterica spp (City) +expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))), + c("Salmonella enterica", "Salmonella enterica", "Salmonella")) + +# no virusses +expect_equal(as.character(as.mo("Virus")), NA_character_) + +# summary +expect_equal(length(summary(example_isolates$mo)), 6) + +# WHONET codes and NA/NaN +expect_equal(as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)), + rep(NA_character_, 3)) +expect_equal(as.character(as.mo("con")), "UNKNOWN") +expect_equal(as.character(as.mo("xxx")), NA_character_) +expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI")) +expect_equal(as.character(as.mo(c("other", "none", "unknown"))), + rep("UNKNOWN", 3)) + +expect_null(mo_failures()) + +expect_error(translate_allow_uncertain(5)) + +# debug mode +expect_stdout(print(suppressMessages(suppressWarnings(as.mo("kshgcjkhsdgkshjdfsfvsdfv", debug = TRUE, allow_uncertain = 3))))) + +# ..coccus +expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))), + c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN")) +# yeasts and fungi +expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))), + c("F_YEAST", "F_FUNGUS")) + +if (suppressWarnings(require("dplyr"))) { + # print tibble + expect_stdout(print(tibble(mo = as.mo("B_ESCHR_COLI")))) +} + +# assigning and subsetting +x <- example_isolates$mo +expect_inherits(x[1], "mo") +expect_inherits(x[[1]], "mo") +expect_inherits(c(x[1], x[9]), "mo") +expect_warning(x[1] <- "invalid code") +expect_warning(x[[1]] <- "invalid code") +expect_warning(c(x[1], "test")) + +# ignoring patterns +expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")), + c("B_ESCHR_COLI", NA)) + +# frequency tables +if (suppressWarnings(require("cleaner"))) { + expect_inherits(cleaner::freq(example_isolates$mo), "freq") +} diff --git a/inst/tinytest/test-mo_property.R b/inst/tinytest/test-mo_property.R new file mode 100644 index 00000000..ece3e6bc --- /dev/null +++ b/inst/tinytest/test-mo_property.R @@ -0,0 +1,129 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_equal(mo_kingdom("Escherichia coli"), "Bacteria") +expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli")) +expect_equal(mo_phylum("Escherichia coli"), "Proteobacteria") +expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria") +expect_equal(mo_order("Escherichia coli"), "Enterobacterales") +expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae") +expect_equal(mo_genus("Escherichia coli"), "Escherichia") +expect_equal(mo_species("Escherichia coli"), "coli") +expect_equal(mo_subspecies("Escherichia coli"), "") +expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli") +expect_equal(mo_name("Escherichia coli"), "Escherichia coli") +expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria") +expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative") +expect_inherits(mo_taxonomy("Escherichia coli"), "list") +expect_equal(names(mo_taxonomy("Escherichia coli")), c("kingdom", "phylum", "class", "order", + "family", "genus", "species", "subspecies")) +expect_equal(mo_synonyms("Escherichia coli"), NULL) +expect_true(length(mo_synonyms("Candida albicans")) > 1) +expect_inherits(mo_synonyms(c("Candida albicans", "Escherichia coli")), "list") +expect_equal(names(mo_info("Escherichia coli")), c("kingdom", "phylum", "class", "order", + "family", "genus", "species", "subspecies", + "synonyms", "gramstain", "url", "ref", + "snomed")) +expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list") + +expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919") +expect_equal(mo_authors("Escherichia coli"), "Castellani et al.") +expect_equal(mo_year("Escherichia coli"), 1919) + +expect_equal(mo_shortname("Escherichia coli"), "E. coli") +expect_equal(mo_shortname("Escherichia"), "Escherichia") +expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus") +expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus") +expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS") +expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae") +expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS") + +expect_true(mo_url("Candida albicans") %like% "catalogueoflife.org") +expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de") + +# test integrity +MOs <- microorganisms +expect_identical(MOs$fullname, mo_fullname(MOs$fullname, language = "en")) + +# check languages +expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien") +expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief") + +expect_stdout(print(mo_gramstain("Escherichia coli", language = "en"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "de"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "nl"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "es"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "pt"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "it"))) +expect_stdout(print(mo_gramstain("Escherichia coli", language = "fr"))) + +expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN")) +dutch <- mo_name(microorganisms$fullname, language = "nl") # should be transformable to English again +expect_identical(mo_name(dutch, language = NULL), microorganisms$fullname) # gigantic test - will run ALL names + +# manual property function +expect_error(mo_property("Escherichia coli", property = c("tsn", "fullname"))) +expect_error(mo_property("Escherichia coli", property = "UNKNOWN")) +expect_identical(mo_property("Escherichia coli", property = "fullname"), + mo_fullname("Escherichia coli")) +expect_identical(mo_property("Escherichia coli", property = "genus"), + mo_genus("Escherichia coli")) +expect_identical(mo_property("Escherichia coli", property = "species"), + mo_species("Escherichia coli")) + +expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968") +expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999") + +expect_true(112283007 %in% mo_snomed("Escherichia coli")) +# old codes must throw a warning in mo_* family +expect_message(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR"))) +# outcome of mo_fullname must always return the fullname from the data set +x <- data.frame(mo = microorganisms$mo, + # fullname from the original data: + f1 = microorganisms$fullname, + # newly created fullname based on MO code: + f2 = mo_fullname(microorganisms$mo, language = "en"), + stringsAsFactors = FALSE) +expect_equal(nrow(subset(x, f1 != f2)), 0) +# is gram pos/neg (also return FALSE for all non-bacteria) +expect_equal(mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), + c(TRUE, FALSE, FALSE)) +expect_equal(mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), + c(FALSE, TRUE, FALSE)) +# is intrinsic resistant +expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"), + "vanco"), + c(TRUE, FALSE, FALSE)) +# with reference data +expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")), + "Escherichia coli") +if (suppressWarnings(require("dplyr"))) { + expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(), + 730) + expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(), + 1238) + expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(), + 710) +} diff --git a/inst/tinytest/test-pca.R b/inst/tinytest/test-pca.R new file mode 100644 index 00000000..d0868094 --- /dev/null +++ b/inst/tinytest/test-pca.R @@ -0,0 +1,63 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +resistance_data <- structure(list(order = c("Bacillales", "Enterobacterales", "Enterobacterales"), + genus = c("Staphylococcus", "Escherichia", "Klebsiella"), + AMC = c(0.00425, 0.13062, 0.10344), + CXM = c(0.00425, 0.05376, 0.10344), + CTX = c(0.00000, 0.02396, 0.05172), + TOB = c(0.02325, 0.02597, 0.10344), + TMP = c(0.08387, 0.39141, 0.18367)), + class = c("grouped_df", "tbl_df", "tbl", "data.frame"), + row.names = c(NA, -3L), + groups = structure(list(order = c("Bacillales", "Enterobacterales"), + .rows = list(1L, 2:3)), + row.names = c(NA, -2L), + class = c("tbl_df", "tbl", "data.frame"), + .drop = TRUE)) +pca_model <- pca(resistance_data) +expect_inherits(pca_model, "pca") + +pdf(NULL) # prevent Rplots.pdf being created + +if (suppressWarnings(require("ggplot2"))) { + ggplot_pca(pca_model, ellipse = TRUE) + ggplot_pca(pca_model, arrows_textangled = FALSE) +} + +if (suppressWarnings(require("dplyr"))) { + resistance_data <- example_isolates %>% + group_by(order = mo_order(mo), + genus = mo_genus(mo)) %>% + summarise_if(is.rsi, resistance, minimum = 0) + pca_result <- resistance_data %>% + pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT") + expect_inherits(pca_result, "prcomp") + + if (suppressWarnings(require("ggplot2"))) { + ggplot_pca(pca_result, ellipse = TRUE) + ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE) + } +} diff --git a/inst/tinytest/test-proportion.R b/inst/tinytest/test-proportion.R new file mode 100755 index 00000000..6de6476d --- /dev/null +++ b/inst/tinytest/test-proportion.R @@ -0,0 +1,130 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX)) +expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX)) +# AMX resistance in `example_isolates` +expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001) +expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001) +expect_equal(1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX), + proportion_S(example_isolates$AMX)) +expect_equal(proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX), + proportion_IR(example_isolates$AMX)) +expect_equal(proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX), + proportion_SI(example_isolates$AMX)) + +expect_equal(example_isolates %>% proportion_SI(AMC), + 0.7626397, + tolerance = 0.0001) +expect_equal(example_isolates %>% proportion_SI(AMC, GEN), + 0.9408, + tolerance = 0.0001) +expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE), + 0.9382647, + tolerance = 0.0001) + +if (suppressWarnings(require("dplyr"))) { + # percentages + expect_equal(example_isolates %>% + group_by(hospital_id) %>% + summarise(R = proportion_R(CIP, as_percent = TRUE), + I = proportion_I(CIP, as_percent = TRUE), + S = proportion_S(CIP, as_percent = TRUE), + n = n_rsi(CIP), + total = n()) %>% + pull(n) %>% + sum(), + 1409) + + # count of cases + expect_equal(example_isolates %>% + group_by(hospital_id) %>% + summarise(cipro_p = proportion_SI(CIP, as_percent = TRUE), + cipro_n = n_rsi(CIP), + genta_p = proportion_SI(GEN, as_percent = TRUE), + genta_n = n_rsi(GEN), + combination_p = proportion_SI(CIP, GEN, as_percent = TRUE), + combination_n = n_rsi(CIP, GEN)) %>% + pull(combination_n), + c(305, 617, 241, 711)) + + # proportion_df + expect_equal( + example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value), + c(example_isolates$AMX %>% proportion_SI(), + example_isolates$AMX %>% proportion_R()) + ) + expect_equal( + example_isolates %>% select(AMX) %>% proportion_df(combine_IR = TRUE) %>% pull(value), + c(example_isolates$AMX %>% proportion_S(), + example_isolates$AMX %>% proportion_IR()) + ) + expect_equal( + example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value), + c(example_isolates$AMX %>% proportion_S(), + example_isolates$AMX %>% proportion_I(), + example_isolates$AMX %>% proportion_R()) + ) +} +reset_all_thrown_messages() +expect_warning(proportion_R(as.character(example_isolates$AMC))) +reset_all_thrown_messages() +expect_warning(proportion_S(as.character(example_isolates$AMC))) +reset_all_thrown_messages() +expect_warning(proportion_S(as.character(example_isolates$AMC, + example_isolates$GEN))) +reset_all_thrown_messages() +expect_warning(n_rsi(as.character(example_isolates$AMC, + example_isolates$GEN))) +expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC, + example_isolates$GEN))), + 1879) + +# check for errors +expect_error(proportion_IR("test", minimum = "test")) +expect_error(proportion_IR("test", as_percent = "test")) +expect_error(proportion_I("test", minimum = "test")) +expect_error(proportion_I("test", as_percent = "test")) +expect_error(proportion_S("test", minimum = "test")) +expect_error(proportion_S("test", as_percent = "test")) +expect_error(proportion_S("test", also_single_tested = TRUE)) + +# check too low amount of isolates +expect_identical(suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), + NA_real_) +expect_identical(suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), + NA_real_) +expect_identical(suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), + NA_real_) + +# warning for speed loss +reset_all_thrown_messages() +expect_warning(proportion_R(as.character(example_isolates$GEN))) +reset_all_thrown_messages() +expect_warning(proportion_I(as.character(example_isolates$GEN))) +reset_all_thrown_messages() +expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN))) +expect_error(proportion_df(c("A", "B", "C"))) +expect_error(proportion_df(example_isolates[, "date"])) diff --git a/tests/testthat/test-like.R b/inst/tinytest/test-random.R similarity index 72% rename from tests/testthat/test-like.R rename to inst/tinytest/test-random.R index 4bbf4ceb..505beb6f 100644 --- a/tests/testthat/test-like.R +++ b/inst/tinytest/test-random.R @@ -23,23 +23,14 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("like.R") - -test_that("`like` works", { - skip_on_cran() - expect_true(sum("test" %like% c("^t", "^s")) == 1) - - expect_true("test" %like% "test") - expect_false("test" %like_case% "TEST") - expect_true(factor("test") %like% factor("t")) - expect_true(factor("test") %like% "t") - expect_true("test" %like% factor("t")) - - expect_true(as.factor("test") %like% "TEST") - expect_identical(factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"), - c(TRUE, TRUE, TRUE)) - expect_identical("test" %like% c("t", "e", "s", "t"), - c(TRUE, TRUE, TRUE, TRUE)) - expect_identical(factor("test") %like% factor(c("t", "e", "s", "t")), - c(TRUE, TRUE, TRUE, TRUE)) -}) +expect_inherits(random_mic(100), "mic") +expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae"), "mic") +expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic") +expect_inherits(random_mic(100, ab = "meropenem"), "mic") +# no normal factors of 2 +expect_inherits(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic") +expect_inherits(random_disk(100), "disk") +expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae"), "disk") +expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk") +expect_inherits(random_disk(100, ab = "meropenem"), "disk") +expect_inherits(random_rsi(100), "rsi") diff --git a/inst/tinytest/test-resistance_predict.R b/inst/tinytest/test-resistance_predict.R new file mode 100644 index 00000000..a19584f2 --- /dev/null +++ b/inst/tinytest/test-resistance_predict.R @@ -0,0 +1,95 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +if (suppressWarnings(require("dplyr"))) { + expect_stdout(AMX_R <- example_isolates %>% + filter(mo == "B_ESCHR_COLI") %>% + rsi_predict(col_ab = "AMX", + col_date = "date", + model = "binomial", + minimum = 10, + info = TRUE) %>% + pull("value")) + # AMX resistance will increase according to data set `example_isolates` + expect_true(AMX_R[3] < AMX_R[20]) +} + +expect_stdout(x <- suppressMessages(resistance_predict(example_isolates, + col_ab = "AMX", + year_min = 2010, + model = "binomial", + info = TRUE))) +pdf(NULL) # prevent Rplots.pdf being created +expect_silent(plot(x)) +if (suppressWarnings(require("ggplot2"))) { + expect_silent(ggplot_rsi_predict(x)) + expect_silent(ggplot(x)) + expect_error(ggplot_rsi_predict(example_isolates)) +} +expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "binomial", + col_ab = "AMX", + col_date = "date", + info = TRUE)) +expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "loglin", + col_ab = "AMX", + col_date = "date", + info = TRUE)) +expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "lin", + col_ab = "AMX", + col_date = "date", + info = TRUE)) + +expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "INVALID MODEL", + col_ab = "AMX", + col_date = "date", + info = TRUE)) +expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "binomial", + col_ab = "NOT EXISTING COLUMN", + col_date = "date", + info = TRUE)) +expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "binomial", + col_ab = "AMX", + col_date = "NOT EXISTING COLUMN", + info = TRUE)) +expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + col_ab = "AMX", + col_date = "NOT EXISTING COLUMN", + info = TRUE)) +expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + col_ab = "AMX", + col_date = "date", + info = TRUE)) +# almost all E. coli are MEM S in the Netherlands :) +expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), + model = "binomial", + col_ab = "MEM", + col_date = "date", + info = TRUE)) diff --git a/inst/tinytest/test-rsi.R b/inst/tinytest/test-rsi.R new file mode 100644 index 00000000..afcac559 --- /dev/null +++ b/inst/tinytest/test-rsi.R @@ -0,0 +1,157 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +expect_true(as.rsi("S") < as.rsi("I")) +expect_true(as.rsi("I") < as.rsi("R")) +expect_true(is.rsi(as.rsi("S"))) +x <- example_isolates$AMX +expect_inherits(x[1], "rsi") +expect_inherits(x[[1]], "rsi") +expect_inherits(c(x[1], x[9]), "rsi") +expect_inherits(unique(x[1], x[9]), "rsi") +pdf(NULL) # prevent Rplots.pdf being created +expect_silent(barplot(as.rsi(c("S", "I", "R")))) +expect_silent(plot(as.rsi(c("S", "I", "R")))) +if (suppressWarnings(require("ggplot2"))) expect_inherits(ggplot(as.rsi(c("S", "I", "R"))), "gg") +expect_stdout(print(as.rsi(c("S", "I", "R")))) +expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R")) +expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA) +expect_equal(summary(as.rsi(c("S", "R"))), + structure(c("Class" = "rsi", + "%R" = "50.0% (n=1)", + "%SI" = "50.0% (n=1)", + "- %S" = "50.0% (n=1)", + "- %I" = " 0.0% (n=0)"), class = c("summaryDefault", "table"))) +expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)), + rep(FALSE, length(example_isolates))) +expect_error(as.rsi.mic(as.mic(16))) +expect_error(as.rsi.disk(as.disk(16))) +expect_error(get_guideline("this one does not exist")) +if (suppressWarnings(require("dplyr"))) { + # 40 rsi columns + expect_equal(example_isolates %>% + mutate_at(vars(PEN:RIF), as.character) %>% + lapply(is.rsi.eligible) %>% + as.logical() %>% + sum(), + 40) + expect_equal(sum(is.rsi(example_isolates)), 40) + + expect_stdout(print(tibble(ab = as.rsi("S")))) +} +if (suppressWarnings(require("skimr"))) { + expect_inherits(skim(example_isolates), + "data.frame") + if (suppressWarnings(require("dplyr"))) { + expect_inherits(example_isolates %>% + mutate(m = as.mic(2), + d = as.disk(20)) %>% + skim(), + "data.frame") + } +} + + +# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2) +expect_equal(as.character( + as.rsi(x = as.mic(c(0.125, 0.5, 1, 2, 4)), + mo = "B_STRPT_PNMN", + ab = "AMP", + guideline = "EUCAST 2020")), + c("S", "S", "I", "I", "R")) +# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8) +expect_equal(as.character( + as.rsi(x = as.mic(c(1, 2, 4, 8, 16)), + mo = "B_STRPT_PNMN", + ab = "AMX", + guideline = "CLSI 2019")), + c("S", "S", "I", "R", "R")) + +# cutoffs at MIC = 8 +expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"), + as.rsi("S")) +expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"), + as.rsi("R")) +if (suppressWarnings(require("dplyr"))) { + expect_true(suppressWarnings(example_isolates %>% + mutate(amox_mic = as.mic(2)) %>% + select(mo, amox_mic) %>% + as.rsi() %>% + pull(amox_mic) %>% + is.rsi())) +} + +expect_equal(as.character( + as.rsi(x = as.disk(22), + mo = "B_STRPT_PNMN", + ab = "ERY", + guideline = "CLSI")), + "S") +expect_equal(as.character( + as.rsi(x = as.disk(18), + mo = "B_STRPT_PNMN", + ab = "ERY", + guideline = "CLSI")), + "I") +expect_equal(as.character( + as.rsi(x = as.disk(10), + mo = "B_STRPT_PNMN", + ab = "ERY", + guideline = "CLSI")), + "R") +if (suppressWarnings(require("dplyr"))) { + expect_true(example_isolates %>% + mutate(amox_disk = as.disk(15)) %>% + select(mo, amox_disk) %>% + as.rsi(guideline = "CLSI") %>% + pull(amox_disk) %>% + is.rsi()) +} +# frequency tables +if (suppressWarnings(require("cleaner"))) { + expect_inherits(cleaner::freq(example_isolates$AMX), "freq") +} + + +df <- data.frame(microorganism = "Escherichia coli", + AMP = as.mic(8), + CIP = as.mic(0.256), + GEN = as.disk(18), + TOB = as.disk(16), + ERY = "R", # note about assigning class + CLR = "V") # note about cleaning +expect_inherits(suppressWarnings(as.rsi(df)), + "data.frame") +expect_inherits(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli", + amoxi = c("R", "S", "I", "invalid")))$amoxi), + "rsi") +expect_warning(as.rsi(data.frame(mo = "E. coli", + NIT = c("<= 2", 32)))) +expect_message(as.rsi(data.frame(mo = "E. coli", + NIT = c("<= 2", 32), + uti = TRUE))) +expect_message(as.rsi(data.frame(mo = "E. coli", + NIT = c("<= 2", 32), + specimen = c("urine", "blood")))) diff --git a/tests/testthat/test-skewness.R b/inst/tinytest/test-skewness.R similarity index 80% rename from tests/testthat/test-skewness.R rename to inst/tinytest/test-skewness.R index 0de83335..1ba333da 100644 --- a/tests/testthat/test-skewness.R +++ b/inst/tinytest/test-skewness.R @@ -23,17 +23,12 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -context("skewness.R") - -test_that("skewness works", { - skip_on_cran() - expect_equal(skewness(example_isolates$age), - -1.212888, - tolerance = 0.00001) - expect_equal(unname(skewness(data.frame(example_isolates$age))), - -1.212888, - tolerance = 0.00001) - expect_equal(skewness(matrix(example_isolates$age)), - -1.212888, - tolerance = 0.00001) -}) +expect_equal(skewness(example_isolates$age), + -1.212888, + tolerance = 0.00001) +expect_equal(unname(skewness(data.frame(example_isolates$age))), + -1.212888, + tolerance = 0.00001) +expect_equal(skewness(matrix(example_isolates$age)), + -1.212888, + tolerance = 0.00001) diff --git a/inst/tinytest/test-zzz.R b/inst/tinytest/test-zzz.R new file mode 100644 index 00000000..5fa85f89 --- /dev/null +++ b/inst/tinytest/test-zzz.R @@ -0,0 +1,112 @@ +# ==================================================================== # +# TITLE # +# Antimicrobial Resistance (AMR) Data Analysis for R # +# # +# SOURCE # +# https://github.com/msberends/AMR # +# # +# LICENCE # +# (c) 2018-2021 Berends MS, Luz CF et al. # +# Developed at the University of Groningen, the Netherlands, in # +# collaboration with non-profit organisations Certe Medical # +# Diagnostics & Advice, and University Medical Center Groningen. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # +# ==================================================================== # + +# Check if these function still exist in the package (all are in Suggests field) +# Since GitHub Action runs every night, we will get emailed when a dependency fails based on this unit test +# functions used by import_fn() +import_functions <- c( + "anti_join" = "dplyr", + "cur_column" = "dplyr", + "full_join" = "dplyr", + "has_internet" = "curl", + "html_attr" = "rvest", + "html_children" = "rvest", + "html_node" = "rvest", + "html_nodes" = "rvest", + "html_table" = "rvest", + "html_text" = "rvest", + "inner_join" = "dplyr", + "insertText" = "rstudioapi", + "left_join" = "dplyr", + "new_pillar_shaft_simple" = "pillar", + "read_html" = "xml2", + "right_join" = "dplyr", + "semi_join" = "dplyr", + "showQuestion" = "rstudioapi") +# functions that are called directly + +call_functions <- c( + # cleaner + "freq.default" = "cleaner", + # skimr + "inline_hist" = "skimr", + "sfl" = "skimr", + # set_mo_source + "read_excel" = "readxl", + # ggplot_rsi + "aes_string" = "ggplot2", + "element_blank" = "ggplot2", + "element_line" = "ggplot2", + "element_text" = "ggplot2", + "facet_wrap" = "ggplot2", + "geom_text" = "ggplot2", + "ggplot" = "ggplot2", + "labs" = "ggplot2", + "layer" = "ggplot2", + "position_fill" = "ggplot2", + "scale_fill_manual" = "ggplot2", + "scale_y_continuous" = "ggplot2", + "theme" = "ggplot2", + "theme_minimal" = "ggplot2", + # ggplot_pca + "aes" = "ggplot2", + "arrow" = "ggplot2", + "element_blank" = "ggplot2", + "element_line" = "ggplot2", + "element_text" = "ggplot2", + "expand_limits" = "ggplot2", + "geom_path" = "ggplot2", + "geom_point" = "ggplot2", + "geom_segment" = "ggplot2", + "geom_text" = "ggplot2", + "ggplot" = "ggplot2", + "labs" = "ggplot2", + "theme" = "ggplot2", + "theme_minimal" = "ggplot2", + "unit" = "ggplot2", + "xlab" = "ggplot2", + "ylab" = "ggplot2", + # resistance_predict + "aes" = "ggplot2", + "geom_errorbar" = "ggplot2", + "geom_point" = "ggplot2", + "geom_ribbon" = "ggplot2", + "ggplot" = "ggplot2", + "labs" = "ggplot2" +) + +import_functions <- c(import_functions, call_functions) +for (i in seq_len(length(import_functions))) { + fn <- names(import_functions)[i] + pkg <- unname(import_functions[i]) + # function should exist in foreign pkg namespace + if (pkg %in% rownames(installed.packages())) { + tst <- !is.null(import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)) + expect_true(tst, + info = ifelse(tst, + "All external function references exist.", + paste0("Function ", pkg, "::", fn, "() does not exist anymore"))) + } +} diff --git a/tests/testthat/test-ab.R b/tests/testthat/test-ab.R deleted file mode 100755 index eeaff7bf..00000000 --- a/tests/testthat/test-ab.R +++ /dev/null @@ -1,78 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("ab.R") - -test_that("as.ab works", { - skip_on_cran() - - expect_equal(as.character(as.ab(c("J01FA01", - "J 01 FA 01", - "Erythromycin", - "eryt", - " eryt 123", - "ERYT", - "ERY", - "erytromicine", - "Erythrocin", - "Romycin"))), - rep("ERY", 10)) - - expect_identical(class(as.ab("amox")), c("ab", "character")) - expect_identical(class(antibiotics$ab), c("ab", "character")) - expect_true(is.ab(as.ab("amox"))) - expect_output(print(as.ab("amox"))) - expect_output(print(data.frame(a = as.ab("amox")))) - - expect_warning(as.ab("J00AA00")) # ATC not yet available in data set - expect_warning(as.ab("UNKNOWN")) - expect_warning(as.ab("")) - - expect_output(print(as.ab("amox"))) - - expect_equal(as.character(as.ab("Phloxapen")), - "FLC") - - expect_equal(suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))), - c(NA, "TMP")) - - expect_equal(as.character(as.ab("Amoxy + clavulaanzuur")), - "AMC") - - expect_equal(as.character(as.ab(c("mreopenem", "co-maoxiclav"))), - c("MEM", "AMC")) - - expect_message(as.ab("cipro mero")) - - # assigning and subsetting - x <- antibiotics$ab - expect_s3_class(x[1], "ab") - expect_s3_class(x[[1]], "ab") - expect_s3_class(c(x[1], x[9]), "ab") - expect_s3_class(unique(x[1], x[9]), "ab") - expect_warning(x[1] <- "invalid code") - expect_warning(x[[1]] <- "invalid code") - expect_warning(c(x[1], "test")) -}) diff --git a/tests/testthat/test-ab_class_selectors.R b/tests/testthat/test-ab_class_selectors.R deleted file mode 100644 index a02ff5da..00000000 --- a/tests/testthat/test-ab_class_selectors.R +++ /dev/null @@ -1,47 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("ab_class_selectors.R") - -test_that("Antibiotic class selectors work", { - skip_on_cran() - - if (suppressWarnings(require("dplyr"))) { - expect_lt(example_isolates %>% select(aminoglycosides()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(carbapenems()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins_1st()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins_2nd()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins_3rd()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins_4th()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(cephalosporins_5th()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(fluoroquinolones()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(glycopeptides()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(macrolides()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(oxazolidinones()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(penicillins()) %>% ncol(), ncol(example_isolates)) - expect_lt(example_isolates %>% select(tetracyclines()) %>% ncol(), ncol(example_isolates)) - } -}) diff --git a/tests/testthat/test-ab_property.R b/tests/testthat/test-ab_property.R deleted file mode 100644 index 554da93f..00000000 --- a/tests/testthat/test-ab_property.R +++ /dev/null @@ -1,69 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("ab_property.R") - -test_that("ab_property works", { - skip_on_cran() - - expect_identical(ab_name("AMX", language = NULL), "Amoxicillin") - expect_identical(as.character(ab_atc("AMX")), "J01CA04") - expect_identical(ab_cid("AMX"), as.integer(33613)) - - expect_equal(class(ab_tradenames("AMX")), "character") - expect_equal(class(ab_tradenames(c("AMX", "AMX"))), "list") - - expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins") - expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins") - expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum") - - expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin") - expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin") - expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin") - expect_identical(ab_name(21319, language = NULL), "Flucloxacillin") - expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin") - - expect_identical(ab_ddd("AMX", "oral"), 1.5) - expect_identical(ab_ddd("AMX", "oral", units = TRUE), "g") - expect_identical(ab_ddd("AMX", "iv"), 3) - expect_identical(ab_ddd("AMX", "iv", units = TRUE), "g") - - expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B")) - expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL), - c("amoxicillin/clavulanic acid", "polymyxin B")) - - expect_equal(class(ab_info("AMX")), "list") - - expect_error(ab_property("amox", "invalid property")) - expect_error(ab_name("amox", language = "INVALID")) - expect_output(print(ab_name("amox", language = NULL))) - - expect_equal(ab_name("21066-6", language = NULL), "Ampicillin") - expect_equal(ab_loinc("ampicillin"), - c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5")) - - expect_true(ab_url("AMX") %like% "whocc.no") - expect_warning(ab_url("ASP")) -}) diff --git a/tests/testthat/test-age.R b/tests/testthat/test-age.R deleted file mode 100644 index 659cbafe..00000000 --- a/tests/testthat/test-age.R +++ /dev/null @@ -1,77 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("age.R") - -test_that("age works", { - skip_on_cran() - expect_equal(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), - reference = "2019-01-01"), - c(39, 34, 29)) - - expect_equal(age(x = c("2019-01-01", "2019-04-01", "2019-07-01"), - reference = "2019-09-01", - exact = TRUE), - c(0.6656393, 0.4191781, 0.1698630), - tolerance = 0.001) - - expect_error(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), - reference = c("2019-01-01", "2019-01-01"))) - - expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), - reference = "1975-01-01")) - - expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"), - reference = "2019-01-01")) - - expect_equal(length(age(x = c("2019-01-01", NA), na.rm = TRUE)), - 1) - -}) - -test_that("age_groups works", { - skip_on_cran() - ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21) - - expect_equal(length(unique(age_groups(ages, 50))), - 2) - expect_equal(length(unique(age_groups(ages, c(50, 60)))), - 3) - expect_identical(class(age_groups(ages, "child")), - c("ordered", "factor")) - - expect_identical(class(age_groups(ages, "elderly")), - c("ordered", "factor")) - - expect_identical(class(age_groups(ages, "tens")), - c("ordered", "factor")) - - expect_identical(class(age_groups(ages, "fives")), - c("ordered", "factor")) - - expect_equal(length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)), - 3) - -}) diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R deleted file mode 100644 index fd988c4e..00000000 --- a/tests/testthat/test-count.R +++ /dev/null @@ -1,106 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("count.R") - -test_that("counts work", { - skip_on_cran() - - expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX)) - expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX)) - expect_equal(count_all(example_isolates$AMX), n_rsi(example_isolates$AMX)) - - # AMX resistance in `example_isolates` - expect_equal(count_R(example_isolates$AMX), 804) - expect_equal(count_I(example_isolates$AMX), 3) - expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543) - expect_equal(count_R(example_isolates$AMX) + count_I(example_isolates$AMX), - suppressWarnings(count_IR(example_isolates$AMX))) - expect_equal(suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX), - count_SI(example_isolates$AMX)) - - - # warning for speed loss - reset_all_thrown_messages() - expect_warning(count_resistant(as.character(example_isolates$AMC))) - reset_all_thrown_messages() - expect_warning(count_resistant(example_isolates$AMC, - as.character(example_isolates$GEN))) - - # check for errors - expect_error(count_resistant("test", minimum = "test")) - expect_error(count_resistant("test", as_percent = "test")) - expect_error(count_susceptible("test", minimum = "test")) - expect_error(count_susceptible("test", as_percent = "test")) - - expect_error(count_df(c("A", "B", "C"))) - expect_error(count_df(example_isolates[, "date"])) - - if (suppressWarnings(require("dplyr"))) { - expect_equal(example_isolates %>% count_susceptible(AMC), 1433) - expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE), 1687) - expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE), 1764) - expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), 1798) - expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936) - expect_identical(example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE), - example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) + - example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE)) - - # count of cases - expect_equal(example_isolates %>% - group_by(hospital_id) %>% - summarise(cipro = count_susceptible(CIP), - genta = count_susceptible(GEN), - combination = count_susceptible(CIP, GEN)) %>% - pull(combination), - c(253, 465, 192, 558)) - - # count_df - expect_equal( - example_isolates %>% select(AMX) %>% count_df() %>% pull(value), - c(example_isolates$AMX %>% count_susceptible(), - example_isolates$AMX %>% count_resistant()) - ) - expect_equal( - example_isolates %>% select(AMX) %>% count_df(combine_IR = TRUE) %>% pull(value), - c(suppressWarnings(example_isolates$AMX %>% count_S()), - suppressWarnings(example_isolates$AMX %>% count_IR())) - ) - expect_equal( - example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value), - c(suppressWarnings(example_isolates$AMX %>% count_S()), - example_isolates$AMX %>% count_I(), - example_isolates$AMX %>% count_R()) - ) - - # grouping in rsi_calc_df() (= backbone of rsi_df()) - expect_true("hospital_id" %in% (example_isolates %>% - group_by(hospital_id) %>% - select(hospital_id, AMX, CIP, gender) %>% - rsi_df() %>% - colnames())) - } - -}) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R deleted file mode 100644 index 9c4c0224..00000000 --- a/tests/testthat/test-data.R +++ /dev/null @@ -1,98 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("data.R") - -test_that("data sets are valid", { - skip_on_cran() - expect_true(check_dataset_integrity()) # in misc.R - - # IDs should always be unique - expect_identical(nrow(microorganisms), length(unique(microorganisms$mo))) - expect_identical(class(microorganisms$mo), c("mo", "character")) - expect_identical(nrow(antibiotics), length(unique(antibiotics$ab))) - expect_identical(class(antibiotics$ab), c("ab", "character")) - - # check cross table reference - expect_true(all(microorganisms.codes$mo %in% microorganisms$mo)) - expect_true(all(example_isolates$mo %in% microorganisms$mo)) - expect_true(all(microorganisms.translation$mo_new %in% microorganisms$mo)) - expect_true(all(rsi_translation$mo %in% microorganisms$mo)) - expect_true(all(rsi_translation$ab %in% antibiotics$ab)) - expect_true(all(intrinsic_resistant$microorganism %in% microorganisms$fullname)) # also important for mo_is_intrinsic_resistant() - expect_true(all(intrinsic_resistant$antibiotic %in% antibiotics$name)) - expect_false(any(is.na(microorganisms.codes$code))) - expect_false(any(is.na(microorganisms.codes$mo))) - expect_false(any(microorganisms.translation$mo_old %in% microorganisms$mo)) - expect_true(all(dosage$ab %in% antibiotics$ab)) - expect_true(all(dosage$name %in% antibiotics$name)) - - # antibiotic names must always be coercible to their original AB code - expect_identical(as.ab(antibiotics$name), antibiotics$ab) - - # there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy) - datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item"] - for (i in seq_len(length(datasets))) { - dataset <- get(datasets[i], envir = asNamespace("AMR")) - expect_identical(dataset_UTF8_to_ASCII(dataset), dataset, label = datasets[i]) - } -}) - -test_that("creation of data sets is valid", { - skip_on_cran() - - df <- AMR:::MO_lookup - expect_lt(nrow(df[which(df$prevalence == 1), ]), nrow(df[which(df$prevalence == 2), ])) - expect_lt(nrow(df[which(df$prevalence == 2), ]), nrow(df[which(df$prevalence == 3), ])) - expect_true(all(c("mo", "fullname", - "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", - "rank", "ref", "species_id", "source", "prevalence", "snomed", - "kingdom_index", "fullname_lower", "g_species") %in% colnames(df))) - - expect_true(all(c("fullname", "fullname_new", "ref", "prevalence", - "fullname_lower", "g_species") %in% colnames(AMR:::MO.old_lookup))) - - expect_s3_class(AMR:::MO_CONS, "mo") - -}) - -test_that("CoL version info works", { - skip_on_cran() - - expect_identical(class(catalogue_of_life_version()), - c("catalogue_of_life_version", "list")) - - expect_output(print(catalogue_of_life_version())) -}) - -test_that("CoNS/CoPS are up to date", { - uncategorised <- subset(microorganisms, - genus == "Staphylococcus" & - !species %in% c("", "aureus") & - !mo %in% c(MO_CONS, MO_COPS)) - expect(NROW(uncategorised) == 0, - failure_message = paste0("Staphylococcal species not categorised as CoNS/CoPS: S. ", - uncategorised$species, " (", uncategorised$mo, ")")) -}) diff --git a/tests/testthat/test-eucast_rules.R b/tests/testthat/test-eucast_rules.R deleted file mode 100755 index 55c42202..00000000 --- a/tests/testthat/test-eucast_rules.R +++ /dev/null @@ -1,168 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("eucast_rules.R") - -test_that("EUCAST rules work", { - - skip_on_cran() - - # thoroughly check input table - expect_equal(colnames(eucast_rules_file), - c("if_mo_property", "like.is.one_of", "this_value", - "and_these_antibiotics", "have_these_values", - "then_change_these_antibiotics", "to_value", - "reference.rule", "reference.rule_group", - "reference.version", - "note")) - MOs_mentioned <- unique(eucast_rules_file$this_value) - MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!is_valid_regex(MOs_mentioned)], ",", fixed = TRUE)))) - MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned))) - expect_length(MOs_mentioned[MOs_test != MOs_mentioned], 0) - - expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing"))) - expect_error(eucast_rules(x = "text")) - expect_error(eucast_rules(data.frame(a = "test"))) - expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set")) - - expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE))) - - expect_identical(colnames(example_isolates), - colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE)))) - expect_output(suppressMessages(eucast_rules(example_isolates, info = TRUE))) - - a <- data.frame(mo = c("Klebsiella pneumoniae", - "Pseudomonas aeruginosa", - "Enterobacter cloacae"), - amox = "-", # Amoxicillin - stringsAsFactors = FALSE) - b <- data.frame(mo = c("Klebsiella pneumoniae", - "Pseudomonas aeruginosa", - "Enterobacter cloacae"), - amox = "R", # Amoxicillin - stringsAsFactors = FALSE) - expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) - expect_output(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE)))) - - a <- data.frame(mo = c("Staphylococcus aureus", - "Streptococcus group A"), - COL = "-", # Colistin - stringsAsFactors = FALSE) - b <- data.frame(mo = c("Staphylococcus aureus", - "Streptococcus group A"), - COL = "R", # Colistin - stringsAsFactors = FALSE) - expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b) - - # piperacillin must be R in Enterobacteriaceae when tica is R - if (suppressWarnings(require("dplyr"))) { - expect_equal(suppressWarnings( - example_isolates %>% - filter(mo_family(mo) == "Enterobacteriaceae") %>% - mutate(TIC = as.rsi("R"), - PIP = as.rsi("S")) %>% - eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>% - pull(PIP) %>% - unique() %>% - as.character()), - "R") - } - - # Azithromycin and Clarythromycin must be equal to Erythromycin - a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo, - ERY = example_isolates$ERY, - AZM = as.rsi("R"), - CLR = factor("R"), - stringsAsFactors = FALSE), - version_expertrules = 3.1, - only_rsi_columns = FALSE)$CLR)) - b <- example_isolates$ERY - expect_identical(a[!is.na(b)], - b[!is.na(b)]) - - # amox is inferred by benzylpenicillin in Kingella kingae - expect_equal( - suppressWarnings( - as.list(eucast_rules( - data.frame(mo = as.mo("Kingella kingae"), - PEN = "S", - AMX = "-", - stringsAsFactors = FALSE) - , info = FALSE))$AMX - ), - "S") - - # also test norf - if (suppressWarnings(require("dplyr"))) { - expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) - } - - # check verbose output - expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE))) - - # AmpC de-repressed cephalo mutants - expect_identical( - eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), - cefotax = as.rsi(c("S", "S"))), - ampc_cephalosporin_resistance = TRUE, - info = FALSE)$cefotax, - as.rsi(c("S", "R"))) - expect_identical( - eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), - cefotax = as.rsi(c("S", "S"))), - ampc_cephalosporin_resistance = NA, - info = FALSE)$cefotax, - as.rsi(c("S", NA))) - expect_identical( - eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"), - cefotax = as.rsi(c("S", "S"))), - ampc_cephalosporin_resistance = NULL, - info = FALSE)$cefotax, - as.rsi(c("S", "S"))) - - # EUCAST dosage ----------------------------------------------------------- - expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3) - expect_s3_class(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame") - -}) - -test_that("Custom EUCAST rules work", { - - skip_on_cran() - x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R", - AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I", - AMX == "S" ~ AMC == "S") - expect_output(print(x)) - expect_output(print(c(x, x))) - expect_output(print(as.list(x, x))) - - # this custom rules makes 8 changes - expect_equal(nrow(eucast_rules(example_isolates, - rules = "custom", - custom_rules = x, - info = FALSE, - verbose = TRUE)), - 8) -}) diff --git a/tests/testthat/test-filter_ab_class.R b/tests/testthat/test-filter_ab_class.R deleted file mode 100644 index 94f55e43..00000000 --- a/tests/testthat/test-filter_ab_class.R +++ /dev/null @@ -1,54 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("filter_ab_class.R") - -test_that("ATC-group filtering works", { - skip_on_cran() - - if (suppressWarnings(require("dplyr"))) { - expect_gt(example_isolates %>% filter_ab_class("carbapenem") %>% nrow(), 0) - expect_gt(example_isolates %>% filter_aminoglycosides() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_carbapenems() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_1st_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_2nd_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_3rd_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_4th_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_5th_cephalosporins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_fluoroquinolones() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_glycopeptides() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_macrolides() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_oxazolidinones() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_penicillins() %>% ncol(), 0) - expect_gt(example_isolates %>% filter_tetracyclines() %>% ncol(), 0) - - expect_gt(example_isolates %>% filter_carbapenems("R", "all") %>% nrow(), 0) - - expect_error(example_isolates %>% filter_carbapenems(result = "test")) - expect_error(example_isolates %>% filter_carbapenems(scope = "test")) - expect_message(example_isolates %>% select(1:3) %>% filter_carbapenems()) - } -}) diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R deleted file mode 100755 index 9b673eec..00000000 --- a/tests/testthat/test-first_isolate.R +++ /dev/null @@ -1,194 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("first_isolate.R") - -test_that("first isolates work", { - skip_on_cran() - - # all four methods - expect_equal(sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE), - 1984) - expect_equal(sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE), - 1265) - expect_equal(sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE), - 1300) - expect_equal(sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE), - 1379) - - # Phenotype-based, using key antimicrobials - expect_equal(sum(first_isolate(x = example_isolates, - method = "phenotype-based", - type = "keyantimicrobials", - antifungal = NULL, info = TRUE), na.rm = TRUE), - 1395) - expect_equal(sum(first_isolate(x = example_isolates, - method = "phenotype-based", - type = "keyantimicrobials", - antifungal = NULL, info = TRUE, ignore_I = FALSE), na.rm = TRUE), - 1418) - - - # first non-ICU isolates - expect_equal( - sum( - first_isolate(example_isolates, - col_mo = "mo", - col_date = "date", - col_patient_id = "patient_id", - col_icu = "ward_icu", - info = TRUE, - icu_exclude = TRUE), - na.rm = TRUE), - 941) - - # set 1500 random observations to be of specimen type 'Urine' - random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE) - x <- example_isolates - x$specimen <- "Other" - x[random_rows, "specimen"] <- "Urine" - expect_lt( - sum( - first_isolate(x = x, - col_date = "date", - col_patient_id = "patient_id", - col_mo = "mo", - col_specimen = "specimen", - filter_specimen = "Urine", - info = TRUE), - na.rm = TRUE), - 1501) - # same, but now exclude ICU - expect_lt( - sum( - first_isolate(x = x, - col_date = "date", - col_patient_id = "patient_id", - col_mo = "mo", - col_specimen = "specimen", - filter_specimen = "Urine", - col_icu = "ward_icu", - icu_exclude = TRUE, - info = TRUE), - na.rm = TRUE), - 1501) - - # "No isolates found" - test_iso <- example_isolates - test_iso$specimen <- "test" - expect_message(first_isolate(test_iso, - "date", - "patient_id", - col_mo = "mo", - col_specimen = "specimen", - filter_specimen = "something_unexisting", - info = TRUE)) - - # printing of exclusion message - expect_message(first_isolate(example_isolates, - col_date = "date", - col_mo = "mo", - col_patient_id = "patient_id", - col_testcode = "gender", - testcodes_exclude = "M", - info = TRUE)) - - # errors - expect_error(first_isolate("date", "patient_id", col_mo = "mo")) - expect_error(first_isolate(example_isolates, - col_date = "non-existing col", - col_mo = "mo")) - - if (suppressWarnings(require("dplyr"))) { - # if mo is not an mo class, result should be the same - expect_identical(example_isolates %>% - mutate(mo = as.character(mo)) %>% - first_isolate(col_date = "date", - col_mo = "mo", - col_patient_id = "patient_id", - info = FALSE), - example_isolates %>% - first_isolate(col_date = "date", - col_mo = "mo", - col_patient_id = "patient_id", - info = FALSE)) - - # support for WHONET - expect_message(example_isolates %>% - select(-patient_id) %>% - mutate(`First name` = "test", - `Last name` = "test", - Sex = "Female") %>% - first_isolate(info = TRUE)) - - # groups - x <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate()) - y <- example_isolates %>% group_by(ward_icu) %>% mutate(first = first_isolate(.)) - expect_identical(x, y) - - } - - # missing dates should be no problem - df <- example_isolates - df[1:100, "date"] <- NA - expect_equal( - sum( - first_isolate(x = df, - col_date = "date", - col_patient_id = "patient_id", - col_mo = "mo", - info = TRUE), - na.rm = TRUE), - 1382) - - # unknown MOs - test_unknown <- example_isolates - test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo) - expect_equal(sum(first_isolate(test_unknown, include_unknown = FALSE)), - 1108) - expect_equal(sum(first_isolate(test_unknown, include_unknown = TRUE)), - 1591) - - test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo) - expect_equal(sum(first_isolate(test_unknown)), - 1108) - - # empty rsi results - expect_equal(sum(first_isolate(example_isolates, include_untested_rsi = FALSE)), - 1366) - - # shortcuts - expect_identical(filter_first_isolate(example_isolates), - subset(example_isolates, first_isolate(example_isolates))) - - - # notice that all mo's are distinct, so all are TRUE - expect_true(all(example_isolates %pm>% - pm_distinct(mo, .keep_all = TRUE) %pm>% - first_isolate(info = TRUE) == TRUE)) - - # only one isolate, so return fast - expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE)) -}) diff --git a/tests/testthat/test-ggplot_rsi.R b/tests/testthat/test-ggplot_rsi.R deleted file mode 100644 index 67be05b4..00000000 --- a/tests/testthat/test-ggplot_rsi.R +++ /dev/null @@ -1,90 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("ggplot_rsi.R") - -test_that("ggplot_rsi works", { - - skip_on_cran() - - skip_if_not_installed("ggplot2") - skip_if_not_installed("dplyr") - - if (suppressWarnings(require("dplyr")) & suppressWarnings(require("ggplot2"))) { - - pdf(NULL) # prevent Rplots.pdf being created - - # data should be equal - expect_equal( - (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi())$data %>% summarise_all(resistance) %>% as.double(), - example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double() - ) - - print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic")) - print(example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation")) - - expect_equal( - (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>% summarise_all(resistance) %>% as.double(), - example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double() - ) - - expect_equal( - (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(resistance) %>% as.double(), - example_isolates %>% select(AMC, CIP) %>% summarise_all(resistance) %>% as.double() - ) - - expect_equal( - (example_isolates %>% select(AMC, CIP) %>% ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>% summarise_all(count_resistant) %>% as.double(), - example_isolates %>% select(AMC, CIP) %>% summarise_all(count_resistant) %>% as.double() - ) - - # support for scale_type ab and mo - expect_equal(class((data.frame(mo = as.mo(c("e. coli", "s aureus")), - n = c(40, 100)) %>% - ggplot(aes(x = mo, y = n)) + - geom_col())$data), - "data.frame") - expect_equal(class((data.frame(ab = as.ab(c("amx", "amc")), - n = c(40, 100)) %>% - ggplot(aes(x = ab, y = n)) + - geom_col())$data), - "data.frame") - - expect_equal(class((data.frame(ab = as.ab(c("amx", "amc")), - n = c(40, 100)) %>% - ggplot(aes(x = ab, y = n)) + - geom_col())$data), - "data.frame") - - # support for manual colours - expect_equal(class((ggplot(data.frame(x = c("Value1", "Value2", "Value3"), - y = c(1, 2, 3), - z = c("Value4", "Value5", "Value6"))) + - geom_col(aes(x = x, y = y, fill = z)) + - scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data), - "data.frame") - - } -}) diff --git a/tests/testthat/test-mdro.R b/tests/testthat/test-mdro.R deleted file mode 100755 index 51698e29..00000000 --- a/tests/testthat/test-mdro.R +++ /dev/null @@ -1,251 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("mdro.R") - -test_that("mdro works", { - - skip_on_cran() - - expect_error(suppressWarnings(mdro(example_isolates, country = "invalid", col_mo = "mo", info = TRUE))) - expect_error(suppressWarnings(mdro(example_isolates, country = "fr", info = TRUE))) - expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE)) - expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE)) - - expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE)))) - expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE)))) - expect_output(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE)))) - # check class - expect_equal(class(outcome), c("ordered", "factor")) - - expect_output(outcome <- mdro(example_isolates, "nl", info = TRUE)) - # check class - expect_equal(class(outcome), c("ordered", "factor")) - - # example_isolates should have these finding using Dutch guidelines - expect_equal(as.double(table(outcome)), - c(1970, 24, 6)) # 1970 neg, 24 unconfirmed, 6 pos - - expect_equal(brmo(example_isolates, info = FALSE), - mdro(example_isolates, guideline = "BRMO", info = FALSE)) - - # test Dutch P. aeruginosa MDRO - expect_equal( - as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), - cfta = "S", - cipr = "S", - mero = "S", - imip = "S", - gent = "S", - tobr = "S", - pita = "S"), - guideline = "BRMO", - col_mo = "mo", - info = FALSE)), - "Negative") - expect_equal( - as.character(mdro(data.frame(mo = as.mo("P. aeruginosa"), - cefta = "R", - cipr = "R", - mero = "R", - imip = "R", - gent = "R", - tobr = "R", - pita = "R"), - guideline = "BRMO", - col_mo = "mo", - info = FALSE)), - "Positive") - - # German 3MRGN and 4MRGN - expect_equal(as.character(mrgn( - data.frame(mo = c("E. coli", "E. coli", "K. pneumoniae", "E. coli", - "A. baumannii", "A. baumannii", "A. baumannii", - "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"), - PIP = c("S", "R", "R", "S", - "S", "R", "R", - "S", "R", "R"), - CTX = c("S", "R", "R", "S", - "R", "R", "R", - "R", "R", "R"), - IPM = c("S", "R", "S", "R", - "R", "R", "S", - "S", "R", "R"), - CIP = c("S", "R", "R", "S", - "R", "R", "R", - "R", "S", "R"), - stringsAsFactors = FALSE))), - c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN")) - - # MDR TB - expect_equal( - # select only rifampicine, mo will be determined automatically (as M. tuberculosis), - # number of mono-resistant strains should be equal to number of rifampicine-resistant strains - as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2], - count_R(example_isolates$RIF)) - - sample_rsi <- function() { - sample(c("S", "I", "R"), - size = 5000, - prob = c(0.5, 0.1, 0.4), - replace = TRUE) - } - x <- data.frame(rifampicin = sample_rsi(), - inh = sample_rsi(), - gatifloxacin = sample_rsi(), - eth = sample_rsi(), - pza = sample_rsi(), - MFX = sample_rsi(), - KAN = sample_rsi()) - expect_gt(length(unique(mdr_tb(x))), 2) - - # check the guideline by Magiorakos et al. (2012), the default guideline - stau <- data.frame(mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"), - GEN = c("R", "R", "S", "R"), - RIF = c("S", "R", "S", "R"), - CPT = c("S", "R", "R", "R"), - OXA = c("S", "R", "R", "R"), - CIP = c("S", "S", "R", "R"), - MFX = c("S", "S", "R", "R"), - SXT = c("S", "S", "R", "R"), - FUS = c("S", "S", "R", "R"), - VAN = c("S", "S", "R", "R"), - TEC = c("S", "S", "R", "R"), - TLV = c("S", "S", "R", "R"), - TGC = c("S", "S", "R", "R"), - CLI = c("S", "S", "R", "R"), - DAP = c("S", "S", "R", "R"), - ERY = c("S", "S", "R", "R"), - LNZ = c("S", "S", "R", "R"), - CHL = c("S", "S", "R", "R"), - FOS = c("S", "S", "R", "R"), - QDA = c("S", "S", "R", "R"), - TCY = c("S", "S", "R", "R"), - DOX = c("S", "S", "R", "R"), - MNO = c("S", "S", "R", "R"), - stringsAsFactors = FALSE) - expect_equal(as.integer(mdro(stau)), c(1:4)) - expect_s3_class(mdro(stau, verbose = TRUE), "data.frame") - - ente <- data.frame(mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"), - GEH = c("R", "R", "S", "R"), - STH = c("S", "R", "S", "R"), - IPM = c("S", "R", "R", "R"), - MEM = c("S", "R", "R", "R"), - DOR = c("S", "S", "R", "R"), - CIP = c("S", "S", "R", "R"), - LVX = c("S", "S", "R", "R"), - MFX = c("S", "S", "R", "R"), - VAN = c("S", "S", "R", "R"), - TEC = c("S", "S", "R", "R"), - TGC = c("S", "S", "R", "R"), - DAP = c("S", "S", "R", "R"), - LNZ = c("S", "S", "R", "R"), - AMP = c("S", "S", "R", "R"), - QDA = c("S", "S", "R", "R"), - DOX = c("S", "S", "R", "R"), - MNO = c("S", "S", "R", "R"), - stringsAsFactors = FALSE) - expect_equal(as.integer(mdro(ente)), c(1:4)) - expect_s3_class(mdro(ente, verbose = TRUE), "data.frame") - - entero <- data.frame(mo = c("E. coli", "E. coli", "E. coli", "E. coli"), - GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"), - AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"), - CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"), - TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"), - IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"), - DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"), - CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"), - CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"), - FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"), - CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"), - TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"), - AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"), - SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"), - FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), - TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"), - MNO = c("S", "S", "R", "R"), - stringsAsFactors = FALSE) - expect_equal(as.integer(mdro(entero)), c(1:4)) - expect_s3_class(mdro(entero, verbose = TRUE), "data.frame") - - pseud <- data.frame(mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"), - GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"), - AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"), - IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"), - DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"), - FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"), - LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"), - TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"), - FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), - PLB = c("S", "S", "R", "R"), - stringsAsFactors = FALSE) - expect_equal(as.integer(mdro(pseud)), c(1:4)) - expect_s3_class(mdro(pseud, verbose = TRUE), "data.frame") - - acin <- data.frame(mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"), - GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"), - AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"), - IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"), - DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"), - LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"), - TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"), - CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"), - FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"), - SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"), - PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"), - DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"), - stringsAsFactors = FALSE) - expect_equal(as.integer(mdro(acin)), c(1:4)) - expect_s3_class(mdro(acin, verbose = TRUE), "data.frame") - - # custom rules - custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A", - "ERY == 'R' & age > 60" ~ "Elderly Type B", - as_factor = TRUE) - expect_output(print(custom)) - expect_output(print(c(custom, custom))) - expect_output(print(as.list(custom, custom))) - - expect_output(x <- mdro(example_isolates, guideline = custom, info = TRUE)) - expect_equal(as.double(table(x)), c(1070, 198, 732)) - - expect_output(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE))) - expect_error(custom_mdro_guideline()) - expect_error(custom_mdro_guideline("test")) - expect_error(custom_mdro_guideline("test" ~ c(1:3))) - expect_error(custom_mdro_guideline("test" ~ A)) - expect_warning(mdro(example_isolates, - # since `test` gives an error, it will be ignored with a warning - guideline = custom_mdro_guideline(test ~ "A"), - info = FALSE)) - - # print groups - if (suppressWarnings(require("dplyr"))) { - expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), info = TRUE)) - expect_output(x <- mdro(example_isolates %>% group_by(hospital_id), guideline = custom, info = TRUE)) - } -}) diff --git a/tests/testthat/test-mic.R b/tests/testthat/test-mic.R deleted file mode 100755 index 2144a4d4..00000000 --- a/tests/testthat/test-mic.R +++ /dev/null @@ -1,143 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("mic.R") - -test_that("mic works", { - skip_on_cran() - expect_true(as.mic(8) == as.mic("8")) - expect_true(as.mic("1") > as.mic("<=0.0625")) - expect_true(as.mic("1") < as.mic(">=32")) - expect_true(is.mic(as.mic(8))) - - expect_equal(as.double(as.mic(">=32")), 32) - expect_equal(as.numeric(as.mic(">=32")), 32) - expect_equal(as.integer(as.mic(">=32")), 32) - expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA) - - # all levels should be valid MICs - x <- as.mic(c(2, 4)) - expect_s3_class(x[1], "mic") - expect_s3_class(x[[1]], "mic") - expect_s3_class(c(x[1], x[9]), "mic") - expect_s3_class(unique(x[1], x[9]), "mic") - expect_s3_class(droplevels(c(x[1], x[9])), "mic") - x[2] <- 32 - expect_s3_class(x, "mic") - expect_warning(as.mic("INVALID VALUE")) - - pdf(NULL) # prevent Rplots.pdf being created - expect_silent(barplot(as.mic(c(1, 2, 4, 8)))) - expect_silent(plot(as.mic(c(1, 2, 4, 8)))) - expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE)) - expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "esco", ab = "cipr")) - if (suppressWarnings(require("ggplot2"))) { - expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8))), "gg") - expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg") - expect_s3_class(ggplot(as.mic(c(1, 2, 4, 8, 32)), mo = "esco", ab = "cipr"), "gg") - } - expect_output(print(as.mic(c(1, 2, 4, 8)))) - - expect_s3_class(summary(as.mic(c(2, 8))), c("summaryDefault", "table")) - - if (suppressWarnings(require("dplyr"))) { - expect_output(print(tibble(m = as.mic(2:4)))) - } -}) - -test_that("mathematical functions on mic work", { - skip_on_cran() - x <- random_mic(50) - x_double <- as.double(gsub("[<=>]+", "", as.character(x))) - suppressWarnings(expect_identical(mean(x), mean(x_double))) - suppressWarnings(expect_identical(median(x), median(x_double))) - suppressWarnings(expect_identical(quantile(x), quantile(x_double))) - suppressWarnings(expect_identical(abs(x), abs(x_double))) - suppressWarnings(expect_identical(sign(x), sign(x_double))) - suppressWarnings(expect_identical(sqrt(x), sqrt(x_double))) - suppressWarnings(expect_identical(floor(x), floor(x_double))) - suppressWarnings(expect_identical(ceiling(x), ceiling(x_double))) - suppressWarnings(expect_identical(trunc(x), trunc(x_double))) - suppressWarnings(expect_identical(round(x), round(x_double))) - suppressWarnings(expect_identical(signif(x), signif(x_double))) - suppressWarnings(expect_identical(exp(x), exp(x_double))) - suppressWarnings(expect_identical(log(x), log(x_double))) - suppressWarnings(expect_identical(log10(x), log10(x_double))) - suppressWarnings(expect_identical(log2(x), log2(x_double))) - suppressWarnings(expect_identical(expm1(x), expm1(x_double))) - suppressWarnings(expect_identical(log1p(x), log1p(x_double))) - suppressWarnings(expect_identical(cos(x), cos(x_double))) - suppressWarnings(expect_identical(sin(x), sin(x_double))) - suppressWarnings(expect_identical(tan(x), tan(x_double))) - suppressWarnings(expect_identical(cospi(x), cospi(x_double))) - suppressWarnings(expect_identical(sinpi(x), sinpi(x_double))) - suppressWarnings(expect_identical(tanpi(x), tanpi(x_double))) - suppressWarnings(expect_identical(acos(x), acos(x_double))) - suppressWarnings(expect_identical(asin(x), asin(x_double))) - suppressWarnings(expect_identical(atan(x), atan(x_double))) - suppressWarnings(expect_identical(cosh(x), cosh(x_double))) - suppressWarnings(expect_identical(sinh(x), sinh(x_double))) - suppressWarnings(expect_identical(tanh(x), tanh(x_double))) - suppressWarnings(expect_identical(acosh(x), acosh(x_double))) - suppressWarnings(expect_identical(asinh(x), asinh(x_double))) - suppressWarnings(expect_identical(atanh(x), atanh(x_double))) - suppressWarnings(expect_identical(lgamma(x), lgamma(x_double))) - suppressWarnings(expect_identical(gamma(x), gamma(x_double))) - suppressWarnings(expect_identical(digamma(x), digamma(x_double))) - suppressWarnings(expect_identical(trigamma(x), trigamma(x_double))) - suppressWarnings(expect_identical(cumsum(x), cumsum(x_double))) - suppressWarnings(expect_identical(cumprod(x), cumprod(x_double))) - suppressWarnings(expect_identical(cummax(x), cummax(x_double))) - suppressWarnings(expect_identical(cummin(x), cummin(x_double))) - suppressWarnings(expect_identical(!x, !(x_double))) - - suppressWarnings(expect_identical(all(x), all(x_double))) - suppressWarnings(expect_identical(any(x), any(x_double))) - suppressWarnings(expect_identical(sum(x), sum(x_double))) - suppressWarnings(expect_identical(prod(x), prod(x_double))) - suppressWarnings(expect_identical(min(x), min(x_double))) - suppressWarnings(expect_identical(max(x), max(x_double))) - suppressWarnings(expect_identical(range(x), range(x_double))) - - el1 <- random_mic(50) - el1_double <- as.double(gsub("[<=>]+", "", as.character(el1))) - el2 <- random_mic(50) - el2_double <- as.double(gsub("[<=>]+", "", as.character(el2))) - suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double)) - suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double)) - suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double)) - suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double)) - suppressWarnings(expect_identical(el1 ^ el2, el1_double ^ el2_double)) - suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double)) - suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double)) - suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double)) - suppressWarnings(expect_identical(el1 | el2, el1_double | el2_double)) - suppressWarnings(expect_identical(el1 == el2, el1_double == el2_double)) - suppressWarnings(expect_identical(el1 != el2, el1_double != el2_double)) - suppressWarnings(expect_identical(el1 < el2, el1_double < el2_double)) - suppressWarnings(expect_identical(el1 <= el2, el1_double <= el2_double)) - suppressWarnings(expect_identical(el1 >= el2, el1_double >= el2_double)) - suppressWarnings(expect_identical(el1 > el2, el1_double > el2_double)) -}) diff --git a/tests/testthat/test-mo.R b/tests/testthat/test-mo.R deleted file mode 100644 index c1e8a144..00000000 --- a/tests/testthat/test-mo.R +++ /dev/null @@ -1,308 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("mo.R") - -test_that("as.mo works", { - - skip_on_cran() - - MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3) - expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo))) - - expect_identical( - as.character(as.mo(c("E. coli", "H. influenzae"))), - c("B_ESCHR_COLI", "B_HMPHL_INFL")) - - expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI") - expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI") - expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI") - expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR") - expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR") - expect_equal(as.character(as.mo("Esch spp.")), "B_ESCHR") - expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI") - expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter - expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN") - expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL") - expect_equal(as.character(as.mo("K. pneu rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis - expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL") - expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC") - expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP") - expect_equal(as.character(as.mo("Strepto")), "B_STRPT") - expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus - expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB") - expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB") - expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0) - expect_equal(as.character(as.mo(c("mycobacterie", "mycobakterium"))), c("B_MYCBC", "B_MYCBC")) - - expect_equal(as.character(as.mo(c("GAS", "GBS", "a MGS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_MILL", "B_STRPT_HAEM")) - - - expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes - - # GLIMS - expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL") - - expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR") - expect_equal(as.character(as.mo("VRE")), "B_ENTRC") - expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG") - expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN") - expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN") - expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN") - expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN") - - expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS") - expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS") - expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS") - expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS") - expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI") - expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL") - - - expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP")) - - # prevalent MO - expect_identical( - suppressWarnings(as.character( - as.mo(c("stau", - "STAU", - "staaur", - "S. aureus", - "S aureus", - "Sthafilokkockus aureeuzz", - "Staphylococcus aureus", - "MRSA", - "VISA")))), - rep("B_STPHY_AURS", 9)) - expect_identical( - as.character( - as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))), - rep("B_ESCHR_COLI", 6)) - # unprevalent MO - expect_identical( - as.character( - as.mo(c("parnod", - "P. nodosa", - "P nodosa", - "Paraburkholderia nodosa"))), - rep("B_PRBRK_NODS", 4)) - - # empty values - expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4)) - expect_identical(as.character(as.mo(" ")), NA_character_) - # too few characters - expect_warning(as.mo("ab")) - - expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))), - c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")) - - # check for Becker classification - expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR") - expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS") - expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS") - expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR") - expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS") - expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS") - # aureus must only be influenced if Becker = "all" - expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS") - expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS") - expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS") - - # check for Lancefield classification - expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN") - expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA") - expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A - expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC") - expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B - expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB") - expect_identical(as.character(as.mo("S. equisimilis", Lancefield = FALSE)), "B_STRPT_DYSG_EQSM") - expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C - # Enterococci must only be influenced if Lancefield = "all" - expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM") - expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM") - expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D - expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN") - expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F - expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN") - expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H - expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR") - expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K - - if (suppressWarnings(require("dplyr"))) { - # select with one column - expect_identical( - example_isolates[1:10, ] %>% - left_join_microorganisms() %>% - select(genus) %>% - as.mo() %>% - as.character(), - c("B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY", - "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY")) - - # select with two columns - expect_identical( - example_isolates[1:10, ] %>% - pull(mo), - example_isolates[1:10, ] %>% - left_join_microorganisms() %>% - select(genus, species) %>% - as.mo()) - - # too many columns - expect_error(example_isolates %>% select(1:3) %>% as.mo()) - - # test pull - expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))), - 2000) - expect_true(example_isolates %>% pull(mo) %>% is.mo()) - } - - # unknown results - expect_warning(as.mo(c("INVALID", "Yeah, unknown"))) - - - # print - expect_output(print(as.mo(c("B_ESCHR_COLI", NA)))) - - - - # test data.frame - expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))), - 1) - - # check empty values - expect_equal(as.character(suppressWarnings(as.mo(""))), - NA_character_) - - # check less prevalent MOs - expect_equal(as.character(as.mo("Gomphosphaeria aponina delicatula")), "B_GMPHS_APNN_DLCT") - expect_equal(as.character(as.mo("Gomphosphaeria apo del")), "B_GMPHS_APNN_DLCT") - expect_equal(as.character(as.mo("G apo deli")), "B_GMPHS_APNN_DLCT") - expect_equal(as.character(as.mo("Gomphosphaeria aponina")), "B_GMPHS_APNN") - expect_equal(as.character(as.mo("Gomphosphaeria species")), "B_GMPHS") - expect_equal(as.character(as.mo("Gomphosphaeria")), "B_GMPHS") - expect_equal(as.character(as.mo(" B_GMPHS_APNN ")), "B_GMPHS_APNN") - expect_equal(as.character(as.mo("g aponina")), "B_GMPHS_APNN") - - # check old names - expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT") - print(mo_renamed()) - expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT")) - - # check uncertain names - expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS") - expect_equal(suppressWarnings(as.character(as.mo("staaur extratest", allow_uncertain = FALSE))), "UNKNOWN") - expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE)) - expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS") - expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS") - expect_equal(suppressMessages(as.character(as.mo(c("s aur THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_ANRB", "B_STPHY_AURS_ANRB")) - - # predefined reference_df - expect_equal(as.character(as.mo("TestingOwnID", - reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))), - "B_ESCHR_COLI") - expect_equal(as.character(as.mo(c("TestingOwnID", "E. coli"), - reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI"))), - c("B_ESCHR_COLI", "B_ESCHR_COLI")) - expect_warning(as.mo("TestingOwnID", reference_df = NULL)) - expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID"))) - - # combination of existing mo and other code - expect_identical(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))), - c("B_ESCHR_COLI", "B_ESCHR_COLI")) - - # from different sources - expect_equal(as.character(as.mo( - c("PRTMIR", "bclcer", "B_ESCHR_COLI"))), - c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI")) - - # hard to find - expect_equal(as.character(suppressMessages(as.mo( - c("Microbacterium paraoxidans", - "Streptococcus suis (bovis gr)", - "Raoultella (here some text) terrigena")))), - c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG")) - expect_output(print(mo_uncertainties())) - x <- as.mo("S. aur") - # many hits - expect_output(print(mo_uncertainties())) - - # Salmonella (City) are all actually Salmonella enterica spp (City) - expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))), - c("Salmonella enterica", "Salmonella enterica", "Salmonella")) - - # no virusses - expect_equal(as.character(as.mo("Virus")), NA_character_) - - # summary - expect_equal(length(summary(example_isolates$mo)), 6) - - # WHONET codes and NA/NaN - expect_equal(as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)), - rep(NA_character_, 3)) - expect_equal(as.character(as.mo("con")), "UNKNOWN") - expect_equal(as.character(as.mo("xxx")), NA_character_) - expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI")) - expect_equal(as.character(as.mo(c("other", "none", "unknown"))), - rep("UNKNOWN", 3)) - - expect_null(mo_failures()) - - expect_error(translate_allow_uncertain(5)) - - # debug mode - expect_output(print(suppressMessages(suppressWarnings(as.mo("kshgcjkhsdgkshjdfsfvsdfv", debug = TRUE, allow_uncertain = 3))))) - - # ..coccus - expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))), - c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN")) - # yeasts and fungi - expect_equal(suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))), - c("F_YEAST", "F_FUNGUS")) - - if (suppressWarnings(require("dplyr"))) { - # print tibble - expect_output(print(tibble(mo = as.mo("B_ESCHR_COLI")))) - } - - # assigning and subsetting - x <- example_isolates$mo - expect_s3_class(x[1], "mo") - expect_s3_class(x[[1]], "mo") - expect_s3_class(c(x[1], x[9]), "mo") - expect_warning(x[1] <- "invalid code") - expect_warning(x[[1]] <- "invalid code") - expect_warning(c(x[1], "test")) - - # ignoring patterns - expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")), - c("B_ESCHR_COLI", NA)) - - # frequency tables - if (suppressWarnings(require("cleaner"))) { - expect_s3_class(cleaner::freq(example_isolates$mo), "freq") - } - -}) diff --git a/tests/testthat/test-mo_property.R b/tests/testthat/test-mo_property.R deleted file mode 100644 index 29c61533..00000000 --- a/tests/testthat/test-mo_property.R +++ /dev/null @@ -1,142 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("mo_property.R") - -test_that("mo_property works", { - - skip_on_cran() - - expect_equal(mo_kingdom("Escherichia coli"), "Bacteria") - expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli")) - expect_equal(mo_phylum("Escherichia coli"), "Proteobacteria") - expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria") - expect_equal(mo_order("Escherichia coli"), "Enterobacterales") - expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae") - expect_equal(mo_genus("Escherichia coli"), "Escherichia") - expect_equal(mo_species("Escherichia coli"), "coli") - expect_equal(mo_subspecies("Escherichia coli"), "") - expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli") - expect_equal(mo_name("Escherichia coli"), "Escherichia coli") - expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria") - expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative") - expect_equal(class(mo_taxonomy("Escherichia coli")), "list") - expect_equal(names(mo_taxonomy("Escherichia coli")), c("kingdom", "phylum", "class", "order", - "family", "genus", "species", "subspecies")) - expect_equal(mo_synonyms("Escherichia coli"), NULL) - expect_gt(length(mo_synonyms("Candida albicans")), 1) - expect_equal(class(mo_synonyms(c("Candida albicans", "Escherichia coli"))), "list") - expect_equal(names(mo_info("Escherichia coli")), c("kingdom", "phylum", "class", "order", - "family", "genus", "species", "subspecies", - "synonyms", "gramstain", "url", "ref", - "snomed")) - expect_equal(class(mo_info(c("Escherichia coli", "Staphylococcus aureus"))), "list") - - expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919") - expect_equal(mo_authors("Escherichia coli"), "Castellani et al.") - expect_equal(mo_year("Escherichia coli"), 1919) - - expect_equal(mo_shortname("Escherichia coli"), "E. coli") - expect_equal(mo_shortname("Escherichia"), "Escherichia") - expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus") - expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus") - expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS") - expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae") - expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS") - - expect_true(mo_url("Candida albicans") %like% "catalogueoflife.org") - expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de") - - # test integrity - MOs <- microorganisms - expect_identical(MOs$fullname, mo_fullname(MOs$fullname, language = "en")) - - # check languages - expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien") - expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief") - - expect_output(print(mo_gramstain("Escherichia coli", language = "en"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "de"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "nl"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "es"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "pt"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "it"))) - expect_output(print(mo_gramstain("Escherichia coli", language = "fr"))) - - expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN")) - - dutch <- mo_name(microorganisms$fullname, language = "nl") # should be transformable to English again - expect_identical(mo_name(dutch, language = NULL), microorganisms$fullname) # gigantic test - will run ALL names - - # manual property function - expect_error(mo_property("Escherichia coli", property = c("tsn", "fullname"))) - expect_error(mo_property("Escherichia coli", property = "UNKNOWN")) - expect_identical(mo_property("Escherichia coli", property = "fullname"), - mo_fullname("Escherichia coli")) - expect_identical(mo_property("Escherichia coli", property = "genus"), - mo_genus("Escherichia coli")) - expect_identical(mo_property("Escherichia coli", property = "species"), - mo_species("Escherichia coli")) - - expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968") - expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999") - - expect_true(112283007 %in% mo_snomed("Escherichia coli")) - - # old codes must throw a warning in mo_* family - expect_message(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR"))) - - # outcome of mo_fullname must always return the fullname from the data set - x <- data.frame(mo = microorganisms$mo, - # fullname from the original data: - f1 = microorganisms$fullname, - # newly created fullname based on MO code: - f2 = mo_fullname(microorganisms$mo, language = "en"), - stringsAsFactors = FALSE) - expect_equal(nrow(subset(x, f1 != f2)), 0) - - # is gram pos/neg (also return FALSE for all non-bacteria) - expect_equal(mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), - c(TRUE, FALSE, FALSE)) - expect_equal(mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")), - c(FALSE, TRUE, FALSE)) - # is intrinsic resistant - expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"), - "vanco"), - c(TRUE, FALSE, FALSE)) - - # with reference data - expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")), - "Escherichia coli") - - if (suppressWarnings(require("dplyr"))) { - expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(), - 730) - expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(), - 1238) - expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(), - 710) - } -}) diff --git a/tests/testthat/test-pca.R b/tests/testthat/test-pca.R deleted file mode 100644 index 0475165e..00000000 --- a/tests/testthat/test-pca.R +++ /dev/null @@ -1,70 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("pca.R") - -test_that("PCA works", { - - skip_on_cran() - - resistance_data <- structure(list(order = c("Bacillales", "Enterobacterales", "Enterobacterales"), - genus = c("Staphylococcus", "Escherichia", "Klebsiella"), - AMC = c(0.00425, 0.13062, 0.10344), - CXM = c(0.00425, 0.05376, 0.10344), - CTX = c(0.00000, 0.02396, 0.05172), - TOB = c(0.02325, 0.02597, 0.10344), - TMP = c(0.08387, 0.39141, 0.18367)), - class = c("grouped_df", "tbl_df", "tbl", "data.frame"), - row.names = c(NA, -3L), - groups = structure(list(order = c("Bacillales", "Enterobacterales"), - .rows = list(1L, 2:3)), - row.names = c(NA, -2L), - class = c("tbl_df", "tbl", "data.frame"), - .drop = TRUE)) - - pca_model <- pca(resistance_data) - - expect_s3_class(pca_model, "pca") - - pdf(NULL) # prevent Rplots.pdf being created - if (suppressWarnings(require("ggplot2"))) { - ggplot_pca(pca_model, ellipse = TRUE) - ggplot_pca(pca_model, arrows_textangled = FALSE) - } - - if (suppressWarnings(require("dplyr"))) { - resistance_data <- example_isolates %>% - group_by(order = mo_order(mo), - genus = mo_genus(mo)) %>% - summarise_if(is.rsi, resistance, minimum = 0) - pca_result <- resistance_data %>% - pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT") - expect_s3_class(pca_result, "prcomp") - if (suppressWarnings(require("ggplot2"))) { - ggplot_pca(pca_result, ellipse = TRUE) - ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE) - } - } -}) diff --git a/tests/testthat/test-proportion.R b/tests/testthat/test-proportion.R deleted file mode 100755 index 5949fa7c..00000000 --- a/tests/testthat/test-proportion.R +++ /dev/null @@ -1,140 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("proportion.R") - -test_that("proportions works", { - - skip_on_cran() - - expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX)) - expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX)) - - # AMX resistance in `example_isolates` - expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001) - expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001) - expect_equal(1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX), - proportion_S(example_isolates$AMX)) - expect_equal(proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX), - proportion_IR(example_isolates$AMX)) - expect_equal(proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX), - proportion_SI(example_isolates$AMX)) - - expect_equal(example_isolates %>% proportion_SI(AMC), - 0.7626397, - tolerance = 0.0001) - expect_equal(example_isolates %>% proportion_SI(AMC, GEN), - 0.9408, - tolerance = 0.0001) - expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE), - 0.9382647, - tolerance = 0.0001) - - if (suppressWarnings(require("dplyr"))) { - # percentages - expect_equal(example_isolates %>% - group_by(hospital_id) %>% - summarise(R = proportion_R(CIP, as_percent = TRUE), - I = proportion_I(CIP, as_percent = TRUE), - S = proportion_S(CIP, as_percent = TRUE), - n = n_rsi(CIP), - total = n()) %>% - pull(n) %>% - sum(), - 1409) - - # count of cases - expect_equal(example_isolates %>% - group_by(hospital_id) %>% - summarise(cipro_p = proportion_SI(CIP, as_percent = TRUE), - cipro_n = n_rsi(CIP), - genta_p = proportion_SI(GEN, as_percent = TRUE), - genta_n = n_rsi(GEN), - combination_p = proportion_SI(CIP, GEN, as_percent = TRUE), - combination_n = n_rsi(CIP, GEN)) %>% - pull(combination_n), - c(305, 617, 241, 711)) - - # proportion_df - expect_equal( - example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value), - c(example_isolates$AMX %>% proportion_SI(), - example_isolates$AMX %>% proportion_R()) - ) - expect_equal( - example_isolates %>% select(AMX) %>% proportion_df(combine_IR = TRUE) %>% pull(value), - c(example_isolates$AMX %>% proportion_S(), - example_isolates$AMX %>% proportion_IR()) - ) - expect_equal( - example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value), - c(example_isolates$AMX %>% proportion_S(), - example_isolates$AMX %>% proportion_I(), - example_isolates$AMX %>% proportion_R()) - ) - } - - reset_all_thrown_messages() - expect_warning(proportion_R(as.character(example_isolates$AMC))) - reset_all_thrown_messages() - expect_warning(proportion_S(as.character(example_isolates$AMC))) - reset_all_thrown_messages() - expect_warning(proportion_S(as.character(example_isolates$AMC, - example_isolates$GEN))) - reset_all_thrown_messages() - expect_warning(n_rsi(as.character(example_isolates$AMC, - example_isolates$GEN))) - expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC, - example_isolates$GEN))), - 1879) - - # check for errors - expect_error(proportion_IR("test", minimum = "test")) - expect_error(proportion_IR("test", as_percent = "test")) - expect_error(proportion_I("test", minimum = "test")) - expect_error(proportion_I("test", as_percent = "test")) - expect_error(proportion_S("test", minimum = "test")) - expect_error(proportion_S("test", as_percent = "test")) - expect_error(proportion_S("test", also_single_tested = TRUE)) - - # check too low amount of isolates - expect_identical(suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), - NA_real_) - expect_identical(suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), - NA_real_) - expect_identical(suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)), - NA_real_) - - # warning for speed loss - reset_all_thrown_messages() - expect_warning(proportion_R(as.character(example_isolates$GEN))) - reset_all_thrown_messages() - expect_warning(proportion_I(as.character(example_isolates$GEN))) - reset_all_thrown_messages() - expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN))) - - expect_error(proportion_df(c("A", "B", "C"))) - expect_error(proportion_df(example_isolates[, "date"])) -}) diff --git a/tests/testthat/test-resistance_predict.R b/tests/testthat/test-resistance_predict.R deleted file mode 100644 index 9b7f751e..00000000 --- a/tests/testthat/test-resistance_predict.R +++ /dev/null @@ -1,102 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("resistance_predict.R") - -test_that("prediction of rsi works", { - skip_on_cran() - - if (suppressWarnings(require("dplyr"))) { - expect_output(AMX_R <- example_isolates %>% - filter(mo == "B_ESCHR_COLI") %>% - rsi_predict(col_ab = "AMX", - col_date = "date", - model = "binomial", - minimum = 10, - info = TRUE) %>% - pull("value")) - # AMX resistance will increase according to data set `example_isolates` - expect_true(AMX_R[3] < AMX_R[20]) - } - - expect_output(x <- suppressMessages(resistance_predict(example_isolates, - col_ab = "AMX", - year_min = 2010, - model = "binomial", - info = TRUE))) - pdf(NULL) # prevent Rplots.pdf being created - expect_silent(plot(x)) - if (suppressWarnings(require("ggplot2"))) { - expect_silent(ggplot_rsi_predict(x)) - expect_silent(ggplot(x)) - expect_error(ggplot_rsi_predict(example_isolates)) - } - - expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "binomial", - col_ab = "AMX", - col_date = "date", - info = TRUE)) - expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "loglin", - col_ab = "AMX", - col_date = "date", - info = TRUE)) - expect_output(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "lin", - col_ab = "AMX", - col_date = "date", - info = TRUE)) - - expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "INVALID MODEL", - col_ab = "AMX", - col_date = "date", - info = TRUE)) - expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "binomial", - col_ab = "NOT EXISTING COLUMN", - col_date = "date", - info = TRUE)) - expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "binomial", - col_ab = "AMX", - col_date = "NOT EXISTING COLUMN", - info = TRUE)) - expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - col_ab = "AMX", - col_date = "NOT EXISTING COLUMN", - info = TRUE)) - expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - col_ab = "AMX", - col_date = "date", - info = TRUE)) - # almost all E. coli are MEM S in the Netherlands :) - expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"), - model = "binomial", - col_ab = "MEM", - col_date = "date", - info = TRUE)) -}) diff --git a/tests/testthat/test-rsi.R b/tests/testthat/test-rsi.R deleted file mode 100644 index d51eaf57..00000000 --- a/tests/testthat/test-rsi.R +++ /dev/null @@ -1,192 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("rsi.R") - -test_that("rsi works", { - - skip_on_cran() - - expect_true(as.rsi("S") < as.rsi("I")) - expect_true(as.rsi("I") < as.rsi("R")) - expect_true(is.rsi(as.rsi("S"))) - - x <- example_isolates$AMX - expect_s3_class(x[1], "rsi") - expect_s3_class(x[[1]], "rsi") - expect_s3_class(c(x[1], x[9]), "rsi") - expect_s3_class(unique(x[1], x[9]), "rsi") - - pdf(NULL) # prevent Rplots.pdf being created - expect_silent(barplot(as.rsi(c("S", "I", "R")))) - expect_silent(plot(as.rsi(c("S", "I", "R")))) - if (suppressWarnings(require("ggplot2"))) expect_s3_class(ggplot(as.rsi(c("S", "I", "R"))), "gg") - expect_output(print(as.rsi(c("S", "I", "R")))) - - expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R")) - - expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA) - - expect_equal(summary(as.rsi(c("S", "R"))), - structure(c("Class" = "rsi", - "%R" = "50.0% (n=1)", - "%SI" = "50.0% (n=1)", - "- %S" = "50.0% (n=1)", - "- %I" = " 0.0% (n=0)"), class = c("summaryDefault", "table"))) - - expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)), - rep(FALSE, length(example_isolates))) - - expect_error(as.rsi.mic(as.mic(16))) - expect_error(as.rsi.disk(as.disk(16))) - - expect_error(get_guideline("this one does not exist")) - - if (suppressWarnings(require("dplyr"))) { - # 40 rsi columns - expect_equal(example_isolates %>% - mutate_at(vars(PEN:RIF), as.character) %>% - lapply(is.rsi.eligible) %>% - as.logical() %>% - sum(), - 40) - expect_equal(sum(is.rsi(example_isolates)), 40) - - expect_output(print(tibble(ab = as.rsi("S")))) - } - - if (suppressWarnings(require("skimr"))) { - expect_s3_class(skim(example_isolates), - "data.frame") - if (suppressWarnings(require("dplyr"))) { - expect_s3_class(example_isolates %>% - mutate(m = as.mic(2), - d = as.disk(20)) %>% - skim(), - "data.frame") - } - } - -}) - -test_that("mic2rsi works", { - - skip_on_cran() - - # S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2) - expect_equal(as.character( - as.rsi(x = as.mic(c(0.125, 0.5, 1, 2, 4)), - mo = "B_STRPT_PNMN", - ab = "AMP", - guideline = "EUCAST 2020")), - c("S", "S", "I", "I", "R")) - # S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8) - expect_equal(as.character( - as.rsi(x = as.mic(c(1, 2, 4, 8, 16)), - mo = "B_STRPT_PNMN", - ab = "AMX", - guideline = "CLSI 2019")), - c("S", "S", "I", "R", "R")) - - # cutoffs at MIC = 8 - expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"), - as.rsi("S")) - expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"), - as.rsi("R")) - - if (suppressWarnings(require("dplyr"))) { - expect_true(suppressWarnings(example_isolates %>% - mutate(amox_mic = as.mic(2)) %>% - select(mo, amox_mic) %>% - as.rsi() %>% - pull(amox_mic) %>% - is.rsi())) - } -}) - -test_that("disk2rsi works", { - - skip_on_cran() - - expect_equal(as.character( - as.rsi(x = as.disk(22), - mo = "B_STRPT_PNMN", - ab = "ERY", - guideline = "CLSI")), - "S") - expect_equal(as.character( - as.rsi(x = as.disk(18), - mo = "B_STRPT_PNMN", - ab = "ERY", - guideline = "CLSI")), - "I") - expect_equal(as.character( - as.rsi(x = as.disk(10), - mo = "B_STRPT_PNMN", - ab = "ERY", - guideline = "CLSI")), - "R") - - if (suppressWarnings(require("dplyr"))) { - expect_true(example_isolates %>% - mutate(amox_disk = as.disk(15)) %>% - select(mo, amox_disk) %>% - as.rsi(guideline = "CLSI") %>% - pull(amox_disk) %>% - is.rsi()) - } - - # frequency tables - if (suppressWarnings(require("cleaner"))) { - expect_s3_class(cleaner::freq(example_isolates$AMX), "freq") - } -}) - -test_that("data.frame2rsi works", { - - skip_on_cran() - - df <- data.frame(microorganism = "Escherichia coli", - AMP = as.mic(8), - CIP = as.mic(0.256), - GEN = as.disk(18), - TOB = as.disk(16), - ERY = "R", # note about assigning class - CLR = "V") # note about cleaning - expect_s3_class(suppressWarnings(as.rsi(df)), - "data.frame") - - expect_s3_class(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli", - amoxi = c("R", "S", "I", "invalid")))$amoxi), - "rsi") - expect_warning(as.rsi(data.frame(mo = "E. coli", - NIT = c("<= 2", 32)))) - expect_message(as.rsi(data.frame(mo = "E. coli", - NIT = c("<= 2", 32), - uti = TRUE))) - expect_message(as.rsi(data.frame(mo = "E. coli", - NIT = c("<= 2", 32), - specimen = c("urine", "blood")))) -}) diff --git a/tests/testthat/test-zzz.R b/tests/testthat/test-zzz.R deleted file mode 100644 index 3891d353..00000000 --- a/tests/testthat/test-zzz.R +++ /dev/null @@ -1,117 +0,0 @@ -# ==================================================================== # -# TITLE # -# Antimicrobial Resistance (AMR) Data Analysis for R # -# # -# SOURCE # -# https://github.com/msberends/AMR # -# # -# LICENCE # -# (c) 2018-2021 Berends MS, Luz CF et al. # -# Developed at the University of Groningen, the Netherlands, in # -# collaboration with non-profit organisations Certe Medical # -# Diagnostics & Advice, and University Medical Center Groningen. # -# # -# This R package is free software; you can freely use and distribute # -# it for both personal and commercial purposes under the terms of the # -# GNU General Public License version 2.0 (GNU GPL-2), as published by # -# the Free Software Foundation. # -# We created this package for both routine data analysis and academic # -# research and it was publicly released in the hope that it will be # -# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # -# # -# Visit our website for the full manual and a complete tutorial about # -# how to conduct AMR data analysis: https://msberends.github.io/AMR/ # -# ==================================================================== # - -context("zzz.R") - -test_that("imports work", { - skip_on_cran() - - # Check if these function still exist in the package (all are in Suggests field) - # Since GitHub Action runs every night, we will get emailed when a dependency fails based on this unit test - - # functions used by import_fn() - import_functions <- c( - "anti_join" = "dplyr", - "cur_column" = "dplyr", - "full_join" = "dplyr", - "has_internet" = "curl", - "html_attr" = "rvest", - "html_children" = "rvest", - "html_node" = "rvest", - "html_nodes" = "rvest", - "html_table" = "rvest", - "html_text" = "rvest", - "inner_join" = "dplyr", - "insertText" = "rstudioapi", - "left_join" = "dplyr", - "new_pillar_shaft_simple" = "pillar", - "read_html" = "xml2", - "right_join" = "dplyr", - "semi_join" = "dplyr", - "showQuestion" = "rstudioapi") - - # functions that are called directly - call_functions <- c( - # cleaner - "freq.default" = "cleaner", - # skimr - "inline_hist" = "skimr", - "sfl" = "skimr", - # set_mo_source - "read_excel" = "readxl", - # ggplot_rsi - "aes_string" = "ggplot2", - "element_blank" = "ggplot2", - "element_line" = "ggplot2", - "element_text" = "ggplot2", - "facet_wrap" = "ggplot2", - "geom_text" = "ggplot2", - "ggplot" = "ggplot2", - "labs" = "ggplot2", - "layer" = "ggplot2", - "position_fill" = "ggplot2", - "scale_fill_manual" = "ggplot2", - "scale_y_continuous" = "ggplot2", - "theme" = "ggplot2", - "theme_minimal" = "ggplot2", - # ggplot_pca - "aes" = "ggplot2", - "arrow" = "ggplot2", - "element_blank" = "ggplot2", - "element_line" = "ggplot2", - "element_text" = "ggplot2", - "expand_limits" = "ggplot2", - "geom_path" = "ggplot2", - "geom_point" = "ggplot2", - "geom_segment" = "ggplot2", - "geom_text" = "ggplot2", - "ggplot" = "ggplot2", - "labs" = "ggplot2", - "theme" = "ggplot2", - "theme_minimal" = "ggplot2", - "unit" = "ggplot2", - "xlab" = "ggplot2", - "ylab" = "ggplot2", - # resistance_predict - "aes" = "ggplot2", - "geom_errorbar" = "ggplot2", - "geom_point" = "ggplot2", - "geom_ribbon" = "ggplot2", - "ggplot" = "ggplot2", - "labs" = "ggplot2" - ) - - import_functions <- c(import_functions, call_functions) - - for (i in seq_len(length(import_functions))) { - fn <- names(import_functions)[i] - pkg <- unname(import_functions[i]) - # function should exist in foreign pkg namespace - if (pkg %in% rownames(installed.packages())) { - expect(!is.null(import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)), - failure_message = paste0("Function ", pkg, "::", fn, "() does not exist anymore")) - } - } -}) diff --git a/tests/testthat.R b/tests/tinytest.R old mode 100755 new mode 100644 similarity index 76% rename from tests/testthat.R rename to tests/tinytest.R index 42c8134b..e4cd572b --- a/tests/testthat.R +++ b/tests/tinytest.R @@ -23,14 +23,9 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # -# the testthat package is in Suggests, but very old R versions will not be -# able to install it. Yet, we want basic R CMD CHECK's in those R versions -# as well, so only run unit tests in later R versions: -if (require("testthat", warn.conflicts = FALSE)) { +# test only on GitHub Actions and at home - not on CRAN as tests are lengthy +if (identical(Sys.getenv("R_TINYTEST"), "true")) { + library(tinytest) library(AMR) - # print non-base packages - print(as.data.frame(utils::installed.packages())[which(is.na(as.data.frame(utils::installed.packages())$Priority)), - "Version", - drop = FALSE]) - test_check("AMR") + test_package("AMR") }