R - 以数据帧列表为条件的快速子集化大数据 table

R - Fast subsetting large data table conditioned on a list of data frame

我有一个数据table和一个格式如下的数据框列表:

require(data.table)
members = c('a','b','c')
DT = do.call('rbind',
         lapply(members, function(x){
             date = seq(as.Date("2015/1/1"), as.Date("2015/12/31"), 'days')
             dummy = sample(length(date))
             dt = data.table(member=sample(x, length(dummy), replace=TRUE), date=date, dummy=dummy)} 
         )
     )

date = seq(as.Date("2015/1/1"), as.Date("2015/12/31"), 'days')
l.members = lapply(members, function(x){
                n.period = sample(10,1)
                do.call('rbind',
                    lapply(1:n.period, function(y){
                        period = sample(date, 2)
                        if (period[1]>period[2]){
                            start=period[2]
                            due=period[1]
                        }else{
                            start=period[1]
                            due=period[2]
                        }
                        return(data.frame(start.date=start, due.date=due))}
                    )
                )
            })
names(l.members) = members

DT 是大数据(作为 csv 文件大约 4G)数据 table,我想根据 l.members 从中进行子集化。 l.members 中条目 x 的每个名称都是 unique(DT$member) 中的成员之一。在每个条目中都有一个数据框,每一行代表一个周期[p1p2],我想根据它对行进行子集化DTDT$memberxDT$date => p1DT$date <= p2。目前的解决方法如下:

l.member.periods = lapply(members,
                       function(x){
                           DT.member = DT[member==x]
                           apply(l.members[[x]], 1,
                               function(y){
                                   start = y[1]
                                   due = y[2]
                                   return(DT.member[date>=start&date<=due])
                               }
                           )
                        }
                   )

l.members中有大约5000个条目时,需要几十年的时间,每个条目大多有10行(句点)。我试过用 mclapply 替换 lapply 但似乎没有用,它最终会耗尽内存并挂起。我怎样才能加快这个过程?

您可以使用 foverlaps。 首先,您需要将 l.members 存储为 data.table

lmembers <- rbindlist(lapply(1:length(l.members), 
                             function(i)data.table(member=names(l.members)[i], 
                                                   l.members[[i]], 
                                                   keep.rownames = TRUE)))

> head(lmembers)
   member rn start.date   due.date
1:      a  1 2015-03-30 2015-04-29
2:      a  2 2015-03-25 2015-12-07
3:      a  3 2015-02-06 2015-03-01
4:      a  4 2015-09-19 2015-11-08
5:      a  5 2015-06-23 2015-08-27
6:      a  6 2015-04-22 2015-10-08

下一步是明显使用 foverlaps

setkey(lmembers, "member", "start.date", "due.date")
DT[, date1:=date,]
setkey(DT, "member","date", "date1")
lmemberperiods <- foverlaps(lmembers, DT)[, .(member, rn, date, dummy)]

检查这是否会产生预期的结果。

lmemberperiods[member=="a" & rn==1]
l.member.periods[[1]][[1]]