diff --git a/DESCRIPTION b/DESCRIPTION index 7a00c231f..f5371c9c1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: gratia -Version: 0.8.9.9 +Version: 0.8.9.10 Date: 2024-03-11 Title: Graceful 'ggplot'-Based Graphics and Other Functions for GAMs Fitted Using 'mgcv' Authors@R: c(person(given = "Gavin L.", family = "Simpson", diff --git a/NEWS.md b/NEWS.md index 02bea823c..aaebbad1d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# gratia 0.8.9.9 +# gratia 0.8.9.10 ## Breaking changes @@ -343,6 +343,10 @@ to `select` and the function will continue. variables in `data` but was written in such a way that it would fail when relocating the data columns to the end of the posterior sampling object. #255 +* `draw.gam()` and `draw.smooth_estimates()` would fail when plotting a + univariate tensor product smooth (e.g. `te(x)`, `ti(x)`, or `t2()`). Reported + by @wStockhausen #260 + # gratia 0.8.2 * Small fixes for CRAN. diff --git a/R/smooth-estimates.R b/R/smooth-estimates.R index 04df12252..89f37a202 100644 --- a/R/smooth-estimates.R +++ b/R/smooth-estimates.R @@ -1072,7 +1072,9 @@ "Mono inc 0 start P spline", "Mono inc 0 start P spline" )) { - class(object) <- c("mgcv_smooth", class(object)) + class(object) <- append(class(object), "mgcv_smooth", after = 0L) + } else if (grepl("1d Tensor product", sm_type, fixed = TRUE)) { + class(object) <- append(class(object), "mgcv_smooth", after = 0L) } else if (sm_type == "Random effect") { class(object) <- append(class(object), c("random_effect", "mgcv_smooth"), diff --git a/R/smooth-type.R b/R/smooth-type.R index 660e24145..2b16451bf 100644 --- a/R/smooth-type.R +++ b/R/smooth-type.R @@ -147,7 +147,11 @@ #' @export #' @rdname smooth_type `smooth_type.t2.smooth` <- function(smooth) { - sm_type <- "Tensor product (T2)" + sm_type <- if (identical(smooth_dim(smooth), 1L)) { + "1d Tensor product (T2)" + } else { + "Tensor product (T2)" + } sm_type } @@ -162,11 +166,15 @@ #' @rdname smooth_type `smooth_type.tensor.smooth` <- function(smooth) { inter <- smooth[["inter"]] + sm_dim <- smooth_dim(smooth) sm_type <- if (isTRUE(inter)) { "Tensor product int." } else { "Tensor product" } + if (identical(sm_dim, 1L)) { + sm_type <- paste("1d", sm_type) + } sm_type } diff --git a/tests/testthat/_snaps/draw-gam/draw-gam-univariate-t2-smooth.svg b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-t2-smooth.svg new file mode 100644 index 000000000..578296654 --- /dev/null +++ b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-t2-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +t2(x2) +Basis: 1d Tensor product (T2) +draw.gam univariate t2 smooth + + diff --git a/tests/testthat/_snaps/draw-gam/draw-gam-univariate-te-smooth.svg b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-te-smooth.svg new file mode 100644 index 000000000..d48b3ca5e --- /dev/null +++ b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-te-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +te(x2) +Basis: 1d Tensor product +draw.gam univariate te smooth + + diff --git a/tests/testthat/_snaps/draw-gam/draw-gam-univariate-ti-smooth.svg b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-ti-smooth.svg new file mode 100644 index 000000000..1faae77e2 --- /dev/null +++ b/tests/testthat/_snaps/draw-gam/draw-gam-univariate-ti-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +ti(x2) +Basis: 1d Tensor product int. +draw.gam univariate ti smooth + + diff --git a/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-t2-smooth.svg b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-t2-smooth.svg new file mode 100644 index 000000000..0b946738e --- /dev/null +++ b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-t2-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +t2(x2) +Basis: 1d Tensor product (T2) +draw.smooth_estimates univariate t2 smooth + + diff --git a/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-te-smooth.svg b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-te-smooth.svg new file mode 100644 index 000000000..97ec63890 --- /dev/null +++ b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-te-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +te(x2) +Basis: 1d Tensor product +draw.smooth_estimates univariate te smooth + + diff --git a/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-ti-smooth.svg b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-ti-smooth.svg new file mode 100644 index 000000000..6f76ee92e --- /dev/null +++ b/tests/testthat/_snaps/draw-smooth-estimates/draw-smooth-estimates-univariate-ti-smooth.svg @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-6 +-3 +0 +3 + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 +x2 +Partial effect +ti(x2) +Basis: 1d Tensor product int. +draw.smooth_estimates univariate ti smooth + + diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 1228f2a2a..661e1646b 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -204,6 +204,11 @@ m_scat <- gam(y ~ s(x0) + s(x1) + s(x2) + s(x3), family = scat(), method = "REML" ) +# models with univariate tensor products +m_univar_te <- gam(y ~ te(x2), data = quick_eg1, method = "REML") +m_univar_ti <- gam(y ~ ti(x2), data = quick_eg1, method = "REML") +m_univar_t2 <- gam(y ~ t2(x2), data = quick_eg1, method = "REML") + m_lm <- lm(y ~ x0 + x1 + x2 + x3, data = quick_eg1) m_glm <- glm(y ~ x0 + x1 + x2 + x3, data = quick_eg1) diff --git a/tests/testthat/test-draw-gam.R b/tests/testthat/test-draw-gam.R index 27a1679db..a4b7e284b 100644 --- a/tests/testthat/test-draw-gam.R +++ b/tests/testthat/test-draw-gam.R @@ -241,3 +241,15 @@ test_that("draw.gam works with grouped by option", { skip_on_ci() expect_doppelganger("grouped by gam", plt) }) + +test_that("draw gam works with univar tensor products #260", { + expect_silent(plt_uni_te <- m_univar_te |> draw(rug = FALSE)) + expect_silent(plt_uni_ti <- m_univar_ti |> draw(rug = FALSE)) + expect_silent(plt_uni_t2 <- m_univar_t2 |> draw(rug = FALSE)) + + skip_on_cran() + + expect_doppelganger("draw.gam univariate te smooth", plt_uni_te) + expect_doppelganger("draw.gam univariate ti smooth", plt_uni_ti) + expect_doppelganger("draw.gam univariate t2 smooth", plt_uni_t2) +}) diff --git a/tests/testthat/test-draw-smooth-estimates.R b/tests/testthat/test-draw-smooth-estimates.R index 7c71aab17..cf3e6b916 100644 --- a/tests/testthat/test-draw-smooth-estimates.R +++ b/tests/testthat/test-draw-smooth-estimates.R @@ -307,3 +307,15 @@ test_that("draw.gam works with sos spline chlorophyll a", { expect_doppelganger("draw.gam sos chlorophyll", plt1) expect_doppelganger("draw.gam sos chlorophyll with crs", plt2) }) + +test_that("draw for smooth estimates works with univar tensor products #260", { + expect_silent(plt_uni_te <- smooth_estimates(m_univar_te) |> draw()) + expect_silent(plt_uni_ti <- smooth_estimates(m_univar_ti) |> draw()) + expect_silent(plt_uni_t2 <- smooth_estimates(m_univar_t2) |> draw()) + + skip_on_cran() + + expect_doppelganger("draw.smooth_estimates univariate te smooth", plt_uni_te) + expect_doppelganger("draw.smooth_estimates univariate ti smooth", plt_uni_ti) + expect_doppelganger("draw.smooth_estimates univariate t2 smooth", plt_uni_t2) +}) \ No newline at end of file diff --git a/tests/testthat/test-smooth-type.R b/tests/testthat/test-smooth-type.R index af7f9d432..91788bff3 100644 --- a/tests/testthat/test-smooth-type.R +++ b/tests/testthat/test-smooth-type.R @@ -54,6 +54,21 @@ test_that("smooth_type works for t2 smooths", { expect_identical(st, "Tensor product (T2)") }) +test_that("smooth_type works for univariate te smooths", { + expect_silent(st <- smooth_type(get_smooth(m_univar_te, "te(x2)"))) + expect_identical(st, "1d Tensor product") +}) + +test_that("smooth_type works for univariate ti smooths", { + expect_silent(st <- smooth_type(get_smooth(m_univar_ti, "ti(x2)"))) + expect_identical(st, "1d Tensor product int.") +}) + +test_that("smooth_type works for univariate t2 smooths", { + expect_silent(st <- smooth_type(get_smooth(m_univar_t2, "t2(x2)"))) + expect_identical(st, "1d Tensor product (T2)") +}) + test_that("smooth_type works for sz smooths", { expect_silent(st <- smooth_type(get_smooth(m_sz, "s(fac,x2)"))) expect_identical(st, "Constr. factor smooth")