File: test-verb-slice.R

package info (click to toggle)
r-cran-dbplyr 2.3.0%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 2,376 kB
  • sloc: sh: 13; makefile: 2
file content (85 lines) | stat: -rw-r--r-- 3,137 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
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))
})

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

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