mirror of
https://github.com/msberends/AMR.git
synced 2026-11-16 00:10:57 +01:00
dr. M.S. (Matthijs) Berends
361dfc28f7
The Vibrio sheet (v12.0 to v16.1) states: "Breakpoints are valid for V. alginolyticus, V. cholerae, V. fluvialis, V. parahaemolyticus and V. vulnificus." The rows of the genus are therefore replaced by rows of these species, with the statement in the note. Other species and isolates identified at genus level give NA, or use PK/PD breakpoints in EUCAST 2022-2023. CLSI is unchanged. Any other wording of "breakpoints are valid for" now stops the script, so that a new statement cannot be missed.
941 lines
45 KiB
R
941 lines
45 KiB
R
# ==================================================================== #
|
|
# 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-sir.R", {
|
|
skip_on_cran()
|
|
|
|
# Existing SIR ----------------------------------------------------------
|
|
|
|
# we must only have EUCAST and CLSI, because otherwise the rules in as.sir() will fail
|
|
expect_identical(
|
|
unique(gsub("[^A-Z]", "", AMR::clinical_breakpoints$guideline)),
|
|
c("EUCAST", "CLSI")
|
|
)
|
|
# no missing SDDs
|
|
expect_identical(sum(is.na(AMR::clinical_breakpoints$is_SDD)), 0L)
|
|
|
|
expect_true(as.sir("S") < as.sir("I"))
|
|
expect_true(as.sir("I") < as.sir("R"))
|
|
expect_true(is.sir(as.sir("S")))
|
|
x <- example_isolates$AMX
|
|
expect_inherits(x[1], "sir")
|
|
expect_inherits(x[[1]], "sir")
|
|
expect_inherits(c(x[1], x[9]), "sir")
|
|
expect_inherits(unique(x[1], x[9]), "sir")
|
|
pdf(NULL) # prevent Rplots.pdf being created
|
|
expect_silent(barplot(as.sir(c("S", "SDD", "I", "R", "NI"))))
|
|
expect_silent(plot(as.sir(c("S", "SDD", "I", "R", "NI"))))
|
|
if (AMR:::pkg_is_available("ggplot2")) {
|
|
expect_inherits(ggplot2::autoplot(as.sir(c("S", "SDD", "I", "R", "NI"))), "gg")
|
|
}
|
|
expect_output(print(as.sir(c("S", "SDD", "I", "R", "NI"))))
|
|
expect_equal(as.character(as.sir(c(1:3))), c("S", "I", "R"))
|
|
expect_equal(as.character(as.sir(c(1:3))), c("S", "I", "R"))
|
|
expect_equal(suppressWarnings(as.logical(as.sir("INVALID VALUE"))), NA)
|
|
expect_equal(
|
|
summary(as.sir(c("S", "R"))),
|
|
structure(c(
|
|
"Class" = "sir",
|
|
"%S" = "50.0% (n=1)",
|
|
"%SDD" = " 0.0% (n=0)",
|
|
"%I" = " 0.0% (n=0)",
|
|
"%R" = "50.0% (n=1)",
|
|
"%NI" = " 0.0% (n=0)"
|
|
), class = c("summaryDefault", "table"))
|
|
)
|
|
expect_identical(
|
|
as.logical(lapply(example_isolates, is_sir_eligible)),
|
|
as.logical(lapply(example_isolates, is.sir))
|
|
)
|
|
expect_error(as.sir.mic(as.mic(16)))
|
|
expect_error(as.sir.disk(as.disk(16)))
|
|
expect_error(AMR:::get_guideline("this one does not exist"))
|
|
|
|
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
|
# 40 sir columns
|
|
expect_equal(
|
|
example_isolates %>%
|
|
mutate_at(vars(PEN:RIF), as.character) %>%
|
|
lapply(is_sir_eligible) %>%
|
|
as.logical() %>%
|
|
sum(),
|
|
40
|
|
)
|
|
expect_equal(sum(is.sir(example_isolates)), 40)
|
|
|
|
expect_output(print(tibble(ab = as.sir("S"))))
|
|
|
|
expect_true(example_isolates %>%
|
|
select(AMC, MEM) %>%
|
|
mutate(MEM = as.sir(ifelse(AMC == "S", "S", MEM))) %>%
|
|
pull(MEM) %>%
|
|
is.sir())
|
|
|
|
expect_true(example_isolates %>%
|
|
select(AMC, MEM) %>%
|
|
mutate(MEM = if_else(AMC == "S", "S", MEM)) %>%
|
|
pull(MEM) %>%
|
|
is.sir())
|
|
}
|
|
|
|
# skimr
|
|
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
|
|
expect_named(
|
|
skim(example_isolates$PEN),
|
|
c("skim_type", "skim_variable", "n_missing", "complete_rate", "sir.count_S", "sir.count_I", "sir.count_R", "sir.prop_S", "sir.prop_I", "sir.prop_R", "sir.hist")
|
|
)
|
|
}
|
|
|
|
expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_))
|
|
|
|
|
|
# Human -----------------------------------------------------------------
|
|
|
|
# allow for guideline length > 1
|
|
expect_equal(
|
|
AMR:::get_guideline(c("CLSI", "CLSI", "CLSI2023", "EUCAST", "EUCAST2020"), AMR::clinical_breakpoints),
|
|
c("CLSI 2026", "CLSI 2026", "CLSI 2023", "EUCAST 2026", "EUCAST 2020")
|
|
)
|
|
|
|
# these are used in the script
|
|
expect_true(all(c("B_GRAMN", "B_GRAMP", "B_ANAER-NEG", "B_ANAER-POS", "B_ANAER") %in% AMR::microorganisms$mo))
|
|
|
|
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2
|
|
expect_identical(
|
|
as.character(as.sir(mics,
|
|
mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
|
uti = FALSE, include_PKPD = FALSE
|
|
)),
|
|
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")
|
|
)
|
|
expect_identical(
|
|
as.character(as.sir(mics,
|
|
mo = "Enterobacterales", ab = "AMC", guideline = "EUCAST 2022",
|
|
uti = TRUE, include_PKPD = FALSE
|
|
)),
|
|
c("S", "S", "S", "S", "S", "S", "S", "S", "S", "S", "R")
|
|
)
|
|
expect_identical(
|
|
as.character(as.sir(mics,
|
|
mo = "Escherichia coli", ab = "AMC", guideline = "EUCAST 2022",
|
|
uti = FALSE, include_PKPD = FALSE
|
|
)),
|
|
c("S", "S", "S", "S", "S", "S", "S", "S", "R", "R", "R")
|
|
)
|
|
|
|
# test SIR using dplyr's mutate_if(...) and mutate(across(...))
|
|
out1 <- as.sir(as.mic(c(0.256, 0.5, 1, 2)), mo = "Escherichia coli", ab = "ertapenem", guideline = "EUCAST 2023")
|
|
expect_identical(out1, as.sir(c("S", "S", "R", "R")))
|
|
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
|
out2 <- data.frame(
|
|
mo = "Escherichia coli",
|
|
ab = "ertapenem",
|
|
some_mics = as.mic(c(0.256, 0.5, 1, 2))
|
|
) %>%
|
|
mutate(across(where(is.mic), function(x) as.sir(x, mo = "mo", ab = "ab", guideline = "EUCAST 2023"))) %>%
|
|
pull(some_mics)
|
|
out3 <- data.frame(
|
|
mo = "Escherichia coli",
|
|
ab = "ertapenem",
|
|
some_mics = as.mic(c(0.256, 0.5, 1, 2))
|
|
) %>%
|
|
mutate_if(is.mic, as.sir, mo = "mo", ab = "ab", guideline = "EUCAST 2023") %>%
|
|
pull(some_mics)
|
|
|
|
expect_identical(out1, out2)
|
|
expect_identical(out1, out3)
|
|
}
|
|
|
|
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
|
|
expect_equal(
|
|
suppressMessages(
|
|
as.character(
|
|
as.sir(
|
|
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(
|
|
suppressMessages(
|
|
as.character(
|
|
as.sir(
|
|
x = as.mic(c(1, 2, 4, 8, 16)),
|
|
mo = "B_STRPT_PNMN",
|
|
ab = "AMX",
|
|
guideline = "CLSI 2019"
|
|
)
|
|
)
|
|
),
|
|
c("S", "S", "I", "R", "R")
|
|
)
|
|
|
|
expect_true(is.data.frame(sir_interpretation_history(clean = FALSE)))
|
|
expect_true(is.data.frame(sir_interpretation_history(clean = TRUE)))
|
|
expect_true(NROW(sir_interpretation_history()) == 0)
|
|
|
|
# cutoffs at MIC = 8
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020")),
|
|
as.sir("S")
|
|
)
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020")),
|
|
as.sir("R")
|
|
)
|
|
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
|
expect_true(suppressWarnings(example_isolates %>%
|
|
mutate(amox_mic = as.mic(2)) %>%
|
|
select(mo, amox_mic) %>%
|
|
as.sir() %>%
|
|
pull(amox_mic) %>%
|
|
is.sir()))
|
|
}
|
|
|
|
expect_equal(
|
|
as.character(
|
|
as.sir(
|
|
x = as.disk(22),
|
|
mo = "B_STRPT_PNMN",
|
|
ab = "ERY",
|
|
guideline = "CLSI"
|
|
)
|
|
),
|
|
"S"
|
|
)
|
|
expect_equal(
|
|
as.character(
|
|
as.sir(
|
|
x = as.disk(18),
|
|
mo = "B_STRPT_PNMN",
|
|
ab = "ERY",
|
|
guideline = "CLSI"
|
|
)
|
|
),
|
|
"I"
|
|
)
|
|
expect_equal(
|
|
as.character(
|
|
as.sir(
|
|
x = as.disk(10),
|
|
mo = "B_STRPT_PNMN",
|
|
ab = "ERY",
|
|
guideline = "CLSI"
|
|
)
|
|
),
|
|
"R"
|
|
)
|
|
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
|
|
expect_true(example_isolates %>%
|
|
mutate(amox_disk = as.disk(15)) %>%
|
|
select(mo, amox_disk) %>%
|
|
as.sir(guideline = "CLSI") %>%
|
|
pull(amox_disk) %>%
|
|
is.sir())
|
|
|
|
# used by group_by() on sir_calc_df(), check some internals to see if grouped calculation without tidyverse works
|
|
groups <- example_isolates %>%
|
|
group_by(mo) %>%
|
|
attributes() %>%
|
|
.$groups
|
|
expect_equal(
|
|
nrow(groups),
|
|
90
|
|
)
|
|
expect_equal(
|
|
class(groups$.rows),
|
|
c("vctrs_list_of", "vctrs_vctr", "list")
|
|
)
|
|
expect_equal(
|
|
groups$.rows[[1]],
|
|
c(101, 524, 1368)
|
|
)
|
|
expect_equal(
|
|
example_isolates[c(101, 524, 1368), "mo", drop = TRUE],
|
|
rep(groups$mo[1], 3)
|
|
)
|
|
}
|
|
# frequency tables
|
|
if (AMR:::pkg_is_available("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 <rsi> class
|
|
CLR = "V"
|
|
) # note about cleaning
|
|
expect_inherits(
|
|
suppressWarnings(as.sir(df)),
|
|
"data.frame"
|
|
)
|
|
expect_inherits(
|
|
suppressWarnings(as.sir(data.frame(
|
|
mo = "Escherichia coli",
|
|
amoxi = c("S", "SDD", "I", "R", "NI", "invalid")
|
|
))$amoxi),
|
|
"sir"
|
|
)
|
|
# expect_warning(as.sir(data.frame(mo = "E. coli", NIT = c("<= 2", 32))))
|
|
expect_message(as.sir(data.frame(
|
|
mo = "E. coli",
|
|
NIT = c("<= 2", 32),
|
|
uti = TRUE
|
|
), info = TRUE))
|
|
expect_message(as.sir(data.frame(
|
|
mo = "E. coli",
|
|
NIT = c("<= 2", 32),
|
|
specimen = c("urine", "blood")
|
|
), info = TRUE))
|
|
|
|
# SDD vs I in CLSI 2024
|
|
expect_identical(
|
|
as.sir(as.mic(2^c(-2:4)), mo = "Enterococcus faecium", ab = "Dapto", guideline = "CLSI 2024"),
|
|
as.sir(c("SDD", "SDD", "SDD", "SDD", "SDD", "R", "R"))
|
|
)
|
|
expect_identical(
|
|
as.sir(as.mic(2^c(-2:2)), mo = "Enterococcus faecium", ab = "Cipro
|
|
", guideline = "CLSI 2024"),
|
|
as.sir(c("S", "S", "S", "I", "R"))
|
|
)
|
|
|
|
|
|
# Veterinary ------------------------------------------------------------
|
|
|
|
# multiple guidelines
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
x <- as.sir(as.mic(c(16, 16)), mo = "B_STRPT_CANS", ab = "AMK", host = "dog", guideline = c("CLSI 2024", "CLSI 2014"))
|
|
expect_equal(x, as.sir(c("R", NA)))
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
expect_equal(sir_history$guideline, c("CLSI 2024", "CLSI 2014"))
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
|
|
mics <- as.mic(2^c(-4:6)) # 0.0625 to 64 in factors of 2
|
|
vet <- data.frame(
|
|
animal = c(rep("cat", 3), rep("dogs", 3), "canine", "equine", "horse", "cattle", "bird"),
|
|
PRA = mics,
|
|
FLR = mics,
|
|
mo = mo_name(rep(c("B_ESCHR_COLI", "B_PSTRL_MLTC", "B_MNNHM_HMLY"), 4)[-1])
|
|
)
|
|
|
|
out_vet <- suppressWarnings(as.sir(vet, host = vet$animal, guideline = "CLSI 2023"))
|
|
# give host column name instead of values
|
|
expect_identical(
|
|
out_vet,
|
|
suppressWarnings(as.sir(vet, host = "animal", guideline = "CLSI 2023"))
|
|
)
|
|
|
|
# check outcomes
|
|
expect_identical(out_vet$PRA, as.sir(c("S", NA, "S", NA, NA, "R", NA, NA, NA, "R", NA)))
|
|
expect_identical(out_vet$FLR, as.sir(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, "R", NA)))
|
|
|
|
out_vet <- as.sir(vet, host = "animal", guideline = "EUCAST 2023")
|
|
expect_identical(out_vet$PRA, rep(NA_sir_, 11))
|
|
# expect_identical(out_vet$FLR, as.sir(c("S", "S", NA, "S", "S", NA, "I", "R", NA, "R", "R")))
|
|
expect_identical(out_vet$FLR, as.sir(c(NA, NA, NA, NA, NA, NA, NA, NA, NA, "R", NA)))
|
|
|
|
sir_history <- sir_interpretation_history()
|
|
expect_identical(
|
|
sort(sir_history$host),
|
|
c(
|
|
"cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cats", "cattle",
|
|
"cattle", "cattle", "cattle", "cattle", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs",
|
|
"dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse",
|
|
"horse", "horse", "poultry", "poultry", "poultry", "poultry", "poultry"
|
|
)
|
|
)
|
|
|
|
# ECOFF -----------------------------------------------------------------
|
|
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(c(2, 32)), "E. coli", "ampicillin", guideline = "EUCAST 2020", breakpoint_type = "ECOFF")),
|
|
as.sir(c("WT", "NWT")) # since ECOFF returns WT/NWT at default
|
|
)
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(c(2, 32)), "E. coli", "ampicillin", guideline = "EUCAST 2020", breakpoint_type = "ECOFF", as_wt_nwt = FALSE)),
|
|
as.sir(c("S", "R"))
|
|
)
|
|
# old method
|
|
expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE))
|
|
|
|
|
|
# Capped MIC handling ---------------------------------------------------
|
|
|
|
out1 <- as.sir(as.mic(c("0.125", "<0.125", ">0.125")), mo = "E. coli", ab = "Cipro", guideline = "EUCAST 2025", breakpoint_type = "ECOFF", capped_mic_handling = "none")
|
|
out2 <- as.sir(as.mic(c("0.125", "<0.125", ">0.125")), mo = "E. coli", ab = "Cipro", guideline = "EUCAST 2025", breakpoint_type = "ECOFF", capped_mic_handling = "conservative")
|
|
out3 <- as.sir(as.mic(c("0.125", "<0.125", ">0.125")), mo = "E. coli", ab = "Cipro", guideline = "EUCAST 2025", breakpoint_type = "ECOFF", capped_mic_handling = "standard")
|
|
out4 <- as.sir(as.mic(c("0.125", "<0.125", ">0.125")), mo = "E. coli", ab = "Cipro", guideline = "EUCAST 2025", breakpoint_type = "ECOFF", capped_mic_handling = "lenient")
|
|
expect_equal(out1, as.sir(c("NWT", "NWT", "NWT")))
|
|
expect_equal(out2, as.sir(c("NWT", "NI", "NWT")))
|
|
expect_equal(out3, as.sir(c("NWT", "WT", "NWT")))
|
|
expect_equal(out4, as.sir(c("NWT", "WT", "NWT")))
|
|
|
|
# Issue #295: no S category (off-scale S breakpoint), e.g. EUCAST CIP in P. aeruginosa (S <= 0.001, R > 0.5)
|
|
capped_psa <- as.mic(c("<=0.5", "<0.5", "<=0.25", "<0.25", "<=0.001", "<=1", "<1", ">=0.5", ">0.5", "0.25"))
|
|
capped_psa_sir <- function(handling) {
|
|
suppressMessages(as.sir(capped_psa, mo = "Pseudomonas aeruginosa", ab = "CIP", guideline = "EUCAST 2026", capped_mic_handling = handling))
|
|
}
|
|
expect_equal(capped_psa_sir("none"), as.sir(c("I", "I", "I", "I", "I", "R", "R", "I", "R", "I")))
|
|
expect_equal(capped_psa_sir("conservative"), as.sir(c("I", "I", "I", "I", "I", "NI", "NI", "NI", "R", "I")))
|
|
expect_equal(capped_psa_sir("standard"), as.sir(c("I", "I", "I", "I", "I", "NI", "I", "NI", "R", "I")))
|
|
expect_equal(capped_psa_sir("lenient"), as.sir(c("I", "I", "I", "I", "I", "I", "I", "R", "R", "I")))
|
|
# the same with custom reference data that uses the off-scale value as printed by EUCAST (S <= 0.001, R > 2)
|
|
ref_staph <- subset(clinical_breakpoints, guideline == "EUCAST 2026" & ab == "CIP" & mo == "B_PSDMN" & method == "MIC" & type == "human")[1, , drop = FALSE]
|
|
ref_staph$mo <- as.mo("B_STPHY_AURS")
|
|
ref_staph$breakpoint_S <- 0.001
|
|
ref_staph$breakpoint_R <- 2
|
|
for (handling in c("conservative", "standard", "lenient")) {
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(c("<=0.5", "<0.5", "<=2", "<0.001")), mo = "Staphylococcus aureus", ab = "CIP", reference_data = ref_staph, capped_mic_handling = handling)),
|
|
as.sir(c("I", "I", "I", "I"))
|
|
)
|
|
}
|
|
# SDD as middle category, e.g. CLSI DAP in E. faecium (SDD <= 4, R >= 8)
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(c("<=4", "<=2", "<=0.5")), mo = "Enterococcus faecium", ab = "DAP", guideline = "CLSI 2026", capped_mic_handling = "lenient")),
|
|
as.sir(c("SDD", "SDD", "SDD"))
|
|
)
|
|
# an S category remains unaffected, e.g. EUCAST CIP in E. coli (S <= 0.25, R > 0.5)
|
|
expect_equal(
|
|
suppressMessages(as.sir(as.mic(c("<=0.5", "<0.5", "<=0.25")), mo = "Escherichia coli", ab = "CIP", guideline = "EUCAST 2026", capped_mic_handling = "standard", site = "non-meningitis")),
|
|
as.sir(c("NI", "S", "S"))
|
|
)
|
|
# capped values must not be forced to S or R if there is no breakpoint (blocking row, here: EUCAST CIP in S. aureus in brackets only)
|
|
for (handling in c("none", "conservative", "standard", "lenient")) {
|
|
expect_true(all(is.na(suppressMessages(as.sir(as.mic(c("<0.5", "<=0.5", ">2", ">=2", "1")), mo = "Staphylococcus aureus", ab = "CIP", guideline = "EUCAST 2026", capped_mic_handling = handling)))))
|
|
}
|
|
|
|
# Issue #278: re-running as.sir() on already-<sir> data must preserve columns
|
|
df_already_sir <- data.frame(
|
|
mo = "B_ESCHR_COLI",
|
|
AMC = as.mic(c("1", "2", "4")),
|
|
GEN = sample(c("S", "I", "R"), 3, replace = TRUE),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
first_pass <- suppressMessages(as.sir(df_already_sir, col_mo = "mo", info = FALSE))
|
|
second_pass <- suppressMessages(as.sir(first_pass, col_mo = "mo", info = FALSE))
|
|
expect_equal(ncol(first_pass), ncol(second_pass))
|
|
expect_true(is.sir(second_pass[["AMC"]]))
|
|
expect_true(is.sir(second_pass[["GEN"]]))
|
|
expect_identical(first_pass[["AMC"]], second_pass[["AMC"]])
|
|
expect_identical(first_pass[["GEN"]], second_pass[["GEN"]])
|
|
|
|
# Issue #278: metadata columns whose names coincidentally match antibiotic
|
|
# codes (e.g. 'patient' -> OXY, 'ward' -> PRU) must not be processed
|
|
df_meta <- data.frame(
|
|
mo = "B_ESCHR_COLI",
|
|
patient = paste0("Pt_", 1:20),
|
|
ward = rep(c("ICU", "Surgery", "Outpatient", "ED"), 5),
|
|
AMC = as.mic(rep(c("1", "2", "4", "8"), 5)),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
df_meta_sir <- suppressMessages(as.sir(df_meta, col_mo = "mo", info = FALSE))
|
|
expect_true("patient" %in% colnames(df_meta_sir))
|
|
expect_true("ward" %in% colnames(df_meta_sir))
|
|
expect_false(is.sir(df_meta_sir[["patient"]]))
|
|
expect_false(is.sir(df_meta_sir[["ward"]]))
|
|
expect_true(is.sir(df_meta_sir[["AMC"]]))
|
|
|
|
# Parallel computing ----------------------------------------------------
|
|
# Tests must pass even when only 1 core is available; parallel = TRUE then
|
|
# silently falls back to sequential, but results must still be identical.
|
|
|
|
if (AMR:::pkg_is_available("future.apply")) {
|
|
set.seed(42)
|
|
n_par <- 200
|
|
df_par <- data.frame(
|
|
mo = "B_ESCHR_COLI",
|
|
AMC = as.mic(sample(c("0.25", "0.5", "1", "2", "4", "8", "16", "32"), n_par, TRUE)),
|
|
GEN = as.mic(sample(c("0.5", "1", "2", "4", "8", "16", "32", "64"), n_par, TRUE)),
|
|
CIP = as.mic(sample(c("0.001", "0.002", "0.004", "0.008", "0.016", "0.032"), n_par, TRUE)),
|
|
PEN = sample(c("S", "I", "R", NA_character_), n_par, TRUE),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
|
|
# clear any existing history before comparing
|
|
sir_interpretation_history(clean = TRUE)
|
|
sir_seq <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE))
|
|
log_seq <- sir_interpretation_history(clean = TRUE)
|
|
|
|
future::plan(future::multicore)
|
|
n_max_workers <- future::nbrOfWorkers()
|
|
|
|
sir_par <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
log_par <- sir_interpretation_history(clean = TRUE)
|
|
|
|
# 1. parallel = TRUE gives identical SIR results to sequential
|
|
expect_identical(sir_seq[["AMC"]], sir_par[["AMC"]])
|
|
expect_identical(sir_seq[["GEN"]], sir_par[["GEN"]])
|
|
expect_identical(sir_seq[["CIP"]], sir_par[["CIP"]])
|
|
expect_identical(sir_seq[["PEN"]], sir_par[["PEN"]])
|
|
|
|
# 2. same number of log rows as sequential
|
|
expect_equal(nrow(log_seq), nrow(log_par))
|
|
|
|
# 3. pre-existing log entries must not be duplicated
|
|
# run sequential once to populate the history, then run parallel and
|
|
# verify the new parallel run adds exactly as many rows as sequential
|
|
sir_interpretation_history(clean = TRUE)
|
|
future::plan(future::sequential)
|
|
suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE)) # populate history
|
|
pre_n <- nrow(sir_interpretation_history())
|
|
future::plan(future::multicore)
|
|
suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
post_n <- nrow(sir_interpretation_history())
|
|
expect_equal(post_n - pre_n, nrow(log_seq)) # exactly one run's worth of new rows
|
|
sir_interpretation_history(clean = TRUE)
|
|
|
|
# 4. two sequential runs and two parallel runs yield identical results
|
|
sir_par2 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
expect_identical(sir_par[["AMC"]], sir_par2[["AMC"]])
|
|
expect_identical(sir_par[["GEN"]], sir_par2[["GEN"]])
|
|
|
|
# 5. used cores = 1 gives same results as default sequential
|
|
future::plan(future::multicore, workers = 1)
|
|
sir_mc1 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
expect_identical(sir_seq[["AMC"]], sir_mc1[["AMC"]])
|
|
expect_identical(sir_seq[["GEN"]], sir_mc1[["GEN"]])
|
|
|
|
# 6. used cores = 2 and used cores = 3 give same results as sequential
|
|
if (n_max_workers >= 3) {
|
|
future::plan(future::multicore, workers = 2)
|
|
sir_mc2 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
future::plan(future::multicore, workers = 3)
|
|
sir_mc3 <- suppressMessages(as.sir(df_par, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
expect_identical(sir_seq[["AMC"]], sir_mc2[["AMC"]])
|
|
expect_identical(sir_seq[["GEN"]], sir_mc3[["GEN"]])
|
|
}
|
|
|
|
# 7. single-column data frame falls back silently to sequential
|
|
df_single <- df_par[, c("mo", "AMC")]
|
|
future::plan(future::sequential)
|
|
sir_single_seq <- suppressMessages(as.sir(df_single, col_mo = "mo", info = FALSE))
|
|
future::plan(future::multicore)
|
|
sir_single_par <- suppressMessages(as.sir(df_single, col_mo = "mo", info = FALSE, parallel = TRUE))
|
|
expect_identical(sir_single_seq[["AMC"]], sir_single_par[["AMC"]])
|
|
|
|
# 8. row-batch mode (n_cols < n_cores): force row splitting via used cores and
|
|
# verify identical output to sequential for a dataset with 2 AB columns so
|
|
# pieces_per_col = ceiling(used cores / 2) >= 2 and row batching activates
|
|
df_wide <- data.frame(
|
|
mo = "B_ESCHR_COLI",
|
|
AMC = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)),
|
|
GEN = as.mic(sample(c("1", "2", "4", "8"), n_par, TRUE)),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
future::plan(future::sequential)
|
|
sir_wide_seq <- suppressMessages(as.sir(df_wide, col_mo = "mo", info = FALSE))
|
|
future::plan(future::multicore)
|
|
sir_wide_par <- suppressMessages(as.sir(df_wide,
|
|
col_mo = "mo", info = FALSE,
|
|
parallel = TRUE
|
|
))
|
|
expect_identical(sir_wide_seq[["AMC"]], sir_wide_par[["AMC"]])
|
|
expect_identical(sir_wide_seq[["GEN"]], sir_wide_par[["GEN"]])
|
|
|
|
# 8. info = TRUE with parallel does not produce per-column worker messages
|
|
# (messages should only appear in the main process, not duplicated from workers)
|
|
msgs <- capture.output(
|
|
suppressWarnings(as.sir(df_par, col_mo = "mo", info = TRUE, parallel = TRUE)),
|
|
type = "message"
|
|
)
|
|
# each AB column name should appear at most once in all messages combined
|
|
for (ab_nm in c("AMC", "GEN", "CIP", "PEN")) {
|
|
n_mentions <- sum(grepl(ab_nm, msgs, fixed = TRUE))
|
|
expect_lte(n_mentions, 1L)
|
|
}
|
|
future::plan(future::sequential)
|
|
}
|
|
})
|
|
|
|
# issue #239 — custom reference_data support
|
|
test_that("custom reference_data: non-EUCAST/CLSI guideline produces R", {
|
|
# Build a minimal one-row custom breakpoint table from a plain data.frame.
|
|
# coerce_reference_data_columns() will coerce mo/ab to the right class.
|
|
my_bp <- clinical_breakpoints[clinical_breakpoints$method == "MIC" &
|
|
clinical_breakpoints$type == "human", ][1, ]
|
|
my_bp$guideline <- "MyLab 2025"
|
|
my_bp$mo <- "B_ACHRMB_XYLS" # plain character — coerced to <mo>
|
|
my_bp$ab <- "MEM" # plain character — coerced to <ab>
|
|
my_bp$breakpoint_S <- 8
|
|
my_bp$breakpoint_R <- 32
|
|
|
|
# guideline omitted: all rows in reference_data are used; R via open interval (>)
|
|
expect_equal(as.character(suppressMessages(
|
|
as.sir(as.mic(64), mo = "B_ACHRMB_XYLS", ab = "MEM", reference_data = my_bp)
|
|
)), "R")
|
|
expect_equal(as.character(suppressMessages(
|
|
as.sir(as.mic(16), mo = "B_ACHRMB_XYLS", ab = "MEM", reference_data = my_bp)
|
|
)), "I")
|
|
# at R breakpoint value must be I (open interval: > not >=)
|
|
expect_equal(as.character(suppressMessages(
|
|
as.sir(as.mic(32), mo = "B_ACHRMB_XYLS", ab = "MEM", reference_data = my_bp)
|
|
)), "I")
|
|
|
|
# guideline explicitly set: same result when it matches the data
|
|
expect_equal(as.character(suppressMessages(
|
|
as.sir(as.mic(64),
|
|
mo = "B_ACHRMB_XYLS", ab = "MEM",
|
|
guideline = "MyLab 2025", reference_data = my_bp
|
|
)
|
|
)), "R")
|
|
})
|
|
|
|
test_that("custom reference_data: host = NA acts as host-agnostic fallback", {
|
|
my_bp <- clinical_breakpoints[clinical_breakpoints$method == "MIC" &
|
|
clinical_breakpoints$type == "human", ][1, ]
|
|
my_bp$guideline <- "MyLab 2025"
|
|
my_bp$mo <- "B_ACHRMB_XYLS"
|
|
my_bp$ab <- "MEM"
|
|
my_bp$type <- "animal"
|
|
my_bp$host <- NA # logical NA — coerced to character by coerce_reference_data_columns()
|
|
my_bp$breakpoint_S <- 8
|
|
my_bp$breakpoint_R <- 32
|
|
|
|
# NA host should match when no species-specific row exists
|
|
result <- suppressMessages(
|
|
as.sir(as.mic(64),
|
|
mo = "B_ACHRMB_XYLS", ab = "MEM",
|
|
host = "dogs", breakpoint_type = "animal", reference_data = my_bp
|
|
)
|
|
)
|
|
expect_equal(as.character(result), "R")
|
|
})
|
|
|
|
test_that("as.sir() uses screening breakpoints as specified (#328)", {
|
|
skip_on_cran()
|
|
sir <- function(ab, ...) {
|
|
as.character(suppressMessages(suppressWarnings(as.sir(as.disk(20), mo = "S. aureus", ab = ab, guideline = "EUCAST 2026", info = FALSE, ...))))
|
|
}
|
|
expect_identical(sir("FOX"), NA_character_)
|
|
expect_false(is.na(sir("FOX-S")))
|
|
expect_false(is.na(sir("FOX-S", include_screening = TRUE)))
|
|
expect_false(is.na(sir("FOX", include_screening = TRUE)))
|
|
expect_identical(sir("FOX", include_screening = TRUE), sir("FOX-S"))
|
|
expect_identical(sir("FOX", include_screening = FALSE), NA_character_)
|
|
expect_identical(sir("FOX-S", include_screening = FALSE), NA_character_)
|
|
# with a note, as this may be by accident
|
|
expect_message(as.sir(as.disk(20), mo = "S. aureus", ab = "FOX-S", guideline = "EUCAST 2026", include_screening = FALSE, info = FALSE), "include_screening")
|
|
sir_interpretation_history(clean = TRUE)
|
|
sir("FOX-S", include_screening = FALSE)
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
expect_match(sir_history$notes, "include_screening = FALSE", fixed = TRUE)
|
|
})
|
|
|
|
test_that("as.sir() takes the site of a breakpoint into account", {
|
|
skip_on_cran()
|
|
sir <- function(x, mo, ab, ..., guideline = "EUCAST 2026") {
|
|
as.character(suppressMessages(suppressWarnings(as.sir(x, mo = mo, ab = ab, guideline = guideline, info = FALSE, ...))))
|
|
}
|
|
# every site in the data set, for humans and for animals, must be known, so that none can be overlooked
|
|
sites <- unique(clinical_breakpoints$site[!is.na(clinical_breakpoints$site)])
|
|
for (s in sites) {
|
|
known <- vapply(setdiff(sir_site_parts(s), SIR_SITE_NOT_A_SITE), function(part) length(sir_site_tokens(part)) == 1, logical(1))
|
|
expect_true(all(known), info = s)
|
|
}
|
|
expect_identical(sort(names(SIR_SITE_PATTERNS)), sort(SIR_SITE_ORDER))
|
|
expect_identical(
|
|
SIR_SITE_ORDER,
|
|
c("systemic", "iv", "meningitis", "endocarditis", "pneumonia", "mastitis", "respiratory", "metritis", "genital", "intestinal", "other", "non-meningitis", "non-endocarditis", "non-pneumonia", "extraintestinal", "soft tissue", "skin", "wounds", "inhaled", "oral", "prophylaxis", "uti", "topical", "screen")
|
|
)
|
|
|
|
# the fixed codes, all other values give an error
|
|
expect_identical(sir_site_normalise(c("Meningitis", "iv, meningitis", NA)), c("meningitis", "iv,meningitis", NA))
|
|
expect_error(as.sir(as.mic(1), mo = "E. coli", ab = "AMC", site = "brain", info = FALSE))
|
|
expect_error(as.sir(as.mic(1), mo = "E. coli", ab = "AMC", site = "uti", uti = FALSE, info = FALSE))
|
|
|
|
# contradictions: only with a site in the same group, or a negation
|
|
expect_false(sir_site_fits("non-meningitis", "meningitis"))
|
|
expect_false(sir_site_fits("meningitis", "non-meningitis"))
|
|
expect_false(sir_site_fits("pneumonia", "meningitis"))
|
|
expect_false(sir_site_fits("oral", "iv"))
|
|
expect_true(sir_site_fits(character(0), "meningitis"))
|
|
expect_true(sir_site_fits("iv", "meningitis"))
|
|
expect_true(sir_site_fits(c("iv", "meningitis"), "meningitis"))
|
|
expect_true(sir_site_fits("non-endocarditis", "meningitis"))
|
|
expect_true(sir_site_fits("systemic", "meningitis"))
|
|
expect_false(sir_site_fits("systemic", "uti"))
|
|
|
|
# veterinary sites: the same rules, where sites that are part of each other do not contradict
|
|
expect_identical(sir_site_tokens("Mammary gland"), "mastitis")
|
|
expect_identical(sir_site_tokens("Wounds, abscesses"), "wounds")
|
|
expect_false(sir_site_fits("mastitis", "respiratory"))
|
|
expect_false(sir_site_fits("respiratory", "uti"))
|
|
expect_true(sir_site_fits("respiratory", "pneumonia"))
|
|
expect_true(sir_site_fits("pneumonia", "respiratory"))
|
|
expect_true(sir_site_fits("metritis", "genital"))
|
|
expect_true(sir_site_fits(c("skin", "soft tissue"), "wounds"))
|
|
|
|
# "other" means any site not listed: it fits no breakpoint limited to an indication, but it does fit the rest
|
|
expect_false(sir_site_fits("meningitis", "other"))
|
|
expect_false(sir_site_fits("uti", "other"))
|
|
expect_false(sir_site_fits("mastitis", "other"))
|
|
expect_true(sir_site_fits(character(0), "other"))
|
|
expect_true(sir_site_fits("other", "other"))
|
|
expect_true(sir_site_fits("non-meningitis", "other"))
|
|
expect_true(sir_site_fits("iv", "other"))
|
|
expect_true(sir_site_given(character(0), "other"))
|
|
expect_false(sir_site_given(character(0), "uti"))
|
|
|
|
# site = NA takes the most systemic site, also compared to a breakpoint without a site
|
|
expect_true(sir_site_rank("Systemic infections") < sir_site_rank("Intravenous"))
|
|
expect_true(sir_site_rank("Intravenous") < sir_site_rank("Meningitis"))
|
|
expect_true(sir_site_rank("Pneumonia") < sir_site_rank("Mastitis"))
|
|
expect_identical(sir_site_rank("Mastitis"), sir_site_rank("Mammary gland"))
|
|
expect_true(sir_site_rank("Mastitis") < sir_site_rank("Intestinal"))
|
|
# "other" and no site are one position: below meningitis, and above UTI
|
|
expect_identical(sir_site_rank(NA), sir_site_rank("Other infections"))
|
|
expect_true(sir_site_rank("Meningitis") < sir_site_rank("Other infections"))
|
|
expect_true(sir_site_rank("Other infections") < sir_site_rank("Uncomplicated urinary tract infection"))
|
|
expect_true(sir_site_rank("Intestinal") < sir_site_rank(NA))
|
|
expect_true(sir_site_rank(NA) < sir_site_rank("Non-meningitis"))
|
|
expect_true(sir_site_rank("Oral") < sir_site_rank("Uncomplicated urinary tract infection"))
|
|
# a second site breaks a tie on the first one
|
|
expect_true(sir_site_rank("Intravenous, Meningitis") < sir_site_rank("Intravenous, Non-meningitis"))
|
|
expect_true(sir_site_rank("Intravenous, Non-meningitis") < sir_site_rank("Meningitis"))
|
|
|
|
# the order of sites does not make a Gram stain precede the more specific anaerobes: CLSI Table 2J, not Table 2B-5
|
|
expect_identical(sir(as.mic(16), "Bacteroides fragilis", "CRO", guideline = "CLSI 2022"), "S")
|
|
# and it does make a meningitis breakpoint precede a non-meningitis breakpoint of another taxon of the same rank
|
|
expect_identical(sir(as.mic(0.25), "Streptococcus agalactiae", "PEN", guideline = "EUCAST 2024"), "R")
|
|
|
|
# "other" in as.sir(): takes the breakpoint for other infections, or without a site
|
|
expect_identical(sir(as.mic(0.25), "Streptococcus pneumoniae", "PEN", site = "other", guideline = "EUCAST 2012"), "I")
|
|
expect_identical(sir(as.mic(0.25), "Streptococcus pneumoniae", "PEN", site = "meningitis", guideline = "EUCAST 2012"), "R")
|
|
# only breakpoints limited to an indication: no result
|
|
expect_identical(sir(as.mic(1), "Escherichia coli", "NTR", site = "other"), NA_character_)
|
|
# veterinary: per site for the host, and no result for another site
|
|
vet <- function(x, mo, ab, ...) {
|
|
sir(x, mo, ab, guideline = "CLSI 2026", breakpoint_type = "animal", host = "cattle", ...)
|
|
}
|
|
expect_identical(vet(as.mic(2), "Staphylococcus aureus", "KAC", site = "mastitis"), "S")
|
|
expect_identical(vet(as.mic(32), "Staphylococcus aureus", "KAC", site = "mastitis"), "R")
|
|
expect_identical(vet(as.mic(2), "Staphylococcus aureus", "KAC", site = "meningitis"), NA_character_)
|
|
|
|
# S. pneumoniae and benzylpenicillin, with breakpoints for meningitis and for other infections
|
|
pen <- as.mic(0.25)
|
|
expect_identical(sir(pen, "Streptococcus pneumoniae", "PEN", site = "meningitis"), "R")
|
|
expect_identical(sir(pen, "Streptococcus pneumoniae", "PEN", site = "non-meningitis"), "I")
|
|
expect_identical(sir(pen, "Streptococcus pneumoniae", "PEN"), "R")
|
|
sir_interpretation_history(clean = TRUE)
|
|
sir(pen, "Streptococcus pneumoniae", "PEN")
|
|
history <- sir_interpretation_history(clean = TRUE)
|
|
expect_match(history$site, "Meningitis", fixed = TRUE)
|
|
expect_match(history$notes, "Multiple breakpoints available", fixed = TRUE)
|
|
|
|
# amoxicillin in Enterobacterales: per route
|
|
amx <- as.mic(4)
|
|
expect_identical(sir(amx, "Escherichia coli", "AMX", site = "iv"), "S")
|
|
expect_identical(sir(amx, "Escherichia coli", "AMX"), "S")
|
|
# only breakpoints for other sites: no result, and no fallback to PK/PD
|
|
expect_identical(sir(as.mic(1), "Escherichia coli", "NTR", site = "meningitis"), NA_character_)
|
|
expect_identical(sir(as.mic(1), "Escherichia coli", "NTR", site = "uti"), "S")
|
|
expect_identical(sir(as.mic(1), "Escherichia coli", "NTR", uti = TRUE), "S")
|
|
|
|
# vectorised, also in combination with uti, of which NA, TRUE and FALSE can be mixed
|
|
expect_identical(
|
|
sir(as.mic(c(0.25, 0.25)), "Streptococcus pneumoniae", "PEN", site = c("meningitis", "non-meningitis")),
|
|
c("R", "I")
|
|
)
|
|
expect_identical(
|
|
sir(as.mic(c(16, 16, 16)), "Escherichia coli", "NTR", uti = c(NA, TRUE, FALSE)),
|
|
c("S", "S", NA)
|
|
)
|
|
|
|
# on a data.frame, with a column name and with fixed values, without treating the column as an antimicrobial
|
|
df <- data.frame(mo = "Streptococcus pneumoniae", PEN = as.mic(c(0.25, 0.25)), where = c("meningitis", "non-meningitis"), stringsAsFactors = FALSE)
|
|
out <- suppressMessages(suppressWarnings(as.sir(df, col_mo = "mo", guideline = "EUCAST 2026", site = "where", info = FALSE)))
|
|
expect_identical(as.character(out$PEN), c("R", "I"))
|
|
expect_identical(out$where, df$where)
|
|
out <- suppressMessages(suppressWarnings(as.sir(df, col_mo = "mo", guideline = "EUCAST 2026", site = "non-meningitis", info = FALSE)))
|
|
expect_identical(as.character(out$PEN), c("I", "I"))
|
|
})
|
|
|
|
test_that("MIC breakpoints are compared as dilutions, not as their notation (#331)", {
|
|
skip_on_cran()
|
|
sir <- function(x, mo, ab, guideline = "EUCAST 2026") {
|
|
as.character(suppressMessages(suppressWarnings(as.sir(as.mic(x), mo = mo, ab = ab, guideline = guideline, info = FALSE))))
|
|
}
|
|
# the published value is the stored value
|
|
pen <- subset(clinical_breakpoints, guideline == "EUCAST 2026" & type == "human" & method == "MIC" & ab == "PEN" & mo == "B_STRPT_GRPA")
|
|
expect_identical(unique(pen$breakpoint_S), 0.03)
|
|
# all notations of this dilution are S, the next dilution is not
|
|
expect_identical(sir(c(0.03, 0.031, 0.03125, 0.032), "Streptococcus pyogenes", "PEN"), rep("S", 4))
|
|
expect_identical(sir(0.064, "Streptococcus pyogenes", "PEN"), "R")
|
|
# the same for an R breakpoint, in the notation of the guideline and of the laboratory
|
|
expect_identical(mic_dilution_level(c(0.03, 0.032, 0.06, 0.064, 0.12, 0.125, 0.19, 3)), c(0.032, 0.032, 0.064, 0.064, 0.125, 0.125, 0.19, 3))
|
|
# the off-scale S breakpoint is stored as published, and never leads to S
|
|
cip <- subset(clinical_breakpoints, guideline == "EUCAST 2026" & type == "human" & method == "MIC" & ab == "CIP" & mo == "B_PSDMN" & is.na(site))
|
|
expect_identical(unique(cip$breakpoint_S), 0.001)
|
|
expect_identical(sir(c(0.0005, 0.001, 0.25), "Pseudomonas aeruginosa", "CIP"), c("I", "I", "I"))
|
|
# the log shows the published breakpoint
|
|
sir_interpretation_history(clean = TRUE)
|
|
sir(0.032, "Streptococcus pyogenes", "PEN")
|
|
expect_identical(sir_interpretation_history(clean = TRUE)$breakpoint_S_R, "0.03-0.03")
|
|
})
|
|
|
|
test_that("Morganella is interpreted as reported, not as M. morganii (#330)", {
|
|
skip_on_cran()
|
|
cb <- as.data.frame(clinical_breakpoints, stringsAsFactors = FALSE)
|
|
cb <- cb[cb$type == "human" & cb$guideline %like% "EUCAST", , drop = FALSE]
|
|
cb[] <- lapply(cb, function(x) if (is.numeric(x) || is.logical(x)) x else as.character(x))
|
|
order_code <- "B_[ORD]_ENTRBCTR"
|
|
family_code <- "B_[FAM]_MORGNLLC"
|
|
genus_code <- "B_MRGNL"
|
|
species_code <- "B_MRGNL_MRGN"
|
|
key <- function(df) paste(df$guideline, df$ab, df$method)
|
|
sir <- function(mo, k) {
|
|
x <- cb[key(cb) == k & cb$mo %in% c(order_code, family_code, genus_code, species_code), , drop = FALSE]
|
|
bp <- unique(c(x$breakpoint_S, x$breakpoint_R))
|
|
bp <- bp[!is.na(bp)]
|
|
if (x$method[1] == "MIC") {
|
|
input <- as.mic(sort(unique(pmax(0.001, c(0.001, 512, bp / 2, bp, bp * 2)))))
|
|
} else {
|
|
input <- as.disk(sort(unique(pmin(50, c(6, 50, bp - 1, bp, bp + 1)))))
|
|
}
|
|
as.character(suppressMessages(suppressWarnings(
|
|
as.sir(input, mo = mo, ab = x$ab[1], guideline = x$guideline[1], uti = FALSE, info = FALSE)
|
|
)))
|
|
}
|
|
|
|
# EUCAST's exceptions for the genus are only for agents that it excludes for Morganella as a whole
|
|
genus_rows <- cb[cb$mo == genus_code, , drop = FALSE]
|
|
expect_true(all(genus_rows$ab == "IMR"))
|
|
expect_true(all(is.na(genus_rows$breakpoint_S) & is.na(genus_rows$breakpoint_R)))
|
|
|
|
# the exceptions for M. morganii itself do not apply to the genus, which follows Enterobacterales
|
|
species_only <- setdiff(key(cb[cb$mo == species_code, ]), key(cb[cb$mo %in% c(family_code, genus_code), ]))
|
|
expect_true(length(species_only) > 0)
|
|
for (k in species_only) {
|
|
expect_identical(sir(genus_code, k), sir(order_code, k), info = k)
|
|
expect_false(identical(sir(species_code, k), sir(order_code, k)), info = k)
|
|
}
|
|
|
|
# the exceptions for the family do apply to the genus, as to any other member of the family
|
|
family_only <- setdiff(key(cb[cb$mo == family_code, ]), key(cb[cb$mo %in% c(species_code, genus_code), ]))
|
|
expect_true(length(family_only) > 0)
|
|
for (k in family_only) {
|
|
expect_identical(sir(genus_code, k), sir(family_code, k), info = k)
|
|
expect_identical(sir("Providencia stuartii", k), sir(family_code, k), info = k)
|
|
}
|
|
|
|
# a current example: imipenem has its own breakpoints for Morganellaceae, including Morganella
|
|
expect_identical(as.character(suppressMessages(as.sir(as.mic(2), mo = "Morganella", ab = "IPM", guideline = "EUCAST 2026", info = FALSE))), "I")
|
|
expect_identical(as.character(suppressMessages(as.sir(as.mic(2), mo = "Klebsiella oxytoca", ab = "IPM", guideline = "EUCAST 2026", info = FALSE))), "S")
|
|
})
|
|
|
|
test_that("EUCAST blocking rows prevent falling back to broader breakpoints", {
|
|
skip_on_cran()
|
|
sir <- function(x, mo, ab, guideline, include_screening = NULL, uti = NA) {
|
|
as.character(suppressMessages(suppressWarnings(
|
|
as.sir(x, mo = mo, ab = ab, guideline = guideline, include_screening = include_screening, uti = uti)
|
|
)))
|
|
}
|
|
# IE for V. fluvialis, while Vibrio spp. has breakpoints
|
|
expect_identical(sir(as.mic(0.125), "Vibrio fluvialis", "CTX", "EUCAST 2026"), NA_character_)
|
|
expect_identical(sir(as.mic(0.125), "Vibrio cholerae", "CTX", "EUCAST 2026"), "S")
|
|
# breakpoints of Vibrio are for 5 species only, so not for other species or for the genus, which can only have PK/PD
|
|
expect_identical(sir(as.mic(0.125), "Vibrio parahaemolyticus", "CIP", "EUCAST 2026"), "S")
|
|
expect_identical(sir(as.mic(0.125), "Vibrio harveyi", "CIP", "EUCAST 2026"), NA_character_)
|
|
expect_identical(sir(as.mic(0.125), "Vibrio", "CIP", "EUCAST 2026"), NA_character_)
|
|
expect_identical(sir(as.mic(0.125), "Vibrio harveyi", "CIP", "EUCAST 2023"), "S")
|
|
# fosfomycin zone diameter breakpoints apply to E. coli only
|
|
expect_identical(sir(as.disk(25), "Klebsiella pneumoniae", "FOS", "EUCAST 2019"), NA_character_)
|
|
expect_identical(sir(as.disk(25), "Escherichia coli", "FOS", "EUCAST 2019"), "S")
|
|
# "-" for enterococci must not fall back to the PK-PD breakpoints
|
|
expect_identical(sir(as.mic(1), "Enterococcus faecalis", "CTX", "EUCAST 2021"), NA_character_)
|
|
# exceptions: "Klebsiella spp. (except K. aerogenes)"
|
|
expect_identical(sir(as.mic(2), "Klebsiella aerogenes", "CXM", "EUCAST 2026"), NA_character_)
|
|
# agent listed in the Enterobacterales table for other organisms only
|
|
expect_identical(sir(as.mic(0.5), "Salmonella enterica", "CXM", "EUCAST 2026"), NA_character_)
|
|
# no EUCAST breakpoints at all, so no PK-PD breakpoints either
|
|
expect_identical(sir(as.mic(0.5), "Burkholderia cepacia complex", "MEM", "EUCAST 2020"), NA_character_)
|
|
# PK-PD breakpoints only until EUCAST 2023
|
|
expect_identical(sir(as.mic(0.25), "Nocardia asteroides", "AMX", "EUCAST 2020"), "S")
|
|
expect_identical(sir(as.mic(0.25), "Nocardia asteroides", "AMX", "EUCAST 2024"), NA_character_)
|
|
# H. influenzae MIC breakpoints apply to H. parainfluenzae, zone diameters do not
|
|
expect_identical(sir(as.mic(0.5), "Haemophilus parainfluenzae", "CIP", "EUCAST 2026"), "R")
|
|
expect_identical(sir(as.disk(30), "Haemophilus parainfluenzae", "CIP", "EUCAST 2026"), NA_character_)
|
|
# cefoxitin screen: CoNS not identified to species level use S >= 25 mm, also with the regular agent if allowed (#328)
|
|
expect_identical(sir(as.disk(23), "B_STPHY_CONS", "FOX", "EUCAST 2026", include_screening = TRUE), "R")
|
|
expect_identical(sir(as.disk(23), "Staphylococcus hominis", "FOX", "EUCAST 2026", include_screening = TRUE), "S")
|
|
expect_identical(sir(as.disk(26), "Staphylococcus epidermidis", "FOX", "EUCAST 2026", include_screening = TRUE), "R")
|
|
expect_identical(sir(as.disk(26), "Staphylococcus epidermidis", "FOX", "EUCAST 2026"), NA_character_)
|
|
# topical screening cut-off values do not replace systemic breakpoints
|
|
expect_identical(sir(as.mic(0.5), "Staphylococcus aureus", "FUS", "EUCAST 2026"), "S")
|
|
# off-scale breakpoint S <= 0.001 mg/L categorises wild type isolates as I
|
|
expect_identical(sir(as.mic(0.0005), "Pseudomonas aeruginosa", "CIP", "EUCAST 2026"), "I")
|
|
# EUCAST's 0.06 mg/L is the dilution 0.0625, i.e. 0.064 in this package
|
|
expect_identical(sir(as.mic(0.064), "Haemophilus influenzae", "LVX", "EUCAST 2026"), "S")
|
|
# high-level gentamicin resistance (screening test given in the notes), under both codes (#328)
|
|
expect_identical(sir(as.mic(256), "Enterococcus faecium", "GEH", "EUCAST 2026"), "R")
|
|
expect_identical(sir(as.mic(256), "Enterococcus faecium", "GEN-S", "EUCAST 2026"), "R")
|
|
# breakpoints in brackets are not in the data set (#327), so a UTI breakpoint is used if uti is unknown and nothing else is available, which is noted every time
|
|
sir_interpretation_history(clean = TRUE)
|
|
expect_identical(sir(as.mic(4), "Acinetobacter baumannii", "AMK", "EUCAST 2026"), "S")
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
expect_match(sir_history$notes, "only available for (uncomplicated) urinary tract infections", fixed = TRUE)
|
|
expect_identical(sir(as.mic(4), "Acinetobacter baumannii", "AMK", "EUCAST 2026", uti = FALSE), NA_character_)
|
|
expect_identical(sir(as.mic(4), "Acinetobacter baumannii", "AMK", "EUCAST 2026", uti = TRUE), "S")
|
|
# without a breakpoint in brackets, PK-PD breakpoints apply if EUCAST has these, as in EUCAST 2023 for aminoglycosides
|
|
sir_interpretation_history(clean = TRUE)
|
|
expect_identical(sir(as.mic(0.5), "Escherichia coli", "AMK", "EUCAST 2023", uti = FALSE), "S")
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
expect_match(sir_history$ref_table, "PK PD", fixed = TRUE)
|
|
# and the breakpoints of a broader taxon for another route, of which the site is noted
|
|
sir_interpretation_history(clean = TRUE)
|
|
expect_identical(sir(as.mic(4), "Enterococcus faecalis", "AMX", "EUCAST 2026", uti = FALSE), "S")
|
|
expect_identical(sir_interpretation_history(clean = TRUE)$site, "Intravenous")
|
|
# an organism that a table excludes stays excluded, also if EUCAST has breakpoints in brackets for it
|
|
expect_identical(sir(as.mic(1), "Bacillus anthracis", "VAN", "EUCAST 2026"), NA_character_)
|
|
# UTI breakpoints are only used for unknown uti if there are no non-UTI breakpoints, which is noted every time
|
|
for (i in 1:2) {
|
|
sir_interpretation_history(clean = TRUE)
|
|
expect_identical(sir(as.mic(16), "Escherichia coli", "NTR", "EUCAST 2026"), "S")
|
|
sir_history <- sir_interpretation_history(clean = TRUE)
|
|
expect_match(sir_history$notes, "only available for (uncomplicated) urinary tract infections", fixed = TRUE)
|
|
}
|
|
expect_identical(sir(as.mic(16), "Escherichia coli", "NTR", "EUCAST 2026", uti = FALSE), NA_character_)
|
|
# the blocking row of Enterobacterales does not override the UTI breakpoint for E. coli itself
|
|
expect_identical(sir(as.mic(2), "Escherichia coli", "CZO", "EUCAST 2026"), "I")
|
|
# with UTI and non-UTI breakpoints, unknown uti takes the non-UTI breakpoint
|
|
expect_identical(sir(as.mic(c(2, 8, 32)), "Escherichia coli", "CZO", "CLSI 2025"), c("S", "R", "R"))
|
|
expect_identical(sir(as.mic(c(2, 8, 32)), "Escherichia coli", "CZO", "CLSI 2025", uti = TRUE), c("S", "S", "R"))
|
|
})
|