variance_comp() gets the name change treatment #247

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 = "[email protected]",

NEWS.md

@@ -1,4 +1,4 @@
-# gratia 0.8.1.55
+# gratia 0.8.1.56
 
 ## Breaking changes
 

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
 }

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)
-<environment: 0x5636134e37f0>
+<environment: 0x561ef301c910>
 > inv_link(mod, parameter = "scale")
 function (eta) 
 1/(exp(eta) + 0.01)
-<environment: 0x5636134e37f0>
+<environment: 0x561ef301c910>
 > 
 > ## 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 

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
+        <chr>            <dbl>    <dbl>     <dbl>     <dbl>
+      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
+        <chr>            <dbl>    <dbl>     <dbl>     <dbl>
+      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
+        <chr>          <dbl>    <dbl>     <dbl>     <dbl>
+      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
+        <chr>          <dbl>    <dbl>     <dbl>     <dbl>
+      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
+        <chr>           <dbl>    <dbl>     <dbl>     <dbl>
+      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
+

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))
 })