diff --git a/DESCRIPTION b/DESCRIPTION index 7f015583..309c3540 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 1.8.2.9122 +Version: 1.8.2.9123 Date: 2023-02-13 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index 6dbd1b9a..2022f33b 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.2.9122 +# AMR 1.8.2.9123 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* diff --git a/R/antibiogram.R b/R/antibiogram.R index f2bd4af2..2a021431 100755 --- a/R/antibiogram.R +++ b/R/antibiogram.R @@ -136,7 +136,7 @@ #' # run ?example_isolates for more info. #' example_isolates #' -#' +#' \donttest{ #' # Traditional antibiogram ---------------------------------------------- #' #' antibiogram(example_isolates, @@ -232,6 +232,7 @@ #' if (requireNamespace("ggplot2")) { #' ggplot2::autoplot(ab2) #' } +#' } antibiogram <- function(x, antibiotics = where(is.sir), mo_transform = "shortname", @@ -543,12 +544,14 @@ autoplot.antibiogram <- function(object, ...) { #' @rdname antibiogram print.antibiogram <- function(x, as_kable = !interactive(), ...) { meet_criteria(as_kable, allow_class = "logical", has_length = 1) - if (isTRUE(as_kable) && - # be sure not to run kable in pkgdown for our website generation - !identical(Sys.getenv("IN_PKGDOWN"), "true")) { - stop_ifnot_installed("knitr") - kable <- import_fn("kable", "knitr", error_on_fail = TRUE) + + kable <- import_fn("kable", "knitr", error_on_fail = FALSE) + if (!is.null(kable) && + isTRUE(as_kable) && + # be sure not to run kable in pkgdown for our website generation + !identical(Sys.getenv("IN_PKGDOWN"), "true")) { kable(x, ...) + } else { # remove 'antibiogram' class and print with default method class(x) <- class(x)[class(x) != "antibiogram"] diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd index 310eddbc..d0eedd66 100644 --- a/man/antibiogram.Rd +++ b/man/antibiogram.Rd @@ -153,7 +153,7 @@ Printing the antibiogram in non-interactive sessions will be done by \code{\link # run ?example_isolates for more info. example_isolates - +\donttest{ # Traditional antibiogram ---------------------------------------------- antibiogram(example_isolates, @@ -250,3 +250,4 @@ if (requireNamespace("ggplot2")) { ggplot2::autoplot(ab2) } } +} diff --git a/tests/tinytest.R b/tests/tinytest.R index 01ef1c7f..35f88729 100644 --- a/tests/tinytest.R +++ b/tests/tinytest.R @@ -64,6 +64,64 @@ if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function( if (getRversion() < "4.0.0") { 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"),