Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Speedup #90

Merged
merged 21 commits into from
Jul 27, 2017
Merged

Speedup #90

Show file tree
Hide file tree
Changes from 16 commits
Commits
Show all changes
21 commits
Select commit Hold shift + click to select a range
ad70d87
remove mutate statments
lorenzwalthert Jul 24, 2017
2c004b7
outsource opening
lorenzwalthert Jul 24, 2017
1497a46
transmute / select
lorenzwalthert Jul 24, 2017
f79bbbd
replace dplyr with base R
lorenzwalthert Jul 24, 2017
8b4debf
early return
lorenzwalthert Jul 25, 2017
3fa0a13
purrr over base R
lorenzwalthert Jul 25, 2017
bc3be9a
more likely condition first
lorenzwalthert Jul 25, 2017
3d41115
primer on performance
lorenzwalthert Jul 25, 2017
1b1792d
use dplyr::between(). Closes #83
lorenzwalthert Jul 25, 2017
5ea6961
drop space in vignette name.
lorenzwalthert Jul 25, 2017
bdb625b
make times argument in rep_char scalar.
lorenzwalthert Jul 26, 2017
32ef3a4
use base R split instead of nest()
lorenzwalthert Jul 26, 2017
c3c5a88
!any(cond) instead of all(!cond)
lorenzwalthert Jul 26, 2017
3fe76fe
lazy
lorenzwalthert Jul 26, 2017
02742a6
pipe -> nested call
lorenzwalthert Jul 26, 2017
cbf94f2
simplify
lorenzwalthert Jul 26, 2017
30aa043
use compute_indent_indices that simplifies code
lorenzwalthert Jul 27, 2017
1690b8f
drop one-step pipe
lorenzwalthert Jul 27, 2017
9b9af35
document
lorenzwalthert Jul 27, 2017
65d99f7
move short to tokenize
lorenzwalthert Jul 27, 2017
c339fa8
update documentation for needs_indention and drop unnecessary paramet…
lorenzwalthert Jul 27, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
57 changes: 26 additions & 31 deletions R/modify_pd.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,33 +9,27 @@ NULL

#' @describeIn update_indention Inserts indetion based on round brackets.
indent_round <- function(pd, indent_by) {
indention_needed <- needs_indention(pd, token = "'('")
opening <- which(pd$token == "'('")
indention_needed <- needs_indention(pd, token = "'('", opening[1])
if (indention_needed) {
opening <- which(pd$token == "'('")
start <- opening + 1
stop <- nrow(pd) - 1
if (start > stop) return(pd)

pd <- pd %>%
mutate(indent = indent + ifelse(seq_len(nrow(pd)) %in% start:stop,
indent_by, 0))
pd$indent <- pd$indent +
ifelse(between(seq_len(nrow(pd)), start, stop), indent_by, 0)
}

pd %>%
set_unindention_child(token = "')'", unindent_by = indent_by)
}
#' @rdname update_indention
indent_curly <- function(pd, indent_by) {
indention_needed <- needs_indention(pd, token = "'{'")
opening <- which(pd$token == "'{'")
indention_needed <- needs_indention(pd, token = "'{'", opening[1])
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we define a function get_indent_indices() instead that returns a (possibly empty) integer vector of positions that need to have indention added?

indent_indices <- get_indent_indices(pd, ...)
if (length(indent_indices) > 0L) pd$indent[indent_indices] <- pd$indent[indent_indices] + 2L

Also, the benchmarks suggest that this doesn't buy us anything.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok, sounds good. I think since dplyr::between() returns boolean values, we better call it compute_indent_flags() and do boolean subsetting instead of integer subsetting. Does that sound reasonable?

indent_round <- function(pd, indent_by) {
  indent_flags <- compute_indent_flags(pd, token = "'('")
  pd$indent[indent_flags] <- pd$indent[indent_flags] + indent_by
  pd %>%
    set_unindention_child(token = "')'", unindent_by = indent_by)
}

compute_indent_flags <- function(pd, token = "'('") {
  npd <- nrow(pd)
  opening <- which(pd$token == token)
  if (!needs_indention(pd, token, opening[1])) return()
  start <- opening + 1
  stop <- npd - 1
  between(seq_len(npd), start, stop)
}

It has only slightly worse performance (<1%) so I think we should do it. It also reduces code duplication.

Copy link
Member

@krlmlr krlmlr Jul 26, 2017 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Indices have the advantage that they can be checked for length zero, and that they only contain the positions that we care about. Essentially, compute_indent_indices <- function(...) which(compute_indent_flags(...)). I'm not sure about performance, because you need to allocate an extra integer vector.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok. I can try that. When I checked the profiling I just got the impression that which() is expensive.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm fine with flags if it works well enough.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok no, I just figured out that which() is not expensive. It was the comparison inside which(), which we can't avoid anyways. Also, always having a numerical vector is better than having NULL sometimes, so I use indices anyways.

if (indention_needed) {
opening <- which(pd$token == "'{'")
start <- opening + 1
stop <- nrow(pd) - 1
if (start > stop) return(pd)

pd <- pd %>%
mutate(indent = indent + ifelse(seq_len(nrow(pd)) %in% start:stop,
indent_by, 0))
pd$indent <- pd$indent +
ifelse(between(seq_len(nrow(pd)), start, stop), indent_by, 0)
}
pd %>%
set_unindention_child(token = "'}'", unindent_by = indent_by)
Expand All @@ -45,14 +39,16 @@ indent_curly <- function(pd, indent_by) {
#'
#' @param pd A parse table.
#' @param token Which token the check should be based on.
#' @param opening the index of the opening parse table. Since always computed
#' before this function is called, it is included as an argument so it does
#' not have to be recomputed.
#' @return returns `TRUE` if indention is needed, `FALSE` otherwise. Indention
#' is needed:
#' * if `token` occurs in `pd`.
#' * if there is no child that starts on the same line as `token` and
#' "opens" indention without closing it on this line.
#' @return `TRUE` if indention is needed, `FALSE` otherwise.
needs_indention <- function(pd, token = "'('") {
opening <- which(pd$token %in% token)[1]
needs_indention <- function(pd, token = "'('", opening) {
if (is.na(opening)) return(FALSE)
before_first_break <- which(pd$lag_newlines > 0)[1] - 1
if (is.na(before_first_break)) return(FALSE)
Expand All @@ -62,13 +58,12 @@ needs_indention <- function(pd, token = "'('") {
#' @rdname update_indention
indent_op <- function(pd, indent_by, token = c(math_token,
"SPECIAL-PIPE")) {
if (needs_indention(pd, token)) {
opening <- which(pd$token %in% token)
opening <- which(pd$token %in% token)
if (needs_indention(pd, token, opening[1])) {
start <- opening[1] + 1
stop <- nrow(pd)
pd <- pd %>%
mutate(indent = indent + ifelse(seq_len(nrow(pd)) %in% start:stop,
indent_by, 0))
pd$indent <- pd$indent +
ifelse(between(seq_len(nrow(pd)), start, stop), indent_by, 0)
}
pd
}
Expand All @@ -77,13 +72,12 @@ indent_op <- function(pd, indent_by, token = c(math_token,
#' after `token`, not all remaining.
indent_assign <- function(pd, indent_by, token = c("LEFT_ASSIGN", "
EQ_ASSIGN")) {
if (needs_indention(pd, token)) {
opening <- which(pd$token %in% token)
opening <- which(pd$token %in% token)
if (needs_indention(pd, token, opening[1])) {
start <- opening + 1
stop <- start + 1
pd <- pd %>%
mutate(indent = indent + ifelse(seq_len(nrow(pd)) %in% start:stop,
indent_by, 0))
pd$indent <- pd$indent +
ifelse(between(seq_len(nrow(pd)), start, stop), indent_by, 0)
}
pd
}
Expand All @@ -105,8 +99,8 @@ indent_without_paren <- function(pd, indent_by = 2) {
#' @param pd A parse table.
#' @importFrom purrr map_lgl
set_multi_line <- function(pd) {
pd %>%
mutate(multi_line = map_lgl(child, token_is_multi_line))
pd$multi_line <- map_lgl(pd$child, token_is_multi_line)
pd
}

#' Check whether a parse table is a multi-line token
Expand All @@ -117,7 +111,7 @@ set_multi_line <- function(pd) {
#' * it has at least one child that is a multi-line expression itself.
#' @param pd A parse table.
token_is_multi_line <- function(pd) {
any(pd$multi_line) | any(pd$lag_newlines)
any(pd$multi_line, pd$lag_newlines > 0)
}


Expand All @@ -127,6 +121,7 @@ token_is_multi_line <- function(pd) {
#' @param pd_flat A flat parse table.
#' @return A nested parse table.
strip_eol_spaces <- function(pd_flat) {
pd_flat %>%
mutate(spaces = spaces * (lead(lag_newlines, default = 0) == 0))
idx <- lead(pd_flat$lag_newlines, default = 0) != 0
pd_flat$spaces[idx] <- 0
pd_flat
}
51 changes: 27 additions & 24 deletions R/nested.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,10 +29,10 @@ compute_parse_data_nested <- function(text) {
add_terminal_token_before() %>%
add_terminal_token_after()

parse_data$child <- rep(list(NULL), length(parse_data$text))
parse_data$short <- substr(parse_data$text, 1, 5)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The short is optional and could be added to the "flat" parse data, too.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do we still need short?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We don't use it further no. I It just helps when working interactively. Should we drop it?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If it helps we should keep it for now.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

moved it into tokenize()


pd_nested <- parse_data %>%
mutate_(child = ~rep(list(NULL), length(text))) %>%
mutate_(short = ~substr(text, 1, 5)) %>%
select_(~short, ~everything()) %>%
nest_parse_data() %>%
flatten_operators()

Expand All @@ -57,13 +57,13 @@ tokenize <- function(text) {
#' description.
#' @param pd A parse table.
enhance_mapping_special <- function(pd) {
pd %>%
mutate(token = case_when(
pd$token <- with(pd, case_when(
token != "SPECIAL" ~ token,
text == "%>%" ~ special_and("PIPE"),
text == "%in%" ~ special_and("IN"),
TRUE ~ special_and("OTHER")
))
pd
}

special_and <- function(text) {
Expand Down Expand Up @@ -98,19 +98,23 @@ NULL

#' @rdname add_token_terminal
add_terminal_token_after <- function(pd_flat) {
pd_flat %>%
terminals <- pd_flat %>%
filter(terminal) %>%
arrange(line1, col1) %>%
transmute(id = id, token_after = lead(token, default = "")) %>%
arrange(line1, col1)

data_frame(id = terminals$id,
token_after = lead(terminals$token, default = "")) %>%
left_join(pd_flat, ., by = "id")
}

#' @rdname add_token_terminal
add_terminal_token_before <- function(pd_flat) {
pd_flat %>%
terminals <- pd_flat %>%
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe faster:

terminals <- which(pd_flat$terminals)
order <- order(pd_flat$line1, pd_flat$col1)[terminals]
data_frame(id = pd_flat$id[order], token_before = ...) %>% ...

Or:

terminals <- which(pd_flat$terminals)
order <- order(pd_flat$line1[terminals], pd_flat$col1[terminals])
data_frame(id = pd_flat$id[terminals][order], token_before = ...) %>% ...

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I tried that but I felt since this function is only called once and it seems pretty inexpensive (10 ms out of 15'460 for the whole run, file R/nested.R), I left it as is, for better legibility. Or do you prefer the rearrangement anyways?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I didn't know that, I just noticed you changed it and assumed that performance matters here. Never mind.

filter(terminal) %>%
arrange(line1, col1) %>%
transmute(id = id, token_before = lag(token, default = "")) %>%
arrange(line1, col1)

data_frame(id = terminals$id,
token_before = lag(terminals$token, default = "")) %>%
left_join(pd_flat, ., by = "id")
}

Expand Down Expand Up @@ -146,24 +150,22 @@ set_spaces <- function(spaces_after_prefix, force_one) {
#' @importFrom purrr map2
nest_parse_data <- function(pd_flat) {
if (all(pd_flat$parent <= 0)) return(pd_flat)
split <- pd_flat %>%
mutate_(internal = ~ (id %in% parent) | (parent <= 0)) %>%
nest_("data", names(pd_flat))
pd_flat$internal <- with(pd_flat, (id %in% parent) | (parent <= 0))
split_data <- split(pd_flat, pd_flat$internal)

child <- split$data[!split$internal][[1L]]
internal <- split$data[split$internal][[1L]]
child <- split_data$`FALSE`
internal <- split_data$`TRUE`

internal <- rename_(internal, internal_child = ~child)

nested <-
child$parent_ <- child$parent
joined <-
child %>%
mutate_(parent_ = ~parent) %>%
nest_(., "child", setdiff(names(.), "parent_")) %>%
left_join(internal, ., by = c("id" = "parent_")) %>%
mutate_(child = ~map2(child, internal_child, combine_children)) %>%
select_(~-internal_child) %>%
select_(~short, ~everything(), ~-text, ~text)

left_join(internal, ., by = c("id" = "parent_"))
nested <- joined
nested$child <- map2(nested$child, nested$internal_child, combine_children)
nested <- nested[, setdiff(names(nested), "internal_child")]
nest_parse_data(nested)
}

Expand All @@ -179,7 +181,8 @@ nest_parse_data <- function(pd_flat) {
combine_children <- function(child, internal_child) {
bound <- bind_rows(child, internal_child)
if (nrow(bound) == 0) return(NULL)
arrange_(bound, ~line1, ~col1)
bound[order(bound$line1, bound$col1), ]

}

#' Get the start right
Expand Down
32 changes: 17 additions & 15 deletions R/parsed.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,9 +44,12 @@ enhance_parse_data <- function(parse_data) {
parse_data_filtered %>%
create_filler()

parse_data_comment_eol <-
parse_data_filled %>%
mutate_(text = ~if_else(token == "COMMENT", gsub(" +$", "", text), text))
parse_data_comment_eol <- parse_data_filled

parse_data_comment_eol$text <-
if_else(parse_data_comment_eol$token == "COMMENT",
gsub(" +$", "", parse_data_comment_eol$text),
parse_data_comment_eol$text)

parse_data_comment_eol
}
Expand Down Expand Up @@ -81,18 +84,17 @@ verify_roundtrip <- function(pd_flat, text) {
#' @return A parse table with two three columns: lag_newlines, newlines and
#' spaces.
create_filler <- function(pd_flat) {
ret <-
pd_flat %>%
mutate_(
line3 = ~lead(line1, default = tail(line2, 1)),
col3 = ~lead(col1, default = tail(col2, 1) + 1L),
newlines = ~line3 - line2,
lag_newlines = ~lag(newlines, default = 0),
col2_nl = ~if_else(newlines > 0L, 0L, col2),
spaces = ~col3 - col2_nl - 1L,
multi_line = ~ifelse(terminal, FALSE, NA)
) %>%
select_(~-line3, ~-col3, ~-col2_nl)

pd_flat$line3 <- lead(pd_flat$line1, default = tail(pd_flat$line2, 1))
pd_flat$col3 <- lead(pd_flat$col1, default = tail(pd_flat$col2, 1) + 1L)
pd_flat$newlines <- pd_flat$line3 - pd_flat$line2
pd_flat$lag_newlines <- lag(pd_flat$newlines, default = 0)
pd_flat$col2_nl <- if_else(pd_flat$newlines > 0L, 0L, pd_flat$col2)
pd_flat$spaces <- pd_flat$col3 - pd_flat$col2_nl - 1L
pd_flat$multi_line <- ifelse(pd_flat$terminal, FALSE, NA)

ret <- pd_flat[, !(names(pd_flat) %in% c("line3", "col3", "col2_nl"))]


if (!("indent" %in% names(ret))) {
ret$indent <- 0
Expand Down
3 changes: 2 additions & 1 deletion R/rules-replacement.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,8 @@ force_assignment_op <- function(pd) {

resolve_semicolon <- function(pd) {
is_semicolon <- pd$token == "';'"
if (!any(is_semicolon)) return(pd)
pd$lag_newlines[lag(is_semicolon)] <- 1L
pd <- pd[!is_semicolon,]
pd <- pd[!is_semicolon, ]
pd
}
Loading