1test_that("select preserves grouping", { 2 gf <- group_by(tibble(g = 1:3, x = 3:1), g) 3 4 i <- count_regroups(out <- select(gf, h = g)) 5 expect_equal(i, 0) 6 expect_equal(group_vars(out), "h") 7}) 8 9test_that("grouping variables preserved with a message, unless already selected (#1511, #5841)", { 10 df <- tibble(g = 1:3, x = 3:1) %>% group_by(g) 11 12 expect_snapshot({ 13 res <- select(df, x) 14 }) 15 expect_named(res, c("g", "x")) 16 17 df <- tibble(a = 1, b = 2, c = 3) %>% group_by(a) 18 expect_equal(df %>% select(a = b), tibble(a = 2)) 19 20 df <- tibble(a = 1, b = 2, c = 3) %>% group_by(a, b) 21 expect_snapshot({ 22 expect_equal(df %>% select(a = c), tibble(b = 2, a = 3) %>% group_by(b)) 23 expect_equal(df %>% select(b = c), tibble(a = 1, b = 3) %>% group_by(a)) 24 }) 25}) 26 27test_that("non-syntactic grouping variable is preserved (#1138)", { 28 expect_snapshot( 29 df <- tibble(`a b` = 1L) %>% group_by(`a b`) %>% select() 30 ) 31 expect_named(df, "a b") 32}) 33 34test_that("select doesn't fail if some names missing", { 35 df1 <- data.frame(x = 1:10, y = 1:10, z = 1:10) 36 df2 <- setNames(df1, c("x", "y", "")) 37 # df3 <- setNames(df1, c("x", "", "")) 38 39 expect_equal(select(df1, x), data.frame(x = 1:10)) 40 expect_equal(select(df2, x), data.frame(x = 1:10)) 41 # expect_equal(select(df3, x), data.frame(x = 1:10)) 42}) 43 44 45# Special cases ------------------------------------------------- 46 47test_that("select with no args returns nothing", { 48 empty <- select(mtcars) 49 expect_equal(ncol(empty), 0) 50 expect_equal(nrow(empty), 32) 51 52 empty <- select(mtcars, !!!list()) 53 expect_equal(ncol(empty), 0) 54 expect_equal(nrow(empty), 32) 55}) 56 57test_that("select excluding all vars returns nothing", { 58 expect_equal(dim(select(mtcars, -(mpg:carb))), c(32, 0)) 59 expect_equal(dim(select(mtcars, starts_with("x"))), c(32, 0)) 60 expect_equal(dim(select(mtcars, -matches("."))), c(32, 0)) 61}) 62 63test_that("negating empty match returns everything", { 64 df <- data.frame(x = 1:3, y = 3:1) 65 expect_equal(select(df, -starts_with("xyz")), df) 66}) 67 68test_that("can select with duplicate columns", { 69 df <- tibble(x = 1, x = 2, y = 1, .name_repair = "minimal") 70 71 # can extract duplicate cols by position 72 expect_named(df %>% select(1, 3), c("x", "y")) 73 74 # can select out non-duplicated columns 75 expect_named(df %>% select(y), "y") 76}) 77 78# Select variables ----------------------------------------------- 79 80test_that("select can be before group_by (#309)", { 81 df <- data.frame( 82 id = c(1, 1, 2, 2, 2, 3, 3, 4, 4, 5), 83 year = c(2013, 2013, 2012, 2013, 2013, 2013, 2012, 2012, 2013, 2013), 84 var1 = rnorm(10) 85 ) 86 dfagg <- df %>% 87 group_by(id, year) %>% 88 select(id, year, var1) %>% 89 summarise(var1 = mean(var1)) 90 expect_equal(names(dfagg), c("id", "year", "var1")) 91}) 92 93 94test_that("select succeeds in presence of raw columns (#1803)", { 95 df <- tibble(a = 1:3, b = as.raw(1:3)) 96 expect_identical(select(df, a), df["a"]) 97 expect_identical(select(df, b), df["b"]) 98 expect_identical(select(df, -b), df["a"]) 99}) 100 101test_that("arguments to select() don't match vars_select() arguments", { 102 df <- tibble(a = 1) 103 expect_identical(select(df, var = a), tibble(var = 1)) 104 expect_identical(select(group_by(df, a), var = a), group_by(tibble(var = 1), var)) 105 expect_identical(select(df, exclude = a), tibble(exclude = 1)) 106 expect_identical(select(df, include = a), tibble(include = 1)) 107 expect_identical(select(group_by(df, a), exclude = a), group_by(tibble(exclude = 1), exclude)) 108 expect_identical(select(group_by(df, a), include = a), group_by(tibble(include = 1), include)) 109}) 110 111test_that("can select() with .data pronoun (#2715)", { 112 expect_identical(select(mtcars, .data$cyl), select(mtcars, cyl)) 113}) 114 115test_that("can select() with character vectors", { 116 expect_identical(select(mtcars, "cyl", !!"disp", c("cyl", "am", "drat")), mtcars[c("cyl", "disp", "am", "drat")]) 117}) 118 119test_that("select() treats NULL inputs as empty", { 120 expect_identical(select(mtcars, cyl), select(mtcars, NULL, cyl, NULL)) 121}) 122 123test_that("can select() with strings and character vectors", { 124 vars <- c(foo = "cyl", bar = "am") 125 126 expect_identical(select(mtcars, !!!vars), select(mtcars, foo = cyl, bar = am)) 127 expect_identical(select(mtcars, !!vars), select(mtcars, foo = cyl, bar = am)) 128}) 129 130test_that("select works on empty names (#3601)", { 131 df <- data.frame(x=1, y=2, z=3) 132 colnames(df) <- c("x","y","") 133 expect_identical(select(df, x)$x, 1) 134 135 colnames(df) <- c("","y","z") 136 expect_identical(select(df, y)$y, 2) 137}) 138 139test_that("select works on NA names (#3601)", { 140 df <- data.frame(x=1, y=2, z=3) 141 colnames(df) <- c("x","y",NA) 142 expect_identical(select(df, x)$x, 1) 143 144 colnames(df) <- c(NA,"y","z") 145 expect_identical(select(df, y)$y, 2) 146}) 147 148test_that("select() keeps attributes of raw data frames (#5831)", { 149 df <- data.frame(x = 1) 150 attr(df, "a") <- "b" 151 expect_equal(attr(select(df, x), "a"), "b") 152}) 153 154# dplyr_col_select() ------------------------------------------------------ 155 156test_that("dplyr_col_select() aborts when `[` implementation is broken", { 157 local_methods( 158 "[.dplyr_test_broken_operator" = function(x, ...) { 159 unclass(x) 160 }, 161 "[.dplyr_test_operator_wrong_size" = function(x, ...) { 162 data.frame() 163 } 164 ) 165 df1 <- new_tibble(list(x = 1), nrow = 1L, class = "dplyr_test_broken_operator") 166 expect_error(dplyr_col_select(df1, 1:2)) 167 expect_error(dplyr_col_select(df1, 0)) 168 169 df2 <- new_tibble(list(x = 1), nrow = 1L, class = "dplyr_test_operator_wrong_size") 170 expect_error(dplyr_col_select(d2f, 1:2)) 171 172 # from vctrs 173 expect_snapshot(error = TRUE, dplyr_col_select(df1, 2)) 174 175 # not returning a data frame 176 expect_snapshot(error = TRUE, dplyr_col_select(df1, 1)) 177 178 # unexpected number of columns 179 expect_snapshot(error = TRUE, dplyr_col_select(df2, 1)) 180}) 181