diff --git a/DESCRIPTION b/DESCRIPTION index 5aebda6..310b5e5 100644 --- a/DESCRIPTION +++ b/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.0.5) VignetteBuilder: knitr URL: https://dmurdoch.github.io/tables/ BugReports: https://github.com/dmurdoch/tables/issues diff --git a/NAMESPACE b/NAMESPACE index c600aa2..db91298 100644 --- a/NAMESPACE +++ b/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 diff --git a/R/toTinytable.R b/R/toTinytable.R new file mode 100644 index 0000000..45e3c8a --- /dev/null +++ b/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) +} diff --git a/man/toTinytable.Rd b/man/toTinytable.Rd new file mode 100644 index 0000000..d31df58 --- /dev/null +++ b/man/toTinytable.Rd @@ -0,0 +1,44 @@ +\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")) { + + tab <- tabular( (Species + 1) ~ (n=1) + Format(digits=2)* + (Sepal.Length + Sepal.Width)*(mean + sd), data=iris ) + tab <- toTinytable(tab, theme = "striped") + tab <- tinytable::style_tt(tab, i = 1:2, background = "teal", color = "white") + tab + +} + +} diff --git a/vignettes/HTML.Rmd b/vignettes/HTML.Rmd index b47a1c8..e8e3ee2 100644 --- a/vignettes/HTML.Rmd +++ b/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! \ No newline at end of file +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") +```