## Test draw() methods
test_that("draw.gam works with numeric select", {
plt1 <- draw(su_m_quick_eg1, select = 2, rug = FALSE)
plt2 <- draw(su_m_quick_eg1, select = c(1, 2), rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam smooth for selected smooth numeric", plt1)
expect_doppelganger("draw gam smooth for two selected smooths numeric", plt2)
})
test_that("draw.gam fails with bad select", {
expect_error(draw(su_m_univar_4, select = 8),
"One or more indices in 'select' > than the number of smooths in the model.",
fixed = TRUE
)
expect_error(draw(su_m_univar_4, select = c(1, 3, 5, 6)),
"One or more indices in 'select' > than the number of smooths in the model.",
fixed = TRUE
)
expect_error(draw(su_m_univar_4, select = c(1, 2, 3, 4, 5)),
"Trying to select more smooths than are in the model.",
fixed = TRUE
)
expect_error(draw(su_m_univar_4, select = TRUE),
"When 'select' is a logical vector, 'length(select)' must equal
the number of smooths in the model.",
fixed = TRUE
)
})
test_that("draw.gam works with character select", {
plt1 <- draw(su_m_quick_eg1, select = "s(x1)", rug = FALSE)
plt2 <- draw(su_m_quick_eg1, select = c("s(x0)", "s(x1)"), rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam smooth for selected smooth character", plt1)
expect_doppelganger(
"draw gam smooth for two selected smooths character",
plt2
)
})
test_that("draw.gam works with logical select single smooth", {
plt <- draw(su_m_quick_eg1,
select = c(TRUE, rep(FALSE, 3)),
rug = FALSE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam smooth for selected smooth logical", plt)
})
test_that("draw.gam works with logical select two smooths", {
plt <- draw(su_m_quick_eg1,
select = rep(c(TRUE, FALSE), each = 2),
rug = FALSE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam smooth for two selected smooths logical", plt)
})
test_that("draw.gam works with partial_match", {
plt <- draw(su_m_factor_by,
select = "x2", partial_match = TRUE,
rug = FALSE, n = 50
)
expect_error(draw(su_m_factor_by, select = "s(x2)", partial_match = FALSE),
"Failed to match any smooths in model `su_m_factor_by`.\nTry with 'partial_match = TRUE'?",
fixed = TRUE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam with partial match TRUE", plt)
})
test_that("draw.gam works with select and parametric", {
plt1 <- draw(su_m_factor_by,
select = "s(x2)", partial_match = TRUE,
rug = FALSE
)
plt2 <- draw(su_m_factor_by,
select = "s(x2)", partial_match = TRUE,
parametric = FALSE, data = su_eg4, envir = teardown_env(),
rug = FALSE
)
plt3 <- draw(su_m_factor_by,
select = "s(x2)", partial_match = TRUE,
parametric = TRUE, data = su_eg4, envir = teardown_env(),
rug = FALSE
)
plt4 <- draw(su_m_factor_by,
parametric = TRUE, rug = FALSE,
data = su_eg4, envir = teardown_env()
)
plt5 <- draw(su_m_factor_by,
parametric = FALSE, rug = FALSE,
data = su_eg4, envir = teardown_env()
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam with select and parametric is NULL", plt1)
expect_doppelganger("draw gam with select and parametric is FALSE", plt2)
expect_doppelganger("draw gam with select and parametric is TRUE", plt3)
expect_doppelganger("draw gam without select and parametric is TRUE", plt4)
expect_doppelganger("draw gam without select and parametric is FALSE", plt5)
})
test_that("draw.gam() plots a simple multi-smooth AM", {
plt1 <- draw(su_m_quick_eg1, rug = FALSE)
plt2 <- draw(su_m_quick_eg1, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw simple multi-smooth AM", plt1)
expect_doppelganger("draw simple multi-smooth AM with fixed scales", plt2)
})
test_that("draw.gam() can draw partial residuals", {
plt1 <- draw(m_tiny_eg1, residuals = TRUE, rug = FALSE)
plt2 <- draw(m_tiny_eg1, residuals = TRUE, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw simple partial residuals", plt1)
expect_doppelganger("draw simple partial residuals with fixed scales", plt2)
})
test_that("draw.gam() plots an AM with a single 2d smooth", {
skip_on_os("windows")
plt <- draw(su_m_bivar, n = 50, rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw AM with 2d smooth", plt)
})
test_that("draw.gam() plots an AM with a single factor by-variable smooth", {
plt1 <- draw(su_m_factor_by, rug = FALSE)
plt2 <- draw(su_m_factor_by, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw AM with factor by-variable smooth", plt1)
expect_doppelganger("draw factor by-variable smooth with fixed scales", plt2)
})
test_that("draw() works with continuous by", {
plt <- draw(su_m_cont_by, rug = FALSE, n = 50)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw with continuous by-variable smooth", plt)
})
test_that("draw() works with continuous by and fixed scales", {
plt <- draw(su_m_cont_by, scales = "fixed", rug = FALSE, n = 50)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw with continuous by-var fixed scale", plt)
})
test_that("draw() works with random effect smooths (bs = 're')", {
p2 <- draw(rm1, ncol = 3, rug = FALSE)
p3 <- draw(rm1, ncol = 3, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw.gam model with ranef smooth", p2)
expect_doppelganger("draw model with ranef smooth fixed scales", p3)
})
test_that("draw() with random effect smooths (bs = 're') & factor by variable ", {
p2 <- draw(rm2, ncol = 3, rug = FALSE)
p3 <- draw(rm2, ncol = 3, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw.gam model with ranef smooth factor by", p2)
expect_doppelganger("draw with ranef smooth factor by fixed scales", p3)
})
test_that("draw() can handle non-standard names -- a function call as a name", {
df <- data.frame(
y = c(
0.15, 0.17, 0.07, 0.17, 0.01, 0.15, 0.18, 0.04, -0.06, -0.08,
0, 0.03, -0.27, -0.93, 0.04, 0.12, 0.08, 0.15, 0.04, 0.15,
0.03, 0.09, 0.11, 0.13, -0.11, -0.32, -0.7, -0.78, 0.07, 0.04,
0.06, 0.12, -0.15, 0.05, -0.08, 0.14, -0.02, -0.14, -0.24,
-0.32, -0.78, -0.81, -0.04, -0.25, -0.09, 0.02, -0.13, -0.2,
-0.04, 0, 0.02, -0.05, -0.19, -0.37, -0.57, -0.81
),
time = rep(2^c(
-1, 0, 1, 1.58, 2, 2.58, 3, 3.32, 3.58, 4.17,
4.58, 5.58, 6.17, 7.39
), 4)
)
## the smooth is of `log2(time)` but this needs special handling
## in the `ggplot()` to avoid `ggplot()` looking incorrectly for `time` and
## not the correct `log2(time)`
fit <- gam(y ~ s(log2(time)), data = df, method = "REML")
p1 <- draw(fit)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw.gam model with non-standard names", p1)
})
test_that("draw() works with factor-smooth interactions (bs = 'fs')", {
# skip_on_ci() # testing without as moved to mac os x
skip_if(packageVersion("mgcv") < "1.8.36")
p2 <- draw(mod_fs, ncol = 2, rug = FALSE)
p3 <- draw(mod_fs, ncol = 2, scales = "fixed", rug = FALSE)
skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw.gam model with fs smooth", p2)
expect_doppelganger("draw model with fs smooth fixed scales", p3)
})
test_that("draw() works with parametric terms", {
## fake some data...
df <- withr::with_seed(0, {
f1 <- function(x) {
exp(2 * x)
}
f2 <- function(x) {
0.2 * x^11 * (10 * (1 - x))^6 + 10 * (10 * x)^3 * (1 - x)^10
}
f3 <- function(x) {
x * 0
}
n <- 200
sig2 <- 4
x0 <- rep(1:4, 50)
x1 <- runif(n, 0, 1)
x2 <- runif(n, 0, 1)
x3 <- runif(n, 0, 1)
e <- rnorm(n, 0, sqrt(sig2))
y <- 2 * x0 + f1(x1) + f2(x2) + f3(x3) + e
data.frame(x0 = x0, x1 = x1, x2 = x2, x3 = x3, y = y)
})
## fit
mod <- gam(y ~ x0 + s(x1) + s(x2) + s(x3), data = df)
skip_if_not_installed("withr")
withr::local_options(lifecycle_verbosity = "quiet")
## evaluate parametric terms directly
e1 <- evaluate_parametric_term(mod, term = "x0")
expect_s3_class(e1, "evaluated_parametric_term")
expect_equal(ncol(e1), 5L)
expect_named(e1, c("term", "type", "value", "partial", "se"))
p1 <- draw(e1, rug = FALSE)
## check evaluate_parametric_term works
p2 <- draw(mod, rug = FALSE)
## factor parametric terms
x0 <- factor(x0)
df <- data.frame(x0 = x0, x1 = x1, x2 = x2, x3 = x3, y = y)
## fit
mod <- gam(y ~ x0 + s(x1) + s(x2) + s(x3), data = df)
## check evaluate_parametric_term works
p3 <- draw(mod, rug = FALSE)
## evaluate parametric terms directly
e2 <- evaluate_parametric_term(mod, term = "x0")
expect_s3_class(e2, "evaluated_parametric_term")
expect_error(evaluate_parametric_term(mod, term = "x1"),
"Term is not in the parametric part of model: <x1>",
fixed = TRUE
)
expect_warning(evaluate_parametric_term(mod, term = c("x0", "x1")),
"More than one `term` requested; using the first <x0>",
fixed = TRUE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw with linear parametric term", p1)
expect_doppelganger("draw.gam with linear parametric term", p2)
expect_doppelganger("draw.gam with factor parametric term", p3)
})
test_that("component-wise CIs work without seWithMean", {
plt <- draw(su_m_univar_4, overall_uncertainty = FALSE, rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw gam with overall_uncertainty false", plt)
})
test_that("draw.derivates() plots derivatives for a GAM", {
# skip_on_ci() # testing without as moved to mac os x
d1 <- derivatives(su_m_univar_4, type = "central", n = 200)
plt1 <- draw(d1)
plt2 <- draw(d1, scales = "fixed")
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw derivatives for a GAM", plt1)
expect_doppelganger("draw derivatives for a GAM with fixed scales", plt2)
})
test_that("draw.derivates plots derivatives with change indicators", {
# not on CRAN
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # causing trivial failures on GH
d1 <- derivatives(m_gam, type = "central", n = 200)
expect_silent(plt1 <- draw(d1, add_change = TRUE))
expect_silent(plt2 <- draw(d1, add_change = TRUE, change_type = "sizer"))
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw derivatives for a GAM with default change", plt1)
expect_doppelganger("draw derivatives for a GAM with sizer change", plt2)
})
test_that("draw.derivates() plots derivatives for a GAM rotated labels", {
skip_on_cran()
d1 <- derivatives(su_m_univar_4, type = "central", n = 100)
plt1 <- draw(d1, angle = 45)
plt2 <- draw(d1, scales = "fixed", angle = 45)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw derivatives for a GAM rotated labels", plt1)
expect_doppelganger(
"draw derivatives for a GAM with fixed scales rotated",
plt2
)
})
test_that("draw plots partial derivatives for a GAM", {
d1 <- partial_derivatives(su_m_bivar_te,
select = "te(x,z)", focal = "z",
type = "central", n = 100
)
plt1 <- draw(d1)
plt2 <- draw(d1, scales = "fixed")
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw partial derivatives for a GAM", plt1)
expect_doppelganger(
"draw partial derivatives for a GAM with fixed scales",
plt2
)
})
test_that("draw plots partial derivs for GAM rotated labels", {
skip_on_cran()
d1 <- partial_derivatives(su_m_bivar_te,
select = "te(x,z)", focal = "z",
type = "central", n = 100
)
plt1 <- draw(d1, angle = 45)
plt2 <- draw(d1, scales = "fixed", angle = 45)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger(
"draw partial derivatives for GAM rotated labels",
plt1
)
expect_doppelganger(
"draw partial derivatives for GAM fixed scales rotated",
plt2
)
})
## test that issue 39 stays fixed
test_that("draw.gam doesn't create empty plots with multiple parametric terms", {
plt <- draw(m_2_fac, rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw issue 39 empty plots", plt)
})
test_that("draw.mgcv_smooth() can plot basic smooth bases", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # sign differences due to eigendecomposition in TPRS
bs <- basis(s(x0), data = quick_eg1)
plt <- draw(bs)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw basic tprs basis", plt)
})
test_that("draw.mgcv_smooth() can plot basic smooth bases with rotated labels", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # sign differences due to eigendecomposition in TPRS
bs <- basis(s(x0), data = quick_eg1)
plt <- draw(bs, angle = 45)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw basic tprs basis rotated", plt)
})
test_that("draw.mgcv_smooth() can plot by factor basis smooth bases", {
bs <- basis(s(x2, by = fac), data = su_eg4)
plt <- draw(bs)
# skip_on_ci() # testing without as moved to mac os x
skip_on_cran()
expect_doppelganger("draw by factor basis", plt)
})
test_that("draw() works with a ziplss models; issue #45", {
plt <- draw(m_ziplss, rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw ziplss parametric terms issue 45", plt)
})
test_that("draw works for sample_smooths objects", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # minor statistical differences
sm1 <- smooth_samples(su_m_univar_4, n = 5, seed = 23478, n_vals = 50)
plt1 <- draw(sm1, alpha = 0.7, n_samples = 5, seed = 2635, rug = FALSE)
sm2 <- smooth_samples(su_m_bivar, n = 4, seed = 23478, n_vals = 50)
plt2 <- draw(sm2, alpha = 0.7, n_samples = 4, seed = 2635)
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt3 <- draw(sm3, alpha = 0.7, n_samples = 5, seed = 2635, rug = FALSE)
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt4 <- draw(sm3,
alpha = 0.7, scales = "fixed", n_samples = 10,
seed = 2635, rug = FALSE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw smooth_samples for GAM m1", plt1)
expect_doppelganger("draw smooth_samples for GAM m2", plt2)
expect_doppelganger("draw smooth_samples for GAM m3", plt3)
expect_doppelganger("draw smooth_samples for GAM m3 fixed scales", plt4)
})
test_that("draw works for sample_smooths objects rotated labels", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # minor statistical differences
sm1 <- smooth_samples(su_m_univar_4, n = 5, seed = 23478, n_vals = 50)
plt1 <- draw(sm1,
alpha = 0.7, n_samples = 5, seed = 2635, angle = 45,
rug = FALSE
)
sm2 <- smooth_samples(su_m_bivar, n = 4, seed = 23478, n_vals = 50)
plt2 <- draw(sm2,
alpha = 0.7, n_samples = 4, seed = 2635, angle = 45,
rug = FALSE
)
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt3 <- draw(sm3,
alpha = 0.7, n_samples = 5, seed = 2635, angle = 45,
rug = FALSE
)
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt4 <- draw(sm3,
alpha = 0.7, scales = "fixed", n_samples = 5, seed = 2635,
angle = 45, rug = FALSE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw smooth_samples for GAM m1 rotated", plt1)
expect_doppelganger("draw smooth_samples for GAM m2 rotated", plt2)
expect_doppelganger("draw smooth_samples for GAM m3 rotated", plt3)
expect_doppelganger(
"draw smooth_samples for GAM m3 fixed scales rotated",
plt4
)
})
test_that("draw works for smooth_samples objects", {
skip_on_os("win")
sm2 <- smooth_samples(su_m_bivar, n = 2, seed = 23478, n_vals = 50)
plt <- draw(sm2, alpha = 0.7, contour = TRUE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw smooth_samples for bivariate GAM contours", plt)
})
test_that("draw works for sample_smooths objects with n_samples", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # minor statistical differences
sm1 <- smooth_samples(su_m_univar_4, n = 5, seed = 23478, n_vals = 50)
plt1 <- draw(sm1, alpha = 0.7, n_samples = 3, rug = FALSE, seed = 1)
sm2 <- smooth_samples(su_m_bivar, n = 4, seed = 23478, n_vals = 50)
plt2 <- draw(sm2, alpha = 0.7, n_samples = 2, rug = FALSE, seed = 14)
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt3 <- draw(sm3, alpha = 0.7, n_samples = 3, rug = FALSE, seed = 19)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw smooth_samples for m1 n_samples", plt1)
expect_doppelganger("draw smooth_samples for m2 n_samples", plt2)
expect_doppelganger("draw smooth_samples for GAM n_samples", plt3)
})
test_that("draw works for sample_smooths objects with user specified smooth", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x # minor statistical differences
sm3 <- smooth_samples(su_m_factor_by, n = 5, seed = 23478, n_vals = 50)
plt1 <- draw(sm3, select = "s(x0)", alpha = 0.7, rug = FALSE)
plt2 <- draw(sm3,
select = "s(x2)", alpha = 0.7, partial_match = TRUE,
rug = FALSE
)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger(
"draw selected factor by smooth_samples for GAM m3",
plt2
)
expect_doppelganger("draw selected smooth_samples for GAM m3", plt1)
})
## Issue #22
test_that("draw() can handle a mixture of numeric and factor random effects", {
df <- data_sim("eg4", seed = 42)
m <- gam(y ~ s(x2, fac, bs = "re"), data = df, method = "REML")
plt <- draw(m)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("issue 22 draw with mixed random effects", plt)
})
test_that("draw.gam uses fixed scales if asked for them: #73", {
skip_on_cran()
# skip_on_ci() # testing without as moved to mac os x
# df <- data_sim("eg1", n = 1000, seed = 1)
m <- gam(y ~ s(x1) + s(x2) + ti(x1, x2), data = su_eg1, method = "REML")
plt <- draw(m, scales = "fixed", rug = FALSE)
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger(
"issue 73 draw uses fixed scales if asked for them",
plt
)
})
test_that("draw.gam can take user specified scales", {
skip_on_os(os = "win")
# skip_on_os(os = "mac") # trivial diffs in contours
plt1 <- draw(su_m_bivar,
rug = FALSE,
continuous_fill = scale_fill_distiller(
palette = "Spectral",
type = "div"
)
)
skip_if(packageVersion("mgcv") < "1.8.36")
plt2 <- draw(mod_fs,
rug = FALSE,
discrete_colour = ggplot2::scale_colour_viridis_d(option = "plasma")
)
skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw 2d smooth with spectral palette", plt1)
skip_if(packageVersion("mgcv") < "1.8.36")
expect_doppelganger(
"draw fs smooth with discrete plasma palette",
plt2
)
})
test_that("plotting sos smooths works", {
skip_on_cran()
skip_if_not_installed("sf")
expect_silent(plt <- draw(m_sos, n = 20))
# skip_on_ci() # testing without as moved to mac os x
expect_doppelganger("draw works for sos smooths", plt)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.