Improve perf of cols_nanoplot() by not resolving + use more vctrs

R/extract.R

@@ -121,7 +121,7 @@
 #' row groups and row labels. Formatting will be applied to the date- and
 #' currency-based columns.
 #'
-#' ```r
+#' ```{r}
 #' gt_tbl <-
 #'   sp500 |>
 #'   dplyr::filter(date >= "2015-01-05" & date <= "2015-01-16") |>
@@ -136,6 +136,9 @@
 #'   fmt_currency(columns = c(open, high, low, close)) |>
 #'   cols_hide(columns = c(high, low))
 #' 
+#' ```
+#' 
+#' ```r
 #' gt_tbl
 #' ```
 #' 

R/fmt_number.R

@@ -509,7 +509,7 @@ fmt_number <- function(
   #
 
   # Ensure that arguments are matched
-  system <- rlang::arg_match(system, c("intl", "ind"))
+  system <- rlang::arg_match0(system, c("intl", "ind"))
 
   # Stop function if `locale` does not have a valid value; normalize locale
   # and resolve one that might be set globally

R/format_data.R

@@ -9912,7 +9912,7 @@ fmt_passthrough <- function(
       rtf = function(x) {
 
         # Create `x_str` with same length as `x`
-        x_str <- rep(NA_character_, length(x))
+        x_str <- rep_len(NA_character_, length(x))
 
         # Handle formatting of pattern
         x_str <-
@@ -9930,7 +9930,7 @@ fmt_passthrough <- function(
       default = function(x) {
 
         # Create `x_str` with same length as `x`
-        x_str <- rep(NA_character_, length(x))
+        x_str <- rep_len(NA_character_, length(x))
 
         # Handle formatting of pattern
         x_str <-

R/format_vec.R

@@ -3318,8 +3318,14 @@ vec_fmt_markdown <- function(
   }
   # Avoid modifying the output to base64enc in Quarto
   if (check_quarto() && output == "html") {
-    rlang::check_installed("withr", "to use vec_fmt_markdown() in Quarto.")
-    withr::local_envvar(c("QUARTO_BIN_PATH" = ""))
+    # Similar to withr::local_envvar 
+    current_envvar <- Sys.getenv("QUARTO_BIN_PATH")
+    Sys.unsetenv("QUARTO_BIN_PATH")
+    on.exit(
+      Sys.setenv(QUARTO_BIN_PATH = current_envvar),
+      add = TRUE,
+      after = TRUE
+    )
   }
   vec_fmt_out <-
     render_as_vector(

R/nanoplot.R

@@ -363,10 +363,8 @@
 #'
 #' ```r
 #' pizzaplace |>
-#'   dplyr::select(type, date) |>
-#'   dplyr::group_by(date, type) |>
-#'   dplyr::summarize(sold = dplyr::n(), .groups = "drop") |>
-#'   tidyr::pivot_wider(names_from = type, values_from = sold) |>
+#'   dplyr::count(type, date) |>
+#'   tidyr::pivot_wider(names_from = type, values_from = n) |>
 #'   dplyr::slice_head(n = 10) |>
 #'   gt(rowname_col = "date") |>
 #'   tab_header(

R/resolver.R

@@ -257,12 +257,13 @@ resolve_cols_c <- function(
     call = rlang::caller_env()
 ) {
 
-  null_means <- rlang::arg_match(null_means)
-
-  if (identical(Sys.getenv("gt_avoid_resolve"), "true")) {
+  if (identical(Sys.getenv("GT_AVOID_RESOLVE"), "true")) {
     ret <- names(dt_data_get(data))
     return(ret)
   }
+
+  null_means <- rlang::arg_match0(null_means, c("everything", "nothing"))
+
   names(
     resolve_cols_i(
       expr = {{ expr }},
@@ -505,8 +506,11 @@ resolve_rows_i <- function(
     null_means = c("everything", "nothing"),
     call = rlang::caller_env()
 ) {
-
-  null_means <- rlang::arg_match(null_means)
+  if (identical(Sys.getenv("GT_AVOID_RESOLVE"), "true")) {
+    ret <- seq_len(nrow(dt_data_get(data)))
+    return(ret)
+  }
+  null_means <- rlang::arg_match0(null_means, c("everything", "nothing"))
 
   resolved_rows <-
     resolve_rows_l(

R/utils_plots.R

@@ -1022,9 +1022,14 @@ generate_nanoplot <- function(
 
   # Speed up nanoplots number formatting rendering by avoid
   # calling resolve_cols_i() too much.
-  # To be used with caution, but setting this envvar 
-  # for 
-  withr::local_envvar(c("gt_avoid_resolve" = "true"))
+  # To be used with caution, but setting this envvar for all the vec_*() calls
+  # similar to withr::local_envvar()
+  Sys.setenv(GT_AVOID_RESOLVE = "true")
+  on.exit(
+    Sys.unsetenv("GT_AVOID_RESOLVE"),
+    add = TRUE,
+    after = TRUE
+  )
 
   if (plot_type == "bar" && single_horizontal_bar) {
 

tests/testthat/test-cols_nanoplot.R

@@ -1,12 +1,35 @@
-test_that("multiplication works", {
+test_that("cols_nanoplot() works without error ", {
   skip_on_cran()
   # options("lifecycle_verbosity" = "error")
   dat <- dplyr::slice_head(sp500, n = 100)
   tbl_gt <- gt(dat)
-  expect_no_error(
+  expect_no_condition(
     cols_nanoplot(tbl_gt, columns = open:close)
   )
-  expect_no_error(
+  expect_no_condition(
     cols_nanoplot(tbl_gt, columns = open:close, autohide = TRUE)
   )
+
+  expect_no_warning({
+    pizzaplace %>%
+    dplyr::count(date, type, name = "sold") %>%
+    tidyr::pivot_wider(names_from = type, values_from = sold) %>%
+    dplyr::slice_head(n = 10) %>%
+    gt(rowname_col = "date") %>%
+    cols_nanoplot(
+      columns = c(chicken, classic, supreme, veggie),
+      plot_type = "bar",
+      autohide = FALSE,
+      new_col_name = "pizzas_sold",
+      new_col_label = "Sales by Type",
+      options = nanoplot_options(
+        show_data_line = FALSE,
+        show_data_area = FALSE,
+        data_bar_stroke_color = "transparent",
+        data_bar_fill_color = c("brown", "gold", "purple", "green")
+      )
+    ) %>%
+      # make sure the formatter works
+      fmt_number()
+  })
 })

tests/testthat/test-extract_body.R

@@ -1127,4 +1127,4 @@ test_that("Extraction of the table body works with variation in arguments", {
       cols_hide(columns = matches("date")) %>%
       extract_body(incl_stub_cols = FALSE, incl_hidden_cols = TRUE) %>%
       expect_snapshot()
-})
+})