Creating a default print for sr_model

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: serodynamics
 Title: What the Package Does (One Line, Title Case)
-Version: 0.0.0.9047
+Version: 0.0.0.9048
 Authors@R: c(
     person("Peter", "Teunis", , "p.teunis@emory.edu", role = c("aut", "cph"),
            comment = "Author of the method and original code."),

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(autoplot,case_data)
+S3method(print,sr_model)
 export(as_case_data)
 export(autoplot)
 export(expect_snapshot_data)

NEWS.md

@@ -15,6 +15,7 @@
 
 ## New features
 
+* Creating default print.sr_model function for sr_model class (#114)
 * Made "newperson" optional in `prep_data()` (#73)
 * Including fitted and residual values as data frame in run_mod output. (#101)
 * Added  `plot_predicted_curve()` with support for faceting by multiple IDs (#68)

R/Run_Mod.R

@@ -209,4 +209,5 @@ run_mod <- function(data,
   jags_out <- jags_out |>
     structure(class = union("sr_model", class(jags_out)))
   jags_out
+
 }

R/print.sr_model.R

@@ -0,0 +1,50 @@
+#' @title Default print for [serodynamics::run_mod()] output object of class
+#' `sr_model`
+#' @description
+#' A default print method for class `sr_model` that prints posterior medians
+#' for antibody kinetic curve parameters by `Iso_type` and
+#' `Stratification` (if specified).
+#' @param x An `sr_model` output object from [run_mod()].
+#' @param print_tbl A [logical] indicator to print `x` in the style of a
+#'   [tibble::tbl_df].
+#' @param ... Additional arguments passed to the print method.
+#' @returns Invisibly returns either:
+#' \itemize{
+#'   \item when `print_tbl = TRUE`, a tibble containing the raw `sr_model`
+#'   draws;
+#'   \item otherwise, a data summary containing posterior medians for
+#'   antibody kinetic curve parameters by `Iso_type` and `Stratification`
+#'   (if specified).
+#' }
+#' @export
+#' @examples
+#' print(nepal_sees_jags_output)
+print.sr_model <- function(x, 
+                           print_tbl = FALSE,
+                           ...) { # nolint
+  if (print_tbl) {
+    x <- dplyr::as_tibble(x)
+    print(x)
+    invisible(x)
+  } else {
+    cat("An sr_model with the following median values:")
+    cat("\n")
+    cat("\n")
+    x <- suppressWarnings({
+      x |>
+        dplyr::filter(.data$Subject == "newperson") |>
+        dplyr::summarise(.by = c("Stratification", "Iso_type", "Parameter"),
+                         median_val = stats::median(.data$value)) |>
+        tidyr::pivot_wider(names_from = "Parameter",
+                           values_from = "median_val") |>
+        dplyr::arrange(.data$Iso_type)
+    })
+    # Taking out stratification column if not specified
+    if (!"Stratification" %in% names(x) || all(x$Stratification == "None", 
+                                               na.rm = TRUE)) {
+      x <- dplyr::select(x, -dplyr::any_of("Stratification"))
+    }
+    print(as.data.frame(x))
+    invisible(x)
+  } 
+}

inst/WORDLIST

@@ -39,6 +39,9 @@ mcmc
 mitre
 newperson
 nmc
+npl
+overfit
+otimes
 onwards
 params
 pkgdown
@@ -48,6 +51,7 @@ rhat
 seroconversion
 seroresponse
 seroresponses
+sr
 strat
 stratifications
 tbl

pkgdown/_pkgdown.yml

@@ -42,6 +42,7 @@ reference:
 - title: Summarize seroresponse model estimates
   contents:
   - post_summ
+  - print.sr_model
 - title: Example data sets
   contents:
   - serodynamics_example

tests/testthat/_snaps/darwin/print.sr_model.md

@@ -0,0 +1,11 @@
+# results consistent with printed output for sr_model as tbl no strat
+
+    Code
+      print(results)
+    Output
+      An sr_model with the following median values:
+
+        Iso_type      alpha    shape      t1      y0        y1
+      1 HlyE_IgA 0.01637070 1.352345 2.74673 2.68448  968.6465
+      2 HlyE_IgG 0.00938515 1.288250 2.97289 2.61949 1099.8900
+

tests/testthat/_snaps/print.sr_model.md

@@ -0,0 +1,44 @@
+# results are consistent with printed output for sr_model class
+
+    Code
+      nepal_sees_jags_output
+    Output
+      An sr_model with the following median values:
+
+        Stratification Iso_type       alpha    shape       t1       y0       y1
+      1          typhi HlyE_IgA 0.001508265 1.673340 6.358405 2.340330 258.1235
+      2      paratyphi HlyE_IgA 0.001556295 1.561960 3.903690 2.852925 191.8805
+      3          typhi HlyE_IgG 0.001393980 1.385280 6.019110 1.788035 243.9110
+      4      paratyphi HlyE_IgG 0.001432405 1.386685 4.726980 2.330555 272.8455
+
+# results are consistent with printed output for sr_model class as tbl
+
+    Code
+      print(nepal_sees_jags_output, print_tbl = TRUE)
+    Output
+      # A tibble: 70,000 x 7
+         Iteration Chain Parameter Iso_type Stratification Subject      value
+             <int> <int> <chr>     <chr>    <chr>          <chr>        <dbl>
+       1         1     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00757
+       2         2     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00794
+       3         3     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00794
+       4         4     1 alpha     HlyE_IgA typhi          sees_npl_1 0.0103 
+       5         5     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00925
+       6         6     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00925
+       7         7     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00950
+       8         8     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00950
+       9         9     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00852
+      10        10     1 alpha     HlyE_IgA typhi          sees_npl_1 0.00852
+      # i 69,990 more rows
+
+# results consistent with printed output for sr_model as tbl no strat
+
+    Code
+      print(results)
+    Output
+      An sr_model with the following median values:
+
+        Iso_type      alpha    shape       t1       y0       y1
+      1 HlyE_IgA 0.01718040 1.368230 2.755075 2.646905 1184.585
+      2 HlyE_IgG 0.01005685 1.293325 2.910905 2.641075  817.486
+

tests/testthat/test-print.sr_model.R

@@ -0,0 +1,36 @@
+test_that(
+  desc = "results are consistent with printed output for sr_model class",
+  code = {
+    testthat::expect_snapshot(nepal_sees_jags_output) 
+  }
+)
+
+test_that(
+  desc = "results are consistent with printed output for sr_model class as tbl",
+  code = {
+    testthat::expect_snapshot(print(nepal_sees_jags_output, print_tbl = TRUE)) 
+  }
+)
+
+test_that(
+  desc = "results consistent with printed output for sr_model as tbl no strat",
+  code = {
+    withr::local_seed(1)
+    dataset <- serodynamics::nepal_sees
+    results <- run_mod(
+      data = dataset, # The data set input
+      file_mod = serodynamics_example("model.jags"),
+      nchain = 2, # Number of mcmc chains to run
+      nadapt = 10, # Number of adaptations to run
+      nburn = 10, # Number of unrecorded samples before sampling begins
+      nmc = 100,
+      niter = 100 # Number of iterations
+    ) |>
+      suppressWarnings()
+
+    testthat::expect_snapshot(
+      print(results),
+      variant = darwin_variant()
+    )
+  }
+)