tests/testthat/test-table_default.R

In tabstats: A Lightweight Toolkit for Displaying Customizable Tables

small = head(mtcars, 5)

# ---- Input validation --------------------------------------------------------

test_that("errors when x cannot be coerced to data frame", {
    expect_error(table_default(function() NULL), "data frame")
})

test_that("coerces a matrix to data frame silently", {
    m = matrix(1:9, 3, 3, dimnames = list(NULL, c("a", "b", "c")))
    expect_no_error(table_default(m))
})

test_that("errors on invalid style_columns type", {
    expect_error(
        table_default(small, style_columns = list(mpg = "cyan")),
        "td_style"
    )
})

test_that("errors on invalid style_colnames type", {
    expect_error(
        table_default(small, style_colnames = list(mpg = "cyan")),
        "td_style"
    )
})

test_that("warns when n_space is negative and resets to 2", {
    expect_warning(table_default(small, n_space = -1), "n_space")
})

test_that("warns when nrows is negative and resets to 10", {
    expect_warning(table_default(small, nrows = -1), "nrows")
})

# ---- Basic output ------------------------------------------------------------

test_that("returns a data frame invisibly", {
    result = expect_invisible(table_default(small))
    expect_s3_class(result, "data.frame")
})

test_that("output contains column names", {
    out = capture.output(table_default(small))
    expect_true(any(grepl("mpg", out)))
    expect_true(any(grepl("cyl", out)))
})

test_that("prints title when supplied", {
    out = capture.output(table_default(small, title = "My Table"))
    expect_true(any(grepl("My Table", out)))
})

test_that("empty data frame with 0 cols prints message and returns NULL", {
    df = data.frame()
    result = expect_invisible(table_default(df))
    expect_null(result)
})

# ---- Truncation ----

test_that("truncates to nrows rows", {
    result = table_default(mtcars, nrows = 3)
    expect_equal(nrow(result), 3L)
})

test_that("truncation alert is shown when rows are truncated", {
    expect_message(
        table_default(mtcars, nrows = 3),
        regexp = "Showing 3 of 32 rows"
    )
})

# ---- Row names -----

test_that("show_row_names = TRUE adds row_names column", {
    result = table_default(small, show_row_names = TRUE)
    expect_true("row_names" %in% names(result))
})

test_that("show_row_names = FALSE does not add row_names column", {
    result = table_default(small, show_row_names = FALSE)
    expect_false("row_names" %in% names(result))
})

# ---- td_style() ----

test_that("td_style() with named string runs without error", {
    expect_no_error(
        table_default(small, style_columns = td_style(mpg = "cyan", cyl = "magenta"))
    )
})

test_that("td_style() with lambda runs without error", {
    expect_no_error(
        table_default(
            small,
            style_columns = td_style(mpg = \(ctx) cli::col_red(ctx$value))
        )
    )
})

test_that("td_style() rejects non-string, non-function values", {
    expect_error(td_style(mpg = 123), "must be a string or a function")
})

test_that("td_style() returns correct class", {
    s = td_style(mpg = "cyan")
    expect_s3_class(s, "td_style")
    expect_s3_class(s, "tabstats_style")
})

test_that("td_style() stores entries correctly", {
    fn = \(ctx) ctx$value
    s = td_style(mpg = fn)
    expect_identical(s$mpg, fn)
})

# ---- data_formatter() --------------------------------------------------------

test_that("rounds numeric columns to given digits", {
    df = data.frame(x = c(1.23456, 2.34567))
    fmt = data_formatter(df, digits = 2, digits_by_col = NULL,
                         scientific = FALSE, na_print = "")
    expect_equal(fmt$x, c("1.23", "2.35"))
})

test_that("formats integer-like numerics without decimals", {
    df = data.frame(x = c(1.0, 2.0, 3.0))
    fmt = data_formatter(df, digits = 3, digits_by_col = NULL,
                         scientific = FALSE, na_print = "")
    expect_equal(fmt$x, c("1", "2", "3"))
})

test_that("replaces NA with na_print string", {
    df = data.frame(x = c(1.0, NA))
    fmt = data_formatter(df, digits = 1, digits_by_col = NULL,
                         scientific = FALSE, na_print = "-")
    expect_equal(fmt$x[2], "-")
})

test_that("converts factors to character", {
    df = data.frame(f = factor(c("a", "b")))
    fmt = data_formatter(df, digits = 1, digits_by_col = NULL,
                         scientific = FALSE, na_print = "")
    expect_type(fmt$f, "character")
})

test_that("digits_by_col overrides global digits for named column", {
    df = data.frame(x = c(1.23456), y = c(1.23456))
    fmt = data_formatter(df, digits = 3, digits_by_col = list(x = 1),
                         scientific = FALSE, na_print = "")
    expect_equal(fmt$x, "1.2")
    expect_equal(fmt$y, "1.235")
})

test_that("scientific = TRUE formats in scientific notation", {
    df = data.frame(x = c(12345.678))
    fmt = data_formatter(df, digits = 2, digits_by_col = NULL,
                         scientific = TRUE, na_print = "")
    expect_true(grepl("e", fmt$x, ignore.case = TRUE))
})

# ---- col_widths_total() ------------------------------------------------------

test_that("returns widths >= column name lengths", {
    df = data.frame(a = "x", longcolname = "y")
    x_chars = as.matrix(df)
    widths = col_widths_total(df, x_chars, colnames(df), NULL, df, NULL)
    expect_gte(widths[2], nchar("longcolname"))
})

test_that("respects min_width", {
    df = data.frame(a = "x", b = "y")
    x_chars = as.matrix(df)
    widths = col_widths_total(df, x_chars, colnames(df), NULL, df, 20)
    expect_true(all(widths >= 20))
})

# ---- vb_resolve() ------------------------------------------------------------

test_that("returns empty idx when vb has no after spec", {
    setup = vb_resolve(list(), c("a", "b", "c"), c(4L, 4L, 4L))
    expect_length(setup$idx, 0)
})

test_that("maps character column names to indices", {
    setup = vb_resolve(list(after = "b"), c("a", "b", "c"), c(4L, 4L, 4L))
    expect_equal(setup$idx, 2L)
})

test_that("maps numeric indices directly", {
    setup = vb_resolve(list(after = 2L), c("a", "b", "c"), c(4L, 4L, 4L))
    expect_equal(setup$idx, 2L)
})

test_that("excludes out-of-range border indices", {
    setup = vb_resolve(list(after = 10L), c("a", "b", "c"), c(4L, 4L, 4L))
    expect_length(setup$idx, 0)
})

# ---- width_total() -----------------------------------------------------------

test_that("computes correct total width", {
    expect_equal(width_total(c(5L, 5L, 5L), 2L, 0L, 1L), 23L)
})

test_that("accounts for vertical borders in total width", {
    without = width_total(c(5L, 5L), 2L, 0L, 1L)
    with_vb = width_total(c(5L, 5L), 2L, 1L, 1L)
    expect_gt(with_vb, without)
})

# ---- left_padding() ----------------------------------------------------------

test_that("returns empty string when center_table = FALSE", {
    expect_equal(left_padding(FALSE, 120, 80), "")
})

test_that("returns non-empty string when table is narrower than terminal", {
    pad = left_padding(TRUE, 200, 80)
    expect_gt(nchar(pad), 0)
})

test_that("returns empty string when table is wider than terminal", {
    expect_equal(left_padding(TRUE, 80, 200), "")
})

# ---- style_mapper() ----------------------------------------------------------

test_that("returns function from named list by column name", {
    fn = function(ctx) ctx$value
    result = style_mapper(list(mpg = fn), "mpg", 1)
    expect_identical(result, fn)
})

test_that("returns function by column index string", {
    fn = function(ctx) ctx$value
    result = style_mapper(list("1" = fn), "mpg", 1)
    expect_identical(result, fn)
})

test_that("returns NULL for unknown column", {
    expect_null(style_mapper(list(mpg = function(ctx) ctx$value), "cyl", 2))
})

test_that("returns NULL when styles is NULL", {
    expect_null(style_mapper(NULL, "mpg", 1))
})

test_that("returns entry by position for unnamed list", {
    fn = function(ctx) ctx$value
    result = style_mapper(list(fn), "anything", 1)
    expect_identical(result, fn)
})

# ---- ctx_maker() -------------------------------------------------------------

test_that("returns list with all required keys", {
    ctx = ctx_maker("val", "col1", 1L, FALSE, mtcars, 10L)
    expect_named(
        ctx,
        c("value", "formatted_value", "col_name", "col_index",
          "is_header", "data", "justify", "width"),
        ignore.order = TRUE
    )
})

test_that("value and formatted_value are equal on construction", {
    ctx = ctx_maker("val", "col1", 1L, FALSE, mtcars, 10L)
    expect_equal(ctx$value, ctx$formatted_value)
})

# ---- group_cols() ------------------------------------------------------------

test_that("puts all columns in one group when they fit", {
    groups = group_cols(2:5, c(5L, 5L, 5L, 5L, 5L), avail_w = 100, n_space = 2)
    expect_length(groups, 1)
    expect_equal(groups[[1]], 2:5)
})

test_that("splits into multiple groups when columns overflow", {
    groups = group_cols(2:5, rep(10L, 5), avail_w = 14, n_space = 2)
    expect_gt(length(groups), 1)
})

test_that("each group always starts a new column when avail_w is tiny", {
    groups = group_cols(2:4, rep(10L, 4), avail_w = 1, n_space = 2)
    expect_length(groups, 3)
})

# ---- vb_remap() ----

test_that("returns empty when vb_idx is empty", {
    expect_equal(vb_remap(integer(0), 1:4), integer(0))
})

test_that("remaps border index to position within cur_cols", {
    expect_equal(vb_remap(3L, c(1L, 3L, 5L)), 2L)
})

test_that("excludes last column position", {
    expect_length(vb_remap(5L, c(1L, 3L, 5L)), 0)
})

test_that("handles multiple remapped indices", {
    result = vb_remap(c(2L, 4L), c(1L, 2L, 4L, 6L))
    expect_equal(result, c(2L, 3L))
})

# ---- Justify Columns ----
test_that("Justify columns", {
    # Bare column
    expect_no_error({
        table_default(
            head(iris, 5),
            justify_cols = list(Sepal.Length = "left")
        )
    })
    # Indexed column
    expect_no_error({
        table_default(
            head(iris, 5),
            justify_cols = list("1" = "left")
        )
    })
    # Right Alignment
    expect_no_error({
        table_default(
            head(iris, 5),
            justify_cols = list(Sepal.Length = "right")
        )
    })
    # Center Alignment
    expect_no_error({
        table_default(
            head(iris, 5),
            justify_cols = list(Sepal.Length = "center")
        )
    })
})