diff --git a/DESCRIPTION b/DESCRIPTION index 2a06308a9..dd1aae0a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: gratia -Version: 0.8.1.55 -Date: 2024-01-04 +Version: 0.8.1.56 +Date: 2024-01-05 Title: Graceful 'ggplot'-Based Graphics and Other Functions for GAMs Fitted Using 'mgcv' Authors@R: c(person(given = "Gavin L.", family = "Simpson", email = "ucfagls@gmail.com", diff --git a/NEWS.md b/NEWS.md index 66899b01f..f7443a321 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# gratia 0.8.1.55 +# gratia 0.8.1.56 ## Breaking changes diff --git a/R/variance-components.R b/R/variance-components.R index ed5bf794b..339c52b6f 100644 --- a/R/variance-components.R +++ b/R/variance-components.R @@ -45,9 +45,9 @@ tbl <- rownames_to_column(vcomps, var = "component") %>% as_tibble() %>% - set_names(nm = c("component", "std_dev", "lower_ci", - "upper_ci")) %>% - add_column(variance = vcomps[, "std.dev"]^2, .after = 1L) + set_names(nm = c(".component", ".std_dev", ".lower_ci", + ".upper_ci")) %>% + add_column(.variance = vcomps[, "std.dev"]^2, .after = 1L) class(tbl) <- c("variance_comp", class(tbl)) tbl } diff --git a/tests/Examples/gratia-Ex.Rout.save b/tests/Examples/gratia-Ex.Rout.save index 20903c85c..591e2e96f 100644 --- a/tests/Examples/gratia-Ex.Rout.save +++ b/tests/Examples/gratia-Ex.Rout.save @@ -1615,11 +1615,11 @@ pmax(exp(eta), .Machine$double.eps) > link(mod, parameter = "scale") function (mu) log(1/mu - 0.01) - + > inv_link(mod, parameter = "scale") function (eta) 1/(exp(eta) + 0.01) - + > > ## Works with `family` objects too > link(shash(), parameter = "skewness") @@ -2697,7 +2697,7 @@ detaching ‘package:mgcv’ > options(digits = 7L) > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n") -Time elapsed: 45.566 0.42 44.621 0 0 +Time elapsed: 17.956 0.24 17.924 0 0 > grDevices::dev.off() null device 1 diff --git a/tests/testthat/_snaps/variance-components.md b/tests/testthat/_snaps/variance-components.md new file mode 100644 index 000000000..03f904af9 --- /dev/null +++ b/tests/testthat/_snaps/variance-components.md @@ -0,0 +1,64 @@ +# variance_comp works for a gam + + Code + print(vc) + Output + # A tibble: 5 x 5 + .component .variance .std_dev .lower_ci .upper_ci + + 1 s(x0) 99.4 9.97 3.85e+ 0 2.58e 1 + 2 s(x1) 44.1 6.64 2.85e+ 0 1.55e 1 + 3 s(x2) 11014. 105. 6.27e+ 1 1.76e 2 + 4 s(x3) 0.00412 0.0642 8.93e-16 4.61e12 + 5 scale 4.30 2.07 1.98e+ 0 2.17e 0 + +# variance_comp works for a gam with rescaling + + Code + print(vc) + Output + # A tibble: 5 x 5 + .component .variance .std_dev .lower_ci .upper_ci + + 1 s(x0) 99.4 9.97 3.85e+ 0 2.58e 1 + 2 s(x1) 44.1 6.64 2.85e+ 0 1.55e 1 + 3 s(x2) 11014. 105. 6.27e+ 1 1.76e 2 + 4 s(x3) 0.00412 0.0642 8.93e-16 4.61e12 + 5 scale 4.30 2.07 1.98e+ 0 2.17e 0 + +# variance_comp works for a single term gam + + Code + print(vc) + Output + # A tibble: 2 x 5 + .component .variance .std_dev .lower_ci .upper_ci + + 1 s(x0) 138. 11.7 3.92 35.2 + 2 scale 13.4 3.66 3.38 3.97 + +# variance_comp works for a continuous by gam + + Code + print(vc) + Output + # A tibble: 2 x 5 + .component .variance .std_dev .lower_ci .upper_ci + + 1 s(x2):x1 6575. 81.1 41.6 158. + 2 scale 4.08 2.02 1.88 2.17 + +# variance_comp works for a factor by gam + + Code + print(vc) + Output + # A tibble: 5 x 5 + .component .variance .std_dev .lower_ci .upper_ci + + 1 s(x2):fac1 125. 11.2 3.93e+ 0 3.19e 1 + 2 s(x2):fac2 181. 13.4 4.18e+ 0 4.32e 1 + 3 s(x2):fac3 5507. 74.2 4.14e+ 1 1.33e 2 + 4 s(x0) 0.00514 0.0717 1.05e-29 4.88e26 + 5 scale 4.17 2.04 1.90e+ 0 2.19e 0 + diff --git a/tests/testthat/test-variance-components.R b/tests/testthat/test-variance-components.R index 733f4eceb..1d7739d1c 100644 --- a/tests/testthat/test-variance-components.R +++ b/tests/testthat/test-variance-components.R @@ -1,13 +1,64 @@ # Test variance_components() +# reference names for tests +var_nms <- c(".component", ".variance", ".std_dev", ".lower_ci", ".upper_ci") + test_that("variance_comp works for a gam", { expect_silent(vc <- variance_comp(m_gam)) expect_s3_class(df, c("variance_comp", "tbl_df", "tbl", "data.frame")) expect_identical(ncol(vc), 5L) expect_identical(nrow(vc), 5L) + expect_named(vc, expected = var_nms) + + skip_on_ci() + skip_on_cran() + expect_snapshot(print(vc)) +}) +test_that("variance_comp works for a gam with rescaling", { + expect_silent(vc <- variance_comp(m_gam, rescale = TRUE)) + expect_s3_class(df, c("variance_comp", "tbl_df", "tbl", "data.frame")) + expect_identical(ncol(vc), 5L) + expect_identical(nrow(vc), 5L) + expect_named(vc, expected = var_nms) + + skip_on_ci() + skip_on_cran() + expect_snapshot(print(vc)) +}) + +test_that("variance_comp works for a single term gam", { expect_silent(vc <- variance_comp(m_1_smooth)) expect_s3_class(df, c("variance_comp", "tbl_df", "tbl", "data.frame")) expect_identical(ncol(vc), 5L) expect_identical(nrow(vc), 2L) + expect_named(vc, expected = var_nms) + + skip_on_ci() + skip_on_cran() + expect_snapshot(print(vc)) +}) + +test_that("variance_comp works for a continuous by gam", { + expect_silent(vc <- variance_comp(su_m_cont_by)) + expect_s3_class(df, c("variance_comp", "tbl_df", "tbl", "data.frame")) + expect_identical(ncol(vc), 5L) + expect_identical(nrow(vc), 2L) + expect_named(vc, expected = var_nms) + + skip_on_ci() + skip_on_cran() + expect_snapshot(print(vc)) +}) + +test_that("variance_comp works for a factor by gam", { + expect_silent(vc <- variance_comp(su_m_factor_by)) + expect_s3_class(df, c("variance_comp", "tbl_df", "tbl", "data.frame")) + expect_identical(ncol(vc), 5L) + expect_identical(nrow(vc), 5L) + expect_named(vc, expected = var_nms) + + skip_on_ci() + skip_on_cran() + expect_snapshot(print(vc)) })