tests/testthat/test-top_perc.R

In mintyr: Grouped and Nested Data Pipelines Built on 'data.table'

# WARNING - Generated by {fusen} from dev/flat_summary.Rmd: do not edit by hand # nolint: line_length_linter.

test_that("top_perc selects the requested share per group", {
  d <- data.frame(g = rep(c("a", "b"), each = 50), v = c(1:50, 101:150))
  res <- top_perc(d, perc = 0.2, cols = "v", by = "g")
  expect_identical(res$n, c(10L, 10L))
  expect_equal(res$min, c(41, 141))
  low <- top_perc(d, perc = -0.2, cols = 2, by = 1)
  expect_equal(low$max, c(10, 110))
})

test_that("top_perc keeps all ties at the cut-off", {
  d <- data.frame(v = c(10, 9, 9, 9, 1:6))
  expect_identical(top_perc(d, perc = 0.2, cols = "v")$n, 4L)
})

test_that("top_perc keeps groups that are too small, with a warning", {
  d <- data.frame(g = rep(1:2, c(3, 10)), v = 1:13)
  expect_warning(res <- top_perc(d, perc = 0.1, cols = "v", by = "g"), "n = 0")
  expect_identical(res$n, c(0L, 1L))
})

test_that("top_perc statistics match desc_stats on the selected records", {
  res <- top_perc(mtcars, perc = 0.25, cols = c("mpg", "hp"), by = "am", keep_data = TRUE,
                  stats = c("n", "mean", "sd", "cv", "skew"))[[1]]
  sel <- data.table::as.data.table(res$data)
  sel[, trait := variable]                 # `variable` is reserved in desc_stats()
  ref <- desc_stats(sel, cols = "value", by = c("am", "trait"),
                    stats = c("n", "mean", "sd", "cv", "skew"))
  expect_identical(names(res$stat), c("am", "variable", "n", "mean", "sd", "cv", "skew",
                                      "selection"))
  expect_equal(res$stat$mean, ref$mean[match(paste(res$stat$am, res$stat$variable),
                                             paste(ref$am, ref$trait))])
  expect_error(top_perc(iris, 0.1, "Sepal.Length", stats = "sum"), "Unknown statistic")
})

test_that("top_perc validates its arguments", {
  expect_error(top_perc(iris, 1.5, "Sepal.Length"), "strictly between")
  expect_error(top_perc(iris, 0.1, "Species"), "numeric")
  expect_error(top_perc(iris, 0.1), "Missing required")
})