Support tabularray

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: kableExtra
 Type: Package
 Title: Construct Complex Table with 'kable' and Pipe Syntax
-Version: 1.3.9.9001
+Version: 1.3.9.9003
 Authors@R: c(
     person('Hao', 'Zhu', email = 'haozhu233@gmail.com', role = c('aut', 'cre'),
     comment = c(ORCID = '0000-0002-3386-6076')),

R/add_header_above.R

@@ -103,19 +103,55 @@ add_header_above <- function(kable_input, header = NULL,
   else {
     header <- standardize_header_input(header)
   }
-  if (kable_format == "html") {
-    return(htmlTable_add_header_above(
+
+  table_info <- magic_mirror(kable_input)
+
+  if (isTRUE(table_info$tabular %in% c("tblr", "longtblr", "talltblr"))) {
+    out <- add_header_above_tabularray(
+      kable_input = kable_input,
+      header = header,
+      bold = bold,
+      italic = italic,
+      monospace = monospace,
+      underline = underline,
+      strikeout = strikeout,
+      align = align,
+      color = color,
+      background = background,
+      font_size = font_size,
+      angle = angle,
+      escape = escape,
+      line = line,
+      line_sep = line_sep,
+      border_left = border_left,
+      border_right = border_right
+    )
+
+  } else if (kable_format == "html") {
+    out <- htmlTable_add_header_above(
       kable_input, header, bold, italic, monospace, underline, strikeout,
       align, color, background, font_size, angle, escape, line, line_sep,
       extra_css, include_empty
-    ))
-  }
-  if (kable_format == "latex") {
-    return(pdfTable_add_header_above(
+    )
+
+  } else if (kable_format == "latex") {
+    out <- pdfTable_add_header_above(
       kable_input, header, bold, italic, monospace, underline, strikeout,
       align, color, background, font_size, angle, escape, line, line_sep,
-      border_left, border_right))
+      border_left, border_right
+    )
   }
+
+  # store header information in the kable_meta attribute may be useful for other
+  # packages and programmers who want to interact with kableExtra objects.
+  if (is.null(table_info[["add_header_above"]])) {
+    table_info[["add_header_above"]] <- list(header)
+  } else {
+    table_info[["add_header_above"]] <- c(table_info[["add_header_above"]], list(header))
+  }
+
+  attr(out, "kable_meta") <- table_info
+  return(out)
 }
 
 # HTML
@@ -182,7 +218,16 @@ standardize_header_input <- function(header) {
   header_names <- names(header)
   header <- as.numeric(header)
   names(header) <- header_names
-  return(data.frame(header = names(header), colspan = header, row.names = NULL, stringsAsFactors = F))
+  end <- cumsum(header)
+  start <- end - header + 1
+  out <- data.frame(
+    header = names(header),
+    colspan = header,
+    start = start,
+    end = end,
+    row.names = NULL,
+    stringsAsFactors = F)
+  return(out)
 }
 
 htmlTable_new_header_generator <- function(header_df, bold, italic, monospace,
@@ -290,7 +335,8 @@ pdfTable_add_header_above <- function(kable_input, header, bold, italic,
   table_info <- magic_mirror(kable_input)
 
   if (is.data.frame(header)){
-    if(ncol(header) == 2 & is.character(header[[1]]) & is.numeric(header[[2]])){
+    # internally header can have 4 columns: header, colspan, start, end
+    if(ncol(header) %in% c(2, 4) & is.character(header[[1]]) & is.numeric(header[[2]])){
       header <- data.frame(header = header[[1]], colspan = header[[2]],
                            stringsAsFactors = FALSE)
     }

R/cell_spec.R

@@ -57,7 +57,6 @@ cell_spec <- function(x, format,
                       escape = TRUE,
                       background_as_tile = TRUE,
                       latex_background_in_cell = TRUE) {
-
   if (missing(format) || is.null(format)) {
     if (knitr::is_latex_output()) {
       format <- "latex"
@@ -66,15 +65,32 @@ cell_spec <- function(x, format,
     }
   }
   if (tolower(format) == "html") {
-    return(cell_spec_html(x, bold, italic, monospace, underline, strikeout,
-                          color, background, align, font_size, angle,
-                          tooltip, popover, link, new_tab, extra_css,
-                          escape, background_as_tile))
-  }
-  if (tolower(format) == "latex") {
-    return(cell_spec_latex(x, bold, italic, monospace, underline, strikeout,
-                           color, background, align, font_size, angle, escape,
-                           latex_background_in_cell))
+    return(cell_spec_html(
+      x, bold, italic, monospace, underline, strikeout,
+      color, background, align, font_size, angle,
+      tooltip, popover, link, new_tab, extra_css,
+      escape, background_as_tile))
+  } else if (tolower(format) == "latex") {
+    return(cell_spec_latex(
+      x, bold, italic, monospace, underline, strikeout,
+      color, background, align, font_size, angle, escape,
+      latex_background_in_cell))
+  } else if (tolower(format) %in% c("tblr", "talltblr", "longtblr")) {
+    return(cell_spec_tabularray(
+      x,
+      bold = bold,
+      italic = italic,
+      monospace = monospace,
+      underline = underline,
+      strikeout = strikeout,
+      color = color,
+      background = background,
+      align = align,
+      font_size = font_size,
+      angle = angle,
+      escape = escape,
+      latex_background_in_cell = latex_background_in_cell
+    ))
   }
 }
 

R/column_spec.R

@@ -340,7 +340,28 @@ 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,
+      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 +382,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)) {

R/kable_styling.R

@@ -115,7 +115,7 @@ kable_styling <- function(kable_input,
   if (length(bootstrap_options) == 1 && bootstrap_options == "basic") {
     bootstrap_options <- getOption("kable_styling_bootstrap_options", "basic")
   }
-  if (length(latex_options) == 1 && latex_options == "basic") {
+  if (is.character(latex_options) && length(latex_options) == 1 && latex_options == "basic") {
     latex_options <- getOption("kable_styling_latex_options", "basic")
   }
   if (position == "center") {
@@ -335,6 +335,23 @@ pdfTable_styling <- function(kable_input,
                              table.envir,
                              wraptable_width) {
 
+
+  # `latex_options`` can only be a list when using tabularray
+  table_info <- magic_mirror(kable_input)
+  tabularray_inner <- tabularray_outer <- NULL
+  if (!is.character(latex_options)) {
+    if (!table_info$tabular %in% c("tblr", "talltblr", "longtblr")) {
+      stop('`latex_options` can only be a character vector, unless `tabular` is one of "tblr", "talltbr", or "longtblr".', call. = FALSE)
+    }
+    if (is.list(latex_options)) {
+      tabularray_inner <- latex_options[["tabularray_inner"]]
+      tabularray_outer <- latex_options[["tabularray_outer"]]
+    }
+  }
+  if ("tabularray_inner" %in% names(latex_options)) latex_options[["tabularray_inner"]] <- NULL
+  if ("tabularray_outer" %in% names(latex_options)) latex_options[["tabularray_outer"]] <- NULL
+  latex_options <- unlist(latex_options)
+
   latex_options <- match.arg(
     latex_options,
     c("basic", "striped", "hold_position", "HOLD_position", "scale_down", "scale_up", "repeat_header"),
@@ -346,6 +363,10 @@ pdfTable_styling <- function(kable_input,
 
   table_info <- magic_mirror(kable_input)
 
+  out <- styling_tabularray(
+    out, tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer
+  )
+
   if ("striped" %in% latex_options) {
     out <- styling_latex_striped(out, table_info, stripe_color, stripe_index)
     table_info <- magic_mirror(out)
@@ -376,9 +397,15 @@ pdfTable_styling <- function(kable_input,
   }
 
   if (full_width) {
-    latex_table_env <- ifelse(table_info$tabular == "longtable",
-                              "longtabu", "tabu")
-    full_width_return <- styling_latex_full_width(out, table_info)
+    if (table_info$tabular %in% c("tblr", "talltblr", "longtblr")) {
+      # styling_latex_full_width_tabularray() changes
+      # table_info$tabularray$colspec: Q[] -> X[]
+      full_width_return <- styling_latex_full_width(out, table_info)
+      table_info <- magic_mirror(full_width_return[[1]])
+    } else if (!table_info$tabular %in% "longtable") {
+      latex_table_env <- "tabu"
+      full_width_return <- styling_latex_full_width(out, table_info)
+    }
     out <- full_width_return[[1]]
     table_info$align_vector <- full_width_return[[2]]
   }
@@ -543,6 +570,12 @@ styling_latex_repeat_header <- function(x, table_info, repeat_header_text,
 }
 
 styling_latex_full_width <- function(x, table_info) {
+
+  if (table_info$tabular %in% c("tblr", "talltblr", "longtblr")) {
+    out <- styling_latex_full_width_tabularray(x, table_info)
+    return(out)
+  }
+
   col_align <- as.character(factor(
     table_info$align_vector, c("c", "l", "r"),
     c(">{\\\\centering}X", ">{\\\\raggedright}X", ">{\\\\raggedleft}X")

R/kbl.R

@@ -26,7 +26,7 @@
 #' @param longtable T/F for whether to use the longtable format. If you have a
 #' table that will span over two or more pages, you will have to turn this on.
 #' @param tabular The "inner environment" to use for the
-#' table, e.g. "tabularx".
+#' table, e.g. "tblr", "tabularx".
 #' @param valign You probably won't need to adjust this latex option very often.
 #' If you are familiar with latex tables, this is the optional position for the
 #' tabular environment controlling the vertical position of the table relative
@@ -72,20 +72,41 @@ kbl <- function(x, format, digits = getOption("digits"),
                 toprule = getOption('knitr.table.toprule', if (booktabs) '\\toprule' else '\\hline'),
                 bottomrule = getOption('knitr.table.bottomrule', if (booktabs) '\\bottomrule' else '\\hline'),
                 midrule = getOption('knitr.table.midrule', if (booktabs) '\\midrule' else '\\hline'),
-                linesep = if (booktabs) c('', '', '', '', '\\addlinespace') else '\\hline',
+                linesep = if (booktabs || tabular %in% c("tblr", "talltblr", "longtblr")) c('', '', '', '', '\\addlinespace') else '\\hline',
                 caption.short = '',
                 table.envir = if (!is.null(caption)) 'table', ...) {
+
   if (!missing(align) && length(align) == 1L && !grepl('[^lcr]', align)) {
     align <- strsplit(align, '')[[1]]
   }
+
   if (missing(format) || is.null(format)) {
     if (knitr::is_latex_output())
       format <- "latex"
     else
       format <- "html"
   }
+
+  # these arguments are used in init_tabularray() and need to be hardcoded in knir::kable
+  if (format == "latex" && isTRUE(tabular %in% c("talltblr", "longtblr"))) {
+    caption_internal <- NULL
+    longtable_internal <- FALSE
+    table.envir_internal <- NULL
+  } else {
+    caption_internal <- caption
+    longtable_internal <- longtable
+    table.envir_internal <- table.envir
+    vline_internal <- vline
+  }
+  # vline_internal="|" is safer because we know where to split column alignments
+  if (format == "latex" && isTRUE(tabular %in% c("tblr", "talltblr", "longtblr"))) {
+    vline_internal <- "|"
+  }
+
   if (format == "latex") {
+
     use_latex_packages()
+
     if (utils::packageVersion("knitr") < "1.40" &&
         !missing(tabular)) {
       warning("'tabular' is not not supported in knitr versions < 1.40")
@@ -95,20 +116,20 @@ kbl <- function(x, format, digits = getOption("digits"),
     out <- knitr::kable(
       x = x, format = format, digits = digits,
       row.names = row.names, col.names = col.names, align = align,
-      caption = caption, label = label, format.args = format.args,
+      caption = caption_internal, label = label, format.args = format.args,
       escape = escape,
-      booktabs = booktabs, longtable = longtable,
+      booktabs = booktabs, longtable = longtable_internal,
       tabular = tabular,
       valign = valign, position = position, centering = centering,
-      vline = vline, toprule = toprule, bottomrule = bottomrule,
+      vline = vline_internal, toprule = toprule, bottomrule = bottomrule,
       midrule = midrule, linesep = linesep, caption.short = caption.short,
-      table.envir = table.envir, ...
+      table.envir = table.envir_internal, ...
     )
   } else if (format == "html") {
     out <- knitr::kable(
       x = x, format = format, digits = digits,
       row.names = row.names, col.names = col.names, align = align,
-      caption = caption, label = label, format.args = format.args,
+      caption = caption_internal, label = label, format.args = format.args,
       escape = escape,
       table.attr = table.attr, ...
     )
@@ -117,8 +138,38 @@ kbl <- function(x, format, digits = getOption("digits"),
     out <- knitr::kable(
       x = x, format = format, digits = digits,
       row.names = row.names, col.names = col.names, align = align,
-      caption = caption, label = label, format.args = format.args,
+      caption = caption_internal, label = label, format.args = format.args,
       escape = escape, ...
     )
+
+  # tabularray
+  if (format == "latex" && isTRUE(tabular %in% c("tblr", "talltblr", "longtblr"))) {
+    out <- init_tabularray(
+      kable_input = out,
+      format = format,
+      digits = digits,
+      row.names = row.names,
+      col.names = col.names,
+      align = align,
+      caption = caption,
+      label = label,
+      format.args = format.args,
+      escape = escape,
+      table.attr = table.attr,
+      booktabs = booktabs,
+      longtable = longtable,
+      tabular = tabular,
+      valign = valign,
+      position = position,
+      centering = centering,
+      vline = vline,
+      toprule = toprule,
+      bottomrule = bottomrule,
+      midrule = midrule,
+      linesep = linesep,
+      caption.short = caption.short,
+      table.envir = table.envir)
+  }
+
   out
 }