stRoke/tests/testthat/test-quantile_cut.R

test_that("quatile_cut() works for detail.list==FALSE", {
  result <- quantile_cut(iris$Sepal.Length,3,detail.list=FALSE)
  expect_equal(length(levels(result)), 3)
  expect_s3_class(result, "factor")
})

################################################################################

test_that("quatile_cut() works for inc.outs==TRUE", {
  result <- quantile_cut(iris$Sepal.Length,3,y=iris$Sepal.Length+3,inc.outs=FALSE)
  expect_true(any(is.na(result)))
  
  result <- quantile_cut(iris$Sepal.Length,3,y=iris$Sepal.Length+3,inc.outs=TRUE)
  expect_false(any(is.na(result)))
  expect_equal(length(levels(result)), 3)
  expect_s3_class(result, "factor")
})

################################################################################

test_that("quatile_cut() works for detail.list==TRUE", {
  result <- quantile_cut(iris$Sepal.Length,3,detail.list=TRUE)
  expect_length(result, 2)
  expect_type(result, "list")
})

################################################################################

# Test created using remotes::install_github("JamesHWade/gpttools") unit test addin.
test_that("quantile_cut works correctly", {
  x <- runif(100)
  groups <- 5
  y <- runif(100)
  expect_equal(quantile_cut(x, groups, y, na.rm = TRUE),
               cut(x, quantile(y, probs = seq(0, 1, 1/groups), na.rm = TRUE, names = TRUE, type = 7),
                   include.lowest = TRUE, labels = NULL, ordered_result = FALSE))
})

################################################################################

range(iris$Sepal.Length)