deprecate output argument in tt()

vincentarelbundock · Jan 19, 2024 · 2a9c920 · 2a9c920
1 parent 1e37b78
commit 2a9c920
Show file tree

Hide file tree

Showing 16 changed files with 174 additions and 148 deletions.
diff --git a/R/build_tt.R b/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)
 }
diff --git a/R/format_tt.R b/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)) {

diff --git a/R/group_tt.R b/R/group_tt.R
@@ -7,7 +7,6 @@
 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", "markdown"))) 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,13 +21,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)
-  } else if (meta(out)$output == "markdown") {
-    cal <- call("group_grid", i = i, j = j)
-  }
+  # 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)))
 

diff --git a/R/print.R b/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"

diff --git a/R/save_tt.R b/R/save_tt.R
@@ -3,7 +3,7 @@
 #' 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 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 overwrite A logical value indicating whether to overwrite an existing file. 
 #' @return invisible(TRUE)
 #' @export
@@ -16,47 +16,67 @@
 #'
 #' }
 #'
-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)
+  }
 
-file_ext <- tools::file_ext(filename)
+  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(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 +89,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."))
-}
-
+                       }
diff --git a/R/tt.R b/R/tt.R
@@ -1,13 +1,15 @@
 #' Draw a Tiny Table
 #'
-#' The `tt` function renders a table in different formats (HTML, Markdown, or LaTeX) with various styling options. The table can be customize with additional functions:
+#' @description
+#' The `tt` function renders a table in different formats (HTML, Markdown, or LaTeX) with various styling options. The table can be customized with additional functions:
 #'
 #' * `style_tt()` to style fonts, colors, alignment, etc.
 #' * `format_tt()` to format numbers, dates, strings, etc.
-#' * `save_tt()` to save the table to a file.
+#' * `save_tt()` to save the table to a file or return the table as a string.
+#'
+#' `tinytable` attempts to determine the appropriate way to print the table based on interactive use, RStudio availability, and output format in RMarkdown or Quarto documents. Users can call `print(x, output="markdown")` to print the table in a specific format. Alternatively, they can set a global option: `options("tinytable_print_output"="markdown")`
 #'
 #' @param x A data frame or data table to be rendered as a table.
-#' @param output The format of the output table. Can be "html", "latex", or "markdown". If NULL, the format is automatically detected in Quarto or Rmarkdown documents.
 #' @param digits Number of significant digits to keep for numeric variables. When `digits` is an integer, `tt()` calls `format_tt(x, digits = digits)` before proceeding to draw the table. Users who need more control can proceed in two steps: (1) format the data with `format_tt()` or other functions, and (2) pass the formatted data to `tt()` for drawing. See `?format_tt` for more details on formating options (ex: decimal, scientific notation, dates, boolean variables, etc.).
 #' @param caption A string that will be used as the caption of the table.
 #' @param width A numeric value between 0 and 1 indicating the proportion of the line width that the table should cover.
@@ -34,16 +36,16 @@
 #' 
 #' @export
 tt <- function(x,
-               output = NULL,
                digits = NULL,
                caption = NULL,
                width = NULL,
                notes = NULL,
                theme = "default",
-               placement = getOption("tt_tabularray_placement", default = NULL)) {
+               placement = getOption("tinytable_tabularray_placement", default = NULL)) {
+
+  output <- meta(x, "output")
 
   # sanity checks
-  output <- sanitize_output(output)
   assert_data_frame(x)
   assert_string(caption, null.ok = TRUE)
   assert_numeric(width, len = 1, lower = 0, upper = 1, null.ok = TRUE)
@@ -70,15 +72,18 @@ tt <- function(x,
   class(out) <- c("tinytable", class(out))
 
   # build table
-  if (output == "latex") {
-    cal <- call("tt_tabularray", x = out, caption = caption, theme = theme, width = width, notes = notes, placement = placement)
-
-  } else if (output == "html"){
-    cal <- call("tt_bootstrap", x = out, caption = caption, theme = theme, width = width, notes = notes)
-
-  } else {
-    cal <- call("tt_grid", x = out, caption = caption)
-  }
+  cal <- call("tt_tabularray", x = out, caption = caption, theme = theme, width = width, notes = notes, placement = placement)
+  # if (output == "latex") {
+  #
+  # } else if (output == "html"){
+  #   cal <- call("tt_bootstrap", x = out, caption = caption, theme = theme, width = width, notes = notes)
+  #
+  # } else if (output == "markdown") {
+  #   cal <- call("tt_grid", x = out, caption = caption)
+  #
+  # } else {
+  #   stop("here be dragons")
+  # }
 
   out <- meta(out, "lazy_tt", cal)
 

diff --git a/R/tt_bootstrap.R b/R/tt_bootstrap.R
@@ -1,4 +1,4 @@
-tt_bootstrap <- function(x, caption, theme, width, notes) {
+tt_bootstrap <- function(x, caption, theme, width, notes, ...) {
 
   template <- template_bootstrap(theme)
   m <- meta(x)