diff --git a/.gitignore b/.gitignore index 020a30db3..6308e558f 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,5 @@ NEWS_files **/.quarto/ *.pdf junit.xml + +**/*.quarto_ipynb diff --git a/DESCRIPTION b/DESCRIPTION index 16e5c760a..c059a50fd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: serocalculator Title: Estimating Infection Rates from Serological Data -Version: 1.3.0.9059 +Version: 1.3.0.9061 Authors@R: c( person("Peter", "Teunis", , "p.teunis@emory.edu", role = c("aut", "cph"), comment = "Author of the method and original code."), @@ -76,4 +76,4 @@ Language: en-US LazyData: true NeedsCompilation: no Roxygen: list(markdown = TRUE, roclets = c("collate", "rd", "namespace", "devtag::dev_roclet")) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 38045bd43..6d22588f4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,6 +27,7 @@ export(est.incidence) export(est.incidence.by) export(est_seroincidence) export(est_seroincidence_by) +export(expect_snapshot_data) export(f_dev) export(f_dev0) export(fdev) diff --git a/NEWS.md b/NEWS.md index 1a1d71928..e43d7598f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -61,6 +61,7 @@ would get merged by `ggplot2::aes(group = iter)` (#382) ## Internal changes +* switched `expect_snapshot_data()` to an internal function due to CRAN errors (#464) * generalized `ab1()` * added codecov/test-results-action to test-coverage.yaml workflow * added test for censored data in f_dev() (#399) diff --git a/R/check_strata.R b/R/check_strata.R index c656eea37..0fdfe60ff 100644 --- a/R/check_strata.R +++ b/R/check_strata.R @@ -10,7 +10,7 @@ #' sees_pop_data_pk_100 |> #' check_strata(strata = c("ag", "catch", "Count")) |> #' try() -#' @dev +#' @keywords internal check_strata <- function(pop_data, strata, biomarker_names_var = diff --git a/R/expect_snapshot_data.R b/R/expect_snapshot_data.R new file mode 100644 index 000000000..fde73d20b --- /dev/null +++ b/R/expect_snapshot_data.R @@ -0,0 +1,35 @@ +#' Snapshot testing for [data.frame]s +#' @description +#' copied from +#' with permission () +#' +#' @param x a [data.frame] to snapshot +#' @param name [character] snapshot name +#' @param digits [integer] passed to [signif()] for numeric variables +#' +#' @returns [NULL] (from [testthat::expect_snapshot_file()]) +#' @export +#' @keywords internal +#' @examples +#' \dontrun{ +#' expect_snapshot_data(iris, name = "iris") +#' } +expect_snapshot_data <- function(x, name, digits = 6) { + fun <- function(x) signif(x, digits = digits) + lapply_fun <- function(x) I(lapply(x, fun)) + x <- dplyr::mutate(x, dplyr::across(tidyselect::where(is.numeric), fun)) + x <- dplyr::mutate(x, dplyr::across(tidyselect::where(is.list), lapply_fun)) + path <- save_csv(x) + testthat::expect_snapshot_file( + path, + paste0(name, ".csv"), + compare = testthat::compare_file_text + ) +} + + +save_csv <- function(x) { + path <- tempfile(fileext = ".csv") + readr::write_csv(x, path) + path +} diff --git a/R/sim_pop_data.R b/R/sim_pop_data.R index 82af13f87..14bb59153 100644 --- a/R/sim_pop_data.R +++ b/R/sim_pop_data.R @@ -29,6 +29,9 @@ #' * `"long"` (one measurement per row) or #' * `"wide"` (one serum sample per row) #' @inheritDotParams simcs.tinf +#' @inheritDotParams ldpar +#' @inheritDotParams ab +#' @inheritDotParams mk_baseline #' @inheritParams log_likelihood # verbose #' @return a [tibble::tbl_df] containing simulated cross-sectional serosurvey #' data, with columns: diff --git a/README.Rmd b/README.Rmd index 272cd5e8c..59d2bedca 100644 --- a/README.Rmd +++ b/README.Rmd @@ -141,7 +141,7 @@ on [GitHub](https://github.com/UCD-SERG/serocalculator/issues). Another great resource is **The Epidemiologist R Handbook**, which includes an introductory page on asking for help with R packages via GitHub: -https://epirhandbook.com/en/getting-help.html +https://epirhandbook.com/en/new_pages/help.html ## Contributing to this project diff --git a/README.md b/README.md index c6e2a08a6..f42b9c7ee 100644 --- a/README.md +++ b/README.md @@ -155,7 +155,7 @@ reproducible example](https://reprex.tidyverse.org/) on Another great resource is **The Epidemiologist R Handbook**, which includes an introductory page on asking for help with R packages via -GitHub: +GitHub: ## Contributing to this project diff --git a/_quarto.yml b/_quarto.yml index d584ac199..a49dd14a9 100644 --- a/_quarto.yml +++ b/_quarto.yml @@ -1,5 +1,7 @@ project: - render: ['*.qmd'] + render: + - "*.qmd" # Render all Quarto markdown files + - "!data-raw/" # Exclude anything in the data-raw directory author: "UC Davis Seroepidemiology Research Group (UCD-SERG)" date: '`r Sys.Date()`' format: diff --git a/inst/WORDLIST b/inst/WORDLIST index ae5f3ec0e..05fe96e9a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -123,3 +123,5 @@ varepsilon vec vee yaml +mitre +colour diff --git a/man/expect_snapshot_data.Rd b/man/expect_snapshot_data.Rd new file mode 100644 index 000000000..7e86c9562 --- /dev/null +++ b/man/expect_snapshot_data.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expect_snapshot_data.R +\name{expect_snapshot_data} +\alias{expect_snapshot_data} +\title{Snapshot testing for \link{data.frame}s} +\usage{ +expect_snapshot_data(x, name, digits = 6) +} +\arguments{ +\item{x}{a \link{data.frame} to snapshot} + +\item{name}{\link{character} snapshot name} + +\item{digits}{\link{integer} passed to \code{\link[=signif]{signif()}} for numeric variables} +} +\value{ +\link{NULL} (from \code{\link[testthat:expect_snapshot_file]{testthat::expect_snapshot_file()}}) +} +\description{ +copied from \url{https://github.com/bcgov/ssdtools} +with permission (\url{https://github.com/bcgov/ssdtools/issues/379}) +} +\examples{ +\dontrun{ +expect_snapshot_data(iris, name = "iris") +} +} +\keyword{internal} diff --git a/man/plot_curve_params_one_ab.Rd b/man/plot_curve_params_one_ab.Rd index 3485f51b5..b5c9dfecc 100644 --- a/man/plot_curve_params_one_ab.Rd +++ b/man/plot_curve_params_one_ab.Rd @@ -55,7 +55,7 @@ mapping.} \item{\code{data}}{Ignored by \code{stat_function()}, do not use.} \item{\code{stat}}{The statistical transformation to use on the data for this layer. When using a \verb{geom_*()} function to construct a layer, the \code{stat} -argument can be used the override the default coupling between geoms and +argument can be used to override the default coupling between geoms and stats. The \code{stat} argument accepts the following: \itemize{ \item A \code{Stat} ggproto subclass, for example \code{StatCount}. @@ -77,17 +77,25 @@ to use \code{position_jitter()}, give the position as \code{"jitter"}. \item For more information and other ways to specify the position, see the \link[ggplot2:layer_positions]{layer position} documentation. }} + \item{\code{arrow}}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + \item{\code{arrow.fill}}{fill colour to use for the arrow head (if closed). \code{NULL} +means use \code{colour} aesthetic.} + \item{\code{lineend}}{Line end style (round, butt, square).} + \item{\code{linejoin}}{Line join style (round, mitre, bevel).} + \item{\code{linemitre}}{Line mitre limit (number greater than 1).} \item{\code{na.rm}}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} \item{\code{show.legend}}{logical. Should this layer be included in the legends? \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE} never includes, and \code{TRUE} always includes. It can also be a named logical vector to finely select the aesthetics to -display.} +display. To include legend keys for all levels, even +when no data exists, use \code{TRUE}. If \code{NA}, all levels are shown in legend, +but unobserved levels are omitted.} \item{\code{inherit.aes}}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them. This is most useful for helper functions that define both data and aesthetics and shouldn't inherit behaviour from -the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} +the default plot specification, e.g. \code{\link[ggplot2:annotation_borders]{annotation_borders()}}.} }} } \value{ diff --git a/man/sim_pop_data.Rd b/man/sim_pop_data.Rd index bacc56b24..7645d1885 100644 --- a/man/sim_pop_data.Rd +++ b/man/sim_pop_data.Rd @@ -77,9 +77,20 @@ combinations \item{verbose}{logical: if TRUE, print verbose log information to console} \item{...}{ - Arguments passed on to \code{\link[=simcs.tinf]{simcs.tinf}} + Arguments passed on to \code{\link[=simcs.tinf]{simcs.tinf}}, \code{\link[=ldpar]{ldpar}}, \code{\link[=ab]{ab}}, \code{\link[=mk_baseline]{mk_baseline}} \describe{ - \item{\code{}}{} + \item{\code{age}}{age at infection} + \item{\code{nmc}}{mcmc sample to use} + \item{\code{npar}}{number of parameters} + \item{\code{t}}{\link{numeric} \link{vector} of elapsed times since start of infection} + \item{\code{par}}{\link{numeric} \link{matrix} of model parameters: +\itemize{ +\item rows are parameters +\item columns are biomarkers +}} + \item{\code{kab}}{\link{integer} indicating which row to read from \code{blims}} + \item{\code{n}}{number of observations} + \item{\code{blims}}{range of possible baseline antibody levels} }} } \value{ diff --git a/tests/testthat/_snaps/autoplot.curve_params/autoplot-curve-params.svg b/tests/testthat/_snaps/autoplot.curve_params/autoplot-curve-params.svg index 74fdddd8a..34e5a857c 100644 --- a/tests/testthat/_snaps/autoplot.curve_params/autoplot-curve-params.svg +++ b/tests/testthat/_snaps/autoplot.curve_params/autoplot-curve-params.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/autoplot.pop_data/density-log.svg b/tests/testthat/_snaps/autoplot.pop_data/density-log.svg index 71c63e72c..cf2508be7 100644 --- a/tests/testthat/_snaps/autoplot.pop_data/density-log.svg +++ b/tests/testthat/_snaps/autoplot.pop_data/density-log.svg @@ -134,9 +134,9 @@ catchment - + - + aku kgh Distribution of Cross-sectional Antibody Responses diff --git a/tests/testthat/_snaps/autoplot.pop_data/density.svg b/tests/testthat/_snaps/autoplot.pop_data/density.svg index 36c0a94b3..df9ac9e7e 100644 --- a/tests/testthat/_snaps/autoplot.pop_data/density.svg +++ b/tests/testthat/_snaps/autoplot.pop_data/density.svg @@ -138,9 +138,9 @@ catchment - + - + aku kgh Distribution of Cross-sectional Antibody Responses diff --git a/tests/testthat/_snaps/graph.curve.params/curve-black-chains.svg b/tests/testthat/_snaps/graph.curve.params/curve-black-chains.svg index 78c2db2b8..0e064bf93 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-black-chains.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-black-chains.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/graph.curve.params/curve-custom-quantiles.svg b/tests/testthat/_snaps/graph.curve.params/curve-custom-quantiles.svg index 6115c6a18..b31090a5a 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-custom-quantiles.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-custom-quantiles.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/graph.curve.params/curve-quantiles-and-samples.svg b/tests/testthat/_snaps/graph.curve.params/curve-quantiles-and-samples.svg index 11498e8e6..0edb09f1b 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-quantiles-and-samples.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-quantiles-and-samples.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/graph.curve.params/curve-quantiles.svg b/tests/testthat/_snaps/graph.curve.params/curve-quantiles.svg index 32257afb0..982c81465 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-quantiles.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-quantiles.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/graph.curve.params/curve-samples-log-x.svg b/tests/testthat/_snaps/graph.curve.params/curve-samples-log-x.svg index 62da4c683..8986a6132 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-samples-log-x.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-samples-log-x.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/graph.curve.params/curve-samples.svg b/tests/testthat/_snaps/graph.curve.params/curve-samples.svg index b51ea604f..05b9b5ddc 100644 --- a/tests/testthat/_snaps/graph.curve.params/curve-samples.svg +++ b/tests/testthat/_snaps/graph.curve.params/curve-samples.svg @@ -18,6 +18,7 @@ + diff --git a/tests/testthat/_snaps/sim_pop_data_multi/.gitignore b/tests/testthat/_snaps/sim_pop_data_multi/.gitignore deleted file mode 100644 index ffa490c9d..000000000 --- a/tests/testthat/_snaps/sim_pop_data_multi/.gitignore +++ /dev/null @@ -1 +0,0 @@ -*.new.csv diff --git a/tests/testthat/test-ab.R b/tests/testthat/test-ab.R index d859b01bd..ea2027855 100644 --- a/tests/testthat/test-ab.R +++ b/tests/testthat/test-ab.R @@ -1,32 +1,32 @@ test_that("`ab()` works consistently", { - par1 <- matrix( - c( - 1.11418923843475, 1, 0.12415057798022207, 0.24829344792968783, - 0.01998946878312856, 0.0012360802436587237, 1.297194045996013, - 1.3976510415108334, 1, 0.2159993563893431, 0.4318070551383313, - 0.0015146395107173347, 0.0003580062906750277, 1.5695811573082081 - ), - nrow = 7L, - ncol = 2L, - dimnames = list( - params = c("y0", "b0", "mu0", "mu1", "c1", "alpha", "shape_r"), - antigen_iso = c("HlyE_IgA", "HlyE_IgG") - ) - ) - t <- 0:1444 - blims <- matrix( - rep(c(0, 0.5), each = 2L), - nrow = 2L, - ncol = 2L, - dimnames = list(c("HlyE_IgA", "HlyE_IgG"), c("min", "max")) - ) - preds <- ab(t = t, par = par1, blims = blims) + par1 <- matrix( + c( + 1.11418923843475, 1, 0.12415057798022207, 0.24829344792968783, + 0.01998946878312856, 0.0012360802436587237, 1.297194045996013, + 1.3976510415108334, 1, 0.2159993563893431, 0.4318070551383313, + 0.0015146395107173347, 0.0003580062906750277, 1.5695811573082081 + ), + nrow = 7L, + ncol = 2L, + dimnames = list( + params = c("y0", "b0", "mu0", "mu1", "c1", "alpha", "shape_r"), + antigen_iso = c("HlyE_IgA", "HlyE_IgG") + ) + ) + t <- 0:1444 + blims <- matrix( + rep(c(0, 0.5), each = 2L), + nrow = 2L, + ncol = 2L, + dimnames = list(c("HlyE_IgA", "HlyE_IgG"), c("min", "max")) + ) + preds <- ab(t = t, par = par1, blims = blims) - colnames(preds) <- colnames(par1) + colnames(preds) <- colnames(par1) - preds2 <- preds |> as_tibble() + preds2 <- preds |> as_tibble() - ssdtools:::expect_snapshot_data(preds2, name = "ab-preds") + expect_snapshot_data(preds2, name = "ab-preds") }) diff --git a/tests/testthat/test-analyze_sims.R b/tests/testthat/test-analyze_sims.R index a5e1329c3..d668c5af3 100644 --- a/tests/testthat/test-analyze_sims.R +++ b/tests/testthat/test-analyze_sims.R @@ -7,7 +7,7 @@ test_that( test_sim_results |> analyze_sims() |> - ssdtools:::expect_snapshot_data(name = "sim_results") + expect_snapshot_data(name = "sim_results") } ) diff --git a/tests/testthat/test-as_sr_params.R b/tests/testthat/test-as_sr_params.R index f27bd0bee..2ee73ed56 100644 --- a/tests/testthat/test-as_sr_params.R +++ b/tests/testthat/test-as_sr_params.R @@ -30,7 +30,7 @@ test_that("`as_sr_params()` produces expected results", { expect_snapshot_value(x = test_data, style = "serialize") - test_data |> ssdtools:::expect_snapshot_data(name = "curve-data") + test_data |> expect_snapshot_data(name = "curve-data") }) diff --git a/tests/testthat/test-sim_pop_data.R b/tests/testthat/test-sim_pop_data.R index 432d882d0..898e975de 100644 --- a/tests/testthat/test-sim_pop_data.R +++ b/tests/testthat/test-sim_pop_data.R @@ -38,5 +38,5 @@ test_that("`sim_pop_data()` produces consistent results", { format = "long" ) - ssdtools:::expect_snapshot_data(csdata, "sim_pop_data") + expect_snapshot_data(csdata, name = "sim_pop_data") }) diff --git a/tests/testthat/test-sim_pop_data_multi.R b/tests/testthat/test-sim_pop_data_multi.R index faed9a674..a953d60dc 100644 --- a/tests/testthat/test-sim_pop_data_multi.R +++ b/tests/testthat/test-sim_pop_data_multi.R @@ -1,4 +1,5 @@ test_that("`sim_pop_data_multi()` works consistently", { + skip_on_cran() skip_on_os("linux") # Load curve parameters dmcmc <- typhoid_curves_nostrat_100 @@ -11,7 +12,6 @@ test_that("`sim_pop_data_multi()` works consistently", { # Simulated incidence rate per person-year lambdas <- c(.05, .1, .15, .2, .3) - # lambdas <- c(.05) # Range covered in simulations lifespan <- c(0, 10) @@ -39,5 +39,5 @@ test_that("`sim_pop_data_multi()` works consistently", { ) pop_data_multi |> - ssdtools:::expect_snapshot_data(name = "pop_data_multi") + expect_snapshot_data(name = "pop_data_multi") }) diff --git a/tests/testthat/test-strata.R b/tests/testthat/test-strata.R index 5520043d2..9f6b3bfed 100644 --- a/tests/testthat/test-strata.R +++ b/tests/testthat/test-strata.R @@ -2,7 +2,7 @@ test_that("results are consistent", { sees_typhoid_ests_strat |> strata() |> - ssdtools:::expect_snapshot_data(name = "strata-ests") + expect_snapshot_data(name = "strata-ests") }) diff --git a/vignettes/.gitignore b/vignettes/.gitignore index 75d0bf236..6a42f5c2e 100644 --- a/vignettes/.gitignore +++ b/vignettes/.gitignore @@ -9,3 +9,5 @@ methodology_files *.docx /.quarto/ *.rmarkdown + +**/*.quarto_ipynb