P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 23:21:56 +02:00
Code Releases Activity

(v2.1.1.9186) replace antibiotics with antimicrobials!

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-03-07 20:43:26 +01:00
parent f2b2a450cb
commit f7938289eb
140 changed files with 4870 additions and 4702 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
tests/testthat/helper-functions.R Normal file
View File

@ -0,0 +1,38 @@
# ==================================================================== #
# 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://msberends.github.io/AMR/ #
# ==================================================================== #
# add functions from the tinytest package (which we use for older R versions)
expect_inherits <- function(x, y, ...) {
expect(inherits(x, y),
failure_message = paste0(
"object has class ", paste0(class(x), collapse = "/"),
", required is class ", paste0(y, collapse = "/")
)
)
}

6
tests/testthat/test-_deprecated.R
View File

@ -27,5 +27,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_warning(example_isolates[, ab_class("mycobact")])
expect_warning(example_isolates[, ab_selector(name %like% "trim")])
test_that("deprecated works", {
expect_warning(example_isolates[, ab_class("mycobact")])
expect_warning(example_isolates[, ab_selector(name %like% "trim")])
})

116
tests/testthat/test-_misc.R
View File

@ -27,70 +27,72 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(AMR:::percentage(0.25), "25%")
expect_equal(AMR:::percentage(0.5), "50%")
expect_equal(AMR:::percentage(0.500, digits = 1), "50.0%")
expect_equal(AMR:::percentage(0.1234), "12.3%")
# round up 0.5
expect_equal(AMR:::percentage(0.0054), "0.5%")
expect_equal(AMR:::percentage(0.0055), "0.6%")
test_that("misc works", {
expect_equal(AMR:::percentage(0.25), "25%")
expect_equal(AMR:::percentage(0.5), "50%")
expect_equal(AMR:::percentage(0.500, digits = 1), "50.0%")
expect_equal(AMR:::percentage(0.1234), "12.3%")
# round up 0.5
expect_equal(AMR:::percentage(0.0054), "0.5%")
expect_equal(AMR:::percentage(0.0055), "0.6%")
# test functions on all R versions - R < 3.3 did not contain these
expect_equal(strrep("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test")
expect_equal(AMR:::trimws2(" test "), "test")
expect_equal(AMR:::trimws2(" test ", "l"), "test ")
expect_equal(AMR:::trimws2(" test ", "r"), " test")
# test functions on all R versions - R < 3.3 did not contain these
expect_equal(strrep("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test")
expect_equal(AMR:::trimws2(" test "), "test")
expect_equal(AMR:::trimws2(" test ", "l"), "test ")
expect_equal(AMR:::trimws2(" test ", "r"), " test")
expect_message(AMR:::get_column_abx(example_isolates, soft_dependencies = "FUS"))
expect_message(AMR:::get_column_abx(example_isolates, soft_dependencies = "FUS"))
# we rely on "grouped_tbl" being a class of grouped tibbles, so run a test that checks for this:
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(ward)))
}
# test get_current_data() ----
is_right <- FALSE
check_df <- function(check_element, return_val = 0) {
is_right <<- FALSE
for (env in sys.frames()) {
if (!is.null(env[[check_element]]) && is.data.frame(env[[check_element]])) {
is_right <<- TRUE
}
# we rely on "grouped_tbl" being a class of grouped tibbles, so run a test that checks for this:
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_true(AMR:::is_null_or_grouped_tbl(example_isolates %>% group_by(ward)))
}
return_val
}
df <- example_isolates[, check_df("x")]
expect_true(is_right, info = "the environmental data cannot be found for base/x (1)")
if (getRversion() < "4.0.0") {
df <- example_isolates[c(1:3), check_df("xx")]
expect_true(is_right, info = "the environmental data cannot be found for base/xx")
} else {
df <- example_isolates[c(1:3), check_df("x")]
expect_true(is_right, info = "the environmental data cannot be found for base/x (2)")
}
# test get_current_data() ----
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
df <- example_isolates %>% select(mo, check_df("data123"))
expect_false(is_right, info = "just a check if non-sense is not being gathered by get_current_data()")
is_right <- FALSE
check_df <- function(check_element, return_val = 0) {
is_right <<- FALSE
for (env in sys.frames()) {
if (!is.null(env[[check_element]]) && is.data.frame(env[[check_element]])) {
is_right <<- TRUE
}
}
return_val
}
df <- example_isolates %>% select(mo, check_df(".data"))
expect_true(is_right, info = "the environmental data cannot be found for dplyr/select()")
df <- example_isolates[, check_df("x")]
expect_true(is_right, info = "the environmental data cannot be found for base/x (1)")
df <- example_isolates %>% select_at(check_df(".tbl"))
expect_true(is_right, info = "the environmental data cannot be found for dplyr/select_at()")
}
if (getRversion() < "4.0.0") {
df <- example_isolates[c(1:3), check_df("xx")]
expect_true(is_right, info = "the environmental data cannot be found for base/xx")
} else {
df <- example_isolates[c(1:3), check_df("x")]
expect_true(is_right, info = "the environmental data cannot be found for base/x (2)")
}
if (AMR:::pkg_is_available("tidymodels", also_load = TRUE)) {
resistance_recipe <- recipe(mo ~ ., data = example_isolates) %>%
step_corr(check_df("training")) %>%
prep()
expect_true(is_right, info = "the environmental data cannot be found for tidymodels/prep()")
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
df <- example_isolates %>% select(mo, check_df("data123"))
expect_false(is_right, info = "just a check if non-sense is not being gathered by get_current_data()")
df <- example_isolates %>% select(mo, check_df(".data"))
expect_true(is_right, info = "the environmental data cannot be found for dplyr/select()")
df <- example_isolates %>% select_at(check_df(".tbl"))
expect_true(is_right, info = "the environmental data cannot be found for dplyr/select_at()")
}
if (AMR:::pkg_is_available("tidymodels", also_load = TRUE)) {
resistance_recipe <- recipe(mo ~ ., data = example_isolates) %>%
step_corr(check_df("training")) %>%
prep()
expect_true(is_right, info = "the environmental data cannot be found for tidymodels/prep()")
}
})

132
tests/testthat/test-ab.R
View File

@ -27,80 +27,82 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
ab_reset_session()
test_that("ab works", {
ab_reset_session()
expect_equal(
as.character(as.ab(c(
"J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"
))),
rep("ERY", 9)
)
expect_equal(
as.character(as.ab(c(
"J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"
))),
rep("ERY", 9)
)
expect_identical(class(as.ab("amox")), c("ab", "character"))
expect_identical(class(antibiotics$ab), c("ab", "character"))
expect_true(is.ab(as.ab("amox")))
expect_stdout(print(as.ab("amox")))
expect_stdout(print(data.frame(a = as.ab("amox"))))
expect_identical(class(as.ab("amox")), c("ab", "character"))
expect_identical(class(AMR::antimicrobials$ab), c("ab", "character"))
expect_true(is.ab(as.ab("amox")))
expect_output(print(as.ab("amox")))
expect_output(print(data.frame(a = as.ab("amox"))))
expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
# expect_warning(as.ab("UNKNOWN"))
expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
# expect_warning(as.ab("UNKNOWN"))
expect_stdout(print(as.ab("amox")))
expect_output(print(as.ab("amox")))
expect_equal(
as.character(as.ab("Phloxapen")),
"FLC"
)
expect_equal(
as.character(as.ab("Phloxapen")),
"FLC"
)
expect_equal(
suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))),
c(NA, "TMP")
)
expect_equal(
suppressWarnings(as.character(as.ab(c("Bacteria", "Bacterial")))),
c(NA, "TMP")
)
expect_equal(
as.character(as.ab("Amoxy + clavulaanzuur")),
"AMC"
)
expect_equal(
as.character(as.ab("Amoxy + clavulaanzuur")),
"AMC"
)
expect_equal(
as.character(as.ab(c("mreopenem", "co-maoxiclav"))),
c("MEM", "AMC")
)
expect_equal(
as.character(as.ab(c("mreopenem", "co-maoxiclav"))),
c("MEM", "AMC")
)
# expect_warning(as.ab("cipro mero"))
# expect_warning(as.ab("cipro mero"))
# based on Levenshtein distance
expect_identical(ab_name("ceftazidim/avibactam", language = NULL), "Ceftazidime/avibactam")
# based on Levenshtein distance
expect_identical(ab_name("ceftazidim/avibactam", language = NULL), "Ceftazidime/avibactam")
expect_identical(
as.character(as.ab(c(
"gentamicine High Level",
"gentamicine High",
"gentamicine (High Level)",
"gentamicine (High)",
"gentamicine HL",
"gentamicine H-L",
"gentamicine (HL)",
"gentamicine (H-L)"
))),
rep("GEH", 8)
)
expect_identical(
as.character(as.ab(c(
"gentamicine High Level",
"gentamicine High",
"gentamicine (High Level)",
"gentamicine (High)",
"gentamicine HL",
"gentamicine H-L",
"gentamicine (HL)",
"gentamicine (H-L)"
))),
rep("GEH", 8)
)
# assigning and subsetting
x <- antibiotics$ab
expect_inherits(x[1], "ab")
expect_inherits(x[[1]], "ab")
expect_inherits(c(x[1], x[9]), "ab")
expect_inherits(unique(x[1], x[9]), "ab")
expect_inherits(rep(x[1], 2), "ab")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
# assigning and subsetting
x <- AMR::antimicrobials$ab
expect_inherits(x[1], "ab")
expect_inherits(x[[1]], "ab")
expect_inherits(c(x[1], x[9]), "ab")
expect_inherits(unique(x[1], x[9]), "ab")
expect_inherits(rep(x[1], 2), "ab")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
})

60
tests/testthat/test-ab_from_text.R
View File

@ -27,34 +27,36 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
ab_reset_session()
test_that("ab_from_text works", {
ab_reset_session()
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin"
)
expect_identical(
ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP"
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin"
)
expect_identical(
ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP"
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", type = "dose")[[1]],
500
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral"
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", type = "dose")[[1]],
500
)
expect_identical(
ab_from_text("28/03/2020 amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral"
)
})

124
tests/testthat/test-ab_property.R
View File

@ -27,72 +27,74 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
ab_reset_session()
test_that("ab_property works", {
ab_reset_session()
expect_identical(ab_name("AMX", language = NULL), "Amoxicillin")
expect_identical(ab_atc("AMX"), "J01CA04")
expect_identical(ab_cid("AMX"), as.integer(33613))
expect_identical(ab_name("AMX", language = NULL), "Amoxicillin")
expect_identical(ab_atc("AMX"), "J01CA04")
expect_identical(ab_cid("AMX"), as.integer(33613))
expect_inherits(ab_tradenames("AMX"), "character")
expect_inherits(ab_tradenames(c("AMX", "AMX")), "list")
expect_inherits(ab_tradenames("AMX"), "character")
expect_inherits(ab_tradenames(c("AMX", "AMX")), "list")
expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins")
expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins")
expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum")
expect_identical(ab_group("AMX", language = NULL), "Beta-lactams/penicillins")
expect_identical(ab_atc_group1("AMX", language = NULL), "Beta-lactam antibacterials, penicillins")
expect_identical(ab_atc_group2("AMX", language = NULL), "Penicillins with extended spectrum")
expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin")
expect_identical(ab_name(21319, language = NULL), "Flucloxacillin")
expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin")
expect_identical(ab_name("Fluclox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("fluklox", language = NULL), "Flucloxacillin")
expect_identical(ab_name("floxapen", language = NULL), "Flucloxacillin")
expect_identical(ab_name(21319, language = NULL), "Flucloxacillin")
expect_identical(ab_name("J01CF05", language = NULL), "Flucloxacillin")
expect_identical(ab_ddd("AMX", "oral"), 1.5)
expect_identical(ab_ddd_units("AMX", "iv"), "g")
expect_identical(ab_ddd("AMX", "iv"), 3)
expect_identical(ab_ddd("AMX", "oral"), 1.5)
expect_identical(ab_ddd_units("AMX", "iv"), "g")
expect_identical(ab_ddd("AMX", "iv"), 3)
expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
expect_identical(
ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B")
)
expect_inherits(ab_info("AMX"), "list")
expect_error(ab_property("amox", "invalid property"))
expect_error(ab_name("amox", language = "INVALID"))
expect_stdout(print(ab_name("amox", language = NULL)))
expect_equal(ab_name("21066-6", language = NULL), "Ampicillin")
expect_equal(
ab_loinc("ampicillin"),
c("101477-8", "101478-6", "18864-9", "18865-6", "20374-5", "21066-6", "23618-2", "27-3", "28-1", "29-9", "30-7", "31-5", "32-3", "33-1", "3355-5", "33562-0", "33919-2", "34-9", "43883-8", "43884-6", "6979-9", "6980-7", "87604-5")
)
expect_true(ab_url("AMX") %like% "fhi[.]no")
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22])),
c("cefoxitin", "cefotaxime", "ceftazidime", "ceftriaxone", "gentamicin", "tobramycin")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22], language = "nl", snake_case = FALSE)),
c("Cefoxitine", "Cefotaxim", "Ceftazidim", "Ceftriaxon", "Gentamicine", "Tobramycine")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22], property = "atc")),
c("J01DC01", "J01DD01", "J01DD02", "J01DD04", "J01GB03", "J01GB01")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
expect_identical(
example_isolates %>% set_ab_names(),
example_isolates %>% rename_with(set_ab_names)
ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B")
)
expect_true(all(c(
"SXT", "nitrofurantoin", "fosfomycin", "linezolid", "ciprofloxacin",
"moxifloxacin", "vancomycin", "TEC"
) %in%
(example_isolates %>%
set_ab_names(NIT:VAN) %>%
colnames())))
}
expect_inherits(ab_info("AMX"), "list")
expect_error(ab_property("amox", "invalid property"))
expect_error(ab_name("amox", language = "INVALID"))
expect_output(print(ab_name("amox", language = NULL)))
expect_equal(ab_name("21066-6", language = NULL), "Ampicillin")
expect_equal(
ab_loinc("ampicillin"),
c("101477-8", "101478-6", "18864-9", "18865-6", "20374-5", "21066-6", "23618-2", "27-3", "28-1", "29-9", "30-7", "31-5", "32-3", "33-1", "3355-5", "33562-0", "33919-2", "34-9", "43883-8", "43884-6", "6979-9", "6980-7", "87604-5")
)
expect_true(ab_url("AMX") %like% "fhi[.]no")
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22])),
c("cefoxitin", "cefotaxime", "ceftazidime", "ceftriaxone", "gentamicin", "tobramycin")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22], language = "nl", snake_case = FALSE)),
c("Cefoxitine", "Cefotaxim", "Ceftazidim", "Ceftriaxon", "Gentamicine", "Tobramycine")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22], property = "atc")),
c("J01DC01", "J01DD01", "J01DD02", "J01DD04", "J01GB03", "J01GB01")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_identical(
example_isolates %>% set_ab_names(),
example_isolates %>% rename_with(set_ab_names)
)
expect_true(all(c(
"SXT", "nitrofurantoin", "fosfomycin", "linezolid", "ciprofloxacin",
"moxifloxacin", "vancomycin", "TEC"
) %in%
(example_isolates %>%
set_ab_names(NIT:VAN) %>%
colnames())))
}
})

114
tests/testthat/test-age.R
View File

@ -27,69 +27,71 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(
age(
test_that("age works", {
expect_equal(
age(
x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "2019-01-01"
),
c(39, 34, 29)
)
expect_equal(
age(
x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01",
exact = TRUE
),
c(0.6656393, 0.4191781, 0.1698630),
tolerance = 0.001
)
expect_error(age(
x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "2019-01-01"
),
c(39, 34, 29)
)
reference = c("2019-01-01", "2019-01-01")
))
expect_equal(
age(
x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01",
exact = TRUE
),
c(0.6656393, 0.4191781, 0.1698630),
tolerance = 0.001
)
# expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), reference = "1975-01-01"))
# expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"), reference = "2019-01-01"))
expect_error(age(
x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = c("2019-01-01", "2019-01-01")
))
# expect_warning(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"), reference = "1975-01-01"))
# expect_warning(age(x = c("1800-01-01", "1805-01-01", "1810-01-01"), reference = "2019-01-01"))
expect_equal(
length(age(x = c("2019-01-01", NA), na.rm = TRUE)),
1
)
expect_equal(
length(age(x = c("2019-01-01", NA), na.rm = TRUE)),
1
)
ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
ages <- c(3, 8, 16, 54, 31, 76, 101, 43, 21)
expect_equal(
length(unique(age_groups(ages, 50))),
2
)
expect_equal(
length(unique(age_groups(ages, c(50, 60)))),
3
)
expect_identical(
class(age_groups(ages, "child")),
c("ordered", "factor")
)
expect_equal(
length(unique(age_groups(ages, 50))),
2
)
expect_equal(
length(unique(age_groups(ages, c(50, 60)))),
3
)
expect_identical(
class(age_groups(ages, "child")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "elderly")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "elderly")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "tens")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "tens")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "fives")),
c("ordered", "factor")
)
expect_identical(
class(age_groups(ages, "fives")),
c("ordered", "factor")
)
expect_equal(
length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)),
3
)
expect_equal(
length(age_groups(c(10, 20, 30, NA), na.rm = TRUE)),
3
)
})

156
tests/testthat/test-amr_selectors.R
View File

@ -27,90 +27,92 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# antibiotic class selectors
expect_equal(ncol(example_isolates[, amr_class("antimyco"), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, amr_selector(name %like% "trim"), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, aminoglycosides(), drop = FALSE]), 4, tolerance = 0.5)
expect_equal(ncol(example_isolates[, aminopenicillins(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, betalactams(), drop = FALSE]), 16, tolerance = 0.5)
expect_equal(ncol(example_isolates[, carbapenems(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins(), drop = FALSE]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_1st(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_2nd(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_3rd(), drop = FALSE]), 3, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_4th(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_5th(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, fluoroquinolones(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, glycopeptides(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, isoxazolylpenicillins(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, lincosamides(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, lipoglycopeptides(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, macrolides(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, monobactams(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, nitrofurans(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, oxazolidinones(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, penicillins(), drop = FALSE]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, phenicols(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, polymyxins(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, rifamycins(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, streptogramins(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, quinolones(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, tetracyclines(), drop = FALSE]), 3, tolerance = 0.5)
expect_equal(ncol(example_isolates[, trimethoprims(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, ureidopenicillins(), drop = FALSE]), 1, tolerance = 0.5)
test_that("amr selectors works", {
# antibiotic class selectors
expect_equal(ncol(example_isolates[, amr_class("antimyco"), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, amr_selector(name %like% "trim"), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, aminoglycosides(), drop = FALSE]), 4, tolerance = 0.5)
expect_equal(ncol(example_isolates[, aminopenicillins(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, betalactams(), drop = FALSE]), 16, tolerance = 0.5)
expect_equal(ncol(example_isolates[, carbapenems(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins(), drop = FALSE]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_1st(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_2nd(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_3rd(), drop = FALSE]), 3, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_4th(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, cephalosporins_5th(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, fluoroquinolones(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, glycopeptides(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, isoxazolylpenicillins(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, lincosamides(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, lipoglycopeptides(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, macrolides(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, monobactams(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, nitrofurans(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, oxazolidinones(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, penicillins(), drop = FALSE]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, phenicols(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, polymyxins(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, rifamycins(), drop = FALSE]), 1, tolerance = 0.5)
expect_equal(ncol(example_isolates[, streptogramins(), drop = FALSE]), 0, tolerance = 0.5)
expect_equal(ncol(example_isolates[, quinolones(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, tetracyclines(), drop = FALSE]), 3, tolerance = 0.5)
expect_equal(ncol(example_isolates[, trimethoprims(), drop = FALSE]), 2, tolerance = 0.5)
expect_equal(ncol(example_isolates[, ureidopenicillins(), drop = FALSE]), 1, tolerance = 0.5)
expect_message(expect_stdout(print(carbapenems())))
expect_error(administrable_per_os())
expect_message(expect_output(print(carbapenems())))
expect_error(administrable_per_os())
# Examples:
# Examples:
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
expect_equal(ncol(example_isolates[, c("mo", aminoglycosides())]), 5, tolerance = 0.5)
# select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB'
expect_equal(ncol(example_isolates[, c("mo", aminoglycosides())]), 5, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_per_os() & penicillins())]), 5, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_iv() & penicillins())]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_iv() | penicillins())]), 37, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_per_os() & penicillins())]), 5, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_iv() & penicillins())]), 7, tolerance = 0.5)
expect_equal(ncol(example_isolates[, c(administrable_iv() | penicillins())]), 37, tolerance = 0.5)
# filter using any() or all()
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), ]), 55, tolerance = 0.5)
expect_equal(nrow(subset(example_isolates, any(carbapenems() == "R"))), 55, tolerance = 0.5)
# filter using any() or all()
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), ]), 55, tolerance = 0.5)
expect_equal(nrow(subset(example_isolates, any(carbapenems() == "R"))), 55, tolerance = 0.5)
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
expect_equal(nrow(example_isolates[any(carbapenems()), ]), 962, tolerance = 0.5)
expect_equal(nrow(example_isolates[all(carbapenems()), ]), 756, tolerance = 0.5)
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), ]), 55, tolerance = 0.5)
expect_equal(nrow(example_isolates[any(carbapenems() != "R"), ]), 910, tolerance = 0.5)
expect_equal(nrow(example_isolates[carbapenems() != "R", ]), 704, tolerance = 0.5)
# filter on any or all results in the carbapenem columns (i.e., IPM, MEM):
expect_equal(nrow(example_isolates[any(carbapenems()), ]), 962, tolerance = 0.5)
expect_equal(nrow(example_isolates[all(carbapenems()), ]), 756, tolerance = 0.5)
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), ]), 55, tolerance = 0.5)
expect_equal(nrow(example_isolates[any(carbapenems() != "R"), ]), 910, tolerance = 0.5)
expect_equal(nrow(example_isolates[carbapenems() != "R", ]), 704, tolerance = 0.5)
# filter with multiple antibiotic selectors using c()
expect_equal(nrow(example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]), 26, tolerance = 0.5)
# filter with multiple antibiotic selectors using c()
expect_equal(nrow(example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]), 26, tolerance = 0.5)
# filter + select in one go: get penicillins in carbapenems-resistant strains
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), penicillins()]), 55, tolerance = 0.5)
expect_equal(ncol(example_isolates[any(carbapenems() == "R"), penicillins()]), 7, tolerance = 0.5)
# filter + select in one go: get penicillins in carbapenems-resistant strains
expect_equal(nrow(example_isolates[any(carbapenems() == "R"), penicillins()]), 55, tolerance = 0.5)
expect_equal(ncol(example_isolates[any(carbapenems() == "R"), penicillins()]), 7, tolerance = 0.5)
x <- data.frame(
x = 0,
mo = 0,
gen = "S",
genta = "S",
J01GB03 = "S",
tobra = "S",
Tobracin = "S"
)
# should have the first hits
expect_identical(
colnames(x[, aminoglycosides(return_all = FALSE)]),
c("gen", "tobra")
)
expect_identical(
colnames(x[, aminoglycosides()]),
c("gen", "genta", "J01GB03", "tobra", "Tobracin")
)
x <- data.frame(
x = 0,
mo = 0,
gen = "S",
genta = "S",
J01GB03 = "S",
tobra = "S",
Tobracin = "S"
)
# should have the first hits
expect_identical(
colnames(x[, aminoglycosides(return_all = FALSE)]),
c("gen", "tobra")
)
expect_identical(
colnames(x[, aminoglycosides()]),
c("gen", "genta", "J01GB03", "tobra", "Tobracin")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% select(administrable_per_os() & penicillins()) %>% ncol(), 5, tolerance = 0.5)
expect_equal(example_isolates %>% select(administrable_iv() & penicillins()) %>% ncol(), 7, tolerance = 0.5)
expect_equal(example_isolates %>% select(administrable_iv() | penicillins()) %>% ncol(), 37, tolerance = 0.5)
# expect_warning(example_isolates %>% select(GEH = GEN) %>% select(aminoglycosides(only_treatable = TRUE)))
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% select(administrable_per_os() & penicillins()) %>% ncol(), 5, tolerance = 0.5)
expect_equal(example_isolates %>% select(administrable_iv() & penicillins()) %>% ncol(), 7, tolerance = 0.5)
expect_equal(example_isolates %>% select(administrable_iv() | penicillins()) %>% ncol(), 37, tolerance = 0.5)
# expect_warning(example_isolates %>% select(GEH = GEN) %>% select(aminoglycosides(only_treatable = TRUE)))
}
})

217
tests/testthat/test-antibiogram.R
View File

@ -27,130 +27,131 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
test_that("antibiogram works", {
# Traditional antibiogram ----------------------------------------------
# Traditional antibiogram ----------------------------------------------
ab1 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems())
)
ab1 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems())
)
ab2 <- antibiogram(example_isolates,
antibiotics = aminoglycosides(),
ab_transform = "atc",
mo_transform = "gramstain",
add_total_n = TRUE
)
ab2 <- antibiogram(example_isolates,
antibiotics = aminoglycosides(),
ab_transform = "atc",
mo_transform = "gramstain",
add_total_n = TRUE
)
ab3 <- antibiogram(example_isolates,
antibiotics = carbapenems(),
ab_transform = "ab",
mo_transform = "name",
formatting_type = 1
)
ab3 <- antibiogram(example_isolates,
antibiotics = carbapenems(),
ab_transform = "ab",
mo_transform = "name",
formatting_type = 1
)
expect_inherits(ab1, "antibiogram")
expect_inherits(ab2, "antibiogram")
expect_inherits(ab3, "antibiogram")
expect_equal(colnames(ab1), c("Pathogen", "Amikacin", "Gentamicin", "Imipenem", "Kanamycin", "Meropenem", "Tobramycin"))
expect_equal(colnames(ab2), c("Pathogen (N min-max)", "J01GB01", "J01GB03", "J01GB04", "J01GB06"))
expect_equal(colnames(ab3), c("Pathogen", "IPM", "MEM"))
expect_equal(ab3$MEM, c(52, NA, 100, 100, NA))
expect_inherits(ab1, "antibiogram")
expect_inherits(ab2, "antibiogram")
expect_inherits(ab3, "antibiogram")
expect_equal(colnames(ab1), c("Pathogen", "Amikacin", "Gentamicin", "Imipenem", "Kanamycin", "Meropenem", "Tobramycin"))
expect_equal(colnames(ab2), c("Pathogen (N min-max)", "J01GB01", "J01GB03", "J01GB04", "J01GB06"))
expect_equal(colnames(ab3), c("Pathogen", "IPM", "MEM"))
expect_equal(ab3$MEM, c(52, NA, 100, 100, NA))
# Combined antibiogram -------------------------------------------------
# Combined antibiogram -------------------------------------------------
# combined antibiotics yield higher empiric coverage
ab4 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain"
)
# combined antibiotics yield higher empiric coverage
ab4 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
mo_transform = "gramstain"
)
ab5 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain",
ab_transform = "name",
sep = " & ",
add_total_n = FALSE
)
ab5 <- antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB"),
mo_transform = "gramstain",
ab_transform = "name",
sep = " & ",
add_total_n = FALSE
)
expect_inherits(ab4, "antibiogram")
expect_inherits(ab5, "antibiogram")
expect_equal(colnames(ab4), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam & Tobramycin"))
expect_inherits(ab4, "antibiogram")
expect_inherits(ab5, "antibiogram")
expect_equal(colnames(ab4), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
expect_equal(colnames(ab5), c("Pathogen", "Piperacillin/tazobactam", "Piperacillin/tazobactam & Tobramycin"))
# Syndromic antibiogram ------------------------------------------------
# Syndromic antibiogram ------------------------------------------------
# the data set could contain a filter for e.g. respiratory specimens
ab6 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward",
ab_transform = NULL
)
# the data set could contain a filter for e.g. respiratory specimens
ab6 <- antibiogram(example_isolates,
antibiotics = c(aminoglycosides(), carbapenems()),
syndromic_group = "ward",
ab_transform = NULL
)
# with a custom language, though this will be determined automatically
# (i.e., this table will be in Dutch on Dutch systems)
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
ab7 <- antibiogram(ex1,
antibiotics = aminoglycosides(),
ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU",
"IC", "Geen IC"
),
language = "nl",
add_total_n = TRUE
)
# with a custom language, though this will be determined automatically
# (i.e., this table will be in Dutch on Dutch systems)
ex1 <- example_isolates[which(mo_genus() == "Escherichia"), ]
ab7 <- antibiogram(ex1,
antibiotics = aminoglycosides(),
ab_transform = "name",
syndromic_group = ifelse(ex1$ward == "ICU",
"IC", "Geen IC"
),
language = "nl",
add_total_n = TRUE
)
expect_inherits(ab6, "antibiogram")
expect_inherits(ab7, "antibiogram")
expect_equal(colnames(ab6), c("Syndromic Group", "Pathogen", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
expect_equal(colnames(ab7), c("Syndroomgroep", "Pathogeen (N min-max)", "Amikacine", "Gentamicine", "Tobramycine"))
expect_inherits(ab6, "antibiogram")
expect_inherits(ab7, "antibiogram")
expect_equal(colnames(ab6), c("Syndromic Group", "Pathogen", "AMK", "GEN", "IPM", "KAN", "MEM", "TOB"))
expect_equal(colnames(ab7), c("Syndroomgroep", "Pathogeen (N min-max)", "Amikacine", "Gentamicine", "Tobramycine"))
# Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# Weighted-incidence syndromic combination antibiogram (WISCA) ---------
# the data set could contain a filter for e.g. respiratory specimens
ab8 <- suppressWarnings(antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
wisca = TRUE
))
# the data set could contain a filter for e.g. respiratory specimens
ab8 <- suppressWarnings(antibiogram(example_isolates,
antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"),
wisca = TRUE
))
expect_inherits(ab8, "antibiogram")
expect_equal(colnames(ab8), c("Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
expect_inherits(ab8, "antibiogram")
expect_equal(colnames(ab8), c("Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
# grouped tibbles
# grouped tibbles
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
ab9 <- example_isolates %>%
group_by(ward, gender) %>%
wisca(antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
expect_equal(colnames(ab9), c("ward", "gender", "Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
}
# Generate plots with ggplot2 or base R --------------------------------
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(ab1))
expect_silent(plot(ab2))
expect_silent(plot(ab3))
expect_silent(plot(ab4))
expect_silent(plot(ab5))
expect_silent(plot(ab6))
expect_silent(plot(ab7))
expect_silent(plot(ab8))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_silent(plot(ab9))
}
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(ab1), "gg")
expect_inherits(ggplot2::autoplot(ab2), "gg")
expect_inherits(ggplot2::autoplot(ab3), "gg")
expect_inherits(ggplot2::autoplot(ab4), "gg")
expect_inherits(ggplot2::autoplot(ab5), "gg")
expect_inherits(ggplot2::autoplot(ab6), "gg")
expect_inherits(ggplot2::autoplot(ab7), "gg")
expect_inherits(ggplot2::autoplot(ab8), "gg")
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_inherits(ggplot2::autoplot(ab9), "gg")
ab9 <- example_isolates %>%
group_by(ward, gender) %>%
wisca(antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
expect_equal(colnames(ab9), c("ward", "gender", "Piperacillin/tazobactam", "Piperacillin/tazobactam + Gentamicin", "Piperacillin/tazobactam + Tobramycin"))
}
}
# Generate plots with ggplot2 or base R --------------------------------
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(ab1))
expect_silent(plot(ab2))
expect_silent(plot(ab3))
expect_silent(plot(ab4))
expect_silent(plot(ab5))
expect_silent(plot(ab6))
expect_silent(plot(ab7))
expect_silent(plot(ab8))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_silent(plot(ab9))
}
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(ab1), "gg")
expect_inherits(ggplot2::autoplot(ab2), "gg")
expect_inherits(ggplot2::autoplot(ab3), "gg")
expect_inherits(ggplot2::autoplot(ab4), "gg")
expect_inherits(ggplot2::autoplot(ab5), "gg")
expect_inherits(ggplot2::autoplot(ab6), "gg")
expect_inherits(ggplot2::autoplot(ab7), "gg")
expect_inherits(ggplot2::autoplot(ab8), "gg")
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_inherits(ggplot2::autoplot(ab9), "gg")
}
}
})

20
tests/testthat/test-atc_online.R
View File

@ -27,12 +27,14 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
if (AMR:::pkg_is_available("curl") &&
AMR:::pkg_is_available("rvest") &&
AMR:::pkg_is_available("xml2") &&
tryCatch(curl::has_internet(), error = function(e) FALSE)) {
expect_true(length(atc_online_groups(ab_atc("AMX"))) >= 1)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "P"), 3)
expect_equal(atc_online_ddd_units("AMX", administration = "P"), "g")
}
test_that("atc_online works", {
if (AMR:::pkg_is_available("curl") &&
AMR:::pkg_is_available("rvest") &&
AMR:::pkg_is_available("xml2") &&
tryCatch(curl::has_internet(), error = function(e) FALSE)) {
expect_true(length(atc_online_groups(ab_atc("AMX"))) >= 1)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "O"), 1.5)
expect_equal(atc_online_ddd(ab_atc("AMX"), administration = "P"), 3)
expect_equal(atc_online_ddd_units("AMX", administration = "P"), "g")
}
})

88
tests/testthat/test-av.R
View File

@ -27,54 +27,56 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(
as.character(as.av(c(
"J05AB01",
"J 05 AB 01",
"Aciclovir",
"aciclo",
" aciclo 123",
"ACICL",
"ACI",
"Virorax",
"Zovirax"
))),
rep("ACI", 9)
)
test_that("av works", {
expect_equal(
as.character(as.av(c(
"J05AB01",
"J 05 AB 01",
"Aciclovir",
"aciclo",
" aciclo 123",
"ACICL",
"ACI",
"Virorax",
"Zovirax"
))),
rep("ACI", 9)
)
expect_identical(class(as.av("acic")), c("av", "character"))
expect_identical(class(antivirals$av), c("av", "character"))
expect_true(is.av(as.av("acic")))
expect_stdout(print(as.av("acic")))
expect_stdout(print(data.frame(a = as.av("acic"))))
expect_identical(class(as.av("acic")), c("av", "character"))
expect_identical(class(antivirals$av), c("av", "character"))
expect_true(is.av(as.av("acic")))
expect_output(print(as.av("acic")))
expect_output(print(data.frame(a = as.av("acic"))))
# expect_warning(as.av("J00AA00")) # ATC not yet available in data set
# expect_warning(as.av("UNKNOWN"))
# expect_warning(as.av("J00AA00")) # ATC not yet available in data set
# expect_warning(as.av("UNKNOWN"))
expect_stdout(print(as.av("acic")))
expect_output(print(as.av("acic")))
expect_equal(
as.character(as.av("zovirax")),
"ACI"
)
expect_equal(
as.character(as.av("zovirax")),
"ACI"
)
expect_equal(
as.character(as.av(c("Abacaivr", "Celvudine"))),
c("ABA", "CLE")
)
expect_equal(
as.character(as.av(c("Abacaivr", "Celvudine"))),
c("ABA", "CLE")
)
# expect_warning(as.av("Abacavir Clevudine"))
# expect_warning(as.av("Abacavir Clevudine"))
# based on Levenshtein distance
expect_identical(av_name("adevofir dypifo", language = NULL), "Adefovir dipivoxil")
# based on Levenshtein distance
expect_identical(av_name("adevofir dypifo", language = NULL), "Adefovir dipivoxil")
# assigning and subsetting
x <- antivirals$av
expect_inherits(x[1], "av")
expect_inherits(x[[1]], "av")
expect_inherits(c(x[1], x[9]), "av")
expect_inherits(unique(x[1], x[9]), "av")
expect_inherits(rep(x[1], 2), "av")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
# assigning and subsetting
x <- antivirals$av
expect_inherits(x[1], "av")
expect_inherits(x[[1]], "av")
expect_inherits(c(x[1], x[9]), "av")
expect_inherits(unique(x[1], x[9]), "av")
expect_inherits(rep(x[1], 2), "av")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
})

58
tests/testthat/test-av_from_text.R
View File

@ -27,32 +27,34 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds")[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", thorough_search = TRUE)[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", thorough_search = FALSE)[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", translate_av = TRUE)[[1]],
"Aciclovir"
)
expect_identical(
av_from_text("administered aciclo and valaciclo", collapse = ", ")[[1]],
"ACI, VALA"
)
test_that("av_from_text works", {
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds")[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", thorough_search = TRUE)[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", thorough_search = FALSE)[[1]],
as.av("Aciclovir")
)
expect_identical(
av_from_text("28/03/2020 regular aciclovir 500mg po tds", translate_av = TRUE)[[1]],
"Aciclovir"
)
expect_identical(
av_from_text("administered aciclo and valaciclo", collapse = ", ")[[1]],
"ACI, VALA"
)
expect_identical(
av_from_text("28/03/2020 regular aciclo 500mg po tds", type = "dose")[[1]],
500
)
expect_identical(
av_from_text("28/03/2020 regular aciclo 500mg po tds", type = "admin")[[1]],
"oral"
)
expect_identical(
av_from_text("28/03/2020 regular aciclo 500mg po tds", type = "dose")[[1]],
500
)
expect_identical(
av_from_text("28/03/2020 regular aciclo 500mg po tds", type = "admin")[[1]],
"oral"
)
})

52
tests/testthat/test-av_property.R
View File

@ -27,37 +27,39 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(av_name("ACI", language = NULL), "Aciclovir")
expect_identical(av_atc("ACI"), "J05AB01")
expect_identical(av_cid("ACI"), as.integer(135398513))
test_that("ab_property works", {
expect_identical(av_name("ACI", language = NULL), "Aciclovir")
expect_identical(av_atc("ACI"), "J05AB01")
expect_identical(av_cid("ACI"), as.integer(135398513))
expect_inherits(av_tradenames("ACI"), "character")
expect_inherits(av_tradenames(c("ACI", "ACI")), "list")
expect_inherits(av_tradenames("ACI"), "character")
expect_inherits(av_tradenames(c("ACI", "ACI")), "list")
expect_identical(av_group("ACI", language = NULL), "Nucleosides and nucleotides excl. reverse transcriptase inhibitors")
expect_identical(av_group("ACI", language = NULL), "Nucleosides and nucleotides excl. reverse transcriptase inhibitors")
expect_identical(av_name(135398513, language = NULL), "Aciclovir")
expect_identical(av_name("J05AB01", language = NULL), "Aciclovir")
expect_identical(av_name(135398513, language = NULL), "Aciclovir")
expect_identical(av_name("J05AB01", language = NULL), "Aciclovir")
expect_identical(av_ddd("ACI", "oral"), 4)
expect_identical(av_ddd_units("ACI", "iv"), "g")
expect_identical(av_ddd("ACI", "iv"), 4)
expect_identical(av_ddd("ACI", "oral"), 4)
expect_identical(av_ddd_units("ACI", "iv"), "g")
expect_identical(av_ddd("ACI", "iv"), 4)
expect_identical(
av_name(x = c("ACI", "VALA"), tolower = TRUE, language = NULL),
c("aciclovir", "valaciclovir")
)
expect_identical(
av_name(x = c("ACI", "VALA"), tolower = TRUE, language = NULL),
c("aciclovir", "valaciclovir")
)
expect_inherits(av_info("ACI"), "list")
expect_inherits(av_info("ACI"), "list")
expect_error(av_property("acic", "invalid property"))
expect_error(av_name("acic", language = "INVALID"))
expect_stdout(print(av_name("acic", language = NULL)))
expect_error(av_property("acic", "invalid property"))
expect_error(av_name("acic", language = "INVALID"))
expect_output(print(av_name("acic", language = NULL)))
expect_equal(av_name("29113-8", language = NULL), "Abacavir")
expect_equal(
av_loinc("Abacavir"),
c("29113-8", "30273-7", "30287-7", "30303-2", "78772-1", "78773-9", "79134-3", "80118-3")
)
expect_equal(av_name("29113-8", language = NULL), "Abacavir")
expect_equal(
av_loinc("Abacavir"),
c("29113-8", "30273-7", "30287-7", "30303-2", "78772-1", "78773-9", "79134-3", "80118-3")
)
expect_true(av_url("ACI") %like% "fhi[.]no")
expect_true(av_url("ACI") %like% "fhi[.]no")
})

4
tests/testthat/test-availability.R
View File

@ -27,4 +27,6 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_inherits(availability(example_isolates), "data.frame")
test_that("availibility works", {
expect_inherits(availability(example_isolates), "data.frame")
})

24
tests/testthat/test-bug_drug_combinations.R
View File

@ -27,14 +27,16 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
b <- suppressWarnings(bug_drug_combinations(example_isolates))
expect_inherits(b, "bug_drug_combinations")
expect_stdout(suppressMessages(print(b)))
expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, add_ab_group = FALSE)))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_true(example_isolates %>%
group_by(ward) %>%
bug_drug_combinations(FUN = mo_gramstain) %>%
is.data.frame())
}
test_that("bug/drug works", {
b <- suppressWarnings(bug_drug_combinations(example_isolates))
expect_inherits(b, "bug_drug_combinations")
expect_output(suppressMessages(print(b)))
expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, add_ab_group = FALSE)))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_true(example_isolates %>%
group_by(ward) %>%
bug_drug_combinations(FUN = mo_gramstain) %>%
is.data.frame())
}
})

154
tests/testthat/test-count.R
View File

@ -27,83 +27,85 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX))
expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX))
expect_equal(count_all(example_isolates$AMX), n_sir(example_isolates$AMX))
test_that("count works", {
expect_equal(count_resistant(example_isolates$AMX), count_R(example_isolates$AMX))
expect_equal(count_susceptible(example_isolates$AMX), count_SI(example_isolates$AMX))
expect_equal(count_all(example_isolates$AMX), n_sir(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(count_R(example_isolates$AMX), 804)
expect_equal(count_I(example_isolates$AMX), 3)
expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543)
expect_equal(
count_R(example_isolates$AMX) + count_I(example_isolates$AMX),
suppressWarnings(count_IR(example_isolates$AMX))
)
expect_equal(
suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX)
)
# warning for speed loss
# expect_warning(count_resistant(as.character(example_isolates$AMC)))
# expect_warning(count_resistant(example_isolates$AMC, as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date", 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_all(AMC, GEN, only_all_tested = TRUE), 1798)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936)
expect_identical(
example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE),
example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) +
example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE)
# AMX resistance in `example_isolates`
expect_equal(count_R(example_isolates$AMX), 804)
expect_equal(count_I(example_isolates$AMX), 3)
expect_equal(suppressWarnings(count_S(example_isolates$AMX)), 543)
expect_equal(
count_R(example_isolates$AMX) + count_I(example_isolates$AMX),
suppressWarnings(count_IR(example_isolates$AMX))
)
expect_equal(
suppressWarnings(count_S(example_isolates$AMX)) + count_I(example_isolates$AMX),
count_SI(example_isolates$AMX)
)
# count of cases
expect_equal(
example_isolates %>%
# warning for speed loss
# expect_warning(count_resistant(as.character(example_isolates$AMC)))
# expect_warning(count_resistant(example_isolates$AMC, as.character(example_isolates$GEN)))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
expect_error(count_resistant("test", as_percent = "test"))
expect_error(count_susceptible("test", minimum = "test"))
expect_error(count_susceptible("test", as_percent = "test"))
expect_error(count_df(c("A", "B", "C")))
expect_error(count_df(example_isolates[, "date", 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_all(AMC, GEN, only_all_tested = TRUE), 1798)
expect_equal(example_isolates %>% count_all(AMC, GEN, only_all_tested = FALSE), 1936)
expect_identical(
example_isolates %>% count_all(AMC, GEN, only_all_tested = TRUE),
example_isolates %>% count_susceptible(AMC, GEN, only_all_tested = TRUE) +
example_isolates %>% count_resistant(AMC, GEN, only_all_tested = TRUE)
)
# count of cases
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)
) %>%
pull(combination),
c(946, 428, 94)
)
# count_df
expect_equal(
example_isolates %>% select(AMX) %>% count_df() %>% pull(value),
c(
example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value),
c(
suppressWarnings(example_isolates$AMX %>% count_S()),
example_isolates$AMX %>% count_I(),
example_isolates$AMX %>% count_R()
)
)
# grouping in sir_calc_df() (= backbone of sir_df())
expect_true("ward" %in% (example_isolates %>%
group_by(ward) %>%
summarise(
cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)
) %>%
pull(combination),
c(946, 428, 94)
)
# count_df
expect_equal(
example_isolates %>% select(AMX) %>% count_df() %>% pull(value),
c(
example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value),
c(
suppressWarnings(example_isolates$AMX %>% count_S()),
example_isolates$AMX %>% count_I(),
example_isolates$AMX %>% count_R()
)
)
# grouping in sir_calc_df() (= backbone of sir_df())
expect_true("ward" %in% (example_isolates %>%
group_by(ward) %>%
select(ward, AMX, CIP, gender) %>%
sir_df() %>%
colnames()))
}
select(ward, AMX, CIP, gender) %>%
sir_df() %>%
colnames()))
}
})

26
tests/testthat/test-custom_antimicrobials.R
View File

@ -27,20 +27,22 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
ab_reset_session()
test_that("custom ab works", {
ab_reset_session()
expect_message(as.ab("testab", info = TRUE))
expect_message(as.ab("testab", info = TRUE))
suppressMessages(
add_custom_antimicrobials(
data.frame(
ab = "TESTAB",
name = "Test Antibiotic",
group = "Test Group"
suppressMessages(
add_custom_antimicrobials(
data.frame(
ab = "TESTAB",
name = "Test Antibiotic",
group = "Test Group"
)
)
)
)
expect_identical(as.character(as.ab("testab")), "TESTAB")
expect_identical(ab_name("testab"), "Test Antibiotic")
expect_identical(ab_group("testab"), "Test Group")
expect_identical(as.character(as.ab("testab")), "TESTAB")
expect_identical(ab_name("testab"), "Test Antibiotic")
expect_identical(ab_group("testab"), "Test Group")
})

53
tests/testthat/test-custom_microorganisms.R
View File

@ -27,33 +27,36 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(
as.mo("Enterobacter asburiae/cloacae"),
as.mo("Enterobacter asburiae")
)
suppressMessages(
add_custom_microorganisms(
data.frame(
mo = "ENT_ASB_CLO",
genus = "Enterobacter",
species = "asburiae/cloacae"
test_that("custom mo works", {
expect_identical(
as.mo("Enterobacter asburiae/cloacae"),
as.mo("Enterobacter asburiae")
)
suppressMessages(
add_custom_microorganisms(
data.frame(
mo = "ENT_ASB_CLO",
genus = "Enterobacter",
species = "asburiae/cloacae"
)
)
)
)
expect_identical(as.character(as.mo("ENT_ASB_CLO")), "ENT_ASB_CLO")
expect_identical(mo_name("ENT_ASB_CLO"), "Enterobacter asburiae/cloacae")
expect_identical(mo_gramstain("ENT_ASB_CLO", language = NULL), "Gram-negative")
expect_identical(as.character(as.mo("ENT_ASB_CLO")), "ENT_ASB_CLO")
expect_identical(mo_name("ENT_ASB_CLO"), "Enterobacter asburiae/cloacae")
expect_identical(mo_gramstain("ENT_ASB_CLO", language = NULL), "Gram-negative")
if (getRversion() >= "3.3.0") {
# until R 3.2, abbreviate() used a completely different algorithm, making these tests unreproducible
expect_identical(
paste("B", AMR:::abbreviate_mo("Klebsiella"), AMR:::abbreviate_mo("pneumoniae", 4), sep = "_"),
as.character(as.mo("Klebsiella pneumoniae"))
)
expect_identical(
paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"),
as.character(as.mo("Aerococcus urinae"))
)
}
if (getRversion() >= "3.3.0") {
# until R 3.2, abbreviate() used a completely different algorithm, making these tests unreproducible
expect_identical(
paste("B", AMR:::abbreviate_mo("Klebsiella"), AMR:::abbreviate_mo("pneumoniae", 4), sep = "_"),
as.character(as.mo("Klebsiella pneumoniae"))
)
expect_identical(
paste("B", AMR:::abbreviate_mo("Aerococcus"), AMR:::abbreviate_mo("urinae", 4), sep = "_"),
as.character(as.mo("Aerococcus urinae"))
)
}
})

174
tests/testthat/test-data.R
View File

@ -27,101 +27,103 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# IDs should always be unique
expect_identical(nrow(microorganisms), length(unique(microorganisms$mo)))
expect_identical(class(microorganisms$mo), c("mo", "character"))
expect_identical(nrow(antibiotics), length(unique(antibiotics$ab)))
expect_true(all(is.na(antibiotics$atc[duplicated(antibiotics$atc)])))
expect_identical(class(antibiotics$ab), c("ab", "character"))
test_that("data works", {
# IDs should always be unique
expect_identical(nrow(microorganisms), length(unique(microorganisms$mo)))
expect_identical(class(microorganisms$mo), c("mo", "character"))
expect_identical(nrow(antimicrobials), length(unique(AMR::antimicrobials$ab)))
expect_true(all(is.na(AMR::antimicrobials$atc[duplicated(AMR::antimicrobials$atc)])))
expect_identical(class(AMR::antimicrobials$ab), c("ab", "character"))
# check cross table reference
expect_true(all(microorganisms.codes$mo %in% microorganisms$mo))
expect_true(all(example_isolates$mo %in% microorganisms$mo))
expect_true(all(microorganisms.groups$mo %in% microorganisms$mo))
expect_true(all(microorganisms.groups$mo_group %in% microorganisms$mo))
expect_true(all(clinical_breakpoints$mo %in% microorganisms$mo))
expect_true(all(clinical_breakpoints$ab %in% antibiotics$ab))
expect_true(all(intrinsic_resistant$mo %in% microorganisms$mo))
expect_true(all(intrinsic_resistant$ab %in% antibiotics$ab))
expect_false(any(is.na(microorganisms.codes$code)))
expect_false(any(is.na(microorganisms.codes$mo)))
expect_true(all(dosage$ab %in% antibiotics$ab))
expect_true(all(dosage$name %in% antibiotics$name))
# check valid disks/MICs
expect_false(any(is.na(as.mic(clinical_breakpoints[which(clinical_breakpoints$method == "MIC" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.mic(clinical_breakpoints[which(clinical_breakpoints$method == "MIC" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_R", drop = TRUE]))))
expect_false(any(is.na(as.disk(clinical_breakpoints[which(clinical_breakpoints$method == "DISK" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.disk(clinical_breakpoints[which(clinical_breakpoints$method == "DISK" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_R", drop = TRUE]))))
# check cross table reference
expect_true(all(microorganisms.codes$mo %in% microorganisms$mo))
expect_true(all(example_isolates$mo %in% microorganisms$mo))
expect_true(all(microorganisms.groups$mo %in% microorganisms$mo))
expect_true(all(microorganisms.groups$mo_group %in% microorganisms$mo))
expect_true(all(clinical_breakpoints$mo %in% microorganisms$mo))
expect_true(all(clinical_breakpoints$ab %in% AMR::antimicrobials$ab))
expect_true(all(intrinsic_resistant$mo %in% microorganisms$mo))
expect_true(all(intrinsic_resistant$ab %in% AMR::antimicrobials$ab))
expect_false(any(is.na(microorganisms.codes$code)))
expect_false(any(is.na(microorganisms.codes$mo)))
expect_true(all(dosage$ab %in% AMR::antimicrobials$ab))
expect_true(all(dosage$name %in% AMR::antimicrobials$name))
# check valid disks/MICs
expect_false(any(is.na(as.mic(clinical_breakpoints[which(clinical_breakpoints$method == "MIC" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.mic(clinical_breakpoints[which(clinical_breakpoints$method == "MIC" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_R", drop = TRUE]))))
expect_false(any(is.na(as.disk(clinical_breakpoints[which(clinical_breakpoints$method == "DISK" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_S", drop = TRUE]))))
expect_false(any(is.na(as.disk(clinical_breakpoints[which(clinical_breakpoints$method == "DISK" & clinical_breakpoints$ref_tbl != "ECOFF"), "breakpoint_R", drop = TRUE]))))
# antibiotic names must always be coercible to their original AB code
expect_identical(as.ab(antibiotics$name), antibiotics$ab)
# antibiotic names must always be coercible to their original AB code
expect_identical(as.ab(AMR::antimicrobials$name), AMR::antimicrobials$ab)
if (AMR:::pkg_is_available("tibble")) {
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(AMR:::dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i])
if (AMR:::pkg_is_available("tibble")) {
# there should be no diacritics (i.e. non ASCII) characters in the datasets (CRAN policy)
datasets <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
for (i in seq_len(length(datasets))) {
dataset <- get(datasets[i], envir = asNamespace("AMR"))
expect_identical(AMR:::dataset_UTF8_to_ASCII(dataset), dataset, info = datasets[i])
}
}
}
df <- AMR:::AMR_env$MO_lookup
expect_true(all(c(
"mo", "fullname", "status", "kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies", "rank", "ref", "source",
"lpsn", "lpsn_parent", "lpsn_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence",
"snomed", "kingdom_index", "fullname_lower", "full_first", "species_first"
) %in% colnames(df)))
df <- AMR:::AMR_env$MO_lookup
expect_true(all(c(
"mo", "fullname", "status", "kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies", "rank", "ref", "source",
"lpsn", "lpsn_parent", "lpsn_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence",
"snomed", "kingdom_index", "fullname_lower", "full_first", "species_first"
) %in% colnames(df)))
expect_inherits(AMR:::MO_CONS, "mo")
expect_inherits(AMR:::MO_CONS, "mo")
uncategorised <- subset(
microorganisms,
genus == "Staphylococcus" &
!species %in% c("", "aureus") &
!mo %in% c(AMR:::MO_CONS, AMR:::MO_COPS)
)
expect_true(NROW(uncategorised) == 0,
info = ifelse(NROW(uncategorised) == 0,
"All staphylococcal species categorised as CoNS/CoPS.",
paste0(
"Staphylococcal species not categorised as CoNS/CoPS: S. ",
uncategorised$species, " (", uncategorised$mo, ")",
collapse = "\n"
uncategorised <- subset(
microorganisms,
genus == "Staphylococcus" &
!species %in% c("", "aureus") &
!mo %in% c(AMR:::MO_CONS, AMR:::MO_COPS)
)
expect_true(NROW(uncategorised) == 0,
info = ifelse(NROW(uncategorised) == 0,
"All staphylococcal species categorised as CoNS/CoPS.",
paste0(
"Staphylococcal species not categorised as CoNS/CoPS: S. ",
uncategorised$species, " (", uncategorised$mo, ")",
collapse = "\n"
)
)
)
)
# THIS WILL CHECK NON-ASCII STRINGS IN ALL FILES:
# THIS WILL CHECK NON-ASCII STRINGS IN ALL FILES:
# check_non_ascii <- function() {
# purrr::map_df(
# .id = "file",
# # list common text files
# .x = fs::dir_ls(
# recurse = TRUE,
# type = "file",
# # ignore images, compressed
# regexp = "\\.(png|ico|rda|ai|tar.gz|zip|xlsx|csv|pdf|psd)$",
# invert = TRUE
# ),
# .f = function(path) {
# x <- readLines(path, warn = FALSE)
# # from tools::showNonASCII()
# asc <- iconv(x, "latin1", "ASCII")
# ind <- is.na(asc) | asc != x
# # make data frame
# if (any(ind)) {
# tibble::tibble(
# row = which(ind),
# line = iconv(x[ind], "latin1", "ASCII", sub = "byte")
# )
# } else {
# tibble::tibble()
# }
# }
# )
# }
# x <- check_non_ascii() %>%
# filter(file %unlike% "^(data-raw|docs|git_)")
# check_non_ascii <- function() {
# purrr::map_df(
# .id = "file",
# # list common text files
# .x = fs::dir_ls(
# recurse = TRUE,
# type = "file",
# # ignore images, compressed
# regexp = "\\.(png|ico|rda|ai|tar.gz|zip|xlsx|csv|pdf|psd)$",
# invert = TRUE
# ),
# .f = function(path) {
# x <- readLines(path, warn = FALSE)
# # from tools::showNonASCII()
# asc <- iconv(x, "latin1", "ASCII")
# ind <- is.na(asc) | asc != x
# # make data frame
# if (any(ind)) {
# tibble::tibble(
# row = which(ind),
# line = iconv(x[ind], "latin1", "ASCII", sub = "byte")
# )
# } else {
# tibble::tibble()
# }
# }
# )
# }
# x <- check_non_ascii() %>%
# filter(file %unlike% "^(data-raw|docs|git_)")
})

54
tests/testthat/test-disk.R
View File

@ -27,33 +27,35 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_true(as.disk(8) == as.disk("8"))
expect_true(is.disk(as.disk(8)))
test_that("disk works", {
expect_true(as.disk(8) == as.disk("8"))
expect_true(is.disk(as.disk(8)))
expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA)
expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA)
# all levels should be valid disks
x <- as.disk(c(20, 40))
expect_inherits(x[1], "disk")
expect_inherits(x[[1]], "disk")
expect_inherits(c(x[1], x[9]), "disk")
expect_inherits(unique(x[1], x[9]), "disk")
# expect_warning(as.disk("INVALID VALUE"))
x[2] <- 32
expect_inherits(x, "disk")
# all levels should be valid disks
x <- as.disk(c(20, 40))
expect_inherits(x[1], "disk")
expect_inherits(x[[1]], "disk")
expect_inherits(c(x[1], x[9]), "disk")
expect_inherits(unique(x[1], x[9]), "disk")
# expect_warning(as.disk("INVALID VALUE"))
x[2] <- 32
expect_inherits(x, "disk")
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"))
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40))), "gg")
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"), "gg")
}
expect_stdout(print(as.disk(12)))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40))))
expect_silent(plot(as.disk(c(10, 20, 40)), expand = FALSE))
expect_silent(plot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"))
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40))), "gg")
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), expand = FALSE), "gg")
expect_inherits(ggplot2::autoplot(as.disk(c(10, 20, 40)), mo = "Escherichia coli", ab = "cipr"), "gg")
}
expect_output(print(as.disk(12)))
if (AMR:::pkg_is_available("tibble")) {
expect_stdout(print(tibble::tibble(d = as.disk(12))))
}
if (AMR:::pkg_is_available("tibble")) {
expect_output(print(tibble::tibble(d = as.disk(12))))
}
})

344
tests/testthat/test-eucast_rules.R
View File

@ -27,198 +27,200 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# thoroughly check input table
expect_equal(
colnames(AMR:::EUCAST_RULES_DF),
c(
"if_mo_property", "like.is.one_of", "this_value",
"and_these_antibiotics", "have_these_values",
"then_change_these_antibiotics", "to_value",
"reference.rule", "reference.rule_group",
"reference.version",
"note"
test_that("eucast_rules works", {
# thoroughly check input table
expect_equal(
colnames(AMR:::EUCAST_RULES_DF),
c(
"if_mo_property", "like.is.one_of", "this_value",
"and_these_antibiotics", "have_these_values",
"then_change_these_antibiotics", "to_value",
"reference.rule", "reference.rule_group",
"reference.version",
"note"
)
)
)
MOs_mentioned <- unique(AMR:::EUCAST_RULES_DF$this_value)
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!AMR:::is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned, keep_synonyms = TRUE, language = NULL)))
expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0)
MOs_mentioned <- unique(AMR:::EUCAST_RULES_DF$this_value)
MOs_mentioned <- sort(trimws(unlist(strsplit(MOs_mentioned[!AMR:::is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned, keep_synonyms = TRUE, language = NULL)))
expect_true(length(MOs_mentioned[MOs_test != MOs_mentioned]) == 0)
expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing")))
expect_error(eucast_rules(x = "text"))
expect_error(eucast_rules(data.frame(a = "test")))
expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
expect_error(suppressWarnings(eucast_rules(example_isolates, col_mo = "Non-existing")))
expect_error(eucast_rules(x = "text"))
expect_error(eucast_rules(data.frame(a = "test")))
expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
# expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
# expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
expect_identical(
colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE)))
)
expect_identical(
colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE)))
)
expect_stdout(suppressMessages(eucast_rules(example_isolates, info = TRUE)))
expect_output(suppressMessages(eucast_rules(example_isolates, info = TRUE)))
a <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE
)
b <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE
)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_stdout(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE))))
a <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE
)
b <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE
)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_output(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE))))
a <- data.frame(
mo = c(
"Staphylococcus aureus",
"Streptococcus group A"
),
COL = "-", # Colistin
stringsAsFactors = FALSE
)
b <- data.frame(
mo = c(
"Staphylococcus aureus",
"Streptococcus group A"
),
COL = "R", # Colistin
stringsAsFactors = FALSE
)
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
a <- data.frame(
mo = c(
"Staphylococcus aureus",
"Streptococcus group A"
),
COL = "-", # Colistin
stringsAsFactors = FALSE
)
b <- data.frame(
mo = c(
"Staphylococcus aureus",
"Streptococcus group A"
),
COL = "R", # Colistin
stringsAsFactors = FALSE
)
expect_equal(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
# piperacillin must be R in Enterobacteriaceae when tica is R
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
# piperacillin must be R in Enterobacteriaceae when tica is R
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(
suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(
TIC = as.sir("R"),
PIP = as.sir("S")
) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()
),
"R"
)
}
# azithromycin and clarythromycin must be equal to Erythromycin
a <- suppressWarnings(as.sir(eucast_rules(
data.frame(
mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.sir("R"),
CLR = factor("R"),
stringsAsFactors = FALSE
),
version_expertrules = 3.1,
only_sir_columns = FALSE
)$CLR))
b <- example_isolates$ERY
expect_identical(
a[!is.na(b)],
b[!is.na(b)]
)
# amox is inferred by benzylpenicillin in Kingella kingae
expect_equal(
suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(
TIC = as.sir("R"),
PIP = as.sir("S")
) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()
as.list(eucast_rules(
data.frame(
mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE
),
info = FALSE
))$AMX
),
"R"
"S"
)
}
# azithromycin and clarythromycin must be equal to Erythromycin
a <- suppressWarnings(as.sir(eucast_rules(
data.frame(
mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.sir("R"),
CLR = factor("R"),
stringsAsFactors = FALSE
),
version_expertrules = 3.1,
only_sir_columns = FALSE
)$CLR))
b <- example_isolates$ERY
expect_identical(
a[!is.na(b)],
b[!is.na(b)]
)
# also test norf
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
}
# amox is inferred by benzylpenicillin in Kingella kingae
expect_equal(
suppressWarnings(
as.list(eucast_rules(
# check verbose output
expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))
# AmpC de-repressed cephalo mutants
expect_identical(
eucast_rules(
data.frame(
mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = TRUE,
info = FALSE
))$AMX
),
"S"
)
)$cefotax,
as.sir(c("S", "R"))
)
# also test norf
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_stdout(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
}
expect_identical(
eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = NA,
info = FALSE
)$cefotax,
as.sir(c("S", NA))
)
# check verbose output
expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))
expect_identical(
eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = NULL,
info = FALSE
)$cefotax,
as.sir(c("S", "S"))
)
# AmpC de-repressed cephalo mutants
expect_identical(
eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = TRUE,
info = FALSE
)$cefotax,
as.sir(c("S", "R"))
)
expect_identical(
eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = NA,
info = FALSE
)$cefotax,
as.sir(c("S", NA))
)
expect_identical(
eucast_rules(
data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.sir(c("S", "S"))
),
ampc_cephalosporin_resistance = NULL,
info = FALSE
)$cefotax,
as.sir(c("S", "S"))
)
# EUCAST dosage -----------------------------------------------------------
expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3)
expect_inherits(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame")
# EUCAST dosage -----------------------------------------------------------
expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3)
expect_inherits(eucast_dosage(c("tobra", "genta", "cipro")), "data.frame")
x <- custom_eucast_rules(
AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
AMX == "S" ~ AMC == "S"
)
expect_stdout(print(x))
expect_stdout(print(c(x, x)))
expect_stdout(print(as.list(x, x)))
x <- custom_eucast_rules(
AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
AMX == "S" ~ AMC == "S"
)
expect_output(print(x))
expect_output(print(c(x, x)))
expect_output(print(as.list(x, x)))
# this custom rules makes 8 changes
expect_equal(
nrow(eucast_rules(example_isolates,
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE
)),
8,
tolerance = 0.5
)
# this custom rules makes 8 changes
expect_equal(
nrow(eucast_rules(example_isolates,
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE
)),
8,
tolerance = 0.5
)
})

432
tests/testthat/test-first_isolate.R
View File

@ -27,234 +27,236 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# all four methods
expect_equal(
sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1387
)
# for phenotype determination
expect_equal(
AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"),
FALSE
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "SSS"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, FALSE)
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "RRR", "SSS"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, TRUE, FALSE)
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "RSS", "SSS", "RSS", "RRR", "RRR", "SSS", "RSS", "RSR", "RRR"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE)
)
# Phenotype-based, using key antimicrobials
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE
), na.rm = TRUE),
1383
)
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE
), na.rm = TRUE),
1397
)
# first non-ICU isolates
expect_true(
sum(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient",
col_icu = example_isolates$ward == "ICU",
info = TRUE,
icu_exclude = TRUE
),
na.rm = TRUE
) < 950
)
# set 1500 random observations to be of specimen type 'Urine'
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
x <- example_isolates
x$specimen <- "Other"
x[random_rows, "specimen"] <- "Urine"
expect_true(
sum(first_isolate(
x = x,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
info = TRUE
), na.rm = TRUE) < 1400
)
# same, but now exclude ICU
expect_true(
sum(first_isolate(
x = x,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
col_icu = x$ward == "ICU",
icu_exclude = TRUE,
info = TRUE
), na.rm = TRUE) < 1000
)
# "No isolates found"
test_iso <- example_isolates
test_iso$specimen <- "test"
expect_message(first_isolate(test_iso,
"date",
"patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "something_unexisting",
info = TRUE
))
# printing of exclusion message
expect_message(first_isolate(example_isolates,
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
col_testcode = "gender",
testcodes_exclude = "M",
info = TRUE
))
# errors
expect_error(first_isolate("date", "patient", col_mo = "mo"))
expect_error(first_isolate(example_isolates,
col_date = "non-existing col",
col_mo = "mo"
))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
# if mo is not an mo class, result should be the same
expect_identical(
example_isolates %>%
mutate(mo = as.character(mo)) %>%
first_isolate(
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
info = FALSE
),
example_isolates %>%
first_isolate(
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
info = FALSE
)
test_that("first_isolate works", {
# all four methods
expect_equal(
sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1387
)
# support for WHONET
expect_message(example_isolates %>%
select(-patient) %>%
mutate(
`First name` = "test",
`Last name` = "test",
Sex = "Female"
) %>%
first_isolate(info = TRUE))
# for phenotype determination
expect_equal(
AMR:::duplicated_antibiogram("SSSS", points_threshold = 2, ignore_I = TRUE, type = "points"),
FALSE
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "SSS"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, FALSE)
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "RRR", "SSS"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, TRUE, FALSE)
)
expect_equal(
AMR:::duplicated_antibiogram(c("RRR", "RSS", "SSS", "RSS", "RRR", "RRR", "SSS", "RSS", "RSR", "RRR"),
points_threshold = 2, ignore_I = TRUE, type = "points"
),
c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, TRUE)
)
# groups
x <- example_isolates %>%
group_by(ward) %>%
mutate(first = first_isolate())
y <- example_isolates %>%
group_by(ward) %>%
mutate(first = first_isolate(.))
expect_identical(x, y)
}
# Phenotype-based, using key antimicrobials
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE
), na.rm = TRUE),
1383
)
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE
), na.rm = TRUE),
1397
)
# missing dates should be no problem
df <- example_isolates
df[1:100, "date"] <- NA
expect_equal(
sum(
first_isolate(
x = df,
# first non-ICU isolates
expect_true(
sum(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient",
col_icu = example_isolates$ward == "ICU",
info = TRUE,
icu_exclude = TRUE
),
na.rm = TRUE
) < 950
)
# set 1500 random observations to be of specimen type 'Urine'
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
x <- example_isolates
x$specimen <- "Other"
x[random_rows, "specimen"] <- "Urine"
expect_true(
sum(first_isolate(
x = x,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
info = TRUE
), na.rm = TRUE) < 1400
)
# same, but now exclude ICU
expect_true(
sum(first_isolate(
x = x,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "Urine",
col_icu = x$ward == "ICU",
icu_exclude = TRUE,
info = TRUE
), na.rm = TRUE) < 1000
)
# "No isolates found"
test_iso <- example_isolates
test_iso$specimen <- "test"
expect_message(first_isolate(test_iso,
"date",
"patient",
col_mo = "mo",
col_specimen = "specimen",
filter_specimen = "something_unexisting",
info = TRUE
))
# printing of exclusion message
expect_message(first_isolate(example_isolates,
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
col_testcode = "gender",
testcodes_exclude = "M",
info = TRUE
))
# errors
expect_error(first_isolate("date", "patient", col_mo = "mo"))
expect_error(first_isolate(example_isolates,
col_date = "non-existing col",
col_mo = "mo"
))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
# if mo is not an mo class, result should be the same
expect_identical(
example_isolates %>%
mutate(mo = as.character(mo)) %>%
first_isolate(
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
info = FALSE
),
example_isolates %>%
first_isolate(
col_date = "date",
col_mo = "mo",
col_patient_id = "patient",
info = FALSE
)
)
# support for WHONET
expect_message(example_isolates %>%
select(-patient) %>%
mutate(
`First name` = "test",
`Last name` = "test",
Sex = "Female"
) %>%
first_isolate(info = TRUE))
# groups
x <- example_isolates %>%
group_by(ward) %>%
mutate(first = first_isolate())
y <- example_isolates %>%
group_by(ward) %>%
mutate(first = first_isolate(.))
expect_identical(x, y)
}
# missing dates should be no problem
df <- example_isolates
df[1:100, "date"] <- NA
expect_equal(
sum(
first_isolate(
x = df,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
info = TRUE
),
na.rm = TRUE
),
na.rm = TRUE
),
1390
)
1390
)
# unknown MOs
test_unknown <- example_isolates
test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = FALSE)),
1116
)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = TRUE)),
1599
)
# unknown MOs
test_unknown <- example_isolates
test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = FALSE)),
1116
)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = TRUE)),
1599
)
test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo)
expect_equal(
sum(first_isolate(test_unknown)),
1116
)
test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo)
expect_equal(
sum(first_isolate(test_unknown)),
1116
)
# empty sir results
expect_equal(
sum(first_isolate(example_isolates, include_untested_sir = FALSE)),
1374
)
# empty sir results
expect_equal(
sum(first_isolate(example_isolates, include_untested_sir = FALSE)),
1374
)
# shortcuts
expect_identical(
filter_first_isolate(example_isolates),
subset(example_isolates, first_isolate(example_isolates))
)
# shortcuts
expect_identical(
filter_first_isolate(example_isolates),
subset(example_isolates, first_isolate(example_isolates))
)
# notice that all mo's are distinct, so all are TRUE
expect_true(all(first_isolate(AMR:::pm_distinct(example_isolates, mo, .keep_all = TRUE), info = TRUE) == TRUE))
# notice that all mo's are distinct, so all are TRUE
expect_true(all(first_isolate(AMR:::pm_distinct(example_isolates, mo, .keep_all = TRUE), info = TRUE) == TRUE))
# only one isolate, so return fast
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))
# only one isolate, so return fast
expect_true(first_isolate(data.frame(mo = "Escherichia coli", date = Sys.Date(), patient = "patient"), info = TRUE))
})

72
tests/testthat/test-g.test.R
View File

@ -27,43 +27,45 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# GOODNESS-OF-FIT
test_that("g.test works", {
# GOODNESS-OF-FIT
# example 1: clearfield rice vs. red rice
x <- c(772, 1611, 737)
expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value,
0.12574,
tolerance = 0.0001
)
# example 2: red crossbills
x <- c(1752, 1895)
expect_equal(g.test(x)$p.value,
0.017873,
tolerance = 0.0001
)
expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25)))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24)))
# expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
# INDEPENDENCE
x <- as.data.frame(
matrix(
data = round(runif(4) * 100000, 0),
ncol = 2,
byrow = TRUE
# example 1: clearfield rice vs. red rice
x <- c(772, 1611, 737)
expect_equal(g.test(x, p = c(0.25, 0.50, 0.25))$p.value,
0.12574,
tolerance = 0.0001
)
)
# fisher.test() is always better for 2x2 tables:
# expect_warning(g.test(x))
expect_true(suppressWarnings(g.test(x)$p.value) < 1)
# example 2: red crossbills
x <- c(1752, 1895)
expect_equal(g.test(x)$p.value,
0.017873,
tolerance = 0.0001
)
# expect_warning(g.test(x = c(772, 1611, 737), y = c(780, 1560, 780), rescale.p = TRUE))
expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25)))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24)))
# expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE)))
expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE)))
# INDEPENDENCE
x <- as.data.frame(
matrix(
data = round(runif(4) * 100000, 0),
ncol = 2,
byrow = TRUE
)
)
# fisher.test() is always better for 2x2 tables:
# expect_warning(g.test(x))
expect_true(suppressWarnings(g.test(x)$p.value) < 1)
# expect_warning(g.test(x = c(772, 1611, 737), y = c(780, 1560, 780), rescale.p = TRUE))
expect_error(g.test(matrix(data = c(-1, -2, -3, -4), ncol = 2, byrow = TRUE)))
expect_error(g.test(matrix(data = c(0, 0, 0, 0), ncol = 2, byrow = TRUE)))
})

88
tests/testthat/test-get_episode.R
View File

@ -27,51 +27,53 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
x <- data.frame(dates = as.Date(c("2021-01-01", "2021-01-02", "2021-01-05", "2021-01-08", "2021-02-21", "2021-02-22", "2021-02-23", "2021-02-24", "2021-03-01", "2021-03-01")))
x$absolute <- get_episode(x$dates, episode_days = 7)
x$relative <- get_episode(x$dates, case_free_days = 7)
expect_equal(x$absolute, c(1, 1, 1, 2, 3, 3, 3, 3, 4, 4))
expect_equal(x$relative, c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2))
expect_equal(get_episode(as.Date(c("2022-01-01", "2020-01-01")), 365), c(2, 1))
expect_equal(get_episode(as.Date(c("2020-01-01", "2022-01-01")), 365), c(1, 2))
test_that("get_episode works", {
x <- data.frame(dates = as.Date(c("2021-01-01", "2021-01-02", "2021-01-05", "2021-01-08", "2021-02-21", "2021-02-22", "2021-02-23", "2021-02-24", "2021-03-01", "2021-03-01")))
x$absolute <- get_episode(x$dates, episode_days = 7)
x$relative <- get_episode(x$dates, case_free_days = 7)
expect_equal(x$absolute, c(1, 1, 1, 2, 3, 3, 3, 3, 4, 4))
expect_equal(x$relative, c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2))
expect_equal(get_episode(as.Date(c("2022-01-01", "2020-01-01")), 365), c(2, 1))
expect_equal(get_episode(as.Date(c("2020-01-01", "2022-01-01")), 365), c(1, 2))
test_df <- rbind(
data.frame(
date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")),
patient_id = "A"
),
data.frame(
date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")),
patient_id = "B"
)
)
expect_equal(
get_episode(test_df$date, 365),
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3)
)
expect_equal(
get_episode(test_df$date[which(test_df$patient_id == "A")], 365),
c(1, 1, 2, 2, 2, 2, 3, 4)
)
expect_equal(
get_episode(test_df$date[which(test_df$patient_id == "B")], 365),
c(1, 2, 2, 2, 3)
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_identical(
test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)
test_df <- rbind(
data.frame(
date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")),
patient_id = "A"
),
data.frame(
date = as.Date(c("2015-01-01", "2016-02-01", "2016-12-31", "2017-01-01", "2017-02-03")),
patient_id = "B"
)
)
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
expect_equal(
get_episode(test_df$date, 365),
c(1, 1, 2, 2, 2, 3, 3, 4, 1, 2, 2, 2, 3)
)
expect_equal(
get_episode(test_df$date[which(test_df$patient_id == "A")], 365),
c(1, 1, 2, 2, 2, 2, 3, 4)
)
expect_equal(
get_episode(test_df$date[which(test_df$patient_id == "B")], 365),
c(1, 2, 2, 2, 3)
)
y <- example_isolates %>%
group_by(patient, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_identical(
test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE)
)
suppressMessages(
x <- example_isolates %>%
mutate(out = first_isolate(., include_unknown = TRUE, method = "episode-based", info = FALSE))
)
y <- example_isolates %>%
group_by(patient, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
}
})

202
tests/testthat/test-ggplot_sir.R
View File

@ -27,111 +27,113 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE) &&
AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
pdf(NULL) # prevent Rplots.pdf being created
test_that("ggplot_sir works", {
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE) &&
AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
pdf(NULL) # prevent Rplots.pdf being created
# data should be equal
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir())$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
# data should be equal
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir())$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_inherits(
example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "interpretation", facet = "antibiotic"),
"gg"
)
expect_inherits(
example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"),
"gg"
)
expect_inherits(
example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "interpretation", facet = "antibiotic"),
"gg"
)
expect_inherits(
example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"),
"gg"
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "interpretation", facet = "antibiotic"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "interpretation", facet = "antibiotic"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(count_resistant) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(count_resistant) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_sir(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(count_resistant) %>%
as.double(),
example_isolates %>%
select(AMC, CIP) %>%
summarise_all(count_resistant) %>%
as.double()
)
# support for scale_type ab and mo
expect_inherits(
(data.frame(
mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)
) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
# support for scale_type ab and mo
expect_inherits(
(data.frame(
mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)
) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
# support for manual colours
expect_inherits(
suppressWarnings((ggplot(data.frame(
x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6")
)) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_sir_colours(aesthetics = "fill", Value4 = "S", Value5 = "I", Value6 = "R"))$data),
"data.frame"
)
}
# support for manual colours
expect_inherits(
suppressWarnings((ggplot(data.frame(
x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6")
)) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_sir_colours(aesthetics = "fill", Value4 = "S", Value5 = "I", Value6 = "R"))$data),
"data.frame"
)
}
})

66
tests/testthat/test-guess_ab_col.R
View File

@ -27,36 +27,38 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(
guess_ab_col(example_isolates, "amox"),
"AMX"
)
expect_equal(
guess_ab_col(example_isolates, "amoxicillin"),
"AMX"
)
expect_equal(
guess_ab_col(example_isolates, "J01AA07"),
"TCY"
)
expect_equal(
guess_ab_col(example_isolates, "tetracycline"),
"TCY"
)
expect_equal(
guess_ab_col(example_isolates, "TETR"),
"TCY"
)
test_that("guess_ab_col works", {
expect_equal(
guess_ab_col(example_isolates, "amox"),
"AMX"
)
expect_equal(
guess_ab_col(example_isolates, "amoxicillin"),
"AMX"
)
expect_equal(
guess_ab_col(example_isolates, "J01AA07"),
"TCY"
)
expect_equal(
guess_ab_col(example_isolates, "tetracycline"),
"TCY"
)
expect_equal(
guess_ab_col(example_isolates, "TETR"),
"TCY"
)
df <- data.frame(
AMP_ND10 = "R",
AMC_ED20 = "S"
)
expect_equal(
guess_ab_col(df, "ampicillin"),
"AMP_ND10"
)
expect_equal(
guess_ab_col(df, "J01CR02"),
"AMC_ED20"
)
df <- data.frame(
AMP_ND10 = "R",
AMC_ED20 = "S"
)
expect_equal(
guess_ab_col(df, "ampicillin"),
"AMP_ND10"
)
expect_equal(
guess_ab_col(df, "J01CR02"),
"AMC_ED20"
)
})

34
tests/testthat/test-italicise_taxonomy.R
View File

@ -27,21 +27,23 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(
italicise_taxonomy("test for E. coli"),
"test for *E. coli*"
)
expect_identical(
italicise_taxonomy("test for E. coli"),
italicize_taxonomy("test for E. coli")
)
if (AMR:::has_colour()) {
test_that("italicise_taxonomy works", {
expect_identical(
italicise_taxonomy("test for E. coli", type = "ansi"),
"test for \033[3mE. coli\033[23m"
italicise_taxonomy("test for E. coli"),
"test for *E. coli*"
)
}
expect_identical(
italicise_taxonomy("test for E. coli", "html"),
"test for <i>E. coli</i>"
)
expect_identical(
italicise_taxonomy("test for E. coli"),
italicize_taxonomy("test for E. coli")
)
if (AMR:::has_colour()) {
expect_identical(
italicise_taxonomy("test for E. coli", type = "ansi"),
"test for \033[3mE. coli\033[23m"
)
}
expect_identical(
italicise_taxonomy("test for E. coli", "html"),
"test for <i>E. coli</i>"
)
})

48
tests/testthat/test-join_microorganisms.R
View File

@ -27,35 +27,37 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
unjoined <- example_isolates
inner <- inner_join_microorganisms(example_isolates)
left <- left_join_microorganisms(example_isolates)
semi <- semi_join_microorganisms(example_isolates)
anti <- anti_join_microorganisms(example_isolates)
suppressWarnings(right <- right_join_microorganisms(example_isolates))
suppressWarnings(full <- full_join_microorganisms(example_isolates))
test_that("join_microorganisms works", {
unjoined <- example_isolates
inner <- inner_join_microorganisms(example_isolates)
left <- left_join_microorganisms(example_isolates)
semi <- semi_join_microorganisms(example_isolates)
anti <- anti_join_microorganisms(example_isolates)
suppressWarnings(right <- right_join_microorganisms(example_isolates))
suppressWarnings(full <- full_join_microorganisms(example_isolates))
expect_true(ncol(unjoined) < ncol(inner))
expect_true(nrow(unjoined) == nrow(inner))
expect_true(ncol(unjoined) < ncol(inner))
expect_true(nrow(unjoined) == nrow(inner))
expect_true(ncol(unjoined) < ncol(left))
expect_true(nrow(unjoined) == nrow(left))
expect_true(ncol(unjoined) < ncol(left))
expect_true(nrow(unjoined) == nrow(left))
expect_true(ncol(semi) == ncol(semi))
expect_true(nrow(semi) == nrow(semi))
expect_true(ncol(semi) == ncol(semi))
expect_true(nrow(semi) == nrow(semi))
expect_true(nrow(anti) == 0)
expect_true(nrow(anti) == 0)
expect_true(nrow(unjoined) < nrow(right))
expect_true(nrow(unjoined) < nrow(full))
expect_true(nrow(unjoined) < nrow(right))
expect_true(nrow(unjoined) < nrow(full))
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1)
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(inner_join_microorganisms("B_ESCHR_COLI", by = c("mo" = "mo"))), 1)
expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0)
expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0)
# expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
# expect_warning(full_join_microorganisms("B_ESCHR_COLI"))
# expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
# expect_warning(full_join_microorganisms("B_ESCHR_COLI"))
})

22
tests/testthat/test-key_antimicrobials.R
View File

@ -27,14 +27,16 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates))
expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL))))
expect_true(antimicrobials_equal("SSS", "SSS", type = "points"))
expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials"))
expect_true(antimicrobials_equal("SSS", "SRS", type = "points"))
expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials"))
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
test_that("key_antimicrobials works", {
expect_equal(length(key_antimicrobials(example_isolates, antifungal = NULL)), nrow(example_isolates))
expect_false(all(is.na(key_antimicrobials(example_isolates, antifungal = NULL))))
expect_true(antimicrobials_equal("SSS", "SSS", type = "points"))
expect_false(antimicrobials_equal("SSS", "SRS", type = "keyantimicrobials"))
expect_true(antimicrobials_equal("SSS", "SRS", type = "points"))
expect_true(antimicrobials_equal("SSS", "SIS", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyantimicrobials"))
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
# expect_warning(key_antimicrobials(example_isolates[rep(1, 10), , drop = FALSE]))
# expect_warning(key_antimicrobials(example_isolates[rep(1, 10), , drop = FALSE]))
})

42
tests/testthat/test-kurtosis.R
View File

@ -27,25 +27,27 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(kurtosis(example_isolates$age),
5.227999,
tolerance = 0.00001
)
test_that("kurtosis works", {
expect_equal(kurtosis(example_isolates$age),
5.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age))),
5.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)),
2.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age))),
5.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)),
2.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age)),
5.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE),
2.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age)),
5.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE),
2.227999,
tolerance = 0.00001
)
})

40
tests/testthat/test-like.R
View File

@ -27,24 +27,26 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_true(sum("test" %like% c("^t", "^s")) == 1)
test_that("like works", {
expect_true(sum("test" %like% c("^t", "^s")) == 1)
expect_true("test" %like% "test")
expect_false("test" %like_case% "TEST")
expect_true(factor("test") %like% factor("t"))
expect_true(factor("test") %like% "t")
expect_true("test" %like% factor("t"))
expect_true("test" %like% "test")
expect_false("test" %like_case% "TEST")
expect_true(factor("test") %like% factor("t"))
expect_true(factor("test") %like% "t")
expect_true("test" %like% factor("t"))
expect_true(as.factor("test") %like% "TEST")
expect_identical(
factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
c(TRUE, TRUE, TRUE)
)
expect_identical(
"test" %like% c("t", "e", "s", "t"),
c(TRUE, TRUE, TRUE, TRUE)
)
expect_identical(
factor("test") %like% factor(c("t", "e", "s", "t")),
c(TRUE, TRUE, TRUE, TRUE)
)
expect_true(as.factor("test") %like% "TEST")
expect_identical(
factor(c("Test case", "Something different", "Yet another thing")) %like% c("case", "diff", "yet"),
c(TRUE, TRUE, TRUE)
)
expect_identical(
"test" %like% c("t", "e", "s", "t"),
c(TRUE, TRUE, TRUE, TRUE)
)
expect_identical(
factor("test") %like% factor(c("t", "e", "s", "t")),
c(TRUE, TRUE, TRUE, TRUE)
)
})

480
tests/testthat/test-mdro.R
View File

@ -27,260 +27,262 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE))
expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE))
test_that("mdro works", {
expect_error(mdro(example_isolates, guideline = c("BRMO", "MRGN"), info = TRUE))
expect_error(mdro(example_isolates, col_mo = "invalid", info = TRUE))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE))))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE))))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.2", info = TRUE))))
expect_stdout(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.3", info = TRUE))))
expect_stdout(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE))))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, info = TRUE))))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.1", info = TRUE))))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.2", info = TRUE))))
expect_output(suppressMessages(suppressWarnings(mdro(example_isolates, "eucast3.3", info = TRUE))))
expect_output(outcome <- suppressMessages(suppressWarnings(eucast_exceptional_phenotypes(example_isolates, info = TRUE))))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
expect_stdout(outcome <- mdro(example_isolates, "nl", info = TRUE))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
expect_output(outcome <- mdro(example_isolates, "nl", info = TRUE))
# check class
expect_identical(class(outcome), c("ordered", "factor"))
# example_isolates should have these finding using Dutch guidelines
expect_equal(
as.double(table(outcome)),
c(1977, 23, 0)
)
# example_isolates should have these finding using Dutch guidelines
expect_equal(
as.double(table(outcome)),
c(1977, 23, 0)
)
expect_equal(
brmo(example_isolates, info = FALSE),
mdro(example_isolates, guideline = "BRMO", info = FALSE)
)
expect_equal(
brmo(example_isolates, info = FALSE),
mdro(example_isolates, guideline = "BRMO", info = FALSE)
)
# test Dutch P. aeruginosa MDRO
expect_equal(
as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"),
cfta = "S",
cipr = "S",
mero = "S",
imip = "S",
gent = "S",
tobr = "S",
pita = "S"
),
guideline = "BRMO",
col_mo = "mo",
info = FALSE
)),
"Negative"
)
expect_equal(
as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"),
cefta = "R",
cipr = "R",
mero = "R",
imip = "R",
gent = "R",
tobr = "R",
pita = "R"
),
guideline = "BRMO",
col_mo = "mo",
info = FALSE
)),
"Positive"
)
# German 3MRGN and 4MRGN
expect_equal(
as.character(mrgn(
data.frame(
mo = c(
"E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"
# test Dutch P. aeruginosa MDRO
expect_equal(
as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"),
cfta = "S",
cipr = "S",
mero = "S",
imip = "S",
gent = "S",
tobr = "S",
pita = "S"
),
PIP = c(
"S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"
guideline = "BRMO",
col_mo = "mo",
info = FALSE
)),
"Negative"
)
expect_equal(
as.character(mdro(
data.frame(
mo = as.mo("P. aeruginosa"),
cefta = "R",
cipr = "R",
mero = "R",
imip = "R",
gent = "R",
tobr = "R",
pita = "R"
),
CTX = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"
),
IPM = c(
"S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"
),
CIP = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"
),
stringsAsFactors = FALSE
)
)),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN")
)
guideline = "BRMO",
col_mo = "mo",
info = FALSE
)),
"Positive"
)
# MDR TB
expect_equal(
# select only rifampicine, mo will be determined automatically (as M. tuberculosis),
# number of mono-resistant strains should be equal to number of rifampicine-resistant strains
as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2],
count_R(example_isolates$RIF)
)
# German 3MRGN and 4MRGN
expect_equal(
as.character(mrgn(
data.frame(
mo = c(
"E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"
),
PIP = c(
"S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"
),
CTX = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"
),
IPM = c(
"S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"
),
CIP = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"
),
stringsAsFactors = FALSE
)
)),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN")
)
x <- data.frame(
rifampicin = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
inh = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
gatifloxacin = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
eth = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
pza = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
MFX = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
KAN = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5))
)
expect_true(length(unique(mdr_tb(x))) > 2)
# MDR TB
expect_equal(
# select only rifampicine, mo will be determined automatically (as M. tuberculosis),
# number of mono-resistant strains should be equal to number of rifampicine-resistant strains
as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2],
count_R(example_isolates$RIF)
)
# check the guideline by Magiorakos et al. (2012), the default guideline
stau <- data.frame(
mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(stau)), c(1:4))
expect_inherits(mdro(stau, verbose = TRUE), "data.frame")
x <- data.frame(
rifampicin = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
inh = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
gatifloxacin = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
eth = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
pza = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
MFX = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5)),
KAN = random_sir(5000, prob_sir = c(0.4, 0.1, 0.5))
)
expect_true(length(unique(mdr_tb(x))) > 2)
ente <- data.frame(
mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(ente)), c(1:4))
expect_inherits(mdro(ente, verbose = TRUE), "data.frame")
# check the guideline by Magiorakos et al. (2012), the default guideline
stau <- data.frame(
mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(stau)), c(1:4))
expect_inherits(mdro(stau, verbose = TRUE), "data.frame")
entero <- data.frame(
mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(entero)), c(1:4))
expect_inherits(mdro(entero, verbose = TRUE), "data.frame")
ente <- data.frame(
mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(ente)), c(1:4))
expect_inherits(mdro(ente, verbose = TRUE), "data.frame")
pseud <- data.frame(
mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(pseud)), c(1:4))
expect_inherits(mdro(pseud, verbose = TRUE), "data.frame")
entero <- data.frame(
mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(entero)), c(1:4))
expect_inherits(mdro(entero, verbose = TRUE), "data.frame")
acin <- data.frame(
mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(acin)), c(1:4))
expect_inherits(mdro(acin, verbose = TRUE), "data.frame")
pseud <- data.frame(
mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(pseud)), c(1:4))
expect_inherits(mdro(pseud, verbose = TRUE), "data.frame")
# custom rules
custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A",
"ERY == 'R' & age > 60" ~ "Elderly Type B",
as_factor = TRUE
)
expect_stdout(print(custom))
expect_stdout(print(c(custom, custom)))
expect_stdout(print(as.list(custom, custom)))
acin <- data.frame(
mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(acin)), c(1:4))
expect_inherits(mdro(acin, verbose = TRUE), "data.frame")
expect_stdout(x <- mdro(example_isolates, guideline = custom, info = TRUE))
expect_equal(as.double(table(x)), c(1070, 198, 732))
# custom rules
custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A",
"ERY == 'R' & age > 60" ~ "Elderly Type B",
as_factor = TRUE
)
expect_output(print(custom))
expect_output(print(c(custom, custom)))
expect_output(print(as.list(custom, custom)))
expect_stdout(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE)))
expect_error(custom_mdro_guideline())
expect_error(custom_mdro_guideline("test"))
expect_error(custom_mdro_guideline("test" ~ c(1:3)))
expect_error(custom_mdro_guideline("test" ~ A))
# expect_warning(mdro(example_isolates,
# # since `test` gives an error, it will be ignored with a warning
# guideline = custom_mdro_guideline(test ~ "A"),
# info = FALSE
# ))
expect_output(x <- mdro(example_isolates, guideline = custom, info = TRUE))
expect_equal(as.double(table(x)), c(1070, 198, 732))
# print groups
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))
expect_stdout(x <- mdro(example_isolates %>% group_by(ward), guideline = custom, info = TRUE))
}
expect_output(print(custom_mdro_guideline(AMX == "R" ~ "test", as_factor = FALSE)))
expect_error(custom_mdro_guideline())
expect_error(custom_mdro_guideline("test"))
expect_error(custom_mdro_guideline("test" ~ c(1:3)))
expect_error(custom_mdro_guideline("test" ~ A))
# expect_warning(mdro(example_isolates,
# # since `test` gives an error, it will be ignored with a warning
# guideline = custom_mdro_guideline(test ~ "A"),
# info = FALSE
# ))
# print groups
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_output(x <- mdro(example_isolates %>% group_by(ward), info = TRUE, pct_required_classes = 0))
expect_output(x <- mdro(example_isolates %>% group_by(ward), guideline = custom, info = TRUE))
}
})

60
tests/testthat/test-mean_amr_distance.R
View File

@ -27,37 +27,39 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
vctr_disk <- as.disk(c(20:25))
vctr_mic <- as.mic(2^c(0:5))
vctr_sir <- as.sir(c("S", "S", "I", "I", "R", "R"))
test_that("mean_amr_distance works", {
vctr_disk <- as.disk(c(20:25))
vctr_mic <- as.mic(2^c(0:5))
vctr_sir <- as.sir(c("S", "S", "I", "I", "R", "R"))
expect_identical(
mean_amr_distance(vctr_disk),
(as.double(vctr_disk) - mean(as.double(vctr_disk))) / sd(as.double(vctr_disk))
)
expect_identical(
mean_amr_distance(vctr_disk),
(as.double(vctr_disk) - mean(as.double(vctr_disk))) / sd(as.double(vctr_disk))
)
expect_identical(
mean_amr_distance(vctr_mic),
(log2(vctr_mic) - mean(log2(vctr_mic))) / sd(log2(vctr_mic))
)
expect_identical(
mean_amr_distance(vctr_mic),
(log2(vctr_mic) - mean(log2(vctr_mic))) / sd(log2(vctr_mic))
)
expect_identical(
mean_amr_distance(vctr_sir, combine_SI = FALSE),
(c(1, 1, 2, 2, 3, 3) - mean(c(1, 1, 2, 2, 3, 3))) / sd(c(1, 1, 2, 2, 3, 3))
)
expect_identical(
mean_amr_distance(vctr_sir, combine_SI = TRUE),
(c(1, 1, 1, 1, 3, 3) - mean(c(1, 1, 1, 1, 3, 3))) / sd(c(1, 1, 1, 1, 3, 3))
)
expect_identical(
mean_amr_distance(vctr_sir, combine_SI = FALSE),
(c(1, 1, 2, 2, 3, 3) - mean(c(1, 1, 2, 2, 3, 3))) / sd(c(1, 1, 2, 2, 3, 3))
)
expect_identical(
mean_amr_distance(vctr_sir, combine_SI = TRUE),
(c(1, 1, 1, 1, 3, 3) - mean(c(1, 1, 1, 1, 3, 3))) / sd(c(1, 1, 1, 1, 3, 3))
)
expect_equal(
mean_amr_distance(data.frame(AMX = vctr_mic, GEN = vctr_sir, TOB = vctr_disk)),
c(-1.10603655, -0.74968823, -0.39333990, -0.03699158, 0.96485397, 1.32120229),
tolerance = 0.00001
)
expect_equal(
mean_amr_distance(data.frame(AMX = vctr_mic, GEN = vctr_sir, TOB = vctr_disk)),
c(-1.10603655, -0.74968823, -0.39333990, -0.03699158, 0.96485397, 1.32120229),
tolerance = 0.00001
)
expect_equal(
mean_amr_distance(data.frame(AMX = vctr_mic, GEN = vctr_sir, TOB = vctr_disk), 2:3),
c(-0.9909017, -0.7236405, -0.4563792, -0.1891180, 1.0463891, 1.3136503),
tolerance = 0.00001
)
expect_equal(
mean_amr_distance(data.frame(AMX = vctr_mic, GEN = vctr_sir, TOB = vctr_disk), 2:3),
c(-0.9909017, -0.7236405, -0.4563792, -0.1891180, 1.0463891, 1.3136503),
tolerance = 0.00001
)
})

270
tests/testthat/test-mic.R
View File

@ -27,152 +27,154 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# used in multiple functions, also in plotting
expect_true(all(as.mic(AMR:::COMMON_MIC_VALUES) %in% AMR:::VALID_MIC_LEVELS))
expect_true(all(paste0("<=", as.mic(AMR:::COMMON_MIC_VALUES)) %in% AMR:::VALID_MIC_LEVELS))
expect_true(all(paste0(">=", as.mic(AMR:::COMMON_MIC_VALUES)) %in% AMR:::VALID_MIC_LEVELS))
test_that("mic works", {
# used in multiple functions, also in plotting
expect_true(all(as.mic(AMR:::COMMON_MIC_VALUES) %in% AMR:::VALID_MIC_LEVELS))
expect_true(all(paste0("<=", as.mic(AMR:::COMMON_MIC_VALUES)) %in% AMR:::VALID_MIC_LEVELS))
expect_true(all(paste0(">=", as.mic(AMR:::COMMON_MIC_VALUES)) %in% AMR:::VALID_MIC_LEVELS))
expect_true(as.mic(8) == as.mic("8"))
expect_true(as.mic("1") > as.mic("<=0.0625"))
expect_true(as.mic("1") < as.mic(">=32"))
expect_true(is.mic(as.mic(8)))
expect_true(as.mic(8) == as.mic("8"))
expect_true(as.mic("1") > as.mic("<=0.0625"))
expect_true(as.mic("1") < as.mic(">=32"))
expect_true(is.mic(as.mic(8)))
expect_equal(as.double(as.mic(">=32")), 32)
expect_equal(as.numeric(as.mic(">=32")), 32)
expect_equal(
as.integer(as.mic(">=32")), # should be factor level, not the MIC
as.integer(factor(as.character(">=32"),
levels = levels(as.mic(">=32"))
))
)
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA)
expect_equal(as.double(as.mic(">=32")), 32)
expect_equal(as.numeric(as.mic(">=32")), 32)
expect_equal(
as.integer(as.mic(">=32")), # should be factor level, not the MIC
as.integer(factor(as.character(">=32"),
levels = levels(as.mic(">=32"))
))
)
expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA)
# all levels should be valid MICs
x <- as.mic(c(2, 4))
expect_inherits(x[1], "mic")
expect_inherits(x[[1]], "mic")
expect_inherits(c(x[1], x[9]), "mic")
expect_inherits(unique(x[1], x[9]), "mic")
expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "factor")
expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "mic")
x[2] <- 32
expect_inherits(x, "mic")
# expect_warning(as.mic("INVALID VALUE"))
# all levels should be valid MICs
x <- as.mic(c(2, 4))
expect_inherits(x[1], "mic")
expect_inherits(x[[1]], "mic")
expect_inherits(c(x[1], x[9]), "mic")
expect_inherits(unique(x[1], x[9]), "mic")
expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "factor")
expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "mic")
x[2] <- 32
expect_inherits(x, "mic")
# expect_warning(as.mic("INVALID VALUE"))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "Escherichia coli", ab = "cipr"))
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8))), "gg")
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8, 32)), mo = "Escherichia coli", ab = "cipr"), "gg")
}
expect_stdout(print(as.mic(c(1, 2, 4, 8))))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8))))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), expand = FALSE))
expect_silent(plot(as.mic(c(1, 2, 4, 8)), mo = "Escherichia coli", ab = "cipr"))
if (AMR:::pkg_is_available("ggplot2")) {
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8))), "gg")
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8)), expand = FALSE), "gg")
expect_inherits(ggplot2::autoplot(as.mic(c(1, 2, 4, 8, 32)), mo = "Escherichia coli", ab = "cipr"), "gg")
}
expect_output(print(as.mic(c(1, 2, 4, 8))))
expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
expect_inherits(summary(as.mic(c(2, 8))), c("summaryDefault", "table"))
if (AMR:::pkg_is_available("tibble")) {
expect_stdout(print(tibble::tibble(m = as.mic(2:4))))
}
if (AMR:::pkg_is_available("tibble")) {
expect_output(print(tibble::tibble(m = as.mic(2:4))))
}
# all mathematical operations
x <- random_mic(50)
x_double <- as.double(gsub("[<=>]+", "", as.character(x)))
suppressWarnings(expect_identical(mean(x), mean(x_double)))
suppressWarnings(expect_identical(median(x), median(x_double)))
suppressWarnings(expect_identical(quantile(x), quantile(x_double)))
suppressWarnings(expect_identical(abs(x), abs(x_double)))
suppressWarnings(expect_identical(sign(x), sign(x_double)))
suppressWarnings(expect_identical(sqrt(x), sqrt(x_double)))
suppressWarnings(expect_identical(floor(x), floor(x_double)))
suppressWarnings(expect_identical(ceiling(x), ceiling(x_double)))
suppressWarnings(expect_identical(trunc(x), trunc(x_double)))
suppressWarnings(expect_identical(round(x), round(x_double)))
suppressWarnings(expect_identical(signif(x), signif(x_double)))
suppressWarnings(expect_identical(exp(x), exp(x_double)))
suppressWarnings(expect_identical(log(x), log(x_double)))
suppressWarnings(expect_identical(log10(x), log10(x_double)))
suppressWarnings(expect_identical(log2(x), log2(x_double)))
suppressWarnings(expect_identical(expm1(x), expm1(x_double)))
suppressWarnings(expect_identical(log1p(x), log1p(x_double)))
suppressWarnings(expect_identical(cos(x), cos(x_double)))
suppressWarnings(expect_identical(sin(x), sin(x_double)))
suppressWarnings(expect_identical(tan(x), tan(x_double)))
if (getRversion() >= "3.1") {
suppressWarnings(expect_identical(cospi(x), cospi(x_double)))
suppressWarnings(expect_identical(sinpi(x), sinpi(x_double)))
suppressWarnings(expect_identical(tanpi(x), tanpi(x_double)))
}
suppressWarnings(expect_identical(acos(x), acos(x_double)))
suppressWarnings(expect_identical(asin(x), asin(x_double)))
suppressWarnings(expect_identical(atan(x), atan(x_double)))
suppressWarnings(expect_identical(cosh(x), cosh(x_double)))
suppressWarnings(expect_identical(sinh(x), sinh(x_double)))
suppressWarnings(expect_identical(tanh(x), tanh(x_double)))
suppressWarnings(expect_identical(acosh(x), acosh(x_double)))
suppressWarnings(expect_identical(asinh(x), asinh(x_double)))
suppressWarnings(expect_identical(atanh(x), atanh(x_double)))
suppressWarnings(expect_identical(lgamma(x), lgamma(x_double)))
suppressWarnings(expect_identical(gamma(x), gamma(x_double)))
suppressWarnings(expect_identical(digamma(x), digamma(x_double)))
suppressWarnings(expect_identical(trigamma(x), trigamma(x_double)))
suppressWarnings(expect_identical(cumsum(x), cumsum(x_double)))
suppressWarnings(expect_identical(cumprod(x), cumprod(x_double)))
suppressWarnings(expect_identical(cummax(x), cummax(x_double)))
suppressWarnings(expect_identical(cummin(x), cummin(x_double)))
suppressWarnings(expect_identical(!x, !x_double))
# all mathematical operations
x <- random_mic(50)
x_double <- as.double(gsub("[<=>]+", "", as.character(x)))
suppressWarnings(expect_identical(mean(x), mean(x_double)))
suppressWarnings(expect_identical(median(x), median(x_double)))
suppressWarnings(expect_identical(quantile(x), quantile(x_double)))
suppressWarnings(expect_identical(abs(x), abs(x_double)))
suppressWarnings(expect_identical(sign(x), sign(x_double)))
suppressWarnings(expect_identical(sqrt(x), sqrt(x_double)))
suppressWarnings(expect_identical(floor(x), floor(x_double)))
suppressWarnings(expect_identical(ceiling(x), ceiling(x_double)))
suppressWarnings(expect_identical(trunc(x), trunc(x_double)))
suppressWarnings(expect_identical(round(x), round(x_double)))
suppressWarnings(expect_identical(signif(x), signif(x_double)))
suppressWarnings(expect_identical(exp(x), exp(x_double)))
suppressWarnings(expect_identical(log(x), log(x_double)))
suppressWarnings(expect_identical(log10(x), log10(x_double)))
suppressWarnings(expect_identical(log2(x), log2(x_double)))
suppressWarnings(expect_identical(expm1(x), expm1(x_double)))
suppressWarnings(expect_identical(log1p(x), log1p(x_double)))
suppressWarnings(expect_identical(cos(x), cos(x_double)))
suppressWarnings(expect_identical(sin(x), sin(x_double)))
suppressWarnings(expect_identical(tan(x), tan(x_double)))
if (getRversion() >= "3.1") {
suppressWarnings(expect_identical(cospi(x), cospi(x_double)))
suppressWarnings(expect_identical(sinpi(x), sinpi(x_double)))
suppressWarnings(expect_identical(tanpi(x), tanpi(x_double)))
}
suppressWarnings(expect_identical(acos(x), acos(x_double)))
suppressWarnings(expect_identical(asin(x), asin(x_double)))
suppressWarnings(expect_identical(atan(x), atan(x_double)))
suppressWarnings(expect_identical(cosh(x), cosh(x_double)))
suppressWarnings(expect_identical(sinh(x), sinh(x_double)))
suppressWarnings(expect_identical(tanh(x), tanh(x_double)))
suppressWarnings(expect_identical(acosh(x), acosh(x_double)))
suppressWarnings(expect_identical(asinh(x), asinh(x_double)))
suppressWarnings(expect_identical(atanh(x), atanh(x_double)))
suppressWarnings(expect_identical(lgamma(x), lgamma(x_double)))
suppressWarnings(expect_identical(gamma(x), gamma(x_double)))
suppressWarnings(expect_identical(digamma(x), digamma(x_double)))
suppressWarnings(expect_identical(trigamma(x), trigamma(x_double)))
suppressWarnings(expect_identical(cumsum(x), cumsum(x_double)))
suppressWarnings(expect_identical(cumprod(x), cumprod(x_double)))
suppressWarnings(expect_identical(cummax(x), cummax(x_double)))
suppressWarnings(expect_identical(cummin(x), cummin(x_double)))
suppressWarnings(expect_identical(!x, !x_double))
suppressWarnings(expect_identical(all(x), all(x_double)))
suppressWarnings(expect_identical(any(x), any(x_double)))
suppressWarnings(expect_identical(sum(x), sum(x_double)))
suppressWarnings(expect_identical(prod(x), prod(x_double)))
suppressWarnings(expect_identical(min(x), min(x_double)))
suppressWarnings(expect_identical(max(x), max(x_double)))
suppressWarnings(expect_identical(range(x), range(x_double)))
suppressWarnings(expect_identical(all(x), all(x_double)))
suppressWarnings(expect_identical(any(x), any(x_double)))
suppressWarnings(expect_identical(sum(x), sum(x_double)))
suppressWarnings(expect_identical(prod(x), prod(x_double)))
suppressWarnings(expect_identical(min(x), min(x_double)))
suppressWarnings(expect_identical(max(x), max(x_double)))
suppressWarnings(expect_identical(range(x), range(x_double)))
el1 <- random_mic(50)
el1_double <- as.double(gsub("[<=>]+", "", as.character(el1)))
el2 <- random_mic(50)
el2_double <- as.double(gsub("[<=>]+", "", as.character(el2)))
suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double))
suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double))
suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double))
suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double))
suppressWarnings(expect_identical(el1^el2, el1_double^el2_double))
suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double))
suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double))
suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double))
el1 <- random_mic(50)
el1_double <- as.double(gsub("[<=>]+", "", as.character(el1)))
el2 <- random_mic(50)
el2_double <- as.double(gsub("[<=>]+", "", as.character(el2)))
suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double))
suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double))
suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double))
suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double))
suppressWarnings(expect_identical(el1^el2, el1_double^el2_double))
suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double))
suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double))
suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double))
# for comparison operators, be more strict:
expect_true(as.mic(">32") > as.mic(32))
expect_true(as.mic(">32") >= as.mic(32))
expect_true(as.mic(">32") >= as.mic("<32"))
expect_true(as.mic(">32") >= as.mic("<=32"))
expect_true(as.mic(">32") > as.mic("<=32"))
# for comparison operators, be more strict:
expect_true(as.mic(">32") > as.mic(32))
expect_true(as.mic(">32") >= as.mic(32))
expect_true(as.mic(">32") >= as.mic("<32"))
expect_true(as.mic(">32") >= as.mic("<=32"))
expect_true(as.mic(">32") > as.mic("<=32"))
expect_false(as.mic("32") > as.mic(32))
expect_true(as.mic("32") >= as.mic(32))
expect_true(as.mic("32") >= as.mic("<32"))
expect_true(as.mic("32") >= as.mic("<=32"))
expect_false(as.mic("32") > as.mic("<=32"))
expect_false(as.mic("32") > as.mic(32))
expect_true(as.mic("32") >= as.mic(32))
expect_true(as.mic("32") >= as.mic("<32"))
expect_true(as.mic("32") >= as.mic("<=32"))
expect_false(as.mic("32") > as.mic("<=32"))
expect_true(as.mic("32") == as.mic(32))
expect_true(as.mic("32") == as.mic(32))
expect_false(as.mic("32") == as.mic("<32"))
expect_true(as.mic("32") == as.mic("<=32"))
expect_true(as.mic("32") == as.mic("<=32"))
expect_true(as.mic("32") == as.mic(32))
expect_true(as.mic("32") == as.mic(32))
expect_false(as.mic("32") == as.mic("<32"))
expect_true(as.mic("32") == as.mic("<=32"))
expect_true(as.mic("32") == as.mic("<=32"))
expect_false(as.mic(">32") < as.mic(32))
expect_false(as.mic(">32") <= as.mic(32))
expect_false(as.mic(">32") <= as.mic("<32"))
expect_false(as.mic(">32") <= as.mic("<=32"))
expect_false(as.mic(">32") < as.mic("<=32"))
expect_false(as.mic(">32") < as.mic(32))
expect_false(as.mic(">32") <= as.mic(32))
expect_false(as.mic(">32") <= as.mic("<32"))
expect_false(as.mic(">32") <= as.mic("<=32"))
expect_false(as.mic(">32") < as.mic("<=32"))
expect_false(as.mic("32") < as.mic(32))
expect_true(as.mic("32") <= as.mic(32))
expect_false(as.mic("32") <= as.mic("<32"))
expect_true(as.mic("32") <= as.mic("<=32"))
expect_false(as.mic("32") < as.mic("<=32"))
expect_false(as.mic("32") < as.mic(32))
expect_true(as.mic("32") <= as.mic(32))
expect_false(as.mic("32") <= as.mic("<32"))
expect_true(as.mic("32") <= as.mic("<=32"))
expect_false(as.mic("32") < as.mic("<=32"))
})

538
tests/testthat/test-mo.R
View File

@ -27,294 +27,296 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo, keep_synonyms = TRUE)))
test_that("mo works", {
MOs <- subset(microorganisms, !is.na(mo) & nchar(mo) > 3)
expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo, keep_synonyms = TRUE)))
expect_identical(
as.character(as.mo(c("E. coli", "H. influenzae"), keep_synonyms = FALSE)),
c("B_ESCHR_COLI", "B_HMPHL_INFL")
)
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR")
expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR")
expect_equal(as.character(as.mo("Eschr spp.")), "B_ESCHR")
expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter
expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN")
expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL")
expect_equal(as.character(as.mo("K. pneumo rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis
expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL")
expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC")
expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP")
expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus
expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo(c("GAS", "GBS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_HAEM"))
expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes
# GLIMS
expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL")
expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR")
expect_equal(as.character(as.mo("VRE")), "B_ENTRC")
expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG")
expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI")
expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL")
expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP"))
# expect_warning(as.mo("Acinetobacter calcoaceticus/baumannii complex"))
# prevalent MO
expect_identical(
suppressWarnings(as.character(
as.mo(c(
"stau", # WHONET code
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureus", # handles incorrect spelling
"Staphylococcus aureus (MRSA)",
"MRSA", # Methicillin Resistant S. aureus
"VISA", # Vancomycin Intermediate S. aureus
"VRSA", # Vancomycin Resistant S. aureus
115329001 # SNOMED CT code
))
)),
rep("B_STPHY_AURS", 11)
)
expect_identical(
as.character(
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))
),
rep("B_ESCHR_COLI", 6)
)
# unprevalent MO
expect_identical(
as.character(
as.mo(c(
"parnod",
"Paraburkholderia nodosa"
))
),
rep("B_PRBRK_NODS", 2)
)
# empty values
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
# expect_warning(as.mo("ab"))
expect_identical(
suppressWarnings(as.character(as.mo(c("Qq species", "MRSA", "K. pneu rhino", "esco")))),
c("UNKNOWN", "B_STPHY_AURS", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")
)
# check for Becker classification
expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR")
expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS")
expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS")
# aureus must only be influenced if Becker = "all"
expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS")
# check for Lancefield classification
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN")
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA")
expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC")
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B
expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB")
expect_identical(as.character(as.mo("S. equi", Lancefield = FALSE)), "B_STRPT_EQUI")
expect_identical(as.character(as.mo("S. equi", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
# Enterococci must only be influenced if Lancefield = "all"
expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D
expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN")
expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN")
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
# select with one column
expect_identical(
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus) %>%
as.mo() %>%
as.character(),
c(
"B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY",
"B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY"
as.character(as.mo(c("E. coli", "H. influenzae"), keep_synonyms = FALSE)),
c("B_ESCHR_COLI", "B_HMPHL_INFL")
)
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia coli")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo(112283007)), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("Escherichia species")), "B_ESCHR")
expect_equal(as.character(as.mo("Escherichia")), "B_ESCHR")
expect_equal(as.character(as.mo("Eschr spp.")), "B_ESCHR")
expect_equal(as.character(as.mo(" B_ESCHR_COLI ")), "B_ESCHR_COLI")
expect_equal(as.character(as.mo("e coli")), "B_ESCHR_COLI") # not Campylobacter
expect_equal(as.character(as.mo("klpn")), "B_KLBSL_PNMN")
expect_equal(as.character(as.mo("Klebsiella")), "B_KLBSL")
expect_equal(as.character(as.mo("K. pneumo rhino")), "B_KLBSL_PNMN_RHNS") # K. pneumoniae subspp. rhinoscleromatis
expect_equal(as.character(as.mo("Bartonella")), "B_BRTNL")
expect_equal(as.character(as.mo("C. difficile")), "B_CRDDS_DFFC")
expect_equal(as.character(as.mo("L. pneumophila")), "B_LGNLL_PNMP")
expect_equal(as.character(as.mo("Streptococcus")), "B_STRPT") # not Peptostreptoccus
expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo(c("GAS", "GBS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_HAEM"))
expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes
# GLIMS
expect_equal(as.character(as.mo("bctfgr")), "B_BCTRD_FRGL")
expect_equal(as.character(as.mo("MRSE")), "B_STPHY_EPDR")
expect_equal(as.character(as.mo("VRE")), "B_ENTRC")
expect_equal(as.character(as.mo("MRPA")), "B_PSDMN_AERG")
expect_equal(as.character(as.mo("PISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("PRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VISP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("VRSP")), "B_STRPT_PNMN")
expect_equal(as.character(as.mo("CNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CoNS")), "B_STPHY_CONS")
expect_equal(as.character(as.mo("CPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("CoPS")), "B_STPHY_COPS")
expect_equal(as.character(as.mo("VGS")), "B_STRPT_VIRI")
expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL")
expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP"))
# expect_warning(as.mo("Acinetobacter calcoaceticus/baumannii complex"))
# prevalent MO
expect_identical(
suppressWarnings(as.character(
as.mo(c(
"stau", # WHONET code
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureus", # handles incorrect spelling
"Staphylococcus aureus (MRSA)",
"MRSA", # Methicillin Resistant S. aureus
"VISA", # Vancomycin Intermediate S. aureus
"VRSA", # Vancomycin Resistant S. aureus
115329001 # SNOMED CT code
))
)),
rep("B_STPHY_AURS", 11)
)
expect_identical(
as.character(
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))
),
rep("B_ESCHR_COLI", 6)
)
# unprevalent MO
expect_identical(
as.character(
as.mo(c(
"parnod",
"Paraburkholderia nodosa"
))
),
rep("B_PRBRK_NODS", 2)
)
# empty values
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
# expect_warning(as.mo("ab"))
expect_identical(
suppressWarnings(as.character(as.mo(c("Qq species", "MRSA", "K. pneu rhino", "esco")))),
c("UNKNOWN", "B_STPHY_AURS", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")
)
# check for Becker classification
expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("Sta intermedius", Becker = FALSE)), "B_STPHY_INTR")
expect_identical(as.character(as.mo("Sta intermedius", Becker = TRUE)), "B_STPHY_COPS")
expect_identical(as.character(as.mo("STAINT", Becker = TRUE)), "B_STPHY_COPS")
# aureus must only be influenced if Becker = "all"
expect_identical(as.character(as.mo("STAAUR", Becker = FALSE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = TRUE)), "B_STPHY_AURS")
expect_identical(as.character(as.mo("STAAUR", Becker = "all")), "B_STPHY_COPS")
# check for Lancefield classification
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN")
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA")
expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC")
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B
expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB")
expect_identical(as.character(as.mo("S. equi", Lancefield = FALSE)), "B_STRPT_EQUI")
expect_identical(as.character(as.mo("S. equi", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
# Enterococci must only be influenced if Lancefield = "all"
expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D
expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN")
expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN")
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
# select with one column
expect_identical(
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus) %>%
as.mo() %>%
as.character(),
c(
"B_ESCHR", "B_ESCHR", "B_STPHY", "B_STPHY", "B_STPHY",
"B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY", "B_STPHY"
)
)
)
# select with two columns
expect_identical(
example_isolates %>%
slice(1:10) %>%
pull(mo),
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo()
)
# select with two columns
expect_identical(
example_isolates %>%
slice(1:10) %>%
pull(mo),
example_isolates %>%
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo()
)
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# test pull
# test pull
expect_equal(
nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000
)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
# print
expect_output(print(as.mo(c("B_ESCHR_COLI", NA))))
# test data.frame
expect_equal(
nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000
nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1
)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
# print
expect_stdout(print(as.mo(c("B_ESCHR_COLI", NA))))
# check empty values
expect_equal(
as.character(as.mo("")),
NA_character_
)
# test data.frame
expect_equal(
nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1
)
# check less prevalent MOs
expect_equal(as.character(as.mo("Actinosynnema pretiosum auranticum")), "B_ANNMA_PRTS_ARNT")
# expect_equal(as.character(as.mo("Actinosynnema preti aura")), "B_ANNMA_PRTS_ARNT")
# expect_equal(as.character(as.mo("A pre aur")), "B_ANNMA_PRTS_ARNT")
expect_equal(as.character(as.mo("Actinosynnema pretiosum")), "B_ANNMA_PRTS")
expect_equal(as.character(as.mo("Actinosynnema")), "B_ANNMA")
expect_equal(as.character(as.mo(" B_ANNMA_PRTS ")), "B_ANNMA_PRTS")
# check empty values
expect_equal(
as.character(as.mo("")),
NA_character_
)
# check old names
expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT")
expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT"))
expect_equal(suppressMessages(mo_name("eubcom")), "Clostridium combesii")
# check less prevalent MOs
expect_equal(as.character(as.mo("Actinosynnema pretiosum auranticum")), "B_ANNMA_PRTS_ARNT")
# expect_equal(as.character(as.mo("Actinosynnema preti aura")), "B_ANNMA_PRTS_ARNT")
# expect_equal(as.character(as.mo("A pre aur")), "B_ANNMA_PRTS_ARNT")
expect_equal(as.character(as.mo("Actinosynnema pretiosum")), "B_ANNMA_PRTS")
expect_equal(as.character(as.mo("Actinosynnema")), "B_ANNMA")
expect_equal(as.character(as.mo(" B_ANNMA_PRTS ")), "B_ANNMA_PRTS")
# predefined reference_df
expect_equal(
as.character(as.mo("TestingOwnID",
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
"B_ESCHR_COLI"
)
expect_equal(
as.character(as.mo(c("TestingOwnID", "E. coli"),
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# # expect_warning(as.mo("TestingOwnID", reference_df = NULL))
expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID")))
# check old names
expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT")
expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT"))
expect_equal(suppressMessages(mo_name("eubcom")), "Clostridium combesii")
# combination of existing mo and other code
expect_identical(
suppressWarnings(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL")))),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# predefined reference_df
expect_equal(
as.character(as.mo("TestingOwnID",
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
"B_ESCHR_COLI"
)
expect_equal(
as.character(as.mo(c("TestingOwnID", "E. coli"),
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# # expect_warning(as.mo("TestingOwnID", reference_df = NULL))
expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID")))
# from different sources
expect_equal(
as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI")
)),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI")
)
# combination of existing mo and other code
expect_identical(
suppressWarnings(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL")))),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# hard to find
expect_equal(
as.character(suppressMessages(as.mo(
c(
"Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena"
)
))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_KLBSL_TRRG")
)
expect_output(print(mo_uncertainties()))
x <- as.mo("Sta. aur")
# many hits
expect_output(print(mo_uncertainties()))
# from different sources
expect_equal(
as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI")
)),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI")
)
# no viruses
expect_equal(suppressWarnings(as.mo("Virus")), as.mo("UNKNOWN"))
# hard to find
expect_equal(
as.character(suppressMessages(as.mo(
c(
"Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena"
)
))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_KLBSL_TRRG")
)
expect_stdout(print(mo_uncertainties()))
x <- as.mo("Sta. aur")
# many hits
expect_stdout(print(mo_uncertainties()))
# summary
expect_equal(length(summary(example_isolates$mo)), 6)
# no viruses
expect_equal(suppressWarnings(as.mo("Virus")), as.mo("UNKNOWN"))
# WHONET codes and NA/NaN
expect_true(all(is.na(as.mo(c("xxx", "na", "nan")))))
expect_equal(as.character(as.mo(c("con", "eco"))), c("UNKNOWN", "B_ESCHR_COLI"))
expect_equal(
as.character(suppressWarnings(as.mo(c("other", "none", "unknown")))),
rep("UNKNOWN", 3)
)
# summary
expect_equal(length(summary(example_isolates$mo)), 6)
# ..coccus
expect_equal(
as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN")
)
# yeasts and fungi
expect_equal(
suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS")
)
# WHONET codes and NA/NaN
expect_true(all(is.na(as.mo(c("xxx", "na", "nan")))))
expect_equal(as.character(as.mo(c("con", "eco"))), c("UNKNOWN", "B_ESCHR_COLI"))
expect_equal(
as.character(suppressWarnings(as.mo(c("other", "none", "unknown")))),
rep("UNKNOWN", 3)
)
if (AMR:::pkg_is_available("tibble")) {
# print tibble
expect_output(print(tibble::tibble(mo = as.mo("B_ESCHR_COLI"))))
}
# ..coccus
expect_equal(
as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN")
)
# yeasts and fungi
expect_equal(
suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS")
)
# assigning and subsetting
x <- example_isolates$mo
expect_inherits(x[1], "mo")
expect_inherits(x[[1]], "mo")
expect_inherits(c(x[1], x[9]), "mo")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
if (AMR:::pkg_is_available("tibble")) {
# print tibble
expect_stdout(print(tibble::tibble(mo = as.mo("B_ESCHR_COLI"))))
}
# ignoring patterns
expect_true(is.na(as.mo("E. coli ignorethis", ignore_pattern = "this")))
# assigning and subsetting
x <- example_isolates$mo
expect_inherits(x[1], "mo")
expect_inherits(x[[1]], "mo")
expect_inherits(c(x[1], x[9]), "mo")
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
# ignoring patterns
expect_true(is.na(as.mo("E. coli ignorethis", ignore_pattern = "this")))
# frequency tables
if (AMR:::pkg_is_available("cleaner")) {
expect_inherits(cleaner::freq(example_isolates$mo), "freq")
}
# frequency tables
if (AMR:::pkg_is_available("cleaner")) {
expect_inherits(cleaner::freq(example_isolates$mo), "freq")
}
})

412
tests/testthat/test-mo_property.R
View File

@ -27,212 +27,214 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(mo_kingdom("Escherichia coli"), "Bacteria")
expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli"))
expect_equal(mo_phylum("Escherichia coli"), "Pseudomonadota")
expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria")
expect_equal(mo_order("Escherichia coli"), "Enterobacterales")
expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae")
expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli")
expect_equal(mo_genus("Escherichia coli"), "Escherichia")
expect_equal(mo_name("Escherichia coli"), "Escherichia coli")
expect_equal(mo_shortname("Escherichia coli"), "E. coli")
expect_equal(mo_shortname("Escherichia"), "Escherichia")
expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS")
expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae")
expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS")
test_that("mo_property works", {
expect_equal(mo_kingdom("Escherichia coli"), "Bacteria")
expect_equal(mo_kingdom("Escherichia coli"), mo_domain("Escherichia coli"))
expect_equal(mo_phylum("Escherichia coli"), "Pseudomonadota")
expect_equal(mo_class("Escherichia coli"), "Gammaproteobacteria")
expect_equal(mo_order("Escherichia coli"), "Enterobacterales")
expect_equal(mo_family("Escherichia coli"), "Enterobacteriaceae")
expect_equal(mo_fullname("Escherichia coli"), "Escherichia coli")
expect_equal(mo_genus("Escherichia coli"), "Escherichia")
expect_equal(mo_name("Escherichia coli"), "Escherichia coli")
expect_equal(mo_shortname("Escherichia coli"), "E. coli")
expect_equal(mo_shortname("Escherichia"), "Escherichia")
expect_equal(mo_shortname("Staphylococcus aureus"), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = TRUE), "S. aureus")
expect_equal(mo_shortname("Staphylococcus aureus", Becker = "all", language = "en"), "CoPS")
expect_equal(mo_shortname("Streptococcus agalactiae"), "S. agalactiae")
expect_equal(mo_shortname("Streptococcus agalactiae", Lancefield = TRUE), "GBS")
# check gram stain determination, to prevent we lag after a taxonomic renaming
current_grampos_phyla <- c(
"Actinomycetota", # since 2021, old name was Actinobacteria
"Chloroflexota", # since 2021, old name was Chloroflexi
"Bacillota", # since 2021, old name was Firmicutes
"Mycoplasmatota" # since 2021, old name was Tenericutes
)
expect_true(all(current_grampos_phyla %in% microorganisms$phylum, na.rm = TRUE))
current_grampos_classes <- c(
"",
"Acidimicrobiia",
"Actinomycetes",
"Anaerolineae",
"Ardenticatenia",
"Bacilli",
"Caldilineae",
"Chloroflexia",
"Clostridia",
"Coriobacteriia",
"Culicoidibacteria",
"Dehalococcoidia",
"Erysipelotrichia",
"Ktedonobacteria",
"Limnochordia",
"Limnocylindria",
"Mollicutes",
"Negativicutes",
"Nitriliruptoria",
"Rubrobacteria",
"Tepidiformia",
"Thermoflexia",
"Thermoleophilia",
"Thermolithobacteria"
)
expect_identical(
sort(unique(microorganisms[which(microorganisms$phylum %in% current_grampos_phyla), "class", drop = TRUE])),
current_grampos_classes
)
expect_equal(mo_species("Escherichia coli"), "coli")
expect_equal(mo_subspecies("Escherichia coli"), "")
expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria")
expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative")
expect_inherits(mo_taxonomy("Escherichia coli"), "list")
expect_equal(names(mo_taxonomy("Escherichia coli")), c(
"kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies"
))
expect_equal(mo_synonyms("Escherichia coli"), NULL)
expect_true(length(mo_synonyms("Candida albicans")) > 1)
expect_inherits(mo_synonyms(c("Candida albicans", "Escherichia coli")), "list")
expect_equal(names(mo_info("Escherichia coli")), c(
"mo", "rank",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"status", "synonyms", "gramstain", "oxygen_tolerance",
"url", "ref", "snomed", "lpsn", "mycobank", "gbif", "group_members"
))
expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
expect_true(length(mo_group_members("B_HACEK")) > 1)
expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list")
expect_identical(
mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
c("facultative anaerobe", "anaerobe")
)
expect_equal(
as.character(table(mo_pathogenicity(example_isolates$mo))),
c("1911", "72", "1", "16")
)
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
expect_equal(mo_year("Escherichia coli"), 1919)
expect_true(mo_url("Amoeba dysenteriae") %like% "gbif.org")
expect_true(mo_url("Candida albicans") %like% "mycobank.org")
expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
# test integrity of getting back full names
expect_identical(
microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"],
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE))
)
# check languages
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien")
expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief")
gr <- mo_gramstain("Escherichia coli", language = NULL)
for (l in AMR:::LANGUAGES_SUPPORTED[-1]) {
expect_false(mo_gramstain("Escherichia coli", language = l) == gr, info = paste("Gram-stain in language", l))
}
# test languages
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
fullnames <- microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]
to_dutch <- suppressWarnings(mo_name(fullnames, language = "nl", keep_synonyms = TRUE))
back_to_english <- suppressWarnings(mo_name(to_dutch, language = NULL, keep_synonyms = TRUE))
diffs <- paste0('"', fullnames[fullnames != back_to_english], '"', collapse = ", ")
expect_identical(fullnames, back_to_english, info = diffs) # gigantic test - will run ALL names
# manual property function
expect_error(mo_property("Escherichia coli", property = c("genus", "fullname")))
expect_error(mo_property("Escherichia coli", property = "UNKNOWN"))
expect_identical(
mo_property("Escherichia coli", property = "fullname"),
mo_fullname("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "genus"),
mo_genus("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "species"),
mo_species("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "lpsn"),
mo_lpsn("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "gbif"),
mo_gbif("Escherichia coli")
)
expect_identical(
mo_property("Absidia abundans", property = "mycobank"),
mo_mycobank("Absidia abundans")
)
expect_true("Escherichia blattae" %in% mo_synonyms("Shimwellia blattae"))
expect_true(is.list(mo_synonyms(rep("Shimwellia blattae", 2))))
expect_identical(
mo_current(c("Escherichia blattae", "Escherichia coli")),
c("Shimwellia blattae", "Escherichia coli")
)
expect_identical(mo_ref("Chlamydia psittaci"), "Garcia-Lopez et al., 2019")
expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999")
expect_true(112283007 %in% mo_snomed("Escherichia coli")[[1]])
# outcome of mo_fullname must always return the fullname from the data set
x <- data.frame(
mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en", keep_synonyms = TRUE),
stringsAsFactors = FALSE
)
expect_equal(nrow(subset(x, f1 != f2)), 0)
# is gram pos/neg (also return FALSE for all non-bacteria)
expect_equal(
mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE)
)
expect_equal(
mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE)
)
expect_equal(
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella")),
c(TRUE, FALSE, FALSE)
)
# is intrinsic resistant
expect_equal(
mo_is_intrinsic_resistant(
c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"),
"vanco"
),
c(TRUE, FALSE, FALSE)
)
# with reference data
expect_equal(
mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli"
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730,
tolerance = 0.5
# check gram stain determination, to prevent we lag after a taxonomic renaming
current_grampos_phyla <- c(
"Actinomycetota", # since 2021, old name was Actinobacteria
"Chloroflexota", # since 2021, old name was Chloroflexi
"Bacillota", # since 2021, old name was Firmicutes
"Mycoplasmatota" # since 2021, old name was Tenericutes
)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238,
tolerance = 0.5
expect_true(all(current_grampos_phyla %in% microorganisms$phylum, na.rm = TRUE))
current_grampos_classes <- c(
"",
"Acidimicrobiia",
"Actinomycetes",
"Anaerolineae",
"Ardenticatenia",
"Bacilli",
"Caldilineae",
"Chloroflexia",
"Clostridia",
"Coriobacteriia",
"Culicoidibacteria",
"Dehalococcoidia",
"Erysipelotrichia",
"Ktedonobacteria",
"Limnochordia",
"Limnocylindria",
"Mollicutes",
"Negativicutes",
"Nitriliruptoria",
"Rubrobacteria",
"Tepidiformia",
"Thermoflexia",
"Thermoleophilia",
"Thermolithobacteria"
)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710,
tolerance = 0.5
expect_identical(
sort(unique(microorganisms[which(microorganisms$phylum %in% current_grampos_phyla), "class", drop = TRUE])),
current_grampos_classes
)
}
expect_equal(mo_species("Escherichia coli"), "coli")
expect_equal(mo_subspecies("Escherichia coli"), "")
expect_equal(mo_type("Escherichia coli", language = "en"), "Bacteria")
expect_equal(mo_gramstain("Escherichia coli", language = "en"), "Gram-negative")
expect_inherits(mo_taxonomy("Escherichia coli"), "list")
expect_equal(names(mo_taxonomy("Escherichia coli")), c(
"kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies"
))
expect_equal(mo_synonyms("Escherichia coli"), NULL)
expect_true(length(mo_synonyms("Candida albicans")) > 1)
expect_inherits(mo_synonyms(c("Candida albicans", "Escherichia coli")), "list")
expect_equal(names(mo_info("Escherichia coli")), c(
"mo", "rank",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"status", "synonyms", "gramstain", "oxygen_tolerance",
"url", "ref", "snomed", "lpsn", "mycobank", "gbif", "group_members"
))
expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
expect_true(length(mo_group_members("B_HACEK")) > 1)
expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list")
expect_identical(
mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
c("facultative anaerobe", "anaerobe")
)
expect_equal(
as.character(table(mo_pathogenicity(example_isolates$mo))),
c("1911", "72", "1", "16")
)
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
expect_equal(mo_authors("Escherichia coli"), "Castellani et al.")
expect_equal(mo_year("Escherichia coli"), 1919)
expect_true(mo_url("Amoeba dysenteriae") %like% "gbif.org")
expect_true(mo_url("Candida albicans") %like% "mycobank.org")
expect_true(mo_url("Escherichia coli") %like% "lpsn.dsmz.de")
# test integrity of getting back full names
expect_identical(
microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"],
suppressWarnings(mo_fullname(microorganisms$fullname[microorganisms$fullname %unlike% "(Fungi|{)"], language = "en", keep_synonyms = TRUE))
)
# check languages
expect_equal(mo_type("Escherichia coli", language = "de"), "Bakterien")
expect_equal(mo_gramstain("Escherichia coli", language = "nl"), "Gram-negatief")
gr <- mo_gramstain("Escherichia coli", language = NULL)
for (l in AMR:::LANGUAGES_SUPPORTED[-1]) {
expect_false(mo_gramstain("Escherichia coli", language = l) == gr, info = paste("Gram-stain in language", l))
}
# test languages
expect_error(mo_gramstain("Escherichia coli", language = "UNKNOWN"))
fullnames <- microorganisms$fullname[which(microorganisms$fullname %unlike% "unknown|coagulase|Fungi|[(]class[)]|[{]")]
to_dutch <- suppressWarnings(mo_name(fullnames, language = "nl", keep_synonyms = TRUE))
back_to_english <- suppressWarnings(mo_name(to_dutch, language = NULL, keep_synonyms = TRUE))
diffs <- paste0('"', fullnames[fullnames != back_to_english], '"', collapse = ", ")
expect_identical(fullnames, back_to_english, info = diffs) # gigantic test - will run ALL names
# manual property function
expect_error(mo_property("Escherichia coli", property = c("genus", "fullname")))
expect_error(mo_property("Escherichia coli", property = "UNKNOWN"))
expect_identical(
mo_property("Escherichia coli", property = "fullname"),
mo_fullname("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "genus"),
mo_genus("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "species"),
mo_species("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "lpsn"),
mo_lpsn("Escherichia coli")
)
expect_identical(
mo_property("Escherichia coli", property = "gbif"),
mo_gbif("Escherichia coli")
)
expect_identical(
mo_property("Absidia abundans", property = "mycobank"),
mo_mycobank("Absidia abundans")
)
expect_true("Escherichia blattae" %in% mo_synonyms("Shimwellia blattae"))
expect_true(is.list(mo_synonyms(rep("Shimwellia blattae", 2))))
expect_identical(
mo_current(c("Escherichia blattae", "Escherichia coli")),
c("Shimwellia blattae", "Escherichia coli")
)
expect_identical(mo_ref("Chlamydia psittaci"), "Garcia-Lopez et al., 2019")
expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everett et al., 1999")
expect_true(112283007 %in% mo_snomed("Escherichia coli")[[1]])
# outcome of mo_fullname must always return the fullname from the data set
x <- data.frame(
mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en", keep_synonyms = TRUE),
stringsAsFactors = FALSE
)
expect_equal(nrow(subset(x, f1 != f2)), 0)
# is gram pos/neg (also return FALSE for all non-bacteria)
expect_equal(
mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE)
)
expect_equal(
mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE)
)
expect_equal(
mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella")),
c(TRUE, FALSE, FALSE)
)
# is intrinsic resistant
expect_equal(
mo_is_intrinsic_resistant(
c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"),
"vanco"
),
c(TRUE, FALSE, FALSE)
)
# with reference data
expect_equal(
mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli"
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730,
tolerance = 0.5
)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238,
tolerance = 0.5
)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710,
tolerance = 0.5
)
}
})

84
tests/testthat/test-pca.R
View File

@ -27,51 +27,53 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
resistance_data <- structure(
list(
order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)
),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(
test_that("pca works", {
resistance_data <- structure(
list(
order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)
order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)
),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(
list(
order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)
),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE
)
)
)
pca_model <- pca(resistance_data)
expect_inherits(pca_model, "pca")
pca_model <- pca(resistance_data)
expect_inherits(pca_model, "pca")
pdf(NULL) # prevent Rplots.pdf being created
if (AMR:::pkg_is_available("ggplot2")) {
ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE)
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
resistance_data <- example_isolates %>%
group_by(
order = mo_order(mo),
genus = mo_genus(mo)
) %>%
summarise_if(is.sir, resistance, minimum = 0)
pca_result <- resistance_data %>%
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
expect_inherits(pca_result, "prcomp")
pdf(NULL) # prevent Rplots.pdf being created
if (AMR:::pkg_is_available("ggplot2")) {
ggplot_pca(pca_result, ellipse = TRUE)
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
ggplot_pca(pca_model, ellipse = TRUE)
ggplot_pca(pca_model, arrows_textangled = FALSE)
}
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
resistance_data <- example_isolates %>%
group_by(
order = mo_order(mo),
genus = mo_genus(mo)
) %>%
summarise_if(is.sir, resistance, minimum = 0)
pca_result <- resistance_data %>%
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
expect_inherits(pca_result, "prcomp")
if (AMR:::pkg_is_available("ggplot2")) {
ggplot_pca(pca_result, ellipse = TRUE)
ggplot_pca(pca_result, ellipse = FALSE, arrows_textangled = FALSE, scale = FALSE)
}
}
})

158
tests/testthat/test-plotting.R
View File

@ -27,88 +27,90 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
if (AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
pdf(NULL) # prevent Rplots.pdf being created
test_that("plotting works", {
if (AMR:::pkg_is_available("ggplot2", also_load = TRUE)) {
pdf(NULL) # prevent Rplots.pdf being created
# scale_*_mic
aesthetics <- c("x", "y", "colour", "fill")
expected_methods <- c("transform", "transform_df", "breaks", "labels", "limits")
for (aest in aesthetics) {
scale_fn_name <- paste0("scale_", aest, "_continuous")
scale_obj <- getExportedValue("ggplot2", scale_fn_name)()
# scale_*_mic
aesthetics <- c("x", "y", "colour", "fill")
expected_methods <- c("transform", "transform_df", "breaks", "labels", "limits")
for (aest in aesthetics) {
scale_fn_name <- paste0("scale_", aest, "_continuous")
scale_obj <- getExportedValue("ggplot2", scale_fn_name)()
for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
)
}
}
# scale_*_sir
aesthetics <- c("colour", "fill")
expected_methods <- c("transform", "transform_df", "labels", "limits")
for (aest in aesthetics) {
scale_fn_name <- "scale_discrete_manual"
scale_obj <- getExportedValue("ggplot2", scale_fn_name)(aesthetics = aest)
for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
)
}
}
for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
expect_true(is.function(ggplot2::scale_x_discrete()[[method]]) || method %in% names(ggplot2::scale_x_discrete()),
info = paste0("Method '", method, "' is missing in ggplot2::", "scale_x_discrete")
)
}
}
# scale_*_sir
aesthetics <- c("colour", "fill")
expected_methods <- c("transform", "transform_df", "labels", "limits")
for (aest in aesthetics) {
scale_fn_name <- "scale_discrete_manual"
scale_obj <- getExportedValue("ggplot2", scale_fn_name)(aesthetics = aest)
for (method in expected_methods) {
expect_true(is.function(scale_obj[[method]]) || method %in% names(scale_obj),
info = paste0("Method '", method, "' is missing in ggplot2::", scale_fn_name)
)
}
}
for (method in expected_methods) {
expect_true(is.function(ggplot2::scale_x_discrete()[[method]]) || method %in% names(ggplot2::scale_x_discrete()),
info = paste0("Method '", method, "' is missing in ggplot2::", "scale_x_discrete")
expect_inherits(
ggplot(
data.frame(
count = c(1, 2, 3, 4),
sir = c("S", "I", "R", "SDD")
),
aes(x = sir, y = count, fill = sir)
) +
geom_col() +
scale_x_sir(eucast_I = F, language = "el") +
scale_fill_sir(eucast_I = T, language = "nl"),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_point() +
scale_y_mic(),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_col() +
scale_y_mic(),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_col() +
scale_y_mic(mic_range = c(4, 16)) +
scale_x_sir(),
"gg"
)
}
expect_inherits(
ggplot(
data.frame(
count = c(1, 2, 3, 4),
sir = c("S", "I", "R", "SDD")
),
aes(x = sir, y = count, fill = sir)
) +
geom_col() +
scale_x_sir(eucast_I = F, language = "el") +
scale_fill_sir(eucast_I = T, language = "nl"),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_point() +
scale_y_mic(),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_col() +
scale_y_mic(),
"gg"
)
expect_inherits(
ggplot(
data.frame(
mic = as.mic(c(2, 4, 8, 16)),
sir = as.sir(c("S", "I", "R", "SDD"))
),
aes(x = sir, y = mic)
) +
geom_col() +
scale_y_mic(mic_range = c(4, 16)) +
scale_x_sir(),
"gg"
)
}
})

240
tests/testthat/test-proportion.R
View File

@ -27,131 +27,133 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX))
expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001)
expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001)
expect_equal(sir_confidence_interval(example_isolates$AMX)[1], 0.5688204, tolerance = 0.0001)
expect_equal(sir_confidence_interval(example_isolates$AMX)[2], 0.6218738, tolerance = 0.0001)
expect_equal(
1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX),
proportion_S(example_isolates$AMX)
)
expect_equal(
proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_IR(example_isolates$AMX)
)
expect_equal(
proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_SI(example_isolates$AMX)
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% proportion_SI(AMC),
0.7626397,
tolerance = 0.0001
)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN),
0.9408,
tolerance = 0.0001
)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE),
0.9382647,
tolerance = 0.0001
)
# percentages
test_that("proportion works", {
expect_equal(proportion_R(example_isolates$AMX), resistance(example_isolates$AMX))
expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolates$AMX))
# AMX resistance in `example_isolates`
expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001)
expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001)
expect_equal(sir_confidence_interval(example_isolates$AMX)[1], 0.5688204, tolerance = 0.0001)
expect_equal(sir_confidence_interval(example_isolates$AMX)[2], 0.6218738, tolerance = 0.0001)
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
R = proportion_R(CIP, as_percent = TRUE),
I = proportion_I(CIP, as_percent = TRUE),
S = proportion_S(CIP, as_percent = TRUE),
n = n_sir(CIP),
total = n()
) %>%
pull(n) %>%
sum(),
1409
1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX),
proportion_S(example_isolates$AMX)
)
expect_equal(
proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_IR(example_isolates$AMX)
)
expect_equal(
proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_SI(example_isolates$AMX)
)
# count of cases
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_sir(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_sir(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_sir(CIP, GEN)
) %>%
pull(combination_n),
c(1181, 577, 116)
)
# proportion_df
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value),
c(
example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R()
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_equal(example_isolates %>% proportion_SI(AMC),
0.7626397,
tolerance = 0.0001
)
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value),
c(
example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_I(),
example_isolates$AMX %>% proportion_R()
expect_equal(example_isolates %>% proportion_SI(AMC, GEN),
0.9408,
tolerance = 0.0001
)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE),
0.9382647,
tolerance = 0.0001
)
# percentages
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
R = proportion_R(CIP, as_percent = TRUE),
I = proportion_I(CIP, as_percent = TRUE),
S = proportion_S(CIP, as_percent = TRUE),
n = n_sir(CIP),
total = n()
) %>%
pull(n) %>%
sum(),
1409
)
# count of cases
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_sir(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_sir(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_sir(CIP, GEN)
) %>%
pull(combination_n),
c(1181, 577, 116)
)
# proportion_df
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value),
c(
example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value),
c(
example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_I(),
example_isolates$AMX %>% proportion_R()
)
)
# expect_warning(example_isolates %>% group_by(ward) %>% summarise(across(KAN, sir_confidence_interval)))
}
# expect_warning(proportion_R(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(example_isolates$AMC, example_isolates$GEN)))
# expect_warning(n_sir(as.character(example_isolates$AMC, example_isolates$GEN)))
expect_equal(
suppressWarnings(n_sir(as.character(
example_isolates$AMC,
example_isolates$GEN
))),
1879
)
# expect_warning(example_isolates %>% group_by(ward) %>% summarise(across(KAN, sir_confidence_interval)))
}
# check for errors
expect_error(proportion_IR("test", minimum = "test"))
expect_error(proportion_IR("test", as_percent = "test"))
expect_error(proportion_I("test", minimum = "test"))
expect_error(proportion_I("test", as_percent = "test"))
expect_error(proportion_S("test", minimum = "test"))
expect_error(proportion_S("test", as_percent = "test"))
expect_error(proportion_S("test", also_single_tested = TRUE))
# expect_warning(proportion_R(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(example_isolates$AMC, example_isolates$GEN)))
# check too low amount of isolates
expect_identical(
suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
expect_identical(
suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
expect_identical(
suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
# expect_warning(n_sir(as.character(example_isolates$AMC, example_isolates$GEN)))
expect_equal(
suppressWarnings(n_sir(as.character(
example_isolates$AMC,
example_isolates$GEN
))),
1879
)
# check for errors
expect_error(proportion_IR("test", minimum = "test"))
expect_error(proportion_IR("test", as_percent = "test"))
expect_error(proportion_I("test", minimum = "test"))
expect_error(proportion_I("test", as_percent = "test"))
expect_error(proportion_S("test", minimum = "test"))
expect_error(proportion_S("test", as_percent = "test"))
expect_error(proportion_S("test", also_single_tested = TRUE))
# check too low amount of isolates
expect_identical(
suppressWarnings(proportion_R(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
expect_identical(
suppressWarnings(proportion_I(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
expect_identical(
suppressWarnings(proportion_S(example_isolates$AMX, minimum = nrow(example_isolates) + 1)),
NA_real_
)
# warning for speed loss
# expect_warning(proportion_R(as.character(example_isolates$GEN)))
# expect_warning(proportion_I(as.character(example_isolates$GEN)))
# expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date", drop = TRUE]))
# warning for speed loss
# expect_warning(proportion_R(as.character(example_isolates$GEN)))
# expect_warning(proportion_I(as.character(example_isolates$GEN)))
# expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date", drop = TRUE]))
})

24
tests/testthat/test-random.R
View File

@ -27,14 +27,16 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_inherits(random_mic(100), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae"), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic")
expect_inherits(random_mic(100, ab = "meropenem"), "mic")
# no normal factors of 2
expect_inherits(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic")
expect_inherits(random_disk(100), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae"), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk")
expect_inherits(random_disk(100, ab = "meropenem"), "disk")
expect_inherits(random_sir(100), "sir")
test_that("random works", {
expect_inherits(random_mic(100), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae"), "mic")
expect_inherits(random_mic(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "mic")
expect_inherits(random_mic(100, ab = "meropenem"), "mic")
# no normal factors of 2
expect_inherits(random_mic(100, "Haemophilus influenzae", "ceftaroline"), "mic")
expect_inherits(random_disk(100), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae"), "disk")
expect_inherits(random_disk(100, mo = "Klebsiella pneumoniae", ab = "meropenem"), "disk")
expect_inherits(random_disk(100, ab = "meropenem"), "disk")
expect_inherits(random_sir(100), "sir")
})

180
tests/testthat/test-resistance_predict.R
View File

@ -27,94 +27,96 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_stdout(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>%
sir_predict(
col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE
) %>%
pull("value"))
# AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20])
}
test_that("resistance_predict works", {
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_output(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>%
sir_predict(
col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE
) %>%
pull("value"))
# AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20])
}
expect_stdout(x <- suppressMessages(resistance_predict(example_isolates,
col_ab = "AMX",
year_min = 2010,
model = "binomial",
info = TRUE
)))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x))
if (AMR:::pkg_is_available("ggplot2")) {
expect_silent(ggplot_sir_predict(x))
expect_silent(ggplot2::autoplot(x))
expect_error(ggplot_sir_predict(example_isolates))
}
expect_stdout(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_stdout(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_stdout(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_output(x <- suppressMessages(resistance_predict(example_isolates,
col_ab = "AMX",
year_min = 2010,
model = "binomial",
info = TRUE
)))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(plot(x))
if (AMR:::pkg_is_available("ggplot2")) {
expect_silent(ggplot_sir_predict(x))
expect_silent(ggplot2::autoplot(x))
expect_error(ggplot_sir_predict(example_isolates))
}
expect_output(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_output(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_output(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE
))
# almost all E. coli are MEM S in the Netherlands :)
expect_error(resistance_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(sir_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE
))
# almost all E. coli are MEM S in the Netherlands :)
expect_error(resistance_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE
))
})

637
tests/testthat/test-sir.R
View File

@ -27,356 +27,357 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
test_that("sir works", {
# Existing SIR ------------------------------------------------------------
# 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)
# 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_stdout(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(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_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(
example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is_sir_eligible) %>%
as.logical() %>%
sum(),
40
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_equal(sum(is.sir(example_isolates)), 40)
expect_stdout(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())
}
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_inherits(
skim(example_isolates),
"data.frame"
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(get_guideline("this one does not exist"))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_inherits(
# 40 sir columns
expect_equal(
example_isolates %>%
mutate(
m = as.mic(2),
d = as.disk(20)
) %>%
skim(),
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())
}
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0", also_load = TRUE)) {
expect_inherits(
skim(example_isolates),
"data.frame"
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0", also_load = TRUE)) {
expect_inherits(
example_isolates %>%
mutate(
m = as.mic(2),
d = as.disk(20)
) %>%
skim(),
"data.frame"
)
}
}
}
expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_))
expect_equal(as.sir(c("", "-", NA, "NULL")), c(NA_sir_, NA_sir_, NA_sir_, NA_sir_))
# Human -------------------------------------------------------------------
# Human -------------------------------------------------------------------
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")
)
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)
# 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)
}
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(
# 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.mic(c(0.125, 0.5, 1, 2, 4)),
x = as.disk(22),
mo = "B_STRPT_PNMN",
ab = "AMP",
guideline = "EUCAST 2020"
ab = "ERY",
guideline = "CLSI"
)
)
),
c("S", "S", "I", "I", "R")
)
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
expect_equal(
suppressMessages(
),
"S"
)
expect_equal(
as.character(
as.sir(
x = as.mic(c(1, 2, 4, 8, 16)),
x = as.disk(18),
mo = "B_STRPT_PNMN",
ab = "AMX",
guideline = "CLSI 2019"
ab = "ERY",
guideline = "CLSI"
)
)
),
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
),
"I"
)
expect_equal(
class(groups$.rows),
c("vctrs_list_of", "vctrs_vctr", "list")
as.character(
as.sir(
x = as.disk(10),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI"
)
),
"R"
)
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")
}
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
)))
expect_message(as.sir(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood")
)))
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
)))
expect_message(as.sir(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood")
)))
# 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
# 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 --------------------------------------------------------------
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 <- as.sir(vet, host = vet$animal, guideline = "CLSI 2023")
# host column name instead of values
expect_identical(
out_vet,
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, "I", 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")))
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", "cats", "cats", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "dogs",
"dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs",
"horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "poultry", "poultry", "poultry", "poultry"
as.sir(c("S", "S", "S", "I", "R"))
)
)
# ECOFF -------------------------------------------------------------------
expect_equal(
suppressMessages(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", breakpoint_type = "ECOFF")),
as.sir("S")
)
# old method
expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE))
# Veterinary --------------------------------------------------------------
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 <- as.sir(vet, host = vet$animal, guideline = "CLSI 2023")
# host column name instead of values
expect_identical(
out_vet,
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, "I", 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")))
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", "cats", "cats", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "cattle", "dogs",
"dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs", "dogs",
"horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "horse", "poultry", "poultry", "poultry", "poultry"
)
)
# ECOFF -------------------------------------------------------------------
expect_equal(
suppressMessages(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", breakpoint_type = "ECOFF")),
as.sir("S")
)
# old method
expect_warning(as.sir(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020", ecoff = TRUE))
})

26
tests/testthat/test-skewness.R
View File

@ -27,15 +27,17 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(skewness(example_isolates$age),
-1.212888,
tolerance = 0.00001
)
expect_equal(unname(skewness(data.frame(example_isolates$age))),
-1.212888,
tolerance = 0.00001
)
expect_equal(skewness(matrix(example_isolates$age)),
-1.212888,
tolerance = 0.00001
)
test_that("skewness works", {
expect_equal(skewness(example_isolates$age),
-1.212888,
tolerance = 0.00001
)
expect_equal(unname(skewness(data.frame(example_isolates$age))),
-1.212888,
tolerance = 0.00001
)
expect_equal(skewness(matrix(example_isolates$age)),
-1.212888,
tolerance = 0.00001
)
})

24
tests/testthat/test-top_n_microorganisms.R
View File

@ -27,17 +27,19 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
out1 <- top_n_microorganisms(example_isolates, n = 3)
out2 <- top_n_microorganisms(example_isolates, n = 5, property = "genus")
out3 <- top_n_microorganisms(example_isolates, n = 5, property = "genus", n_for_each = 3)
test_that("top_n_microorganisms works", {
out1 <- top_n_microorganisms(example_isolates, n = 3)
out2 <- top_n_microorganisms(example_isolates, n = 5, property = "genus")
out3 <- top_n_microorganisms(example_isolates, n = 5, property = "genus", n_for_each = 3)
expect_equal(NROW(out1), 1015, tolerance = 0.5)
expect_equal(NROW(out2), 1742, tolerance = 0.5)
expect_equal(NROW(out3), 1497, tolerance = 0.5)
expect_equal(NROW(out1), 1015, tolerance = 0.5)
expect_equal(NROW(out2), 1742, tolerance = 0.5)
expect_equal(NROW(out3), 1497, tolerance = 0.5)
expect_equal(length(table(out1$mo)), 3, tolerance = 0.5)
expect_equal(length(table(out2$mo)), 39, tolerance = 0.5)
expect_equal(length(table(out3$mo)), 13, tolerance = 0.5)
expect_equal(length(table(out1$mo)), 3, tolerance = 0.5)
expect_equal(length(table(out2$mo)), 39, tolerance = 0.5)
expect_equal(length(table(out3$mo)), 13, tolerance = 0.5)
expect_equal(length(unique(mo_genus(out2$mo))), 5, tolerance = 0.5)
expect_equal(length(unique(mo_genus(out3$mo))), 5, tolerance = 0.5)
expect_equal(length(unique(mo_genus(out2$mo))), 5, tolerance = 0.5)
expect_equal(length(unique(mo_genus(out3$mo))), 5, tolerance = 0.5)
})

46
tests/testthat/test-translate.R
View File

@ -27,27 +27,29 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(mo_genus("B_GRAMP", language = "pt"), "(gênero desconhecido)")
test_that("translate works", {
expect_identical(mo_genus("B_GRAMP", language = "pt"), "(gênero desconhecido)")
expect_identical(mo_fullname("CoNS", "cs"), "Koaguláza-negativní stafylokok (KNS)")
expect_identical(mo_fullname("CoNS", "da"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)")
expect_identical(mo_fullname("CoNS", "el"), "Σταφυλόκοκκος με αρνητική πηκτικότητα (CoNS)")
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
expect_identical(mo_fullname("CoNS", "fi"), "Koagulaasinegatiivinen stafylokokki (KNS)")
expect_identical(mo_fullname("CoNS", "fr"), "Staphylococcus à coagulase négative (CoNS)")
expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
expect_identical(mo_fullname("CoNS", "ja"), "コアグラーゼ陰性ブドウ球菌 (グラム陰性)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "no"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "pl"), "Staphylococcus koagulazoujemny (CoNS)")
expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")
expect_identical(mo_fullname("CoNS", "ro"), "Stafilococ coagulazo-negativ (SCN)")
expect_identical(mo_fullname("CoNS", "ru"), "Коагулазоотрицательный стафилококк (КОС)")
expect_identical(mo_fullname("CoNS", "sv"), "Koagulasnegativa stafylokocker (KNS)")
expect_identical(mo_fullname("CoNS", "tr"), "Koagülaz-negatif Stafilokok (KNS)")
expect_identical(mo_fullname("CoNS", "uk"), "Коагулазонегативний стафілокок (КНС)")
expect_identical(mo_fullname("CoNS", "zh"), "凝固酶阴性葡萄球菌 (CoNS)")
expect_identical(mo_fullname("CoNS", "cs"), "Koaguláza-negativní stafylokok (KNS)")
expect_identical(mo_fullname("CoNS", "da"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "de"), "Koagulase-negative Staphylococcus (KNS)")
expect_identical(mo_fullname("CoNS", "el"), "Σταφυλόκοκκος με αρνητική πηκτικότητα (CoNS)")
expect_identical(mo_fullname("CoNS", "en"), "Coagulase-negative Staphylococcus (CoNS)")
expect_identical(mo_fullname("CoNS", "es"), "Staphylococcus coagulasa negativo (SCN)")
expect_identical(mo_fullname("CoNS", "fi"), "Koagulaasinegatiivinen stafylokokki (KNS)")
expect_identical(mo_fullname("CoNS", "fr"), "Staphylococcus à coagulase négative (CoNS)")
expect_identical(mo_fullname("CoNS", "it"), "Staphylococcus negativo coagulasi (CoNS)")
expect_identical(mo_fullname("CoNS", "ja"), "コアグラーゼ陰性ブドウ球菌 (グラム陰性)")
expect_identical(mo_fullname("CoNS", "nl"), "Coagulase-negatieve Staphylococcus (CNS)")
expect_identical(mo_fullname("CoNS", "no"), "Koagulase-negative stafylokokker (KNS)")
expect_identical(mo_fullname("CoNS", "pl"), "Staphylococcus koagulazoujemny (CoNS)")
expect_identical(mo_fullname("CoNS", "pt"), "Staphylococcus coagulase negativo (CoNS)")
expect_identical(mo_fullname("CoNS", "ro"), "Stafilococ coagulazo-negativ (SCN)")
expect_identical(mo_fullname("CoNS", "ru"), "Коагулазоотрицательный стафилококк (КОС)")
expect_identical(mo_fullname("CoNS", "sv"), "Koagulasnegativa stafylokocker (KNS)")
expect_identical(mo_fullname("CoNS", "tr"), "Koagülaz-negatif Stafilokok (KNS)")
expect_identical(mo_fullname("CoNS", "uk"), "Коагулазонегативний стафілокок (КНС)")
expect_identical(mo_fullname("CoNS", "zh"), "凝固酶阴性葡萄球菌 (CoNS)")
expect_error(mo_fullname("CoNS", "aa"))
expect_error(mo_fullname("CoNS", "aa"))
})

56
tests/testthat/test-vctrs.R
View File

@ -27,31 +27,33 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# extra tests for {vctrs} pkg support
if (AMR:::pkg_is_available("tibble")) {
test <- tibble::tibble(
ab = as.ab("CIP"),
mo = as.mo("Escherichia coli"),
mic = as.mic(2),
disk = as.disk(20),
sir = as.sir("S")
)
check1 <- lapply(test, class)
test[1, "ab"] <- "GEN"
test[1, "mo"] <- "B_KLBSL_PNMN"
test[1, "mic"] <- ">=32"
test[1, "mic"] <- 32
test[1, "disk"] <- "35"
test[1, "disk"] <- 25
test[1, "disk"] <- 26L
test[1, "sir"] <- "R"
check2 <- lapply(test, class)
expect_identical(check1, check2)
test_that("vctrs works", {
# extra tests for {vctrs} pkg support
if (AMR:::pkg_is_available("tibble")) {
test <- tibble::tibble(
ab = as.ab("CIP"),
mo = as.mo("Escherichia coli"),
mic = as.mic(2),
disk = as.disk(20),
sir = as.sir("S")
)
check1 <- lapply(test, class)
test[1, "ab"] <- "GEN"
test[1, "mo"] <- "B_KLBSL_PNMN"
test[1, "mic"] <- ">=32"
test[1, "mic"] <- 32
test[1, "disk"] <- "35"
test[1, "disk"] <- 25
test[1, "disk"] <- 26L
test[1, "sir"] <- "R"
check2 <- lapply(test, class)
expect_identical(check1, check2)
test <- tibble::tibble(
cipro = as.sir("S"),
variable = "test"
)
expect_equal(nrow(test[quinolones() == "S", ]), 1)
expect_equal(nrow(test[quinolones() == "R", ]), 0)
}
test <- tibble::tibble(
cipro = as.sir("S"),
variable = "test"
)
expect_equal(nrow(test[quinolones() == "S", ]), 1)
expect_equal(nrow(test[quinolones() == "R", ]), 0)
}
})

290
tests/testthat/test-zzz.R
View File

@ -27,150 +27,152 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# Check if these functions still exist in their package (all are in Suggests field)
# Since GitHub Actions runs every night, we will get emailed when a dependency fails based on this unit test
test_that("zzz works", {
# Check if these functions still exist in their package (all are in Suggests field)
# Since GitHub Actions runs every night, we will get emailed when a dependency fails based on this unit test
# functions used by import_fn()
import_functions <- c(
"%chin%" = "data.table",
"anti_join" = "dplyr",
"as.data.table" = "data.table",
"as_tibble" = "tibble",
"chmatch" = "data.table",
"cli_abort" = "cli",
"cur_column" = "dplyr",
"cur_group" = "dplyr",
"document_position" = "rstudioapi",
"document_range" = "rstudioapi",
"full_join" = "dplyr",
"getActiveDocumentContext" = "rstudioapi",
"has_color" = "crayon",
"has_internet" = "curl",
"html_attr" = "rvest",
"html_children" = "rvest",
"html_node" = "rvest",
"html_nodes" = "rvest",
"html_table" = "rvest",
"html_text" = "rvest",
"inner_join" = "dplyr",
"insertText" = "rstudioapi",
"left_join" = "dplyr",
"modifyRange" = "rstudioapi",
"new_pillar_shaft_simple" = "pillar",
"progress_bar" = "progress",
"read_html" = "xml2",
"right_join" = "dplyr",
"semi_join" = "dplyr",
"showQuestion" = "rstudioapi",
"symbol" = "cli",
"tibble" = "tibble",
"write.xlsx" = "openxlsx"
)
# functions that are called directly with ::
call_functions <- c(
# cleaner
"freq" = "cleaner",
"freq.default" = "cleaner",
"percentage" = "cleaner",
# cli
"symbol" = "cli",
# curl
"has_internet" = "curl",
# ggplot2
"aes" = "ggplot2",
"arrow" = "ggplot2",
"autoplot" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"expand_limits" = "ggplot2",
"facet_wrap" = "ggplot2",
"fortify" = "ggplot2",
"geom_col" = "ggplot2",
"geom_errorbar" = "ggplot2",
"geom_path" = "ggplot2",
"geom_point" = "ggplot2",
"geom_ribbon" = "ggplot2",
"geom_segment" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"position_dodge2" = "ggplot2",
"position_fill" = "ggplot2",
"scale_colour_discrete" = "ggplot2",
"scale_discrete_manual" = "ggplot2",
"scale_fill_discrete" = "ggplot2",
"scale_fill_manual" = "ggplot2",
"scale_x_discrete" = "ggplot2",
"scale_y_continuous" = "ggplot2",
"scale_y_discrete" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
"unit" = "ggplot2",
"xlab" = "ggplot2",
"ylab" = "ggplot2",
# knitr
"asis_output" = "knitr",
"kable" = "knitr",
"knit_print" = "knitr",
"opts_chunk" = "knitr",
# pillar
"pillar_shaft" = "pillar",
"tbl_format_footer" = "pillar",
"tbl_sum" = "pillar",
"type_sum" = "pillar",
# readxl
"read_excel" = "readxl",
# rmarkdown
"html_vignette" = "rmarkdown",
# skimr
"get_skimmers" = "skimr",
"inline_hist" = "skimr",
"sfl" = "skimr",
# tibble
"tibble" = "tibble",
# vctrs
"vec_arith" = "vctrs",
"vec_cast" = "vctrs",
"vec_math" = "vctrs",
"vec_ptype2" = "vctrs",
"vec_ptype_abbr" = "vctrs",
"vec_ptype_full" = "vctrs"
)
import_functions <- c(import_functions, call_functions)
suggests <- strsplit(utils::packageDescription("AMR")$Suggests, "[,\n ]+")[[1]]
for (i in seq_len(length(import_functions))) {
fn <- names(import_functions)[i]
pkg <- unname(import_functions[i])
expect_true(pkg %in% suggests,
info = paste0("package `", pkg, "` is not in Suggests")
# functions used by import_fn()
import_functions <- c(
"%chin%" = "data.table",
"anti_join" = "dplyr",
"as.data.table" = "data.table",
"as_tibble" = "tibble",
"chmatch" = "data.table",
"cli_abort" = "cli",
"cur_column" = "dplyr",
"cur_group" = "dplyr",
"document_position" = "rstudioapi",
"document_range" = "rstudioapi",
"full_join" = "dplyr",
"getActiveDocumentContext" = "rstudioapi",
"has_color" = "crayon",
"has_internet" = "curl",
"html_attr" = "rvest",
"html_children" = "rvest",
"html_node" = "rvest",
"html_nodes" = "rvest",
"html_table" = "rvest",
"html_text" = "rvest",
"inner_join" = "dplyr",
"insertText" = "rstudioapi",
"left_join" = "dplyr",
"modifyRange" = "rstudioapi",
"new_pillar_shaft_simple" = "pillar",
"progress_bar" = "progress",
"read_html" = "xml2",
"right_join" = "dplyr",
"semi_join" = "dplyr",
"showQuestion" = "rstudioapi",
"symbol" = "cli",
"tibble" = "tibble",
"write.xlsx" = "openxlsx"
)
# function should exist in foreign pkg namespace
if (AMR:::pkg_is_available(pkg,
also_load = FALSE,
min_version = if (pkg == "dplyr") "1.0.0" else NULL
)) {
expect_true(!is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`")
)
} else if (pkg != "rstudioapi") {
warning("Package '", pkg, "' not available")
}
}
if (AMR:::pkg_is_available("cli")) {
expect_true(!is.null(cli::symbol$bullet) && is.character(cli::symbol$bullet) && length(cli::symbol$bullet) == 1)
expect_true(!is.null(cli::symbol$ellipsis) && is.character(cli::symbol$ellipsis) && length(cli::symbol$ellipsis) == 1)
expect_true(!is.null(cli::symbol$info) && is.character(cli::symbol$info) && length(cli::symbol$info) == 1)
expect_true(!is.null(cli::symbol$sup_1) && is.character(cli::symbol$sup_1) && length(cli::symbol$sup_1) == 1)
}
if (AMR:::pkg_is_available("ggplot2")) {
# the scale_*_mic() functions rely on these
expect_true(is.function(ggplot2::scale_x_discrete()$transform))
expect_true(is.function(ggplot2::scale_y_discrete()$transform))
expect_true(is.function(ggplot2::scale_colour_discrete()$transform))
expect_true(is.function(ggplot2::scale_fill_discrete()$transform))
}
# functions that are called directly with ::
call_functions <- c(
# cleaner
"freq" = "cleaner",
"freq.default" = "cleaner",
"percentage" = "cleaner",
# cli
"symbol" = "cli",
# curl
"has_internet" = "curl",
# ggplot2
"aes" = "ggplot2",
"arrow" = "ggplot2",
"autoplot" = "ggplot2",
"element_blank" = "ggplot2",
"element_line" = "ggplot2",
"element_text" = "ggplot2",
"expand_limits" = "ggplot2",
"facet_wrap" = "ggplot2",
"fortify" = "ggplot2",
"geom_col" = "ggplot2",
"geom_errorbar" = "ggplot2",
"geom_path" = "ggplot2",
"geom_point" = "ggplot2",
"geom_ribbon" = "ggplot2",
"geom_segment" = "ggplot2",
"geom_text" = "ggplot2",
"ggplot" = "ggplot2",
"labs" = "ggplot2",
"position_dodge2" = "ggplot2",
"position_fill" = "ggplot2",
"scale_colour_discrete" = "ggplot2",
"scale_discrete_manual" = "ggplot2",
"scale_fill_discrete" = "ggplot2",
"scale_fill_manual" = "ggplot2",
"scale_x_discrete" = "ggplot2",
"scale_y_continuous" = "ggplot2",
"scale_y_discrete" = "ggplot2",
"theme" = "ggplot2",
"theme_minimal" = "ggplot2",
"unit" = "ggplot2",
"xlab" = "ggplot2",
"ylab" = "ggplot2",
# knitr
"asis_output" = "knitr",
"kable" = "knitr",
"knit_print" = "knitr",
"opts_chunk" = "knitr",
# pillar
"pillar_shaft" = "pillar",
"tbl_format_footer" = "pillar",
"tbl_sum" = "pillar",
"type_sum" = "pillar",
# readxl
"read_excel" = "readxl",
# rmarkdown
"html_vignette" = "rmarkdown",
# skimr
"get_skimmers" = "skimr",
"inline_hist" = "skimr",
"sfl" = "skimr",
# tibble
"tibble" = "tibble",
# vctrs
"vec_arith" = "vctrs",
"vec_cast" = "vctrs",
"vec_math" = "vctrs",
"vec_ptype2" = "vctrs",
"vec_ptype_abbr" = "vctrs",
"vec_ptype_full" = "vctrs"
)
import_functions <- c(import_functions, call_functions)
suggests <- strsplit(utils::packageDescription("AMR")$Suggests, "[,\n ]+")[[1]]
for (i in seq_len(length(import_functions))) {
fn <- names(import_functions)[i]
pkg <- unname(import_functions[i])
expect_true(pkg %in% suggests,
info = paste0("package `", pkg, "` is not in Suggests")
)
# function should exist in foreign pkg namespace
if (AMR:::pkg_is_available(pkg,
also_load = FALSE,
min_version = if (pkg == "dplyr") "1.0.0" else NULL
)) {
expect_true(!is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`")
)
} else if (pkg != "rstudioapi") {
warning("Package '", pkg, "' not available")
}
}
if (AMR:::pkg_is_available("cli")) {
expect_true(!is.null(cli::symbol$bullet) && is.character(cli::symbol$bullet) && length(cli::symbol$bullet) == 1)
expect_true(!is.null(cli::symbol$ellipsis) && is.character(cli::symbol$ellipsis) && length(cli::symbol$ellipsis) == 1)
expect_true(!is.null(cli::symbol$info) && is.character(cli::symbol$info) && length(cli::symbol$info) == 1)
expect_true(!is.null(cli::symbol$sup_1) && is.character(cli::symbol$sup_1) && length(cli::symbol$sup_1) == 1)
}
if (AMR:::pkg_is_available("ggplot2")) {
# the scale_*_mic() functions rely on these
expect_true(is.function(ggplot2::scale_x_discrete()$transform))
expect_true(is.function(ggplot2::scale_y_discrete()$transform))
expect_true(is.function(ggplot2::scale_colour_discrete()$transform))
expect_true(is.function(ggplot2::scale_fill_discrete()$transform))
}
})