test_that("Component construction: linear model", {
df <- data.frame(x = 1:10, response = 1:10)
llik <- like_list(list(like(formula = response ~ ., data = df)))
# Using label as input:
cmp0 <- component_list(
list(component("x", x)),
lhoods = llik
)[["x"]]
expect_equal(cmp0$label, "x")
expect_equal(cmp0$main$model, "linear")
expect_equal(as.character(cmp0$main$input$input), "x")
# Using label as input:
cmp0 <- component_list(
~x,
lhoods = llik
)[["x"]]
expect_equal(cmp0$label, "x")
expect_equal(cmp0$main$model, "linear")
expect_equal(as.character(cmp0$main$input$input), "x")
cmp <- component_list(
~ beta(main = x, model = "linear", values = 1),
lhoods = llik
)[["beta"]]
expect_equal(cmp$label, "beta")
expect_equal(cmp$main$model, "linear")
expect_equal(as.character(cmp$main$input$input), "x")
# Covariate mapping
df <- data.frame(x = 1:10)
inp <- input_eval(cmp, data = df)
expect_equal(
inp,
list(
mapper = list(
main = 1:10,
group = 1,
replicate = 1
),
scale = NULL
)
)
idx <- index_eval(cmp, inla_f = FALSE)
expect_type(idx, "list")
expect_equal(names(idx)[1], "beta")
expect_equal(names(idx)[2], "beta.group")
expect_equal(names(idx)[3], "beta.repl")
expect_equal(idx$beta, 1)
# A-matrix
comp_lin <- comp_lin_eval(cmp, input = inp, inla_f = FALSE)
A <- ibm_jacobian(comp_lin)
expect_s4_class(A, "dgCMatrix")
expect_equal(nrow(A), 10)
expect_equal(ncol(A), 1)
expect_equal(as.vector(A), 1:10)
# Value
v <- evaluate_effect_single_state(comp_lin, state = 2)
expect_equal(v, 2 * df$x, ignore_attr = TRUE)
v <- evaluate_effect_single_state(comp_lin, state = 2, A = A)
expect_equal(v, 2 * df$x, ignore_attr = TRUE)
cmps <- component_list(list(cmp))
inps <- input_eval(cmps, data = df)
v <- evaluate_effect_multi_state(
cmps,
input = inps,
state = list(list(beta = 2))
)
expect_equal(v[[1]][["beta"]], 2 * df$x, ignore_attr = TRUE)
v <- evaluate_effect_multi_state(
cmps,
input = inps,
state = list(list(beta = 2))
)
expect_equal(v[[1]][["beta"]], 2 * df$x, ignore_attr = TRUE)
})
test_that("Component construction: duplicate detection", {
expect_error(
component_list(
~ -1 +
beta(main = x, model = "linear", values = 1) +
beta(main = x, model = "linear", values = 2)
),
regexp = "Duplicated component labels detected: 'beta'"
)
})
test_that("Component construction: offset", {
cmp <- component_list(~ -1 + something(a, model = "offset"))
inp <- input_eval(cmp, data = data.frame(a = 11:15))
val <- evaluate_effect_single_state(cmp,
input = inp,
state = NULL
)
expect_equal(
val$something,
11:15,
ignore_attr = TRUE
)
})
test_that("Component construction: terra", {
skip_if_not_installed("sf")
skip_if_not_installed("terra")
f <- system.file("ex/elev.tif", package = "terra")
r <- terra::rast(f)
data <- sf::st_sf(
data.frame(
geometry = sf::st_sfc(
sf::st_point(cbind(6, 50)),
crs = "epsg:4326"
),
response = 1
)
)
expect_equal(eval_spatial(r, data), 406)
llik <- like_list(list(like(formula = response ~ ., data = data)))
cmp <- component_list(
~ -1 + something(eval_spatial(r, geometry), model = "linear"),
lhoods = llik
)
inp <- input_eval(cmp, data = data)
comp_lin <- comp_lin_eval(cmp,
input = inp,
state = list(something = 2),
inla_f = FALSE
)
val <- evaluate_effect_single_state(
comp_lin,
state = list(something = 2)
)
expect_equal(
val$something,
2 * 406
)
cmp <- component_list(~ -1 + something(r, model = "linear"),
lhoods = llik
)
inp <- input_eval(cmp, data = data)
comp_lin <- comp_lin_eval(cmp,
input = inp,
state = list(something = 2),
inla_f = FALSE
)
val <- evaluate_effect_single_state(
comp_lin,
state = list(something = 2)
)
expect_equal(
val$something,
2 * 406
)
cmp <- component_list(~ -1 + something(r, model = "linear", main_layer = 1),
lhoods = llik
)
inp <- input_eval(cmp, data = data)
comp_lin <- comp_lin_eval(cmp,
input = inp,
state = list(something = 2),
inla_f = FALSE
)
val <- evaluate_effect_single_state(
comp_lin,
state = list(something = 2)
)
expect_equal(
val$something,
2 * 406
)
cmp <- component_list(~ -1 + something(r, model = "linear", main_layer = "elevation"),
lhoods = llik
)
inp <- input_eval(cmp, data = data)
comp_lin <- comp_lin_eval(cmp,
input = inp,
state = list(something = 2),
inla_f = FALSE
)
val <- evaluate_effect_single_state(
comp_lin,
state = list(something = 2)
)
expect_equal(
val$something,
2 * 406
)
expect_error(
component_list(~ something(r, model = "linear", main_layer = 2),
lhoods = llik
),
NULL
)
expect_error(
component_list(~ something(r, model = "linear", main_layer = "elev"),
lhoods = llik
),
NULL
)
})
test_that("Component construction: default index/mesh/mapping construction", {
skip_on_cran()
local_bru_safe_inla()
lik <- like("gaussian",
formula = y ~ .,
data = data.frame(x = c(1, 1.5, 2, NA, 4), y = 11:15),
include = "effect"
)
cmp1 <- component_list(~ effect(c(1, 1.5, 2, NA, 4), model = "iid") - 1)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$main,
sort(unique(lik$data$x), na.last = NA)
)
expect_equal(
ibm_eval(cmp2$effect$mapper$mappers$mapper$mappers$main,
input = c(1, NA, 4),
state = c(11, 12, 13, 14)
),
c(11, 0, 14)
)
cmp1 <- component_list(~ effect(x, model = "rw2") - 1)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$main,
sort(unique(lik$data$x), na.last = NA)
)
mesh1 <- fm_mesh_1d(
sort(unique(lik$data$x), na.last = NA)
)
expect_error(
component_list(
~ effect(x, model = "rw2", mapper = mesh1) - 1
),
regexp = "Unknown mapper"
)
cmp1 <- component_list(
~ effect(x,
model = "rw2",
mapper = bru_mapper(mesh1, indexed = FALSE)
) - 1
)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$main,
sort(unique(lik$data$x), na.last = NA)
)
cmp1 <- component_list(
~ effect(x,
model = "rw2",
mapper = bru_mapper(mesh1, indexed = TRUE)
) - 1
)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$main,
seq_along(sort(unique(lik$data$x), na.last = NA))
)
})
test_that("Component construction: main iid factor construction", {
skip_on_cran()
lik <- like("gaussian",
formula = y ~ .,
data = data.frame(x = as.factor(c(1, 1.5, 2, 3, 4)), y = 11:15),
include = "effect"
)
cmp1 <- component_list(~ effect(as.factor(c(1, 1.5, 2, 3, 4)),
model = "iid"
) - 1)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$main,
as.character(lik$data$x)
)
expect_equal(
ibm_eval(cmp2$effect$mapper$mappers$mapper$mappers$main,
input = as.factor(c(1, NA, 4)),
state = c(11, 12, 13, 14, 15)
),
c(11, 0, 15)
)
})
test_that("Component construction: group iid factor construction", {
skip_on_cran()
lik <- like("gaussian",
formula = y ~ .,
data = data.frame(x = as.factor(c(1, 1.5, 2, 3, 4)), y = 11:15),
include = "effect"
)
cmp1 <- component_list(
~ -1 +
effect(rep(1, 5),
group = x,
model = "iid",
control.group = list(model = "iid")
)
)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$group,
as.numeric(lik$data$x)
)
expect_equal(
ibm_eval(cmp2$effect$mapper$mappers$mapper$mappers$group,
input = as.factor(c(1, NA, 4)),
state = c(11, 12, 13, 14, 15)
),
c(11, 0, 15)
)
local_bru_safe_inla()
expect_no_error(bru(cmp2, lik))
})
test_that("Component construction: replicate iid factor construction", {
skip_on_cran()
lik <- like("gaussian",
formula = y ~ .,
data = data.frame(x = as.factor(c(1, 1.5, 2, 3, 4)), y = 11:15),
include = "effect"
)
cmp1 <- component_list(
~ -1 +
effect(rep(1, 5),
replicate = x,
model = "iid"
)
)
cmp2 <- add_mappers(cmp1, lhoods = like_list(list(lik)))
expect_equal(
ibm_values(cmp2$effect$mapper, multi = 1)$replicate,
as.numeric(lik$data$x)
)
expect_equal(
ibm_eval(cmp2$effect$mapper$mappers$mapper$mappers$replicate,
input = as.factor(c(1, NA, 4)),
state = c(11, 12, 13, 14, 15)
),
c(11, 0, 15)
)
local_bru_safe_inla()
expect_no_error(bru(cmp2, lik))
})
test_that("Component construction: unsafe intercepts", {
cmp <- component_list(~ something_unknown - 1)
lik <- like(formula = response ~ ., data = data.frame(response = 1:5))
expect_warning(
object = {
model <- bru_model(cmp, like_list(list(lik)))
},
"All covariate evaluations for 'something_unknown' are NULL"
)
})
test_that("Component construction: deprecated arguments", {
expect_warning(
component_list(~ something(map = a)),
"Use of 'map' is deprecated"
)
skip_on_cran()
local_bru_safe_inla()
expect_warning(
bru(~ something(map = a),
formula = response ~ .,
data = data.frame(a = 1:5, response = 11:15),
options = list(bru_run = FALSE)
),
"Use of 'map' is deprecated"
)
})
test_that("Component inputs: non-numeric input detection", {
skip_on_cran()
local_bru_safe_inla()
bnd <- spoly(data.frame(
x = c(-15, 15, 15, -15),
y = c(25, 25, 50, 50)
))
mesh <- fm_mesh_2d_inla(boundary = bnd, max.edge = 100)
matern <-
INLA::inla.spde2.pcmatern(mesh,
prior.sigma = c(0.1, 0.01),
prior.range = c(1, 0.01)
)
df <- sf::st_as_sf(
data.frame(x = runif(10, -10, 10), y = runif(10, 30, 45), obs = rnorm(10)),
coords = c("x", "y")
)
# No model specified (argument unnamed), geometry invalid for bru_mapper_linear:
cmp <- ~ Intercept(1) + field(geometry, matern)
lk <- like(formula = obs ~ ., data = df, family = "gaussian")
model <- bru_model(component_list(cmp), c(lk))
expect_error(
ibm_eval(bru_mapper_linear(), input = df$geometry, state = 1),
"The input to a bru_mapper_linear evaluation must be numeric or logical."
)
cmp <- ~ Intercept(1) + field(geometry, matern, model = matern)
lk <- like(formula = obs ~ ., data = df, family = "gaussian")
model <- bru_model(component_list(cmp), c(lk))
input <- input_eval(model$effects$field, data = df)
expect_error(
ibm_eval(
model$effects$field$mapper,
input = input,
state = rep(1, fm_dof(mesh))
),
"The input to a bru_mapper_scale evaluation must be numeric or logical."
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.