Merge branch 'main' into hyperlink-function-names

.Rbuildignore

@@ -21,3 +21,5 @@ allpopsamples_hlye.csv$
 ^serocalculator.*\.tgz$
 ^inst/extdata
 ^CRAN-SUBMISSION$
+^README\.qmd$
+^codecov\.yml$

.github/workflows/R-CMD-check.yaml

@@ -46,4 +46,5 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          error-on: '"warning"'
           build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/R-check-docs.yml

@@ -0,0 +1,43 @@
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+
+name: "Documentation check"
+
+jobs:
+  docs-check:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ github.token }}
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::roxygen2
+          needs: roxygen2
+
+      - name: Document
+        run: roxygen2::roxygenise()
+        shell: Rscript {0}
+
+      - name: Check for changed files
+        run: |
+          git add --all
+          changes=$(git diff-index HEAD --name-only -- man/ NAMESPACE DESCRIPTION)
+          if [ -n "$changes" ]; then
+            echo "Changes found after documenting."
+            git --no-pager diff
+            echo "$changes"
+            echo "Please update documentation."
+            exit 1
+          else
+            echo "No changes found after documenting."
+            exit 0
+          fi

.github/workflows/test-coverage.yaml

@@ -0,0 +1,61 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: test-coverage
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2
+          needs: coverage
+
+      - name: Test coverage
+        run: |
+          cov <- covr::package_coverage(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+          )
+          covr::to_cobertura(cov)
+        shell: Rscript {0}
+
+      - uses: codecov/codecov-action@v4
+        with:
+          fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+          file: ./cobertura.xml
+          plugin: noop
+          disable_search: true
+          token: ${{ secrets.CODECOV_TOKEN }}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v4
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: serocalculator
 Type: Package
 Title: Estimating Infection Rates from Serological Data
-Version: 1.1.0
+Version: 1.2.0.9000
 Authors@R: c(
   person(given = "Peter", family = "Teunis", email = "[email protected]", role = c("aut", "cph"), comment = "Author of the method and original code."),
   person(given = "Kristina", family = "Lai", email = "[email protected]", role = c("aut", "cre")), 
@@ -42,11 +42,12 @@ Suggests:
     readr,
     bookdown,
     ggbeeswarm,
-    DT
+    DT,
+    spelling
 LazyData: true
 Encoding: UTF-8
 URL: https://github.com/UCD-SERG/serocalculator, https://ucd-serg.github.io/serocalculator/
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 NeedsCompilation: no
 LinkingTo: 
     Rcpp

NAMESPACE

@@ -6,18 +6,34 @@ S3method(autoplot,pop_data)
 S3method(autoplot,seroincidence)
 S3method(autoplot,seroincidence.by)
 S3method(autoplot,summary.seroincidence.by)
+S3method(get_age,pop_data)
+S3method(get_age_var,pop_data)
+S3method(get_biomarker_levels,pop_data)
+S3method(get_biomarker_names,pop_data)
+S3method(get_biomarker_names_var,pop_data)
+S3method(get_id,pop_data)
+S3method(get_id_var,pop_data)
+S3method(get_value,pop_data)
+S3method(get_value_var,pop_data)
 S3method(print,seroincidence)
 S3method(print,seroincidence.by)
+S3method(print,summary.pop_data)
 S3method(print,summary.seroincidence.by)
+S3method(set_age,pop_data)
+S3method(set_biomarker_var,pop_data)
+S3method(set_id,pop_data)
+S3method(set_value,pop_data)
 S3method(strata,seroincidence.by)
 S3method(summary,pop_data)
 S3method(summary,seroincidence)
 S3method(summary,seroincidence.by)
+export(as_curve_params)
 export(as_pop_data)
 export(check_pop_data)
 export(est.incidence)
 export(est.incidence.by)
 export(f_dev)
+export(f_dev0)
 export(fdev)
 export(getAdditionalData)
 export(get_additional_data)
@@ -42,6 +58,8 @@ importFrom(dplyr,distinct)
 importFrom(dplyr,everything)
 importFrom(dplyr,filter)
 importFrom(dplyr,group_by)
+importFrom(dplyr,if_all)
+importFrom(dplyr,if_any)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,is.grouped_df)
 importFrom(dplyr,mutate)

NEWS.md

@@ -1,3 +1,15 @@
+# serocalculator (development version)
+
+# serocalculator 1.2.0
+* Added `test-summary.pop_data` test
+
+* Modified `test-est.incidence` test
+
+* Added stratification to `summary.pop_data`
+
+* Added `verbose` option for `check_pop_data()`, changing default behavior
+to avoid printing an OK message.
+
 # serocalculator 1.1.0
 
 * Renamed `llik()` to `log_likelihood()`

R/add_point_to_graph.R

@@ -5,7 +5,7 @@ add_point_to_graph <- function(
     point_data =
       tibble(
         x = fit$estimate %>% exp(),
-        y = llik(.data$x, ...),
+        y = log_likelihood(.data$x, ...),
         label = "est.incidence"
       ),
     ...) {

R/as_curve_params.R

@@ -0,0 +1,46 @@
+#' Load antibody decay curve parameter
+#'
+#' @param data a [data.frame()] or [tibble::tbl_df]
+#' @param antigen_isos [character()] vector of antigen isotypes to be used in analyses
+#' @returns a `curve_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
+#' @export
+#' @examples
+#' library(magrittr)
+#' curve_data <-
+#'   "https://osf.io/download/rtw5k/" %>%
+#'   readr::read_rds() %>%
+#'   as_curve_params()
+#'
+#' print(curve_data)
+
+as_curve_params <- function(data, antigen_isos = NULL) {
+  curve_data <-
+    data %>%
+    tibble::as_tibble()
+
+  # define curve columns
+  curve_cols <- c("antigen_iso", "y0", "y1", "t1", "alpha", "r")
+
+  # check if object is curve (with columns)
+  if (!all(is.element(curve_cols, curve_data %>% names()))) {
+    cli::cli_abort("Please provide curve data")
+  }
+
+  # assign curve class
+  class(curve_data) <-
+    c("curve_params", class(curve_data))
+
+
+  if (is.null(antigen_isos)) {
+    antigen_isos <- unique(curve_data$antigen_iso)
+  } else {
+    stopifnot(all(
+      is.element(antigen_isos, curve_data$antigen_iso)
+    ))
+  }
+
+  # assign antigen attribute
+  attr(curve_data, "antigen_isos") <- antigen_isos
+
+  return(curve_data)
+}

R/as_pop_data.R

@@ -9,15 +9,19 @@
 #' @returns a `pop_data` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
 #' @export
 #' @examples
-#' xs_data <- load_pop_data("https://osf.io/download//n6cp3/")
+#' library(magrittr)
+#' xs_data <-
+#'   "https://osf.io/download//n6cp3/" %>%
+#'   readr::read_rds() %>%
+#'   as_pop_data()
 #'
 #' print(xs_data)
 as_pop_data <- function(data,
-                          antigen_isos = NULL,
-                          age = "Age",
-                          value = "result",
-                          id = "index_id",
-                          standardize = TRUE) {
+                        antigen_isos = NULL,
+                        age = "Age",
+                        value = "result",
+                        id = "index_id",
+                        standardize = TRUE) {
 
 
   pop_data <-
@@ -38,8 +42,8 @@ as_pop_data <- function(data,
   pop_data <- pop_data %>%
     set_age(age = age, standardize = standardize) %>%
     set_value(value = value, standardize = standardize) %>%
-    set_id(id = id, standardize = standardize)
+    set_id(id = id, standardize = standardize)  %>%
+    set_biomarker_var(biomarker = "antigen_iso", standardize = standardize)
 
   return(pop_data)
 }
-

R/build_likelihood_function.R

@@ -1,3 +1,4 @@
+# not currently used internally or exported; can we remove it?
 build_likelihood_function <- function(
     cross_sectional_data,
     longitudinal_parameter_samples,
@@ -10,7 +11,7 @@ build_likelihood_function <- function(
     for (cur_antigen in antigen_isos)
     {
       res <- res +
-        fdev(
+        f_dev(
           lambda = lambda,
           csdata = cross_sectional_data[[cur_antigen]],
           lnpars = longitudinal_parameter_samples[[cur_antigen]],