Skip to main content
Improved function and added benchmark
Source Link
Scarabee
  • 393
  • 1
  • 9
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. 
truthTable <- 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(x) do.call(func, x))
  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
truthTable2 <- function(func, valuesOnly = FALSE) {
  args <- formals(func)
  L <- setNames(rep(list(c(TRUE, FALSE)), length(args)), names(args))
  df <- expand.grid(L)
  result <- sapply(1:nrow(df), function(i) do.call(func, lapply(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. 
Source Link
Scarabee
  • 393
  • 1
  • 9

The main flaw that can be observed in your function is the presence of code duplication: expressions such as 2^numArguments and arguments <- rev(as.logical(intToBits(i-1)))[-(1:(32-numArguments))] appear multiple times. Code duplication is generally bad, you could refactor so that each of them appears only one time.

Other little things:

  • R.utils and stringr are loaded but never used.
  • It's better to use FALSE instead of F.

Here is an alternative solution using expand.grid:

truthTable <- 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(x) do.call(func, x))
  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