From 9a162f4c8382ad019b93751c68b46840065b2007 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 15 Feb 2024 13:14:41 -0500 Subject: [PATCH 1/5] toTinytable: minimal support --- NAMESPACE | 2 +- R/tinytable.tabular.R | 51 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 R/tinytable.tabular.R 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/tinytable.tabular.R b/R/tinytable.tabular.R new file mode 100644 index 0000000..b6561b6 --- /dev/null +++ b/R/tinytable.tabular.R @@ -0,0 +1,51 @@ +toTinytable <- function(object, file = "", ...) { + + rowLabels <- attr(object, "rowLabels") + rowLabels[is.na(rowLabels)] <- "" + + clabels <- attr(object, "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(object, latex = FALSE, minus = opts$latexminus, + leftpad = opts$latexleftpad, + rightpad = opts$latexrightpad,...) # format without justification + + 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] + } + } + } + + # convert to tinytable format + out <- tinytable::tt(chars) + + # 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) + } + + spans <- rev(apply(clabels, 1, get_span)[1:(nrow(clabels) - 1)]) + + for (s in spans) { + out <- tinytable::group_tt(out, j = s) + } + + return(out) +} From f934a95a08d7a207abcbf8cf332b41efee36aacf Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 15 Feb 2024 16:01:44 -0500 Subject: [PATCH 2/5] tinytable: align + vignette + safety --- DESCRIPTION | 2 +- R/tinytable.tabular.R | 51 -------------------------------- R/toTinytable.R | 67 +++++++++++++++++++++++++++++++++++++++++++ man/toTinytable.Rd | 46 +++++++++++++++++++++++++++++ vignettes/HTML.Rmd | 23 +++++++++++++-- 5 files changed, 135 insertions(+), 54 deletions(-) delete mode 100644 R/tinytable.tabular.R create mode 100644 R/toTinytable.R create mode 100644 man/toTinytable.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 5aebda6..23e905e 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.5.0) VignetteBuilder: knitr URL: https://dmurdoch.github.io/tables/ BugReports: https://github.com/dmurdoch/tables/issues diff --git a/R/tinytable.tabular.R b/R/tinytable.tabular.R deleted file mode 100644 index b6561b6..0000000 --- a/R/tinytable.tabular.R +++ /dev/null @@ -1,51 +0,0 @@ -toTinytable <- function(object, file = "", ...) { - - rowLabels <- attr(object, "rowLabels") - rowLabels[is.na(rowLabels)] <- "" - - clabels <- attr(object, "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(object, latex = FALSE, minus = opts$latexminus, - leftpad = opts$latexleftpad, - rightpad = opts$latexrightpad,...) # format without justification - - 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] - } - } - } - - # convert to tinytable format - out <- tinytable::tt(chars) - - # 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) - } - - spans <- rev(apply(clabels, 1, get_span)[1:(nrow(clabels) - 1)]) - - for (s in spans) { - out <- tinytable::group_tt(out, j = s) - } - - return(out) -} diff --git a/R/toTinytable.R b/R/toTinytable.R new file mode 100644 index 0000000..6af20d7 --- /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) { + spans <- rev(apply(clabels, 1, get_span)[1:(nrow(clabels) - 1)]) + for (s in spans) { + 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..3ecabc2 --- /dev/null +++ b/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) +} +} 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") +``` From 80dd8fda1285f1766b932e44892c7ed118e43030 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 15 Feb 2024 16:42:17 -0500 Subject: [PATCH 3/5] simplification --- R/toTinytable.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/toTinytable.R b/R/toTinytable.R index 6af20d7..45e3c8a 100644 --- a/R/toTinytable.R +++ b/R/toTinytable.R @@ -57,8 +57,8 @@ toTinytable <- function(table, ...) { # entries in the first row of clabels are already colnames in out if (nrow(clabels) > 1) { - spans <- rev(apply(clabels, 1, get_span)[1:(nrow(clabels) - 1)]) - for (s in spans) { + for (i in (nrow(clabels) - 1):1) { + s <- get_span(clabels[i,]) out <- tinytable::group_tt(out, j = s) } } From 2165648e116a98253d862ac7dfe06939966eb3a9 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 15 Feb 2024 17:38:52 -0500 Subject: [PATCH 4/5] tinytable 0.0.5 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 23e905e..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, tinytable (>= 0.5.0) + pkgdown, formatters, tinytable (>= 0.0.5) VignetteBuilder: knitr URL: https://dmurdoch.github.io/tables/ BugReports: https://github.com/dmurdoch/tables/issues From 61a27982e462ff640a550d550097bc90e12ee69a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Thu, 15 Feb 2024 20:39:49 -0500 Subject: [PATCH 5/5] tinytable: example not conditional on pkgdown --- man/toTinytable.Rd | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/man/toTinytable.Rd b/man/toTinytable.Rd index 3ecabc2..d31df58 100644 --- a/man/toTinytable.Rd +++ b/man/toTinytable.Rd @@ -31,16 +31,14 @@ Markdown, Word, Typst, PDF, and PNG. \code{\link[tinytable]{tinytable-package}} } \examples{ -if (requireNamespace("tinytable") && - (!requireNamespace("pkgdown") || !pkgdown::in_pkgdown())) { +if (requireNamespace("tinytable")) { + 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) + tab <- toTinytable(tab, theme = "striped") + tab <- tinytable::style_tt(tab, i = 1:2, background = "teal", color = "white") + tab + } + }