From 9fb027388be0ba66a5222f5f701aa3d18edd82cc Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Fri, 6 Mar 2026 20:49:03 +0000 Subject: [PATCH 1/2] Initial plan From ea9510893dcaa559d801321db6851c839c089f62 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Fri, 6 Mar 2026 21:05:27 +0000 Subject: [PATCH 2/2] Apply PR #507 + PR #506 changes: replace ggpubr with patchwork, add graceful internet error handling Co-authored-by: kristinawlai <57973437+kristinawlai@users.noreply.github.com> --- .gitignore | 1 + DESCRIPTION | 6 +- NEWS.md | 6 + R/autoplot.seroincidence.by.R | 19 +- R/graph_seroresponse_model_1.R | 2 +- R/load_noise_params.R | 49 +++- R/load_sr_params.R | 45 +++- man/autoplot.seroincidence.by.Rd | 2 +- man/load_noise_params.Rd | 4 +- .../seroinc-plot.svg | 251 +++++++++--------- tests/testthat/test-load_noise_params.R | 35 +++ tests/testthat/test-load_sr_params.R | 38 ++- 12 files changed, 312 insertions(+), 146 deletions(-) create mode 100644 tests/testthat/test-load_noise_params.R diff --git a/.gitignore b/.gitignore index 95e38a9a9..76005b694 100644 --- a/.gitignore +++ b/.gitignore @@ -25,3 +25,4 @@ junit.xml **/*.quarto_ipynb *.knit.md +tests/vdiffr.Rout.fail diff --git a/DESCRIPTION b/DESCRIPTION index f85dbda03..2932c5995 100644 --- a/DESCRIPTION +++ b/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, diff --git a/NEWS.md b/NEWS.md index 20e004582..fb5bb901b 100644 --- a/NEWS.md +++ b/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 diff --git a/R/autoplot.seroincidence.by.R b/R/autoplot.seroincidence.by.R index da0cbc2cc..a7004a686 100644 --- a/R/autoplot.seroincidence.by.R +++ b/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 diff --git a/R/graph_seroresponse_model_1.R b/R/graph_seroresponse_model_1.R index e81049b70..e01cbca4a 100644 --- a/R/graph_seroresponse_model_1.R +++ b/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 diff --git a/R/load_noise_params.R b/R/load_noise_params.R index 116e80e10..507f8f2cf 100644 --- a/R/load_noise_params.R +++ b/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) } diff --git a/R/load_sr_params.R b/R/load_sr_params.R index 0d6439bf3..70cca875a 100644 --- a/R/load_sr_params.R +++ b/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) } diff --git a/man/autoplot.seroincidence.by.Rd b/man/autoplot.seroincidence.by.Rd index a4540441a..b97eba450 100644 --- a/man/autoplot.seroincidence.by.Rd +++ b/man/autoplot.seroincidence.by.Rd @@ -19,7 +19,7 @@ or linear scale (\code{FALSE}, default)?} }} } \value{ -a \code{"ggarrange"} object: a single or \code{\link[=list]{list()}} of \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}}s +a \code{"patchwork"} object: a single or \code{\link[=list]{list()}} of \code{\link[ggplot2:ggplot]{ggplot2::ggplot()}}s } \description{ Plots log-likelihood curves by stratum, for \code{seroincidence.by} objects diff --git a/man/load_noise_params.Rd b/man/load_noise_params.Rd index d0d68780d..bc8e82876 100644 --- a/man/load_noise_params.Rd +++ b/man/load_noise_params.Rd @@ -23,7 +23,9 @@ with extra attribute \code{antigen_isos}) Load noise parameters } \examples{ -noise <- load_noise_params(serocalculator_example("example_noise_params.rds")) +noise <- load_noise_params( + serocalculator_example("example_noise_params.rds") +) print(noise) } diff --git a/tests/testthat/_snaps/autoplot.seroincidence.by/seroinc-plot.svg b/tests/testthat/_snaps/autoplot.seroincidence.by/seroinc-plot.svg index f41658d6e..5db27ec6f 100644 --- a/tests/testthat/_snaps/autoplot.seroincidence.by/seroinc-plot.svg +++ b/tests/testthat/_snaps/autoplot.seroincidence.by/seroinc-plot.svg @@ -18,149 +18,160 @@ + - - + + - - + - - + + - - - - - - - - - - - - - - - - - - - - - - + + --400 --350 --300 - - - - - - - - -0.00 -0.25 -0.50 -0.75 -1.00 -incidence rate (events per person:year) -log(likelihood) - - - - - - - -HlyE_IgG + HlyE_IgA -est.incidence -lambda_start -Stratum 1 - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + --450 --400 --350 --300 --250 - - - - - - - - - - -0.00 -0.25 -0.50 -0.75 -1.00 -incidence rate (events per person:year) -log(likelihood) - - - - - - - -HlyE_IgG + HlyE_IgA -est.incidence -lambda_start -Stratum 2 +-400 +-350 +-300 + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +incidence rate (events per person:year) +log(likelihood) + + + + + + + +HlyE_IgG + HlyE_IgA +est.incidence +lambda_start +Stratum 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-450 +-400 +-350 +-300 +-250 + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +incidence rate (events per person:year) +log(likelihood) + + + + + + + +HlyE_IgG + HlyE_IgA +est.incidence +lambda_start +Stratum 2 +seroinc-plot diff --git a/tests/testthat/test-load_noise_params.R b/tests/testthat/test-load_noise_params.R new file mode 100644 index 000000000..394a53b74 --- /dev/null +++ b/tests/testthat/test-load_noise_params.R @@ -0,0 +1,35 @@ +test_that( + desc = "`load_noise_params()` produces expected results", + code = { + expect_no_error( + noise_params_true <- + load_noise_params( + serocalculator_example("example_noise_params.rds") + ) + ) + expect_s3_class(noise_params_true, "noise_params") + } +) + +test_that( + desc = "non-URL file error is re-thrown", + code = { + err <- tryCatch( + load_noise_params("nonexistent_file.rds"), + error = function(e) e + ) + + expect_true(inherits(err, "error")) + } +) + +test_that( + desc = "unavailable internet resource produces informative error", + code = { + expect_error( + load_noise_params("https://ucdserg.ucdavis.edu/nofile.rds"), + class = "internet_resource_unavailable", + regexp = "Unable to load noise parameters from internet resource" + ) + } +) diff --git a/tests/testthat/test-load_sr_params.R b/tests/testthat/test-load_sr_params.R index 323d05931..55b2882d0 100644 --- a/tests/testthat/test-load_sr_params.R +++ b/tests/testthat/test-load_sr_params.R @@ -26,9 +26,43 @@ test_that( desc = "non filepath produces error", code = { expect_error( - expect_warning( - load_sr_params("non file path") + load_sr_params("non file path") + ) + } +) + +test_that( + desc = "non-URL file error is re-thrown", + code = { + err <- tryCatch( + load_sr_params("nonexistent_file.rds"), + error = function(e) e + ) + + expect_true(inherits(err, "error")) + } +) + +test_that( + desc = "unavailable internet resource produces informative error", + code = { + expect_error( + load_sr_params("https://ucdserg.ucdavis.edu/nofile.rds"), + class = "internet_resource_unavailable", + regexp = "Unable to load seroresponse parameters from internet resource" + ) + } +) + +test_that( + desc = "deprecated load_curve_params() still works", + code = { + result <- suppressWarnings( + load_curve_params( + serocalculator_example("example_curve_params.rds") ) ) + + expect_s3_class(result, "curve_params") } )