mirror of
https://github.com/msberends/AMR.git
synced 2026-11-15 22:20:47 +01:00
(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
This commit is contained in:
dr. M.S. (Matthijs) Berends committed
1 parent
4be7352843
commit
8b01bcb23c
16 files changed
+360
-38
No files matched your search
@@ -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)
|
||||
Executable
+51
@@ -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 <script.R>
|
||||
# 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
|
||||
@@ -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)
|
||||
@@ -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")'
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+1
-1
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
+18
-9
@@ -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
|
||||
}
|
||||
|
||||
@@ -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"
|
||||
|
||||
@@ -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())))
|
||||
}
|
||||
})
|
||||
@@ -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"))
|
||||
}
|
||||
|
||||
+12
-11
@@ -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(
|
||||
|
||||
@@ -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(
|
||||
|
||||
@@ -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)
|
||||
})
|
||||
@@ -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`
|
||||
|
||||
Reference in new issue
Block a user