tests/testthat/test-Model-class.R

# GeneralModel-class ----

test_that(".GeneralModel works as expected", {
  # nolint start
  result <- expect_silent(
    .GeneralModel(
      datamodel = function(x) {},
      priormodel = function(x) {},
      modelspecs = function(x) {},
      init = function(x) {},
      sample = "param1",
      datanames = "x",
      datanames_prior = "x1"
    )
  )
  # nolint end
  expect_valid(result, "GeneralModel")
})

# ModelLogNormal-class ----

test_that(".ModelLogNormal works as expected", {
  # nolint start
  result <- expect_silent(
    .ModelLogNormal(
      params = ModelParamsNormal(mean = c(0, 2), cov = diag(2)),
      ref_dose = positive_number(1),
      datamodel = function(x) {},
      priormodel = function(x) {},
      modelspecs = function(x) {},
      init = function(x) {},
      sample = "param1",
      datanames = "x",
      datanames_prior = "x1"
    )
  )
  # nolint end
  expect_valid(result, "ModelLogNormal")
})

# ModelLogNormal-constructor ----

test_that("ModelLogNormal object can be created with user constructor", {
  result <- expect_silent(
    ModelLogNormal(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "ModelLogNormal")
})

# LogisticNormal ----

## constructor ----

test_that("LogisticNormal object can be created with user constructor", {
  result <- expect_silent(
    LogisticNormal(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "LogisticNormal")
})

test_that(".DefaultLogisticNormal works as expected", {
  expect_equal(
    .DefaultLogisticNormal(),
    LogisticNormal(
      mean = c(-0.85, 1),
      cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2)
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticNormal model", {
  data <- h_get_data()
  model <- h_get_logistic_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticNormal model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_logistic_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticLogNormal ----

## constructor ----

test_that("LogisticLogNormal object can be created with user constructor", {
  result <- expect_silent(
    LogisticLogNormal(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "LogisticLogNormal")
})

test_that(".DefaultLogisticLogNormal works as expected", {
  expect_equal(
    .DefaultLogisticLogNormal(),
    LogisticLogNormal(
      mean = c(-0.85, 1),
      cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
      ref_dose = 50
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticLogNormal model", {
  data <- h_get_data()
  model <- h_get_logistic_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticLogNormal model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_logistic_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticLogNormalSub ----

## constructor ----

test_that("LogisticLogNormalSub object can be created with user constructor", {
  result <- expect_silent(
    LogisticLogNormalSub(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "LogisticLogNormalSub")
})

test_that(".DefaultLogisticLogNormalSub works correctly", {
  expect_equal(
    .DefaultLogisticLogNormalSub(),
    LogisticLogNormalSub(
      mean = c(-0.85, 1),
      cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
      ref_dose = 50
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticLogNormalSub model", {
  data <- h_get_data()
  model <- h_get_logistic_log_normal_sub()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticLogNormalSub model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_logistic_log_normal_sub()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# ProbitLogNormal ----

## constructor ----

test_that("ProbitLogNormal object can be created with user constructor", {
  result <- expect_silent(
    ProbitLogNormal(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "ProbitLogNormal")
})

test_that(".DefaultProbitLogNormal works correctly", {
  expect_equal(
    .DefaultProbitLogNormal(),
    ProbitLogNormal(
      mean = c(-0.85, 1),
      cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
      ref_dose = 7.2
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for ProbitLogNormal model", {
  data <- h_get_data()
  model <- h_get_probit_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for ProbitLogNormal model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_probit_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# ProbitLogNormalRel ----

## constructor ----

test_that("ProbitLogNormalRel object can be created with user constructor", {
  result <- expect_silent(
    ProbitLogNormalRel(
      mean = c(1, 5),
      cov = diag(4, ncol = 2, nrow = 2),
      ref_dose = 2
    )
  )
  expect_valid(result, "ProbitLogNormalRel")
})

test_that(".DefaultProbitLogNormalRel works correctly", {
  expect_equal(
    .DefaultProbitLogNormalRel(),
    ProbitLogNormalRel(
      mean = c(-0.85, 1),
      cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2)
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for ProbitLogNormalRel model", {
  data <- h_get_data()
  model <- h_get_probit_log_normal_rel()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for ProbitLogNormalRel model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_probit_log_normal_rel()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticLogNormalGrouped ----

## constructor ----

test_that("LogisticLogNormalGrouped object can be created with user constructor", {
  result <- expect_silent(
    LogisticLogNormalGrouped(
      mean = 1:4,
      cov = diag(1:4, 4),
      ref_dose = 2
    )
  )
  expect_valid(result, "LogisticLogNormalGrouped")
})

test_that(".DefaultLogisticLogNormalGrouped works as expected", {
  expect_valid(
    .DefaultLogisticLogNormalGrouped(),
    "LogisticLogNormalGrouped"
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticLogNormalGrouped model", {
  data <- h_get_data_grouped()
  model <- .DefaultLogisticLogNormalGrouped()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticLogNormalGrouped model and empty data", {
  data <- h_get_data_grouped(empty = TRUE)
  model <- .DefaultLogisticLogNormalGrouped()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticKadane ----

## constructor ----

test_that("LogisticKadane object can be created with user constructor", {
  result <- expect_silent(
    LogisticKadane(
      theta = 0.33,
      xmin = 1,
      xmax = 200
    )
  )
  expect_valid(result, "LogisticKadane")
})

test_that(".DefaultLogisticKadane works correctly", {
  expect_equal(
    .DefaultLogisticKadane(),
    LogisticKadane(theta = 0.33, xmin = 1, xmax = 200)
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticKadane model", {
  data <- h_get_data()
  model <- h_get_logistic_kadane()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticKadane model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_logistic_kadane()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticKadaneBetaGamma ----

## constructor ----

test_that("LogisticKadaneBetaGamma object can be created with user constructor", {
  result <- expect_silent(
    LogisticKadaneBetaGamma(
      theta = 0.3,
      xmin = 0,
      xmax = 7,
      alpha = 1,
      beta = 19,
      shape = 0.5625,
      rate = 0.125
    )
  )
  expect_valid(result, "LogisticKadaneBetaGamma")
})

test_that(".DefaultLogisticKadaneBetaGamma works correctly", {
  expect_equal(
    .DefaultLogisticKadaneBetaGamma(),
    LogisticKadaneBetaGamma(
      theta = 0.3,
      xmin = 0,
      xmax = 7,
      alpha = 1,
      beta = 19,
      shape = 0.5625,
      rate = 0.125
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticKadaneBetaGamma model", {
  data <- h_get_data_2()
  model <- h_get_logistic_kadane_beta_gam()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticKadaneBetaGamma model and empty data", {
  data <- h_get_data(empty = TRUE)
  model <- h_get_logistic_kadane_beta_gam()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticNormalMixture ----

## constructor ----

test_that("LogisticNormalMixture object can be created with user constructor", {
  result <- expect_silent(
    LogisticNormalMixture(
      comp1 = ModelParamsNormal(mean = c(0, 3), cov = diag(2)),
      comp2 = ModelParamsNormal(mean = c(-1, 6), cov = c(2, 4) * diag(2)),
      weightpar = c(a = 1, b = 5),
      ref_dose = 2
    )
  )
  expect_valid(result, "LogisticNormalMixture")
})


test_that(".DefaultLogisticNormalMixture works correctly", {
  expect_equal(
    .DefaultLogisticNormalMixture(),
    LogisticNormalMixture(
      comp1 = ModelParamsNormal(
        mean = c(-0.85, 1),
        cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2)
      ),
      comp2 = ModelParamsNormal(
        mean = c(1, 1.5),
        cov = matrix(c(1.2, -0.45, -0.45, 0.6), nrow = 2)
      ),
      weightpar = c(a = 1, b = 1),
      ref_dose = 50
    )
  )
})
## mcmc ----

test_that("MCMC computes correct values for LogisticNormalMixture model", {
  data <- h_get_data_mixture()
  model <- h_get_logistic_normal_mix()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticNormalMixture model and empty data", {
  data <- h_get_data_mixture(empty = TRUE)
  model <- h_get_logistic_normal_mix()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# LogisticNormalFixedMixture ----

## constructor ----

test_that("LogisticNormalFixedMixture object can be created with user constructor", {
  result <- expect_silent(
    LogisticNormalFixedMixture(
      components = list(
        comp1 = ModelParamsNormal(
          mean = c(-0.85, 1),
          cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2)
        ),
        comp2 = ModelParamsNormal(
          mean = c(1, 1.5),
          cov = matrix(c(1.2, -0.45, -0.45, 0.6), nrow = 2)
        )
      ),
      weights = c(0.3, 0.7),
      ref_dose = 50
    )
  )
  expect_valid(result, "LogisticNormalFixedMixture")
})

test_that(".DefaultLogisticNormalFixedMixture works as expected", {
  expect_equal(
    .DefaultLogisticNormalFixedMixture(),
    LogisticNormalFixedMixture(
      components = list(
        comp1 = ModelParamsNormal(
          mean = c(-0.85, 1),
          cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2)
        ),
        comp2 = ModelParamsNormal(
          mean = c(1, 1.5),
          cov = matrix(c(1.2, -0.45, -0.45, 0.6), nrow = 2)
        )
      ),
      weights = c(0.3, 0.7),
      ref_dose = 50
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticNormalFixedMixture model", {
  data <- h_get_data_mixture()
  model <- h_get_logistic_normal_fixed_mix()
  model_log_normal <- h_get_logistic_normal_fixed_mix(log_normal = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_normal <- mcmc(
    data = data,
    model = model_log_normal,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_normal@data)
})

test_that("MCMC computes correct values for LogisticNormalFixedMixture model and empty data", {
  data <- h_get_data_mixture(empty = TRUE)
  model <- h_get_logistic_normal_fixed_mix()
  model_log_normal <- h_get_logistic_normal_fixed_mix(log_normal = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_normal <- mcmc(
    data = data,
    model = model_log_normal,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_normal@data)
})

# LogisticLogNormalMixture ----

## constructor ----

test_that("LogisticLogNormalMixture object can be created with user constructor", {
  result <- expect_silent(
    LogisticLogNormalMixture(
      mean = c(0, 1),
      cov = diag(2),
      share_weight = 0.1,
      ref_dose = 1
    )
  )
  expect_valid(result, "LogisticLogNormalMixture")
})

test_that(".DefaultLogisticLogNormalMixture works as expected", {
  test_obj <-
    expect_equal(
      .DefaultLogisticLogNormalMixture(),
      LogisticLogNormalMixture(
        share_weight = 0.1,
        mean = c(-0.85, 1),
        cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
        ref_dose = 50
      )
    )
})

## mcmc ----

test_that("MCMC computes correct values for LogisticLogNormalMixture model", {
  data <- h_get_data_mixture()
  model <- h_get_logistic_log_normal_mix()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticLogNormalMixture model and empty data", {
  data <- h_get_data_mixture(empty = TRUE)
  model <- h_get_logistic_log_normal_mix()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# DualEndpoint ----

## constructor ----

test_that("DualEndpoint object can be created with user constructor (fixed params)", {
  result <- expect_silent(h_get_dual_endpoint())
  expect_valid(result, "DualEndpoint")
})

test_that("DualEndpoint object can be created with user constructor", {
  result <- expect_silent(h_get_dual_endpoint(fixed = FALSE))
  expect_valid(result, "DualEndpoint")
})

# DualEndpointRW ----

## constructor ----

test_that("DualEndpointRW object can be created with user constructor (fixed params)", {
  result <- expect_silent(h_get_dual_endpoint_rw())
  expect_valid(result, "DualEndpointRW")
})

test_that("DualEndpointRW object can be created with user constructor", {
  result <- expect_silent(h_get_dual_endpoint_rw(fixed = FALSE))
  expect_valid(result, "DualEndpointRW")
})

test_that(".DefaultDualEndpointRW works correctly", {
  expect_equal(
    .DefaultDualEndpointRW(),
    DualEndpointRW(
      mean = c(0, 1),
      cov = matrix(c(1, 0, 0, 1), nrow = 2),
      sigma2W = c(a = 0.1, b = 0.1),
      rho = c(a = 1, b = 1),
      sigma2betaW = 0.01,
      rw1 = TRUE
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for DualEndpointRW model (fixed params)", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_rw()
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_rw(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model with RW2", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_rw(rw1 = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE, rw1 = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model (fixed params) with RW2", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_rw(rw1 = FALSE, fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(
    use_log_dose = TRUE,
    rw1 = FALSE,
    fixed = FALSE
  )
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model (fixed params, empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw()
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model with RW2 (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw(rw1 = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(use_log_dose = TRUE, rw1 = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointRW model (fixed params, empty data) with RW2", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw(rw1 = FALSE, fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_rw(
    use_log_dose = TRUE,
    rw1 = FALSE,
    fixed = FALSE
  )
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC throws the error for DualEndpointRW model when 'nGrid == 1' for RW 1", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw(rw1 = TRUE)
  options <- h_get_mcmc_options()

  data@nGrid <- 1L
  data@doseGrid <- data@doseGrid[1]

  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'data@nGrid >= 2' failed: Must be TRUE"
  )
})

test_that("MCMC throws the error for DualEndpointRW model when 'nGrid <= 2' for RW 2", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_rw(rw1 = FALSE)
  options <- h_get_mcmc_options()

  data@nGrid <- 1L
  data@doseGrid <- data@doseGrid[1]

  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'data@nGrid >= 3' failed: Must be TRUE"
  )

  data@nGrid <- 2L
  data@doseGrid <- data@doseGrid[1:2]

  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'data@nGrid >= 3' failed: Must be TRUE"
  )
})

# DualEndpointBeta ----

## constructor ----

test_that("DualEndpointBeta object can be created with user constructor (fixed params)", {
  result <- expect_silent(h_get_dual_endpoint_beta())
  expect_valid(result, "DualEndpointBeta")
})

test_that("DualEndpointBeta object can be created with user constructor", {
  result <- expect_silent(h_get_dual_endpoint_beta(fixed = FALSE))
  expect_valid(result, "DualEndpointBeta")
})

test_that(".DefaultDualEndpointBeta works as expected", {
  expect_equal(
    .DefaultDualEndpointBeta(),
    DualEndpointBeta(
      mean = c(0, 1),
      cov = matrix(c(1, 0, 0, 1), nrow = 2),
      ref_dose = 10,
      use_log_dose = TRUE,
      sigma2W = c(a = 0.1, b = 0.1),
      rho = c(a = 1, b = 1),
      E0 = c(0, 100),
      Emax = c(0, 500),
      delta1 = c(0, 5),
      mode = c(1, 15),
      ref_dose_beta = 1000
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for DualEndpointBeta model with fixed parameters", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_beta()
  model_log_dose <- h_get_dual_endpoint_beta(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointBeta model", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_beta(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_beta(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC throws the error for DualEndpointBeta model when 'ref_dose_beta <= max(doseGrid)'", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_beta()
  options <- h_get_mcmc_options()

  model@ref_dose_beta <- positive_number(data@doseGrid[data@nGrid] - 1)
  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'model@ref_dose_beta > data@doseGrid\\[data@nGrid\\]' failed: Must be TRUE."
  )
})

test_that("MCMC throws the error for DualEndpointBeta model when 'nGrid == 0'", {
  data <- DataDual()
  model <- h_get_dual_endpoint_beta()
  options <- h_get_mcmc_options()

  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'data@nGrid >= 1' failed: Must be TRUE"
  )
})

test_that("MCMC computes correct values for DualEndpointBeta model with fixed parameters (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_beta()
  model_log_dose <- h_get_dual_endpoint_beta(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointBeta model (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_beta(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_beta(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

# DualEndpointEmax ----

## constructor ----

test_that("DualEndpointEmax object can be created with user constructor (fixed params)", {
  result <- expect_silent(h_get_dual_endpoint_emax())
  expect_valid(result, "DualEndpointEmax")
})

test_that("DualEndpointEmax object can be created with user constructor", {
  result <- expect_silent(h_get_dual_endpoint_emax(fixed = FALSE))
  expect_valid(result, "DualEndpointEmax")
})

test_that(".DefaultDualEndpointEmax works correctly", {
  expect_equal(
    .DefaultDualEndpointEmax(),
    DualEndpointEmax(
      mean = c(0, 1),
      cov = matrix(c(1, 0, 0, 1), nrow = 2),
      sigma2W = c(a = 0.1, b = 0.1),
      rho = c(a = 1, b = 1),
      E0 = c(0, 100),
      Emax = c(0, 500),
      ED50 = c(10, 200),
      ref_dose_emax = 1000
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for DualEndpointEmax model with fixed parameters", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_emax()
  model_log_dose <- h_get_dual_endpoint_emax(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointEmax model", {
  data <- h_get_data_dual()
  model <- h_get_dual_endpoint_emax(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_emax(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointEmax model with fixed parameters (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_emax()
  model_log_dose <- h_get_dual_endpoint_emax(use_log_dose = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC computes correct values for DualEndpointEmax model (empty data)", {
  data <- h_get_data_dual(empty = TRUE)
  model <- h_get_dual_endpoint_emax(fixed = FALSE)
  model_log_dose <- h_get_dual_endpoint_emax(use_log_dose = TRUE, fixed = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  result_log_dose <- mcmc(
    data = data,
    model = model_log_dose,
    options = options
  )
  expect_snapshot(result@data)
  expect_snapshot(result_log_dose@data)
})

test_that("MCMC throws the error for DualEndpointEmax model when 'nGrid == 0'", {
  data <- DataDual()
  model <- h_get_dual_endpoint_emax()
  options <- h_get_mcmc_options()

  expect_error(
    mcmc(data = data, model = model, options = options),
    "Assertion on 'data@nGrid >= 1' failed: Must be TRUE"
  )
})

# LogisticIndepBeta ----

## constructor ----

test_that("LogisticIndepBeta object can be created with user constructor (empty data)", {
  result <- expect_silent(h_get_logistic_indep_beta(emptydata = TRUE))
  expect_valid(result, "LogisticIndepBeta")
})

test_that("LogisticIndepBeta object can be created with user constructor", {
  result <- expect_silent(h_get_logistic_indep_beta(emptydata = FALSE))
  expect_valid(result, "LogisticIndepBeta")
})

## mcmc ----

test_that("MCMC computes correct values for LogisticIndepBeta model", {
  model <- h_get_logistic_indep_beta(emptydata = FALSE)
  options <- h_get_mcmc_options()

  set.seed(10)
  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for LogisticIndepBeta model (empty data)", {
  model <- h_get_logistic_indep_beta(emptydata = TRUE)
  options <- h_get_mcmc_options()

  set.seed(10)
  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

# Effloglog ----

## constructor ----

test_that("Effloglog object can be created with user constructor (empty data)", {
  result <- expect_silent(h_get_eff_log_log(emptydata = TRUE))
  expect_valid(result, "Effloglog")
})

test_that("Effloglog object can be created with user constructor", {
  result <- expect_silent(h_get_eff_log_log(emptydata = FALSE))
  expect_valid(result, "Effloglog")
})

## mcmc ----

test_that("MCMC computes correct values for Effloglog model", {
  model <- h_get_eff_log_log(emptydata = FALSE)
  options <- h_get_mcmc_options()

  set.seed(10)
  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for Effloglog model (empty data)", {
  model <- h_get_eff_log_log(emptydata = TRUE)
  options <- h_get_mcmc_options()

  set.seed(10)
  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

# EffFlexi ----

## constructor ----

test_that("EffFlexi object can be created with user constructor", {
  result <- expect_silent(h_get_eff_flexi())
  expect_valid(result, "EffFlexi")
})

test_that("EffFlexi object can be created with user constructor (RW2)", {
  result <- expect_silent(h_get_eff_flexi(rw1 = FALSE))
  expect_valid(result, "EffFlexi")
})

test_that("EffFlexi object can be created with user constructor (empty data)", {
  result <- expect_silent(h_get_eff_flexi(emptydata = TRUE))
  expect_valid(result, "EffFlexi")
})

test_that("EffFlexi object can be created with user constructor (empty data, RW2)", {
  result <- expect_silent(h_get_eff_flexi(emptydata = TRUE, rw1 = FALSE))
  expect_valid(result, "EffFlexi")
})

## mcmc ----

test_that("MCMC computes correct values for EffFlexi model", {
  model <- h_get_eff_flexi()
  options <- h_get_mcmc_options()

  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for EffFlexi model (RW2)", {
  model <- h_get_eff_flexi(rw1 = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for EffFlexi model (empty data)", {
  model <- h_get_eff_flexi(emptydata = TRUE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for EffFlexi model (empty data, RW2)", {
  model <- h_get_eff_flexi(emptydata = TRUE, rw1 = FALSE)
  options <- h_get_mcmc_options()

  result <- mcmc(data = model@data, model = model, options = options)
  expect_snapshot(result@data)
})

# DALogisticLogNormal ----

## constructor ----

test_that("DALogisticLogNormal object can be created with user constructor", {
  result <- expect_silent(
    DALogisticLogNormal(
      mean = c(0, 1),
      cov = diag(2),
      ref_dose = 1,
      npiece = 3,
      l = c(0.5, 0.5, 0.5),
      c_par = 2
    )
  )
  expect_valid(result, "DALogisticLogNormal")
})

test_that(".DefaultDALogisticLogNormal works as expected", {
  npiece <- 10
  Tmax <- 60

  lambda_prior <- function(k) {
    npiece / (Tmax * (npiece - k + 0.5))
  }

  test_obj <-
    expect_equal(
      .DefaultDALogisticLogNormal(),
      DALogisticLogNormal(
        mean = c(-0.85, 1),
        cov = matrix(c(1, -0.5, -0.5, 1), nrow = 2),
        ref_dose = 56,
        npiece = npiece,
        l = as.numeric(t(apply(
          as.matrix(c(1:npiece), 1, npiece),
          2,
          lambda_prior
        ))),
        c_par = 2
      )
    )
})
## mcmc ----

test_that("MCMC computes correct values for DALogisticLogNormal model", {
  data <- h_get_data_da()
  model <- h_get_da_logistic_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for DALogisticLogNormal model and empty data", {
  data <- h_get_data_da(empty = TRUE)
  model <- h_get_da_logistic_log_normal()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# TITELogisticLogNormal ----

## constructor ----

test_that("TITELogisticLogNormal object can be created with user constructor (linear weight)", {
  result <- expect_silent(h_get_tite_logistic_log_normal("linear"))
  expect_valid(result, "TITELogisticLogNormal")
})

test_that("TITELogisticLogNormal object can be created with user constructor (adaptive weight)", {
  result <- expect_silent(h_get_tite_logistic_log_normal("adaptive"))
  expect_valid(result, "TITELogisticLogNormal")
})

test_that(".DefaultTITELogisticLogNormal object can be created with user constructor (linear weight)", {
  expect_equal(
    .DefaultTITELogisticLogNormal(),
    TITELogisticLogNormal(
      mean = c(0, 1),
      cov = diag(2),
      ref_dose = 1,
      weight_method = "linear"
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for TITELogisticLogNormal model (linear)", {
  data <- h_get_data_da()
  model <- h_get_tite_logistic_log_normal("linear")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for TITELogisticLogNormal model (linear, data 2)", {
  data <- h_get_data_da_2()
  model <- h_get_tite_logistic_log_normal("linear")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for TITELogisticLogNormal model (linear, empty data)", {
  data <- h_get_data_da(empty = TRUE)
  model <- h_get_tite_logistic_log_normal("linear")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for TITELogisticLogNormal model (adaptive)", {
  data <- h_get_data_da()
  model <- h_get_tite_logistic_log_normal("adaptive")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for TITELogisticLogNormal model (adaptive, data 2)", {
  data <- h_get_data_da_2()
  model <- h_get_tite_logistic_log_normal("adaptive")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for TITELogisticLogNormal model (adaptive, empty data)", {
  data <- h_get_data_da(empty = TRUE)
  model <- h_get_tite_logistic_log_normal("adaptive")
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

# OneParLogNormalPrior ----

## constructor ----

test_that("OneParLogNormalPrior object can be created with user constructor", {
  result <- expect_silent(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = 1:5,
      sigma2 = 2
    )
  )
  expect_valid(result, "OneParLogNormalPrior")
  expect_identical(result@skel_probs, c(0.1, 0.3, 0.5, 0.7, 0.9))
  expect_identical(result@sigma2, 2)
  expect_identical(
    result@skel_fun(c(1, 1.5, 3, 3.7, 5)),
    c(0.10, 0.20, 0.50, 0.64, 0.90)
  )
  expect_identical(
    result@skel_fun_inv(c(0.10, 0.20, 0.50, 0.64, 0.90)),
    c(1, 1.5, 3, 3.7, 5)
  )
})

test_that("OneParLogNormalPrior throws the error when dose_grid and skel_probs have diff. lengths", {
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = 1:6,
      sigma2 = 2
    ),
    "Assertion on 'dose_grid' failed: Must have length 5, but has length 6."
  )
})

test_that("OneParLogNormalPrior throws the error for not unique or not sorted dose_grid", {
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = c(1, 3, 4, 5, 5),
      sigma2 = 2
    ),
    "Assertion on 'dose_grid' failed: Contains duplicated values, position 5."
  )
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = c(2, 1, 3, 4, 5),
      sigma2 = 2
    ),
    "Assertion on 'dose_grid' failed: Must be sorted"
  )
})

test_that("OneParLogNormalPrior throws the error for not a probability values in skel_probs", {
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 1.1),
      dose_grid = 1:5,
      sigma2 = 2
    ),
    "Assertion on 'skel_probs' failed: Probability must be within \\[0, 1\\] bounds but it is not"
  )
})

test_that("OneParLogNormalPrior throws the error for not unique or not sorted skel_probs", {
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.1, 0.2, 0.2, 0.3, 0.4),
      dose_grid = 1:5,
      sigma2 = 2
    ),
    "Assertion on 'skel_probs' failed: Contains duplicated values, position 3."
  )
  result <- expect_error(
    OneParLogNormalPrior(
      skel_probs = c(0.3, 0.1, 0.5, 0.7, 0.9),
      dose_grid = 1:5,
      sigma2 = 2
    ),
    "Assertion on 'skel_probs' failed: Must be sorted"
  )
})

## mcmc ----

test_that("MCMC computes correct values for OneParLogNormalPrior model", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_one_par_log_normal_prior()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for OneParLogNormalPrior model and empty data", {
  data <- h_get_data(empty = TRUE, placebo = FALSE)
  model <- h_get_one_par_log_normal_prior()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC throws the error for OneParLogNormalPrior model when 'xLevel' does not match 'skel_probs'", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_one_par_log_normal_prior()
  model@skel_probs <- model@skel_probs[-1]
  options <- h_get_mcmc_options()

  expect_error(
    mcmc(data = data, model = model, options = options, from_prior = FALSE),
    "Assertion on 'length\\(model@skel_probs\\) == data@nGrid' failed: Must be TRUE."
  )
})

test_that("No NA is returned in dose calculations for OneParLogNormalPrior model", {
  model <- h_get_one_par_log_normal_prior()
  calc_dose <- doseFunction(model, alpha = 1)

  expect_false(is.na(calc_dose(0.95)))
})

# OneParExpPrior ----

## constructor ----

test_that("OneParExpPrior object can be created with user constructor", {
  result <- expect_silent(
    OneParExpPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = 1:5,
      lambda = 2
    )
  )
  expect_valid(result, "OneParExpPrior")
  expect_identical(result@skel_probs, c(0.1, 0.3, 0.5, 0.7, 0.9))
  expect_identical(result@lambda, 2)
  expect_identical(
    result@skel_fun(c(1, 1.5, 3, 3.7, 5)),
    c(0.10, 0.20, 0.50, 0.64, 0.90)
  )
  expect_identical(
    result@skel_fun_inv(c(0.10, 0.20, 0.50, 0.64, 0.90)),
    c(1, 1.5, 3, 3.7, 5)
  )
})

test_that("OneParExpPrior throws the error when dose_grid and skel_probs have diff. lengths", {
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = 1:6,
      lambda = 2
    ),
    "Assertion on 'dose_grid' failed: Must have length 5, but has length 6."
  )
})

test_that("OneParExpPrior throws the error for not unique or not sorted dose_grid", {
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = c(1, 3, 4, 5, 5),
      lambda = 2
    ),
    "Assertion on 'dose_grid' failed: Contains duplicated values, position 5."
  )
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
      dose_grid = c(2, 1, 3, 4, 5),
      lambda = 2
    ),
    "Assertion on 'dose_grid' failed: Must be sorted"
  )
})

test_that("OneParExpPrior throws the error for not a probability values in skel_probs", {
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.1, 0.3, 0.5, 0.7, 1.1),
      dose_grid = 1:5,
      lambda = 2
    ),
    "Assertion on 'skel_probs' failed: Probability must be within \\[0, 1\\] bounds but it is not"
  )
})

test_that("OneParExpPrior throws the error for not unique or not sorted skel_probs", {
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.1, 0.2, 0.2, 0.3, 0.4),
      dose_grid = 1:5,
      lambda = 2
    ),
    "Assertion on 'skel_probs' failed: Contains duplicated values, position 3."
  )
  result <- expect_error(
    OneParExpPrior(
      skel_probs = c(0.3, 0.1, 0.5, 0.7, 0.9),
      dose_grid = 1:5,
      lambda = 2
    ),
    "Assertion on 'skel_probs' failed: Must be sorted"
  )
})

## mcmc ----

test_that("MCMC computes correct values for OneParExpPrior model", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_one_par_exp_prior()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for OneParExpPrior model and empty data", {
  data <- h_get_data(empty = TRUE, placebo = FALSE)
  model <- h_get_one_par_exp_prior()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC throws the error for OneParExpPrior model when 'xLevel' does not match 'skel_probs'", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_one_par_exp_prior()
  model@skel_probs <- model@skel_probs[-1]
  options <- h_get_mcmc_options()

  expect_error(
    mcmc(data = data, model = model, options = options, from_prior = FALSE),
    "Assertion on 'length\\(model@skel_probs\\) == data@nGrid' failed: Must be TRUE."
  )
})

test_that("No NA is returned in dose calculations for OneParExpPrior model", {
  model <- h_get_one_par_exp_prior()
  calc_dose <- doseFunction(model, theta = 1)

  expect_false(is.na(calc_dose(0.95)))
})

# FractionalCRM ----

## constructor ----

test_that("FractionalCRM object can be created with user constructor", {
  result <- expect_silent(
    FractionalCRM(
      skel_probs = c(0.1, 0.2, 0.3, 0.4),
      dose_grid = c(10, 30, 50, 100),
      sigma2 = 2
    )
  )
  expect_valid(result, "FractionalCRM")
})

test_that(".DefaultFractionalCRM works correctly", {
  expect_equal(
    .DefaultFractionalCRM(),
    FractionalCRM(
      skel_probs = c(0.1, 0.2, 0.3, 0.4),
      dose_grid = c(10, 30, 50, 100),
      sigma2 = 2
    )
  )
})

## mcmc ----

test_that("MCMC computes correct values for FractionalCRM model", {
  data <- h_get_data_da(placebo = FALSE)
  model <- h_get_fractional_crm()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC computes correct values for FractionalCRM model and empty data", {
  data <- h_get_data_da(empty = TRUE, placebo = FALSE)
  model <- h_get_fractional_crm()
  options <- h_get_mcmc_options()

  result <- mcmc(data = data, model = model, options = options)
  expect_snapshot(result@data)
})

test_that("MCMC throws the error for FractionalCRM model when 'xLevel' does not match 'skel_probs'", {
  data <- h_get_data(placebo = FALSE)
  model <- h_get_fractional_crm()
  model@skel_probs <- model@skel_probs[-1]
  options <- h_get_mcmc_options()

  expect_error(
    mcmc(data = data, model = model, options = options, from_prior = FALSE),
    "Assertion on 'length\\(model@skel_probs\\) == data@nGrid' failed: Must be TRUE."
  )
})

Try the crmPack package in your browser

Any scripts or data that you put into this service are public.

crmPack documentation built on Nov. 29, 2025, 5:07 p.m.