custom plot example + fixups

R/plot_tt.R

@@ -13,7 +13,7 @@
 #' @param data Optional, a list of data frames to be used with a custom plotting function.
 #' @param string Name of color to use for inline plots (passed to the `col` argument base `graphics` plots in `R`).
 #' @param xlim Numeric vector of length 2.
-#' @param fun Optional, a list of functions to generate plots from the data in `plot_data`. Valid functions include:
+#' @param fun  A function to generate plots from the data in `data`. Valid functions include:
 #' - Functions that return `ggplot2` objects.
 #' - Functions that return another function which generates a base `R` plot, ex: `function(x) {function() hist(x)}`
 #' - See the tutorial on the `tinytable` website for more information.
@@ -69,7 +69,7 @@ plot_tt <- function(x,
   if (is.character(fun)) {
     assert_choice(fun, c("histogram", "density", "bar"))
   } else {
-    assert_list(data, len = len, null.ok = TRUE)
+    assert_function(fun, null.ok = TRUE)
   }
 
   # built-in plots
@@ -85,6 +85,8 @@ plot_tt <- function(x,
     }
     xlim <- c(0, max(unlist(data)))
     fun <- rep(list(tiny_bar), length(data))
+  } else {
+    fun <- rep(list(fun), length(data))
   }
 
   # needed when rendering in tempdir()
@@ -153,6 +155,7 @@ plot_tt_lazy <- function(x,
       if (inherits(p, "ggplot")) {
         assert_dependency("ggplot2")
         suppressMessages(ggplot2::ggsave(
+          p,
           filename = fn_full,
           width = 1, height = asp,
           units = "in"
@@ -208,7 +211,7 @@ tiny_histogram <- function(d, color = "black", ...) {
 
 tiny_density <- function(d, color = "black", ...) {
   function() {
-    d <- stats::density(d)
+    d <- stats::density(stats::na.omit(d))
     graphics::plot(d, axes = FALSE, ann = FALSE, col = color)
     graphics::polygon(d, col = color)
   }

man/figures/gallery/gallery.sh

@@ -8,7 +8,7 @@ output_gif="tinytable_gallery.gif"
 # -resize option is used to fit images within a 1280x720 frame (16:9 aspect ratio)
 # convert -delay 250 -loop 0 tinytable_gallery_*.png -resize 1250x690 -gravity center -extent 1280x720 "$output_gif"
 # convert -delay 250 -loop 0 tinytable_gallery_*.png -resize 1000x500 -gravity center -extent 1025x576 "$output_gif"
-convert -delay 250 -loop 0 tinytable_gallery_*.png -resize 1000x500 -gravity center -extent 1025x576 -layers Optimize -colors 128 "$output_gif"
+convert -delay 200 -loop 0 tinytable_gallery_*.png -resize 1000x500 -gravity center -extent 1025x576 -layers Optimize -colors 128 "$output_gif"
 
 # Display a message when done
 echo "Animated GIF created: $output_gif"

vignettes/tutorial.qmd

@@ -641,35 +641,77 @@ f <- function(d, ...) {
   function() hist(d, axes = FALSE, ann = FALSE, col = "lightblue")
 }
 
-plot_fun <- rep(list(f), 3)
 plot_data <- list(mtcars$mpg, mtcars$hp, mtcars$qsec)
 
 dat <- data.frame(Variables = c("mpg", "hp", "qsec"), Histogram = "")
 
 tt(dat) |>
-  plot_tt(j = 2, fun = plot_fun, data = plot_data)
+  plot_tt(j = 2, fun = f, data = plot_data)
 ```
 
 
 ### Custom plots: `ggplot2`
 
 ```{r}
+library(ggplot2)
+
 f <- function(d, color = "black", ...) {
   d <- data.frame(x = d)
-  ggplot2::ggplot(d, ggplot2::aes(x = x)) + 
-    ggplot2::geom_histogram(bins = 30, color = color) +
-    ggplot2::scale_x_continuous(expand=c(0,0)) +
-    ggplot2::scale_y_continuous(expand=c(0,0)) +
-    ggplot2::theme_void()
+  ggplot(d, aes(x = x)) + 
+    geom_histogram(bins = 30, color = color, fill = color) +
+    scale_x_continuous(expand=c(0,0)) +
+    scale_y_continuous(expand=c(0,0)) +
+    theme_void()
 }
 
-plot_fun <- rep(list(f), 3)
 plot_data <- list(mtcars$mpg, mtcars$hp, mtcars$qsec)
 
 tt(dat) |>
-  plot_tt(j = 2, fun = plot_fun, data = plot_data, color = "pink")
+  plot_tt(j = 2, fun = f, data = plot_data, color = "pink")
 ```
 
+We can insert arbitrarily complex plots by customizing the `ggplot2` call:
+
+```{r}
+#| message: false
+#| warning: false
+library(palmerpenguins)
+
+# split data by species
+dat <- split(penguins, penguins$species)
+body <- lapply(dat, \(x) x$body_mass_g)
+flip <- lapply(dat, \(x) x$flipper_length_mm)
+
+# create nearly empty table
+tab <- data.frame(
+  "Species" = names(dat),
+  "Body Mass" = "",
+  "Flipper Length" = "",
+  "Body vs. Flipper" = "",
+  check.names = FALSE
+)
+
+# custom ggplot2 function to create inline plot
+f <- function(d, ...) {
+  ggplot(d, aes(x = flipper_length_mm, y = body_mass_g, color = sex)) +
+    geom_point(size = .2) +
+    scale_x_continuous(expand=c(0,0)) +
+    scale_y_continuous(expand=c(0,0)) +
+    scale_color_manual(values = c("#E69F00", "#56B4E9")) +
+    theme_void() +
+    theme(legend.position = "none")
+}
+
+# `tinytable` calls
+tt(tab) |>
+  plot_tt(j = 2, fun = "histogram", data = body, height = 2) |>
+  plot_tt(j = 3, fun = "density", data = flip, height = 2) |>
+  plot_tt(j = 4, fun = f, data = dat, height = 2) |>
+  style_tt(j = 2:4, align = "c")
+```
+
+
+
 
 # Groups and labels