Nothing
context("test-src_impute_data.R")
test_that("Test observation_impute_cpp", {
# Example data -----------
if (requireNamespace("datasets", quietly = TRUE)) {
data("mtcars", package = "datasets")
rownames(mtcars) <- NULL
mtcars <- as.matrix(mtcars)
# Example -----------
m <- 3
n_combinations <- 2^m
mtcars <- mtcars[1:15, seq(m)]
ntrain <- 14
xtrain <- mtcars[seq(ntrain), ]
xtest <- mtcars[-seq(ntrain), , drop = FALSE]
S <- matrix(0L, n_combinations, m)
features <- list(
integer(), 1, 2, 3, c(1, 2), c(1, 3), c(2, 3), c(1, 2, 3)
)
for (i in seq_along(features)) {
feature_i <- features[[i]]
if (length(feature_i) > 0) {
S[i, features[[i]]] <- 1L
}
}
# Tests (invalid input) -----------
expect_error(
observation_impute_cpp(
index_xtrain = c(1, 2),
index_s = c(1, 2, 3),
xtrain = xtrain,
xtest = xtest,
S = S
)
)
expect_error(
observation_impute_cpp(
index_xtrain = c(1, 2),
index_s = c(2, 3),
xtrain = xtrain[, 1:2],
xtest = xtest,
S = S
)
)
# Tests (valid input) -----------
index_xtrain <- c(1, 2)
index_s <- c(4, 5)
x <- observation_impute_cpp(
index_xtrain = index_xtrain,
index_s = index_s,
xtrain = xtrain,
xtest = xtest,
S = S
)
expect_equal(nrow(x), length(index_s))
expect_equal(ncol(x), ncol(xtrain))
expect_true(is.matrix(x))
expect_true(is.double(x))
for (i in 1:nrow(x)) {
feature_i <- features[[index_s[i]]]
for (j in seq(m)) {
if (j %in% feature_i) {
expect_equal(x[i, j], unname(xtest[1, j]))
} else {
expect_equal(x[i, j], unname(xtrain[index_xtrain[i], j]))
}
}
}
}
})
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.