Used new environment ignoring argument, tolerance instead of tol, and expect_equal() with ignore_attr = TRUE instead of equivalent

Author: VisruthSK

tests/testthat/test-aesthetics.R

@@ -9,12 +9,12 @@ prepare_colors_for_test <- function(scheme) {
 
 test_that("getting and setting the color scheme works", {
   color_scheme_set("red")
-  expect_equivalent(color_scheme_get(), prepare_colors_for_test("red"))
+  expect_equal(color_scheme_get(), prepare_colors_for_test("red"), ignore_attr = TRUE)
   expect_named(prepare_colors_for_test("blue"), scheme_level_names())
   expect_named(color_scheme_get(), scheme_level_names())
   for (clr in names(master_color_list)) {
     color_scheme_set(clr)
-    expect_equivalent(color_scheme_get(), prepare_colors_for_test(clr),
+    expect_equal(color_scheme_get(), prepare_colors_for_test(clr, ignore_attr = TRUE),
                       info = clr)
     expect_named(color_scheme_get(), scheme_level_names())
   }
@@ -24,7 +24,7 @@ test_that("getting and setting the color scheme works", {
   expect_gg(plot(color_scheme_get("mix-blue-green")))
 
   color_scheme_set("blue")
-  expect_equivalent(color_scheme_get("teal"), prepare_colors_for_test("teal"))
+  expect_equal(color_scheme_get("teal"), prepare_colors_for_test("teal"), ignore_attr = TRUE)
 
   # error if not character
   expect_error(color_scheme_set(7), "'scheme' should be a character vector of length 1 or 6")
@@ -56,10 +56,10 @@ test_that("color_scheme_get with i argument works", {
 
 test_that("setting mixed scheme works", {
   color_scheme_set("mix-gray-blue")
-  expect_equivalent(color_scheme_get(), mixed_scheme("gray", "blue"))
+  expect_equal(color_scheme_get(), mixed_scheme("gray", "blue"), ignore_attr = TRUE)
 
   color_scheme_set("mix-blue-gray")
-  expect_equivalent(color_scheme_get(), mixed_scheme("blue", "gray"))
+  expect_equal(color_scheme_get(), mixed_scheme("blue", "gray"), ignore_attr = TRUE)
 
   expect_error(color_scheme_set("mix-green-reds"), "should be one of")
   expect_error(color_scheme_set("mix-greens-red"), "should be one of")
@@ -68,9 +68,9 @@ test_that("setting mixed scheme works", {
 test_that("setting brewer scheme works", {
   skip_if_not_installed("RColorBrewer")
   color_scheme_set("brewer-Blues")
-  expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"))
+  expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"), ignore_attr = TRUE)
   color_scheme_set("brewer-Spectral")
-  expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"))
+  expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"), ignore_attr = TRUE)
   expect_error(color_scheme_set("brewer-FAKE"), "FAKE is not a valid palette")
 })
 
@@ -102,11 +102,11 @@ test_that("mixed_scheme internal function doesn't error", {
 test_that("custom color schemes work", {
   color_scheme_set(orange_scheme_ok)
   expect_named(color_scheme_get())
-  expect_equivalent(unlist(color_scheme_get()), orange_scheme_ok)
+  expect_equal(unlist(color_scheme_get()), orange_scheme_ok, ignore_attr = TRUE)
 
   random_scheme <- colors()[sample(length(colors()), 6)]
   color_scheme_set(random_scheme)
-  expect_equivalent(unlist(color_scheme_get()), random_scheme)
+  expect_equal(unlist(color_scheme_get()), random_scheme, ignore_attr = TRUE)
 })
 
 test_that("get_color returns correct color values", {

tests/testthat/test-convenience-functions.R

@@ -5,35 +5,35 @@ test_that("abline_01 returns the correct object", {
   a <- abline_01(color = "green", linetype = 2)
   b <- geom_abline(intercept = 0, slope = 1, color = "green", linetype = 2, na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("vline_* and hline_* return correct objects", {
   a <- vline_0(color = "red")
   b <- geom_vline(xintercept = 0, color = "red", na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- hline_0(linewidth = 2, linetype = 3)
   b <- geom_hline(yintercept = 0, linewidth = 2, linetype = 3, na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- vline_at(c(3,4), na.rm = FALSE)
   b <- geom_vline(xintercept = c(3,4))
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- hline_at(c(3,4), na.rm = FALSE)
   b <- geom_hline(yintercept = c(3,4))
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("vline_at with 'fun' works", {
   x <- example_mcmc_draws(chains = 1)
   a <- vline_at(x, colMeans)
   b <- geom_vline(xintercept = colMeans(x), na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("calc_v (internal function) works", {
   a <- 1:4
@@ -96,13 +96,13 @@ test_that("facet_bg returns correct theme object", {
 test_that("legend_none returns correct theme object", {
   none <- legend_none()
   expect_s3_class(none, "theme")
-  expect_equivalent(none, list(legend.position = "none"))
+  expect_equal(none, list(legend.position = "none"), ignore_attr = TRUE)
   expect_false(attr(none, "complete"))
 })
 test_that("legend_move returns correct theme object", {
   left <- legend_move("left")
   expect_s3_class(left, "theme")
-  expect_equivalent(left, list(legend.position = "left"))
+  expect_equal(left, list(legend.position = "left"), ignore_attr = TRUE)
   expect_false(attr(left, "complete"))
 
   pos <- legend_move(c(0.25, 0.5))
@@ -182,7 +182,7 @@ test_that("overlay_function returns the correct object", {
   a <- overlay_function(fun = "dnorm")
   b <- stat_function(fun = "dnorm", inherit.aes = FALSE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 
 

tests/testthat/test-example-draws.R

@@ -23,7 +23,7 @@ test_that("example ppc data works", {
 
   yrep <- example_yrep_draws()
   expect_type(yrep, "double")
-  expect_is(yrep, "matrix")
+  expect_true(is.matrix(yrep))
   expect_equal(ncol(yrep), length(y))
 
   group <- example_group_data()

tests/testthat/test-extractors.R

@@ -81,7 +81,7 @@ test_that("neff_ratio.stanreg returns correct structure", {
   ratio <- neff_ratio(fit)
   expect_named(ratio)
   ans <- summary(fit)[1:length(ratio), "n_eff"] / (floor(ITER / 2) * CHAINS)
-  expect_equal(ratio, ans, tol = 0.001)
+  expect_equal(ratio, ans, tolerance = 0.001)
 })
 
 test_that("rhat.stanfit returns correct structure", {
@@ -104,12 +104,12 @@ test_that("neff_ratio.stanreg returns correct structure", {
   ratio <- neff_ratio(fit$stanfit)
   expect_named(ratio)
   ans <- summary(fit)[, "n_eff"] / denom
-  expect_equal(ratio, ans, tol = 0.001)
+  expect_equal(ratio, ans, tolerance = 0.001)
 
   ratio2 <- neff_ratio(fit$stanfit, pars = c("wt", "sigma"))
   expect_named(ratio2)
   ans2 <- summary(fit, pars = c("wt", "sigma"))[, "n_eff"] / denom
-  expect_equal(ratio2, ans2, tol = 0.001)
+  expect_equal(ratio2, ans2, tolerance = 0.001)
 })
 
 test_that("cmdstanr methods work", {

tests/testthat/test-helpers-mcmc.R

@@ -298,7 +298,7 @@ test_that("diagnostic_factor.rhat works", {
                       high = 1.2, high = 1.7))
 
   r <- diagnostic_factor(unname(rhats))
-  expect_equivalent(r, as.factor(names(rhats)))
+  expect_equal(r, as.factor(names(rhats)), ignore_attr = TRUE)
   expect_identical(levels(r), c("low", "ok", "high"))
 })
 test_that("diagnostic_factor.neff_ratio works", {
@@ -307,7 +307,7 @@ test_that("diagnostic_factor.neff_ratio works", {
                              high = 0.51, high = 0.99, high = 1))
 
   r <- diagnostic_factor(unname(ratios))
-  expect_equivalent(r, as.factor(names(ratios)))
+  expect_equal(r, as.factor(names(ratios)), ignore_attr = TRUE)
   expect_identical(levels(r), c("low", "ok", "high"))
 })
 

tests/testthat/test-mcmc-intervals.R

@@ -7,7 +7,7 @@ test_that("mcmc_intervals_data computes quantiles", {
 
   qs <- unlist(d[, c("ll", "l", "m", "h", "hh")])
   by_hand <- quantile(xs$Value, c(.25, .35, .5, .65, .75))
-  expect_equivalent(qs, by_hand)
+  expect_equal(qs, by_hand, ignore_attr = TRUE)
 
   expect_equal(d$parameter, factor("beta[1]"))
   expect_equal(d$outer_width, .5)
@@ -26,7 +26,7 @@ test_that("mcmc_intervals_data computes point estimates", {
   d <- mcmc_intervals_data(arr, pars = "beta[2]",
                            prob = .3, prob_outer = .5, point_est = "mean")
 
-  expect_equivalent(d$m, mean(xs$Value))
+  expect_equal(d$m, mean(xs$Value), ignore_attr = TRUE)
   expect_equal(d$parameter, factor("beta[2]"))
   expect_equal(d$point_est, "mean")
 

tests/testthat/test-mcmc-scatter-and-parcoord.R

@@ -210,40 +210,40 @@ test_that("pairs_condition returns correct structure", {
   # default
   cond0 <- pairs_condition()
   expect_s3_class(cond0, "pairs_condition")
-  expect_equivalent(unclass(cond0), list())
+  expect_equal(unclass(cond0), list(), ignore_attr = TRUE)
   expect_equal(attr(cond0, "type"), "default")
 
   # chains
   cond1 <- pairs_condition(chains = 1:4)
   expect_s3_class(cond1, "integer")
   expect_s3_class(cond1, "pairs_condition")
-  expect_equivalent(unclass(cond1), 1:4)
+  expect_equal(unclass(cond1), 1:4, ignore_attr = TRUE)
   expect_equal(attr(cond1, "type"), "chain_vector")
 
   cond2 <- pairs_condition(chains = list(1:4, 5:6))
   expect_s3_class(cond2, "list")
   expect_s3_class(cond2, "pairs_condition")
-  expect_equivalent(unclass(cond2), list(upper=1:4, lower=5:6))
+  expect_equal(unclass(cond2), list(upper=1:4, lower=5:6), ignore_attr = TRUE)
   expect_equal(attr(cond2, "type"), "chain_list")
 
   # draws
   cond3 <- pairs_condition(draws = 0.7)
   expect_s3_class(cond3, "numeric")
   expect_s3_class(cond3, "pairs_condition")
-  expect_equivalent(unclass(cond3), 0.7)
+  expect_equal(unclass(cond3), 0.7, ignore_attr = TRUE)
   expect_equal(attr(cond3, "type"), "draws_proportion")
 
   cond4 <- pairs_condition(draws = c(T, F, T))
   expect_s3_class(cond4, "logical")
   expect_s3_class(cond4, "pairs_condition")
-  expect_equivalent(unclass(cond4), c(T, F, T))
+  expect_equal(unclass(cond4), c(T, F, T), ignore_attr = TRUE)
   expect_equal(attr(cond4, "type"), "draws_selection")
 
   # nuts
   cond5 <- pairs_condition(nuts = "lp__")
   expect_s3_class(cond5, "character")
   expect_s3_class(cond5, "pairs_condition")
-  expect_equivalent(unclass(cond5), "lp__")
+  expect_equal(unclass(cond5), "lp__", ignore_attr = TRUE)
   expect_equal(attr(cond5, "type"), "nuts")
 })
 

tests/testthat/test-pp_check.R

@@ -6,12 +6,12 @@ test_that("default pp_check method works", {
   expect_equal(
     pp_check(y, yrep[1:50, ], ppc_dens_overlay),
     ppc_dens_overlay(y, yrep[1:50, ]),
-    check.environment = FALSE
+    ignore_function_env = TRUE
   )
   expect_equal(
     pp_check(y, yrep, fun = "stat_grouped", group = g, stat = "median"),
     ppc_stat_grouped(y, yrep, group = g, stat = "median"),
-    check.environment = FALSE
+    ignore_function_env = TRUE
   )
 })
 

tests/testthat/test-ppc-discrete.R

@@ -72,9 +72,9 @@ test_that("ppc_bars_data includes all levels", {
   d3 <- ppc_bars_data(y_ord, yrep_ord2)
   expect_equal(d3$x, 1:4)
   expect_equal(d3$y_obs, tab)
-  expect_equivalent(d3$l[2], 0)
-  expect_equivalent(d3$m[2], 0)
-  expect_equivalent(d3$h[2], 0)
+  expect_equal(d3$l[2], 0, ignore_attr = TRUE)
+  expect_equal(d3$m[2], 0, ignore_attr = TRUE)
+  expect_equal(d3$h[2], 0, ignore_attr = TRUE)
 })
 
 

tests/testthat/test-ppc-input-validation.R

@@ -20,7 +20,7 @@ test_that("validate_predictions works", {
   expect_equal(validate_predictions(yrep2, length(y2)), yrep2)
 
   colnames(yrep) <- paste0("yrep", 1:ncol(yrep))
-  expect_equivalent(validate_predictions(yrep, length(y)), unname(yrep))
+  expect_equal(validate_predictions(yrep, length(y)), unname(yrep), ignore_attr = TRUE)
 })
 test_that("validate_predictions throws errors", {
   expect_error(validate_predictions(as.matrix(LETTERS), length(y)), "numeric")