tests/testthat/test-desc_stats.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("desc_stats matches base R statistics", {
  x <- iris$Sepal.Length
  r <- desc_stats(iris, cols = "Sepal.Length", type = "full")
  expect_identical(r$variable, "Sepal.Length")
  expect_identical(r$n, 150L)
  expect_equal(c(r$min, r$max, r$median, r$mean, r$sd, r$mad),
               c(min(x), max(x), median(x), mean(x), sd(x), mad(x)))
  expect_equal(r$iqr, IQR(x))
  expect_equal(r$se, sd(x) / sqrt(150))
  expect_equal(r$ci, qt(0.975, 149) * sd(x) / sqrt(150))
  expect_equal(r$cv, sd(x) / mean(x))
})

test_that("desc_stats presets and custom stats select the right columns", {
  expect_identical(names(desc_stats(iris, cols = 1)),
                   c("variable", "n", "min", "max", "median", "iqr", "mean", "sd", "se", "ci"))
  expect_identical(names(desc_stats(iris, cols = 1, type = "five_number")),
                   c("variable", "n", "min", "q1", "median", "q3", "max"))
  expect_identical(names(desc_stats(iris, cols = 1, stats = c("mean", "n_miss"))),
                   c("variable", "mean", "n_miss"))
  q <- desc_stats(iris, cols = 1, type = "quantile", probs = c(0.025, 0.5))
  expect_identical(names(q), c("variable", "n", "q2.5", "q50"))
  expect_equal(q$q2.5, unname(quantile(iris$Sepal.Length, 0.025)))
  expect_identical(desc_stats(iris)$variable, names(iris)[1:4])   # default cols
  expect_silent(desc_stats(mtcars, cols = c("cyl", "mpg"), type = "mean"))  # int + double
})

test_that("desc_stats total row: counts add up, statistics use all records", {
  r <- desc_stats(iris, cols = 1, by = "Species", type = "mean_sd", total = TRUE)
  expect_identical(as.character(r$Species), c("setosa", "versicolor", "virginica", "Total"))
  expect_equal(r$mean[4], mean(iris$Sepal.Length))
  expect_equal(r$sd[4], sd(iris$Sepal.Length))          # not a mean of group SDs
  expect_identical(levels(r$Species), c(levels(iris$Species), "Total"))
  expect_identical(r$n[4], sum(r$n[1:3]))               # only counts add up
  d <- data.frame(farm = c(rep("A", 4), "B"), w = c(10, 12, 14, 16, NA))
  t2 <- desc_stats(d, by = "farm", stats = c("n", "n_miss", "mean"), total = TRUE,
                   total_label = "All farms")
  expect_identical(t2$farm, c("A", "B", "All farms"))
  expect_identical(t2$n, c(4L, 0L, 4L))
  expect_identical(t2$n_miss, c(0L, 1L, 1L))
  expect_equal(t2$mean[3], 13)                          # not the mean of 13 and NA
})

test_that("desc_stats CV is NA unless all values are positive", {
  d <- data.frame(x = c(-1, 1, -2, 2.01), y = c(1, 2, 3, 4))
  r <- desc_stats(d, stats = c("mean", "cv"))
  expect_true(is.na(r$cv[1]))
  expect_equal(r$cv[2], sd(d$y) / mean(d$y))
})

test_that("desc_stats keeps group order and handles NA / tiny groups", {
  d <- data.frame(p = c(9, 10, 2, 10), v = c(1, 2, 3, NA))
  r <- desc_stats(d, by = "p", stats = c("n", "mean", "sd"), total = TRUE)
  expect_identical(r$p, c("2", "9", "10", "Total"))
  expect_true(is.na(r$sd[1]))                            # one value: sd undefined
  expect_identical(r$n[r$p == "10"], 1L)
  r0 <- desc_stats(d, by = "p", stats = c("n", "mean"), na_rm = FALSE)
  expect_true(is.na(r0$mean[r0$p == 10]))
  expect_identical(r0$n[r0$p == 10], 2L)
})

test_that("desc_stats shape = 'wide' puts groups in rows and variables in columns", {
  long <- desc_stats(mtcars, cols = c("mpg", "hp"), by = "cyl", type = "mean_sd",
                     total = TRUE)
  wide <- desc_stats(mtcars, cols = c("mpg", "hp"), by = "cyl", type = "mean_sd",
                     total = TRUE, shape = "wide")
  expect_identical(names(wide),
                   c("cyl", "mpg_n", "mpg_mean", "mpg_sd", "hp_n", "hp_mean", "hp_sd",
                     "Total_n"))                                 # counts add up
  expect_identical(wide$cyl, c("4", "6", "8", "Total"))          # total row last
  expect_equal(wide$hp_sd, long[variable == "hp"]$sd)            # same numbers
  one <- desc_stats(iris, by = "Species", stats = "mean", total = TRUE,
                    shape = "wide")
  expect_identical(names(one), c("Species", names(iris)[1:4]))
  flat <- desc_stats(iris, cols = 1:2, stats = c("mean", "sd"), shape = "wide", sep = ".")
  expect_identical(names(flat), c("Sepal.Length.mean", "Sepal.Length.sd",
                                  "Sepal.Width.mean", "Sepal.Width.sd"))
  d <- data.frame(g = c("a", NA, "a", "b"), x = c(1, 2, 3, 4))
  w <- desc_stats(d, by = "g", stats = c("n", "mean"), total = TRUE, shape = "wide")
  expect_identical(w$g, c("a", "b", NA, "Total"))
  two <- desc_stats(mtcars, cols = "mpg", by = c("am", "vs"), stats = "mean",
                    total = TRUE, shape = "wide", out_type = "df")
  expect_s3_class(two, "data.frame", exact = TRUE)
  expect_identical(unlist(two[5, c("am", "vs")], use.names = FALSE), c("Total", "Total"))
})

test_that("desc_stats fmt renders report-ready text", {
  r <- desc_stats(mtcars, cols = "mpg", by = "am", fmt = "{mean} ± {sd}",
                  total = TRUE)
  expect_identical(names(r), c("am", "variable", "mean ± sd"))
  m <- tapply(mtcars$mpg, mtcars$am, mean); s <- tapply(mtcars$mpg, mtcars$am, sd)
  expect_identical(r[["mean ± sd"]][1:2], sprintf("%.2f ± %.2f", m, s))
  expect_identical(r[["mean ± sd"]][3], sprintf("%.2f ± %.2f", mean(mtcars$mpg), sd(mtcars$mpg)))
  x <- mtcars$mpg
  q <- desc_stats(mtcars, cols = "mpg",
                  fmt = c(N = "{n}", CV = "{cv:1%}", P = "{q2.5:3}-{q97.5:3}", Q = "{q1:1}"))
  expect_identical(q$N, "32")
  expect_identical(q$CV, sprintf("%.1f%%", 100 * sd(x) / mean(x)))
  expect_identical(q$P, sprintf("%.3f-%.3f", quantile(x, 0.025), quantile(x, 0.975)))
  expect_identical(q$Q, sprintf("%.1f", quantile(x, 0.25)))
  w <- desc_stats(mtcars, cols = c("mpg", "hp"), by = "cyl", fmt = "{mean} ± {sd}",
                  total = TRUE, shape = "wide")
  expect_identical(names(w), c("cyl", "mpg", "hp"))
  d <- data.frame(farm = c(rep("A", 4), "B"), w = c(10, 12, 14, 16, 30))
  r <- desc_stats(d, by = "farm", fmt = "{mean:1} ± {sd:1} (n = {n})", total = TRUE)
  expect_identical(r[[3]], c("13.0 ± 2.6 (n = 4)", "30.0 ± NA (n = 1)",
                             sprintf("%.1f ± %.1f (n = 5)", mean(d$w), sd(d$w))))
})

test_that("desc_stats rounding, output type and input safety", {
  df <- data.frame(g = c("a", "b"), v = c(1.23456, 2.34567))
  r <- desc_stats(df, by = "g", type = "mean", digits = 1, out_type = "df")
  expect_s3_class(r, "data.frame", exact = TRUE)
  expect_equal(r$mean, c(1.2, 2.3))
  expect_identical(class(df), "data.frame")
  expect_identical(names(df), c("g", "v"))
})

test_that("desc_stats validates its arguments", {
  expect_error(desc_stats(iris, cols = "Species"), "numeric")
  expect_error(desc_stats(iris, cols = 1, by = 1), "both")
  expect_error(desc_stats(iris, type = "x"), "type")
  expect_error(desc_stats(iris, stats = "geomean"), "Unknown statistic")
  expect_error(desc_stats(iris, conf_level = 1), "conf_level")
  expect_error(desc_stats(data.frame(g = "Total", y = 2), by = "g", total = TRUE),
               "already occurs")
  expect_error(desc_stats(data.frame(variable = c("a", "b"), x = 1:2), by = "variable"),
               "must not be named")
  expect_error(desc_stats(iris, by = 5, total = "yes"), "`total`")
  expect_error(desc_stats(iris, stats = "sum"), "Unknown statistic")
  expect_warning(desc_stats(iris, stats = "mean", total = TRUE), "Nothing to total")
  expect_warning(desc_stats(iris, cols = 1, total = TRUE), "two or more variables")
  one <- desc_stats(iris, cols = 1, by = "Species", stats = "n", total = TRUE)
  expect_false("Total" %in% one$variable)                  # one variable: no total column
  expect_error(desc_stats(iris, fmt = "{mean} ± {geomean}"), "Unknown statistic")
  expect_error(desc_stats(iris, fmt = "no placeholder"), "no \\{statistic\\}")
  expect_error(desc_stats(iris, fmt = c(a = "{n}", a = "{mean}")), "duplicated")
  expect_error(desc_stats(iris, fmt = "{q150}"), "between q0 and q100")
  expect_error(desc_stats(iris, fmt = c(variable = "{n}")), "clash")
  expect_warning(desc_stats(iris, fmt = "{mean}", type = "full"), "ignored")
})

test_that("desc_stats engine matches base R for many random groups", {
  set.seed(42)
  d <- data.frame(g = sample(letters[1:15], 600, TRUE), x = rgamma(600, 3), y = rnorm(600))
  d$x[sample(600, 50)] <- NA
  r <- desc_stats(d, by = "g", stats = c("n", "median", "q1", "q3", "mad", "quantile",
                                          "skew", "kurt"), probs = c(0.1, 0.9))
  for (gg in c("a", "h", "o")) {
    x <- d$x[d$g == gg & !is.na(d$x)]
    n <- length(x); m <- mean(x); s <- sd(x)
    row <- r[g == gg & variable == "x"]
    expect_equal(row$n, length(x))
    expect_equal(c(row$median, row$q1, row$q3, row$q10, row$q90),
                 unname(quantile(x, c(0.5, 0.25, 0.75, 0.1, 0.9))))
    expect_equal(row$mad, mad(x))
    expect_equal(row$skew, n / ((n - 1) * (n - 2)) * sum(((x - m) / s)^3))
    expect_equal(row$kurt, n * (n + 1) / ((n - 1) * (n - 2) * (n - 3)) * sum(((x - m) / s)^4) -
                   3 * (n - 1)^2 / ((n - 2) * (n - 3)))
  }
})

test_that("desc_stats skew / kurt need 3 / 4 values and non-zero spread", {
  d <- data.frame(g = c("a", "a", "b", "b", "b", "c", "c", "c", "c"),
                  x = c(1, 2, 1, 2, 4, 5, 5, 5, 5))
  r <- desc_stats(d, by = "g", stats = c("n", "skew", "kurt"))
  expect_true(is.na(r$skew[1]))                          # n = 2
  expect_false(is.na(r$skew[2])); expect_true(is.na(r$kurt[2]))   # n = 3
  expect_true(is.na(r$skew[3]))                          # constant values
})

test_that("desc_stats ci_low / ci_high bound the mean", {
  x <- mtcars$mpg
  r <- desc_stats(mtcars, cols = "mpg", type = "mean_ci")
  expect_identical(names(r), c("variable", "n", "mean", "ci_low", "ci_high"))
  half <- qt(0.975, 31) * sd(x) / sqrt(32)
  expect_equal(c(r$ci_low, r$ci_high), mean(x) + c(-1, 1) * half)
  f <- desc_stats(mtcars, cols = "mpg", fmt = "{mean:1} ({ci_low:1}, {ci_high:1})")
  expect_identical(f[[2]], sprintf("%.1f (%.1f, %.1f)", mean(x), mean(x) - half, mean(x) + half))
})

test_that("desc_stats min_n hides statistics of small groups", {
  r <- desc_stats(mtcars, cols = "mpg", by = "carb", stats = c("n", "mean", "sd"), min_n = 3)
  small <- r$n < 3
  expect_true(any(small))
  expect_true(all(is.na(r$mean[small]) & is.na(r$sd[small])))
  expect_false(anyNA(r$mean[!small]))
  expect_identical(r$n, as.integer(table(mtcars$carb)))  # counts stay
  t <- desc_stats(mtcars, cols = "mpg", by = "carb", stats = "mean", min_n = 3, total = TRUE)
  expect_false(is.na(t$mean[nrow(t)]))                   # total row has 32 values
  expect_error(desc_stats(mtcars, min_n = 0), "min_n")
})

test_that("desc_stats digits per variable", {
  r <- desc_stats(mtcars, cols = c("mpg", "wt", "qsec"), type = "mean",
                  digits = c(1, wt = 3))
  expect_equal(r$mean, c(round(mean(mtcars$mpg), 1), round(mean(mtcars$wt), 3),
                         round(mean(mtcars$qsec), 1)))
  r2 <- desc_stats(mtcars, cols = c("mpg", "wt"), type = "mean", digits = c(wt = 1))
  expect_equal(r2$mean, c(mean(mtcars$mpg), round(mean(mtcars$wt), 1)))   # mpg unrounded
  f <- desc_stats(mtcars, cols = c("mpg", "wt"), fmt = "{mean}", digits = c(mpg = 0, wt = 3))
  expect_identical(f[[2]], c(sprintf("%.0f", mean(mtcars$mpg)), sprintf("%.3f", mean(mtcars$wt))))
  expect_error(desc_stats(mtcars, digits = c(zz = 1)), "not in `cols`")
  expect_error(desc_stats(mtcars, digits = c(1, 2)), "at most one unnamed")
  expect_error(desc_stats(mtcars, digits = -1), "non-negative")
})

test_that("desc_stats labels rename variables in both shapes", {
  lab <- c(mpg = "Miles/gallon", wt = "Weight (1000 lbs)")
  r <- desc_stats(mtcars, cols = c("mpg", "wt", "hp"), type = "mean", labels = lab)
  expect_identical(r$variable, c("Miles/gallon", "Weight (1000 lbs)", "hp"))
  w <- desc_stats(mtcars, cols = c("mpg", "wt"), by = "am", stats = "mean",
                  labels = lab, shape = "wide", digits = c(wt = 2))
  expect_identical(names(w), c("am", unname(lab)))
  expect_equal(w[[3]], as.vector(round(tapply(mtcars$wt, mtcars$am, mean), 2)))
  expect_error(desc_stats(mtcars, labels = c("x")), "named")
  expect_error(desc_stats(mtcars, labels = c(zz = "x")), "not in `cols`")
  expect_error(desc_stats(mtcars, cols = c("mpg", "wt"), labels = c(mpg = "wt")),
               "same name")
})


test_that("desc_stats total adds row and column totals to a count table", {
  ir <- iris
  ir$Sepal.Width[c(1, 60, 61)] <- NA
  w <- desc_stats(ir, by = "Species", stats = "n", total = TRUE, shape = "wide")
  expect_identical(names(w), c("Species", names(iris)[1:4], "Total"))
  expect_identical(as.character(w$Species), c(levels(iris$Species), "Total"))
  expect_identical(w$Sepal.Width, c(49L, 48L, 50L, 147L))
  expect_identical(w$Total, c(199L, 198L, 200L, 597L))
  expect_identical(w$Total[4], sum(w$Total[1:3]))       # grand total both ways
  w2 <- desc_stats(ir, by = "Species", stats = c("n", "n_miss"), total = TRUE, shape = "wide")
  expect_identical(w2$Total_n_miss, c(1L, 2L, 0L, 3L))
})

test_that("desc_stats total variable only holds counts", {
  r <- desc_stats(iris, type = "mean_sd", total = TRUE)
  expect_identical(r$variable, c(names(iris)[1:4], "Total"))
  expect_identical(r$n[5], 600L)
  expect_true(is.na(r$mean[5]) && is.na(r$sd[5]))
  w <- desc_stats(iris, cols = 1:2, by = "Species", type = "mean_sd", total = TRUE,
                  shape = "wide")
  expect_true("Total_n" %in% names(w))
  expect_false(any(c("Total_mean", "Total_sd") %in% names(w)))   # empty columns dropped
  expect_identical(w$Total_n, c(100L, 100L, 100L, 300L))
  expect_identical(w$Sepal.Width_mean[4], mean(iris$Sepal.Width))  # total row: all records
})

test_that("desc_stats total with fmt keeps count-only templates", {
  r <- desc_stats(mtcars, cols = c("mpg", "hp"), by = "am",
                  fmt = c(N = "{n}", MS = "{mean:1} ± {sd:1}"), total = TRUE)
  tv <- r[variable == "Total"]
  expect_identical(tv$N, c("38", "26", "64"))               # mpg n + hp n
  expect_true(all(is.na(tv$MS)))
  w <- desc_stats(mtcars, cols = c("mpg", "hp"), by = "am", fmt = "{mean} ± {sd}",
                  total = TRUE, shape = "wide")
  expect_identical(names(w), c("am", "mpg", "hp"))         # no total variable
  expect_error(desc_stats(data.frame(Total = 1:3, b = 2:4), stats = "n", total = TRUE),
               "variable name")
  expect_error(desc_stats(mtcars, cols = c("mpg", "wt"), stats = "n", total = TRUE,
                          labels = c(wt = "Total")), "variable name")
})