tinytable support

DESCRIPTION

@@ -10,7 +10,7 @@ License: GPL-2
 Depends: R (>= 2.12.0)
 Imports: stats, utils, knitr, htmltools
 Suggests: magrittr, kableExtra (>= 0.9.0), Hmisc, bookdown, rmarkdown,
-          pkgdown, formatters
+          pkgdown, formatters, tinytable (>= 0.5.0)
 VignetteBuilder: knitr
 URL: https://dmurdoch.github.io/tables/
 BugReports: https://github.com/dmurdoch/tables/issues

NAMESPACE

@@ -4,7 +4,7 @@ export(tabular, htmlNumeric, labelSubset, latexNumeric, PlusMinus,
        as.tabular, writeCSS,
        rowLabels, colLabels, "rowLabels<-", "colLabels<-",
        toKable, knit_print.tabular,
-       toLatex, toHTML, html.tabular, latex.tabular,
+       toLatex, toHTML, toTinytable, html.tabular, latex.tabular,
        latexTable, useGroupLabels, HTMLfootnotes, matrix_form.tabular)
 
 # pseudo-function exports; not meant to be called, but meant to make the checks happy

R/toTinytable.R

@@ -0,0 +1,67 @@
+toTinytable <- function(table, ...) {
+
+  if (!inherits(table, "tabular"))
+    stop("'table' must be a 'tabular' object.")
+
+  if (!requireNamespace("tinytable"))
+    stop("Please install the 'tinytable' package.")
+
+  rowLabels <- attr(table, "rowLabels")
+  rowLabels[is.na(rowLabels)] <- ""
+
+  clabels <- attr(table, "colLabels")
+
+  # pad column labels based on row stubs
+  pad <- matrix("", nrow = nrow(clabels), ncol = ncol(rowLabels))
+  pad[nrow(pad),] <- colnames(rowLabels)
+  clabels <- cbind(pad, clabels)
+
+  chars <- format(table, latex = FALSE)
+
+  chars <- data.frame(rowLabels, chars)
+  colnames(chars) <- clabels[nrow(clabels),]
+
+  # fill in missing column labels
+  for (i in seq_len(nrow(clabels))) {
+    for (j in seq_len(ncol(clabels))) {
+      if (j != 1 && is.na(clabels[i, j])) {
+        clabels[i, j] <- clabels[i, j - 1]
+      }
+    }
+  }
+
+  out <- tinytable::tt(chars, ...)
+
+  # TODO: allow justification on a cell-by-cell basis. Currently we only columns.
+  just <- cbind(
+    attr(attr(table, "rowLabels"), "justification"),
+    attr(table, "justification"))
+  for (j in seq_len(ncol(just))) {
+    align <- unique(just[, j])
+    if (length(align) == 1 && align %in% c("l", "r", "c")) {
+      out <- tinytable::style_tt(out, j = j, align = align)
+    }
+  }
+
+  # column spans
+  get_span <- function(x) {
+    x <- trimws(x)
+    idx <- rle(x)
+    end <- cumsum(idx$length)
+    start <- end - idx$length + 1
+    span <- lapply(seq_along(idx$values), function(i) start[i]:end[i])
+    names(span) <- idx$values
+    span <- span[names(span) != ""]
+    return(span)
+  }
+
+  # entries in the first row of clabels are already colnames in out
+  if (nrow(clabels) > 1) {
+    for (i in (nrow(clabels) - 1):1) {
+      s <- get_span(clabels[i,])
+      out <- tinytable::group_tt(out, j = s)
+    }
+  }
+
+  return(out)
+}

man/toTinytable.Rd

@@ -0,0 +1,46 @@
+\name{toTinytable}
+\alias{toTinytable}
+\title{
+Convert \code{tabular} object to \code{tinytable} format.
+}
+\description{
+Converts the output of the \code{\link{tabular}} and related
+functions to a format consistent with the output of the
+\code{\link[tinytable]{tt}} function, so that it can be 
+customized using the \pkg{tinytable} package.
+}
+\usage{
+toTinytable(table, ...)
+}
+\arguments{
+  \item{table}{
+An object of class \code{tabular}.
+}
+  \item{...}{
+Additional arguments to pass to \code{\link[tinytable]{tt}}.
+}
+}
+\value{
+An object of class \code{tinytable}, suitable for passing
+to functions in the \pkg{tinytable} package. These tables
+can be exported to several formats, including LaTeX, HTML,
+Markdown, Word, Typst, PDF, and PNG.
+}
+
+\seealso{
+\code{\link[tinytable]{tinytable-package}} 
+}
+\examples{
+if (requireNamespace("tinytable") && 
+    (!requireNamespace("pkgdown") || !pkgdown::in_pkgdown())) {
+  tab <-  tabular( (Species + 1) ~ (n=1) + Format(digits=2)*
+          (Sepal.Length + Sepal.Width)*(mean + sd), data=iris )
+  print(toTinytable(tab, theme = "striped"))
+  cat("\n")
+
+  tab <- toTinytable(tab)
+  tab <- tinytable::style_tt(tab, i = 1:2, background = "teal", 
+    color = "white")
+  print(tab)
+}
+}

vignettes/HTML.Rmd

@@ -142,7 +142,7 @@ this package, using the `toKable()` function.  For example,
 library(magrittr)
 library(kableExtra)
 toKable(tab, format="html") %>% 
-  kable_styling("striped", position = "float_right", full_width = FALSE) %>%
+  kable_styling("striped", full_width = FALSE) %>%
   add_header_above(c("Row Label" = 1, "Statistics" = 3)) %>%
   column_spec(4, color = "red") %>%
   row_spec(1, color = "blue") %>%
@@ -152,4 +152,23 @@ There are conflicts between the styling options
 from `kableExtra` and the ones specified in `table_options()$CSS`;
 some modifications might be needed to make everything work.  For
 instance, the code above requests striping, but that
-did not show up.  Experimentation may be needed!
+did not show up.  Experimentation may be needed!
+
+
+## tinytable support
+
+The `tinytable` package is another package which can be used to customize the
+look of tables generated by `tables`. A `tinytable` can be customized, and then
+printed or saved to a variety of formats, including: HTML, LaTeX, Word, Typst,
+PNG, PDF, Rmarkdown, and Quarto. For example,
+
+
+```{r}
+library(magrittr)
+library(tinytable)
+toTinytable(tab, theme = "striped") %>%
+  group_tt(i = list("Subgroup" = 3)) %>%
+  group_tt(j = list("Row Label" = 1, "Statistics" = 2:4)) %>%
+  style_tt(i = 3, color = "red", align = "c", line = "bt", line_color = "red") %>%
+  style_tt(i = 5:6, j = 3:4, background = "black", color = "orange")
+```