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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
foo <- function(data, select = NULL, exclude = NULL, regex = FALSE) {
.select_nse(select, data, exclude = exclude, regex = regex, ignore_case = FALSE)
}
test_that(".select_nse needs data", {
expect_error(foo(select = "Sepal.Length", data = NULL), regexp = "must be provided")
})
test_that(".select_nse needs a data frame or something coercible to a dataframe", {
expect_identical(
foo(select = "Sepal.Length", data = as.matrix(head(iris))),
"Sepal.Length"
)
expect_error(
foo(select = "Sepal.Length", data = list(1:3, 1:2)),
regexp = "must be a data frame"
)
})
test_that(".select_nse: arg 'select' works", {
expect_identical(
foo(iris, select = NULL),
names(iris)
)
expect_identical(
foo(iris, Petal.Length),
"Petal.Length"
)
expect_identical(
foo(iris, c("Petal.Length", "Sepal.Width")),
c("Petal.Length", "Sepal.Width")
)
expect_identical(
foo(iris, c(3, 2)),
c("Petal.Length", "Sepal.Width")
)
expect_identical(
foo(iris, 1:5),
names(iris)
)
expect_identical(
foo(iris, is.numeric),
c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
)
expect_identical(
foo(iris, is.numeric()),
c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
)
expect_identical(
extract_column_names(iris, sepal.length, ignore_case = TRUE),
"Sepal.Length"
)
expect_identical(
foo(iris, starts_with("Petal")),
c("Petal.Length", "Petal.Width")
)
expect_identical(
foo(iris, ends_with("Length")),
c("Sepal.Length", "Petal.Length")
)
expect_identical(
foo(iris, contains("Length")),
c("Sepal.Length", "Petal.Length")
)
expect_identical(
foo(iris, regex("Length$")),
c("Sepal.Length", "Petal.Length")
)
expect_identical(
foo(iris, "Len", regex = TRUE),
c("Sepal.Length", "Petal.Length")
)
})
test_that(".select_nse: arg 'exclude' works", {
expect_identical(
foo(iris, exclude = c("Petal.Length", "Sepal.Width")),
c("Sepal.Length", "Petal.Width", "Species")
)
expect_identical(
foo(iris, exclude = c(3, 2)),
c("Sepal.Length", "Petal.Width", "Species")
)
expect_identical(
foo(iris, exclude = starts_with("Petal")),
c("Sepal.Length", "Sepal.Width", "Species")
)
expect_identical(
foo(iris, exclude = ends_with("Length")),
c("Sepal.Width", "Petal.Width", "Species")
)
expect_identical(
foo(iris, exclude = contains("Length")),
c("Sepal.Width", "Petal.Width", "Species")
)
expect_identical(
foo(iris, exclude = regex("Length$")),
c("Sepal.Width", "Petal.Width", "Species")
)
})
test_that(".select_nse: args 'select' and 'exclude' at the same time", {
expect_identical(
foo(iris, select = contains("Length"), exclude = starts_with("Petal")),
"Sepal.Length"
)
expect_identical(
foo(iris, select = contains("Length"), exclude = contains("Length")),
character(0)
)
})
test_that(".select_nse: misc", {
iris2 <- iris[, 1:3]
expect_identical(
foo(iris, select = names(iris2)),
c("Sepal.Length", "Sepal.Width", "Petal.Length")
)
expect_identical(
foo(iris, select = names(iris2)[2]),
"Sepal.Width"
)
})
test_that(".select_nse: works with function and namespace", {
model <- lm(Petal.Length ~ Petal.Width, data = iris)
out <- data_select(iris, insight::find_predictors(model, effects = "fixed", flatten = TRUE))
expect_identical(out, iris["Petal.Width"])
fun <- function(x) {
data_select(iris, x)
}
out <- fun(insight::find_predictors(model, effects = "fixed", flatten = TRUE))
expect_identical(out, iris["Petal.Width"])
x <- "Sepal.Length"
out <- fun(insight::find_predictors(model, effects = "fixed", flatten = TRUE))
expect_identical(out, iris["Petal.Width"])
})
test_that(".select_nse: allow character vector with :", {
data(mtcars)
out <- data_select(mtcars, c("cyl:hp", "wt", "vs:gear"))
expect_named(out, c("cyl", "disp", "hp", "wt", "vs", "am", "gear"))
out <- data_select(mtcars, c("cyl:hp", "wta", "vs:gear"))
expect_named(out, c("cyl", "disp", "hp", "vs", "am", "gear"))
out <- data_select(mtcars, c("hp:cyl", "wta", "vs:gear"))
expect_named(out, c("hp", "disp", "cyl", "vs", "am", "gear"))
out <- data_select(mtcars, c("cyl:hq", "wt", "vs:gear"))
expect_named(out, c("wt", "vs", "am", "gear"))
expect_warning(
center(mtcars, c("cyl:hp", "wta", "vs:gear"), verbose = TRUE),
regex = "Did you mean \"wt\""
)
expect_warning(
center(mtcars, c("cyl:hq", "wt", "vs:gear"), verbose = TRUE),
regex = "Did you mean one of \"hp\""
)
})
|
