Apply multiple functions to multiple columns of data table in R

user_19574774 0
Viewed 50

I need help to remove a loop in a function using data table.

The code:

f = function(DT, col_by, col_func, col_new, func){
  temp = DT[, mget(unique(c(col_by,col_func)))]
  
##loop to remove
  for ( i in 1:length(func)){
    temp[ ,eval(col_new[i]) := do.call(func[[i]], lapply(col_func, function(x) get(x))), by = mget(col_by)]
  }
##

  temp = unique(temp[,mget(c(col_new, col_by))])
  return(temp)
}

DT = data.table(iris)

col_by = c("Species")
col_func = c("Petal.Length","Petal.Width")
col_new = c("PL.mean","PL.max")
func = list(function(x,y) return(mean(x[y == max(y)])), function(x,y) return(max(x[y == max(y)])))

f(DT, col_by, col_func,col_new,func)

If you have any idea to used data table tricks to remove this loop, let me know!

Thanks a lot for your help :)

data.table r
1 Answers

With another lapply:

f_lapply = function(DT, col_by, col_func, col_new, func){
  temp = DT[, mget(unique(c(col_by,col_func)))]
  
  ##loop to remove
  # 1:length(func)){
  #   temp[ ,eval(col_new[i]) := do.call(func[[i]], lapply(col_func, function(x) get(x))), by = mget(col_by)]
  # }
  ##

  temp[ ,(col_new) := lapply(func, function(y) do.call(y, lapply(col_func, function(x) get(x)))), by = mget(col_by)]
  
  temp = unique(temp[,mget(c(col_new, col_by))])
  return(temp)
}

DT = data.table(iris)

col_by = c("Species")
col_func = c("Petal.Length","Petal.Width")
col_new = c("PL.mean","PL.max")
func = list(function(x,y) return(mean(x[y == max(y)])), function(x,y) return(max(x[y == max(y)])))

f_lapply(DT, col_by, col_func,col_new,func)
#>     PL.mean PL.max    Species
#>       <num>  <num>     <fctr>
#> 1: 1.600000    1.6     setosa
#> 2: 4.800000    4.8 versicolor
#> 3: 5.933333    6.1  virginica

About 25% more efficient on this example:

microbenchmark::microbenchmark(f_lapply(DT, col_by, col_func,col_new,func),
                               f(DT, col_by, col_func,col_new,func))
Unit: milliseconds
                                          expr    min     lq     mean  median      uq     max neval
 f_lapply(DT, col_by, col_func, col_new, func) 2.1065 2.2694 2.791411 2.41730 2.58115 13.4727   100
        f(DT, col_by, col_func, col_new, func) 2.8480 3.0575 3.672728 3.19515 3.46075 17.1140   100
user_135133280
Related