Fix table widths for latex tables and add unit testing

NEWS.md

@@ -23,6 +23,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)

R/utils_render_latex.R

@@ -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,
@@ -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}",
@@ -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]),
             "}"
           )
 
@@ -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
@@ -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]

tests/testthat/test-l_cols_width.R

@@ -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\\}\\}")
+})