fast.R

library(tidyverse)

## ── Attaching packages ──────────────────────────────── tidyverse 1.3.0.9000 ──

## ✓ ggplot2 3.3.0            ✓ purrr   0.3.3.9000  
## ✓ tibble  2.99.99.9014     ✓ dplyr   0.8.5       
## ✓ tidyr   1.0.2            ✓ stringr 1.4.0       
## ✓ readr   1.3.1.9000       ✓ forcats 0.5.0

## ── Conflicts ──────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()

library(vctrs)
library(rlang)

## 
## Attaching package: 'rlang'

## The following objects are masked from 'package:purrr':
## 
##     %@%, as_function, flatten, flatten_chr, flatten_dbl, flatten_int,
##     flatten_lgl, flatten_raw, invoke, list_along, modify, prepend,
##     splice

Implementation sketch

fast_if_else <- function(condition, true, false, ..., .env = caller_env()) {
  dots <- enquos(..., .named = TRUE)
  if (is_empty(dots) && exists(".data", .env, inherits = FALSE)) {
    # FIXME: Install lazy data mask
    dots <- as.list(.env$.top_env)
  } else {
    dots <- lapply(dots, eval_tidy)
  }

  data <- tibble(!!!dots)

  true <- enexpr(true)
  false <- enexpr(false)
  conds <- list(false, true)

  grouped_data <-
    data %>%
    group_by(..idx = !!condition + 1L)

  rows <-
    grouped_data %>%
    group_rows()

  recipe <-
    grouped_data %>%
    summarize(
      res = list(eval_tidy(conds[[ ..idx[[1]] ]])),
      target_idx = rows[ ..idx[[1]] ]
    ) %>%
    ungroup()

  target_idx <- recipe$target_idx
  res <- recipe$res

  out_idx <- rep(NA_integer_, length(condition))
  out_idx[ target_idx[[1]] ] <- seq_along(target_idx[[1]])
  out <- vec_slice(res[[1]], out_idx)

  for (i in seq2(2, nrow(recipe))) {
    out <- vec_assign(out, target_idx[[i]], res[[i]])
  }

  out
}

slow <- function(x) {
  Sys.sleep(0.05 * length(x))
  x
}

Results

x <- 1:10

system.time(
  if_else(x < 5, slow(x), slow(-x), x)
)

##    user  system elapsed 
##   0.008   0.000   1.010

system.time(
  fast_if_else(x < 5, slow(x), slow(-x), x)
)

##    user  system elapsed 
##   0.030   0.000   0.531

tibble(xx = x) %>%
  mutate(yy = fast_if_else(xx < 5, slow(xx), slow(-xx)))

## # A tibble: 10 x 2
##       xx    yy
##    <int> <int>
##  1     1     1
##  2     2     2
##  3     3     3
##  4     4     4
##  5     5    -5
##  6     6    -6
##  7     7    -7
##  8     8    -8
##  9     9    -9
## 10    10   -10