test_that("can use freshly create variables (#138)", {
df <- tibble(x = 1:10)
out <- summarise(df, y = mean(x), z = y + 1)
expect_equal(out$y, 5.5)
expect_equal(out$z, 6.5)
})
test_that("inputs are recycled", {
expect_equal(
tibble() %>% summarise(x = 1, y = 1:3, z = 1),
tibble(x = 1, y = 1:3, z = 1)
)
gf <- group_by(tibble(a = 1:2), a)
expect_equal(
gf %>% summarise(x = 1, y = 1:3, z = 1),
tibble(a = rep(1:2, each = 3), x = 1, y = c(1:3, 1:3), z = 1) %>% group_by(a)
)
expect_equal(
gf %>% summarise(x = seq_len(a), y = 1),
tibble(a = c(1L, 2L, 2L), x = c(1L, 1L, 2L), y = 1) %>% group_by(a)
)
})
test_that("works with empty data frames", {
# 0 rows
df <- tibble(x = integer())
expect_equal(summarise(df), tibble(.rows = 1))
expect_equal(summarise(df, n = n(), sum = sum(x)), tibble(n = 0, sum = 0))
# 0 cols
df <- tibble(.rows = 10)
expect_equal(summarise(df), tibble(.rows = 1))
expect_equal(summarise(df, n = n()), tibble(n = 10))
})
test_that("works with grouped empty data frames", {
df <- tibble(x = integer())
expect_equal(
df %>% group_by(x) %>% summarise(y = 1L),
tibble(x = integer(), y = integer())
)
expect_equal(
df %>% rowwise(x) %>% summarise(y = 1L),
group_by(tibble(x = integer(), y = integer()), x)
)
})
test_that("no expressions yields grouping data", {
df <- tibble(x = 1:2, y = 1:2)
gf <- group_by(df, x)
expect_equal(summarise(df), tibble(.rows = 1))
expect_equal(summarise(gf), tibble(x = 1:2))
expect_equal(summarise(df, !!!list()), tibble(.rows = 1))
expect_equal(summarise(gf, !!!list()), tibble(x = 1:2))
})
test_that("preserved class, but not attributes", {
df <- structure(
data.frame(x = 1:10, g1 = rep(1:2, each = 5), g2 = rep(1:5, 2)),
meta = "this is important"
)
out <- df %>% summarise(n = n())
expect_s3_class(out, "data.frame", exact = TRUE)
expect_equal(attr(out, "res"), NULL)
out <- df %>% group_by(g1) %>% summarise(n = n())
# expect_s3_class(out, "data.frame", exact = TRUE)
expect_equal(attr(out, "res"), NULL)
})
test_that("works with unquoted values", {
df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5)
expect_equal(summarise(df, out = !!1), tibble(out = 1))
expect_equal(summarise(df, out = !!quo(1)), tibble(out = 1))
expect_equal(summarise(df, out = !!(1:2)), tibble(out = 1:2))
})
test_that("formulas are evaluated in the right environment (#3019)", {
out <- mtcars %>% summarise(fn = list(rlang::as_function(~ list(~foo, environment()))))
out <- out$fn[[1]]()
expect_identical(environment(out[[1]]), out[[2]])
})
test_that("data frame results with 0 columns are ignored (#5084)", {
df1 <- tibble(x = 1:2)
expect_equal(df1 %>% group_by(x) %>% summarise(data.frame()), df1)
expect_equal(df1 %>% group_by(x) %>% summarise(data.frame(), y = 65), mutate(df1, y = 65))
expect_equal(df1 %>% group_by(x) %>% summarise(y = 65, data.frame()), mutate(df1, y = 65))
df2 <- tibble(x = 1:2, y = 3:4)
expect_equal(df2 %>% group_by(x) %>% summarise(data.frame()), df1)
expect_equal(df2 %>% group_by(x) %>% summarise(data.frame(), z = 98), mutate(df1, z = 98))
expect_equal(df2 %>% group_by(x) %>% summarise(z = 98, data.frame()), mutate(df1, z = 98))
})
# grouping ----------------------------------------------------------------
test_that("peels off a single layer of grouping", {
df <- tibble(x = rep(1:4, each = 4), y = rep(1:2, each = 8), z = runif(16))
gf <- df %>% group_by(x, y)
expect_equal(group_vars(summarise(gf)), "x")
expect_equal(group_vars(summarise(summarise(gf))), character())
})
test_that("correctly reconstructs groups", {
d <- tibble(x = 1:4, g1 = rep(1:2, 2), g2 = 1:4) %>%
group_by(g1, g2) %>%
summarise(x = x + 1)
expect_equal(group_rows(d), list_of(1:2, 3:4))
})
test_that("can modify grouping variables", {
df <- tibble(a = c(1, 2, 1, 2), b = c(1, 1, 2, 2))
gf <- group_by(df, a, b)
i <- count_regroups(out <- summarise(gf, a = a + 1))
expect_equal(i, 1)
expect_equal(out$a, c(2, 2, 3, 3))
})
# vector types ----------------------------------------------------------
test_that("summarise allows names (#2675)", {
data <- tibble(a = 1:3) %>% summarise(b = c("1" = a[[1]]))
expect_equal(names(data$b), "1")
data <- tibble(a = 1:3) %>% rowwise() %>% summarise(b = setNames(nm = a))
expect_equal(names(data$b), c("1", "2", "3"))
data <- tibble(a = c(1, 1, 2)) %>% group_by(a) %>% summarise(b = setNames(nm = a[[1]]))
expect_equal(names(data$b), c("1", "2"))
res <- data.frame(x = c(1:3), y = letters[1:3]) %>%
group_by(y) %>%
summarise(
a = length(x),
b = quantile(x, 0.5)
)
expect_equal(res$b, c("50%" = 1, "50%" = 2, "50%" = 3))
})
test_that("summarise handles list output columns (#832)", {
df <- tibble(x = 1:10, g = rep(1:2, each = 5))
res <- df %>% group_by(g) %>% summarise(y = list(x))
expect_equal(res$y[[1]], 1:5)
# preserving names
d <- tibble(x = rep(1:3, 1:3), y = 1:6, names = letters[1:6])
res <- d %>% group_by(x) %>% summarise(y = list(setNames(y, names)))
expect_equal(names(res$y[[1]]), letters[[1]])
})
test_that("summarise coerces types across groups", {
gf <- group_by(tibble(g = 1:2), g)
out <- summarise(gf, x = if (g == 1) NA else "x")
expect_type(out$x, "character")
out <- summarise(gf, x = if (g == 1L) NA else 2.5)
expect_type(out$x, "double")
})
test_that("unnamed tibbles are unpacked (#2326)", {
df <- tibble(x = 1:2)
out <- summarise(df, tibble(y = x * 2, z = 3))
expect_equal(out$y, c(2L, 4L))
expect_equal(out$z, c(3L, 3L))
})
test_that("named tibbles are packed (#2326)", {
df <- tibble(x = 1:2)
out <- summarise(df, df = tibble(y = x * 2, z = 3))
expect_equal(out$df, tibble(y = c(2L, 4L), z = c(3L, 3L)))
})
test_that("summarise(.groups=)", {
expect_message(eval_bare(
expr(data.frame(x = 1, y = 2) %>% group_by(x, y) %>% summarise()),
env(global_env())
))
expect_message(eval_bare(
expr(data.frame(x = 1, y = 2) %>% rowwise(x, y) %>% summarise()),
env(global_env())
))
df <- data.frame(x = 1, y = 2)
expect_equal(df %>% summarise(z = 3, .groups= "rowwise"), rowwise(data.frame(z = 3)))
gf <- df %>% group_by(x, y)
expect_equal(gf %>% summarise() %>% group_vars(), "x")
expect_equal(gf %>% summarise(.groups = "drop_last") %>% group_vars(), "x")
expect_equal(gf %>% summarise(.groups = "drop") %>% group_vars(), character())
expect_equal(gf %>% summarise(.groups = "keep") %>% group_vars(), c("x", "y"))
rf <- df %>% rowwise(x, y)
expect_equal(rf %>% summarise(.groups = "drop") %>% group_vars(), character())
expect_equal(rf %>% summarise(.groups = "keep") %>% group_vars(), c("x", "y"))
})
test_that("summarise() casts data frame results to common type (#5646)", {
df <- data.frame(x = 1:2, g = 1:2) %>% group_by(g)
res <- df %>%
summarise(if (g == 1) data.frame(y = 1) else data.frame(y = 1, z = 2), .groups = "drop")
expect_equal(res$z, c(NA, 2))
})
test_that("summarise() silently skips when all results are NULL (#5708)", {
df <- data.frame(x = 1:2, g = 1:2) %>% group_by(g)
expect_equal(summarise(df, x = NULL), summarise(df))
expect_error(summarise(df, x = if(g == 1) 42))
})
test_that("summarise() propagates caller env", {
expect_caller_env(summarise(mtcars, sig_caller_env()))
expect_caller_env(summarise(group_by(mtcars, cyl), sig_caller_env()))
})
# errors -------------------------------------------------------------------
test_that("summarise() preserves the call stack on error (#5308)", {
foobar <- function() stop("foo")
stack <- NULL
expect_error(
withCallingHandlers(
error = function(...) stack <<- sys.calls(),
summarise(mtcars, foobar())
)
)
expect_true(some(stack, is_call, "foobar"))
})
test_that("summarise() gives meaningful errors", {
eval(envir = global_env(), expr({
expect_snapshot({
# Messages about .groups=
tibble(x = 1, y = 2) %>% group_by(x, y) %>% summarise()
tibble(x = 1, y = 2) %>% group_by(x, y) %>% summarise(z = c(2,2))
tibble(x = 1, y = 2) %>% rowwise(x, y) %>% summarise()
tibble(x = 1, y = 2) %>% rowwise() %>% summarise()
})
}))
eval(envir = global_env(), expr({
expect_snapshot({
# unsupported type
(expect_error(
tibble(x = 1, y = c(1, 2, 2), z = runif(3)) %>%
summarise(a = rlang::env(a = 1))
))
(expect_error(
tibble(x = 1, y = c(1, 2, 2), z = runif(3)) %>%
group_by(x, y) %>%
summarise(a = rlang::env(a = 1))
))
(expect_error(
tibble(x = 1, y = c(1, 2, 2), z = runif(3)) %>%
rowwise() %>%
summarise(a = lm(y ~ x))
))
# mixed types
(expect_error(
tibble(id = 1:2, a = list(1, "2")) %>%
group_by(id) %>%
summarise(a = a[[1]])
))
(expect_error(
tibble(id = 1:2, a = list(1, "2")) %>%
rowwise() %>%
summarise(a = a[[1]])
))
# incompatible size
(expect_error(
tibble(z = 1) %>%
summarise(x = 1:3, y = 1:2)
))
(expect_error(
tibble(z = 1:2) %>%
group_by(z) %>%
summarise(x = 1:3, y = 1:2)
))
(expect_error(
tibble(z = c(1, 3)) %>%
group_by(z) %>%
summarise(x = seq_len(z), y = 1:2)
))
# NULL and no NULL
(expect_error(
data.frame(x = 1:2, g = 1:2) %>% group_by(g) %>% summarise(x = if(g == 1) 42)
))
# Missing variable
(expect_error(summarise(mtcars, a = mean(not_there))))
(expect_error(summarise(group_by(mtcars, cyl), a = mean(not_there))))
# .data pronoun
(expect_error(summarise(tibble(a = 1), c = .data$b)))
(expect_error(summarise(group_by(tibble(a = 1:3), a), c = .data$b)))
# Duplicate column names
(expect_error(
tibble(x = 1, x = 1, .name_repair = "minimal") %>% summarise(x)
))
# Not glue()ing
(expect_error(tibble() %>% summarise(stop("{"))))
(expect_error(
tibble(a = 1, b="{value:1, unit:a}") %>% group_by(b) %>% summarise(a = stop("!"))
))
})
}))
})
Generated by dwww version 1.15 on Tue Jun 25 07:31:31 CEST 2024.