notes arguments accepts lists with i,j arguments to add markers in …

…cells to refer to specific footnotes

R/build_tt.R

@@ -18,6 +18,9 @@ build_tt <- function(x, output = NULL) {
     out <- eval(l)
   }
 
+  # add footnote markers just after formatting, otherwise appending converts to string
+  out <- footnote_markers(out)
+
   # plots and images
   for (l in m$lazy_plot) {
     tmp <- out

R/footnotes.R

@@ -0,0 +1,23 @@
+footnote_markers <- function(x) {
+    notes <- meta(x, "notes")
+    for (idx in seq_along(notes)) {
+        n <- notes[[idx]]
+        sup <- names(notes)[idx]
+        if (is.list(n)) {
+            if (meta(x)$output == "latex") {
+                x[n$i, n$j] <- paste0(x[n$i, n$j], "\\textsuperscript{", sup, "}")
+                if (0 %in% n$i) colnames(x)[n$j] <- paste0(colnames(x)[n$j], "\\textsuperscript{", sup, "}")
+            } else if (meta(x)$output == "html") {
+                x[n$i, n$j] <- paste0(x[n$i, n$j], "<sup>", sup, "</sup>")
+                if (0 %in% n$i) colnames(x)[n$j] <- paste0(colnames(x)[n$j], "<sup>", sup, "</sup>")
+            } else if (meta(x)$output == "typst") {
+                x[n$i, n$j] <- paste0(x[n$i, n$j], "#super[", sup, "]")
+                if (0 %in% n$i) colnames(x)[n$j] <- paste0(colnames(x)[n$j], "#super[", sup, "]")
+            } else {
+                x[n$i, n$j] <- paste0(x[n$i, n$j], "^", sup, "^")
+                if (0 %in% n$i) colnames(x)[n$j] <- paste0(colnames(x)[n$j], "^", sup, "^")
+            }
+        }
+    }
+    return(x)
+}

R/sanity.R

@@ -228,3 +228,28 @@ assert_class <- function(x, classname) {
     stop(msg, call. = FALSE)
   }
 }
+
+
+sanity_notes <- function(notes) {
+  if (is.character(notes) && length(notes) > 0) {
+    notes <- as.list(notes)
+  }
+  assert_list(notes, null.ok = TRUE)
+  for (idx in seq_along(notes)) {
+    n <- notes[[idx]]
+    bad <- FALSE
+    if (is.list(n)) {
+      if (is.null(names(notes)[idx])) {
+        bad <- TRUE
+      }
+      if (!all(c("i", "j", "text") %in% names(n))) {
+        bad <- TRUE
+      }
+    } else if (!is.character(n) || length(n) != 1) {
+      bad <- TRUE
+    }
+    if (isTRUE(bad)) {
+      stop("`notes` includes invalid elements. Please refer to the documentation for details.", call. = FALSE)
+    }
+  }
+}

R/tt.R

@@ -14,8 +14,15 @@
 #' @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.
 #' @param theme The theme to apply to the table: "default", "striped", "bootstrap", "void", or "grid".
-#' @param notes A single string or a (named) list of strings to append at the bottom of the table.
-#' 
+#' @param notes Notes to append to the bottom of the table. This argument accepts several different inputs:
+#' * Single string insert a single note: 
+#'    - `notes = "blah blah"`
+#' * Multiple strings insert multiple notes sequentially: 
+#'    - `notes = list("Hello world", "Foo bar")`
+#' * A named list inserts a list with the name as superscript: 
+#'    - `notes = list("a" = list("Hello World"))`
+#' * A named list with positions inserts markers as superscripts inside table cells:
+#'    - `notes = list("a" = list(i = 0:1, j = 2, text = "Hello World"))`
 #' @param placement A string to control the position of tables in LaTeX. Will be inserted in square brackets like: `\\begin{table}[H]`
 #' @return An object of class `tt` representing the table.
 #' @template latex_preamble
@@ -30,7 +37,11 @@
 #'    theme = "striped",
 #'    width = 0.5,
 #'    caption = "Data about cars.")
+#' 
+#' tt(x, notes = "Hello World!")
 #'
+#' tt(x, notes = list("*" = list(i = 0:1, j = 2, text = "Hello World!"))
+#' 
 #' @export
 tt <- function(x,
                digits = NULL,
@@ -51,10 +62,7 @@ tt <- function(x,
 
 
   # notes can be a single string or a (named) list of strings
-  if (is.character(notes) && length(notes)) {
-    notes <- list(notes)
-  }
-  assert_list(notes, null.ok = TRUE)
+  sanity_notes(notes)
 
   # before style_tt() call for align
   out <- x 
@@ -67,22 +75,13 @@ tt <- function(x,
   out <- meta(out, "nhead", if (is.null(colnames(x))) 0 else 1)
   out <- meta(out, "nrows", nrow(x))
   out <- meta(out, "ncols", ncol(x))
+  out <- meta(out, "notes", notes)
   out <- meta(out, "caption", caption)
   class(out) <- c("tinytable", class(out))
 
   # build table
+  # tt_tabularray wil be substituted in build_tt by the appropriate on based on output
   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)
 

R/tt_bootstrap.R

@@ -33,7 +33,18 @@ tt_bootstrap <- function(x, caption, theme, width, notes, ...) {
     notes_tmp <- NULL
     for (k in seq_along(notes)) {
       if (!is.null(names(notes))) {
-        tmp <- sprintf("<tr><td colspan='%s'><sup>%s</sup> %s</td></tr>", ncol(x), names(notes)[k], notes[k])
+        if (is.list(notes[[k]])) {
+          tmp <- sprintf("<tr><td colspan='%s'><sup>%s</sup> %s</td></tr>",
+            ncol(x),
+            names(notes)[k],
+            notes[[k]]$text)
+        # note is a string
+        } else {
+          tmp <- sprintf("<tr><td colspan='%s'><sup>%s</sup> %s</td></tr>",
+            ncol(x),
+            names(notes)[k],
+            notes[k])
+        }
       } else {
         tmp <- sprintf("<tr><td colspan='%s'>%s</td></tr>", ncol(x), notes[k])
       }

R/tt_tabularray.R

@@ -85,7 +85,7 @@ tt_tabularray <- function(x, caption, theme, width, notes, placement) {
     } else {
       lab <- names(notes)
     }
-    notes <- unlist(notes)
+    notes <- sapply(notes, function(n) if (is.list(n)) n$text else n)
     for (k in seq_along(notes)) {
       spec <- sprintf("note{%s}={%s}", lab[k], notes[k])
       out <- tabularray_insert(out, content = spec, type = "outer")

inst/tinytest/_tinysnapshot/notes-latex_cell_markers.txt

@@ -0,0 +1,19 @@
+
+\begin{table}
+\centering
+\begin{talltblr}[         %% tabularray outer open
+entry=none,label=none,
+note{}={Blah blah},
+note{*}={foo bar},
+]                     %% tabularray outer close
+{                     %% tabularray inner open
+colspec={Q[]Q[]Q[]},
+}                     %% tabularray inner close
+\toprule
+mpg & cyl\textsuperscript{*} & disp \\ \midrule %% TinyTableHeader
+21.0 & 6\textsuperscript{*} & 160 \\
+21.0 & 6 & 160 \\
+22.8 & 4 & 108 \\
+\bottomrule
+\end{talltblr}
+\end{table}

inst/tinytest/test-notes.R

@@ -0,0 +1,22 @@
+source("helpers.R")
+using("tinysnapshot")
+
+
+# latex table with cell marker table
+options(tinytable_print_output = "latex")
+x <- mtcars[1:3, 1:3]
+n <- list("Blah blah", "*" = list(i = 0:1, j = 2, text = "foo bar"))
+tab <- tt(x, notes = n)
+expect_snapshot_print(tab, label = "notes-latex_cell_markers")
+options(tinytable_print_output = NULL)
+
+
+
+
+
+
+
+
+
+
+