inst/tinytest/test-latex.R

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

source("helpers.R")
using("tinysnapshot")
options(tinytable_print_output = "latex")

x <- mtcars[1:4, 1:5]

expect_snapshot_print(
  tt(x),
  label = "latex-default"
)

k <- x
colnames(k) <- NULL
expect_snapshot_print(
  tt(k),
  label = "latex-nohead"
)

# Align
expect_snapshot_print(
  tt(x) |> style_tt(j = 1:5, align = "ccllr"),
  label = "latex-align"
)

# Themes
expect_snapshot_print(
  tt(x, theme = "striped"),
  label = "latex-theme_striped"
)

expect_snapshot_print(
  tt(x, theme = "grid"),
  label = "latex-theme_grid"
)

expect_snapshot_print(
  tt(x, theme = "void"),
  label = "latex-theme_void"
)

# Styles
expect_snapshot_print(
  tt(x) |> style_tt(i = 1:4, color = "orange"),
  label = "latex-row_color"
)

expect_snapshot_print(
  tt(x) |> style_tt(j = 1:4, color = "orange"),
  label = "latex-col_color"
)

expect_snapshot_print(
  tt(x) |> style_tt(i = 1:2, j = 1:4, color = "orange"),
  label = "latex-cell_color"
)

# Lazy style: group after style is respected
a <- tt(mtcars[1:4, 1:4]) |>
  style_tt(color = "orange", background = "black") |>
  group_tt(j = list("blah" = 1:2, "bar" = 3:4))
b <- tt(mtcars[1:4, 1:4]) |>
  group_tt(j = list("blah" = 1:2, "bar" = 3:4)) |>
  style_tt(color = "orange", background = "black")
expect_snapshot_print(a, label = "latex-group_style_order")
expect_equal(as.character(a@table_string), as.character(b@table_string))

# align d
x <- data.frame(pi = c(pi * 100, pi * 1000, pi * 10000, pi * 100000))
tab <- tt(x) |>
  format_tt(j = 1, digits = 8, num_fmt = "significant_cell") |>
  style_tt(j = 1, align = "d")
expect_snapshot_print(tab, label = "latex-align_d")

dat = data.frame(a = c("(03.1)", "(3.14)**", "(003.1416)+"))
tt(dat) |> style_tt(align = "d")
expect_snapshot_print(tab, label = "latex-align_d_02")

dat = data.frame(a = c("(03.1)", "(3.14)**", "(003.1416)+"))
tt(dat) |>
  group_tt(j = list("blah" = 1)) |>
  style_tt(align = "d")
expect_snapshot_print(tab, label = "latex-align_d_03")

# bug discovered with vignette
x <- tt(mtcars[1:9, 1:8]) |>
  group_tt(
    i = list(
      "I like (fake) hamburgers" = 3,
      "She prefers halloumi" = 4,
      "They love tofu" = 7
    )
  ) |>
  style_tt(
    i = c(3, 5, 9),
    align = "c",
    color = "white",
    background = "gray",
    bold = TRUE
  ) |>
  save_tt("latex")
expect_inherits(x, "character")

# Footnotes
expect_snapshot_print(
  (tt(mtcars[1:4, 1:5], notes = list(a = "Blah.", b = "Blah blah."))),
  label = "latex-footnotes"
)

# Maths
math <- tt(
  data.frame(
    Math = c(
      "$x^2 + y^2 = z^2$",
      "$\\frac{1}{2}$"
    )
  )
) |>
  style_tt(j = 1, align = "c")
expect_snapshot_print(
  math,
  label = "latex-maths"
)

# Line breaks
expect_snapshot_print(
  (
    tt(
      data.frame(
        "{Sed ut \\\\ perspiciatis unde}",
        "dicta sunt<br> explicabo. Nemo"
      ) |>
        setNames(c("LaTeX line break", "HTML line break")),
      width = 1
    )
  ),
  label = "latex-breaks"
)

# Formatting
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)
)
expect_snapshot_print(
  (
    tt(dat) |>
      format_tt(j = "a", sprintf = "Food: %s") |>
      format_tt(j = 2, digits = 1) |>
      format_tt(j = "c", digits = 2, num_suffix = TRUE)
  ),
  label = "latex-formatting"
)

# placement
tab <- mtcars[1:3, 1:3]
tab <- tt(tab) |> theme_tt("placement", latex_float = "H")
tab@output <- "latex"
expect_snapshot_print(tab, label = "latex-placement")

# Missing value replacement
tab <- data.frame(a = c(NA, 1, 2), b = c(3, NA, 5))
expect_snapshot_print(
  tt(tab) |> format_tt(replace = "-"),
  label = "latex-missing_value_replacement"
)

# Escape special characters
dat <- data.frame(
  "LaTeX" = c("Dollars $", "Percent %", "Underscore _"),
  "HTML" = c("<br>", "<sup>4</sup>", "<emph>blah</emph>")
)
expect_snapshot_print(
  tt(dat) |> format_tt(escape = TRUE),
  label = "latex-escape_special_caracters"
)

# Formatting URLs
dat <- data.frame(
  `Package (link)` = c(
    "[`marginaleffects`](https://www.marginaleffects.com/)",
    "[`modelsummary`](https://www.modelsummary.com/)"
  ),
  Purpose = c(
    "Interpreting statistical models",
    "Data and model summaries"
  ),
  check.names = FALSE
)
dat <- tt(dat) |> format_tt(j = 1, markdown = TRUE)
expect_snapshot_print(
  dat,
  label = "latex-formatting_url"
)

# Style
x <- mtcars[1:4, 1:5]
expect_snapshot_print(
  (
    tt(x) |>
      style_tt(
        i = 2:3,
        j = c(1, 3, 4),
        italic = TRUE,
        background = "green",
        color = "orange"
      )
  ),
  label = "latex-style"
)

# Font size
expect_snapshot_print(
  (tt(x) |> style_tt(j = "mpg|hp|qsec", fontsize = 1.5)),
  label = "latex-font_size"
)

# Merging cells
expect_snapshot_print(
  (
    tt(x) |>
      style_tt(
        i = 2,
        j = 2,
        colspan = 3,
        rowspan = 2,
        align = "c",
        alignv = "m",
        color = "white",
        background = "black",
        bold = TRUE
      )
  ),
  label = "latex-merging_cells"
)

# Spanning cells
tab <- aggregate(mpg ~ cyl + am, FUN = mean, data = mtcars)
tab <- tab[order(tab$cyl, tab$am), ]
expect_snapshot_print(
  (
    tt(tab, digits = 2) |>
      style_tt(i = c(1, 3, 5), j = 1, rowspan = 2, alignv = "t")
  ),
  label = "latex-spanning_cells"
)

# Conditional styling
k <- mtcars[1:10, c("mpg", "am", "vs")]
expect_snapshot_print(
  (
    tt(k) |>
      style_tt(
        i = which(k$am == k$vs),
        background = "teal",
        color = "white"
      )
  ),
  label = "latex-conditional_styling"
)

# Heatmaps
fs <- seq(.1, 2, length.out = 20)
k <- data.frame(matrix(fs, ncol = 5))
colnames(k) <- NULL
bg <- hcl.colors(20, "Inferno")
fg <- ifelse(as.matrix(k) < 1.7, tail(bg, 1), head(bg, 1))
expect_snapshot_print(
  (
    tt(k, width = .7, theme = "void") |>
      style_tt(j = 1:5, align = "ccccc") |>
      style_tt(
        i = 1:4,
        j = 1:5,
        color = fg,
        background = bg,
        fontsize = fs
      )
  ),
  label = "latex-heatmaps"
)

# Borders
expect_snapshot_print(
  tt(x, theme = "void") |>
    style_tt(
      i = 0:3,
      j = 1:3,
      line = "tblr",
      line_width = 0.4,
      line_color = "orange"
    ),
  label = "latex-borders"
)

# Issue #242: multiple notes in tabularray are fiddly
tab <- tt(
  mtcars[1:4, 1:4],
  notes = list(a = "blah", b = "hello world", "oh yeah", "works?")
)
tab@output <- "latex"
expect_snapshot_print(tab, label = "latex-issue242")

# Issue #306
x <- data.frame(x = 1:5)
x <- data.frame(x = 1:5)
colnames(x) <- NULL
tab <- tt(x) |>
  format_tt() |>
  save_tt("latex")
expect_inherits(tab, "character")

# Issue #307
tab <- tt(head(iris)) |>
  group_tt(j = list("blah" = 1:2)) |>
  theme_tt("tabular")
expect_snapshot_print(tab, label = "latex-issue307.tex")

# Issue #419
tab <- tt(head(iris)) |>
  style_tt(
    tabularray_outer = "label={tbl-species}",
    tabularray_inner = "rowsep=0pt"
  )
expect_snapshot_print(tab, label = "latex-issue419.tex")

# format_tt math
dat <- data.frame("y^2 = e^x" = c(-2, -pi), check.names = FALSE)
tab <- tt(dat, digits = 3) |> format_tt(math = TRUE)
expect_snapshot_print(tab, label = "latex-format_tt_math.tex")

options(tinytable_print_output = NULL)