Merge pull request #912 from rstudio/sub-fns

Add small collection of `sub_*()` functions

Author: rich-iannone

DESCRIPTION

@@ -23,7 +23,7 @@ BugReports: https://github.com/rstudio/gt/issues
 Encoding: UTF-8
 LazyData: true
 ByteCompile: true
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
 Depends:
     R (>= 3.2.0)
 Imports:
@@ -102,6 +102,7 @@ Collate:
     'render_as_html.R'
     'resolver.R'
     'shiny.R'
+    'substitution.R'
     'summary_rows.R'
     'text_transform.R'
     'utils.R'

NAMESPACE

@@ -98,6 +98,10 @@ export(random_id)
 export(render_gt)
 export(row_group_order)
 export(starts_with)
+export(sub_large_vals)
+export(sub_missing)
+export(sub_small_vals)
+export(sub_zero)
 export(summary_rows)
 export(tab_footnote)
 export(tab_header)

R/data_color.R

@@ -128,7 +128,7 @@
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-18
+#' 3-21
 #'
 #' @import rlang
 #' @export

R/dt_formats.R

@@ -12,18 +12,20 @@ dt_formats_set <- function(data, formats) {
 
 dt_formats_init <- function(data) {
 
-  list() %>%
-    dt_formats_set(formats = ., data = data)
+  dt_formats_set(data = data, formats = list())
 }
 
-dt_formats_add <- function(data, formats) {
+dt_formats_add <- function(data, formats, prepend) {
 
-  data %>%
-    dt_formats_get() %>%
-    append(
-      list(formats)
-    ) %>%
-    dt_formats_set(formats = ., data = data)
+  formats_list <- dt_formats_get(data = data)
+
+  if (prepend) {
+    formats <- prepend_vec(list(formats), values = formats_list)
+  } else {
+    formats <- append(list(formats), values = formats_list)
+  }
+
+  dt_formats_set(data = data, formats = formats)
 }
 
 # This function is used in `dt_summary_build()` to get a

R/format_data.R

@@ -1345,10 +1345,7 @@ fmt_partsper <- function(
 #'     accuracy = 10,
 #'     simplify = FALSE
 #'   ) %>%
-#'   fmt_missing(
-#'     columns = everything(),
-#'     missing_text = ""
-#'   ) %>%
+#'   sub_missing(missing_text = "") %>%
 #'   tab_spanner(
 #'     label = "Sold",
 #'     columns = contains("sold")
@@ -2913,7 +2910,7 @@ fmt_passthrough <- function(
 
         x_str
       },
-      latex = function(x) {
+      rtf = function(x) {
 
         # Create `x_str` with same length as `x`
         x_str <- rep(NA_character_, length(x))
@@ -2949,135 +2946,28 @@ fmt_passthrough <- function(
   )
 }
 
-#' Format missing values
-#'
-#' @description
-#' Wherever there is missing data (i.e., `NA` values) a customizable mark may
-#' present better than the standard `NA` text that would otherwise appear. The
-#' `fmt_missing()` function allows for this replacement through its
-#' `missing_text` argument (where an em dash serves as the default).
-#'
-#' @details
-#' Targeting of values is done through `columns` and additionally by `rows` (if
-#' nothing is provided for `rows` then entire columns are selected). Conditional
-#' formatting is possible by providing a conditional expression to the `rows`
-#' argument. See the *Arguments* section for more information on this.
-#'
-#' @inheritParams fmt_number
-#' @param missing_text The text to be used in place of `NA` values in the
-#'   rendered table.
-#'
-#' @return An object of class `gt_tbl`.
-#'
-#' @section Examples:
-#'
-#' Use [`exibble`] to create a **gt** table. The `NA` values in different
-#' columns will be given replacement text.
-#'
-#' ```r
-#' exibble %>%
-#'   dplyr::select(-row, -group) %>%
-#'   gt() %>%
-#'   fmt_missing(
-#'     columns = 1:2,
-#'     missing_text = "missing"
-#'   ) %>%
-#'   fmt_missing(
-#'     columns = 4:7,
-#'     missing_text = "nothing"
-#'   )
-#' ```
-#'
-#' \if{html}{\out{
-#' `r man_get_image_tag(file = "man_fmt_missing_1.png")`
-#' }}
-#'
-#' @family Format Data
-#' @section Function ID:
-#' 3-15
-#'
-#' @import rlang
-#' @export
-fmt_missing <- function(
-    data,
-    columns,
-    rows = everything(),
-    missing_text = "---"
-) {
-
-  # Perform input object validation
-  stop_if_not_gt(data = data)
-
-  # Pass `data`, `columns`, `rows`, and the formatting
-  # functions (as a function list) to `fmt()`
-  fmt(
-    data = data,
-    columns = {{ columns }},
-    rows = {{ rows }},
-    fns = list(
-      html = function(x) {
-
-        missing_text <-
-          context_missing_text(
-            missing_text = missing_text,
-            context = "html"
-          )
-
-        # Any values of `x` that are `NA` get
-        # `missing_text` as output; any values that
-        # are not missing get `NA` as their output
-        # (meaning, the existing output for that
-        # value, if it exists, should be inherited)
-        ifelse(is.na(x), missing_text, NA_character_)
-      },
-      rtf = function(x) {
-
-        missing_text <-
-          context_missing_text(
-            missing_text = missing_text,
-            context = "rtf"
-          )
-
-        # Any values of `x` that are `NA` get
-        # `missing_text` as output; any values that
-        # are not missing get `NA` as their output
-        # (meaning, the existing output for that
-        # value, if it exists, should be inherited)
-        ifelse(is.na(x), missing_text, NA_character_)
-      },
-      default = function(x) {
-
-        # Any values of `x` that are `NA` get
-        # `missing_text` as output; any values that
-        # are not missing get `NA` as their output
-        # (meaning, the existing output for that
-        # value, if it exists, should be inherited)
-        ifelse(is.na(x), missing_text, NA_character_)
-      }
-    )
-  )
-}
-
 #' Set a column format with a formatter function
 #'
 #' @description
-#' The `fmt()` function provides greater control in formatting raw data values
-#' than any of the specialized `fmt_*()` functions that are available in
-#' **gt**. Along with the `columns` and `rows` arguments that provide some
-#' precision in targeting data cells, the `fns` argument allows you to define
-#' one or more functions for manipulating the raw data.
+#' The `fmt()` function provides a way to execute custom formatting
+#' functionality with raw data values in a way that can consider all output
+#' contexts.
+#'
+#' Along with the `columns` and `rows` arguments that provide some precision in
+#' targeting data cells, the `fns` argument allows you to define one or more
+#' functions for manipulating the raw data.
 #'
 #' If providing a single function to `fns`, the recommended format is in the
 #' form: `fns = function(x) ...`. This single function will format the targeted
 #' data cells the same way regardless of the output format (e.g., HTML, LaTeX,
 #' RTF).
 #'
 #' If you require formatting of `x` that depends on the output format, a list of
-#' functions can be provided for the `html`, `latex`, and `default` contexts.
-#' This can be in the form of `fns = list(html = function(x) ..., latex =
-#' function(x) ..., default = function(x) ...)`. In this multiple-function case,
-#' we recommended including the `default` function as a fallback if all contexts
-#' aren't provided.
+#' functions can be provided for the `html`, `latex`, `rtf`, and `default`
+#' contexts. This can be in the form of `fns = list(html = function(x) ...,
+#' latex = function(x) ..., default = function(x) ...)`. In this
+#' multiple-function case, we recommended including the `default` function as a
+#' fallback if all contexts aren't provided.
 #'
 #' @details
 #' As with all of the `fmt_*()` functions, targeting of values is done through
@@ -3088,6 +2978,9 @@ fmt_missing <- function(
 #'
 #' @inheritParams fmt_number
 #' @param fns Either a single formatting function or a named list of functions.
+#' @param prepend Should the formatting function(s) be brought to the beginning
+#' of the formatting queue (`TRUE`) or placed at the end (`FALSE`). By default,
+#' this is `FALSE` and this leads to 'last-one-wins' semantics.
 #'
 #' @return An object of class `gt_tbl`.
 #'
@@ -3114,21 +3007,22 @@ fmt_missing <- function(
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-16
+#' 3-15
 #'
 #' @import rlang
 #' @export
 fmt <- function(
     data,
     columns = everything(),
     rows = everything(),
-    fns
+    fns,
+    prepend = FALSE
 ) {
 
   # Perform input object validation
   stop_if_not_gt(data = data)
 
-  # Get the `stub_df` data frame from `data`
+  # Get the `stub_df` and `data_tbl` tables from `data`
   stub_df <- dt_stub_df_get(data = data)
   data_tbl <- dt_data_get(data = data)
 
@@ -3163,7 +3057,11 @@ fmt <- function(
       rows = resolved_rows_idx
     )
 
-  dt_formats_add(data = data, formats = formatter_list)
+  dt_formats_add(
+    data = data,
+    formats = formatter_list,
+    prepend = prepend
+  )
 }
 
 #' Insert separator marks to an integer to conform to Indian numbering system

R/helpers.R

@@ -787,10 +787,7 @@ cells_group <- function(groups = TRUE) {
 #'   dplyr::filter(!is.na(sza)) %>%
 #'   tidyr::spread(key = "tst", value = sza) %>%
 #'   gt(rowname_col = "month") %>%
-#'   fmt_missing(
-#'     columns = everything(),
-#'     missing_text = ""
-#'   ) %>%
+#'   sub_missing(missing_text = "") %>%
 #'   tab_style(
 #'     style = list(
 #'       cell_fill(color = "darkblue"),
@@ -2234,7 +2231,7 @@ cell_style_structure <- function(name, obj, subclass = name) {
 #' exibble %>%
 #'   dplyr::select(char, time) %>%
 #'   gt() %>%
-#'   fmt_missing(columns = everything()) %>%
+#'   sub_missing() %>%
 #'   tab_style(
 #'     style = cell_text(
 #'       font = c(

R/modify_columns.R

@@ -1024,7 +1024,7 @@ cols_unhide <- function(
 #' merged column (e.g., `NA` + `NA` = `NA`)
 #'
 #' Any resulting `NA` values in the `col_val` column following the merge
-#' operation can be easily formatted using the [fmt_missing()] function.
+#' operation can be easily formatted using the [sub_missing()] function.
 #'
 #' This function is part of a set of four column-merging functions. The other
 #' two are the general [cols_merge()] function and the specialized
@@ -1161,8 +1161,8 @@ cols_merge_uncert <- function(
 #' the merged column
 #'
 #' Any resulting `NA` values in the `col_begin` column following the merge
-#' operation can be easily formatted using the [fmt_missing()] function.
-#' Separate calls of [fmt_missing()] can be used for the `col_begin` and
+#' operation can be easily formatted using the [sub_missing()] function.
+#' Separate calls of [sub_missing()] can be used for the `col_begin` and
 #' `col_end` columns for finer control of the replacement values.
 #'
 #' This function is part of a set of four column-merging functions. The other
@@ -1312,8 +1312,8 @@ cols_merge_resolver <- function(data, col_begin, col_end, sep) {
 #' `"0"` (i.e., no percentage will be shown)
 #'
 #' Any resulting `NA` values in the `col_n` column following the merge
-#' operation can be easily formatted using the [fmt_missing()] function.
-#' Separate calls of [fmt_missing()] can be used for the `col_n` and
+#' operation can be easily formatted using the [sub_missing()] function.
+#' Separate calls of [sub_missing()] can be used for the `col_n` and
 #' `col_pct` columns for finer control of the replacement values. It is the
 #' responsibility of the user to ensure that values are correct in both the
 #' `col_n` and `col_pct` columns (this function neither generates nor

R/opts.R

@@ -59,7 +59,7 @@
 #'   ) %>%
 #'   gt(rowname_col = "tst") %>%
 #'   tab_spanner_delim(delim = ".") %>%
-#'   fmt_missing(
+#'   sub_missing(
 #'     columns = everything(),
 #'     missing_text = "90+"
 #'   ) %>%