tests/testthat/test-posterior.R

In yodel: A General Bayesian Model Averaging Helper

test_that("posterior", {
  # functions which caclulate the dose response for a linear and quadratic model
  fun_linear <- function(x, dose) {
    mean_response <- x$b1 + x$b2 * dose
    data.frame(iter = seq_len(nrow(x)), dose = dose, mean = mean_response)
  }

  fun_quad <- function(x, dose) {
    x <- as.data.frame(do.call("rbind", x))
    mean_response <- x$b1 + x$b2 * dose + x$b3 * dose ^ 2
    data.frame(iter = seq_len(nrow(x)), dose = dose, mean = mean_response)
  }

  b1 <- 1:5
  b2 <- 11:15
  sigma <- seq(.1, .5, .1)

  b1_quad <- 1:5 / 2
  b2_quad <- 11:15 / 2
  b3_quad <- 5:1
  sigma_quad <- seq(.1, .5, .1)

  mcmc_quad <- data.frame(
    b1 = b1_quad,
    b2 = b2_quad,
    b3 = b3_quad,
    sigma = sigma_quad
  )
  mcmc_quad <- list(
    as.matrix(mcmc_quad[1:3, ]),
    as.matrix(mcmc_quad[4:5, ])
  )
  class(mcmc_quad) <- "mcmc.list"

  fit <- bma(
    linear = model_bma_predictive(
      mcmc = data.frame(b1, b2, sigma),
      log_post_pred = matrix(log(1:100), 5, 20),
      adjustment = - 3 / 2,
      w_prior = .5,
      fun = fun_linear
    ),
    quad = model_bma_predictive(
      mcmc = mcmc_quad,
      log_post_pred = matrix(log(2:101), 5, 20),
      adjustment = - 4 / 2,
      w_prior = .5,
      fun = fun_quad
    ),
    seed = 5L
  )

  dose <- 2
  tab <- posterior(fit, dose = dose)
  ind <- tab$model == "linear"
  tab <- tab %>%
    dplyr::mutate(
      true_vals = c(
        !!b1[ind] + !!b2[ind] * !!dose,
        !!b1_quad[!ind] +
          !!b2_quad[!ind] * !!dose +
            !!b3_quad[!ind] * !!dose ^ 2
      )[c(3, 1, 2, 4, 5)]
    )
  expect_equal(tab$mean, tab$true_vals)

  expect_equal(
    posterior(fit, dose = dose),
    posterior(fit, dose = dose)
  )
})