Nothing
test_that("`new_apd_hat_values` arguments are assigned correctly", {
x <- new_apd_hat_values(
"XtX_inv",
"pctls",
blueprint = hardhat::default_xy_blueprint()
)
expect_equal(names(x), c("XtX_inv", "pctls", "blueprint"))
expect_equal(x$XtX_inv, "XtX_inv")
expect_equal(x$pctls, "pctls")
expect_equal(x$blueprint, hardhat::default_xy_blueprint())
})
test_that("XtX_inv is provided", {
expect_snapshot(error = TRUE,
new_apd_hat_values(blueprint = hardhat::default_xy_blueprint())
)
})
test_that("`new_apd_hat_values` fails when blueprint is numeric", {
expect_snapshot(error = TRUE,
new_apd_hat_values(XtX_inv = 1, blueprint = 1)
)
})
test_that("`new_apd_hat_values` returned blueprint is of class hardhat_blueprint", {
x <- new_apd_hat_values(
"XtX_inv",
"pctls",
blueprint = hardhat::default_xy_blueprint()
)
expect_s3_class(x$blueprint, "hardhat_blueprint")
})
test_that("`apd_hat_values` fails when model is not of class apd_hat_values", {
model <- apd_hat_values(~ Sepal.Length + Species, iris)
expect_s3_class(model, "apd_hat_values")
})
test_that("`apd_hat_values` fails when model is not of class hardhat_model", {
model <- apd_hat_values(~ Sepal.Length + Species, iris)
expect_s3_class(model, "hardhat_model")
})
test_that("`apd_hat_values` is defined for data.frame objects", {
x <- apd_hat_values(mtcars)
X <- as.matrix(mtcars)
XpX <- t(X) %*% X
XtX_inv <- qr.solve(XpX)
dimnames(XtX_inv) <- NULL
expect_equal(class(x), c("apd_hat_values", "hardhat_model", "hardhat_scalar"))
expect_equal(names(x), c("XtX_inv", "pctls", "blueprint"))
expect_equal(x$XtX_inv, XtX_inv)
})
test_that("`apd_hat_values` is defined for formula objects", {
x <- apd_hat_values(~ Sepal.Width + Sepal.Length, iris)
X <- as.matrix(iris %>% select(Sepal.Width, Sepal.Length))
XpX <- t(X) %*% X
XtX_inv <- qr.solve(XpX)
dimnames(XtX_inv) <- NULL
expect_equal(class(x), c("apd_hat_values", "hardhat_model", "hardhat_scalar"))
expect_equal(names(x), c("XtX_inv", "pctls", "blueprint"))
expect_equal(x$XtX_inv, XtX_inv)
})
test_that("`apd_hat_values` is defined for recipe objects", {
rec <- recipes::recipe(~ Sepal.Width + Sepal.Length, iris)
x <- apd_hat_values(rec, data = iris)
X <- as.matrix(iris %>% select(Sepal.Width, Sepal.Length))
XpX <- t(X) %*% X
XtX_inv <- qr.solve(XpX)
dimnames(XtX_inv) <- NULL
expect_equal(class(x), c("apd_hat_values", "hardhat_model", "hardhat_scalar"))
expect_equal(names(x), c("XtX_inv", "pctls", "blueprint"))
expect_equal(x$XtX_inv, XtX_inv)
})
test_that("`apd_hat_values` is defined for matrix objects", {
X <- as.matrix(iris %>% select(-Species))
x <- apd_hat_values(X)
XpX <- t(X) %*% X
XtX_inv <- qr.solve(XpX)
dimnames(XtX_inv) <- NULL
expect_equal(class(x), c("apd_hat_values", "hardhat_model", "hardhat_scalar"))
expect_equal(names(x), c("XtX_inv", "pctls", "blueprint"))
expect_equal(x$XtX_inv, XtX_inv)
})
test_that("`apd_hat_values` is not defined for vectors", {
cls <- class(mtcars$mpg)[1]
expected_message <- glue::glue("`x` is not of a recognized type.
Only data.frame, matrix, recipe, and formula objects are allowed.
A {cls} was specified.")
expect_condition(
apd_hat_values(mtcars$mpg),
expected_message
)
})
test_that("`apd_hat_values` fails when matrix has more predictors than samples", {
bad_data <- mtcars %>%
slice(1:5)
expect_snapshot(error = TRUE,
apd_hat_values(bad_data)
)
})
test_that("`apd_hat_values` fails when the matrix X^tX is singular", {
bad_data <- matrix(
rep(0, 6),
nrow = 3
)
colnames(bad_data) <- c("A", "B")
expect_snapshot(error = TRUE,
apd_hat_values(bad_data)
)
})
test_that("`get_inv` behaves correctly when the input is not a matrix", {
X <- c(1:5)
expect_error(get_inv(X), NA)
})
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.