tests/testthat/test_bin.R

In cheapr: Simple Functions to Save Time and Memory

test_that("binning", {
  set.seed(42)
  x <- sample(-10:11, 100, TRUE)
  breaks <- seq(0L, 7L, by = 1L)

  .bin <- function(x, breaks, ...){
    breaks[.bincode(x, breaks, ...)]
  }

  expect_equal(
    .bincode(x, breaks),
    bin(x, breaks, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = FALSE),
    bin(x, breaks, left_closed = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, include.lowest = TRUE),
    bin(x, breaks, include_endpoint = TRUE, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = TRUE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = FALSE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = FALSE)
  )

  breaks <- seq(0, max(x), by = 0.5)

  expect_equal(
    .bincode(x, breaks),
    bin(x, breaks, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = FALSE),
    bin(x, breaks, left_closed = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, include.lowest = TRUE),
    bin(x, breaks, include_endpoint = TRUE, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = TRUE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = FALSE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = FALSE)
  )

  breaks <- seq(min(x), 5, by = 0.5)

  ### When x is integer here, this might be unexpected result :)

  expect_equal(
    as.integer(.bin(as.integer(x), breaks)),
    bin(as.integer(x), breaks, left_closed = FALSE, codes = FALSE)
  )

  x <- as.double(x)

  expect_equal(
    .bin(x, breaks),
    bin(x, breaks, left_closed = FALSE, codes = FALSE)
  )
  expect_equal(
    .bin(x, breaks, right = FALSE),
    bin(x, breaks, left_closed = TRUE, codes = FALSE)
  )
  expect_equal(
    .bin(x, breaks, include.lowest = TRUE),
    bin(x, breaks, include_endpoint = TRUE, codes = FALSE, left_closed = FALSE)
  )
  expect_equal(
    .bin(x, breaks, right = TRUE, include.lowest = TRUE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = TRUE, codes = FALSE)
  )
  expect_equal(
    .bin(x, breaks, right = TRUE, include.lowest = FALSE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = FALSE, codes = FALSE)
  )

  x <- as.double(-1:10)
  breaks <- 0:11

  expect_equal(
    .bincode(x, breaks, include.lowest = TRUE, right = TRUE),
    bin(x, breaks, include_endpoint = TRUE, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, include.lowest = TRUE, right = FALSE),
    bin(x, breaks, include_endpoint = TRUE, left_closed = TRUE)
  )

  expect_equal(
    .bincode(x, c(-Inf, breaks), right = TRUE),
    bin(x, breaks, left_closed = FALSE, include_oob = TRUE)
  )
  expect_equal(
    .bincode(x, c(breaks, Inf), right = FALSE),
    bin(x, breaks, left_closed = TRUE, include_oob = TRUE)
  )

  expect_equal(
    bin(x, breaks, include_oob = TRUE, left_closed = FALSE),
    c(1, 1:11)
  )
  expect_equal(
    bin(x, breaks, include_oob = TRUE, left_closed = TRUE),
    c(NA, 1:11)
  )

  x <- seq(0, 10, 0.5)
  breaks <- seq(1, 9, 0.25)

  expect_equal(
    .bincode(x, breaks),
    bin(x, breaks, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = FALSE),
    bin(x, breaks, left_closed = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, include.lowest = TRUE),
    bin(x, breaks, include_endpoint = TRUE, left_closed = FALSE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = TRUE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = TRUE)
  )
  expect_equal(
    .bincode(x, breaks, right = TRUE, include.lowest = FALSE),
    bin(x, breaks, left_closed = FALSE, include_endpoint = FALSE)
  )
})