inst/tinytest/test-format_tt.R

In tinytable: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats

source("helpers.R")
using("tinysnapshot")


# bug discovered in modelsummary
z <- factor(c("a", "b", NA))
a <- format_tt(z, replace = "-")
b <- c("a", "b", "-")
expect_equivalent(a, b)


# numeric vector input
a <- c(98938272783457, 7288839482, 29111727, 93945)
b <- format_tt(a, num_suffix = TRUE, digits = 2)
expect_equivalent(b, c("99T", "7.3B", "29M", "94K"))


# num_suffix (vignette)
options(tinytable_print_output = "markdown")

dat <- data.frame(
  a = c("Burger", "Halloumi", "Tofu", "Beans"),
  b = c(1.43202, 201.399, 0.146188, 0.0031),
  c = c(98938272783457, 7288839482, 29111727, 93945))
tab <- tt(dat) |>
  format_tt(j = "a", sprintf = "Food: %s") |>
  format_tt(j = 2, digits = 1) |>
  format_tt(j = "c", digits = 2, num_suffix = TRUE)
expect_snapshot_print(tab, label = "format_tt-num_suffix_vignette")

set.seed(1024)
dat <- data.frame(
  w = c(143002.2092, 201399.181, 100188.3883),
  x = c(1.43402, 201.399, 0.134588),
  y = as.Date(sample(1:1000, 3), origin = "1970-01-01"),
  z = c(TRUE, TRUE, FALSE))
tab <- tt(dat, digits = 2)
expect_snapshot_print(tab, label = "format_tt-vignette_digits")

tab <- tt(dat) |>
  format_tt(
    j = 2:4,
    digits = 1,
    date = "%B %d %Y") |>
  format_tt(
    j = 1,
    digits = 2,
    num_mark_big = " ",
    num_mark_dec = ",",
    num_fmt = "decimal")
expect_snapshot_print(tab, label = "format_tt-vignette_misc")

expect_snapshot_print(
  format_tt(dat, digits = 1, num_suffix = TRUE),
  label = "format_tt-dataframe")



# bug: duplicated columns with markdown html
dat <- data.frame(
  markdown = c(
    "This is _italic_ text.",
    "This sentence ends with a superscript.^2^")
)
tab <- tt(dat) |>
  format_tt(j = 1, markdown = TRUE) |>
  style_tt(j = 1, align = "c")
expect_snapshot_print(print_html(tab), "format_tt-vignette_html_markdown.html")


# custom formatting
x <- mtcars[1:3, 1:3]
tab <- tt(x) |> format_tt(fn = function(x) paste("Ya", x))
expect_snapshot_print(tab, "format_tt-fn")


# Issue #142
k <- data.frame(x = c(0.000123456789, 12.4356789))
tab <- tt(k, digits = 2)
expect_snapshot_print(tab, "format_tt-issue142_01")
tab <- tt(k) |> format_tt(digits = 2, num_fmt = "significant_cell")
expect_snapshot_print(tab, "format_tt-issue142_02")


# Issue #147: format_tt(escape = TRUE) zaps previous formattinglibrary(tinytable)
options(tinytable_print_output = "latex")
x <- data.frame(num = c(pi, pi), char = c("10$", "blah_blah"))
tab <- tt(x) |>
  format_tt(i = 1, j = 1, digits = 2) |>
  format_tt(i = 1, j = 1, digits = 3) # overwrite
expect_snapshot_print(tab, "format_tt-issue147_01")
tab <- tt(x) |>
  format_tt(i = 1, j = 1, digits = 2) |>
  format_tt(i = 2, j = 1, digits = 3) # different cell
expect_snapshot_print(tab, "format_tt-issue147_02")
tab <- tt(x) |>
  format_tt(i = 1, j = 1, digits = 2) |>
  format_tt(i = 2, j = 1, digits = 3) |>
  format_tt(escape = TRUE) # do not zap
expect_snapshot_print(tab, "format_tt-issue147_03")
options(tinytable_print_output = NULL)


# Issue #149: num_mark_big requires digits
x <- data.frame(x = c(pi * 1e6, pi * 1e9))
tab <- format_tt(tt(x), digits = 1, num_mark_big = " ")
expect_snapshot_print(tab, "format_tt-issue149")
# expect_error(format_tt(tt(x), num_mark_big = " "))


# Issue #218
options(tinytable_print_output = "dataframe")
tab <- data.frame(x = 1, y = Inf) |>
  tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = NaN) |>
  tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = NA) |>
  tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = Inf) |>
  tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = Inf) |>
  tt() |>
  format_tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = NaN) |>
  tt() |>
  format_tt() |>
  print()
expect_inherits(tab, "data.frame")
tab <- data.frame(x = 1, y = NA) |>
  tt() |>
  format_tt() |>
  print()
expect_inherits(tab, "data.frame")

x <- data.frame(x = 1:5, y = c(pi, NA, NaN, -Inf, Inf))
dict <- list("-" = c(NA, NaN), "Tiny" = -Inf, "Huge" = Inf)
tab <- tt(x) |>
  format_tt(replace = dict) |>
  print()
expect_equivalent(tab$y, c("3.141593", "-", "-", "Tiny", "Huge"))

# Issue #256: big mark for integers
tab <- data.frame(x = c(1332037, 1299128, 805058, 206840, 698511)) |>
  tt() |>
  format_tt(num_mark_big = " ", digits = 0, num_fmt = "decimal") |>
  print("dataframe")
expect_equivalent(tab$x, c("1 332 037", "1 299 128", "805 058", "206 840", "698 511"))


x <- data.frame(x = pi, y = NA)
options(tinytable_tt_digits = 2)
tab <- tt(x) |> print()
expect_equivalent(tab$y, "")

options(tinytable_format_replace = "zzz")
tab <- tt(x) |> print()
expect_equivalent(tab$y, "zzz")

options(tinytable_format_replace = FALSE)
tab <- tt(x) |> print()
expect_equivalent(tab$y, "NA")

options(tinytable_print_output = NULL)
options(tinytable_tt_digits = NULL)
options(tinytable_format_replace = NULL)



# Issue #263: NA processing with Quarto doesn't work
x <- data.frame(
  Points = c(40, 0, 10, 10, 10, 10, 10, 20, 110),
  Assignment = c(
    "Analytical Assignments", "Team Project Part 0 - County Selection",
    "Team Project Part 1 - Summary Background",
    "Team Project Part 2 - SWOT Analysis",
    "Team Project Part 3 - Strategic Direction/Action Plan",
    "Team Project Part 4 - Evaluation Framework",
    "Team Project Part 5 - Plan Presentation", "Class participation", "Total"
  ),
  Percent = c("36%", "0%", "9%", "9%", "9%", "9%", "9%", "18%", NA)
)
x <- tt(x) |>
  format_tt(replace = "!", quarto = TRUE) |>
  save_tt("latex")
expect_true(grepl("IQ==", x))