tests/testthat/test-choice_parameters.R

In choicedata: Working with Choice Data

test_that("input checks for choice parameters work", {
  expect_error(
    choice_parameters(beta = "not_a_numeric"),
    "Input `beta` is bad: Must be of type 'numeric', not 'character'"
  )
  expect_error(
    choice_parameters(Omega = "not_a_numeric"),
    "Input `Omega` is bad: Must be of type 'numeric', not 'character'"
  )
  expect_error(
    choice_parameters(Sigma = "not_a_numeric"),
    "Input `Sigma` is bad: Must be of type 'numeric', not 'character'"
  )
  expect_error(
    choice_parameters(gamma = "not_a_numeric"),
    "Input `gamma` is bad: Must be of type 'numeric', not 'character'"
  )
})

test_that("choice parameter can be created", {
  x <- choice_parameters()
  expect_true(is.choice_parameters(x))
  expect_s3_class(x, "choice_parameters")
})

test_that("choice parameters can be generated", {
  choice_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | 0 + B,
      random_effects = c("B" = "cn")
    ),
    choice_alternatives = choice_alternatives(J = 3)
  )
  set.seed(1)
  x <- generate_choice_parameters(choice_effects)
  expect_s3_class(x, "choice_parameters")

  ordered_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | 0
    ),
    choice_alternatives = choice_alternatives(J = 3, ordered = TRUE)
  )

  y <- generate_choice_parameters(ordered_effects)
  expect_s3_class(y, "choice_parameters")
  expect_length(y$gamma, 2L)
  expect_true(is.numeric(y$Sigma))
})

test_that("choice parameter can be validated", {
  choice_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | 0 + B,
      random_effects = c("B" = "cn")
    ),
    choice_alternatives = choice_alternatives(J = 3)
  )
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(),
      choice_effects = choice_effects
    ),
    "Parameter `beta` is required"
  )
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1:3),
      choice_effects = choice_effects
    ),
    "Parameter `Omega` is required"
  )
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1:3, Omega = diag(2)),
      choice_effects = choice_effects
    ),
    "Parameter `Sigma` is required"
  )

  ordered_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | 0
    ),
    choice_alternatives = choice_alternatives(J = 3, ordered = TRUE)
  )
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1),
      choice_effects = ordered_effects
    ),
    "Parameter `Sigma` is required"
  )
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1, Sigma = 1),
      choice_effects = ordered_effects
    ),
    "Parameter `gamma` is required"
  )
  expect_true(is.choice_parameters(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1, Sigma = 1, gamma = c(0, 1)),
      choice_effects = ordered_effects
    )
  ))
  expect_error(
    validate_choice_parameters(
      choice_parameters = choice_parameters(beta = 1, Sigma = 1, gamma = c(0, 0.5, 0.5)),
      choice_effects = ordered_effects
    ),
    "strictly increasing"
  )
})

test_that("not required choice parameters are set to NULL", {
  choice_effects_no_covariates <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ 0 | 0
    ),
    choice_alternatives = choice_alternatives(J = 3)
  )
  expect_true(is.choice_parameters(
    validate_choice_parameters(
      choice_parameters = choice_parameters(Sigma = diag(3)),
      choice_effects = choice_effects_no_covariates
    )
  ))
})

test_that("choice parameters can be transformed between interpretation and optimization space", {

  ### MNP model
  J <- 3
  choice_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | B
    ),
    choice_alternatives = choice_alternatives(J = J)
  )
  choice_parameters <- generate_choice_parameters(
    choice_effects = choice_effects,
    fixed_parameters = choice_parameters(
      Sigma = diag(c(0, rep(1, J - 1))) # scale and level normalization
    )
  )
  o_space <- switch_parameter_space(choice_parameters, choice_effects)
  i_space <- switch_parameter_space(o_space, choice_effects)
  expect_identical(
    choice_parameters, i_space
  )

  ### MMNP model
  J <- 3
  choice_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | B,
      random_effects = c("A" = "cn")
    ),
    choice_alternatives = choice_alternatives(J = J)
  )
  choice_parameters <- generate_choice_parameters(
    choice_effects = choice_effects,
    fixed_parameters = choice_parameters(
      Sigma = diag(c(0, rep(1, J - 1))) # scale and level normalization
    )
  )
  o_space <- switch_parameter_space(choice_parameters, choice_effects)
  i_space <- switch_parameter_space(o_space, choice_effects)
  expect_identical(
    choice_parameters, i_space
  )

  ### Ordered model
  J <- 3
  ordered_effects <- choice_effects(
    choice_formula = choice_formula(
      formula = choice ~ A | 0
    ),
    choice_alternatives = choice_alternatives(J = J, ordered = TRUE)
  )
  ordered_parameters <- generate_choice_parameters(
    choice_effects = ordered_effects,
    fixed_parameters = choice_parameters(
      Sigma = 1,
      gamma = c(0, 1)
    )
  )
  o_space_ord <- switch_parameter_space(ordered_parameters, ordered_effects)
  i_space_ord <- switch_parameter_space(o_space_ord, ordered_effects)
  expect_equal(ordered_parameters$Sigma, i_space_ord$Sigma)
  expect_equal(ordered_parameters$gamma, i_space_ord$gamma)
})