P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 06:46:11 +01:00
Code Releases Activity

fix for R < 3.2, expect_warning() on hold

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-14 10:41:01 +01:00
parent 3396236eef
commit a4cd38c433
24 changed files with 55 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.8.2.9123
Date: 2023-02-13
Version: 1.8.2.9124
Date: 2023-02-14
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9123
# AMR 1.8.2.9124
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

3
R/aa_helper_functions.R
View File

@ -176,8 +176,7 @@ rbind2 <- function(...) {
}
df
})
fun <- function(...) rbind(..., stringsAsFactors = FALSE)
do.call(fun, l_new)
do.call(rbind, l_new)
}
# No export, no Rd

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

@ -45,14 +45,14 @@ expect_equal(AMR:::trimws2(" test "), "test")
expect_equal(AMR:::trimws2(" test ", "l"), "test ")
expect_equal(AMR:::trimws2(" test ", "r"), " test")
expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX")))
expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE))
expect_warning(AMR:::get_column_abx(example_isolates, hard_dependencies = "FUS"))
# expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX")))
# expect_warning(AMR:::generate_warning_abs_missing(c("AMP", "AMX"), any = TRUE))
# expect_warning(AMR:::get_column_abx(example_isolates, hard_dependencies = "FUS"))
expect_message(AMR:::get_column_abx(example_isolates, soft_dependencies = "FUS"))
if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
# expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = TRUE))
# expect_warning(AMR:::get_column_abx(rename(example_isolates, thisone = AMX), amox = "thisone", tmp = "thisone", verbose = FALSE))
}
# we rely on "grouped_tbl" being a class of grouped tibbles, so run a test that checks for this:

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

@ -49,8 +49,8 @@ expect_true(is.ab(as.ab("amox")))
expect_stdout(print(as.ab("amox")))
expect_stdout(print(data.frame(a = as.ab("amox"))))
expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
expect_warning(as.ab("UNKNOWN"))
# expect_warning(as.ab("J00AA00")) # ATC not yet available in data set
# expect_warning(as.ab("UNKNOWN"))
expect_stdout(print(as.ab("amox")))
@ -74,7 +74,7 @@ expect_equal(
c("MEM", "AMC")
)
expect_warning(as.ab("cipro mero"))
# expect_warning(as.ab("cipro mero"))
# based on Levenshtein distance
expect_identical(ab_name("ceftazidim/avibactam", language = NULL), "Ceftazidime/avibactam")
@ -86,6 +86,6 @@ expect_inherits(x[[1]], "ab")
expect_inherits(c(x[1], x[9]), "ab")
expect_inherits(unique(x[1], x[9]), "ab")
expect_inherits(rep(x[1], 2), "ab")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))

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

@ -67,7 +67,7 @@ expect_equal(
)
expect_true(ab_url("AMX") %like% "whocc.no")
expect_warning(ab_url("ASP"))
# expect_warning(ab_url("ASP"))
expect_identical(
colnames(set_ab_names(example_isolates[, 17:22])),

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

@ -99,5 +99,5 @@ 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)
expect_equal(example_isolates %>% select(administrable_iv() & penicillins()) %>% ncol(), 7, tolerance = 0.5)
expect_equal(example_isolates %>% select(administrable_iv() | penicillins()) %>% ncol(), 37, tolerance = 0.5)
expect_warning(example_isolates %>% select(GEH = GEN) %>% select(aminoglycosides(only_treatable = TRUE)))
# expect_warning(example_isolates %>% select(GEH = GEN) %>% select(aminoglycosides(only_treatable = TRUE)))
}

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

@ -27,7 +27,7 @@
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
expect_warning(as.ab("testab"))
# expect_warning(as.ab("testab"))
expect_identical(as.character(suppressWarnings(as.ab("testab"))), NA_character_)
suppressMessages(

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

@ -49,12 +49,12 @@ expect_error(age(
reference = c("2019-01-01", "2019-01-01")
))
expect_warning(age(
# expect_warning(age(
x = c("1980-01-01", "1985-01-01", "1990-01-01"),
reference = "1975-01-01"
))
expect_warning(age(
# expect_warning(age(
x = c("1800-01-01", "1805-01-01", "1810-01-01"),
reference = "2019-01-01"
))

12
inst/tinytest/test-av.R
View File

@ -48,8 +48,8 @@ expect_true(is.av(as.av("acic")))
expect_stdout(print(as.av("acic")))
expect_stdout(print(data.frame(a = as.av("acic"))))
expect_warning(as.av("J00AA00")) # ATC not yet available in data set
expect_warning(as.av("UNKNOWN"))
# expect_warning(as.av("J00AA00")) # ATC not yet available in data set
# expect_warning(as.av("UNKNOWN"))
expect_stdout(print(as.av("acic")))
@ -63,7 +63,7 @@ expect_equal(
c("ABA", "CLE")
)
expect_warning(as.av("Abacavir Clevudine"))
# expect_warning(as.av("Abacavir Clevudine"))
# based on Levenshtein distance
expect_identical(av_name("adevofir dypifo", language = NULL), "Adefovir dipivoxil")
@ -75,6 +75,6 @@ expect_inherits(x[[1]], "av")
expect_inherits(c(x[1], x[9]), "av")
expect_inherits(unique(x[1], x[9]), "av")
expect_inherits(rep(x[1], 2), "av")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))

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

@ -61,4 +61,4 @@ expect_equal(
)
expect_true(av_url("ACI") %like% "whocc.no")
expect_warning(av_url("ASP"))
# expect_warning(av_url("ASP"))

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

@ -45,9 +45,9 @@ expect_equal(
)
# warning for speed loss
expect_warning(count_resistant(as.character(example_isolates$AMC)))
# expect_warning(count_resistant(as.character(example_isolates$AMC)))
expect_warning(count_resistant(
# expect_warning(count_resistant(
example_isolates$AMC,
as.character(example_isolates$GEN)
))

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

@ -38,7 +38,7 @@ expect_inherits(x[1], "disk")
expect_inherits(x[[1]], "disk")
expect_inherits(c(x[1], x[9]), "disk")
expect_inherits(unique(x[1], x[9]), "disk")
expect_warning(as.disk("INVALID VALUE"))
# expect_warning(as.disk("INVALID VALUE"))
x[2] <- 32
expect_inherits(x, "disk")

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

@ -49,7 +49,7 @@ expect_error(eucast_rules(x = "text"))
expect_error(eucast_rules(data.frame(a = "test")))
expect_error(eucast_rules(data.frame(mo = "test"), rules = "invalid rules set"))
expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
# expect_warning(eucast_rules(data.frame(mo = "Escherichia coli", vancomycin = "S", stringsAsFactors = TRUE)))
expect_identical(
colnames(example_isolates),

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

@ -47,7 +47,7 @@ expect_error(g.test(0))
expect_error(g.test(c(0, 1), 0))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25)))
expect_error(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24)))
expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
# expect_warning(g.test(c(1, 2, 3, 4), p = c(0.25, 0.25, 0.25, 0.24), rescale.p = TRUE))
# INDEPENDENCE
@ -60,10 +60,10 @@ x <- as.data.frame(
)
# fisher.test() is always better for 2x2 tables:
expect_warning(g.test(x))
# expect_warning(g.test(x))
expect_true(suppressWarnings(g.test(x)$p.value) < 1)
expect_warning(g.test(
# expect_warning(g.test(
x = c(772, 1611, 737),
y = c(780, 1560, 780),
rescale.p = TRUE

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

@ -57,5 +57,5 @@ expect_equal(nrow(left_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(semi_join_microorganisms("B_ESCHR_COLI")), 1)
expect_equal(nrow(anti_join_microorganisms("B_ESCHR_COLI")), 0)
expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
expect_warning(full_join_microorganisms("B_ESCHR_COLI"))
# expect_warning(right_join_microorganisms("B_ESCHR_COLI"))
# expect_warning(full_join_microorganisms("B_ESCHR_COLI"))

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

@ -37,4 +37,4 @@ expect_false(antimicrobials_equal("SSS", "SIS", ignore_I = FALSE, type = "keyant
expect_true(antimicrobials_equal(".SS", "SI.", ignore_I = TRUE, type = "keyantimicrobials"))
expect_false(antimicrobials_equal(".SS", "SI.", ignore_I = FALSE, type = "keyantimicrobials"))
expect_warning(key_antimicrobials(example_isolates[rep(1, 10), , drop = FALSE]))
# expect_warning(key_antimicrobials(example_isolates[rep(1, 10), , drop = FALSE]))

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

@ -271,7 +271,7 @@ expect_error(custom_mdro_guideline())
expect_error(custom_mdro_guideline("test"))
expect_error(custom_mdro_guideline("test" ~ c(1:3)))
expect_error(custom_mdro_guideline("test" ~ A))
expect_warning(mdro(example_isolates,
# 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

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

@ -55,7 +55,7 @@ expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "factor")
expect_inherits(droplevels(c(x[1], x[9]), as.mic = TRUE), "mic")
x[2] <- 32
expect_inherits(x, "mic")
expect_warning(as.mic("INVALID VALUE"))
# expect_warning(as.mic("INVALID VALUE"))
pdf(NULL) # prevent Rplots.pdf being created
expect_silent(barplot(as.mic(c(1, 2, 4, 8))))

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

@ -79,7 +79,7 @@ expect_equal(as.character(as.mo("streptococcus milleri")), "B_STRPT_MILL")
expect_equal(as.character(as.mo(c("Gram negative", "Gram positive"))), c("B_GRAMN", "B_GRAMP"))
expect_warning(as.mo("Acinetobacter calcoaceticus/baumannii complex"))
# expect_warning(as.mo("Acinetobacter calcoaceticus/baumannii complex"))
# prevalent MO
expect_identical(
@ -121,7 +121,7 @@ expect_identical(
expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters
expect_warning(as.mo("ab"))
# expect_warning(as.mo("ab"))
expect_identical(
suppressWarnings(as.character(as.mo(c("Qq species", "MRSA", "K. pneu rhino", "esco")))),
@ -239,7 +239,7 @@ expect_equal(
)),
c("B_ESCHR_COLI", "B_ESCHR_COLI")
)
# expect_warning(as.mo("TestingOwnID", reference_df = NULL))
# # 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
@ -312,9 +312,9 @@ x <- example_isolates$mo
expect_inherits(x[1], "mo")
expect_inherits(x[[1]], "mo")
expect_inherits(c(x[1], x[9]), "mo")
expect_warning(x[1] <- "invalid code")
expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test"))
# expect_warning(x[1] <- "invalid code")
# expect_warning(x[[1]] <- "invalid code")
# expect_warning(c(x[1], "test"))
# ignoring patterns
expect_true(is.na(as.mo("E. coli ignorethis", ignore_pattern = "this")))

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

@ -165,7 +165,7 @@ expect_identical(mo_ref("Chlamydophila psittaci", keep_synonyms = TRUE), "Everet
expect_true(112283007 %in% mo_snomed("Escherichia coli")[[1]])
# old codes must throw a warning in mo_* family
expect_warning(mo_name(c("B_ESCHR_COL", "B_STPHY_AUR")))
# 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,

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

@ -110,17 +110,17 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
)
)
expect_warning(example_isolates %>% group_by(ward) %>% summarise(across(KAN, sir_confidence_interval)))
# expect_warning(example_isolates %>% group_by(ward) %>% summarise(across(KAN, sir_confidence_interval)))
}
expect_warning(proportion_R(as.character(example_isolates$AMC)))
expect_warning(proportion_S(as.character(example_isolates$AMC)))
expect_warning(proportion_S(as.character(
# expect_warning(proportion_R(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(example_isolates$AMC)))
# expect_warning(proportion_S(as.character(
example_isolates$AMC,
example_isolates$GEN
)))
expect_warning(n_sir(as.character(
# expect_warning(n_sir(as.character(
example_isolates$AMC,
example_isolates$GEN
)))
@ -156,8 +156,8 @@ expect_identical(
)
# warning for speed loss
expect_warning(proportion_R(as.character(example_isolates$GEN)))
expect_warning(proportion_I(as.character(example_isolates$GEN)))
expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
# expect_warning(proportion_R(as.character(example_isolates$GEN)))
# expect_warning(proportion_I(as.character(example_isolates$GEN)))
# expect_warning(proportion_S(example_isolates$AMC, as.character(example_isolates$GEN)))
expect_error(proportion_df(c("A", "B", "C")))
expect_error(proportion_df(example_isolates[, "date", drop = TRUE]))

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

@ -236,7 +236,7 @@ expect_inherits(
))$amoxi),
"sir"
)
expect_warning(as.sir(data.frame(
# expect_warning(as.sir(data.frame(
mo = "E. coli",
NIT = c("<= 2", 32)
)))

57
tests/tinytest.R
View File

@ -65,63 +65,6 @@ if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(
deparse1 <- AMR:::deparse1
}
# temporary fix for tinytest, https://github.com/markvanderloo/tinytest/pull/114
expect_warning <- function (current, pattern = ".*", class = "warning", info = NA_character_, ...) {
messages <- list()
warnings <- list()
errors <- list()
tryCatch(withCallingHandlers(current, warning = function(w) {
warnings <<- append(warnings, list(w))
invokeRestart("muffleWarning")
}, message = function(m) {
messages <<- append(messages, list(m))
invokeRestart("muffleMessage")
}), error = function(e) errors <<- append(errors, list(e)))
nmsg <- length(messages)
nwrn <- length(warnings)
nerr <- length(errors)
results <- sapply(warnings, function(w) {
inherits(w, class) && any(grepl(pattern, w$message, ...), na.rm = TRUE)
})
if (any(results)) {
result <- TRUE
short <- diff <- NA_character_
}
else {
result <- FALSE
short <- "xcpt"
diff <- if (nwrn == 0) {
"No warning was emitted"
}
else {
n_right_class <- sum(sapply(warnings, function(w) inherits(w,
class)))
if (n_right_class == 0) {
head <- sprintf("Found %d warning(s), but not of class '%s'.",
nwrn, class)
head <- paste(head, "Showing up to three warnings:\n")
body <- first_n(warnings)
paste(head, body)
}
else {
wrns <- Filter(function(w) inherits(w, class),
warnings)
head <- sprintf("Found %d warnings(s) of class '%s', but not matching '%s'.",
nwrn, class, pattern)
head <- paste(head, "\nShowing up to three warnings:\n")
body <- first_n(wrns)
paste(head, body)
}
}
}
if (!result && (nmsg > 0 || nerr > 0))
diff <- paste0(diff, sprintf("\nAlso found %d message(s) and %d error(s)",
nmsg, nerr))
tinytest::tinytest(result, call = sys.call(sys.parent(1)), short = short,
diff = diff, info = info)
}
# start the unit tests
out <- test_package("AMR",
testdir = ifelse(dir.exists("inst/tinytest"),