Skip to content

Commit

Permalink
Continuing to try to improve test speed
Browse files Browse the repository at this point in the history
  • Loading branch information
bertcarnell committed Feb 12, 2023
1 parent ad2c98a commit 7b51c6a
Show file tree
Hide file tree
Showing 6 changed files with 17 additions and 13 deletions.
4 changes: 4 additions & 0 deletions tests/testthat/setup-models.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,5 @@
# Copyright 2023 Robert Carnell

# Common models between importance and tornado tests

survreg_model <- survival::survreg(survival::Surv(futime, fustat) ~ ecog.ps*rx + age,
Expand Down Expand Up @@ -31,3 +33,5 @@ if (requireNamespace("glmnet")) {
glmnet_model_weighted <- glmnet::cv.glmnet(x = glmnet_mm, y = mtcars$mpg,
family = "gaussian", weights = rep(1:2, nrow(mtcars) / 2))
}

n_permutation_tests <- 10
5 changes: 5 additions & 0 deletions tests/testthat/setup-tornado_train.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,11 @@

rf_model_numeric <- caret::train(x = subset(mtcars, select = -mpg), y = mtcars$mpg, method = "rf")

if (!exists("my_mtcars"))
{
source("setup-create_endpoints.R")
}

rf_model_factor <- caret::train(x = subset(my_mtcars, select = -mpg), y = my_mtcars$mpg, method = "rf")

rf_model_class <- caret::train(x = subset(my_mtcars, select = -vs), y = my_mtcars$vs, method = "rf")
Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/test-importance_glmnet.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,15 +3,15 @@ context("test-importance_glmnet")
test_that("importance glmnet works", {
testthat::skip_if_not_installed("glmnet")

imp <- importance(glmnet_model, mtcars, glmnet_form, nperm = 25)
imp <- importance(glmnet_model, mtcars, glmnet_form, nperm = n_permutation_tests)
expect_equal(class(imp), "importance_plot")
plot(imp)
})

test_that("importance glmnet works with weights", {
testthat::skip_if_not_installed("glmnet")

imp <- importance(glmnet_model_weighted, mtcars, glmnet_form, nperm = 25)
imp <- importance(glmnet_model_weighted, mtcars, glmnet_form, nperm = n_permutation_tests)
expect_equal(class(imp), "importance_plot")
plot(imp)
})
4 changes: 2 additions & 2 deletions tests/testthat/test-importance_survreg.R
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
context("test-importance_survreg")

test_that("importance.survreg works", {
imp <- importance(survreg_model, survival::ovarian, nperm = 25)
imp <- importance(survreg_model, survival::ovarian, nperm = n_permutation_tests)
expect_equal(class(imp), "importance_plot")
plot(imp)
})

test_that("importance.survreg works with weights", {
imp <- importance(survreg_model_weighted, survival::ovarian, nperm = 25)
imp <- importance(survreg_model_weighted, survival::ovarian, nperm = n_permutation_tests)
expect_equal(class(imp), "importance_plot")
plot(imp)
})
4 changes: 2 additions & 2 deletions tests/testthat/test-plot_importance_plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ test_that("plotting works for base packages", {
gtest <- survival::survreg(survival::Surv(futime, fustat) ~ ecog.ps*rx + age,
data = survival::ovarian,
dist = "weibull")
imp <- importance(gtest, survival::ovarian, nperm = 500)
imp <- importance(gtest, survival::ovarian, nperm = n_permutation_tests)
expect_equal(imp$type, "survreg")
plot(imp)

Expand All @@ -46,7 +46,7 @@ test_that("plotting works for glmnet", {
mf <- model.frame(form, data = mtcars)
mm <- model.matrix(mf, mf)
gtest <- glmnet::cv.glmnet(x = mm, y = mtcars$mpg, family = "gaussian")
imp <- importance(gtest, mtcars, form, nperm = 100)
imp <- importance(gtest, mtcars, form, nperm = n_permutation_tests)
expect_equal(imp$type, "cv.glmnet")
plot(imp)

Expand Down
9 changes: 2 additions & 7 deletions tests/testthat/test-tornado_lm.R
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,7 @@ test_that("linear model tornado works", {
plot(g)

# test a model with two factors
mydat <- mtcars
mydat$cyl <- factor(mydat$cyl)
mydat$vs <- factor(mydat$vs)
gtest <- lm(mpg ~ cyl + wt + hp + vs, data = mydat)
gtest <- lm(mpg ~ cyl + wt + hp + vs, data = my_mtcars)
torn <- tornado(gtest, type = "PercentChange", alpha = 0.10)
expect_equal(class(torn), "tornado_plot")
g <- plot(torn, plot = FALSE, xlabel = "MPG")
Expand All @@ -53,9 +50,7 @@ test_that("linear model tornado works", {
plot(g)

# test a variable with one factor
mydat <- mtcars
mydat$cyl <- factor(mydat$cyl)
gtest <- lm(mpg ~ cyl + wt + hp, data = mydat)
gtest <- lm(mpg ~ cyl + wt + hp, data = my_mtcars)
torn <- tornado(gtest, type = "PercentChange", alpha = 0.10)
expect_equal(class(torn), "tornado_plot")
g <- plot(torn, plot = FALSE, xlabel = "MPG")
Expand Down

0 comments on commit 7b51c6a

Please sign in to comment.