Nothing
test_that("slice, head and tail aren't available", {
lf <- lazy_frame(x = 1)
expect_snapshot(error = TRUE, lf %>% slice())
expect_snapshot(error = TRUE, lf %>% slice_head())
expect_snapshot(error = TRUE, lf %>% slice_tail())
})
test_that("slice_min handles arguments", {
db <- memdb_frame(x = c(1, 1, 2), id = c(1, 2, 3))
expect_equal(db %>% slice_min(id) %>% pull(), 1)
expect_equal(db %>% slice_min(x) %>% pull(), c(1, 2))
expect_equal(db %>% slice_min(x, with_ties = FALSE) %>% pull(), 1)
expect_equal(db %>% slice_min(id, n = 2) %>% pull(), c(1, 2))
expect_equal(db %>% slice_min(id, prop = 0.5) %>% pull(), 1)
expect_snapshot(error = TRUE, db %>% slice_min())
expect_snapshot(error = TRUE, db %>% slice_min(id, prop = 0.5, with_ties = FALSE))
expect_snapshot(error = TRUE, db %>% slice_min(id, n = 1, na_rm = FALSE))
})
test_that("slice_max orders in opposite order", {
db <- memdb_frame(x = c(1, 1, 2), id = c(1, 2, 3))
expect_equal(db %>% slice_max(id) %>% pull(), 3)
expect_equal(db %>% slice_max(x) %>% pull(), 3)
expect_snapshot(error = TRUE, db %>% slice_max())
expect_snapshot(error = TRUE, db %>% slice_max(id, n = 1, na_rm = FALSE))
})
test_that("slice_* can use data masking pronouns", {
lf <- lazy_frame(x = c(1, 1, 2), id = c(1, 2, 3))
x <- -1L
expect_snapshot({
lf %>% slice_max(x)
lf %>% slice_max(.data$x)
lf %>% slice_max(.data$x * .env$x)
})
})
test_that("slice_sample errors when expected", {
db <- memdb_frame(x = c(1, 1, 2), id = c(1, 2, 3))
# Can't see how to test this, but interactive experimentation
# shows that it doesn't always return the same result
expect_error(db %>% slice_sample() %>% pull(), NA)
expect_snapshot(error = TRUE, db %>% slice_sample(replace = TRUE))
expect_snapshot(error = TRUE, db %>% slice_sample(weight_by = x))
expect_snapshot(error = TRUE, db %>% slice_sample(prop = 0.5))
})
test_that("window_order is preserved", {
db <- memdb_frame(x = c(1, 1, 2), id = c(1, 2, 3))
sort <- db %>% window_order(x) %>% slice_min(id) %>% op_sort()
expect_equal(length(sort), 1)
expect_equal(get_expr(sort[[1]]), quote(x))
})
test_that("check_slice_size checks for common issues", {
lf <- lazy_frame(x = c(1, 1, 2), id = c(1, 2, 3))
expect_snapshot(error = TRUE, lf %>% slice_sample(n = 1, prop = 1))
expect_snapshot(error = TRUE, lf %>% slice_sample(n = "a"))
expect_snapshot(error = TRUE, lf %>% slice_sample(prop = "a"))
expect_snapshot(error = TRUE, lf %>% slice_sample(n = -1))
expect_snapshot(error = TRUE, lf %>% slice_sample(prop = -1))
})
test_that("slice_helper `by` errors use correct error context and correct `by_arg`", {
df <- lazy_frame(x = 1)
gdf <- group_by(df, x)
expect_snapshot(error = TRUE, {
slice_min(gdf, order_by = x, by = x)
slice_max(gdf, order_by = x, by = x)
slice_sample(gdf, n = 1, by = x)
})
})
test_that("slice_min/max() work with `by`", {
df <- memdb_frame(g = c(2, 2, 1, 1), x = c(1, 2, 3, 1))
out <- slice_min(df, x, by = g) %>% arrange(g) %>% collect()
expect_identical(out, tibble(g = c(1, 2), x = 1))
expect_equal(group_vars(out), character())
expect_identical(slice_max(df, x, by = g) %>% arrange(g) %>% collect(), tibble(g = c(1, 2), x = c(3, 2)))
})
test_that("slice_sample() works with `by`", {
df <- tibble(g = c(2, 2, 2, 1), x = c(1, 2, 3, 1))
df <- memdb_frame(g = c(2, 2, 2, 1), x = c(1, 2, 3, 1))
expect_identical(
slice_sample(df, n = 2, by = g) %>% pull(g) %>% sort(),
c(1, 2, 2)
)
})
test_that("slice_min/max can order by multiple columns", {
lf <- lazy_frame(x = 1, y = 1)
expect_snapshot({
lf %>% slice_min(tibble(x))
lf %>% slice_min(tibble::tibble(x, y))
lf %>% slice_min(data.frame(y, x))
})
expect_snapshot({
lf %>% slice_max(tibble(x))
lf %>% slice_max(tibble::tibble(x, y))
lf %>% slice_max(data.frame(y, x))
})
})
test_that("slice_min/max informs if order_by uses c()", {
lf <- lazy_frame(x = 1, y = 1)
expect_snapshot_error(
lf %>% slice_min(c(x, y))
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.