tests/testthat/test-rows.R

In purrrlyr: Tools at the Intersection of 'purrr' and 'dplyr'

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)
})