Use less dplyr in the codebase in favor of vctrs for speed + add a wo…

…rkaround to disable column resolve when it is not necessary to speed up `cols_nanoplot()`

R/cols_add.R

@@ -427,7 +427,7 @@ cols_add <- function(
   if (is.null(resolved_column_before) && is.null(resolved_column_after)) {
 
     updated_data_tbl <-
-      dplyr::bind_cols(
+      vctrs::vec_cbind(
         data_tbl,
         data_tbl_new_cols
       )
@@ -445,16 +445,16 @@ cols_add <- function(
     if (before_colnum <= 1) {
       # put new column first
       updated_data_tbl <-
-        dplyr::bind_cols(
+        vctrs::vec_cbind(
           data_tbl_new_cols,
           data_tbl
         )
     } else {
       updated_data_tbl <-
-        dplyr::bind_cols(
-          dplyr::select(data_tbl, 1:(dplyr::all_of(before_colnum) - 1)),
+        vctrs::vec_cbind(
+          data_tbl[1:(before_colnum - 1)],
           data_tbl_new_cols,
-          dplyr::select(data_tbl, dplyr::all_of(before_colnum):ncol(data_tbl))
+          data_tbl[before_colnum:ncol(data_tbl)]
         )
     }
 
@@ -474,15 +474,15 @@ cols_add <- function(
 
     updated_data_tbl <-
       dplyr::bind_cols(
-        dplyr::select(data_tbl, 1:dplyr::all_of(after_colnum)),
+        data_tbl[1:(after_colnum)],
         data_tbl_new_cols,
-        dplyr::select(data_tbl, (after_colnum + 1):ncol(data_tbl))
+        data_tbl[(after_colnum + 1):ncol(data_tbl)]
       )
 
     after_colnum <- which(boxh_df[["var"]] == resolved_column_after)
 
     updated_boxh_df <-
-      dplyr::bind_rows(
+      vctrs::vec_rbind(
         boxh_df[1:after_colnum, ],
         boxh_df_new_cols,
         boxh_df[(after_colnum + 1):nrow(boxh_df), ]

R/dt_summary.R

@@ -272,15 +272,12 @@ dt_summary_build <- function(data, context) {
     )] <- NA_real_
 
     summary_dfs_data <-
-      dplyr::select(
-        summary_dfs_data,
-        dplyr::all_of(c(
-          group_id_col_private,
-          row_id_col_private,
-          rowname_col_private,
-          colnames(body)
-        ))
-      )
+      summary_dfs_data[c(
+        group_id_col_private,
+        row_id_col_private,
+        rowname_col_private,
+        colnames(body)
+      )]
 
     #
     # Format with formatting formulae
@@ -297,11 +294,8 @@ dt_summary_build <- function(data, context) {
     summary_dfs_display_gt[["_data"]][is.na(summary_dfs_display_gt[["_data"]])] <-
       NA
 
-    summary_dfs_display_gt[["_stub_df"]] <-
-      dplyr::mutate(
-        summary_dfs_display_gt[["_stub_df"]],
-        row_id = gsub("__[0-9]*", "", row_id)
-      )
+    summary_dfs_display_gt[["_stub_df"]]$row_id <-
+      gsub("__[0-9]*", "", summary_dfs_display_gt[["_stub_df"]]$row_id)
 
     for (k in seq_along(fmt_exprs)) {
 
@@ -414,7 +408,7 @@ dt_summary_build <- function(data, context) {
     labels_processed <- unlist(lapply(labels, FUN = process_text, context = context))
 
     for (i in seq_len(nrow(summary_dfs_display))) {
-      summary_dfs_display[i, ][["::rowname::"]] <-
+      summary_dfs_display[i, ][[rowname_col_private]] <-
         unname(labels_processed[names(labels_processed) == summary_dfs_display[i, ][["::row_id::"]]])
     }
 

R/extract.R

@@ -396,7 +396,8 @@ assemble_body_extract <- function(
     }
 
     if (!is.null(rowname_col)) {
-      names(out_df)[names(out_df) == rowname_col] <- "::rowname::"
+      # ::rowname::
+      names(out_df)[names(out_df) == rowname_col] <- rowname_col_private
     }
   }
 

R/format_data.R

@@ -4953,12 +4953,12 @@ format_bins_by_context <- function(x, sep, fmt, context) {
 
     # Format the LHS and RHS values
     val_tbl <-
-      dplyr::tibble(
+      vctrs::data_frame(
         left = as.numeric(x_str_lhs),
         right = as.numeric(x_str_rhs)
       )
 
-    val_tbl_gt <- gt(val_tbl)
+    val_tbl_gt <- gt(val_tbl, groupname_col = NULL)
 
     # Ensure that the expression (a RHS formula) is made a closure
     format_fn <- rlang::as_closure(fmt)

R/helpers.R

@@ -705,7 +705,11 @@ unit_conversion <- function(from, to) {
   }
 
   row_conversion <-
-    dplyr::filter(conversion_factors, from == {{ from }}, to == {{ to }})
+    vctrs::vec_slice(
+      conversion_factors,
+      conversion_factors$from == from &
+        conversion_factors$to == to
+    )
 
   # In the case where units are valid and available in the internal dataset,
   # they may be across categories; such pairings do not allow for a conversion

R/render_as_i_html.R

@@ -412,9 +412,9 @@ render_as_ihtml <- function(data, id) {
   col_defs <- c(col_defs, group_col_defs, row_name_col_def)
 
   styles_tbl <- dt_styles_get(data = data)
-  body_styles_tbl <- dplyr::filter(styles_tbl, locname %in% c("data", "stub"))
+  body_styles_tbl <- vctrs::vec_slice(styles_tbl, styles_tbl$locname %in% c("data", "stub"))
   body_styles_tbl <- dplyr::arrange(body_styles_tbl, colnum, rownum)
-  body_styles_tbl <- dplyr::select(body_styles_tbl, colname, rownum, html_style)
+  body_styles_tbl <- dplyr::select(body_styles_tbl, "colname", "rownum", "html_style")
 
   # Generate styling rule per combination of `colname` and
   # `rownum` in `body_styles_tbl`
@@ -426,7 +426,7 @@ render_as_ihtml <- function(data, id) {
         colname <- body_styles_tbl[x, ][["colname"]]
         rownum <- body_styles_tbl[x, ][["rownum"]]
         html_style <- body_styles_tbl[x, ][["html_style"]]
-        html_style <- unlist(strsplit(html_style, "; "))
+        html_style <- unlist(strsplit(html_style, "; ", fixed = TRUE))
         html_style <- gsub("(-)\\s*(.)", "\\U\\2", html_style, perl = TRUE)
         html_style <- gsub("(:)\\s*(.*)", ": '\\2'", html_style, perl = TRUE)
         html_style <- paste(html_style, collapse = ", ")
@@ -537,7 +537,10 @@ render_as_ihtml <- function(data, id) {
   if (has_tab_spanners) {
 
     hidden_columns <- dt_boxhead_get_var_by_type(data = data, type = "hidden")
-    col_groups <- dplyr::filter(dt_spanners_get(data = data), spanner_level == 1)
+    spanners_df <- dt_spanners_get(data = data)
+    col_groups <- vctrs::vec_slice(
+      spanners_df, spanners_df$spanner_level == 1
+    )
 
     for (i in seq_len(nrow(col_groups))) {
 

R/resolver.R

@@ -181,8 +181,10 @@ resolve_cells_column_spanners <- function(
     }
 
     # filter for levels
-    spanners <- spanners %>% dplyr::filter(spanner_level %in% levels)
-
+    spanners <- vctrs::vec_slice(
+      spanners,
+      spanners$spanner_level %in% levels
+    )
   }  #
   # Resolution of spanners as column spanner names
   #
@@ -256,7 +258,11 @@ resolve_cols_c <- function(
 ) {
 
   null_means <- rlang::arg_match(null_means)
-
+
+  if (identical(Sys.getenv("gt_avoid_resolve"), "true")) {
+    ret <- names(dt_data_get(data))
+    return(ret)
+  }
   names(
     resolve_cols_i(
       expr = {{ expr }},

R/tab_info.R

@@ -197,13 +197,13 @@ tab_info <- function(data) {
 
     groups_rows <- dt_row_groups_get(data = data)
 
-    row_groups <- dplyr::select(stub_df, id = group_id, label = group_label)
+    row_groups <- dplyr::select(stub_df, id = "group_id", label = "group_label")
     row_groups <- dplyr::filter(row_groups, dplyr::row_number() == 1, .by = "id")
     row_groups <- dplyr::mutate(row_groups, i = which(groups_rows %in% id))
     row_groups$type <- NA_character_
     row_groups$label <- unlist(row_groups$label)
     row_groups$location <- "Row Groups"
-    row_groups <- dplyr::select(row_groups, id, i, label, type, location)
+    row_groups <- row_groups[c("id", "i", "label", "type", "location")]
 
   } else {
     row_groups <- empty_tbl

R/tab_options.R

@@ -880,7 +880,7 @@ tab_options <- function(
   new_df <-
     dplyr::left_join(
       new_df,
-      dplyr::select(opts_df, parameter, type),
+      dplyr::select(opts_df, "parameter", "type"),
       by = "parameter"
     )
   new_df$value <- mapply(

R/utils.R

@@ -2384,7 +2384,8 @@ column_classes_are_valid <- function(data, columns, valid_classes, call = rlang:
     )
 
   table_data <- dt_data_get(data = data)
-  table_data <- dplyr::select(table_data, dplyr::all_of(resolved))
+  # select all resolved columns
+  table_data <- table_data[resolved]
 
   all(
     vapply(

R/utils_plots.R

@@ -1020,6 +1020,12 @@ generate_nanoplot <- function(
     bar_tags <- paste(bar_strings, collapse = "\n")
   }
 
+  # 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"))
+
   if (plot_type == "bar" && single_horizontal_bar) {
 
     # This type of display assumes there is only a single `y` value and there
@@ -2204,7 +2210,7 @@ format_number_compactly <- function(
   }
 
   # Format value accordingly
-
+  
   if (!is.null(currency)) {
 
     if (abs(val) >= 1e15) {

R/utils_render_grid.R

@@ -104,15 +104,15 @@ create_heading_component_g <- function(data) {
 
   title_styles <- NA_character_
   if ("title" %in% styles_tbl$locname) {
-    title_style_rows <- dplyr::filter(styles_tbl, locname == "title")
+    title_style_rows <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "title")
     if (nrow(title_style_rows) > 0) {
       title_styles <- title_style_rows$html_style
     }
   }
 
   subtitle_styles <- NA_character_
   if (subtitle_defined && "subtitle" %in% styles_tbl$locname) {
-    subtitle_style_rows <- dplyr::filter(styles_tbl, locname == "subtitle")
+    subtitle_style_rows <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "subtitle")
     if (nrow(subtitle_style_rows) > 0) {
       subtitle_styles <- subtitle_style_rows$html_style
     }
@@ -762,7 +762,7 @@ create_source_notes_component_g <- function(data) {
 
   style <- NA
   if ("source_notes" %in% styles_tbl$locname) {
-    source_notes_style <- dplyr::filter(styles_tbl, locname == "source_notes")
+    source_notes_style <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "source_notes")
     if (nrow(source_notes_style)) {
       style <- source_notes_style$html_style
     }
@@ -804,7 +804,7 @@ create_footnotes_component_g <- function(data) {
 
   style <- NA
   if ("footnotes" %in% styles_tbl$locname) {
-    footnotes_style <- dplyr::filter(styles_tbl, locname == "footnotes")
+    footnotes_style <- vctrs::vec_slice(styles_tbl, styles_tbl$locname == "footnotes")
     if (nrow(footnotes_style) > 0) {
       style <- footnotes_style$html_style
     }

R/utils_render_html.R

@@ -270,13 +270,13 @@ get_table_defs <- function(data) {
   if ("stub" %in% widths[["type"]]) {
     stub_idx <- which(widths$type == "stub")
     othr_idx <- base::setdiff(seq_len(nrow(widths)), stub_idx)
-    widths <- dplyr::slice(widths, stub_idx, othr_idx)
+    widths <- vctrs::vec_slice(widths, c(stub_idx, othr_idx))
   }
 
   if ("row_group" %in% widths[["type"]] && row_group_as_column) {
     row_group_idx <- which(widths$type == "row_group")
     othr_idx <- base::setdiff(seq_len(nrow(widths)), row_group_idx)
-    widths <- dplyr::slice(widths, row_group_idx, othr_idx)
+    widths <- vctrs::vec_slice(widths, c(row_group_idx, othr_idx))
   }
 
   widths <- widths[seq_len(nrow(widths)), "column_width", drop = TRUE]

R/utils_render_latex.R

@@ -165,13 +165,13 @@ create_table_start_l <- function(data, colwidth_df) {
   if ("stub" %in% colwidth_df_visible[["type"]]) {
     stub_idx <- which(colwidth_df_visible$type == "stub")
     othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), stub_idx)
-    colwidth_df_visible <- dplyr::slice(colwidth_df_visible, stub_idx, othr_idx)
+    colwidth_df_visible <- vctrs::vec_slice(colwidth_df_visible, c(stub_idx, othr_idx))
   }
 
   if ("row_group" %in% colwidth_df_visible[["type"]]) {
     row_group_idx <- which(colwidth_df_visible$type == "row_group")
     othr_idx <- base::setdiff(seq_len(nrow(colwidth_df_visible)), row_group_idx)
-    colwidth_df_visible <- dplyr::slice(colwidth_df_visible, row_group_idx, othr_idx)
+    colwidth_df_visible <- vctrs::vec_slice(colwidth_df_visible, c(row_group_idx, othr_idx))
   }
 
   # Determine if there are any footnotes or source notes; if any,
@@ -454,7 +454,7 @@ create_columns_component_l <- function(data, colwidth_df) {
 
     styles_stubhead <-
       consolidate_cell_styles_l(
-        dplyr::filter(styles_tbl, locname == "stubhead")
+        vctrs::vec_slice(styles_tbl, styles_tbl$locname == "stubhead")
       )
 
     headings_vars <- prepend_vec(headings_vars, "::stub")
@@ -948,7 +948,7 @@ summary_rows_for_group_l <- function(
     styles_df <- dt_styles_get(data)
     styles_df <- styles_df[styles_df$locname == loc_type & styles_df$grpname == group_id, , drop = FALSE]
     # set colname to ::rowname:: if colname is present and colnum = 0
-    styles_df$colname[is.na(styles_df$colname) & styles_df$colnum == 0] <- "::rowname::"
+    styles_df$colname[is.na(styles_df$colname) & styles_df$colnum == 0] <- rowname_col_private
 
     styles_summary <- styles_df[styles_df$colname == col_name, , drop = FALSE]