diff --git a/DESCRIPTION b/DESCRIPTION index 6a395e4f68..9cc0588382 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,8 @@ Imports: scales (>= 1.1.0), stringr (>= 1.3.1), tibble (>= 3.0.0), - tidyselect (>= 1.0.0) + tidyselect (>= 1.0.0), + vctrs Suggests: covr, knitr, @@ -100,6 +101,7 @@ Collate: 'render_as_html.R' 'resolver.R' 'shiny.R' + 'spec.R' 'summary_rows.R' 'text_transform.R' 'utils.R' @@ -111,4 +113,6 @@ Collate: 'utils_render_html.R' 'utils_render_latex.R' 'utils_render_rtf.R' + 'utils_spec.R' + 'vctrs.R' 'zzz.R' diff --git a/NAMESPACE b/NAMESPACE index 193d632d12..06a7c459d0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ # Generated by roxygen2: do not edit by hand S3method(as.data.frame,gt_tbl) +S3method(obj_print_header,gt_vctr) +S3method(print,gt_spec) S3method(print,gt_tbl) S3method(print,rtf_text) export("%>%") @@ -67,6 +69,8 @@ export(gt) export(gt_latex_dependencies) export(gt_output) export(gt_preview) +export(gt_spec_number) +export(gt_vctr) export(gtsave) export(html) export(info_currencies) @@ -109,6 +113,7 @@ export(text_transform) export(vars) export(web_image) import(rlang) +import(vctrs) importFrom(dplyr,vars) importFrom(ggplot2,ggsave) importFrom(htmltools,css) diff --git a/R/format_data.R b/R/format_data.R index 03526fc22f..011e2977b1 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -168,17 +168,6 @@ fmt_number <- function(data, # Perform input object validation stop_if_not_gt(data = data) - # Use locale-based marks if a locale ID is provided - sep_mark <- get_locale_sep_mark(locale, sep_mark, use_seps) - dec_mark <- get_locale_dec_mark(locale, dec_mark) - - # Stop function if `locale` does not have a valid value - validate_locale(locale) - - # Normalize the `suffixing` input to either return a character vector - # of suffix labels, or NULL (the case where `suffixing` is FALSE) - suffix_labels <- normalize_suffixing_inputs(suffixing, scale_by) - # Stop function if any columns have data that is incompatible # with this formatter if ( @@ -195,75 +184,26 @@ fmt_number <- function(data, ) } - # Set the `formatC_format` option according to whether number - # formatting with significant figures is to be performed - if (!is.null(n_sigfig)) { - - # Stop function if `n_sigfig` does not have a valid value - validate_n_sigfig(n_sigfig) - - formatC_format <- "fg" - } else { - formatC_format <- "f" - } - # Pass `data`, `columns`, `rows`, and the formatting # functions as a function list to `fmt()` fmt( data = data, columns = {{ columns }}, rows = {{ rows }}, - fns = num_fmt_factory_multi( + fns = gt_spec_number( + decimals = decimals, + n_sigfig = n_sigfig, + drop_trailing_zeros = drop_trailing_zeros, + drop_trailing_dec_mark = drop_trailing_dec_mark, + use_seps = use_seps, + accounting = accounting, + scale_by = scale_by, + suffixing = suffixing, pattern = pattern, - format_fn = function(x, context) { - - # Create the `suffix_df` object - suffix_df <- - create_suffix_df( - x, - decimals = decimals, - suffix_labels = suffix_labels, - scale_by = scale_by - ) - - # Scale the `x` values by the `scale_by` values in `suffix_df` - x <- scale_x_values(x, scale_by = suffix_df$scale_by) - - # Format numeric values to character-based numbers - x_str <- - format_num_to_str( - x, - context = context, - decimals = decimals, - n_sigfig = n_sigfig, - sep_mark = sep_mark, - dec_mark = dec_mark, - drop_trailing_zeros = drop_trailing_zeros, - drop_trailing_dec_mark = drop_trailing_dec_mark, - format = formatC_format - ) - - # Paste the vector of suffixes to the right of the values - x_str <- paste_right(x_str, x_right = suffix_df$suffix) - - # Format values in accounting notation (if `accounting = TRUE`) - x_str <- - format_as_accounting( - x_str, - x = x, - context = context, - accounting = accounting - ) - - # Force a positive sign on certain values if the option is taken - if (!accounting && force_sign) { - - positive_x <- !is.na(x) & x > 0 - x_str[positive_x] <- paste_left(x_str[positive_x], x_left = "+") - } - - x_str - } + sep_mark = sep_mark, + dec_mark = dec_mark, + force_sign = force_sign, + locale = locale ) ) } diff --git a/R/spec.R b/R/spec.R new file mode 100644 index 0000000000..2b6a0260a6 --- /dev/null +++ b/R/spec.R @@ -0,0 +1,97 @@ +#' @rdname fmt_number +#' @export +gt_spec_number <- function(decimals = 2, + n_sigfig = NULL, + drop_trailing_zeros = FALSE, + drop_trailing_dec_mark = TRUE, + use_seps = TRUE, + accounting = FALSE, + scale_by = 1.0, + suffixing = FALSE, + pattern = "{x}", + sep_mark = ",", + dec_mark = ".", + force_sign = FALSE, + locale = NULL) { + + call <- capture_call("gt_spec_number") + + # Use locale-based marks if a locale ID is provided + sep_mark <- get_locale_sep_mark(locale, sep_mark, use_seps) + dec_mark <- get_locale_dec_mark(locale, dec_mark) + + # Stop function if `locale` does not have a valid value + validate_locale(locale) + + # Normalize the `suffixing` input to either return a character vector + # of suffix labels, or NULL (the case where `suffixing` is FALSE) + suffix_labels <- normalize_suffixing_inputs(suffixing, scale_by) + + # Set the `formatC_format` option according to whether number + # formatting with significant figures is to be performed + if (!is.null(n_sigfig)) { + + # Stop function if `n_sigfig` does not have a valid value + validate_n_sigfig(n_sigfig) + + formatC_format <- "fg" + } else { + formatC_format <- "f" + } + + # Return the factory + funs <- num_fmt_factory_multi( + pattern = pattern, + format_fn = function(x, context) { + + # Create the `suffix_df` object + suffix_df <- + create_suffix_df( + x, + decimals = decimals, + suffix_labels = suffix_labels, + scale_by = scale_by + ) + + # Scale the `x` values by the `scale_by` values in `suffix_df` + x <- scale_x_values(x, scale_by = suffix_df$scale_by) + + # Format numeric values to character-based numbers + x_str <- + format_num_to_str( + x, + context = context, + decimals = decimals, + n_sigfig = n_sigfig, + sep_mark = sep_mark, + dec_mark = dec_mark, + drop_trailing_zeros = drop_trailing_zeros, + drop_trailing_dec_mark = drop_trailing_dec_mark, + format = formatC_format + ) + + # Paste the vector of suffixes to the right of the values + x_str <- paste_right(x_str, x_right = suffix_df$suffix) + + # Format values in accounting notation (if `accounting = TRUE`) + x_str <- + format_as_accounting( + x_str, + x = x, + context = context, + accounting = accounting + ) + + # Force a positive sign on certain values if the option is taken + if (!accounting && force_sign) { + + positive_x <- !is.na(x) & x > 0 + x_str[positive_x] <- paste_left(x_str[positive_x], x_left = "+") + } + + x_str + } + ) + + new_gt_spec(funs, call) +} diff --git a/R/utils_spec.R b/R/utils_spec.R new file mode 100644 index 0000000000..1b5a545f61 --- /dev/null +++ b/R/utils_spec.R @@ -0,0 +1,17 @@ +capture_call <- function(name = as.character(sys.call(1))[[1]], fun = sys.function(sys.parent()), env = parent.frame()) { + formals <- formals(fun) + args <- mget(names(formals), env) + + same <- unlist(Map(formals, args, f = identical)) + custom_args <- args[!same] + call2(name, !!!custom_args) +} + +new_gt_spec <- function(funs, call) { + structure(funs, call = call, class = "gt_spec") +} + +#' @export +print.gt_spec <- function(x, ...) { + cat("<", as_label(attr(x, "call")), ">\n", sep = "") +} diff --git a/R/vctrs.R b/R/vctrs.R new file mode 100644 index 0000000000..181e976918 --- /dev/null +++ b/R/vctrs.R @@ -0,0 +1,18 @@ +#' Attach a spec to a vector +#' +#' Use `gt_vctr()` early in your analysis to define the formatting of numbers +#' and other data. +#' The formatting is then picked up automatically by `gt()`. +#' +#' @param x A numeric vector +#' @param spec Created by [gt_spec_number()] and other functions. +#' @import vctrs +#' @export +gt_vctr <- function(x, spec) { + vctrs::new_vctr(x, gt_spec = spec, class = "gt_vctr") +} + +#' @export +obj_print_header.gt_vctr <- function(x, ...) { + print(attr(x, "gt_spec")) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 11652e20e7..0f6cc7bee9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -65,6 +65,17 @@ reference: - text_transform - data_color + - title: Data Format Specifications + desc: > + Each `fmt_*()` function uses a corresponding `gt_spec_*()` function under + the hood. Columns in the raw data can choose their formatting early + using `gt_vctr()` with a data format specification, it will be picked up + automatically by `gt()` and also when such a column is used in a ggplot2 + scale. + contents: + - gt_spec_number + - gt_vctr + - title: Modify Columns desc: > The `cols_*()` functions allow for modifications that act on entire diff --git a/man/fmt_number.Rd b/man/fmt_number.Rd index 5c1ea7af3b..0bdb60a0cb 100644 --- a/man/fmt_number.Rd +++ b/man/fmt_number.Rd @@ -1,7 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/format_data.R +% Please edit documentation in R/format_data.R, R/spec.R \name{fmt_number} \alias{fmt_number} +\alias{gt_spec_number} \title{Format numeric values} \usage{ fmt_number( @@ -22,6 +23,22 @@ fmt_number( force_sign = FALSE, locale = NULL ) + +gt_spec_number( + decimals = 2, + n_sigfig = NULL, + drop_trailing_zeros = FALSE, + drop_trailing_dec_mark = TRUE, + use_seps = TRUE, + accounting = FALSE, + scale_by = 1, + suffixing = FALSE, + pattern = "{x}", + sep_mark = ",", + dec_mark = ".", + force_sign = FALSE, + locale = NULL +) } \arguments{ \item{data}{A table object that is created using the \code{\link[=gt]{gt()}} function.} diff --git a/man/gt_vctr.Rd b/man/gt_vctr.Rd new file mode 100644 index 0000000000..e17e4d65de --- /dev/null +++ b/man/gt_vctr.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vctrs.R +\name{gt_vctr} +\alias{gt_vctr} +\title{Attach a spec to a vector} +\usage{ +gt_vctr(x, spec) +} +\arguments{ +\item{x}{A numeric vector} + +\item{spec}{Created by \code{\link[=gt_spec_number]{gt_spec_number()}} and other functions.} +} +\description{ +Use \code{gt_vctr()} early in your analysis to define the formatting of numbers +and other data. +The formatting is then picked up automatically by \code{gt()}. +}