Nothing
# Test data_slice() methods
test_that("data_slice works for a GAM", {
expect_silent(ds <- data_slice(su_m_quick_eg1,
x1 = evenly(x1, n = 50),
x2 = evenly(x2, n = 50), data = quick_eg1, envir = teardown_env()
))
expect_s3_class(ds, "tbl_df")
expect_named(ds, c("x1", "x2", "x0", "x3"))
expect_message(
data_slice(su_m_quick_eg1,
x1 = evenly(x1, n = 50), var2 = "foo",
data = quick_eg1, envir = teardown_env()
),
"Some specified variable\\(s\\) not used in model"
)
expect_message(
data_slice(su_m_quick_eg1,
x1 = evenly(x1, n = 50), var2 = "foo",
data = quick_eg1, envir = teardown_env()
),
"var2"
)
})
test_that("process_slice_data works when passed a 1-row data frame, tibble, or list", {
expect_silent(result1 <- process_slice_data(quick_eg1[1, ]))
expect_silent(result2 <- process_slice_data(as_tibble(quick_eg1[1, ])))
expect_silent(result3 <- process_slice_data(as.list(quick_eg1[1, ])))
expect_equal(NROW(result1), 1L)
expect_equal(NROW(result2), 1L)
expect_equal(NROW(result3), 1L)
expect_equal(result1, result2)
expect_equal(result1, result3)
expect_equal(result2, result3)
})
test_that("process_slice_data fails when passed a data frame with > 1 rows", {
expect_error(process_slice_data(quick_eg1),
"'data' should have 1 row only. Supplied <300>",
fixed = TRUE
)
})
test_that("process_slice_data fails when passed a matrix", {
expect_error(process_slice_data(as.matrix(quick_eg1)),
"'data' should be a tibble, data frame, or list. Supplied <matrix>",
fixed = TRUE
)
})
test_that("process_slice_data fails when passed a list with elements of length > 1", {
expect_error(process_slice_data(as.list(quick_eg1[1:2, ])),
"If 'data' is a list, it should be a list of length-1 vectors",
fixed = TRUE
)
})
test_that("process_slice_var fails when passed a logical variable", {
dat2 <- cbind(quick_eg1,
foo = sample(c(TRUE, FALSE), nrow(quick_eg1), replace = TRUE)
)
expect_error(process_slice_var("foo", dat2),
"Variable <foo> must be a factor or numeric vector. Found <character>",
fixed = TRUE
)
})
test_that("process_slice_var fails when `x` is not character", {
bar <- 1
expect_error(process_slice_var(bar, dat2),
"Supplied 'x' is not character.",
fixed = TRUE
)
})
test_that("process_slice_var returns NULL when `x` is NULL", {
expect_identical(process_slice_var(NULL, dat2), NULL)
})
test_that("data_slice works for a GAM with factor by", {
expect_silent(ds <- data_slice(su_m_factor_by,
x2 = evenly(x2),
fac = evenly(fac),
data = su_eg4, envir = teardown_env()
))
expect_s3_class(ds, "tbl_df")
expect_named(ds, c("x2", "fac", "x0"))
})
test_that("default data_slice method fails gracefully", {
expect_error(data_slice(1:10),
"Don't know how to create a data slice from <integer>",
fixed = TRUE
)
})
test_that("value_closest_to_median fails for character vectors", {
expect_error(value_closest_to_median(LETTERS),
"'x' must be a factor or numeric vector. Supplied <character>",
fixed = TRUE
)
})
test_that("value_closest_to_median fails for logical vectors", {
expect_error(
value_closest_to_median(sample(c(TRUE, FALSE), 50,
replace = TRUE
)),
"'x' must be a factor or numeric vector. Supplied <logical>",
fixed = TRUE
)
})
test_that("value_closest_to_median works with a factor", {
expect_silent(result <-
gratia:::value_closest_to_median(su_eg4[["fac"]]))
expect_identical(factor(1, levels = c(1, 2, 3)), result)
})
# typical_values()
test_that("typical_values works with a simple GAM", {
expect_silent(tv <- typical_values(su_m_quick_eg1,
data = quick_eg1, envir = teardown_env()
))
expect_s3_class(tv, "tbl_df")
expect_identical(nrow(tv), 1L)
expect_identical(ncol(tv), 4L)
})
test_that("typical_values works when including terms", {
expect_silent(tv <- typical_values(su_m_quick_eg1,
vars = c(x0, x2),
data = quick_eg1, envir = teardown_env()
))
expect_s3_class(tv, "tbl_df")
expect_identical(nrow(tv), 1L)
expect_identical(ncol(tv), 2L)
expect_identical(names(tv), c("x0", "x2"))
})
test_that("typical_values works when excluding terms", {
expect_silent(tv <- typical_values(su_m_quick_eg1,
vars = !c(x0, x2),
data = quick_eg1, envir = teardown_env()
))
expect_s3_class(tv, "tbl_df")
expect_identical(nrow(tv), 1L)
expect_identical(ncol(tv), 2L)
expect_identical(names(tv), c("x1", "x3"))
})
# factor_combos()
test_that("factor_combos works with a simple GAM", {
expect_silent(fc <- factor_combos(m_para_sm))
expect_s3_class(fc, "tbl_df")
expect_identical(nrow(fc), 12L)
expect_identical(ncol(fc), 2L)
expect_named(fc, c("fac", "ff"))
})
test_that("factor_combos works when including terms", {
expect_silent(fc <- factor_combos(m_para_sm, vars = fac))
expect_s3_class(fc, "tbl_df")
expect_identical(nrow(fc), 3L)
expect_identical(ncol(fc), 1L)
expect_named(fc, c("fac"))
})
test_that("factor_combos works when excluding terms", {
expect_silent(fc <- factor_combos(m_para_sm, vars = !fac))
expect_s3_class(fc, "tbl_df")
expect_identical(nrow(fc), 4L)
expect_identical(ncol(fc), 1L)
expect_named(fc, c("ff"))
})
test_that("factor_combos works when there are no factor terms", {
expect_silent(fc <- factor_combos(m_gam, vars = !fac))
expect_identical(fc, NULL)
})
# data_combos()
test_that("data_combos works with a GAM", {
expect_silent(dc <- data_combos(m_para_sm,
envir = teardown_env(), data = df_2_fac
))
expect_s3_class(dc, "tbl_df")
expect_identical(nrow(dc), 12L)
expect_identical(ncol(dc), 5L)
expect_named(dc, c("fac", "ff", "x0", "x1", "x2"))
})
test_that("data_combos works when including terms", {
expect_silent(dc <- data_combos(m_para_sm,
vars = c(fac, x0),
data = df_2_fac, envir = teardown_env()
))
expect_s3_class(dc, "tbl_df")
expect_identical(nrow(dc), 12L)
expect_identical(ncol(dc), 2L)
expect_named(dc, c("fac", "x0"))
})
test_that("data_combos works when exluding terms", {
expect_silent(dc <- data_combos(m_para_sm,
vars = !c(fac, x0),
data = df_2_fac, envir = teardown_env()
))
expect_s3_class(dc, "tbl_df")
expect_identical(nrow(dc), 12L)
expect_identical(ncol(dc), 3L)
expect_named(dc, c("ff", "x1", "x2"))
})
test_that("data_combos works when there are no factor terms", {
expect_silent(dc <- data_combos(m_gam,
data = su_eg1, envir = teardown_env()
))
expect_identical(nrow(dc), 1L)
expect_identical(ncol(dc), 4L)
expect_named(dc, c("x0", "x1", "x2", "x3"))
})
# Test data_slice with models that have an offset(s) - # 189
test_that("data_slice with no args works with models with an offset", {
expect_silent(ds <- data_slice(m_1_smooth_offset,
data = quick_eg1_off, envir = teardown_env()
))
expect_identical(nrow(ds), 1L)
expect_identical(ncol(ds), 2L)
expect_identical(ds$off, 2)
})
test_that("data_slice with works with models with an offset", {
expect_silent(ds <- data_slice(m_1_smooth_offset,
off = 1,
data = quick_eg1_off, envir = teardown_env()
))
expect_identical(nrow(ds), 1L)
expect_identical(ncol(ds), 2L)
expect_identical(ds$off, 1)
})
test_that("data_slice with works with models with an offset", {
expect_silent(ds <- data_slice(m_1_smooth_offset,
x0 = evenly(x0, n = 50),
off = 1
))
expect_identical(nrow(ds), 50L)
expect_identical(ncol(ds), 2L)
expect_identical(ds$off, rep(1, length.out = 50))
})
test_that("typical_values works for a data frame", {
expect_silent(tv <- typical_values(su_eg2, vars = any_of(c("x", "z"))))
expect_snapshot(tv, cran = FALSE)
})
test_that("data_slice works for a data frame", {
expect_silent(ds <- data_slice(su_eg2, x = evenly(x, n = 25)))
expect_snapshot(ds, cran = FALSE)
expect_identical(nrow(ds), 25L)
expect_silent(ds <- data_slice(su_eg2,
x = evenly(x, n = 25),
z = evenly(z, n = 25)
))
expect_snapshot(ds, cran = FALSE)
expect_identical(nrow(ds), 625L)
})
# make sure #222 remains fixed
test_that("issue 222 is fixed", {
expect_silent(tv <- typical_values(m_logical,
envir = teardown_env(),
data = logi_df
))
})
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.