tests/testthat/test-bayes.R

context("Tests Bayesian regression code (rrreg.bayes)")

## Define design parameters
p <- 2/3  # probability of answering honestly in Forced Response Design
p1 <- 1/6 # probability of forced 'yes'
p0 <- 1/6 # probability of forced 'no'

set.seed(1)

## starting values constructed from MLE model
mle.estimates <- rrreg(rr.q1 ~ cov.asset.index + cov.married + 
                         I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female, 
                       data = nigeria, 
                       p = p, p1 = p1, p0 = p0,
                       design = "forced-known")

library(MASS)
draws <- mvrnorm(n = 3, mu = coef(mle.estimates), 
                 Sigma = vcov(mle.estimates) * 9)

test_that("basic code runs with all defaults", {  
  bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                         I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                       data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001, 
                       design = "forced-known")
  expect_is(bayes, "rrreg.bayes")
  expect_equal(ncol(bayes$beta), 7)
})

test_that("basic code runs varying the burnin / thin / n.draws options", {
  
  expect_is(
    bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001,
                         n.draws = 250, burnin = 100,
                         design = "forced-known"),
    "rrreg.bayes"
  )
  
  expect_is(
    bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001,
                         n.draws = 250, burnin = 100, thin = 10,
                         design = "forced-known"),
    "rrreg.bayes"
  )
  
})


test_that("basic code runs setting customized Metropolis options", {
  
  expect_is(
    bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001, 
                         beta.start = draws[1,],
                         n.draws = 500, burnin = 250, thin = 1,
                         design = "forced-known"),
    "rrreg.bayes"
  )
  
  expect_is(
    bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001, 
                         beta.start = draws[1,], beta.mu0 = rep(0, 7), 
                         beta.A0 = diag(7) * 1,
                         n.draws = 500, burnin = 250, thin = 1,
                         design = "forced-known"),
    "rrreg.bayes"
  )
  
  
})

test_that("standard functions coef, sd.rrreg.bayes, summary work", {
  
  bayes <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                         I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                       data = nigeria, p = p, p1 = p1, p0 = p0, beta.tune = .0001, 
                       n.draws = 500, burnin = 250, thin = 1,
                       design = "forced-known")
  
  expect_equal(
    length(coef(bayes)$beta), 7
  )
  expect_is(
    coef(bayes)$beta, "numeric"
  )
  expect_is(
    vcov(bayes), "matrix" 
  )
  expect_equal(
    length(sd.rrreg.bayes(bayes)$beta), 7
  )
  
  expect_output(
    print(bayes), "Randomized Response Technique Bayesian Regression"
  )
  
  expect_output(
    print(summary(bayes)), "Individual-level predictors"
  )
  
  expect_is(
    as.list(bayes), "rrreg.bayes.list"
    )
  
}) 

test_that("doing multiple chains works as well as coef, sd.rrreg.bayes, summary work", {
  
  bayes.1 <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0,
                         beta.tune = .0001, beta.start = draws[1,],
                         n.draws = 500, burnin = 250, thin = 1,
                         design = "forced-known")
  
  bayes.2 <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0,
                         beta.tune = .0001, beta.start = draws[2,],
                         n.draws = 500, burnin = 250, thin = 1,
                         design = "forced-known")
  
  bayes.3 <- rrreg.bayes(rr.q1 ~ cov.asset.index + cov.married + 
                           I(cov.age/10) + I((cov.age/10)^2) + cov.education + cov.female,   
                         data = nigeria, p = p, p1 = p1, p0 = p0,
                         beta.tune = .0001, beta.start = draws[3,],
                         n.draws = 500, burnin = 250, thin = 1,
                         design = "forced-known")
  
  bayes <- as.list(bayes.1, bayes.2, bayes.3)
  
  expect_is(bayes, "rrreg.bayes.list")
  
  expect_equal(
    length(coef(bayes)$beta), 7
  )
  expect_is(
    coef(bayes)$beta, "numeric"
  )
  expect_is(
    vcov(bayes), "matrix" 
  )
  expect_equal(
    length(sd.rrreg.bayes.list(bayes)$beta), 7
  )
  
  expect_output(
    print(bayes), "Randomized Response Technique Bayesian Regression"
  )
  
  summ <- summary(bayes)
  
  expect_output(
    print(summ), "Individual-level predictors"
  )
  
  expect_output(
    print(summ), "Gelman-Rubin statistics"
  )
  
}) 
SensitiveQuestions/rr documentation built on Feb. 1, 2024, 11:31 a.m.