tt_grid() (#82)

Markdown uses Grid format for pandoc-compatible tables with column spans

R/build_tt.R

@@ -1,10 +1,12 @@
 # internal function
 # style_tt() stores style calls and we only want to evaluate them at the end because 
 # some rows may be added, which changes how the style is applied
-build_tt <- function(x) {
+build_tt <- function(x, output = NULL) {
   m <- meta(x)
 
+  output <- sanitize_output(output)
   out <- x
+  out <- meta(out, "output", output)
 
   # format data before drawing the table
   for (l in m$lazy_format) {
@@ -13,27 +15,47 @@ build_tt <- function(x) {
     l[["x"]] <- tmp
     out <- eval(l)
   }
+  # shouldn't have to add this everywhere, but I'm too lazy to check
+  out <- meta(out, "output", output)
 
   # draw the table
   lazy_tt <- meta(x, "lazy_tt")
   lazy_tt[["x"]] <- out
+  if (output == "html") {
+    lazy_tt[[1]] <- quote(tt_bootstrap)
+  } else if (output == "latex") {
+    lazy_tt[[1]] <- quote(tt_tabularray)
+  } else if (output == "markdown") {
+    lazy_tt[[1]] <- quote(tt_grid)
+  }
   out <- eval(lazy_tt)
+  out <- meta(out, "output", output)
 
   # group the table (before style)
   for (l in m$lazy_group) {
     l[["x"]] <- out
+    if (output == "html") {
+      l[[1]] <- quote(group_bootstrap)
+    } else if (output == "latex") {
+      l[[1]] <- quote(group_tabularray)
+    } else if (output == "markdown") {
+      l[[1]] <- quote(group_grid)
+    }
     out <- eval(l)
   }
+  out <- meta(out, "output", output)
 
   # style the table
   for (l in m$lazy_style) {
     l[["x"]] <- out
     out <- eval(l)
   }
+  out <- meta(out, "output", output)
 
   m <- meta(x)
   m$lazy_style <- list()
   attr(out, "tinytable_meta") <- m
+  out <- meta(out, "output", output)
 
   return(out)
 }

R/format_tt.R

@@ -1,7 +1,3 @@
-# output is selected automatically if format_tt is called in tt()
-# x is inserted automatically if format_tt is called in tt()
-
-
 #' Format columns of a data frame
 #'
 #' This function formats the columns of a data frame based on the column type (logical, date, numeric). 
@@ -37,7 +33,6 @@
 #'
 format_tt <- function(x,
                       j = NULL,
-                      output = NULL,
                       digits = getOption("digits"),
                       num_fmt = "significant",
                       num_zero = TRUE,
@@ -56,7 +51,6 @@ format_tt <- function(x,
   if (inherits(out, "tinytable")) {
     cal <- call("format_tt_lazy", 
                 j = j,
-                output = output,
                 digits = digits,
                 num_fmt = num_fmt,
                 num_zero = num_zero,
@@ -73,7 +67,6 @@ format_tt <- function(x,
 
     out <- format_tt_lazy(out,
                           j = j,
-                          output = output,
                           digits = digits,
                           num_fmt = num_fmt,
                           num_zero = num_zero,
@@ -91,7 +84,6 @@ format_tt <- function(x,
 
 format_tt_lazy <- function(x,
                            j = NULL,
-                           output = NULL ,
                            digits,
                            num_fmt = "significant",
                            num_zero = FALSE,
@@ -130,7 +122,6 @@ format_tt_lazy <- function(x,
   assert_function(identity)
   assert_string(sprintf, null.ok = TRUE)
 
-  output <- sanitize_output(output)
 
   # column index NULL or regex or integer vector
   if (is.null(j)) {

R/group_tt.R

@@ -3,11 +3,11 @@
 #' @export
 #' @inheritParams tt
 #' @inheritParams style_tt
+#' @return An object of class `tt` representing the table.
 #' @param indent integer number of `pt` to use when indenting the non-labelled rows.
 group_tt <- function(x, i = NULL, j = NULL, indent = 1) {
 
   if (is.null(meta(x))) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE)
-  if (!isTRUE(meta(x, "output") %in% c("html", "latex"))) return(x)
   if (is.null(i) && is.null(j)) stop("At least one of `i` or `j` must be specified.", call. = FALSE)
   assert_integerish(indent, lower = 0)
 
@@ -22,11 +22,8 @@ group_tt <- function(x, i = NULL, j = NULL, indent = 1) {
   # we don't need this as a list, and we use some sorting later
   i <- unlist(i)
 
-  if (meta(out)$output == "latex") {
-    cal <- call("group_tabularray", i = i, j = j, indent = indent)
-  } else if (meta(out)$output == "html") {
-    cal <- call("group_bootstrap", i = i, j = j, indent = indent)
-  }
+  # the actual function is subbed in build_tt for html and grid
+  cal <- call("group_tabularray", i = i, j = j, indent = indent)
 
   out <- meta(out, "lazy_group", c(meta(out)$lazy_group, list(cal)))
 

R/print.R

@@ -2,9 +2,12 @@
 #'
 #' @keywords internal
 #' @export
-knit_print.tinytable <- function(x, ...) {
+knit_print.tinytable <- function(x,
+                                 output = getOption("tinytable_print_output", default = NULL),
+                                 ...) {
+
   # lazy styles get evaluated here, at the very end
-  out <- build_tt(x)
+  out <- build_tt(x, output = output)
 
   if (meta(out)$output == "html") {
     # from htmltools:::html_preserve
@@ -23,9 +26,11 @@ knit_print.tinytable <- function(x, ...) {
 
 
 #' @export
-print.tinytable <- function(x, ...) {
+print.tinytable <- function(x,
+                            output = getOption("tinytable_print_output", default = NULL),
+                            ...){
   # lazy styles get evaluated here, at the very end
-  out <- build_tt(x)
+  out <- build_tt(x, output = output)
 
   if (meta(out, "output") == "latex") {
     class(out) <- "character"

R/save_tt.R

@@ -3,60 +3,79 @@
 #' This function saves an object of class tinytable to a specified file and format, with an option to overwrite existing files.
 #'
 #' @param x The tinytable object to be saved.
-#' @param filename A string representing the path to the file where the object should be saved. The supported file formats are: .html, .png, .md, .pdf, and .tex.
+#' @param output String or file path. 
+#' + If `output` is "markdown", "latex", or "html", the table is returned in a string as an `R` object. 
+#' + If `output` is a valid file path, the table is saved to file. The supported extensions are: .html, .png, .pdf, .tex and .md (with aliases .txt, .Rmd and .qmd).
 #' @param overwrite A logical value indicating whether to overwrite an existing file. 
-#' @return invisible(TRUE)
+#' @return A string or `TRUE` when the table is written to file.
 #' @export
 #' @examples
-#' \dontrun{
 #'
 #' library(tinytable)
-#' tab  <- tt(mtcars[1:4, 1:4])
-#' save_tt(tt, "path/to/file.txt")
+#' filename <- file.path(tempdir(), "table.tex")
+#' tt(mtcars[1:4, 1:4]) |> save_tt(filename)
 #'
-#' }
-#'
-save_tt <- function(x, filename, overwrite = FALSE) {
-m <- meta(x)
+save_tt <- function(x, output, overwrite = FALSE) {
+  m <- meta(x)
 
-assert_string(filename)
-assert_flag(overwrite)
-if (file.exists(filename) && !overwrite) {
-  stop("File already exists and overwrite is set to FALSE.", call. = FALSE)
-}
-if (is.null(m)) {
-  stop("`x` must be an object produced by the `tinytable::tt()` function.", call. = FALSE)
-}
+  assert_string(output)
+  assert_flag(overwrite)
+  if (file.exists(output) && !overwrite) {
+    stop("File already exists and overwrite is set to FALSE.", call. = FALSE)
+  }
+  if (is.null(m)) {
+    stop("`x` must be an object produced by the `tinytable::tt()` function.", call. = FALSE)
+  }
+
+  if (identical(output, "markdown")) {
+    out <- build_tt(x, output = "markdown")
+    return(as.character(out))
+  } else if (identical(output, "html")) {
+    out <- build_tt(x, output = "html")
+    return(as.character(out))
+  } else if (identical(output, "latex")) {
+    out <- build_tt(x, output = "latex")
+    return(as.character(out))
+  }
 
-file_ext <- tools::file_ext(filename)
+  file_ext <- tools::file_ext(output)
 
-sanity_file_extension(x, file_ext)
+  output_format <- switch(file_ext,
+                          "png" = "html",
+                          "html" = "html",
+                          "pdf" = "latex",
+                          "tex" = "latex",
+                          "md" = "markdown",
+                          "Rmd" = "markdown",
+                          "qmd" = "markdown",
+                          "txt" = "markdown",
+                          stop("The supported file extensions are: .png, .html, .pdf, .tex, and .md.", call. = FALSE))
 
-# evaluate styles at the very end of the pipeline, just before writing
-x <- build_tt(x)
+  # evaluate styles at the very end of the pipeline, just before writing
+  x <- build_tt(x, output = output_format)
 
-if (file_ext %in% c("html", "tex", "md", "Rmd", "qmd", "txt")) {
-  write(x, file = filename)
+  if (file_ext %in% c("html", "tex", "md", "Rmd", "qmd", "txt")) {
+    write(x, file = output)
 
-} else if (file_ext == "png") {
-  assert_dependency("webshot2")
-  d <- tempdir()
-  f <- file.path(d, "index.html")
-  write(x, file = f)
-  webshot2::webshot(
-    f,
-    file = filename,
-    selector = "body > div > table",
-    zoom = 4)
+  } else if (file_ext == "png") {
+    assert_dependency("webshot2")
+    d <- tempdir()
+    f <- file.path(d, "index.html")
+    write(x, file = f)
+    webshot2::webshot(
+                      f,
+                      file = output,
+                      selector = "body > div > table",
+                      zoom = 4)
 
-} else if (file_ext == "pdf") {
-  assert_dependency("tinytex")
-  # \documentclass{standalone} does not support \begin{table}
-  tmp <- strsplit(x, "\\n")[[1]]
-  tmp <- tmp[!grepl("\\begin{table}", tmp, fixed = TRUE)]
-  tmp <- tmp[!grepl("\\end{table}", tmp, fixed = TRUE)]
-  tmp <- paste(tmp, collapse = "\n")
-  tmp <- sprintf("
+  } else if (file_ext == "pdf") {
+    assert_dependency("tinytex")
+    # \documentclass{standalone} does not support \begin{table}
+    tmp <- strsplit(x, "\\n")[[1]]
+    tmp <- tmp[!grepl("\\begin{table}", tmp, fixed = TRUE)]
+    tmp <- tmp[!grepl("\\end{table}", tmp, fixed = TRUE)]
+    tmp <- paste(tmp, collapse = "\n")
+    tmp <- sprintf("
 \\documentclass{standalone}
 \\usepackage{tabularray}
 \\usepackage{float}
@@ -69,38 +88,12 @@ if (file_ext %in% c("html", "tex", "md", "Rmd", "qmd", "txt")) {
 \\begin{document}
 %s
 \\end{document}",
-  tmp)
-  d <- tempdir()
-  f <- file.path(d, "index.tex")
-  write(tmp, f)
-  tinytex::xelatex(f, pdf_file = filename)
+    tmp)
+    d <- tempdir()
+    f <- file.path(d, "index.tex")
+    write(tmp, f)
+    tinytex::xelatex(f, pdf_file = output)
 }
 
 return(invisible(TRUE))
-}
-
-
-sanity_file_extension <- function(x, file_ext) {
-  m <- meta(x)
-
-  # Define the expected output for each extension
-  expected_output <- switch(file_ext,
-  "png" = "html",
-  "html" = "html",
-  "pdf" = "latex",
-  "tex" = "latex",
-  "md" = "markdown",
-  "Rmd" = "markdown",
-  "qmd" = "markdown",
-  "txt" = "markdown",
-  stop("Unsupported file extension", call. = FALSE))
-
-  # Check if the actual output matches the expected output
-  if (!is.null(m) && !is.null(m$output) && m$output != expected_output) {
-    stop(paste("For", file_ext, "files, the `output` argument should be:", expected_output), call. = FALSE)
-  }
-
-  # If everything is fine, return a success message or perform other actions
-  return(paste("File extension and output format are compatible."))
-}
-
+                       }

R/style_tt.R

@@ -31,7 +31,7 @@
 #' @param tabularray_inner A string that specifies the "inner" settings of a tabularray LaTeX table. 
 #' @param tabularray_outer A string that specifies the "outer" settings of a tabularray LaTeX table.
 #' @param ... extra arguments are ignored
-#' @return Returns a modified `tinytable` object with the applied styles.
+#' @return An object of class `tt` representing the table.
 #' @template latex_preamble
 #' @export
 #' @examples