diff --git a/DESCRIPTION b/DESCRIPTION index 96008cf6a..abade383a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -6,7 +6,6 @@ Authors@R: c(person("Kirill", "Müller", role = c("aut"), email = "krlmlr+r@mail Description: Pretty-prints R code without changing the user's formatting intent. Imports: - dplyr, purrr, rlang, rprojroot, @@ -16,6 +15,7 @@ Imports: withr Suggests: data.tree, + dplyr, here, knitr, mockr, @@ -35,6 +35,7 @@ RoxygenNote: 6.0.1.9000 VignetteBuilder: knitr Collate: 'addins.R' + 'dplyr.R' 'initialize.R' 'modify_pd.R' 'nested.R' diff --git a/NAMESPACE b/NAMESPACE index 8bf3e827e..3d2c1df6d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,7 +7,6 @@ export(style_file) export(style_pkg) export(style_text) export(tidyverse_style) -import(dplyr) import(tibble) import(tidyr) importFrom(purrr,flatten) diff --git a/R/dplyr.R b/R/dplyr.R new file mode 100644 index 000000000..7d629d3d3 --- /dev/null +++ b/R/dplyr.R @@ -0,0 +1,107 @@ +lag <- function(x, n = 1L, default = NA, ...) { + if (n == 0) { + return(x) + } + xlen <- length(x) + n <- pmin(n, xlen) + out <- c(rep(default, n), x[seq_len(xlen - n)]) + attributes(out) <- attributes(x) + out +} + +lead <- function(x, n = 1L, default = NA, ...) { + if (n == 0) { + return(x) + } + xlen <- length(x) + n <- pmin(n, xlen) + out <- c(x[-seq_len(n)], rep(default, n)) + attributes(out) <- attributes(x) + out +} + +arrange <- function(.data, ...) { + stopifnot(is.data.frame(.data)) + ord <- eval(substitute(order(...)), .data, parent.frame()) + if (length(ord) != nrow(.data)) { + stop("Length of ordering vectors don't match data frame size", + call. = FALSE) + } + .data[ord, , drop = FALSE] +} + +bind_rows <- function(x, y = NULL) { + if (is.null(x) && is.null(y)) { + return(tibble()) + } + 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 + } + } + rbind.data.frame(x, y) +} + +if_else <- function(condition, true, false, missing = NULL) { + ifelse(condition, true, false) +} + +filter <- function(.data, ...) { + subset(.data, ...) +} + +left_join <- function(x, y, by, ...) { + if (rlang::is_named(by)) { + by_x <- names(by) + by_y <- unname(by) + } else { + by_x <- by_y <- by + } + res <- as_tibble(merge(x, y, by.x = by_x, by.y = by_y, all.x = TRUE, ...)) + res <- arrange(res, line1, col1, line2, col2, parent) + + # dplyr::left_join set unknown list columns to NULL, merge sets them + # to NA + if (exists("child", res) && any(is.na(res$child))) { + res$child[is.na(res$child)] <- list(NULL) + } + res +} + +nth <- function (x, n, order_by = NULL, default = x[NA_real_]) { + stopifnot(length(n) == 1, is.numeric(n)) + n <- trunc(n) + if (n == 0 || n > length(x) || n < -length(x)) { + return(default) + } + if (n < 0) { + n <- length(x) + n + 1 + } + if (is.null(order_by)) { + x[[n]] + } + else { + x[[order(order_by)[[n]]]] + } +} + + +last <- function (x, order_by = NULL, default = x[NA_real_]) { + nth(x, -1L, order_by = order_by, default = default) +} + +slice <- function(.data, ...) { + .data[c(...), , drop = FALSE] +} diff --git a/R/nested.R b/R/nested.R index 22c08ad56..d9a06101b 100644 --- a/R/nested.R +++ b/R/nested.R @@ -41,12 +41,15 @@ tokenize <- function(text) { #' description. #' @param pd A parse table. enhance_mapping_special <- function(pd) { - pd$token <- with(pd, case_when( - token != "SPECIAL" ~ token, - text == "%>%" ~ special_and("PIPE"), - text == "%in%" ~ special_and("IN"), - TRUE ~ special_and("OTHER") - )) + pipes <- pd$token == "SPECIAL" & pd$text == "%>%" + pd$token[pipes] <- special_and("PIPE") + + ins <- pd$token == "SPECIAL" & pd$text == "%in%" + pd$token[ins] <- special_and("IN") + + others <- pd$token == "SPECIAL" & !(pipes | ins) + pd$token[others] <- special_and("OTHER") + pd } @@ -120,7 +123,8 @@ nest_parse_data <- function(pd_flat) { child <- split_data$`FALSE` internal <- split_data$`TRUE` - internal <- rename_(internal, internal_child = ~child) + internal$internal_child <- internal$child + internal$child <- NULL child$parent_ <- child$parent joined <- diff --git a/R/nested_to_tree.R b/R/nested_to_tree.R index 4690ddfee..be5a30cf8 100644 --- a/R/nested_to_tree.R +++ b/R/nested_to_tree.R @@ -35,10 +35,7 @@ create_node_from_nested <- function(pd_nested, parent) { if (is.null(pd_nested)) return() - node_info <- - pd_nested %>% - transmute(formatted = paste0(token, ": ", short, " [", lag_newlines, "/", spaces, "] {", id, "}")) %>% - .[["formatted"]] + node_info <- paste0(pd_nested$token, ": ", pd_nested$short, " [", pd_nested$lag_newlines, "/", pd_nested$spaces, "] {", pd_nested$id, "}") child_nodes <- node_info %>% diff --git a/R/rules-spacing.R b/R/rules-spacing.R index 2fa7fa045..421247379 100644 --- a/R/rules-spacing.R +++ b/R/rules-spacing.R @@ -27,7 +27,7 @@ remove_space_after_unary_pm <- function(pd_flat) { pm_after <- pd_flat$token %in% op_pm pd_flat$spaces[pm_after & (pd_flat$newlines == 0L) & - (dplyr::lag(pd_flat$token) %in% op_pm_unary_after)] <- 0L + (lag(pd_flat$token) %in% op_pm_unary_after)] <- 0L pd_flat } diff --git a/R/serialize.R b/R/serialize.R index 1e94fa78d..e0c15ad24 100644 --- a/R/serialize.R +++ b/R/serialize.R @@ -4,16 +4,10 @@ #' @param flattened_pd A flattened parse table. serialize_parse_data_flattened <- function(flattened_pd) { flattened_pd$lag_newlines[1] <- flattened_pd$line1[1] - 1 - flattened_pd %>% - summarize_( - text_ws = ~paste0( - map(lag_newlines, add_newlines), - map(lag_spaces, add_spaces), - text, - collapse = "")) %>% - .[["text_ws"]] %>% - strsplit("\n", fixed = TRUE) %>% - .[[1L]] - + res <- with(flattened_pd, + paste0(collapse = "", + map(lag_newlines, add_newlines), map(lag_spaces, add_spaces), text) + ) + strsplit(res, "\n")[[1L]] } diff --git a/R/styler.R b/R/styler.R index dc9c976f3..881cb6dd0 100644 --- a/R/styler.R +++ b/R/styler.R @@ -19,7 +19,7 @@ if (getRversion() >= "2.15.1") { utils::globalVariables(c( ".", "pd", "pd_nested", "pd_flat", "flattened_pd", - "line1", "line2", "col1", "col2", + "line1", "line2", "col1", "col2", "parent", "terminal", "text", "short", "spaces", "lag_spaces", "newlines", "lag_newlines", diff --git a/R/visit.R b/R/visit.R index d216c1dd6..4b96793b6 100644 --- a/R/visit.R +++ b/R/visit.R @@ -142,10 +142,13 @@ enrich_terminals <- function(flattened_pd, use_raw_indention = FALSE) { flattened_pd$newlines <- lead(flattened_pd$lag_newlines, default = 0L) flattened_pd$nchar <- nchar(flattened_pd$text, type = "width") + groups <- flattened_pd$line1 flattened_pd <- flattened_pd %>% - group_by(line1) %>% - mutate(col2 = cumsum(nchar + lag_spaces)) %>% - ungroup() + split(groups) %>% + lapply(function(.x) { + .x$col2 <- cumsum(.x$nchar + .x$lag_spaces) + .x}) %>% + bind_rows() flattened_pd$col1 <- flattened_pd$col2 - flattened_pd$nchar flattened_pd } diff --git a/R/ws.R b/R/ws.R index a40b637de..930f9d2ee 100644 --- a/R/ws.R +++ b/R/ws.R @@ -1,6 +1,5 @@ #' @api #' @import tibble -#' @import dplyr #' @import tidyr NULL