Nothing
#' Add a table header
#'
#' @description
#' We can add a table header to the **gt** table with a title and even a
#' subtitle. A table header is an optional table part that is positioned above
#' the column labels. We have the flexibility to use Markdown formatting for the
#' header's title and subtitle. Furthermore, if the table is intended for HTML
#' output, we can use HTML in either of the title or subtitle.
#'
#' @inheritParams fmt_number
#' @param title,subtitle Text to be used in the table title and, optionally, for
#' the table subtitle. We can elect to use the [md()] and [html()] helper
#' functions to style the text as Markdown or to retain HTML elements in the
#' text.
#' @param preheader Optional preheader content that is rendered above the table.
#' Can be supplied as a vector of text.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table. Add a header part with the
#' `tab_header()` function so that we get a title and a subtitle for the table.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(mfr, model, msrp) %>%
#' dplyr::slice(1:5) %>%
#' gt() %>%
#' tab_header(
#' title = md("Data listing from **gtcars**"),
#' subtitle = md("`gtcars` is an R dataset")
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_header_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-1
#'
#' @export
tab_header <- function(
data,
title,
subtitle = NULL,
preheader = NULL
) {
# Perform input object validation
stop_if_not_gt(data = data)
dt_set_heading_components(
data = data,
title = title,
subtitle = subtitle,
preheader = preheader
)
}
#' Add a spanner column label
#'
#' @description
#' Set a spanner column label by mapping it to columns already in the table.
#' This label is placed above one or more column labels, spanning the width of
#' those columns and column labels.
#'
#' @inheritParams fmt_number
#' @param label The text to use for the spanner column label.
#' @param columns The columns to be components of the spanner heading.
#' @param spanners The spanners that should be spanned over, should they already
#' be defined.
#' @param level An explicit level to which the spanner should be placed. If not
#' provided, **gt** will choose the level based on the inputs provided within
#' `columns` and `spanners`, placing the spanner label where it will fit. The
#' first spanner level (right above the column labels) is `1`.
#' @param id The ID for the spanner column label. When accessing a spanner
#' column label through [cells_column_spanners()] (when using [tab_style()] or
#' [tab_footnote()]) the `id` value is used as the reference (and not the
#' `label`). If an `id` is not explicitly provided here, it will be taken from
#' the `label` value. It is advisable to set an explicit `id` value if you
#' plan to access this cell in a later function call and the label text is
#' complicated (e.g., contains markup, is lengthy, or both). Finally, when
#' providing an `id` value you must ensure that it is unique across all ID
#' values set for column spanner labels (the function will stop if `id` isn't
#' unique).
#' @param gather An option to move the specified `columns` such that they are
#' unified under the spanner column label. Ordering of the moved-into-place
#' columns will be preserved in all cases. By default, this is set to `TRUE`.
#' @param replace Should new spanners be allowed to partially or fully replace
#' existing spanners? (This is a possibility if setting spanners at an already
#' populated `level`.) By default, this is set to `FALSE` and an error will
#' occur if some replacement is attempted.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table. Use the `tab_spanner()` function to
#' effectively group several columns related to car performance under a spanner
#' column with the label `"performance"`.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(
#' -mfr, -trim, bdy_style,
#' -drivetrain, -trsmn, -ctry_origin
#' ) %>%
#' dplyr::slice(1:8) %>%
#' gt(rowname_col = "model") %>%
#' tab_spanner(
#' label = "performance",
#' columns = c(
#' hp, hp_rpm, trq, trq_rpm,
#' mpg_c, mpg_h
#' )
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_spanner_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-2
#'
#' @import rlang
#' @export
tab_spanner <- function(
data,
label,
columns = NULL,
spanners = NULL,
level = NULL,
id = label,
gather = TRUE,
replace = FALSE
) {
# Perform input object validation
stop_if_not_gt(data = data)
present_spanner_ids <- dt_spanners_get_ids(data = data)
# Get the columns supplied in `columns` as a character vector
column_names <-
resolve_cols_c(
expr = {{ columns }},
data = data,
null_means = "nothing"
)
# Get the spanner IDs supplied in `spanners` as a character vector
spanner_id_idx <-
tidyselect::with_vars(
vars = present_spanner_ids,
expr = spanners
)
# Stop function if `level` is provided and is less than `1`
if (!is.null(level) && level < 1) {
cli::cli_abort(c(
"A spanner level of {level} cannot be set.",
"*" = "Please choose a `level` value greater than or equal to `1`."
))
}
if (is.numeric(spanner_id_idx)) {
spanner_ids <- present_spanner_ids[spanner_id_idx]
} else {
if (
!is.null(spanner_id_idx) &&
!all(spanner_id_idx %in% present_spanner_ids)
) {
error_vars <-
paste(
base::setdiff(spanner_id_idx, present_spanner_ids),
collapse = ", "
)
cli::cli_abort(
"One or more spanner ID(s) supplied in `spanners` ({error_vars}),
for the new spanner with the ID `{id}` doesn't belong to any
existing spanners."
)
}
spanner_ids <- spanner_id_idx
}
# If `column_names` and `spanner_ids` have zero lengths then
# return the data unchanged
if (length(column_names) < 1 && length(spanner_ids) < 1) {
return(data)
}
# Check new `id` against existing `id` values across column labels
# and spanner column labels and stop if necessary
check_spanner_id_unique(data = data, spanner_id = id)
# Resolve the `column_names` that new spanner will span over
column_names <-
resolve_spanned_column_names(
data = data,
column_names = column_names,
spanner_ids = spanner_ids
)
# Resolve the `level` of the new spanner
level <-
resolve_spanner_level(
data = data,
column_names = column_names,
level = level
)
# Add the spanner to the `_spanners` table
data <-
dt_spanners_add(
data = data,
vars = column_names,
spanner_label = label,
spanner_id = id,
spanner_level = level,
gather = gather,
replace = replace
)
# Move columns into place with `cols_move()` only if specific
# conditions are met:
# - `gather` should be TRUE
# - `spanner_ids` should be empty
# - `level` is NULL or `1`
if (
gather &&
length(spanner_ids) < 1 &&
(is.null(level) || level == 1)
) {
data <-
cols_move(
data = data,
columns = column_names,
after = column_names[1]
)
}
data
}
resolve_spanner_level <- function(
data,
column_names,
level
) {
# If explicitly providing a `level` simply return that value
if (!is.null(level)) {
return(as.integer(level))
}
# Determine if there are any existing spanners
any_existing_spanners <- dt_spanners_exists(data = data)
# If there aren't any existing spanners, then the new spanner
# level will always be `1`
if (!any_existing_spanners) {
return(1L)
}
# Get the present `spanners_tbl`
spanners_tbl <- dt_spanners_get(data = data)
highest_level <- 0L
spanners_tbl <- dplyr::select(spanners_tbl, spanner_id, vars, spanner_level)
highest_level <-
dplyr::filter(
spanners_tbl,
vapply(
vars,
FUN.VALUE = logical(1),
FUN = function(x) any(column_names %in% x)
)
) %>%
dplyr::pull("spanner_level") %>%
max(0) # Max of ^ and 0
highest_level + 1L
}
resolve_spanned_column_names <- function(
data,
column_names,
spanner_ids
) {
if (length(spanner_ids) > 0) {
spanners_existing <- dt_spanners_get(data = data)
column_names_associated <-
unlist(
spanners_existing[["vars"]][
spanners_existing[["spanner_id"]] %in% spanner_ids
]
)
column_names <- c(column_names, column_names_associated)
}
unique(column_names)
}
#' Create column labels and spanners via delimited names
#'
#' @description
#' This function will split selected delimited column names such that the first
#' components (LHS) are promoted to being spanner column labels, and the
#' secondary components (RHS) will become the column labels. Please note that
#' reference to individual columns must continue to be the column names from the
#' input table data (which are unique by necessity).
#'
#' @details
#' If we look to the column names in the `iris` dataset as an example of how
#' `tab_spanner_delim()` might be useful, we find the names `Sepal.Length`,
#' `Sepal.Width`, `Petal.Length`, `Petal.Width`. From this naming system, it's
#' easy to see that the `Sepal` and `Petal` can group together the repeated
#' common `Length` and `Width` values. In your own datasets, we can avoid a
#' lengthy relabeling with [cols_label()] if column names can be fashioned
#' beforehand to contain both the spanner column label and the column label. An
#' additional advantage is that the column names in the input table data remain
#' unique even though there may eventually be repeated column labels in the
#' rendered output table).
#'
#' @inheritParams tab_spanner
#' @param delim The delimiter to use to split an input column name. The
#' delimiter supplied will be autoescaped for the internal splitting
#' procedure. The first component of the split will become the spanner column
#' label (and its ID value, used for styling or for the addition of footnotes
#' in those locations) and the second component will be the column label.
#' @param columns An optional vector of column names that this operation should
#' be limited to. The default is to consider all columns in the table.
#' @param split Should the delimiter splitting occur from the `"last"` instance
#' of the `delim` character or from the `"first"`? By default, column name
#' splitting begins at the last instance of the delimiter.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use `iris` to create a **gt** table and use the `tab_spanner_delim()`
#' function to automatically generate column spanner labels. This splits any
#' columns that are dot-separated between column spanner labels (first part) and
#' column labels (second part).
#'
#' ```r
#' iris %>%
#' dplyr::group_by(Species) %>%
#' dplyr::slice(1:4) %>%
#' gt() %>%
#' tab_spanner_delim(delim = ".")
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_spanner_delim_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-3
#'
#' @import rlang
#' @export
tab_spanner_delim <- function(
data,
delim,
columns = everything(),
split = c("last", "first")
) {
# Perform input object validation
stop_if_not_gt(data = data)
split <- rlang::arg_match(split)
# Get all of the columns in the dataset
all_cols <- dt_boxhead_get_vars(data = data)
# Get the columns supplied in `columns` as a character vector
columns <-
suppressWarnings(
resolve_cols_c(
expr = {{ columns }},
data = data
)
)
if (!is.null(columns)) {
colnames_spanners <- base::intersect(all_cols, columns)
} else {
colnames_spanners <- all_cols
}
if (length(colnames_spanners) == 0) {
return(data)
}
if (split == "first") {
colnames_spanners_ordered <-
vapply(
colnames_spanners,
FUN.VALUE = character(1),
USE.NAMES = FALSE,
FUN = function(x) {
paste(
rev(unlist(strsplit(x, split = delim, fixed = TRUE))),
collapse = delim
)
}
)
} else {
colnames_spanners_ordered <- colnames_spanners
}
#
# Determine the highest spanner level from these column names
#
max_level <-
max(
vapply(
colnames_spanners_ordered,
FUN.VALUE = integer(1), FUN = function(x) {
length(unlist(strsplit(x, split = delim, fixed = TRUE)))
}
),
na.rm = TRUE
)
#
# Create a matrix representation of the spanners
#
spanner_matrix <- matrix(data = NA_character_, nrow = max_level, ncol = 0)
for (col in all_cols) {
if (col %in% colnames_spanners) {
col_name <- colnames_spanners_ordered[colnames_spanners %in% col]
elements <- unlist(strsplit(col_name, split = delim, fixed = TRUE))
elements_n <- length(elements)
matrix_col_i <-
matrix(
c(rep(NA_character_, max_level - elements_n), elements),
ncol = 1
)
} else {
matrix_col_i <- matrix(c(rep(NA_character_, max_level - 1), col))
}
spanner_matrix <- cbind(spanner_matrix, matrix_col_i)
}
# If the height of the spanner matrix isn't greater than
# one then return the data untouched
if (nrow(spanner_matrix) == 1) {
return(data)
}
for (i in rev(seq_len(nrow(spanner_matrix)))) {
if (i == nrow(spanner_matrix)) next
level <- nrow(spanner_matrix) - i
rle_spanners_i <- rle(spanner_matrix[i, ])
spanners_i_lengths <- rle_spanners_i$lengths
spanners_i_values <- rle_spanners_i$values
spanners_i_col_i <- utils::head(cumsum(c(1, spanners_i_lengths)), -1)
spanner_id_vals <- c()
for (j in seq_along(spanners_i_lengths)) {
if (!is.na(spanners_i_values[j])) {
# Construct the ID for the spanner from the spanner matrix
spanner_id <-
paste0(
"spanner-",
paste(
spanner_matrix[seq(i, nrow(spanner_matrix)), spanners_i_col_i[j]],
collapse = delim
)
)
# Modify `spanner_id` to not collide with any other values
if (spanner_id %in% spanner_id_vals) {
if (grepl("^spanner-", spanner_id)) {
# Add number to spanner ID values on first duplication
spanner_id <- gsub("^spanner-", "spanner:1-", spanner_id)
}
while (spanner_id %in% spanner_id_vals) {
# Increment number to spanner ID values on subsequent duplications
idx_str <- gsub("^spanner:([0-9]+)-.*", "\\1", spanner_id)
idx_int <- as.integer(idx_str)
spanner_id <- gsub("^(spanner:)[0-9]+(-.*)", paste0("\\1", idx_int + 1, "\\2"), spanner_id)
}
}
spanner_id_vals <- unique(c(spanner_id_vals, spanner_id))
spanner_columns <-
seq(
spanners_i_col_i[j],
spanners_i_col_i[j] + spanners_i_lengths[j] - 1
)
# Set the spanner with a call to `tab_spanner()`
data <-
tab_spanner(
data = data,
label = spanners_i_values[j],
columns = spanner_columns,
spanners = NULL,
level = level,
id = spanner_id,
gather = FALSE
)
}
}
}
#
# Re-label column labels included in `colnames_spanners`
#
new_labels <-
strsplit(colnames_spanners_ordered, split = delim, fixed = TRUE) %>%
vapply(FUN.VALUE = character(1), utils::tail, 1)
new_label_list <- stats::setNames(as.list(new_labels), colnames_spanners)
cols_label(data, .list = new_label_list)
}
#' Add a row group to a **gt** table
#'
#' @description
#' Create a row group with a collection of rows. This requires specification of
#' the rows to be included, either by supplying row labels, row indices, or
#' through use of a select helper function like [starts_with()]. To modify the
#' order of row groups, use the [row_group_order()] function.
#'
#' To set a default row group label for any rows not formally placed in a row
#' group, we can use a separate call to `tab_options(row_group.default_label =
#' <label>)`. If this is not done and there are rows that haven't been placed
#' into a row group (where one or more row groups already exist), those rows
#' will be automatically placed into a row group without a label. To restore
#' labels for row groups not explicitly assigned a group,
#' `tab_options(row_group.default_label = "")` can be used.
#'
#' @inheritParams fmt_number
#' @param label The text to use for the row group label.
#' @param rows The rows to be made components of the row group. Can either be a
#' vector of row captions provided in `c()`, a vector of row indices, or a
#' helper function focused on selections. The select helper functions are:
#' [starts_with()], [ends_with()], [contains()], [matches()], [one_of()], and
#' [everything()].
#' @param id The ID for the row group. When accessing a row group through
#' [cells_row_groups()] (when using [tab_style()] or [tab_footnote()]) the
#' `id` value is used as the reference (and not the `label`). If an `id` is
#' not explicitly provided here, it will be taken from the `label` value. It
#' is advisable to set an explicit `id` value if you plan to access this cell
#' in a later function call and the label text is complicated (e.g., contains
#' markup, is lengthy, or both). Finally, when providing an `id` value you
#' must ensure that it is unique across all ID values set for row groups (the
#' function will stop if `id` isn't unique).
#' @param others_label This argument is deprecated. Instead use
#' `tab_options(row_group.default_label = <label>)`.
#' @param group This argument is deprecated. Instead use `label`.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table and use `tab_row_group()` to add two
#' row groups with the labels: `numbered` and `NA`. The row group with the `NA`
#' label ends up being rendered without a label at all.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(model, year, hp, trq) %>%
#' dplyr::slice(1:8) %>%
#' gt(rowname_col = "model") %>%
#' tab_row_group(
#' label = "numbered",
#' rows = matches("^[0-9]")
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_row_group_1.png")`
#' }}
#'
#' Use [`gtcars`] to create a **gt** table. Add two row groups with the labels
#' `powerful` and `super powerful`. The distinction between the groups is
#' whether `hp` is lesser or greater than `600` (governed by the expressions
#' provided to the `rows` argument).
#'
#' ```r
#' gtcars %>%
#' dplyr::select(model, year, hp, trq) %>%
#' dplyr::slice(1:8) %>%
#' gt(rowname_col = "model") %>%
#' tab_row_group(
#' label = "powerful",
#' rows = hp <= 600
#' ) %>%
#' tab_row_group(
#' label = "super powerful",
#' rows = hp > 600
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_row_group_2.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-4
#'
#' @import rlang
#' @export
tab_row_group <- function(
data,
label,
rows,
id = label,
others_label = NULL,
group = NULL
) {
# Perform input object validation
stop_if_not_gt(data = data)
arrange_groups_vars <- dt_row_groups_get(data = data)
if (!missing(group)) {
if (missing(label)) {
label <- group
}
cli::cli_warn(c(
"Since gt v0.3.0 the `group` argument has been deprecated.",
"*" = "Use the `label` argument to specify the group label."
))
}
# Warn user about `others_label` deprecation
if (!is.null(others_label)) {
data <-
tab_options(
data = data,
row_group.default_label = others_label
)
cli::cli_warn(c(
"Since gt v0.3.0 the `others_label` argument has been deprecated.",
"*" = "Use `tab_options(row_group.default_label = <label>)` to set
this label."
))
if (missing(label) && missing(rows) && missing(id)) {
return(data)
}
}
# Check `id` against existing `id` values and stop if necessary
check_row_group_id_unique(data = data, row_group_id = id)
# Capture the `rows` expression
row_expr <- rlang::enquo(rows)
# Get the `stub_df` data frame from `data`
stub_df <- dt_stub_df_get(data = data)
# Resolve the row numbers using the `resolve_vars` function
resolved_rows_idx <-
resolve_rows_i(
expr = !!row_expr,
data = data
)
stub_df <- dt_stub_df_get(data = data)
# Place the `label` in the `groupname` column `stub_df`
stub_df[resolved_rows_idx, "group_label"] <- list(list(label))
stub_df[resolved_rows_idx, "group_id"] <- as.character(id)
data <- dt_stub_df_set(data = data, stub_df = stub_df)
# Set the `_row_groups` vector here with the group id; new groups will
# be placed at the front, pushing down `NA` (the 'Others' group)
arrange_groups_vars <- c(id, stats::na.omit(arrange_groups_vars))
arrange_groups_vars <- unique(arrange_groups_vars)
arrange_groups_vars <- arrange_groups_vars[arrange_groups_vars %in% stub_df$group_id]
if (dt_stub_groupname_has_na(data = data)) {
arrange_groups_vars <- c(arrange_groups_vars, NA_character_)
}
if (length(arrange_groups_vars) == 1 && is.na(arrange_groups_vars)) {
arrange_groups_vars <- character(0)
}
dt_row_groups_set(
data = data,
row_groups = arrange_groups_vars
)
}
#' Add label text to the stubhead
#'
#' @description
#' Add a label to the stubhead of a **gt** table. The stubhead is the lone
#' element that is positioned left of the column labels, and above the stub. If
#' a stub does not exist, then there is no stubhead (so no change will be made
#' when using this function in that case). We have the flexibility to use
#' Markdown formatting for the stubhead label. Furthermore, if the table is
#' intended for HTML output, we can use HTML for the stubhead label.
#'
#' @inheritParams fmt_number
#' @param label The text to be used as the stubhead label We can optionally use
#' the [md()] and [html()] functions to style the text as Markdown or to
#' retain HTML elements in the text.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table. With `tab_stubhead()` we can add a
#' stubhead label. This appears in the top-left and can be used to describe what
#' is in the stub.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(model, year, hp, trq) %>%
#' dplyr::slice(1:5) %>%
#' gt(rowname_col = "model") %>%
#' tab_stubhead(label = "car")
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_stubhead_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-5
#'
#' @export
tab_stubhead <- function(
data,
label
) {
# Perform input object validation
stop_if_not_gt(data = data)
dt_stubhead_label(data = data, label = label)
}
#' Control indentation of row labels in the stub
#'
#' @description
#' Indentation of row labels is an effective way for establishing structure in a
#' table stub. The `tab_stub_indent()` function allows for fine control over
#' row label indentation through either explicit definition of an indentation
#' level, or, by way of an indentation directive using keywords.
#'
#' @inheritParams fmt_number
#' @param rows The rows to consider for the indentation change. Can either be a
#' vector of row captions provided in `c()`, a vector of row indices, or a
#' helper function focused on selections. The select helper functions are:
#' [starts_with()], [ends_with()], [contains()], [matches()], [one_of()], and
#' [everything()].
#' @param indent An indentation directive either as a keyword describing the
#' indentation change or as an explicit integer value for directly setting the
#' indentation level. The keyword `"increase"` (the default) will increase the
#' indentation level by one; `"decrease"` will do the same in the reverse
#' direction. The starting indentation level of `0` means no indentation and
#' this values serves as a lower bound. The upper bound for indentation is at
#' level `5`.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`pizzaplace`] to create a **gt** table. With `tab_stub_indent()` we can
#' add indentation to targeted row labels in the stub. Here we target the
#' different pizza sizes and avoid selecting the repeating `"All Sizes"` row
#' label.
#'
#' ```r
#' dplyr::bind_rows(
#' pizzaplace %>%
#' dplyr::group_by(type, size) %>%
#' dplyr::summarize(
#' sold = n(),
#' income = sum(price),
#' .groups = "drop_last"
#' ) %>%
#' dplyr::summarize(
#' sold = sum(sold),
#' income = sum(income),
#' size = "All Sizes",
#' .groups = "drop"
#' ),
#' pizzaplace %>%
#' dplyr::group_by(type, size) %>%
#' dplyr::summarize(
#' sold = n(),
#' income = sum(price),
#' .groups = "drop"
#' )
#' ) %>%
#' gt(rowname_col = "size", groupname_col = "type") %>%
#' tab_header(title = "Pizzas Sold in 2015") %>%
#' fmt_number(
#' columns = sold,
#' decimals = 0,
#' use_seps = TRUE
#' ) %>%
#' fmt_currency(
#' columns = income,
#' currency = "USD"
#' ) %>%
#' tab_options(
#' summary_row.background.color = "#ACEACE",
#' row_group.background.color = "#FFEFDB",
#' row_group.as_column = TRUE
#' ) %>%
#' tab_stub_indent(
#' rows = matches("^L|^M|^S|^XL|^XXL"),
#' indent = 2
#' ) %>%
#' tab_style(
#' style = cell_fill(color = "gray95"),
#' locations = list(
#' cells_body(rows = matches("^All")),
#' cells_stub(rows = matches("^All"))
#' )
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_stub_indent_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-6
#'
#' @import rlang
#' @export
tab_stub_indent <- function(
data,
rows,
indent = "increase"
) {
# Perform input object validation
stop_if_not_gt(data = data)
# Capture the `rows` expression
row_expr <- rlang::enquo(rows)
# Get the `stub_df` data frame from `data`
stub_df <- dt_stub_df_get(data = data)
# Resolve the row numbers using the `resolve_vars` function
resolved_rows_idx <-
resolve_rows_i(
expr = !!row_expr,
data = data
)
# Set indent levels appropriately
indent_vals <- stub_df[stub_df$rownum_i %in% resolved_rows_idx, ][["indent"]]
for (i in seq_along(indent_vals)) {
if (is.na(indent_vals[i])) {
indent_val_i <- 0L
} else if (grepl("^[0-9]$", indent_vals[i])) {
indent_val_i <- as.integer(indent_vals[i])
} else {
indent_val_i <- indent_vals[i]
}
# Modify `indent_val_i` based on keyword directives
if (is.character(indent)) {
# Move `indent_val_i` up or down by one
if (indent == "increase") {
indent_val_i <- indent_val_i + 1L
} else if (indent == "decrease") {
indent_val_i <- indent_val_i - 1L
}
# Set hard boundaries on the indentation value (LB is `0`, UB is `5`)
if (indent_val_i > 5) indent_val_i <- 5L
if (indent_val_i < 0) indent_val_i <- 0L
}
# Modify `indent_val_i` using a fixed value
if (
is.numeric(indent) &&
!is.na(indent) &&
!is.infinite(indent)
) {
# Stop function if `indent` value doesn't fall into the acceptable range
if (indent < 0 | indent > 5) {
cli::cli_abort(c(
"If given as a numeric value, `indent` should be one of the following:",
"*" = "0, 1, 2, 3, 4, or 5"
))
}
# Coerce `indent` to an integer value
indent_val_i <- as.integer(indent)
}
# Ensure that `indent_val_i` is assigned to indent_vals as a character value
indent_vals[i] <- as.character(indent_val_i)
}
stub_df[stub_df$rownum_i %in% resolved_rows_idx, ][["indent"]] <- indent_vals
dt_stub_df_set(data = data, stub_df = stub_df)
}
#' Add a table footnote
#'
#' @description
#' The `tab_footnote()` function can make it a painless process to add a
#' footnote to a **gt** table. There are two components to a footnote: (1) a
#' footnote mark that is attached to the targeted cell text, and (2) the
#' footnote text (that starts with the corresponding footnote mark) that is
#' placed in the table's footer area. Each call of `tab_footnote()` will add a
#' different note, and one or more cells can be targeted via the location helper
#' functions (e.g., [cells_body()], [cells_column_labels()], etc.).
#'
#' @details
#' The formatting of the footnotes can be controlled through the use of various
#' parameters in the [tab_options()] function:
#' - `footnotes.multiline`: a setting that determines whether footnotes each
#' start on a new line or are combined into a single block.
#' - `footnotes.sep`: allows for a choice of the separator between consecutive
#' footnotes in the table footer. By default, this is set to a single space
#' character.
#' - `footnotes.marks`: the set of sequential characters or numbers used to
#' identify the footnotes.
#' - `footnotes.font.size`: the size of the font used in the footnote section.
#' - `footnotes.padding`: the amount of padding to apply between the footnote
#' and source note sections in the table footer.
#'
#' @inheritParams fmt_number
#' @param footnote The text to be used in the footnote. We can optionally use
#' the [md()] and [html()] functions to style the text as Markdown or to
#' retain HTML elements in the footnote text.
#' @param locations The cell or set of cells to be associated with the footnote.
#' Supplying any of the `cells_*()` helper functions is a useful way to target
#' the location cells that are associated with the footnote text. These helper
#' functions are: [cells_title()], [cells_stubhead()],
#' [cells_column_spanners()], [cells_column_labels()], [cells_row_groups()],
#' [cells_stub()], [cells_body()], [cells_summary()], [cells_grand_summary()],
#' [cells_stub_summary()], and [cells_stub_grand_summary()]. Additionally, we
#' can enclose several `cells_*()` calls within a `list()` if we wish to link
#' the footnote text to different types of locations (e.g., body cells, row
#' group labels, the table title, etc.).
#' @param placement Where to affix footnote marks to the table content. Two
#' options for this are `"left` or `"right"`, where the placement is to the
#' absolute left or right of the cell content. By default, however, this is
#' set to `"auto"` whereby **gt** will choose a preferred left-or-right
#' placement depending on the alignment of the cell content.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`sza`] to create a **gt** table. Color the `sza` column using the
#' [data_color()] function, then, use `tab_footnote()` to add a footnote to the
#' `sza` column label (explaining what the color scale signifies).
#'
#' ```r
#' sza %>%
#' dplyr::filter(
#' latitude == 20 &
#' month == "jan" &
#' !is.na(sza)
#' ) %>%
#' dplyr::select(-latitude, -month) %>%
#' gt() %>%
#' data_color(
#' columns = sza,
#' colors = scales::col_numeric(
#' palette = c("white", "yellow", "navyblue"),
#' domain = c(0, 90)
#' )
#' ) %>%
#' tab_footnote(
#' footnote = "Color indicates height of sun.",
#' locations = cells_column_labels(
#' columns = sza
#' )
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_footnote_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-7
#'
#' @export
tab_footnote <- function(
data,
footnote,
locations = NULL,
placement = c("auto", "right", "left")
) {
placement <- rlang::arg_match(placement)
# Perform input object validation
stop_if_not_gt(data = data)
if (is.null(locations)) {
# We need to invoke `dt_footnotes_add()` here (and not use
# `as_locations()`/`set_footnote()`) because there is no
# method for NULL
data <-
dt_footnotes_add(
data = data,
locname = "none",
grpname = NA_character_,
colname = NA_character_,
locnum = 0,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
return(data)
}
# Resolve into a list of locations
locations <- as_locations(locations)
# Resolve the locations of the targeted data cells and append
# the footnotes
for (loc in locations) {
data <-
set_footnote(
loc = loc,
data = data,
footnote = footnote,
placement = placement
)
}
data
}
set_footnote <- function(loc, data, footnote, placement) {
UseMethod("set_footnote")
}
set_footnote.cells_title <- function(loc, data, footnote, placement) {
title_components <- rlang::eval_tidy(loc$groups)
if ("title" %in% title_components) {
data <-
dt_footnotes_add(
data = data,
locname = "title",
grpname = NA_character_,
colname = NA_character_,
locnum = 1,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
}
if ("subtitle" %in% title_components) {
data <-
dt_footnotes_add(
data = data,
locname = "subtitle",
grpname = NA_character_,
colname = NA_character_,
locnum = 2,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
}
data
}
set_footnote.cells_stubhead <- function(loc, data, footnote, placement) {
data <-
dt_footnotes_add(
data = data,
locname = loc$groups,
grpname = NA_character_,
colname = NA_character_,
locnum = 2.5,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_column_labels <- function(loc, data, footnote, placement) {
resolved <- resolve_cells_column_labels(data = data, object = loc)
cols <- resolved$columns
colnames <- names(cols)
data <-
dt_footnotes_add(
data = data,
locname = "columns_columns",
grpname = NA_character_,
colname = colnames,
locnum = 4,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_column_spanners <- function(loc, data, footnote, placement) {
resolved <- resolve_cells_column_spanners(data = data, object = loc)
groups <- resolved$spanners
data <-
dt_footnotes_add(
data = data,
locname = "columns_groups",
grpname = groups,
colname = NA_character_,
locnum = 3,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_row_groups <- function(loc, data, footnote, placement) {
row_groups <- dt_row_groups_get(data = data)
# Resolve row groups
resolved_row_groups_idx <-
resolve_vector_i(
expr = !!loc$groups,
vector = row_groups,
item_label = "row group"
)
groups <- row_groups[resolved_row_groups_idx]
data <-
dt_footnotes_add(
data = data,
locname = "row_groups",
grpname = groups,
colname = NA_character_,
locnum = 5,
rownum = NA_integer_,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_body <- function(loc, data, footnote, placement) {
resolved <- resolve_cells_body(data = data, object = loc)
rows <- resolved$rows
colnames <- resolved$colnames
data <-
dt_footnotes_add(
data = data,
locname = "data",
grpname = NA_character_,
colname = colnames,
locnum = 5,
rownum = rows,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_stub <- function(loc, data, footnote, placement) {
resolved <- resolve_cells_stub(data = data, object = loc)
rows <- resolved$rows
data <-
dt_footnotes_add(
data = data,
locname = "stub",
grpname = NA_character_,
colname = NA_character_,
locnum = 5,
rownum = rows,
footnotes = footnote,
placement = placement
)
data
}
set_footnote.cells_summary <- function(loc, data, footnote, placement) {
add_summary_location_row(
loc = loc,
data = data,
style = footnote,
placement = placement,
df_type = "footnotes_df"
)
}
set_footnote.cells_grand_summary <- function(loc, data, footnote, placement) {
add_grand_summary_location_row(
loc = loc,
data = data,
style = footnote,
placement = placement,
df_type = "footnotes_df"
)
}
set_footnote.cells_stub_summary <- function(loc, data, footnote, placement) {
add_summary_location_row(
loc = loc,
data = data,
style = footnote,
placement = placement,
df_type = "footnotes_df"
)
}
set_footnote.cells_stub_grand_summary <- function(loc, data, footnote, placement) {
add_grand_summary_location_row(
loc = loc,
data = data,
style = footnote,
placement = placement,
df_type = "footnotes_df"
)
}
set_footnote.cells_source_notes <- function(loc, data, footnote, placement) {
cli::cli_abort("Footnotes cannot be applied to source notes.")
data
}
set_footnote.cells_footnotes <- function(loc, data, footnote, placement) {
cli::cli_abort("Footnotes cannot be applied to other footnotes.")
data
}
#' Add a source note citation
#'
#' @description
#' Add a source note to the footer part of the **gt** table. A source note is
#' useful for citing the data included in the table. Several can be added to the
#' footer, simply use multiple calls of `tab_source_note()` and they will be
#' inserted in the order provided. We can use Markdown formatting for the note,
#' or, if the table is intended for HTML output, we can include HTML formatting.
#'
#' @inheritParams fmt_number
#' @param source_note Text to be used in the source note. We can optionally use
#' the [md()] and [html()] functions to style the text as Markdown or to
#' retain HTML elements in the text.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table. Use `tab_source_note()` to add a
#' source note to the table footer that cites the data source.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(mfr, model, msrp) %>%
#' dplyr::slice(1:5) %>%
#' gt() %>%
#' tab_source_note(source_note = "From edmunds.com")
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_source_note_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-8
#'
#' @export
tab_source_note <- function(
data,
source_note
) {
# Perform input object validation
stop_if_not_gt(data = data)
dt_source_notes_add(
data = data,
source_note = source_note
)
}
#' Add a table caption
#'
#' @description
#' Add a caption to a **gt** table, which is handled specially for a table
#' within an R Markdown, Quarto, or **bookdown** context. The addition of
#' captions makes tables cross-referencing across the containing document. The
#' caption location (i.e., top, bottom, margin) is handled at the document level
#' in each of these system.
#'
#' @inheritParams fmt_number
#' @param caption The table caption to use for cross-referencing in R Markdown,
#' Quarto, or **bookdown**.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`gtcars`] to create a **gt** table. Add a header part with the
#' [tab_header()] function, and, add a caption as well with `tab_caption()`.
#'
#' ```r
#' gtcars %>%
#' dplyr::select(mfr, model, msrp) %>%
#' dplyr::slice(1:5) %>%
#' gt() %>%
#' tab_header(
#' title = md("Data listing from **gtcars**"),
#' subtitle = md("`gtcars` is an R dataset")
#' ) %>%
#' tab_caption(caption = md("**gt** table example."))
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_caption_1.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-9
#'
#' @export
tab_caption <- function(
data,
caption
) {
# Perform input object validation
stop_if_not_gt(data = data)
dt_options_set_value(
data = data,
option = "table_caption",
value = caption
)
}
#' Add custom styles to one or more cells
#'
#' @description
#' With the `tab_style()` function we can target specific cells and apply styles
#' to them. This is best done in conjunction with the helper functions
#' [cell_text()], [cell_fill()], and [cell_borders()]. At present this function
#' is focused on the application of styles for HTML output only (as such, other
#' output formats will ignore all `tab_style()` calls). Using the aforementioned
#' helper functions, here are some of the styles we can apply:
#'
#' - the background color of the cell ([cell_fill()]: `color`)
#' - the cell's text color, font, and size ([cell_text()]: `color`, `font`,
#' `size`)
#' - the text style ([cell_text()]: `style`), enabling the use of italics or
#' oblique text.
#' - the text weight ([cell_text()]: `weight`), allowing the use of thin to
#' bold text (the degree of choice is greater with variable fonts)
#' - the alignment and indentation of text ([cell_text()]: `align` and
#' `indent`)
#' - the cell borders ([cell_borders()])
#'
#' @inheritParams fmt_number
#' @param style a vector of styles to use. The [cell_text()], [cell_fill()], and
#' [cell_borders()] helper functions can be used here to more easily generate
#' valid styles. If using more than one helper function to define styles, all
#' calls must be enclosed in a [list()]. Custom CSS declarations can be used
#' for HTML output by including a [css()]-based statement as a list item.
#' @param locations the cell or set of cells to be associated with the style.
#' Supplying any of the `cells_*()` helper functions is a useful way to target
#' the location cells that are associated with the styling. These helper
#' functions are: [cells_title()], [cells_stubhead()],
#' [cells_column_spanners()], [cells_column_labels()], [cells_row_groups()],
#' [cells_stub()], [cells_body()], [cells_summary()], [cells_grand_summary()],
#' [cells_stub_summary()], [cells_stub_grand_summary()], [cells_footnotes()],
#' and [cells_source_notes()]. Additionally, we can enclose several
#' `cells_*()` calls within a `list()` if we wish to apply styling to
#' different types of locations (e.g., body cells, row group labels, the table
#' title, etc.).
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`exibble`] to create a **gt** table. Add styles that are to be applied
#' to data cells that satisfy a condition (using `tab_style()`).
#'
#' ```r
#' exibble %>%
#' dplyr::select(num, currency) %>%
#' gt() %>%
#' fmt_number(
#' columns = c(num, currency),
#' decimals = 1
#' ) %>%
#' tab_style(
#' style = list(
#' cell_fill(color = "lightcyan"),
#' cell_text(weight = "bold")
#' ),
#' locations = cells_body(
#' columns = num,
#' rows = num >= 5000
#' )
#' ) %>%
#' tab_style(
#' style = list(
#' cell_fill(color = "#F9E3D6"),
#' cell_text(style = "italic")
#' ),
#' locations = cells_body(
#' columns = currency,
#' rows = currency < 100
#' )
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_style_1.png")`
#' }}
#'
#' Use [`sp500`] to create a **gt** table. Color entire rows of cells based on
#' values in a particular column.
#'
#' ```r
#' sp500 %>%
#' dplyr::filter(
#' date >= "2015-12-01" &
#' date <= "2015-12-15"
#' ) %>%
#' dplyr::select(-c(adj_close, volume)) %>%
#' gt() %>%
#' tab_style(
#' style = cell_fill(color = "lightgreen"),
#' locations = cells_body(rows = close > open)
#' ) %>%
#' tab_style(
#' style = list(
#' cell_fill(color = "red"),
#' cell_text(color = "white")
#' ),
#' locations = cells_body(rows = open > close)
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_style_2.png")`
#' }}
#'
#' Use [`exibble`] to create a **gt** table. Replace missing values with the
#' [sub_missing()] function and then add styling to the `char` column with
#' [cell_fill()] and with a CSS style declaration.
#'
#' ```r
#' exibble %>%
#' dplyr::select(char, fctr) %>%
#' gt() %>%
#' sub_missing() %>%
#' tab_style(
#' style = list(
#' cell_fill(color = "lightcyan"),
#' "font-variant: small-caps;"
#' ),
#' locations = cells_body(columns = char)
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_style_3.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-10
#'
#' @seealso [cell_text()], [cell_fill()], and [cell_borders()] as helpers for
#' defining custom styles and [cells_body()] as one of many useful helper
#' functions for targeting the locations to be styled.
#'
#' @export
tab_style <- function(
data,
style,
locations
) {
# Perform input object validation
stop_if_not_gt(data = data)
# Upgrade `style` to be within a list if not provided as such
if (inherits(style, "cell_styles")) {
style <- list(style)
}
# Determine if there is a `cell_text` list within the main list;
# because we need to intercept any provided `font` inputs in `cell_text`
# this is the first thing we need to know
has_cell_text <- "cell_text" %in% names(unlist(style, recursive = FALSE))
# If the `cell_text` list is present we now need to determine if there
# is indeed a `font` input within that list
if (has_cell_text) {
# The `style` list will itself contain several lists and it's
# important to identify which one represents `cell_text`
for (i in seq_along(style)) {
if ("cell_text" %in% names(style[[i]])) {
cell_text_idx <- i
}
}
# If the `cell_text` list contains a `font` input then intercept
# the font styles that require registration
if ("font" %in% names(style[[cell_text_idx]][["cell_text"]])) {
font <- style[[cell_text_idx]][["cell_text"]][["font"]]
font <- normalize_font_input(font_input = font)
existing_additional_css <-
dt_options_get_value(
data = data,
option = "table_additional_css"
)
additional_css <- c(font$import_stmt, existing_additional_css)
data <-
tab_options(
data = data,
table.additional_css = additional_css
)
style[[cell_text_idx]][["cell_text"]][["font"]] <-
as_css_font_family_attr(
font_vec = font$name,
value_only = TRUE
)
}
}
# Resolve into a list of locations
locations <- as_locations(locations)
style <- as_style(style = style)
# Resolve the locations of the targeted data cells and append
# the format directives
for (loc in locations) {
data <-
set_style(
loc = loc,
data = data,
style = style
)
}
data
}
as_style <- function(style) {
# If style rules are part of a list, paste each of the list
# components together
if (!inherits(style, "cell_styles")) {
# Initialize an empty list that will be
# populated with normalized style declarations
final_style <- list()
for (i in seq(style)) {
style_item <- style[[i]]
if (inherits(style_item, "character")) {
style_item <- list(cell_style = style_item)
} else if (!inherits(style_item, "cell_styles")) {
cli::cli_abort(c(
"All provided styles should be generated by stylizing
helper functions.",
"*" = "Style with index `{i}` is invalid."
))
}
final_style <- utils::modifyList(final_style, style_item)
}
class(final_style) <- "cell_styles"
style <- final_style
}
style
}
set_style <- function(loc, data, style) {
UseMethod("set_style")
}
set_style.cells_title <- function(loc, data, style) {
title_components <- rlang::eval_tidy(loc$groups)
if ("title" %in% title_components) {
data <-
dt_styles_add(
data = data,
locname = "title",
grpname = NA_character_,
colname = NA_character_,
locnum = 1,
rownum = NA_integer_,
styles = style
)
}
if ("subtitle" %in% title_components) {
data <-
dt_styles_add(
data = data,
locname = "subtitle",
grpname = NA_character_,
colname = NA_character_,
locnum = 2,
rownum = NA_integer_,
styles = style
)
}
data
}
set_style.cells_stubhead <- function(loc, data, style) {
data <-
dt_styles_add(
data = data,
locname = loc$groups,
grpname = NA_character_,
colname = NA_character_,
locnum = 2.5,
rownum = NA_integer_,
styles = style
)
data
}
set_style.cells_column_labels <- function(loc, data, style) {
resolved <- resolve_cells_column_labels(data = data, object = loc)
cols <- resolved$columns
colnames <- names(cols)
data <-
dt_styles_add(
data = data,
locname = "columns_columns",
grpname = NA_character_,
colname = colnames,
locnum = 4,
rownum = NA_integer_,
styles = style
)
data
}
set_style.cells_column_spanners <- function(loc, data, style) {
resolved <- resolve_cells_column_spanners(data = data, object = loc)
groups <- resolved$spanners
data <-
dt_styles_add(
data = data,
locname = "columns_groups",
grpname = groups,
colname = NA_character_,
locnum = 3,
rownum = NA_integer_,
styles = style
)
data
}
set_style.cells_row_groups <- function(loc, data, style) {
row_groups <- dt_row_groups_get(data = data)
# Resolve row groups
resolved_row_groups_idx <-
resolve_vector_i(
expr = !!loc$groups,
vector = row_groups,
item_label = "row group"
)
groups <- row_groups[resolved_row_groups_idx]
data <-
dt_styles_add(
data = data,
locname = "row_groups",
grpname = groups,
colname = NA_character_,
locnum = 5,
rownum = NA_integer_,
styles = style
)
data
}
set_style.cells_body <- function(loc, data, style) {
resolved <- resolve_cells_body(data = data, object = loc)
rows <- resolved$rows
colnames <- resolved$colnames
data <-
dt_styles_add(
data = data,
locname = "data",
grpname = NA_character_,
colname = colnames,
locnum = 5,
rownum = rows,
styles = style
)
data
}
set_style.cells_stub <- function(loc, data, style) {
resolved <- resolve_cells_stub(data = data, object = loc)
rows <- resolved$rows
data <-
dt_styles_add(
data = data,
locname = "stub",
grpname = NA_character_,
colname = NA_character_,
locnum = 5,
rownum = rows,
styles = style
)
data
}
set_style.cells_summary <- function(loc, data, style) {
add_summary_location_row(
loc = loc,
data = data,
style = style,
df_type = "styles_df"
)
}
set_style.cells_grand_summary <- function(loc, data, style) {
add_grand_summary_location_row(
loc = loc,
data = data,
style = style,
df_type = "styles_df"
)
}
set_style.cells_stub_summary <- function(loc, data, style) {
add_summary_location_row(
loc = loc,
data = data,
style = style,
df_type = "styles_df"
)
}
set_style.cells_stub_grand_summary <- function(loc, data, style) {
add_grand_summary_location_row(
loc = loc,
data = data,
style = style,
df_type = "styles_df"
)
}
set_style.cells_footnotes <- function(loc, data, style) {
data <-
dt_styles_add(
data = data,
locname = "footnotes",
grpname = NA_character_,
colname = NA_character_,
locnum = 7,
rownum = NA_integer_,
styles = style
)
}
set_style.cells_source_notes <- function(loc, data, style) {
data <-
dt_styles_add(
data = data,
locname = "source_notes",
grpname = NA_character_,
colname = NA_character_,
locnum = 8,
rownum = NA_integer_,
styles = style
)
}
#' Modify the table output options
#'
#' @description
#' Modify the options available in a table. These options are named by the
#' components, the subcomponents, and the element that can adjusted.
#'
#' @inheritParams fmt_number
#' @param container.width,container.height,container.padding.x,container.padding.y
#' The width and height of the table's container, and, the vertical and
#' horizontal padding of the table's container. The container width and height
#' can be specified with units of pixels or as a percentage. The padding is to
#' be specified as a length with units of pixels. If provided as a numeric
#' value, it is assumed that the value is given in units of pixels. The [px()]
#' and [pct()] helper functions can also be used to pass in numeric values and
#' obtain values as pixel or percent units.
#' @param container.overflow.x,container.overflow.y Options to enable scrolling
#' in the horizontal and vertical directions when the table content overflows
#' the container dimensions. Using `TRUE` (the default for both) means that
#' horizontal or vertical scrolling is enabled to view the entire table in
#' those directions. With `FALSE`, the table may be clipped if the table width
#' or height exceeds the `container.width` or `container.height`.
#' @param table.width The width of the table. Can be specified as a
#' single-length character with units of pixels or as a percentage. If
#' provided as a single-length numeric vector, it is assumed that the value is
#' given in units of pixels. The [px()] and [pct()] helper functions can also
#' be used to pass in numeric values and obtain values as pixel or percent
#' units.
#' @param table.layout The value for the `table-layout` CSS style in the HTML
#' output context. By default, this is `"fixed"` but another valid option is
#' `"auto"`.
#' @param table.align The horizontal alignment of the table in its container. By
#' default, this is `"center"`. Other options are `"left"` and `"right"`. This
#' will automatically set `table.margin.left` and `table.margin.right` to the
#' appropriate values.
#' @param table.margin.left,table.margin.right The size of the margins on the
#' left and right of the table within the container. Can be specified as a
#' single-length character with units of pixels or as a percentage. If
#' provided as a single-length numeric vector, it is assumed that the value is
#' given in units of pixels. The [px()] and [pct()] helper functions can also
#' be used to pass in numeric values and obtain values as pixel or percent
#' units. Using `table.margin.left` or `table.margin.right` will overwrite any
#' values set by `table.align`.
#' @param table.background.color,heading.background.color,column_labels.background.color,row_group.background.color,stub.background.color,summary_row.background.color,grand_summary_row.background.color,footnotes.background.color,source_notes.background.color
#' Background colors for the parent element `table` and the following child
#' elements: `heading`, `column_labels`, `row_group`, `stub`, `summary_row`,
#' `grand_summary_row`, `footnotes`, and `source_notes`. A color name or a
#' hexadecimal color code should be provided.
#' @param table.additional_css This option can be used to supply an additional
#' block of CSS rules to be applied after the automatically generated table
#' CSS.
#' @param table.font.names The names of the fonts used for the table. This is
#' a vector of several font names. If the first font isn't available, then
#' the next font is tried (and so on).
#' @param table.font.style The font style for the table. Can be one of either
#' `"normal"`, `"italic"`, or `"oblique"`.
#' @param table.font.color,table.font.color.light
#' The text color used throughout the table. There are two variants:
#' `table.font.color` is for text overlaid on lighter background colors, and
#' `table.font.color.light` is automatically used when text needs to be
#' overlaid on darker background colors. A color name or a hexadecimal color
#' code should be provided.
#' @param table.font.size,heading.title.font.size,heading.subtitle.font.size,column_labels.font.size,row_group.font.size,stub.font.size,footnotes.font.size,source_notes.font.size
#' The font sizes for the parent text element `table` and the following child
#' elements: `heading.title`, `heading.subtitle`, `column_labels`,
#' `row_group`, `footnotes`, and `source_notes`. Can be specified as a
#' single-length character vector with units of pixels (e.g., `12px`) or as a
#' percentage (e.g., `80\%`). If provided as a single-length numeric vector,
#' it is assumed that the value is given in units of pixels. The [px()] and
#' [pct()] helper functions can also be used to pass in numeric values and
#' obtain values as pixel or percentage units.
#' @param heading.align Controls the horizontal alignment of the heading title
#' and subtitle. We can either use `"center"`, `"left"`, or `"right"`.
#' @param table.font.weight,heading.title.font.weight,heading.subtitle.font.weight,column_labels.font.weight,row_group.font.weight,stub.font.weight
#' The font weights of the table, `heading.title`, `heading.subtitle`,
#' `column_labels`, `row_group`, and `stub` text elements. Can be a text-based
#' keyword such as `"normal"`, `"bold"`, `"lighter"`, `"bolder"`, or, a
#' numeric value between `1` and `1000`, inclusive. Note that only variable
#' fonts may support the numeric mapping of weight.
#' @param column_labels.text_transform,row_group.text_transform,stub.text_transform,summary_row.text_transform,grand_summary_row.text_transform
#' Options to apply text transformations to the `column_labels`, `row_group`,
#' `stub`, `summary_row`, and `grand_summary_row` text elements. Either of the
#' `"uppercase"`, `"lowercase"`, or `"capitalize"` keywords can be used.
#' @param heading.padding,column_labels.padding,data_row.padding,row_group.padding,summary_row.padding,grand_summary_row.padding,footnotes.padding,source_notes.padding
#' The amount of vertical padding to incorporate in the `heading` (title and
#' subtitle), the `column_labels` (this includes the column spanners), the row
#' group labels (`row_group.padding`), in the body/stub rows
#' (`data_row.padding`), in summary rows (`summary_row.padding` or
#' `grand_summary_row.padding`), or in the footnotes and source notes
#' (`footnotes.padding` and `source_notes.padding`).
#' @param heading.padding.horizontal,column_labels.padding.horizontal,data_row.padding.horizontal,row_group.padding.horizontal,summary_row.padding.horizontal,grand_summary_row.padding.horizontal,footnotes.padding.horizontal,source_notes.padding.horizontal
#' The amount of horizontal padding to incorporate in the `heading` (title and
#' subtitle), the `column_labels` (this includes the column spanners), the row
#' group labels (`row_group.padding.horizontal`), in the body/stub rows
#' (`data_row.padding`), in summary rows (`summary_row.padding.horizontal` or
#' `grand_summary_row.padding.horizontal`), or in the footnotes and source
#' notes (`footnotes.padding.horizontal` and
#' `source_notes.padding.horizontal`).
#' @param table.border.top.style,table.border.top.width,table.border.top.color,table.border.right.style,table.border.right.width,table.border.right.color,table.border.bottom.style,table.border.bottom.width,table.border.bottom.color,table.border.left.style,table.border.left.width,table.border.left.color
#' The style, width, and color properties of the table's absolute top and
#' absolute bottom borders.
#' @param heading.border.bottom.style,heading.border.bottom.width,heading.border.bottom.color
#' The style, width, and color properties of the header's bottom border. This
#' border shares space with that of the `column_labels` location. If the
#' `width` of this border is larger, then it will be the visible border.
#' @param heading.border.lr.style,heading.border.lr.width,heading.border.lr.color
#' The style, width, and color properties for the left and right borders of
#' the `heading` location.
#' @param column_labels.vlines.style,column_labels.vlines.width,column_labels.vlines.color
#' The style, width, and color properties for all vertical lines ('vlines')
#' of the the `column_labels`.
#' @param column_labels.border.top.style,column_labels.border.top.width,column_labels.border.top.color
#' The style, width, and color properties for the top border of the
#' `column_labels` location. This border shares space with that of the
#' `heading` location. If the `width` of this border is larger, then it will
#' be the visible border.
#' @param column_labels.border.bottom.style,column_labels.border.bottom.width,column_labels.border.bottom.color
#' The style, width, and color properties for the bottom border of the
#' `column_labels` location.
#' @param column_labels.border.lr.style,column_labels.border.lr.width,column_labels.border.lr.color
#' The style, width, and color properties for the left and right borders of
#' the `column_labels` location.
#' @param column_labels.hidden An option to hide the column labels. If providing
#' `TRUE` then the entire `column_labels` location won't be seen and the table
#' header (if present) will collapse downward.
#' @param row_group.border.top.style,row_group.border.top.width,row_group.border.top.color,row_group.border.bottom.style,row_group.border.bottom.width,row_group.border.bottom.color,row_group.border.left.style,row_group.border.left.width,row_group.border.left.color,row_group.border.right.style,row_group.border.right.width,row_group.border.right.color
#' The style, width, and color properties for all top, bottom, left, and right
#' borders of the `row_group` location.
#' @param table_body.hlines.style,table_body.hlines.width,table_body.hlines.color,table_body.vlines.style,table_body.vlines.width,table_body.vlines.color
#' The style, width, and color properties for all horizontal lines ('hlines')
#' and vertical lines ('vlines') in the `table_body`.
#' @param table_body.border.top.style,table_body.border.top.width,table_body.border.top.color,table_body.border.bottom.style,table_body.border.bottom.width,table_body.border.bottom.color
#' The style, width, and color properties for all top and bottom borders of
#' the `table_body` location.
#' @param stub.border.style,stub.border.width,stub.border.color
#' The style, width, and color properties for the vertical border of the table
#' stub.
#' @param stub_row_group.font.size,stub_row_group.font.weight,stub_row_group.text_transform,stub_row_group.border.style,stub_row_group.border.width,stub_row_group.border.color
#' Options for the row group column in the stub (made possible when using
#' `row_group.as_column = TRUE`). The defaults for these options mirror that
#' of the `stub.*` variants (except for `stub_row_group.border.width`, which
#' is `"1px"` instead of `"2px"`).
#' @param row_group.default_label An option to set a default row group label for
#' any rows not formally placed in a row group named by `group` in any call of
#' `tab_row_group()`. If this is set as `NA_character` and there are rows that
#' haven't been placed into a row group (where one or more row groups already
#' exist), those rows will be automatically placed into a row group without a
#' label.
#' @param row_group.as_column How should row groups be structured? By default,
#' they are separate rows that lie above the each of the groups. Setting this
#' to `TRUE` will structure row group labels are columns to the far left of
#' the table.
#' @param stub.indent_length The width of each indentation level. By default
#' this is `"5px"`.
#' @param summary_row.border.style,summary_row.border.width,summary_row.border.color
#' The style, width, and color properties for all horizontal borders of the
#' `summary_row` location.
#' @param grand_summary_row.border.style,grand_summary_row.border.width,grand_summary_row.border.color
#' The style, width, and color properties for the top borders of the
#' `grand_summary_row` location.
#' @param footnotes.border.bottom.style,footnotes.border.bottom.width,footnotes.border.bottom.color
#' The style, width, and color properties for the bottom border of the
#' `footnotes` location.
#' @param footnotes.border.lr.style,footnotes.border.lr.width,footnotes.border.lr.color
#' The style, width, and color properties for the left and right borders of
#' the `footnotes` location.
#' @param footnotes.marks The set of sequential marks used to reference and
#' identify each of the footnotes (same input as the [opt_footnote_marks()]
#' function. We can supply a vector that represents the series of footnote
#' marks. This vector is recycled when its usage goes beyond the length of the
#' set. At each cycle, the marks are simply combined (e.g., `*` -> `**` ->
#' `***`). The option exists for providing keywords for certain types of
#' footnote marks. The keyword `"numbers"` (the default, indicating that we
#' want to use numeric marks). We can use lowercase `"letters"` or uppercase
#' `"LETTERS"`. There is the option for using a traditional symbol set where
#' `"standard"` provides four symbols, and, `"extended"` adds two more
#' symbols, making six.
#' @param footnotes.multiline,source_notes.multiline An option to either put
#' footnotes and source notes in separate lines (the default, or `TRUE`) or
#' render them as a continuous line of text with `footnotes.sep` providing the
#' separator (by default `" "`) between notes.
#' @param footnotes.sep,source_notes.sep The separating characters between
#' adjacent footnotes and source notes in their respective footer sections
#' when rendered as a continuous line of text (when
#' `footnotes.multiline == FALSE`). The default value is a single space
#' character (`" "`).
#' @param source_notes.border.bottom.style,source_notes.border.bottom.width,source_notes.border.bottom.color
#' The style, width, and color properties for the bottom border of the
#' `source_notes` location.
#' @param source_notes.border.lr.style,source_notes.border.lr.width,source_notes.border.lr.color
#' The style, width, and color properties for the left and right borders of
#' the `source_notes` location.
#' @param row.striping.background_color The background color for striped table
#' body rows. A color name or a hexadecimal color code should be provided.
#' @param row.striping.include_stub An option for whether to include the stub
#' when striping rows.
#' @param row.striping.include_table_body An option for whether to include the
#' table body when striping rows.
#' @param page.orientation For RTF output, this provides an two options for page
#' orientation: `"portrait"` (the default) and `"landscape"`.
#' @param page.numbering Within RTF output, should page numbering be displayed?
#' By default, this is set to `FALSE` but if `TRUE` then page numbering text
#' will be added to the document header.
#' @param page.header.use_tbl_headings If `TRUE` then RTF output tables will
#' migrate all table headings (including the table title and all column
#' labels) to the page header. This page header content will repeat across
#' pages. By default, this is `FALSE`.
#' @param page.footer.use_tbl_notes If `TRUE` then RTF output tables will
#' migrate all table footer content (this includes footnotes and source notes)
#' to the page footer. This page footer content will repeat across pages. By
#' default, this is `FALSE`.
#' @param page.width,page.height The page width and height in the standard
#' portrait orientation. This is for RTF table output and the default
#' values (in inches) are `8.5in` and `11.0in`.
#' @param page.margin.left,page.margin.right,page.margin.top,page.margin.bottom
#' For RTF table output, these options correspond to the left, right, top, and
#' bottom page margins. The default values for each of these is `1.0in`.
#' @param page.header.height,page.footer.height The heights of the page header
#' and footer for RTF table outputs. Default values for both are `0.5in`.
#'
#' @return An object of class `gt_tbl`.
#'
#' @section Examples:
#'
#' Use [`exibble`] to create a **gt** table with all the main parts added. We
#' can use this **gt** object going forward to demo some of what's available in
#' the `tab_options()` function.
#'
#' ```r
#' tab_1 <-
#' exibble %>%
#' dplyr::select(-c(fctr, date, time, datetime)) %>%
#' gt(
#' rowname_col = "row",
#' groupname_col = "group"
#' ) %>%
#' tab_header(
#' title = md("Data listing from **exibble**"),
#' subtitle = md("`exibble` is an R dataset")
#' ) %>%
#' fmt_number(columns = num) %>%
#' fmt_currency(columns = currency) %>%
#' tab_footnote(
#' footnote = "Using commas for separators.",
#' locations = cells_body(
#' columns = num,
#' rows = num > 1000
#' )
#' ) %>%
#' tab_footnote(
#' footnote = "Using commas for separators.",
#' locations = cells_body(
#' columns = currency,
#' rows = currency > 1000
#' )
#' ) %>%
#' tab_footnote(
#' footnote = "Alphabetical fruit.",
#' locations = cells_column_labels(columns = char)
#' )
#'
#' tab_1
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_1.png")`
#' }}
#'
#' Modify the table width to be 100% (which spans the entire content width
#' area).
#'
#' ```r
#' tab_1 %>% tab_options(table.width = pct(100))
#' ```
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_2.png")`
#' }}
#'
#' Modify the table's background color to be `"lightcyan"`.
#'
#' ```r
#' tab_1 %>% tab_options(table.background.color = "lightcyan")
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_3.png")`
#' }}
#'
#' Use letters as the marks for footnote references. Also, separate footnotes in
#' the footer by spaces instead of newlines.
#'
#' ```r
#' tab_1 %>%
#' tab_options(
#' footnotes.marks = letters,
#' footnotes.multiline = FALSE
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_4.png")`
#' }}
#'
#' Change the padding of data rows to 5 px.
#'
#' ```r
#' tab_1 %>%
#' tab_options(
#' data_row.padding = px(5)
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_5.png")`
#' }}
#'
#' Reduce the size of the title and the subtitle text.
#'
#' ```r
#' tab_1 %>%
#' tab_options(
#' heading.title.font.size = "small",
#' heading.subtitle.font.size = "small"
#' )
#' ```
#'
#' \if{html}{\out{
#' `r man_get_image_tag(file = "man_tab_options_6.png")`
#' }}
#'
#' @family part creation/modification functions
#' @section Function ID:
#' 2-12
#'
#' @export
tab_options <- function(
data,
container.width = NULL,
container.height = NULL,
container.padding.x = NULL,
container.padding.y = NULL,
container.overflow.x = NULL,
container.overflow.y = NULL,
table.width = NULL,
table.layout = NULL,
table.align = NULL,
table.margin.left = NULL,
table.margin.right = NULL,
table.background.color = NULL,
table.additional_css = NULL,
table.font.names = NULL,
table.font.size = NULL,
table.font.weight = NULL,
table.font.style = NULL,
table.font.color = NULL,
table.font.color.light = NULL,
table.border.top.style = NULL,
table.border.top.width = NULL,
table.border.top.color = NULL,
table.border.right.style = NULL,
table.border.right.width = NULL,
table.border.right.color = NULL,
table.border.bottom.style = NULL,
table.border.bottom.width = NULL,
table.border.bottom.color = NULL,
table.border.left.style = NULL,
table.border.left.width = NULL,
table.border.left.color = NULL,
heading.background.color = NULL,
heading.align = NULL,
heading.title.font.size = NULL,
heading.title.font.weight = NULL,
heading.subtitle.font.size = NULL,
heading.subtitle.font.weight = NULL,
heading.padding = NULL,
heading.padding.horizontal = NULL,
heading.border.bottom.style = NULL,
heading.border.bottom.width = NULL,
heading.border.bottom.color = NULL,
heading.border.lr.style = NULL,
heading.border.lr.width = NULL,
heading.border.lr.color = NULL,
column_labels.background.color = NULL,
column_labels.font.size = NULL,
column_labels.font.weight = NULL,
column_labels.text_transform = NULL,
column_labels.padding = NULL,
column_labels.padding.horizontal = NULL,
column_labels.vlines.style = NULL,
column_labels.vlines.width = NULL,
column_labels.vlines.color = NULL,
column_labels.border.top.style = NULL,
column_labels.border.top.width = NULL,
column_labels.border.top.color = NULL,
column_labels.border.bottom.style = NULL,
column_labels.border.bottom.width = NULL,
column_labels.border.bottom.color = NULL,
column_labels.border.lr.style = NULL,
column_labels.border.lr.width = NULL,
column_labels.border.lr.color = NULL,
column_labels.hidden = NULL,
row_group.background.color = NULL,
row_group.font.size = NULL,
row_group.font.weight = NULL,
row_group.text_transform = NULL,
row_group.padding = NULL,
row_group.padding.horizontal = NULL,
row_group.border.top.style = NULL,
row_group.border.top.width = NULL,
row_group.border.top.color = NULL,
row_group.border.bottom.style = NULL,
row_group.border.bottom.width = NULL,
row_group.border.bottom.color = NULL,
row_group.border.left.style = NULL,
row_group.border.left.width = NULL,
row_group.border.left.color = NULL,
row_group.border.right.style = NULL,
row_group.border.right.width = NULL,
row_group.border.right.color = NULL,
row_group.default_label = NULL,
row_group.as_column = NULL,
table_body.hlines.style = NULL,
table_body.hlines.width = NULL,
table_body.hlines.color = NULL,
table_body.vlines.style = NULL,
table_body.vlines.width = NULL,
table_body.vlines.color = NULL,
table_body.border.top.style = NULL,
table_body.border.top.width = NULL,
table_body.border.top.color = NULL,
table_body.border.bottom.style = NULL,
table_body.border.bottom.width = NULL,
table_body.border.bottom.color = NULL,
stub.background.color = NULL,
stub.font.size = NULL,
stub.font.weight = NULL,
stub.text_transform = NULL,
stub.border.style = NULL,
stub.border.width = NULL,
stub.border.color = NULL,
stub.indent_length = NULL,
stub_row_group.font.size = NULL,
stub_row_group.font.weight = NULL,
stub_row_group.text_transform = NULL,
stub_row_group.border.style = NULL,
stub_row_group.border.width = NULL,
stub_row_group.border.color = NULL,
data_row.padding = NULL,
data_row.padding.horizontal = NULL,
summary_row.background.color = NULL,
summary_row.text_transform = NULL,
summary_row.padding = NULL,
summary_row.padding.horizontal = NULL,
summary_row.border.style = NULL,
summary_row.border.width = NULL,
summary_row.border.color = NULL,
grand_summary_row.background.color = NULL,
grand_summary_row.text_transform = NULL,
grand_summary_row.padding = NULL,
grand_summary_row.padding.horizontal = NULL,
grand_summary_row.border.style = NULL,
grand_summary_row.border.width = NULL,
grand_summary_row.border.color = NULL,
footnotes.background.color = NULL,
footnotes.font.size = NULL,
footnotes.padding = NULL,
footnotes.padding.horizontal = NULL,
footnotes.border.bottom.style = NULL,
footnotes.border.bottom.width = NULL,
footnotes.border.bottom.color = NULL,
footnotes.border.lr.style = NULL,
footnotes.border.lr.width = NULL,
footnotes.border.lr.color = NULL,
footnotes.marks = NULL,
footnotes.multiline = NULL,
footnotes.sep = NULL,
source_notes.background.color = NULL,
source_notes.font.size = NULL,
source_notes.padding = NULL,
source_notes.padding.horizontal = NULL,
source_notes.border.bottom.style = NULL,
source_notes.border.bottom.width = NULL,
source_notes.border.bottom.color = NULL,
source_notes.border.lr.style = NULL,
source_notes.border.lr.width = NULL,
source_notes.border.lr.color = NULL,
source_notes.multiline = NULL,
source_notes.sep = NULL,
row.striping.background_color = NULL,
row.striping.include_stub = NULL,
row.striping.include_table_body = NULL,
page.orientation = NULL,
page.numbering = NULL,
page.header.use_tbl_headings = NULL,
page.footer.use_tbl_notes = NULL,
page.width = NULL,
page.height = NULL,
page.margin.left = NULL,
page.margin.right = NULL,
page.margin.top = NULL,
page.margin.bottom = NULL,
page.header.height = NULL,
page.footer.height = NULL
) {
# Perform input object validation
stop_if_not_gt(data = data)
# Extract the options table from `data`
opts_df <- dt_options_get(data = data)
arg_names <- base::setdiff(names(formals(tab_options)), "data")
arg_vals <- mget(arg_names)
arg_vals <- arg_vals[!vapply(arg_vals, FUN = is.null, FUN.VALUE = logical(1))]
arg_vals <- set_super_options(arg_vals = arg_vals)
new_df <-
dplyr::tibble(
parameter = tidy_gsub(names(arg_vals), ".", "_", fixed = TRUE),
value = unname(arg_vals)
) %>%
dplyr::left_join(
dplyr::select(opts_df, parameter, type),
by = "parameter"
) %>%
dplyr::mutate(
value = mapply(
preprocess_tab_option,
option = value, var_name = parameter, type = type,
SIMPLIFY = FALSE
)
) %>%
dplyr::select(-type)
# This rearranges the rows in the `opts_df` table, but this
# shouldn't be a problem
opts_df <-
dplyr::bind_rows(
dplyr::inner_join(
new_df,
dplyr::select(opts_df, -value),
by = "parameter"
),
dplyr::anti_join(opts_df, new_df, by = "parameter")
)
# Write the modified options table back to `data`
dt_options_set(data = data, options = opts_df)
}
preprocess_tab_option <- function(option, var_name, type) {
# Perform pre-processing on the option depending on `type`
option <-
switch(
type,
overflow = {
if (isTRUE(option)) {
"auto"
} else if (is_false(option)) {
"hidden"
} else {
option
}
},
px = {
if (is.numeric(option)) {
px(option)
} else {
option
}
},
option
)
# Perform `stopifnot()` checks by `type`
switch(
type,
logical = stopifnot(rlang::is_scalar_logical(option), !any(is.na(option))),
overflow = ,
px = ,
value = stopifnot(rlang::is_scalar_character(option), !any(is.na(option))),
values = stopifnot(rlang::is_character(option), length(option) >= 1, !any(is.na(option)))
)
option
}
set_super_options <- function(arg_vals) {
if ("table.align" %in% names(arg_vals)) {
table_align_val <- arg_vals$table.align
arg_vals$table.align <- NULL
if (!(table_align_val %in% c("left", "center", "right"))) {
cli::cli_abort(c(
"The chosen option for `table.align` (`{table_align_val}`) is invalid.",
"*" = "We can use either of \"left\", \"center\", or \"right\"."
))
}
arg_vals$table.margin.left <-
arg_vals$table.margin.left %||%
switch(
table_align_val,
center = "auto",
left = "0",
right = "auto"
)
arg_vals$table.margin.right <-
arg_vals$table.margin.right %||%
switch(
table_align_val,
center = "auto",
left = "auto",
right = "0"
)
}
arg_vals
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.