data.table 列表列上的元编程映射

Question

我无法使用 data.table 映射嵌套列。我举个例子。

library(data.table)    
library(purrr)

DT <- setDT(list(
  gp = c("A", "B"),
  data = list(
    setDT(list(d1 = c(1, 2, 3), d2 = c(2, 2, 4), d3 = c(0.2, 0.2, 0.4))),
    setDT(list(d1 = c(10, 20, 30), d2 = c(20, 20, 40), d3 = c(0.2, 0.2, 0.4)))
  ),
  metric = c("max", "min")
))

choose_a 和 choose_b 是嵌套的 n 列中的两列。 calc_name 是计算的新列的名称，已由 calc_metric_mean 函数

calc_metric_mean <- function(a, b, metric){
  if(metric == "max"){ 
    return(mean(c(max(a), max(b))))
  }
  if(metric == "min"){
    return(mean(c(min(a), min(b))))
  }
  if(metric == "q74"){
    return(mean(c(quantile(a, 74), quantile(b, 74))))
  }
}

choose_a <- c("d1", "d2", "d2")
choose_b <- c("d3", "d1", "d2")
calc_name <- paste(choose_a, choose_b, sep = '')
metric <- "max"

for(i in 1:length(calc_name)){
  DT[, calc_name[[i]] := map_dbl(
    .x = data,
    ~calc_metric_mean(
      a = choose_a[[i]],
      b = choose_b[[i]],
      metric = "max"
    )
  )]
}

结果会是

   gp              data d1d3 d2d1 d2d2
1:  A <data.table[3x3]>  1.7  3.5    4
2:  B <data.table[3x3]> 15.2 35.0   40

已添加 2021-03-18 第二个测验：如果您在嵌套数据之外的列中有参数“metric”怎么办？结果将是

   gp              data metric d1d3 d2d1 d2d2
1:  A <data.table[3x3]>  max   1.7  3.5    4
2:  B <data.table[3x3]>  min   5.1   15   20

Answer 1

抱歉，如果我没有正确理解问题，但是如果您尝试使用 DT 生成所需的输出，则使用带有 set() 的 for() 循环是一个选项：

for(i in 1:length(calc_name)){
  set(DT, NULL, j = calc_name[i],
    value = lapply(DT$data, function(x){
      calc_metric_mean(a = x[[choose_a[i]]], b = x[[choose_b[i]]], metric = "max")
      }
    )
  )
}

DT

这种方法在某种程度上是一个嵌套的 for 循环，这不是最优雅的，但它完成了工作并且使用 set() 循环仍然可以非常快，因为它是通过引用更新的。需要注意的是，这种方法利用了 data.table 是一个包含 x[[choose_a[i]].

的列表这一事实

为了让我的代码正常工作，我不得不对您的示例设置进行两处小改动。首先，因为你用结构创建了 DT，所以你需要 setDT(DT) 才能使用 set()。其次，我编辑了 calc_metric_mean() 以更明确地说明它 returns 的内容。否则，它为我返回 NULL：

calc_metric_mean <- function(a, b, metric){
  if(metric == "max"){ 
    return(mean(c(max(a), max(b))))
    }
  if(metric == "min"){
    return(mean(c(min(a), min(b))))
    }
  if(metric == "q74"){
    return(mean(c(quantile(a, 74), quantile(b, 74))))
  }
}

Answer 2

感谢@diaggy 的精彩回答，还有另一个答案。

for(i in 1:length(calc_name)){
  DT[, calc_name[i] := lapply(DT$data, function(x){
    calc_metric_mean(a = x[[choose_a[i]]], b = x[[choose_b[i]]], metric = "max")
  })][]
}

这也导致了预期的结果。

> DT
   gp              data d1d3 d2d1 d2d2
1:  A <data.table[3x3]>  1.7  3.5    4
2:  B <data.table[3x3]> 15.2   35   40

还有一些意见要做：

最后的空 [] 是列出 data.table 中的 := 结果所必需的（参见 faqs 中的 2.23）。
双重调用x[[对于评估列表列中的内部列是必要的。出于某种原因，x[ choose_a[i]] returns 字符 choose_a[i] 这将不起作用。

对比之下，还是@diaggy的方案更好：

              expr      min       lq     mean   median       uq     max neval
 eval(diaggys_set) 3.589102 3.849702 4.487934 4.054001 4.516901 10.4261   100
      eval(direct) 4.749001 5.127901 5.844534 5.386051 5.985651 12.9724   100

Answer 3

第一种变体：使用嵌套目标中的变量

lapply 就够了。请参阅@diaggy 的回答。

第二种变体：使用嵌套目标中和外部的变量

如果您必须从其他列加载参数，则需要从 lapply 传递到 mapply。

for(i in 1:length(calc_name)){
  set(DT, NULL, j = calc_name[i],
      value = mapply(function(x, m){
        calc_metric_mean(a = x[[choose_a[i]]], b = x[[choose_b[i]]], metric = m)
      }, x = DT$data, m = DT$metric, SIMPLIFY = FALSE
    )
  )
}

> DT
   gp              data metric d1d3 d2d1 d2d2
1:  A <data.table[3x3]>    max  1.7  3.5    4
2:  B <data.table[3x3]>    min  5.1   15   20

SIMPLIFY = FALSE 如果它将 return 列表而不是向量，则需要 SIMPLIFY = FALSE。

data.table 列表列上的元编程映射

metaprogramming map on data.table list-columns

r

metaprogramming

data.table