/
test-select.r
158 lines (121 loc) · 5.15 KB
/
test-select.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
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
context("Select")
df <- as.data.frame(as.list(setNames(1:26, letters)))
srcs <- temp_srcs(c("df", "sqlite", "postgres"))
tbls <- temp_load(srcs, df)
test_that("two selects equivalent to one", {
compare_tbls(tbls, function(tbl) tbl %>% select(l:s) %>% select(n:o),
ref = select(df, n:o))
})
test_that("select does not lose grouping (#147)", {
df <- tbl_df(data.frame(a = rep(1:4, 2), b = rep(1:4, each = 2), x = runif(8)))
grouped <- df %>% group_by(a) %>% select(a, b, x)
expect_equal(groups(grouped), list(quote(a)))
})
test_that("grouping variables preserved with a message (#1511)", {
df <- data_frame(g = 1:3, x = 3:1) %>% group_by(g)
expect_message(res <- select(df, x), "Adding missing grouping variables")
expect_named(res, c("g", "x"))
})
test_that("non-syntactic grouping variable is preserved (#1138)", {
df <- data_frame(`a b` = 1L) %>% group_by(`a b`) %>% select()
expect_named(df, "a b")
})
test_that("select doesn't fail if some names missing", {
df1 <- data.frame(x = 1:10, y = 1:10, z = 1:10)
df2 <- setNames(df1, c("x", "y", ""))
# df3 <- setNames(df1, c("x", "", ""))
expect_equal(select(df1, x), data.frame(x = 1:10))
expect_equal(select(df2, x), data.frame(x = 1:10))
# expect_equal(select(df3, x), data.frame(x = 1:10))
})
# Empty selects -------------------------------------------------
test_that("select with no args returns nothing", {
empty <- select(mtcars)
expect_equal(ncol(empty), 0)
expect_equal(nrow(empty), 32)
})
test_that("select excluding all vars returns nothing", {
expect_equal(dim(select(mtcars, -(mpg:carb))), c(32, 0))
expect_equal(dim(select(mtcars, starts_with("x"))), c(32, 0))
expect_equal(dim(select(mtcars, -matches("."))), c(32, 0))
})
test_that("negating empty match returns everything", {
df <- data.frame(x = 1:3, y = 3:1)
expect_equal(select(df, -starts_with("xyz")), df)
})
# Select variables -----------------------------------------------
test_that("select_vars can rename variables", {
vars <- c("a", "b")
expect_equal(select_vars(vars, b = a, a = b), c("b" = "a", "a" = "b"))
})
test_that("last rename wins", {
vars <- c("a", "b")
expect_equal(select_vars(vars, b = a, c = a), c("c" = "a"))
})
test_that("negative index removes values", {
vars <- letters[1:3]
expect_equal(select_vars(vars, -c), c("a" = "a", "b" = "b"))
expect_equal(select_vars(vars, a:c, -c), c("a" = "a", "b" = "b"))
expect_equal(select_vars(vars, a, b, c, -c), c("a" = "a", "b" = "b"))
expect_equal(select_vars(vars, -c, a, b), c("a" = "a", "b" = "b"))
})
test_that("select can be before group_by (#309)",{
df <- data.frame(id=c(1,1,2,2,2,3,3,4,4,5), year=c(2013,2013,2012,2013,2013,2013,2012,2012,2013,2013), var1=rnorm(10))
dfagg <- df %>%
group_by(id, year) %>%
select(id, year, var1) %>%
summarise(var1=mean(var1))
expect_equal(names(dfagg), c("id", "year", "var1"))
expect_equal(attr(dfagg, "vars" ), list(quote(id)))
})
# Database ---------------------------------------------------------------------
test_that("select renames variables (#317)", {
first <- tbls$sqlite %>% select(A = a)
expect_equal(tbl_vars(first), "A")
expect_equal(tbl_vars(first %>% select(A)), "A")
expect_equal(tbl_vars(first %>% select(B = A)), "B")
})
test_that("select preserves grouping vars", {
first <- tbls$sqlite %>% group_by(b) %>% select(a)
expect_equal(tbl_vars(first), c("b", "a"))
})
test_that("rename handles grouped data (#640)", {
res <- data_frame(a = 1, b = 2) %>% group_by(a) %>% rename(c = b)
expect_equal(names(res), c("a", "c"))
})
# combine_vars ------------------------------------------------------------
# This is the low C++ function which works on integer indices
test_that("empty index gives empty output", {
vars <- combine_vars(letters, list())
expect_equal(length(vars), 0)
vars <- combine_vars(letters, list(numeric()))
expect_equal(length(vars), 0)
})
test_that("positive indexes kept", {
expect_equal(combine_vars(letters, list(1)), c(a = 1))
expect_equal(combine_vars(letters, list(1, 26)), c(a = 1, z = 26))
expect_equal(combine_vars(letters, list(c(1, 26))), c(a = 1, z = 26))
})
test_that("indexes returned in order they appear", {
expect_equal(combine_vars(letters, list(26, 1)), c(z = 26, a = 1))
})
test_that("negative index in first position includes all others", {
vars <- combine_vars(letters[1:3], list(-1))
expect_equal(vars, c(b = 2, c = 3))
})
test_that("named inputs rename outputs", {
expect_equal(combine_vars(letters[1:3], list(d = 1)), c(d = 1))
expect_equal(combine_vars(letters[1:3], list(c(d = 1))), c(d = 1))
})
test_that("if multiple names, last kept", {
expect_equal(combine_vars(letters[1:3], list(d = 1, e = 1)), c(e = 1))
expect_equal(combine_vars(letters[1:3], list(c(d = 1, e = 1))), c(e = 1))
})
test_that("if one name for multiple vars, use integer index", {
expect_equal(combine_vars(letters[1:3], list(x = 1:3)), c(x1 = 1, x2 = 2, x3 = 3))
})
test_that("invalid inputs raise error", {
expect_error(combine_vars(names(mtcars), list(0)), "positive or negative")
expect_error(combine_vars(names(mtcars), list(c(-1, 1))), "positive or negative")
expect_error(combine_vars(names(mtcars), list(12)), "must be between")
})