Prefer vctrs functions over slower base R equivalents

NAMESPACE

@@ -52,3 +52,6 @@ importFrom(rlang,is_installed)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,warn)
+importFrom(vctrs,vec_rbind)
+importFrom(vctrs,vec_slice)
+importFrom(vctrs,vec_split)

R/compat-dplyr.R

@@ -13,41 +13,17 @@ lead <- function(x, n = 1L, default = NA) {
 
 arrange <- function(.data, ...) {
   ord <- eval(substitute(order(...)), .data, parent.frame())
-  .data[ord, , drop = FALSE]
+  vec_slice(.data, ord)
 }
 
 arrange_pos_id <- function(data) {
   pos_id <- data$pos_id
   if (is.unsorted(pos_id)) {
-    data <- data[order(pos_id), , drop = FALSE]
+    data <- vec_slice(data, order(pos_id))
   }
   data
 }
 
-bind_rows <- function(x, y = NULL, ...) {
-  if (is.null(x) && is.null(y)) {
-    return(new_styler_df(list()))
-  }
-  if (is.null(x)) {
-    if (inherits(y, "data.frame")) {
-      return(y)
-    }
-    return(do.call(rbind.data.frame, x))
-  }
-  if (is.null(y)) {
-    if (inherits(x, "data.frame")) {
-      return(x)
-    }
-    return(do.call(rbind.data.frame, x))
-  }
-  if (NCOL(x) != NCOL(y)) {
-    for (nme in setdiff(names(x), names(y))) {
-      y[[nme]] <- NA
-    }
-  }
-  bind_rows(rbind.data.frame(x, y), ...)
-}
-
 filter <- function(.data, ...) {
   subset(.data, ...)
 }
@@ -76,13 +52,8 @@ last <- function(x) {
   x[[length(x)]]
 }
 
-slice <- function(.data, ...) {
-  .data[c(...), , drop = FALSE]
-}
-
-# TODO: Use `purrr::map_dfr()` when it stops implicitly relying on `{dplyr}`
-map_dfr <- function(.x, .f, ..., .id = NULL) {
+map_dfr <- function(.x, .f, ...) {
   .f <- purrr::as_mapper(.f, ...)
   res <- map(.x, .f, ...)
-  bind_rows(res, .id = .id)
+  vec_rbind(!!!res)
 }

R/compat-tidyr.R

@@ -3,8 +3,8 @@ nest_ <- function(data, key_col, nest_cols = character()) {
   key_data <- data[[key_column]]
   key_levels <- unique(key_data)
   key_factor <- factor(key_data, levels = key_levels)
-  res <- list()
-  res[[key_column]] <- key_levels
-  res[[key_col]] <- split(data[, nest_cols], key_factor)
-  new_styler_df(res)
+
+  res <- vec_split(data[, nest_cols], key_factor)
+  names(res) <- c(key_column, key_col)
+  res
 }

R/detect-alignment-utils.R

@@ -15,7 +15,7 @@ alignment_ensure_no_closing_brace <- function(pd_by_line,
     pd_by_line[-length(pd_by_line)]
   } else {
     # only drop last elment of last line
-    pd_by_line[[length(pd_by_line)]] <- last[seq2(1L, nrow(last) - 1L), ]
+    pd_by_line[[length(pd_by_line)]] <- vec_slice(last, seq2(1L, nrow(last) - 1L))
     pd_by_line
   }
 }
@@ -29,7 +29,7 @@ alignment_ensure_no_closing_brace <- function(pd_by_line,
 #' @keywords internal
 alignment_drop_comments <- function(pd_by_line) {
   map(pd_by_line, function(x) {
-    out <- x[x$token != "COMMENT", ]
+    out <- vec_slice(x, x$token != "COMMENT")
     if (nrow(out) < 1L) {
       return(NULL)
     } else {
@@ -62,7 +62,7 @@ alignment_drop_last_expr <- function(pds_by_line) {
   pd_last_line <- pds_by_line[[length(pds_by_line)]]
   last_two_lines <- pd_last_line$token[c(nrow(pd_last_line) - 1L, nrow(pd_last_line))]
   if (identical(last_two_lines, c("')'", "expr"))) {
-    pd_last_line <- pd_last_line[-nrow(pd_last_line), ]
+    pd_last_line <- vec_slice(pd_last_line, -nrow(pd_last_line))
   }
   pds_by_line[[length(pds_by_line)]] <- pd_last_line
   pds_by_line
@@ -141,7 +141,7 @@ alignment_serialize_line <- function(relevant_pd_by_line, column) {
     return(NULL)
   }
   between_commas <- seq2(max(1L, comma_idx[column - 1L]), comma_idx[column])
-  relevant_pd_by_line <- relevant_pd_by_line[between_commas, ]
+  relevant_pd_by_line <- vec_slice(relevant_pd_by_line, between_commas)
   alignment_serialize(relevant_pd_by_line)
 }
 

R/detect-alignment.R

@@ -46,7 +46,12 @@ token_is_on_aligned_line <- function(pd_flat) {
   # pos_id too expensive to construct in alignment_ensure_trailing_comma()
   pd_flat$lag_newlines <- pd_flat$pos_id <- NULL
   pd_flat$.lag_spaces <- lag(pd_flat$spaces)
-  pd_by_line <- split(pd_flat, line_idx)
+  pd_by_line_split <- vec_split(pd_flat, line_idx)
+
+  # FIXME: Why are we using names here?
+  pd_by_line <- pd_by_line_split[[2L]]
+  names(pd_by_line) <- as.character(pd_by_line_split[[1L]])
+
   pd_by_line[purrr::map_lgl(pd_by_line, ~ any(.x$stylerignore))] <- NULL
   if (length(pd_by_line) < 1L) {
     return(TRUE)

R/indent.R

@@ -179,7 +179,7 @@ needs_indention_one <- function(pd,
     potential_trigger_pos, before_first_break
   )
   multi_line_token <- pd_is_multi_line(
-    pd[row_idx_between_trigger_and_line_break, ]
+    vec_slice(pd, row_idx_between_trigger_and_line_break)
   )
   remaining_row_idx_between_trigger_and_line_break <- setdiff(
     row_idx_between_trigger_and_line_break,

R/nest.R

@@ -99,12 +99,12 @@ add_cache_block <- function(pd_nested) {
 shallowify <- function(pd) {
   if (cache_is_activated()) {
     order <- order(pd$line1, pd$col1, -pd$line2, -pd$col2, as.integer(pd$terminal))
-    pd_parent_first <- pd[order, ]
-    pos_ids_to_keep <- pd_parent_first %>%
-      split(cumsum(pd_parent_first$parent == 0L)) %>%
+    pd_parent_first <- vec_slice(pd, order)
+    pd_parent_first_split <- vec_split(pd_parent_first, cumsum(pd_parent_first$parent == 0L))
+    pos_ids_to_keep <- pd_parent_first_split[[2L]] %>%
       map(find_pos_id_to_keep) %>%
       unlist(use.names = FALSE)
-    shallow <- pd[pd$pos_id %in% pos_ids_to_keep, ]
+    shallow <- vec_slice(pd, pd$pos_id %in% pos_ids_to_keep)
     shallow$terminal[shallow$is_cached] <- TRUE
     # all cached expressions need to be marked as terminals because to
     # [apply_stylerignore()], we rely on terminals only.
@@ -335,10 +335,9 @@ nest_parse_data <- function(pd_flat) {
       return(pd_flat)
     }
     pd_flat$internal <- with(pd_flat, (id %in% parent) | (parent <= 0L))
-    split_data <- split(pd_flat, pd_flat$internal)
 
-    child <- split_data$`FALSE`
-    internal <- split_data$`TRUE`
+    child <- vec_slice(pd_flat, !pd_flat$internal)
+    internal <- vec_slice(pd_flat, pd_flat$internal)
 
     internal$internal_child <- internal$child
     internal$child <- NULL
@@ -367,14 +366,14 @@ nest_parse_data <- function(pd_flat) {
 #' the correct order.
 #' @param child A parse table or `NULL`.
 #' @param internal_child A parse table or `NULL`.
-#' @details Essentially, this is a wrapper around [dplyr::bind_rows()], but
-#'   returns `NULL` if the result of [dplyr::bind_rows()] is a data frame with
+#' @details Essentially, this is a wrapper around vctrs::vec_rbind()], but
+#'   returns `NULL` if the result of vctrs::vec_rbind()] is a data frame with
 #'   zero rows.
 #' @keywords internal
 combine_children <- function(child, internal_child) {
-  bound <- bind_rows(child, internal_child)
+  bound <- vec_rbind(child, internal_child)
   if (nrow(bound) == 0L) {
     return(NULL)
   }
-  bound[order(bound$pos_id), ]
+  vec_slice(bound, order(bound$pos_id))
 }

R/parse.R

@@ -137,7 +137,7 @@ ensure_correct_txt <- function(pd, text) {
   if (!any(is_problematic_text)) {
     return(pd)
   }
-  problematic_text <- pd[is_problematic_text, ]
+  problematic_text <- vec_slice(pd, is_problematic_text)
   is_parent_of_problematic_string <- pd$id %in% problematic_text$parent
 
   is_unaffected_token <- !magrittr::or(
@@ -167,10 +167,10 @@ ensure_correct_txt <- function(pd, text) {
     names(new_text),
     paste0(line_col_names(), "parent")
   )
-  bind_rows(
+  vec_rbind(
     new_text[, names_to_keep],
-    pd[is_unaffected_token, ],
-    pd[is_parent_of_problematic_string, ]
+    vec_slice(pd, is_unaffected_token),
+    vec_slice(pd, is_parent_of_problematic_string)
   ) %>%
     arrange_pos_id()
 }

R/reindent.R

@@ -96,8 +96,8 @@ set_regex_indention <- function(flattened_pd,
     if (length(cond) < 1L) {
       return(flattened_pd)
     }
-    to_check <- flattened_pd[cond, ]
-    not_to_check <- flattened_pd[-cond, ]
+    to_check <- vec_slice(flattened_pd, cond)
+    not_to_check <- vec_slice(flattened_pd, -cond)
   } else {
     to_check <- flattened_pd
     not_to_check <- NULL
@@ -108,6 +108,6 @@ set_regex_indention <- function(flattened_pd,
     flatten_int()
 
   to_check$lag_spaces[indices_to_force] <- target_indention
-  bind_rows(to_check, not_to_check) %>%
+  vec_rbind(to_check, not_to_check) %>%
     arrange_pos_id()
 }

R/relevel.R

@@ -85,8 +85,8 @@ flatten_pd <- function(pd_nested, token, child_token = token, left = TRUE) {
 #' @keywords internal
 bind_with_child <- function(pd_nested, pos) {
   pd_nested %>%
-    slice(-pos) %>%
-    bind_rows(pd_nested$child[[pos]]) %>%
+    vec_slice(-pos) %>%
+    vec_rbind(pd_nested$child[[pos]]) %>%
     arrange_pos_id()
 }
 
@@ -178,8 +178,8 @@ relocate_eq_assign_nest <- function(pd) {
   idx_eq_assign <- which(pd$token == "EQ_ASSIGN")
   if (length(idx_eq_assign) > 0L) {
     block_id <- find_block_id(pd)
-    blocks <- split(pd, block_id)
-    pd <- map_dfr(blocks, relocate_eq_assign_one)
+    blocks <- vec_split(pd, block_id)
+    pd <- map_dfr(blocks[[2L]], relocate_eq_assign_one)
   }
   pd
 }
@@ -217,7 +217,7 @@ relocate_eq_assign_one <- function(pd) {
   eq_ind <- seq2(idx_eq_assign[1L] - 1L, last(idx_eq_assign) + 1L)
   # initialize because wrap_expr_in_expr -> create_tokens -> requires it
   pd$indent <- 0L
-  eq_expr <- pd[eq_ind, ] %>%
+  eq_expr <- vec_slice(pd, eq_ind) %>%
     wrap_expr_in_expr() %>%
     add_line_col_to_wrapped_expr() %>%
     remove_attributes(c(
@@ -227,8 +227,8 @@ relocate_eq_assign_one <- function(pd) {
   eq_expr$id <- NA
   eq_expr$parent <- NA
   pd$indent <- NULL
-  non_eq_expr <- pd[-eq_ind, ]
-  pd <- bind_rows(eq_expr, non_eq_expr) %>%
+  non_eq_expr <- vec_slice(pd, -eq_ind)
+  pd <- vec_rbind(eq_expr, non_eq_expr) %>%
     arrange_pos_id()
   pd
 }

R/roxygen-examples.R

@@ -8,9 +8,9 @@
 #' @inheritSection parse_transform_serialize_roxygen Hierarchy
 #' @keywords internal
 style_roxygen_code_example <- function(example, transformers, base_indention) {
-  example <- split(example, cumsum(grepl("^#' *@examples", example)))
+  example <- vec_split(example, cumsum(grepl("^#' *@examples", example)))
   purrr::map(
-    example, style_roxygen_code_example_one,
+    example[[2L]], style_roxygen_code_example_one,
     transformers = transformers, base_indention = base_indention
   ) %>%
     flatten_chr()
@@ -28,8 +28,8 @@ style_roxygen_code_example_one <- function(example_one,
   example_one <- example_one[example_one != ""]
 
   bare <- parse_roxygen(example_one)
-  one_dont <- split(bare$text, factor(cumsum(bare$text %in% dont_keywords())))
-  unmasked <- map(one_dont, style_roxygen_code_example_segment,
+  one_dont <- vec_split(bare$text, factor(cumsum(bare$text %in% dont_keywords())))
+  unmasked <- map(one_dont[[2L]], style_roxygen_code_example_segment,
     transformers = transformers,
     base_indention = base_indention
   ) %>%

R/rules-indention.R

@@ -40,7 +40,7 @@ unindent_fun_dec <- function(pd, indent_by = 2L) {
 #' @inheritParams tidyverse_style
 #' @keywords internal
 is_double_indent_function_declaration <- function(pd, indent_by = 2L) {
-  head_pd <- pd[-nrow(pd), ]
+  head_pd <- vec_slice(pd, -nrow(pd))
   line_break_in_header <- which(head_pd$lag_newlines > 0L & head_pd$token == "SYMBOL_FORMALS")
   if (length(line_break_in_header) > 0L) {
     # indent results from applying the rules, spaces is the initial spaces

R/rules-line-breaks.R

@@ -60,7 +60,7 @@ set_line_break_before_curly_opening <- function(pd) {
   if (length(line_break_to_set_idx) > 0L) {
     is_not_curly_curly <- map_chr(
       line_break_to_set_idx + 1L,
-      ~ next_terminal(pd[.x, ], vars = "token_after")$token_after
+      ~ next_terminal(vec_slice(pd, .x), vars = "token_after")$token_after
     ) != "'{'"
     last_expr_idx <- max(which(pd$token == "expr"))
     is_last_expr <- if (any(c("IF", "WHILE") == pd$token[1L])) {

R/rules-tokens.R

@@ -12,7 +12,7 @@ resolve_semicolon <- function(pd) {
     return(pd)
   }
   pd$lag_newlines[lag(is_semicolon)] <- 1L
-  pd <- pd[!is_semicolon, ]
+  pd <- vec_slice(pd, !is_semicolon)
   pd
 }
 
@@ -51,10 +51,7 @@ add_brackets_in_pipe_one <- function(pd, pos) {
       block = NA,
       is_cached = FALSE
     )
-    pd$child[[next_non_comment]] <- bind_rows(
-      pd$child[[next_non_comment]],
-      new_pd
-    ) %>%
+    pd$child[[next_non_comment]] <- vec_rbind(pd$child[[next_non_comment]], new_pd) %>%
       arrange_pos_id()
   }
   pd
@@ -102,7 +99,7 @@ wrap_multiline_curly <- function(pd, indent_by, key_token, space_after = 1L) {
   to_be_wrapped_expr_with_child <- next_non_comment(
     pd, which(pd$token == key_token)[1L]
   )
-  next_terminal <- next_terminal(pd[to_be_wrapped_expr_with_child, ])$text
+  next_terminal <- next_terminal(vec_slice(pd, to_be_wrapped_expr_with_child))$text
   requires_braces <- if_for_while_part_requires_braces(pd, key_token) && !any(pd$stylerignore)
   if (requires_braces || next_terminal == "return") {
     closing_brace_ind <- which(pd$token == key_token)[1L]
@@ -159,7 +156,7 @@ wrap_subexpr_in_curly <- function(pd,
   to_be_wrapped_starts_with_comment <-
     pd$token[ind_to_be_wrapped[1L]] == "COMMENT"
   new_expr <- wrap_expr_in_curly(
-    pd[ind_to_be_wrapped, ],
+    vec_slice(pd, ind_to_be_wrapped),
     stretch_out = c(!to_be_wrapped_starts_with_comment, TRUE),
     space_after = space_after
   )
@@ -169,8 +166,8 @@ wrap_subexpr_in_curly <- function(pd,
     remove_attributes(c("token_before", "token_after"))
 
   pd %>%
-    slice(-ind_to_be_wrapped) %>%
-    bind_rows(new_expr_in_expr) %>%
+    vec_slice(-ind_to_be_wrapped) %>%
+    vec_rbind(new_expr_in_expr) %>%
     set_multi_line() %>%
     arrange_pos_id()
 }
@@ -204,7 +201,7 @@ fix_quotes <- function(pd_flat) {
     return(pd_flat)
   }
 
-  pd_flat$text[str_const] <- map(pd_flat$text[str_const], fix_quotes_one)
+  pd_flat$text[str_const] <- map_chr(pd_flat$text[str_const], fix_quotes_one)
   pd_flat
 }
 

R/styler-package.R

@@ -18,14 +18,16 @@
 #' style_text("a%>%b; a", scope = "tokens")
 "_PACKAGE"
 
-## styler namespace: start
+## usethis namespace: start
 #'
-#' @importFrom rlang abort warn seq2 is_installed "%||%" set_names
-#' @importFrom purrr map map_lgl map_int map_chr map2 map2_chr map_at pmap pwalk
-#' @importFrom purrr compact partial flatten flatten_int flatten_chr
 #' @importFrom magrittr "%>%"
-#'
-## styler namespace: end
+#' @importFrom purrr compact partial flatten flatten_int flatten_chr
+#' @importFrom purrr map map_lgl map_int map_chr map2 map2_chr map_at pmap pwalk
+#' @importFrom rlang abort warn seq2 is_installed "%||%" set_names
+#' @importFrom vctrs vec_rbind
+#' @importFrom vctrs vec_slice
+#' @importFrom vctrs vec_split
+## usethis namespace: end
 NULL