R：使用 data.table := 操作来计算新列答案

【问题标题】：R: using data.table := operations to calculate new columnsR：使用 data.table := 操作来计算新列
【发布时间】：2012-05-22 13:43:07
【问题描述】：

让我们获取以下数据：

dt <- data.table(TICKER=c(rep("ABC",10),"DEF"),
        PERIOD=c(rep(as.Date("2010-12-31"),10),as.Date("2011-12-31")),
        DATE=as.Date(c("2010-01-05","2010-01-07","2010-01-08","2010-01-09","2010-01-10","2010-01-11","2010-01-13","2010-04-01","2010-04-02","2010-08-03","2011-02-05")),
        ID=c(1,2,1,3,1,2,1,1,2,2,1),VALUE=c(1.5,1.3,1.4,1.6,1.4,1.2,1.5,1.7,1.8,1.7,2.3))
setkey(dt,TICKER,PERIOD,ID,DATE)

现在对于每个代码/周期组合，我需要在新列中添加以下内容：

PRIORAVG：每个 ID 的最新 VALUE 的平均值，不包括当前 ID，前提是它不超过 180 天。
PREV：来自同一个 ID 的前一个值。

结果应该是这样的：

      TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
 [1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
 [2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
 [3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
 [4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
 [5,]    ABC 2010-12-31 2010-04-01  1   1.7     1.40  1.5
 [6,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
 [7,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
 [8,]    ABC 2010-12-31 2010-04-02  2   1.8     1.65  1.2
 [9,]    ABC 2010-12-31 2010-08-03  2   1.7     1.70  1.8
[10,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[11,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

注意第 9 行的 PRIORAVG 等于 1.7（这等于第 5 行的 VALUE，这是过去 180 天内另一个 ID 的唯一先前观察）

我发现了data.table 包，但我似乎无法完全理解:= 功能。当我保持简单时，它似乎有效。获取每个ID的先前值（我基于this question的解决方案）：

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),roll=TRUE,mult="last"][,VALUE]]

这很好用，只需 0.13 秒即可对我的数据集执行此操作，其中包含约 250k 行；我的矢量扫描函数得到了相同的结果，但速度慢了大约 30,000 倍。

好的，所以我有我的第一个要求。让我们来看看第二个更复杂的需求。目前对我来说，目前禁食的方法是使用几个向量扫描并通过plyr 函数adply 抛出函数来获得每一行的结果。

calc <- function(df,ticker,period,id,date) {
  df <- df[df$TICKER == ticker & df$PERIOD == period 
        & df$ID != id & df$DATE < date & df$DATE > date-180, ]
  df <- df[order(df$DATE),]
  mean(df[!duplicated(df$ID, fromLast = TRUE),"VALUE"])
}

df <- data.frame(dt)
adply(df,1,function(x) calc(df,x$TICKER,x$PERIOD,x$ID,x$DATE))

我为data.frame 编写了函数，但它似乎不适用于data.table。对于 5000 行的子集，这大约需要 44 秒，但我的数据包含超过 100 万行。我想知道是否可以通过使用:= 来提高效率。

dt[J("ABC"),last(VALUE),by=ID][,mean(V1)]

这可以为 ABC 的每个 ID 选择最新 VALUE 的平均值。

dt[,PRIORAVG:=dt[J(TICKER,PERIOD),last(VALUE),by=ID][,mean(V1)]]

但是，这并没有按预期工作，因为它取所有代码/周期的所有最后 VALUE 的平均值，而不仅仅是当前代码/周期。所以最终所有行都获得相同的平均值。我做错了什么还是这是:=的限制？

【问题讨论】：

提示：加入过去 180 天流行观察的继承范围（使用 i. 前缀：[,j=list(...,age=PERIOD-i.PERIOD,...),][age<180] 和 mult="last"，而不是 last()，也许。
有问题的数据面板看起来与上面的代码提取不同。它似乎缺少)。
添加了显示 180 天要求的预期结果的数据

标签： r data.table

【解决方案1】：

很好的问题。试试这个：

dt
     TICKER     PERIOD       DATE ID VALUE
[1,]    ABC 2010-12-31 2010-01-05  1   1.5
[2,]    ABC 2010-12-31 2010-01-08  1   1.4
[3,]    ABC 2010-12-31 2010-01-10  1   1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5
[5,]    ABC 2010-12-31 2010-01-07  2   1.3
[6,]    ABC 2010-12-31 2010-01-11  2   1.2
[7,]    ABC 2010-12-31 2010-01-09  3   1.6
[8,]    DEF 2011-12-31 2011-02-05  1   2.3

ids = unique(dt$ID)
dt[,PRIORAVG:=NA_real_]
for (i in 1:nrow(dt))
    dt[i,PRIORAVG:=dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
                      mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"]]
dt
     TICKER     PERIOD       DATE ID VALUE PRIORAVG
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA

那么你已经有了一点简化......

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),VALUE,roll=TRUE,mult="last"]]

     TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

如果这可以作为原型，那么一个很大的速度改进将是保持循环但使用set() 而不是:=，以减少开销：

for (i in 1:nrow(dt))
    set(dt,i,6L,dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
                   mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"])
dt
     TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

这应该比问题中显示的重复矢量扫描快很多。

或者，可以对操作进行矢量化。但由于此任务的特性，这将不太容易编写和阅读。

顺便说一句，问题中没有任何数据可以测试 180 天的要求。如果您添加一些并再次显示预期输出，那么我将使用我在 cmets 中提到的连接继承范围添加年龄计算。

【讨论】：

很好的答案。计算我的数据集的第一部分（180k 行）只需要 20 分钟，而向量方法需要几个小时。我喜欢使用 setdiff() 来选择除当前 ID 以外的所有 ID，但我认为它可能会因大量 ID （我的数据集中有 6000 个 ID，每个股票平均只有 16 个 ID）而减慢速度。
好。对于这项任务来说，20 分钟听起来仍然很长。使用set()？无论如何，正如咒语所说，Rprof、Rprof、Rprof。在setdiff() 上是的（如果Rprof 确实表明这是造成时间的原因），您可以预先执行此操作并为每个ID 存储“其他”ID 的列表或环境，然后查找它。或者我可能缺少一种更简单的方法。
确实是使用set()。 setdiff() 本身并不需要太多时间，它是使用 setdiff() 的输出的子集。使用 5k 行的子集进行测试，将 ids 从 738 增加到 5866 会增加 60% 的计算时间。
好的，申请data.table wiki point 3怎么样？为此，您需要更改nomatch=0 以取出NA，因为.Internal(mean,na.rm=TRUE) 忽略na.rm 参数。这将在 v1.8.1 中自动完成。
然后可能不得不取消循环，以获得二进制合并而不是对每一行进行完整的二进制搜索。

【解决方案2】：

使用data.table 更高版本的另一种可能方法：

library(data.table) #data.table_1.12.6 as of Nov 20, 2019
cols <- copy(names(DT))
DT[, c("MIN_DATE", "MAX_DATE") := .(DATE - 180L, DATE)]

DT[, PRIORAVG := 
        .SD[.SD, on=.(TICKER, PERIOD, DATE>=MIN_DATE, DATE<=MAX_DATE),
            by=.EACHI, {
                subdat <- .SD[x.ID!=i.ID]
                pavg <- if (subdat[, .N > 0L])
                    mean(subdat[, last(VALUE), ID]$V1, na.rm=TRUE)
                else 
                    NA_real_
                c(setNames(mget(paste0("i.", cols)), cols), .(PRIORAVG=pavg))
            }]$PRIORAVG
]

DT[, PREV := shift(VALUE), .(TICKER, PERIOD, ID)]

输出：

    TICKER     PERIOD       DATE ID VALUE   MIN_DATE   MAX_DATE PRIORAVG PREV
 1:    ABC 2010-12-31 2010-01-05  1   1.5 2009-07-09 2010-01-05       NA   NA
 2:    ABC 2010-12-31 2010-01-08  1   1.4 2009-07-12 2010-01-08     1.30  1.5
 3:    ABC 2010-12-31 2010-01-10  1   1.4 2009-07-14 2010-01-10     1.45  1.4
 4:    ABC 2010-12-31 2010-01-13  1   1.5 2009-07-17 2010-01-13     1.40  1.4
 5:    ABC 2010-12-31 2010-04-01  1   1.7 2009-10-03 2010-04-01     1.40  1.5
 6:    ABC 2010-12-31 2010-01-07  2   1.3 2009-07-11 2010-01-07     1.50   NA
 7:    ABC 2010-12-31 2010-01-11  2   1.2 2009-07-15 2010-01-11     1.50  1.3
 8:    ABC 2010-12-31 2010-04-02  2   1.8 2009-10-04 2010-04-02     1.65  1.2
 9:    ABC 2010-12-31 2010-08-03  2   1.7 2010-02-04 2010-08-03     1.70  1.8
10:    ABC 2010-12-31 2010-01-09  3   1.6 2009-07-13 2010-01-09     1.35   NA
11:    DEF 2011-12-31 2011-02-05  1   2.3 2010-08-09 2011-02-05       NA   NA

【讨论】：