Use testthat edition 3 & fix imports

DESCRIPTION

@@ -30,8 +30,6 @@ BugReports: https://github.com/mrc-ide/EpiEstim/issues
 Depends: R (>= 3.3.0)
 Imports:
     coarseDataTools (>= 0.6-4),
-    incidence (>= 1.7.0),
-    incidence2 (>= 2.6.4.9000),
     ggplot2,
     fitdistrplus,
     coda,
@@ -42,7 +40,9 @@ Imports:
     patchwork (>= 1.2.0),
     rlang
 Suggests:
-    testthat,
+    incidence (>= 1.7.0),
+    incidence2 (>= 2.6.4.9000),
+    testthat (>= 3.0.0),
     utils,
     vdiffr,
     covr,
@@ -61,3 +61,4 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 VignetteBuilder: knitr
 Remotes: reconverse/incidence2/pkg
+Config/testthat/edition: 3

NEWS.md

@@ -1,3 +1,9 @@
+# EpiEstim 3.0.1
+
+- Moved incidence and incidence2 to suggests `walling_teunis()` and
+  `estimate_R()` will check for installations as required (fixes
+  [#241](https://github.com/mrc-ide/EpiEstim/issues/241))
+
 # EpiEstim 3.0.0
 
 ## New features

R/estimate_R.R

@@ -361,6 +361,13 @@ estimate_R <- function(incid,
                        date_convention = NULL
                        ) {
 
+  if(inherits(incid, "incidence")) {
+    rlang::check_installed("incidence", "to work with incidence data")
+  }
+  if(inherits(incid, "incidence2")) {
+    rlang::check_installed("incidence2", "to work with incidence2 data")
+  }
+
   if (is.data.frame(incid) && "dates" %in% names(incid)) {
     if (!all(diff(incid$dates) > 0)) {
       stop("dates in incid must be in ascending order", call. = FALSE)

R/plot.R

@@ -177,7 +177,7 @@
           panel.border = element_blank(),
           axis.line = element_line(
             colour = "black",
-            size = 0.2
+            linewidth = 0.2
           ),
           plot.title = element_text(
             size = 12,
@@ -202,7 +202,7 @@
 
     options_I$col <- "#5983AB"
   } else {
     if (plot_theme == "original") {
       theme_epiestim <- function() {
         theme()
       }
@@ -222,7 +222,7 @@
     } else {
     multiple_input <- TRUE
     if (length(unique(vapply(x, function(e) nrow(e$R), integer(1)))) > 1) {
       stop("R estimates cannot be plotted simulatneously because
            they are of different sizes, i.e. they were obtained using
            t_start or t_end of different lengths")
     }
@@ -234,9 +234,9 @@
         options_R$col,
         ceiling(length(x_list) / length(options_R$col))
       )
       options_R$col <- options_R$col[seq_len(length(x_list))]
     } else {
       options_R$col <- options_R$col[seq_len(length(x_list))]
     }
   }
 
@@ -248,7 +248,7 @@
   method <- x$method
   si_distr <- x$si_distr
   incid <- data.frame(local = x$I_local, imported = x$I_imported)
   T <- nrow(incid)
   if (!is.null(x$dates)) {
     dates <- x$dates
   } else {
@@ -264,6 +264,7 @@
 
   what <- match.arg(what)
   if (what %in% c("incid", "all")) {
+    rlang::check_installed("incidence", "to plot incidence data")
     if (add_imported_cases) {
       p1 <- plot(
         incidence::as.incidence(incid,
@@ -315,13 +316,13 @@
           options_R$xlim <- c(min(dates), max(dates) + 1)
         }
 
         df <- reshape2::melt(data.frame(
           start = dates[t_start] - 0.5, end = dates[t_end] + 0.5, meanR = mean_posterior,
           lower = quantile_0.025_posterior,
           upper = quantile_0.975_posterior
         ), id.vars = c("meanR", "lower", "upper"))
         df$group <- as.factor(rep(
           seq_len(length(t_start)),
           dim(df)[1] / length(t_start)
         ))
 
@@ -348,7 +349,7 @@
           lower = quantile_0.025_posterior,
           upper = quantile_0.975_posterior
         )
         df <- df_tmp
         id_tmp <- c("meanR", "lower", "upper")
         id <- id_tmp
 
@@ -370,7 +371,7 @@
             upper2 = quantile_0.975_posterior2
           )
           names(df_tmp2) <- paste0(names(df_tmp), i)
           df <- cbind(df, df_tmp2)
           id_tmp2 <- paste0(id, i)
           id <- c(id, id_tmp2)
         }
@@ -385,7 +386,7 @@
           options_R$xlim <- c(min(dates), max(dates) + 1)
         }
 
         df <- reshape2::melt(df, id = id)
         df$group <- as.factor(rep(
           seq_len(length(t_start)),
           dim(df)[1] / length(t_start)

R/test_utils.R

@@ -10,16 +10,13 @@
 #' 
 #' @noRd
 
-epi_expect_doppelganger <- function(name, code, variant) {
+epi_expect_doppelganger <- function(name, test, code, variant) {
 
   testthat::skip_if_not_installed("vdiffr")
 
   on_ci <- as.logical(Sys.getenv("CI", "false"))
   no_snap <- !file.exists(
-    testthat::test_path(
-      "_snaps",
-      variant,
-      paste0(name, ".svg")
+    testthat::test_path("_snaps", variant, test, paste0(name, ".svg")
     )
   )
   if (on_ci && no_snap) {
@@ -35,3 +32,36 @@ epi_expect_doppelganger <- function(name, code, variant) {
   )
 }
 
+#' Custom snapshot utility function
+#' 
+#' Creates mini snapshots by sampling `x` down to `n`. If `x` is a list, the
+#' function recurses down the list sampling applies to all sub-items (which may
+#' or may not be appropriate, depending on the situation). Also rounds to 8
+#' digits to avoid mismatches in re-loading values with long trailing decimals.
+#'
+#' @param x Vector or list of vectors to take a snapshot of.
+#' @param style Snapshot style (see `?testthat::snapshot_value()`)
+#' @param n Numeric. Number of samples to keep
+#'
+#' @noRd
+epi_snapshot_value <- function(x, style = "json2", n = 5, digits = 8) {
+
+  sample_x <- function(xx) {
+    # Recurse if this is still a list
+    if(is.list(xx)) return(lapply(xx, sample_x))
+
+    # Take random sample of points if less than n
+    if(!is.null(n) && length(xx) > n) {
+      set.seed(1) # TODO: could use withr::with_seed()
+      xx <- sample(xx, size = n)
+    }
+
+    # Round to avoid mismatches from truncated records
+    if(is.numeric(xx)) xx <- round(xx, digits = digits) 
+    xx
+  }
+
+  x <- sample_x(x)
+
+  testthat::expect_snapshot_value(x, style = style)
+}

R/wallinga_teunis.R

@@ -416,6 +416,8 @@ wallinga_teunis.incidence <- function(incid,
                                       quiet = FALSE,
                                       ...) {
 
+  rlang::check_installed("incidence", "to work with incidence data")
+
   ## checks specific to incidence objects
   if (as.integer(mean(incidence::get_interval(incid))) != 1L) {
     msg <- sprintf(
@@ -457,6 +459,8 @@ wallinga_teunis.incidence2 <- function(incid,
                                        quiet = FALSE,
                                        ...) {
 
+  rlang::check_installed("incidence2", "to work with incidence2 data")
+
   ## checks specific to incidence2 objects
   dates <- incidence2::get_dates(incid)
   interval <- incidence2::get_interval_duration(incid)

tests/testthat.R

@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
 library(testthat)
 library(EpiEstim)