Bayesian adjustment of panel test error

devtools::load_all()
#> ℹ Loading testerror
#> ℹ Re-compiling testerror (debug build)
#> ── R CMD INSTALL ───────────────────────────────────────────────────────────────
#> * installing *source* package ‘testerror’ ...
#> ** this is package ‘testerror’ version ‘0.1.0’
#> ** using staged installation
#> * DONE (testerror)
library(tidyverse)
#> ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
#> ✔ dplyr     1.2.1     ✔ readr     2.2.0
#> ✔ forcats   1.0.1     ✔ stringr   1.6.0
#> ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
#> ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
#> ✔ purrr     1.2.2     
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ readr::edition_get()   masks testthat::edition_get()
#> ✖ dplyr::filter()        masks stats::filter()
#> ✖ dplyr::lag()           masks stats::lag()
#> ✖ readr::local_edition() masks testthat::local_edition()
#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(testerror)
options(mc.cores = 2) # parallel::detectCores())
rstan::rstan_options(auto_write = FALSE)
here::i_am("vignettes/testerror.Rmd")
#> here() starts at /tmp/RtmppeLXzz/Rbuild1a2667edf0f3/testerror
source(here::here("vignettes/formatting.R"))

BinaxNOW test results


binax_pos = 26
binax_n = 786

# Fit beta distributions to sinclair 2013 data:
# We apply a widening to increase uncertainty in sensitivity
binax_sens = beta_params(median = 0.740, lower = 0.666, upper = 0.823, widen = 5)
binax_spec = beta_params(median = 0.972, lower=  0.927, upper = 0.998)

tmp1 = testerror::bayesian_true_prevalence_model(
  pos_obs = binax_pos,
  n_obs = binax_n,
  sens = binax_sens,
  spec = binax_spec,
  model_type = "logit"
)
#> recompiling to avoid crashing R session
#> Warning: There were 5 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems
#> Warning: Tail Effective Samples Size (ESS) is too low, indicating posterior variances and tail quantiles may be unreliable.
#> Running the chains for more iterations may help. See
#> https://mc-stan.org/misc/warnings.html#tail-ess

binax_summ = tmp1$summary %>%
  dplyr::transmute(
  Test = "Binax",
  Positivity = sprintf("%d/%d (%1.2f%%)", binax_pos, binax_n, binax_pos/binax_n*100),
  `Estimated prevalence` = prevalence.label,
  `Sensitivity` = sens.label,
  `Specificity` = spec.label,
  `Method` = prevalence.method
  )

binax_summ %>% default_table()
TestPositivityEstimated prevalenceSensitivitySpecificityMethod
Binax26/786 (3.31%)0.29% [0.00% — 3.30%]74.73% [53.52% — 88.38%]97.15% [95.71% — 98.77%]bayes (logit)

UAD1 results

For this description we are going to assume we have only count data for panel and components, and we have limited information about component tests.


# data from Forstner et al (2019)
components = tibble::tibble(
  serotype = factor(c("1", "3", "4", "5", "6A", "6B", "7F", "9V", "14", "18C", "19A", "19F", "23F")),
  pos = c(2, 30, 2, 1, 4, 0, 7, 1, 1, 3, 2, 3, 4),
  n = 796
)

uad1_pos = 59
uad1_n = 796

# control group data
# negatives at 
uad1_spec = spec_prior() %>% 
  # data from Pride et al
  update_posterior(0,17)

# Datd from Pride et al
uad1_controls = tibble::tibble(
  serotype = factor(c("1", "3", "4", "5", "6A", "6B", "7F", "9V", "14", "18C", "19A", "19F", "23F")),
  false_neg_diseased = c(0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L),
  n_diseased = c(7, 1, 3, 1, 1, 0, 4, 2, 7, 0, 6, 0, 2),
  # In the design of UAD1 the cut off is calibrated on 400 negative samples and 
  # set to make 2 positive
  
  # Forstner et al (2019) control group
  # In the control group of 397 non-CAP patients, 1 patient had to
  # be excluded because of indeterminable results (0.3%, see Fig. 1)
  # and SSUAD was positive in 3 patients (0.8%). Of those 3 non-CAP
  # patients, 2 were positive for serotype 18C and 1 person for two
  # pneumococcal serotypes (5, 7F).

  false_pos_controls = 2+c(0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 2L, 0L, 0L, 0L),
  n_controls = 400+396
)


uad1_sens = sens_prior() %>% 
  # data from Pride et al
  update_posterior(17,17)

With this we can use a bayesian model to construct adjusted estimates


corr3 = testerror::bayesian_panel_true_prevalence_model(
  panel_pos_obs = uad1_pos,
  panel_n_obs = uad1_n,
  panel_name = "PCV13",
  
  pos_obs = components$pos,
  n_obs = components$n,
  test_names = components$serotype,
  
  false_pos_controls = uad1_controls$false_pos_controls,
  n_controls = uad1_controls$n_controls,
  false_neg_diseased = uad1_controls$false_neg_diseased,
  n_diseased = uad1_controls$n_diseased,
  
  panel_sens = uad1_sens,
  model_type = "logit"
)
#> recompiling to avoid crashing R session
corr3$summary %>% 
  mutate(
    pos_obs = c(components$pos, uad1_pos),
    n_obs = c(components$n, uad1_n)
  ) %>%
  dplyr::transmute(
  Test = test,
  Positivity = sprintf("%d/%d (%1.2f%%)", pos_obs, n_obs, pos_obs/n_obs*100),
  `Estimated prevalence` = prevalence.label,
  `Sensitivity` = sens.label,
  `Specificity` = spec.label,
  `Method` = prevalence.method
) %>% 
  bind_rows(binax_summ) %>%
  default_table() %>% huxtable::set_top_border(row = huxtable::final(2), col=huxtable::everywhere, value = 1)
TestPositivityEstimated prevalenceSensitivitySpecificityMethod
12/796 (0.25%)0.02% [0.00% — 0.41%]97.41% [77.19% — 99.91%]99.81% [99.50% — 99.97%]bayes (logit)
330/796 (3.77%)5.54% [3.02% — 21.82%]62.17% [15.47% — 96.18%]99.80% [99.34% — 99.98%]bayes (logit)
42/796 (0.25%)0.02% [0.00% — 0.45%]96.28% [62.22% — 99.90%]99.81% [99.50% — 99.96%]bayes (logit)
51/796 (0.13%)0.01% [0.00% — 0.31%]93.57% [34.76% — 99.85%]99.79% [99.49% — 99.94%]bayes (logit)
6A4/796 (0.50%)0.15% [0.00% — 1.06%]93.74% [31.86% — 99.89%]99.75% [99.40% — 99.96%]bayes (logit)
6B0/796 (0.00%)0.01% [0.00% — 0.33%]88.53% [7.76% — 99.83%]99.90% [99.67% — 99.99%]bayes (logit)
7F7/796 (0.88%)0.35% [0.00% — 1.26%]96.64% [66.62% — 99.92%]99.60% [99.12% — 99.91%]bayes (logit)
9V1/796 (0.13%)0.02% [0.00% — 0.33%]95.42% [51.29% — 99.90%]99.85% [99.59% — 99.97%]bayes (logit)
141/796 (0.13%)0.01% [0.00% — 0.29%]97.53% [78.32% — 99.91%]99.85% [99.59% — 99.97%]bayes (logit)
18C3/796 (0.38%)0.02% [0.00% — 0.62%]88.93% [9.57% — 99.83%]99.62% [99.24% — 99.86%]bayes (logit)
19A2/796 (0.25%)0.02% [0.00% — 0.42%]97.34% [75.22% — 99.92%]99.81% [99.49% — 99.96%]bayes (logit)
19F3/796 (0.38%)0.07% [0.00% — 1.09%]88.97% [9.82% — 99.84%]99.77% [99.42% — 99.96%]bayes (logit)
23F4/796 (0.50%)0.15% [0.00% — 0.91%]95.42% [48.02% — 99.91%]99.75% [99.38% — 99.96%]bayes (logit)
PCV1359/796 (7.41%)6.74% [4.24% — 21.45%]67.88% [22.48% — 94.51%]96.92% [95.88% — 97.78%]bayes (logit)
Binax26/786 (3.31%)0.29% [0.00% — 3.30%]74.73% [53.52% — 88.38%]97.15% [95.71% — 98.77%]bayes (logit)

Sensitivity analysis with different UAD test parameters


# senstivity / specificity from Kakiuchi et al 

kak_uad1_sens = beta_params(median = 0.741, lower = 0.537, upper = 0.889)
kak_uad1_spec = beta_params(median = 0.954, lower = 0.917, upper = 0.978) %>% 
  # data from Pride et al
  update_posterior(17,17)

corr4 = testerror::bayesian_panel_true_prevalence_model(
  panel_pos_obs = uad1_pos,
  panel_n_obs = uad1_n,
  panel_name = "PCV13",
  
  pos_obs = components$pos,
  n_obs = components$n,
  test_names = components$serotype,
  
  false_pos_controls = uad1_controls$false_pos_controls,
  n_controls = uad1_controls$n_controls,
  false_neg_diseased = uad1_controls$false_neg_diseased,
  n_diseased = uad1_controls$n_diseased,
  
  panel_sens = kak_uad1_sens,
  panel_spec = kak_uad1_spec,
  model_type="logit"
)
#> recompiling to avoid crashing R session
#> recompiling to avoid crashing R session
#>                 1.826 seconds (Total)
#> Chain 1:
#> Warning: There were 6 divergent transitions after warmup. See
#> https://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
#> to find out why this is a problem and how to eliminate them.
#> Warning: Examine the pairs() plot to diagnose sampling problems

corr4$summary %>% 
  mutate(
    pos_obs = c(components$pos, uad1_pos),
    n_obs = c(components$n, uad1_n)
  ) %>%
  dplyr::transmute(
  Test = test,
  Positivity = sprintf("%d/%d (%1.2f%%)", pos_obs, n_obs, pos_obs/n_obs*100),
  `Estimated prevalence` = prevalence.label,
  `Sensitivity` = sens.label,
  `Specificity` = spec.label,
  `Method` = prevalence.method
) %>% bind_rows(
  binax_summ
) %>% 
  default_table() %>% huxtable::set_top_border(row = huxtable::final(2), col=huxtable::everywhere, value = 1)
TestPositivityEstimated prevalenceSensitivitySpecificityMethod
12/796 (0.25%)0.02% [0.00% — 0.42%]97.50% [77.13% — 99.92%]99.80% [99.48% — 99.96%]bayes (logit)
330/796 (3.77%)5.00% [3.15% — 8.45%]66.82% [41.65% — 88.05%]99.77% [99.25% — 99.97%]bayes (logit)
42/796 (0.25%)0.02% [0.00% — 0.43%]96.06% [61.92% — 99.90%]99.80% [99.48% — 99.96%]bayes (logit)
51/796 (0.13%)0.01% [0.00% — 0.32%]93.61% [29.63% — 99.89%]99.78% [99.45% — 99.94%]bayes (logit)
6A4/796 (0.50%)0.14% [0.00% — 0.96%]93.61% [35.73% — 99.88%]99.74% [99.32% — 99.95%]bayes (logit)
6B0/796 (0.00%)0.01% [0.00% — 0.30%]88.47% [7.74% — 99.81%]99.90% [99.65% — 99.99%]bayes (logit)
7F7/796 (0.88%)0.29% [0.00% — 1.20%]96.63% [66.00% — 99.91%]99.57% [99.05% — 99.90%]bayes (logit)
9V1/796 (0.13%)0.02% [0.00% — 0.33%]95.00% [47.87% — 99.89%]99.85% [99.57% — 99.97%]bayes (logit)
141/796 (0.13%)0.01% [0.00% — 0.30%]97.58% [76.01% — 99.93%]99.85% [99.56% — 99.98%]bayes (logit)
18C3/796 (0.38%)0.02% [0.00% — 0.56%]88.73% [8.69% — 99.84%]99.59% [99.18% — 99.85%]bayes (logit)
19A2/796 (0.25%)0.02% [0.00% — 0.43%]97.26% [74.37% — 99.92%]99.80% [99.48% — 99.96%]bayes (logit)
19F3/796 (0.38%)0.07% [0.00% — 0.88%]89.67% [10.76% — 99.85%]99.76% [99.40% — 99.95%]bayes (logit)
23F4/796 (0.50%)0.12% [0.00% — 0.87%]94.80% [51.23% — 99.88%]99.73% [99.34% — 99.95%]bayes (logit)
PCV1359/796 (7.41%)6.01% [4.31% — 8.84%]71.73% [50.47% — 86.27%]96.67% [95.72% — 97.50%]bayes (logit)
Binax26/786 (3.31%)0.29% [0.00% — 3.30%]74.73% [53.52% — 88.38%]97.15% [95.71% — 98.77%]bayes (logit)