truthTabletruthTable2 <- function(func, valuesOnly = FALSE) {
args <- formals(func)
L <- setNames(rep(list(c(TRUE, FALSE)), length(args)), names(args))
df <- expand.grid(L)
result <- sapply(split(df, 1:nrow(df)), function(xi) do.call(func, xlapply(df, `[`, i)))
# or result <- do.call(func, df) if func is vectorized
if (valuesOnly) {
unname(result)
} else {
df[[substitute(func)]] <- result
as.matrix(df)
}
}
truthTable(majority)
# a b c majority
# [1,] TRUE TRUE TRUE TRUE
# [2,] FALSE TRUE TRUE TRUE
# [3,] TRUE FALSE TRUE TRUE
# [4,] FALSE FALSE TRUE FALSE
# [5,] TRUE TRUE FALSE TRUE
# [6,] FALSE TRUE FALSE FALSE
# [7,] TRUE FALSE FALSE FALSE
# [8,] FALSE FALSE FALSE FALSE
Benchmark:
bench::mark(
truthTable(majority),
truthTable2(majority),
check = FALSE
)
# # A tibble: 2 x 13
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time result memory time
# <bch:expr> <bch:t> <bch:t> <dbl> <bch:byt> <dbl> <int> <dbl> <bch:tm> <list> <list> <lis>
# 1 truthTable(majority) 89.5us 97.4us 9634. 1.44KB 6.22 4650 3 483ms <lgl[~ <df[,~ <bch~
# 2 truthTable2(majority) 189.6us 204.7us 4292. 0B 4.07 2110 2 492ms <lgl[~ <df[,~ <bch~
# # ... with 1 more variable: gc <list>
bigf <- function(a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) TRUE
bench::mark(
truthTable(bigf),
truthTable2(bigf),
check = FALSE
)
# # A tibble: 2 x 13
# expression min median `itr/sec` mem_alloc `gc/sec` n_itr n_gc total_time result memory time gc
# <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl> <int> <dbl> <bch:tm> <list> <list> <list> <list>
# 1 truthTable(bigf) 2.13s 2.13s 0.469 64MB 5.63 1 12 2.13s <lgl[,18] [131,072 ~ <df[,3] [262,351~ <bch:t~ <tibble [1 x~
# 2 truthTable2(bigf) 2.43s 2.43s 0.412 76.5MB 5.77 1 14 2.43s <lgl[,18] [131,072 ~ <df[,3] [262,218~ <bch:t~ <tibble [1 x~
# Warning message:
# Some expressions had a GC in every iteration; so filtering is disabled.