Merge pull request #2101 from thebioengineer/latex_stub_separator

Add option latex.stub_separate

Author: rich-iannone

.Rbuildignore

@@ -164,6 +164,10 @@ tests/testthat/test-rtf_summary_rows.R
 tests/testthat/_snaps/rtf_summary_rows.md
 
 tests/testthat/test-stub.R
+
+tests/testthat/test-stub_separate.R
+tests/testthat/_snaps/stub_separate.md
+
 tests/testthat/test-substitution.R
 
 tests/testthat/test-summary_rows.R

NEWS.md

@@ -1,6 +1,8 @@
 # gt (development version)
 
-* Update how long text that has a line break or is horizontally aligned in a cell (stubs, labels, table body).
+* Update how long text that has a line break or is horizontally aligned in a cell (stubs, labels, table body). (@thebioengineer)
+
+* Added `stub.separate` option to control if vertical bars/borders are added for stubs (#2096). (@thebioengineer)
 
 # gt 1.2.0
 

R/compile_scss.R

@@ -31,6 +31,26 @@ compile_scss <- function(data, id = NULL) {
   gt_options_tbl <-
     gt_options_tbl[gt_options_tbl$scss & !is.na(gt_options_tbl$value), ]
 
+  # If stub.separate is FALSE, override stub border style to "none"
+  stub_separate <- dt_options_get_value(data = data, option = "stub_separate")
+
+  if (!is.na(stub_separate) && !stub_separate) {
+    
+    stub_border_idx <-
+      which(gt_options_tbl$parameter == "stub_border_style")
+    
+    if (length(stub_border_idx) > 0) {
+      gt_options_tbl$value[[stub_border_idx]] <- "none"
+    }
+    
+    stub_row_group_border_idx <-
+      which(gt_options_tbl$parameter == "stub_row_group_border_style")
+    
+    if (length(stub_row_group_border_idx) > 0) {
+      gt_options_tbl$value[[stub_row_group_border_idx]] <- "none"
+    }
+  }
+
   color_rows <- grepl("_color", gt_options_tbl$parameter, fixed = TRUE)
 
   gt_options_tbl <-

R/dt_options.R

@@ -274,6 +274,7 @@ dt_options_tbl <-
     "quarto_use_bootstrap",              FALSE,  "quarto",           "logical", FALSE,
     "latex_use_longtable",               FALSE,  "latex",            "logical", FALSE,
     "latex_header_repeat",               FALSE,  "latex",            "logical", FALSE,
+    "stub_separate",                     FALSE,  "stub",             "logical",  TRUE,
     "latex_toprule",                     FALSE,  "latex",            "logical",  TRUE,
     "latex_bottomrule",                  FALSE,  "latex",            "logical",  TRUE,
     "latex_tbl_pos",                     FALSE,  "latex",            "value",   "t",

R/tab_options.R

@@ -237,6 +237,14 @@
 #'
 #'   The style, width, and color properties for the vertical border of the table
 #'   stub.
+#' 
+#' @param stub.separate
+#'   *Specify whether the stub should have a separating vertical bar or not*
+#'
+#'   Vertical bars typically separate the stub from the rest of the table columns.
+#'   Setting this parameter to `FALSE` will remove that vertical separator line
+#'   from the stub/body interface. Currently supported for HTML and LaTeX output
+#'   formats. The default is `TRUE`.
 #'
 #' @param stub_row_group.font.size,stub_row_group.font.weight,stub_row_group.text_transform,stub_row_group.border.style,stub_row_group.border.width,stub_row_group.border.color
 #'   *Properties of the row group column in the table stub*
@@ -542,7 +550,6 @@
 #'   use the `longtable` environment which will not float and may span multiple
 #'   pages.
 #'
-#'
 #' @param latex.header_repeat
 #'
 #'   * Specify if the header should repeat or not across pages*
@@ -551,7 +558,7 @@
 #'   every page. Setting this parameter to `TRUE` will add a `\endhead` command
 #'   after the table headers so LaTeX knows where the headers end and will
 #'   repeat them on every page.
-#'
+#' 
 #' @param latex.toprule,latex.bottomrule
 #'
 #'   * Specify if an hrule should be put in the table at the top (latex.toprule) or bottom (latex.bottomrule)*
@@ -561,7 +568,6 @@
 #'   parameters to `FALSE` will instead not have these commands added, which
 #'   lets the tables be produced without the top and bottom lines.
 #'
-#'
 #' @param latex.tbl.pos
 #'
 #'   *Specify latex floating position*
@@ -812,6 +818,7 @@ tab_options <- function(
     stub.border.width = NULL,
     stub.border.color = NULL,
     stub.indent_length = NULL,
+    stub.separate = NULL,
     stub_row_group.font.size = NULL,
     stub_row_group.font.weight = NULL,
     stub_row_group.text_transform = NULL,

R/utils_render_latex.R

@@ -196,6 +196,7 @@ 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_visible$unspec < 1L)) {
 
     col_defs <- NULL
@@ -234,7 +235,7 @@ create_table_start_l <- function(data, colwidth_df) {
   }
 
   # # Add borders to the right of any columns in the stub
-  if (length(stub_layout) > 0) {
+  if (length(stub_layout) > 0 && dt_options_get_value(data, "stub_separate")) {
 
     # Count the actual number of stub columns
     # When we have both group_label and rowname, we have 2 columns
@@ -1247,21 +1248,28 @@ summary_rows_for_group_l <- function(
   ##? TODO: GET COLUMN WIDTH TO ADD TO ALIGNMENT
 
   if (stub_is_2) {
+
+    rowsplit_alignment <- "l"
+
+    if (dt_options_get_value(data, "stub_separate")) {
+      rowsplit_alignment <- paste0(rowsplit_alignment, "|")
+    }
+
     row_splits_summary <-
       lapply(
         row_splits_summary,
         function(x) {
           x <- c("", x)
           x[1] <- latex_multicolumn_cell(
             x = x[1],
-            alignment = "l|",
+            alignment = rowsplit_alignment,
             ncols = 1,
             override_ncols = TRUE,
             override_alignment = FALSE
           )
           x[2] <- latex_multicolumn_cell(
             x = x[2],
-            alignment = "l|",
+            alignment = rowsplit_alignment,
             ncols = 1,
             override_ncols = TRUE,
             override_alignment = FALSE
@@ -1317,7 +1325,7 @@ create_table_end_l <- function(data) {
 
 
   paste0(
-    if(include_bottomrule){"\\bottomrule\n"},
+    if (include_bottomrule){"\\bottomrule\n"},
     ifelse(dt_options_get_value(data = data, option = "latex_use_longtable"),
            "\\end{longtable}\n",
            "\\end{tabular*}\n"),
@@ -1385,11 +1393,11 @@ create_footer_component_l <- function(data) {
           if(grepl("\\\\shortstack", footnote_latex)){
 
             ## remove linewidth parbox within a shortstack for footnotes, already within a parbox
-            footnote_latex <- gsub("(?<=\\\\shortstack\\[.\\]\\{)\\\\parbox\\{.+?\\}\\{(.+?)\\}","\\1",footnote_latex, perl = TRUE)
+            footnote_latex <- gsub("(?<=\\\\shortstack\\[.\\]\\{)\\\\parbox\\{.+?\\}\\{(.+?)\\}","\\1", footnote_latex, perl = TRUE)
 
             ## add footmark within shortstack
             if(nzchar(footmark)){
-              footnote_latex <- gsub("(\\\\shortstack\\[.\\]\\{)(.+?\\})",paste0("\\1",gsub("\\","\\\\",footmark, fixed=TRUE),"\\2"), footnote_latex, perl = TRUE)
+              footnote_latex <- gsub("(\\\\shortstack\\[.\\]\\{)(.+?\\})",paste0("\\1",gsub("\\","\\\\", footmark, fixed=TRUE),"\\2"), footnote_latex, perl = TRUE)
             }
 
           }else{
@@ -1597,6 +1605,7 @@ create_body_rows_l <- function(
                   identical(colname_i, "::stub::") ||
                   grepl("^::stub_.*::$", colname_i)
                 ) {
+
                   colwidth_i <- dplyr::filter(
                     colwidth_df,
                     type == "stub",
@@ -1609,16 +1618,17 @@ create_body_rows_l <- function(
                   )
                 }
 
-                if(sum(colwidth_i$unspec < 1) > 0){
+                if (sum(colwidth_i$unspec < 1) > 0) {
                   cell_width <- create_singlecolumn_width_text_l(pt = colwidth_i$pt, lw = colwidth_i$lw)
-                }else{
+                } else {
                   cell_width <- ""
                 }
 
-                content[i] <- apply_cell_styles_l(
-                  content_i,
-                  styles_body,
-                  width = cell_width
+                content[i] <-
+                  apply_cell_styles_l(
+                    content_i,
+                    styles_body,
+                    width = cell_width
                   ) |>
                   remove_footnote_encoding()
 
@@ -1640,12 +1650,11 @@ create_body_rows_l <- function(
                   )
                 }
 
-                if(isFALSE(sum(colwidth_i$unspec < 1) > 0)){
-                  content_i <- gsub("\\\\parbox\\{\\\\linewidth\\}\\{(.+?)\\}","\\1",content_i)
+                if (isFALSE(sum(colwidth_i$unspec < 1) > 0)) {
+                  content_i <- gsub("\\\\parbox\\{\\\\linewidth\\}\\{(.+?)\\}", "\\1", content_i)
                 }
 
-                ## if styling set, remove the parbox if it is set to line width
-
+                # If styling set, remove the parbox if it is set to line width
                 content[i] <- remove_footnote_encoding(content_i)
 
               }
@@ -1665,48 +1674,48 @@ create_body_rows_l <- function(
 # cells not modified by tab_style calls.
 remove_footnote_encoding <- function(x) {
 
-  ## if no footnotes, move along
-  if((sum(grepl("%%%(right|left):",x)) == 0)){
+  # If no footnotes, move along
+  if ((sum(grepl("%%%(right|left):",x)) == 0)) {
     return(x)
   }
 
-  ## if there are footnotes, loop through
-
-  for( i in seq_along(x)){
+  # If there are footnotes, loop through
+  for (i in seq_along(x)) {
 
     x_i <- x[i]
 
-    if(grepl("\\\\(shortstack|parbox)",x_i)){
+    if (grepl("\\\\(shortstack|parbox)", x_i)) {
 
-      if(grepl("%%%right:",x_i)){
+      if (grepl("%%%right:", x_i)) {
         footmark_text <- regmatches(x_i, regexec("(?<=%%%right:).+$", x_i, perl = TRUE))[[1]]
-        if(grepl("%%%left:", footmark_text)){
+        if (grepl("%%%left:", footmark_text)) {
           footmark_text <- regmatches(footmark_text, regexec(".+?(?=%%%left:)", footmark_text, perl = TRUE))[[1]]
         }
         content_x <- regmatches(x_i, regexec(".+?(?=%%%right:)", x_i, perl = TRUE))[[1]]
 
-        if(grepl("\\\\shortstack", content_x)){
-          x_i <- gsub("(\\\\shortstack\\[.\\]\\{(\\\\parbox\\{.+?\\}\\{)*.+?)((\\}\\s*)+$)",paste0("\\1",gsub("\\","\\\\",footmark_text, fixed=TRUE)," \\3"), content_x, perl = TRUE)
-        }else{
-          x_i <- gsub("((\\\\parbox\\{.+?\\}\\{).+?)((\\}\\s*)+$)",paste0("\\1",gsub("\\","\\\\",footmark_text, fixed=TRUE)," \\3"), content_x, perl = TRUE)
+        if (grepl("\\\\shortstack", content_x)) {
+          x_i <- gsub("(\\\\shortstack\\[.\\]\\{(\\\\parbox\\{.+?\\}\\{)*.+?)((\\}\\s*)+$)", paste0("\\1", gsub("\\", "\\\\", footmark_text, fixed=TRUE), " \\3"), content_x, perl = TRUE)
+        } else {
+          x_i <- gsub("((\\\\parbox\\{.+?\\}\\{).+?)((\\}\\s*)+$)", paste0("\\1", gsub("\\", "\\\\", footmark_text, fixed=TRUE), " \\3"), content_x, perl = TRUE)
         }
-      } else if(grepl("%%%left:",x_i)){
+      } else if (grepl("%%%left:",x_i)) {
         footmark_text <- regmatches(x_i, regexec("(?<=%%%left:).+?$", x_i, perl = TRUE))[[1]]
         content_x <- regmatches(x_i, regexec(".+?(?=%%%left:)", x_i, perl = TRUE))[[1]]
-        ## add footmark within shortstack
-        if(grepl("\\\\shortstack", content_x)){
-          x_i <- gsub("(\\\\shortstack\\[.\\]\\{(\\\\parbox\\{.+?\\}\\{)*)(.+?\\})",paste0("\\1",gsub("\\","\\\\",footmark_text, fixed=TRUE)," \\3"), content_x, perl = TRUE)
-        }else{
-          x_i <- gsub("((\\\\parbox\\{.+?\\}\\{).+?)\\s(.+?((\\}\\s*)+$))",paste0("\\1",gsub("\\","\\\\",footmark_text, fixed=TRUE)," \\3"), content_x, perl = TRUE)
+        
+        # Add footmark within shortstack
+        if (grepl("\\\\shortstack", content_x)) {
+          x_i <- gsub("(\\\\shortstack\\[.\\]\\{(\\\\parbox\\{.+?\\}\\{)*)(.+?\\})", paste0("\\1", gsub("\\", "\\\\", footmark_text, fixed=TRUE), " \\3"), content_x, perl = TRUE)
+        } else {
+          x_i <- gsub("((\\\\parbox\\{.+?\\}\\{).+?)\\s(.+?((\\}\\s*)+$))", paste0("\\1", gsub("\\", "\\\\", footmark_text, fixed=TRUE), " \\3"), content_x, perl = TRUE)
         }
 
       }
 
-    }else{
-      if(grepl("%%%right:",x_i)){
+    } else {
+      if (grepl("%%%right:",x_i)) {
         x_i <- gsub("%%%(right):", "", x_i)
       }
-      if(grepl("%%%left:", x_i)){
+      if (grepl("%%%left:", x_i)) {
 
         footmark_text <- regmatches(x_i, regexec("(?<=%%%left:).+?$", x_i, perl = TRUE))[[1]]
         content_x <- regmatches(x_i, regexec(".+?(?=%%%left:)", x_i, perl = TRUE))[[1]]
@@ -1734,11 +1743,13 @@ convert_font_size_l <- function(x) {
     `default` = ""
   )
 
+  if (as.character(x) %in% names(size_map)) {
 
-  if (as.character(x) %in% names(size_map)){
     return(size_map[[x]])
-  }else if(grepl("(pt|%|px|in|cm|emu|em)",x)){
-    return(.apply_style_fontsize_l(list('cell_text' = list('size' = round(parse_font_size_l(x))))))
+
+  } else if (grepl("(pt|%|px|in|cm|emu|em)", x)) {
+
+    return(.apply_style_fontsize_l(list("cell_text" = list("size" = round(parse_font_size_l(x))))))
   }
 
   NULL
@@ -1806,6 +1817,11 @@ create_summary_rows_l <- function(
 
           if (stub_width > 1) {
 
+            rowsplit_alignment <- "l"
+            if (dt_options_get_value(data, "stub_separate")) {
+              rowsplit_alignment <- paste0(rowsplit_alignment, "|")
+            }
+
             row_splits_summary <-
               lapply(
                 row_splits_summary,
@@ -1814,8 +1830,8 @@ create_summary_rows_l <- function(
                   x <- c(rep("", stub_width - 1), x)
 
                   x[seq_len(stub_width)] <- sapply(x[seq_len(stub_width)], function(x) {
-                    latex_multicolumn_cell(x, ncols = 1, alignment = "l|", override_alignment = FALSE)
-                    })
+                    latex_multicolumn_cell(x, ncols = 1, alignment = rowsplit_alignment, override_alignment = FALSE)
+                  })
 
                   x
                 }
@@ -1877,10 +1893,12 @@ derive_table_width_statement_l <- function(data) {
 
   # Bookends are not required if a table width is not specified
   # of if using floating table
-  if (table_width == "auto" ||
-      !dt_options_get_value(data = data, option = "latex_use_longtable")) {
+  if (
+    table_width == "auto" ||
+      !dt_options_get_value(data = data, option = "latex_use_longtable")
+  ) {
 
-    statement <- ''
+    statement <- ""
 
   } else if (endsWith(table_width, "%")) {
 
@@ -1916,7 +1934,6 @@ derive_table_width_statement_l <- function(data) {
   }
 
   statement
-
 }
 
 #' Consolidate Cell Styles