tests/testthat/test-Model-validity.R

In crmPack: Object-Oriented Implementation of Dose Escalation Designs

# v_general_model ----

test_that("v_general_model passes for valid object", {
  object <- h_get_general_model()
  expect_true(v_general_model(object))
})

test_that("v_general_model returns message for non-valid object", {
  object <- h_get_general_model()
  # Changing `datanames` so that the arguments of `object@init` are not a subset
  # of the `datanames`.
  object@datanames <- "y"

  expect_equal(
    v_general_model(object),
    "Arguments of the init function must be data names"
  )
})

# v_model_logistic_kadane ----

test_that("v_model_logistic_kadane passes for valid object", {
  object <- h_get_logistic_kadane()
  expect_true(v_model_logistic_kadane(object))
})

test_that("v_model_logistic_kadane returns message for wrong theta probability", {
  object <- h_get_logistic_kadane()
  err_msg <- "theta must be a probability scalar > 0 and < 1"
  # Assigning wrong values for probability theta.
  object@theta <- -1
  expect_equal(v_model_logistic_kadane(object), err_msg)
  object@theta <- 5
  expect_equal(v_model_logistic_kadane(object), err_msg)
  object@theta <- 0
  expect_equal(v_model_logistic_kadane(object), err_msg)
})

test_that("v_model_logistic_kadane returns message for non-scalars", {
  object <- h_get_logistic_kadane()
  # Assigning vectors for scalar slots.
  object@theta <- c(0.4, 0.5)
  object@xmin <- 1:4
  object@xmax <- 2:5

  expect_equal(
    v_model_logistic_kadane(object),
    c(
      "theta must be a probability scalar > 0 and < 1",
      "xmin must be scalar",
      "xmax must be scalar"
    )
  )
})

test_that("v_model_logistic_kadane returns message for xmin greater than xmax", {
  object <- h_get_logistic_kadane()
  # Assigning vectors for scalar slots.
  object@xmin <- 1
  object@xmax <- 1
  expect_equal(
    v_model_logistic_kadane(object),
    "xmin must be strictly smaller than xmax"
  )
  object@xmin <- 2
  object@xmax <- 1
  expect_equal(
    v_model_logistic_kadane(object),
    "xmin must be strictly smaller than xmax"
  )
})

test_that("v_model_logistic_kadane returns message for wrong theta probability", {
  object <- h_get_logistic_kadane_beta_gam()
  err_msg <- "theta must be a probability scalar > 0 and < 1"
  # Assigning wrong values for probability theta.
  object@theta <- -1
  expect_equal(v_model_logistic_kadane(object), err_msg)
  object@theta <- 5
  expect_equal(v_model_logistic_kadane(object), err_msg)
  object@theta <- 0
  expect_equal(v_model_logistic_kadane(object), err_msg)
})

test_that("v_model_logistic_kadane returns message for xmin greater than xmax", {
  object <- h_get_logistic_kadane_beta_gam()
  # Assigning vectors for scalar slots.
  object@xmin <- 1
  object@xmax <- 1
  expect_equal(
    v_model_logistic_kadane(object),
    "xmin must be strictly smaller than xmax"
  )
  object@xmin <- 2
  object@xmax <- 1
  expect_equal(
    v_model_logistic_kadane(object),
    "xmin must be strictly smaller than xmax"
  )
})

test_that("v_model_logistic_kadane returns message for non-scalars", {
  object <- h_get_logistic_kadane_beta_gam()
  # Assigning vectors for scalar slots.
  object@theta <- c(0.4, 0.5)
  object@xmin <- 1:4
  object@xmax <- 2:5

  expect_equal(
    v_model_logistic_kadane(object),
    c(
      "theta must be a probability scalar > 0 and < 1",
      "xmin must be scalar",
      "xmax must be scalar"
    )
  )
})

# v_model_logistic_kadane_beta_gamma ----

test_that("v_model_logistic_kadane_beta_gamma passes for valid object", {
  object <- h_get_logistic_kadane_beta_gam()
  expect_true(v_model_logistic_kadane_beta_gamma(object))
})

test_that("v_model_logistic_kadane_beta_gamma returns message for non-scalars", {
  object <- h_get_logistic_kadane_beta_gam()
  # Assigning vectors for scalar slots.
  object@alpha <- 3:6
  object@beta <- 3:6
  object@shape <- 4:7
  object@rate <- 4:7

  expect_snapshot(v_model_logistic_kadane_beta_gamma(object))
})

test_that("v_model_logistic_kadane_beta_gamma returns message for wrong Beta distribution shape parameter alpha", {
  object <- h_get_logistic_kadane_beta_gam()
  err_msg <- "Beta distribution shape parameter alpha must be a positive scalar"
  # Assigning wrong values for Beta distribution shape parameter alpha.
  object@alpha <- -1
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
  object@alpha <- 0
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
})

test_that("v_model_logistic_kadane_beta_gamma returns message for wrong Beta distribution shape parameter beta", {
  object <- h_get_logistic_kadane_beta_gam()
  err_msg <- "Beta distribution shape parameter beta must be a positive scalar"
  # Assigning wrong values for Beta distribution shape parameter beta.
  object@beta <- -1
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
  object@beta <- 0
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
})

test_that("v_model_logistic_kadane_beta_gamma returns message for wrong Gamma distribution shape parameter", {
  object <- h_get_logistic_kadane_beta_gam()
  err_msg <- "Gamma distribution shape parameter must be a positive scalar"
  # Assigning wrong values for Gamma distribution shape parameter.
  object@shape <- -1
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
  object@shape <- 0
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
})

test_that("v_model_logistic_kadane_beta_gamma returns message for wrong Gamma distribution rate parameter", {
  object <- h_get_logistic_kadane_beta_gam()
  err_msg <- "Gamma distribution rate parameter must be a positive scalar"
  # Assigning wrong values for Gamma distribution rate parameter.
  object@rate <- -1
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
  object@rate <- 0
  expect_equal(v_model_logistic_kadane_beta_gamma(object), err_msg)
})

# v_model_logistic_normal_mix ----

test_that("v_model_logistic_normal_mix passes for valid object", {
  object <- h_get_logistic_normal_mix()
  expect_true(v_model_logistic_normal_mix(object))
})

test_that("v_model_logistic_normal_mix returns message for wrong weightpar", {
  object <- h_get_logistic_normal_mix()
  err_msg <- "weightpar must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  # Assigning wrong values for weightpar.
  object@weightpar <- c(a = -1, b = -2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
  object@weightpar <- c(a = -1, b = 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)

  object@weightpar <- c(1, 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
  object@weightpar <- c(a = 1, 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
  object@weightpar <- c(1, b = 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
  object@weightpar <- c(a = 1, g = 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
  object@weightpar <- c(h = 1, g = 2)
  expect_equal(v_model_logistic_normal_mix(object), err_msg)
})

# v_model_logistic_normal_fixed_mix ----

test_that("v_model_logistic_normal_fixed_mix passes for valid object", {
  object <- h_get_logistic_normal_fixed_mix()
  expect_true(v_model_logistic_normal_fixed_mix(object))
})

test_that("v_model_logistic_normal_fixed_mix returns message for wrong components", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning wrong values for components.
  object@components <- list(mean = c(0, 1), cov = diag(2))

  expect_equal(
    v_model_logistic_normal_fixed_mix(object),
    "components must be a list with ModelParamsNormal S4 class objects"
  )
})

test_that("v_model_logistic_normal_fixed_mix returns message for non-valid ModelParamsNormal comp", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning wrong values for ModelParamsNormal object.
  object@components[[1]]@mean <- c(0, NA)
  object@components[[1]]@cov <- matrix(letters[1:4], nrow = 2)

  expect_snapshot(v_model_logistic_normal_fixed_mix(object))
})

test_that("v_model_logistic_normal_fixed_mix returns message for weights and comp of diff len", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning weights of different length than the components.
  object@weights <- rep(0.1, 10)

  expect_equal(
    v_model_logistic_normal_fixed_mix(object),
    "components must have same length as weights"
  )
})

test_that("v_model_logistic_normal_fixed_mix returns message for weights not sum to 1", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning weights that do not sum to 1.
  object@weights <- c(2, 4)

  expect_equal(
    v_model_logistic_normal_fixed_mix(object),
    "weights must sum to 1"
  )
})

test_that("v_model_logistic_normal_fixed_mix returns message for negative weights", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning negative weights.
  object@weights <- c(-0.5, 1.5)

  expect_equal(
    v_model_logistic_normal_fixed_mix(object),
    "weights must be positive"
  )
})

test_that("v_model_logistic_normal_fixed_mix returns message for non-scalar log_normal", {
  object <- h_get_logistic_normal_fixed_mix()
  # Assigning non-scalar log_normal.
  object@log_normal <- c(TRUE, FALSE, TRUE)

  expect_equal(
    v_model_logistic_normal_fixed_mix(object),
    "log_normal must be TRUE or FALSE"
  )
})

# v_model_logistic_log_normal_mix ----

test_that("v_model_logistic_log_normal_mix passes for valid object", {
  object <- h_get_logistic_log_normal_mix()
  expect_true(v_model_logistic_log_normal_mix(object))
})

test_that("v_model_logistic_log_normal_mix returns message for wrong share_weight", {
  object <- h_get_logistic_log_normal_mix()
  err_msg <- "share_weight does not specify a probability"
  # Assigning wrong values for weightpar.
  object@share_weight <- -1
  expect_equal(v_model_logistic_log_normal_mix(object), err_msg)
  object@share_weight <- c(-1, 0.5)
  expect_equal(v_model_logistic_log_normal_mix(object), err_msg)
})

# v_model_dual_endpoint ----

test_that("v_model_dual_endpoint passes for valid object", {
  object <- h_get_dual_endpoint()
  object_ff <- h_get_dual_endpoint(fixed = FALSE)

  expect_true(v_model_dual_endpoint(object))
  expect_true(v_model_dual_endpoint(object_ff))
})

test_that("v_model_dual_endpoint returns message for wrong use_log_dose", {
  object <- h_get_dual_endpoint()
  # We assign a use_log_dose which is not a single flag.
  object@use_log_dose <- c(TRUE, FALSE)

  expect_equal(
    v_model_dual_endpoint(object),
    "use_log_dose must be TRUE or FALSE"
  )
})

test_that("v_model_dual_endpoint returns message for wrong use_fixed", {
  object <- h_get_dual_endpoint()
  # Assigning non-valid use_fixed.
  object@use_fixed <- TRUE

  expect_snapshot(v_model_dual_endpoint(object))
})

test_that("v_model_dual_endpoint returns message for wrong fixed sigma2W", {
  object <- h_get_dual_endpoint()
  # Assigning wrong values for sigma2W.
  object@sigma2W <- c(-5:0, Inf)

  expect_equal(
    v_model_dual_endpoint(object),
    "sigma2W must be a positive and finite numerical scalar"
  )
})

test_that("v_model_dual_endpoint returns message for wrong sigma2W", {
  object <- h_get_dual_endpoint()
  # Assigning wrong values for sigma2W.
  object@sigma2W <- c(4, -5, b = -Inf)
  object@use_fixed["sigma2W"] <- FALSE

  expect_equal(
    v_model_dual_endpoint(object),
    "sigma2W must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

test_that("v_model_dual_endpoint returns message for wrong fixed rho", {
  object <- h_get_dual_endpoint()
  # Assigning wrong values for rho.
  object@rho <- c(-5:0, Inf)

  expect_equal(
    v_model_dual_endpoint(object),
    "rho must be a number in (-1, 1)"
  )
})

test_that("v_model_dual_endpoint returns message for wrong rho", {
  object <- h_get_dual_endpoint()
  # Assigning wrong values for rho.
  object@rho <- c(4, -5, b = -Inf)
  object@use_fixed["rho"] <- FALSE

  expect_equal(
    v_model_dual_endpoint(object),
    "rho must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

# v_model_dual_endpoint_rw ----

test_that("v_model_dual_endpoint_rw passes for valid object", {
  object <- h_get_dual_endpoint_rw()
  object_ff <- h_get_dual_endpoint_rw(fixed = FALSE)

  expect_true(v_model_dual_endpoint_rw(object))
  expect_true(v_model_dual_endpoint_rw(object_ff))
})

test_that("v_model_dual_endpoint_rw returns message for wrong use_fixed", {
  object <- h_get_dual_endpoint_rw()
  # Assigning non-valid use_fixed.
  object@use_fixed <- TRUE

  expect_equal(
    v_model_dual_endpoint_rw(object),
    c(
      "use_fixed must be a named logical vector that contains name 'sigma2betaW'",
      "sigma2betaW must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
    )
  )
})

test_that("v_model_dual_endpoint_rw returns message for wrong fixed sigma2betaW", {
  object <- h_get_dual_endpoint_rw()
  # Assigning wrong values for sigma2betaW.
  object@sigma2betaW <- c(-5:0, Inf)

  expect_equal(
    v_model_dual_endpoint_rw(object),
    "sigma2betaW must be a positive and finite numerical scalar"
  )
})

test_that("v_model_dual_endpoint_rw returns message for wrong sigma2betaW", {
  object <- h_get_dual_endpoint_rw()
  # Assigning wrong values for sigma2betaW.
  object@sigma2betaW <- c(4, -5, b = -Inf)
  object@use_fixed["sigma2betaW"] <- FALSE

  expect_equal(
    v_model_dual_endpoint_rw(object),
    "sigma2betaW must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

# v_model_dual_endpoint_beta ----

test_that("v_model_dual_endpoint_beta passes for valid object", {
  object <- h_get_dual_endpoint_beta()
  object_ff <- h_get_dual_endpoint_beta(fixed = FALSE)

  expect_true(v_model_dual_endpoint_beta(object))
  expect_true(v_model_dual_endpoint_beta(object_ff))
})

test_that("v_model_dual_endpoint_beta returns message for wrong use_fixed", {
  object <- h_get_dual_endpoint_beta()
  # Assigning non-valid use_fixed.
  object@use_fixed <- TRUE

  expect_snapshot(v_model_dual_endpoint_beta(object))
})

test_that("v_model_dual_endpoint_beta returns message for wrong fixed parameters", {
  object <- h_get_dual_endpoint_beta()
  # Assigning wrong values for fixed delta1, mode parameters.
  object@delta1 <- c(-2, 0)
  object@mode <- c(-2, 2)

  expect_snapshot(v_model_dual_endpoint_beta(object))
})

test_that("v_model_dual_endpoint_beta returns message for wrong parameters", {
  object <- h_get_dual_endpoint_beta(fixed = FALSE)
  # Assigning wrong values for E0, Emax, delta1, mode parameters.
  object@E0 <- c(4, -5, b = -Inf)
  object@Emax <- c(4, -5, b = -Inf)
  object@delta1 <- c(4, -5, b = -Inf)
  object@mode <- c(4, -5, b = -Inf)

  expect_snapshot(v_model_dual_endpoint_beta(object))
})

# v_model_dual_endpoint_emax ----

test_that("v_model_dual_endpoint_emax passes for valid object", {
  object <- h_get_dual_endpoint_emax()
  object_ff <- h_get_dual_endpoint_emax(fixed = FALSE)

  expect_true(v_model_dual_endpoint_emax(object))
  expect_true(v_model_dual_endpoint_emax(object_ff))
})

test_that("v_model_dual_endpoint_emax returns message for wrong fixed parameters", {
  object <- h_get_dual_endpoint_emax()
  # Assigning wrong values for fixed E0, Emax, ED50 parameters.
  object@E0 <- c(-2, 0)
  object@Emax <- c(-2, 2)
  object@ED50 <- c(-2, 6)

  expect_snapshot(v_model_dual_endpoint_emax(object))
})

test_that("v_model_dual_endpoint_emax returns message for wrong parameters", {
  object <- h_get_dual_endpoint_emax(fixed = FALSE)
  # Assigning wrong values for E0, Emax, ED50 parameters.
  object@E0 <- c(4, -5, b = -Inf)
  object@Emax <- c(4, -5, b = -Inf)
  object@ED50 <- c(4, -5, b = -Inf)

  expect_snapshot(v_model_dual_endpoint_emax(object))
})

# v_model_logistic_indep_beta ----

test_that("v_model_logistic_indep_beta passes for valid object", {
  object_edat <- h_get_logistic_indep_beta(emptydata = TRUE)
  object <- h_get_logistic_indep_beta(emptydata = FALSE)

  expect_true(v_model_logistic_indep_beta(object_edat))
  expect_true(v_model_logistic_indep_beta(object))
})

test_that("v_model_logistic_indep_beta returns message for wrong DLE parameters", {
  object <- h_get_logistic_indep_beta()
  # Assigning wrong values for binDLE, DLEdose, DLEweights.
  object@binDLE <- c(-2, NA)
  object@DLEdose <- c(3, NA)
  object@DLEweights <- c(4L, NA)
  expect_snapshot(v_model_logistic_indep_beta(object))

  object@binDLE <- -2
  object@DLEdose <- 3
  object@DLEweights <- 4L
  expect_snapshot(v_model_logistic_indep_beta(object))
})

test_that("v_model_logistic_indep_beta returns message for wrong DLE parameters (diff len)", {
  object <- h_get_logistic_indep_beta()
  # Assigning wrong-length values for binDLE, DLEdose, DLEweights.
  object@binDLE <- c(2, 6)
  object@DLEdose <- c(3, 8, 9)
  object@DLEweights <- c(4L, 12L)
  expect_snapshot(v_model_logistic_indep_beta(object))

  object@binDLE <- c(2, 6)
  object@DLEdose <- c(3, 8)
  object@DLEweights <- c(4L, 12L, 20L)
  expect_snapshot(v_model_logistic_indep_beta(object))

  object@binDLE <- c(2, 6)
  object@DLEdose <- c(3, 8, 11)
  object@DLEweights <- c(4L, 12L, 20L)
  expect_snapshot(v_model_logistic_indep_beta(object))
})

test_that("v_model_logistic_indep_beta returns message for wrong phi parameters", {
  object <- h_get_logistic_indep_beta()
  # Assigning non-scalar values for phi1 and phi2.
  object@phi1 <- c(2, 6)
  object@phi2 <- c(3, 8, 9)

  expect_equal(
    v_model_logistic_indep_beta(object),
    c(
      "phi1 must be a numerical scalar",
      "phi2 must be a numerical scalar"
    )
  )
})

test_that("v_model_logistic_indep_beta returns message for wrong Pcov", {
  err_msg <- "Pcov must be 2x2 positive-definite matrix without any missing values"
  object <- h_get_logistic_indep_beta()

  # Assigning wrong Pcov matrix.
  object@Pcov <- matrix(c(1:3, 4, 5, NA), ncol = 2)
  expect_equal(v_model_logistic_indep_beta(object), err_msg)

  object@Pcov <- matrix(c(5, 2, 1, 5), ncol = 2)
  expect_equal(v_model_logistic_indep_beta(object), err_msg)

  object@Pcov <- matrix(c(5, 2, 3, 2, 3, 2, 3, 2, 5), ncol = 3)
  expect_equal(v_model_logistic_indep_beta(object), err_msg)
})

# v_model_eff_log_log ----

test_that("v_model_eff_log_log passes for valid object", {
  object_edat <- h_get_eff_log_log(emptydata = TRUE)
  object <- h_get_eff_log_log(emptydata = FALSE)

  expect_true(v_model_eff_log_log(object_edat))
  expect_true(v_model_eff_log_log(object))
})

test_that("v_model_eff_log_log returns message for wrong eff and eff_dose parameters (NAs)", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for eff, eff_dose (no NA allowed, min len 2).
  object@eff <- c(2, NA)
  object@eff_dose <- c(3, NA)
  expect_equal(
    v_model_eff_log_log(object),
    c(
      "eff must be a finite numerical vector of minimum length 2, without missing values",
      "eff_dose must be a finite numerical vector of the same length as 'eff', without missing values"
    )
  )
})

test_that("v_model_eff_log_log returns message for wrong eff and eff_dose parameters (scalars)", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for eff, eff_dose.
  object@eff <- 2
  object@eff_dose <- 3
  expect_equal(
    v_model_eff_log_log(object),
    "eff must be a finite numerical vector of minimum length 2, without missing values"
  )
})

test_that("v_model_eff_log_log returns message for wrong eff and eff_dose parameters (diff lengths)", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for eff, eff_dose.
  object@eff <- c(20, 50)
  object@eff_dose <- c(4, 6, 7)
  expect_equal(
    v_model_eff_log_log(object),
    "eff_dose must be a finite numerical vector of the same length as 'eff', without missing values"
  )
})

test_that("v_model_eff_log_log returns message for wrong fixed nu", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for nu.
  object@nu <- c(-5:0, Inf)
  object@use_fixed <- TRUE
  expect_equal(
    v_model_eff_log_log(object),
    "nu must be a positive and finite numerical scalar"
  )
})

test_that("v_model_eff_log_log returns message for wrong nu", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for nu.
  object@nu <- c(4, -5, b = -Inf)
  expect_equal(
    v_model_eff_log_log(object),
    "nu must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

test_that("v_model_eff_log_log returns message for wrong use_fixed", {
  object <- h_get_eff_log_log()
  # Assigning non-valid use_fixed.
  object@use_fixed <- c(TRUE, FALSE)
  expect_equal(v_model_eff_log_log(object), "use_fixed must be a flag")
})

test_that("v_model_eff_log_log returns message for wrong const", {
  object <- h_get_eff_log_log()
  err_msg <- "const must be a non-negative number"

  # Assigning non-valid const.
  object@const <- c(5, 6)
  expect_equal(v_model_eff_log_log(object), err_msg)

  object@const <- -4
  expect_equal(v_model_eff_log_log(object), err_msg)
})

test_that("v_model_eff_log_log returns message for dose + const <= 1 (emptydata)", {
  object <- h_get_eff_log_log(emptydata = TRUE)
  # Assigning wrong combination of eff_dose and const.
  object@eff_dose <- c(1, 2)
  object@const <- 0
  expect_equal(
    v_model_eff_log_log(object),
    "For log-log model, doses and const must be such that dose + const > 1"
  )
})

test_that("v_model_eff_log_log returns message for dose + const <= 1", {
  object <- h_get_eff_log_log(emptydata = FALSE)
  # Assigning wrong combination of dose (at observed efficacy) and const.
  object@data@doseGrid[1] <- 1
  object@const <- 0
  expect_equal(
    v_model_eff_log_log(object),
    "For log-log model, doses and const must be such that dose + const > 1"
  )
})

test_that("v_model_eff_log_log returns message for wrong theta1, theta2", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for theta1, theta2.
  object@theta1 <- c(-5, Inf)
  object@theta2 <- c(4, 7)

  expect_equal(
    v_model_eff_log_log(object),
    c("theta1 must be a numerical scalar", "theta2 must be a numerical scalar")
  )
})

test_that("v_model_eff_log_log returns message for wrong Pcov", {
  object <- h_get_eff_log_log()
  err_msg <- "Pcov must be 2x2 positive-definite matrix without any missing values"

  # Assigning wrong Pcov matrix.
  object@Pcov <- matrix(c(1:3, 4, 5, NA), ncol = 2)
  expect_equal(v_model_eff_log_log(object), err_msg)

  object@Pcov <- matrix(c(5, 2, 1, 5), ncol = 2)
  expect_equal(v_model_eff_log_log(object), err_msg)

  object@Pcov <- matrix(c(5, 2, 3, 2, 3, 2, 3, 2, 5), ncol = 3)
  expect_equal(v_model_eff_log_log(object), err_msg)
})

test_that("v_model_eff_log_log returns message for wrong Pcov (data len <= 2)", {
  object <- h_get_eff_log_log(dlt_observed_only = TRUE)
  # Assigning wrong Pcov matrix.
  object@Pcov <- matrix(c(1:3, 4, 5, NA), ncol = 2)
  expect_equal(
    v_model_eff_log_log(object),
    "Pcov must be 2x2 numeric matrix with all values missing if the length of combined data is 2"
  )
})

test_that("v_model_eff_log_log returns message for wrong X (empty data)", {
  object <- h_get_eff_log_log(emptydata = TRUE)
  # Assigning wrong values for X (wrong dimension).
  object@X <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_log_log(object),
    "X must be a finite numerical matrix of size 2 x 2, without any missing values"
  )

  # Assigning wrong values for X (wrong 1st column).
  object@X <- matrix(c(1, 0, 27, 302), ncol = 2)
  expect_equal(
    v_model_eff_log_log(object),
    "X must be a design matrix, i.e. first column must be of 1s"
  )
})

test_that("v_model_eff_log_log returns message for wrong X", {
  object <- h_get_eff_log_log(emptydata = FALSE)
  # Assigning wrong values for X (wrong dimension).
  object@X <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_log_log(object),
    "X must be a finite numerical matrix of size 4 x 2, without any missing values"
  )

  # Assigning wrong values for X (wrong 1st column).
  object@X <- matrix(c(1, 1, 1, 0, 25, 50, 50, 75), ncol = 2)
  expect_equal(
    v_model_eff_log_log(object),
    "X must be a design matrix, i.e. first column must be of 1s"
  )
})

test_that("v_model_eff_log_log returns message for wrong Y (empty data)", {
  object <- h_get_eff_log_log(emptydata = TRUE)
  # Assigning wrong values for Y.
  object@Y <- c(27, 302, 27)
  expect_equal(
    v_model_eff_log_log(object),
    "Y must be a finite numerical vector of length 2 and without any missing values"
  )
})

test_that("v_model_eff_log_log returns message for wrong Y", {
  object <- h_get_eff_log_log(emptydata = FALSE)
  # Assigning wrong values for Y.
  object@Y <- c(0.31, 0.42, 0.59, 0.45, 5)
  expect_equal(
    v_model_eff_log_log(object),
    "Y must be a finite numerical vector of length 4 and without any missing values"
  )
})

test_that("v_model_eff_log_log returns message for wrong mu", {
  object <- h_get_eff_log_log()
  # Assigning wrong values for mu.
  object@mu <- c(4, -5, b = -Inf, NA)
  expect_equal(
    v_model_eff_log_log(object),
    "mu must be a finite numerical vector of length 2"
  )
})

test_that("v_model_eff_log_log returns message for wrong Q", {
  object <- h_get_eff_log_log()
  err_msg <- "Q must be 2x2 positive-definite matrix without any missing values"

  # Assigning wrong Pcov matrix.
  object@Q <- matrix(c(1:3, 4, 5, NA), ncol = 2)
  expect_equal(v_model_eff_log_log(object), err_msg)

  object@Q <- matrix(c(5, 2, 1, 5), ncol = 2)
  expect_equal(v_model_eff_log_log(object), err_msg)

  object@Q <- matrix(c(5, 2, 3, 2, 3, 2, 3, 2, 5), ncol = 3)
  expect_equal(v_model_eff_log_log(object), err_msg)
})

# v_model_eff_flexi ----

test_that("v_model_eff_flexi passes for valid object", {
  object_edat <- h_get_eff_flexi(emptydata = TRUE)
  object <- h_get_eff_flexi(emptydata = FALSE)

  expect_true(v_model_eff_flexi(object_edat))
  expect_true(v_model_eff_flexi(object))
})

test_that("v_model_eff_flexi returns message for wrong eff and eff_dose parameters (NAs)", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for eff, eff_dose (no NA allowed, min len 2).
  object@eff <- c(2, NA)
  object@eff_dose <- c(3, NA)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "eff must be a finite numerical vector of minimum length 2, without missing values",
      "eff_dose must be a finite numerical vector of the same length as 'eff', without missing values"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong eff and eff_dose parameters (scalars)", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for eff, eff_dose.
  object@eff <- 2
  object@eff_dose <- 3
  expect_equal(
    v_model_eff_flexi(object),
    "eff must be a finite numerical vector of minimum length 2, without missing values"
  )
})

test_that("v_model_eff_flexi returns message for wrong eff and eff_dose parameters (diff lengths)", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for eff, eff_dose.
  object@eff <- c(20, 50)
  object@eff_dose <- c(4, 6, 7)
  expect_equal(
    v_model_eff_flexi(object),
    "eff_dose must be a finite numerical vector of the same length as 'eff', without missing values"
  )
})

test_that("v_model_eff_flexi returns message for wrong use_fixed", {
  object <- h_get_eff_flexi()
  # Assigning non-valid use_fixed.
  object@use_fixed <- TRUE

  expect_equal(
    v_model_eff_flexi(object),
    c(
      "use_fixed must be a named logical vector that contains name 'sigma2W'",
      "use_fixed must be a named logical vector that contains name 'sigma2betaW'"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong fixed sigma2W", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for sigma2W.
  object@sigma2W <- c(-5:0, Inf)
  object@use_fixed <- TRUE
  expect_snapshot(v_model_eff_flexi(object))
})

test_that("v_model_eff_flexi returns message for wrong sigma2W", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for sigma2W.
  object@sigma2W <- c(4, -5, b = -Inf)
  expect_equal(
    v_model_eff_flexi(object),
    "sigma2W must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

test_that("v_model_eff_flexi returns message for wrong fixed sigma2betaW", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for sigma2betaW.
  object@sigma2betaW <- c(-5:0, Inf)
  object@use_fixed <- TRUE
  expect_snapshot(v_model_eff_flexi(object))
})

test_that("v_model_eff_flexi returns message for wrong sigma2betaW", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for sigma2betaW.
  object@sigma2betaW <- c(4, -5, b = -Inf)
  expect_equal(
    v_model_eff_flexi(object),
    "sigma2betaW must be a named numerical vector of length two with positive finite values and names 'a', 'b'"
  )
})

test_that("v_model_eff_flexi returns message for wrong rw1", {
  object <- h_get_eff_flexi()
  # Assigning non-valid rw1.
  object@rw1 <- c(TRUE, FALSE)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "rw1 must be a flag",
      "RW_rank must be an integer equal to data@nGrid - 2L"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong ncol of X (empty data)", {
  object <- h_get_eff_flexi(emptydata = TRUE)
  # Assigning wrong values for X (wrong ncol).
  object@X <- matrix(c(1, 1, 1, 0, 0, 1), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    "X must be an integer matrix with 12 columns and without any missing values"
  )
})

test_that("v_model_eff_flexi returns message for wrong X (empty data)", {
  object <- h_get_eff_flexi(emptydata = TRUE)
  # Assigning wrong values for X (wrong values and ncol).
  object@X <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "X must be an integer matrix with 12 columns and without any missing values",
      "X must be a matrix with 0-1 values only"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong ncol of X", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for X (wrong ncol).
  object@X <- matrix(c(1, 1, 1, 0, 0, 1), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    "X must be an integer matrix with 12 columns and without any missing values"
  )
})

test_that("v_model_eff_flexi returns message for wrong X", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for X (wrong values and ncol).
  object@X <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "X must be an integer matrix with 12 columns and without any missing values",
      "X must be a matrix with 0-1 values only"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong RW", {
  object <- h_get_eff_flexi()
  # Assigning wrong values for X (wrong dimension and va).
  object@RW <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "RW must be 12x12 matrix without any missing values"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong RW (RW2)", {
  object <- h_get_eff_flexi(rw1 = FALSE)
  # Assigning wrong values for RW (wrong dimension).
  object@RW <- matrix(c(1, 1, 1, 27, 302, 27), ncol = 2)
  expect_equal(
    v_model_eff_flexi(object),
    c(
      "RW must be 12x12 matrix without any missing values"
    )
  )
})

test_that("v_model_eff_flexi returns message for wrong RW_rank", {
  object <- h_get_eff_flexi()
  err_msg <- "RW_rank must be an integer equal to data@nGrid - 2L"

  # Assigning wrong RW_rank.
  object@RW_rank <- c(5L, 6L)
  expect_equal(v_model_eff_flexi(object), err_msg)

  object@RW_rank <- 5L
  expect_equal(v_model_eff_flexi(object), err_msg)
})

# v_model_da_logistic_log_normal ----

test_that("v_model_da_logistic_log_normal passes for valid object", {
  object <- h_get_da_logistic_log_normal()
  expect_true(v_model_da_logistic_log_normal(object))
})

test_that("v_model_da_logistic_log_normal returns message for wrong npiece", {
  object <- h_get_da_logistic_log_normal()

  # Assigning wrong npiece.
  object@npiece <- c(5L, 6L)
  expect_equal(
    v_model_da_logistic_log_normal(object),
    "npiece must be a is a single integerish value"
  )
})

test_that("v_model_da_logistic_log_normal returns message for wrong l vector", {
  object <- h_get_da_logistic_log_normal()
  err_msg <- "prior parameter vector l of lambda must be a non-negative vector of length equal to npiece"

  # Assigning wrong l.
  object@l <- c(5L, 6L, Inf)
  expect_equal(v_model_da_logistic_log_normal(object), err_msg)

  object@l <- 5L
  expect_equal(v_model_da_logistic_log_normal(object), err_msg)
})

test_that("v_model_da_logistic_log_normal returns message for wrong c_par", {
  object <- h_get_da_logistic_log_normal()

  # Assigning wrong c_par.
  object@c_par <- c(5, 6, Inf)
  expect_equal(
    v_model_da_logistic_log_normal(object),
    "c_par must be a finite numerical scalar"
  )
})

test_that("v_model_da_logistic_log_normal returns message for wrong cond_pem", {
  object <- h_get_da_logistic_log_normal()

  # Assigning non-valid cond_pem.
  object@cond_pem <- c(TRUE, FALSE)
  expect_equal(
    v_model_da_logistic_log_normal(object),
    "cond_pem must be a flag"
  )
})

# v_model_tite_logistic_log_normal ----

test_that("v_model_tite_logistic_log_normal passes for valid object", {
  object <- h_get_tite_logistic_log_normal()
  expect_true(v_model_tite_logistic_log_normal(object))
})

test_that("v_model_tite_logistic_log_normal returns message for wrong weight_method", {
  object <- h_get_tite_logistic_log_normal()
  err_msg <- "weight_method must be a string equal either to linear or adaptive"

  # Assigning wrong weight_method.
  object@weight_method <- "linearadaptive"
  expect_equal(v_model_tite_logistic_log_normal(object), err_msg)

  object@weight_method <- c("linear", "adaptive")
  expect_equal(v_model_tite_logistic_log_normal(object), err_msg)
})

# v_model_one_par_exp_normal_prior ----

test_that("v_model_one_par_exp_normal_prior passes for valid object", {
  object <- h_get_one_par_log_normal_prior()
  expect_true(v_model_one_par_exp_normal_prior(object))
})

test_that("v_model_one_par_exp_normal_prior passes for valid object (finit art. prec. interpolation)", {
  object <- OneParLogNormalPrior(
    skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
    dose_grid = 1:5,
    sigma2 = 2
  )
  expect_true(v_model_one_par_exp_normal_prior(object))
})

test_that("v_model_one_par_exp_normal_prior returns message for wrong skel_fun - skel_fun_inv", {
  object <- h_get_one_par_log_normal_prior()

  # Assigning wrong skel_fun/skel_fun_inv
  object@skel_fun <- function(x) 2 * x
  object@skel_fun_inv <- function(x) x^2
  expect_equal(
    v_model_one_par_exp_normal_prior(object),
    c(
      "skel_fun_inv must be an inverse funtion of skel_fun function on within the range of sekeleton probs",
      "skel_fun_inv must be an inverse funtion of skel_fun function on outside the range of sekeleton probs"
    )
  )
})

test_that("v_model_one_par_exp_normal_prior returns message for wrong skel_probs", {
  object <- h_get_one_par_log_normal_prior()
  err_msg <- "skel_probs must be a unique sorted probability values between 0 and 1"

  # Assigning wrong skel_probs.
  object@skel_probs <- c(-1, 0.5, Inf)
  expect_equal(v_model_one_par_exp_normal_prior(object), err_msg)

  # Assigning non-unique skel_probs.
  object@skel_probs <- c(0.2, 0.2)
  expect_equal(v_model_one_par_exp_normal_prior(object), err_msg)

  # Assigning not sorted skel_probs.
  object@skel_probs <- c(0.2, 0.1)
  expect_equal(v_model_one_par_exp_normal_prior(object), err_msg)
})

test_that("v_model_one_par_exp_normal_prior returns message for wrong sigma2", {
  object <- h_get_one_par_log_normal_prior()
  err_msg <- "sigma2 must be a positive finite number"

  # Assigning wrong sigma2.
  object@sigma2 <- -1
  expect_equal(v_model_one_par_exp_normal_prior(object), err_msg)

  # Assigning sigma2 which is not a scalar.
  object@sigma2 <- 1:2
  expect_equal(v_model_one_par_exp_normal_prior(object), err_msg)
})

# v_model_one_par_exp_prior ----

test_that("v_model_one_par_exp_prior passes for valid object", {
  object <- h_get_one_par_exp_prior()
  expect_true(v_model_one_par_exp_prior(object))
})

test_that("v_model_one_par_exp_prior passes for valid object (finit art. prec. interpolation)", {
  object <- OneParExpPrior(
    skel_probs = c(0.1, 0.3, 0.5, 0.7, 0.9),
    dose_grid = 1:5,
    lambda = 2
  )
  expect_true(v_model_one_par_exp_prior(object))
})

test_that("v_model_one_par_exp_prior returns message for wrong skel_fun - skel_fun_inv", {
  object <- h_get_one_par_exp_prior()

  # Assigning wrong skel_fun/skel_fun_inv
  object@skel_fun <- function(x) 2 * x
  object@skel_fun_inv <- function(x) x^2
  expect_equal(
    v_model_one_par_exp_prior(object),
    c(
      "skel_fun_inv must be an inverse funtion of skel_fun function on within the range of sekeleton probs",
      "skel_fun_inv must be an inverse funtion of skel_fun function on outside the range of sekeleton probs"
    )
  )
})

test_that("v_model_one_par_exp_prior returns message for wrong skel_probs", {
  object <- h_get_one_par_exp_prior()
  err_msg <- "skel_probs must be a unique sorted probability values between 0 and 1"

  # Assigning wrong skel_probs.
  object@skel_probs <- c(-1, 0.5, Inf)
  expect_equal(v_model_one_par_exp_prior(object), err_msg)

  # Assigning non-unique skel_probs.
  object@skel_probs <- c(0.2, 0.2)
  expect_equal(v_model_one_par_exp_prior(object), err_msg)

  # Assigning not sorted skel_probs.
  object@skel_probs <- c(0.2, 0.1)
  expect_equal(v_model_one_par_exp_prior(object), err_msg)
})

test_that("v_model_one_par_exp_prior returns message for wrong lambda", {
  object <- h_get_one_par_exp_prior()
  err_msg <- "lambda must be a positive finite number"

  # Assigning wrong lambda.
  object@lambda <- -1
  expect_equal(v_model_one_par_exp_prior(object), err_msg)

  # Assigning lambda which is not a scalar.
  object@lambda <- 1:2
  expect_equal(v_model_one_par_exp_prior(object), err_msg)
})

# v_logisticlognormalordinal ----
test_that("LogisticLogNormalOrdinal accepts only diagonal covariance matrices", {
  expect_no_error(
    LogisticLogNormalOrdinal(
      mean = c(3, 4, 0),
      cov = diag(c(4, 3, 1)),
      ref_dose = 1
    )
  )

  expect_error(
    LogisticLogNormalOrdinal(
      mean = c(3, 4, 0),
      cov = matrix(c(4, -0.1, -0.1, -0.1, 3, -0.1, -0.1, -0.1, 1), ncol = 3),
      ref_dose = 1
    ),
    "invalid class \"LogisticLogNormalOrdinal\" object\\: covariance matrix must be diagonal"
  )
})