diff --git a/DESCRIPTION b/DESCRIPTION index e17794e0b..bdd312fea 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: serodynamics Title: What the Package Does (One Line, Title Case) -Version: 0.0.0.9055 +Version: 0.0.0.9056 Authors@R: c( person("Peter", "Teunis", , "p.teunis@emory.edu", role = c("aut", "cph"), comment = "Author of the method and original code."), diff --git a/NAMESPACE b/NAMESPACE index 2db4d027e..85f628ac5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,7 @@ export(plot_jags_dens) export(plot_jags_effect) export(plot_jags_trace) export(plot_predicted_curve) +export(plot_serocurve) export(post_summ) export(postprocess_jags_output) export(prep_data) diff --git a/NEWS.md b/NEWS.md index 517344c2c..47b33d4e8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # serodynamics (development version) +* Added `plot_serocurve()` for graphical visualization of population-level + serodynamic curves using posterior samples of the `mu.par` hyperparameter + (or optionally the "newperson" subject). Supports 95% credible interval + ribbons, stratified curves with colour or faceting, and multiple + antigen-isotypes (#74). * Clarified Code Style Guidelines in `.github/copilot-instructions.md`: the UCD-SeRG Lab Manual takes precedence over the tidyverse style guide where they conflict, and functions should end with an explicit diff --git a/R/Run_Mod.R b/R/Run_Mod.R index 0d04b1520..67e6bd116 100644 --- a/R/Run_Mod.R +++ b/R/Run_Mod.R @@ -222,7 +222,7 @@ run_mod <- function(data, jags_out <- jags_out[, c("Iteration", "Chain", "Parameter", "Iso_type", "Stratification", "Subject", "value")] jags_out <- rebuild_sr_model_attributes(jags_out, mod_atts) - + # Adding population parameters optionally and priors in as attributes if (with_pop_params) { jags_out <- jags_out |> diff --git a/R/nepal_sees_jags_output.R b/R/nepal_sees_jags_output.R index eac82edaf..4f7a6926f 100644 --- a/R/nepal_sees_jags_output.R +++ b/R/nepal_sees_jags_output.R @@ -27,7 +27,11 @@ #' `sees_npl_2`} #' \item{value}{Estimated value of the parameter} #' \item{attributes}{A [list] of `attributes` that summarize the jags inputs, -#' priors, and optional jags_post mcmc object} +#' priors, optional jags_post mcmc object, and population-level parameters. +#' Includes a `population_params` attribute with posterior samples of the +#' population-level parameters (`mu.par`, `prec.par`, `prec.logy`), indexed +#' by `Iteration`, `Chain`, `Parameter`, `Iso_type`, `Stratification`, and +#' `Population_Parameter`.} #' } #' @source reference study: "nepal_sees_jags_output" diff --git a/R/plot_serocurve.R b/R/plot_serocurve.R new file mode 100644 index 000000000..a10e3ddbe --- /dev/null +++ b/R/plot_serocurve.R @@ -0,0 +1,319 @@ +#' @title Plot Estimated Serodynamic Curves at the Population Level +#' @description +#' Plots the estimated antibody response curve derived from posterior samples +#' of population-level (`mu.par`) or the predictive distribution from a fitted +#' [run_mod()] model. A median curve with an optional 95% credible interval +#' ribbon is produced for each requested antigen-isotype and stratification +#' combination. +#' +#' @param model An `sr_model` object returned by [run_mod()]. +#' @param antigen_iso A [character] vector of antigen-isotype combinations to +#' plot. Defaults to all antigen-isotypes present in the subject-level +#' draws of `model` (`model$Iso_type`); in normal usage these match the +#' levels available in `attr(model, "population_params")`. +#' @param strat A [character] vector of stratification levels to include. +#' Defaults to all stratification levels present in the subject-level +#' draws of `model` (`model$Stratification`); in normal usage these match +#' the levels available in `attr(model, "population_params")`. +#' @param param_source [character]; which posterior samples to use for the +#' curve. Options: +#' - `"population"` (default): uses population-level `mu.par` samples stored +#' in `attr(model, "population_params")`. Requires the model to have been +#' fitted with `run_mod(..., with_pop_params = TRUE)`. +#' - `"newperson"`: uses the predictive distribution for a new individual +#' drawn from the population-level prior. +#' @param show_ci [logical]; if [TRUE] (default), draws a 95% credible +#' interval ribbon around the median curve. +#' @param log_y [logical]; if [TRUE], applies a [log10] transformation to the +#' y-axis. Defaults to [FALSE]. +#' @param log_x [logical]; if [TRUE], applies a pseudo-log10 transformation to +#' the x-axis. Defaults to [FALSE]. +#' @param xlim (Optional) A numeric vector of length 2 giving custom x-axis +#' limits. +#' @param facet_by_antigen_iso [logical]; if [TRUE], facets the plot by +#' antigen-isotype. Defaults to [TRUE] when multiple antigen-isotypes are +#' requested. +#' @param facet_by_strat [logical]; if [TRUE], facets the plot by +#' stratification level. When [FALSE] (default), different stratification +#' levels are shown as different colours on the same panel. +#' @param ncol [integer]; number of columns when faceting. If [NULL] +#' (default), a sensible value is chosen automatically. +#' +#' @return A [ggplot2::ggplot] object. +#' @export +#' +#' @example inst/examples/examples-plot_serocurve.R +plot_serocurve <- function( + model, + antigen_iso = unique(model$Iso_type), + strat = unique(model$Stratification), + param_source = "population", + show_ci = TRUE, + log_y = FALSE, + log_x = FALSE, + xlim = NULL, + facet_by_antigen_iso = length(antigen_iso) > 1, + facet_by_strat = FALSE, + ncol = NULL) { + + param_source <- match.arg(param_source, c("population", "newperson")) + + antigen_iso_col <- "Iso_type" + + # ---- Retrieve posterior samples of curve parameters -------------------- + if (param_source == "population") { + pop_params <- attr(model, "population_params") + if (is.null(pop_params)) { + cli::cli_abort( + c( + "The {.arg model} object does not have a {.field population_params}", + " attribute.", + "i" = paste0( + "Re-fit the model with", + " {.code run_mod(..., with_pop_params = TRUE)}." + ) + ) + ) + } + # The population_params tibble has columns: + # Iteration, Chain, Parameter, Iso_type, Stratification, + # Population_Parameter, value + # Filter to mu.par rows only, then pivot wider and transform from log scale. + param_samples <- pop_params |> + dplyr::filter( + .data$Population_Parameter == "mu.par", + .data$Iso_type %in% .env$antigen_iso, + .data$Stratification %in% .env$strat + ) |> + dplyr::select( + all_of( + c("Chain", "Iteration", "Parameter", "Iso_type", "Stratification", + "value") + ) + ) |> + tidyr::pivot_wider( + names_from = "Parameter", + values_from = "value", + names_prefix = "log_" + ) |> + dplyr::mutate( + y0 = exp(.data$log_y0), + y1 = .data$y0 + exp(.data$log_y1), + t1 = exp(.data$log_t1), + alpha = exp(.data$log_alpha), + shape = exp(.data$log_shape) + 1 + ) |> + dplyr::select( + -dplyr::starts_with("log_") + ) |> + dplyr::mutate( + Iso_type = factor(.data$Iso_type), + Stratification = factor(.data$Stratification) + ) + } else { + # "newperson": predictive distribution for a new individual drawn from + # the population-level prior + newperson_rows <- model |> + dplyr::filter( + .data$Subject == "newperson", + .data$Iso_type %in% .env$antigen_iso, + .data$Stratification %in% .env$strat + ) + + if (nrow(newperson_rows) == 0) { + cli::cli_abort( + c( + paste0( + "No {.val newperson} subject found in {.arg model} for the ", + "requested {.arg antigen_iso}/{.arg strat}." + ), + "i" = paste0( + "Ensure the model was fit with a {.val newperson} subject ", + "included." + ) + ) + ) + } + + param_samples <- newperson_rows |> + dplyr::select( + all_of( + c("Chain", "Iteration", "Parameter", "Iso_type", "Stratification", + "value") + ) + ) |> + tidyr::pivot_wider( + names_from = "Parameter", + values_from = "value" + ) |> + dplyr::mutate( + Iso_type = factor(.data$Iso_type), + Stratification = factor(.data$Stratification) + ) + } + + # ---- Compute predicted curves over a grid of time points --------------- + # Clamp the grid to `xlim` when supplied to avoid unnecessary computation + # outside the visible range. + if (!is.null(xlim)) { + tx <- seq(xlim[1], xlim[2], by = 5) + } else { + tx <- seq(0, 1200, by = 5) + } + + serocourse_all <- param_samples |> + dplyr::reframe( + t = .env$tx, + res = ab(.data$t, .data$y0, .data$y1, .data$t1, .data$alpha, + .data$shape), + .by = all_of( + c("Chain", "Iteration", antigen_iso_col, "Stratification") + ) + ) + + # ---- Summarise to median + 95 % CI ------------------------------------- + curve_summary <- serocourse_all |> + dplyr::summarise( + .by = all_of(c(antigen_iso_col, "Stratification", "t")), + res_med = stats::quantile(.data$res, probs = 0.50, na.rm = TRUE), + res_low = stats::quantile(.data$res, probs = 0.025, na.rm = TRUE), + res_high = stats::quantile(.data$res, probs = 0.975, na.rm = TRUE) + ) + + # ---- Determine whether to colour by stratification --------------------- + n_strat <- length(unique(param_samples$Stratification)) + multi_strat <- n_strat > 1 && !facet_by_strat + + # ---- Build the ggplot -------------------------------------------------- + p <- ggplot2::ggplot() + + ggplot2::theme_minimal() + + ggplot2::labs(x = "Time since onset", y = "Assay result") + + ggplot2::theme(legend.position = "bottom") + + if (show_ci) { + if (multi_strat) { + p <- p + + ggplot2::geom_ribbon( + data = curve_summary, + ggplot2::aes( + x = .data$t, + ymin = .data$res_low, + ymax = .data$res_high, + fill = .data$Stratification + ), + alpha = 0.2, + inherit.aes = FALSE + ) + } else { + p <- p + + ggplot2::geom_ribbon( + data = curve_summary, + ggplot2::aes( + x = .data$t, + ymin = .data$res_low, + ymax = .data$res_high, + fill = "ci" + ), + alpha = 0.2, + inherit.aes = FALSE + ) + } + } + + # Median line + if (multi_strat) { + p <- p + + ggplot2::geom_line( + data = curve_summary, + ggplot2::aes( + x = .data$t, + y = .data$res_med, + colour = .data$Stratification + ), + linewidth = 1, + inherit.aes = FALSE + ) + } else { + p <- p + + ggplot2::geom_line( + data = curve_summary, + ggplot2::aes( + x = .data$t, + y = .data$res_med, + colour = "median" + ), + linewidth = 1, + inherit.aes = FALSE + ) + } + + # ---- Legend for single-stratification plots ---------------------------- + if (!multi_strat) { + color_vals <- c("median" = "red") + color_labels <- c("median" = "Median") + + p <- p + + ggplot2::scale_color_manual( + name = "", + values = color_vals, + labels = color_labels, + guide = ggplot2::guide_legend(override.aes = list(shape = NA)) + ) + + if (show_ci) { + fill_vals <- c("ci" = "red") + fill_labels <- c("ci" = "95% credible interval") + + p <- p + + ggplot2::scale_fill_manual( + name = "", + values = fill_vals, + labels = fill_labels, + guide = ggplot2::guide_legend(override.aes = list(color = NA)) + ) + } + } + + # ---- Faceting ---------------------------------------------------------- + facet_vars <- character(0) + if (facet_by_antigen_iso) facet_vars <- c(facet_vars, antigen_iso_col) + if (facet_by_strat) facet_vars <- c(facet_vars, "Stratification") + + if (length(facet_vars) > 0) { + facet_formula <- stats::as.formula( + paste("~", paste(facet_vars, collapse = " + ")) + ) + if (is.null(ncol)) { + n_panels <- length(unique(interaction( + curve_summary[[facet_vars[1]]], + if (length(facet_vars) > 1) curve_summary[[facet_vars[2]]] else NULL + ))) + ncol <- if (n_panels == 1) { + 1 + } else if (n_panels <= 4) { + 2 + } else { + NULL + } + } + p <- p + ggplot2::facet_wrap(facet_formula, ncol = ncol) + } + + # ---- Log scales -------------------------------------------------------- + if (log_y) { + p <- p + ggplot2::scale_y_log10() + } + if (log_x) { + p <- p + + ggplot2::scale_x_continuous( + trans = scales::pseudo_log_trans(sigma = 1, base = 10) + ) + } + + # ---- Custom x-axis limits ---------------------------------------------- + if (!is.null(xlim)) { + p <- p + ggplot2::coord_cartesian(xlim = xlim) + } + + return(p) +} diff --git a/R/use_att_names.R b/R/use_att_names.R index 02a40618c..6f6515421 100644 --- a/R/use_att_names.R +++ b/R/use_att_names.R @@ -2,7 +2,7 @@ #' @description #' `use_att_names` takes prepared longitudinal data for antibody kinetic #' modeling and names columns using attribute values to allow merging -#' with a modeled [run_mod()] output [tibble::tbl_df]. The column names include +#' with a modeled [run_mod] output [tibble::tbl_df]. The column names include #' `Subject`, `Iso_type`, `t`, and `result`. #' @param data A [data.frame] raw longitudinal data that has been #' prepared for antibody kinetic modeling using [as_case_data()]. diff --git a/data/nepal_sees_jags_output.rda b/data/nepal_sees_jags_output.rda index 25de55ea1..096ac65e8 100644 Binary files a/data/nepal_sees_jags_output.rda and b/data/nepal_sees_jags_output.rda differ diff --git a/inst/WORDLIST b/inst/WORDLIST index 95895593c..f4b9d4fe9 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -70,4 +70,6 @@ unstratified vh wishdf SeRG +Serodynamic UCD +serodynamic diff --git a/inst/examples/examples-plot_serocurve.R b/inst/examples/examples-plot_serocurve.R new file mode 100644 index 000000000..2825d3fdc --- /dev/null +++ b/inst/examples/examples-plot_serocurve.R @@ -0,0 +1,42 @@ +# nepal_sees_jags_output already includes population_params +model <- serodynamics::nepal_sees_jags_output + +# Population-level curve for a single antigen-isotype and stratum +p1 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + strat = "typhi" +) +print(p1) + +# Population-level curves for both stratifications, coloured by stratum +p2 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA" +) +print(p2) + +# Facet by stratification instead of colouring +p3 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + facet_by_strat = TRUE +) +print(p3) + +# Multiple antigen-isotypes, faceted, without CI +p4 <- plot_serocurve( + model = model, + antigen_iso = c("HlyE_IgA", "HlyE_IgG"), + facet_by_antigen_iso = TRUE, + show_ci = FALSE +) +print(p4) + +# Using the predictive distribution for a new individual (newperson posterior) +p5 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + param_source = "newperson" +) +print(p5) diff --git a/man/nepal_sees_jags_output.Rd b/man/nepal_sees_jags_output.Rd index 3c2f18582..4c9d4981d 100644 --- a/man/nepal_sees_jags_output.Rd +++ b/man/nepal_sees_jags_output.Rd @@ -24,7 +24,11 @@ Contains 40,000 \code{rows}, 7 \code{columns}, and model \code{attributes}. \code{sees_npl_2}} \item{value}{Estimated value of the parameter} \item{attributes}{A \link{list} of \code{attributes} that summarize the jags inputs, -priors, and optional jags_post mcmc object} +priors, optional jags_post mcmc object, and population-level parameters. +Includes a \code{population_params} attribute with posterior samples of the +population-level parameters (\code{mu.par}, \code{prec.par}, \code{prec.logy}), indexed +by \code{Iteration}, \code{Chain}, \code{Parameter}, \code{Iso_type}, \code{Stratification}, and +\code{Population_Parameter}.} } } \source{ diff --git a/man/plot_serocurve.Rd b/man/plot_serocurve.Rd new file mode 100644 index 000000000..53b53a210 --- /dev/null +++ b/man/plot_serocurve.Rd @@ -0,0 +1,120 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_serocurve.R +\name{plot_serocurve} +\alias{plot_serocurve} +\title{Plot Estimated Serodynamic Curves at the Population Level} +\usage{ +plot_serocurve( + model, + antigen_iso = unique(model$Iso_type), + strat = unique(model$Stratification), + param_source = "population", + show_ci = TRUE, + log_y = FALSE, + log_x = FALSE, + xlim = NULL, + facet_by_antigen_iso = length(antigen_iso) > 1, + facet_by_strat = FALSE, + ncol = NULL +) +} +\arguments{ +\item{model}{An \code{sr_model} object returned by \code{\link[=run_mod]{run_mod()}}.} + +\item{antigen_iso}{A \link{character} vector of antigen-isotype combinations to +plot. Defaults to all antigen-isotypes present in the subject-level +draws of \code{model} (\code{model$Iso_type}); in normal usage these match the +levels available in \code{attr(model, "population_params")}.} + +\item{strat}{A \link{character} vector of stratification levels to include. +Defaults to all stratification levels present in the subject-level +draws of \code{model} (\code{model$Stratification}); in normal usage these match +the levels available in \code{attr(model, "population_params")}.} + +\item{param_source}{\link{character}; which posterior samples to use for the +curve. Options: +\itemize{ +\item \code{"population"} (default): uses population-level \code{mu.par} samples stored +in \code{attr(model, "population_params")}. Requires the model to have been +fitted with \code{run_mod(..., with_pop_params = TRUE)}. +\item \code{"newperson"}: uses the predictive distribution for a new individual +drawn from the population-level prior. +}} + +\item{show_ci}{\link{logical}; if \link{TRUE} (default), draws a 95\% credible +interval ribbon around the median curve.} + +\item{log_y}{\link{logical}; if \link{TRUE}, applies a \link{log10} transformation to the +y-axis. Defaults to \link{FALSE}.} + +\item{log_x}{\link{logical}; if \link{TRUE}, applies a pseudo-log10 transformation to +the x-axis. Defaults to \link{FALSE}.} + +\item{xlim}{(Optional) A numeric vector of length 2 giving custom x-axis +limits.} + +\item{facet_by_antigen_iso}{\link{logical}; if \link{TRUE}, facets the plot by +antigen-isotype. Defaults to \link{TRUE} when multiple antigen-isotypes are +requested.} + +\item{facet_by_strat}{\link{logical}; if \link{TRUE}, facets the plot by +stratification level. When \link{FALSE} (default), different stratification +levels are shown as different colours on the same panel.} + +\item{ncol}{\link{integer}; number of columns when faceting. If \link{NULL} +(default), a sensible value is chosen automatically.} +} +\value{ +A \link[ggplot2:ggplot]{ggplot2::ggplot} object. +} +\description{ +Plots the estimated antibody response curve derived from posterior samples +of population-level (\code{mu.par}) or the predictive distribution from a fitted +\code{\link[=run_mod]{run_mod()}} model. A median curve with an optional 95\% credible interval +ribbon is produced for each requested antigen-isotype and stratification +combination. +} +\examples{ +# nepal_sees_jags_output already includes population_params +model <- serodynamics::nepal_sees_jags_output + +# Population-level curve for a single antigen-isotype and stratum +p1 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + strat = "typhi" +) +print(p1) + +# Population-level curves for both stratifications, coloured by stratum +p2 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA" +) +print(p2) + +# Facet by stratification instead of colouring +p3 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + facet_by_strat = TRUE +) +print(p3) + +# Multiple antigen-isotypes, faceted, without CI +p4 <- plot_serocurve( + model = model, + antigen_iso = c("HlyE_IgA", "HlyE_IgG"), + facet_by_antigen_iso = TRUE, + show_ci = FALSE +) +print(p4) + +# Using the predictive distribution for a new individual (newperson posterior) +p5 <- plot_serocurve( + model = model, + antigen_iso = "HlyE_IgA", + param_source = "newperson" +) +print(p5) +} diff --git a/man/use_att_names.Rd b/man/use_att_names.Rd index 95db5a471..03a87619c 100644 --- a/man/use_att_names.Rd +++ b/man/use_att_names.Rd @@ -16,7 +16,7 @@ The input \link{data.frame} with columns named after attributes. \description{ \code{use_att_names} takes prepared longitudinal data for antibody kinetic modeling and names columns using attribute values to allow merging -with a modeled \code{\link[=run_mod]{run_mod()}} output \link[tibble:tbl_df]{tibble::tbl_df}. The column names include +with a modeled \link{run_mod} output \link[tibble:tbl_df]{tibble::tbl_df}. The column names include \code{Subject}, \code{Iso_type}, \code{t}, and \code{result}. } \keyword{internal} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 61c982025..b56b3bdb5 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -35,7 +35,10 @@ reference: - plot_jags_Rhat - plot_jags_trace - plot_jags_effect +- title: Visualize model results + contents: - plot_predicted_curve + - plot_serocurve - title: Postprocess JAGS output contents: - postprocess_jags_output diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-newperson-single-strat.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-newperson-single-strat.svg new file mode 100644 index 000000000..7ccd15f13 --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-newperson-single-strat.svg @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +500 +1000 +1500 +2000 +2500 +0 +250 +500 +750 +1000 +1250 +Time since onset +Assay result + +Median + +95% credible interval +serocurve-newperson-single-strat + + diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-antigen-iso.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-antigen-iso.svg new file mode 100644 index 000000000..67768dc67 --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-antigen-iso.svg @@ -0,0 +1,139 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +HlyE_IgA + + + + + + + + + +HlyE_IgG + + +0 +250 +500 +750 +1000 +1250 +0 +250 +500 +750 +1000 +1250 +0 +200 +400 +600 +Time since onset +Assay result +Stratification + + + + +paratyphi +typhi +serocurve-population-facet-antigen-iso + + diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-strat.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-strat.svg new file mode 100644 index 000000000..5ad5b357f --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-population-facet-strat.svg @@ -0,0 +1,128 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +paratyphi + + + + + + + + + +typhi + + +0 +250 +500 +750 +1000 +1250 +0 +250 +500 +750 +1000 +1250 +0 +200 +400 +600 +Time since onset +Assay result + +Median + +95% credible interval +serocurve-population-facet-strat + + diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-population-multi-strat.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-population-multi-strat.svg new file mode 100644 index 000000000..c5782519c --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-population-multi-strat.svg @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +200 +400 +600 +0 +250 +500 +750 +1000 +1250 +Time since onset +Assay result +Stratification + + + + +paratyphi +typhi +serocurve-population-multi-strat + + diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-population-no-ci.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-population-no-ci.svg new file mode 100644 index 000000000..193d852f9 --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-population-no-ci.svg @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +50 +100 +150 +200 +0 +250 +500 +750 +1000 +1250 +Time since onset +Assay result + +Median +serocurve-population-no-ci + + diff --git a/tests/testthat/_snaps/plot_serocurve/serocurve-population-single-strat.svg b/tests/testthat/_snaps/plot_serocurve/serocurve-population-single-strat.svg new file mode 100644 index 000000000..241b598d5 --- /dev/null +++ b/tests/testthat/_snaps/plot_serocurve/serocurve-population-single-strat.svg @@ -0,0 +1,71 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +200 +400 +600 +0 +250 +500 +750 +1000 +1250 +Time since onset +Assay result + +Median + +95% credible interval +serocurve-population-single-strat + + diff --git a/tests/testthat/test-plot_serocurve.R b/tests/testthat/test-plot_serocurve.R new file mode 100644 index 000000000..ad57c0e87 --- /dev/null +++ b/tests/testthat/test-plot_serocurve.R @@ -0,0 +1,80 @@ +test_that( + desc = "plot_serocurve() works with population param_source (default)", + code = { + skip_if(getRversion() < "4.4.1") + + sr_model <- serodynamics::nepal_sees_jags_output + + # Single antigen-iso, single stratum + p1 <- plot_serocurve( + model = sr_model, + antigen_iso = "HlyE_IgA", + strat = "typhi" + ) + vdiffr::expect_doppelganger("serocurve-population-single-strat", p1) + + # Multiple strata coloured (default) + p2 <- plot_serocurve( + model = sr_model, + antigen_iso = "HlyE_IgA" + ) + vdiffr::expect_doppelganger("serocurve-population-multi-strat", p2) + + # Faceted by stratification + p3 <- plot_serocurve( + model = sr_model, + antigen_iso = "HlyE_IgA", + facet_by_strat = TRUE + ) + vdiffr::expect_doppelganger("serocurve-population-facet-strat", p3) + + # Multiple antigen-isotypes, faceted + p4 <- plot_serocurve( + model = sr_model, + antigen_iso = c("HlyE_IgA", "HlyE_IgG"), + facet_by_antigen_iso = TRUE + ) + vdiffr::expect_doppelganger("serocurve-population-facet-antigen-iso", p4) + + # Without CI + p5 <- plot_serocurve( + model = sr_model, + antigen_iso = "HlyE_IgA", + strat = "typhi", + show_ci = FALSE + ) + vdiffr::expect_doppelganger("serocurve-population-no-ci", p5) + } +) + +test_that( + desc = "plot_serocurve() works with newperson param_source", + code = { + skip_if(getRversion() < "4.4.1") + + sr_model <- serodynamics::nepal_sees_jags_output + + p6 <- plot_serocurve( + model = sr_model, + antigen_iso = "HlyE_IgA", + strat = "typhi", + param_source = "newperson" + ) + vdiffr::expect_doppelganger("serocurve-newperson-single-strat", p6) + } +) + +test_that( + desc = "plot_serocurve() errors when population_params attribute is missing", + code = { + # Strip the population_params attribute to simulate an old sr_model object + sr_model_old <- serodynamics::nepal_sees_jags_output + attr(sr_model_old, "population_params") <- NULL + + expect_error( + plot_serocurve(sr_model_old, antigen_iso = "HlyE_IgA", + param_source = "population"), + regexp = "population_params" + ) + } +) diff --git a/tests/testthat/test-run_mod.R b/tests/testthat/test-run_mod.R index ffee63beb..932c42002 100644 --- a/tests/testthat/test-run_mod.R +++ b/tests/testthat/test-run_mod.R @@ -64,7 +64,6 @@ test_that( expect_snapshot_data("popparam-summary-stats", variant = darwin_variant() ) - pop_params <- attributes(results)$population_params expect_s3_class(pop_params, "data.frame") expect_true(all(c("Population_Parameter", "value") %in% names(pop_params))) @@ -117,9 +116,7 @@ test_that( "strat-fitted_residuals", variant = darwin_variant() ) - expect_null(attr(results, "population_params")) - } ) @@ -254,6 +251,5 @@ test_that( expect_type(jags_post, "list") expect_true("None" %in% names(jags_post)) expect_s3_class(jags_post$None$mcmc, "mcmc.list") - } )