From 8b01bcb23c7e21097ae721266009ee21ef1a9daa Mon Sep 17 00:00:00 2001 From: Matthijs Berends Date: Wed, 14 Oct 2026 23:34:45 +0200 Subject: [PATCH] (v3.0.1.9135) Fix get_mo_source() removing the mo_source file at the default location, returning the wrong mo_source, and throwing an error after the original file was moved, and run the unit tests in CI also in a real interactive session and with a user setup, a Dutch locale, and CLSI as default guideline, with tests that no longer assume an English locale or EUCAST --- .github/scripts/run_tests.R | 50 +++++++++++ .github/scripts/run_tests.sh | 51 +++++++++++ .github/scripts/setup_test_scenario.R | 67 ++++++++++++++ .github/workflows/check-current-testthat.yaml | 34 ++++++- .github/workflows/check-without-dplyr.yaml | 5 ++ .github/workflows/codecovr.yaml | 5 ++ DESCRIPTION | 2 +- NEWS.md | 7 +- R/mo_source.R | 27 ++++-- tests/testthat/test-ab_from_text.R | 3 + tests/testthat/test-ab_property.R | 4 +- tests/testthat/test-antibiogram.R | 24 +++-- tests/testthat/test-count.R | 23 ++--- tests/testthat/test-interpretive_rules.R | 3 + tests/testthat/test-mo_source.R | 88 +++++++++++++++++++ tests/testthat/test-proportion.R | 5 +- 16 files changed, 360 insertions(+), 38 deletions(-) create mode 100644 .github/scripts/run_tests.R create mode 100755 .github/scripts/run_tests.sh create mode 100644 .github/scripts/setup_test_scenario.R create mode 100644 tests/testthat/test-mo_source.R diff --git a/.github/scripts/run_tests.R b/.github/scripts/run_tests.R new file mode 100644 index 000000000..f0b100bad --- /dev/null +++ b/.github/scripts/run_tests.R @@ -0,0 +1,50 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# 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://amr-for-r.org # +# ==================================================================== # + +# Runs all unit tests from source, see run_tests.sh. Quits with status 1 on any failure or error, and with status 2 if the tests could not be run at all. +# Every top-level error must end in quit(), since an interactive session would otherwise continue reading "1" from stdin. + +status <- tryCatch( + { + if (identical(Sys.getenv("AMR_TEST_INTERACTIVE"), "true") && !interactive()) { + stop("AMR_TEST_INTERACTIVE is set, but this R session is not interactive") + } + cat("Interactive:", interactive(), "| LANG:", Sys.getenv("LANG"), "| AMR options:", paste(names(options())[grepl("^AMR_", names(options()))], collapse = ", "), "\n") + # report all failures, not only the first 10 + options(warn = 1, testthat.summary.max_reports = Inf, testthat.progress.max_fails = Inf) + res <- as.data.frame(testthat::test_local(Sys.getenv("AMR_TEST_PKG_DIR", "."), reporter = "summary", stop_on_failure = FALSE)) + cat("\nFiles:", length(unique(res$file)), "| failed:", sum(res$failed), "| errors:", sum(res$error), "| skipped:", sum(res$skipped), "| passed:", sum(res$passed), "\n") + as.integer(sum(res$failed) > 0 || any(res$error)) + }, + error = function(e) { + cat("Tests could not be run:", conditionMessage(e), "\n") + 2L + } +) +quit(save = "no", status = status) diff --git a/.github/scripts/run_tests.sh b/.github/scripts/run_tests.sh new file mode 100755 index 000000000..ec3d10e9f --- /dev/null +++ b/.github/scripts/run_tests.sh @@ -0,0 +1,51 @@ +#!/bin/bash +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# 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://amr-for-r.org # +# ==================================================================== # + +# Runs an R script, in a real interactive R session if AMR_TEST_INTERACTIVE is "true", and exits with its status. +# Usage: run_tests.sh +# R CMD check and Rscript are never interactive, so code behind interactive() is otherwise never run in CI. +# In an interactive session, R reads both its commands and the answers to prompts from stdin, and it ignores -f. Therefore stdin holds one source() line, followed by an endless stream of "1", which means 'proceed' in every utils::menu() prompt of this package. +# A timeout prevents an unanswerable prompt from hanging the job. + +set +e +o pipefail +script="$(cd "$(dirname "$1")" && pwd)/$(basename "$1")" + +if [ "$AMR_TEST_INTERACTIVE" = "true" ]; then + { echo "source('$script')"; yes 1; } | timeout 3600 R --interactive --no-save --quiet + status=${PIPESTATUS[1]} +else + timeout 3600 Rscript "$script" + status=$? +fi + +if [ "$status" = "124" ]; then + echo "Timed out, possibly on a prompt that could not be answered" +fi +exit $status diff --git a/.github/scripts/setup_test_scenario.R b/.github/scripts/setup_test_scenario.R new file mode 100644 index 000000000..aa4f84fa9 --- /dev/null +++ b/.github/scripts/setup_test_scenario.R @@ -0,0 +1,67 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# 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://amr-for-r.org # +# ==================================================================== # + +# Sets up the user environment of a test scenario in the home directory, before run_tests.sh runs the tests. Run it through run_tests.sh with AMR_TEST_INTERACTIVE=true, since set_mo_source() only works in interactive sessions. +# AMR_TEST_SCENARIO can contain one or more of these words, separated by a comma: +# - "user": an existing ~/mo_source.rds, and the options AMR_custom_ab and AMR_custom_mo set to RDS files +# - "clsi": the option AMR_guideline set to "CLSI" +# The options are written to ~/.Rprofile, so that they are set at start-up as with users. + +status <- tryCatch( + { + stopifnot(interactive()) + scenarios <- trimws(strsplit(Sys.getenv("AMR_TEST_SCENARIO"), ",")[[1]]) + stopifnot(length(scenarios) > 0, all(scenarios %in% c("user", "clsi"))) + pkgload::load_all(Sys.getenv("AMR_TEST_PKG_DIR", "."), quiet = TRUE) + opts <- character(0) + if ("user" %in% scenarios) { + dir.create("~/amr_fixtures", showWarnings = FALSE) + write.csv(data.frame(lab_code = c("AMRTEST_ECOLI", "AMRTEST_SAUR"), mo = c("B_ESCHR_COLI", "B_STPHY_AURS")), "~/amr_fixtures/mo_source.csv", row.names = FALSE) + set_mo_source("~/amr_fixtures/mo_source.csv") + stopifnot(file.exists("~/mo_source.rds")) + saveRDS(data.frame(ab = "AMRTST", name = "Amrtestacillin", group = "Test antimicrobials"), "~/amr_fixtures/custom_ab.rds") + saveRDS(data.frame(genus = "Amrtestbacterium", species = "scenarii"), "~/amr_fixtures/custom_mo.rds") + opts <- c(opts, paste0("AMR_custom_ab = '", path.expand("~/amr_fixtures/custom_ab.rds"), "'"), paste0("AMR_custom_mo = '", path.expand("~/amr_fixtures/custom_mo.rds"), "'")) + } + if ("clsi" %in% scenarios) { + opts <- c(opts, "AMR_guideline = 'CLSI'") + } + if (length(opts) > 0) { + write(paste0("options(", paste(opts, collapse = ", "), ")"), "~/.Rprofile", append = TRUE) + } + cat("Scenario set up:", paste(scenarios, collapse = ", "), "\n") + if (file.exists("~/.Rprofile")) cat(readLines("~/.Rprofile"), sep = "\n") + 0L + }, + error = function(e) { + cat("Scenario could not be set up:", conditionMessage(e), "\n") + 2L + } +) +quit(save = "no", status = status) diff --git a/.github/workflows/check-current-testthat.yaml b/.github/workflows/check-current-testthat.yaml index 04b9568d5..def2645b9 100644 --- a/.github/workflows/check-current-testthat.yaml +++ b/.github/workflows/check-current-testthat.yaml @@ -41,6 +41,11 @@ on: name: check-recent +# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push +concurrency: + group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: setup: runs-on: ubuntu-latest @@ -49,11 +54,15 @@ jobs: steps: - id: set-matrix shell: bash + # entries with "tests": true do not run R CMD check, but run the unit tests from source with .github/scripts/run_tests.sh, optionally: + # - "interactive": true, in a real interactive R session, so that code behind interactive() is also tested + # - "scenario", the user environment set up with .github/scripts/setup_test_scenario.R + # - "lang", the LANG environment variable run: | if [ "${{ github.event_name }}" = "pull_request" ]; then - echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","allowfail":false}]}' >> "$GITHUB_OUTPUT" + echo 'matrix={"config":[{"os":"ubuntu-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive","interactive":true}]}' >> "$GITHUB_OUTPUT" else - echo 'matrix={"config":[{"os":"windows-latest","r":"devel","allowfail":false},{"os":"ubuntu-latest","r":"devel","allowfail":false,"http-user-agent":"release"},{"os":"macOS-latest","r":"release","allowfail":true},{"os":"windows-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-1","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-2","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-3","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-4","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-5","allowfail":false}]}' >> "$GITHUB_OUTPUT" + echo 'matrix={"config":[{"os":"windows-latest","r":"devel","allowfail":false},{"os":"ubuntu-latest","r":"devel","allowfail":false,"http-user-agent":"release"},{"os":"macOS-latest","r":"release","allowfail":true},{"os":"windows-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-1","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-2","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-3","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-4","allowfail":false},{"os":"ubuntu-latest","r":"oldrel-5","allowfail":false},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive","interactive":true},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"interactive, user setup","interactive":true,"scenario":"user"},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"Dutch locale","lang":"nl_NL.UTF-8"},{"os":"ubuntu-latest","r":"release","allowfail":false,"tests":true,"label":"CLSI as default guideline","scenario":"clsi"}]}' >> "$GITHUB_OUTPUT" fi R-code-check: @@ -62,7 +71,7 @@ jobs: continue-on-error: ${{ matrix.config.allowfail }} - name: ${{ matrix.config.os }} (R-${{ matrix.config.r }}) + name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})${{ matrix.config.label && format(' {0}', matrix.config.label) || '' }} strategy: fail-fast: false @@ -71,6 +80,8 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes + AMR_TEST_INTERACTIVE: ${{ matrix.config.interactive && 'true' || 'false' }} + AMR_TEST_SCENARIO: ${{ matrix.config.scenario || '' }} steps: - uses: actions/checkout@v4 @@ -86,11 +97,26 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck + extra-packages: ${{ matrix.config.tests && 'any::pkgload' || 'any::rcmdcheck' }} needs: check upgrade: 'TRUE' + - name: Set LANG + if: matrix.config.lang + run: echo "LANG=${{ matrix.config.lang }}" >> "$GITHUB_ENV" + + - name: Set up scenario '${{ matrix.config.scenario }}' + if: matrix.config.scenario + run: AMR_TEST_INTERACTIVE=true .github/scripts/run_tests.sh .github/scripts/setup_test_scenario.R + + - name: Run unit tests + if: matrix.config.tests + env: + NOT_CRAN: true + run: .github/scripts/run_tests.sh .github/scripts/run_tests.R + - uses: r-lib/actions/check-r-package@v2 + if: ${{ !matrix.config.tests }} with: upload-snapshots: true build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/.github/workflows/check-without-dplyr.yaml b/.github/workflows/check-without-dplyr.yaml index 4af3a4e44..5ff02ac93 100644 --- a/.github/workflows/check-without-dplyr.yaml +++ b/.github/workflows/check-without-dplyr.yaml @@ -43,6 +43,11 @@ on: name: check-without-dplyr +# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push +concurrency: + group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: setup: runs-on: ubuntu-latest diff --git a/.github/workflows/codecovr.yaml b/.github/workflows/codecovr.yaml index ae94b20fd..0f8864da4 100644 --- a/.github/workflows/codecovr.yaml +++ b/.github/workflows/codecovr.yaml @@ -37,6 +37,11 @@ on: name: code-coverage +# a new commit cancels the runs of the previous commit on the same PR or branch, a scheduled run is never cancelled by a push +concurrency: + group: ${{ github.workflow }}-${{ github.event_name }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: code-coverage: runs-on: ubuntu-latest diff --git a/DESCRIPTION b/DESCRIPTION index d255140fb..8a53dce68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 3.0.1.9134 +Version: 3.0.1.9135 Date: 2026-10-14 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index 543ca58f6..fcc08d931 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9134 +# AMR 3.0.1.9135 Planned as v3.1.0, mid October 2026. @@ -84,6 +84,11 @@ Planned as v3.1.0, mid October 2026. * *Salmonella* serovars written with the species, such as `"Salmonella enterica serovar Typhi"`, no longer return *Salmonella bongori* or another subspecies * `as.mo()` and `mo_current()` now find the current name of synonyms with multiple sources (e.g., *Chaetomium abuense*) * `mo_taxonomy()` and `mo_info()` now contain an extra element `domain` +* Own microorganism codes (`set_mo_source()` and `get_mo_source()`) + * Fixed `get_mo_source()` removing the `mo_source` file at the default location in interactive sessions, when called with a `destination` that does not exist + * Fixed `get_mo_source()` returning the `mo_source` already loaded instead of the one at the requested `destination` + * Fixed `get_mo_source()`, and therefore `as.mo()` and all `mo_*()` functions, throwing an error in interactive sessions after the original file of the `mo_source` was moved or deleted. The `mo_source` file is now removed, as documented. + * An updated original file now updates the `mo_source` file at its own `destination` instead of at the default location * `microorganisms` data set * Taxonomic update of all microorganisms, now based on COL 2026-04-18 XR, LPSN and BacDive of October 2026, and MycoBank of January 2026 * Names listed twice by a source now take the correct record (e.g., *Eggerthella lenta*, *Gordonia amarae*, and *Anisakis simplex* were synonyms without a current name) diff --git a/R/mo_source.R b/R/mo_source.R index b66579997..63f888360 100755 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -245,9 +245,9 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s #' @export get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.rds")) { if (!file.exists(path.expand(destination))) { - if (interactive()) { - # source file might have been deleted, so update reference - set_mo_source("") + if (interactive() && identical(attributes(AMR_env$mo_source)$mo_source_destination, path.expand(destination))) { + # the mo_source file in use was deleted, so remove the reference to it; this must only concern this destination, so that no other mo_source file is removed + set_mo_source("", destination = destination) } return(NULL) } @@ -257,15 +257,24 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source. vowel <- ifelse(current_ext %like% "^[AEFHILMNORSX]", "n", "") stop_("The AMR mo source must be an RDS file, not a", vowel, " ", toupper(current_ext), " file. If \"", basename(destination), "\" was meant as your input file, use {.help [{.fun set_mo_source}](AMR::set_mo_source)} on this file. In any case, the option {.code AMR_mo_source} must be set to another path.") } - if (is.null(AMR_env$mo_source)) { + if (is.null(AMR_env$mo_source) || !identical(attributes(AMR_env$mo_source)$mo_source_destination, path.expand(destination))) { + # not loaded yet, or loaded from another destination AMR_env$mo_source <- readRDS_AMR(path.expand(destination)) + # files created before AMR 1.5.0 lack this attribute + attr(AMR_env$mo_source, "mo_source_destination") <- path.expand(destination) } - old_time <- attributes(AMR_env$mo_source)$mo_source_timestamp - new_time <- file.mtime(attributes(AMR_env$mo_source)$mo_source_location) - if (interactive() && !identical(old_time, new_time)) { - # source file was updated, also update reference - set_mo_source(attributes(AMR_env$mo_source)$mo_source_location) + source_location <- attributes(AMR_env$mo_source)$mo_source_location + if (interactive() && !is.null(source_location)) { + if (!file.exists(source_location)) { + # the original file was moved or deleted, so remove the mo_source file as documented + set_mo_source("", destination = destination) + return(NULL) + } + if (!identical(attributes(AMR_env$mo_source)$mo_source_timestamp, file.mtime(source_location))) { + # the original file was updated, so update the mo_source file at this destination too + set_mo_source(source_location, destination = destination) + } } AMR_env$mo_source } diff --git a/tests/testthat/test-ab_from_text.R b/tests/testthat/test-ab_from_text.R index 4a8daec63..c88293201 100644 --- a/tests/testthat/test-ab_from_text.R +++ b/tests/testthat/test-ab_from_text.R @@ -44,10 +44,13 @@ test_that("test-ab_from_text.R", { ab_from_text("28/03/2020 amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]], as.ab("Amoxicillin") ) + # translated names are in the language of the system, and are tested here in English + old_opts <- options(AMR_locale = "en") expect_identical( ab_from_text("28/03/2020 amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]], "Amoxicillin" ) + options(old_opts) expect_identical( ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]], "AMC, CIP" diff --git a/tests/testthat/test-ab_property.R b/tests/testthat/test-ab_property.R index 5f3bcf666..b58fe8db0 100644 --- a/tests/testthat/test-ab_property.R +++ b/tests/testthat/test-ab_property.R @@ -75,7 +75,7 @@ test_that("test-ab_property.R", { expect_true(ab_url("AMX") %like% "fhi[.]no") expect_identical( - colnames(set_ab_names(example_isolates[, 17:22])), + colnames(set_ab_names(example_isolates[, 17:22], language = "en")), c("cefoxitin", "cefotaxime", "ceftazidime", "ceftriaxone", "gentamicin", "tobramycin") ) expect_identical( @@ -97,7 +97,7 @@ test_that("test-ab_property.R", { "moxifloxacin", "vancomycin", "TEC" ) %in% (example_isolates %>% - set_ab_names(NIT:VAN) %>% + set_ab_names(NIT:VAN, language = "en") %>% colnames()))) } }) diff --git a/tests/testthat/test-antibiogram.R b/tests/testthat/test-antibiogram.R index 6f36ce2db..9c61aa5c2 100644 --- a/tests/testthat/test-antibiogram.R +++ b/tests/testthat/test-antibiogram.R @@ -35,21 +35,25 @@ test_that("test-antibiogram.R", { ab0 <- antibiogram(example_isolates) + # the column names of ab1 to ab6 and ab8 to ab9 are tested in English, which must also hold on systems in another language ab1 <- antibiogram(example_isolates, - antimicrobials = c(aminoglycosides(), carbapenems()) + antimicrobials = c(aminoglycosides(), carbapenems()), + language = "en" ) ab2 <- antibiogram(example_isolates, antimicrobials = aminoglycosides(), ab_transform = "atc", - mo_transform = "gramstain" + mo_transform = "gramstain", + language = "en" ) ab3 <- antibiogram(example_isolates, antimicrobials = carbapenems(), ab_transform = "ab", mo_transform = "name", - formatting_type = 1 + formatting_type = 1, + language = "en" ) expect_inherits(ab1, "antibiogram") @@ -65,7 +69,8 @@ test_that("test-antibiogram.R", { # combined antibiogram yield higher empiric coverage ab4 <- antibiogram(example_isolates, antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"), - mo_transform = "gramstain" + mo_transform = "gramstain", + language = "en" ) ab5 <- antibiogram(example_isolates, @@ -73,7 +78,8 @@ test_that("test-antibiogram.R", { mo_transform = "gramstain", ab_transform = "name", sep = " & ", - add_total_n = FALSE + add_total_n = FALSE, + language = "en" ) expect_inherits(ab4, "antibiogram") @@ -87,7 +93,8 @@ test_that("test-antibiogram.R", { ab6 <- antibiogram(example_isolates, antimicrobials = c(aminoglycosides(), carbapenems()), syndromic_group = "ward", - ab_transform = NULL + ab_transform = NULL, + language = "en" ) # with a custom language, though this will be determined automatically @@ -112,7 +119,8 @@ test_that("test-antibiogram.R", { # the data set could contain a filter for e.g. respiratory specimens ab8 <- suppressWarnings(antibiogram(example_isolates, antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"), - wisca = TRUE + wisca = TRUE, + language = "en" )) expect_inherits(ab8, "antibiogram") @@ -125,7 +133,7 @@ test_that("test-antibiogram.R", { expect_warning( ab9 <- example_isolates %>% group_by(ward, gender) %>% - wisca(antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN")) + wisca(antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"), language = "en") ) expect_equal(colnames(ab9), c("ward", "gender", "Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin")) } diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index a39483386..2a41d9195 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -30,8 +30,9 @@ test_that("test-count.R", { skip_on_cran() - expect_equal(count_R(example_isolates$AMX), count_resistant(example_isolates$AMX)) - expect_equal(count_SI(example_isolates$AMX), count_susceptible(example_isolates$AMX)) + # the counts in this file are based on EUCAST, which must also hold when another guideline is set with the AMR_guideline option + expect_equal(count_R(example_isolates$AMX), count_resistant(example_isolates$AMX, guideline = "EUCAST")) + expect_equal(count_SI(example_isolates$AMX), count_susceptible(example_isolates$AMX, guideline = "EUCAST")) expect_equal(count_IR(example_isolates$AMX), count_resistant(example_isolates$AMX, guideline = "CLSI")) expect_equal(count_S(example_isolates$AMX), count_susceptible(example_isolates$AMX, guideline = "CLSI")) expect_equal(count_all(example_isolates$AMX), n_sir(example_isolates$AMX)) @@ -64,9 +65,9 @@ test_that("test-count.R", { expect_error(count_df(example_isolates[, "date", drop = TRUE])) if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) { - 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_susceptible(AMC, guideline = "EUCAST"), 1433) + expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE, guideline = "EUCAST"), 1687) + expect_equal(example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = FALSE, guideline = "EUCAST"), 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( @@ -80,20 +81,20 @@ test_that("test-count.R", { example_isolates %>% group_by(ward) %>% summarise( - cipro = count_susceptible(CIP), - genta = count_susceptible(GEN), - combination = count_susceptible(CIP, GEN) + cipro = count_susceptible(CIP, guideline = "EUCAST"), + genta = count_susceptible(GEN, guideline = "EUCAST"), + combination = count_susceptible(CIP, GEN, guideline = "EUCAST") ) %>% pull(combination), c(946, 428, 94) ) - # count_df + # count_df, which always combines S and I, as with EUCAST expect_equal( example_isolates %>% select(AMX) %>% count_df() %>% pull(value), c( - example_isolates$AMX %>% count_susceptible(), - example_isolates$AMX %>% count_resistant() + example_isolates$AMX %>% count_susceptible(guideline = "EUCAST"), + example_isolates$AMX %>% count_resistant(guideline = "EUCAST") ) ) expect_equal( diff --git a/tests/testthat/test-interpretive_rules.R b/tests/testthat/test-interpretive_rules.R index 070782ed0..241afdfff 100755 --- a/tests/testthat/test-interpretive_rules.R +++ b/tests/testthat/test-interpretive_rules.R @@ -29,6 +29,9 @@ test_that("test-interpretive_rules.R", { skip_on_cran() + # these tests are based on EUCAST rules, which must also hold when another guideline is set with the AMR_guideline option + old_opts <- options(AMR_guideline = "EUCAST") + on.exit(options(old_opts), add = TRUE) # thoroughly check input table expect_equal( diff --git a/tests/testthat/test-mo_source.R b/tests/testthat/test-mo_source.R new file mode 100644 index 000000000..947d381f4 --- /dev/null +++ b/tests/testthat/test-mo_source.R @@ -0,0 +1,88 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# 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://amr-for-r.org # +# ==================================================================== # + +test_that("test-mo_source.R", { + # set_mo_source() and the interactive branches of get_mo_source() only work in interactive sessions, see .github/scripts/run_tests.sh + skip_if_not(interactive()) + skip_on_cran() + + dir <- tempfile("mo_source_test") + dir.create(dir) + src_a <- file.path(dir, "source_a.csv") + src_b <- file.path(dir, "source_b.csv") + dest_a <- file.path(dir, "dest_a.rds") + dest_b <- file.path(dir, "dest_b.rds") + write.csv(data.frame(lab_code = "TESTCODE_A", mo = "B_ESCHR_COLI"), src_a, row.names = FALSE) + write.csv(data.frame(lab_code = "TESTCODE_B", mo = "B_STPHY_AURS"), src_b, row.names = FALSE) + # existing destination files are updated without asking for permission, so these tests never prompt + saveRDS(NULL, dest_a) + saveRDS(NULL, dest_b) + amr_env <- AMR:::AMR_env + mo_source_bak <- amr_env$mo_source + on.exit(amr_env$mo_source <- mo_source_bak, add = TRUE) + + suppressMessages(set_mo_source(src_b, destination = dest_b)) + suppressMessages(set_mo_source(src_a, destination = dest_a)) + expect_identical(get_mo_source(destination = dest_a)$lab_code, "TESTCODE_A") + # another destination returns its own mo_source, not the one already loaded + expect_identical(get_mo_source(destination = dest_b)$lab_code, "TESTCODE_B") + expect_identical(as.character(as.mo("TESTCODE_B", reference_df = get_mo_source(destination = dest_b), info = FALSE)), "B_STPHY_AURS") + + # a destination that does not exist removes no other mo_source file, nor the loaded mo_source or the cache + suppressMessages(get_mo_source(destination = dest_a)) + suppressWarnings(as.mo("Klebsiela pneumonia", info = FALSE)) + # as.mo() uses the mo_source at the default destination, which can exist on the system that runs these tests + loaded_destination <- attributes(amr_env$mo_source)$mo_source_destination + n_cached <- NROW(amr_env$mo_previously_coerced) + expect_null(get_mo_source(destination = file.path(dir, "does_not_exist.rds"))) + expect_true(file.exists(dest_a)) + expect_true(file.exists(dest_b)) + expect_identical(attributes(amr_env$mo_source)$mo_source_destination, loaded_destination) + expect_identical(NROW(amr_env$mo_previously_coerced), n_cached) + + # an updated original file updates the mo_source file at the same destination + write.csv(data.frame(lab_code = "TESTCODE_A2", mo = "B_ESCHR_COLI"), src_a, row.names = FALSE) + Sys.setFileTime(src_a, Sys.time() + 60) + expect_identical(suppressMessages(get_mo_source(destination = dest_a))$lab_code, "TESTCODE_A2") + expect_true(file.exists(dest_b)) + + # a deleted mo_source file removes the reference to it + unlink(dest_a) + expect_null(get_mo_source(destination = dest_a)) + expect_null(amr_env$mo_source) + expect_true(file.exists(dest_b)) + + # a moved or deleted original file removes the mo_source file, as documented, without an error + suppressMessages(get_mo_source(destination = dest_b)) + unlink(src_b) + expect_null(suppressMessages(get_mo_source(destination = dest_b))) + expect_false(file.exists(dest_b)) + + unlink(dir, recursive = TRUE) +}) diff --git a/tests/testthat/test-proportion.R b/tests/testthat/test-proportion.R index c7bdeaa2a..20f831d48 100755 --- a/tests/testthat/test-proportion.R +++ b/tests/testthat/test-proportion.R @@ -30,8 +30,9 @@ test_that("test-proportion.R", { 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)) + # with EUCAST, which must also hold when another guideline is set with the AMR_guideline option + expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX, guideline = "EUCAST")) + expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX, guideline = "EUCAST")) expect_equal(proportion_IR(example_isolates$AMX), resistance(example_isolates$AMX, guideline = "CLSI")) expect_equal(proportion_S(example_isolates$AMX), susceptibility(example_isolates$AMX, guideline = "CLSI")) # AMX resistance in `example_isolates`