/
test-glmnet.R
83 lines (67 loc) · 2.14 KB
/
test-glmnet.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
context("glmnet tidiers")
set.seed(2014)
x <- matrix(rnorm(100 * 20), 100, 20)
test_that("glmnet tidiers work", {
y <- rnorm(100)
fit1 <- glmnet::glmnet(x, y)
td1 <- tidy(fit1)
check_tidy(td1, exp.col = 5)
expect_true(all(td1$estimate != 0))
td2 <- tidy(fit1, return_zeros = TRUE)
check_tidy(td2, exp.col = 5)
expect_true(any(td2$estimate == 0))
gl <- glance(fit1)
check_tidy(gl, exp.col = 2)
})
test_that("multinomial response glmnet tidier works", {
g <- sample(1:4, 100, replace = TRUE)
fit2 <- glmnet::glmnet(x, g, family = "multinomial")
expect_warning(td <- tidy(fit2))
check_tidy(td, exp.col = 6)
})
test_that("cv.glmnet tidiers work", {
set.seed(2014)
nobs <- 100
nvar <- 50
real <- 5
x <- matrix(rnorm(nobs * nvar), nobs, nvar)
beta <- c(rnorm(real, 0, 1), rep(0, nvar - real))
y <- c(t(beta) %*% t(x)) + rnorm(nvar, sd = 3)
cvfit1 <- glmnet::cv.glmnet(x, y)
td <- tidy(cvfit1)
check_tidy(td, exp.col = 6)
gl <- glance(cvfit1)
check_tidy(gl, exp.col = 2)
})
glm_td <- function() {
cars_matrix <- model.matrix(mpg ~ wt + disp, data = mtcars)
glm_fit <- glmnet::glmnet(cars_matrix[, -1], mtcars$mpg)
glm_fit
}
cv_glm_td <- function() {
set.seed(1234)
cars_matrix <- model.matrix(mpg ~ wt + disp, data = mtcars)
glm_fit <- glmnet::cv.glmnet(cars_matrix[, -1], mtcars$mpg)
glm_fit
}
test_that("tidy.glmnet works", {
td <- tidy(glm_td())
tidy_names <- c("term", "step", "estimate", "lambda", "dev.ratio")
check_tidy(td, exp.col = 5, exp.names = tidy_names)
expect_true(all(c("(Intercept)", "wt", "disp") %in% td$term))
})
test_that("glance.glmnet works", {
td <- glance(glm_td())
tidy_names <- c("nulldev", "npasses")
check_tidy(td, exp.row = 1, exp.col = 2, exp.names = tidy_names)
})
test_that("tidy.cv.glmnet works", {
td <- tidy(cv_glm_td())
tidy_names <- unlist(strsplit("lambda estimate std.error conf.high conf.low nzero", split = "[ ]"))
check_tidy(td, exp.col = 6, exp.names = tidy_names)
})
test_that("glance.cv.glmnet works", {
td <- glance(cv_glm_td())
tidy_names <- c("lambda.min", "lambda.1se")
check_tidy(td, exp.row = 1, exp.col = 2, exp.names = tidy_names)
})