Option to only put currency sign or percent sign in first row

[janekbennett]

For the format functions fmt_currency and fmt_percent, could there be an option to only put the appropriate symbol in the first row of the selection? I guess the option could be called row_1_only or something like that. Also, the values still have to be aligned as if the symbol were there in rows 2 and lower ( or the effect wouldn't be as good).

Thank you!

[meghannash8]

I fully support this feature addition and I would use it extensively.

[rich-iannone]

This seems like a great feature request. Thanks for submitting it! This work can be done alongside other work that'll focus on alignment on characters.

Notes to self (Rich): the extra space allotted for the character (not present in rows 2 and beyond) needs to be accounted for and I think a scheme with (differing-width) space characters might be used here.

[jthomasmock]

Hey @rich-iannone - I'm playing around with some of this, and came up with the following function. In general, this relies on monospace fonts and matching the "suffix" length with &nbsp. This still requires passing raw HTML strings into gt::html(), but it does work out nicely.

Part of the limitation I run into with using gt's native text transform is that it will repeat the input vector, unless I supply a map() function, which requires 2x text_transform() calls (as seen in example 2).

library(gt)
library(tidyverse)

add_nbsp <- function(x, suffix = "", symbol, decimals = 1) {
  suffix <- as.character(suffix)
  symbol <- as.character(symbol)

  if (symbol == "%" | suffix == "%") {
    fmt_val <- round(x, digits = decimals) %>%
      format(nsmall = decimals)
  } else {
    fmt_val <- x
  }

  length_nbsp <- rep("&nbsp", nchar(suffix) + 1) %>%
    paste0(collapse = "")

  symb_add <- c(paste0(suffix, symbol), rep(length_nbsp, length(x) - 1))

  glue::glue("{fmt_val}{symb_add}") %>%
    purrr::map(gt::html)
}

head(gtcars) %>%
  dplyr::mutate(
    hp_pct = (hp / max(hp) * 100) %>% add_nbsp(suffix = "", symbol = "%"),
    hp = add_nbsp(hp, "ft", "&sup3")
  ) %>%
  dplyr::select(mfr, model, year, trim, hp, hp_pct) %>%
  gt() %>%
  opt_table_font(font = google_font("Roboto Mono")) %>%
  cols_align(align = "right", columns = vars(hp, hp_pct))

You can accomplish the same thing with 2x text_transform() calls:

head(gtcars) %>%
  mutate(hp_pct = (hp/max(hp) * 100)) %>% 
  dplyr::select(mfr, model, year, trim, hp, hp_pct) %>%
  gt() %>%
  opt_table_font(font = google_font("Roboto Mono")) %>%
  cols_align(align = "right", columns = vars(hp, hp_pct)) %>% 
  text_transform(
    locations = cells_body(vars(hp), rows = 1),
    fn = function(x){ paste0(x, "ft&sup3") %>% gt::html()}
  ) %>% 
  text_transform(
    locations = cells_body(vars(hp), rows = 2:6),
    fn = function(x){ 
      nbsp_add <- rep("&nbsp", 3) %>% paste0(collapse = "")
      map(x, ~paste0(.x, nbsp_add) %>% gt::html())}
  )

[jthomasmock]

One more try at a more general "wrapper" function.

```{r} fmt_symbol_first <- function(data, column = NULL, symbol = NULL, suffix = "", decimals = NULL, last_row_n = NULL) { # needs to type convert to double to play nicely with decimals and rounding # as it's converted to character by gt::text_transform add_to_first <- function(x, suff = suffix, symb = symbol) { if (!is.null(decimals)) { x <- suppressWarnings(as.double(x)) fmt_val <- round(x, digits = decimals) %>% format(nsmall = decimals) } else { fmt_val <- x } # combine the value, passed suffix, symbol -> html paste0(fmt_val, suff, symb) %>% gt::html() } # repeat non-breaking space for combined length of suffix + symbol if (!is.null(symbol) | !identical(as.character(NULL), character(0))){ suffix <- ifelse(identical(as.character(suffix), character(0)), "", suffix) length_nbsp <- rep(" ", nchar(suffix) + 1) %>% paste0(collapse = "") } else { suffix <- ifelse(identical(as.character(suffix), character(0)), "", suffix) length_nbsp <- rep(" ", nchar(suffix)) %>% paste0(collapse = "") } # affect rows OTHER than the first row add_to_remainder <- function(x, length = length_nbsp) { if (!is.null(decimals)) { x <- suppressWarnings(as.double(x)) fmt_val <- round(x, digits = decimals) %>% format(nsmall = decimals) } else { fmt_val <- x } paste0(fmt_val, length) %>% lapply(FUN = gt::html) } # pass gt object # align right to make sure the spacing is meaningful data %>% cols_align(align = "right", columns = vars({{ column }})) %>% # transform first rows text_transform( locations = cells_body(vars({{ column }}), rows = 1), fn = add_to_first ) %>% # transform remainng rows text_transform( locations = cells_body(vars({{ column }}), rows = 2:last_row_n), fn = add_to_remainder ) } gtcars %>% head() %>% dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>% dplyr::mutate(mpg_h = rnorm(n = dplyr::n(), mean = 22, sd = 1)) %>% gt() %>% opt_table_font(font = google_font("Roboto Mono")) %>% opt_table_lines() %>% fmt_symbol_first(column = mfr, symbol = "$", suffix = " ", last_row_n = 6) %>% fmt_symbol_first(column = year, symbol = NULL, suffix = "%", last_row_n = 6) %>% fmt_symbol_first(column = mpg_h, symbol = "%", suffix = NULL, last_row_n = 6, decimals = 1) %>% fmt_symbol_first(column = hp, symbol = "%", suffix = " S", last_row_n = 6, decimals = NULL) ```

gtcars %>% 
  head() %>% 
  dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>% 
  dplyr::mutate(mpg_h = rnorm(n = dplyr::n(), mean = 22, sd = 1)) %>% 
  gt() %>% 
  opt_table_font(font = google_font("Roboto Mono")) %>%
  opt_table_lines() %>% 
  fmt_symbol_first(column = mfr, symbol = "$", suffix = " ", last_row_n = 6) %>%
  fmt_symbol_first(column = year, symbol = NULL, suffix = "%", last_row_n = 6) %>%
  fmt_symbol_first(column = mpg_h, symbol = "%", suffix = NULL, last_row_n = 6, decimals = 1) %>% 
  fmt_symbol_first(column = hp, symbol = "°", suffix = " F", last_row_n = 6, decimals = NULL)