Skip to content

Commit

Permalink
Use withr to not change global state (#829)
Browse files Browse the repository at this point in the history 
* Use withr to not change global state
Fixes easystats/easystats#388

* test

* fix test

* fix test

* fix

* fix
  • Loading branch information
@strengejacke
strengejacke authored Nov 13, 2023
1 parent f054c1f commit ebe7d72
Show file tree
Hide file tree
Showing 4 changed files with 351 additions and 370 deletions.
208 changes: 98 additions & 110 deletions tests/testthat/test-backticks.R
View file
Original file line number Diff line number Diff line change
@@ -1,122 +1,110 @@
iris$`a m` <- iris$Species
iris$`Sepal Width` <- iris$Sepal.Width
dat <<- iris
m <- lm(`Sepal Width` ~ Petal.Length + `a m` * log(Sepal.Length), data = dat)
m2 <- lm(`Sepal Width` ~ Petal.Length + `a m`, data = dat)

test_that("text_remove_backticks", {
d <- data.frame(Parameter = names(coef(m2)), Estimate = unname(coef(m2)), stringsAsFactors = FALSE)
expect_equal(
text_remove_backticks(d)$Parameter,
c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica")
)

d <- data.frame(
Parameter = names(coef(m2)),
Term = names(coef(m2)),
Estimate = unname(coef(m2)),
stringsAsFactors = FALSE
)
x <- text_remove_backticks(d, c("Parameter", "Term"))
expect_equal(x$Parameter, c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"))
expect_equal(x$Term, c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"))

d <- list(Parameter = names(coef(m2)), Estimate = unname(coef(m2)))
expect_warning(text_remove_backticks(d, verbose = TRUE))
expect_equal(
text_remove_backticks(d),
list(
Parameter = c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"),
Estimate = c(2.99186937324135, 0.298310962215218, -1.49267407227818, -1.67409183546024)
),
tolerance = 1e-3
)
})

test_that("backticks", {
expect_equal(
find_parameters(m),
list(conditional = c(
"(Intercept)", "Petal.Length", "a mversicolor",
"a mvirginica", "log(Sepal.Length)", "a mversicolor:log(Sepal.Length)",
"a mvirginica:log(Sepal.Length)"
))
)

expect_equal(
get_parameters(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
skip_if_not_installed("withr")

withr::with_environment(
new.env(),
test_that("text_remove_backticks", {
iris$`a m` <- iris$Species
iris$`Sepal Width` <- iris$Sepal.Width
dat <- iris
m <- lm(`Sepal Width` ~ Petal.Length + `a m` * log(Sepal.Length), data = dat)
m2 <- lm(`Sepal Width` ~ Petal.Length + `a m`, data = dat)

d <- data.frame(Parameter = names(coef(m2)), Estimate = unname(coef(m2)), stringsAsFactors = FALSE)
expect_identical(
text_remove_backticks(d)$Parameter,
c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica")
)
)

expect_equal(
get_statistic(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
d <- data.frame(
Parameter = names(coef(m2)),
Term = names(coef(m2)),
Estimate = unname(coef(m2)),
stringsAsFactors = FALSE
)
)

expect_equal(
clean_parameters(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
x <- text_remove_backticks(d, c("Parameter", "Term"))
expect_identical(x$Parameter, c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"))
expect_identical(x$Term, c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"))

d <- list(Parameter = names(coef(m2)), Estimate = unname(coef(m2)))
expect_warning(text_remove_backticks(d, verbose = TRUE))
expect_equal(
text_remove_backticks(d),
list(
Parameter = c("(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica"),
Estimate = c(2.99186937324135, 0.298310962215218, -1.49267407227818, -1.67409183546024)
),
tolerance = 1e-3
)
)

expect_equal(
find_predictors(m),
list(conditional = c("Petal.Length", "a m", "Sepal.Length"))
)

expect_equal(
colnames(get_predictors(m)),
c("Petal.Length", "a m", "Sepal.Length")
)

expect_equal(
find_variables(m),
list(
response = "Sepal Width",
conditional = c("Petal.Length", "a m", "Sepal.Length")
expect_identical(
find_parameters(m),
list(conditional = c(
"(Intercept)", "Petal.Length", "a mversicolor",
"a mvirginica", "log(Sepal.Length)", "a mversicolor:log(Sepal.Length)",
"a mvirginica:log(Sepal.Length)"
))
)
)

expect_equal(
find_terms(m),
list(
response = "Sepal Width",
conditional = c("Petal.Length", "a m", "log(Sepal.Length)")
expect_identical(
get_parameters(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
)
)
)

expect_equal(
rownames(get_varcov(m)),
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica",
"log(Sepal.Length)", "a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
expect_identical(
get_statistic(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
)
)
)

expect_equal(
clean_names(m),
c("Sepal Width", "Petal.Length", "a m", "Sepal.Length")
)

expect_equal(find_response(m), "Sepal Width")

expect_equal(get_response(m), iris[["Sepal Width"]])
})
expect_identical(
clean_parameters(m)$Parameter,
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica", "log(Sepal.Length)",
"a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
)
)
expect_identical(
find_predictors(m),
list(conditional = c("Petal.Length", "a m", "Sepal.Length"))
)
expect_identical(
find_variables(m),
list(
response = "Sepal Width",
conditional = c("Petal.Length", "a m", "Sepal.Length")
)
)
expect_identical(
find_terms(m),
list(
response = "Sepal Width",
conditional = c("Petal.Length", "a m", "log(Sepal.Length)")
)
)
expect_identical(
rownames(get_varcov(m)),
c(
"(Intercept)", "Petal.Length", "a mversicolor", "a mvirginica",
"log(Sepal.Length)", "a mversicolor:log(Sepal.Length)", "a mvirginica:log(Sepal.Length)"
)
)
expect_identical(
clean_names(m),
c("Sepal Width", "Petal.Length", "a m", "Sepal.Length")
)
expect_identical(find_response(m), "Sepal Width")
expect_identical(get_response(m), iris[["Sepal Width"]])
expect_named(get_predictors(m), c("Petal.Length", "a m", "Sepal.Length"))
})
)


test_that("text_remove_backticks, character", {
x <- "`test`"
expect_equal(text_remove_backticks(x), "test")
expect_identical(text_remove_backticks(x), "test")
x <- "test"
expect_equal(text_remove_backticks(x), "test")
expect_identical(text_remove_backticks(x), "test")
x <- NULL
expect_null(text_remove_backticks(x))
})
Expand All @@ -125,13 +113,13 @@ test_that("text_remove_backticks, character", {
test_that("text_remove_backticks, matrix", {
x <- matrix(1:9, nrow = 3)
out <- text_remove_backticks(x)
expect_equal(dimnames(x), dimnames(out))
expect_identical(dimnames(x), dimnames(out))

colnames(x) <- rownames(x) <- 1:3
out <- text_remove_backticks(x)
expect_equal(dimnames(x), dimnames(out))
expect_identical(dimnames(x), dimnames(out))

colnames(x) <- rownames(x) <- paste0("`", 1:3, "`")
out <- text_remove_backticks(x)
expect_equal(list(as.character(1:3), as.character(1:3)), dimnames(out))
expect_identical(list(as.character(1:3), as.character(1:3)), dimnames(out))
})
Loading

2 comments on commit ebe7d72

@strengejacke
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@IndrajeetPatil Are the failing tests temporary (Matrix update?), or do we need to update some of our GHA?

@IndrajeetPatil
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If it is indeed related to Matrix update, I don't see what more we can do since we already always install Matrix from source in GHA.

Please sign in to comment.