test_that("can use character vectors or bare functions", { df <- data.frame(x = 1:3) expect_equal(summarise_all(df, "mean"), data.frame(x = 2)) expect_equal(summarise_all(df, mean), data.frame(x = 2)) expect_equal(mutate_all(df, list(x = "mean")), data.frame(x = rep(2, 3))) expect_equal(mutate_all(df, list(x = mean)), data.frame(x = rep(2, 3))) }) test_that("default names are smallest unique set", { df <- data.frame(x = 1:3, y = 1:3) expect_named(summarise_at(df, vars(x:y), list(mean)), c("x", "y")) expect_named(summarise_at(df, vars(x), list(mean = mean, sd = sd)), c("mean", "sd")) expect_named(summarise_at(df, vars(x:y), list(mean = mean, sd = sd)), c("x_mean", "y_mean", "x_sd", "y_sd")) }) test_that("named arguments force complete names", { df <- data.frame(x = 1:3, y = 1:3) expect_named(summarise_at(df, vars(x:y), list(mean = mean)), c("x_mean", "y_mean")) expect_named(summarise_at(df, vars(x = x), list(mean = mean, sd = sd)), c("x_mean", "x_sd")) }) expect_classes <- function(tbl, expected) { classes <- unname(map_chr(tbl, class)) classes <- paste0(substring(classes, 0, 1), collapse = "") expect_equal(classes, expected) } test_that("can select colwise", { columns <- iris %>% mutate_at(NULL, as.character) expect_classes(columns, "nnnnf") columns <- iris %>% mutate_at(vars(starts_with("Petal")), as.character) expect_classes(columns, "nnccf") numeric <- iris %>% mutate_at(c(1, 3), as.character) expect_classes(numeric, "cncnf") character <- iris %>% mutate_at("Species", as.character) expect_classes(character, "nnnnc") }) test_that("can probe colwise", { predicate <- iris %>% mutate_if(is.factor, as.character) expect_classes(predicate, "nnnnc") logical <- iris %>% mutate_if(c(TRUE, FALSE, TRUE, TRUE, FALSE), as.character) expect_classes(logical, "cnccf") }) test_that("non syntactic colnames work", { df <- tibble(`x 1` = 1:3) expect_identical(summarise_at(df, "x 1", sum)[[1]], 6L) expect_identical(summarise_if(df, is.numeric, sum)[[1]], 6L) expect_identical(summarise_all(df, sum)[[1]], 6L) expect_identical(mutate_all(df, `*`, 2)[[1]], (1:3) * 2) }) test_that("empty selection does not select everything (#2009, #1989)", { expect_equal( tibble::remove_rownames(mtcars), tibble::remove_rownames(mutate_if(mtcars, is.factor, as.character)) ) }) test_that("predicate can be quoted", { expected <- mutate_if(mtcars, is_integerish, mean) expect_identical(mutate_if(mtcars, "is_integerish", mean), expected) expect_identical(mutate_if(mtcars, ~ is_integerish(.x), mean), expected) }) test_that("transmute verbs do not retain original variables", { expect_named(transmute_all(tibble(x = 1:3, y = 1:3), list(mean = mean, sd = sd)), c("x_mean", "y_mean", "x_sd", "y_sd")) expect_named(transmute_if(tibble(x = 1:3, y = 1:3), is_integer, list(mean = mean, sd = sd)), c("x_mean", "y_mean", "x_sd", "y_sd")) expect_named(transmute_at(tibble(x = 1:3, y = 1:3), vars(x:y), list(mean = mean, sd = sd)), c("x_mean", "y_mean", "x_sd", "y_sd")) }) test_that("can rename with vars() (#2594)", { expect_identical( mutate_at(tibble(x = 1:3), vars(y = x), mean), tibble(x = 1:3, y = c(2, 2, 2)) ) }) test_that("selection works with grouped data frames (#2624)", { gdf <- group_by(iris, Species) expect_snapshot(out <- mutate_if(gdf, is.factor, as.character)) expect_identical(out, gdf) }) test_that("at selection works even if not all ops are named (#2634)", { df <- tibble(x = 1, y = 2) expect_identical(mutate_at(df, vars(z = x, y), list(~. + 1)), tibble(x = 1, y = 3, z = 2)) }) test_that("can use a purrr-style lambda", { expect_identical(summarise_at(mtcars, vars(1:2), ~ mean(.x)), summarise(mtcars, mpg = mean(mpg), cyl = mean(cyl))) }) test_that("mutate and transmute variants does not mutate grouping variable (#3351, #3480)", { tbl <- tibble(gr1 = rep(1:2, 4), gr2 = rep(1:2, each = 4), x = 1:8) %>% group_by(gr1) res <- mutate(tbl, gr2 = sqrt(gr2), x = sqrt(x)) expect_message(expect_identical(mutate_all(tbl, sqrt), res), "ignored") expect_message(expect_identical(transmute_all(tbl, sqrt), res), "ignored") expect_message(expect_identical(mutate_if(tbl, is.integer, sqrt), res), "ignored") expect_message(expect_identical(transmute_if(tbl, is.integer, sqrt), res), "ignored") expect_identical(transmute_at(tbl, vars(-group_cols()), sqrt), res) expect_identical(mutate_at(tbl, vars(-group_cols()), sqrt), res) }) test_that("summarise variants does not summarise grouping variable (#3351, #3480)", { tbl <- tibble(gr1 = rep(1:2, 4), gr2 = rep(1:2, each = 4), x = 1:8) %>% group_by(gr1) res <- summarise(tbl, gr2 = mean(gr2), x = mean(x)) expect_identical(summarise_all(tbl, mean), res) expect_identical(summarise_if(tbl, is.integer, mean), res) }) test_that("summarise_at removes grouping variables (#3613)", { d <- tibble( x = 1:2, y = 3:4, g = 1:2) %>% group_by(g) res <- d %>% group_by(g) %>% summarise_at(-1, mean) expect_equal(names(res), c("g", "y")) }) test_that("group_by_(at,all) handle utf-8 names (#3829)", { local_non_utf8_encoding() name <- get_native_lang_string() tbl <- tibble(a = 1) %>% setNames(name) res <- group_by_all(tbl) %>% groups() expect_equal(res[[1]], sym(name)) res <- group_by_at(tbl, name) %>% groups() expect_equal(res[[1]], sym(name)) }) test_that("*_(all,at) handle utf-8 names (#2967)", { local_non_utf8_encoding() name <- get_native_lang_string() tbl <- tibble(a = 1) %>% setNames(name) res <- tbl %>% mutate_all(list(as.character)) %>% names() expect_equal(res, name) res <- tbl %>% mutate_at(name, list(as.character)) %>% names() expect_equal(res, name) res <- tbl %>% summarise_all(list(as.character)) %>% names() expect_equal(res, name) res <- tbl %>% summarise_at(name, list(as.character)) %>% names() expect_equal(res, name) res <- select_at(tbl, name) %>% names() expect_equal(res, name) }) test_that("summarise_at with multiple columns AND unnamed functions works (#4119)", { res <- storms %>% summarise_at(vars(wind, pressure), list(mean, median)) expect_equal(ncol(res), 4L) expect_equal(names(res), c("wind_fn1", "pressure_fn1", "wind_fn2", "pressure_fn2")) res <- storms %>% summarise_at(vars(wind, pressure), list(n = length, mean, median)) expect_equal(ncol(res), 6L) expect_equal(names(res), c("wind_n", "pressure_n", "wind_fn1", "pressure_fn1", "wind_fn2", "pressure_fn2")) }) test_that("mutate_at with multiple columns AND unnamed functions works (#4119)", { res <- storms %>% mutate_at(vars(wind, pressure), list(mean, median)) expect_equal(ncol(res), ncol(storms) + 4L) expect_equal( names(res), c(names(storms), c("wind_fn1", "pressure_fn1", "wind_fn2", "pressure_fn2")) ) }) test_that("colwise mutate have .data in scope of rlang lambdas (#4183)", { results <- list( iris %>% mutate_if(is.numeric, ~ . / iris$Petal.Width), iris %>% mutate_if(is.numeric, ~ . / Petal.Width), iris %>% mutate_if(is.numeric, ~ . / .data$Petal.Width), iris %>% mutate_if(is.numeric, list(~ . / iris$Petal.Width )), iris %>% mutate_if(is.numeric, list(~ . / Petal.Width )), iris %>% mutate_if(is.numeric, list(~ . / .data$Petal.Width)), iris %>% mutate_if(is.numeric, ~ .x / iris$Petal.Width), iris %>% mutate_if(is.numeric, ~ .x / Petal.Width), iris %>% mutate_if(is.numeric, ~ .x / .data$Petal.Width), iris %>% mutate_if(is.numeric, list(~ .x / iris$Petal.Width )), iris %>% mutate_if(is.numeric, list(~ .x / Petal.Width )), iris %>% mutate_if(is.numeric, list(~ .x / .data$Petal.Width)) ) for(i in 2:12) { expect_equal(results[[1]], results[[i]]) } }) test_that("can choose the name of vars with multiple funs (#4180)", { expect_identical( mtcars %>% group_by(cyl) %>% summarise_at(vars(DISP = disp), list(mean = mean, median = median)), mtcars %>% group_by(cyl) %>% summarise(DISP_mean = mean(disp), DISP_median = median(disp)) ) }) test_that("summarise_at() unquotes in lambda (#4287)", { df <- tibble::tibble(year = seq(2015, 2050, 5), P = 5.0 + 2.5 * year) year <- 2037 expect_equal( summarise_at(df, vars(-year), ~approx(x = year, y = ., xout = !!year)$y), summarise(df, P = approx(x = year, y = P, xout = !!year)$y) ) }) test_that("mutate_at() unquotes in lambdas (#4199)", { df <- tibble(a = 1:10, b = runif(1:10), c = letters[1:10]) varname <- "a" symname <- rlang::sym(varname) quoname <- enquo(symname) expect_identical( df %>% mutate(b = mean(!!quoname)), df %>% mutate_at(vars(matches("b")), list(~mean(!!quoname))) ) }) test_that("summarise_at() can refer to local variables and columns (#4304)", { # using local here in case someone wants to run the content of the test # as opposed to the test_that() call res <- local({ value <- 10 expect_identical( iris %>% summarise_at("Sepal.Length", ~ sum(. / value)), iris %>% summarise(Sepal.Length = sum(Sepal.Length / value)) ) }) }) test_that("colwise mutate handles formulas with constants (#4374)", { expect_identical( tibble(x = 12) %>% mutate_all(~ 42), tibble(x = 42) ) expect_identical( tibble(x = 12) %>% mutate_at("x", ~ 42), tibble(x = 42) ) }) test_that("colwise mutate handle named chr vectors", { res <- tibble(x = 1:10) %>% mutate_at(c(y = "x"), mean) expect_identical(res, tibble(x = 1:10, y = 5.5)) }) test_that("colwise verbs deprecate quosures (#4330)", { expect_snapshot({ (expect_warning(mutate_at(mtcars, vars(mpg), quo(mean(.))))) (expect_warning(summarise_at(mtcars, vars(mpg), quo(mean(.))))) }) }) test_that("rlang lambda inherit from the data mask (#3843)", { res <- iris %>% mutate_at( vars(starts_with("Petal")), ~ ifelse(Species == "setosa" & . < 1.5, NA, .) ) expected <- iris %>% mutate( Petal.Length = ifelse(Species == "setosa" & Petal.Length < 1.5, NA, Petal.Length), Petal.Width = ifelse(Species == "setosa" & Petal.Width < 1.5, NA, Petal.Width) ) expect_identical(res, expected) res <- iris %>% group_by(Species) %>% mutate_at( vars(starts_with("Petal")), ~ ifelse(Species == "setosa" & . < 1.5, NA, .) ) expected <- iris %>% group_by(Species) %>% mutate( Petal.Length = ifelse(Species == "setosa" & Petal.Length < 1.5, NA, Petal.Length), Petal.Width = ifelse(Species == "setosa" & Petal.Width < 1.5, NA, Petal.Width) ) expect_identical(res, expected) }) test_that("_if isn't tripped up by columns named 'i' (#5330)", { test_df <- tibble(i = c("a", "b"), j = c(1, 2)) result_df <- test_df %>% mutate_if(is.character, as.factor) expect_equal(result_df$i, as.factor(test_df$i)) expect_equal(result_df$j, test_df$j) }) # Errors -------------------------------------------- test_that("colwise mutate gives meaningful error messages", { expect_snapshot({ # column not found (expect_error( mutate_at(tibble(), "test", ~ 1) )) # not summarising grouping variables tbl <- tibble(gr1 = rep(1:2, 4), gr2 = rep(1:2, each = 4), x = 1:8) tbl <- group_by(tbl, gr1) (expect_error( summarise_at(tbl, vars(gr1), mean) )) # improper additional arguments (expect_error( mutate_all(mtcars, length, 0, 0) )) (expect_error( mutate_all(mtcars, mean, na.rm = TRUE, na.rm = TRUE) )) }) })