tests/testthat/test-sieve.R

In gghighlight: Highlight Lines and Points in 'ggplot2'

grey07 <- "#BEBEBEB2"

d <- tibble::tribble(
  ~x, ~y, ~type, ~value,
  1,  2,   "a",      0,
  2,  3,   "a",      1,
  3,  4,   "a",      0,
  1,  3,   "b",      1,
  2,  2,   "b",      5,
  1,  4,   "c",     10,
  3,  3,   "c",     10
)

d_ <- setNames(d[1:3], c("x", "y", "colour"))
ids <- c(1, 1, 1, 2, 2, 3, 3)

# tests -------------------------------------------------------------------

expect_equal_sieved <- function(layer, params, ..., expect) {
  params <- purrr::list_modify(params, ...)
  params$layer <- layer
  expect_true(do.call(sieve_layer, params))
  expect_equal_layer(layer, expect)
}

test_that("sieve_layer() works with simple ungrouped cases", {
  params <- list(
    group_info = NULL,
    predicates = list(quo(value > 1))
  )

  # Basic usage
  expect_equal_sieved(
    geom_bar(aes(x = x), d),
    params = params,
    expect = geom_bar(aes(x = x), d[d$value > 1, ])
  )

  # Large number of max_highlights doesn't affect the result.
  expect_equal_sieved(
    geom_bar(aes(x = x), d),
    params = params, max_highlight = 100L,
    expect = geom_bar(aes(x = x), d[d$value > 1, ])
  )

  # Even when the max_highlight is smaller, if no numeric predicates are available,
  # the result is not sliced down to the number.
  expect_equal_sieved(
    geom_bar(aes(x = x), d),
    params = params, max_highlight = 2L,
    expect = geom_bar(aes(x = x), d[d$value > 1, ])
  )

  # When predicate is numerical, the result is sliced.
  expect_equal_sieved(
    geom_bar(aes(x = x), d),
    params = params,
    predicates = list(quo(value)),
    max_highlight = 2L,
    expect = geom_bar(aes(x = x), d[6:7, ])
  )
})

test_that("sieve_layer() works with simple grouped cases", {
  params <- list(
    group_info = list(data = d_, id = ids, key = aes(colour = type)),
    predicates = list(quo(mean(value) > 1))
  )

  # Basic usage.
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params,
    expect = geom_bar(aes(colour = type), d[d$type != "a", ])
  )

  # Large number of max_highlights doesn't affect the result.
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params, max_highlight = 100L,
    expect = geom_bar(aes(colour = type), d[d$type != "a", ])
  )

  # Even when the max_highlight is smaller, if no numeric predicates are available,
  # the result is not sliced down to the number.
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params, max_highlight = 1L,
    expect = geom_bar(aes(colour = type), d[d$type != "a", ])
  )

  # When predicate is numerical, the result is sliced.
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params,
    predicates = list(quo(mean(value))),
    max_highlight = 1L,
    expect = geom_bar(aes(colour = type), d[6:7, ])
  )
})

test_that("sieve_layer() works with intentionally ungrouped cases", {
  # cases where data can be grouped, but intentionally avoid group_by;
  params <- list(
    group_info = list(data = d_, id = ids, key = quo(type)),
    predicates = list(quo(value > 1)),
    use_group_by = FALSE
  )

  # the result is same no matter group_key is provided or not
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params,
    expect = geom_bar(aes(colour = type), d[d$value > 1, ])
  )
  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params,
    group_info = list(data = d_, id = ids),
    expect = geom_bar(aes(colour = type), d[d$value > 1, ])
  )

  # even if use_group_by = TRUE, this succeeds with a warning
  expect_warning(
    expect_equal_sieved(
      geom_bar(aes(colour = type), d),
      params = params,
      expect = geom_bar(aes(colour = type), d[d$value > 1, ]),
      use_group_by = TRUE
    )
  )

  # use_group_by=TRUE without group_key generates a warning, and do sieving in ungrouped-manner.
  expect_warning(
    expect_equal_sieved(
      geom_bar(aes(colour = type), d),
      params = params,
      group_info = list(data = d_, id = ids),
      expect = geom_bar(aes(colour = type), d[d$value > 1, ]),
      use_group_by = TRUE
    )
  )
})
test_that("sieve_layer() can handle predicates that contains the group key (c.f. #27)", {
  m <- c(a = 1, b = 100, c = 10)
  params <- list(
    group_info = list(data = d_, id = ids, key = aes(colour = type)),
    predicates = list(quo(max(value * m[type]) >= 100))
  )

  expect_equal_sieved(
    geom_bar(aes(colour = type), d),
    params = params,
    expect = geom_bar(aes(colour = type), d[d$type != "a", ])
  )
})

test_that("sieve_layer() returns false if all calculation is failed", {
  expect_false(sieve_layer(geom_bar(aes(x = x), d), NULL, list(quo(no_such_column > 1))))
})

test_that("sieve_layer() works with zero predicate", {
  params <- list(group_info = NULL, predicates = NULL)

  expect_equal_sieved(
    geom_bar(aes(x = x), d),
    params = params,
    expect = geom_bar(aes(x = x), d)
  )
})

test_that("sieve_layer() works with more than two predicates", {
  d2 <- tibble::tribble(
    ~type, ~val1, ~val2,
      "a",     1,     0,
      "a",     2,     2,
      "b",     4,     2,
      "b",     5,     2,
      "c",    10,     0,
      "c",    10,     2,
      "d",    10,     1,
      "d",    10,     3,
      "e",    11,    10,
      "e",    12,    30
  )
  pred_grouped <- quos(
    mean(val1) > 2,      # logical to filter out "a"
    any(val2 %% 2 == 0), # logical to filter out "d"
    sum(val2)            # numerical
  )

  d2_ <- setNames(d2[1], c("colour"))
  ids2 <- c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5)

  params <- list(
    group_info = list(data = d2_, id = ids2, key = aes(colour = type))
  )

  # logical predicates only; max_highlight is ignored.
  expect_equal_sieved(
    geom_line(aes(colour = type), d2),
    params = params,
    predicates = pred_grouped[1:2],
    max_highlight = 2L,
    expect = geom_line(aes(colour = type), d2[!d2$type %in% c("a", "d"), ])
  )

  # include numerical predicates; max_highlight is used
  expect_equal_sieved(
    geom_line(aes(colour = type), d2),
    params = params,
    predicates = pred_grouped,
    max_highlight = 2L,
    expect = geom_line(aes(colour = type), d2[c(3,4,9,10), ])
  )
})

test_that("sieve_layer() works with list columns", {
  d3 <- tibble::tibble(
    x = 1:4,
    v = 1:4,
    z = c("a", "a", "b", "b"),
    l = list(
      c(1, 2, 3),
      c(1, 4, 10),
      c(4, 6),
      c(1)
    )
  )

  # ungrouped
  sl <- geom_bar(aes(x), d3)
  expect_true(
    sieve_layer(
      sl,
      group_info = NULL,
      predicates = quos(p1 = l, p2 = v),
      max_highlight = 2L
    )
  )
  expect_identical(sl$mapping, aes(x))
  expect_identical(sl$data, d3[3:4, ])

  # grouped
  sl <- geom_line(aes(x, v, colour = z), d3)
  expect_true(
    sieve_layer(
      sl,
      group_info = list(data = setNames(d3[3], c("colour")),
                        id = c(1, 1, 2, 2),
                        key = aes(colour = z)),
      predicates = quos(p1 = list(l), p2 = sum(v)),
      max_highlight = 1L,
      use_group_by = TRUE
    )
  )
  expect_identical(sl$mapping, aes(x, v, colour = z))
  expect_identical(sl$data, d3[3:4, ])
})

test_that("sieve_layer() do not count NA for max_highlights", {
  d4 <- data.frame(x = c(1:3, NA))

  params <- list(
    group_info = NULL,
    predicates = list(quo(x))
  )

  expect_equal_sieved(
    geom_bar(aes(x = x), d4),
    params = params, max_highlight = 2L,
    expect = geom_bar(aes(x = x), d4[2:3, , drop = FALSE])
  )
})