Merge branch 'main' into improve-autoplotpop_data-error-communication

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: serocalculator
 Title: Estimating Infection Rates from Serological Data
-Version: 1.2.0.9015
+Version: 1.2.0.9016
 Authors@R: c(
     person("Peter", "Teunis", , "[email protected]", role = c("aut", "cph"),
            comment = "Author of the method and original code."),

NAMESPACE

@@ -15,6 +15,7 @@ S3method(summary,pop_data)
 S3method(summary,seroincidence)
 S3method(summary,seroincidence.by)
 export(as_curve_params)
+export(as_noise_params)
 export(as_pop_data)
 export(autoplot)
 export(check_pop_data)

NEWS.md

@@ -1,18 +1,21 @@
 # serocalculator (development version)
 
 ## New features
-
 * Improved error messaging for `autoplot.pop_data()` (#234).
 
 * Clarified package installation instructions in scrub typhus vignette (#234).
 
 * Updated `simulate_xsectionalData.Rmd()` (linting, removing deprecated functions).
 
+* Add `as_noise_params` (#228) 
+
+* Updated `simulate_xsectionalData.Rmd` (linting, removing deprecated functions) (#289)
+
 * Added default value for `antigen_isos` argument in `log_likelihood()` (#286)
 
 * Updated enteric fever example article with upgraded code and visualizations (#290)
 
-* Added `Methodology` vignette (#284, #302)
+* Added `Methodology` vignette (#284, #302, #303)
 
 * Added template for reporting Issues 
 (from `usethis::use_tidy_issue_template()`) (#270)

R/as_noise_params.R

@@ -0,0 +1,82 @@
+#' Load noise parameters
+#'
+#' @param data a [data.frame()] or [tibble::tbl_df]
+#' @param antigen_isos [character()] vector of antigen isotypes
+#' to be used in analyses
+#'
+#' @returns a `noise_params` object (a [tibble::tbl_df] with
+#' extra attribute `antigen_isos`)
+#' @export
+#' @examples
+#' library(magrittr)
+#' noise_data <-
+#'   "https://osf.io/download//hqy4v/" %>%
+#'   readr::read_rds() %>%
+#'   as_noise_params()
+#'
+#' print(noise_data)
+#'
+as_noise_params <- function(data, antigen_isos = NULL) {
+  if (!is.data.frame(data)) {
+    cli::cli_abort(
+      class = "not data.frame",
+      message = c(
+        "Can't convert {.arg data} to {.cls noise_params}.",
+        paste(
+          "x" = "{.arg data} must be a {.cls data.frame}",
+          "(or a subclass of {.cls data.frame})."
+        ),
+        "i" = "You have supplied a {.cls {class(data)}}."
+      )
+    )
+  }
+
+  noise_data <- data %>% tibble::as_tibble()
+
+  # Define noise columns
+  noise_cols <- c("antigen_iso", "y.low", "eps", "nu", "y.high")
+
+  # Get any missing columns
+  missing_cols <- setdiff(x = noise_cols, y = names(data))
+
+  if (length(missing_cols) > 0) {
+    cli::cli_abort(
+      class = "not noise_params",
+      message = c(
+        "Can't convert {.arg data} to {.cls noise_params}.",
+        "i" = paste(
+          "The column{?s}: {.strong {.var {missing_cols}}}",
+          "{?is/are} missing."
+        )
+      )
+    )
+  }
+
+  # Assign noise_params class
+  class(noise_data) <- c("noise_params", class(noise_data))
+
+  # Handle antigen_isos
+  if (is.null(antigen_isos)) {
+    antigen_isos <- unique(noise_data$antigen_iso)
+  } else {
+    missing_antigen <- setdiff(antigen_isos, unique(noise_data$antigen_iso))
+
+    if (length(missing_antigen) > 0) {
+      cli::cli_abort(
+        class = "missing-antigen",
+        message = c(
+          "x" = "Can't convert {.var data} to {.cls noise_params}.",
+          "i" = paste(
+            "The antigen type{?s} {.str {missing_antigen}}",
+            "{?is/are} missing in {.var data}."
+          )
+        )
+      )
+    }
+  }
+
+  # Assign antigen attribute
+  attr(noise_data, "antigen_isos") <- antigen_isos
+
+  return(noise_data)
+}

R/load_noise_params.R

@@ -1,9 +1,14 @@
 #' Load noise parameters
 #'
-#' @param file_path path to an RDS file containing biologic and measurement noise of antibody decay curve parameters `y.low`, `eps`, `nu`, and `y.high`, stored as a [data.frame()] or [tibble::tbl_df]
-#' @param antigen_isos [character()] vector of antigen isotypes to be used in analyses
+#' @param file_path path to an RDS file containing biologic
+#' and measurement noise of antibody decay curve parameters
+#' `y.low`, `eps`, `nu`, and `y.high`,
+#' stored as a [data.frame()] or [tibble::tbl_df]
+#' @param antigen_isos [character()] vector
+#' of antigen isotypes to be used in analyses
 #'
-#' @returns a `noise` object (a [tibble::tbl_df] with extra attribute `antigen_isos`)
+#' @returns a `noise` object (a [tibble::tbl_df]
+#' with extra attribute `antigen_isos`)
 #' @export
 #' @examples
 #' noise <- load_noise_params("https://osf.io/download//hqy4v/")
@@ -17,18 +22,7 @@ load_noise_params <- function(file_path, antigen_isos = NULL) {
   noise <-
     file_path %>%
     readRDS() %>%
-    tibble::as_tibble()
-
-  class(noise) <-
-    c("noise", class(noise))
-
-  if (is.null(antigen_isos)) {
-    antigen_isos <- unique(noise$antigen_iso)
-  } else {
-    stopifnot(all(is.element(antigen_isos, noise$antigen_iso)))
-  }
-
-  attr(noise, "antigen_isos") <- antigen_isos
+    as_noise_params()
 
   return(noise)
 }

README.md

@@ -11,9 +11,14 @@
 [![codecov](https://codecov.io/gh/UCD-SERG/serocalculator/graph/badge.svg?token=85CXV6GN2T)](https://codecov.io/gh/UCD-SERG/serocalculator)
 <!-- badges: end -->
 
-    #> Warning: package 'qrcode' was built under R version 4.4.1
+<div id="fig-website-QR">
 
-![QR code for {serocalculator} website](man/figures/qr.svg)
+![](man/figures/qr.svg)
+
+
+Figure 1: QR code for `serocalculator` website
+
+</div>
 
 Antibody levels measured in a cross–sectional population sample can be
 translated into an estimate of the frequency with which seroconversions

README.qmd

@@ -29,7 +29,7 @@ code <- qr_code("https://ucd-serg.github.io/serocalculator/")
 generate_svg(code, filename = "man/figures/qr.svg")
 ```
 
-![QR code for {serocalculator} website](man/figures/qr.svg)
+![QR code for `serocalculator` website](man/figures/qr.svg){#fig-website-QR}
 
 Antibody levels measured in a cross–sectional population sample can be translated into an estimate of the frequency with which seroconversions (infections) occur in the sampled population. 
 In other words, the presence of many high antibody titers indicates that many individuals likely experienced infection recently and the burden of disease is high in the population, 

_pkgdown.yml

@@ -3,3 +3,4 @@ template:
   bootstrap: 5
   light-switch: true
 
+bibliography: vignettes/references.bib

tests/testthat/_snaps/as_noise_params.md

@@ -0,0 +1,57 @@
+# `as_noise_params()` produces expected results
+
+    Code
+      test_data
+    Output
+      # A tibble: 16 x 7
+         antigen_iso Country    y.low   eps    nu  y.high Lab  
+         <chr>       <fct>      <dbl> <dbl> <dbl>   <dbl> <fct>
+       1 HlyE_IgA    Bangladesh 0.376 0.280  2.60 5000000 CHRF 
+       2 HlyE_IgA    Ghana      0.179 0.240  2.60 5000000 MGH  
+       3 HlyE_IgA    Nepal      0.853 0.238  2.60 5000000 DH   
+       4 HlyE_IgA    Pakistan   0.508 0.279  2.60 5000000 AKU  
+       5 HlyE_IgG    Bangladesh 0.787 0.306  2.36 5000000 CHRF 
+       6 HlyE_IgG    Ghana      0.645 0.164  2.36 5000000 MGH  
+       7 HlyE_IgG    Nepal      1.89  0.128  2.36 5000000 DH   
+       8 HlyE_IgG    Pakistan   1.59  0.146  2.36 5000000 AKU  
+       9 LPS_IgA     Bangladesh 0.660 0.299  2.14 5000000 CHRF 
+      10 LPS_IgA     Ghana      0.861 0.163  2.14 5000000 MGH  
+      11 LPS_IgA     Nepal      1.79  0.115  2.14 5000000 DH   
+      12 LPS_IgA     Pakistan   5.13  0.246  2.14 5000000 AKU  
+      13 LPS_IgG     Bangladesh 0.992 0.298  3.24 5000000 CHRF 
+      14 LPS_IgG     Ghana      0.885 0.195  3.24 5000000 MGH  
+      15 LPS_IgG     Nepal      0.647 0.179  3.24 5000000 DH   
+      16 LPS_IgG     Pakistan   4.84  0.273  3.24 5000000 AKU  
+
+---
+
+    WAoAAAACAAQEAQACAwAAAAMTAAAABwAAABAAAAAQAAQACQAAAAhIbHlFX0lnQQAEAAkAAAAI
+    SGx5RV9JZ0EABAAJAAAACEhseUVfSWdBAAQACQAAAAhIbHlFX0lnQQAEAAkAAAAISGx5RV9J
+    Z0cABAAJAAAACEhseUVfSWdHAAQACQAAAAhIbHlFX0lnRwAEAAkAAAAISGx5RV9JZ0cABAAJ
+    AAAAB0xQU19JZ0EABAAJAAAAB0xQU19JZ0EABAAJAAAAB0xQU19JZ0EABAAJAAAAB0xQU19J
+    Z0EABAAJAAAAB0xQU19JZ0cABAAJAAAAB0xQU19JZ0cABAAJAAAAB0xQU19JZ0cABAAJAAAA
+    B0xQU19JZ0cAAAMNAAAAEAAAAAEAAAACAAAAAwAAAAQAAAABAAAAAgAAAAMAAAAEAAAAAQAA
+    AAIAAAADAAAABAAAAAEAAAACAAAAAwAAAAQAAAQCAAAAAQAEAAkAAAAGbGV2ZWxzAAAAEAAA
+    AAQABAAJAAAACkJhbmdsYWRlc2gABAAJAAAABUdoYW5hAAQACQAAAAVOZXBhbAAEAAkAAAAI
+    UGFraXN0YW4AAAQCAAAAAQAEAAkAAAAFY2xhc3MAAAAQAAAAAQAEAAkAAAAGZmFjdG9yAAAA
+    /gAAAA4AAAAQP9gUhDQ1RGM/xvCKmUL++z/rSk6UfGgfP+BFPcbXYck/6TE4o6ROQj/ko950
+    nZRZP/5JGcI3t0A/+YNhwTKHMz/lIQmukLLRP+uL8ltAh0g//LaTVr0DtUAUhFsZVj1OP+++
+    j4SPPcI/7E67WBZ9rD/kspkzsff5QBNb4G4DLJ8AAAAOAAAAED/R87Wq5+K3P86rhUPfGHg/
+    zoJeQW9aLT/R4GSyElOYP9OWzBODLmI/xPtMdrkKcj/AaTWyrixoP8KkV93KZo8/0x2pZndK
+    kz/E2s3uS1HXP71nYcIHjvo/z3PLL4YC+D/TD0QauoAUP8kEu44Oiq0/xuWdcUgfXD/RdF8Z
+    kNbEAAAADgAAABBABMPOAA0c6EAEw84ADRzoQATDzgANHOhABMPOAA0c6EAC4WKiymBYQALh
+    YqLKYFhAAuFiospgWEAC4WKiymBYQAEbfuAKClBAARt+4AoKUEABG37gCgpQQAEbfuAKClBA
+    CeX2bXB1/kAJ5fZtcHX+QAnl9m1wdf5ACeX2bXB1/gAAAA4AAAAQQVMS0AAAAABBUxLQAAAA
+    AEFTEtAAAAAAQVMS0AAAAABBUxLQAAAAAEFTEtAAAAAAQVMS0AAAAABBUxLQAAAAAEFTEtAA
+    AAAAQVMS0AAAAABBUxLQAAAAAEFTEtAAAAAAQVMS0AAAAABBUxLQAAAAAEFTEtAAAAAAQVMS
+    0AAAAAAAAAMNAAAAEAAAAAEAAAACAAAAAwAAAAQAAAABAAAAAgAAAAMAAAAEAAAAAQAAAAIA
+    AAADAAAABAAAAAEAAAACAAAAAwAAAAQAAAQCAAAB/wAAABAAAAAEAAQACQAAAARDSFJGAAQA
+    CQAAAANNR0gABAAJAAAAAkRIAAQACQAAAANBS1UAAAQCAAAC/wAAABAAAAABAAQACQAAAAZm
+    YWN0b3IAAAD+AAAEAgAAAv8AAAAQAAAABAAEAAkAAAAMbm9pc2VfcGFyYW1zAAQACQAAAAZ0
+    YmxfZGYABAAJAAAAA3RibAAEAAkAAAAKZGF0YS5mcmFtZQAABAIAAAABAAQACQAAAAlyb3cu
+    bmFtZXMAAAANAAAAAoAAAAD////wAAAEAgAAAAEABAAJAAAABW5hbWVzAAAAEAAAAAcABAAJ
+    AAAAC2FudGlnZW5faXNvAAQACQAAAAdDb3VudHJ5AAQACQAAAAV5LmxvdwAEAAkAAAADZXBz
+    AAQACQAAAAJudQAEAAkAAAAGeS5oaWdoAAQACQAAAANMYWIAAAQCAAAAAQAEAAkAAAAMYW50
+    aWdlbl9pc29zAAAAEAAAAAQABAAJAAAACEhseUVfSWdBAAQACQAAAAhIbHlFX0lnRwAEAAkA
+    AAAHTFBTX0lnQQAEAAkAAAAHTFBTX0lnRwAAAP4=
+

tests/testthat/test-as_noise_params.R

@@ -0,0 +1,48 @@
+test_that("`as_noise_params()` produces an error
+          when non-noise data is provided", {
+            library(magrittr)
+            expect_error(
+              object = noise_data <-
+                "https://osf.io/download//n6cp3/" %>% # pop data
+                readr::read_rds() %>%
+                as_noise_params(),
+              class = "not noise_params"
+            )
+          })
+
+test_that("`as_noise_params()` produces expected results", {
+  library(dplyr)
+  test_data <- "https://osf.io/download//hqy4v/" %>% # noise data
+    readr::read_rds() %>%
+    as_noise_params()
+
+  expect_snapshot(test_data)
+
+  expect_snapshot_value(
+    x = test_data,
+    style = "serialize"
+  )
+})
+
+test_that("`as_noise_params()` produces error when
+          wrong antigen_iso is provided", {
+            library(dplyr)
+
+            expect_error(
+              object = "https://osf.io/download//hqy4v/" %>% # noise data
+                readr::read_rds() %>%
+                as_noise_params(antigen_iso = "HlyE_IgB"),
+              class = "missing-antigen"
+            )
+          })
+
+test_that("`as_noise_params()` produces error when
+          non-data frame is provided", {
+            library(dplyr)
+
+            expect_error(
+              object = "a string sample" %>% # random string
+                as_noise_params(),
+              class = "not data.frame"
+            )
+          })

vignettes/.gitignore

@@ -7,5 +7,5 @@ methodology_files
 *_files/
 *.pptx
 *.docx
-
 /.quarto/
+*.rmarkdown

vignettes/articles/enteric_fever_example.Rmd

@@ -9,7 +9,7 @@ vignette: >
   %\VignetteIndexEntry{Enteric Fever Seroincidence Vignette}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
-
+bibliography: ../references.bib
 ---
 ## Introduction