From deeacdc9f1fe13cad75e7f9abc8dbcf34edaf3d3 Mon Sep 17 00:00:00 2001 From: Richard Iannone Date: Fri, 28 Jan 2022 16:25:05 -0500 Subject: [PATCH 1/2] Bug fixes and enhancements to date/time formatters (#801) * Fix formatting bug in `fmt_date()` and add tests * Update format_data.R * Rework time formatting and add tests * Rework `fmt_date()` and `fmt_datetime()` * Update help files using roxygen * Update DESCRIPTION * Update test-fmt_date_time.R * Add the `is_string_time()` utility function * Use `as.POSIXlt()` to preprocess dates/times * Add several testthat tests * Add the `check_format_string()` util function * Handle any non-NULL `format` values * Include the `format` arg in `fmt_datetime()` * Update documentation in `fmt_datetime()` * Update fmt_datetime.Rd * Rewrite internals of `fmt_datetime()` * Add `tz` argument to `fmt_datetime()` * Update documentation for `fmt_datetime()` * Add several testthat tests * Modify documentation for `tz` param * Modify error messages and documentation * Update help files using roxygen * Allow use of `tz` option w/o format string * Modify regex for string time * Add/modify args for `fmt_datetime()` * Have LaTeX math mode transform be optional * Use `num_fmt_factory_multi()` for date/time fmt fns * Update help files using roxygen * Update documentation for `tz` param * Add several util function for parsing date-time strings * Add the `normalize_dt_tz()` util fn * Add several testthat tests * Update test-util_functions.R * Rename util function * Add `ordered_dt_formats()` util fn * Add `parse_8601_datetime_str()` util fn * Fix error in `grepl()` call * `devtools::document()` (GitHub Actions) * `devtools::build_readme()` (GitHub Actions) * Update fmt_datetime.Rd * Remove unused util functions and tests * `devtools::document()` (GitHub Actions) * Update test-fmt_date_time.R * Update test-fmt_date_time.R * Make changes based on code review Co-authored-by: rich-iannone --- DESCRIPTION | 1 + R/format_data.R | 340 ++++++++---- R/utils.R | 122 ++++- R/utils_formatters.R | 16 +- man/fmt_date.Rd | 24 +- man/fmt_datetime.Rd | 105 +++- man/fmt_time.Rd | 21 +- tests/testthat/test-fmt_date_time.R | 809 ++++++++++++++++++++-------- 8 files changed, 1054 insertions(+), 384 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6a395e4f6..192528206 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,6 +49,7 @@ Suggests: paletteer, testthat (>= 2.1.0), RColorBrewer, + lubridate, rmarkdown, rvest, shiny, diff --git a/R/format_data.R b/R/format_data.R index 03526fc22..ec3bf148d 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -1344,13 +1344,15 @@ fmt_bytes <- function(data, #' Format values as dates #' #' @description -#' Format input date values that are either of the `Date` type, or, are -#' character-based and expressed according to the ISO 8601 date format -#' (`YYYY-MM-DD`). Once the appropriate data cells are targeted with `columns` -#' (and, optionally, `rows`), we can simply apply a preset date style to format -#' the dates. The following date styles are available for simpler formatting of -#' ISO dates (all using the input date of `2000-02-29` in the example output -#' dates): +#' Format input values to time values using one of fourteen presets. Input can +#' be in the form of `POSIXt` (i.e., date-times), the `Date` type, or +#' `character` (must be in the ISO 8601 form of `YYYY-MM-DD HH:MM:SS` or +#' `YYYY-MM-DD`). +#' +#' Once the appropriate data cells are targeted with `columns` (and, optionally, +#' `rows`), we can simply apply a preset date style to format the dates. The +#' following date styles are available for use (all using the input date of +#' `2000-02-29` in the example output dates): #' #' 1. `"iso"`: `2000-02-29` #' 2. `"wday_month_day_year"`: `Tuesday, February 29, 2000` @@ -1374,7 +1376,7 @@ fmt_bytes <- function(data, #' 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. +#' argument. See the *Arguments* section for more information on this. #' #' @inheritParams fmt_number #' @param date_style The date style to use. Supply a number (from `1` to `14`) @@ -1435,7 +1437,8 @@ fmt_bytes <- function(data, fmt_date <- function(data, columns, rows = everything(), - date_style = 2) { + date_style = 2, + pattern = "{x}") { # Perform input object validation stop_if_not_gt(data = data) @@ -1449,11 +1452,12 @@ fmt_date <- function(data, !column_classes_are_valid( data = data, columns = {{ columns }}, - valid_classes = c("Date", "character") + valid_classes = c("Date", "POSIXt", "character") ) ) { stop( - "The `fmt_date()` function can only be used on `columns` with `character` or `Date` values.", + "The `fmt_date()` function can only be used on `columns` of certain types:\n", + "* Allowed types are `Date`, `POSIXt`, and `character` (in ISO 8601 format).", call. = FALSE ) } @@ -1464,27 +1468,35 @@ fmt_date <- function(data, data = data, columns = {{ columns }}, rows = {{ rows }}, - fns = list( - default = function(x) { - - # If `x` is of the `Date` type, simply make - # that a character vector - if (inherits(x, "Date")) { - x <- as.character(x) - } + fns = num_fmt_factory_multi( + pattern = pattern, + use_latex_math_mode = FALSE, + format_fn = function(x, context) { + # Convert incoming values to POSIXlt but provide a friendly error + # if the values cannot be parsed by `as.POSIXlt()` date <- - ifelse(grepl("^[0-9]*?\\:[0-9]*?", x), paste("1970-01-01", x), x) %>% - strftime(format = date_format_str) + tryCatch( + as.POSIXlt(x), + error = function(cond) { + stop( + "One or more of the provided date/date-time values are invalid.", + call. = FALSE + ) + } + ) + + # Format the date string using `strftime()` + date <- strftime(date, format = date_format_str) - if (date_style %in% 2:12) { - date <- date %>% tidy_gsub(., "^0", "") + # Perform several cosmetic changes to the formatted date + if (date_format_str != "%F") { + + date <- gsub(" 0([0-9])", " \\1", date) + date <- gsub("^0([0-9])[^/]", "\\1 ", date) } - date %>% - tidy_gsub(" 0([0-9])", " \\1") %>% - tidy_gsub("pm$", "PM") %>% - tidy_gsub("am$", "AM") + date } ) ) @@ -1493,11 +1505,14 @@ fmt_date <- function(data, #' Format values as times #' #' @description -#' Format input time values that are character-based and expressed according to -#' the ISO 8601 time format (`HH:MM:SS`). Once the appropriate data cells are -#' targeted with `columns` (and, optionally, `rows`), we can simply apply a -#' preset time style to format the times. The following time styles are -#' available for simpler formatting of ISO times (all using the input time of +#' Format input values to time values using one of five presets. Input can be in +#' the form of `POSIXt` (i.e., date-times), `character` (must be in the ISO +#' 8601 forms of `HH:MM:SS` or `YYYY-MM-DD HH:MM:SS`), or `Date` (which always +#' results in the formatting of `00:00:00`). +#' +#' Once the appropriate data cells are targeted with `columns` (and, optionally, +#' `rows`), we can simply apply a preset time style to format the times. The +#' following time styles are available for use (all using the input time of #' `14:35:00` in the example output times): #' #' 1. `"hms"`: `14:35:00` @@ -1513,7 +1528,7 @@ fmt_date <- function(data, #' 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. +#' argument. See the *Arguments* section for more information on this. #' #' @inheritParams fmt_number #' @param time_style The time style to use. Supply a number (from `1` to `5`) @@ -1574,7 +1589,8 @@ fmt_date <- function(data, fmt_time <- function(data, columns, rows = everything(), - time_style = 2) { + time_style = 2, + pattern = "{x}") { # Perform input object validation stop_if_not_gt(data = data) @@ -1588,10 +1604,11 @@ fmt_time <- function(data, !column_classes_are_valid( data = data, columns = {{ columns }}, - valid_classes = "character") + valid_classes = c("Date", "POSIXt", "character")) ) { stop( - "The `fmt_date()` function can only be used on `columns` with `character` values.", + "The `fmt_time()` function can only be used on `columns` of certain types:\n", + "* Allowed types are `Date`, `POSIXt`, and `character` (in `HH:MM:SS` format).", call. = FALSE ) } @@ -1602,21 +1619,44 @@ fmt_time <- function(data, data = data, columns = {{ columns }}, rows = {{ rows }}, - fns = list( - default = function(x) { + fns = num_fmt_factory_multi( + pattern = pattern, + use_latex_math_mode = FALSE, + format_fn = function(x, context) { + # If the incoming values are strings that adequately represent time + # values, then prepend with the `1970-01-01` dummy date to create an + # input that will works with `strftime()` + if (all(is_string_time(x))) { + x <- paste("1970-01-01", x) + } + + # Convert incoming values to POSIXlt but provide a friendly error + # if the values cannot be parsed by `as.POSIXlt()` time <- - ifelse(grepl("^[0-9]*?\\:[0-9]*?", x), paste("1970-01-01", x), x) %>% - strftime(format = time_format_str) + tryCatch( + as.POSIXlt(x), + error = function(cond) { + stop( + "One or more of the provided date/time/date-time values are invalid.", + call. = FALSE + ) + } + ) - if (time_style %in% 3:5) { - time <- time %>% tidy_gsub(., "^0", "") + # Format the date string using `strftime()` + time <- strftime(time, format = time_format_str) + + # Perform several cosmetic changes to the formatted time + if (grepl("%P$", time_format_str)) { + + time <- gsub("^0", "", time) + time <- gsub(" 0([0-9])", " \\1", time) + time <- gsub("\\bpm\\b$", "PM", time) + time <- gsub("\\bam\\b$", "AM", time) } - time %>% - tidy_gsub(" 0([0-9])", " \\1") %>% - tidy_gsub("pm$", "PM") %>% - tidy_gsub("am$", "AM") + time } ) ) @@ -1625,13 +1665,16 @@ fmt_time <- function(data, #' Format values as date-times #' #' @description -#' Format input date-time values that are character-based and expressed -#' according to the ISO 8601 date-time format (`YYYY-MM-DD HH:MM:SS`). Once the -#' appropriate data cells are targeted with `columns` (and, optionally, `rows`), -#' we can simply apply preset date and time styles to format the date-time -#' values. The following date styles are available for simpler formatting of the -#' date portion (all using the input date of `2000-02-29` in the example output -#' dates): +#' Format input values to date-time values using one of fourteen presets for the +#' date component and one of five presets for the time component. Input can be +#' in the form of `POSIXct` (i.e., date-times), the `Date` type, or `character` +#' (must be in the ISO 8601 form of `YYYY-MM-DD HH:MM:SS` or `YYYY-MM-DD`). +#' +#' Once the appropriate data cells are targeted with `columns` (and, optionally, +#' `rows`), we can simply apply preset date and time styles to format the +#' date-time values. The following date styles are available for formatting of +#' the date portion (all using the input date of `2000-02-29` in the example +#' output dates): #' #' 1. `"iso"`: `2000-02-29` #' 2. `"wday_month_day_year"`: `Tuesday, February 29, 2000` @@ -1648,8 +1691,8 @@ fmt_time <- function(data, #' 13. `"year.mn.day"`: `2000/02/29` #' 14. `"y.mn.day"`: `00/02/29` #' -#' The following time styles are available for simpler formatting of the time -#' portion (all using the input time of `14:35:00` in the example output times): +#' The following time styles are available for formatting of the time portion +#' (all using the input time of `14:35:00` in the example output times): #' #' 1. `"hms"`: `14:35:00` #' 2. `"hm"`: `14:35` @@ -1665,11 +1708,74 @@ fmt_time <- function(data, #' 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. +#' argument. See the *Arguments* section for more information on this. +#' +#' @section Date and Time Formats: +#' Using `format` to create custom time formats isn't so hard once we know about +#' all of the different format codes. The formats are all indicated with a +#' leading `%` and literal characters are any of those without the leading `%`. +#' We'll use the date and time `"2015-06-08 23:05:37.48"` for all of the +#' examples here. +#' +#' First off, let's look at a few format code combinations that work well +#' together as format codes. This will give us an intuition on how these +#' generally work. +#' +#' - `"%m/%d/%Y"` -> `"06/08/2015"` +#' - `"%A, %B %e, %Y"` -> `"Monday, June 8, 2015"` +#' - `"%b %e %a"` -> `"Jun 8 Mon"` +#' - `"%H:%M"` -> `"23:05"` +#' - `"%I:%M %p"` -> `"11:05 pm"` +#' - `"%A, %B %e, %Y at %I:%M %p"` -> `"Monday, June 8, 2015 at 11:05 pm"` +#' +#' Here are the individual format codes for date components: +#' +#' - `"%a"` -> `"Mon"` (abbreviated day of week name) +#' - `"%A"` -> `"Monday"` (full day of week name) +#' - `"%w"` -> `"1"` (day of week number in `0..6`; Sunday is `0`) +#' - `"%u"` -> `"1"` (day of week number in `1..7`; Monday is `1`, Sunday `7`) +#' - `"%y"` -> `"15"` (abbreviated year, using the final two digits) +#' - `"%Y"` -> `"2015"` (full year) +#' - `"%b"` -> `"Jun"` (abbreviated month name) +#' - `"%B"` -> `"June"` (full month name) +#' - `"%m"` -> `"06"` (month number) +#' - `"%d"` -> `"08"` (day number, zero-padded) +#' - `"%e"` -> `"8"` (day number without zero padding) +#' +#' Here are the individual format codes for time components: +#' +#' - `"%H"` -> `"23"` (24h hour) +#' - `"%I"` -> `"11"` (12h hour) +#' - `"%M"` -> `"05"` (minute) +#' - `"%S"` -> `"37"` (second) +#' - `"%OS3"` -> `"37.480"` (seconds with decimals; `3` decimal places here) +#' - `%p` -> `"pm"` (AM or PM indicator, may not appear in certain locales) +#' +#' Here are some extra formats that you may find useful: +#' +#' - `"%j"` -> `"159"` (day of the year, always zero-padded) +#' - `"%W"` -> `"23"` (week number for the year, always zero-padded) +#' - `"%V"` -> `"24"` (week number for the year, following ISO 8601 standard) +#' - `"%C"` -> `"20"` (the century number) +#' - `"%z"` -> `"+0000"` (signed time zone offset, here using UTC) +#' - `"%F"` -> `"2015-06-08"` (the date in the ISO 8601 date format) +#' - `"%%"` -> `"%"` (the literal "`%`" character, in case you need it) #' #' @inheritParams fmt_number #' @inheritParams fmt_date #' @inheritParams fmt_time +#' @param sep The separator string to use between the date and time components. +#' By default, this is a single space character (`" "`). Only used when not +#' specifying a `format` code. +#' @param format An optional format code used for generating custom dates/times. +#' If used then the arguments governing preset styles (`date_style` and +#' `time_style`) will be ignored in favor of formatting via the `format` +#' string. +#' @param tz The time zone for printing dates/times (i.e., the output). The +#' default of `NULL` will preserve the time zone of the input data in the +#' output. If providing a time zone, it must be one that is recognized by the +#' user's operating system (a vector of all valid `tz` values can be produced +#' with [OlsonNames()]). #' #' @return An object of class `gt_tbl`. #' @@ -1702,16 +1808,28 @@ fmt_datetime <- function(data, columns, rows = everything(), date_style = 2, - time_style = 2) { + time_style = 2, + sep = " ", + format = NULL, + tz = NULL, + pattern = "{x}") { # Perform input object validation stop_if_not_gt(data = data) - # Transform `date_style` to `date_format` - date_format_str <- get_date_format(date_style = date_style) + if (!is.null(format)) { - # Transform `time_style` to `time_format` - time_format_str <- get_time_format(time_style = time_style) + # Ensure that the format string meets some basic validation requirements + check_format_string(format = format) + + } else { + + # Transform `date_style` to `date_format` + date_format_str <- get_date_format(date_style = date_style) + + # Transform `time_style` to `time_format` + time_format_str <- get_time_format(time_style = time_style) + } # Stop function if any columns have data that is incompatible # with this formatter @@ -1719,12 +1837,13 @@ fmt_datetime <- function(data, !column_classes_are_valid( data = data, columns = {{ columns }}, - valid_classes = "character" - )) { - stop( - "The `fmt_datetime()` function can only be used on `columns` with `character` values.", - call. = FALSE - ) + valid_classes = c("Date", "POSIXct", "character")) + ) { + stop( + "The `fmt_datetime()` function can only be used on `columns` of certain types:\n", + "* Allowed types are `Date`, `POSIXct`, and `character` (in ISO 8601 format).", + call. = FALSE + ) } # Pass `data`, `columns`, `rows`, and the formatting @@ -1733,42 +1852,77 @@ fmt_datetime <- function(data, data = data, columns = {{ columns }}, rows = {{ rows }}, - fns = list( - default = function(x) { + fns = num_fmt_factory_multi( + pattern = pattern, + use_latex_math_mode = FALSE, + format_fn = function(x, context) { - date <- - ifelse(grepl("^[0-9]*?\\:[0-9]*?", x), paste("1970-01-01", x), x) %>% - strftime(format = date_format_str) + # If a format string is provided then use that to generate the + # formatted date/time string + if (!is.null(format)) { - if (date_style %in% 2:12) { - date <- date %>% tidy_gsub(., "^0", "") - } + # If the incoming values are strings that adequately represent time + # values, then prepend with the `1970-01-01` dummy date to create an + # input that will works with `strftime()` + if (all(is_string_time(x))) { + x <- paste("1970-01-01", x) - date <- - date %>% - tidy_gsub(" 0([0-9])", " \\1") %>% - tidy_gsub("pm$", "PM") %>% - tidy_gsub("am$", "AM") + } - time <- - ifelse(grepl("^[0-9]*?\\:[0-9]*?", x), paste("1970-01-01", x), x) %>% - strftime(format = time_format_str) + if (is.character(x) && is.null(tz)) { + tz <- "" + } - if (time_style %in% 3:5) { - time <- time %>% tidy_gsub(., "^0", "") + # Format the date-time values using `strftime()` + return(strftime(x, format = format, tz = tz)) } - time <- - time %>% - tidy_gsub(" 0([0-9])", " \\1") %>% - tidy_gsub("pm$", "PM") %>% - tidy_gsub("am$", "AM") + # + # Format the date portion of the datetime string + # + # Convert incoming values to POSIXlt but provide a friendly error + # if the values cannot be parsed by `as.POSIXlt()` datetime <- - paste(date, time) %>% - tidy_gsub("NA NA", "NA") + tryCatch( + as.POSIXlt(x), + error = function(cond) { + stop( + "One or more of the provided date/date-time values are invalid.", + call. = FALSE + ) + } + ) + + # Format `datetime` into a date string using `strftime()` with + # the resolved formatting string + date <- strftime(datetime, format = date_format_str, tz = tz) + + # Perform several cosmetic changes to the formatted date + if (date_format_str != "%F") { + + date <- gsub(" 0([0-9])", " \\1", date) + date <- gsub("^0([0-9])[^/]", "\\1 ", date) + } + + # + # Format the time portion of the datetime string + # + + # Format `datetime` into a time string using `strftime()` with + # the resolved formatting string + time <- strftime(datetime, format = time_format_str, tz = tz) + + # Perform several cosmetic changes to the formatted time + if (grepl("%P$", time_format_str)) { + + time <- gsub("^0", "", time) + time <- gsub(" 0([0-9])", " \\1", time) + time <- gsub("\\bpm\\b$", "PM", time) + time <- gsub("\\bam\\b$", "AM", time) + } - datetime + paste(date, time, sep = sep) } ) ) diff --git a/R/utils.R b/R/utils.R index 6799ae902..4daa831bb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -40,25 +40,48 @@ time_formats <- function() { #' @noRd get_date_format <- function(date_style) { - # Create bindings for specific variables - format_number <- format_code <- format_name <- NULL + date_format_tbl <- date_formats() + date_format_num_range <- seq_len(nrow((date_format_tbl))) + + # In the rare instance that `date_style` consists of a character-based + # number in the valid range of numbers, cast the value as a number + if ( + is.character(date_style) && + date_style %in% as.character(date_format_num_range) + ) { + date_style <- as.numeric(date_style) + } - if (date_style %in% 1:14 | date_style %in% as.character(1:14)) { + # Stop function if a numeric `date_style` value is invalid + if (is.numeric(date_style)) { - return( - date_formats() %>% - dplyr::filter(format_number == as.character(date_style)) %>% - dplyr::pull(format_code) - ) + if (!(date_style %in% date_format_num_range)) { + stop( + "If using a numeric value for a `date_style`, it must be ", + "between `1` and `", nrow((date_format_tbl)), "`:\n", + "* Use `info_date_style()` for a useful visual reference", + call. = FALSE + ) + } } - if (date_style %in% date_formats()$format_name) { - return( - date_formats() %>% - dplyr::filter(format_name == date_style) %>% - dplyr::pull(format_code) - ) + # Stop function if a character-based `date_style` value is invalid + if (is.character(date_style)) { + + if (!(date_style %in% date_format_tbl$format_name)) { + stop( + "If using a `date_style` name, it must be in the valid set:\n", + "* Use `info_date_style()` for a useful visual reference", + call. = FALSE + ) + } + + # Normalize `date_style` to be a numeric index value + date_style <- which(date_format_tbl$format_name == date_style) } + + # Obtain the correct date format code for use with `strptime()` + date_format_tbl[["format_code"]][date_style] } #' Transform a `time_style` to a `time_format` @@ -66,22 +89,69 @@ get_date_format <- function(date_style) { #' @noRd get_time_format <- function(time_style) { - # Create bindings for specific variables - format_number <- format_code <- format_name <- NULL + time_format_tbl <- time_formats() + time_format_num_range <- seq_len(nrow((time_format_tbl))) - if (time_style %in% 1:5 | time_style %in% as.character(1:5)) { + # In the rare instance that `time_style` consists of a character-based + # number in the valid range of numbers, cast the value as a number + if ( + is.character(time_style) && + time_style %in% as.character(time_format_num_range) + ) { + time_style <- as.numeric(time_style) + } - return( - time_formats() %>% - dplyr::filter(format_number == as.character(time_style)) %>% - dplyr::pull(format_code)) + # Stop function if a numeric `time_style` value is invalid + if (is.numeric(time_style)) { + + if (!(time_style %in% time_format_num_range)) { + stop( + "If using a numeric value for a `time_style`, it must be ", + "between `1` and `", nrow((time_format_tbl)), "`:\n", + "* Use `info_time_style()` for a useful visual reference", + call. = FALSE + ) + } } - if (time_style %in% time_formats()$format_name) { - return( - time_formats() %>% - dplyr::filter(format_name == time_style) %>% - dplyr::pull(format_code)) + # Stop function if a character-based `time_style` value is invalid + if (is.character(time_style)) { + + if (!(time_style %in% time_format_tbl$format_name)) { + stop( + "If using a `time_style` name, it must be in the valid set:\n", + "* Use `info_time_style()` for a useful visual reference", + call. = FALSE + ) + } + + # Normalize `time_style` to be a numeric index value + time_style <- which(time_format_tbl$format_name == time_style) + } + + # Obtain the correct time format code for use with `strptime()` + time_format_tbl[["format_code"]][time_style] +} + +#' Are string values 24 hour times? +#' +#' Determine whether string values are representative of ISO 8601 time parts +#' (in 24 hour time). Valid strings can be in the following formats: `hh::mm`, +#' `hh::mm:ss`, and `hh::mm:ss.sss`. +#' +#' @noRd +is_string_time <- function(x) { + + is.character(x) & grepl("^\\d{1,2}:\\d{2}(:\\d{2}(\\.\\d+)?)?$", x) +} + +check_format_string <- function(format) { + + if (!is.character(format) || length(format) != 1) { + stop( + "The `format` code must be a character string of length 1.", + call. = FALSE + ) } } diff --git a/R/utils_formatters.R b/R/utils_formatters.R index d8687958e..bcfe3f619 100644 --- a/R/utils_formatters.R +++ b/R/utils_formatters.R @@ -313,6 +313,7 @@ format_num_to_str_c <- function(x, #' #' @param x Numeric values in `character` form. #' @param context The output context. +#' #' @noRd to_latex_math_mode <- function(x, context) { @@ -697,6 +698,7 @@ create_suffix_df <- function(x, #' @param format_fn A function for formatting the numeric values. #' @noRd num_fmt_factory_multi <- function(pattern, + use_latex_math_mode = TRUE, format_fn) { # Generate a named list of factory functions, with one @@ -704,7 +706,12 @@ num_fmt_factory_multi <- function(pattern, all_contexts %>% magrittr::set_names(all_contexts) %>% lapply(function(x) { - num_fmt_factory(context = x, pattern = pattern, format_fn = format_fn) + num_fmt_factory( + context = x, + pattern = pattern, + use_latex_math_mode = use_latex_math_mode, + format_fn = format_fn + ) }) } @@ -717,6 +724,7 @@ num_fmt_factory_multi <- function(pattern, #' @noRd num_fmt_factory <- function(context, pattern, + use_latex_math_mode = TRUE, format_fn) { # Force all arguments @@ -740,11 +748,11 @@ num_fmt_factory <- function(context, x_str_vals <- x_vals %>% # Format all non-NA x values with a formatting function - format_fn(context) %>% + format_fn(context = context) %>% # If in a LaTeX context, wrap values in math mode - to_latex_math_mode(context) %>% + { if (use_latex_math_mode) to_latex_math_mode(., context = context) else . } %>% # Handle formatting of pattern - apply_pattern_fmt_x(pattern) + apply_pattern_fmt_x(pattern = pattern) # Create `x_str` with the same length as `x`; place the # `x_str_vals` into `str` (at the non-NA indices) diff --git a/man/fmt_date.Rd b/man/fmt_date.Rd index 6aee0ac89..88446cee4 100644 --- a/man/fmt_date.Rd +++ b/man/fmt_date.Rd @@ -4,7 +4,7 @@ \alias{fmt_date} \title{Format values as dates} \usage{ -fmt_date(data, columns, rows = everything(), date_style = 2) +fmt_date(data, columns, rows = everything(), date_style = 2, pattern = "{x}") } \arguments{ \item{data}{A table object that is created using the \code{\link[=gt]{gt()}} function.} @@ -28,18 +28,24 @@ to filter down to the rows we need (e.g., that corresponds to the preferred date style, or, provide a named date style (\code{"wday_month_day_year"}, \code{"m_day_year"}, \code{"year.mn.day"}, etc.). Use \code{\link[=info_date_style]{info_date_style()}} to see the different numbered and named date presets.} + +\item{pattern}{A formatting pattern that allows for decoration of the +formatted value. The value itself is represented by \code{{x}} and all other +characters are taken to be string literals.} } \value{ An object of class \code{gt_tbl}. } \description{ -Format input date values that are either of the \code{Date} type, or, are -character-based and expressed according to the ISO 8601 date format -(\code{YYYY-MM-DD}). Once the appropriate data cells are targeted with \code{columns} -(and, optionally, \code{rows}), we can simply apply a preset date style to format -the dates. The following date styles are available for simpler formatting of -ISO dates (all using the input date of \code{2000-02-29} in the example output -dates): +Format input values to time values using one of fourteen presets. Input can +be in the form of \code{POSIXt} (i.e., date-times), the \code{Date} type, or +\code{character} (must be in the ISO 8601 form of \verb{YYYY-MM-DD HH:MM:SS} or +\code{YYYY-MM-DD}). + +Once the appropriate data cells are targeted with \code{columns} (and, optionally, +\code{rows}), we can simply apply a preset date style to format the dates. The +following date styles are available for use (all using the input date of +\code{2000-02-29} in the example output dates): \enumerate{ \item \code{"iso"}: \code{2000-02-29} \item \code{"wday_month_day_year"}: \verb{Tuesday, February 29, 2000} @@ -64,7 +70,7 @@ the possible inputs to \code{date_style}. Targeting of values is done through \code{columns} and additionally by \code{rows} (if nothing is provided for \code{rows} then entire columns are selected). Conditional formatting is possible by providing a conditional expression to the \code{rows} -argument. See the Arguments section for more information on this. +argument. See the \emph{Arguments} section for more information on this. } \section{Figures}{ diff --git a/man/fmt_datetime.Rd b/man/fmt_datetime.Rd index df756dea2..fac3d601e 100644 --- a/man/fmt_datetime.Rd +++ b/man/fmt_datetime.Rd @@ -9,7 +9,11 @@ fmt_datetime( columns, rows = everything(), date_style = 2, - time_style = 2 + time_style = 2, + sep = " ", + format = NULL, + tz = NULL, + pattern = "{x}" ) } \arguments{ @@ -39,18 +43,40 @@ style (\code{"wday_month_day_year"}, \code{"m_day_year"}, \code{"year.mn.day"}, that corresponds to the preferred time style, or, provide a named time style (\code{"hms"}, \code{"hms_p"}, \code{"h_p"}, etc.). Use \code{\link[=info_time_style]{info_time_style()}} to see the different numbered and named time presets.} + +\item{sep}{The separator string to use between the date and time components. +By default, this is a single space character (\code{" "}). Only used when not +specifying a \code{format} code.} + +\item{format}{An optional format code used for generating custom dates/times. +If used then the arguments governing preset styles (\code{date_style} and +\code{time_style}) will be ignored in favor of formatting via the \code{format} +string.} + +\item{tz}{The time zone for printing dates/times (i.e., the output). The +default of \code{NULL} will preserve the time zone of the input data in the +output. If providing a time zone, it must be one that is recognized by the +user's operating system (a vector of all valid \code{tz} values can be produced +with \code{\link[=OlsonNames]{OlsonNames()}}).} + +\item{pattern}{A formatting pattern that allows for decoration of the +formatted value. The value itself is represented by \code{{x}} and all other +characters are taken to be string literals.} } \value{ An object of class \code{gt_tbl}. } \description{ -Format input date-time values that are character-based and expressed -according to the ISO 8601 date-time format (\verb{YYYY-MM-DD HH:MM:SS}). Once the -appropriate data cells are targeted with \code{columns} (and, optionally, \code{rows}), -we can simply apply preset date and time styles to format the date-time -values. The following date styles are available for simpler formatting of the -date portion (all using the input date of \code{2000-02-29} in the example output -dates): +Format input values to date-time values using one of fourteen presets for the +date component and one of five presets for the time component. Input can be +in the form of \code{POSIXct} (i.e., date-times), the \code{Date} type, or \code{character} +(must be in the ISO 8601 form of \verb{YYYY-MM-DD HH:MM:SS} or \code{YYYY-MM-DD}). + +Once the appropriate data cells are targeted with \code{columns} (and, optionally, +\code{rows}), we can simply apply preset date and time styles to format the +date-time values. The following date styles are available for formatting of +the date portion (all using the input date of \code{2000-02-29} in the example +output dates): \enumerate{ \item \code{"iso"}: \code{2000-02-29} \item \code{"wday_month_day_year"}: \verb{Tuesday, February 29, 2000} @@ -68,8 +94,8 @@ dates): \item \code{"y.mn.day"}: \code{00/02/29} } -The following time styles are available for simpler formatting of the time -portion (all using the input time of \code{14:35:00} in the example output times): +The following time styles are available for formatting of the time portion +(all using the input time of \code{14:35:00} in the example output times): \enumerate{ \item \code{"hms"}: \code{14:35:00} \item \code{"hm"}: \code{14:35} @@ -86,8 +112,65 @@ useful references for all of the possible inputs to \code{date_style} and Targeting of values is done through \code{columns} and additionally by \code{rows} (if nothing is provided for \code{rows} then entire columns are selected). Conditional formatting is possible by providing a conditional expression to the \code{rows} -argument. See the Arguments section for more information on this. +argument. See the \emph{Arguments} section for more information on this. +} +\section{Date and Time Formats}{ + +Using \code{format} to create custom time formats isn't so hard once we know about +all of the different format codes. The formats are all indicated with a +leading \verb{\%} and literal characters are any of those without the leading \verb{\%}. +We'll use the date and time \code{"2015-06-08 23:05:37.48"} for all of the +examples here. + +First off, let's look at a few format code combinations that work well +together as format codes. This will give us an intuition on how these +generally work. +\itemize{ +\item \code{"\%m/\%d/\%Y"} -> \code{"06/08/2015"} +\item \code{"\%A, \%B \%e, \%Y"} -> \code{"Monday, June 8, 2015"} +\item \code{"\%b \%e \%a"} -> \code{"Jun 8 Mon"} +\item \code{"\%H:\%M"} -> \code{"23:05"} +\item \code{"\%I:\%M \%p"} -> \code{"11:05 pm"} +\item \code{"\%A, \%B \%e, \%Y at \%I:\%M \%p"} -> \code{"Monday, June 8, 2015 at 11:05 pm"} } + +Here are the individual format codes for date components: +\itemize{ +\item \code{"\%a"} -> \code{"Mon"} (abbreviated day of week name) +\item \code{"\%A"} -> \code{"Monday"} (full day of week name) +\item \code{"\%w"} -> \code{"1"} (day of week number in \verb{0..6}; Sunday is \code{0}) +\item \code{"\%u"} -> \code{"1"} (day of week number in \verb{1..7}; Monday is \code{1}, Sunday \code{7}) +\item \code{"\%y"} -> \code{"15"} (abbreviated year, using the final two digits) +\item \code{"\%Y"} -> \code{"2015"} (full year) +\item \code{"\%b"} -> \code{"Jun"} (abbreviated month name) +\item \code{"\%B"} -> \code{"June"} (full month name) +\item \code{"\%m"} -> \code{"06"} (month number) +\item \code{"\%d"} -> \code{"08"} (day number, zero-padded) +\item \code{"\%e"} -> \code{"8"} (day number without zero padding) +} + +Here are the individual format codes for time components: +\itemize{ +\item \code{"\%H"} -> \code{"23"} (24h hour) +\item \code{"\%I"} -> \code{"11"} (12h hour) +\item \code{"\%M"} -> \code{"05"} (minute) +\item \code{"\%S"} -> \code{"37"} (second) +\item \code{"\%OS3"} -> \code{"37.480"} (seconds with decimals; \code{3} decimal places here) +\item \verb{\%p} -> \code{"pm"} (AM or PM indicator, may not appear in certain locales) +} + +Here are some extra formats that you may find useful: +\itemize{ +\item \code{"\%j"} -> \code{"159"} (day of the year, always zero-padded) +\item \code{"\%W"} -> \code{"23"} (week number for the year, always zero-padded) +\item \code{"\%V"} -> \code{"24"} (week number for the year, following ISO 8601 standard) +\item \code{"\%C"} -> \code{"20"} (the century number) +\item \code{"\%z"} -> \code{"+0000"} (signed time zone offset, here using UTC) +\item \code{"\%F"} -> \code{"2015-06-08"} (the date in the ISO 8601 date format) +\item \code{"\%\%"} -> \code{"\%"} (the literal "\verb{\%}" character, in case you need it) +} +} + \section{Figures}{ \if{html}{\figure{man_fmt_datetime_1.png}{options: width=100\%}} diff --git a/man/fmt_time.Rd b/man/fmt_time.Rd index 5c3da3ab8..3143e8399 100644 --- a/man/fmt_time.Rd +++ b/man/fmt_time.Rd @@ -4,7 +4,7 @@ \alias{fmt_time} \title{Format values as times} \usage{ -fmt_time(data, columns, rows = everything(), time_style = 2) +fmt_time(data, columns, rows = everything(), time_style = 2, pattern = "{x}") } \arguments{ \item{data}{A table object that is created using the \code{\link[=gt]{gt()}} function.} @@ -28,16 +28,23 @@ to filter down to the rows we need (e.g., that corresponds to the preferred time style, or, provide a named time style (\code{"hms"}, \code{"hms_p"}, \code{"h_p"}, etc.). Use \code{\link[=info_time_style]{info_time_style()}} to see the different numbered and named time presets.} + +\item{pattern}{A formatting pattern that allows for decoration of the +formatted value. The value itself is represented by \code{{x}} and all other +characters are taken to be string literals.} } \value{ An object of class \code{gt_tbl}. } \description{ -Format input time values that are character-based and expressed according to -the ISO 8601 time format (\code{HH:MM:SS}). Once the appropriate data cells are -targeted with \code{columns} (and, optionally, \code{rows}), we can simply apply a -preset time style to format the times. The following time styles are -available for simpler formatting of ISO times (all using the input time of +Format input values to time values using one of five presets. Input can be in +the form of \code{POSIXt} (i.e., date-times), \code{character} (must be in the ISO +8601 forms of \code{HH:MM:SS} or \verb{YYYY-MM-DD HH:MM:SS}), or \code{Date} (which always +results in the formatting of \code{00:00:00}). + +Once the appropriate data cells are targeted with \code{columns} (and, optionally, +\code{rows}), we can simply apply a preset time style to format the times. The +following time styles are available for use (all using the input time of \code{14:35:00} in the example output times): \enumerate{ \item \code{"hms"}: \code{14:35:00} @@ -54,7 +61,7 @@ the possible inputs to \code{time_style}. Targeting of values is done through \code{columns} and additionally by \code{rows} (if nothing is provided for \code{rows} then entire columns are selected). Conditional formatting is possible by providing a conditional expression to the \code{rows} -argument. See the Arguments section for more information on this. +argument. See the \emph{Arguments} section for more information on this. } \section{Figures}{ diff --git a/tests/testthat/test-fmt_date_time.R b/tests/testthat/test-fmt_date_time.R index 5920da385..194ee5ddc 100644 --- a/tests/testthat/test-fmt_date_time.R +++ b/tests/testthat/test-fmt_date_time.R @@ -1,4 +1,4 @@ -context("Ensuring that the formatting of dates and times works as expected") +library(lubridate) test_that("the `fmt_date()` function works correctly", { @@ -6,7 +6,8 @@ test_that("the `fmt_date()` function works correctly", { # that contains dates as character values data_tbl <- dplyr::tibble(date = c( - "2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10")) + "2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10", "2000-01-01" + )) # Create a `tab` object with `gt()` and the # `data_tbl` dataset @@ -25,209 +26,198 @@ test_that("the `fmt_date()` function works correctly", { # Expect an error when attempting to format a column # that does not exist - expect_error( - tab %>% fmt_date(columns = "num_1", date_style = 1)) - - # - # Format `date` in various date formats and verify the output - # - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 1) %>% - render_formats_test(context = "html"))[["date"]], - c("2017-10-15", "2013-02-22", - "2014-09-22", "2018-01-10")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 2) %>% - render_formats_test(context = "html"))[["date"]], - c("Sunday, October 15, 2017", "Friday, February 22, 2013", - "Monday, September 22, 2014", "Wednesday, January 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 3) %>% - render_formats_test(context = "html"))[["date"]], - c("Sun, Oct 15, 2017", "Fri, Feb 22, 2013", - "Mon, Sep 22, 2014", "Wed, Jan 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 4) %>% - render_formats_test(context = "html"))[["date"]], - c("Sunday 15 October 2017", "Friday 22 February 2013", - "Monday 22 September 2014", "Wednesday 10 January 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 5) %>% - render_formats_test(context = "html"))[["date"]], - c("October 15, 2017", "February 22, 2013", - "September 22, 2014", "January 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 6) %>% - render_formats_test(context = "html"))[["date"]], - c("Oct 15, 2017", "Feb 22, 2013", - "Sep 22, 2014", "Jan 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 7) %>% - render_formats_test(context = "html"))[["date"]], - c("15 Oct 2017", "22 Feb 2013", - "22 Sep 2014", "10 Jan 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 8) %>% - render_formats_test(context = "html"))[["date"]], - c("15 October 2017", "22 February 2013", - "22 September 2014", "10 January 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 9) %>% - render_formats_test(context = "html"))[["date"]], - c("15 October", "22 February", "22 September", "10 January")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 10) %>% - render_formats_test(context = "html"))[["date"]], - c("2017", "2013", "2014", "2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 11) %>% - render_formats_test(context = "html"))[["date"]], - c("October", "February", "September", "January")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 12) %>% - render_formats_test(context = "html"))[["date"]], - c("15", "22", "22", "10")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 13) %>% - render_formats_test(context = "html"))[["date"]], - c("2017/10/15", "2013/02/22", "2014/09/22", "2018/01/10")) + expect_error(tab %>% fmt_date(columns = "num_1", date_style = 1)) - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 14) %>% - render_formats_test(context = "html"))[["date"]], - c("17/10/15", "13/02/22", "14/09/22", "18/01/10")) + # Create three gt objects with a `date` column having different types + tab_1 <- + dplyr::tibble(date = c( + "2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10", "2000-01-01" + )) %>% + gt() - # Create an input tibble frame with a single column - # that contains dates as `Date` values - data_tbl <- + tab_2 <- dplyr::tibble(date = as.Date(c( - "2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10"))) + "2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10", "2000-01-01" + ))) %>% + gt() - # Create a `tab` object with `gt()` and the `data_tbl` dataset - tab <- gt(data_tbl) + tab_3 <- + dplyr::tibble(date = c( + "2017-10-15 20:00:10", "2013-02-22 00:00:00", + "2014-09-22 23:59:59", "2018-01-10 06:30:34", + "2000-01-01 12:00:00" + )) %>% + dplyr::mutate(date = lubridate::ymd_hms(date)) %>% + gt() + + # Combine the gt tables into a list + gt_tables <- list(tab_1, tab_2, tab_3) # # Format `date` in various date formats and verify the output # - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 1) %>% - render_formats_test(context = "html"))[["date"]], - c("2017-10-15", "2013-02-22", - "2014-09-22", "2018-01-10")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 2) %>% - render_formats_test(context = "html"))[["date"]], - c("Sunday, October 15, 2017", "Friday, February 22, 2013", - "Monday, September 22, 2014", "Wednesday, January 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 3) %>% - render_formats_test(context = "html"))[["date"]], - c("Sun, Oct 15, 2017", "Fri, Feb 22, 2013", - "Mon, Sep 22, 2014", "Wed, Jan 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 4) %>% - render_formats_test(context = "html"))[["date"]], - c("Sunday 15 October 2017", "Friday 22 February 2013", - "Monday 22 September 2014", "Wednesday 10 January 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 5) %>% - render_formats_test(context = "html"))[["date"]], - c("October 15, 2017", "February 22, 2013", - "September 22, 2014", "January 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 6) %>% - render_formats_test(context = "html"))[["date"]], - c("Oct 15, 2017", "Feb 22, 2013", - "Sep 22, 2014", "Jan 10, 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 7) %>% - render_formats_test(context = "html"))[["date"]], - c("15 Oct 2017", "22 Feb 2013", - "22 Sep 2014", "10 Jan 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 8) %>% - render_formats_test(context = "html"))[["date"]], - c("15 October 2017", "22 February 2013", - "22 September 2014", "10 January 2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 9) %>% - render_formats_test(context = "html"))[["date"]], - c("15 October", "22 February", "22 September", "10 January")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 10) %>% - render_formats_test(context = "html"))[["date"]], - c("2017", "2013", "2014", "2018")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 11) %>% - render_formats_test(context = "html"))[["date"]], - c("October", "February", "September", "January")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 12) %>% - render_formats_test(context = "html"))[["date"]], - c("15", "22", "22", "10")) - - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 13) %>% - render_formats_test(context = "html"))[["date"]], - c("2017/10/15", "2013/02/22", "2014/09/22", "2018/01/10")) + for (tab in gt_tables) { + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 1) %>% + render_formats_test(context = "html"))[["date"]], + c("2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10", "2000-01-01") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 2) %>% + render_formats_test(context = "html"))[["date"]], + c("Sunday, October 15, 2017", "Friday, February 22, 2013", + "Monday, September 22, 2014", "Wednesday, January 10, 2018", + "Saturday, January 1, 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 3) %>% + render_formats_test(context = "html"))[["date"]], + c("Sun, Oct 15, 2017", "Fri, Feb 22, 2013", + "Mon, Sep 22, 2014", "Wed, Jan 10, 2018", + "Sat, Jan 1, 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 4) %>% + render_formats_test(context = "html"))[["date"]], + c("Sunday 15 October 2017", "Friday 22 February 2013", + "Monday 22 September 2014", "Wednesday 10 January 2018", + "Saturday 1 January 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 5) %>% + render_formats_test(context = "html"))[["date"]], + c("October 15, 2017", "February 22, 2013", + "September 22, 2014", "January 10, 2018", + "January 1, 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 6) %>% + render_formats_test(context = "html"))[["date"]], + c("Oct 15, 2017", "Feb 22, 2013", "Sep 22, 2014", + "Jan 10, 2018", "Jan 1, 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 7) %>% + render_formats_test(context = "html"))[["date"]], + c("15 Oct 2017", "22 Feb 2013", "22 Sep 2014", + "10 Jan 2018", "1 Jan 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 8) %>% + render_formats_test(context = "html"))[["date"]], + c("15 October 2017", "22 February 2013", "22 September 2014", + "10 January 2018", "1 January 2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 9) %>% + render_formats_test(context = "html"))[["date"]], + c("15 October", "22 February", "22 September", "10 January", "1 January") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 10) %>% + render_formats_test(context = "html"))[["date"]], + c("2017", "2013", "2014", "2018", "2000") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 11) %>% + render_formats_test(context = "html"))[["date"]], + c("October", "February", "September", "January", "January") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 12) %>% + render_formats_test(context = "html"))[["date"]], + c("15", "22", "22", "10", "01") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 13) %>% + render_formats_test(context = "html"))[["date"]], + c("2017/10/15", "2013/02/22", "2014/09/22", "2018/01/10", "2000/01/01") + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = 14) %>% + render_formats_test(context = "html"))[["date"]], + c("17/10/15", "13/02/22", "14/09/22", "18/01/10", "00/01/01") + ) + } + + # Ensure that using named `date_style` values results in + # equivalent output as compared to using numbered `date_style`s + date_style_names <- date_formats()[["format_name"]] + + for (tab in gt_tables) { + + for (i in 1:14) { + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = i) %>% + render_formats_test(context = "html"))[["date"]], + (tab %>% + fmt_date(columns = "date", date_style = date_style_names[i]) %>% + render_formats_test(context = "html"))[["date"]] + ) + + expect_equal( + (tab %>% + fmt_date(columns = "date", date_style = i) %>% + render_formats_test(context = "html"))[["date"]], + (tab %>% + fmt_date(columns = "date", date_style = as.character(i)) %>% + render_formats_test(context = "html"))[["date"]] + ) + } + } + + # Expect errors if invalid input is provided to `fmt_date()` + expect_error(tab_1 %>% fmt_date(columns = "date", date_style = "none")) + expect_error(tab_1 %>% fmt_date(columns = "date", date_style = 50)) + + # Expect an error if providing a time as input for `fmt_date()` + expect_error( + dplyr::tibble(time = c( + "23:01", "15:30", "08:22" + )) %>% + gt() %>% + fmt_date(columns = "time") %>% + as_raw_html(inline_css = FALSE) + ) - expect_equal( - (tab %>% - fmt_date(columns = "date", date_style = 14) %>% - render_formats_test(context = "html"))[["date"]], - c("17/10/15", "13/02/22", "14/09/22", "18/01/10")) + # Expect an error if any string-based dates are invalid + expect_error( + dplyr::tibble(date = c("2013-12-30", "2017-30-15")) %>% + gt() %>% + fmt_date(columns = "date") %>% + as_raw_html(inline_css = FALSE) + ) }) test_that("the `fmt_time()` function works correctly", { @@ -236,7 +226,8 @@ test_that("the `fmt_time()` function works correctly", { # that contains times as character values data_tbl <- dplyr::tibble(time = c( - "12:35:23", "15:01:34", "09:45:23", "01:32:00")) + "12:35:23", "15:01:34", "09:45:23", "01:32:00" + )) # Create a `gt_tbl` object with `gt()` and the # `data_tbl` dataset @@ -255,42 +246,185 @@ test_that("the `fmt_time()` function works correctly", { # Expect an error when attempting to format a column # that does not exist - expect_error( - tab %>% fmt_time(columns = "num_1", time_style = 1)) + expect_error(tab %>% fmt_time(columns = "num_1", time_style = 1)) + + # Create three gt objects with a `time` column having different types + tab_1 <- + dplyr::tibble(time = c( + "12:35:23", "15:01:34", "09:45:23", "01:32:00" + )) %>% + gt() + + tab_2 <- + dplyr::tibble(time = c( + "2017-10-15 12:35:23", "2013-02-22 15:01:34", + "2014-09-22 09:45:23", "2018-01-10 01:32:00" + )) %>% + gt() + + tab_3 <- + dplyr::tibble(time = c( + "2017-10-15 12:35:23", "2013-02-22 15:01:34", + "2014-09-22 09:45:23", "2018-01-10 01:32:00" + )) %>% + dplyr::mutate(time = lubridate::ymd_hms(time)) %>% + gt() + + + # Combine the gt tables into a list + gt_tables <- list(tab_1, tab_2, tab_3) # # Format `time` in various date formats and verify the output # - expect_equal( - (tab %>% + for (tab in gt_tables) { + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = 1) %>% + render_formats_test(context = "default"))[["time"]], + c("12:35:23", "15:01:34", "09:45:23", "01:32:00") + ) + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = 2) %>% + render_formats_test(context = "default"))[["time"]], + c("12:35", "15:01", "09:45", "01:32") + ) + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = 3) %>% + render_formats_test(context = "default"))[["time"]], + c("12:35:23 PM", "3:01:34 PM", "9:45:23 AM", "1:32:00 AM") + ) + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = 4) %>% + render_formats_test(context = "default"))[["time"]], + c("12:35 PM", "3:01 PM", "9:45 AM", "1:32 AM") + ) + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = 5) %>% + render_formats_test(context = "default"))[["time"]], + c("12 PM", "3 PM", "9 AM", "1 AM") + ) + } + + # Ensure that using named `time_style` values results in + # equivalent output as compared to using numbered `time_style`s + time_style_names <- time_formats()[["format_name"]] + + for (tab in gt_tables) { + + for (i in 1:5) { + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = i) %>% + render_formats_test(context = "html"))[["time"]], + (tab %>% + fmt_time(columns = "time", time_style = time_style_names[i]) %>% + render_formats_test(context = "html"))[["time"]] + ) + + expect_equal( + (tab %>% + fmt_time(columns = "time", time_style = i) %>% + render_formats_test(context = "html"))[["time"]], + (tab %>% + fmt_time(columns = "time", time_style = as.character(i)) %>% + render_formats_test(context = "html"))[["time"]] + ) + } + } + + # Create a gt table that has `Date` values in the `time` column + tab_4 <- + dplyr::tibble(time = as.Date(c( + "2017-10-15 12:35:23", "2013-02-22 15:01:34", + "2014-09-22 09:45:23", "2018-01-10 01:32:00" + ))) %>% + gt() + + expect_equal( + (tab_4 %>% fmt_time(columns = "time", time_style = 1) %>% render_formats_test(context = "default"))[["time"]], - c("12:35:23", "15:01:34", "09:45:23", "01:32:00")) + rep("00:00:00", 4) + ) expect_equal( - (tab %>% + (tab_4 %>% fmt_time(columns = "time", time_style = 2) %>% render_formats_test(context = "default"))[["time"]], - c("12:35", "15:01", "09:45", "01:32")) + rep("00:00", 4) + ) expect_equal( - (tab %>% + (tab_4 %>% fmt_time(columns = "time", time_style = 3) %>% render_formats_test(context = "default"))[["time"]], - c("12:35:23 PM", "3:01:34 PM", "9:45:23 AM", "1:32:00 AM")) + rep("12:00:00 AM", 4) + ) expect_equal( - (tab %>% + (tab_4 %>% fmt_time(columns = "time", time_style = 4) %>% render_formats_test(context = "default"))[["time"]], - c("12:35 PM", "3:01 PM", "9:45 AM", "1:32 AM")) + rep("12:00 AM", 4) + ) expect_equal( - (tab %>% + (tab_4 %>% fmt_time(columns = "time", time_style = 5) %>% render_formats_test(context = "default"))[["time"]], - c("12 PM", "3 PM", "9 AM", "1 AM")) + rep("12 AM", 4) + ) + + # Expect errors if invalid input is provided to `fmt_time()` + expect_error(tab_1 %>% fmt_time(columns = "time", time_style = "none")) + expect_error(tab_1 %>% fmt_time(columns = "time", time_style = 50)) + + # Expect that mixed, string-based dates and date-times + # will result in the time value always being "00:00" + expect_equal( + (dplyr::tibble(date = c("2013-12-30 12:30", "2017-03-15")) %>% + gt() %>% + fmt_time(columns = "date") %>% + render_formats_test(context = "default"))[["date"]], + rep("00:00", 2) + ) + expect_equal( + (dplyr::tibble(date = c("2013-12-30", "2017-03-15 12:30")) %>% + gt() %>% + fmt_time(columns = "date") %>% + render_formats_test(context = "default"))[["date"]], + rep("00:00", 2) + ) + + # Don't expect an error if any string-based date-times have invalid + # time components + expect_error( + regexp = NA, + dplyr::tibble(date = c("2013-12-30 25:30", "2017-03-15 02:32")) %>% + gt() %>% + fmt_time(columns = "date") + ) + + # Expect an error if any string-based date-times have invalid + # date components + expect_error( + dplyr::tibble(date = c("2013-14-30 22:30", "2017-03-15 02:32")) %>% + gt() %>% + fmt_time(columns = "date") %>% + as_raw_html(inline_css = FALSE) + ) }) test_that("the `fmt_datetime()` function works correctly", { @@ -302,7 +436,9 @@ test_that("the `fmt_datetime()` function works correctly", { "2017-06-10 12:35:23", "2017-07-12 15:01:34", "2017-08-05 09:45:23", - "2017-10-23 01:32:00")) + "2017-10-23 01:32:00", + "2000-01-01 00:00:00" + )) # Create a `gt_tbl` object with `gt()` and the # `data_tbl` dataset @@ -326,46 +462,251 @@ test_that("the `fmt_datetime()` function works correctly", { fmt_datetime( columns = "num_1", date_style = 1, - time_style = 1) + time_style = 1 + ) ) + # Create two gt objects with a `datetime` column having different types + tab_1 <- + dplyr::tibble(datetime = c( + "2017-06-10 12:35:23", "2017-07-12 15:01:34", "2017-08-05 09:45:23", + "2017-10-23 01:32:00", "2000-01-01 00:00:00" + )) %>% + gt() + + tab_2 <- + dplyr::tibble(datetime = c( + "2017-06-10 12:35:23", "2017-07-12 15:01:34", "2017-08-05 09:45:23", + "2017-10-23 01:32:00", "2000-01-01 00:00:00" + )) %>% + dplyr::mutate(datetime = lubridate::ymd_hms(datetime)) %>% + gt() + + # Combine the gt tables into a list + gt_tables <- list(tab_1, tab_2) + # - # Format `time` in various date formats and verify the output + # Format `datetime` in various date formats and verify the output + # + + for (tab in gt_tables) { + + expect_equal( + (tab %>% + fmt_datetime(columns = "datetime", date_style = 1, time_style = 1) %>% + render_formats_test(context = "default"))[["datetime"]], + c("2017-06-10 12:35:23", "2017-07-12 15:01:34", "2017-08-05 09:45:23", + "2017-10-23 01:32:00", "2000-01-01 00:00:00") + ) + + expect_equal( + (tab %>% + fmt_datetime(columns = "datetime", date_style = 2, time_style = 2) %>% + render_formats_test(context = "default"))[["datetime"]], + c("Saturday, June 10, 2017 12:35", "Wednesday, July 12, 2017 15:01", + "Saturday, August 5, 2017 09:45", "Monday, October 23, 2017 01:32", + "Saturday, January 1, 2000 00:00") + ) + + expect_equal( + (tab %>% + fmt_datetime(columns = "datetime", date_style = 3, time_style = 3) %>% + render_formats_test(context = "default"))[["datetime"]], + c("Sat, Jun 10, 2017 12:35:23 PM", "Wed, Jul 12, 2017 3:01:34 PM", + "Sat, Aug 5, 2017 9:45:23 AM", "Mon, Oct 23, 2017 1:32:00 AM", + "Sat, Jan 1, 2000 12:00:00 AM") + ) + + expect_equal( + (tab %>% + fmt_datetime(columns = "datetime", date_style = 4, time_style = 4) %>% + render_formats_test(context = "default"))[["datetime"]], + c("Saturday 10 June 2017 12:35 PM", "Wednesday 12 July 2017 3:01 PM", + "Saturday 5 August 2017 9:45 AM", "Monday 23 October 2017 1:32 AM", + "Saturday 1 January 2000 12:00 AM") + ) + + expect_equal( + (tab %>% + fmt_datetime(columns = "datetime", date_style = 5, time_style = 5) %>% + render_formats_test(context = "default"))[["datetime"]], + c("June 10, 2017 12 PM", "July 12, 2017 3 PM", "August 5, 2017 9 AM", + "October 23, 2017 1 AM", "January 1, 2000 12 AM") + ) + } + + # Expect errors if invalid input is provided to `fmt_datetime()` + expect_error(tab_1 %>% fmt_datetime(columns = "datetime", date_style = "none")) + expect_error(tab_1 %>% fmt_datetime(columns = "datetime", date_style = 50)) + + # + # Format `datetime` using a custom `format` and verify the output # + for (tab in gt_tables) { + + expect_equal( + (tab %>% + fmt_datetime( + columns = "datetime", format = "%F", tz = NULL + ) %>% + render_formats_test(context = "default"))[["datetime"]], + c("2017-06-10", "2017-07-12", "2017-08-05", "2017-10-23", "2000-01-01") + ) + + expect_equal( + (tab %>% + fmt_datetime( + columns = "datetime", format = "%B %d, %Y %H:%M:%S", tz = NULL + ) %>% + render_formats_test(context = "default"))[["datetime"]], + c( + "June 10, 2017 12:35:23", "July 12, 2017 15:01:34", + "August 05, 2017 09:45:23", "October 23, 2017 01:32:00", + "January 01, 2000 00:00:00" + ) + ) + + expect_equal( + (tab %>% + fmt_datetime( + columns = "datetime", date_style = 2, time_style = 2, + format = "%B %d, %Y %H:%M:%S", tz = NULL + ) %>% + render_formats_test(context = "default"))[["datetime"]], + c( + "June 10, 2017 12:35:23", "July 12, 2017 15:01:34", + "August 05, 2017 09:45:23", "October 23, 2017 01:32:00", + "January 01, 2000 00:00:00" + ) + ) + + expect_equal( + (tab %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = NULL + ) %>% + render_formats_test(context = "default"))[["datetime"]], + c( + "June 10, 2017 12:35:23 (+0000)", "July 12, 2017 15:01:34 (+0000)", + "August 05, 2017 09:45:23 (+0000)", "October 23, 2017 01:32:00 (+0000)", + "January 01, 2000 00:00:00 (+0000)" + ) + ) + } + + # Using a string to represent a date or date-time doesn't allow the + # output time to be altered by `tz` + expect_equivalent( + gt_tables[[1]] %>% # table where `datetime` column was `character` + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "GMT" + ) %>% render_formats_test(context = "default"), + gt_tables[[1]] %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "America/Toronto" + ) %>% render_formats_test(context = "default") + ) + + # Using a POSIXct-formatted date-time *does* allow + # the output time to be altered by changing `tz` expect_equal( - (tab %>% - fmt_datetime(columns = "datetime", date_style = 1, time_style = 1) %>% + (gt_tables[[2]] %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "America/Toronto" + ) %>% render_formats_test(context = "default"))[["datetime"]], - c("2017-06-10 12:35:23", "2017-07-12 15:01:34", - "2017-08-05 09:45:23", "2017-10-23 01:32:00")) - + c( + "June 10, 2017 08:35:23 (-0400)", "July 12, 2017 11:01:34 (-0400)", + "August 05, 2017 05:45:23 (-0400)", "October 22, 2017 21:32:00 (-0400)", + "December 31, 1999 19:00:00 (-0500)" + ) + ) expect_equal( - (tab %>% - fmt_datetime(columns = "datetime", date_style = 2, time_style = 2) %>% + (gt_tables[[2]] %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "Asia/Tokyo" + ) %>% render_formats_test(context = "default"))[["datetime"]], - c("Saturday, June 10, 2017 12:35", "Wednesday, July 12, 2017 15:01", - "Saturday, August 5, 2017 09:45", "Monday, October 23, 2017 01:32")) + c( + "June 10, 2017 21:35:23 (+0900)", "July 13, 2017 00:01:34 (+0900)", + "August 05, 2017 18:45:23 (+0900)", "October 23, 2017 10:32:00 (+0900)", + "January 01, 2000 09:00:00 (+0900)" + ) + ) + + # Create a table with datetime values set in JST + datetime_jst_tbl <- + dplyr::tibble(datetime = c( + "2017-10-15 12:35:23", "2013-02-22 15:01:34", + "2014-09-22 09:45:23", "2018-01-10 01:32:00" + )) %>% + dplyr::mutate(datetime = lubridate::ymd_hms(datetime, tz = "Asia/Tokyo")) + # Expect that the default display of date-time values matches the input + # date-time values expect_equal( - (tab %>% - fmt_datetime(columns = "datetime", date_style = 3, time_style = 3) %>% + (datetime_jst_tbl %>% + gt() %>% render_formats_test(context = "default"))[["datetime"]], - c("Sat, Jun 10, 2017 12:35:23 PM", "Wed, Jul 12, 2017 3:01:34 PM", - "Sat, Aug 5, 2017 9:45:23 AM", "Mon, Oct 23, 2017 1:32:00 AM")) + c( + "2017-10-15 12:35:23", "2013-02-22 15:01:34", + "2014-09-22 09:45:23", "2018-01-10 01:32:00" + ) + ) + # Expect that the display of date-time values and time zone is correct + # since the `tz` matches the input time zone expect_equal( - (tab %>% - fmt_datetime(columns = "datetime", date_style = 4, time_style = 4) %>% + (datetime_jst_tbl %>% + gt() %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "Asia/Tokyo" + ) %>% render_formats_test(context = "default"))[["datetime"]], - c("Saturday 10 June 2017 12:35 PM", "Wednesday 12 July 2017 3:01 PM", - "Saturday 5 August 2017 9:45 AM", "Monday 23 October 2017 1:32 AM")) + c( + "October 15, 2017 12:35:23 (+0900)", "February 22, 2013 15:01:34 (+0900)", + "September 22, 2014 09:45:23 (+0900)", "January 10, 2018 01:32:00 (+0900)" + ) + ) + # Expect that the display of date-time values can be moved to a different + # time zone using the output `tz` of "America/Toronto" expect_equal( - (tab %>% - fmt_datetime(columns = "datetime", date_style = 5, time_style = 5) %>% + (datetime_jst_tbl %>% + gt() %>% + fmt_datetime( + columns = "datetime", + format = "%B %d, %Y %H:%M:%S (%z)", tz = "America/Toronto" + ) %>% render_formats_test(context = "default"))[["datetime"]], - c("June 10, 2017 12 PM", "July 12, 2017 3 PM", - "August 5, 2017 9 AM", "October 23, 2017 1 AM")) -}) + c( + "October 14, 2017 23:35:23 (-0400)", "February 22, 2013 01:01:34 (-0500)", + "September 21, 2014 20:45:23 (-0400)", "January 09, 2018 11:32:00 (-0500)" + ) + ) + + # Create a gt table with a `time` column containing valid time strings + tab_3 <- + dplyr::tibble(time = c( + "12:35:23", "15:01:34", "09:45:23", "01:32:00", "00:00:00" + )) %>% + gt() + + # + # Format `time` with a time format and verify the output + # + expect_equal( + (tab_3 %>% + fmt_datetime(columns = "time", format = "%I:%M:%S %P") %>% + render_formats_test(context = "default"))[["time"]], + c("12:35:23 pm", "03:01:34 pm", "09:45:23 am", "01:32:00 am", "12:00:00 am") + ) +}) From c44578bc4dd5c33e40a3c04ae73dde2ec981c398 Mon Sep 17 00:00:00 2001 From: Richard Iannone Date: Fri, 28 Jan 2022 19:52:09 -0500 Subject: [PATCH 2/2] Add ability to set global locale in `gt()` (#866) * Add ability to set global locale in `gt()` * `devtools::document()` (GitHub Actions) * Update docs for the `locale` arg across formatters * Make `resolve_locale()` validate the resolved locale value Co-authored-by: rich-iannone --- DESCRIPTION | 1 + R/dt_locale.R | 24 ++++++ R/format_data.R | 34 +++++---- R/gt.R | 10 +++ R/utils_formatters.R | 31 +++++++- man/fmt_bytes.Rd | 4 +- man/fmt_currency.Rd | 4 +- man/fmt_engineering.Rd | 4 +- man/fmt_integer.Rd | 4 +- man/fmt_number.Rd | 4 +- man/fmt_percent.Rd | 4 +- man/fmt_scientific.Rd | 4 +- man/gt.Rd | 7 ++ tests/testthat/helper-gt_attr_expectations.R | 2 +- tests/testthat/test-gt_object.R | 78 ++++++++++++++++++++ 15 files changed, 191 insertions(+), 24 deletions(-) create mode 100644 R/dt_locale.R diff --git a/DESCRIPTION b/DESCRIPTION index 192528206..1779a6a72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -73,6 +73,7 @@ Collate: 'dt_groups_rows.R' 'dt_has_built.R' 'dt_heading.R' + 'dt_locale.R' 'dt_options.R' 'dt_row_groups.R' 'dt_source_notes.R' diff --git a/R/dt_locale.R b/R/dt_locale.R new file mode 100644 index 000000000..12def19bd --- /dev/null +++ b/R/dt_locale.R @@ -0,0 +1,24 @@ +.dt_locale_key <- "_locale" + +dt_locale_get <- function(data) { + + dt__get(data, .dt_locale_key) +} + +dt_locale_set <- function(data, locale) { + + dt__set(data, .dt_locale_key, locale) +} + +dt_locale_init <- function(data, locale = NULL) { + + list( + locale = locale + ) %>% + dt_locale_set(data = data) +} + +dt_locale_get_value <- function(data) { + + dt_locale_get(data = data)$locale +} diff --git a/R/format_data.R b/R/format_data.R index ec3bf148d..714341fb4 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -97,7 +97,9 @@ #' (United States) and `"fr_FR"` for French (France). The use of a valid #' locale ID will override any values provided in `sep_mark` and `dec_mark`. #' We can use the [info_locales()] function as a useful reference for all of -#' the locales that are supported. +#' the locales that are supported. Any `locale` value provided here will +#' override any global locale setting performed in [gt()]'s own `locale` +#' argument. #' #' @return An object of class `gt_tbl`. #' @@ -168,13 +170,13 @@ fmt_number <- function(data, # Perform input object validation stop_if_not_gt(data = data) + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # 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) @@ -446,13 +448,13 @@ fmt_scientific <- function(data, suffixing <- FALSE use_seps <- TRUE + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # 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 = 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) @@ -623,13 +625,13 @@ fmt_engineering <- function(data, suffixing <- FALSE use_seps <- TRUE + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # 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 = 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) @@ -761,9 +763,6 @@ fmt_symbol <- function(data, 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 = 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) @@ -950,6 +949,9 @@ fmt_percent <- function(data, # Perform input object validation stop_if_not_gt(data = data) + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # Stop function if any columns have data that is incompatible # with this formatter if ( @@ -1125,6 +1127,9 @@ fmt_currency <- function(data, # Perform input object validation stop_if_not_gt(data = data) + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # Stop function if any columns have data that is incompatible # with this formatter if ( @@ -1266,6 +1271,9 @@ fmt_bytes <- function(data, standard <- match.arg(standard) + # Resolve the `locale` value here with the global locale value + locale <- resolve_locale(data = data, locale = locale) + # 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) diff --git a/R/gt.R b/R/gt.R index 3124650d6..eb8af603f 100644 --- a/R/gt.R +++ b/R/gt.R @@ -40,6 +40,11 @@ #' @param id The table ID. By default, with `NULL`, this will be a random, #' ten-letter ID as generated by using the [random_id()] function. A custom #' table ID can be used with any single-length character vector. +#' @param locale An optional locale ID that can be set as the default locale for +#' all functions that take a `locale` argument. Examples of valid locales +#' include `"en_US"` for English (United States) and `"fr_FR"` for French +#' (France). Refer to the information provided by the [info_locales()] to +#' determine which locales are supported. #' @param row_group.sep The separator to use between consecutive group names (a #' possibility when providing `data` as a `grouped_df` with multiple groups) #' in the displayed stub row group label. @@ -90,12 +95,16 @@ gt <- function(data, rownames_to_stub = FALSE, auto_align = TRUE, id = NULL, + locale = NULL, row_group.sep = getOption("gt.row_group.sep", " - ")) { # Stop function if the supplied `id` doesn't conform # to character(1) input or isn't NULL validate_table_id(id) + # Stop function if `locale` does not have a valid value + validate_locale(locale) + if (rownames_to_stub) { # Just a column name that's unlikely to collide with user data rowname_col <- "__GT_ROWNAME_PRIVATE__" @@ -143,6 +152,7 @@ gt <- function(data, data <- dt_summary_init(data = data) data <- dt_options_init(data = data) data <- dt_transforms_init(data = data) + data <- dt_locale_init(data = data, locale = locale) data <- dt_has_built_init(data = data) # Add any user-defined table ID to the `table_id` parameter diff --git a/R/utils_formatters.R b/R/utils_formatters.R index bcfe3f619..71685f267 100644 --- a/R/utils_formatters.R +++ b/R/utils_formatters.R @@ -34,9 +34,11 @@ validate_locale <- function(locale) { # Stop function if the `locale` provided # isn't a valid one if (!is.null(locale) && !(locale %in% locales$base_locale_id)) { - stop("The supplied `locale` is not available in the list of supported locales.\n", - " * Use the `info_locales()` function to see which locales can be used.", - call. = FALSE) + stop( + "The supplied `locale` is not available in the list of supported locales.\n", + " * Use the `info_locales()` function to see which locales can be used.", + call. = FALSE + ) } } @@ -123,6 +125,29 @@ get_locale_dec_mark <- function(locale = NULL, filter_table_to_value(locales, dec_sep, base_locale_id == locale) } +#' Resolve the locale in functions with a `locale` argument +#' +#' This performs locale resolution since the default locale (possibly set in +#' `gt()`) can be overridden with a `locale` set in a downstream function. +#' This performs a final validation of the resolved locale to ensure it has a +#' supported value. +#' +#' @param data The gt object. +#' @param locale The user-supplied `locale` value, found in several `fmt_*()` +#' functions. This is expected as `NULL` if not supplied by the user. +#' +#' @noRd +resolve_locale <- function(data, locale) { + + if (is.null(locale)) { + locale <- dt_locale_get_value(data = data) + } + + validate_locale(locale = locale) + + locale +} + #' Determine which numbers in scientific notation would be zero order #' #' @param x A vector of numeric values, including `NA` values diff --git a/man/fmt_bytes.Rd b/man/fmt_bytes.Rd index 7182cbcf8..937e81620 100644 --- a/man/fmt_bytes.Rd +++ b/man/fmt_bytes.Rd @@ -87,7 +87,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_currency.Rd b/man/fmt_currency.Rd index 3b3a99854..5465148cd 100644 --- a/man/fmt_currency.Rd +++ b/man/fmt_currency.Rd @@ -131,7 +131,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_engineering.Rd b/man/fmt_engineering.Rd index d2c7a4e5d..f33b61a86 100644 --- a/man/fmt_engineering.Rd +++ b/man/fmt_engineering.Rd @@ -65,7 +65,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_integer.Rd b/man/fmt_integer.Rd index 19137838c..4a0c6082b 100644 --- a/man/fmt_integer.Rd +++ b/man/fmt_integer.Rd @@ -85,7 +85,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_number.Rd b/man/fmt_number.Rd index 5c1ea7af3..1b03a21ff 100644 --- a/man/fmt_number.Rd +++ b/man/fmt_number.Rd @@ -110,7 +110,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_percent.Rd b/man/fmt_percent.Rd index 9a0197752..1ab33f959 100644 --- a/man/fmt_percent.Rd +++ b/man/fmt_percent.Rd @@ -92,7 +92,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/fmt_scientific.Rd b/man/fmt_scientific.Rd index e830fa5e5..ed5a9a356 100644 --- a/man/fmt_scientific.Rd +++ b/man/fmt_scientific.Rd @@ -65,7 +65,9 @@ according the locale's rules. Examples include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French (France). The use of a valid locale ID will override any values provided in \code{sep_mark} and \code{dec_mark}. We can use the \code{\link[=info_locales]{info_locales()}} function as a useful reference for all of -the locales that are supported.} +the locales that are supported. Any \code{locale} value provided here will +override any global locale setting performed in \code{\link[=gt]{gt()}}'s own \code{locale} +argument.} } \value{ An object of class \code{gt_tbl}. diff --git a/man/gt.Rd b/man/gt.Rd index 25d0dc019..183dce8e5 100644 --- a/man/gt.Rd +++ b/man/gt.Rd @@ -12,6 +12,7 @@ gt( rownames_to_stub = FALSE, auto_align = TRUE, id = NULL, + locale = NULL, row_group.sep = getOption("gt.row_group.sep", " - ") ) } @@ -42,6 +43,12 @@ calls \code{cols_align(align = "auto")} for all columns.} ten-letter ID as generated by using the \code{\link[=random_id]{random_id()}} function. A custom table ID can be used with any single-length character vector.} +\item{locale}{An optional locale ID that can be set as the default locale for +all functions that take a \code{locale} argument. Examples of valid locales +include \code{"en_US"} for English (United States) and \code{"fr_FR"} for French +(France). Refer to the information provided by the \code{\link[=info_locales]{info_locales()}} to +determine which locales are supported.} + \item{row_group.sep}{The separator to use between consecutive group names (a possibility when providing \code{data} as a \code{grouped_df} with multiple groups) in the displayed stub row group label.} diff --git a/tests/testthat/helper-gt_attr_expectations.R b/tests/testthat/helper-gt_attr_expectations.R index d5718e045..0bb410732 100644 --- a/tests/testthat/helper-gt_attr_expectations.R +++ b/tests/testthat/helper-gt_attr_expectations.R @@ -145,7 +145,7 @@ gt_attr_names <- function() { "_stub_df", "_row_groups", "_heading", "_spanners", "_stubhead", "_footnotes", "_source_notes", "_formats", "_styles", - "_summary", "_options", "_transforms", "_has_built" + "_summary", "_options", "_transforms", "_locale", "_has_built" ) } diff --git a/tests/testthat/test-gt_object.R b/tests/testthat/test-gt_object.R index bf4d412c5..ef48bd15f 100644 --- a/tests/testthat/test-gt_object.R +++ b/tests/testthat/test-gt_object.R @@ -792,3 +792,81 @@ test_that("Escapable characters in rownames are handled correctly in each output fixed = TRUE ) }) + + +test_that("Default locale settings are honored by formatting functions", { + + exibble_1 <- exibble[7, 1] + + # `fmt_number()` + (exibble_1 %>% gt() %>% fmt_number(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,000.00") + (exibble_1 %>% gt(locale = "fr") %>% fmt_number(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000,00") + (exibble_1 %>% gt(locale = "en") %>% fmt_number(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000,00") + (exibble_1 %>% gt(locale = "fr") %>% fmt_number(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777.000,00") + + # `fmt_integer()` + (exibble_1 %>% gt() %>% fmt_integer(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,000") + (exibble_1 %>% gt(locale = "fr") %>% fmt_integer(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000") + (exibble_1 %>% gt(locale = "en") %>% fmt_integer(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000") + (exibble_1 %>% gt(locale = "fr") %>% fmt_integer(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777.000") + + # `fmt_scientific()` + (exibble_1 %>% gt() %>% fmt_scientific(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("7.77 x 10(5)") + (exibble_1 %>% gt(locale = "fr") %>% fmt_scientific(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("7,77 x 10(5)") + (exibble_1 %>% gt(locale = "en") %>% fmt_scientific(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("7,77 x 10(5)") + (exibble_1 %>% gt(locale = "fr") %>% fmt_scientific(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("7,77 x 10(5)") + + # `fmt_engineering()` + (exibble_1 %>% gt() %>% fmt_engineering(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777.00 x 10(3)") + (exibble_1 %>% gt(locale = "fr") %>% fmt_engineering(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,00 x 10(3)") + (exibble_1 %>% gt(locale = "en") %>% fmt_engineering(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,00 x 10(3)") + (exibble_1 %>% gt(locale = "fr") %>% fmt_engineering(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,00 x 10(3)") + + # `fmt_percent()` + (exibble_1 %>% gt() %>% fmt_percent(num, scale_values = FALSE) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777,000.00%") + (exibble_1 %>% gt(locale = "fr") %>% fmt_percent(num, scale_values = FALSE) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000,00%") + (exibble_1 %>% gt(locale = "en") %>% fmt_percent(num, scale_values = FALSE, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777 000,00%") + (exibble_1 %>% gt(locale = "fr") %>% fmt_percent(num, scale_values = FALSE, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("777.000,00%") + + # `fmt_currency()` + (exibble_1 %>% gt() %>% fmt_currency(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("$777,000.00") + (exibble_1 %>% gt(locale = "fr") %>% fmt_currency(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("$777 000,00") + (exibble_1 %>% gt(locale = "en") %>% fmt_currency(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("$777 000,00") + (exibble_1 %>% gt(locale = "fr") %>% fmt_currency(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("$777.000,00") + + exibble_1 <- exibble[8, 1] + + # `fmt_bytes()` + (exibble_1 %>% gt() %>% fmt_bytes(num, ) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("8.9 MB") + (exibble_1 %>% gt(locale = "fr") %>% fmt_bytes(num) %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("8,9 MB") + (exibble_1 %>% gt(locale = "en") %>% fmt_bytes(num, locale = "fr") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("8,9 MB") + (exibble_1 %>% gt(locale = "fr") %>% fmt_bytes(num, locale = "de") %>% render_formats_test(context = "plain"))[["num"]] %>% + expect_equal("8,9 MB") +})