Nothing
# 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."
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.