test_that("`reframe()` allows summaries", { df <- tibble(g = c(1, 1, 1, 2, 2), x = 1:5) expect_identical( reframe(df, x = mean(x)), tibble(x = 3) ) expect_identical( reframe(df, x = mean(x), .by = g), tibble(g = c(1, 2), x = c(2, 4.5)) ) }) test_that("`reframe()` allows size 0 results", { df <- tibble(g = c(1, 1, 1, 2, 2), x = 1:5) gdf <- group_by(df, g) expect_identical( reframe(df, x = which(x > 5)), tibble(x = integer()) ) expect_identical( reframe(df, x = which(x > 5), .by = g), tibble(g = double(), x = integer()) ) expect_identical( reframe(gdf, x = which(x > 5)), tibble(g = double(), x = integer()) ) }) test_that("`reframe()` allows size >1 results", { df <- tibble(g = c(1, 1, 1, 2, 2), x = 1:5) gdf <- group_by(df, g) expect_identical( reframe(df, x = which(x > 2)), tibble(x = 3:5) ) expect_identical( reframe(df, x = which(x > 2), .by = g), tibble(g = c(1, 2, 2), x = c(3L, 1L, 2L)) ) expect_identical( reframe(gdf, x = which(x > 2)), tibble(g = c(1, 2, 2), x = c(3L, 1L, 2L)) ) }) test_that("`reframe()` recycles across columns", { df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5) out <- reframe(df, a = 1:2, b = 1L, c = 2:3) expect_identical(out$a, 1:2) expect_identical(out$b, c(1L, 1L)) expect_identical(out$c, 2:3) out <- reframe(df, a = 1:2, b = 1L, c = 2:3, .by = g) expect_identical(out$g, c(1, 1, 2, 2)) expect_identical(out$a, c(1:2, 1:2)) expect_identical(out$b, c(1L, 1L, 1L, 1L)) expect_identical(out$c, c(2:3, 2:3)) }) test_that("`reframe()` can recycle across columns to size 0", { df <- tibble(g = 1:2, x = 1:2) gdf <- group_by(df, g) out <- reframe(df, y = mean(x), z = which(x > 3)) expect_identical(out$y, double()) expect_identical(out$z, integer()) out <- reframe(df, y = mean(x), z = which(x > 1), .by = g) expect_identical(out$g, 2L) expect_identical(out$y, 2) expect_identical(out$z, 1L) out <- reframe(gdf, y = mean(x), z = which(x > 1)) expect_identical(out$g, 2L) expect_identical(out$y, 2) expect_identical(out$z, 1L) }) test_that("`reframe()` throws intelligent recycling errors", { df <- tibble(g = 1:2, x = 1:2) gdf <- group_by(df, g) expect_snapshot(error = TRUE, { reframe(df, x = 1:2, y = 3:5) }) expect_snapshot(error = TRUE, { reframe(df, x = 1:2, y = 3:5, .by = g) }) expect_snapshot(error = TRUE, { reframe(gdf, x = 1:2, y = 3:5) }) }) test_that("`reframe()` can return more rows than the original data frame", { df <- tibble(x = 1:2) expect_identical( reframe(df, x = vec_rep_each(x, x)), tibble(x = c(1L, 2L, 2L)) ) }) test_that("`reframe()` doesn't message about regrouping when multiple group columns are supplied", { df <- tibble(a = c(1, 1, 2, 2, 2), b = c(1, 2, 1, 1, 2), x = 1:5) gdf <- group_by(df, a, b) # Silence expect_snapshot({ out <- reframe(df, x = mean(x), .by = c(a, b)) }) expect_snapshot({ out <- reframe(gdf, x = mean(x)) }) }) test_that("`reframe()` doesn't message about regrouping when >1 rows are returned per group", { df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5) gdf <- group_by(df, g) # Silence expect_snapshot({ out <- reframe(df, x = vec_rep_each(x, x), .by = g) }) expect_snapshot({ out <- reframe(gdf, x = vec_rep_each(x, x)) }) }) test_that("`reframe()` allows sequential assignments", { df <- tibble(g = 1:2, x = 1:2) expect_identical( reframe(df, y = 3, z = mean(x) + y), tibble(y = 3, z = 4.5) ) expect_identical( reframe(df, y = 3, z = mean(x) + y, .by = g), tibble(g = 1:2, y = c(3, 3), z = c(4, 5)) ) }) test_that("`reframe()` allows for overwriting existing columns", { df <- tibble(g = c("a", "b"), x = 1:2) expect_identical( reframe(df, x = 3, z = x), tibble(x = 3, z = 3) ) expect_identical( reframe(df, x = cur_group_id(), z = x, .by = g), tibble(g = c("a", "b"), x = 1:2, z = 1:2) ) }) test_that("`reframe()` works with unquoted values", { df <- tibble(x = 1:5) expect_equal(reframe(df, out = !!1), tibble(out = 1)) expect_equal(reframe(df, out = !!quo(1)), tibble(out = 1)) expect_equal(reframe(df, out = !!(1:2)), tibble(out = 1:2)) }) test_that("`reframe()` with bare data frames always returns a bare data frame", { df <- data.frame(g = c(1, 1, 2, 1, 2), x = c(5, 2, 1, 2, 3)) out <- reframe(df, x = mean(x)) expect_s3_class(out, class(df), exact = TRUE) out <- reframe(df, x = mean(x), .by = g) expect_s3_class(out, class(df), exact = TRUE) }) test_that("`reframe()` drops data frame attributes", { # Because `reframe()` theoretically creates a "new" data frame # With data.frames df <- data.frame(g = c(1, 1, 2), x = c(1, 2, 1)) attr(df, "foo") <- "bar" out <- reframe(df, x = mean(x)) expect_null(attr(out, "foo")) out <- reframe(df, x = mean(x), .by = g) expect_null(attr(out, "foo")) # With tibbles tbl <- as_tibble(df) attr(tbl, "foo") <- "bar" out <- reframe(tbl, x = mean(x)) expect_null(attr(out, "foo")) out <- reframe(tbl, x = mean(x), .by = g) expect_null(attr(out, "foo")) # With grouped_df gdf <- group_by(df, g) attr(gdf, "foo") <- "bar" out <- reframe(gdf, x = mean(x)) expect_null(attr(out, "foo")) }) test_that("`reframe()` with `group_by()` sorts keys", { df <- tibble(g = c(2, 1, 2, 0), x = c(4, 2, 8, 5)) df <- group_by(df, g) out <- reframe(df, x = mean(x)) expect_identical(out$g, c(0, 1, 2)) expect_identical(out$x, c(5, 2, 6)) }) test_that("`reframe()` with `group_by()` respects `.drop = FALSE`", { g <- factor(c("c", "a", "c"), levels = c("a", "b", "c")) df <- tibble(g = g, x = c(1, 4, 2)) gdf <- group_by(df, g, .drop = FALSE) out <- reframe(gdf, x = mean(x)) expect_identical(out$g, factor(c("a", "b", "c"))) expect_identical(out$x, c(4, NaN, 1.5)) }) test_that("`reframe()` with `group_by()` always returns an ungrouped tibble", { df <- tibble(a = c(1, 1, 2, 2, 2), b = c(1, 2, 1, 1, 2), x = 1:5) gdf <- group_by(df, a, b) out <- reframe(gdf, x = mean(x)) expect_identical(class(out), class(df)) }) test_that("`reframe()` with `rowwise()` respects list-col element access", { df <- tibble(x = list(1:2, 3:5, 6L)) rdf <- rowwise(df) expect_identical( reframe(rdf, x), tibble(x = 1:6) ) }) test_that("`reframe()` with `rowwise()` respects rowwise group columns", { df <- tibble(g = c(1, 1, 2), x = list(1:2, 3:5, 6L)) rdf <- rowwise(df, g) out <- reframe(rdf, x) expect_identical(out$g, c(rep(1, 5), 2)) expect_identical(out$x, 1:6) }) test_that("`reframe()` with `rowwise()` always returns an ungrouped tibble", { df <- tibble(g = c(1, 1, 2), x = list(1:2, 3:5, 6L)) rdf <- rowwise(df, g) expect_s3_class(reframe(rdf, x), class(df), exact = TRUE) }) # .by ---------------------------------------------------------------------- test_that("can group transiently using `.by`", { df <- tibble(g = c(1, 1, 2, 1, 2), x = c(5, 2, 1, 2, 3)) out <- reframe(df, x = mean(x), .by = g) expect_identical(out$g, c(1, 2)) expect_identical(out$x, c(3, 2)) expect_s3_class(out, class(df), exact = TRUE) }) test_that("transient grouping orders by first appearance", { df <- tibble(g = c(2, 1, 2, 0), x = c(4, 2, 8, 5)) out <- reframe(df, x = mean(x), .by = g) expect_identical(out$g, c(2, 1, 0)) expect_identical(out$x, c(6, 2, 5)) }) test_that("catches `.by` with grouped-df", { df <- tibble(x = 1) gdf <- group_by(df, x) expect_snapshot(error = TRUE, { reframe(gdf, .by = x) }) }) test_that("catches `.by` with rowwise-df", { df <- tibble(x = 1) rdf <- rowwise(df) expect_snapshot(error = TRUE, { reframe(rdf, .by = x) }) })