From 5c6b5d60ac6425fe94a42479963d2ba315acad08 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Mon, 11 Dec 2023 11:21:55 -0500 Subject: [PATCH 1/2] news --- inst/NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/inst/NEWS.md b/inst/NEWS.md index c86fbae..872f0e5 100644 --- a/inst/NEWS.md +++ b/inst/NEWS.md @@ -4,6 +4,7 @@ kableExtra 1.4.0 New Features: * Added live preview of inline plots (#777). +* Add feature to scale_up and scale_down latex tables (#753) * Added row grouping feature with `row_group_label_position = first` option (#711). * Expanded the functionality of `spec_color` to allow arbitrary palettes. * Removed dependency on `rvest` and `glue` From 0d5ed5fd20c03d4f1b551b660180828317edc2cc Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Tue, 12 Dec 2023 09:41:28 -0500 Subject: [PATCH 2/2] Support: tabularray for LaTeX tables --- R/column_spec.R | 27 +++- R/magic_mirror.R | 13 +- R/row_spec.R | 87 ++++++++---- R/tabularray.R | 202 ++++++++++++++++++++++++++++ R/util.R | 2 + inst/rmarkdown/tabularray_small.Rmd | 39 ++++++ 6 files changed, 339 insertions(+), 31 deletions(-) create mode 100644 R/tabularray.R create mode 100644 inst/rmarkdown/tabularray_small.Rmd diff --git a/R/column_spec.R b/R/column_spec.R index 08e1802..d7c9c3b 100644 --- a/R/column_spec.R +++ b/R/column_spec.R @@ -340,7 +340,30 @@ column_spec_latex <- function(kable_input, column, width, border_left, border_right, latex_column_spec, latex_valign, include_thead, link, image) { - table_info <- magic_mirror(kable_input) + + out <- solve_enc(kable_input) + table_info <- magic_mirror(out) + + if (table_info$tabular == "tblr") { + out <- column_spec_tabularray( + kable_input = out, + column = column, + bold = bold, + italic = italic, + monospace = monospace, + underline = underline, + strikeout = strikeout, + color = color, + background = background, + font_size = NULL, + angle = NULL, + width = width, + latex_valign = latex_valign, + latex_column_spec = latex_column_spec + ) + return(out) + } + if (!is.null(table_info$collapse_rows)) { message("Usually it is recommended to use column_spec before collapse_rows,", " especially in LaTeX, to get a desired result. ") @@ -361,7 +384,7 @@ column_spec_latex <- function(kable_input, column, width, out <- sub(paste0("\\{", kable_align_old, "\\}"), paste0("\\{", kable_align_new, "\\}"), - solve_enc(kable_input), + out, perl = T) if (!is.null(width)) { diff --git a/R/magic_mirror.R b/R/magic_mirror.R index be52d7c..4db2bdf 100644 --- a/R/magic_mirror.R +++ b/R/magic_mirror.R @@ -39,11 +39,16 @@ magic_mirror_latex <- function(kable_input){ rownames = NULL, caption = NULL, caption.short = NULL, contents = NULL, centering = FALSE, table_env = FALSE) + # Tabular - table_info$tabular <- ifelse( - grepl("\\\\begin\\{tabular\\}", kable_input), - "tabular", "longtable" - ) + if (grepl("\\\\begin\\{tabular\\}", kable_input)) { + table_info$tabular <- "tabular" + } else if (grepl("\\\\begin\\{tblr\\}", kable_input)) { + table_info$tabular <- "tblr" + } else { + table_info$tabular <- "longtable" + } + # Booktabs table_info$booktabs <- grepl("\\\\toprule", kable_input) # Align diff --git a/R/row_spec.R b/R/row_spec.R index cc1bd5e..5125fa6 100644 --- a/R/row_spec.R +++ b/R/row_spec.R @@ -189,9 +189,32 @@ row_spec_latex <- function(kable_input, row, bold, italic, monospace, underline, strikeout, color, background, align, font_size, angle, hline_after, extra_latex_after) { + table_info <- magic_mirror(kable_input) + out <- solve_enc(kable_input) + if (table_info$tabular == "tblr") { + out <- row_spec_tabularray( + kable_input = out, + row = row, + bold = bold, + italic = italic, + monospace = monospace, + underline = underline, + strikeout = strikeout, + color = color, + background = background, + align = align, + font_size = font_size, + angle = angle, + hline_after = hline_after, + extra_latex_after = extra_latex_after + ) + return(out) + } + + if (table_info$duplicated_rows) { dup_fx_out <- fix_duplicated_rows_latex(out, table_info) out <- dup_fx_out[[1]] @@ -206,31 +229,16 @@ row_spec_latex <- function(kable_input, row, bold, italic, monospace, underline, strikeout, color, background, align, font_size, angle, hline_after, extra_latex_after) - temp_sub <- ifelse(i == 1 & (table_info$tabular == "longtable" | - !is.null(table_info$repeat_header_latex)), - gsub, sub) - if (length(new_row) == 1) { - # fixed=TRUE is safer but does not always work - regex <- paste0("\\Q", target_row, "\\E") - if (grepl(regex, out)) { - out <- temp_sub(regex, new_row, out, perl = TRUE) - } else { - out <- temp_sub(paste0(target_row, "\\\\\\\\"), - paste0(new_row, "\\\\\\\\"), out, perl = TRUE) - } - table_info$contents[i] <- new_row - } else { - # fixed=TRUE is safer but does not always work - regex <- paste0("\\Q", target_row, "\\E") - if (any(grepl(regex, out))) { - out <- temp_sub(regex, - paste(new_row, collapse = ""), out, perl = TRUE) - } else { - out <- temp_sub(paste0(target_row, "\\\\\\\\"), - paste(new_row, collapse = ""), out, perl = TRUE) - } - table_info$contents[i] <- new_row[1] - } + + tmp <- latex_new_row_replacer( + i = i, + row = row, + out = out, + table_info = table_info, + new_row = new_row, + target_row = target_row) + out <- tmp$out + table_info <- tmp$table_info } out <- structure(out, format = "latex", class = "knitr_kable") @@ -238,6 +246,7 @@ row_spec_latex <- function(kable_input, row, bold, italic, monospace, return(out) } + latex_new_row_builder <- function(target_row, table_info, bold, italic, monospace, underline, strikeout, @@ -348,3 +357,31 @@ latex_new_row_builder <- function(target_row, table_info, } +# Do not repeat yourself: tabularray.R +latex_new_row_replacer <- function(i, row, out, table_info, new_row, target_row) { + temp_sub <- ifelse(i == 1 & (table_info$tabular == "longtable" | !is.null(table_info$repeat_header_latex)), + gsub, sub) + if (length(new_row) == 1) { + # fixed=TRUE is safer but does not always work + regex <- paste0("\\Q", target_row, "\\E") + if (grepl(regex, out)) { + out <- temp_sub(regex, new_row, out, perl = TRUE) + } else { + out <- temp_sub(paste0(target_row, "\\\\\\\\"), + paste0(new_row, "\\\\\\\\"), out, perl = TRUE) + } + table_info$contents[i] <- new_row + } else { + # fixed=TRUE is safer but does not always work + regex <- paste0("\\Q", target_row, "\\E") + if (any(grepl(regex, out))) { + out <- temp_sub(regex, + paste(new_row, collapse = ""), out, perl = TRUE) + } else { + out <- temp_sub(paste0(target_row, "\\\\\\\\"), + paste(new_row, collapse = ""), out, perl = TRUE) + } + table_info$contents[i] <- new_row[1] + } + return(list(out = out, table_info = table_info)) +} \ No newline at end of file diff --git a/R/tabularray.R b/R/tabularray.R new file mode 100644 index 0000000..bb55dee --- /dev/null +++ b/R/tabularray.R @@ -0,0 +1,202 @@ +row_spec_tabularray <- function(kable_input, + row = NULL, + bold = NULL, + italic = NULL, + monospace = NULL, + underline = NULL, + strikeout = NULL, + color = NULL, + background = NULL, + align = NULL, + font_size = NULL, + angle = NULL, + hline_after = NULL, + extra_latex_after = NULL) { + # TODO: hline_after is not supported + # TODO: font_size, angle + # TODO: vectorize bold et al. + # TODO: DRY with row replacer + + out <- kable_input + + table_info <- magic_mirror(kable_input) + + vectorize_style <- function(s, row) { + if (is.null(s)) { + return(rep("", length(row))) + } + + if (length(s) == 1) { + out <- rep(s, length(row)) + } else { + out <- s + } + if (length(out) != length(row)) { + msg <- sprintf("`row_spec()` error: length of style vector must be the same as the length of the `row` index vector.", length(row)) + stop(msg, .call = FALSE) + } + return(out) + } + + bold <- vectorize_style(bold, row) + italic <- vectorize_style(italic, row) + monospace <- vectorize_style(monospace, row) + underline <- vectorize_style(underline, row) + strikeout <- vectorize_style(strikeout, row) + color <- vectorize_style(color, row) + background <- vectorize_style(background, row) + align <- vectorize_style(align, row) + # font_size <- vectorize_style(font_size, row) + # angle <- vectorize_style(angle, row) + + row <- row + table_info$position_offset + + for (r in seq_along(row)) { + i <- row[r] + target_row <- table_info$contents[i] + + # SetRow override + new_row <- sub("\\\\SetRow\\{[^\\}]*\\}", "", target_row) + + new_row <- latex_new_row_builder( + target_row = new_row, + table_info = table_info, + bold = FALSE, + italic = FALSE, + monospace = FALSE, + underline = underline[r], + strikeout = strikeout[r], + color = NULL, + background = NULL, + align = NULL, + font_size = NULL, + angle = NULL, + hline_after = FALSE, + extra_latex_after = extra_latex_after) + + + # SetRow settings + font <- rep("", length(row)) + font <- ifelse(bold, paste0(font, "\\\\bfseries"), font) + font <- ifelse(monospace, paste0(font, "\\\\ttfamily"), font) + font <- ifelse(italic, paste0(font, "\\\\itshape"), font) + + new_row <- sprintf( + "\\\\SetRow{%s, bg=%s, fg=%s, font=%s} %s", + align[r], + background[r], + color[r], + font[r], + new_row + ) + + tmp <- latex_new_row_replacer( + i = i, + row = row, + out = out, + table_info = table_info, + new_row = new_row, + target_row = target_row) + out <- tmp$out + table_info <- tmp$table_info + } + + out <- structure(out, format = "latex", class = "knitr_kable") + return(out) +} + + +column_spec_tabularray <- function(kable_input, + column, + bold, + italic, + monospace, + underline, + strikeout, + color, + background, + font_size, + angle, + width, + latex_valign, + latex_column_spec) { + # TODO: align_collapse vlines="|" (bug not specific to this PR) + # TODO: support missing arguments + table_info <- magic_mirror(kable_input) + out <- kable_input + + if (!is.null(font_size)) stop("`font_size` is not supported by `column_spec()` for `tabularray` tables.", .call = FALSE) + if (!is.null(angle)) stop("`angle` is not supported by `column_spec()` for `tabularray` tables.", .call = FALSE) + if (!identical(latex_valign, "p")) stop("`latex_valign` is not supported by `column_spec()` for `tabularray` tables.", .call = FALSE) + if (!is.null(latex_column_spec)) stop("`latex_column_spec` is not supported by `column_spec()` for `tabularray` tables.", .call = FALSE) + + # sanity check + align <- table_info$align_vector + if (length(align) != table_info$ncol || any(!table_info$align_vector %in% c("l", "r", "c"))) { + msg <- 'When using `tabularray`, entries in the `align` argument must be "l", "r", or "c".' + stop(msg, .call = FALSE) + } + + vectorize_style <- function(s, column) { + if (is.null(s)) { + return(rep("", length(column))) + } + + if (length(s) == 1) { + out <- rep(s, length(column)) + } else { + out <- s + } + if (length(out) != length(column)) { + msg <- sprintf("`column_spec()` error: length of style vector must be the same as the length of the `column` index vector.", length(column)) + stop(msg, .call = FALSE) + } + return(out) + } + bold <- vectorize_style(bold, column) + italic <- vectorize_style(italic, column) + monospace <- vectorize_style(monospace, column) + underline <- vectorize_style(underline, column) + strikeout <- vectorize_style(strikeout, column) + color <- vectorize_style(color, column) + background <- vectorize_style(background, column) + width <- vectorize_style(width, column) + + font <- rep("", length(row)) + font <- ifelse(bold, paste0(font, "\\\\bfseries"), font) + font <- ifelse(monospace, paste0(font, "\\\\ttfamily"), font) + font <- ifelse(italic, paste0(font, "\\\\itshape"), font) + + cmd <- rep("", length(row)) + cmd <- ifelse(underline, paste0(cmd, "\\\\kableExtraTabularrayUnderline{\\#1}"), cmd) + cmd <- ifelse(strikeout, paste0(cmd, "\\\\kableExtraTabularrayStrikeout{\\#1}"), cmd) + + headers <- sprintf( + "Q[wd=%s, align=%s, bg=%s, fg=%s, font=%s, cmd=%s]", + width, + align[column], + background, + color, + font, + cmd + ) + + align_collapse <- ifelse(table_info$booktabs | !is.null(table_info$xtable), "", "\\|") + + # old header settings + align_collapse <- ifelse(table_info$booktabs | !is.null(table_info$xtable), "", "\\|") + kable_align_old <- paste(table_info$align_vector, collapse = align_collapse) + + # new header settings + table_info$align_vector[column] <- headers + kable_align_new <- paste(table_info$align_vector, collapse = paste(align_collapse)) + + out <- sub(paste0("\\{", kable_align_old, "\\}"), + paste0("\\{", kable_align_new, "\\}"), + out, + perl = T) + + out <- structure(out, format = "latex", class = "knitr_kable") + attr(out, "kable_meta") <- table_info + return(out) +} diff --git a/R/util.R b/R/util.R index 95dd618..ace9cd9 100644 --- a/R/util.R +++ b/R/util.R @@ -58,6 +58,7 @@ use_latex_packages <- function() { usepackage_latex("colortbl") usepackage_latex("pdflscape") usepackage_latex("tabu") + usepackage_latex("tabularray") usepackage_latex("threeparttable") usepackage_latex("threeparttablex") usepackage_latex("ulem", "normalem") @@ -217,6 +218,7 @@ latex_pkg_list <- function() { "\\usepackage{colortbl}", "\\usepackage{pdflscape}", "\\usepackage{tabu}", + "\\usepackage{tabularray}", "\\usepackage{threeparttable}", "\\usepackage{threeparttablex}", "\\usepackage[normalem]{ulem}", diff --git a/inst/rmarkdown/tabularray_small.Rmd b/inst/rmarkdown/tabularray_small.Rmd new file mode 100644 index 0000000..8615270 --- /dev/null +++ b/inst/rmarkdown/tabularray_small.Rmd @@ -0,0 +1,39 @@ +--- +output: + pdf_document: + keep_tex: true +header-includes: + - \newcommand{\kableExtraTabularrayUnderline}[1]{\underline} + - \newcommand{\kableExtraTabularrayStrikeout}[1]{\sout} +--- + +# TODO + +* [ ] vectorized arguments in columns +* [ ] `border_right` and `border_left` are profoundly broken +* [ ] `vline=""` breaks replacement of Q[] because sub is looking for "l|r|r" + +```{r, results = "asis"} +pkgload::load_all() + +d <- mtcars[1:3, 1:3] +kbl(d, format = "latex", tabular = "tblr", align = "lcr") |> + row_spec( + row = c(1, 3), + background = "pink", + color = "blue", + bold = TRUE, + italic = TRUE, + strikeout = FALSE, + align = "c" + ) |> + column_spec( + 1:2, + background = "yellow", + color = "red", + monospace = TRUE, + strikeout = TRUE, + width = "4cm", + border_left = TRUE + ) |> cat() +```