Question

我有一个data.table，变量作为列，一列为每行存储不同的函数作为字符。我想简单地将每个函数应用到它的行并将输出存储在一个新列而不使用for循环，因为我需要它快速并且有25000行。

如果我举一个简化的例子，假设我有一个data.table dt：

dt <- data.table(a=c(1,2,3),b=c(4,5,6),c=c(7,8,9),d=c("a+b+c","a*b*c","c/a*b"))
dt
   a b c     d
1: 1 4 7 a+b+c
2: 2 5 8 a*b*c
3: 3 6 9 c/a*b

我希望得到这样的结果：

   a b c     d   e
1: 1 4 7 a+b+c  12
2: 2 5 8 a*b*c  80
3: 3 6 9 c/a*b  18

到目前为止，我找到的唯一解决方案是for循环，但对于我的25000行和32个变量来说速度很慢：

for (i in 1:nrow(dt)){
    dt[i,e:=eval(parse(text=dt[i,d]))]
}

我一直在搜索（尝试使用eval，sapply，......）但到目前为止还没有成功，我真的很感激任何建议。

Answer 1

interpret <- function(expr, .SD) eval(parse(text = expr[1]), envir = .SD)
dt[, e := interpret(d,.SD), by = d, .SDcols = c("a", "b", "c")]
dt

返回：

> dt
   a b c     d   e
1: 1 4 7 a+b+c  12
2: 2 5 8 a*b*c  80
3: 3 6 9 c/a*b  18

虚拟长凳：

l <- lapply(1:1e5, function(i) dt)
bigdt <- rbindlist(l)
bigdt[, e:=interpret(d,.SD), by=d, .SDcols=c("a", "b", "c")]
bigdt
microbenchmark(for (i in 1:nrow(dt)){
  bigdt[i,e:=eval(parse(text=bigdt[i,d]))]
}, bigdt[, e:=interpret(d,.SD), by=d, .SDcols=c("a", "b", "c")])

给了我

Unit: milliseconds
                                                                             expr
 for (i in 1:nrow(dt)) {     bigdt[i, `:=`(e, eval(parse(text = bigdt[i, d])))] }
     bigdt[, `:=`(e, interpret(d, .SD)), by = d, .SDcols = c("a",      "b", "c")]
      min       lq     mean   median       uq      max neval  cld
 2.693427 2.833544 3.240561 3.043713 3.150880  6.212202   100   a 
 6.891739 7.280915 9.988198 8.496646 8.721075 69.666926   100   b
>

Answer 2

来自包invoke_map()的

purrr旨在迭代函数列表和每个函数的参数列表。

这是一个替代方案，稍微长篇大论，想法如何解决这个问题。

dt <- data.frame(a=rep(c(1,2,3, 5), 10),b= rep(c(4,5,6, 5),10),c=rep(c(7,8,9, 5), 10),d=rep(c("a+b+c","a*b*c","c/a*b", "a+b+c"), 10), stringsAsFactors = FALSE)

根据列d

在环境中创建函数

funs_map <- data.frame()
for(i in 1:length(unique(dt$d))){
eval(parse(text = paste('f', i, '<- function(', 'a, b, c', ') { return(' , unique(dt$d)[i] , ')}', sep=''))) 
  funs_map[i,1] <- unique(dt$d)[i]
  funs_map[i,2] <- paste('f', i, sep="")
  }

创建要迭代的函数列表 - 这将是invoke_map的.f参数

funs_list <- as.list(funs_map$V2[match(dt$d , funs_map$V1)])

不再需要最后一栏

dt <- dt[-4]

为每个功能创建一个参数列表 - 这似乎是最耗时的步骤

params <-vector(mode = "list", length = nrow(dt))
for(i in 1:nrow(dt)){
params[[i]] <-   as.list(dt[i,])
}

迭代函数

result <- invoke_map(funs_list, params)

将此代码放入函数和基准测试中：

microbenchmark(apply_funs(dt))
Unit: milliseconds
           expr      min       lq     mean   median       uq      max neval
 apply_funs(dt) 19.27345 20.34213 21.09592 20.66714 21.63639 26.83376   100

原始代码：

Unit: milliseconds
                                                                       expr      min
 for (i in 1:nrow(dt)) {     dt[i, `:=`(e, eval(parse(text = dt[i, d])))] } 353.7435
       lq     mean   median       uq      max neval
 358.0244 362.6764 360.3644 362.9175 439.9213   100

tokiloutok解决方案（最快）：

Unit: milliseconds
                                                                      expr      min
 dt[, `:=`(e, interpret(d, .SD)), by = d, .SDcols = c("a", "b",      "c")] 0.780877
        lq      mean   median        uq      max neval
 0.8148745 0.8432403 0.822787 0.8480175 1.203817   100

将存储在data.table列中的字符表达式列表应用于每行的其他列

2 个答案: