diff --git a/.github/workflows/check.yaml b/.github/workflows/check.yaml index 29053e107..4d44a918d 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 85711e997..a4650e8f3 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 465c8846e..2f7682044 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 c6468c07b..80fa16f5f 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 000000000..b1aa9ac79 --- /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 33f02b6ce..6f3df78c5 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 425aa90d5..e5c16bd8e 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 1ae9f88ab..751188202 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 a726d9f28..b79679965 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 8ea1630fe..33a014f12 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 5f95edd08..7c5e9c4fc 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 f0c65a8b8..bfcafffb2 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 0996b8d73..04e8ee427 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 f52d7b9b6..bb803e310 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 000000000..80c01cce1 --- /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 5561429ef..af898a51f 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 9e0512b22..effe6b8d1 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 d8c22e892..56327f578 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 be465b595..aaed893b7 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 000000000..dd3f255b5 --- /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 dfc1c70bc..114ef28ac 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 f014c0bf6..bd390e1aa 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 171da6fd1..79a97f06a 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 80b838869..50ae048c3 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 000000000..38cbcd934 --- /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 000000000..76be35111 --- /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 15bb359dd..5187bd7c9 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 637683e84..618963f54 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 000000000..014f073ff --- /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 000000000..1476933da --- /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 000000000..fa5918370 --- /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 2a5910e43..aed6f20a9 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 e4f6848ff..758e83a59 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 000000000..b328ce129 --- /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 000000000..afd1f3562 --- /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 859e84faf..5d88a775f 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 c7005393f..c79aed5f5 --- 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 000000000..fc648956b --- /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 ebcf728dd..e2d0419fc 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 938eef210..cf3f7e738 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 000000000..38644726a --- /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 000000000..acefa5e0d --- /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 000000000..fedb479d0 --- /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 000000000..ece3e6bc6 --- /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 000000000..d08680949 --- /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 000000000..6de6476de --- /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 4bbf4ceb1..505beb6f6 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 000000000..a19584f20 --- /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 000000000..afcac5595 --- /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 0de833354..1ba333dab 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 000000000..5fa85f894 --- /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 eeaff7bf1..000000000 --- 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 a02ff5dac..000000000 --- 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 554da93ff..000000000 --- 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 659cbafe1..000000000 --- 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 fd988c4e0..000000000 --- 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 9c4c02243..000000000 --- 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 55c42202a..000000000 --- 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 94f55e436..000000000 --- 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 9b673eec1..000000000 --- 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 67be05b49..000000000 --- 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 51698e293..000000000 --- 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 2144a4d44..000000000 --- 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 c1e8a144f..000000000 --- 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 29c61533e..000000000 --- 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 0475165ec..000000000 --- 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 5949fa7cd..000000000 --- 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 9b7f751e2..000000000 --- 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 d51eaf576..000000000 --- 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 3891d3537..000000000 --- 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 42c8134b7..e4cd572bb --- 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") }