R - Быстрый Подменит стол больших объемов данных с кондиционером в списке кадра данных

Question

У меня есть таблица данных и список кадра данных в следующем формате:

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 является большим (около 4G, как CSV-файл) таблицу данных, из которой я хочу подмножество на основе l.members. Каждое название записи x в l.members является одним из членов в unique(DT$member). В каждой записи есть кадр данных с каждой строкой, представляющей собой период [p1, p2], на основании которых я хочу подмножество строк в DT с DT$member является х и DT$date =>р1 и DT$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]) 
           } 
          ) 
         } 
        ) 

Это занимает десятилетия, когда существует около 5000 записей в l.members, каждый из которых имеет в основном 10 строк (периоды). Я попытался заменить lapply на mclapply, но, похоже, не работает, он заканчивает высыхание памяти и зависание. Как я могу ускорить процесс?

Answer 1

Вы можете использовать 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]]