test_that("output column is named according to .to", { output1 <- mtcars %>% slice_rows("cyl") %>% by_slice(~ list(NULL), .to = "my_col", .labels = FALSE) output2 <- mtcars %>% by_row(~ list(NULL), .to = "my_col", .labels = FALSE) output3 <- mtcars %>% invoke_rows(.f = function(...) list(NULL), .collate = "list", .to = "my_col", .labels = FALSE) expect_equal(names(output1), "my_col") expect_equal(names(output2), "my_col") expect_equal(names(output3), "my_col") }) test_that("empty", { rows_collation <- invoke_rows(empty, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(empty, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(empty, mtcars[1:2], .collate = "list") expect_equal(rows_collation$.out, numeric(0)) expect_equal(cols_collation$.out, numeric(0)) expect_equal(list_collation$.out, purrr::rerun(32, numeric(0))) expect_equal(dim(rows_collation), c(0, 3)) expect_equal(dim(cols_collation), c(0, 3)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("all nulls fail, except with list-collation", { expect_error(invoke_rows(all_nulls, mtcars[1:2], .collate = "rows")) expect_error(invoke_rows(all_nulls, mtcars[1:2], .collate = "cols")) list_collation <- invoke_rows(all_nulls, mtcars[1:2], .collate = "list") expect_equal(list_collation$.out, vector("list", 32)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("scalars", { rows_collation <- invoke_rows(scalars, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(scalars, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(scalars, mtcars[1:2], .collate = "list") out <- paste("a", mtcars$mpg) expect_equal(rows_collation$.out, out) expect_equal(cols_collation$.out, out) expect_equal(list_collation$.out, as.list(out)) expect_equal(dim(rows_collation), c(32, 3)) expect_equal(dim(cols_collation), c(32, 3)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("scalars with some nulls", { rows_collation <- invoke_rows(scalar_nulls, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(scalar_nulls, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(scalar_nulls, mtcars[1:2], .collate = "list") expect_equal(rows_collation$.out, rep(1, 16)) expect_equal(cols_collation$.out, rep(1, 16)) expect_equal(list_collation$.out, rep(list(1L, NULL), 16)) expect_equal(dim(rows_collation), c(16, 3)) expect_equal(dim(cols_collation), c(16, 3)) expect_equal(dim(list_collation), c(32, 3)) # Make sure properties are well inferred when first result is NULL rows_collation <- invoke_rows(scalar_first_nulls, mtcars[1:2], .collate = "rows") expect_equal(rows_collation$.out, rep(1, 16)) }) test_that("labels are correctly subsetted", { rows_collation <- invoke_rows(scalar_first_nulls, mtcars[1:2], .collate = "rows") expect_equal(rows_collation[1:2], dplyr::as_tibble(mtcars[seq(2, 32, 2), 1:2])) }) test_that("vectors", { rows_collation <- invoke_rows(vectors, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(vectors, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(vectors, mtcars[1:2], .collate = "list") data <- dplyr::rowwise(mtcars[1:2]) out <- dplyr::do(data, .out = paste(c("a", "b"), c(.$mpg, .$cyl)))[[1]] expect_equal(rows_collation$.row, rep(1:32, each = 2)) expect_equal(rows_collation$.out, unlist(out)) expect_equal(cols_collation$.out1, paste("a", mtcars$mpg)) expect_equal(cols_collation$.out2, paste("b", mtcars$cyl)) expect_equal(list_collation$.out, out) expect_equal(dim(rows_collation), c(64, 4)) expect_equal(dim(cols_collation), c(32, 4)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("data frames", { rows_collation <- invoke_rows(dataframes, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(dataframes, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(dataframes, mtcars[1:2], .collate = "list") expect_equal(rows_collation$.row, rep(1:32, each = 3)) expect_equal(rows_collation[4:5], dplyr::as_tibble(dplyr::bind_rows(purrr::rerun(32, df)))) expect_equal(cols_collation[[3]], rep(df[[1]][1], 32)) expect_equal(cols_collation[[8]], rep(df[[2]][3], 32)) expect_equal(list_collation$.out, purrr::rerun(32, df)) expect_equal(dim(rows_collation), c(96, 5)) expect_equal(dim(cols_collation), c(32, 8)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("data frames with some nulls/empty", { rows_collation <- invoke_rows(dataframes_nulls, mtcars[1:2], .collate = "rows") cols_collation <- invoke_rows(dataframes_nulls, mtcars[1:2], .collate = "cols") list_collation <- invoke_rows(dataframes_nulls, mtcars[1:2], .collate = "list") expect_equal(rows_collation[4:5], dplyr::as_tibble(dplyr::bind_rows(purrr::rerun(16, df)))) expect_equal(list_collation$.out, rep(list(df, NULL), 16)) expect_equal(dim(rows_collation), c(48, 5)) expect_equal(dim(cols_collation), c(16, 8)) expect_equal(dim(list_collation), c(32, 3)) }) test_that("empty data frames", { rows_collation_by_row <- invoke_rows(empty_dataframes, mtcars[1:2], .collate = "rows") rows_collation_by_slice <- by_slice(grouped, empty_dataframes, .collate = "rows") expect_equal(rows_collation_by_row[4:5], dplyr::as_tibble(df[0, ])) expect_equal(rows_collation_by_slice[2:3], dplyr::as_tibble(df[0, ])) expect_equal(dim(rows_collation_by_row), c(0, 5)) expect_equal(dim(rows_collation_by_slice), c(0, 3)) }) test_that("some empty data frames", { rows_collation_by_row <- invoke_rows(some_empty_dataframes, mtcars[1:2], .collate = "rows") rows_collation_by_slice <- by_slice(grouped, some_empty_dataframes, .collate = "rows") expect_equal(rows_collation_by_row[4:5], dplyr::as_tibble(dplyr::bind_rows(purrr::rerun(16, df)))) expect_equal(rows_collation_by_slice[2:3], dplyr::as_tibble(dplyr::bind_rows(purrr::rerun(2, df)))) expect_equal(dim(rows_collation_by_row), c(48, 5)) expect_equal(dim(rows_collation_by_slice), c(6, 3)) }) test_that("unconsistent data frames fail", { expect_error(invoke_rows(unconsistent_names, mtcars[1:2], .collate = "rows"), "consistent names") expect_error(invoke_rows(unconsistent_types, mtcars[1:2], .collate = "rows"), "must return either data frames or vectors") }) test_that("objects", { list_collation <- invoke_rows(test_objects, mtcars[1:2], .collate = "list") expect_equal( list_collation$.out, rep(list(function() {}), 32), ignore_function_env = TRUE ) expect_equal(dim(list_collation), c(32, 3)) expect_error(invoke_rows(test_objects, mtcars[1:2], .collate = "rows")) expect_error(invoke_rows(test_objects, mtcars[1:2], .collate = "cols")) }) test_that("collation of ragged objects on cols fails", { expect_error(invoke_rows(ragged_dataframes, mtcars[1:2], .collate = "cols")) expect_error(invoke_rows(ragged_vectors, mtcars[1:2], .collate = "cols")) }) test_that("by_slice() works with slicers of different types", { df1 <- slice_rows(mtcars, "cyl") df2 <- dmap_at(mtcars, "cyl", as.character) %>% slice_rows("cyl") out1 <- by_slice(df1, purrr::map, mean) out2 <- by_slice(df2, purrr::map, mean) expect_identical(out1[-1], out2[-1]) expect_equal(typeof(out1$cyl), "double") expect_equal(typeof(out2$cyl), "character") }) test_that("by_slice() does not create .row column", { data <- slice_rows(mtcars[1:2], "cyl") rows_vectors <- by_slice(data, function(x) 1:3, .collate = "rows") expect_equal(dim(rows_vectors), c(9, 2)) expect_equal(names(rows_vectors), c("cyl", ".out")) rows_dfs <- by_slice(data, function(x) df, .collate = "rows") expect_equal(dim(rows_dfs), c(9, 3)) expect_equal(names(rows_dfs), c("cyl", "wt", "qsec")) }) test_that("by_slice() fails with ungrouped data frames", { expect_error(by_slice(mtcars, list)) }) test_that("by_row() creates indices with c++ style indexing", { out <- mtcars[1:5, 1:2] %>% by_row(~ .$cyl[1]) expect_equal(out$.out[[5]], 8) }) test_that("error is thrown when no columns to map", { expect_error(mtcars["cyl"] %>% slice_rows("cyl") %>% by_slice(list), "empty") expect_error(dplyr::tibble() %>% invoke_rows(.f = c), "empty") expect_error(dplyr::tibble() %>% by_row(c), "empty") }) test_that("grouping list-columns are copied (#9)", { df <- dplyr::tibble(x = as.list(1:2)) exp <- dplyr::tibble(x = list(1L, 2L), .out = list(NA, NA)) expect_identical(by_row(df, ~NA), exp) })