plot_tt initial

R/build_tt.R

@@ -1,6 +1,8 @@
 # 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
+#
+# THE ORDER MATTERS A LOT!
 build_tt <- function(x, output = NULL) {
   m <- meta(x)
 
@@ -16,6 +18,14 @@ build_tt <- function(x, output = NULL) {
     out <- eval(l)
   }
 
+  # plots and images
+  for (l in m$lazy_plot) {
+    tmp <- out
+    class(tmp) <- "data.frame"
+    l[["x"]] <- tmp
+    out <- eval(l)
+  }
+
   # markdown styles need to be applied before creating the table, otherwise there's annoying parsing, etc.
   if (output == "markdown") {
     for (l in m$lazy_style) {

R/plot_tt.R

@@ -0,0 +1,78 @@
+plot_tt <- function(x,
+                    i = NULL,
+                    j = NULL,
+                    path = NULL,
+                    height = 2,
+                    ...) {
+  assert_integerish(i, null.ok = TRUE)
+  assert_integerish(j, null.ok = TRUE)
+  assert_integerish(height, len = 1)
+  assert_class(x, "tinytable")
+  out <- x
+
+  ival <- if (is.null(i)) seq_len(meta(x, "nrows")) else i
+  jval <- if (is.null(j)) seq_len(meta(x, "ncols")) else j
+
+  len <- length(ival) * length(jval)
+  assert_character(path, len = len)
+  if (length(path) != len) {
+    msg <- sprintf("`path` must match the dimensions of `i` and `j`: length %s.", len) 
+    stop(msg, call. = FALSE)
+  }
+
+  # needed when rendering in tempdir()
+  out <- meta(out, "path_plot", path)
+
+  cal <- call("plot_tt_lazy", 
+    i = ival,
+    j = jval,
+    path = path,
+    height = height)
+
+  out <- meta(out, "lazy_plot", c(meta(out)$lazy_plot, list(cal)))
+
+  return(out)
+}
+
+
+plot_tt_lazy <- function(x,
+                         i = NULL,
+                         j = NULL,
+                         path = NULL,
+                         height = 2,
+                         ...) {
+
+  out <- x
+
+  build_dir <- meta(out, "path_dir_build")
+  if (!is.null(build_dir)) {
+    tmp <- file.copy(
+      from = path, 
+      to = build_dir,
+      overwrite = TRUE)
+    path <- sapply(path, basename)
+  }
+
+  if (meta(x)$output == "latex") {
+    cell <- "\\includegraphics[height=%sem]{%s}"
+    cell <- sprintf(cell, height, path)
+
+  } else if (meta(x)$output == "html") {
+    cell <- '<img src="%s" style="height: %sem;">'
+    cell <- sprintf(cell, path, height)
+
+  } else if (meta(x)$output == "markdown") {
+    cell <- '![](%s)'
+    cell <- sprintf(cell, path)
+
+  } else {
+    stop("here be dragons")
+  }
+
+  out[i, j] <- cell
+
+  return(out)
+}
+
+
+

R/sanity.R

@@ -22,6 +22,7 @@ sanitize_output <- function(output) {
       usepackage_latex("float")
       usepackage_latex("tabularray", extra_lines = c(
         "\\usepackage[normalem]{ulem}",
+        "\\usepackage{graphicx}",
         "\\UseTblrLibrary{booktabs}",
         "\\NewTableCommand{\\tinytableDefineColor}[3]{\\definecolor{#1}{#2}{#3}}",
         "\\newcommand{\\tinytableTabularrayUnderline}[1]{\\underline{#1}}",
@@ -203,3 +204,10 @@ check_atomic_vector<- function(x, null.ok = FALSE, name = as.character(substitut
   return(out)
 }
 
+
+assert_class <- function(x, classname) {
+  if (!inherits(x, classname)) {
+    msg <- sprintf("`x` must be of class `%s`.", classname)
+    stop(msg, call. = FALSE)
+  }
+}

R/save_tt.R

@@ -39,6 +39,9 @@ save_tt <- function(x, output, overwrite = FALSE) {
     return(as.character(out))
   }
 
+  d <- ttempdir()
+  x <- meta(x, "path_dir_output", dirname(output))
+  x <- meta(x, "path_dir_build", d)
 
   file_ext <- tools::file_ext(output)
 
@@ -62,14 +65,15 @@ save_tt <- function(x, output, overwrite = FALSE) {
 
   } else if (file_ext == "png") {
     assert_dependency("webshot2")
-    d <- tempdir()
-    f <- file.path(d, "index.html")
+    # this doesn't work in tempdir() for some reason.
+    # probably webshot2's fault.
+    f <- file.path(dirname(output), paste0(get_id(), ".html"))
     write(x, file = f)
-    webshot2::webshot(
-                      f,
+    webshot2::webshot(f,
                       file = output,
                       selector = "body > div > table",
                       zoom = 4)
+    unlink(f)
 
   } else if (file_ext == "pdf") {
     assert_dependency("tinytex")
@@ -81,6 +85,7 @@ save_tt <- function(x, output, overwrite = FALSE) {
     tmp <- sprintf("
 \\documentclass{standalone}
 \\usepackage{tabularray}
+\\usepackage{graphicx}
 \\usepackage{float}
 \\usepackage{codehigh}
 \\usepackage[normalem]{ulem}
@@ -92,15 +97,17 @@ save_tt <- function(x, output, overwrite = FALSE) {
 %s
 \\end{document}",
                          tmp)
-    d <- tempdir()
     f <- file.path(d, "index.tex")
-    write(tmp, f)
+    write(tmp, f) 
+    # tinytex is fiddly with file paths, so we need to hack 
+    # it by changing the working directory
+    wd <- getwd()
+    setwd(d)
     tinytex::xelatex(f, pdf_file = output)
+    setwd(wd)
 
     } else if (file_ext == "docx") {
       assert_dependency("pandoc")
-      # fn <- file.path(tempdir(), "temp.md")
-      # write(x, file = fn)
       pandoc::pandoc_convert(text = x, to = "docx", output = output)
     }
 

R/tt.R

@@ -61,6 +61,7 @@ tt <- function(x,
   out <- x 
   out <- meta(out, "x_character", data.frame(lapply(x, as.character)))
   out <- meta(out, "output", output)
+  out <- meta(out, "output_dir", getwd())
   out <- meta(out, "colnames", names(x))
   out <- meta(out, "xdim", dim(x))
   out <- meta(out, "output", output)

R/utils.R

@@ -29,3 +29,11 @@ meta <- function(x, get, set) {
 }
 
 
+ttempdir <- function() {
+  d <- tempdir()
+  d <- file.path(d, "tinytable")
+  # start fresh
+  if (dir.exists(d)) unlink(d, recursive = TRUE)
+  dir.create(d)
+  return(d)
+}

man-roxygen/latex_preamble.R

@@ -7,6 +7,7 @@
 #' ```latex
 #' \usepackage{tabularray}
 #' \usepackage{float}
+#' \usepackage{graphicx}
 #' \usepackage{codehigh}
 #' \usepackage[normalem]{ulem}
 #' \UseTblrLibrary{booktabs}

vignettes/tutorial.qmd

@@ -125,7 +125,7 @@ dat <- data.frame(
   b = c("b", "bb", "bbb"),
   c = c("c", "cc", "ccc"))
 
-tt(dat) |> style_tt(align = "c")
+tt(dat) |> style_tt(j = 1:3, align = "c")
 
 tt(dat) |> style_tt(j = 1:3, align = "lcr")
 ```
@@ -739,6 +739,7 @@ In Rmarkdown and Quarto documents, `tinytable` will automatically populate your
 \usepackage{tabularray}
 \usepackage{float}
 \usepackage{codehigh}
+\usepackage{graphicx}
 \usepackage[normalem]{ulem}
 \UseTblrLibrary{booktabs}
 \NewTableCommand{\tinytableDefineColor}[3]{\definecolor{#1}{#2}{#3}}