inst/tinytest/test-escape.R

In modelsummary: Summary Tables and Plots for Statistical Models and Data: Beautiful, Customizable, and Publication-Ready

source("helpers.R")
requiet("tinysnapshot")
using("tinysnapshot")
# exit_file("many tinytable problems")

dat <- mtcars
colnames(dat)[1] <- "under_score"
colnames(dat)[2] <- "oh&yeah<sup>2</sup>"

# escaped tables
# unicode minus signs break on windows
mod <- list(
  "First&Second" = lm(hp ~ under_score + `oh&yeah<sup>2</sup>` + drat, dat),
  "Third_Fourth" = lm(hp ~ under_score + `oh&yeah<sup>2</sup>` + drat, dat)
)
expect_snapshot_print(
  modelsummary(mod, output = "latex"),
  "escape-latex"
)
## <td style="text-align:left;"> `oh&amp;yeah&lt;sup&gt;2&lt;/sup&gt;` </td>
tab <- modelsummary(mod)
expect_snapshot_print(print_html(tab), "escape-escape.html")
## <td style="text-align:left;"> `oh&amp;yeah<sup>2</sup>` </td>
tab <- modelsummary(mod, escape = FALSE)
expect_snapshot_print(print_html(tab), "escape-escape_html_false.html")

# manual escape
expect_equivalent(modelsummary:::escape_latex("$&_"), "\\$\\&\\_")
expect_equivalent(modelsummary:::escape_html("<&"), "&lt;&amp;")

# datasummary escape colnames and stub
# TRUE
expect_snapshot_print(
  datasummary(
    under_score + hp ~ Heading("%") * mean + Heading("Money $$") * sd,
    data = dat,
    output = "latex"
  ),
  "escape-datasummary_escape_colnames"
)

# FALSE
expect_snapshot_print(
  datasummary(
    under_score + hp ~ Heading("%") * mean + Heading("Money $$") * sd,
    data = dat,
    output = "latex",
    escape = FALSE
  ),
  "escape-datasummary_escape_colnames_FALSE"
)

# datasummary_crosstab escape colnames and stub
tmp <- mtcars
tmp$under_score1 <- tmp$vs
tmp$under_score2 <- tmp$gear
tmp$under_score3 <- tmp$am
## TRUE
expect_snapshot_print(
  datasummary_crosstab(
    under_score1 * under_score2 ~ under_score3,
    data = tmp,
    output = "latex"
  ),
  "escape-crosstab_latex"
)
## FALSE
expect_snapshot_print(
  datasummary_crosstab(
    under_score1 * under_score2 ~ under_score3,
    data = tmp,
    output = "latex",
    escape = FALSE
  ),
  "escape-crosstab_latex_FALSE"
)

# datasummary_correlation escape rownames and colnames
# unicode minus signs break on windows
## TRUE
expect_snapshot_print(
  datasummary_correlation(dat, output = "latex"),
  "escape-correlation_latex"
)
## FALSE
expect_snapshot_print(
  datasummary_correlation(dat, output = "latex", escape = FALSE),
  "escape-correlation_latex_FALSE"
)

# TODO: Why does this print to console?
## TRUE
# expect_snapshot_print(datasummary_correlation(dat, output = "html"),
#     "escape-correlation_html")
# ## FALSE
# expect_snapshot_print(print(datasummary_correlation(dat, output = "html", escape = FALSE)),
#     "escape-correlation_html_FALSE")

# Bugfix: escape & latex & coef_map
# Bug reported here:
# https://github.com/vincentarelbundock/modelsummary/issues/378
mtcars2 <- mtcars
mtcars2$disp_x <- mtcars2$disp
mtcars2$wt_x <- mtcars2$wt

# Problem 1:  When there is a variable with underscore raw name not
# displayed in output; not in expected order
reg_prob1 <- list()
reg_prob1[[1]] <- lm(data = mtcars2, mpg ~ disp_x)
reg_prob1[[2]] <- lm(data = mtcars2, mpg ~ disp_x + wt)
reg_prob1[[3]] <- lm(data = mtcars2, mpg ~ disp_x + wt + am)
expect_snapshot_print(
  msummary(reg_prob1, coef_map = c("disp_x", "wt"), output = "latex"),
  "escape-modelsummary_latex"
)

# Problem 2: When there are two or more variables with underscores rows for
# coefficients and std errors are not in the right place and names are not
# displayed
reg_prob2 <- list()
reg_prob2[[1]] <- lm(data = mtcars2, mpg ~ disp_x)
reg_prob2[[2]] <- lm(data = mtcars2, mpg ~ disp_x + wt_x)
reg_prob2[[3]] <- lm(data = mtcars2, mpg ~ disp_x + wt_x + am)
expect_snapshot_print(
  msummary(reg_prob2, coef_map = c("disp_x", "wt_x"), output = "latex"),
  "escape-modelsummary_latex2"
)

# bugs stay dead: escape=FALSE w/ coef_map
url <- "https://vincentarelbundock.github.io/Rdatasets/csv/HistData/Guerry.csv"
dat <- read.csv(url)
cm <- c(
  "Literacy" = "Literacy (\\%)",
  "Commerce" = "Patents per capita",
  "(Intercept)" = "Constant"
)
dat <- read.csv(url)
models <- list("OLS 1" = lm(Donations ~ Literacy + Commerce, data = dat))
expect_snapshot_print(
  modelsummary(models, coef_map = cm, output = "latex_tabular", escape = FALSE),
  "escape-modelsummary_latex_tabular_FALSE"
)

# column headers are not escaped with `escape=FALSE`
# unicode minus signs break on windows
mod <- list(
  "<code>lm()</code>" = lm(mpg ~ hp + drat, mtcars),
  "<code>lm_robust()</code>" = lm(mpg ~ hp + drat, mtcars)
)
tab <- modelsummary(mod, vcov = c("classical", "HC1"), escape = FALSE)
expect_snapshot_print(print_html(tab), "escape-modelsummary.html")

# Issue 546: escape gof names
requiet("fixest")
dat <- mtcars
dat$cyl_new <- dat$cyl
mod <- feols(mpg ~ hp | cyl_new, data = dat)
tab <- modelsummary(mod, "latex")
expect_true(grepl("cyl\\_new", tab, fixed = TRUE))


# Issue #622: shape = 'rbind' with escape TRUE/FALSE
tmp <- transform(mtcars, a_b = qsec, b_c = hp)
panels <- list(
  "Panel B: $\\log(3)^2$" = list(
    "A_B" = lm(mpg ~ a_b, data = tmp),
    "B_C" = lm(mpg ~ a_b + b_c, data = tmp)
  ),
  "Panel B: $\\log(3)_2$" = list(
    "A_B" = lm(disp ~ a_b, data = tmp),
    "B_C" = lm(disp ~ a_b + b_c, data = tmp)
  )
)
expect_snapshot_print(
  modelsummary(
    panels,
    output = "latex_tabular",
    shape = "rbind",
    title = "$\\beta_1$",
    escape = FALSE
  ),
  "escape-panel_escape_FALSE"
)
expect_snapshot_print(
  modelsummary(
    panels,
    output = "latex_tabular",
    shape = "rbind",
    title = "$\\beta_1$",
    escape = TRUE
  ),
  "escape-panel_escape_TRUE"
)


# Escape caption and notes
tmp <- mtcars |>
  transform(x = ifelse(cyl == 4, "foo_bar", "hello_world")) |>
  transform(x = ifelse(cyl == 6, "banana_fish", x))
mod <- lm(mpg ~ x + drat, data = tmp)
tab <- modelsummary(
  mod,
  output = "latex",
  title = "banana_fish",
  notes = c("foo_bar", "hello_world")
)
expect_snapshot_print(tab, "escape-caption_notes")


# Issue #560 and #693
mod <- lm(mpg ~ I(wt^2) * disp, data = mtcars)
expect_snapshot_print(
  modelsummary(mod, output = "latex", escape = TRUE),
  "escape-hat_I_formula"
)


# Issue# #740: escape not respected in `datasummary_df()`
tbl <- data.frame(
  "a" = c(1, 2, 3),
  "{}" = c(4, "\\times 5", 6),
  check.names = FALSE
)
expect_snapshot_print(
  datasummary_df(tbl, output = "latex_tabular", escape = FALSE),
  "escape-latex_tabular_escape_false"
)
expect_snapshot_print(
  datasummary_df(tbl, output = "latex_tabular", escape = TRUE),
  "escape-latex_tabular_escape_true"
)


requiet("fixest")
base <- iris
names(base) <- c("y", paste0("x", 1:3), "fe1")
base$fe2 <- rep(letters[1:5], 30)
base$fe3 <- rep(letters[1:5], 30)
est_comb <- feols(y ~ x1 | fe1 + fe2 + fe3, data = base, cluster = "fe1^fe2")
expect_snapshot_print(
  modelsummary(est_comb, output = "latex", escape = TRUE),
  "escape-hat_fixest"
)


# Issue #707: inconsistent escape for captions in modelsummary and datasummary
mod <- lm(mpg ~ hp, mtcars)
tab <- modelsummary(mod, title = "blah_blah", gof_map = NA, output = "latex")
expect_snapshot_print(tab, "escape-issue707_01")
tab <- datasummary(
  mpg + hp ~ mean + sd,
  title = "blah_blah",
  data = mtcars,
  output = "latex"
)
expect_snapshot_print(tab, "escape-issue707_02")
tab <- modelsummary(
  mod,
  title = "blah_blah",
  gof_map = NA,
  output = "latex",
  escape = FALSE
)
expect_snapshot_print(tab, "escape-issue707_03")
tab <- datasummary(
  mpg + hp ~ mean + sd,
  title = "blah_blah",
  data = mtcars,
  output = "latex",
  escape = FALSE
)
expect_snapshot_print(tab, "escape-issue707_04")