Векторизованный if_else или case_when, который не с готовностью оценивает свои потенциальные результаты?

Question

dplyr имеет векторизованные условия if_else и case_when.

Однако оба они охотно оценивают свои возможные выходы (true/false для if_else, RHS формулы для case_when):

suppressPackageStartupMessages({
  library(dplyr)
})

if_else(c(T, T, T), print(1), print(2))
#> [1] 1
#> [1] 2
#> [1] 1 1 1

case_when(
  c(T, T, T) ~ print(1),
  c(F, F, F) ~ print(2)
)
#> [1] 1
#> [1] 2
#> [1] 1 1 1

^{Создано в 2020-02-05 пакетом Представить (v0.3.0)}

Здесь мы можем очевидно, что false случаи оцениваются, даже если они никогда не используются. Я ищу способ избежать этого, так как мой

Есть ли альтернатива, которая этого не делает?

Я знаю, одна альтернатива на самом деле base::ifelse:

ifelse(c(T, T, T), print(1), print(2))
#> [1] 1
#> [1] 1 1 1

Однако base::ifelse общеизвестно неэффективен, так что лучшая альтернатива будет хорошей. При этом меня особенно интересуют альтернативы для case_when, которые я использую довольно часто, когда в противном случае мне нужно было бы использовать цепочку из ifelse s.

Я уже смотрел на data.table::fifelse, но она страдает от той же проблемы:

suppressPackageStartupMessages({
  library(data.table)
})

fifelse(c(T, T, T), print(1), print(2))
#> [1] 1
#> [1] 2
#> [1] 1 1 1

Итак, есть ли альтернатива для if_else и case_when, которая не с готовностью оценивает свои неиспользованные случаи?

Answer 1

Если вы устанавливаете версию разработки data.table из GitHub, вы можете использовать fcase, что похоже на dplyr::case_when, но с ленивой оценкой:

data.table::fcase(c(TRUE, TRUE, TRUE), print(1L), c(FALSE, FALSE, FALSE), print(2L))

[1] 1
[1] 1 1 1

Answer 2

Вы можете просто положиться на ленивую оценку native R передачи параметров и использовать all для проверки случаев, когда FALSE отсутствует:

lazy_if_else <- function(logical_test, value_if_true, value_if_false)
{
  if(all(logical_test)) return(rep(value_if_true, length.out = length(logical_test)))
  if_else(logical_test, value_if_true, value_if_false)
}

Это превосходит ifelse и if_else

microbenchmark::microbenchmark(ifelse(c(T, T, T), 0, Sys.sleep(0.1)),
                               if_else(c(T, T, T), 0, Sys.sleep(0.1)),
                               lazy_if_else(c(T, T, T), 0, Sys.sleep(0.1)))
#> Unit: microseconds
#>                                         expr        min         lq         mean
#>        ifelse(c(T, T, T), 0, Sys.sleep(0.1))     12.662     13.689     25.47675
#>       if_else(c(T, T, T), 0, Sys.sleep(0.1)) 102723.054 109145.897 109678.33523
#>  lazy_if_else(c(T, T, T), 0, Sys.sleep(0.1))      4.791      5.476     10.80378
#>       median         uq        max neval cld
#>      15.3995     34.904     74.255   100  a 
#>  110036.0945 110176.049 116619.936   100   b
#>       6.5030     16.768     26.008   100  a