Data.table 循环效率答案

【问题标题】：Data.table loop efficiencyData.table 循环效率
【发布时间】：2014-03-08 10:18:21
【问题描述】：

我有两个具有 34 列的 data.tables，其中的列完全相同。

Month SpId1 SpId2 ... SpId33

编辑：这里是使用来自Reproducible Example的重现功能的示例数据

AltSuitSp1 <- data.table(structure(list(Month = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L,12L, 12L, 12L), .Label = c("1", "10", "11", "12", "2", "3", "4","5", "6", "7", "8", "9"), class = "factor"), SpdSpSuit = c(0,0, 0, 0, 0, 0, 0, 0, 0, 0), SpdIncSuit = c(0, 0, 0,0, 0, 0, 0, 0, 0, 0), SpdGrowSuit = c(0.4625, 0.4625, 0.4625, 0.4625, 0.4625, 0.4625, 0.4625,0.4625, 0.4625, 0.4625), RzbSpSuit = c(0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333), RzbIncSuit = c(0.34,0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34), RzbGrowSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333), FMSSpSuit = c(0.34,0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34, 0.34), FMSIncSuit = c(0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425), FMSGrowSuit = c(0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333), BhsSpSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.233333333, 0.233333333, 0.233333333), BhsIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), BhsGrowSuit = c(0.283333333,0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.283333333, 0.233333333, 0.233333333, 0.233333333), BrtSpSuit = c(0.866666667,0.866666667, 0.866666667, 0.866666667, 0.866666667, 0.866666667,0.866666667, 0.54, 0.54, 0.54), BrtIncSuit = c(0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.8, 0.43, 0.43, 0.43), BrtGrSuit = c(0.8, 0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.86, 0.86, 0.86), CcfSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), CcfIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0),CcfGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), RbtSpSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), RbtIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0,0), RbtGrSuit = c(0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.95, 0.925, 0.925, 0.925), SmbSpSuit = c(0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.675, 0.675,0.675), SmbIncSuit = c(0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.75, 0.766666667,0.766666667, 0.766666667), SmbGrSuit = c(0.9, 0.9, 0.9, 0.9, 0.9, 0.9, 0.9, 0.0875, 0.0875, 0.0875), StbSpSuit = c(0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425, 0.425), StbIncSuit = c(0, 0,0, 0, 0, 0, 0, 0, 0, 0), StbGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), HbcSpSuit = c(0, 0, 0, 0, 0, 0, 0,0, 0, 0), HbcIncSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0,0), HbcGrSuit = c(0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.425, 0.425, 0.425)), .Names = c("Month", "SpdSpSuit", "SpdIncSuit", "SpdGrowSuit","RzbSpSuit", "RzbIncSuit", "RzbGrowSuit", "FMSSpSuit", "FMSIncSuit","FMSGrowSuit", "BhsSpSuit", "BhsIncSuit", "BhsGrowSuit", "BrtSpSuit","BrtIncSuit", "BrtGrSuit", "CcfSpSuit", "CcfIncSuit", "CcfGrSuit","GsfSpSuit", "GsfIncSuit", "GsfGrSuit", "RbtSpSuit", "RbtIncSuit","RbtGrSuit", "SmbSpSuit", "SmbIncSuit", "SmbGrSuit", "StbSpSuit","StbIncSuit", "StbGrSuit", "HbcSpSuit", "HbcIncSuit", "HbcGrSuit"), class = c("data.table", "data.frame"), row.names = c(NA, -10L))) 

AltSuitDates <- data.table(structure(list(Month = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 10L, 11L,12L), SpdSpT = c(NA, NA, NA, NA, NA, 1L, 1L, NA, NA, NA), SpdIncT = c(NA,NA, NA, NA, NA, 1L, 1L, NA, NA, NA), SpdGrT = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L), RzbSpT = c(NA, NA, NA, 1L, 1L, 1L, NA,NA, NA, NA), RzbIncT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA,NA), RzbGrT = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), FmsSpT = c(NA,NA, 1L, 1L, NA, NA, NA, NA, NA, NA), FmsIncT = c(NA, NA, 1L,1L, 1L, NA, NA, NA, NA, NA), FMSGrT = c(1L, 1L, 1L, 1L, 1L, 1L,1L, 1L, 1L, 1L), BhsSpT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA,NA), BhsIncT = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), BhsGrT = c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), BRTsp = c(1L, 1L, 1L, NA,NA, NA, NA, 1L, 1L, 1L), BRTinc = c(1L, 1L, 1L, 1L, NA, NA, NA,1L, 1L, 1L), BRTgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), CCFsp = c(NA, NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), CCFinc = c(NA,NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), CCFgr = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L), GSFsp = c(NA, NA, NA, NA, 1L, 1L, 1L,NA, NA, NA), GSFinc = c(NA, NA, NA, NA, 1L, 1L, 1L, NA, NA, NA), GSFgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), RBTsp = c(1L,1L, 1L, 1L, 1L, 1L, 1L, NA, NA, NA), RBTinc = c(1L, 1L, 1L, 1L,1L, 1L, 1L, NA, NA, NA), RBTgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L,1L, 1L, 1L), SMBsp = c(NA, NA, NA, 1L, 1L, 1L, 1L, NA, NA, NA), SMBinc = c(NA, NA, NA, 1L, 1L, 1L, 1L, NA, NA, NA), SMBgr = c(1L,1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), STBsp = c(NA, NA, NA, NA,NA, 1L, 1L, NA, NA, NA), STBinc = c(NA, NA, NA, NA, NA, 1L, 1L,NA, NA, NA), STBgr = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), HBCsp = c(NA, NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), HBCinc = c(NA,NA, NA, 1L, 1L, 1L, NA, NA, NA, NA), HBCgr = c(1L, 1L, 1L, 1L,1L, 1L, 1L, 1L, 1L, 1L)), .Names = c("Month", "SpdSpT", "SpdIncT","SpdGrT", "RzbSpT", "RzbIncT", "RzbGrT", "FmsSpT", "FmsIncT","FMSGrT", "BhsSpT", "BhsIncT", "BhsGrT", "BRTsp", "BRTinc", "BRTgr","CCFsp", "CCFinc", "CCFgr", "GSFsp", "GSFinc", "GSFgr", "RBTsp","RBTinc", "RBTgr", "SMBsp", "SMBinc", "SMBgr", "STBsp", "STBinc","STBgr", "HBCsp", "HBCinc", "HBCgr"), class = c("data.table","data.frame"), row.names = c(NA, -10L)))

其中 SpId 是物种标识符。一个 DT 是 5+ 百万行长 (AltSuitSp1)，另一个是 12 (AltSuitDates)。我正在使用 12 行长（对应 12 个月）的 DT 来更新较大的 DT。目前我在for循环中使用嵌套的if，else if结构来检查条件并根据较小的DT更新较大的DT（参见下面的代码）

h <- 1
n <- length(AltSuitSp1[,Month])
stm <- AltSuitSp1[,Month]  #  AltSuitSp1 is the 5+ million row DT

cond1 <- which(stm == 1)  #  list of all rows of AltSuitSp1 where the Month is = 1
cond2 <- which(stm == 2)  #  list of all rows of AltSuitSp1 where the Month is = 2
...
cond12 <- which(stm == 12)

for (h in seq(n)){
    if (any(cond1 == h)){
        set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[1,2:34,with=F]))
    }else if (any(cond2 == h)){
        set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[2,2:34,with=F]))
    }else if ...
    }else if (any(cond12)){
        set(AltSuitSp1,h,2:34,(AltSuitSp1[h,2:34,with=F] * AltSuitDates[12,2:34,with=F]))
    }else
        break
}

现在，我已运行此代码 1 分钟并检查 h 前进了多少。目前我看到每秒大约 29-30 次循环，并且 h 已经推进到大约 1800 次迭代。但是，即使每秒循环 30 次（这相当慢：Using Set in DT），此代码也需要大约 2 天才能完成。但是，正如下面的输出所示，它正在做我想要/期望它做的事情。

AltSuitSp1Results <- data.table(structure(list(Month = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L,12L, 12L, 12L), .Label = c("1", "10", "11", "12", "2", "3", "4","5", "6", "7", "8", "9"), class = "factor"), SpdSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0, 0, 0), SpdIncSuit = c(NA, NA, NA,NA, NA, NA, NA, 0, 0, 0), SpdGrowSuit = c(0, 0, 0, 0, 0, 0, 0,0.4625, 0.4625, 0.4625), RzbSpSuit = c(NA, NA, NA, NA, NA, NA,NA, 0.283333333, 0.283333333, 0.283333333), RzbIncSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.34, 0.34, 0.34), RzbGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.283333333, 0.283333333, 0.283333333), FMSSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.34, 0.34, 0.34), FMSIncSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.425, 0.425, 0.425), FMSGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.283333333, 0.283333333, 0.283333333), BhsSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0.233333333, 0.233333333, 0.233333333), BhsIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0, 0), BhsGrowSuit = c(0,0, 0, 0, 0, 0, 0, 0.233333333, 0.233333333, 0.233333333), BrtSpSuit = c(0.866666667,0.866666667, 0.866666667, 0.866666667, 0.866666667, 0.866666667,0.866666667, 0, 0, 0), BrtIncSuit = c(0.8, 0.8, 0.8, 0.8, 0.8,0.8, 0.8, 0.43, 0.43, 0.43), BrtGrSuit = c(0, 0, 0, 0, 0, 0,0, 0.86, 0.86, 0.86), CcfSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), CcfIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0, 0),CcfGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), GsfSpSuit = c(NA,NA, NA, NA, NA, NA, NA, 0, 0, 0), GsfIncSuit = c(NA, NA,NA, NA, NA, NA, NA, 0, 0, 0), GsfGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), RbtSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), RbtIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0,0), RbtGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0.925, 0.925, 0.925), SmbSpSuit = c(NA, NA, NA, NA, NA, NA, NA, 0.675, 0.675,0.675), SmbIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0.766666667,0.766666667, 0.766666667), SmbGrSuit = c(0, 0, 0, 0, 0, 0,0, 0.0875, 0.0875, 0.0875), StbSpSuit = c(NA, NA, NA, NA,NA, NA, NA, 0.425, 0.425, 0.425), StbIncSuit = c(NA, NA,NA, NA, NA, NA, NA, 0, 0, 0), StbGrSuit = c(0, 0, 0, 0, 0,0, 0, 0, 0, 0), HbcSpSuit = c(NA, NA, NA, NA, NA, NA, NA,0, 0, 0), HbcIncSuit = c(NA, NA, NA, NA, NA, NA, NA, 0, 0,0), HbcGrSuit = c(0, 0, 0, 0, 0, 0, 0, 0.425, 0.425, 0.425)), .Names = c("Month", "SpdSpSuit", "SpdIncSuit", "SpdGrowSuit","RzbSpSuit", "RzbIncSuit", "RzbGrowSuit", "FMSSpSuit", "FMSIncSuit","FMSGrowSuit", "BhsSpSuit", "BhsIncSuit", "BhsGrowSuit", "BrtSpSuit","BrtIncSuit", "BrtGrSuit", "CcfSpSuit", "CcfIncSuit", "CcfGrSuit","GsfSpSuit", "GsfIncSuit", "GsfGrSuit", "RbtSpSuit", "RbtIncSuit","RbtGrSuit", "SmbSpSuit", "SmbIncSuit", "SmbGrSuit", "StbSpSuit","StbIncSuit", "StbGrSuit", "HbcSpSuit", "HbcIncSuit", "HbcGrSuit"), class = c("data.table", "data.frame"), row.names = c(NA, -10L)))

显然，我并没有以一种有效的方式来解决这个问题，并且正在做一些草率的编程。但是，我正在努力弄清楚我可以在哪里优化我的代码。我是否试图重新发明一个内置的 DT 函数DT？我在其中一个圈子里吗？我是否错过了可以矢量化的地方：R Inferno？

基本上，我需要根据 AltSuitDates DT 更新 AltSuitSp1 DT 中的 2:34 列，使用 Month 列作为条件来了解从 AltSuitDates DT 中使用哪一行来更新 AltSuitSp1。任何帮助表示赞赏。

【问题讨论】：

如果将 2 个数据表合并为 1 个，则不需要循环。如果没有示例数据，很难说更多。
@DeanMacGregor，不包括示例数据让我排在第 9 圈！感谢您提醒我包含示例数据。
@duHaas，你能在 dput 之前 as.data.frame 你的数据吗？我认为dputing 数据表有问题。或者在之前尝试代码并确认它是否符合您的要求，或者解释为什么它没有。
@BrodieG 我认为如果你在最后取出 selfref 指针，它会起作用。
@DeanMacGregor：删除 selfref 指针对我有用。我相应地编辑了示例数据。

标签： r dataframe data.table vectorization

【解决方案1】：

根据@BrodieG 的评论，这已被重新设计以适应 SP2 中的 34 列。在您大小的数据集（5e6 行，34 列）上，它运行大约 4 分钟。

基本方法是将引用列（此处称为Dates）附加到SP1，一次一个。然后更新 SP1 的相应列，然后重复下一列。这在内存方面相当有效（任何时候都只有 1 个额外的列），并且仍然利用 data.table 的 set-by-reference。

library(data.table)
set.seed(1)
ncol <- 34
nrow <- 5e6
m    <- matrix(sample(10000:99999,nrow*ncol,replace=T),ncol=ncol)
SP1  <- data.table(Month=sample(1:12,nrow(m),replace=T),m)
m    <- matrix(sample(1:12,12*ncol,replace=T),ncol=ncol)
SP2  <- data.table(Month=sample(1:12,12),m)
cols <- paste0("SpId",(1:ncol(m)))
setnames(SP1,2:(ncol(m)+1),cols)
setnames(SP2,2:(ncol(m)+1),cols)

system.time({
  setkey(SP1,"Month")
  setkey(SP2,"Month")
  lapply(1:ncol,function(i){
    setnames(SP2,cols[i],"Dates")  # don't want colname collision in merge
    SP1[SP2[,c("Month","Dates")],Dates:=Dates]
    SP1[, cols[i] := lapply(.SD, `*`, Dates), .SDcols = cols[i]]
    setnames(SP2,"Dates",cols[i])  # set it back so next iteration works
  })
})
#    user  system elapsed 
#  219.54   22.45  242.59

【讨论】：

我对这个问题的解释是两个表都有 34 个数据列，需要成对匹配（即 SP1 的第一个与 SP2 的第一个等）。如果我理解正确，您不会这样做。我认为我的大部分额外复杂性都在处理这个问题，并且还有一个结构可以处理不同数量的列。
我明白你的意思。我已经改变了答案以适应这一点。毫不奇怪，现在大约需要 34 * 5 秒。

【解决方案2】：

编辑，更新以使用发布的数据运行。

这应该可行：

AltSuitSp1$Month <- as.integer(levels(AltSuitSp1$Month))[AltSuitSp1$Month]
setkey(AltSuitDates, Month)
d.cols <- ncol(AltSuitDates) - 1L
AltSuitDates[AltSuitSp1, ][, 
  c(list(Month=Month), 
   mapply(
     `*`, 
     .SD[, 2:(d.cols + 1)],
     .SD[, (d.cols + 2):(2 * d.cols + 1)],
     SIMPLIFY=FALSE
) ) ]

基本上，您首先通过Month（第三行）连接两个表，然后使用.SD，这是一个引用数据表本身的特殊对象，从@传递第一组行987654324@ 和第二组从AltSuitDates（这些现在都在同一个表中）到mapply 以便它可以将它们相乘。这是我使用的数据：

library(data.table)
set.seed(1)
AltSuitSp1 <- do.call(rbind, replicate(3, data.table(Month=1:12, a=runif(12), b=runif(12), c=runif(12)), s=F))
AltSuitDates <- data.table(Month=1:12, a=runif(12, 5, 10), b=runif(12, 5, 10), c=runif(12, 5, 10))

【讨论】：

【解决方案3】：

试试这个。我认为它可能与 BrodieG 的相似，但是当我复制粘贴 BrodieG 的答案时，它对我不起作用，我不知道如何阅读mapply 部分以找出我做错了什么......

comb<-merge(AltSuitSp1,AltSuitDates,by="Month")
sp<-colnames(AltSuitSp1)[2:NCOL(AltSuitSp1)]
dat<-colnames(AltSuitDates)[2:NCOL(AltSuitDates)]
comb[,eval(parse(text=paste0("list(Month,",paste0(sp,"=",sp,"*",dat,collapse=","),")")))]

我知道 ol'eval(parse(text= 通常不被认为是好的做法，但是当你只有一把锤子时，它会让螺丝钉在木头里。

【讨论】：