tests/testthat/test-variant_funs.R

In EMC2: Bayesian Hierarchical Analysis of Cognitive Models of Choice

# When working with lM it is useful to design  an "average and difference"
# contrast matrix, which for binary responses has a simple canonical from:
ADmat <- matrix(c(-1/2,1/2),ncol=1,dimnames=list(NULL,"d"))
# We also define a match function for lM
matchfun=function(d)d$S==d$lR

# Drop most subjects
dat <- forstmann[forstmann$subjects %in% unique(forstmann$subjects)[1:2],]
dat$subjects <- droplevels(dat$subjects)

design_LNR <- design(data = dat,model=LNR,matchfun=matchfun,
                          formula=list(m~lM,s~1,t0~1),
                          contrasts=list(m=list(lM=ADmat)))



# Set seed for mclapply
RNGkind("L'Ecuyer-CMRG")
set.seed(123)
# Run the models for the different variants
# Only preburn, so bit risky since adapt could fail
N <- 25
idx <- N + 1

test_that("run_diag", {
  skip_on_os("windows")

  LNR_diag <- make_emc(dat, design_LNR, rt_resolution = 0.05, n_chains = 2, type = "diagonal")
  LNR_diag <- init_chains(LNR_diag, cores_for_chains = 1, particles = 5)
  LNR_diag <- run_emc(LNR_diag, cores_for_chains = 1, stop_criteria = list(iter = N), stage = "preburn", particle_factor = 10)


  expect_snapshot(
    LNR_diag[[1]]$samples$alpha[,,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    LNR_diag[[1]]$samples$theta_mu[,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    LNR_diag[[1]]$samples$theta_var[,,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    compare(list(diag = LNR_diag),
            stage = "preburn", cores_for_props = 1),
    variant = Sys.info()[1]
  )
})

test_that("run_blocked", {
  skip_on_os("windows")

  LNR_blocked <- make_emc(dat, design_LNR, rt_resolution = 0.05, n_chains = 2, type = "blocked",
                          par_group = c(1,2,3,3))
  LNR_blocked <- init_chains(LNR_blocked, cores_for_chains = 1, particles = 5)
  LNR_blocked <- run_emc(LNR_blocked, cores_for_chains = 1, stop_criteria = list(iter = N), stage = "preburn", particle_factor = 10)

  expect_snapshot(
    LNR_blocked[[1]]$samples$alpha[,,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    LNR_blocked[[1]]$samples$theta_mu[,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    LNR_blocked[[1]]$samples$theta_var[,,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    compare(list(blocked = LNR_blocked),
            stage = "preburn", cores_for_props = 1),
    variant = Sys.info()[1]
  )
})

test_that("run_single", {
  skip_on_os("windows")

  LNR_single <- make_emc(dat, design_LNR, rt_resolution = 0.05, n_chains = 2, type = "single")
  LNR_single <- init_chains(LNR_single, cores_for_chains = 1, particles = 5)
  LNR_single <- run_emc(LNR_single, cores_for_chains = 1, stop_criteria = list(iter = N), stage = "preburn", particle_factor = 10)

  expect_snapshot(
    LNR_single[[1]]$samples$alpha[,,idx], variant = Sys.info()[1]
  )
  expect_snapshot(
    compare(list(single = LNR_single),
            stage = "preburn", cores_for_props = 1),
    variant = Sys.info()[1]
  )
})