tests/testthat/testCEA.R

In idefix: Efficient Designs for Discrete Choice Experiments

context("Tests for CEA")
test_that("Errors for creating initial design in CEA function", {
  ## Categorical attributes
  # Misspecification of coding type
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "B")), 
               "coding argument is incorrect.")
  # Less coding types than attributes
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D")), 
               "coding argument is incorrect.")
  # One attribute only
  expect_error(CEA(lvls = c(3), coding = c("D")), "lvls argument is incorrect.")
  # Non-numeric number of levels of an attribute
  expect_error(CEA(lvls = c(3, 3, "d"), coding = c("D", "D", "D")), 
               "lvls argument is incorrect.")
  # Incorrect type of coding
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "f")), 
               "coding argument is incorrect.")
  
  ## Continuous attributes
  # Continuous levels missing
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("C", "C", "C")), 
               "when 'coding' contains C, 'c.lvls' should be specified")
  # Less number of continuous levels than attributes
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("C", "C", "C"), 
      c.lvls = list(c(4, 6, 8), c(2, 4,6))), 
      "length of 'c.lvls' does not match number of specified continuous attributes in 'coding")
  # Misspecification in "c.lvls" according to the number of levels in "lvls"
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("C", "C", "C"), 
                   c.lvls = list(c(4, 6), c(2, 4, 6), c(5, 6, 7))), 
               "the number of levels provided in 'c.lvls' does not match the expected based on 'lvls'")
  
  ## Design specifications
  # More alternative constants than alternatives in a choice set
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, par.draws = c(0, 0, 0, 0, 0, 0), 
                   alt.cte = c(1, 0, 0)), 
                   "'n.alts' does not match the 'alt.cte' vector")
  # An alternative constant equals to 2
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, par.draws = c(0, 0, 0, 0, 0, 0), 
                   alt.cte = c(2, 0)), 
               "'alt.cte' should only contain zero or ones.")
  # No boolean value in nochoice parameter
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = c(0, 0, 0, 0, 0, 0), no.choice = T), 
               "if 'no.choice' is TRUE, the last alternative constant should equal 1.")
  # 1 alternative constant and not a list in the draws
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = c(0, 0, 0, 0, 0, 0), no.choice = F), 
  "par.draws should be a list")
  # 1 alternative constant and draws in a list, but a single component
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = list(c(0, 0, 0, 0, 0, 0, 0)), no.choice = F), 
  "'par.draws' should contain two components")
  # 1 alternative constant and draws for the attributes are not in a matrix
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = list(0, c(0, 0, 0, 0, 0, 0)), no.choice = F), 
  "'par.draws' should contain two matrices")
  # Different number of draws for the alternative constant and betas
  # Note: There should be the same number of draws for both components
  # All these values are random
  mu <- c(0.5, 0.8, 0.2, -0.3, -1.2, 1.6, 2.2) 
  v <- diag(length(mu)) # Prior variance.
  set.seed(123) 
  pd <- MASS::mvrnorm(n = 2, mu = mu, Sigma = v) # 10 draws.
  p.d <- list(matrix(pd[,1], ncol = 2), pd[,2:7])
  p.d[[1]] <- p.d[[1]][,-2] # Remove a draw for the constant
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = p.d, no.choice = F), 
  "the number of rows in the components of 'par.draws' should be equal")
  # 2 alternative constants and not a list in the draws
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 3, alt.cte = c(1, 1, 0), 
                   par.draws = c(0, 0, 0, 0, 0, 0, 0, 0), no.choice = F), 
               "par.draws should be a list")
  # 2 alternative constants and draws in a list, but a single component
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 3, alt.cte = c(1, 1, 0), 
                   par.draws = list(c(0, 0, 0, 0, 0, 0, 0, 0)), no.choice = F),
               "'par.draws' should contain two components")
  # 2 alternative constants and draws for the attributes are not in a matrix
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 3, alt.cte = c(1, 1, 0), 
                   par.draws = list(c(0, 0), c(0, 0, 0, 0, 0, 0)), 
                   no.choice = F), 
               "'par.draws' should contain two matrices")
  # 2 alternative constants and draws for only one of them
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 3, alt.cte = c(1, 1, 0), 
                   par.draws = list(as.matrix(c(0)), 
                                    as.matrix(c(0, 0, 0, 0, 0, 0))), 
                   no.choice = F), 
"the first component of 'par.draws' should contain the same number of columns as there are non zero elements in 'alt.cte'")
  # Different number of draws for the alternative constants and betas
  # Note: There should be the same number of draws for both components
  # All these values are random
  mu <- c(0.5, 0.5, 0.8, 0.2, -0.3, -1.2, 1.6, 2.2) 
  v <- diag(length(mu)) # Prior variance.
  set.seed(123) 
  pd <- MASS::mvrnorm(n = 3, mu = mu, Sigma = v) # 10 draws.
  p.d <- list(matrix(pd[,1:2], ncol = 2), pd[,3:8])
  p.d[[1]] <- p.d[[1]][-2,] # Remove a draw for the constant
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 8,
                   n.alts = 3, alt.cte = c(1, 1, 0), 
                   par.draws = p.d, no.choice = F), 
               "the number of rows in the components of 'par.draws' should be equal")
  # Number of choice sets is smaller than parameters to estimate
  mu <- c(0.5, 0.8, 0.2, -0.3, -1.2, 1.6, 2.2) 
  v <- diag(length(mu)) # Prior variance.
  set.seed(123) 
  pd <- MASS::mvrnorm(n = 3, mu = mu, Sigma = v) # 10 draws.
  p.d <- list(matrix(pd[,1], ncol = 1), pd[,2:7])
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 6,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = p.d, no.choice = F),  
  "Model is unidentified. Increase the number of choice sets or decrease parameters to estimate.")
  # Number of columns of par.draws has to be the same as number of parameters
  # in the model
  mu <- c(0.5, 0.8, 0.2, -0.3, -1.2, 1.6, 2.2) 
  v <- diag(length(mu)) # Prior variance.
  set.seed(123) 
  pd <- MASS::mvrnorm(n = 3, mu = mu, Sigma = v) # 10 draws.
  p.d <- list(matrix(pd[,1], ncol = 1), pd[,2:6])
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), n.sets = 6,
                   n.alts = 2, alt.cte = c(1, 0), 
                   par.draws = p.d, no.choice = F),  
               "The sum of the number of columns in the components of 'par.draws' should equal the number of columns of design matrix \\(including alternative specific constants\\)")
  # When initial designs are given, should be in a list
  mu <- c(1.2, 1, 0.8, 0.2, -0.3, -1.2, 1.6, 2.2) # Prior parameter vector
  v <- diag(length(mu)) # Prior variance.
  set.seed(123) 
  pd <- MASS::mvrnorm(n = 3, mu = mu, Sigma = v) # 10 draws.
  p.d <- list(matrix(pd[,1:2], ncol = 2), pd[,3:8])
  initial <- matrix(c(1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 
                      0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
                      1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 0, 
                      0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 
                      1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 
                      0, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
                      1, 0, 0, 1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 
                      0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
                      1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 
                      0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 
                      1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 
                      0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 1, 
                      0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0), 
                    36,8,byrow = T)
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), 
                   par.draws = p.d, n.alts = 3, n.sets = 12, parallel = F, 
                   alt.cte = c(1, 0, 1), no.choice = T,
                   start.des = initial), "'start.des' should be a list")
  # All initial designs should be matrices
  initial_v <- list(initial, as.vector(initial))
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), 
                   par.draws = p.d, n.alts = 3, n.sets = 12, parallel = F, 
                   alt.cte = c(1, 0, 1), no.choice = T,start.des = initial_v),
               "'start.des' should contain matrices as components")
  # All initial designs should have the same dimensions
  initial_d <- list(initial, initial[-(1:3),])
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), 
                   par.draws = p.d, n.alts = 3, n.sets = 12, parallel = F, 
                   alt.cte = c(1, 0, 1), no.choice = T, start.des = initial_d),
               "start designs have different dimensions")
  # The number of rows of the initial design should be the same as the number
  # of alternatives per (times) choice set (n.alts*n.sets)
  initial_r <- list(initial[-(1:3),])
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), 
                   par.draws = p.d, n.alts = 3, n.sets = 12, parallel = F, 
                   alt.cte = c(1, 0, 1), no.choice = T, start.des = initial_r),
               "number of rows of start design\\(s\\) does not match with 'n.alts' \\* 'n.sets'")
  # The number of columns of the initial design should be the same as the number
  # of parameter in the model
  initial_c <- list(initial[,-1])
  expect_error(CEA(lvls = c(3, 3, 3), coding = c("D", "D", "D"), 
                   par.draws = p.d, n.alts = 3, n.sets = 12, parallel = F, 
                   alt.cte = c(1, 0, 1), no.choice = T, start.des = initial_c),
  "number of columns of start design\\(s\\) does not match with the number of columns in the design matrix")
})