Fix R oldrel-1 CI failure: replace ggpubr with patchwork + graceful internet error handling

.gitignore

@@ -25,3 +25,4 @@ junit.xml
 
 **/*.quarto_ipynb
 *.knit.md
+tests/vdiffr.Rout.fail

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: serocalculator
 Title: Estimating Infection Rates from Serological Data
-Version: 1.4.0.9003
+Version: 1.4.0.9004
 Authors@R: c(
     person("Kristina", "Lai", , "kwlai@ucdavis.edu", role = c("aut", "cre")),
     person("Chris", "Orwa", role = "aut"),
@@ -27,10 +27,11 @@ Imports:
     dplyr,
     foreach,
     ggplot2,
-    ggpubr,
     lifecycle,
     magrittr,
+    patchwork,
     Rcpp,
+    readr,
     rlang,
     rngtools,
     scales,
@@ -53,7 +54,6 @@ Suggests:
     knitr,
     mixtools,
     pak,
-    readr,
     quarto,
     rmarkdown,
     spelling,

NEWS.md

@@ -1,5 +1,11 @@
 # serocalculator (development version)
 
+## Bug fixes
+
+* `load_noise_params()` and `load_sr_params()` now fail gracefully with informative messages when internet resources are unavailable, complying with CRAN policy (#505)
+
+* Replaced `ggpubr` with `patchwork` for arranging panel plots in `autoplot.seroincidence.by()` and `graph_seroresponse_model_1()`, removing the indirect `ggrepel` dependency that required R >= 4.5.0 (#507)
+
 # serocalculator 1.4.0
 
 ## New features

R/autoplot.seroincidence.by.R

@@ -4,7 +4,7 @@
 #' @param object a '"seroincidence.by"' object (from [est_seroincidence_by()])
 #' @param ncol number of columns to use for panel of plots
 #' @inheritDotParams autoplot.seroincidence
-#' @return a `"ggarrange"` object: a single or [list()] of [ggplot2::ggplot()]s
+#' @return a `"patchwork"` object: a single or [list()] of [ggplot2::ggplot()]s
 #' @export
 #' @examples
 #'\donttest{
@@ -41,14 +41,19 @@ autoplot.seroincidence.by <- function(
     ncol = min(3, length(object)),
     ...) {
   if (length(object) == 0) {
-    stop("The input doesn't contain any fits. Did subsetting go wrong?")
+    cli::cli_abort(
+      "The input doesn't contain any fits. Did subsetting go wrong?"
+    )
   }
 
   if (!attr(object, "graphs_included")) {
-    stop(
-      "Graphs cannot be extracted; ",
-      "`build_graph` was not `TRUE` in the call to `est_seroincidence_by()`"
-    )
+    cli::cli_abort(c(
+      "Graphs cannot be extracted.",
+      "i" = paste0(
+        "`build_graph` was not `TRUE` in the call to",
+        " `est_seroincidence_by()`"
+      )
+    ))
     figure <- NULL
   }
 
@@ -63,7 +68,7 @@ autoplot.seroincidence.by <- function(
   nrow <- ceiling(length(figs) / ncol)
   figure <- do.call(
     what = function(...) {
-      ggpubr::ggarrange(
+      patchwork::wrap_plots(
         ...,
         ncol = ncol,
         nrow = nrow

R/graph_seroresponse_model_1.R

@@ -59,7 +59,7 @@ graph_seroresponse_model_1 <- function(
   nrow <- ceiling(length(figs) / ncol)
   figure <- do.call(
     what = function(...) {
-      ggpubr::ggarrange(
+      patchwork::wrap_plots(
         ...,
         ncol = ncol,
         nrow = nrow

R/load_noise_params.R

@@ -11,18 +11,55 @@
 #' with extra attribute `antigen_isos`)
 #' @export
 #' @examples
-#' noise <- load_noise_params(serocalculator_example("example_noise_params.rds"))
+#' noise <- load_noise_params(
+#'   serocalculator_example("example_noise_params.rds")
+#' )
 #' print(noise)
 #'
 load_noise_params <- function(file_path, antigen_isos = NULL) {
-  if (file_path %>% substr(1, 4) == "http") {
+  is_url <- file_path |> substr(1, 4) == "http"
+
+  if (is_url) {
     file_path <- url(file_path)
   }
 
-  noise <-
-    file_path %>%
-    readRDS() %>%
-    as_noise_params()
+  noise <- tryCatch(
+    {
+      data <- if (is_url) {
+        withCallingHandlers(
+          readr::read_rds(file_path),
+          warning = function(w) {
+            invokeRestart("muffleWarning")
+          }
+        )
+      } else {
+        readr::read_rds(file_path)
+      }
+
+      as_noise_params(data, antigen_isos = antigen_isos)
+    },
+    error = function(e) {
+      if (is_url) {
+        cli::cli_abort(
+          class = "internet_resource_unavailable",
+          message = c(
+            "Unable to load noise parameters from internet resource.",
+            "x" = paste(
+              "The resource at {.url {summary(file_path)$description}}",
+              "is not available or has changed."
+            ),
+            "i" = paste(
+              "Please check your internet connection",
+              "and verify the URL is correct."
+            ),
+            "i" = "Original error: {e$message}"
+          )
+        )
+      } else {
+        rlang::cnd_signal(e)
+      }
+    }
+  )
 
   return(noise)
 }

R/load_sr_params.R

@@ -14,14 +14,49 @@
 #' print(curve)
 #'
 load_sr_params <- function(file_path, antigen_isos = NULL) {
-  if (file_path |>  substr(1, 4) == "http") {
+  is_url <- file_path |> substr(1, 4) == "http"
+
+  if (is_url) {
     file_path <- url(file_path)
   }
 
-  curve_params <-
-    file_path |>
-    readRDS() |>
-    as_sr_params()
+  curve_params <- tryCatch(
+    {
+      data <- if (is_url) {
+        withCallingHandlers(
+          readr::read_rds(file_path),
+          warning = function(w) {
+            invokeRestart("muffleWarning")
+          }
+        )
+      } else {
+        readr::read_rds(file_path)
+      }
+
+      as_sr_params(data, antigen_isos = antigen_isos)
+    },
+    error = function(e) {
+      if (is_url) {
+        cli::cli_abort(
+          class = "internet_resource_unavailable",
+          message = c(
+            "Unable to load seroresponse parameters from internet resource.",
+            "x" = paste(
+              "The resource at {.url {summary(file_path)$description}}",
+              "is not available or has changed."
+            ),
+            "i" = paste(
+              "Please check your internet connection",
+              "and verify the URL is correct."
+            ),
+            "i" = "Original error: {e$message}"
+          )
+        )
+      } else {
+        rlang::cnd_signal(e)
+      }
+    }
+  )
 
   return(curve_params)
 }