Skip to content

Commit

Permalink
Merge pull request #1867 from snhansen/master
Browse files Browse the repository at this point in the history
Fix table widths for latex tables and add unit testing
  • Loading branch information
rich-iannone authored Oct 2, 2024
2 parents 10711c5 + 86b23b9 commit 72664c3
Show file tree
Hide file tree
Showing 3 changed files with 232 additions and 15 deletions.
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,8 @@

## Bug fixes

* Fixed an issue where column widths weren't set properly using `col_widths()` for LaTeX output. (#1837)

* Improved error messages for the `text_transform()` function if `locations` couldn't be resolved. (@olivroy, #1774)

* `tab_row_group()` gives a more precise error message when `rows` can't be resolved correctly (#1535). (@olivroy, #1770)
Expand Down
52 changes: 37 additions & 15 deletions R/utils_render_latex.R
Original file line number Diff line number Diff line change
Expand Up @@ -148,11 +148,30 @@ create_table_start_l <- function(data, colwidth_df) {
# Get vector representation of stub layout
stub_layout <- get_stub_layout(data = data)

# Get default alignments for body columns
col_alignment <- dt_boxhead_get_vars_align_default(data = data)

if (length(stub_layout) > 0) {
col_alignment <- c(rep("left", length(stub_layout)), col_alignment)
# Extract only visible columns of `colwidth_df` based on stub_layout.
types <- c("default")
if ("rowname" %in% stub_layout) {
types <- c(types, "stub")
}
if ("group_label" %in% stub_layout) {
types <- c(types, "row_group")
}

colwidth_df_visible <- colwidth_df[colwidth_df$type %in% types, ]

# Ensure that the `colwidth_df_visible` df rows are sorted such that the
# `"row_group"` row is first (only if it's located in the stub), then `"stub"`,
# and then everything else
if ("stub" %in% colwidth_df_visible[["type"]]) {
stub_idx <- which(colwidth_df_visible$type == "stub")
othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), stub_idx)
colwidth_df_visible <- dplyr::slice(colwidth_df_visible, stub_idx, othr_idx)
}

if ("row_group" %in% colwidth_df_visible[["type"]]) {
row_group_idx <- which(colwidth_df_visible$type == "row_group")
othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), row_group_idx)
colwidth_df_visible <- dplyr::slice(colwidth_df_visible, row_group_idx, othr_idx)
}

# Determine if there are any footnotes or source notes; if any,
Expand All @@ -176,19 +195,19 @@ create_table_start_l <- function(data, colwidth_df) {
# - `>{\centering\arraybackslash}` <- center alignment
# the `\arraybackslash` command is used to restore the behavior of the
# `\\` command in the table (all of this uses the CTAN `array` package)
if (any(colwidth_df$unspec < 1L)) {
if (any(colwidth_df_visible$unspec < 1L)) {

col_defs <- NULL

for (i in seq_along(col_alignment)) {

if (colwidth_df$unspec[i] == 1L) {
col_defs_i <- substr(col_alignment[i], 1, 1)
for (i in seq_len(nrow(colwidth_df_visible))) {
if (colwidth_df_visible$unspec[i] == 1L) {
col_defs_i <- substr(colwidth_df_visible$column_align[i], 1, 1)
} else {

align <-
switch(
col_alignment[i],
colwidth_df_visible$column_align[i],
left = ">{\\raggedright\\arraybackslash}",
right = ">{\\raggedleft\\arraybackslash}",
center = ">{\\centering\\arraybackslash}",
Expand All @@ -199,7 +218,7 @@ create_table_start_l <- function(data, colwidth_df) {
paste0(
align,
"p{",
create_singlecolumn_width_text_l(pt = colwidth_df$pt[i], lw = colwidth_df$lw[i]),
create_singlecolumn_width_text_l(pt = colwidth_df_visible$pt[i], lw = colwidth_df_visible$lw[i]),
"}"
)

Expand All @@ -209,8 +228,8 @@ create_table_start_l <- function(data, colwidth_df) {
}

} else {

col_defs <- substr(col_alignment, 1, 1)
col_defs <- substr(colwidth_df_visible$column_align, 1, 1)
}

# Add borders to the right of any columns in the stub
Expand Down Expand Up @@ -1685,8 +1704,11 @@ create_colwidth_df_l <- function(data) {
type = boxhead$type,
unspec = rep.int(0L, n),
lw = rep.int(0L, n),
pt = rep.int(0L, n)
pt = rep.int(0L, n),
column_align = boxhead$column_align
)

width_df$column_align[width_df$type %in% c("stub", "row_group")] <- "left"

for (i in 1:n) {
raw <- unlist(boxhead$column_width[i])[1L]
Expand Down
193 changes: 193 additions & 0 deletions tests/testthat/test-l_cols_width.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,193 @@
test_that("cols_width() works correctly", {

# Create a `tbl_latex` object with `gt()`:
# The `mpg` and `cyl` columns with one width, and the `cyl` and `hp`
# columns with another width.

tbl <- mtcars_short %>%
gt() %>%
cols_hide(c("drat", "wt", "qsec", "vs", "am", "gear", "carb")) %>%
cols_width(
c("mpg", "disp") ~ px(150),
c("cyl", "hp") ~ px(100)
)

tbl_latex_tabul <- tbl %>%
as_latex() %>%
as.character()

tbl_latex_lt <- tbl %>%
tab_options(latex.use_longtable = TRUE) %>%
as_latex() %>%
as.character()

# Expect a characteristic pattern depending whether longtable or tabular is used.
expect_length(tbl_latex_lt, 1)
expect_match(tbl_latex_lt, "\\\\begin\\{longtable\\}\\{>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 75.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 75.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

expect_length(tbl_latex_tabul, 1)
expect_match(tbl_latex_tabul, "\\\\begin\\{tabular\\*\\}\\{\\\\linewidth\\}\\{@\\{\\\\extracolsep\\{\\\\fill\\}\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 75.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 75.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

# Create a `tbl_latex` object with `gt()`:
# The `mpg` and `cyl` columns are merged having one width,
# and the `cyl` and `hp` columns are merged having another width.

tbl <- mtcars_short %>%
gt() %>%
cols_hide(c("drat", "wt", "qsec", "vs", "am", "gear", "carb")) %>%
cols_merge(
columns = c("mpg", "cyl"),
pattern = "{1}-{2}"
) %>%
cols_merge(
columns = c("disp", "hp"),
pattern = "{1}-{2}"
) %>%
cols_width(
"mpg" ~ px(150),
"disp" ~ px(200)
)

tbl_latex_tabul <- tbl %>%
as_latex() %>%
as.character()

tbl_latex_lt <- tbl %>%
tab_options(latex.use_longtable = TRUE) %>%
as_latex() %>%
as.character()

# Expect a characteristic pattern depending whether longtable or tabular is used.
expect_length(tbl_latex_lt, 1)
expect_match(tbl_latex_lt, "\\\\begin\\{longtable\\}\\{>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

expect_length(tbl_latex_tabul, 1)
expect_match(tbl_latex_tabul, "\\\\begin\\{tabular\\*\\}\\{\\\\linewidth\\}\\{@\\{\\\\extracolsep\\{\\\\fill\\}\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

# Create a `tbl_latex` object with `gt()`:
# `carb` is used a stub with a specific width.
# The `mpg` and `cyl` columns are merged having one width,
# and the `cyl` and `hp` columns are merged having another width.

tbl <- mtcars_short %>%
gt(rowname_col = "carb") %>%
cols_hide(c("drat", "wt", "qsec", "vs", "am", "gear")) %>%
tab_stubhead(label = "carb") %>%
cols_merge(
columns = c("mpg", "cyl"),
pattern = "{1}-{2}"
) %>%
cols_merge(
columns = c("disp", "hp"),
pattern = "{1}-{2}"
) %>%
cols_width(
"mpg" ~ px(150),
"disp" ~ px(200),
"carb" ~ px(75)
)

tbl_latex_tabul <- tbl %>%
as_latex() %>%
as.character()

tbl_latex_lt <- tbl %>%
tab_options(latex.use_longtable = TRUE) %>%
as_latex() %>%
as.character()

# Expect a characteristic pattern depending whether longtable or tabular is used.
expect_length(tbl_latex_lt, 1)
expect_match(tbl_latex_lt, "\\\\begin\\{longtable\\}\\{>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

expect_length(tbl_latex_tabul, 1)
expect_match(tbl_latex_tabul, "\\\\begin\\{tabular\\*\\}\\{\\\\linewidth\\}\\{@\\{\\\\extracolsep\\{\\\\fill\\}\\}>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

# Create a `tbl_latex` object with `gt()`:
# `carb` is used a stub with a specific width, and `carb_group` is used as row_groups.
# The `mpg` and `cyl` columns are merged having one width,
# and the `cyl` and `hp` columns are merged having another width.
# We set the width of the row_groups here to check that the table isn't
# affected since `row_group_as_column` is FALSE.

tbl <- mtcars_short %>%
dplyr::mutate(carb_grp = ifelse(carb <= 2, "<=2", ">2")) %>%
gt(rowname_col = "carb", groupname_col = "carb_grp") %>%
cols_hide(c("drat", "wt", "qsec", "vs", "am", "gear")) %>%
tab_stubhead(label = "carb") %>%
cols_merge(
columns = c("mpg", "cyl"),
pattern = "{1}-{2}"
) %>%
cols_merge(
columns = c("disp", "hp"),
pattern = "{1}-{2}"
) %>%
cols_width(
"mpg" ~ px(150),
"disp" ~ px(200),
"carb" ~ px(75),
"carb_grp"~ px(1000)
)

tbl_latex_tabul <- tbl %>%
as_latex() %>%
as.character()

tbl_latex_lt <- tbl %>%
tab_options(latex.use_longtable = TRUE) %>%
as_latex() %>%
as.character()

# Expect a characteristic pattern depending whether longtable or tabular is used.
expect_length(tbl_latex_lt, 1)
expect_match(tbl_latex_lt, "\\\\begin\\{longtable\\}\\{>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

expect_length(tbl_latex_tabul, 1)
expect_match(tbl_latex_tabul, "\\\\begin\\{tabular\\*\\}\\{\\\\linewidth\\}\\{@\\{\\\\extracolsep\\{\\\\fill\\}\\}>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

# Create a `tbl_latex` object with `gt()`:
# `carb` is used a stub with a specific width, and `carb_group` is used as row_groups
# getting its own column with its own width.
# The `mpg` and `cyl` columns are merged having one width,
# and the `cyl` and `hp` columns are merged having another width.

tbl <- mtcars_short %>%
dplyr::mutate(carb_grp = ifelse(carb <= 2, "<=2", ">2")) %>%
gt(rowname_col = "carb",
groupname_col = "carb_grp",
row_group_as_column = TRUE
) %>%
cols_hide(c("drat", "wt", "qsec", "vs", "am", "gear")) %>%
tab_stubhead(label = "carb") %>%
cols_merge(
columns = c("mpg", "cyl"),
pattern = "{1}-{2}"
) %>%
cols_merge(
columns = c("disp", "hp"),
pattern = "{1}-{2}"
) %>%
cols_width(
"mpg" ~ px(150),
"disp" ~ px(200),
"carb" ~ px(75),
"carb_grp"~ px(50)
)

tbl_latex_tabul <- tbl %>%
as_latex() %>%
as.character()

tbl_latex_lt <- tbl %>%
tab_options(latex.use_longtable = TRUE) %>%
as_latex() %>%
as.character()

# Expect a characteristic pattern depending whether longtable or tabular is used.
expect_length(tbl_latex_lt, 1)
expect_match(tbl_latex_lt, "\\\\begin\\{longtable\\}\\{>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 37.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")

expect_length(tbl_latex_tabul, 1)
expect_match(tbl_latex_tabul, "\\\\begin\\{tabular\\*\\}\\{\\\\linewidth\\}\\{@\\{\\\\extracolsep\\{\\\\fill\\}\\}>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 37.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedright\\\\arraybackslash\\}p\\{\\\\dimexpr 56.25pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}|>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 112.50pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}>\\{\\\\raggedleft\\\\arraybackslash\\}p\\{\\\\dimexpr 150.00pt -2\\\\tabcolsep-1.5\\\\arrayrulewidth\\}\\}")
})

0 comments on commit 72664c3

Please sign in to comment.