", jstring)
@@ -67,7 +69,8 @@ group_bootstrap_row <- function(x, i, j, indent = 1, ...) {
# 0-indexing
i[g] + x@nhead - 1,
ncol(x),
- names(i)[g])
+ names(i)[g]
+ )
out <- lines_insert(out, js, "tinytable span after", "after")
# out <- bootstrap_setting(out, new = js, component = "cell")
}
@@ -78,7 +81,8 @@ group_bootstrap_row <- function(x, i, j, indent = 1, ...) {
"insertSpanRow(",
paste0("insertSpanRow_", get_id(""), "("),
out,
- fixed = TRUE)
+ fixed = TRUE
+ )
idx <- insert_values(seq_len(nrow(x)), rep(NA, length(i)), i)
diff --git a/R/group_grid.R b/R/group_grid.R
index 08f32173..9e0e5729 100644
--- a/R/group_grid.R
+++ b/R/group_grid.R
@@ -9,7 +9,8 @@ setMethod(
x <- group_grid_row(x, i)
x <- group_grid_col(x, j)
return(x)
- })
+ }
+)
group_grid_col <- function(x, j, ...) {
diff --git a/R/group_tabularray.R b/R/group_tabularray.R
index a2a971de..1565b88e 100644
--- a/R/group_tabularray.R
+++ b/R/group_tabularray.R
@@ -9,7 +9,8 @@ setMethod(
x <- group_tabularray_col(x, j, ...)
x <- group_tabularray_row(x, i, indent)
return(x)
- })
+ }
+)
group_tabularray_col <- function(x, j, ihead, ...) {
@@ -38,7 +39,8 @@ group_tabularray_col <- function(x, j, ihead, ...) {
out[1:idx],
# empty lines can break latex
trimws(header),
- out[(idx + 1):length(out)])
+ out[(idx + 1):length(out)]
+ )
out <- paste(out, collapse = "\n")
# rebuild including meta before style_tt
@@ -54,7 +56,8 @@ group_tabularray_col <- function(x, j, ihead, ...) {
i = ihead,
j = z,
align = "c",
- colspan = cs)
+ colspan = cs
+ )
x <- do.call(style_tt, args)
}
diff --git a/R/group_tt.R b/R/group_tt.R
index c3492f2a..ce198c6b 100644
--- a/R/group_tt.R
+++ b/R/group_tt.R
@@ -11,15 +11,16 @@
#' @param ... Other arguments are ignored.
#' @return An object of class `tt` representing the table.
#' @param indent integer number of `pt` to use when indenting the non-labelled rows.
+#' @template limitations_word_markdown
#' @details
#' Warning: The `style_tt()` can normally be used to style the group headers, as expected, but that feature is not available for Markdown and Word tables.
#' @examples
#'
#' # vector of row labels
#' dat <- data.frame(
-#' label = c("a", "a", "a", "b", "b", "c", "a", "a"),
-#' x1 = rnorm(8),
-#' x2 = rnorm(8))
+#' label = c("a", "a", "a", "b", "b", "c", "a", "a"),
+#' x1 = rnorm(8),
+#' x2 = rnorm(8))
#' tt(dat[, 2:3]) |> group_tt(i = dat$label)
#'
#' # named lists of labels
@@ -51,7 +52,6 @@
#' group_tt(j = list("Hello" = 1:2, "World" = 3:4, "Hello" = 5:6)) |>
#' group_tt(j = list("Foo" = 1:3, "Bar" = 4:6))
#'
-
group_tt <- function(x, i = NULL, j = NULL, indent = 1, ...) {
# ... is important for ihead passing
@@ -67,29 +67,30 @@ group_tt <- function(x, i = NULL, j = NULL, indent = 1, ...) {
i <- sanitize_group_index(i, hi = nrow(x) + 1, orientation = "row")
j <- sanitize_group_index(j, hi = ncol(x), orientation = "column")
- # we don't need this as a list, and we use some sorting later
+ # increment indices eagerly
i <- unlist(i)
if (!is.null(i)) {
- if (isTRUE(x@group_tt_i)) {
+ if (x@ngroupi > 0) {
stop("Only one row-wise `group_tt(i = ...)` call is allowed.", call. = FALSE)
}
- x@group_tt_i <- TRUE
+
+ x@ngroupi <- length(i)
+ x@nrow <- x@nrow + x@ngroupi
+ x@group_i_idx <- as.numeric(i)
+
if (isTRUE(indent > 0)) {
- idx_indent <- setdiff(
- seq_len(nrow(x) + length(i)),
- i + seq_along(i) - 1)
+ idx_indent <- setdiff(seq_len(nrow(x)), i + seq_along(i) - 1)
x <- style_tt(x, i = idx_indent, j = 1, indent = indent)
}
}
- if (!is.null(i)) {
- x@ngroupi <- x@ngroupi + length(i)
- x@group_i_idx <- as.numeric(unlist(i))
+ if (!is.null(j)) {
+ x@nhead <- x@nhead + 1
}
+ # apply group labels lazily
cal <- call("group_eval", i = i, j = j, indent = indent)
-
x@lazy_group <- c(x@lazy_group, list(cal))
return(x)
diff --git a/R/group_typst.R b/R/group_typst.R
index d651f5df..5948fdbe 100644
--- a/R/group_typst.R
+++ b/R/group_typst.R
@@ -16,7 +16,8 @@ setMethod(
}
return(out)
- })
+ }
+)
group_typst_row <- function(x, i, indent, ...) {
@@ -24,7 +25,6 @@ group_typst_row <- function(x, i, indent, ...) {
tab <- strsplit(tab, split = "\\n")[[1]]
body_min <- utils::head(grep("tinytable cell content after", tab), 1) + 1
body_max <- utils::head(grep("end table", tab), 1) - 1
- body <- body_min:body_max
top <- tab[1:(body_min - 1)]
mid <- tab[body_min:body_max]
mid <- mid[mid != ""]
@@ -32,15 +32,15 @@ group_typst_row <- function(x, i, indent, ...) {
for (idx in rev(seq_along(i))) {
mid <- append(mid,
sprintf("table.cell(colspan: %s)[%s],", ncol(x), names(i)[idx]),
- after = i[idx] - 1)
+ after = i[idx] - 1
+ )
}
tab <- c(top, mid, bot)
tab <- paste(tab, collapse = "\n")
x@table_string <- tab
idx_new <- i + seq_along(i) - 1
- idx_all <- seq_len(nrow(x) + length(i))
+ idx_all <- seq_len(nrow(x))
idx <- setdiff(idx_all, idx_new)
- # x <- style_tt(x, idx, indent = indent)
return(x)
}
@@ -58,7 +58,8 @@ group_typst_col <- function(x, j, ihead, ...) {
col <- ifelse(
trimws(lab) == "",
sprintf("[%s],", lab),
- sprintf("table.cell(stroke: (bottom: .05em + black), colspan: %s, align: center)[%s],", len, lab))
+ sprintf("table.cell(stroke: (bottom: .05em + black), colspan: %s, align: center)[%s],", len, lab)
+ )
col <- paste(col, collapse = "")
out <- lines_insert(out, col, "repeat: true", "after")
if (!any(grepl("column-gutter", out))) {
diff --git a/R/last_style.R b/R/last_style.R
index d132560e..69a52d96 100644
--- a/R/last_style.R
+++ b/R/last_style.R
@@ -1,25 +1,27 @@
last_valid <- function(x) {
- x <- x[!is.na(x)]
- if (length(x) == 0) return(NA)
- return(utils::tail(x, 1))
+ x <- x[!is.na(x)]
+ if (length(x) == 0) {
+ return(NA)
+ }
+ return(utils::tail(x, 1))
}
last_style_vec <- function(x) {
- if (is.factor(x)) {
- x <- as.character(x)
- }
- if (is.logical(x) && !all(is.na(x))) {
- x <- any(sapply(x, isTRUE))
- } else {
- x <- last_valid(x)
- }
- return(x)
+ if (is.factor(x)) {
+ x <- as.character(x)
+ }
+ if (is.logical(x) && !all(is.na(x))) {
+ x <- any(sapply(x, isTRUE))
+ } else {
+ x <- last_valid(x)
+ }
+ return(x)
}
last_style <- function(sty) {
- sty <- split(sty, list(sty$i, sty$j))
- sty <- lapply(sty, function(k) lapply(k, last_style_vec))
- sty <- do.call(rbind, lapply(sty, data.frame))
- return(sty)
+ sty <- split(sty, list(sty$i, sty$j))
+ sty <- lapply(sty, function(k) lapply(k, last_style_vec))
+ sty <- do.call(rbind, lapply(sty, data.frame))
+ return(sty)
}
diff --git a/R/package.R b/R/package.R
index a133c157..e321b112 100644
--- a/R/package.R
+++ b/R/package.R
@@ -2,5 +2,5 @@
# 2012 hadley says "globalVariables is a hideous hack and I will never use it"
# 2014 hadley updates his own answer with globalVariables as one of "two solutions"
utils::globalVariables(c(
-"bootstrap"
+ "bootstrap"
))
diff --git a/R/plot_tt.R b/R/plot_tt.R
index 95066323..3c0b0209 100644
--- a/R/plot_tt.R
+++ b/R/plot_tt.R
@@ -102,7 +102,8 @@ plot_tt <- function(x,
xlim = xlim,
height = height,
images = images,
- assets = assets)
+ assets = assets
+ )
cal <- c(cal, list(...))
cal <- do.call(call, cal)
@@ -130,9 +131,9 @@ plot_tt_lazy <- function(x,
assert_dependency("ggplot2")
images <- NULL
- if(isTRUE(x@output == "html") && isTRUE(x@portable)) {
- path_full <- tempdir()
- assets <- tempdir()
+ if (isTRUE(x@output == "html") && isTRUE(x@portable)) {
+ path_full <- tempdir()
+ assets <- tempdir()
} else {
path_full <- file.path(x@output_dir, assets)
}
@@ -182,7 +183,7 @@ plot_tt_lazy <- function(x,
if (isTRUE(x@output == "latex")) {
cell <- "\\includegraphics[height=%sem]{%s}"
cell <- sprintf(cell, height, images)
- } else if(isTRUE(x@output == "html") && isTRUE(x@portable)) {
+ } else if (isTRUE(x@output == "html") && isTRUE(x@portable)) {
assert_dependency("base64enc")
http <- grepl("^http", trimws(images))
@@ -192,7 +193,8 @@ plot_tt_lazy <- function(x,
cell <- ifelse(
grepl("^http", trimws(images)),
'',
- '')
+ ''
+ )
cell <- sprintf(cell, images, height)
} else if (isTRUE(x@output == "markdown")) {
cell <- "{ height=%s }"
@@ -250,7 +252,7 @@ encode <- function(images) {
assert_dependency("base64enc")
ext <- tools::file_ext(images)
- if(any(ext == "")) stop("Empty image extensions are not allowed", call. = FALSE)
+ if (any(ext == "")) stop("Empty image extensions are not allowed", call. = FALSE)
encoded <- sapply(images, base64enc::base64encode)
sprintf("data:image/%s;base64, %s", ext, encoded)
diff --git a/R/posit.R b/R/posit.R
new file mode 100644
index 00000000..d63ef152
--- /dev/null
+++ b/R/posit.R
@@ -0,0 +1,20 @@
+is_rstudio <- function() {
+ identical(Sys.getenv("RSTUDIO"), "1")
+}
+
+is_positron <- function() {
+ identical(Sys.getenv("POSITRON"), "1")
+}
+
+is_rstudio_notebook <- function() {
+ flag <- FALSE
+ # inline doesn't work in Positron
+ if (is_rstudio()) {
+ assert_dependency("rstudioapi")
+ con <- rstudioapi::getActiveDocumentContext()[["path"]]
+ if (isTRUE(grepl("\\.qmd$|\\.Rmd$", con))) {
+ flag <- TRUE
+ }
+ }
+ return(flag)
+}
diff --git a/R/print.R b/R/print.R
index ae104caa..4a5f0f8c 100644
--- a/R/print.R
+++ b/R/print.R
@@ -1,6 +1,7 @@
#' Print a tinytable object in knitr
#'
#' @keywords internal
+#' @rawNamespace S3method(knitr::knit_print, tinytable)
#' @return A string with class `knit_asis` to be printed in Rmarkdown or Quarto documents.
#' @export
knit_print.tinytable <- function(x,
@@ -36,7 +37,6 @@ knit_print.tinytable <- function(x,
return(out)
}
-
#' Print, display, or convert a tinytable object
#'
#' This function is called automatically by `R` whenever a `tinytable` object is anprinted to the console or in an HTML viewer pane.
@@ -74,6 +74,16 @@ print.tinytable <- function(x,
if (output %in% c("latex", "typst", "markdown", "gfm")) {
cat(tab, "\n")
} else if (output == "html") {
+ if (is_rstudio_notebook()) {
+ tinytable_print_rstudio <- getOption("tinytable_print_rstudio_notebook", default = "inline")
+ assert_choice(tinytable_print_rstudio, c("inline", "viewer"))
+ if (tinytable_print_rstudio == "inline") {
+ tab <- sprintf("\n```{=html}\n%s\n```\n`", tab)
+ print(knitr::asis_output(tab))
+ return(invisible(x))
+ }
+ }
+
# need to change the output directory to a temporary directory
# for plot_tt() inline plots to show up in RStudio
htmlFile <- file.path(dir, "index.html")
diff --git a/R/rbind2.R b/R/rbind2.R
index d704446c..510923e9 100644
--- a/R/rbind2.R
+++ b/R/rbind2.R
@@ -1,5 +1,5 @@
#' Combine `tinytable` objects by rows (vertically)
-#'
+#'
#' @details
#' `format_tt()` calls applied to `x` or `y` are evaluated before binding, to allow distinct formatting for each panel.
#'
@@ -25,55 +25,56 @@
#' @aliases rbind2
#' @examples
#' library(tinytable)
-#' x = tt(mtcars[1:3, 1:2], caption = "Combine two tiny tables.")
-#' y = tt(mtcars[4:5, 8:10])
-#'
+#' x <- tt(mtcars[1:3, 1:2], caption = "Combine two tiny tables.")
+#' y <- tt(mtcars[4:5, 8:10])
+#'
#' # rbind() does not support additional aarguments
#' # rbind2() supports additional arguments
-#'
+#'
#' # basic combination
#' rbind(x, y)
-#'
+#'
#' rbind(x, y) |> format_tt(replace = "")
-#'
+#'
#' # omit y header
#' rbind2(x, y, headers = FALSE)
-#'
+#'
#' # bind by position rather than column names
#' rbind2(x, y, use_names = FALSE)
-#'
+#'
#' @importFrom methods rbind2
#' @export
-setMethod("rbind2",
- signature = signature(x = "tinytable", y = "tinytable"),
- definition = function(x, y,
- use_names = TRUE,
- headers = TRUE,
- ...) {
+setMethod("rbind2",
+ signature = signature(x = "tinytable", y = "tinytable"),
+ definition = function(x, y,
+ use_names = TRUE,
+ headers = TRUE,
+ ...) {
+ assert_class(x, "tinytable")
+ assert_class(y, "tinytable")
+ assert_dependency("data.table")
+ assert_flag(use_names)
+ assert_flag(headers)
- assert_class(x, "tinytable")
- assert_class(y, "tinytable")
- assert_dependency("data.table")
- assert_flag(use_names)
- assert_flag(headers)
+ x_df <- print(x, output = "dataframe")
+ y_df <- print(y, output = "dataframe")
- x_df <- print(x, output = "dataframe")
- y_df <- print(y, output = "dataframe")
+ if (isTRUE(headers) && !is.null(colnames(y))) {
+ y_df <- base::rbind(colnames(y_df), y_df)
+ }
- if (isTRUE(headers) && !is.null(colnames(y))) {
- y_df <- base::rbind(colnames(y_df), y_df)
- }
+ out <- data.table::rbindlist(list(x_df, y_df),
+ fill = TRUE,
+ use.names = use_names
+ )
- out <- data.table::rbindlist(list(x_df, y_df),
- fill = TRUE,
- use.names = use_names)
+ out <- tt(out)
- out <- tt(out)
+ out@output <- x@output
+ out@notes <- c(x@notes, y@notes)
+ out@width <- x@width
+ out@caption <- x@caption
- out@output <- x@output
- out@notes <- c(x@notes, y@notes)
- out@width <- x@width
- out@caption <- x@caption
-
- return(out)
-})
+ return(out)
+ }
+)
diff --git a/R/sanity.R b/R/sanity.R
index cf267bb4..ff119a2f 100644
--- a/R/sanity.R
+++ b/R/sanity.R
@@ -1,14 +1,14 @@
usepackage_latex <- function(name, options = NULL, extra_lines = NULL) {
- assert_dependency("rmarkdown")
- invisible(knitr::knit_meta_add(list(rmarkdown::latex_dependency(name, options, extra_lines))))
+ assert_dependency("rmarkdown")
+ invisible(knitr::knit_meta_add(list(rmarkdown::latex_dependency(name, options, extra_lines))))
}
sanity_align <- function(align, i) {
- if (any(grepl("d", align)) && !is.null(i)) {
- msg <- "d column alignment can only be applied to entire columns. `i` must be `NULL`."
- stop(msg, call. = FALSE)
- }
+ if (any(grepl("d", align)) && !is.null(i)) {
+ msg <- "d column alignment can only be applied to entire columns. `i` must be `NULL`."
+ stop(msg, call. = FALSE)
+ }
}
@@ -31,78 +31,104 @@ sanitize_i <- function(i, x, pre_group_i = FALSE, lazy = TRUE) {
}
return(out)
}
+sanitize_i <- function(i, x, pre_group_i = FALSE, lazy = TRUE) {
+ if (is.character(i)) {
+ assert_choice(i, c("notes", "caption"))
+ return(i)
+ } else if (is.matrix(i) && is.logical(i)) {
+ return(i)
+ }
+ out <- seq_len(nrow(x))
+ assert_numeric(i, null.ok = TRUE, name = "i")
+ if (is.null(i) && isTRUE(lazy)) {
+ out <- NA
+ attr(out, "null") <- TRUE
+ attr(out, "body") <- seq_len(nrow(x))
+ attr(out, "head") <- integer()
+ } else {
+ if (!is.null(i)) {
+ out <- i
+ } else if (inherits(x, "tinytable")) {
+ out <- seq_len(nrow(x@table_dataframe))
+ }
+ attr(out, "null") <- FALSE
+ attr(out, "body") <- out[out > 0]
+ attr(out, "head") <- out[out < 1]
+ }
+ return(out)
+}
sanitize_j <- function(j, x) {
- # regex
- if (is.character(j) && length(j) == 1 && !is.null(colnames(x))) {
- out <- grep(j, colnames(x), perl = TRUE)
- # full names
- } else if (is.character(j) && length(j) > 1 && !is.null(colnames(x))) {
- bad <- setdiff(j, colnames(x))
- if (length(bad) > 0) {
- msg <- sprintf("Missing columns: %s", paste(bad, collapse = ", "))
- stop(msg, call. = FALSE)
- }
- out <- which(colnames(x) %in% j)
+ # regex
+ if (is.character(j) && length(j) == 1 && !is.null(colnames(x))) {
+ out <- grep(j, colnames(x), perl = TRUE)
+ # full names
+ } else if (is.character(j) && length(j) > 1 && !is.null(colnames(x))) {
+ bad <- setdiff(j, colnames(x))
+ if (length(bad) > 0) {
+ msg <- sprintf("Missing columns: %s", paste(bad, collapse = ", "))
+ stop(msg, call. = FALSE)
+ }
+ out <- which(colnames(x) %in% j)
+ } else {
+ assert_integerish(j, lower = 1, upper = ncol(x), null.ok = TRUE)
+ if (is.null(j)) {
+ out <- seq_len(ncol(x))
} else {
- assert_integerish(j, lower = 1, upper = ncol(x), null.ok = TRUE)
- if (is.null(j)) {
- out <- seq_len(ncol(x))
- } else {
- out <- j
- }
+ out <- j
}
- attr(out, "null") <- is.null(j)
- return(out)
+ }
+ attr(out, "null") <- is.null(j)
+ return(out)
}
sanitize_output <- function(output) {
- assert_choice(output, choice = c("tinytable", "markdown", "latex", "html", "typst", "dataframe", "gfm"), null.ok = TRUE)
-
- # default output format
- if (is.null(output) || isTRUE(output == "tinytable")) {
- has_viewer <- interactive() && !is.null(getOption("viewer"))
- out <- if (has_viewer) "html" else "markdown"
- } else {
- out <- output
- }
-
- if (isTRUE(check_dependency("knitr"))) {
- if (isTRUE(knitr::pandoc_to() %in% c("latex", "beamer"))) {
- flag <- getOption("tinytable_latex_preamble", default = TRUE)
- if (isTRUE(flag)) {
- usepackage_latex("float")
- usepackage_latex("tabularray", extra_lines = c(
- "\\usepackage[normalem]{ulem}",
- "\\usepackage{graphicx}",
- "\\UseTblrLibrary{booktabs}",
- "\\UseTblrLibrary{rotating}",
- "\\UseTblrLibrary{siunitx}",
- "\\NewTableCommand{\\tinytableDefineColor}[3]{\\definecolor{#1}{#2}{#3}}",
- "\\newcommand{\\tinytableTabularrayUnderline}[1]{\\underline{#1}}",
- "\\newcommand{\\tinytableTabularrayStrikeout}[1]{\\sout{#1}}"
- ))
- }
- if (is.null(output)) out <- "latex"
- } else if (isTRUE(knitr::pandoc_to() %in% c("html", "revealjs"))) {
- if (is.null(output)) out <- "html"
- } else if (isTRUE(knitr::pandoc_to() == "typst")) {
- if (is.null(output)) out <- "typst"
- if (isTRUE(check_dependency("quarto"))) {
- if (isTRUE(quarto::quarto_version() < "1.5.29")) {
- msg <- "Typst tables require version 1.5.29 or later of Quarto and version 0.11.0 or later of Typst. This software may (or may not) only be available in pre-release builds: https://quarto.org/docs/download"
- stop(msg, call. = FALSE)
- }
- }
- } else if (isTRUE(knitr::pandoc_to() == "docx")) {
- if (is.null(output)) out <- "markdown"
- } else {
- if (is.null(output)) out <- "markdown"
+ assert_choice(output, choice = c("tinytable", "markdown", "latex", "html", "typst", "dataframe", "gfm"), null.ok = TRUE)
+
+ # default output format
+ if (is.null(output) || isTRUE(output == "tinytable")) {
+ has_viewer <- interactive() && !is.null(getOption("viewer"))
+ out <- if (has_viewer) "html" else "markdown"
+ } else {
+ out <- output
+ }
+
+ if (isTRUE(check_dependency("knitr"))) {
+ if (isTRUE(knitr::pandoc_to() %in% c("latex", "beamer"))) {
+ flag <- getOption("tinytable_latex_preamble", default = TRUE)
+ if (isTRUE(flag)) {
+ usepackage_latex("float")
+ usepackage_latex("tabularray", extra_lines = c(
+ "\\usepackage[normalem]{ulem}",
+ "\\usepackage{graphicx}",
+ "\\UseTblrLibrary{booktabs}",
+ "\\UseTblrLibrary{rotating}",
+ "\\UseTblrLibrary{siunitx}",
+ "\\NewTableCommand{\\tinytableDefineColor}[3]{\\definecolor{#1}{#2}{#3}}",
+ "\\newcommand{\\tinytableTabularrayUnderline}[1]{\\underline{#1}}",
+ "\\newcommand{\\tinytableTabularrayStrikeout}[1]{\\sout{#1}}"
+ ))
+ }
+ if (is.null(output)) out <- "latex"
+ } else if (isTRUE(knitr::pandoc_to() %in% c("html", "revealjs"))) {
+ if (is.null(output)) out <- "html"
+ } else if (isTRUE(knitr::pandoc_to() == "typst")) {
+ if (is.null(output)) out <- "typst"
+ if (isTRUE(check_dependency("quarto"))) {
+ if (isTRUE(quarto::quarto_version() < "1.5.29")) {
+ msg <- "Typst tables require version 1.5.29 or later of Quarto and version 0.11.0 or later of Typst. This software may (or may not) only be available in pre-release builds: https://quarto.org/docs/download"
+ stop(msg, call. = FALSE)
}
+ }
+ } else if (isTRUE(knitr::pandoc_to() == "docx")) {
+ if (is.null(output)) out <- "markdown"
+ } else {
+ if (is.null(output)) out <- "markdown"
}
+ }
- return(out)
+ return(out)
}
@@ -110,315 +136,315 @@ sanitize_output <- function(output) {
#'
#' @noRd
check_dependency <- function(library_name) {
- flag <- requireNamespace(library_name, quietly = TRUE)
- if (isFALSE(flag)) {
- msg <- sprintf("Please install the `%s` package.", library_name)
- return(msg)
- } else {
- return(TRUE)
- }
+ flag <- requireNamespace(library_name, quietly = TRUE)
+ if (isFALSE(flag)) {
+ msg <- sprintf("Please install the `%s` package.", library_name)
+ return(msg)
+ } else {
+ return(TRUE)
+ }
}
assert_dependency <- function(library_name) {
- flag <- check_dependency(library_name)
- if (!isTRUE(flag)) stop(flag, call. = FALSE)
- return(invisible())
+ flag <- check_dependency(library_name)
+ if (!isTRUE(flag)) stop(flag, call. = FALSE)
+ return(invisible())
}
assert_choice <- function(x, choice, null.ok = FALSE, name = as.character(substitute(x))) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(TRUE)
- }
- if (is.character(x) && length(x) == 1 && x %in% choice) {
- return(TRUE)
- }
- msg <- sprintf(
- "`%s` must be one of: %s",
- name,
- paste(choice, collapse = ", ")
- )
- stop(msg, call. = FALSE)
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(TRUE)
+ }
+ if (is.character(x) && length(x) == 1 && x %in% choice) {
+ return(TRUE)
+ }
+ msg <- sprintf(
+ "`%s` must be one of: %s",
+ name,
+ paste(choice, collapse = ", ")
+ )
+ stop(msg, call. = FALSE)
}
check_string <- function(x, null.ok = FALSE) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(invisible(TRUE))
- }
- if (is.character(x) && length(x) == 1) {
- return(invisible(TRUE))
- }
- return(FALSE)
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(invisible(TRUE))
+ }
+ if (is.character(x) && length(x) == 1) {
+ return(invisible(TRUE))
+ }
+ return(FALSE)
}
assert_string <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- msg <- sprintf("`%s` must be a string.", name)
- if (!isTRUE(check_string(x, null.ok = null.ok))) {
- stop(msg, call. = FALSE)
- }
+ msg <- sprintf("`%s` must be a string.", name)
+ if (!isTRUE(check_string(x, null.ok = null.ok))) {
+ stop(msg, call. = FALSE)
+ }
}
check_flag <- function(x, null.ok = FALSE) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(TRUE)
- }
- if (is.logical(x) && length(x) == 1) {
- return(TRUE)
- }
- return(FALSE)
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(TRUE)
+ }
+ if (is.logical(x) && length(x) == 1) {
+ return(TRUE)
+ }
+ return(FALSE)
}
assert_flag <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- msg <- sprintf("`%s` must be a logical flag.", name)
- if (!isTRUE(check_flag(x, null.ok = null.ok))) {
- stop(msg, call. = FALSE)
- }
+ msg <- sprintf("`%s` must be a logical flag.", name)
+ if (!isTRUE(check_flag(x, null.ok = null.ok))) {
+ stop(msg, call. = FALSE)
+ }
}
check_function <- function(x, null.ok = FALSE) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(TRUE)
- }
- if (is.function(x)) {
- return(TRUE)
- }
- return(FALSE)
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(TRUE)
+ }
+ if (is.function(x)) {
+ return(TRUE)
+ }
+ return(FALSE)
}
assert_function <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- msg <- sprintf("`%s` must be a function.", name)
- if (!isTRUE(check_function(x, null.ok = null.ok))) {
- stop(msg, call. = FALSE)
- }
+ msg <- sprintf("`%s` must be a function.", name)
+ if (!isTRUE(check_function(x, null.ok = null.ok))) {
+ stop(msg, call. = FALSE)
+ }
}
assert_length <- function(x, len = 1, null.ok = FALSE, name = as.character(substitute(x))) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(invisible(TRUE))
- }
- msg <- sprintf("`%s` must be one of these lengths: %s", name, paste(len, collapse = ", "))
- if (!length(x) %in% len) {
- stop(msg, call. = FALSE)
- }
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(invisible(TRUE))
+ }
+ msg <- sprintf("`%s` must be one of these lengths: %s", name, paste(len, collapse = ", "))
+ if (!length(x) %in% len) {
+ stop(msg, call. = FALSE)
+ }
}
assert_logical <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(invisible(TRUE))
- }
- msg <- sprintf("`%s` must be a logical vector", name)
- if (!is.logical(x)) stop(msg, call. = FALSE)
+ if (is.null(x) && isTRUE(null.ok)) {
+ return(invisible(TRUE))
+ }
+ msg <- sprintf("`%s` must be a logical vector", name)
+ if (!is.logical(x)) stop(msg, call. = FALSE)
}
check_integerish <- function(x, len = NULL, lower = NULL, upper = NULL, null.ok = TRUE) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(TRUE)
- }
- if (!is.numeric(x)) {
- return(FALSE)
- }
- x <- stats::na.omit(x)
- if (!is.null(len) && length(x) != len) {
- return(FALSE)
- }
- if (!is.null(lower) && any(x < lower)) {
- return(FALSE)
- }
- if (!is.null(upper) && any(x > upper)) {
- return(FALSE)
- }
- if (isTRUE(any(abs(x - round(x)) > (.Machine$double.eps)^0.5))) {
- return(FALSE)
- }
+ if (is.null(x) && isTRUE(null.ok)) {
return(TRUE)
+ }
+ if (!is.numeric(x)) {
+ return(FALSE)
+ }
+ x <- stats::na.omit(x)
+ if (!is.null(len) && length(x) != len) {
+ return(FALSE)
+ }
+ if (!is.null(lower) && any(x < lower)) {
+ return(FALSE)
+ }
+ if (!is.null(upper) && any(x > upper)) {
+ return(FALSE)
+ }
+ if (isTRUE(any(abs(x - round(x)) > (.Machine$double.eps)^0.5))) {
+ return(FALSE)
+ }
+ return(TRUE)
}
assert_integerish <- function(x, len = NULL, lower = NULL, upper = NULL, null.ok = FALSE, name = as.character(substitute(x))) {
- if (isTRUE(null.ok) && is.null(x)) {
- return(invisible())
- }
- msg <- sprintf("`%s` must be integer-ish", name)
- if (is.null(x) && !isTRUE(null.ok)) stop(sprintf("%s should not be NULL.", name), call. = FALSE)
- if (!isTRUE(check_integerish(x, len = len, lower = lower, upper = upper, null.ok = null.ok))) {
- if (!is.numeric(x)) msg <- paste0(msg, "; it is not numeric")
- if (!is.null(len) && length(x) != len) msg <- paste0(msg, sprintf("; its length must be %s", len))
- if (!is.null(lower) && any(x < lower)) msg <- paste0(msg, sprintf("; all values must be greater than or equal to %s", lower))
- if (!is.null(upper) && any(x > upper)) msg <- paste0(msg, sprintf("; all values must be less than or equal to %s", upper))
- if (isTRUE(any(abs(x - round(x)) > (.Machine$double.eps)^0.5))) msg <- paste0(msg, "; all values must be close to integers")
- stop(msg, call. = FALSE)
- }
+ if (isTRUE(null.ok) && is.null(x)) {
+ return(invisible())
+ }
+ msg <- sprintf("`%s` must be integer-ish", name)
+ if (is.null(x) && !isTRUE(null.ok)) stop(sprintf("%s should not be NULL.", name), call. = FALSE)
+ if (!isTRUE(check_integerish(x, len = len, lower = lower, upper = upper, null.ok = null.ok))) {
+ if (!is.numeric(x)) msg <- paste0(msg, "; it is not numeric")
+ if (!is.null(len) && length(x) != len) msg <- paste0(msg, sprintf("; its length must be %s", len))
+ if (!is.null(lower) && any(x < lower)) msg <- paste0(msg, sprintf("; all values must be greater than or equal to %s", lower))
+ if (!is.null(upper) && any(x > upper)) msg <- paste0(msg, sprintf("; all values must be less than or equal to %s", upper))
+ if (isTRUE(any(abs(x - round(x)) > (.Machine$double.eps)^0.5))) msg <- paste0(msg, "; all values must be close to integers")
+ stop(msg, call. = FALSE)
+ }
}
check_null <- function(x) {
- is.null(x)
+ is.null(x)
}
assert_null <- function(x, name = as.character(substitute(x))) {
- if (!isTRUE(check_null(x))) stop(sprintf("%s should be NULL.", name), call. = FALSE)
+ if (!isTRUE(check_null(x))) stop(sprintf("%s should be NULL.", name), call. = FALSE)
}
check_numeric <- function(x, len = NULL, lower = NULL, upper = NULL, null.ok = TRUE) {
- if (is.null(x) && isTRUE(null.ok)) {
- return(TRUE)
- }
- if (!is.numeric(x)) {
- return(FALSE)
- }
- if (!is.null(len) && length(x) != len) {
- return(FALSE)
- }
- if (!is.null(lower) && any(x < lower)) {
- return(FALSE)
- }
- if (!is.null(upper) && any(x > upper)) {
- return(FALSE)
- }
+ if (is.null(x) && isTRUE(null.ok)) {
return(TRUE)
+ }
+ if (!is.numeric(x)) {
+ return(FALSE)
+ }
+ if (!is.null(len) && length(x) != len) {
+ return(FALSE)
+ }
+ if (!is.null(lower) && any(x < lower)) {
+ return(FALSE)
+ }
+ if (!is.null(upper) && any(x > upper)) {
+ return(FALSE)
+ }
+ return(TRUE)
}
assert_numeric <- function(x, len = NULL, lower = NULL, upper = NULL, null.ok = FALSE, name = as.character(substitute(x))) {
- msg <- sprintf("`%s` must be numeric", name)
- if (!isTRUE(check_numeric(x, len = len, lower = lower, upper = upper, null.ok = null.ok))) {
- if (!is.null(len) && length(x) != len) msg <- paste0(msg, sprintf("; its length must be %s", len))
- if (!is.null(lower) && any(x < lower)) msg <- paste0(msg, sprintf("; all values must be greater than or equal to %s", lower))
- if (!is.null(upper) && any(x > upper)) msg <- paste0(msg, sprintf("; all values must be less than or equal to %s", upper))
- stop(msg, call. = FALSE)
- }
+ msg <- sprintf("`%s` must be numeric", name)
+ if (!isTRUE(check_numeric(x, len = len, lower = lower, upper = upper, null.ok = null.ok))) {
+ if (!is.null(len) && length(x) != len) msg <- paste0(msg, sprintf("; its length must be %s", len))
+ if (!is.null(lower) && any(x < lower)) msg <- paste0(msg, sprintf("; all values must be greater than or equal to %s", lower))
+ if (!is.null(upper) && any(x > upper)) msg <- paste0(msg, sprintf("; all values must be less than or equal to %s", upper))
+ stop(msg, call. = FALSE)
+ }
}
assert_data_frame <- function(x, min_rows = 0, min_cols = 0, name = as.character(substitute(x))) {
- msg <- sprintf("`%s` must be a data.frame.", name)
- if (!is.data.frame(x)) stop(msg, call. = FALSE)
- msg <- sprintf("Number of rows in `%s` must be at least `%s`", name, min_rows)
- if (nrow(x) < min_rows) stop(msg, call. = FALSE)
- msg <- sprintf("Number of columns in `%s` must be at least `%s`", name, min_cols)
- if (ncol(x) < min_cols) stop(msg, call. = FALSE)
+ msg <- sprintf("`%s` must be a data.frame.", name)
+ if (!is.data.frame(x)) stop(msg, call. = FALSE)
+ msg <- sprintf("Number of rows in `%s` must be at least `%s`", name, min_rows)
+ if (nrow(x) < min_rows) stop(msg, call. = FALSE)
+ msg <- sprintf("Number of columns in `%s` must be at least `%s`", name, min_cols)
+ if (ncol(x) < min_cols) stop(msg, call. = FALSE)
}
check_character <- function(x, len = NULL, null.ok = FALSE, name = as.character(substitute(x))) {
- if (isTRUE(null.ok) && is.null(x)) {
- return(TRUE)
- } else if (!is.character(x)) {
- msg <- sprintf("`%s` must be character.", name)
- return(msg)
- } else if (!is.null(len) && length(x) != len) {
- msg <- sprintf("`%s` must have length %s.", name, len)
- return(msg)
- }
+ if (isTRUE(null.ok) && is.null(x)) {
return(TRUE)
+ } else if (!is.character(x)) {
+ msg <- sprintf("`%s` must be character.", name)
+ return(msg)
+ } else if (!is.null(len) && length(x) != len) {
+ msg <- sprintf("`%s` must have length %s.", name, len)
+ return(msg)
+ }
+ return(TRUE)
}
assert_character <- function(x, len = NULL, null.ok = FALSE, name = as.character(substitute(x))) {
- flag <- check_character(x, len = len, null.ok = null.ok, name = name)
- if (!isTRUE(flag)) {
- stop(flag, call. = FALSE)
- } else {
- return(invisible(TRUE))
- }
+ flag <- check_character(x, len = len, null.ok = null.ok, name = name)
+ if (!isTRUE(flag)) {
+ stop(flag, call. = FALSE)
+ } else {
+ return(invisible(TRUE))
+ }
}
assert_list <- function(x, named = FALSE, len = NULL, null.ok = FALSE, name = as.character(substitute(x))) {
- if (isTRUE(null.ok) && is.null(x)) {
- return(invisible(TRUE))
- }
- if (!is.list(x)) stop("Input is not a list.", call. = FALSE)
- if (isTRUE(named)) {
- if (is.null(names(x))) {
- stop(sprintf("`%s` should be named list.", name), call. = FALSE)
- }
+ if (isTRUE(null.ok) && is.null(x)) {
+ return(invisible(TRUE))
+ }
+ if (!is.list(x)) stop("Input is not a list.", call. = FALSE)
+ if (isTRUE(named)) {
+ if (is.null(names(x))) {
+ stop(sprintf("`%s` should be named list.", name), call. = FALSE)
}
- if (!is.null(len)) {
- if (length(x) != len) {
- stop(sprintf("`%s` must be of length %s.", name, len), call. = FALSE)
- }
+ }
+ if (!is.null(len)) {
+ if (length(x) != len) {
+ stop(sprintf("`%s` must be of length %s.", name, len), call. = FALSE)
}
+ }
}
assert_function <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- if (isTRUE(null.ok) && is.null(x)) {
- return(invisible(TRUE))
- }
- if (!is.function(x)) {
- msg <- sprintf("`%s` must be a function.", name)
- stop(msg, call. = FALSE)
- }
+ if (isTRUE(null.ok) && is.null(x)) {
+ return(invisible(TRUE))
+ }
+ if (!is.function(x)) {
+ msg <- sprintf("`%s` must be a function.", name)
+ stop(msg, call. = FALSE)
+ }
}
check_atomic_vector <- function(x, null.ok = FALSE, name = as.character(substitute(x))) {
- if (isTRUE(null.ok) && is.null(x)) {
- return(invisible(TRUE))
- }
- # doesn't work on glue::glue() output
- # flag <- is.atomic(x) && is.vector(x) && !is.list(x)
- flag <- is.atomic(x) && is.null(dim(x)) && length(x) > 0 && !is.list(x)
- if (flag) {
- out <- TRUE
- } else if (is.factor(x) && is.null(dim(x))) {
- out <- TRUE
- } else {
- out <- sprintf("`%s` must be an atomic vector.", name)
- }
- return(out)
+ if (isTRUE(null.ok) && is.null(x)) {
+ return(invisible(TRUE))
+ }
+ # doesn't work on glue::glue() output
+ # flag <- is.atomic(x) && is.vector(x) && !is.list(x)
+ flag <- is.atomic(x) && is.null(dim(x)) && length(x) > 0 && !is.list(x)
+ if (flag) {
+ out <- TRUE
+ } else if (is.factor(x) && is.null(dim(x))) {
+ out <- TRUE
+ } else {
+ out <- sprintf("`%s` must be an atomic vector.", name)
+ }
+ return(out)
}
assert_class <- function(x, classname) {
- if (!inherits(x, classname)) {
- msg <- sprintf("`x` must be of class `%s`.", classname)
- stop(msg, call. = FALSE)
- }
+ if (!inherits(x, classname)) {
+ msg <- sprintf("`x` must be of class `%s`.", classname)
+ stop(msg, call. = FALSE)
+ }
}
sanitize_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)
- }
- }
- return(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)
+ }
+ }
+ return(notes)
}
sanitize_replace <- function(replace) {
- if (isTRUE(replace)) {
- replace <- stats::setNames(list(NA), "")
- } else if (isFALSE(replace)) {
- replace <- stats::setNames(list(NULL), "")
- } else if (isTRUE(check_string(replace))) {
- replace <- stats::setNames(list(NA), replace)
- } else if (!is.list(replace) || is.null(names(replace))) {
- stop("`replace` should be TRUE/FALSE, a single string, or a named list.", call. = FALSE)
- }
- return(replace)
+ if (isTRUE(replace)) {
+ replace <- stats::setNames(list(NA), "")
+ } else if (isFALSE(replace)) {
+ replace <- stats::setNames(list(NULL), "")
+ } else if (isTRUE(check_string(replace))) {
+ replace <- stats::setNames(list(NA), replace)
+ } else if (!is.list(replace) || is.null(names(replace))) {
+ stop("`replace` should be TRUE/FALSE, a single string, or a named list.", call. = FALSE)
+ }
+ return(replace)
}
sanity_num_mark <- function(digits, num_mark_big, num_mark_dec) {
- if (is.null(digits)) {
- if (num_mark_big != "") stop("`num_mark_big` requires a `digits` value.", call. = FALSE)
- if (num_mark_dec != ".") stop("`num_mark_dec` requires a `digits` value.", call. = FALSE)
- }
+ if (is.null(digits)) {
+ if (num_mark_big != "") stop("`num_mark_big` requires a `digits` value.", call. = FALSE)
+ if (num_mark_dec != ".") stop("`num_mark_dec` requires a `digits` value.", call. = FALSE)
+ }
}
diff --git a/R/save_tt.R b/R/save_tt.R
index e68b5cb9..b11caee4 100644
--- a/R/save_tt.R
+++ b/R/save_tt.R
@@ -10,6 +10,9 @@
#' the images are included in the HTML as base64 encoded string instead of link to a local file.
#' @param overwrite A logical value indicating whether to overwrite an existing file.
#' @return A string with the table when `output` is a format, and the file path when `output` is a valid path.
+#' @template dependencies
+#' @template latex_preamble
+#' @template global_options
#' @export
#' @examples
#' library(tinytable)
@@ -23,7 +26,7 @@
#' tt(mtcars[1:4, 1:4]) |> save_tt(filename)
#'
save_tt <- function(x,
- output,
+ output,
overwrite = get_option("tinytable_save_overwrite", default = FALSE)) {
assert_class(x, "tinytable")
assert_string(output)
@@ -34,8 +37,8 @@ save_tt <- function(x,
}
if (isTRUE(getOption("tinytable_html_portable", default = FALSE))) {
- assert_dependency("base64enc")
- x@portable <- TRUE
+ assert_dependency("base64enc")
+ x@portable <- TRUE
}
if (identical(output, "html_portable")) {
@@ -97,7 +100,8 @@ save_tt <- function(x,
file = output,
selector = "body > div > table",
zoom = 4,
- quiet = TRUE)
+ quiet = TRUE
+ )
unlink(tmp)
} else if (file_ext == "pdf") {
assert_dependency("tinytex")
@@ -154,6 +158,7 @@ latex_standalone <- "
\\usepackage{rotating}
\\usepackage{float}
\\usepackage[normalem]{ulem}
+\\usepackage[x11names, svgnames]{xcolor}
\\UseTblrLibrary{booktabs}
\\UseTblrLibrary{siunitx}
\\newcommand{\\tinytableTabularrayUnderline}[1]{\\underline{#1}}
diff --git a/R/style_bootstrap.R b/R/style_bootstrap.R
index fbd2b7b3..d93ef289 100644
--- a/R/style_bootstrap.R
+++ b/R/style_bootstrap.R
@@ -29,103 +29,104 @@ setMethod(
bootstrap_css = NULL,
bootstrap_css_rule = NULL,
...) {
-
-
- if (length(x@bootstrap_css_rule) == 1) {
- x@table_string <- bootstrap_setting(x@table_string, x@bootstrap_css_rule, component = "css")
- }
-
- sty <- x@style
-
- sty$alignv[which(sty$alignv == "t")] <- "top"
- sty$alignv[which(sty$alignv == "b")] <- "bottom"
- sty$alignv[which(sty$alignv == "m")] <- "middle"
-
- sty$align[which(sty$align == "l")] <- "left"
- sty$align[which(sty$align == "c")] <- "center"
- sty$align[which(sty$align == "d")] <- "center"
- sty$align[which(sty$align == "r")] <- "right"
-
- rec <- expand.grid(
- i = c(-(seq_len(x@nhead) - 1), seq_len(x@nrow)),
- j = seq_len(x@ncol)
- )
- css <- rep("", nrow(rec))
-
- for (row in seq_len(nrow(sty))) {
-
- # index: sty vs rec
- idx_i <- sty$i[row]
- if (is.na(idx_i)) idx_i <- unique(rec$i)
- idx_j <- sty$j[row]
- if (is.na(idx_j)) idx_j <- unique(rec$j)
- idx <- rec$i == idx_i & rec$j == idx_j
-
- if (isTRUE(sty[row, "bold"])) css[idx] <- paste(css[idx], "font-weight: bold;")
- if (isTRUE(sty[row, "italic"])) css[idx] <- paste(css[idx], "font-style: italic;")
- if (isTRUE(sty[row, "underline"])) css[idx] <- paste(css[idx], "text-decoration: underline;")
- if (isTRUE(sty[row, "strikeout"])) css[idx] <- paste(css[idx], "text-decoration: line-through;")
- if (isTRUE(sty[row, "monospace"])) css[idx] <- paste(css[idx], "font-family: monospace;")
- if (!is.na(sty[row, "color"])) css[idx] <- paste(css[idx], paste0("color: ", sty[row, "color"], ";"))
- if (!is.na(sty[row, "background"])) css[idx] <- paste(css[idx], paste0("background-color: ", sty[row, "background"], ";"))
- if (!is.na(sty[row, "fontsize"])) css[idx] <- paste(css[idx], paste0("font-size: ", sty[row, "fontsize"], "em;"))
- if (!is.na(sty[row, "alignv"])) css[idx] <- paste(css[idx], paste0("vertical-align: ", sty[row, "alignv"], ";"))
- if (!is.na(sty[row, "align"])) css[idx] <- paste(css[idx], paste0("text-align: ", sty[row, "align"], ";"))
- if (!is.na(sty[row, "indent"])) css[idx] <- paste(css[idx], paste0("padding-left: ", sty[row, "indent"], "em;"))
- if (!is.na(sty[row, "bootstrap_css"])) css[idx] <- paste(css[idx], sty[row, "bootstrap_css"])
-
- lin <- ""
- line <- sty$line[row]
- line_width <- sty$line_width[row]
- line_color <- sty$line_color[row]
- line_color <- if (is.na(line_color)) "black" else line_color
- line_width <- if (is.na(line_width)) 0.1 else line_width
- left <- grepl("l", line)
- right <- grepl("r",line)
- top <- grepl("t", line)
- bottom <- grepl("b", line)
- if (all(c(left, right, top, bottom))) {
- template <- "border: solid %s %sem;"
- } else if (any(c(left, right, top, bottom))) {
- template <- "border: solid %s %sem;"
- if (left) template <- "border-left: solid %s %sem;"
- if (right) template <- "border-right: solid %s %sem;"
- if (top) template <- "border-top: solid %s %sem;"
- if (bottom) template <- "border-bottom: solid %s %sem;"
- } else {
- template <- ""
+ if (length(x@bootstrap_css_rule) == 1) {
+ x@table_string <- bootstrap_setting(x@table_string, x@bootstrap_css_rule, component = "css")
}
- if (template != "") {
- lin <- paste(lin, sprintf(template, line_color, line_width))
+
+ sty <- x@style
+
+
+ sty$alignv[which(sty$alignv == "t")] <- "top"
+ sty$alignv[which(sty$alignv == "b")] <- "bottom"
+ sty$alignv[which(sty$alignv == "m")] <- "middle"
+
+ sty$align[which(sty$align == "l")] <- "left"
+ sty$align[which(sty$align == "c")] <- "center"
+ sty$align[which(sty$align == "d")] <- "center"
+ sty$align[which(sty$align == "r")] <- "right"
+
+ rec <- expand.grid(
+ i = c(-(seq_len(x@nhead) - 1), seq_len(x@nrow)),
+ j = seq_len(x@ncol)
+ )
+ css <- rep("", nrow(rec))
+
+ for (row in seq_len(nrow(sty))) {
+ # index: sty vs rec
+ idx_i <- sty$i[row]
+ if (is.na(idx_i)) idx_i <- unique(rec$i)
+ idx_j <- sty$j[row]
+ if (is.na(idx_j)) idx_j <- unique(rec$j)
+ idx <- rec$i == idx_i & rec$j == idx_j
+
+ if (isTRUE(sty[row, "bold"])) css[idx] <- paste(css[idx], "font-weight: bold;")
+ if (isTRUE(sty[row, "italic"])) css[idx] <- paste(css[idx], "font-style: italic;")
+ if (isTRUE(sty[row, "underline"])) css[idx] <- paste(css[idx], "text-decoration: underline;")
+ if (isTRUE(sty[row, "strikeout"])) css[idx] <- paste(css[idx], "text-decoration: line-through;")
+ if (isTRUE(sty[row, "monospace"])) css[idx] <- paste(css[idx], "font-family: monospace;")
+ if (!is.na(sty[row, "color"])) css[idx] <- paste(css[idx], paste0("color: ", sty[row, "color"], ";"))
+ if (!is.na(sty[row, "background"])) css[idx] <- paste(css[idx], paste0("background-color: ", sty[row, "background"], ";"))
+ if (!is.na(sty[row, "fontsize"])) css[idx] <- paste(css[idx], paste0("font-size: ", sty[row, "fontsize"], "em;"))
+ if (!is.na(sty[row, "alignv"])) css[idx] <- paste(css[idx], paste0("vertical-align: ", sty[row, "alignv"], ";"))
+ if (!is.na(sty[row, "align"])) css[idx] <- paste(css[idx], paste0("text-align: ", sty[row, "align"], ";"))
+ if (!is.na(sty[row, "indent"])) css[idx] <- paste(css[idx], paste0("padding-left: ", sty[row, "indent"], "em;"))
+ if (!is.na(sty[row, "bootstrap_css"])) css[idx] <- paste(css[idx], sty[row, "bootstrap_css"])
+
+ lin <- ""
+ line <- sty$line[row]
+ line_width <- sty$line_width[row]
+ line_color <- sty$line_color[row]
+ line_color <- if (is.na(line_color)) "black" else line_color
+ line_width <- if (is.na(line_width)) 0.1 else line_width
+ left <- grepl("l", line)
+ right <- grepl("r", line)
+ top <- grepl("t", line)
+ bottom <- grepl("b", line)
+ if (all(c(left, right, top, bottom))) {
+ template <- "border: solid %s %sem;"
+ } else if (any(c(left, right, top, bottom))) {
+ template <- "border: solid %s %sem;"
+ if (left) template <- "border-left: solid %s %sem;"
+ if (right) template <- "border-right: solid %s %sem;"
+ if (top) template <- "border-top: solid %s %sem;"
+ if (bottom) template <- "border-bottom: solid %s %sem;"
+ } else {
+ template <- ""
+ }
+ if (template != "") {
+ lin <- paste(lin, sprintf(template, line_color, line_width))
+ }
+ css[idx] <- paste(css[idx], lin)
}
- css[idx] <- paste(css[idx], lin)
- }
- css <- gsub(" +", " ", trimws(css))
+ css <- gsub(" +", " ", trimws(css))
- # JS 0-indexing
- rec$i <- rec$i - 1 + x@nhead
- rec$j <- rec$j - 1
+ # JS 0-indexing
+ rec$i <- rec$i - 1 + x@nhead
+ rec$j <- rec$j - 1
- # spans: before styles because we return(x) if there is no style
- for (row in seq_len(nrow(sty))) {
- rowspan <- if (!is.na(sty$rowspan[row])) sty$rowspan[row] else 1
- colspan <- if (!is.na(sty$colspan[row])) sty$colspan[row] else 1
- if (rowspan > 1 || colspan > 1) {
- id <- get_id(stem = "spanCell_")
- listener <- " window.addEventListener('load', function () { %s(%s, %s, %s, %s) })"
- listener <- sprintf(listener, id, sty$i[row], sty$j[row] - 1, rowspan, colspan)
- x@table_string <- lines_insert(x@table_string, listener, "tinytable span after", "after")
- # x@table_string <- bootstrap_setting(x@table_string, listener, component = "cell")
+ # spans: before styles because we return(x) if there is no style
+ for (row in seq_len(nrow(sty))) {
+ rowspan <- if (!is.na(sty$rowspan[row])) sty$rowspan[row] else 1
+ colspan <- if (!is.na(sty$colspan[row])) sty$colspan[row] else 1
+ if (rowspan > 1 || colspan > 1) {
+ id <- get_id(stem = "spanCell_")
+ listener <- " window.addEventListener('load', function () { %s(%s, %s, %s, %s) })"
+ listener <- sprintf(listener, id, sty$i[row], sty$j[row] - 1, rowspan, colspan)
+ x@table_string <- lines_insert(x@table_string, listener, "tinytable span after", "after")
+ # x@table_string <- bootstrap_setting(x@table_string, listener, component = "cell")
+ }
}
- }
- rec$css_arguments <- css
- rec <- rec[rec$css_arguments != "", , drop = FALSE]
- if (nrow(rec) == 0) return(x)
- # rowspan + colspan delete cells
+ rec$css_arguments <- css
+ rec <- rec[rec$css_arguments != "", , drop = FALSE]
+ if (nrow(rec) == 0) {
+ return(x)
+ }
+
+ # rowspan + colspan delete cells
bad <- data.frame()
idx <- which(!is.na(sty$i) & !is.na(sty$j) & (!is.na(sty$rowspan) | !is.na(sty$colspan)))
idx <- sty[idx, c("i", "j", "rowspan", "colspan"), drop = FALSE]
@@ -149,7 +150,6 @@ setMethod(
rec <- rec[-which(rec$deleted == TRUE),]
}
-
# Unique CSS arguments assigne by arrays
css_table <- unique(rec[, c("css_arguments"), drop = FALSE])
css_table$id_css <- sapply(seq_len(nrow(css_table)), function(i) get_id(stem = "tinytable_css_"))
@@ -167,7 +167,6 @@ setMethod(
}
}
- return(x)
-})
-
-
+ return(x)
+ }
+)
diff --git a/R/style_grid.R b/R/style_grid.R
index ab213ee2..97c8e9fa 100644
--- a/R/style_grid.R
+++ b/R/style_grid.R
@@ -1,10 +1,10 @@
style_eval_grid <- function(x) {
-
-
out <- x@table_dataframe
sty <- x@style
- if (nrow(sty) == 0) return(x)
+ if (nrow(sty) == 0) {
+ return(x)
+ }
all_i <- seq_len(nrow(x))
idx_g <- x@group_i_idx + cumsum(rep(1, length(x@group_i_idx))) - 1
@@ -15,13 +15,17 @@ style_eval_grid <- function(x) {
alli <- data.frame(i = seq_len(nrow(x)))
alli <- merge(alli, sty[is.na(sty$i), colnames(sty) != "i"], all = TRUE)
sty <- rbind(sty, alli)
- sty <- sty[!is.na(sty$i),]
- sty <- sty[order(sty$i, sty$j),]
+ sty <- sty[!is.na(sty$i), ]
+ sty <- sty[order(sty$i, sty$j), ]
}
-
+
last <- function(k) {
- if (all(is.na(k))) return(NA)
- if (is.logical(k)) return(as.logical(max(k, na.rm = TRUE)))
+ if (all(is.na(k))) {
+ return(NA)
+ }
+ if (is.logical(k)) {
+ return(as.logical(max(k, na.rm = TRUE)))
+ }
return(utils::tail(stats::na.omit(k), 1))
}
sty <- do.call(rbind, by(sty, list(sty$i, sty$j), function(k) {
@@ -29,12 +33,14 @@ style_eval_grid <- function(x) {
}))
# TODO: style groups
- sty <- sty[which(!sty$i %in% idx_g),]
+ sty <- sty[which(!sty$i %in% idx_g), ]
- if (nrow(sty) == 0) return(x)
+ if (nrow(sty) == 0) {
+ return(x)
+ }
# user-supplied indices are post-groups
- # adjust indices to match original data rows since we only operate on those
+ # adjust indices to match original data rows since we only operate on those
for (g in rev(idx_g)) {
sty[sty$i > g, "i"] <- sty[sty$i > g, "i"] - 1
}
@@ -83,10 +89,10 @@ style_eval_grid <- function(x) {
#' tinytable S4 method
-#'
+#'
#' @keywords internal
setMethod(
- f = "style_eval",
- signature = "tinytable_grid",
- definition = style_eval_grid
+ f = "style_eval",
+ signature = "tinytable_grid",
+ definition = style_eval_grid
)
diff --git a/R/style_grid_dataframe.R b/R/style_grid_dataframe.R
index 7e59d869..03d336ce 100644
--- a/R/style_grid_dataframe.R
+++ b/R/style_grid_dataframe.R
@@ -1,25 +1,28 @@
#' tinytable S4 method
-#'
+#'
#' @keywords internal
-setMethod(f = "style_eval",
- signature = "tinytable_dataframe",
- definition = style_eval_grid
+setMethod(
+ f = "style_eval",
+ signature = "tinytable_dataframe",
+ definition = style_eval_grid
)
#' tinytable S4 method
-#'
+#'
#' @keywords internal
-setMethod(f = "group_eval",
- signature = "tinytable_dataframe",
- definition = identity
+setMethod(
+ f = "group_eval",
+ signature = "tinytable_dataframe",
+ definition = identity
)
#' tinytable S4 method
-#'
+#'
#' @keywords internal
-setMethod(f = "finalize",
- signature = "tinytable_dataframe",
- definition = identity
+setMethod(
+ f = "finalize",
+ signature = "tinytable_dataframe",
+ definition = identity
)
diff --git a/R/style_notes.R b/R/style_notes.R
new file mode 100644
index 00000000..e69de29b
diff --git a/R/style_string.R b/R/style_string.R
new file mode 100644
index 00000000..4e009fc7
--- /dev/null
+++ b/R/style_string.R
@@ -0,0 +1,108 @@
+style_string_html <- function(n, styles) {
+ if (isTRUE(styles[["italic"]])) {
+ n <- sprintf("%s", n)
+ }
+ if (isTRUE(styles[["strikeout"]])) {
+ n <- sprintf("%s", n)
+ }
+ if (isTRUE(styles[["underline"]])) {
+ n <- sprintf("%s", n)
+ }
+ if (isTRUE(styles[["bold"]])) {
+ n <- sprintf("%s", n)
+ }
+ if (isTRUE(styles[["monospace"]])) {
+ n <- sprintf("%s", n)
+ }
+ if (!is.null(styles[["color"]])) {
+ n <- sprintf("%s", styles[["color"]], n)
+ }
+ if (!is.null(styles[["fontsize"]])) {
+ n <- sprintf("%s", styles[["fontsize"]], n)
+ }
+ n
+}
+
+
+style_string_latex <- function(n, styles) {
+ if (isTRUE(styles[["italic"]])) {
+ n <- sprintf("\\textit{%s}", n)
+ }
+ if (isTRUE(styles[["strikeout"]])) {
+ n <- sprintf("\\sout{%s}", n)
+ }
+ if (isTRUE(styles[["underline"]])) {
+ n <- sprintf("\\underline{%s}", n)
+ }
+ if (isTRUE(styles[["bold"]])) {
+ n <- sprintf("\\textbf{%s}", n)
+ }
+ if (isTRUE(styles[["monospace"]])) {
+ n <- sprintf("\\texttt{%s}", n)
+ }
+ if (!is.null(styles[["color"]])) {
+ n <- sprintf("\\textcolor{%s}{%s}", styles[["color"]], n)
+ }
+ if (!is.null(styles[["fontsize"]])) {
+ n <- sprintf("{\\fontsize{%sem}{%sem}\\selectfont %s}", styles[["fontsize"]], styles[["fontsize"]], n)
+ }
+ n
+}
+
+
+style_string_typst <- function(n, styles) {
+ sty <- NULL
+ if (isTRUE(styles[["italic"]])) {
+ sty <- c(sty, 'style: "italic"')
+ }
+ if (isTRUE(styles[["bold"]])) {
+ sty <- c(sty, 'weight: "bold"')
+ }
+ if (isTRUE(styles[["strikeout"]])) {
+ # not sure how to do this
+ }
+ if (isTRUE(styles[["underline"]])) {
+ # not sure how to do this
+ }
+ if (!is.null(styles[["fontsize"]])) {
+ fs <- sprintf("size: %sem", styles[["fontsize"]])
+ sty <- c(sty, fs)
+ }
+ if (!is.null(styles[["color"]])) {
+ col <- styles[["color"]]
+ if (grepl("^#", col)) col <- sprintf('rgb("%s")', col)
+ col <- sprintf("fill: %s", col)
+ sty <- c(sty, col)
+ }
+ template <- paste0("text(", paste(sty, collapse = ", "), ", [%s])")
+ out <- sprintf(template, n)
+ out <- sub("text(, ", "text(", out, fixed = TRUE)
+ return(out)
+}
+
+
+style_notes <- function(x) {
+ fun <- switch(x@output,
+ "typst" = style_string_typst,
+ "html" = style_string_html,
+ "html_portable" = style_string_html,
+ "latex" = style_string_latex,
+ function(k, ...) identity(k)
+ )
+ x@notes <- lapply(x@notes, fun, x@style_notes)
+ return(x)
+}
+
+style_caption <- function(x) {
+ fun <- switch(x@output,
+ "typst" = style_string_typst,
+ "html" = style_string_html,
+ "html_portable" = style_string_html,
+ "latex" = style_string_latex,
+ function(k, ...) identity(k)
+ )
+ if (length(x@caption) > 0) {
+ x@caption <- fun(x@caption, x@style_caption)
+ }
+ return(x)
+}
diff --git a/R/style_tabularray.R b/R/style_tabularray.R
index d6ec2932..c3f14936 100644
--- a/R/style_tabularray.R
+++ b/R/style_tabularray.R
@@ -23,226 +23,239 @@ setMethod(
tabularray_inner = NULL,
tabularray_outer = NULL,
...) {
-
- sty <- x@style
- sty$i <- sty$i + x@nhead
-
- rec <- expand.grid(
- i = c(seq_len(x@nrow + x@nhead)),
- j = seq_len(x@ncol),
- line = NA,
- line_color = NA,
- line_width = NA
- )
-
- sty$alignv[which(sty$alignv == "b")] <- "f"
- sty$alignv[which(sty$alignv == "t")] <- "h"
- sty$alignv[which(sty$alignv == "m")] <- "m"
-
- for (spec in stats::na.omit(sty$tabularray_inner)) {
- x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
- }
-
- for (spec in stats::na.omit(sty$tabularray_outer)) {
- x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
- }
-
- set <- span <- rep("", nrow(rec))
-
- for (row in seq_len(nrow(sty))) {
-
- # index: sty vs rec
- idx_i <- sty$i[row]
- if (is.na(idx_i)) idx_i <- unique(rec$i)
- idx_j <- sty$j[row]
- if (is.na(idx_j)) idx_j <- unique(rec$j)
- idx <- rec$i == idx_i & rec$j == idx_j
-
- cmd <- ""
- if (isTRUE(sty$bold[row])) cmd <- paste0(cmd, "\\bfseries")
- if (isTRUE(sty$italic[row])) cmd <- paste0(cmd, "\\textit")
- if (isTRUE(sty$underline[row])) cmd <- paste0(cmd, "\\tinytableTabularrayUnderline")
- if (isTRUE(sty$strikeout[row])) cmd <- paste0(cmd, "\\tinytableTabularrayStrikeout")
- if (isTRUE(sty$monospace[row])) cmd <- paste0(cmd, "\\texttt")
-
- col <- sty$color[row]
- if (!is.na(col)) {
- x <- color_to_preamble(x, col)
- if (grepl("^#", col)) col <- sub("^#", "c", col)
- cmd <- sprintf("%s, fg=%s", cmd, col)
- }
-
- bg <- sty$background[row]
- if (!is.na(bg)) {
- x <- color_to_preamble(x, bg)
- if (grepl("^#", bg)) bg <- sub("^#", "c", bg)
- cmd <- sprintf("%s, bg=%s", cmd, bg)
+ sty <- x@style
+ sty$i <- sty$i + x@nhead
+
+ rec <- expand.grid(
+ i = c(seq_len(x@nrow + x@nhead)),
+ j = seq_len(x@ncol),
+ line = NA,
+ line_color = NA,
+ line_width = NA
+ )
+
+ sty$alignv[which(sty$alignv == "b")] <- "f"
+ sty$alignv[which(sty$alignv == "t")] <- "h"
+ sty$alignv[which(sty$alignv == "m")] <- "m"
+
+ set <- span <- rep("", nrow(rec))
+
+ # d-column are column-wise, so we treat them here
+ if (nrow(sty) > 0) {
+ dcol_j <- sty[grepl("^d$", sty[["align"]]), "j"]
+ dcol_j <- if (length(dcol_j) == 0) NULL else unique(dcol_j)
+ for (idx_j in dcol_j) {
+ spec <- get_dcolumn(idx_j, x)
+ spec <- sprintf("column{%s}={%s}\n", idx_j, spec)
+ x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
+ for (idx_i in seq_len(x@nhead)) {
+ spec <- paste(sprintf("cell{%s}{%s}={guard,halign=c,},", idx_i, idx_j), collapse = "\n")
+ x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
+ }
+ }
}
- if (grepl("^,", cmd)) {
+ for (row in seq_len(nrow(sty))) {
+ # index: sty vs rec
+ idx_i <- sty$i[row]
+ if (is.na(idx_i)) idx_i <- unique(rec$i)
+ idx_j <- sty$j[row]
+ if (is.na(idx_j)) idx_j <- unique(rec$j)
+ idx <- rec$i == idx_i & rec$j == idx_j
+
+ cmd <- ""
+ if (isTRUE(sty$bold[row])) cmd <- paste0(cmd, "\\bfseries")
+ if (isTRUE(sty$italic[row])) cmd <- paste0(cmd, "\\textit")
+ if (isTRUE(sty$underline[row])) cmd <- paste0(cmd, "\\tinytableTabularrayUnderline")
+ if (isTRUE(sty$strikeout[row])) cmd <- paste0(cmd, "\\tinytableTabularrayStrikeout")
+ if (isTRUE(sty$monospace[row])) cmd <- paste0(cmd, "\\texttt")
+
+ col <- sty$color[row]
+ if (!is.na(col)) {
+ x <- color_to_preamble(x, col)
+ if (grepl("^#", col)) col <- sub("^#", "c", col)
+ cmd <- sprintf("%s, fg=%s", cmd, col)
+ }
+
+ bg <- sty$background[row]
+ if (!is.na(bg)) {
+ x <- color_to_preamble(x, bg)
+ if (grepl("^#", bg)) bg <- sub("^#", "c", bg)
+ cmd <- sprintf("%s, bg=%s", cmd, bg)
+ }
+
+ if (grepl("^,", cmd)) {
tmp <- "%s, %s, "
- } else {
+ } else {
tmp <- "%s, cmd=%s, "
+ }
+ if (trimws(cmd) != "") set[idx] <- sprintf(tmp, set[idx], cmd)
+
+ fontsize <- sty$fontsize[row]
+ if (!is.na(as.numeric(fontsize))) {
+ set[idx] <- sprintf(
+ "%s font=\\fontsize{%sem}{%sem}\\selectfont,",
+ set[idx], fontsize, fontsize + 0.3
+ )
+ }
+
+ halign <- sty$align[row]
+ if (!is.na(halign) && !grepl("d", halign)) {
+ set[idx] <- sprintf("%s, halign=%s,", set[idx], halign)
+ }
+
+ alignv <- sty$alignv[row]
+ if (!is.na(alignv)) {
+ set[idx] <- sprintf("%s, valign=%s,", set[idx], alignv)
+ }
+
+ indent <- sty$indent[row]
+ if (isTRUE(indent > 0)) {
+ set[idx] <- sprintf("%s preto={\\hspace{%sem}},", set[idx], indent)
+ }
+
+ if (!is.na(sty$colspan[row])) {
+ span[idx] <- paste0(span[idx], "c=", sty$colspan[row], ",")
+ }
+
+ if (!is.na(sty$rowspan[row])) {
+ span[idx] <- paste0(span[idx], "r=", sty$rowspan[row], ",")
+ }
+
+ if (!is.na(sty$line[row])) {
+ rec$line[idx] <- sty$line[row]
+ }
+
+ if (!is.na(sty$line_color[row])) {
+ rec$line_color[idx] <- sty$line_color[row]
+ }
+
+ if (!is.na(sty$line_width[row])) {
+ rec$line_width[idx] <- sty$line_width[row]
+ }
}
- if (trimws(cmd) != "") set[idx] <- sprintf(tmp, set[idx], cmd)
- fontsize <- sty$fontsize[row]
- if (!is.na(as.numeric(fontsize))) {
- set[idx] <- sprintf(
- "%s font=\\fontsize{%sem}{%sem}\\selectfont,",
- set[idx], fontsize, fontsize + 0.3)
+ clean <- function(k) {
+ k <- gsub("\\s*", "", k)
+ k <- gsub(",+", ",", k)
+ k <- gsub("^,", "", k, perl = TRUE)
+ k <- gsub(",", ", ", k)
+ k <- trimws(k)
+ return(k)
}
- halign <- sty$align[row]
- if (!is.na(halign)) {
- if (!identical(halign, "d")) {
- set[idx] <- sprintf("%s, halign=%s,", set[idx], halign)
- } else {
- dcol <- get_dcolumn(rec[row, "j"], x)
- set[idx] <- sprintf("%s, %s", set[idx], dcol)
- }
- }
-
- alignv <- sty$alignv[row]
- if (!is.na(alignv)) {
- set[idx] <- sprintf("%s, valign=%s,", set[idx], alignv)
+ rec$set <- clean(set)
+ rec$span <- clean(span)
+
+ all_i <- seq_len(x@nrow + x@nhead)
+ all_j <- seq_len(x@ncol)
+
+ # complete rows and columns
+ rec <- do.call(rbind, by(rec, list(rec$j, rec$set, rec$span), function(k) {
+ transform(k, complete_column = all(all_i %in% k$i))
+ }))
+ rec <- do.call(rbind, by(rec, list(rec$i, rec$set, rec$span), function(k) {
+ transform(k, complete_row = all(all_j %in% k$j))
+ }))
+
+ idx <- rec$span != "" | rec$set != ""
+
+ # complete columns (first because of d-column)
+ cols <- unique(rec[idx & rec$complete_column, c("j", "set", "span"), drop = FALSE])
+ spec <- by(cols, list(cols$set, cols$span), function(k) {
+ sprintf("column{%s}={%s}{%s}", paste(k$j, collapse = ","), k$span, k$set)
+ })
+ spec <- unique(as.vector(unlist(spec)))
+ for (s in spec) {
+ x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
}
- indent <- sty$indent[row]
- if (isTRUE(indent > 0)) {
- set[idx] <- sprintf("%s preto={\\hspace{%sem}},", set[idx], indent)
+ # complete rows
+ rows <- unique(rec[
+ idx & rec$complete_row & !rec$complete_column,
+ c("i", "set", "span"),
+ drop = FALSE
+ ])
+ spec <- by(rows, list(rows$set, rows$span), function(k) {
+ sprintf("row{%s}={%s}{%s}", paste(k$i, collapse = ","), k$span, k$set)
+ })
+ spec <- unique(as.vector(unlist(spec)))
+ for (s in spec) {
+ x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
}
- if (!is.na(sty$colspan[row])) {
- span[idx] <- paste0(span[idx], "c=", sty$colspan[row], ",")
+ # cells
+ cells <- unique(rec[idx & !rec$complete_row & !rec$complete_column, , drop = FALSE])
+ spec <- sprintf("cell{%s}{%s}={%s}{%s}", cells$i, cells$j, cells$span, cells$set)
+ spec <- unique(as.vector(unlist(spec)))
+ for (s in spec) {
+ x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
}
- if (!is.na(sty$rowspan[row])) {
- span[idx] <- paste0(span[idx], "r=", sty$rowspan[row], ",")
+ # lines
+ rec$lin <- "solid, "
+ rec$lin <- ifelse(!is.na(rec$line_color),
+ paste0(rec$lin, rec$line_color), rec$lin
+ )
+ rec$lin <- ifelse(!is.na(rec$line_width),
+ paste0(rec$lin, sprintf(", %sem", rec$line_width)), rec$lin
+ )
+ rec$lin[is.na(rec$line)] <- NA
+
+ # horizontal lines
+ horizontal <- rec[grepl("b|t", rec$line), c("i", "j", "lin", "line"), drop = FALSE]
+ horizontal <- rbind(
+ horizontal[grepl("t", horizontal$line), , drop = FALSE],
+ transform(horizontal[grepl("b", horizontal$line), , drop = FALSE], i = i + 1)
+ )
+ spec <- by(horizontal, list(horizontal$i, horizontal$lin), function(k) {
+ jval <- paste(sort(unique(k$j)), collapse = ",")
+ sprintf("hline{%s}={%s}{%s}", k$i, jval, k$lin)
+ })
+ spec <- unique(as.vector(unlist(spec)))
+ for (s in spec) {
+ x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
}
- if (!is.na(sty$line[row])) {
- rec$line[idx] <- sty$line[row]
+ # vertical lines
+ vertical <- rec[grepl("l|r", rec$line), c("i", "j", "lin", "line"), drop = FALSE]
+ vertical <- rbind(
+ vertical[grepl("l", vertical$line), , drop = FALSE],
+ transform(vertical[grepl("r", vertical$line), , drop = FALSE], j = j + 1)
+ )
+ spec <- by(vertical, list(vertical$j, vertical$lin), function(k) {
+ ival <- paste(sort(unique(k$i)), collapse = ",")
+ sprintf("vline{%s}={%s}{%s}", k$j, ival, k$lin)
+ })
+ spec <- unique(as.vector(unlist(spec)))
+ for (s in spec) {
+ x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
}
- if (!is.na(sty$line_color[row])) {
- rec$line_color[idx] <- sty$line_color[row]
+ for (spec in unique(stats::na.omit(sty$tabularray_inner))) {
+ x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
}
- if (!is.na(sty$line_width[row])) {
- rec$line_width[idx] <- sty$line_width[row]
+ for (spec in unique(stats::na.omit(sty$tabularray_outer))) {
+ x@table_string <- tabularray_insert(x@table_string, content = spec, type = "inner")
}
- }
- clean <- function(k) {
- k <- gsub("\\s*", "", k)
- k <- gsub(",+", ",", k)
- k <- gsub("^,", "", k, perl = TRUE)
- k <- gsub(",", ", ", k)
- k <- trimws(k)
- return(k)
- }
- rec$set <- clean(set)
- rec$span <- clean(span)
-
- all_i <- seq_len(x@nrow + x@nhead)
- all_j <- seq_len(x@ncol)
-
- # complete rows and columns
- rec <- do.call(rbind, by(rec, list(rec$j, rec$set, rec$span), function(k) {
- transform(k, complete_column = all(all_i %in% k$i))
- }))
- rec <- do.call(rbind, by(rec, list(rec$i, rec$set, rec$span), function(k) {
- transform(k, complete_row = all(all_j %in% k$j))
- }))
-
- idx <- rec$span != "" | rec$set != ""
-
- # complete columns (first because of d-column)
- cols <- unique(rec[idx & rec$complete_column, c("j", "set", "span"), drop = FALSE])
- spec <- by(cols, list(cols$set, cols$span), function(k) {
- sprintf("column{%s}={%s}{%s}", paste(k$j, collapse = ","), k$span, k$set)
- })
- spec <- unique(as.vector(unlist(spec)))
- for (s in spec) {
- x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
+ return(x)
}
-
- # complete rows
- rows <- unique(rec[
- idx & rec$complete_row & !rec$complete_column,
- c("i", "set", "span"),
- drop = FALSE])
- spec <- by(rows, list(rows$set, rows$span), function(k) {
- sprintf("row{%s}={%s}{%s}", paste(k$i, collapse = ","), k$span, k$set)
- })
- spec <- unique(as.vector(unlist(spec)))
- for (s in spec) {
- x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
- }
-
- # cells
- cells <- unique(rec[idx & !rec$complete_row & !rec$complete_column, , drop = FALSE])
- spec <- sprintf("cell{%s}{%s}={%s}{%s}", cells$i, cells$j, cells$span, cells$set)
- spec <- unique(as.vector(unlist(spec)))
- for (s in spec) {
- x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
- }
-
- # lines
- rec$lin <- "solid, "
- rec$lin <- ifelse(!is.na(rec$line_color),
- paste0(rec$lin, rec$line_color), rec$lin)
- rec$lin <- ifelse(!is.na(rec$line_width),
- paste0(rec$lin, sprintf(", %sem", rec$line_width)), rec$lin)
- rec$lin[is.na(rec$line)] <- NA
-
- # horizontal lines
- horizontal <- rec[grepl("b|t", rec$line), c("i", "j", "lin", "line"), drop = FALSE]
- horizontal <- rbind(
- horizontal[grepl("t", horizontal$line),, drop = FALSE],
- transform(horizontal[grepl("b", horizontal$line),, drop = FALSE], i = i + 1)
- )
- spec <- by(horizontal, list(horizontal$i, horizontal$lin), function(k) {
- jval <- paste(sort(unique(k$j)), collapse = ",")
- sprintf("hline{%s}={%s}{%s}", k$i, jval, k$lin)
- })
- spec <- unique(as.vector(unlist(spec)))
- for (s in spec) {
- x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
- }
-
- # vertical lines
- vertical <- rec[grepl("l|r", rec$line), c("i", "j", "lin", "line"), drop = FALSE]
- vertical <- rbind(
- vertical[grepl("l", vertical$line),, drop = FALSE],
- transform(vertical[grepl("r", vertical$line),, drop = FALSE], j = j + 1)
- )
- spec <- by(vertical, list(vertical$j, vertical$lin), function(k) {
- ival <- paste(sort(unique(k$i)), collapse = ",")
- sprintf("vline{%s}={%s}{%s}", k$j, ival, k$lin)
- })
- spec <- unique(as.vector(unlist(spec)))
- for (s in spec) {
- x@table_string <- tabularray_insert(x@table_string, content = s, type = "inner")
- }
-
- return(x)
-
-})
+)
tabularray_insert <- function(x, content = NULL, type = "body") {
-
out <- x
out <- strsplit(out, "\n")[[1]]
comment <- switch(type,
- "body" = "% tabularray inner close",
- "outer" = "% tabularray outer close",
- "inner" = "% tabularray inner close")
+ "body" = "% tabularray inner close",
+ "outer" = "% tabularray outer close",
+ "inner" = "% tabularray inner close"
+ )
idx <- grep(comment, out)
if (length(content) > 0) {
@@ -278,17 +291,17 @@ color_to_preamble <- function(x, col) {
get_dcolumn <- function(j, x) {
- siunitx <- get_option("tinytable_siunitx_table_format", default = "table-format=-%s.%s,table-align-text-before=false,table-align-text-after=false,input-symbols={-,\\*+()}")
- num <- unlist(x@table_dataframe[, j])
- num <- strsplit(num, "\\.")
- num <- lapply(num, function(k) if (length(k) == 1) c(k, " ") else k)
- left <- sapply(num, function(k) k[[1]])
- right <- sapply(num, function(k) k[[2]])
- left <- max(nchar(gsub("\\D", "", left)))
- right <- max(nchar(gsub("\\D", "", right)))
- out <- sprintf(siunitx, left, right)
- out <- sprintf("si={%s},", out)
- return(out)
+ siunitx <- get_option("tinytable_siunitx_table_format", default = "table-format=-%s.%s,table-align-text-before=false,table-align-text-after=false,input-symbols={-,\\*+()}")
+ num <- unlist(x@table_dataframe[, j])
+ num <- strsplit(num, "\\.")
+ num <- lapply(num, function(k) if (length(k) == 1) c(k, " ") else k)
+ left <- sapply(num, function(k) k[[1]])
+ right <- sapply(num, function(k) k[[2]])
+ left <- max(nchar(gsub("\\D", "", left)))
+ right <- max(nchar(gsub("\\D", "", right)))
+ out <- sprintf(siunitx, left, right)
+ out <- sprintf("si={%s},", out)
+ return(out)
}
diff --git a/R/style_tt.R b/R/style_tt.R
index 23adc45d..4cec207d 100644
--- a/R/style_tt.R
+++ b/R/style_tt.R
@@ -3,14 +3,15 @@
#' @details
#' This function applies styling to a table created by `tt()`. It allows customization of text style (bold, italic, monospace), text and background colors, font size, cell width, text alignment, column span, and indentation. The function also supports passing native instructions to LaTeX (tabularray) and HTML (bootstrap) formats.
#'
-#' Note: Markdown and Word tables only support these styles: italic, bold, strikeout. Moreover, the `style_tt()` function cannot be used to style headers inserted by the `group_tt()` function; instead, you should style the headers directly in the header definition using markdown syntax: `group_tt(i = list("*italic header*" = 2))`. These limitations are due to the fact that there is no markdown syntax for the other options, and that we create Word documents by converting a markdown table to .docx via the Pandoc software.
-#'
#' @param x A table object created by `tt()`.
-#' @param i Row indices where the styling should be applied. Can be a single value, a vector, or a logical matrix with the same number of rows and columns as `x`. `i=0` is the header, and negative values are higher level headers. Row indices refer to rows *after* the insertion of row labels by `group_tt()`, when applicable.
+#' @param i Numeric vector, logical matrix, or string..
+#' - Numeric vector: Row indices where the styling should be applied. Can be a single value or a vector.
+#' - Logical matrix: A matrix with the same number of rows and columns as `x`. `i=0` is the header, and negative values are higher level headers. Row indices refer to rows *after* the insertion of row labels by `group_tt()`, when applicable.
+#' - String: "notes" or "caption".
#' @param j Column indices where the styling should be applied. Can be:
#' + Integer vectors indicating column positions.
#' + Character vector indicating column names.
-#' + A single string specifying a Perl-style regular expression used to match column names.
+#' + A single string specifying a Perl-style regular expression used to match column names.
#' @param bold Logical; if `TRUE`, text is styled in bold.
#' @param italic Logical; if `TRUE`, text is styled in italic.
#' @param monospace Logical; if `TRUE`, text is styled in monospace font.
@@ -24,7 +25,7 @@
#' - Hex code composed of # and 6 characters, ex: "#CC79A7". See the section below for instructions to add in LaTeX preambles.
#' - Keywords: black, blue, brown, cyan, darkgray, gray, green, lightgray, lime, magenta, olive, orange, pink, purple, red, teal, violet, white, yellow.
#' - Color blending using xcolor`, ex: `white!80!blue`, `green!20!red`.
-#' - Color names with luminance levels from [the `ninecolors` package](https://mirror.quantum5.ca/CTAN/macros/latex/contrib/ninecolors/ninecolors.pdf) (ex: "azure4", "magenta8", "teal2", "gray1", "olive3").
+#' - Color names with luminance levels from [the `ninecolors` package](https://mirror.quantum5.ca/CTAN/macros/latex/contrib/ninecolors/ninecolors.pdf) (ex: "azure4", "magenta8", "teal2", "gray1", "olive3").
#' @param background Background color. Specified as a color name or hexadecimal code. Can be `NULL` for default color.
#' @param fontsize Font size in em units. Can be `NULL` for default size.
#' @param align A single character or a string with a number of characters equal to the number of columns in `j`. Valid characters include 'c' (center), 'l' (left), 'r' (right), 'd' (decimal). Decimal alignment is only available in LaTeX via the `siunitx` package. The width of columns is determined by the maximum number of digits to the left and to the right in all cells specified by `i` and `j`.
@@ -32,7 +33,7 @@
#' @param colspan Number of columns a cell should span. `i` and `j` must be of length 1.
#' @param rowspan Number of rows a cell should span. `i` and `j` must be of length 1.
#' @param indent Text indentation in em units. Positive values only.
-#' @param line String determines if solid lines (rules or borders) should be drawn around the cell, row, or column.
+#' @param line String determines if solid lines (rules or borders) should be drawn around the cell, row, or column.
#' + "t": top
#' + "b": bottom
#' + "l": left
@@ -41,39 +42,39 @@
#' @param line_color Color of the line. See the `color` argument for details.
#' @param line_width Width of the line in em units (default: 0.1).
#' @param finalize A function applied to the table object at the very end of table-building, for post-processing. For example, the function could use regular expressions to add LaTeX commands to the text version of the table hosted in `x@table_string`, or it could programmatically change the caption in `x@caption`.
-#' @param bootstrap_css Character vector. CSS style declarations to be applied to every cell defined by `i` and `j` (ex: `"font-weight: bold"`).
-#' @param bootstrap_class String. Bootstrap table class such as `"table"`, `"table table-dark"` or `"table table-dark table-hover"`. See the bootstrap documentation.
+#' @param bootstrap_css Character vector. CSS style declarations to be applied to every cell defined by `i` and `j` (ex: `"font-weight: bold"`).
+#' @param bootstrap_class String. Bootstrap table class such as `"table"`, `"table table-dark"` or `"table table-dark table-hover"`. See the bootstrap documentation.
#' @param bootstrap_css_rule String. Complete CSS rules (with curly braces, semicolon, etc.) that apply to the table class specified by the `bootstrap_class` argument.
-#' @param tabularray_inner A string that specifies the "inner" settings of a tabularray LaTeX table.
+#' @param tabularray_inner A string that specifies the "inner" settings of a tabularray LaTeX table.
#' @param tabularray_outer A string that specifies the "outer" settings of a tabularray LaTeX table.
-#' @param output Apply style only to the output format specified by this argument. `NULL` means that we apply to all formats.
+#' @param output Apply style only to the output format specified by this argument. `NULL` means that we apply to all formats.
#' @param ... extra arguments are ignored
#' @return An object of class `tt` representing the table.
-#' @template latex_preamble
+#' @template limitations_word_markdown
#' @export
#' @examplesIf knitr::is_html_output()
#' @examples
#' if (knitr::is_html_output()) options(tinytable_print_output = "html")
-#'
+#'
#' library(tinytable)
-#'
+#'
#' tt(mtcars[1:5, 1:6])
-#'
+#'
#' # Alignment
-#' tt(mtcars[1:5, 1:6]) |>
+#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(j = 1:5, align = "lcccr")
-#'
+#'
#' # Colors and styles
-#' tt(mtcars[1:5, 1:6]) |>
+#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(i = 2:3, background = "black", color = "orange", bold = TRUE)
-#'
+#'
#' # column selection with `j``
-#' tt(mtcars[1:5, 1:6]) |>
+#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(j = 5:6, background = "pink")
-#'
+#'
#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(j = "drat|wt", background = "pink")
-#'
+#'
#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(j = c("drat", "wt"), background = "pink")
#'
@@ -82,27 +83,27 @@
#' i = 2, j = 2,
#' colspan = 3,
#' rowspan = 2,
-#' align="c",
+#' align = "c",
#' alignv = "m",
#' color = "white",
#' background = "black",
#' bold = TRUE)
-#'
+#'
#' tt(mtcars[1:5, 1:6], theme = "void") |>
#' style_tt(
-#' i=0:3,
-#' j=1:3,
-#' line="tblr",
-#' line_width=0.4,
-#' line_color="teal")
-#'
+#' i = 0:3,
+#' j = 1:3,
+#' line = "tblr",
+#' line_width = 0.4,
+#' line_color = "teal")
+#'
#' tt(mtcars[1:5, 1:6], theme = "bootstrap") |>
-#' style_tt(
-#' i = c(2,5),
-#' j = 3,
-#' strikeout = TRUE,
-#' fontsize = 0.7)
-#'
+#' style_tt(
+#' i = c(2, 5),
+#' j = 3,
+#' strikeout = TRUE,
+#' fontsize = 0.7)
+#'
#' tt(mtcars[1:5, 1:6]) |>
#' style_tt(bootstrap_class = "table table-dark table-hover")
#'
@@ -120,252 +121,261 @@
#' tt(mtcars[1:5, 1:4], theme = "void") |>
#' style_tt(tabularray_inner = inner)
#'
-style_tt <- function (x,
- i = NULL,
- j = NULL,
- bold = FALSE,
- italic = FALSE,
- monospace = FALSE,
- underline = FALSE,
- strikeout = FALSE,
- color = NULL,
- background = NULL,
- fontsize = NULL,
- align = NULL,
- alignv = NULL,
- colspan = NULL,
- rowspan = NULL,
- indent = NULL,
- line = NULL,
- line_color = "black",
- line_width = 0.1,
- finalize = NULL,
- tabularray_inner = NULL,
- tabularray_outer = NULL,
- bootstrap_class = NULL,
- bootstrap_css = NULL,
- bootstrap_css_rule = NULL,
- output = NULL,
- ...) {
+style_tt <- function(x,
+ i = NULL,
+ j = NULL,
+ bold = FALSE,
+ italic = FALSE,
+ monospace = FALSE,
+ underline = FALSE,
+ strikeout = FALSE,
+ color = NULL,
+ background = NULL,
+ fontsize = NULL,
+ align = NULL,
+ alignv = NULL,
+ colspan = NULL,
+ rowspan = NULL,
+ indent = NULL,
+ line = NULL,
+ line_color = "black",
+ line_width = 0.1,
+ finalize = NULL,
+ tabularray_inner = NULL,
+ tabularray_outer = NULL,
+ bootstrap_class = NULL,
+ bootstrap_css = NULL,
+ bootstrap_css_rule = NULL,
+ output = NULL,
+ ...) {
+ out <- x
- out <- x
+ assert_choice(alignv, c("t", "m", "b"), null.ok = TRUE)
- assert_choice(alignv, c("t", "m", "b"), null.ok = TRUE)
-
- assert_style_tt(
- x = out, i = i, j = j, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout,
- color = color, background = background, fontsize = fontsize, align = align,
- colspan = colspan, rowspan = rowspan, indent = indent,
- line = line, line_color = line_color, line_width = line_width,
- tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css,
- bootstrap_css_rule = bootstrap_css_rule)
+ assert_style_tt(
+ x = out, i = i, j = j, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout,
+ color = color, background = background, fontsize = fontsize, align = align,
+ colspan = colspan, rowspan = rowspan, indent = indent,
+ line = line, line_color = line_color, line_width = line_width,
+ tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css,
+ bootstrap_css_rule = bootstrap_css_rule)
+ if (isTRUE(i %in% c("notes", "caption"))) {
+ tmp <- list(
+ color = color,
+ fontsize = fontsize,
+ italic = italic,
+ monospace = monospace,
+ strikeout = strikeout,
+ underline = underline
+ )
+ if (identical(i, "notes")) out@style_notes <- tmp
+ if (identical(i, "caption")) out@style_caption <- tmp
+ return(out)
+ }
- if (!is.null(bootstrap_class)) {
- out@bootstrap_class <- bootstrap_class
- }
- if (!is.null(bootstrap_css_rule)) {
- out@bootstrap_css_rule <- bootstrap_css_rule
- }
+ if (!is.null(bootstrap_class)) {
+ out@bootstrap_class <- bootstrap_class
+ }
+ if (!is.null(bootstrap_css_rule)) {
+ out@bootstrap_css_rule <- bootstrap_css_rule
+ }
- sanity_align(align, i)
+ sanity_align(align, i)
- assert_choice(output, c("typst", "latex", "html", "markdown", "gfm"), null.ok = TRUE)
+ assert_choice(output, c("typst", "latex", "html", "markdown", "gfm"), null.ok = TRUE)
- if ("width" %in% names(list(...))) {
- stop("The `width` argument is now in the `tt()` function.", call. = FALSE)
- }
+ if ("width" %in% names(list(...))) {
+ stop("The `width` argument is now in the `tt()` function.", call. = FALSE)
+ }
- # i is a logical matrix mask
- if (is.matrix(i) && is.logical(i) && nrow(i) == nrow(x) && ncol(i) == ncol(x)) {
- assert_null(j)
- settings <- which(i == TRUE, arr.ind = TRUE)
- settings <- stats::setNames(data.frame(settings), c("i", "j"))
- } else {
- ival <- sanitize_i(i, x)
- jval <- sanitize_j(j, x)
- # order may be important for recycling
- settings <- expand.grid(i = ival, j = jval, tabularray = "")
- if (is.null(i) && !is.null(j)) {
- settings <- settings[order(settings$i, settings$j), ]
- }
+ # i is a logical matrix mask
+ if (is.matrix(i) && is.logical(i) && nrow(i) == nrow(x) && ncol(i) == ncol(x)) {
+ assert_null(j)
+ settings <- which(i == TRUE, arr.ind = TRUE)
+ settings <- stats::setNames(data.frame(settings), c("i", "j"))
+ } else {
+ ival <- sanitize_i(i, x)
+ jval <- sanitize_j(j, x)
+ # order may be important for recycling
+ settings <- expand.grid(i = ival, j = jval, tabularray = "")
+ if (is.null(i) && !is.null(j)) {
+ settings <- settings[order(settings$i, settings$j), ]
}
+ }
- settings[["color"]] <- if (is.null(color)) NA else as.vector(color)
- settings[["background"]] <- if (is.null(background)) NA else as.vector(background)
- settings[["fontsize"]] <- if (is.null(fontsize)) NA else as.vector(fontsize)
- settings[["alignv"]] <- if (is.null(alignv)) NA else alignv
- settings[["line"]] <- if (is.null(line)) NA else line
- settings[["line_color"]] <- if (is.null(line)) NA else line_color
- settings[["line_width"]] <- if (is.null(line)) NA else line_width
- settings[["bold"]] <- bold
- settings[["italic"]] <- italic
- settings[["monospace"]] <- monospace
- settings[["strikeout"]] <- strikeout
- settings[["underline"]] <- underline
- settings[["indent"]] <- if (is.null(indent)) NA else as.vector(indent)
- settings[["colspan"]] <- if (is.null(colspan)) NA else colspan
- settings[["rowspan"]] <- if (is.null(rowspan)) NA else rowspan
- settings[["bootstrap_css_rule"]] <- if (!is.null(bootstrap_css_rule)) bootstrap_css_rule else NA
- settings[["bootstrap_css"]] <- if (!is.null(bootstrap_css)) bootstrap_css else NA
- settings[["tabularray_inner"]] <- if (!is.null(tabularray_inner)) tabularray_inner else NA
- settings[["tabularray_outer"]] <- if (!is.null(tabularray_outer)) tabularray_outer else NA
+ settings[["color"]] <- if (is.null(color)) NA else as.vector(color)
+ settings[["background"]] <- if (is.null(background)) NA else as.vector(background)
+ settings[["fontsize"]] <- if (is.null(fontsize)) NA else as.vector(fontsize)
+ settings[["alignv"]] <- if (is.null(alignv)) NA else alignv
+ settings[["line"]] <- if (is.null(line)) NA else line
+ settings[["line_color"]] <- if (is.null(line)) NA else line_color
+ settings[["line_width"]] <- if (is.null(line)) NA else line_width
+ settings[["bold"]] <- bold
+ settings[["italic"]] <- italic
+ settings[["monospace"]] <- monospace
+ settings[["strikeout"]] <- strikeout
+ settings[["underline"]] <- underline
+ settings[["indent"]] <- if (is.null(indent)) NA else as.vector(indent)
+ settings[["colspan"]] <- if (is.null(colspan)) NA else colspan
+ settings[["rowspan"]] <- if (is.null(rowspan)) NA else rowspan
+ settings[["bootstrap_css_rule"]] <- if (!is.null(bootstrap_css_rule)) bootstrap_css_rule else NA
+ settings[["bootstrap_css"]] <- if (!is.null(bootstrap_css)) bootstrap_css else NA
+ settings[["tabularray_inner"]] <- if (!is.null(tabularray_inner)) tabularray_inner else NA
+ settings[["tabularray_outer"]] <- if (!is.null(tabularray_outer)) tabularray_outer else NA
- if (!is.null(align)) {
- if (nchar(align) == length(jval)) {
- align_string <- strsplit(align, "")[[1]]
- if (!all(align_string %in% c("c", "l", "r", "d"))) {
- msg <- "`align` must be characters c, l, r, or d."
- stop(msg, call. = FALSE)
- }
- align_string <- data.frame(j = jval, align = align_string)
- settings <- merge(settings, align_string, by = "j", all.x = TRUE)
- } else if (nchar(align) == 1) {
- assert_choice(align, c("c", "l", "r", "d"))
- align_string <- data.frame(j = jval, align = align)
- settings <- merge(settings, align_string, by = "j", all.x = TRUE)
- } else {
- msg <- sprintf("`align` must be a single character or a string of length %s.", length(jval))
- stop(msg, call. = FALSE)
- }
+ if (!is.null(align)) {
+ if (nchar(align) == length(jval)) {
+ align_string <- strsplit(align, "")[[1]]
+ if (!all(align_string %in% c("c", "l", "r", "d"))) {
+ msg <- "`align` must be characters c, l, r, or d."
+ stop(msg, call. = FALSE)
+ }
+ align_string <- data.frame(j = jval, align = align_string)
+ settings <- merge(settings, align_string, by = "j", all.x = TRUE)
+ } else if (nchar(align) == 1) {
+ assert_choice(align, c("c", "l", "r", "d"))
+ align_string <- data.frame(j = jval, align = align)
+ settings <- merge(settings, align_string, by = "j", all.x = TRUE)
} else {
- settings[["align"]] <- NA
+ msg <- sprintf("`align` must be a single character or a string of length %s.", length(jval))
+ stop(msg, call. = FALSE)
}
+ } else {
+ settings[["align"]] <- NA
+ }
- empty <- settings[, 4:ncol(settings)]
- empty <- sapply(empty, function(x) is.na(x) | (is.logical(x) && !any(x)))
- if (nrow(settings) == 1) {
- empty <- all(empty)
- settings <- settings[!empty, , drop = FALSE]
- } else {
- empty <- apply(empty, 1, all)
- settings <- settings[!empty, , drop = FALSE]
- }
+ empty <- settings[, 4:ncol(settings)]
+ empty <- sapply(empty, function(x) is.na(x) | (is.logical(x) && !any(x)))
+ if (nrow(settings) == 1) {
+ empty <- all(empty)
+ settings <- settings[!empty, , drop = FALSE]
+ } else {
+ empty <- apply(empty, 1, all)
+ settings <- settings[!empty, , drop = FALSE]
+ }
- if (nrow(out@style) > 0 && nrow(settings) > 0 && ncol(out@style) != ncol(settings)) {
- a <- out@style
- b <- settings
- if (!"tabularray" %in% colnames(a)) a$tabularray <- ""
- if (!"tabularray" %in% colnames(b)) b$tabularray <- ""
- settings <- rbind(a, b[, colnames(a)])
- out@style <- unique(settings)
- } else if (nrow(settings) > 0) {
- out@style <- rbind(out@style, settings)
- }
+ if (nrow(out@style) > 0 && nrow(settings) > 0 && ncol(out@style) != ncol(settings)) {
+ a <- out@style
+ b <- settings
+ if (!"tabularray" %in% colnames(a)) a$tabularray <- ""
+ if (!"tabularray" %in% colnames(b)) b$tabularray <- ""
+ settings <- rbind(a, b[, colnames(a)])
+ out@style <- unique(settings)
+ } else if (nrow(settings) > 0) {
+ out@style <- rbind(out@style, settings)
+ }
- ## issue #759: reuse object with different styles across RevealJS slides requires new ID every time style_tt is called
- # This is a very bad idea. Breaks a ton of things. We need unique IDs.
- # out@id <- get_id("tinytable_")
+ ## issue #759: reuse object with different styles across RevealJS slides requires new ID every time style_tt is called
+ # This is a very bad idea. Breaks a ton of things. We need unique IDs.
+ # out@id <- get_id("tinytable_")
- assert_function(finalize, null.ok = TRUE)
- if (is.function(finalize)) {
- out@lazy_finalize <- c(out@lazy_finalize, list(finalize))
- }
+ assert_function(finalize, null.ok = TRUE)
+ if (is.function(finalize)) {
+ out@lazy_finalize <- c(out@lazy_finalize, list(finalize))
+ }
- return(out)
+ return(out)
}
-assert_style_tt <- function (x,
- i,
- j,
- bold,
- italic,
- monospace,
- underline,
- strikeout,
- color,
- background,
- fontsize,
- align,
- colspan,
- rowspan,
- indent,
- line,
- line_color,
- line_width,
- tabularray_inner,
- tabularray_outer,
- bootstrap_class = NULL,
- bootstrap_css = NULL,
- bootstrap_css_rule = NULL) {
+assert_style_tt <- function(x,
+ i,
+ j,
+ bold,
+ italic,
+ monospace,
+ underline,
+ strikeout,
+ color,
+ background,
+ fontsize,
+ align,
+ colspan,
+ rowspan,
+ indent,
+ line,
+ line_color,
+ line_width,
+ tabularray_inner,
+ tabularray_outer,
+ bootstrap_class = NULL,
+ bootstrap_css = NULL,
+ bootstrap_css_rule = NULL) {
+ assert_integerish(colspan, len = 1, lower = 2, null.ok = TRUE)
+ assert_integerish(rowspan, len = 1, lower = 2, null.ok = TRUE)
+ assert_numeric(indent, len = 1, lower = 0, null.ok = TRUE)
+ assert_character(background, null.ok = TRUE)
+ assert_character(color, null.ok = TRUE)
+ assert_numeric(fontsize, null.ok = TRUE)
+ assert_logical(bold)
+ assert_logical(italic)
+ assert_logical(monospace)
+ assert_logical(underline)
+ assert_logical(strikeout)
+ assert_string(line, null.ok = TRUE)
+ assert_string(line_color, null.ok = FALSE) # black default
+ assert_numeric(line_width, len = 1, lower = 0, null.ok = FALSE) # 0.1 default
+ assert_character(bootstrap_class, null.ok = TRUE)
+ assert_character(bootstrap_css, null.ok = TRUE)
+ assert_string(bootstrap_css_rule, null.ok = TRUE)
- assert_integerish(colspan, len = 1, lower = 2, null.ok = TRUE)
- assert_integerish(rowspan, len = 1, lower = 2, null.ok = TRUE)
- assert_numeric(indent, len = 1, lower = 0, null.ok = TRUE)
- assert_character(background, null.ok = TRUE)
- assert_character(color, null.ok = TRUE)
- assert_numeric(fontsize, null.ok = TRUE)
- assert_logical(bold)
- assert_logical(italic)
- assert_logical(monospace)
- assert_logical(underline)
- assert_logical(strikeout)
- assert_string(line, null.ok = TRUE)
- assert_string(line_color, null.ok = FALSE) # black default
- assert_numeric(line_width, len = 1, lower = 0, null.ok = FALSE) # 0.1 default
- assert_character(bootstrap_class, null.ok = TRUE)
- assert_character(bootstrap_css, null.ok = TRUE)
- assert_string(bootstrap_css_rule, null.ok = TRUE)
-
- if (is.character(line)) {
- line <- strsplit(line, split = "")[[1]]
- if (!all(line %in% c("t", "b", "l", "r"))) {
- msg <- "`line` must be a string of characters t, b, l, or r."
- stop(msg, call. = FALSE)
- }
+ if (is.character(line)) {
+ line <- strsplit(line, split = "")[[1]]
+ if (!all(line %in% c("t", "b", "l", "r"))) {
+ msg <- "`line` must be a string of characters t, b, l, or r."
+ stop(msg, call. = FALSE)
}
+ }
- ival <- sanitize_i(i, x)
- jval <- sanitize_j(j, x)
- inull <- isTRUE(attr(ival, "null"))
- jnull <- isTRUE(attr(jval, "null"))
+ ival <- sanitize_i(i, x)
+ jval <- sanitize_j(j, x)
+ inull <- isTRUE(attr(ival, "null"))
+ jnull <- isTRUE(attr(jval, "null"))
- # 1
- if (inull && jnull) {
- assert_length(color, len = 1, null.ok = TRUE)
- assert_length(background, len = 1, null.ok = TRUE)
- assert_length(fontsize, len = 1, null.ok = TRUE)
- assert_length(bold, len = 1)
- assert_length(italic, len = 1)
- assert_length(monospace, len = 1)
- assert_length(underline, len = 1)
- assert_length(strikeout, len = 1)
+ # 1
+ if (inull && jnull) {
+ assert_length(color, len = 1, null.ok = TRUE)
+ assert_length(background, len = 1, null.ok = TRUE)
+ assert_length(fontsize, len = 1, null.ok = TRUE)
+ assert_length(bold, len = 1)
+ assert_length(italic, len = 1)
+ assert_length(monospace, len = 1)
+ assert_length(underline, len = 1)
+ assert_length(strikeout, len = 1)
# 1 or #rows
- } else if (!inull && jnull) {
- assert_length(color, len = c(1, length(ival)), null.ok = TRUE)
- assert_length(background, len = c(1, length(ival)), null.ok = TRUE)
- assert_length(fontsize, len = c(1, length(ival)), null.ok = TRUE)
- assert_length(bold, len = c(1, length(ival)))
- assert_length(italic, len = c(1, length(ival)))
- assert_length(monospace, len = c(1, length(ival)))
- assert_length(underline, len = c(1, length(ival)))
- assert_length(strikeout, len = c(1, length(ival)))
+ } else if (!inull && jnull) {
+ assert_length(color, len = c(1, length(ival)), null.ok = TRUE)
+ assert_length(background, len = c(1, length(ival)), null.ok = TRUE)
+ assert_length(fontsize, len = c(1, length(ival)), null.ok = TRUE)
+ assert_length(bold, len = c(1, length(ival)))
+ assert_length(italic, len = c(1, length(ival)))
+ assert_length(monospace, len = c(1, length(ival)))
+ assert_length(underline, len = c(1, length(ival)))
+ assert_length(strikeout, len = c(1, length(ival)))
# 1 or #cols
- } else if (inull && !jnull) {
- assert_length(color, len = c(1, length(jval)), null.ok = TRUE)
- assert_length(background, len = c(1, length(jval)), null.ok = TRUE)
- assert_length(fontsize, len = c(1, length(jval)), null.ok = TRUE)
- assert_length(bold, len = c(1, length(jval)))
- assert_length(italic, len = c(1, length(jval)))
- assert_length(monospace, len = c(1, length(jval)))
- assert_length(underline, len = c(1, length(jval)))
- assert_length(strikeout, len = c(1, length(jval)))
+ } else if (inull && !jnull) {
+ assert_length(color, len = c(1, length(jval)), null.ok = TRUE)
+ assert_length(background, len = c(1, length(jval)), null.ok = TRUE)
+ assert_length(fontsize, len = c(1, length(jval)), null.ok = TRUE)
+ assert_length(bold, len = c(1, length(jval)))
+ assert_length(italic, len = c(1, length(jval)))
+ assert_length(monospace, len = c(1, length(jval)))
+ assert_length(underline, len = c(1, length(jval)))
+ assert_length(strikeout, len = c(1, length(jval)))
# 1 or #cells
- } else if (!inull && !jnull) {
- assert_length(color, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
- assert_length(background, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
- assert_length(fontsize, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
- assert_length(bold, len = c(1, length(ival) * length(jval)))
- assert_length(italic, len = c(1, length(ival) * length(jval)))
- assert_length(monospace, len = c(1, length(ival) * length(jval)))
- assert_length(underline, len = c(1, length(ival) * length(jval)))
- assert_length(strikeout, len = c(1, length(ival) * length(jval)))
- }
+ } else if (!inull && !jnull) {
+ assert_length(color, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
+ assert_length(background, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
+ assert_length(fontsize, len = c(1, length(ival) * length(jval)), null.ok = TRUE)
+ assert_length(bold, len = c(1, length(ival) * length(jval)))
+ assert_length(italic, len = c(1, length(ival) * length(jval)))
+ assert_length(monospace, len = c(1, length(ival) * length(jval)))
+ assert_length(underline, len = c(1, length(ival) * length(jval)))
+ assert_length(strikeout, len = c(1, length(ival) * length(jval)))
+ }
}
-
-
diff --git a/R/style_typst.R b/R/style_typst.R
index 941b6f83..6fd24350 100644
--- a/R/style_typst.R
+++ b/R/style_typst.R
@@ -25,13 +25,11 @@ setMethod(
indent = 0,
midrule = FALSE, # undocumented, only used by `group_tt()`
...) {
-
-
sty <- x@style
# gutters are used for group_tt(j) but look ugly with cell fill
if (!all(is.na(sty$background))) {
- x@table_string <- lines_drop(x@table_string, "column-gutter:", fixed = TRUE)
+ x@table_string <- lines_drop(x@table_string, "column-gutter:", fixed = TRUE)
}
sty$align[which(sty$align == "l")] <- "left"
@@ -44,54 +42,55 @@ setMethod(
if (length(x@names) == 0) sty$i <- sty$i + 1
rec <- expand.grid(
- i = seq_len(x@nhead + x@nrow + x@ngroupi) - 1,
- j = seq_len(x@ncol) - 1
+ i = seq_len(x@nhead + x@nrow) - 1,
+ j = seq_len(x@ncol) - 1
)
css <- rep("", nrow(rec))
insert_field <- function(x, name = "bold", value = "true") {
- old <- sprintf("%s: [^,]*,", name)
- new <- sprintf("%s: %s,", name, value)
- out <- ifelse(grepl(old, x),
- sub(old, new, x),
- sprintf("%s, %s", x, new))
- return(out)
+ old <- sprintf("%s: [^,]*,", name)
+ new <- sprintf("%s: %s,", name, value)
+ out <- ifelse(grepl(old, x),
+ sub(old, new, x),
+ sprintf("%s, %s", x, new)
+ )
+ return(out)
}
for (row in seq_len(nrow(sty))) {
- idx_i <- sty$i[row]
- if (is.na(idx_i)) idx_i <- unique(rec$i)
- idx_j <- sty$j[row]
- if (is.na(idx_j)) idx_j <- unique(rec$j)
- idx <- rec$i == idx_i & rec$j == idx_j
- if (isTRUE(sty[row, "bold"])) css[idx] <- insert_field(css[idx], "bold", "true")
- if (isTRUE(sty[row, "italic"])) css[idx] <- insert_field(css[idx], "italic", "true")
- if (isTRUE(sty[row, "underline"])) css[idx] <- insert_field(css[idx], "underline", "true")
- if (isTRUE(sty[row, "strikeout"])) css[idx] <- insert_field(css[idx], "strikeout", "true")
- if (isTRUE(sty[row, "monospace"])) css[idx] <- insert_field(css[idx], "monospace", "true")
- if (!is.na(sty[row, "align"])) css[idx] <- insert_field(css[idx], "align", sty[row, "align"])
-
- fs <- sty[row, "indent"]
- if (!is.na(fs)) {
- css[idx] <- insert_field(css[idx], "indent", sprintf("%sem", fs))
- }
-
- fs <- sty[row, "fontsize"]
- if (!is.na(fs)) {
- css[idx] <- insert_field(css[idx], "fontsize", sprintf("%sem", fs))
- }
-
- col <- sty[row, "color"]
- if (!is.na(col)) {
- if (grepl("^#", col)) col <- sprintf('rgb("%s")', col)
- css[idx] <- insert_field(css[idx], "color", col)
- }
-
- bg <- sty[row, "background"]
- if (!is.na(bg)) {
- if (grepl("^#", bg)) bg <- sprintf('rgb("%s")', bg)
- css[idx] <- insert_field(css[idx], "background", bg)
- }
+ idx_i <- sty$i[row]
+ if (is.na(idx_i)) idx_i <- unique(rec$i)
+ idx_j <- sty$j[row]
+ if (is.na(idx_j)) idx_j <- unique(rec$j)
+ idx <- rec$i == idx_i & rec$j == idx_j
+ if (isTRUE(sty[row, "bold"])) css[idx] <- insert_field(css[idx], "bold", "true")
+ if (isTRUE(sty[row, "italic"])) css[idx] <- insert_field(css[idx], "italic", "true")
+ if (isTRUE(sty[row, "underline"])) css[idx] <- insert_field(css[idx], "underline", "true")
+ if (isTRUE(sty[row, "strikeout"])) css[idx] <- insert_field(css[idx], "strikeout", "true")
+ if (isTRUE(sty[row, "monospace"])) css[idx] <- insert_field(css[idx], "monospace", "true")
+ if (!is.na(sty[row, "align"])) css[idx] <- insert_field(css[idx], "align", sty[row, "align"])
+
+ fs <- sty[row, "indent"]
+ if (!is.na(fs)) {
+ css[idx] <- insert_field(css[idx], "indent", sprintf("%sem", fs))
+ }
+
+ fs <- sty[row, "fontsize"]
+ if (!is.na(fs)) {
+ css[idx] <- insert_field(css[idx], "fontsize", sprintf("%sem", fs))
+ }
+
+ col <- sty[row, "color"]
+ if (!is.na(col)) {
+ if (grepl("^#", col)) col <- sprintf('rgb("%s")', col)
+ css[idx] <- insert_field(css[idx], "color", col)
+ }
+
+ bg <- sty[row, "background"]
+ if (!is.na(bg)) {
+ if (grepl("^#", bg)) bg <- sprintf('rgb("%s")', bg)
+ css[idx] <- insert_field(css[idx], "background", bg)
+ }
}
css <- gsub(" +", " ", trimws(css))
@@ -106,96 +105,96 @@ setMethod(
pairs <- sapply(uni, function(x) paste(sprintf("(%s, %s),", x$j, x$i), collapse = " "))
styles <- sapply(uni, function(x) x$css[1])
- styles <- sprintf("(pairs: (%s), %s),", pairs, styles)
+ styles <- sprintf("(pairs: (%s), %s),", pairs, styles)
for (s in styles) {
- x@table_string <- lines_insert(x@table_string, s, "tinytable cell style after", "after")
- # x@table_string <- lines_insert(x@table_string, s, "tinytable cell align after", "after")
+ x@table_string <- lines_insert(x@table_string, s, "tinytable cell style after", "after")
}
- lin <- sty[grepl("b|t", sty$line),, drop = FALSE]
+ lin <- sty[grepl("b|t", sty$line), , drop = FALSE]
if (nrow(lin) > 0) {
- lin <- split(lin, list(lin$i, lin$line, lin$line_color, lin$line_width))
- lin <- Filter(function(x) nrow(x) > 0, lin)
- lin <- lapply(lin, hlines)
- for (l in lin) {
- x@table_string <- lines_insert(x@table_string, l, "tinytable lines before", "before")
- }
+ lin <- split(lin, list(lin$i, lin$line, lin$line_color, lin$line_width))
+ lin <- Filter(function(x) nrow(x) > 0, lin)
+ lin <- lapply(lin, hlines)
+ for (l in lin) {
+ x@table_string <- lines_insert(x@table_string, l, "tinytable lines before", "before")
+ }
}
- lin <- sty[grepl("l|r", sty$line),, drop = FALSE]
+ lin <- sty[grepl("l|r", sty$line), , drop = FALSE]
if (nrow(lin) > 0) {
- lin <- split(lin, list(lin$j, lin$line, lin$line_color, lin$line_width))
- lin <- Filter(function(x) nrow(x) > 0, lin)
- lin <- lapply(lin, vlines)
- for (l in lin) {
- x@table_string <- lines_insert(x@table_string, l, "tinytable lines before", "before")
- }
+ lin <- split(lin, list(lin$j, lin$line, lin$line_color, lin$line_width))
+ lin <- Filter(function(x) nrow(x) > 0, lin)
+ lin <- lapply(lin, vlines)
+ for (l in lin) {
+ x@table_string <- lines_insert(x@table_string, l, "tinytable lines before", "before")
+ }
}
return(x)
-})
+ }
+)
split_chunks <- function(x) {
- x <- sort(x)
- breaks <- c(0, which(diff(x) != 1), length(x))
- result <- list()
- for (i in seq_along(breaks)[-length(breaks)]) {
- chunk <- x[(breaks[i] + 1):breaks[i + 1]]
- result[[i]] <- c(min = min(chunk), max = max(chunk))
- }
- out <- data.frame(do.call(rbind, result))
- out$max <- out$max + 1
- return(out)
+ x <- sort(x)
+ breaks <- c(0, which(diff(x) != 1), length(x))
+ result <- list()
+ for (i in seq_along(breaks)[-length(breaks)]) {
+ chunk <- x[(breaks[i] + 1):breaks[i + 1]]
+ result[[i]] <- c(min = min(chunk), max = max(chunk))
+ }
+ out <- data.frame(do.call(rbind, result))
+ out$max <- out$max + 1
+ return(out)
}
hlines <- function(k) {
- xmin <- split_chunks(k$j)$min
- xmax <- split_chunks(k$j)$max
- ymin <- k$i[1]
- ymax <- k$i[1] + 1
- line <- k$line[1]
- color <- if (is.na(k$line_color[1])) "black" else k$line_color[1]
- if (grepl("^#", color)) color <- sprintf('rgb("%s")', color)
- width <- if (is.na(k$line_width[1])) 0.1 else k$line_width[1]
- width <- sprintf("%sem", width)
- out <- ""
- if (grepl("t", line)) {
- tmp <- "table.hline(y: %s, start: %s, end: %s, stroke: %s + %s),"
- tmp <- sprintf(tmp, ymin, xmin, xmax, width, color)
- out <- paste(out, tmp)
- }
- if (grepl("b", line)) {
- tmp <- "table.hline(y: %s, start: %s, end: %s, stroke: %s + %s),"
- tmp <- sprintf(tmp, ymax, xmin, xmax, width, color)
- out <- paste(out, tmp)
- }
- return(out)
+ xmin <- split_chunks(k$j)$min
+ xmax <- split_chunks(k$j)$max
+ ymin <- k$i[1]
+ ymax <- k$i[1] + 1
+ line <- k$line[1]
+ color <- if (is.na(k$line_color[1])) "black" else k$line_color[1]
+ if (grepl("^#", color)) color <- sprintf('rgb("%s")', color)
+ width <- if (is.na(k$line_width[1])) 0.1 else k$line_width[1]
+ width <- sprintf("%sem", width)
+ out <- ""
+ if (grepl("t", line)) {
+ tmp <- "table.hline(y: %s, start: %s, end: %s, stroke: %s + %s),"
+ tmp <- sprintf(tmp, ymin, xmin, xmax, width, color)
+ out <- paste(out, tmp)
+ }
+ if (grepl("b", line)) {
+ tmp <- "table.hline(y: %s, start: %s, end: %s, stroke: %s + %s),"
+ tmp <- sprintf(tmp, ymax, xmin, xmax, width, color)
+ out <- paste(out, tmp)
+ }
+ return(out)
}
vlines <- function(k) {
- ymin <- split_chunks(k$i)$min
- ymax <- split_chunks(k$i)$max
- xmin <- k$j[1]
- xmax <- xmin + 1
- line <- k$line[1]
- color <- if (is.na(k$line_color[1])) "black" else k$line_color[1]
- width <- if (is.na(k$line_width[1])) 0.1 else k$line_width[1]
- width <- sprintf("%sem", width)
- out <- ""
- if (grepl("l", line)) {
- tmp <- "table.vline(x: %s, start: %s, end: %s, stroke: %s + %s),"
- tmp <- sprintf(tmp, xmin, ymin, ymax, width, color)
- out <- paste(out, tmp)
- }
- if (grepl("r", line)) {
- tmp <- "table.vline(x: %s, start: %s, end: %s, stroke: %s + %s),"
- tmp <- sprintf(tmp, xmax, ymin, ymax, width, color)
- out <- paste(out, tmp)
- }
- return(out)
+ ymin <- split_chunks(k$i)$min
+ ymax <- split_chunks(k$i)$max
+ xmin <- k$j[1]
+ xmax <- xmin + 1
+ line <- k$line[1]
+ color <- if (is.na(k$line_color[1])) "black" else k$line_color[1]
+ width <- if (is.na(k$line_width[1])) 0.1 else k$line_width[1]
+ width <- sprintf("%sem", width)
+ out <- ""
+ if (grepl("l", line)) {
+ tmp <- "table.vline(x: %s, start: %s, end: %s, stroke: %s + %s),"
+ tmp <- sprintf(tmp, xmin, ymin, ymax, width, color)
+ out <- paste(out, tmp)
+ }
+ if (grepl("r", line)) {
+ tmp <- "table.vline(x: %s, start: %s, end: %s, stroke: %s + %s),"
+ tmp <- sprintf(tmp, xmax, ymin, ymax, width, color)
+ out <- paste(out, tmp)
+ }
+ return(out)
}
diff --git a/R/theme_bootstrap.R b/R/theme_bootstrap.R
index 55dab118..ddd51c4b 100644
--- a/R/theme_bootstrap.R
+++ b/R/theme_bootstrap.R
@@ -1,26 +1,27 @@
theme_bootstrap <- function(x, ...) {
+ fn <- theme_placement_factory(
+ horizontal = get_option("tinytable_theme_default_horizontal", "c"),
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
+ x <- style_tt(x, finalize = fn)
- fn <- theme_placement_factory(
- horizontal = get_option("tinytable_theme_default_horizontal", "c"),
- latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL))
- x <- style_tt(x, finalize = fn)
-
- fn <- function(table) {
- if (isTRUE(table@output == "markdown")) {
- tab <- table@table_string
- tab <- strsplit(tab, "\n")[[1]]
- tab <- tab[!grepl("^[\\+|-]+$", tab)]
- tab <- gsub("|", " ", tab, fixed = TRUE)
- table@table_string <- paste(tab, collapse = "\n")
- } else if (isTRUE(table@output == "typst")) {
- table <- style_tt(table, i = 0:nrow(table), line = "bt", line_width = 0.05, line_color = "silver")
- }
- return(table)
+ fn <- function(table) {
+ if (isTRUE(table@output == "markdown")) {
+ tab <- table@table_string
+ tab <- strsplit(tab, "\n")[[1]]
+ tab <- tab[!grepl("^[\\+|-]+$", tab)]
+ tab <- gsub("|", " ", tab, fixed = TRUE)
+ table@table_string <- paste(tab, collapse = "\n")
+ } else if (isTRUE(table@output == "typst")) {
+ table <- style_tt(table, i = 0:nrow(table), line = "bt", line_width = 0.05, line_color = "silver")
}
- x <- style_tt(x, finalize = theme_void_fn) # only affects LaTeX
- x <- style_tt(x,
- tabularray_inner = "hlines={gray8},",
- bootstrap_class = "table",
- finalize = fn)
- return(x)
+ return(table)
+ }
+ x <- style_tt(x, finalize = theme_void_fn) # only affects LaTeX
+ x <- style_tt(x,
+ tabularray_inner = "hlines={gray8},",
+ bootstrap_class = "table",
+ finalize = fn
+ )
+ return(x)
}
diff --git a/R/theme_default.R b/R/theme_default.R
index e5b09b33..17b625f5 100644
--- a/R/theme_default.R
+++ b/R/theme_default.R
@@ -1,24 +1,40 @@
theme_default <- function(x, ...) {
-
fn <- theme_placement_factory(
horizontal = get_option("tinytable_theme_default_horizontal", "c"),
- latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL))
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
x <- style_tt(x, finalize = fn)
if (isTRUE(x@output %in% c("html", "typst"))) {
+ col <- if (x@output == "typst") "black" else "#d3d8dc"
bc <- if (length(x@bootstrap_class) == 0) "table table-borderless" else x@bootstrap_class
- x <- style_tt(x,
+ # top
+ x <- style_tt(x,
bootstrap_class = bc,
- i = nrow(x) + x@ngroupi,
- line = "b",
- line_color = "#d3d8dc",
- line_width = 0.1)
- x <- style_tt(x,
+ i = -x@nhead + 1,
+ line = "t",
+ line_color = col,
+ line_width = 0.1
+ )
+ # mid
+ if (length(x@names) > 0) {
+ x <- style_tt(x,
+ bootstrap_class = bc,
+ i = 0,
+ line = "b",
+ line_color = col,
+ line_width = 0.05
+ )
+ }
+ # bottom
+ x <- style_tt(x,
bootstrap_class = bc,
- i = 0,
- line = "bt",
- line_color = "#d3d8dc",
- line_width = 0.1)
+ i = nrow(x),
+ line = "b",
+ line_color = col,
+ line_width = 0.1
+ )
}
+
return(x)
}
diff --git a/R/theme_grid.R b/R/theme_grid.R
index dcbf3ee3..4b78f675 100644
--- a/R/theme_grid.R
+++ b/R/theme_grid.R
@@ -1,23 +1,26 @@
theme_grid <- function(x, ...) {
+ fn <- theme_placement_factory(
+ horizontal = get_option("tinytable_theme_default_horizontal", "c"),
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
+ x <- style_tt(x, finalize = fn)
- fn <- theme_placement_factory(
- horizontal = get_option("tinytable_theme_default_horizontal", "c"),
- latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL))
- x <- style_tt(x, finalize = fn)
-
- fn <- function(table) {
- if (isTRUE(table@output == "latex")) {
- table <- theme_void_fn(table)
- } else if (isTRUE(table@output == "typst")) {
- table@table_string <- sub(
- "stroke: none,",
- "stroke: (paint: black),",
- table@table_string)
- }
- return(table)
+ fn <- function(table) {
+ if (isTRUE(table@output == "latex")) {
+ table <- theme_void_fn(table)
+ } else if (isTRUE(table@output == "typst")) {
+ table@table_string <- sub(
+ "stroke: none,",
+ "stroke: (paint: black),",
+ table@table_string
+ )
}
+ return(table)
+ }
- x <- style_tt(x, tabularray_inner = "hlines, vlines,", finalize = fn,
- bootstrap_class = "table table-bordered")
- return(x)
+ x <- style_tt(x,
+ tabularray_inner = "hlines, vlines,", finalize = fn,
+ bootstrap_class = "table table-bordered"
+ )
+ return(x)
}
diff --git a/R/theme_multipage.R b/R/theme_multipage.R
index 6d28635a..e5231a68 100644
--- a/R/theme_multipage.R
+++ b/R/theme_multipage.R
@@ -1,41 +1,41 @@
-theme_multipage <- function(x,
- rowhead = get_option("tinytable_theme_multipage_rowhead", 0L),
- rowfoot = get_option("tinytable_theme_multipage_rowfoot", 0L),
+theme_multipage <- function(x,
+ rowhead = get_option("tinytable_theme_multipage_rowhead", 0L),
+ rowfoot = get_option("tinytable_theme_multipage_rowfoot", 0L),
...) {
- # do not change the defaul theme
- if (identical(x@theme[[1]], "multipage")) x@theme <- list("default")
- assert_integerish(rowhead, lower = 0, len = 1)
- assert_integerish(rowfoot, lower = 0, len = 1)
- # cap <- sprintf("caption={%s}", x@caption)
- # x@caption <- ""
- fn <- function(table) {
- if (!isTRUE(table@output == "latex")) return(table)
-
- tab <- table@table_string
- tab <- sub("\\\\begin\\{talltblr", "\\\\begin\\{longtblr", tab)
- tab <- sub("\\\\end\\{talltblr", "\\\\end\\{longtblr", tab)
-
- tab <- strsplit(tab, "\n")[[1]]
- idx <- grepl("^\\\\caption\\{|^\\\\begin\\{table|^\\\\end\\{table|^\\\\centering", trimws(tab))
- tab <- tab[!idx]
- tab <- paste(tab, collapse = "\n")
+ # do not change the defaul theme
+ if (identical(x@theme[[1]], "multipage")) x@theme <- list("default")
+ assert_integerish(rowhead, lower = 0, len = 1)
+ assert_integerish(rowfoot, lower = 0, len = 1)
+ # cap <- sprintf("caption={%s}", x@caption)
+ # x@caption <- ""
+ fn <- function(table) {
+ if (!isTRUE(table@output == "latex")) {
+ return(table)
+ }
- table@table_string <- tab
+ tab <- table@table_string
+ tab <- sub("\\\\begin\\{talltblr", "\\\\begin\\{longtblr", tab)
+ tab <- sub("\\\\end\\{talltblr", "\\\\end\\{longtblr", tab)
- # table <- style_tt(table, tabularray_outer = cap)
+ tab <- strsplit(tab, "\n")[[1]]
+ idx <- grepl("^\\\\caption\\{|^\\\\begin\\{table|^\\\\end\\{table|^\\\\centering", trimws(tab))
+ tab <- tab[!idx]
+ tab <- paste(tab, collapse = "\n")
- if (rowhead > 0) {
- table <- style_tt(table, tabularray_inner = sprintf("rowhead=%s", rowhead))
- }
+ table@table_string <- tab
- if (rowfoot > 0) {
- table <- style_tt(table, tabularray_inner = sprintf("rowfoot=%s", rowfoot))
- }
+ # table <- style_tt(table, tabularray_outer = cap)
- return(table)
+ if (rowhead > 0) {
+ table <- style_tt(table, tabularray_inner = sprintf("rowhead=%s", rowhead))
}
- x <- style_tt(x, finalize = fn)
- return(x)
-}
+ if (rowfoot > 0) {
+ table <- style_tt(table, tabularray_inner = sprintf("rowfoot=%s", rowfoot))
+ }
+ return(table)
+ }
+ x <- style_tt(x, finalize = fn)
+ return(x)
+}
diff --git a/R/theme_placement.R b/R/theme_placement.R
index 21d17cc8..1937b8ba 100644
--- a/R/theme_placement.R
+++ b/R/theme_placement.R
@@ -1,36 +1,34 @@
theme_placement_factory <- function(
horizontal = get_option("tinytable_theme_placement_horizontal", default = NULL),
latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)) {
-
- function(x) {
- tab <- x@table_string
- if (x@output == "latex" && !is.null(latex_float)) {
- assert_string(latex_float, null.ok = TRUE)
- tab <- sub(
- "\\\\begin\\{table\\}([^\\[])",
- sprintf("\\\\begin{table}[%s]\\1", latex_float),
- tab)
- } else if (x@output == "typst" && !is.null(horizontal)) {
- assert_choice(horizontal, c("l", "c", "r"))
- if (horizontal == "l") {
- tab <- sub("#align(center,", "#align(left,", tab, fixed = TRUE)
- } else if (horizontal == "r") {
- tab <- sub("#align(center,", "#align(right,", tab, fixed = TRUE)
- }
- }
- x@table_string <- tab
- return(x)
+ function(x) {
+ tab <- x@table_string
+ if (x@output == "latex" && !is.null(latex_float)) {
+ assert_string(latex_float, null.ok = TRUE)
+ tab <- sub(
+ "\\\\begin\\{table\\}([^\\[])",
+ sprintf("\\\\begin{table}[%s]\\1", latex_float),
+ tab
+ )
+ } else if (x@output == "typst" && !is.null(horizontal)) {
+ assert_choice(horizontal, c("l", "c", "r"))
+ if (horizontal == "l") {
+ tab <- sub("#align(center,", "#align(left,", tab, fixed = TRUE)
+ } else if (horizontal == "r") {
+ tab <- sub("#align(center,", "#align(right,", tab, fixed = TRUE)
+ }
}
+ x@table_string <- tab
+ return(x)
+ }
}
theme_placement <- function(
- x,
+ x,
horizontal = get_option("tinytable_theme_placement_horizontal", default = NULL),
latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)) {
- fn <- theme_placement_factory(horizontal = horizontal, latex_float = latex_float)
- x <- style_tt(x, finalize = fn)
- return(x)
+ fn <- theme_placement_factory(horizontal = horizontal, latex_float = latex_float)
+ x <- style_tt(x, finalize = fn)
+ return(x)
}
-
-
diff --git a/R/theme_resize.R b/R/theme_resize.R
index f56d2c2f..345ea029 100644
--- a/R/theme_resize.R
+++ b/R/theme_resize.R
@@ -1,44 +1,44 @@
-theme_resize <- function(x,
- width = get_option("tinytable_theme_resize_width", 1),
- direction = get_option("tinytable_theme_resize_direction", "down"),
+theme_resize <- function(x,
+ width = get_option("tinytable_theme_resize_width", 1),
+ direction = get_option("tinytable_theme_resize_direction", "down"),
...) {
+ fn <- theme_placement_factory(
+ horizontal = get_option("tinytable_theme_default_horizontal", "c"),
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
+ x <- style_tt(x, finalize = fn)
+
+ assert_numeric(width, len = 1, lower = 0.01, upper = 1)
+ assert_choice(direction, c("down", "up", "both"))
+ # do not change the default theme
+ if (identical(x@theme[[1]], "resize")) x@theme <- list("default")
+ fn <- function(table) {
+ if (!isTRUE(table@output == "latex")) {
+ return(table)
+ }
- fn <- theme_placement_factory(
- horizontal = get_option("tinytable_theme_default_horizontal", "c"),
- latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL))
- x <- style_tt(x, finalize = fn)
-
- assert_numeric(width, len = 1, lower = 0.01, upper = 1)
- assert_choice(direction, c("down", "up", "both"))
- # do not change the default theme
- if (identical(x@theme[[1]], "resize")) x@theme <- list("default")
- fn <- function(table) {
- if (!isTRUE(table@output == "latex")) return(table)
+ tab <- table@table_string
- tab <- table@table_string
+ if (direction == "both") {
+ new <- sprintf("\\resizebox{%s\\linewidth}{!}{", width)
+ } else if (direction == "down") {
+ new <- sprintf("\\resizebox{\\ifdim\\width>\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
+ } else if (direction == "up") {
+ new <- sprintf("\\resizebox{\\ifdim\\width<\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
+ }
- if (direction == "both") {
- new <- sprintf("\\resizebox{%s\\linewidth}{!}{", width)
- } else if (direction == "down") {
- new <- sprintf("\\resizebox{\\ifdim\\width>\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
- } else if (direction == "up") {
- new <- sprintf("\\resizebox{\\ifdim\\width<\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
- }
+ reg <- "\\\\begin\\{tblr\\}|\\\\begin\\{talltblr\\}"
+ tab <- lines_insert(tab, regex = reg, new = new, position = "before")
- reg <- "\\\\begin\\{tblr\\}|\\\\begin\\{talltblr\\}"
- tab <- lines_insert(tab, regex = reg, new = new, position = "before")
+ new <- "}"
+ reg <- "\\\\end\\{tblr\\}|\\\\end\\{talltblr\\}"
+ tab <- lines_insert(tab, regex = reg, new = new, position = "after")
- new <- "}"
- reg <- "\\\\end\\{tblr\\}|\\\\end\\{talltblr\\}"
- tab <- lines_insert(tab, regex = reg, new = new, position = "after")
+ table@table_string <- tab
- table@table_string <- tab
+ return(table)
+ }
- return(table)
- }
-
- x <- style_tt(x, finalize = fn)
- return(x)
+ x <- style_tt(x, finalize = fn)
+ return(x)
}
-
-
diff --git a/R/theme_revealjs.R b/R/theme_revealjs.R
new file mode 100644
index 00000000..5be2cab4
--- /dev/null
+++ b/R/theme_revealjs.R
@@ -0,0 +1,44 @@
+theme_revealjs <- function(
+ x,
+ fontsize = get_option("tinytable_theme_revealjs_fontsize", default = 0.8),
+ fontsize_caption = get_option("tinytable_theme_revealjs_fontsize_caption", default = 1)) {
+ css <- "
+// tables
+
+.reveal table {
+ // height: auto; /* Adjust table width to fit content up to the available slide space */
+ margin: auto;
+ border-collapse: collapse;
+ border-spacing: 0;
+}
+
+.reveal table th,
+.reveal table td {
+ border: none;
+ padding: .23em;
+ font-weight: lighter;
+ font-size: %sem;
+}
+
+/* Adds a bottom border to the table header row for distinction */
+.reveal table thead th,
+.reveal .slides table tr:last-child td,
+.reveal .slides table {
+ border-bottom: 2px solid #D3D3D3;
+}
+
+/* Make column headers bold */
+.reveal table thead th {
+/* font-weight: bold; */
+}
+
+/* Styling table captions */
+.reveal table caption {
+ color: #666666; /* Dark grey color for the caption */
+ font-size: %emem;
+}
+"
+ css <- sprintf(css, fontsize, fontsize_caption)
+ x <- style_tt(x, bootstrap_css_rule = css)
+ return(x)
+}
diff --git a/R/theme_rotate.R b/R/theme_rotate.R
index d04ca483..0db5403b 100644
--- a/R/theme_rotate.R
+++ b/R/theme_rotate.R
@@ -1,35 +1,38 @@
theme_rotate <- function(x, angle = 90, ...) {
- assert_numeric(angle, len = 1, lower = 0, upper = 360)
- fn <- function(table) {
- if (isTRUE(table@output == "latex")) {
- rot <- sprintf("\\begin{table}\n\\rotatebox{%s}{", angle)
- table@table_string <- sub(
- "\\begin{table}",
- rot,
- table@table_string,
- fixed = TRUE)
- table@table_string <- sub(
- "\\end{table}",
- "}\n\\end{table}",
- table@table_string,
- fixed = TRUE)
- } else if (isTRUE(table@output == "typst")) {
- rot <- sprintf("#rotate(-%sdeg, reflow: true, [\n #figure(", angle)
- table@table_string <- sub(
- "#figure(",
- rot,
- table@table_string,
- fixed = TRUE)
- table@table_string <- sub(
- ") // end figure",
- ") ]) // end figure",
- table@table_string,
- fixed = TRUE)
- }
- table <- style_tt(table, finalize = fn)
- return(table)
+ assert_numeric(angle, len = 1, lower = 0, upper = 360)
+ fn <- function(table) {
+ if (isTRUE(table@output == "latex")) {
+ rot <- sprintf("\\begin{table}\n\\rotatebox{%s}{", angle)
+ table@table_string <- sub(
+ "\\begin{table}",
+ rot,
+ table@table_string,
+ fixed = TRUE
+ )
+ table@table_string <- sub(
+ "\\end{table}",
+ "}\n\\end{table}",
+ table@table_string,
+ fixed = TRUE
+ )
+ } else if (isTRUE(table@output == "typst")) {
+ rot <- sprintf("#rotate(-%sdeg, reflow: true, [\n #figure(", angle)
+ table@table_string <- sub(
+ "#figure(",
+ rot,
+ table@table_string,
+ fixed = TRUE
+ )
+ table@table_string <- sub(
+ ") // end figure",
+ ") ]) // end figure",
+ table@table_string,
+ fixed = TRUE
+ )
}
- x <- style_tt(x, finalize = fn)
- return(x)
+ table <- style_tt(table, finalize = fn)
+ return(table)
+ }
+ x <- style_tt(x, finalize = fn)
+ return(x)
}
-
diff --git a/R/theme_spacing.R b/R/theme_spacing.R
new file mode 100644
index 00000000..10c1153c
--- /dev/null
+++ b/R/theme_spacing.R
@@ -0,0 +1,48 @@
+theme_spacing <- function(x,
+ rowsep = get_option("tinytable_theme_spacing_rowsep", 0.1),
+ colsep = get_option("tinytable_theme_spacing_colsep", 0.5),
+ ...) {
+ # placement
+ fn <- theme_placement_factory(
+ horizontal = get_option("tinytable_theme_default_horizontal", "c"),
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
+ x <- style_tt(x, finalize = fn)
+
+ # rules
+ if (isTRUE(x@output %in% c("html", "typst"))) {
+ bc <- if (length(x@bootstrap_class) == 0) "table table-borderless" else x@bootstrap_class
+ x <- style_tt(x,
+ bootstrap_class = bc,
+ i = nrow(x),
+ line = "b",
+ line_color = "#d3d8dc",
+ line_width = 0.1
+ )
+ x <- style_tt(x,
+ bootstrap_class = bc,
+ i = 0,
+ line = "bt",
+ line_color = "#d3d8dc",
+ line_width = 0.1
+ )
+ }
+
+ # spacing
+ x <- style_tt(x,
+ tabularray_inner = sprintf("rowsep={%sem}, colsep = {%sem}", rowsep, colsep)
+ )
+ x <- style_tt(x,
+ tabularray_inner = sprintf("rowsep={%sem}, colsep = {%sem}", rowsep, colsep)
+ )
+ x <- style_tt(x,
+ j = seq_len(ncol(x) - 1),
+ bootstrap_css = sprintf("padding-right: %sem;", colsep)
+ )
+ x <- style_tt(x,
+ i = -5:(nrow(x) - 1),
+ bootstrap_css = sprintf("padding-bottom: %sem;", rowsep)
+ )
+
+ return(x)
+}
diff --git a/R/theme_striped.R b/R/theme_striped.R
index 375ecd9a..80d9ee28 100644
--- a/R/theme_striped.R
+++ b/R/theme_striped.R
@@ -1,32 +1,36 @@
theme_striped <- function(x, ...) {
+ fn <- theme_placement_factory(
+ horizontal = get_option("tinytable_theme_default_horizontal", "c"),
+ latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)
+ )
+ x <- style_tt(x, finalize = fn)
- fn <- theme_placement_factory(
- horizontal = get_option("tinytable_theme_default_horizontal", "c"),
- latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL))
- x <- style_tt(x, finalize = fn)
+ x <- style_tt(x,
+ tabularray_inner = "row{even}={bg=black!5!white}",
+ bootstrap_class = "table table-striped",
+ output = "latex"
+ )
- x <- style_tt(x,
- tabularray_inner = "row{even}={bg=black!5!white}",
- bootstrap_class = "table table-striped",
- output = "latex")
-
- x <- style_tt(x,
- i = seq(1, nrow(x), by = 2),
- background = "#ededed",
- output = "typst")
+ x <- style_tt(x,
+ i = seq(1, nrow(x), by = 2),
+ background = "#ededed",
+ output = "typst"
+ )
- # theme_default
- if (isTRUE(x@output %in% c("html", "typst"))) {
- x <- style_tt(x,
- i = nrow(x),
- line = "b",
- line_color = "#d3d8dc",
- line_width = 0.1)
- x <- style_tt(x,
- i = 0,
- line = "bt",
- line_color = "#d3d8dc",
- line_width = 0.1)
- }
- return(x)
+ # theme_default
+ if (isTRUE(x@output %in% c("html", "typst"))) {
+ x <- style_tt(x,
+ i = nrow(x),
+ line = "b",
+ line_color = "#d3d8dc",
+ line_width = 0.1
+ )
+ x <- style_tt(x,
+ i = 0,
+ line = "bt",
+ line_color = "#d3d8dc",
+ line_width = 0.1
+ )
+ }
+ return(x)
}
diff --git a/R/theme_tabular.R b/R/theme_tabular.R
index 5e7442fb..d50548fa 100644
--- a/R/theme_tabular.R
+++ b/R/theme_tabular.R
@@ -1,55 +1,50 @@
-theme_tabular <- function(x,
- style = get_option("tinytable_theme_tabular_style", "tabular"),
+theme_tabular <- function(x,
+ style = get_option("tinytable_theme_tabular_style", "tabular"),
...) {
-
- assert_choice(style, c("tabular", "tabularray"))
-
- # do not change the default theme
- if (identical(x@theme[[1]], "tabular")) x@theme <- list("default")
-
- fn <- function(table) {
- tab <- table@table_string
-
- if (isTRUE(table@output == "latex")) {
- tab <- lines_drop(tab, regex = "\\\\begin\\{table\\}", position = "before")
- tab <- lines_drop(tab, regex = "\\\\begin\\{table\\}", position = "equal")
- tab <- lines_drop(tab, regex = "\\\\end\\{table\\}", position = "after")
- tab <- lines_drop(tab, regex = "\\\\end\\{table\\}", position = "equal")
- tab <- lines_drop(tab, regex = "\\\\centering", position = "equal")
- if (style == "tabular") {
- tab <- lines_drop_between(tab, regex_start = "tabularray outer open", regex_end = "tabularray inner close")
- tab <- lines_drop(tab, regex = "tabularray outer close", position = "equal")
- tab <- lines_drop(tab, regex = "tabularray inner open", position = "equal")
- tab <- lines_drop(tab, regex = "tabularray inner close", position = "equal")
- tab <- lines_drop(tab, regex = "^colspec=\\{", position = "equal")
- tab <- gsub("cmidrule\\[(.*?)\\]", "cmidrule(\\1)", tab)
- tab <- gsub("\\{tblr\\}\\[*", "{tabular}", tab)
- tab <- gsub("\\{talltblr\\}\\[", "{tabular}", tab)
- tab <- gsub("\\{talltblr\\}", "{tabular}", tab)
- tab <- gsub("\\{longtblr\\}\\[", "{tabular}", tab)
- tab <- gsub("\\{longtblr\\}", "{tabular}", tab)
- tab <- gsub("\\\\toprule|\\\\midrule|\\\\bottomrule", "\\\\hline", tab)
- tab <- sub("\\s*%% tabularray outer open", "", tab)
- tab <- sub("\\s*%% TinyTableHeader", "", tab)
- # align
- a <- sprintf("begin{tabular}{%s}", strrep("l", ncol(table)))
- tab <- sub("begin{tabular}", a, tab, fixed = TRUE)
- }
-
- } else if (isTRUE(table@output == "html")) {
- tab <- lines_drop(tab, regex = "
theme_tt("striped")
-#'
+#'
#' # resize w/ argument
-#' x <- cbind(mtcars[1:10,], mtcars[1:10,])
+#' x <- cbind(mtcars[1:10, ], mtcars[1:10, ])
#' tt(x) |>
#' theme_tt("resize", width = .9) |>
#' print("latex")
-#'
+#'
#' @return A modified `tinytable` object
#' @export
theme_tt <- function(x, theme, ...) {
- assert_class(x, "tinytable")
- if (is.null(theme)) return(x)
- if (is.function(theme)) return(theme(x, ...))
- td <- theme_dictionary
- na <- unique(sort(names(td)))
- assert_choice(theme, na)
- fn <- td[[theme]]
- out <- list(list(fn, list(...)))
- x@lazy_theme <- c(x@lazy_theme, out)
+ assert_class(x, "tinytable")
+ if (is.null(theme)) {
return(x)
+ }
+ if (is.function(theme)) {
+ return(theme(x, ...))
+ }
+ td <- theme_dictionary
+ na <- unique(sort(names(td)))
+ assert_choice(theme, na)
+ fn <- td[[theme]]
+ out <- list(list(fn, list(...)))
+ x@lazy_theme <- c(x@lazy_theme, out)
+ return(x)
}
-
diff --git a/R/tt.R b/R/tt.R
index c7487273..cc31de18 100644
--- a/R/tt.R
+++ b/R/tt.R
@@ -15,8 +15,8 @@
#' @param x A data frame or data table to be rendered as a table.
#' @param digits Number of significant digits to keep for numeric variables. When `digits` is an integer, `tt()` calls `format_tt(x, digits = digits)` before proceeding to draw the table. Note that this will apply all default argument values of `format_tt()`, such as replacing `NA` by "". Users who need more control can use the `format_tt()` function instead.
#' @param caption A string that will be used as the caption of the table. This argument should *not* be used in Quarto or Rmarkdown documents. In that context, please use the appropriate chunk options.
-#' @param width Table or column width.
-#' - Single numeric value smaller than or equal to 1 determines the full table width, in proportion of line width.
+#' @param width Table or column width.
+#' - Single numeric value smaller than or equal to 1 determines the full table width, in proportion of line width.
#' - Numeric vector of length equal to the number of columns in `x` determines the width of each column, in proportion of line width. If the sum of `width` exceeds 1, each element is divided by `sum(width)`. This makes the table full-width with relative column sizes.
#' @param theme Function or string.
#' - String: `r paste(setdiff(names(theme_dictionary), "default"), collapse = ", ")`
@@ -30,31 +30,33 @@
#' @param escape Logical. If `TRUE`, escape special characters in the table. Equivalent to `format_tt(tt(x), escape = TRUE)`.
#' @param ... Additional arguments are ignored
#' @return An object of class `tt` representing the table.
-#'
+#'
#' The table object has S4 slots which hold information about the structure of the table. Relying on or modifying the contents of these slots is strongly discouraged. Their names and contents could change at any time, and the `tinytable` developers do not consider changes to the internal structure of the output object to be a "breaking change" for versioning or changelog purposes.
+#' @template dependencies
#' @template latex_preamble
+#' @template limitations_word_markdown
#' @template global_options
-#'
+#'
#' @examples
#' library(tinytable)
#' x <- mtcars[1:4, 1:5]
#'
#' tt(x)
-#'
+#'
#' tt(x,
-#' theme = "striped",
-#' width = 0.5,
-#' caption = "Data about cars.")
-#'
+#' theme = "striped",
+#' width = 0.5,
+#' caption = "Data about cars.")
+#'
#' tt(x, notes = "Hello World!")
#'
#' fn <- list(i = 0:1, j = 2, text = "Hello World!")
#' tab <- tt(x, notes = list("*" = fn))
#' print(tab, "latex")
-#'
+#'
#' k <- data.frame(x = c(0.000123456789, 12.4356789))
-#' tt(k, digits=2)
-#'
+#' tt(k, digits = 2)
+#'
#' @export
tt <- function(x,
digits = get_option("tinytable_tt_digits", default = NULL),
@@ -65,8 +67,6 @@ tt <- function(x,
rownames = get_option("tinytable_tt_rownames", default = FALSE),
escape = get_option("tinytable_tt_escape", default = FALSE),
...) {
-
-
dots <- list(...)
# sanity checks
@@ -90,20 +90,20 @@ tt <- function(x,
# it might be dangerous to leave non-numerics, but what about dates and other character-coercibles?
for (i in seq_along(x)) {
if (is.factor(x[[i]])) {
- x[[i]] <- as.character(x[[i]])
+ x[[i]] <- as.character(x[[i]])
}
}
assert_numeric(width, lower = 0, null.ok = TRUE)
if (!length(width) %in% c(0, 1, ncol(x))) {
- msg <- sprintf("The `width` argument must have length 1 or %s.", ncol(x))
- stop(msg, call. = FALSE)
+ msg <- sprintf("The `width` argument must have length 1 or %s.", ncol(x))
+ stop(msg, call. = FALSE)
}
if (sum(width) > 1) {
- width <- width / sum(width)
+ width <- width / sum(width)
}
- # bind the row names if the user explicitly asks for it in global option.
+ # bind the row names if the user explicitly asks for it in global option.
# Same name as tibble::rownames_to_column()
assert_flag(rownames)
if (isTRUE(rownames) && !is.null(row.names(x))) {
@@ -123,6 +123,7 @@ tt <- function(x,
# twice because format() leaves Date type, which cannot be partially reasigned
# with indexed format_tt(i)
tab <- data.frame(lapply(tab, format))
+ tab <- data.frame(lapply(tab, trimws))
colnames(tab) <- colnames(x)
out <- methods::new("tinytable",
@@ -131,7 +132,8 @@ tt <- function(x,
caption = caption,
notes = notes,
theme = list(theme),
- width = width)
+ width = width
+ )
if (is.null(theme)) {
out <- theme_tt(out, theme = "default")
diff --git a/R/tt_bootstrap.R b/R/tt_bootstrap.R
index 4fa11522..331d3b9b 100644
--- a/R/tt_bootstrap.R
+++ b/R/tt_bootstrap.R
@@ -2,176 +2,182 @@ setMethod(
f = "tt_eval",
signature = "tinytable_bootstrap",
definition = function(x, ...) {
+ template <- readLines(system.file("templates/bootstrap.html", package = "tinytable"))
+
+ mathjax <- get_option("tinytable_html_mathjax", default = FALSE)
+ assert_flag(mathjax, name = "tinytable_html_mathjax")
+ if (isFALSE(mathjax)) {
+ template <- paste(template, collapse = "\n")
+ sta <- " "
+ end <- " "
+ template <- lines_drop_between(template, sta, end, fixed = TRUE)
+ template <- strsplit(template, "\n")[[1]]
+ }
- template <- readLines(system.file("templates/bootstrap.html", package = "tinytable"))
-
- mathjax <- get_option("tinytable_html_mathjax", default = FALSE)
- assert_flag(mathjax, name = "tinytable_html_mathjax")
- if (isFALSE(mathjax)) {
- template <- paste(template, collapse = "\n")
- sta <- " "
- end <- " "
- template <- lines_drop_between(template, sta, end, fixed = TRUE)
- template <- strsplit(template, "\n")[[1]]
- }
-
- quartoprocessing <- get_option("tinytable_quarto_disable_processing", default = TRUE)
- assert_flag(quartoprocessing, name = "tinytable_quarto_disable_processing")
- if (isFALSE(quartoprocessing)) {
+ quartoprocessing <- get_option("tinytable_quarto_disable_processing", default = TRUE)
+ assert_flag(quartoprocessing, name = "tinytable_quarto_disable_processing")
+ if (isFALSE(quartoprocessing)) {
template <- sub("data-quarto-disable-processing='true'",
- "data-quarto-disable-processing='false'",
- template,
- fixed = TRUE)
- }
+ "data-quarto-disable-processing='false'",
+ template,
+ fixed = TRUE
+ )
+ }
- # caption
- if (length(x@caption) != 1) {
- template <- sub(
- "$tinytable_BOOTSTRAP_CAPTION",
- "",
- template,
- fixed = TRUE
- )
- } else {
- template <- sub(
- "$tinytable_BOOTSTRAP_CAPTION",
- sprintf("
")
- return(out)
- }
- body <- apply(x@table_dataframe, 1, makerow)
- idx <- grep("$tinytable_BOOTSTRAP_BODY", template, fixed = TRUE)
- template <- c(
- template[1:(idx - 1)],
- paste(strrep(" ", 13), body),
- template[(idx + 1):length(template)]
- )
-
- out <- paste(template, collapse = "\n")
-
- # before style_eval()
- x@table_string <- out
-
- if (length(x@bootstrap_class) == 0) {
- if (is.null(x@theme[[1]]) || is.function(x@theme[[1]]) || isTRUE("default" %in% x@theme[[1]])) {
- x <- theme_tt(x, "default")
+ out <- paste(template, collapse = "\n")
+
+ # before style_eval()
+ x@table_string <- out
+
+ if (length(x@bootstrap_class) == 0) {
+ if (is.null(x@theme[[1]]) || is.function(x@theme[[1]]) || isTRUE("default" %in% x@theme[[1]])) {
+ x <- theme_tt(x, "default")
+ }
+ } else if ("bootstrap" %in% x@theme[[1]]) {
+ x <- style_tt(x, bootstrap_class = "table")
+ } else if ("striped" %in% x@theme[[1]]) {
+ x <- style_tt(x, bootstrap_class = "table table-striped")
+ } else if ("grid" %in% x@theme[[1]]) {
+ x <- style_tt(x, bootstrap_class = "table table-bordered")
+ } else if ("void" %in% x@theme[[1]]) {
+ x <- style_tt(x, bootstrap_class = "table table-borderless")
}
- } else if ("bootstrap" %in% x@theme[[1]]) {
- x <- style_tt(x, bootstrap_class = "table")
- } else if ("striped" %in% x@theme[[1]]) {
- x <- style_tt(x, bootstrap_class = "table table-striped")
- } else if ("grid" %in% x@theme[[1]]) {
- x <- style_tt(x, bootstrap_class = "table table-bordered")
- } else if ("void" %in% x@theme[[1]]) {
- x <- style_tt(x, bootstrap_class = "table table-borderless")
- }
- if (length(x@width) > 1) {
+ if (length(x@width) > 1) {
for (j in seq_len(ncol(x))) {
- css <- sprintf("width: %s%%;", x@width[j] / sum(x@width) * 100)
- x <- style_tt(x, j = j, bootstrap_css = css)
+ css <- sprintf("width: %s%%;", x@width[j] / sum(x@width) * 100)
+ x <- style_tt(x, j = j, bootstrap_css = css)
}
- }
+ }
- return(x)
-})
+ return(x)
+ }
+)
bootstrap_setting <- function(x, new, component = "row") {
- att <- attributes(x)
+ att <- attributes(x)
out <- strsplit(x, "\n")[[1]]
if (component == "row") {
idx <- grep("tinytable rows before this", out)
diff --git a/R/tt_grid.R b/R/tt_grid.R
index ba67c2af..40bc5aca 100755
--- a/R/tt_grid.R
+++ b/R/tt_grid.R
@@ -6,8 +6,7 @@ grid_line <- function(width_cols, char = "-") {
}
-tt_eval_grid <- function(x, width_cols = NULL, ...) {
-
+tt_eval_grid <- function(x, width_cols = NULL, ...) {
is_matrix <- is.matrix(x)
if (is_matrix) {
tab <- x
@@ -16,7 +15,7 @@ tt_eval_grid <- function(x, width_cols = NULL, ...) {
}
if (is.null(width_cols)) {
- width_cols <- x@width_cols
+ width_cols <- x@width_cols
}
tthead <- inherits(x, "tinytable") && isTRUE(x@nhead > 0)
@@ -81,7 +80,9 @@ tt_eval_grid <- function(x, width_cols = NULL, ...) {
out <- paste(tab, collapse = "\n")
- if (is_matrix) return(out)
+ if (is_matrix) {
+ return(out)
+ }
# rebuild output
x@width_cols <- width_cols
@@ -140,14 +141,17 @@ grid_hlines <- function(x) {
setMethod(
f = "tt_eval",
signature = "tinytable_grid",
- definition = tt_eval_grid)
+ definition = tt_eval_grid
+)
setMethod(
f = "tt_eval",
signature = "matrix",
- definition = tt_eval_grid)
+ definition = tt_eval_grid
+)
setMethod(
f = "tt_eval",
signature = "tinytable_dataframe",
- definition = tt_eval_grid)
+ definition = tt_eval_grid
+)
diff --git a/R/tt_tabularray.R b/R/tt_tabularray.R
index 76e2cf16..21f86972 100644
--- a/R/tt_tabularray.R
+++ b/R/tt_tabularray.R
@@ -2,115 +2,111 @@ setMethod(
f = "tt_eval",
signature = "tinytable_tabularray",
definition = function(x, ...) {
+ template <- readLines(system.file("templates/tabularray.tex", package = "tinytable"))
- template <- readLines(system.file("templates/tabularray.tex", package = "tinytable"))
+ ncols <- ncol(x)
+ nrows <- nrow(x)
- ncols <- ncol(x)
- nrows <- nrow(x)
+ tall <- FALSE
+ if (length(x@caption) > 0) tall <- TRUE
+ if (length(x@notes) > 0) tall <- TRUE
- tall <- FALSE
- if (length(x@caption) > 0) tall <- TRUE
- if (length(x@notes) > 0) tall <- TRUE
+ # placement
+ if (length(x@placement) == 1) {
+ assert_string(x@placement)
+ # dollar sign to avoid [H][H] when we style multiple times
+ template <- sub("\\\\begin\\{table\\}", sprintf("\\\\begin{table}[%s]\n", x@placement), template)
+ }
- # placement
- if (length(x@placement) == 1) {
- assert_string(x@placement)
- # dollar sign to avoid [H][H] when we style multiple times
- template <- sub("\\\\begin\\{table\\}", sprintf("\\\\begin{table}[%s]\n", x@placement), template)
- }
-
- # body: main
- if (length(colnames(x)) > 0) {
- header <- paste(colnames(x), collapse = " & ")
- header <- paste(header, "\\\\")
- } else {
- header <- NULL
- }
- body <- apply(as.data.frame(x@table_dataframe), 1, paste, collapse = " & ")
- body <- paste(body, "\\\\")
-
- # theme: booktabs
- th <- x@theme[[1]]
- if (is.null(th) || is.function(th) || isTRUE(th %in% c("default", "striped"))) {
+ # body: main
if (length(colnames(x)) > 0) {
- # %% are important to distinguish between potentially redundant data rows
- header[length(header)] <- paste(header[length(header)], "\\midrule %% TinyTableHeader")
+ header <- paste(colnames(x), collapse = " & ")
+ header <- paste(header, "\\\\")
+ } else {
+ header <- NULL
+ }
+ body <- apply(as.data.frame(x@table_dataframe), 1, paste, collapse = " & ")
+ body <- paste(body, "\\\\")
+
+ # theme: booktabs
+ th <- x@theme[[1]]
+ if (is.null(th) || is.function(th) || isTRUE(th %in% c("default", "striped"))) {
+ if (length(colnames(x)) > 0) {
+ # %% are important to distinguish between potentially redundant data rows
+ header[length(header)] <- paste(header[length(header)], "\\midrule %% TinyTableHeader")
+ }
}
- }
-
- # body: finish
- idx <- grep("\\$tinytable_BODY", template)
- out <- c(
- template[1:(idx - 1)],
- header,
- body,
- template[(idx + 1):length(template)]
- )
- out <- trimws(out)
- out <- paste(out, collapse = "\n")
+ # body: finish
+ idx <- grep("\\$tinytable_BODY", template)
+ out <- c(
+ template[1:(idx - 1)],
+ header,
+ body,
+ template[(idx + 1):length(template)]
+ )
- if (length(x@caption) > 0) {
- spec <- sprintf("caption={%s},", x@caption[1])
- out <- tabularray_insert(out, content = spec, type = "outer")
- }
+ out <- trimws(out)
+ out <- paste(out, collapse = "\n")
- if (length(x@width) == 0) {
- tabularray_cols <- rep("Q[]", ncol(x))
-
- } else if (length(x@width) == 1) {
- tabularray_cols <- rep("X[]", ncol(x))
- spec <- sprintf("width={%s\\linewidth},", round(x@width, 4))
- out <- tabularray_insert(out, content = spec, type = "inner")
+ if (length(x@caption) > 0) {
+ spec <- sprintf("caption={%s},", x@caption[1])
+ out <- tabularray_insert(out, content = spec, type = "outer")
+ }
- } else if (length(x@width) > 1) {
- tabularray_cols <- sprintf("X[%s]", x@width)
- spec <- sprintf("width={%s\\linewidth},", round(sum(x@width), 4))
- out <- tabularray_insert(out, content = spec, type = "inner")
- }
+ if (length(x@width) == 0) {
+ tabularray_cols <- rep("Q[]", ncol(x))
+ } else if (length(x@width) == 1) {
+ tabularray_cols <- rep("X[]", ncol(x))
+ spec <- sprintf("width={%s\\linewidth},", round(x@width, 4))
+ out <- tabularray_insert(out, content = spec, type = "inner")
+ } else if (length(x@width) > 1) {
+ tabularray_cols <- sprintf("X[%s]", x@width)
+ spec <- sprintf("width={%s\\linewidth},", round(sum(x@width), 4))
+ out <- tabularray_insert(out, content = spec, type = "inner")
+ }
- # colspec (we don't need rowspec)
- colspec <- sprintf("colspec={%s},", paste(tabularray_cols, collapse = ""))
- out <- tabularray_insert(out, content = colspec, type = "inner")
+ # colspec (we don't need rowspec)
+ colspec <- sprintf("colspec={%s},", paste(tabularray_cols, collapse = ""))
+ out <- tabularray_insert(out, content = colspec, type = "inner")
- # notes
- if (length(x@notes) > 0) {
- if (length(x@caption) == 0) {
+ # notes
+ if (length(x@notes) > 0) {
+ if (length(x@caption) == 0) {
# otherwise an empty caption is created automatically
out <- tabularray_insert(out, content = "entry=none,label=none", type = "outer")
- }
- if (is.null(names(x@notes))) {
- lab <- sapply(seq_along(x@notes), function(k) strrep(" ", k - 1))
- } else {
- lab <- NULL
- pad <- 0
- for (i in seq_along(x@notes)) {
- # tabularray requires unique labels, but multiple blanks work
- if (names(x@notes)[i] == "") {
- lab[i] <- strrep(" ", pad) # not sure why -1 is necessary in tabularray
- pad <- pad + 1
- } else {
- lab[i] <- names(x@notes)[i]
+ }
+ if (is.null(names(x@notes))) {
+ lab <- sapply(seq_along(x@notes), function(k) strrep(" ", k - 1))
+ } else {
+ lab <- NULL
+ pad <- 0
+ for (i in seq_along(x@notes)) {
+ # tabularray requires unique labels, but multiple blanks work
+ if (names(x@notes)[i] == "") {
+ lab[i] <- strrep(" ", pad) # not sure why -1 is necessary in tabularray
+ pad <- pad + 1
+ } else {
+ lab[i] <- names(x@notes)[i]
+ }
}
}
+ notes <- sapply(x@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")
+ }
}
- notes <- sapply(x@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")
- }
- }
-
- if (isTRUE(tall)) {
- out <- sub("\\begin{tblr}", "\\begin{talltblr}", out, fixed = TRUE)
- out <- sub("\\end{tblr}", "\\end{talltblr}", out, fixed = TRUE)
- }
- x@table_string <- out
- x@body <- body
-
- return(x)
-})
+ if (isTRUE(tall)) {
+ out <- sub("\\begin{tblr}", "\\begin{talltblr}", out, fixed = TRUE)
+ out <- sub("\\end{tblr}", "\\end{talltblr}", out, fixed = TRUE)
+ }
+ x@table_string <- out
+ x@body <- body
+ return(x)
+ }
+)
diff --git a/R/tt_typst.R b/R/tt_typst.R
index 1cd347c9..b41530dd 100644
--- a/R/tt_typst.R
+++ b/R/tt_typst.R
@@ -2,86 +2,95 @@ setMethod(
f = "tt_eval",
signature = "tinytable_typst",
definition = function(x, ...) {
- out <- readLines(system.file("templates/typst.typ", package = "tinytable"))
- out <- paste(out, collapse = "\n")
+ out <- readLines(system.file("templates/typst.typ", package = "tinytable"))
+ out <- paste(out, collapse = "\n")
- # body
- body <- apply(x@table_dataframe, 2, function(k) paste0("[", k, "]"))
- if (nrow(x@table_dataframe) && is.null(dim(body))) {
- body <- matrix(body)
- }
- header <- !is.null(colnames(x)) && length(colnames(x)) > 0
- if (header) {
- header <- paste(paste0("[", colnames(x), "]"), collapse = ", ")
- header <- paste0(header, ",")
- out <- lines_insert(out, header, "repeat: true", "after")
- }
- body <- apply(body, 1, paste, collapse = ", ", simplify = FALSE)
- body <- paste(body, collapse = ",\n")
- body <- paste0(body, ",\n")
- out <- typst_insert(out, body, type = "body")
+ # body
+ body <- apply(x@table_dataframe, 2, function(k) paste0("[", k, "]"))
+ if (nrow(x@table_dataframe) && is.null(dim(body))) {
+ body <- matrix(body)
+ }
+ header <- !is.null(colnames(x)) && length(colnames(x)) > 0
+ if (header) {
+ header <- paste(paste0("[", colnames(x), "]"), collapse = ", ")
+ header <- paste0(header, ",")
+ out <- lines_insert(out, header, "repeat: true", "after")
+ }
+ body <- apply(body, 1, paste, collapse = ", ", simplify = FALSE)
+ body <- paste(body, collapse = ",\n")
+ body <- paste0(body, ",\n")
+ out <- typst_insert(out, body, type = "body")
- if (length(x@width) == 0) {
- width <- rep("auto", ncol(x))
- } else if (length(x@width) == 1) {
- width <- rep(sprintf("%.2f%%", x@width / ncol(x) * 100), ncol(x))
- } else {
- width <- sprintf("%.2f%%", x@width * 100)
- }
- width <- sprintf(" columns: (%s),", paste(width, collapse = ", "))
- out <- lines_insert(out, width, "tinytable table start", "after")
+ if (length(x@width) == 0) {
+ width <- rep("auto", ncol(x))
+ } else if (length(x@width) == 1) {
+ width <- rep(sprintf("%.2f%%", x@width / ncol(x) * 100), ncol(x))
+ } else {
+ width <- sprintf("%.2f%%", x@width * 100)
+ }
+ width <- sprintf(" columns: (%s),", paste(width, collapse = ", "))
+ out <- lines_insert(out, width, "tinytable table start", "after")
- # notes
- if (length(x@notes) > 0) {
- ft <- "
+ # notes
+ if (length(x@notes) > 0) {
+ ft <- "
table.footer(
repeat: false,
// tinytable notes after
),
"
- out <- lines_insert(out, ft, "tinytable footer after", "after")
- notes <- rev(x@notes)
- # otherwise an empty caption is created automatically
- if (is.null(names(notes))) {
- lab <- rep("", length(notes))
- } else {
- lab <- names(notes)
- }
- notes <- sapply(notes, function(n) if (is.list(n)) n$text else n)
- for (k in seq_along(notes)) {
- if (lab[k] == "") {
- tmp <- sprintf(" table.cell(align: left, colspan: %s, [%s]),", ncol(x), notes[k])
+ out <- lines_insert(out, ft, "tinytable footer after", "after")
+ notes <- rev(x@notes)
+ # otherwise an empty caption is created automatically
+ if (is.null(names(notes))) {
+ lab <- rep("", length(notes))
} else {
- tmp <- sprintf(" table.cell(align: left, colspan: %s, [#super[%s] %s]),", ncol(x), lab[k], notes[k])
+ lab <- names(notes)
+ }
+ notes <- sapply(notes, function(n) if (is.list(n)) n$text else n)
+ for (k in seq_along(notes)) {
+ if (lab[k] == "") {
+ tmp <- sprintf(" table.cell(align: left, colspan: %s, %s),", ncol(x), notes[k])
+ } else {
+ n <- notes[k]
+ l <- sprintf("[#super[%s] ", lab[k])
+ n <- sub("[", l, n, fixed = TRUE)
+ tmp <- sprintf(" table.cell(align: left, colspan: %s, %s),", ncol(x), n)
+ }
+ tmp <- sub("text(, ", "text(", tmp, fixed = TRUE)
+ out <- lines_insert(out, tmp, "tinytable notes after", "after")
}
- out <- lines_insert(out, tmp, "tinytable notes after", "after")
}
- }
- # default alignment
- align_default <- sprintf(
- " #let align-default-array = ( %s, ) // tinytable align-default-array here",
- paste(rep("left", ncol(x)), collapse = ", "))
- out <- lines_insert(
- out,
- align_default,
- "// tinytable align-default-array before",
- "after")
+ # default alignment
+ align_default <- sprintf(
+ " #let align-default-array = ( %s, ) // tinytable align-default-array here",
+ paste(rep("left", ncol(x)), collapse = ", ")
+ )
+ out <- lines_insert(
+ out,
+ align_default,
+ "// tinytable align-default-array before",
+ "after"
+ )
- x@table_string <- out
+ x@table_string <- out
- return(x)
-})
+ return(x)
+ }
+)
typst_insert <- function(x, content = NULL, type = "body") {
- if (is.null(content)) return(x)
+ if (is.null(content)) {
+ return(x)
+ }
out <- strsplit(x, "\n")[[1]]
comment <- switch(type,
- "lines" = "tinytable lines before",
- "style" = "tinytable cell style before",
- "body" = "tinytable cell content after"
+ "lines" = "tinytable lines before",
+ "style" = "tinytable cell style before",
+ "body" = "tinytable cell content after"
)
idx <- grep(comment, out)
diff --git a/R/utils.R b/R/utils.R
index 70bc5435..39f5bdcf 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -36,7 +36,7 @@ lines_drop_consecutive_empty <- function(x) {
lines <- strsplit(x, "\n")[[1]]
tmp <- rle(lines)
tmp$lengths[trimws(tmp$values) == ""] <- 1
- lines <- inverse.rle(tmp)
+ lines <- inverse.rle(tmp)
x <- paste0(lines, collapse = "\n")
return(x)
}
@@ -78,7 +78,7 @@ lines_drop_between <- function(text, regex_start, regex_end, fixed = FALSE) {
if (idx_start >= idx_end) {
stop("`regex_start` matches a line after `regex_end`.", call. = FALSE)
}
- lines_to_keep <- c(1:(idx_start-1), (idx_end+1):length(lines))
+ lines_to_keep <- c(1:(idx_start - 1), (idx_end + 1):length(lines))
output <- lines[lines_to_keep]
out <- paste(output, collapse = "\n")
return(out)
@@ -86,19 +86,19 @@ lines_drop_between <- function(text, regex_start, regex_end, fixed = FALSE) {
lines_insert <- function(old, new, regex, position = "before") {
- lines <- strsplit(old, "\n")[[1]]
- idx <- grep(regex, lines)
- if (length(idx) != 1 || anyNA(idx)) {
- stop("The `regex` supplied `lines_insert()` did not match a unique line.", call. = FALSE)
- }
- if (position == "before") {
- top <- lines[1:(idx - 1)]
- bot <- lines[idx:length(lines)]
- } else if (position == "after") {
- top <- lines[1:idx]
- bot <- lines[(idx + 1):length(lines)]
- }
- lines <- c(top, new, bot)
- out <- paste(lines, collapse = "\n")
- return(out)
+ lines <- strsplit(old, "\n")[[1]]
+ idx <- grep(regex, lines)
+ if (length(idx) != 1 || anyNA(idx)) {
+ stop("The `regex` supplied `lines_insert()` did not match a unique line.", call. = FALSE)
+ }
+ if (position == "before") {
+ top <- lines[1:(idx - 1)]
+ bot <- lines[idx:length(lines)]
+ } else if (position == "after") {
+ top <- lines[1:idx]
+ bot <- lines[(idx + 1):length(lines)]
+ }
+ lines <- c(top, new, bot)
+ out <- paste(lines, collapse = "\n")
+ return(out)
}
diff --git a/R/zzz.R b/R/zzz.R
index add21f67..d4564bd9 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,5 +1,8 @@
-.onLoad <- function(libname, pkgname) {
- if(requireNamespace("knitr", quietly = TRUE)) {
- registerS3method("knit_print", "tinytable", knit_print.tinytable, envir = asNamespace("knitr"))
- }
-}
+# replaced this with @rawNamespace S3method(knitr::knit_print, tinytable) in print.R
+
+
+# .onLoad <- function(libname, pkgname) {
+# if (requireNamespace("knitr", quietly = TRUE)) {
+# registerS3method("knit_print", "tinytable", knit_print.tinytable, envir = asNamespace("knitr"))
+# }
+# }
diff --git a/README.md b/README.md
index 32116079..17a7fe8c 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,7 @@
+
@@ -12,7 +13,7 @@
## What?
`tinytable` is a small but powerful `R` package to draw beautiful tables
-in a variety of formats: HTML, LaTeX, Word, PDF, PNG, Markdown, and
+in a variety of formats: HTML, LaTeX, Word[^1], PDF, PNG, Markdown, and
Typst. The user interface is minimalist and easy to learn, while giving
users access to powerful frameworks to create endlessly customizable
tables.
@@ -26,25 +27,24 @@ ecosystem. Why release a new one? As [the maintainer of
`modelsummary`](https://modelsummary.com), I needed a table-drawing
package which was:
-- *Simple*: Streamlined, consistent, and uncluttered user interface,
- with few functions to learn.
-- *Flexible*: Expressive frameworks to customize tables in HTML and
- LaTeX formats.[1]
-- *Zero-dependency*: Avoid importing any other `R` package.[2]
-- *Concise*: Draw beautiful tables without typing a lot of code.
-- *Safe*: User inputs are checked thoroughly, and informative errors
- are returned early.
-- *Maintainable*: A small code base which does not rely on too many
- complex regular expressions.
-- *Readable*: HTML and LaTeX code should be human-readable and
- editable.
-- *Free*: This package will always be free. Tiny tables for a tiny
- price!
+- *Simple*: Streamlined, consistent, and uncluttered user interface,
+ with few functions to learn.
+- *Flexible*: Expressive frameworks to customize tables in HTML and
+ LaTeX formats.[^2]
+- *Zero-dependency*: Avoid importing any other `R` package.[^3]
+- *Concise*: Draw beautiful tables without typing a lot of code.
+- *Safe*: User inputs are checked thoroughly, and informative errors are
+ returned early.
+- *Maintainable*: A small code base which does not rely on too many
+ complex regular expressions.
+- *Readable*: HTML and LaTeX code should be human-readable and editable.
+- *Free*: This package will always be free. Tiny tables for a tiny
+ price!
To achieve these goals, the design philosophy of `tinytable` rests on
three pillars:
-1. *Data is separate from style.* The code that this package creates
+1) *Data is separate from style.* The code that this package creates
keeps the content of a table separate from the style sheet that
applies to its cells. This is in contrast to other `R` packages that
modify the actual text in each cell to style it. Keeping data and
@@ -53,13 +53,13 @@ three pillars:
developers to keep a simpler code base, with minimal use of messy
regular expressions.
-2. *Flexibility.* Users’ needs are extremely varied, and a
+2) *Flexibility.* Users’ needs are extremely varied, and a
table-drawing package must be flexible enough to accomodate
different ideas. To achieve this, `tinytable` builds on
battle-tested and versatile frameworks like `Bootstrap` for HTML and
`tabularray` for LaTeX.
-3. [*Lightweight is the right weight.*](https://www.tinyverse.org/)
+3) [*Lightweight is the right weight.*](https://www.tinyverse.org/)
Some of the most popular table-drawing packages in the `R` ecosystem
are very heavy: A single `library()` call can sometimes load upwards
of 65 `R` packages. In contrast, `tinytable` imports zero 3rd party
@@ -131,29 +131,34 @@ tt(x,
## Tutorial
-The `tinytable` 0.5.0.1 tutorial will take you much further. It is
+The `tinytable` 0.6.1.3 tutorial will take you much further. It is
available in two formats:
-- [Tutorial
- (PDF)](https://vincentarelbundock.github.io/tinytable/vignettes/tinytable_tutorial.pdf)
-- Tutorial (HTML):
- - [Tiny
- tables](https://vincentarelbundock.github.io/tinytable/vignettes/tinytable.html)
- - [Format](https://vincentarelbundock.github.io/tinytable/vignettes/format.html)
- - [Style](https://vincentarelbundock.github.io/tinytable/vignettes/style.html)
- - [Group
- labels](https://vincentarelbundock.github.io/tinytable/vignettes/group.html)
- - [Plots and
- images](https://vincentarelbundock.github.io/tinytable/vignettes/plot.html)
- - [Themes](https://vincentarelbundock.github.io/tinytable/vignettes/theme.html)
- - [Customization](https://vincentarelbundock.github.io/tinytable/vignettes/custom.html)
- - [FAQ](https://vincentarelbundock.github.io/tinytable/vignettes/faq.html)
- - [Alternatives](https://vincentarelbundock.github.io/tinytable/vignettes/alternatives.html)
-
-[1] Other formats like Markdown and Typst are also available, but less
-flexible.
-
-[2] Some extra packages can be imported to access specific
-functionality, such as integration with Quarto, inserting `ggplot2`
-objects as inline plots, and saving tables to PNG images or PDF
-documents.
+- [Tutorial
+ (PDF)](https://vincentarelbundock.github.io/tinytable/vignettes/tinytable_tutorial.pdf)
+- Tutorial (HTML):
+ - [Tiny
+ tables](https://vincentarelbundock.github.io/tinytable/vignettes/tinytable.html)
+ - [Format](https://vincentarelbundock.github.io/tinytable/vignettes/format.html)
+ - [Style](https://vincentarelbundock.github.io/tinytable/vignettes/style.html)
+ - [Group
+ labels](https://vincentarelbundock.github.io/tinytable/vignettes/group.html)
+ - [Plots and
+ images](https://vincentarelbundock.github.io/tinytable/vignettes/plot.html)
+ - [Themes](https://vincentarelbundock.github.io/tinytable/vignettes/theme.html)
+ - [Notebooks (Quarto, Rmarkdown, Bookdown,
+ etc.)](https://vincentarelbundock.github.io/tinytable/vignettes/notebooks.html)
+ - [Customization](https://vincentarelbundock.github.io/tinytable/vignettes/custom.html)
+ - [FAQ](https://vincentarelbundock.github.io/tinytable/vignettes/faq.html)
+ - [Alternatives](https://vincentarelbundock.github.io/tinytable/vignettes/alternatives.html)
+
+[^1]: Styling options in Word are somewhat limited. See the FAQ page and
+ the `style_tt()` documentation for details.
+
+[^2]: Other formats like Markdown and Typst are also available, but less
+ flexible.
+
+[^3]: Some extra packages can be imported to access specific
+ functionality, such as integration with Quarto, inserting `ggplot2`
+ objects as inline plots, and saving tables to PNG images or PDF
+ documents.
diff --git a/README.qmd b/README.qmd
index 779999ee..6725cde1 100644
--- a/README.qmd
+++ b/README.qmd
@@ -1,4 +1,6 @@
-
+---
+format: gfm
+---
@@ -12,7 +14,7 @@
## What?
-`tinytable` is a small but powerful `R` package to draw beautiful tables in a variety of formats: HTML, LaTeX, Word, PDF, PNG, Markdown, and Typst. The user interface is minimalist and easy to learn, while giving users access to powerful frameworks to create endlessly customizable tables.
+`tinytable` is a small but powerful `R` package to draw beautiful tables in a variety of formats: HTML, LaTeX, Word^[Styling options in Word are somewhat limited. See the FAQ page and the `style_tt()` documentation for details.], PDF, PNG, Markdown, and Typst. The user interface is minimalist and easy to learn, while giving users access to powerful frameworks to create endlessly customizable tables.
@@ -20,10 +22,10 @@
```{r, include=FALSE}
db <- tools::CRAN_package_db()
-dep_ke <- tools::package_dependencies(c("kableExtra"), recursive=TRUE, db=db)[[1]] |> length()
-dep_hux <- tools::package_dependencies(c("huxtable"), recursive=TRUE, db=db)[[1]] |> length()
-dep_dt <- tools::package_dependencies(c("DT"), recursive=TRUE, db=db)[[1]] |> length()
-dep_gt <- tools::package_dependencies(c("gt"), recursive=TRUE, db=db)[[1]] |> length()
+dep_ke <- tools::package_dependencies(c("kableExtra"), recursive = TRUE, db = db)[[1]] |> length()
+dep_hux <- tools::package_dependencies(c("huxtable"), recursive = TRUE, db = db)[[1]] |> length()
+dep_dt <- tools::package_dependencies(c("DT"), recursive = TRUE, db = db)[[1]] |> length()
+dep_gt <- tools::package_dependencies(c("gt"), recursive = TRUE, db = db)[[1]] |> length()
```
There are already many excellent table-drawing packages in the `R` ecosystem. Why release a new one? As [the maintainer of `modelsummary`](https://modelsummary.com), I needed a table-drawing package which was:
@@ -117,6 +119,7 @@ The `tinytable` `r packageVersion("tinytable")` tutorial will take you much furt
- [Group labels](https://vincentarelbundock.github.io/tinytable/vignettes/group.html)
- [Plots and images](https://vincentarelbundock.github.io/tinytable/vignettes/plot.html)
- [Themes](https://vincentarelbundock.github.io/tinytable/vignettes/theme.html)
+ - [Notebooks (Quarto, Rmarkdown, Bookdown, etc.)](https://vincentarelbundock.github.io/tinytable/vignettes/notebooks.html)
- [Customization](https://vincentarelbundock.github.io/tinytable/vignettes/custom.html)
- [FAQ](https://vincentarelbundock.github.io/tinytable/vignettes/faq.html)
- [Alternatives](https://vincentarelbundock.github.io/tinytable/vignettes/alternatives.html)
diff --git a/altdoc/quarto_website.yml b/altdoc/quarto_website.yml
index 3db87d35..85d6660d 100644
--- a/altdoc/quarto_website.yml
+++ b/altdoc/quarto_website.yml
@@ -20,7 +20,7 @@ website:
- vignettes/plot.qmd
- vignettes/theme.qmd
- vignettes/custom.qmd
- - vignettes/options.qmd
+ - vignettes/notebooks.qmd
- vignettes/faq.qmd
- text: Tutorial (PDF)
file: vignettes/tinytable_tutorial.pdf
@@ -34,24 +34,26 @@ website:
contents:
- section: Tutorial
contents:
- - text: Tiny tables
- file: vignettes/tinytable.qmd
- - text: Format
- file: vignettes/format.qmd
- - text: Style
- file: vignettes/style.qmd
- - text: Group labels
- file: vignettes/group.qmd
- - text: Plots and images
- file: vignettes/plot.qmd
- - text: Themes
- file: vignettes/theme.qmd
- - text: Customization
- file: vignettes/custom.qmd
- - text: FAQ
- file: vignettes/faq.qmd
- - text: Alternatives
- file: vignettes/alternatives.qmd
+ - text: Tiny tables
+ file: vignettes/tinytable.qmd
+ - text: Format
+ file: vignettes/format.qmd
+ - text: Style
+ file: vignettes/style.qmd
+ - text: Group labels
+ file: vignettes/group.qmd
+ - text: Plots and images
+ file: vignettes/plot.qmd
+ - text: Themes
+ file: vignettes/theme.qmd
+ - text: Customization
+ file: vignettes/custom.qmd
+ - text: Notebooks
+ file: vignettes/notebooks.qmd
+ - text: FAQ
+ file: vignettes/faq.qmd
+ - text: Alternatives
+ file: vignettes/alternatives.qmd
- text: "Tutorial (PDF)"
file: vignettes/tinytable_tutorial.pdf
- section: Functions
diff --git a/inst/templates/typst.typ b/inst/templates/typst.typ
index f5bb8e1e..1fddd737 100644
--- a/inst/templates/typst.typ
+++ b/inst/templates/typst.typ
@@ -42,27 +42,19 @@ block[ // start block
#table( // tinytable table start
stroke: none,
align: (x, y) => {
- let align-array = (
- // tinytable cell align after
- )
- if align-array.len() == 0 {
- left
+ let sarray = style-array.filter(a => "align" in a)
+ let sarray = sarray.filter(a => a.pairs.find(p => p.at(0) == x and p.at(1) == y) != none)
+ if sarray.len() > 0 {
+ sarray.last().align
} else {
left
- // for style in style-array {
- // let m = style.pairs.find(k => k.at(0) == x and k.at(1) == y)
- // if m != none and ("align" in style) {
- // let a = style.align
- // }
- // }
}
},
fill: (x, y) => {
- for style in style-array {
- let m = style.pairs.find(k => k.at(0) == x and k.at(1) == y)
- if m != none and ("background" in style) {
- style.background
- }
+ let sarray = style-array.filter(a => "background" in a)
+ let sarray = sarray.filter(a => a.pairs.find(p => p.at(0) == x and p.at(1) == y) != none)
+ if sarray.len() > 0 {
+ sarray.last().background
}
},
// tinytable lines before
diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_01.txt b/inst/tinytest/_tinysnapshot/docx-issue98_01.txt
index 46ab5adf..eed3351e 100644
--- a/inst/tinytest/_tinysnapshot/docx-issue98_01.txt
+++ b/inst/tinytest/_tinysnapshot/docx-issue98_01.txt
@@ -7,7 +7,7 @@
+------+-----+------+-----+------+
| 21.0 | 6 | 160 | 110 | 3.90 |
+------+-----+------+-----+------+
-| 22.8 | 4 | 108 | 93 | 3.85 |
+| 22.8 | 4 | 108 | 93 | 3.85 |
+------+-----+------+-----+------+
| 21.4 | 6 | 258 | 110 | 3.08 |
+------+-----+------+-----+------+
diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_02.txt b/inst/tinytest/_tinysnapshot/docx-issue98_02.txt
index 8f4baa5a..023da336 100644
--- a/inst/tinytest/_tinysnapshot/docx-issue98_02.txt
+++ b/inst/tinytest/_tinysnapshot/docx-issue98_02.txt
@@ -1,12 +1,12 @@
-+-----------+-----+------+-----+------+
-| mpg | cyl | disp | hp | drat |
-+===========+=====+======+=====+======+
-| $\sigma$ | 6 | 160 | 110 | 3.90 |
-+-----------+-----+------+-----+------+
-| 21 | 6 | 160 | 110 | 3.90 |
-+-----------+-----+------+-----+------+
-| 22.8 | 4 | 108 | 93 | 3.85 |
-+-----------+-----+------+-----+------+
-| 21.4 | 6 | 258 | 110 | 3.08 |
-+-----------+-----+------+-----+------+
++----------+-----+------+-----+------+
+| mpg | cyl | disp | hp | drat |
++==========+=====+======+=====+======+
+| $\sigma$ | 6 | 160 | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 21 | 6 | 160 | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 22.8 | 4 | 108 | 93 | 3.85 |
++----------+-----+------+-----+------+
+| 21.4 | 6 | 258 | 110 | 3.08 |
++----------+-----+------+-----+------+
diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_03.txt b/inst/tinytest/_tinysnapshot/docx-issue98_03.txt
index e57ef8e7..e4204181 100644
--- a/inst/tinytest/_tinysnapshot/docx-issue98_03.txt
+++ b/inst/tinytest/_tinysnapshot/docx-issue98_03.txt
@@ -1,12 +1,12 @@
-+-----------+-----+------+-----+------+
-| $\sigma$ | cyl | disp | hp | drat |
-+===========+=====+======+=====+======+
-| $\sigma$ | 6 | 160 | 110 | 3.90 |
-+-----------+-----+------+-----+------+
-| 21 | 6 | 160 | 110 | 3.90 |
-+-----------+-----+------+-----+------+
-| 22.8 | 4 | 108 | 93 | 3.85 |
-+-----------+-----+------+-----+------+
-| 21.4 | 6 | 258 | 110 | 3.08 |
-+-----------+-----+------+-----+------+
++----------+-----+------+-----+------+
+| $\sigma$ | cyl | disp | hp | drat |
++==========+=====+======+=====+======+
+| $\sigma$ | 6 | 160 | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 21 | 6 | 160 | 110 | 3.90 |
++----------+-----+------+-----+------+
+| 22.8 | 4 | 108 | 93 | 3.85 |
++----------+-----+------+-----+------+
+| 21.4 | 6 | 258 | 110 | 3.08 |
++----------+-----+------+-----+------+
diff --git a/inst/tinytest/_tinysnapshot/docx-issue98_04.txt b/inst/tinytest/_tinysnapshot/docx-issue98_04.txt
index 7b7ca7b3..19db6fdd 100644
--- a/inst/tinytest/_tinysnapshot/docx-issue98_04.txt
+++ b/inst/tinytest/_tinysnapshot/docx-issue98_04.txt
@@ -6,7 +6,7 @@
+----------+-----+------+-----+------+
| 21 | 6 | 160 | 110 | 3.90 |
+----------+-----+------+-----+------+
-| 22.8 | 4 | 108 | 93 | 3.85 |
+| 22.8 | 4 | 108 | 93 | 3.85 |
+----------+-----+------+-----+------+
| 21.4 | 6 | 258 | 110 | 3.08 |
+----------+-----+------+-----+------+
diff --git a/inst/tinytest/_tinysnapshot/format_tt-vignette_html_markdown.html b/inst/tinytest/_tinysnapshot/format_tt-vignette_html_markdown.html
index ada79f99..2465ff75 100644
--- a/inst/tinytest/_tinysnapshot/format_tt-vignette_html_markdown.html
+++ b/inst/tinytest/_tinysnapshot/format_tt-vignette_html_markdown.html
@@ -62,7 +62,8 @@
window.addEventListener('load', function () {
var cellsToStyle = [
// tinytable style arrays after
- { positions: [ { i: 0, j: 0 }, { i: 2, j: 0 }, ], css_id: 'tinytable_css_ps3hrarwxnclv9tvdcq0',},
+ { positions: [ { i: 0, j: 0 }, ], css_id: 'tinytable_css_ps3hrarwxnclv9tvdcq0',},
+ { positions: [ { i: 2, j: 0 }, ], css_id: 'tinytable_css_fe9hmaas4mta0vfcevu8',},
{ positions: [ { i: 1, j: 0 }, ], css_id: 'tinytable_css_9jxgyitf4or5kg1sue01',},
];
@@ -77,7 +78,8 @@
}}
+
+You can set options in a script or via \code{.Rprofile}. Note: be cautious with \code{.Rprofile} settings as they may affect reproducibility.
+\subsection{Default values for function arguments}{
+\subsection{tt()}{
\itemize{
-\item \code{options("tinytable_quarto_figure" = FALSE)}: Typst only. Normally, it is best to allow Quarto to define the figure environment, so the default behavior is to not include one.
+\item \code{tinytable_tt_digits}
+\item \code{tinytable_tt_caption}
+\item \code{tinytable_tt_notes}
+\item \code{tinytable_tt_width}
+\item \code{tinytable_tt_theme}
+\item \code{tinytable_tt_rownames}
}
}
-\subsection{Data Processing}{
-
-The \code{format_tt(quarto=TRUE)} argument activates Quarto data processing for specific cells. This funcationality comes with a few warnings:
-\enumerate{
-\item Currently, Quarto provides a \verb{\\QuartoMarkdownBase64\{\}} LaTeX macro, but it does not appear to do anything with it. References and markdown codes may not be processed as expected in LaTeX.
-\item Quarto data processing can enter in conflict with \code{tinytable} styling or formatting options. See below for how to disable it.
+\subsection{format_tt()}{
+\itemize{
+\item \code{tinytable_format_digits}
+\item \code{tinytable_format_num_fmt}
+\item \code{tinytable_format_num_zero}
+\item \code{tinytable_format_num_suffix}
+\item \code{tinytable_format_num_mark_big}
+\item \code{tinytable_format_num_mark_dec}
+\item \code{tinytable_format_date}
+\item \code{tinytable_format_bool}
+\item \code{tinytable_format_other}
+\item \code{tinytable_format_replace}
+\item \code{tinytable_format_escape}
+\item \code{tinytable_format_markdown}
+\item \code{tinytable_format_quarto}
+\item \code{tinytable_format_fn}
+\item \code{tinytable_format_sprintf}
+}
}
-\code{options(tinytable_quarto_disable_processing = TRUE)}
-
-Disable Quarto processing of cell content. Setting this global option to \code{FALSE} may lead to conflicts with some \code{tinytable} features, but it also allows use of markdown and Quarto-specific code in table cells, such as cross-references.
+\subsection{save_tt()}{
+\itemize{
+\item \code{tinytable_save_overwrite}
+}
+}
-\if{html}{\out{
}}
+\subsection{theme_tt()}{
-See this link for more details: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
+Placement:
+\itemize{
+\item \code{tinytable_theme_placement_float}
+\item \code{tinytable_theme_placement_horizontal}
}
+Resize:
+\itemize{
+\item \code{tinytable_theme_resize_width}
+\item \code{tinytable_theme_resize_direction}
}
-\subsection{HTML}{
+Multipage:
\itemize{
-\item \code{options(tinytable_html_mathjax = TRUE)}
+\item \code{tinytable_theme_multipage_rowhead}
+\item \code{tinytable_theme_multipage_rowfoot}
+}
+
+Tabular:
\itemize{
-\item insert MathJax scripts in the HTML document. Warning: This may conflict with other elements of the page if MathJax is otherwise loaded.
+\item \code{tinytable_theme_tabular_style}
+}
}
-\item \code{options(tinytable_html_portable = TRUE)}
+
+\subsection{print.tinytable()}{
\itemize{
-\item \code{plot_tt()} inserts base 64 encoded images directly in the HTML file rather than use external links.
+\item \code{tinytable_print_output}
}
}
+
}
-\subsection{PDF}{
+\subsection{Output-specific options}{
+\subsection{HTML}{
\itemize{
-\item \code{options(tinytable_pdf_clean = TRUE)}
+\item \code{tinytable_html_mathjax}: Insert MathJax scripts (warning: may conflict if MathJax is loaded elsewhere)
+\item \code{tinytable_html_portable}: Insert base64 encoded images directly in HTML for \code{plot_tt()}
+}
+}
+
+\subsection{PDF}{
\itemize{
-\item deletes temporary and log files.
+\item \code{tinytable_pdf_clean}: Delete temporary and log files
+\item \code{tinytable_pdf_engine}: Choose between "xelatex", "pdflatex", "lualatex"
}
-\item \code{options(tinytable_pdf_engine = "xelatex")}
+}
+
+\subsection{Quarto}{
+
+The \code{format_tt(quarto=TRUE)} argument enables Quarto data processing with some limitations:
+\enumerate{
+\item The \verb{\\QuartoMarkdownBase64\{\}} LaTeX macro may not process references and markdown as expected
+\item Quarto processing may conflict with \code{tinytable} styling/formatting
+}
+
+Options:
\itemize{
-\item "xelatex", "pdflatex", "lualatex"
+\item \code{tinytable_quarto_disable_processing}: Disable Quarto cell processing
+\item \code{tinytable_print_rstudio_notebook}: Display tables "inline" or in "viewer" for RStudio notebooks
+\item \code{tinytable_quarto_figure}: Control Typst figure environment in Quarto
}
+
+Example of Quarto-specific code in cells:
+
+\if{html}{\out{
}}
+
+For more details on Quarto table processing: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
}
+
}
}
\examples{
dat <- data.frame(
a = rnorm(3, mean = 10000),
- b = rnorm(3, 10000))
+ b = rnorm(3, 10000)
+)
tab <- tt(dat)
format_tt(tab,
- digits = 2,
- num_mark_dec = ",",
- num_mark_big = " ")
-
+ digits = 2,
+ num_mark_dec = ",",
+ num_mark_big = " "
+)
+
k <- tt(data.frame(x = c(0.000123456789, 12.4356789)))
format_tt(k, digits = 2, num_fmt = "significant_cell")
-
+
dat <- data.frame(
- a = c("Burger", "Halloumi", "Tofu", "Beans"),
- b = c(1.43202, 201.399, 0.146188, 0.0031),
- c = c(98938272783457, 7288839482, 29111727, 93945))
+ a = c("Burger", "Halloumi", "Tofu", "Beans"),
+ b = c(1.43202, 201.399, 0.146188, 0.0031),
+ c = c(98938272783457, 7288839482, 29111727, 93945)
+)
tt(dat) |>
- format_tt(j = "a", sprintf = "Food: \%s") |>
- format_tt(j = 2, digits = 1, num_fmt = "decimal", num_zero = TRUE) |>
- format_tt(j = "c", digits = 2, num_suffix = TRUE)
-
+ format_tt(j = "a", sprintf = "Food: \%s") |>
+ format_tt(j = 2, digits = 1, num_fmt = "decimal", num_zero = TRUE) |>
+ format_tt(j = "c", digits = 2, num_suffix = TRUE)
+
y <- tt(data.frame(x = c(123456789.678, 12435.6789)))
-format_tt(y, digits=3, num_mark_big=" ")
+format_tt(y, digits = 3, num_mark_big = " ")
x <- tt(data.frame(Text = c("_italicized text_", "__bold text__")))
-format_tt(x, markdown=TRUE)
+format_tt(x, markdown = TRUE)
tab <- data.frame(a = c(NA, 1, 2), b = c(3, NA, 5))
tt(tab) |> format_tt(replace = "-")
dat <- data.frame(
- "LaTeX" = c("Dollars $", "Percent \%", "Underscore _"),
- "HTML" = c(" ", "4", "blah")
+ "LaTeX" = c("Dollars $", "Percent \%", "Underscore _"),
+ "HTML" = c(" ", "4", "blah")
)
-tt(dat) |> format_tt(escape = TRUE)
+tt(dat) |> format_tt(escape = TRUE)
}
diff --git a/man/group_tt.Rd b/man/group_tt.Rd
index e7fd6d23..3e1f1653 100644
--- a/man/group_tt.Rd
+++ b/man/group_tt.Rd
@@ -31,13 +31,24 @@ Spanning labels to identify groups of rows or columns
\details{
Warning: The \code{style_tt()} can normally be used to style the group headers, as expected, but that feature is not available for Markdown and Word tables.
}
+\section{Word and Markdown limitations}{
+
+
+Markdown and Word tables only support these styles: italic, bold, strikeout. The \code{width} argument is also unavailable
+Moreover, the \code{style_tt()} function cannot be used to style headers inserted by the \code{group_tt()} function;
+instead, you should style the headers directly in the header definition using markdown syntax:
+\code{group_tt(i = list("*italic header*" = 2))}. These limitations are due to the fact that there is no markdown
+syntax for the other options, and that we create Word documents by converting a markdown table to .docx
+via the Pandoc software.
+}
+
\examples{
# vector of row labels
dat <- data.frame(
- label = c("a", "a", "a", "b", "b", "c", "a", "a"),
- x1 = rnorm(8),
- x2 = rnorm(8))
+ label = c("a", "a", "a", "b", "b", "c", "a", "a"),
+ x1 = rnorm(8),
+ x2 = rnorm(8))
tt(dat[, 2:3]) |> group_tt(i = dat$label)
# named lists of labels
diff --git a/man/initialize-tinytable-method.Rd b/man/initialize-tinytable-method.Rd
index 5707ffd2..8fe22d80 100644
--- a/man/initialize-tinytable-method.Rd
+++ b/man/initialize-tinytable-method.Rd
@@ -28,7 +28,7 @@
\item{theme}{Function or string.
\itemize{
-\item String: grid, resize, multipage, placement, rotate, striped, void, bootstrap, tabular
+\item String: bootstrap, grid, multipage, placement, revealjs, resize, rotate, spacing, striped, tabular, void
\item Function: Applied to the \code{tinytable} object.
}}
diff --git a/man/rbind2-tinytable-tinytable-method.Rd b/man/rbind2-tinytable-tinytable-method.Rd
index 8b6461d1..861f58f1 100644
--- a/man/rbind2-tinytable-tinytable-method.Rd
+++ b/man/rbind2-tinytable-tinytable-method.Rd
@@ -42,8 +42,8 @@ This function relies on the \code{rbindlist()} function from the \code{data.tabl
}
\examples{
library(tinytable)
-x = tt(mtcars[1:3, 1:2], caption = "Combine two tiny tables.")
-y = tt(mtcars[4:5, 8:10])
+x <- tt(mtcars[1:3, 1:2], caption = "Combine two tiny tables.")
+y <- tt(mtcars[4:5, 8:10])
# rbind() does not support additional aarguments
# rbind2() supports additional arguments
diff --git a/man/save_tt.Rd b/man/save_tt.Rd
index 25e9f939..4560a46f 100644
--- a/man/save_tt.Rd
+++ b/man/save_tt.Rd
@@ -29,6 +29,162 @@ A string with the table when \code{output} is a format, and the file path when \
\description{
This function saves an object of class tinytable to a specified file and format, with an option to overwrite existing files.
}
+\section{Dependencies}{
+
+\itemize{
+\item \code{.pdf} output requires a full LaTeX installation on the local computer.
+\item \code{.png} output requires the \code{webshot2} package.
+\item \code{.html} self-contained files require the \code{base64enc} package.
+}
+}
+
+\section{LaTeX preamble}{
+
+
+\code{tinytable} uses the \code{tabularray} package from your LaTeX distribution to draw tables. \code{tabularray}, in turn, uses the special \code{tblr}, \code{talltblr}, and \code{longtblr} environments.
+
+When rendering a document from Quarto or Rmarkdown directly to PDF, \code{tinytable} will populate the LaTeX preamble automatically with all the required packages. For standalone LaTeX documents, these commands should be inserted in the preamble manually:
+
+Note: Your document will fail to compile to PDF in Quarto if you enable caching and you use tinytable due to missing LaTeX headers. To avoid this problem, set the option \verb{#| cache: false} for the chunk(s) where you use tinytable.
+
+\if{html}{\out{
}}
+}
+
+\section{Global options}{
+
+
+Options can be set with \code{options()} and change the default behavior of tinytable. For example:
+
+\if{html}{\out{
}}
+
+For more details on Quarto table processing: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
+}
+
+}
+}
+
\examples{
library(tinytable)
x <- mtcars[1:4, 1:5]
diff --git a/man/style_tt.Rd b/man/style_tt.Rd
index 14e18a31..5c54a1da 100644
--- a/man/style_tt.Rd
+++ b/man/style_tt.Rd
@@ -37,7 +37,12 @@ style_tt(
\arguments{
\item{x}{A table object created by \code{tt()}.}
-\item{i}{Row indices where the styling should be applied. Can be a single value, a vector, or a logical matrix with the same number of rows and columns as \code{x}. \code{i=0} is the header, and negative values are higher level headers. Row indices refer to rows \emph{after} the insertion of row labels by \code{group_tt()}, when applicable.}
+\item{i}{Numeric vector, logical matrix, or string..
+\itemize{
+\item Numeric vector: Row indices where the styling should be applied. Can be a single value or a vector.
+\item Logical matrix: A matrix with the same number of rows and columns as \code{x}. \code{i=0} is the header, and negative values are higher level headers. Row indices refer to rows \emph{after} the insertion of row labels by \code{group_tt()}, when applicable.
+\item String: "notes" or "caption".
+}}
\item{j}{Column indices where the styling should be applied. Can be:
\itemize{
@@ -123,27 +128,16 @@ Style a Tiny Table
}
\details{
This function applies styling to a table created by \code{tt()}. It allows customization of text style (bold, italic, monospace), text and background colors, font size, cell width, text alignment, column span, and indentation. The function also supports passing native instructions to LaTeX (tabularray) and HTML (bootstrap) formats.
-
-Note: Markdown and Word tables only support these styles: italic, bold, strikeout. Moreover, the \code{style_tt()} function cannot be used to style headers inserted by the \code{group_tt()} function; instead, you should style the headers directly in the header definition using markdown syntax: \code{group_tt(i = list("*italic header*" = 2))}. These limitations are due to the fact that there is no markdown syntax for the other options, and that we create Word documents by converting a markdown table to .docx via the Pandoc software.
}
-\section{LaTeX preamble}{
+\section{Word and Markdown limitations}{
-\code{tinytable} uses the \code{tabularray} package from your LaTeX distribution to draw tables. \code{tabularray}, in turn, uses the special \code{tblr}, \code{talltblr}, and \code{longtblr} environments.
-
-When rendering a document from Quarto or Rmarkdown directly to PDF, \code{tinytable} will populate the LaTeX preamble automatically with all the required packages (except when code chunks are cached). For standalone LaTeX documents, these commands should be inserted in the preamble manually:
-
-\if{html}{\out{
}}
+Markdown and Word tables only support these styles: italic, bold, strikeout. The \code{width} argument is also unavailable
+Moreover, the \code{style_tt()} function cannot be used to style headers inserted by the \code{group_tt()} function;
+instead, you should style the headers directly in the header definition using markdown syntax:
+\code{group_tt(i = list("*italic header*" = 2))}. These limitations are due to the fact that there is no markdown
+syntax for the other options, and that we create Word documents by converting a markdown table to .docx
+via the Pandoc software.
}
\examples{
@@ -156,15 +150,15 @@ library(tinytable)
tt(mtcars[1:5, 1:6])
# Alignment
-tt(mtcars[1:5, 1:6]) |>
+tt(mtcars[1:5, 1:6]) |>
style_tt(j = 1:5, align = "lcccr")
# Colors and styles
-tt(mtcars[1:5, 1:6]) |>
+tt(mtcars[1:5, 1:6]) |>
style_tt(i = 2:3, background = "black", color = "orange", bold = TRUE)
# column selection with `j``
-tt(mtcars[1:5, 1:6]) |>
+tt(mtcars[1:5, 1:6]) |>
style_tt(j = 5:6, background = "pink")
tt(mtcars[1:5, 1:6]) |>
@@ -178,27 +172,27 @@ tt(mtcars[1:5, 1:6], theme = "void") |>
i = 2, j = 2,
colspan = 3,
rowspan = 2,
- align="c",
+ align = "c",
alignv = "m",
color = "white",
background = "black",
bold = TRUE)
-
+
tt(mtcars[1:5, 1:6], theme = "void") |>
style_tt(
- i=0:3,
- j=1:3,
- line="tblr",
- line_width=0.4,
- line_color="teal")
-
+ i = 0:3,
+ j = 1:3,
+ line = "tblr",
+ line_width = 0.4,
+ line_color = "teal")
+
tt(mtcars[1:5, 1:6], theme = "bootstrap") |>
- style_tt(
- i = c(2,5),
- j = 3,
- strikeout = TRUE,
- fontsize = 0.7)
-
+ style_tt(
+ i = c(2, 5),
+ j = 3,
+ strikeout = TRUE,
+ fontsize = 0.7)
+
tt(mtcars[1:5, 1:6]) |>
style_tt(bootstrap_class = "table table-dark table-hover")
diff --git a/man/theme_tt.Rd b/man/theme_tt.Rd
index 9ac81d50..dc21420f 100644
--- a/man/theme_tt.Rd
+++ b/man/theme_tt.Rd
@@ -17,6 +17,7 @@ theme_tt(x, theme, ...)
\item "placement": Position of the table environment (LaTeX)
\item "rotate": Rotate a LaTeX or Typst table.
\item "resize": Scale a LaTeX \code{tinytable} to fit the \code{width} argument.
+\item "spacing": Draw more compact or airy tables.
\item "striped": Grey stripes on alternating rows
\item "tabular": Remove table environment (LaTeX) or Javascript/CSS (HTML)
\item "void": No rules
@@ -91,6 +92,12 @@ rotate
\item LaTeX: In Quarto documents, captions must be specified using the \code{caption} argument in \code{tt()} rather than via Quarto chunk options.
}
}
+
+spacing
+\itemize{
+\item \code{rowsep}: Row spacing
+\item \code{colsep}: Column spacing
+}
}
\examples{
@@ -104,7 +111,7 @@ tt(x, theme = "striped")
tt(x) |> theme_tt("striped")
# resize w/ argument
-x <- cbind(mtcars[1:10,], mtcars[1:10,])
+x <- cbind(mtcars[1:10, ], mtcars[1:10, ])
tt(x) |>
theme_tt("resize", width = .9) |>
print("latex")
diff --git a/man/tt.Rd b/man/tt.Rd
index 273afaf8..52e100a6 100644
--- a/man/tt.Rd
+++ b/man/tt.Rd
@@ -39,7 +39,7 @@ tt(
\item{theme}{Function or string.
\itemize{
-\item String: grid, resize, multipage, placement, rotate, striped, void, bootstrap, tabular
+\item String: bootstrap, grid, multipage, placement, revealjs, resize, rotate, spacing, striped, tabular, void
\item Function: Applied to the \code{tinytable} object.
}}
@@ -67,12 +67,23 @@ The \code{tt} function renders a table in different formats with various styling
\code{tinytable} attempts to determine the appropriate way to print the table based on interactive use, RStudio availability, and output format in RMarkdown or Quarto documents. Users can call \code{print(x, output="markdown")} to print the table in a specific format. Alternatively, they can set a global option: \code{options("tinytable_print_output"="markdown")}
}
+\section{Dependencies}{
+
+\itemize{
+\item \code{.pdf} output requires a full LaTeX installation on the local computer.
+\item \code{.png} output requires the \code{webshot2} package.
+\item \code{.html} self-contained files require the \code{base64enc} package.
+}
+}
+
\section{LaTeX preamble}{
\code{tinytable} uses the \code{tabularray} package from your LaTeX distribution to draw tables. \code{tabularray}, in turn, uses the special \code{tblr}, \code{talltblr}, and \code{longtblr} environments.
-When rendering a document from Quarto or Rmarkdown directly to PDF, \code{tinytable} will populate the LaTeX preamble automatically with all the required packages (except when code chunks are cached). For standalone LaTeX documents, these commands should be inserted in the preamble manually:
+When rendering a document from Quarto or Rmarkdown directly to PDF, \code{tinytable} will populate the LaTeX preamble automatically with all the required packages. For standalone LaTeX documents, these commands should be inserted in the preamble manually:
+
+Note: Your document will fail to compile to PDF in Quarto if you enable caching and you use tinytable due to missing LaTeX headers. To avoid this problem, set the option \verb{#| cache: false} for the chunk(s) where you use tinytable.
\if{html}{\out{
}}\preformatted{\\usepackage\{tabularray\}
\\usepackage\{float\}
@@ -87,66 +98,139 @@ When rendering a document from Quarto or Rmarkdown directly to PDF, \code{tinyta
}\if{html}{\out{
}}
}
+\section{Word and Markdown limitations}{
+
+
+Markdown and Word tables only support these styles: italic, bold, strikeout. The \code{width} argument is also unavailable
+Moreover, the \code{style_tt()} function cannot be used to style headers inserted by the \code{group_tt()} function;
+instead, you should style the headers directly in the header definition using markdown syntax:
+\code{group_tt(i = list("*italic header*" = 2))}. These limitations are due to the fact that there is no markdown
+syntax for the other options, and that we create Word documents by converting a markdown table to .docx
+via the Pandoc software.
+}
+
\section{Global options}{
-Many global options can be used to set the default argument values of \code{tinytable} functions.
-For a full list, see:
+Options can be set with \code{options()} and change the default behavior of tinytable. For example:
-https://vincentarelbundock.github.io/tinytable/vignettes/options.html
-\subsection{Quarto}{
-\subsection{Figure environment}{
+\if{html}{\out{
}}
+
+You can set options in a script or via \code{.Rprofile}. Note: be cautious with \code{.Rprofile} settings as they may affect reproducibility.
+\subsection{Default values for function arguments}{
+\subsection{tt()}{
\itemize{
-\item \code{options("tinytable_quarto_figure" = FALSE)}: Typst only. Normally, it is best to allow Quarto to define the figure environment, so the default behavior is to not include one.
+\item \code{tinytable_tt_digits}
+\item \code{tinytable_tt_caption}
+\item \code{tinytable_tt_notes}
+\item \code{tinytable_tt_width}
+\item \code{tinytable_tt_theme}
+\item \code{tinytable_tt_rownames}
}
}
-\subsection{Data Processing}{
-
-The \code{format_tt(quarto=TRUE)} argument activates Quarto data processing for specific cells. This funcationality comes with a few warnings:
-\enumerate{
-\item Currently, Quarto provides a \verb{\\QuartoMarkdownBase64\{\}} LaTeX macro, but it does not appear to do anything with it. References and markdown codes may not be processed as expected in LaTeX.
-\item Quarto data processing can enter in conflict with \code{tinytable} styling or formatting options. See below for how to disable it.
+\subsection{format_tt()}{
+\itemize{
+\item \code{tinytable_format_digits}
+\item \code{tinytable_format_num_fmt}
+\item \code{tinytable_format_num_zero}
+\item \code{tinytable_format_num_suffix}
+\item \code{tinytable_format_num_mark_big}
+\item \code{tinytable_format_num_mark_dec}
+\item \code{tinytable_format_date}
+\item \code{tinytable_format_bool}
+\item \code{tinytable_format_other}
+\item \code{tinytable_format_replace}
+\item \code{tinytable_format_escape}
+\item \code{tinytable_format_markdown}
+\item \code{tinytable_format_quarto}
+\item \code{tinytable_format_fn}
+\item \code{tinytable_format_sprintf}
+}
}
-\code{options(tinytable_quarto_disable_processing = TRUE)}
+\subsection{save_tt()}{
+\itemize{
+\item \code{tinytable_save_overwrite}
+}
+}
-Disable Quarto processing of cell content. Setting this global option to \code{FALSE} may lead to conflicts with some \code{tinytable} features, but it also allows use of markdown and Quarto-specific code in table cells, such as cross-references.
+\subsection{theme_tt()}{
-\if{html}{\out{
}}
-
-See this link for more details: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
+Placement:
+\itemize{
+\item \code{tinytable_theme_placement_float}
+\item \code{tinytable_theme_placement_horizontal}
}
+Resize:
+\itemize{
+\item \code{tinytable_theme_resize_width}
+\item \code{tinytable_theme_resize_direction}
}
-\subsection{HTML}{
+Multipage:
\itemize{
-\item \code{options(tinytable_html_mathjax = TRUE)}
+\item \code{tinytable_theme_multipage_rowhead}
+\item \code{tinytable_theme_multipage_rowfoot}
+}
+
+Tabular:
\itemize{
-\item insert MathJax scripts in the HTML document. Warning: This may conflict with other elements of the page if MathJax is otherwise loaded.
+\item \code{tinytable_theme_tabular_style}
+}
}
-\item \code{options(tinytable_html_portable = TRUE)}
+
+\subsection{print.tinytable()}{
\itemize{
-\item \code{plot_tt()} inserts base 64 encoded images directly in the HTML file rather than use external links.
+\item \code{tinytable_print_output}
}
}
+
}
-\subsection{PDF}{
+\subsection{Output-specific options}{
+\subsection{HTML}{
\itemize{
-\item \code{options(tinytable_pdf_clean = TRUE)}
+\item \code{tinytable_html_mathjax}: Insert MathJax scripts (warning: may conflict if MathJax is loaded elsewhere)
+\item \code{tinytable_html_portable}: Insert base64 encoded images directly in HTML for \code{plot_tt()}
+}
+}
+
+\subsection{PDF}{
\itemize{
-\item deletes temporary and log files.
+\item \code{tinytable_pdf_clean}: Delete temporary and log files
+\item \code{tinytable_pdf_engine}: Choose between "xelatex", "pdflatex", "lualatex"
+}
}
-\item \code{options(tinytable_pdf_engine = "xelatex")}
+
+\subsection{Quarto}{
+
+The \code{format_tt(quarto=TRUE)} argument enables Quarto data processing with some limitations:
+\enumerate{
+\item The \verb{\\QuartoMarkdownBase64\{\}} LaTeX macro may not process references and markdown as expected
+\item Quarto processing may conflict with \code{tinytable} styling/formatting
+}
+
+Options:
\itemize{
-\item "xelatex", "pdflatex", "lualatex"
+\item \code{tinytable_quarto_disable_processing}: Disable Quarto cell processing
+\item \code{tinytable_print_rstudio_notebook}: Display tables "inline" or in "viewer" for RStudio notebooks
+\item \code{tinytable_quarto_figure}: Control Typst figure environment in Quarto
}
+
+Example of Quarto-specific code in cells:
+
+\if{html}{\out{
}}
+
+For more details on Quarto table processing: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
}
+
}
}
@@ -157,9 +241,9 @@ x <- mtcars[1:4, 1:5]
tt(x)
tt(x,
- theme = "striped",
- width = 0.5,
- caption = "Data about cars.")
+ theme = "striped",
+ width = 0.5,
+ caption = "Data about cars.")
tt(x, notes = "Hello World!")
@@ -168,6 +252,6 @@ tab <- tt(x, notes = list("*" = fn))
print(tab, "latex")
k <- data.frame(x = c(0.000123456789, 12.4356789))
-tt(k, digits=2)
+tt(k, digits = 2)
}
diff --git a/sandbox/latex.qmd b/sandbox/latex.qmd
new file mode 100644
index 00000000..3256603c
--- /dev/null
+++ b/sandbox/latex.qmd
@@ -0,0 +1,16 @@
+---
+format: pdf
+---
+
+```{r}
+pkgload::load_all()
+dat <- data.frame(a = c("(03.1)", "(3.14)**", "(003.1416)+"))
+tt(dat) |> style_tt(align = "d")
+```
+
+```{r}
+dat <- data.frame(a = c("(03.1)", "(3.14)**", "(003.1416)+"))
+tt(dat) |>
+ group_tt(j = list("blah" = 1)) |>
+ style_tt(align = "d")
+```
diff --git a/sandbox/quarto_processing.qmd b/sandbox/quarto_processing.qmd
index 6b24b2fb..fb16e054 100644
--- a/sandbox/quarto_processing.qmd
+++ b/sandbox/quarto_processing.qmd
@@ -36,4 +36,4 @@ tt(x) |> format_tt(replace = " ", quarto = TRUE)
```{r}
#| eval: false
tt(x) |> format_tt(replace = "+", quarto = TRUE)
-```
\ No newline at end of file
+```
diff --git a/sandbox/typst.qmd b/sandbox/typst.qmd
index bd94b29d..0e02396e 100644
--- a/sandbox/typst.qmd
+++ b/sandbox/typst.qmd
@@ -12,13 +12,12 @@ options(tinytable_print_output = "typst")
```
```{r}
-dat <- data.frame(
- a = c("a", "aa", "aaa"),
- b = c("b", "bb", "bbb"),
- c = c("c", "cc", "ccc"))
-tt(dat) |> style_tt(j = 1:3, align = "lcr")
+tt(head(iris), caption = "Hello World", notes = "This is a note") |>
+ style_tt("notes", color = "orange", italic = TRUE) |>
+ style_tt("caption", color = "green", bold = TRUE, strikeout = TRUE)
```
+
```{r}
# Semi-complicated
tab <- tt(mtcars[1:4, 1:5], caption = "Hello World") |>
@@ -41,7 +40,7 @@ tab
```{r}
# Issue #139
tab <- tt(mtcars[1:5, 1:5]) |>
- style_tt(2:3, 2:3, line_color = "red", line = "tblr", line_width = .05)
+ style_tt(2:3, 2:3, line_color = "red", line = "tblr", line_width = .05)
tab
```
@@ -58,7 +57,8 @@ dat <- data.frame(
w = c(143002.2092, 201399.181, 100188.3883),
x = c(1.43402, 201.399, 0.134588),
y = as.Date(c(897, 232, 198), origin = "1970-01-01"),
- z = c(TRUE, TRUE, FALSE))
+ z = c(TRUE, TRUE, FALSE)
+)
dat <- tt(dat, digits = 2)
dat
```
@@ -68,7 +68,8 @@ dat
dat <- data.frame(
a = c("Burger", "Halloumi", "Tofu", "Beans"),
b = c(1.43202, 201.399, 0.146188, 0.0031),
- c = c(98938272783457, 7288839482, 29111727, 93945))
+ c = c(98938272783457, 7288839482, 29111727, 93945)
+)
tab <- tt(dat) |>
format_tt(j = "a", sprintf = "Food: %s") |>
format_tt(j = 2, digits = 1) |>
@@ -124,7 +125,8 @@ dat <- tt(dat) |>
group_tt(i = list(
"I like (fake) hamburgers" = 3,
"She prefers halloumi" = 4,
- "They love tofu" = 7))
+ "They love tofu" = 7
+ ))
dat
```
@@ -137,7 +139,9 @@ tab <- tt(dat) |>
j = list(
"Hamburgers" = 1:3,
"Halloumi" = 4:5,
- "Tofu" = 7))
+ "Tofu" = 7
+ )
+ )
tab
```
@@ -154,19 +158,25 @@ tab
#| warnings: false
# issue #323
dat <- mtcars[1:9, 1:8]
-tab <- tt(dat) |>
+tab <- tt(dat) |>
group_tt(
- i = list("I like (fake) hamburgers" = 3,
- "She prefers halloumi" = 4,
- "They love tofu" = 7),
- j = list("Hamburgers" = 1:3,
- "Halloumi" = 4:5,
- "Tofu" = 7)) |>
+ i = list(
+ "I like (fake) hamburgers" = 3,
+ "She prefers halloumi" = 4,
+ "They love tofu" = 7
+ ),
+ j = list(
+ "Hamburgers" = 1:3,
+ "Halloumi" = 4:5,
+ "Tofu" = 7
+ )
+ ) |>
style_tt(
i = c(3, 5, 9),
align = "c",
background = "black",
- color = "orange") |>
+ color = "orange"
+ ) |>
style_tt(i = -1, color = "orange")
tab
```
@@ -187,3 +197,20 @@ tt(head(iris)) |> group_tt(i = list("hello" = 2, "world" = 2))
tt(head(iris), notes = "blah")
```
+
+# align
+
+```{r}
+dat <- data.frame(
+ a = c("a", "aa", "aaa"),
+ b = c("b", "bb", "bbb"),
+ c = c("c", "cc", "ccc")
+)
+tt(dat)
+```
+```{r}
+tt(dat) |> style_tt(align = "c")
+```
+```{r}
+tt(dat) |> style_tt(align = "lcr")
+```
diff --git a/tests/tinytest.R b/tests/tinytest.R
index 09bf3bf6..c4b167e7 100644
--- a/tests/tinytest.R
+++ b/tests/tinytest.R
@@ -1,5 +1,3 @@
-
-if ( requireNamespace("tinytest", quietly=TRUE) ){
+if (requireNamespace("tinytest", quietly = TRUE)) {
tinytest::test_package("tinytable")
}
-
diff --git a/vignettes/alternatives.qmd b/vignettes/alternatives.qmd
index 94e62c43..f02441f0 100644
--- a/vignettes/alternatives.qmd
+++ b/vignettes/alternatives.qmd
@@ -29,12 +29,12 @@ How does `tinytable` compare to alternative table-drawing packages in `R`? There
```{r, include=FALSE}
db <- tools::CRAN_package_db()
-dep_kableExtra <- length(tools::package_dependencies("kableExtra", recursive=TRUE, db=db)[[1]])
-dep_gt <- length(tools::package_dependencies("gt", recursive=TRUE, db=db)[[1]])
-dep_flextable <- length(tools::package_dependencies("flextable", recursive=TRUE, db=db)[[1]])
-dep_huxtable <- length(tools::package_dependencies("huxtable", recursive=TRUE, db=db)[[1]])
-dep_DT <- length(tools::package_dependencies("DT", recursive=TRUE, db=db)[[1]])
-dep_reactable <- length(tools::package_dependencies("reactable", recursive=TRUE, db=db)[[1]])
+dep_kableExtra <- length(tools::package_dependencies("kableExtra", recursive = TRUE, db = db)[[1]])
+dep_gt <- length(tools::package_dependencies("gt", recursive = TRUE, db = db)[[1]])
+dep_flextable <- length(tools::package_dependencies("flextable", recursive = TRUE, db = db)[[1]])
+dep_huxtable <- length(tools::package_dependencies("huxtable", recursive = TRUE, db = db)[[1]])
+dep_DT <- length(tools::package_dependencies("DT", recursive = TRUE, db = db)[[1]])
+dep_reactable <- length(tools::package_dependencies("reactable", recursive = TRUE, db = db)[[1]])
```
Here are a few totally biased (and possibly unfair) comments about each of them.
diff --git a/vignettes/custom.qmd b/vignettes/custom.qmd
index 96254aa1..1a3a68d4 100644
--- a/vignettes/custom.qmd
+++ b/vignettes/custom.qmd
@@ -49,7 +49,16 @@ We can also combine several Bootstrap classes. Here, we get a table with the "ho
```{r, eval = knitr::is_html_output()}
tt(x) |> style_tt(
- bootstrap_class = "table table-hover")
+ bootstrap_class = "table table-hover"
+)
+```
+
+
+By default, Bootstrap 5 places captions at the bottom of the table. This can be changed by using a different class:
+
+```{r}
+tt(head(iris), caption = "A caption on top") |>
+ style_tt(bootstrap_class = "table caption-top")
```
:::
@@ -104,12 +113,13 @@ css_rule <- "
}
"
-tt(x, width = 2/3) |>
+tt(x, width = 2 / 3) |>
style_tt(
j = 1:5,
align = "ccccc",
bootstrap_class = "table mytable",
- bootstrap_css_rule = css_rule)
+ bootstrap_css_rule = css_rule
+ )
```
@@ -128,8 +138,9 @@ css <- "
tt(mtcars[1:10, 1:8]) |>
style_tt(
- bootstrap_class = "table table-borderless squirreltable",
- bootstrap_css_rule = css)
+ bootstrap_class = "table table-borderless squirreltable",
+ bootstrap_css_rule = css
+ )
```
:::
@@ -200,7 +211,7 @@ The Inner block, enclosed in `{}`, defines specific styles like column formats (
We can create this code easily by passing a string to the `tabularray_inner` argument of the `style_tt()` function:
```{r, eval = knitr::is_latex_output()}
-##| tbl-cap: "\\LaTeX{} table with colors and a spanning cell."
+## | tbl-cap: "\\LaTeX{} table with colors and a spanning cell."
inner <- "
column{1-4}={halign=c},
hlines = {fg=white},
@@ -346,15 +357,18 @@ library("shiny")
library("tinytable")
fn <- paste(tempfile(), ".html")
-tab <- tt(mtcars[1:5, 1:4]) |>
- style_tt(i = 0:5, color = "orange", background = "black") |>
- save_tt(fn)
+tab <- tt(mtcars[1:5, 1:4]) |>
+ style_tt(i = 0:5, color = "orange", background = "black") |>
+ save_tt(fn)
shinyApp(
ui = fluidPage(
- fluidRow(column(12, h1("This is test of tinytable"),
- shiny::includeHTML(fn)))),
- server = function(input, output) {
+ fluidRow(column(
+ 12, h1("This is test of tinytable"),
+ shiny::includeHTML(fn)
+ ))
+ ),
+ server = function(input, output) {
}
)
```
diff --git a/vignettes/faq.qmd b/vignettes/faq.qmd
index f6bd46ca..f4a17abc 100644
--- a/vignettes/faq.qmd
+++ b/vignettes/faq.qmd
@@ -165,17 +165,24 @@ With these changes, the table should appear with colors as expected.
## Typst
-### Captions and labels
+### Quarto
-Due to a quirk in Quarto [reported here,](https://github.com/quarto-dev/quarto-cli/issues/9369) captions in Typst and Quarto documents need to be specified using *both* the `tbl-cap` and the `label` chunk option:
+By default `tinytable` uses Quarto's own figure handling to set captions and figure blocks. This allows cross-references to work. For this to work well, users should specify _both_ the table label and the table caption explicitly using chunk options. Note that the label must imperatively start with `tbl-`:
-````{verbatim}
-```{r}
-#| tbl-cap: "blah blah blah"
-#| label: tbl-blah
-tinytable::tt(head(iris, 5))
+```r
+#| label: tbl-example
+#| tbl-cap: This is an example table
+library(tinytable)
+tt(head(iris))
```
-````
+
+Alternatively, users can disable Quarto table handling and rely on internal `tinytable` options instead.
+
+```r
+options(tinytable_quarto_figure = FALSE)
+```
+
+Doing this will prevent styles to bleed over from one table to the next.
### Multi-page long tables
@@ -213,103 +220,38 @@ These arguments are already implemented in the form of "pseudo-spans", meaning t
One alternative would be to remove line segments in finalize_grid(). I tried this but it is tricky and the results were brittle, so I rolled it back. I'm open to considering a PR if someone wants to contribute code, but please discuss the feature design in an issue with me before working on this.
-## Quarto
-
-### Custom crossref styles
-In `Quarto`, it is possible to create a custom crossref type for things like appendix tables. One challenge, is that LaTeX will not allow users to nest a `tblr` environment, inside a `table` environment, inside the new environment that `Quarto` creates for the crossref. Therefore, when rendering a table to LaTeX/PDF, it is important to drop the `\begin{table}` environment. This can be done using the `theme_tt()` function.
-In the example below, we call `theme_tt()` explicitly for a single table, but the [themes vignette](https://vincentarelbundock.github.io/tinytable/vignettes/theme.html) shows how to set a global theme using the `tinytable_tt_theme` option.
+## Word (`.docx`)
-````{verbatim}
----
-title: "Crossref Example"
-format:
- pdf: default
- html: default
-crossref:
- custom:
- - kind: float
- key: apptbl
- latex-env: apptbl
- reference-prefix: Table A
- space-before-numbering: false
- latex-list-of-description: Appendix Table
-apptbl-cap-location: top
----
-
-See @apptbl-testing
-
-::: {#apptbl-testing}
+Word document documents are created in two steps:
-```{r}
-library(tinytable)
-
-tt(mtcars[1:5,]) |> theme_tt("tabular", style = "tabularray")
-```
-
-Caption goes here.
+1. Generates a markdown table.
+2. Call the external [Pandoc software](https://pandoc.org/) to convert the markdown table to a Word document.
-:::
-````
+This workflow limits the range of styling options available in Word. Indeed, many arguments in the `style_tt()` function do not have formal markdown notation to represent them, and are thus not available. For example, while `italic`, `bold`, and `strikeout`, are supported, `color` and `background` are not.
-### Sub-captions
+Note that other `tinytable` functions such as `group_tt()` and `format_tt()` and `plot_tt()` should work as expected in Word.
-With version 0.4.0 of `tinytable` and versions above 1.6 of Quarto---only available [as a pre-release build at the time of writing](https://quarto.org/docs/download/prerelease.html)--- users can specify sub-captions for tables. This is done by adding a `tbl-subcap` chunk option to the table chunk. We also need to use a `tinytable` theme to remove built-in table structure and let Quarto handle the table construction. Here is a simple example document:
+Users who want full styling capabilities in Word can save tables as image files and insert them in their documents. Here is an example Quarto notebook illustrating this workflow.
````{verbatim}
---
-format: pdf
+format: docx
---
-See @tbl-example, @tbl-example-1, or @tbl-example-2.
-
```{r}
-#| label: tbl-example
-#| tbl-cap: "Example"
-#| tbl-subcap:
-#| - "Cars"
-#| - "Pressure"
-#| layout-ncol: 2
-
+#| out-width: "50%"
library(tinytable)
-tt(head(cars)) |> theme_tt("tabular", style = "tabularray")
-tt(head(pressure)) |> theme_tt("tabular", style = "tabularray")
-```
-````
-
-### Same table, different styles
-In some cases, the user wants to print a single table multiple times with different styles in a single HTML document. This will sometimes cause issues, because the `style_tt()` function inserts several javascript functions to modify the same table, thus creating conflicts. A simple solution is to change the unique ID of the table object manually.
+options(tinytable_save_overwrite = TRUE)
-Consider this RevalJS slideshow in which we sequentially highlight different rows of the data frame:
+tt(mtcars[1:10, 1:5]) |>
+ style_tt(j = 2:3, background = "black", color = "white") |>
+ save_tt("table_01.png")
-````{verbatim}
----
-format: revealjs
----
-
-## Page 1
-
-```{r}
-library(tinytable)
-
-tab <- tt(head(iris))
-tab
-```
-
-## Page 2
-
-```{r}
-tab@id <- "table_01"
-tab |> style_tt(i = 3, background = "skyblue")
-```
-
-## Page 3
-
-```{r}
-tab@id <- "table_02"
-tab |> style_tt(i = 5, background = "orange")
+knitr::include_graphics("table_01.png")
```
````
+
diff --git a/vignettes/figures/gallery/gallery.sh b/vignettes/figures/gallery/gallery.sh
new file mode 100755
index 00000000..b8d32d70
--- /dev/null
+++ b/vignettes/figures/gallery/gallery.sh
@@ -0,0 +1,14 @@
+#!/bin/bash
+
+# Define the output GIF filename
+output_gif="tinytable_gallery.gif"
+
+# Use ImageMagick to create an animated GIF from images starting with 'tinytable_gallery_'
+# -delay is increased for a slower animation (e.g., 100 equals 1 second per frame)
+# -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 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"
diff --git a/vignettes/figures/gallery/tinytable_gallery_00.png b/vignettes/figures/gallery/tinytable_gallery_00.png
new file mode 100755
index 00000000..9e6ce448
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_00.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_01.png b/vignettes/figures/gallery/tinytable_gallery_01.png
new file mode 100755
index 00000000..04973678
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_01.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_02.png b/vignettes/figures/gallery/tinytable_gallery_02.png
new file mode 100755
index 00000000..07de0df4
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_02.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_03.png b/vignettes/figures/gallery/tinytable_gallery_03.png
new file mode 100755
index 00000000..39791189
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_03.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_04.png b/vignettes/figures/gallery/tinytable_gallery_04.png
new file mode 100755
index 00000000..889cef25
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_04.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_06.png b/vignettes/figures/gallery/tinytable_gallery_06.png
new file mode 100755
index 00000000..a1a60321
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_06.png differ
diff --git a/vignettes/figures/gallery/tinytable_gallery_07.png b/vignettes/figures/gallery/tinytable_gallery_07.png
new file mode 100755
index 00000000..48b981d0
Binary files /dev/null and b/vignettes/figures/gallery/tinytable_gallery_07.png differ
diff --git a/vignettes/figures/spider.png b/vignettes/figures/spider.png
new file mode 100755
index 00000000..a017a78f
Binary files /dev/null and b/vignettes/figures/spider.png differ
diff --git a/vignettes/figures/spider_long.png b/vignettes/figures/spider_long.png
new file mode 100755
index 00000000..559e6af5
Binary files /dev/null and b/vignettes/figures/spider_long.png differ
diff --git a/vignettes/figures/squirrel.png b/vignettes/figures/squirrel.png
new file mode 100755
index 00000000..5b11d688
Binary files /dev/null and b/vignettes/figures/squirrel.png differ
diff --git a/vignettes/figures/tinytable_logo.png b/vignettes/figures/tinytable_logo.png
new file mode 100755
index 00000000..9e6ce448
Binary files /dev/null and b/vignettes/figures/tinytable_logo.png differ
diff --git a/vignettes/figures/tinytable_logo.svg b/vignettes/figures/tinytable_logo.svg
new file mode 100755
index 00000000..c7f16e0b
--- /dev/null
+++ b/vignettes/figures/tinytable_logo.svg
@@ -0,0 +1,59 @@
+
+
+
+
diff --git a/vignettes/figures/tinytable_logo_notext.png b/vignettes/figures/tinytable_logo_notext.png
new file mode 100755
index 00000000..1ee18de8
Binary files /dev/null and b/vignettes/figures/tinytable_logo_notext.png differ
diff --git a/vignettes/figures/tinytable_logo_notext.svg b/vignettes/figures/tinytable_logo_notext.svg
new file mode 100644
index 00000000..694d8edc
--- /dev/null
+++ b/vignettes/figures/tinytable_logo_notext.svg
@@ -0,0 +1,52 @@
+
+
+
+
diff --git a/vignettes/figures/tinytable_logo_notext_white.png b/vignettes/figures/tinytable_logo_notext_white.png
new file mode 100644
index 00000000..0747f762
Binary files /dev/null and b/vignettes/figures/tinytable_logo_notext_white.png differ
diff --git a/vignettes/format.qmd b/vignettes/format.qmd
index a8721edf..75a5ff06 100644
--- a/vignettes/format.qmd
+++ b/vignettes/format.qmd
@@ -33,10 +33,11 @@ In a very simple case---such as printing 2 significant digits of all numeric var
```{r}
dat <- data.frame(
- w = c(143002.2092, 201399.181, 100188.3883),
- x = c(1.43402, 201.399, 0.134588),
- y = as.Date(sample(1:1000, 3), origin = "1970-01-01"),
- z = c(TRUE, TRUE, FALSE))
+ w = c(143002.2092, 201399.181, 100188.3883),
+ x = c(1.43402, 201.399, 0.134588),
+ y = as.Date(sample(1:1000, 3), origin = "1970-01-01"),
+ z = c(TRUE, TRUE, FALSE)
+)
tt(dat, digits = 2)
```
@@ -44,27 +45,31 @@ tt(dat, digits = 2)
We can get more fine-grained control over formatting by calling `format_tt()` after `tt()`, optionally by specifying the columns to format with `j`:
```{r}
-tt(dat) |>
+tt(dat) |>
format_tt(
j = 2:4,
digits = 1,
- date = "%B %d %Y") |>
+ date = "%B %d %Y",
+ bool = tolower
+ ) |>
format_tt(
j = 1,
digits = 2,
num_mark_big = " ",
num_mark_dec = ",",
num_zero = TRUE,
- num_fmt = "decimal")
+ num_fmt = "decimal"
+ )
```
We can use a regular expression in `j` to select columns, and the `?sprintf` function to format strings, numbers, and to do [string interpolation](https://en.wikipedia.org/wiki/String_interpolation) (similar to the `glue` package, but using Base `R`):
```{r}
dat <- data.frame(
- a = c("Burger", "Halloumi", "Tofu", "Beans"),
- b = c(1.43202, 201.399, 0.146188, 0.0031),
- c = c(98938272783457, 7288839482, 29111727, 93945))
+ a = c("Burger", "Halloumi", "Tofu", "Beans"),
+ b = c(1.43202, 201.399, 0.146188, 0.0031),
+ c = c(98938272783457, 7288839482, 29111727, 93945)
+)
tt(dat) |>
format_tt(j = "a", sprintf = "Food: %s") |>
format_tt(j = 2, digits = 1) |>
@@ -172,15 +177,13 @@ tt(dat) |>
## Replacement
-Missing values can be replaced by a custom string using the `replace` argument (default `""`):
+Missing values can be replaced by a custom string using the `replace` argument:
```{r}
tab <- data.frame(a = c(NA, 1, 2), b = c(3, NA, 5))
tt(tab)
-tt(tab) |> format_tt()
-
tt(tab) |> format_tt(replace = "-")
```
@@ -199,8 +202,8 @@ LaTeX and HTML use special characters to indicate strings which should be interp
```{r}
dat <- data.frame(
- "LaTeX" = c("Dollars $", "Percent %", "Underscore _"),
- "HTML" = c(" ", "4", "blah")
+ "LaTeX" = c("Dollars $", "Percent %", "Underscore _"),
+ "HTML" = c(" ", "4", "blah")
)
tt(dat) |> format_tt(escape = TRUE)
@@ -217,10 +220,10 @@ format_tt("_ Dollars $", escape = "latex")
Markdown can be rendered in cells by using the `markdown` argument of the `format_tt()` function (note: this requires installing the `markdown` as an optional dependency).
```{r}
-dat <- data.frame( markdown = c(
+dat <- data.frame(markdown = c(
"This is _italic_ text.",
- "This sentence ends with a superscript.^2^")
-)
+ "This sentence ends with a superscript.^2^"
+))
tt(dat) |>
format_tt(j = 1, markdown = TRUE) |>
@@ -269,7 +272,7 @@ tt(dat) |> format_tt(j = 1, markdown = TRUE)
On top of the built-in features of `format_tt`, a custom formatting function can be specified via the `fn` argument. The `fn` argument takes a function that accepts a single vector and returns a string (or something that coerces to a string like a number).
```{r}
-tt(x) |>
+tt(x) |>
format_tt(j = "mpg", fn = function(x) paste(x, "mi/gal")) |>
format_tt(j = "drat", fn = \(x) signif(x, 2))
```
@@ -290,9 +293,9 @@ thumbdrives <- data.frame(
tt(thumbdrives) |>
format_tt(j = 1, fn = scales::label_date("%e %b", locale = "fr")) |>
format_tt(j = 2, fn = scales::label_currency()) |>
- format_tt(j = 3, fn = scales::label_ordinal()) |>
- format_tt(j = 4, fn = scales::label_bytes()) |>
- format_tt(j = 5, fn = scales::label_percent()) |>
+ format_tt(j = 3, fn = scales::label_ordinal()) |>
+ format_tt(j = 4, fn = scales::label_bytes()) |>
+ format_tt(j = 5, fn = scales::label_percent()) |>
format_tt(escape = TRUE)
```
diff --git a/vignettes/group.qmd b/vignettes/group.qmd
index b52ba90e..d61adea5 100644
--- a/vignettes/group.qmd
+++ b/vignettes/group.qmd
@@ -53,18 +53,21 @@ tt(head(iris)) |>
We can style group rows in the same way as regular rows:
```{r}
-tt(dat) |>
+tt(dat) |>
group_tt(
i = list(
"I like (fake) hamburgers" = 3,
"She prefers halloumi" = 4,
- "They love tofu" = 7)) |>
+ "They love tofu" = 7
+ )
+ ) |>
style_tt(
i = c(3, 5, 9),
align = "c",
color = "white",
background = "gray",
- bold = TRUE)
+ bold = TRUE
+ )
```
### Automatic row groups
@@ -73,7 +76,9 @@ We can use the `group_tt()` function to group rows and label them using spanners
```{r}
# subset and sort data
-df <- mtcars |> head(10) |> sort_by(~ am)
+df <- mtcars |>
+ head(10) |>
+ sort_by(~am)
# draw table
tt(df) |> group_tt(i = df$am)
@@ -85,7 +90,7 @@ tt(df) |> group_tt(i = df$am)
The syntax for column groups is very similar, but we use the `j` argument instead. The named list specifies the labels to appear in column-spanning labels, and the values must be a vector of consecutive and non-overlapping integers that indicate which columns are associated to which labels:
```{r}
-tt(dat) |>
+tt(dat) |>
group_tt(
j = list(
"Hamburgers" = 1:3,
@@ -97,19 +102,25 @@ Here is a table with both row and column headers, as well as some styling:
```{r}
dat <- mtcars[1:9, 1:8]
-tt(dat) |>
+tt(dat) |>
group_tt(
- i = list("I like (fake) hamburgers" = 3,
- "She prefers halloumi" = 4,
- "They love tofu" = 7),
- j = list("Hamburgers" = 1:3,
- "Halloumi" = 4:5,
- "Tofu" = 7)) |>
+ i = list(
+ "I like (fake) hamburgers" = 3,
+ "She prefers halloumi" = 4,
+ "They love tofu" = 7
+ ),
+ j = list(
+ "Hamburgers" = 1:3,
+ "Halloumi" = 4:5,
+ "Tofu" = 7
+ )
+ ) |>
style_tt(
i = c(3, 5, 9),
align = "c",
background = "teal",
- color = "white") |>
+ color = "white"
+ ) |>
style_tt(i = -1, color = "teal")
```
diff --git a/vignettes/notebooks.qmd b/vignettes/notebooks.qmd
new file mode 100644
index 00000000..4e8cd233
--- /dev/null
+++ b/vignettes/notebooks.qmd
@@ -0,0 +1,208 @@
+# Notebooks
+
+
+## Quarto
+
+### Slides: RevealjS
+
+Quarto can create slides using [the RevealJS framework](https://revealjs.com/). Unfortunately, RevealJS does not include Bootstrap, so `tinytable` will not be as pretty as in other HTML documents, and the font size will often be too big.
+
+A good workaround is to use the `theme_revealjs()` function. For a one time use:
+
+````{verbatim}
+```{r}
+library(tinytable)
+tt(head(iris)) |> theme_revealjs()
+```
+````
+
+To style all tables in a slide show, use a global option:
+
+````{verbatim}
+```{r}
+options(tinytable_tt_theme = "revealjs")
+tt(head(iris))
+```
+````
+
+To select a specific font size, use the `fontsize` argument:
+
+````{verbatim}
+# Slide title
+
+This is a nice table:
+
+```{r}
+library(tinytable)
+options(tinytable_tt_theme = \(x) theme_tt(x, "revealjs", fontsize = .5))
+tt(head(iris))
+```
+````
+
+### Custom crossref styles
+
+In `Quarto`, it is possible to create a custom crossref type for things like appendix tables. One challenge, is that LaTeX will not allow users to nest a `tblr` environment, inside a `table` environment, inside the new environment that `Quarto` creates for the crossref. Therefore, when rendering a table to LaTeX/PDF, it is important to drop the `\begin{table}` environment. This can be done using the `theme_tt()` function.
+
+In the example below, we call `theme_tt()` explicitly for a single table, but the [themes vignette](https://vincentarelbundock.github.io/tinytable/vignettes/theme.html) shows how to set a global theme using the `tinytable_tt_theme` option.
+
+````{verbatim}
+---
+title: "Crossref Example"
+format:
+ pdf: default
+ html: default
+crossref:
+ custom:
+ - kind: float
+ key: apptbl
+ latex-env: apptbl
+ reference-prefix: Table A
+ space-before-numbering: false
+ latex-list-of-description: Appendix Table
+apptbl-cap-location: top
+---
+
+See @apptbl-testing
+
+::: {#apptbl-testing}
+
+```{r}
+library(tinytable)
+
+tt(mtcars[1:5, ]) |> theme_tt("tabular", style = "tabularray")
+```
+
+Caption goes here.
+
+:::
+````
+
+### Sub-captions
+
+With version 0.4.0 of `tinytable` and versions above 1.6 of Quarto---only available [as a pre-release build at the time of writing](https://quarto.org/docs/download/prerelease.html)--- users can specify sub-captions for tables. This is done by adding a `tbl-subcap` chunk option to the table chunk. We also need to use a `tinytable` theme to remove built-in table structure and let Quarto handle the table construction. Here is a simple example document:
+
+````{verbatim}
+---
+format: pdf
+---
+
+See @tbl-example, @tbl-example-1, or @tbl-example-2.
+
+```{r}
+#| label: tbl-example
+#| tbl-cap: "Example"
+#| tbl-subcap:
+#| - "Cars"
+#| - "Pressure"
+#| layout-ncol: 2
+
+library(tinytable)
+tt(head(cars)) |> theme_tt("tabular", style = "tabularray")
+tt(head(pressure)) |> theme_tt("tabular", style = "tabularray")
+```
+````
+
+### Same table, different styles
+
+In some cases, the user wants to print a single table multiple times with different styles in a single HTML document. This will sometimes cause issues, because the `style_tt()` function inserts several javascript functions to modify the same table, thus creating conflicts. A simple solution is to change the unique ID of the table object manually.
+
+Consider this RevalJS slideshow in which we sequentially highlight different rows of the data frame:
+
+````{verbatim}
+---
+format: revealjs
+---
+
+## Page 1
+
+```{r}
+library(tinytable)
+
+tab <- tt(head(iris))
+tab
+```
+
+## Page 2
+
+```{r}
+tab@id <- "table_01"
+tab |> style_tt(i = 3, background = "skyblue")
+```
+
+## Page 3
+
+```{r}
+tab@id <- "table_02"
+tab |> style_tt(i = 5, background = "orange")
+```
+````
+
+### Typst
+
+See [the FAQ on Typst](https://vincentarelbundock.github.io/tinytable/vignettes/faq.html#typst) for important notes on using Typst in Quarto documents.
+
+
+
+## Rmarkdown
+
+
+### `papaja`
+
+
+`papaja` is a package to assist in the preparation of APA manuscripts. Cross-references can be a bit challenging to implement when using this package with `tinytable`. When the target format is PDF, one workaround is to use raw LaTeX code to make renferences and labels.
+
+For example:
+
+````{verbatim}
+---
+output :
+ papaja::apa6_pdf:
+ latex_engine: xelatex
+ fig_caption: yes
+ keep_tex: false
+header-includes :
+ - \usepackage{tabularray}
+ - \usepackage{graphicx}
+ - \UseTblrLibrary{booktabs}
+ - \UseTblrLibrary{siunitx}
+ - \newcommand{\tinytableTabularrayUnderline}[1]{\underline{#1}}
+ - \newcommand{\tinytableTabularrayStrikeout}[1]{\sout{#1}}
+ - \NewTableCommand{\tinytableDefineColor}[3]{\definecolor{#1}{#2}{#3}}
+ - \usepackage{caption,fixltx2e}
+ - \usepackage[table]{xcolor}
+---
+
+# tidytable
+
+Table \ref{tab:tinytableref}
+
+```{r}
+library(tinytable)
+tt(head(iris), caption = "\\label{tab:tinytableref} Hello world!") |>
+ style_tt(color = "blue")
+```
+```{r}
+````
+
+
+
+
+
+## Bookdown
+
+### Cross-references
+
+The `bookdown` package uses a special syntax to handle cross-references, and it does not recognize `tinytable` objects as tables automatically. To include cross-references to tables, it is thus necessary to use the `caption` argument of `tinytable::tt()`, and to insert a `bookdown` label in that caption. Here is an example:
+
+
+````{verbatim}
+Table \@ref(tab:tinytableref)
+
+```{r}
+library(tinytable)
+tt(head(iris), caption = "(#tab:tinytableref) Hello world!") |>
+ style_tt(color = "blue")
+```
+````
+
+
diff --git a/vignettes/options.qmd b/vignettes/options.qmd
deleted file mode 100644
index d15f7897..00000000
--- a/vignettes/options.qmd
+++ /dev/null
@@ -1,118 +0,0 @@
-# Available Options
-
-Options can be set with `options()` and change the default behavior of tinytable. For example, to format all tables to 4 digits when calling `tt()`, we can do:
-
-```r
-options(tinytable_tt_digits = 4)
-tt(head(iris))
-```
-
-You can either set options in a script (usually at the top) or via `.Rprofile`. Note that you want to [be cautious](https://rstats.wtf/r-startup.html) with putting things in `.Rprofile` since they might make results not reproducible (e.g. if you change `tinytable_format_digits` in `.Rprofile`, the table will be formatted differently).
-
-## Default values for function arguments
-
-Most options are function specific and allow you to set default values. These all start with `tinytable_X_` where X is `tt`/`format`/`theme`/`print`. See the corresponding help documentation for the what the argument looks like.
-
-### `tt()`
-
-Sets default values for `tt()` arguments.
-
-- `tinytable_tt_digits`
-- `tinytable_tt_caption`
-- `tinytable_tt_notes`
-- `tinytable_tt_width`
-- `tinytable_tt_theme`
-- `tinytable_tt_rownames`
-
-### `format_tt()`
-
-Sets default formats for different kinds of variables. see `format_tt()`
-
-- `tinytable_format_digits`
-- `tinytable_format_num_fmt`
-- `tinytable_format_num_zero`
-- `tinytable_format_num_suffix`
-- `tinytable_format_num_mark_big`
-- `tinytable_format_num_mark_dec`
-- `tinytable_format_date`
-- `tinytable_format_bool`
-- `tinytable_format_other`
-- `tinytable_format_replace`
-- `tinytable_format_escape`
-- `tinytable_format_markdown`
-- `tinytable_format_quarto`
-- `tinytable_format_fn`
-- `tinytable_format_sprintf`
-
-### `save_tt()`
-
-- `tinytable_save_overwrite`
-
-### `theme_tt()`
-
-When using `theme_tt(theme = "theme_name")`, this allows you to set default arguments to the corresponding theme. See `theme_tt()` for details.
-
-placement:
-
-- `tinytable_theme_placement_float`
-- `tinytable_theme_placement_horizontal`
-
-resize:
-
-- `tinytable_theme_resize_width`
-- `tinytable_theme_resize_direction`
-
-multipage:
-
-- `tinytable_theme_multipage_rowhead`
-- `tinytable_theme_multipage_rowfoot`
-
-tabular:
-
-- `tinytable_theme_tabular_style`
-
-### `print.tinytable()`
-
-`tinytable_print_output`
-
-
-## Global options
-
-The rest of the options are a set of global options that apply when the tables are being built.
-
-### HTML
-
-* `options(tinytable_html_mathjax = TRUE)`
- - insert MathJax scripts in the HTML document. Warning: This may conflict with other elements of the page if MathJax is otherwise loaded.
-* `options(tinytable_html_portable = TRUE)`
- - `plot_tt()` inserts base 64-encoded images directly in the HTML file rather than use external links.
-
-### PDF
-
-* `options(tinytable_pdf_clean = TRUE)`
- - deletes temporary and log files.
-* `options(tinytable_pdf_engine = "xelatex")`
- - `"xelatex"`, `"pdflatex"`, `"lualatex"`
-
-### Quarto
-
-The `format_tt(quarto=TRUE)` argument activates Quarto data processing for specific cells. This funcationality comes with a few warnings:
-
-1. Currently, Quarto provides a `\QuartoMarkdownBase64{}` LaTeX macro, but it does not appear to do anything with it. References and markdown codes may not be processed as expected in LaTeX.
-2. Quarto data processing can enter in conflict with `tinytable` styling or formatting options. See below for how to disable it.
-
-* `options(tinytable_quarto_disable_processing = TRUE)`
- - disables Quarto processing of cell content.
-* `options(tinytable_quarto_figure = FALSE)`
- - by default, do not include Typst tables in a figure environment in Quarto.
-
- Setting this global option to `FALSE` may lead to conflicts with some `tinytable` features, but it also allows use of markdown and Quarto-specific code in table cells, such as cross-references.
-
- ```r
- x <- data.frame(Math = "x^2^", Citation = "@Lovelace1842")
- fn <- function(z) sprintf("", z)
- tt(x) |> format_tt(i = 1, fn = fn)
- ```
-
- See this link for more details: https://quarto.org/docs/authoring/tables.html#disabling-quarto-table-processing
-
diff --git a/vignettes/plot.qmd b/vignettes/plot.qmd
index eb289b92..2c45b7bb 100644
--- a/vignettes/plot.qmd
+++ b/vignettes/plot.qmd
@@ -35,8 +35,8 @@ dat <- data.frame(
)
img <- c(
- "../figures/spider.png",
- "../figures/squirrel.png"
+ "figures/spider.png",
+ "figures/squirrel.png"
)
tt(dat) |>
@@ -73,7 +73,7 @@ There are several types of inline plots available by default. For example,
plot_data <- list(mtcars$mpg, mtcars$hp, mtcars$qsec)
dat <- data.frame(
- Variables = c("mpg", "hp", "qsec"),
+ Variables = c("mpg", "hp", "qsec"),
Histogram = "",
Density = "",
Bar = "",
@@ -124,10 +124,10 @@ library(ggplot2)
f <- function(d, color = "black", ...) {
d <- data.frame(x = d)
- ggplot(d, aes(x = x)) +
+ 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)) +
+ scale_x_continuous(expand = c(0, 0)) +
+ scale_y_continuous(expand = c(0, 0)) +
theme_void()
}
@@ -144,7 +144,8 @@ We can insert arbitrarily complex plots by customizing the `ggplot2` call:
#| warning: false
penguins <- read.csv(
"https://vincentarelbundock.github.io/Rdatasets/csv/palmerpenguins/penguins.csv",
- na.strings = "") |> na.omit()
+ na.strings = ""
+) |> na.omit()
# split data by species
dat <- split(penguins, penguins$species)
@@ -164,8 +165,8 @@ tab <- data.frame(
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_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")
@@ -176,7 +177,7 @@ 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")
+ style_tt(j = 2:4, align = "c")
```
diff --git a/vignettes/style.qmd b/vignettes/style.qmd
index 470b23f1..47e2a957 100644
--- a/vignettes/style.qmd
+++ b/vignettes/style.qmd
@@ -54,7 +54,8 @@ tt(x) |>
i = 2,
j = 3,
background = "black",
- color = "white")
+ color = "white"
+ )
```
The `i` and `j` accept vectors of integers to modify several cells at once:
@@ -65,7 +66,8 @@ tt(x) |>
i = 2:3,
j = c(1, 3, 4),
italic = TRUE,
- color = "orange")
+ color = "orange"
+ )
```
We can style all cells in a table by omitting both the `i` and `j` arguments:
@@ -104,7 +106,7 @@ tt(x) |> style_tt(j = "^(?!drat|mpg)", color = "orange")
Of course, we can also call the `style_tt()` function several times to apply different styles to different parts of the table:
```{r}
-tt(x) |>
+tt(x) |>
style_tt(i = 1, j = 1:2, color = "orange") |>
style_tt(i = 1, j = 3:4, color = "green")
```
@@ -143,7 +145,8 @@ To align columns, we use a single character, or a string where each letter repre
dat <- data.frame(
a = c("a", "aa", "aaa"),
b = c("b", "bb", "bbb"),
- c = c("c", "cc", "ccc"))
+ c = c("c", "cc", "ccc")
+)
tt(dat) |> style_tt(j = 1:3, align = "c")
@@ -155,8 +158,8 @@ In LaTeX documents (only), we can use decimal-alignment:
```{r}
z <- data.frame(pi = c(pi * 100, pi * 1000, pi * 10000, pi * 100000))
tt(z) |>
- format_tt(j = 1, digits = 8, num_fmt = "significant_cell") |>
- style_tt(j = 1, align = "d")
+ format_tt(j = 1, digits = 8, num_fmt = "significant_cell") |>
+ style_tt(j = 1, align = "d")
```
@@ -173,7 +176,7 @@ tt(x) |> style_tt(j = "mpg|hp|qsec", fontsize = 1.5)
Sometimes, it can be useful to make a cell stretch across multiple colums or rows, for example when we want to insert a label. To achieve this, we can use the `colspan` argument. Here, we make the 2nd cell of the 2nd row stretch across three columns and two rows:
```{r}
-tt(x)|> style_tt(
+tt(x) |> style_tt(
i = 2, j = 2,
colspan = 3,
rowspan = 2,
@@ -181,7 +184,8 @@ tt(x)|> style_tt(
alignv = "m",
color = "white",
background = "black",
- bold = TRUE)
+ bold = TRUE
+)
```
Here is the original table for comparison:
@@ -194,7 +198,7 @@ Spanning cells can be particularly useful when we want to suppress redundant lab
```{r}
tab <- aggregate(mpg ~ cyl + am, FUN = mean, data = mtcars)
-tab <- tab[order(tab$cyl, tab$am),]
+tab <- tab[order(tab$cyl, tab$am), ]
tab
tt(tab, digits = 2) |>
@@ -207,15 +211,15 @@ The `rowspan` feature is also useful to create multi-row labels. For example, in
tab <- data.frame(Letters = c("A B", ""), Numbers = c("First", "Second"))
tt(tab) |>
- style_tt(bootstrap_class = "table-bordered")
+ style_tt(bootstrap_class = "table-bordered")
```
Now, we use `colspan` to ensure that that cells in the first column take up less space and are combined into one:
```{r}
tt(tab) |>
- style_tt(bootstrap_class = "table-bordered") |>
- style_tt(1, 1, rowspan = 2)
+ style_tt(bootstrap_class = "table-bordered") |>
+ style_tt(1, 1, rowspan = 2)
```
## Headers
@@ -248,11 +252,12 @@ We can use the standard `which` function from Base `R` to create indices and app
```{r}
k <- mtcars[1:10, c("mpg", "am", "vs")]
-tt(k) |>
+tt(k) |>
style_tt(
i = which(k$am == k$vs),
background = "teal",
- color = "white")
+ color = "white"
+ )
```
In versions *above* 0.4.0 of `tinytable`, users can also supply a logical matrix of the same size as `x` to indicate which cell should be styled. For example, we can change the colors of certain entries in a correlation matrix as follows:
@@ -272,7 +277,8 @@ The `color`, `background`, and `fontsize` arguments are vectorized. This allows
tt(x) |>
style_tt(
i = 1:4,
- color = c("red", "blue", "green", "orange"))
+ color = c("red", "blue", "green", "orange")
+ )
```
When using a single value for a vectorized argument, it gets applied to all values:
@@ -282,7 +288,8 @@ tt(x) |>
style_tt(
j = 2:3,
color = c("orange", "green"),
- background = "black")
+ background = "black"
+ )
```
We can also produce more complex heatmap-like tables to illustrate different font sizes in em units:
@@ -307,7 +314,8 @@ tt(k, width = .7, theme = "void") |>
j = 1:5,
color = fg,
background = bg,
- fontsize = fs)
+ fontsize = fs
+ )
```
@@ -328,21 +336,22 @@ Here is an example where we draw lines around every border ("t", "b", "l", and "
```{r}
tt(x, theme = "void") |>
- style_tt(
- i = 0:3,
- j = 1:3,
- line = "tblr",
- line_width = 0.4,
- line_color = "orange")
+ style_tt(
+ i = 0:3,
+ j = 1:3,
+ line = "tblr",
+ line_width = 0.4,
+ line_color = "orange"
+ )
```
And here is an example with horizontal rules:
```{r}
tt(x, theme = "void") |>
- style_tt(i = 0, line = "t", line_color = "orange", line_width = 0.4) |>
- style_tt(i = 1, line = "t", line_color = "purple", line_width = 0.2) |>
- style_tt(i = 4, line = "b", line_color = "orange", line_width = 0.4)
+ style_tt(i = 0, line = "t", line_color = "orange", line_width = 0.4) |>
+ style_tt(i = 1, line = "t", line_color = "purple", line_width = 0.2) |>
+ style_tt(i = 4, line = "b", line_color = "orange", line_width = 0.4)
```
@@ -350,25 +359,13 @@ tt(x, theme = "void") |>
dat <- data.frame(1:2, 3:4, 5:6, 7:8)
colnames(dat) <- NULL
-tt(dat, theme = "void") |>
+tt(dat, theme = "void") |>
style_tt(
line = "tblr", line_color = "white", line_width = 0.5,
- background = "blue", color = "white")
-```
-
-## Cell padding (height and width)
-
-There is no argument in `style_tt()` to control the padding of cells. Thankfully, this is easy to control using CSS and `tabularray` options:
-
-
-```{r}
-tt(x) |> style_tt(
- bootstrap_css = "padding-right: .2em; padding-top: 2em;",
- tabularray_inner = "rowsep={2em}, colsep = {.2em}"
-)
+ background = "blue", color = "white"
+ )
```
-
## Markdown and Word
Styling for Markdown and Word tables is more limited than for the other formats. In particular:
diff --git a/vignettes/theme.qmd b/vignettes/theme.qmd
index 402ba799..216a07b3 100644
--- a/vignettes/theme.qmd
+++ b/vignettes/theme.qmd
@@ -43,6 +43,10 @@ tt(x, theme = "grid")
tt(x, theme = "bootstrap")
```
+```{r}
+tt(x, theme = "spacing")
+```
+
::: {.content-visible when-format="pdf"}
```{r}
tt(x, theme = "void")
@@ -56,7 +60,7 @@ Users can also define their own themes to apply consistent visual tweaks to tabl
```{r}
theme_vincent <- function(x, ...) {
- out <- x |>
+ out <- x |>
style_tt(color = "teal")
out@caption <- "Always use the same caption."
out@width <- .5
@@ -78,14 +82,14 @@ Here is a slightly more complex example. The benefit of this approach is that we
```{r}
#| eval: false
theme_slides <- function(x, ...) {
- fn <- function(table) {
- if (isTRUE(table@output == "typst")) {
- table@table_string <- paste0("#figure([\n", table@table_string, "\n])")
- }
- return(table)
+ fn <- function(table) {
+ if (isTRUE(table@output == "typst")) {
+ table@table_string <- paste0("#figure([\n", table@table_string, "\n])")
}
- x <- style_tt(x, finalize = fn)
- return(x)
+ return(table)
+ }
+ x <- style_tt(x, finalize = fn)
+ return(x)
}
tt(head(iris), theme = theme_slides)
@@ -97,7 +101,9 @@ tt(head(iris), theme = theme_slides)
The `tabular` theme is designed to provide a more "raw" table, without a floating table environment in LaTeX, and without CSS or Javascript in HTML.
```{r tabular-theme}
-tt(x) |> theme_tt("tabular") |> print("latex")
+tt(x) |>
+ theme_tt("tabular") |>
+ print("latex")
```
@@ -111,7 +117,7 @@ LaTeX only.
The `resize` theme allows you to adjust the size of the table in LaTeX outputs, making it fit within a specified width of the page. This is useful for large tables that need to be scaled down to fit the document layout. This table will be scaled to 90% of the available line width, ensuring it fits nicely within the document.
```{r}
-tmp <- cbind(mtcars, mtcars)[1:10,]
+tmp <- cbind(mtcars, mtcars)[1:10, ]
tt(tmp) |> theme_tt("resize", width = .9)
```
@@ -141,7 +147,7 @@ tt(x) |>
## Rotate
```{r}
-tt(head(iris), caption = "Rotated table.") |>
+tt(head(iris), caption = "Rotated table.") |>
theme_tt("rotate", angle = 45)
```
:::
@@ -161,8 +167,8 @@ tmp <- rbind(mtcars, mtcars)[, 1:6]
cap <- "A long 80\\% width table with repeating headers."
-tt(tmp, width = .8, caption = cap) |>
- theme_tt("multipage", rowhead = 1)
+tt(tmp, width = .8, caption = cap) |>
+ theme_tt("multipage", rowhead = 1)
```
:::
diff --git a/vignettes/tinytable.qmd b/vignettes/tinytable.qmd
index 00aedc0f..cd0039ed 100644
--- a/vignettes/tinytable.qmd
+++ b/vignettes/tinytable.qmd
@@ -21,7 +21,8 @@ Install the latest version from R-Universe or CRAN:
```{r, eval = FALSE}
install.packages("tinytable",
- repos = c("https://vincentarelbundock.r-universe.dev", "https://cran.r-project.org"))
+ repos = c("https://vincentarelbundock.r-universe.dev", "https://cran.r-project.org")
+)
```
This tutorial introduces the main functions of the package. It is also [available as a single PDF document.](tinytable_tutorial.pdf)
@@ -74,7 +75,7 @@ lorem <- data.frame(
Ipsum = " Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos."
)
-tt(lorem, width = 3/4)
+tt(lorem, width = 3 / 4)
```
@@ -99,10 +100,9 @@ We can also add markers in individual cells by providing coordinates:
```{r}
tt(x, notes = list(
- a = list(i = 0:1, j = 1, text = "Blah."),
- b = "Blah blah."
- )
-)
+ a = list(i = 0:1, j = 1, text = "Blah."),
+ b = "Blah blah."
+))
```
@@ -201,10 +201,13 @@ tt(mtcars[1:10, 1:5]) |>
group_tt(
i = list(
"Hello" = 3,
- "World" = 8),
+ "World" = 8
+ ),
j = list(
"Foo" = 2:3,
- "Bar" = 4:5)) |>
+ "Bar" = 4:5
+ )
+ ) |>
print("markdown")
```
@@ -213,10 +216,13 @@ tt(mtcars[1:10, 1:5]) |>
group_tt(
i = list(
"Hello" = 3,
- "World" = 8),
+ "World" = 8
+ ),
j = list(
"Foo" = 2:3,
- "Bar" = 4:5)) |>
+ "Bar" = 4:5
+ )
+ ) |>
save_tt("markdown")
```
@@ -238,7 +244,7 @@ Tables can be combined with the usual `rbind()` function:
```{r}
a <- tt(mtcars[1:3, 1:2], caption = "Combine two tiny tables.")
-b <- tt(mtcars[4:5, 8:10])
+b <- tt(mtcars[4:5, 8:10])
rbind(a, b)
@@ -274,7 +280,7 @@ In a pipe-based workflow, we can use the `setNames()` function from base `R`:
```{r}
mtcars[1:2, 1:2] |>
- tt() |>
- setNames(c("a", "b"))
+ tt() |>
+ setNames(c("a", "b"))
```
diff --git a/vignettes/tinytable_tutorial.qmd b/vignettes/tinytable_tutorial.qmd
index ffbd6d2d..cf8472c7 100644
--- a/vignettes/tinytable_tutorial.qmd
+++ b/vignettes/tinytable_tutorial.qmd
@@ -7,6 +7,10 @@ format:
number-sections: true
colorlinks: true
keep-tex: true
+ pdf-engine: xelatex
+ include-in-header:
+ text: |
+ \usepackage{fontspec}
---
\clearpage
