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

styled, unit test fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-08-28 10:31:50 +02:00
parent 4cb1db4554
commit 4d050aef7c
147 changed files with 10897 additions and 8169 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
inst/tinytest/test-_deprecated.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -22,4 +22,3 @@
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #

2
inst/tinytest/test-_misc.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

52
inst/tinytest/test-ab.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,17 +23,21 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_equal(as.character(as.ab(c("J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
" eryt 123",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"))),
rep("ERY", 10))
expect_equal(
as.character(as.ab(c(
"J01FA01",
"J 01 FA 01",
"Erythromycin",
"eryt",
" eryt 123",
"ERYT",
"ERY",
"erytromicine",
"Erythrocin",
"Romycin"
))),
rep("ERY", 10)
)
expect_identical(class(as.ab("amox")), c("ab", "character"))
expect_identical(class(antibiotics$ab), c("ab", "character"))
@ -47,17 +51,25 @@ expect_warning(as.ab(""))
expect_stdout(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_message(as.ab("cipro mero"))

44
inst/tinytest/test-ab_from_text.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,18 +23,32 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin"))
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin")
expect_identical(ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP")
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds")[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = TRUE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", thorough_search = FALSE)[[1]],
as.ab("Amoxicillin")
)
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", translate_ab = TRUE)[[1]],
"Amoxicillin"
)
expect_identical(
ab_from_text("administered amoxi/clav and cipro", collapse = ", ")[[1]],
"AMC, CIP"
)
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]],
500)
expect_identical(ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral")
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "dose")[[1]],
500
)
expect_identical(
ab_from_text("28/03/2020 regular amoxicilliin 500mg po tds", type = "admin")[[1]],
"oral"
)

50
inst/tinytest/test-ab_property.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -47,8 +47,10 @@ expect_identical(ab_ddd("AMX", "iv"), 3)
expect_identical(ab_ddd_units("AMX", "iv"), "g")
expect_identical(ab_name(x = c("AMC", "PLB"), language = NULL), c("Amoxicillin/clavulanic acid", "Polymyxin B"))
expect_identical(ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B"))
expect_identical(
ab_name(x = c("AMC", "PLB"), tolower = TRUE, language = NULL),
c("amoxicillin/clavulanic acid", "polymyxin B")
)
expect_inherits(ab_info("AMX"), "list")
@ -57,25 +59,37 @@ expect_error(ab_name("amox", language = "INVALID"))
expect_stdout(print(ab_name("amox", language = NULL)))
expect_equal(ab_name("21066-6", language = NULL), "Ampicillin")
expect_equal(ab_loinc("ampicillin"),
c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5"))
expect_equal(
ab_loinc("ampicillin"),
c("21066-6", "3355-5", "33562-0", "33919-2", "43883-8", "43884-6", "87604-5")
)
expect_true(ab_url("AMX") %like% "whocc.no")
expect_warning(ab_url("ASP"))
expect_identical(colnames(set_ab_names(example_isolates[, 20:25])),
c("cefoxitin", "cefotaxime", "ceftazidime", "ceftriaxone", "gentamicin", "tobramycin"))
expect_identical(colnames(set_ab_names(example_isolates[, 20:25], language = "nl", snake_case = FALSE)),
c("Cefoxitine", "Cefotaxim", "Ceftazidim", "Ceftriaxon", "Gentamicine", "Tobramycine"))
expect_identical(colnames(set_ab_names(example_isolates[, 20:25], property = "atc")),
c("J01DC01", "J01DD01", "J01DD02", "J01DD04", "J01GB03", "J01GB01"))
expect_identical(
colnames(set_ab_names(example_isolates[, 20:25])),
c("cefoxitin", "cefotaxime", "ceftazidime", "ceftriaxone", "gentamicin", "tobramycin")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 20:25], language = "nl", snake_case = FALSE)),
c("Cefoxitine", "Cefotaxim", "Ceftazidim", "Ceftriaxon", "Gentamicine", "Tobramycine")
)
expect_identical(
colnames(set_ab_names(example_isolates[, 20:25], property = "atc")),
c("J01DC01", "J01DD01", "J01DD02", "J01DD04", "J01GB03", "J01GB01")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
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())))
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())))
}

24
inst/tinytest/test-ab_selectors.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -76,16 +76,20 @@ expect_equal(nrow(example_isolates[all(c(carbapenems(), aminoglycosides()) == "R
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")
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()]),
c("gen", "tobra"))
expect_identical(
colnames(x[, aminoglycosides()]),
c("gen", "tobra")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_equal(example_isolates %>% select(administrable_per_os() & penicillins()) %>% ncol(), 5, tolerance = 0.5)

91
inst/tinytest/test-age.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,46 +23,75 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
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("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_equal(age(
x = c("2019-01-01", "2019-04-01", "2019-07-01"),
reference = "2019-09-01",
exact = TRUE
),
c(0.6656393, 0.4191781, 0.1698630),
tolerance = 0.001
)
expect_error(age(x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = c("2019-01-01", "2019-01-01")))
expect_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("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_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)
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
)

9
inst/tinytest/test-atc_online.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,12 +24,11 @@
# ==================================================================== #
if (AMR:::pkg_is_available("curl", also_load = FALSE) &&
AMR:::pkg_is_available("rvest", also_load = FALSE) &&
AMR:::pkg_is_available("xml2", also_load = FALSE) &&
tryCatch(curl::has_internet(), error = function(e) FALSE)) {
AMR:::pkg_is_available("rvest", also_load = FALSE) &&
AMR:::pkg_is_available("xml2", also_load = FALSE) &&
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")
}

4
inst/tinytest/test-availability.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -22,5 +22,5 @@
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_inherits(availability(example_isolates), "data.frame")

10
inst/tinytest/test-bug_drug_combinations.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -29,8 +29,8 @@ expect_stdout(suppressMessages(print(b)))
expect_true(is.data.frame(format(b)))
expect_true(is.data.frame(format(b, combine_IR = TRUE, add_ab_group = FALSE)))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_true(example_isolates %>%
group_by(ward) %>%
bug_drug_combinations(FUN = mo_gramstain) %>%
is.data.frame())
expect_true(example_isolates %>%
group_by(ward) %>%
bug_drug_combinations(FUN = mo_gramstain) %>%
is.data.frame())
}

80
inst/tinytest/test-count.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -31,16 +31,22 @@ expect_equal(count_all(example_isolates$AMX), n_rsi(example_isolates$AMX))
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))
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)))
expect_warning(count_resistant(
example_isolates$AMC,
as.character(example_isolates$GEN)
))
# check for errors
expect_error(count_resistant("test", minimum = "test"))
@ -57,41 +63,53 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
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))
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(253, 465, 192, 558))
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
cipro = count_susceptible(CIP),
genta = count_susceptible(GEN),
combination = count_susceptible(CIP, GEN)
) %>%
pull(combination),
c(253, 465, 192, 558)
)
# count_df
expect_equal(
example_isolates %>% select(AMX) %>% count_df() %>% pull(value),
c(example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant())
c(
example_isolates$AMX %>% count_susceptible(),
example_isolates$AMX %>% count_resistant()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_IR = TRUE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
suppressWarnings(example_isolates$AMX %>% count_IR()))
c(
suppressWarnings(example_isolates$AMX %>% count_S()),
suppressWarnings(example_isolates$AMX %>% count_IR())
)
)
expect_equal(
example_isolates %>% select(AMX) %>% count_df(combine_SI = FALSE) %>% pull(value),
c(suppressWarnings(example_isolates$AMX %>% count_S()),
c(
suppressWarnings(example_isolates$AMX %>% count_S()),
example_isolates$AMX %>% count_I(),
example_isolates$AMX %>% count_R())
example_isolates$AMX %>% count_R()
)
)
# grouping in rsi_calc_df() (= backbone of rsi_df())
expect_true("ward" %in% (example_isolates %>%
group_by(ward) %>%
select(ward, AMX, CIP, gender) %>%
rsi_df() %>%
colnames()))
expect_true("ward" %in% (example_isolates %>%
group_by(ward) %>%
select(ward, AMX, CIP, gender) %>%
rsi_df() %>%
colnames()))
}

50
inst/tinytest/test-data.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -64,30 +64,42 @@ for (i in seq_len(length(datasets))) {
df <- AMR:::MO_lookup
expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE]))
expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE]))
expect_true(all(c("mo", "fullname",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"rank", "ref", "species_id", "source", "prevalence", "snomed",
"kingdom_index", "fullname_lower", "g_species") %in% colnames(df)))
expect_true(all(c(
"mo", "fullname",
"kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
"rank", "ref", "species_id", "source", "prevalence", "snomed",
"kingdom_index", "fullname_lower", "g_species"
) %in% colnames(df)))
expect_true(all(c("fullname", "fullname_new", "ref", "prevalence",
"fullname_lower", "g_species") %in% colnames(AMR:::MO.old_lookup)))
expect_true(all(c(
"fullname", "fullname_new", "ref", "prevalence",
"fullname_lower", "g_species"
) %in% colnames(AMR:::MO.old_lookup)))
expect_inherits(AMR:::MO_CONS, "mo")
expect_identical(class(catalogue_of_life_version()),
c("catalogue_of_life_version", "list"))
expect_identical(
class(catalogue_of_life_version()),
c("catalogue_of_life_version", "list")
)
expect_stdout(print(catalogue_of_life_version()))
uncategorised <- subset(microorganisms,
genus == "Staphylococcus" &
!species %in% c("", "aureus") &
!mo %in% c(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, ")")))
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, ")"
)
)
)
# THIS WILL CHECK NON-ASCII STRINGS IN ALL FILES:
@ -119,5 +131,5 @@ expect_true(NROW(uncategorised) == 0,
# }
# )
# }
# x <- check_non_ascii() %>%
# x <- check_non_ascii() %>%
# filter(file %unlike% "^(data-raw|docs|git_)")

2
inst/tinytest/test-disk.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

33
inst/tinytest/test-episode.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -31,19 +31,28 @@ test_df <- rbind(
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))
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")) {
expect_identical(test_df %>% group_by(patient_id) %>% mutate(f = is_new_episode(date, 365)) %>% pull(f),
c(TRUE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, TRUE))
expect_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))
@ -51,6 +60,6 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
y <- example_isolates %>%
group_by(patient, mo) %>%
mutate(out = is_new_episode(date, 365))
expect_identical(which(x$out), which(y$out))
}

205
inst/tinytest/test-eucast_rules.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,13 +24,17 @@
# ==================================================================== #
# 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"))
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(AMR:::trimws(unlist(strsplit(MOs_mentioned[!AMR:::is_valid_regex(MOs_mentioned)], ",", fixed = TRUE))))
MOs_test <- suppressWarnings(suppressMessages(mo_name(MOs_mentioned)))
@ -43,71 +47,103 @@ expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
expect_identical(colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE))))
expect_identical(
colnames(example_isolates),
colnames(suppressWarnings(eucast_rules(example_isolates, info = FALSE)))
)
expect_stdout(suppressMessages(eucast_rules(example_isolates, info = TRUE)))
a <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE)
a <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "-", # Amoxicillin
stringsAsFactors = FALSE
)
b <- data.frame(
mo = c(
"Klebsiella pneumoniae",
"Pseudomonas aeruginosa",
"Enterobacter cloacae"
),
amox = "R", # Amoxicillin
stringsAsFactors = FALSE
)
expect_identical(suppressWarnings(eucast_rules(a, "mo", info = FALSE)), b)
expect_stdout(suppressMessages(suppressWarnings(eucast_rules(a, "mo", info = TRUE))))
a <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "-", # Colistin
stringsAsFactors = FALSE)
b <- data.frame(mo = c("Staphylococcus aureus",
"Streptococcus group A"),
COL = "R", # Colistin
stringsAsFactors = FALSE)
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")) {
expect_equal(suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(TIC = as.rsi("R"),
PIP = as.rsi("S")) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()),
"R")
expect_equal(
suppressWarnings(
example_isolates %>%
filter(mo_family(mo) == "Enterobacteriaceae") %>%
mutate(
TIC = as.rsi("R"),
PIP = as.rsi("S")
) %>%
eucast_rules(col_mo = "mo", version_expertrules = 3.1, info = FALSE) %>%
pull(PIP) %>%
unique() %>%
as.character()
),
"R"
)
}
# azithromycin and clarythromycin must be equal to Erythromycin
a <- suppressWarnings(as.rsi(eucast_rules(data.frame(mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.rsi("R"),
CLR = factor("R"),
stringsAsFactors = FALSE),
version_expertrules = 3.1,
only_rsi_columns = FALSE)$CLR))
a <- suppressWarnings(as.rsi(eucast_rules(data.frame(
mo = example_isolates$mo,
ERY = example_isolates$ERY,
AZM = as.rsi("R"),
CLR = factor("R"),
stringsAsFactors = FALSE
),
version_expertrules = 3.1,
only_rsi_columns = FALSE
)$CLR))
b <- example_isolates$ERY
expect_identical(a[!is.na(b)],
b[!is.na(b)])
expect_identical(
a[!is.na(b)],
b[!is.na(b)]
)
# amox is inferred by benzylpenicillin in Kingella kingae
expect_equal(
suppressWarnings(
as.list(eucast_rules(
data.frame(mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE)
, info = FALSE))$AMX
data.frame(
mo = as.mo("Kingella kingae"),
PEN = "S",
AMX = "-",
stringsAsFactors = FALSE
),
info = FALSE
))$AMX
),
"S")
"S"
)
# also test norf
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
@ -120,25 +156,37 @@ expect_stdout(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, ru
# AmpC de-repressed cephalo mutants
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = TRUE,
info = FALSE)$cefotax,
as.rsi(c("S", "R")))
eucast_rules(data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))
),
ampc_cephalosporin_resistance = TRUE,
info = FALSE
)$cefotax,
as.rsi(c("S", "R"))
)
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NA,
info = FALSE)$cefotax,
as.rsi(c("S", NA)))
eucast_rules(data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))
),
ampc_cephalosporin_resistance = NA,
info = FALSE
)$cefotax,
as.rsi(c("S", NA))
)
expect_identical(
eucast_rules(data.frame(mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))),
ampc_cephalosporin_resistance = NULL,
info = FALSE)$cefotax,
as.rsi(c("S", "S")))
eucast_rules(data.frame(
mo = c("Escherichia coli", "Enterobacter cloacae"),
cefotax = as.rsi(c("S", "S"))
),
ampc_cephalosporin_resistance = NULL,
info = FALSE
)$cefotax,
as.rsi(c("S", "S"))
)
# EUCAST dosage -----------------------------------------------------------
expect_equal(nrow(eucast_dosage(c("tobra", "genta", "cipro"))), 3)
@ -146,17 +194,22 @@ 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")
x <- custom_eucast_rules(
AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I",
AMX == "S" ~ AMC == "S"
)
expect_stdout(print(x))
expect_stdout(print(c(x, x)))
expect_stdout(print(as.list(x, x)))
# this custom rules makes 8 changes
expect_equal(nrow(eucast_rules(example_isolates,
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE)),
8, tolerance = 0.5)
rules = "custom",
custom_rules = x,
info = FALSE,
verbose = TRUE
)),
8,
tolerance = 0.5
)

245
inst/tinytest/test-first_isolate.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,40 +24,59 @@
# ==================================================================== #
# all four methods
expect_equal(sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984)
expect_equal(sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265)
expect_equal(sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300)
expect_equal(sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1379)
expect_equal(
sum(first_isolate(x = example_isolates, method = "isolate-based", info = TRUE), na.rm = TRUE),
1984
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "patient-based", info = TRUE), na.rm = TRUE),
1265
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "episode-based", info = TRUE), na.rm = TRUE),
1300
)
expect_equal(
sum(first_isolate(x = example_isolates, method = "phenotype-based", info = TRUE), na.rm = TRUE),
1379
)
# Phenotype-based, using key antimicrobials
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE), na.rm = TRUE),
1395)
expect_equal(sum(first_isolate(x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE), na.rm = TRUE),
1418)
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE
), na.rm = TRUE),
1395
)
expect_equal(
sum(first_isolate(
x = example_isolates,
method = "phenotype-based",
type = "keyantimicrobials",
antifungal = NULL, info = TRUE, ignore_I = FALSE
), na.rm = TRUE),
1418
)
# first non-ICU isolates
expect_equal(
sum(
first_isolate(example_isolates,
col_mo = "mo",
col_date = "date",
col_patient_id = "patient",
col_icu = example_isolates$ward == "ICU",
info = TRUE,
icu_exclude = TRUE),
na.rm = TRUE),
941)
col_mo = "mo",
col_date = "date",
col_patient_id = "patient",
col_icu = example_isolates$ward == "ICU",
info = TRUE,
icu_exclude = TRUE
),
na.rm = TRUE
),
941
)
# set 1500 random observations to be of specimen type 'Urine'
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
@ -65,78 +84,98 @@ 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) < 1501)
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) < 1501
)
# 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) < 1501)
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) < 1501
)
# "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))
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))
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"))
col_date = "non-existing col",
col_mo = "mo"
))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# 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))
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_id) %>%
mutate(`First name` = "test",
`Last name` = "test",
Sex = "Female") %>%
first_isolate(info = TRUE))
select(-patient_id) %>%
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(.))
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
@ -144,33 +183,47 @@ 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),
1382)
first_isolate(
x = df,
col_date = "date",
col_patient_id = "patient",
col_mo = "mo",
info = TRUE
),
na.rm = TRUE
),
1382
)
# unknown MOs
test_unknown <- example_isolates
test_unknown$mo <- ifelse(test_unknown$mo == "B_ESCHR_COLI", "UNKNOWN", test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown, include_unknown = FALSE)),
1108)
expect_equal(sum(first_isolate(test_unknown, include_unknown = TRUE)),
1591)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = FALSE)),
1108
)
expect_equal(
sum(first_isolate(test_unknown, include_unknown = TRUE)),
1591
)
test_unknown$mo <- ifelse(test_unknown$mo == "UNKNOWN", NA, test_unknown$mo)
expect_equal(sum(first_isolate(test_unknown)),
1108)
expect_equal(
sum(first_isolate(test_unknown)),
1108
)
# empty rsi results
expect_equal(sum(first_isolate(example_isolates, include_untested_rsi = FALSE)),
1366)
expect_equal(
sum(first_isolate(example_isolates, include_untested_rsi = FALSE)),
1366
)
# shortcuts
expect_identical(filter_first_isolate(example_isolates),
subset(example_isolates, first_isolate(example_isolates)))
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

28
inst/tinytest/test-g.test.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -28,14 +28,16 @@
# 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)
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)
0.017873,
tolerance = 0.0001
)
expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
@ -46,18 +48,22 @@ expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p =
# INDEPENDENCE
x <- as.data.frame(
matrix(data = round(runif(4) * 100000, 0),
ncol = 2,
byrow = TRUE)
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_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)))

2
inst/tinytest/test-get_locale.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

102
inst/tinytest/test-ggplot_rsi.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,14 +24,13 @@
# ==================================================================== #
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_available("ggplot2")) {
pdf(NULL) # prevent Rplots.pdf being created
# data should be equal
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi())$data %>%
select(AMC, CIP) %>%
ggplot_rsi())$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
@ -39,18 +38,18 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_availa
summarise_all(resistance) %>%
as.double()
)
expect_stdout(print(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic")))
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic")))
expect_stdout(print(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation")))
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation")))
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "interpretation", facet = "antibiotic"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
@ -58,11 +57,11 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_availa
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(resistance) %>%
as.double(),
example_isolates %>%
@ -70,11 +69,11 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_availa
summarise_all(resistance) %>%
as.double()
)
expect_equal(
(example_isolates %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
select(AMC, CIP) %>%
ggplot_rsi(x = "antibiotic", facet = "interpretation"))$data %>%
summarise_all(count_resistant) %>%
as.double(),
example_isolates %>%
@ -82,31 +81,46 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0") & AMR:::pkg_is_availa
summarise_all(count_resistant) %>%
as.double()
)
# support for scale_type ab and mo
expect_inherits((data.frame(mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data,
"data.frame")
expect_inherits((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame")
expect_inherits((data.frame(ab = as.ab(c("amx", "amc")),
n = c(40, 100)) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame")
expect_inherits(
(data.frame(
mo = as.mo(c("e. coli", "s aureus")),
n = c(40, 100)
) %>%
ggplot(aes(x = mo, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
expect_inherits(
(data.frame(
ab = as.ab(c("amx", "amc")),
n = c(40, 100)
) %>%
ggplot(aes(x = ab, y = n)) +
geom_col())$data,
"data.frame"
)
# support for manual colours
expect_inherits((ggplot(data.frame(x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6"))) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data,
"data.frame")
expect_inherits(
(ggplot(data.frame(
x = c("Value1", "Value2", "Value3"),
y = c(1, 2, 3),
z = c("Value4", "Value5", "Value6")
)) +
geom_col(aes(x = x, y = y, fill = z)) +
scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R"))$data,
"data.frame"
)
}

50
inst/tinytest/test-guess_ab_col.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,20 +23,36 @@
# 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")
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"
)

20
inst/tinytest/test-italicise_taxonomy.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,11 +23,17 @@
# 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"))
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()) {
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", type = "ansi"),
"test for \033[3mE. coli\033[23m"
)
}

2
inst/tinytest/test-join_microorganisms.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

2
inst/tinytest/test-key_antimicrobials.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

27
inst/tinytest/test-kurtosis.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,19 +24,24 @@
# ==================================================================== #
expect_equal(kurtosis(example_isolates$age),
5.227999,
tolerance = 0.00001)
5.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age))),
5.227999,
tolerance = 0.00001)
5.227999,
tolerance = 0.00001
)
expect_equal(unname(kurtosis(data.frame(example_isolates$age), excess = TRUE)),
2.227999,
tolerance = 0.00001)
2.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age)),
5.227999,
tolerance = 0.00001)
5.227999,
tolerance = 0.00001
)
expect_equal(kurtosis(matrix(example_isolates$age), excess = TRUE),
2.227999,
tolerance = 0.00001)
2.227999,
tolerance = 0.00001
)

20
inst/tinytest/test-like.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -32,9 +32,15 @@ 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_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)
)

332
inst/tinytest/test-mdro.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -41,181 +41,222 @@ expect_stdout(outcome <- mdro(example_isolates, "nl", info = TRUE))
expect_identical(class(outcome), c("ordered", "factor"))
# example_isolates should have these finding using Dutch guidelines
expect_equal(as.double(table(outcome)),
c(1954, 24, 6)) # 1954 neg, 24 unconfirmed, 6 pos, rest is NA
expect_equal(
as.double(table(outcome)),
c(1954, 24, 6)
) # 1954 neg, 24 unconfirmed, 6 pos, rest is NA
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")
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")
as.character(mdro(data.frame(
mo = as.mo("P. aeruginosa"),
cefta = "R",
cipr = "R",
mero = "R",
imip = "R",
gent = "R",
tobr = "R",
pita = "R"
),
guideline = "BRMO",
col_mo = "mo",
info = FALSE
)),
"Positive"
)
# German 3MRGN and 4MRGN
expect_equal(as.character(mrgn(
data.frame(mo = c("E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
PIP = c("S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"),
CTX = c("S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"),
IPM = c("S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"),
CIP = c("S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"),
stringsAsFactors = FALSE))),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN"))
expect_equal(
as.character(mrgn(
data.frame(
mo = c(
"E. coli", "E. coli", "K. pneumoniae", "E. coli",
"A. baumannii", "A. baumannii", "A. baumannii",
"P. aeruginosa", "P. aeruginosa", "P. aeruginosa"
),
PIP = c(
"S", "R", "R", "S",
"S", "R", "R",
"S", "R", "R"
),
CTX = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "R", "R"
),
IPM = c(
"S", "R", "S", "R",
"R", "R", "S",
"S", "R", "R"
),
CIP = c(
"S", "R", "R", "S",
"R", "R", "R",
"R", "S", "R"
),
stringsAsFactors = FALSE
)
)),
c("Negative", "4MRGN", "3MRGN", "4MRGN", "4MRGN", "4MRGN", "3MRGN", "Negative", "3MRGN", "4MRGN")
)
# MDR TB
expect_equal(
# select only rifampicine, mo will be determined automatically (as M. tuberculosis),
# number of mono-resistant strains should be equal to number of rifampicine-resistant strains
as.double(table(mdr_tb(example_isolates[, "RIF", drop = FALSE])))[2],
count_R(example_isolates$RIF))
count_R(example_isolates$RIF)
)
x <- data.frame(rifampicin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
inh = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
gatifloxacin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
eth = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
pza = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
MFX = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
KAN = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)))
x <- data.frame(
rifampicin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
inh = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
gatifloxacin = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
eth = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
pza = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
MFX = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5)),
KAN = random_rsi(5000, prob_RSI = c(0.4, 0.1, 0.5))
)
expect_true(length(unique(mdr_tb(x))) > 2)
# check the guideline by Magiorakos et al. (2012), the default guideline
stau <- data.frame(mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
stau <- data.frame(
mo = c("S. aureus", "S. aureus", "S. aureus", "S. aureus"),
GEN = c("R", "R", "S", "R"),
RIF = c("S", "R", "S", "R"),
CPT = c("S", "R", "R", "R"),
OXA = c("S", "R", "R", "R"),
CIP = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
SXT = c("S", "S", "R", "R"),
FUS = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TLV = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
CLI = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
ERY = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(stau)), c(1:4))
expect_inherits(mdro(stau, verbose = TRUE), "data.frame")
ente <- data.frame(mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
ente <- data.frame(
mo = c("Enterococcus", "Enterococcus", "Enterococcus", "Enterococcus"),
GEH = c("R", "R", "S", "R"),
STH = c("S", "R", "S", "R"),
IPM = c("S", "R", "R", "R"),
MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"),
MFX = c("S", "S", "R", "R"),
VAN = c("S", "S", "R", "R"),
TEC = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"),
DAP = c("S", "S", "R", "R"),
LNZ = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"),
QDA = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(ente)), c(1:4))
expect_inherits(mdro(ente, verbose = TRUE), "data.frame")
entero <- data.frame(mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
entero <- data.frame(
mo = c("E. coli", "E. coli", "E. coli", "E. coli"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
CPT = c("S", "R", "R", "R"), TCC = c("S", "R", "R", "R"),
TZP = c("S", "S", "R", "R"), ETP = c("S", "S", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CZO = c("S", "S", "R", "R"),
CXM = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CAZ = c("S", "S", "R", "R"), FEP = c("S", "S", "R", "R"),
FOX = c("S", "S", "R", "R"), CTT = c("S", "S", "R", "R"),
CIP = c("S", "S", "R", "R"), SXT = c("S", "S", "R", "R"),
TGC = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
AMP = c("S", "S", "R", "R"), AMC = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), CHL = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
TCY = c("S", "S", "R", "R"), DOX = c("S", "S", "R", "R"),
MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(entero)), c(1:4))
expect_inherits(mdro(entero, verbose = TRUE), "data.frame")
pseud <- data.frame(mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
pseud <- data.frame(
mo = c("P. aeruginosa", "P. aeruginosa", "P. aeruginosa", "P. aeruginosa"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "S", "S", "R"),
AMK = c("S", "S", "R", "R"), NET = c("S", "S", "R", "R"),
IPM = c("S", "R", "R", "R"), MEM = c("S", "S", "R", "R"),
DOR = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TCC = c("S", "S", "R", "R"),
TZP = c("S", "S", "R", "R"), ATM = c("S", "S", "R", "R"),
FOS = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(pseud)), c(1:4))
expect_inherits(mdro(pseud, verbose = TRUE), "data.frame")
acin <- data.frame(mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE)
acin <- data.frame(
mo = c("A. baumannii", "A. baumannii", "A. baumannii", "A. baumannii"),
GEN = c("R", "R", "S", "R"), TOB = c("S", "R", "S", "R"),
AMK = c("S", "R", "R", "R"), NET = c("S", "R", "R", "R"),
IPM = c("S", "S", "R", "R"), MEM = c("S", "R", "R", "R"),
DOR = c("S", "S", "R", "R"), CIP = c("S", "S", "R", "R"),
LVX = c("S", "S", "R", "R"), TZP = c("S", "S", "R", "R"),
TCC = c("S", "S", "R", "R"), CTX = c("S", "S", "R", "R"),
CRO = c("S", "S", "R", "R"), CAZ = c("S", "S", "R", "R"),
FEP = c("S", "R", "R", "R"), SXT = c("S", "S", "R", "R"),
SAM = c("S", "S", "R", "R"), COL = c("S", "S", "R", "R"),
PLB = c("S", "S", "R", "R"), TCY = c("S", "S", "R", "R"),
DOX = c("S", "S", "R", "R"), MNO = c("S", "S", "R", "R"),
stringsAsFactors = FALSE
)
expect_equal(as.integer(mdro(acin)), c(1:4))
expect_inherits(mdro(acin, verbose = TRUE), "data.frame")
# custom rules
custom <- custom_mdro_guideline("CIP == 'R' & age > 60" ~ "Elderly Type A",
"ERY == 'R' & age > 60" ~ "Elderly Type B",
as_factor = TRUE)
"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)))
@ -229,9 +270,10 @@ 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))
# 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")) {

13
inst/tinytest/test-mic.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -33,9 +33,12 @@ 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(
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
@ -131,7 +134,7 @@ suppressWarnings(expect_identical(el1 + el2, el1_double + el2_double))
suppressWarnings(expect_identical(el1 - el2, el1_double - el2_double))
suppressWarnings(expect_identical(el1 * el2, el1_double * el2_double))
suppressWarnings(expect_identical(el1 / el2, el1_double / el2_double))
suppressWarnings(expect_identical(el1 ^ el2, el1_double ^ el2_double))
suppressWarnings(expect_identical(el1^el2, el1_double^el2_double))
suppressWarnings(expect_identical(el1 %% el2, el1_double %% el2_double))
suppressWarnings(expect_identical(el1 %/% el2, el1_double %/% el2_double))
suppressWarnings(expect_identical(el1 & el2, el1_double & el2_double))

217
inst/tinytest/test-mo.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -28,7 +28,8 @@ expect_identical(as.character(MOs$mo), as.character(as.mo(MOs$mo)))
expect_identical(
as.character(as.mo(c("E. coli", "H. influenzae"))),
c("B_ESCHR_COLI", "B_HMPHL_INFL"))
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")
@ -79,29 +80,39 @@ expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAM
# prevalent MO
expect_identical(
suppressWarnings(as.character(
as.mo(c("stau",
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureeuzz",
"Staphylococcus aureus",
"MRSA",
"VISA",
"meth.-resis. S. aureus (MRSA)")))),
rep("B_STPHY_AURS", 10))
as.mo(c(
"stau",
"STAU",
"staaur",
"S. aureus",
"S aureus",
"Sthafilokkockus aureeuzz",
"Staphylococcus aureus",
"MRSA",
"VISA",
"meth.-resis. S. aureus (MRSA)"
))
)),
rep("B_STPHY_AURS", 10)
)
expect_identical(
as.character(
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))),
rep("B_ESCHR_COLI", 6))
as.mo(c("EHEC", "EPEC", "EIEC", "STEC", "ATEC", "UPEC"))
),
rep("B_ESCHR_COLI", 6)
)
# unprevalent MO
expect_identical(
as.character(
as.mo(c("parnod",
"P. nodosa",
"P nodosa",
"Paraburkholderia nodosa"))),
rep("B_PRBRK_NODS", 4))
as.mo(c(
"parnod",
"P. nodosa",
"P nodosa",
"Paraburkholderia nodosa"
))
),
rep("B_PRBRK_NODS", 4)
)
# empty values
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
@ -109,40 +120,42 @@ expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
expect_warning(as.mo("ab"))
expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))),
c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI"))
expect_equal(
suppressWarnings(as.character(as.mo(c("Qq species", "", "CRSM", "K. pneu rhino", "esco")))),
c("UNKNOWN", NA_character_, "B_STNTR_MLTP", "B_KLBSL_PNMN_RHNS", "B_ESCHR_COLI")
)
# check for Becker classification
expect_identical(as.character(as.mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPDR")
expect_identical(as.character(as.mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("STAEPI", Becker = TRUE)), "B_STPHY_CONS")
expect_identical(as.character(as.mo("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")
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 = 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(as.mo("S. pyogenes", Lancefield = FALSE)), "B_STRPT_PYGN")
expect_identical(as.character(as.mo("S. pyogenes", Lancefield = TRUE)), "B_STRPT_GRPA")
expect_identical(as.character(as.mo("STCPYO", Lancefield = TRUE)), "B_STRPT_GRPA") # group A
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = FALSE)), "B_STRPT_AGLC")
expect_identical(as.character(as.mo("S. agalactiae", Lancefield = TRUE)), "B_STRPT_GRPB") # group B
expect_identical(as.character(suppressWarnings(as.mo("estreptococos grupo B"))), "B_STRPT_GRPB")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = FALSE)), "B_STRPT_DYSG_EQSM")
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
expect_identical(as.character(as.mo("S. equisimilis", Lancefield = TRUE)), "B_STRPT_GRPC") # group C
# Enterococci must only be influenced if Lancefield = "all"
expect_identical(as.character(as.mo("E. faecium", Lancefield = FALSE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = TRUE)), "B_ENTRC_FACM")
expect_identical(as.character(as.mo("E. faecium", Lancefield = "all")), "B_STRPT_GRPD") # group D
expect_identical(as.character(as.mo("S. anginosus", Lancefield = FALSE)), "B_STRPT_ANGN")
expect_identical(as.character(as.mo("S. anginosus", Lancefield = TRUE)), "B_STRPT_GRPF") # group F
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = FALSE)), "B_STRPT_SNGN")
expect_identical(as.character(as.mo("S. sanguinis", Lancefield = TRUE)), "B_STRPT_GRPH") # group H
expect_identical(as.character(as.mo("S. salivarius", Lancefield = FALSE)), "B_STRPT_SLVR")
expect_identical(as.character(as.mo("S. salivarius", Lancefield = TRUE)), "B_STRPT_GRPK") # group K
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")) {
# select with one column
@ -153,9 +166,12 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
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"))
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 %>%
@ -165,14 +181,17 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
slice(1:10) %>%
left_join_microorganisms() %>%
select(genus, species) %>%
as.mo())
as.mo()
)
# too many columns
expect_error(example_isolates %>% select(1:3) %>% as.mo())
# test pull
expect_equal(nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000)
expect_equal(
nrow(example_isolates %>% mutate(mo = as.mo(mo))),
2000
)
expect_true(example_isolates %>% pull(mo) %>% is.mo())
}
@ -183,12 +202,16 @@ expect_warning(as.mo(c("INVALID", "Yeah, unknown")))
expect_stdout(print(as.mo(c("B_ESCHR_COLI", NA))))
# test data.frame
expect_equal(nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1)
expect_equal(
nrow(data.frame(test = as.mo("B_ESCHR_COLI"))),
1
)
# check empty values
expect_equal(as.character(suppressWarnings(as.mo(""))),
NA_character_)
expect_equal(
as.character(suppressWarnings(as.mo(""))),
NA_character_
)
# check less prevalent MOs
expect_equal(as.character(as.mo("Gomphosphaeria aponina delicatula")), "B_GMPHS_APNN_DLCT")
@ -215,38 +238,56 @@ expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_unce
expect_equal(suppressMessages(as.character(as.mo(c("s aure THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_AURS", "B_STPHY_AURS_AURS"))
# 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_equal(
as.character(as.mo("TestingOwnID",
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
"B_ESCHR_COLI"
)
expect_equal(
as.character(as.mo(c("TestingOwnID", "E. coli"),
reference_df = data.frame(mycol = "TestingOwnID", mo = "B_ESCHR_COLI")
)),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
expect_warning(as.mo("TestingOwnID", reference_df = NULL))
expect_error(as.mo("E. coli", reference_df = data.frame(mycol = "TestingOwnID")))
# combination of existing mo and other code
expect_identical(as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI"))
expect_identical(
as.character(as.mo(c("B_ESCHR_COL", "ESCCOL"))),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# from different sources
expect_equal(as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI"))),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI"))
expect_equal(
as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COLI")
)),
c("B_PROTS_MRBL", "B_BCLLS_CERS", "B_ESCHR_COLI")
)
# hard to find
expect_equal(as.character(suppressMessages(as.mo(
c("Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena")))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG"))
expect_equal(
as.character(suppressMessages(as.mo(
c(
"Microbacterium paraoxidans",
"Streptococcus suis (bovis gr)",
"Raoultella (here some text) terrigena"
)
))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG")
)
expect_stdout(print(mo_uncertainties()))
x <- as.mo("S. aur")
# many hits
expect_stdout(print(mo_uncertainties()))
# Salmonella (City) are all actually Salmonella enterica spp (City)
expect_equal(suppressMessages(as.mo(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
as.mo(c("Salmonella enterica", "Salmonella enterica", "Salmonella")))
expect_equal(
suppressMessages(as.mo(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
as.mo(c("Salmonella enterica", "Salmonella enterica", "Salmonella"))
)
# no viruses
expect_equal(as.character(as.mo("Virus")), NA_character_)
@ -255,13 +296,17 @@ expect_equal(as.character(as.mo("Virus")), NA_character_)
expect_equal(length(summary(example_isolates$mo)), 6)
# WHONET codes and NA/NaN
expect_equal(as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)),
rep(NA_character_, 3))
expect_equal(
as.character(as.mo(c("xxx", "na", "nan"), debug = TRUE)),
rep(NA_character_, 3)
)
expect_equal(as.character(as.mo("con")), "UNKNOWN")
expect_equal(as.character(as.mo("xxx")), NA_character_)
expect_equal(as.character(as.mo(c("xxx", "con", "eco"))), c(NA_character_, "UNKNOWN", "B_ESCHR_COLI"))
expect_equal(as.character(as.mo(c("other", "none", "unknown"))),
rep("UNKNOWN", 3))
expect_equal(
as.character(as.mo(c("other", "none", "unknown"))),
rep("UNKNOWN", 3)
)
expect_null(mo_failures())
@ -271,11 +316,15 @@ expect_error(translate_allow_uncertain(5))
expect_stdout(print(suppressMessages(suppressWarnings(as.mo("kshgcjkhsdgkshjdfsfvsdfv", debug = TRUE, allow_uncertain = 3)))))
# ..coccus
expect_equal(as.character(as.mo(c("meningococ", "gonococ", "pneumococ"))),
c("B_NESSR_MNNG", "B_NESSR_GNRR", "B_STRPT_PNMN"))
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"))
expect_equal(
suppressWarnings(as.character(as.mo(c("yeasts", "fungi")))),
c("F_YEAST", "F_FUNGUS")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# print tibble
@ -292,8 +341,10 @@ expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# ignoring patterns
expect_equal(as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA))
expect_equal(
as.character(as.mo(c("E. coli", "E. coli ignorethis"), ignore_pattern = "this")),
c("B_ESCHR_COLI", NA)
)
# frequency tables
if (AMR:::pkg_is_available("cleaner")) {

96
inst/tinytest/test-mo_property.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -45,15 +45,19 @@ 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(names(mo_taxonomy("Escherichia coli")), c(
"kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies"
))
expect_equal(mo_synonyms("Escherichia coli"), NULL)
expect_true(length(mo_synonyms("Candida albicans")) > 1)
expect_inherits(mo_synonyms(c("Candida albicans", "Escherichia coli")), "list")
expect_equal(names(mo_info("Escherichia coli")), c("kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies",
"synonyms", "gramstain", "url", "ref",
"snomed"))
expect_equal(names(mo_info("Escherichia coli")), c(
"kingdom", "phylum", "class", "order",
"family", "genus", "species", "subspecies",
"synonyms", "gramstain", "url", "ref",
"snomed"
))
expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
expect_equal(mo_ref("Escherichia coli"), "Castellani et al., 1919")
@ -86,14 +90,22 @@ expect_identical(mo_name(dutch, language = NULL), microorganisms$fullname) # gig
# manual property function
expect_error(mo_property("Escherichia coli", property = c("tsn", "fullname")))
expect_error(mo_property("Escherichia coli", property = "UNKNOWN"))
expect_identical(mo_property("Escherichia coli", property = "fullname"),
mo_fullname("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "genus"),
mo_genus("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "species"),
mo_species("Escherichia coli"))
expect_identical(mo_property("Escherichia coli", property = "species_id"),
mo_lpsn("Escherichia coli"))
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 = "species_id"),
mo_lpsn("Escherichia coli")
)
expect_identical(suppressWarnings(mo_ref("Chlamydia psittaci")), "Page, 1968")
expect_identical(mo_ref("Chlamydophila psittaci"), "Everett et al., 1999")
@ -102,30 +114,48 @@ expect_true(112283007 %in% mo_snomed("Escherichia coli"))
# old codes must throw a warning in mo_* family
expect_warning(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR")))
# outcome of mo_fullname must always return the fullname from the data set
x <- data.frame(mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en"),
stringsAsFactors = FALSE)
x <- data.frame(
mo = microorganisms$mo,
# fullname from the original data:
f1 = microorganisms$fullname,
# newly created fullname based on MO code:
f2 = mo_fullname(microorganisms$mo, language = "en"),
stringsAsFactors = FALSE
)
expect_equal(nrow(subset(x, f1 != f2)), 0)
# is gram pos/neg (also return FALSE for all non-bacteria)
expect_equal(mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE))
expect_equal(mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE))
expect_equal(
mo_is_gram_negative(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(TRUE, FALSE, FALSE)
)
expect_equal(
mo_is_gram_positive(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans")),
c(FALSE, TRUE, FALSE)
)
# is intrinsic resistant
expect_equal(mo_is_intrinsic_resistant(c("Escherichia coli", "Staphylococcus aureus", "Candida albicans"),
"vanco"),
c(TRUE, FALSE, FALSE))
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")
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")) {
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730, tolerance = 0.5)
730,
tolerance = 0.5
)
expect_equal(example_isolates %>% filter(mo_is_gram_positive()) %>% nrow(),
1238, tolerance = 0.5)
1238,
tolerance = 0.5
)
expect_equal(example_isolates %>% filter(mo_is_intrinsic_resistant(ab = "Vancomycin")) %>% nrow(),
710, tolerance = 0.5)
710,
tolerance = 0.5
)
}

50
inst/tinytest/test-pca.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -23,20 +23,26 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
resistance_data <- structure(list(order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(list(order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE))
resistance_data <- structure(list(
order = c("Bacillales", "Enterobacterales", "Enterobacterales"),
genus = c("Staphylococcus", "Escherichia", "Klebsiella"),
AMC = c(0.00425, 0.13062, 0.10344),
CXM = c(0.00425, 0.05376, 0.10344),
CTX = c(0.00000, 0.02396, 0.05172),
TOB = c(0.02325, 0.02597, 0.10344),
TMP = c(0.08387, 0.39141, 0.18367)
),
class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
row.names = c(NA, -3L),
groups = structure(list(
order = c("Bacillales", "Enterobacterales"),
.rows = list(1L, 2:3)
),
row.names = c(NA, -2L),
class = c("tbl_df", "tbl", "data.frame"),
.drop = TRUE
)
)
pca_model <- pca(resistance_data)
expect_inherits(pca_model, "pca")
@ -48,14 +54,16 @@ if (AMR:::pkg_is_available("ggplot2")) {
}
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
resistance_data <- example_isolates %>%
group_by(order = mo_order(mo),
genus = mo_genus(mo)) %>%
resistance_data <- example_isolates %>%
group_by(
order = mo_order(mo),
genus = mo_genus(mo)
) %>%
summarise_if(is.rsi, resistance, minimum = 0)
pca_result <- resistance_data %>%
pca(AMC, CXM, CTX, CAZ, GEN, TOB, TMP, "SXT")
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)

147
inst/tinytest/test-proportion.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -28,77 +28,108 @@ expect_equal(proportion_SI(example_isolates$AMX), susceptibility(example_isolate
# AMX resistance in `example_isolates`
expect_equal(proportion_R(example_isolates$AMX), 0.5955556, tolerance = 0.0001)
expect_equal(proportion_I(example_isolates$AMX), 0.002222222, tolerance = 0.0001)
expect_equal(1 - proportion_R(example_isolates$AMX) - proportion_I(example_isolates$AMX),
proportion_S(example_isolates$AMX))
expect_equal(proportion_R(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_IR(example_isolates$AMX))
expect_equal(proportion_S(example_isolates$AMX) + proportion_I(example_isolates$AMX),
proportion_SI(example_isolates$AMX))
expect_equal(
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")) {
expect_equal(example_isolates %>% proportion_SI(AMC),
0.7626397,
tolerance = 0.0001)
0.7626397,
tolerance = 0.0001
)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN),
0.9408,
tolerance = 0.0001)
0.9408,
tolerance = 0.0001
)
expect_equal(example_isolates %>% proportion_SI(AMC, GEN, only_all_tested = TRUE),
0.9382647,
tolerance = 0.0001)
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_rsi(CIP),
total = n()) %>%
pull(n) %>%
sum(),
1409)
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_rsi(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_rsi(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_rsi(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_rsi(CIP, GEN)) %>%
pull(combination_n),
c(305, 617, 241, 711))
expect_equal(
example_isolates %>%
group_by(ward) %>%
summarise(
cipro_p = proportion_SI(CIP, as_percent = TRUE),
cipro_n = n_rsi(CIP),
genta_p = proportion_SI(GEN, as_percent = TRUE),
genta_n = n_rsi(GEN),
combination_p = proportion_SI(CIP, GEN, as_percent = TRUE),
combination_n = n_rsi(CIP, GEN)
) %>%
pull(combination_n),
c(305, 617, 241, 711)
)
# proportion_df
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df() %>% pull(value),
c(example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R())
c(
example_isolates$AMX %>% proportion_SI(),
example_isolates$AMX %>% proportion_R()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_IR = TRUE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_IR())
c(
example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_IR()
)
)
expect_equal(
example_isolates %>% select(AMX) %>% proportion_df(combine_SI = FALSE) %>% pull(value),
c(example_isolates$AMX %>% proportion_S(),
c(
example_isolates$AMX %>% proportion_S(),
example_isolates$AMX %>% proportion_I(),
example_isolates$AMX %>% proportion_R())
example_isolates$AMX %>% proportion_R()
)
)
}
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(proportion_S(as.character(
example_isolates$AMC,
example_isolates$GEN
)))
expect_warning(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN)))
expect_equal(suppressWarnings(n_rsi(as.character(example_isolates$AMC,
example_isolates$GEN))),
1879)
expect_warning(n_rsi(as.character(
example_isolates$AMC,
example_isolates$GEN
)))
expect_equal(
suppressWarnings(n_rsi(as.character(
example_isolates$AMC,
example_isolates$GEN
))),
1879
)
# check for errors
expect_error(proportion_IR("test", minimum = "test"))
@ -110,12 +141,18 @@ 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_)
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)))

2
inst/tinytest/test-random.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #

131
inst/tinytest/test-resistance_predict.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -25,22 +25,25 @@
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_stdout(AMX_R <- example_isolates %>%
filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE) %>%
pull("value"))
filter(mo == "B_ESCHR_COLI") %>%
rsi_predict(
col_ab = "AMX",
col_date = "date",
model = "binomial",
minimum = 10,
info = TRUE
) %>%
pull("value"))
# AMX resistance will increase according to data set `example_isolates`
expect_true(AMX_R[3] < AMX_R[20])
}
expect_stdout(x <- suppressMessages(resistance_predict(example_isolates,
col_ab = "AMX",
year_min = 2010,
model = "binomial",
info = TRUE)))
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")) {
@ -48,48 +51,66 @@ if (AMR:::pkg_is_available("ggplot2")) {
expect_silent(autoplot(x))
expect_error(ggplot_rsi_predict(example_isolates))
}
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_stdout(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_stdout(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_stdout(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "loglin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_stdout(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "lin",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE))
expect_error(rsi_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE))
expect_error(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "INVALID MODEL",
col_ab = "AMX",
col_date = "date",
info = TRUE
))
expect_error(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "NOT EXISTING COLUMN",
col_date = "date",
info = TRUE
))
expect_error(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "NOT EXISTING COLUMN",
info = TRUE
))
expect_error(rsi_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
col_ab = "AMX",
col_date = "date",
info = TRUE
))
# almost all E. coli are MEM S in the Netherlands :)
expect_error(resistance_predict(x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE))
expect_error(resistance_predict(
x = subset(example_isolates, mo == "B_ESCHR_COLI"),
model = "binomial",
col_ab = "MEM",
col_date = "date",
info = TRUE
))

237
inst/tinytest/test-rsi.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,8 +24,10 @@
# ==================================================================== #
# we must only have EUCAST and CLSI, because otherwise the rules in as.rsi() will fail
expect_identical(unique(gsub("[^A-Z]", "", AMR::rsi_translation$guideline)),
c("EUCAST", "CLSI"))
expect_identical(
unique(gsub("[^A-Z]", "", AMR::rsi_translation$guideline)),
c("EUCAST", "CLSI")
)
expect_true(as.rsi("S") < as.rsi("I"))
expect_true(as.rsi("I") < as.rsi("R"))
@ -45,97 +47,140 @@ expect_stdout(print(as.rsi(c("S", "I", "R"))))
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
expect_equal(as.character(as.rsi(c(1:3))), c("S", "I", "R"))
expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA)
expect_equal(summary(as.rsi(c("S", "R"))),
structure(c("Class" = "rsi",
"%R" = "50.0% (n=1)",
"%SI" = "50.0% (n=1)",
"- %S" = "50.0% (n=1)",
"- %I" = " 0.0% (n=0)"), class = c("summaryDefault", "table")))
expect_identical(as.logical(lapply(example_isolates, is.rsi.eligible)),
as.logical(lapply(example_isolates, is.rsi)))
expect_equal(
summary(as.rsi(c("S", "R"))),
structure(c(
"Class" = "rsi",
"%R" = "50.0% (n=1)",
"%SI" = "50.0% (n=1)",
"- %S" = "50.0% (n=1)",
"- %I" = " 0.0% (n=0)"
), class = c("summaryDefault", "table"))
)
expect_identical(
as.logical(lapply(example_isolates, is.rsi.eligible)),
as.logical(lapply(example_isolates, is.rsi))
)
expect_error(as.rsi.mic(as.mic(16)))
expect_error(as.rsi.disk(as.disk(16)))
expect_error(get_guideline("this one does not exist"))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
# 40 rsi columns
expect_equal(example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is.rsi.eligible) %>%
as.logical() %>%
sum(),
40)
expect_equal(
example_isolates %>%
mutate_at(vars(PEN:RIF), as.character) %>%
lapply(is.rsi.eligible) %>%
as.logical() %>%
sum(),
40
)
expect_equal(sum(is.rsi(example_isolates)), 40)
expect_stdout(print(tibble(ab = as.rsi("S"))))
}
if (AMR:::pkg_is_available("skimr", min_version = "2.0.0")) {
expect_inherits(skim(example_isolates),
"data.frame")
expect_inherits(
skim(example_isolates),
"data.frame"
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_inherits(example_isolates %>%
mutate(m = as.mic(2),
d = as.disk(20)) %>%
skim(),
"data.frame")
expect_inherits(
example_isolates %>%
mutate(
m = as.mic(2),
d = as.disk(20)
) %>%
skim(),
"data.frame"
)
}
}
expect_equal(as.rsi(c("", "-", NA, "NULL")), c(NA_rsi_, NA_rsi_, NA_rsi_, NA_rsi_))
# S. pneumoniae/ampicillin in EUCAST 2020: 0.5-2 ug/ml (R is only > 2)
expect_equal(as.character(
as.rsi(x = as.mic(c(0.125, 0.5, 1, 2, 4)),
mo = "B_STRPT_PNMN",
ab = "AMP",
guideline = "EUCAST 2020")),
c("S", "S", "I", "I", "R"))
expect_equal(
as.character(
as.rsi(
x = as.mic(c(0.125, 0.5, 1, 2, 4)),
mo = "B_STRPT_PNMN",
ab = "AMP",
guideline = "EUCAST 2020"
)
),
c("S", "S", "I", "I", "R")
)
# S. pneumoniae/amoxicillin in CLSI 2019: 2-8 ug/ml (R is 8 and > 8)
expect_equal(as.character(
as.rsi(x = as.mic(c(1, 2, 4, 8, 16)),
mo = "B_STRPT_PNMN",
ab = "AMX",
guideline = "CLSI 2019")),
c("S", "S", "I", "R", "R"))
expect_equal(
as.character(
as.rsi(
x = as.mic(c(1, 2, 4, 8, 16)),
mo = "B_STRPT_PNMN",
ab = "AMX",
guideline = "CLSI 2019"
)
),
c("S", "S", "I", "R", "R")
)
# cutoffs at MIC = 8
expect_equal(as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("S"))
expect_equal(as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R"))
expect_equal(
as.rsi(as.mic(2), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("S")
)
expect_equal(
as.rsi(as.mic(32), "E. coli", "ampicillin", guideline = "EUCAST 2020"),
as.rsi("R")
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_true(suppressWarnings(example_isolates %>%
mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>%
as.rsi() %>%
pull(amox_mic) %>%
is.rsi()))
mutate(amox_mic = as.mic(2)) %>%
select(mo, amox_mic) %>%
as.rsi() %>%
pull(amox_mic) %>%
is.rsi()))
}
expect_equal(as.character(
as.rsi(x = as.disk(22),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"S")
expect_equal(as.character(
as.rsi(x = as.disk(18),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"I")
expect_equal(as.character(
as.rsi(x = as.disk(10),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI")),
"R")
expect_equal(
as.character(
as.rsi(
x = as.disk(22),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI"
)
),
"S"
)
expect_equal(
as.character(
as.rsi(
x = as.disk(18),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI"
)
),
"I"
)
expect_equal(
as.character(
as.rsi(
x = as.disk(10),
mo = "B_STRPT_PNMN",
ab = "ERY",
guideline = "CLSI"
)
),
"R"
)
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_true(example_isolates %>%
mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>%
is.rsi())
mutate(amox_disk = as.disk(15)) %>%
select(mo, amox_disk) %>%
as.rsi(guideline = "CLSI") %>%
pull(amox_disk) %>%
is.rsi())
}
# frequency tables
if (AMR:::pkg_is_available("cleaner")) {
@ -143,23 +188,37 @@ if (AMR:::pkg_is_available("cleaner")) {
}
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.rsi(df)),
"data.frame")
expect_inherits(suppressWarnings(as.rsi(data.frame(mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")))$amoxi),
"rsi")
expect_warning(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32))))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
uti = TRUE)))
expect_message(as.rsi(data.frame(mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood"))))
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.rsi(df)),
"data.frame"
)
expect_inherits(
suppressWarnings(as.rsi(data.frame(
mo = "Escherichia coli",
amoxi = c("R", "S", "I", "invalid")
))$amoxi),
"rsi"
)
expect_warning(as.rsi(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32)
)))
expect_message(as.rsi(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
uti = TRUE
)))
expect_message(as.rsi(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32),
specimen = c("urine", "blood")
)))

17
inst/tinytest/test-skewness.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -24,11 +24,14 @@
# ==================================================================== #
expect_equal(skewness(example_isolates$age),
-1.212888,
tolerance = 0.00001)
-1.212888,
tolerance = 0.00001
)
expect_equal(unname(skewness(data.frame(example_isolates$age))),
-1.212888,
tolerance = 0.00001)
-1.212888,
tolerance = 0.00001
)
expect_equal(skewness(matrix(example_isolates$age)),
-1.212888,
tolerance = 0.00001)
-1.212888,
tolerance = 0.00001
)

25
inst/tinytest/test-zzz.R
View File

@ -9,7 +9,7 @@
# (c) 2018-2022 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
@ -46,7 +46,8 @@ import_functions <- c(
"read_html" = "xml2",
"right_join" = "dplyr",
"semi_join" = "dplyr",
"showQuestion" = "rstudioapi")
"showQuestion" = "rstudioapi"
)
# functions that are called directly
call_functions <- c(
@ -84,9 +85,10 @@ call_functions <- c(
)
if (AMR:::pkg_is_available("skimr", also_load = FALSE, min_version = "2.0.0")) {
call_functions <- c(call_functions,
# skimr
"inline_hist" = "skimr",
"sfl" = "skimr")
# skimr
"inline_hist" = "skimr",
"sfl" = "skimr"
)
}
extended_functions <- c(
@ -105,12 +107,15 @@ for (i in seq_len(length(import_functions))) {
pkg <- unname(import_functions[i])
# 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)) {
also_load = FALSE,
min_version = if (pkg == "dplyr") "1.0.0" else NULL
)) {
tst <- !is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE))
expect_true(tst,
info = ifelse(tst,
"All external function references exist.",
paste0("Function ", pkg, "::", fn, "() does not exist anymore")))
info = ifelse(tst,
"All external function references exist.",
paste0("Function ", pkg, "::", fn, "() does not exist anymore")
)
)
}
}