update to testthat edition 3

tests/testthat.R

@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
 library(testthat)
 library(gnm)
 

tests/testthat/_snaps/confint.gnm.md

@@ -0,0 +1,30 @@
+# confint works within function call
+
+    {
+      "type": "double",
+      "attributes": {
+        "dim": {
+          "type": "integer",
+          "attributes": {},
+          "value": [2, 2]
+        },
+        "dimnames": {
+          "type": "list",
+          "attributes": {},
+          "value": [
+            {
+              "type": "character",
+              "attributes": {},
+              "value": ["(Intercept)", "vote2"]
+            },
+            {
+              "type": "character",
+              "attributes": {},
+              "value": ["2.5 %", "97.5 %"]
+            }
+          ]
+        }
+      },
+      "value": [3.78231676, -0.00752684, 3.84179311, 0.07587694]
+    }
+

tests/testthat/test-RC.R

@@ -1,5 +1,3 @@
-context("datasets [mentalHealth]")
-
 # set seed to fix sign of coef
 suppressWarnings(RNGversion("3.0.0")) 
 set.seed(1)

tests/testthat/test-RChomog.R

@@ -1,5 +1,3 @@
-context("implementation [multHomog]")
-
 # Goodman, L. A. (1979) J. Am. Stat. Assoc., 74 (367), 537–552.
 
 RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) +

tests/testthat/test-Symm.R

@@ -1,5 +1,3 @@
-context("model spec [Symm]")
-
 tol <- 1e-4
 
 test_that("Symm works with >2 factors", {

tests/testthat/test-biplot.R

@@ -1,5 +1,3 @@
-context("datasets [barley]")
-
 # set seed to fix sign in gnm
 suppressWarnings(RNGversion("3.0.0")) 
 set.seed(1)
@@ -9,8 +7,8 @@ set.seed(1)
 test_that("biplot model as expected for barley data", {
     biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2),
                        family = wedderburn, data = barley, verbose = FALSE)
-    expect_known_value(biplotModel,
-                       file = test_path("outputs/biplotModel.rds"))
+    expect_snapshot_value(biplotModel, style = "serialize",
+                          ignore_formula_env = TRUE)
     # rotate and scale fitted predictors
     barleyMatrix <- xtabs(biplotModel$predictors ~ site + variety,
                           data = barley)
@@ -23,17 +21,20 @@ test_that("biplot model as expected for barley data", {
     # compare vs matrices in Gabriel (1998): 
     # allow for sign change in gnm and in SVD on different systems
     # 3rd element in fit is 1.425 vs 1.42 in paper
-    expect_equivalent(round(abs(A), 2), 
-                      matrix(abs(c(-4.19, -2.76, -1.43, -1.85, -1.27, 
-                                   -1.16, -1.02, -0.65, 0.15, 
-                                   -0.39, -0.34, -0.05, 0.33, 0.16, 
-                                   0.4, 0.73, 1.46, 2.13)), nrow = 9))
-    expect_equivalent(round(abs(B), 2), 
-                      matrix(abs(c(2.07, 3.06, 2.96, 1.81, 1.56,
-                                   1.89, 1.18, 0.85, 0.97, 0.60,
-                                   -0.97, -0.51, -0.33, -0.50, -0.08, 
-                                   1.08, 0.41, 1.15, 1.27, 1.40)), nrow = 10))
-    expect_equivalent(sign(tcrossprod(A, B)), sign(unclass(barleyMatrix)))
+    expect_equal(round(abs(A), 2), 
+                 matrix(abs(c(-4.19, -2.76, -1.43, -1.85, -1.27, 
+                              -1.16, -1.02, -0.65, 0.15, 
+                              -0.39, -0.34, -0.05, 0.33, 0.16, 
+                              0.4, 0.73, 1.46, 2.13)), nrow = 9),
+                 ignore_attr = TRUE)
+    expect_equal(round(abs(B), 2), 
+                 matrix(abs(c(2.07, 3.06, 2.96, 1.81, 1.56,
+                              1.89, 1.18, 0.85, 0.97, 0.60,
+                              -0.97, -0.51, -0.33, -0.50, -0.08, 
+                              1.08, 0.41, 1.15, 1.27, 1.40)), nrow = 10),
+                 ignore_attr = TRUE)
+    expect_equal(sign(tcrossprod(A, B)), sign(unclass(barleyMatrix)),
+                 ignore_attr = TRUE)
     # chi-square statistic approx equal to that reported
     expect_equal(round(sum(residuals(biplotModel, type = "pearson")^2)), 54)
     expect_equal(df.residual(biplotModel), 56)

tests/testthat/test-bwt.R

@@ -1,5 +1,3 @@
-context("implementation [multinomial as poisson]")
-
 tol <- 1e-4
 
 library(MASS)
@@ -21,14 +19,15 @@ bwt.po2 <- glm(formula = count ~ -1 + id + low * (. -id), family = "poisson",
 test_that("gnm agrees with multinom", {
     cf0 <- coef(bwt.mu)
     cf1 <- na.omit(coef(bwt.po))
-    expect_equivalent(cf0, cf1, tol = tol)
-    expect_equivalent(deviance(bwt.mu), deviance(bwt.po), tol = tol)
+    expect_equal(cf0, cf1, tolerance = tol, ignore_attr = TRUE)
+    expect_equal(deviance(bwt.mu), deviance(bwt.po), tolerance = tol,
+                 ignore_attr = TRUE)
 })
 
 test_that("gnm agrees with glm", {
     cf1 <- coef(bwt.po)
     all_coef1 <- c(attr(cf1, "eliminated"), cf1)
-    expect_equivalent(all_coef1, coef(bwt.po2), tol = tol)
+    expect_equal(all_coef1, coef(bwt.po2), tolerance = tol, ignore_attr = TRUE)
 })
 
 

tests/testthat/test-confint.gnm.R

@@ -1,5 +1,3 @@
-context("model spec [Symm]")
-
 tol <- 1e-4
 
 test_that("confint works within function call", {
@@ -8,6 +6,5 @@ test_that("confint works within function call", {
         fit <- gnm(Freq ~ vote, family = poisson, data = d)
         confint(fit)
     }
-    expect_known_value(f(as.data.frame(cautres)),
-                       file = test_path("outputs/confint.rds"))
+    expect_snapshot_value(f(as.data.frame(cautres)), style = "json2")
 })

tests/testthat/test-diagonalRef.R

@@ -1,5 +1,3 @@
-context("datasets [voting]")
-
 count <- with(voting, percentage/100 * total)
 yvar <- cbind(count, voting$total - count)
 
@@ -21,12 +19,12 @@ test_that("standard Dref model as expected for voting data", {
     expect_equal(round(deviance(classMobility), 2), 21.22)
     expect_equal(df.residual(classMobility), 19)
     p <- DrefWeights(classMobility)$origin["weight"]
-    expect_equivalent(round(p, 2), 0.44)
+    expect_equal(round(p, 2), 0.44, ignore_attr = TRUE)
 })
 
 test_that("modified Dref model as expected for voting data", {
     expect_equal(round(deviance(socialMobility), 2), 18.97)
     expect_equal(df.residual(socialMobility), 17)
     p <- DrefWeights(socialMobility)$origin[, "weight"]
-    expect_equivalent(round(p, 2), c(0.40, 0.60, 0.39))
+    expect_equal(round(p, 2), c(0.40, 0.60, 0.39), ignore_attr = TRUE)
 })

tests/testthat/test-doubleUnidiff.R

@@ -1,5 +1,3 @@
-context("datasets [cautres]")
-
 # set seed to compare to saved values (not all identifiable)
 suppressWarnings(RNGversion("3.0.0")) 
 set.seed(1)
@@ -11,10 +9,9 @@ test_that("double unidiff model as expected for cautres data", {
                          family = poisson, data = cautres, verbose = FALSE)
     doubleUnidiff$family$dispersion <- 1
     expect_equal(round(deviance(doubleUnidiff), 2), 133.04)
-    expect_known_value(doubleUnidiff,
-                       file = test_path("outputs/doubleUnidiff.rds"))
+    expect_snapshot_value(doubleUnidiff, style = "serialize",
+                          ignore_formula_env = TRUE)
     contr <- getContrasts(doubleUnidiff, 
                           rev(pickCoef(doubleUnidiff, ", class:vote")))
-    expect_known_value(contr,
-                       file = test_path("outputs/doubleUnidiff-contrasts.rds"))
+    expect_snapshot_value(contr, style = "serialize")
 })

tests/testthat/test-gammi.R

@@ -1,5 +1,3 @@
-context("datasets [wheat]")
-
 tol <- 1e-4
 
 # Vargas, M et al (2001). Interpreting treatment by environment interaction in 
@@ -26,12 +24,12 @@ test_that("bilinear model as expected for wheat data", {
     # check vs AMMI analysis of the T × E, end of Table 1
     txe <- anova(mainEffects, bilinear1, bilinear2, bilinear3)
     # year x treatment
-    expect_equal(deviance(mainEffects), 279520, tol = tol)
+    expect_equal(deviance(mainEffects), 279520, tolerance = tol)
     expect_equal(df.residual(mainEffects), 207)
     # diff for bilinear models
-    expect_equal(txe$Deviance, c(NA, 151130, 39112, 36781), tol = tol)
+    expect_equal(txe$Deviance, c(NA, 151130, 39112, 36781), tolerance = tol)
     expect_equal(txe$Df, c(NA, 31, 29, 27))
     # "Deviations"
-    expect_equal(deviance(bilinear3), 52497, tol = tol)
+    expect_equal(deviance(bilinear3), 52497, tolerance = tol)
     expect_equal(df.residual(bilinear3), 120)
 })

tests/testthat/test-glm.R

@@ -31,7 +31,8 @@ test_that("gnmFit handles linear fit provided optimal starting values", {
     fitgnm <- gnm(formula = form, family = Gamma(link = "identity"), 
                   data = data.frame(dat), start=coeffs, trace=TRUE)
 
-    expect_equivalent(coeffs, fitgnm$coefficients)
+    expect_equal(coeffs, fitgnm$coefficients, ignore_attr = TRUE)
     # glm always does an extra iteration, even from previously converged fit
-    expect_equivalent(coef(fitglm), coef(fitgnm), tolerance = 1e-6)
+    expect_equal(coef(fitglm), coef(fitgnm), tolerance = 1e-6,
+                 ignore_attr = TRUE)
 })

tests/testthat/test-hskewL.R

@@ -12,12 +12,14 @@ test_that("gnmFit handles extra linear constraints with eliminate", {
         ass <- model$assoc
 
         # First score for Farmers is slightly different from original article
-        expect_equivalent(round(ass$row[,,1] * sqrt(ass$phi[1,1]), d=2)[5:1,],
-                          matrix(c(-0.08, -0.2, -0.23, -0.11, 0.61,
-                                   0.34,  0.3, -0.13, -0.51, 0), 5, 2))
-        expect_equivalent(round(ass$row[,,1] * sqrt(ass$phi[2,1]), d=2)[5:1,],
-                          matrix(c(-0.08, -0.2, -0.23, -0.11, 0.61,
-                                   0.34,  0.3, -0.13, -0.51, 0), 5, 2))
+        expect_equal(round(ass$row[,,1] * sqrt(ass$phi[1,1]), d=2)[5:1,],
+                     matrix(c(-0.08, -0.2, -0.23, -0.11, 0.61,
+                              0.34,  0.3, -0.13, -0.51, 0), 5, 2),
+                     ignore_attr = TRUE)
+        expect_equal(round(ass$row[,,1] * sqrt(ass$phi[2,1]), d=2)[5:1,],
+                     matrix(c(-0.08, -0.2, -0.23, -0.11, 0.61,
+                              0.34,  0.3, -0.13, -0.51, 0), 5, 2),
+                     ignore_attr = TRUE)
 
     }
 })

tests/testthat/test-logistic.R

@@ -1,5 +1,3 @@
-context("implementation [Logistic]")
-
 tol <- 1e-5
 
 DNase1 <- subset(DNase, Run == 1)
@@ -33,7 +31,10 @@ mod_logistic <- gnm(density ~ -1 + Logistic(log(conc)),
                     data = DNase1, verbose = FALSE)
 
 test_that("logistic with gnm equivalent to nls", {
-    expect_equivalent(unclass(coef(mod_basic)), coef(mod_nls), tol = tol)
-    expect_equivalent(unclass(coef(mod_logistic)), coef(mod_nls), tol = tol)
-    expect_equivalent(coef(mod_basic), coef(mod_logistic), tol = tol)
+    expect_equal(unclass(coef(mod_basic)), coef(mod_nls), tolerance = tol,
+                 ignore_attr = TRUE)
+    expect_equal(unclass(coef(mod_logistic)), coef(mod_nls), tolerance = tol,
+                 ignore_attr = TRUE)
+    expect_equal(coef(mod_basic), coef(mod_logistic), tolerance = tol,
+                 ignore_attr = TRUE)
 })

tests/testthat/test-stereotype.R

@@ -1,5 +1,3 @@
-context("datasets [backPain]")
-
 tol <- 1e-4
 
 backPainLong <- expandCategorical(backPain, "pain")
@@ -17,5 +15,6 @@ test_that("sterotype model as expected for backPain data", {
     expect_equal(round(sum(stereotype$y * log(stereotype$fitted/size)), 2),
                  -151.55)
     # number of parameters
-    expect_equivalent(stereotype$rank - nlevels(stereotype$eliminate), 12)
+    expect_equal(stereotype$rank - nlevels(stereotype$eliminate), 12,
+                 ignore_attr = TRUE)
 })