diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 89236eacf..fdb43875b 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -388,4 +388,12 @@ ziplss_data <- function(seed = 0) { ziplss_df <- ziplss_data() m_ziplss <- gam(list(y ~ s(x2) + x3, ~ s(x0) + x1), family = ziplss(), data = ziplss_df) - \ No newline at end of file + +# TWLSS example from ?mgcv::twlss +twlss_df <- withr::with_seed(3, gamSim(1, n = 400, dist = "poisson", + scale = 0.2, verbose = FALSE) |> + mutate(y = mgcv::rTweedie(exp(.data$f), p = 1.3, + phi = 0.5))) ## Tweedie response +## Fit a fixed p Tweedie, with wrong link ... +m_twlss <- gam(list(y ~ s(x0) + s(x1) + s(x2) + s(x3), ~ 1, ~ 1), + family = twlss(), data = twlss_df) diff --git a/tests/testthat/test-fitted-values.R b/tests/testthat/test-fitted-values.R index 3fb413761..f81c1281d 100644 --- a/tests/testthat/test-fitted-values.R +++ b/tests/testthat/test-fitted-values.R @@ -89,6 +89,13 @@ test_that("fitted values works for a gaulss model", { expect_named(fv, expected = c(".row", ".parameter", fv_nms)) }) +test_that("fitted values works for a twlss model", { + expect_silent(fv <- fitted_values(m_twlss)) + expect_named(fv, expected = c(".row", ".parameter", fv_nms)) + expect_identical(pull(fv, ".parameter") |> unique(), + c("location", "power", "scale")) +}) + test_that("fitted values works for a gamm model", { expect_silent(fv <- fitted_values(m_gamm)) expect_named(fv, expected = c(".row","x0", "x1", "x2", "x3", fv_nms))