Merge pull request #807 from haozhu233/rulewidth

Sometimes \toprule etc. have optional width spec.
haozhu233 · Dec 13, 2023 · 86c281c · 86c281c
2 parents 8e8ec75 + e366192
commit 86c281c
Show file tree

Hide file tree

Showing 9 changed files with 114 additions and 18 deletions.
diff --git a/R/add_footnote.R b/R/add_footnote.R
@@ -144,9 +144,9 @@ add_footnote <- function(input, label = NULL,
             label[i], "}")
         }
 
-        if (str_detect(export, "\\\\toprule")) {
-          export <- sub("\\\\toprule",
-                        paste0("\\\\toprule\n", caption.footnote), export)
+        if (str_detect(export, toprule_regexp)) {
+          export <- sub(toprule_regexp,
+                        paste0("\\1\n", caption.footnote), export)
         } else {
           export <- sub("\\\\hline",
                         paste0("\\\\hline\n", caption.footnote), export)

diff --git a/R/add_header_above.R b/R/add_header_above.R
@@ -312,7 +312,7 @@ pdfTable_add_header_above <- function(kable_input, header, bold, italic,
 
   align <- vapply(align, match.arg, 'a', choices = c("l", "c", "r"))
 
-  hline_type <- switch(table_info$booktabs + 1, "\\\\hline", "\\\\toprule")
+  hline_type <- switch(table_info$booktabs + 1, "(\\\\hline)", toprule_regexp)
   new_header_split <- pdfTable_new_header_generator(
     header, table_info$booktabs, bold, italic, monospace, underline, strikeout,
     align, color, background, font_size, angle, line_sep,
@@ -324,7 +324,7 @@ pdfTable_add_header_above <- function(kable_input, header, bold, italic,
   }
   out <- str_replace(solve_enc(kable_input),
                      hline_type,
-                     paste0(hline_type, "\n", new_header))
+                     paste0("\\1\n", new_header))
   out <- structure(out, format = "latex", class = "knitr_kable")
   # new_header_row <- latex_contents_escape(new_header_split[1])
   if (is.null(table_info$new_header_row)) {

diff --git a/R/footnote.R b/R/footnote.R
@@ -283,7 +283,7 @@ footnote_latex <- function(kable_input, footnote_table, footnote_as_chunk,
                         "}\n\\\\end{ThreePartTable}"),
                  out)
       if (table_info$booktabs) {
-        out <- sub("\\\\bottomrule", "\\\\bottomrule\n\\\\insertTableNotes", out)
+        out <- sub(bottomrule_regexp, "\\1\n\\\\insertTableNotes", out)
       } else {
         out <- sub("\\\\hline\n\\\\end\\{longtable\\}",
                    "\\\\hline\n\\\\insertTableNotes\n\\\\end\\{longtable\\}",
@@ -308,8 +308,8 @@ footnote_latex <- function(kable_input, footnote_table, footnote_as_chunk,
     }
   } else {
     if (table_info$booktabs) {
-      out <- sub("\\\\bottomrule",
-                 paste0("\\\\bottomrule\n", footnote_text), out)
+      out <- sub(bottomrule_regexp,
+                 paste0("\\1\n", footnote_text), out)
     } else {
       out <- sub(table_info$end_tabular,
                  paste0(footnote_text, "\n\\\\end{", table_info$tabular, "}"),

diff --git a/R/kable_styling.R b/R/kable_styling.R
@@ -470,12 +470,18 @@ styling_latex_repeat_header <- function(x, table_info, repeat_header_text,
                                         repeat_header_method,
                                         repeat_header_continued) {
   x <- str_split(x, "\n")[[1]]
+  # These two defs won't be used, but make it clear
+  # the rules are defined
+  midrule <- "\\midrule"
+  bottomrule <- "\\bottomrule"
+  #
   if (table_info$booktabs) {
-    header_rows_start <- which(x == "\\toprule")[1]
+    header_rows_start <- grep(paste0("^", toprule_regexp, "$"),  x)[1]
     if (is.null(table_info$colnames)) {
       header_rows_end <- header_rows_start
     } else {
-      header_rows_end <- which(x == "\\midrule")[1]
+      header_rows_end <- grep(paste0("^", midrule_regexp, "$"), x)[1]
+      midrule <- sub(midrule_regexp, "\\1", x[header_rows_end])
     }
   } else {
     header_rows_start <- which(x == "\\hline")[1]
@@ -498,23 +504,25 @@ styling_latex_repeat_header <- function(x, table_info, repeat_header_text,
   if (!table_info$booktabs) {
     bottom_part <- NULL
   } else {
-    index_bottomrule <- which(x == "\\bottomrule")
+    index_bottomrule <- grep(paste0("^", bottomrule_regexp, "$"), x)
+    bottomrule <- x[index_bottomrule]
     x <- x[-index_bottomrule]
     x[index_bottomrule - 1] <- paste0(x[index_bottomrule - 1], "*")
 
     if (repeat_header_continued == FALSE) {
-      bottom_part <- "\n\\endfoot\n\\bottomrule\n\\endlastfoot"
+      bottom_part <- paste0( "\n\\endfoot\n", bottomrule,
+                             "\n\\endlastfoot")
     } else {
       if (repeat_header_continued == TRUE) {
         bottom_text <- "\\textit{(continued \\ldots)}"
       } else {
         bottom_text <- repeat_header_continued
       }
       bottom_part <- paste0(
-        "\\midrule\n",
+        midrule, "\n",
         "\\multicolumn{", table_info$ncol, "}{r@{}}{", bottom_text, "}\\\\\n",
         "\\endfoot\n",
-        "\\bottomrule\n",
+        bottomrule, "\n",
         "\\endlastfoot"
       )
     }

diff --git a/R/magic_mirror.R b/R/magic_mirror.R
@@ -45,7 +45,7 @@ magic_mirror_latex <- function(kable_input){
     "tabular", "longtable"
   )
   # Booktabs
-  table_info$booktabs <- grepl("\\\\toprule", kable_input)
+  table_info$booktabs <- grepl(toprule_regexp, kable_input)
   # Align
   table_info$align <- gsub("\\|", "", str_match(
     kable_input, paste0("\\\\begin\\{",
@@ -96,7 +96,7 @@ magic_mirror_latex <- function(kable_input){
   table_info$nrow <- length(table_info$contents)
   table_info$duplicated_rows <- (sum(duplicated(table_info$contents)) != 0)
   # Column names
-  if (table_info$booktabs & !grepl("\\\\midrule", kable_input)) {
+  if (table_info$booktabs & !grepl(midrule_regexp, kable_input)) {
     table_info$colnames <- NULL
     table_info$position_offset <- 0
   } else {

diff --git a/R/util.R b/R/util.R
@@ -336,3 +336,11 @@ md_table_parser <- function(md_table) {
              caption=table_caption, booktabs = TRUE,
              longtable = TRUE))
 }
+
+# \toprule, \midrule and \bottomrule have an optional width argument #806
+# Match it all.  Sometimes these are used with
+# the extended regex language, sometimes with PCRE
+# or ICU, so be careful!
+toprule_regexp <- "(\\\\toprule(\\[[^]]*])?)"
+midrule_regexp <- "(\\\\midrule(\\[[^]]*])?)"
+bottomrule_regexp <- "(\\\\bottomrule(\\[[^]]*])?)"
diff --git a/inst/NEWS.md b/inst/NEWS.md
@@ -43,6 +43,8 @@ dark-themed Rstudio (#689).
 including extra stuff, like a style block.
 * Fixed minor spelling errors and typos in various places (#779, #709, #710, #676).
 * Resolved issue with `auto_format` default setting (#749).
+* Some table additions didn't work with custom rule
+widths (#806).
 
 Documentation and Maintenance:
 

diff --git a/tests/testthat/_snaps/bugfix.md b/tests/testthat/_snaps/bugfix.md
@@ -1,3 +1,64 @@
+# Issue #806: custom rule widths
+
+    Code
+      footnote(add_footnote(add_header_above(kable_styling(kbl(mtcars[1:3, 1:4],
+      caption = "kable vary line thickness", booktabs = TRUE, toprule = "\\toprule[4pt]",
+      midrule = "\\midrule[3pt]", bottomrule = "\\bottomrule[5pt]", linesep = "\\midrule[2pt]"),
+      repeat_header_text = TRUE), c("", `Group 1` = 2, `Group 2` = 2)),
+      "The footnote"), "Another footnote")
+    Output
+      <table class="table" style="margin-left: auto; margin-right: auto;border-bottom: 0;">
+      <caption>kable vary line thickness</caption>
+       <thead>
+      <tr>
+      <th style="empty-cells: hide;border-bottom:hidden;" colspan="1"></th>
+      <th style="border-bottom:hidden;padding-bottom:0; padding-left:3px;padding-right:3px;text-align: center; " colspan="2"><div style="border-bottom: 1px solid #ddd; padding-bottom: 5px; ">Group 1</div></th>
+      <th style="border-bottom:hidden;padding-bottom:0; padding-left:3px;padding-right:3px;text-align: center; " colspan="2"><div style="border-bottom: 1px solid #ddd; padding-bottom: 5px; ">Group 2</div></th>
+      </tr>
+        <tr>
+         <th style="text-align:left;">   </th>
+         <th style="text-align:right;"> mpg </th>
+         <th style="text-align:right;"> cyl </th>
+         <th style="text-align:right;"> disp </th>
+         <th style="text-align:right;"> hp </th>
+        </tr>
+       </thead>
+      <tbody>
+        <tr>
+         <td style="text-align:left;"> Mazda RX4 </td>
+         <td style="text-align:right;"> 21.0 </td>
+         <td style="text-align:right;"> 6 </td>
+         <td style="text-align:right;"> 160 </td>
+         <td style="text-align:right;"> 110 </td>
+        </tr>
+        <tr>
+         <td style="text-align:left;"> Mazda RX4 Wag </td>
+         <td style="text-align:right;"> 21.0 </td>
+         <td style="text-align:right;"> 6 </td>
+         <td style="text-align:right;"> 160 </td>
+         <td style="text-align:right;"> 110 </td>
+        </tr>
+        <tr>
+         <td style="text-align:left;"> Datsun 710 </td>
+         <td style="text-align:right;"> 22.8 </td>
+         <td style="text-align:right;"> 4 </td>
+         <td style="text-align:right;"> 108 </td>
+         <td style="text-align:right;"> 93 </td>
+        </tr>
+      </tbody>
+      <tfoot>
+      <tr>
+      <td style="padding: 0; border:0;" colspan="100%">
+      <sup>a</sup> The footnote</td>
+      </tr>
+      </tfoot>
+      <tfoot>
+      <tr><td style="padding: 0; " colspan="100%"><span style="font-style: italic;">Note: </span></td></tr>
+      <tr><td style="padding: 0; " colspan="100%">
+      <sup></sup> Another footnote</td></tr>
+      </tfoot>
+      </table>
+
 # Issue #796
 
     Code

diff --git a/tests/testthat/test-bugfix.R b/tests/testthat/test-bugfix.R
@@ -1,3 +1,19 @@
+test_that("Issue #806: custom rule widths", {
+  expect_snapshot(
+    kbl(mtcars[1:3, 1:4],
+        caption="kable vary line thickness",
+        booktabs = TRUE,
+        toprule = "\\toprule[4pt]",
+        midrule = "\\midrule[3pt]",
+        bottomrule = "\\bottomrule[5pt]",
+        linesep = "\\midrule[2pt]") |>
+      kable_styling(repeat_header_text = TRUE) |>
+      add_header_above(c("", "Group 1" = 2, "Group 2" = 2)) |>
+      add_footnote("The footnote") |>
+      footnote("Another footnote")
+  )
+})
+
 test_that("Issue #796", {
     expect_snapshot(
         kbl(mtcars[1:3, 1:4], caption = "Demo table", booktabs = TRUE, format = "latex") |>
@@ -6,10 +22,10 @@ test_that("Issue #796", {
 })
 
 
-# Issue #658: column_spec() fails at single-row headerless tables in latex format. 
+# Issue #658: column_spec() fails at single-row headerless tables in latex format.
 dat <- data.frame(x = 1, y = 1)
 dat <- setNames(dat, NULL)
-tab <- kbl(dat, format = "latex") %>% 
+tab <- kbl(dat, format = "latex") %>%
   column_spec(2, latex_column_spec = "l")
 expect_s3_class(tab, "knitr_kable")
 
@@ -52,3 +68,4 @@ expect_s3_class(tab, "kableExtra")
 #     column_spec(1, width = "40em", include_thead = FALSE)
 # expect_s3_class(tab, "kableExtra")
 
+