使用 R data.tables 快速计算每个对象的事件数

Question

我有许多对象，它们可以位于多个位置（其中位置的数量比对象的数量要少得多），每个对象都有一个开始和结束日期。我还有一些事件，它们也有一个位置，以及它们发生的日期。我想知道每个对象在其逗留期间在同一位置发生的事件数量（以便在对象的开始日期和结束日期之间发生）。

由于我有几组并且对象的数量从 450.000 到 600 万不等，因此这项任务需要相当长的时间。到目前为止，我发现的最快的方法是使用 data.table 方法。下面的函数显示了一个示例，您可以在其中改变大小的数量。

coupleEventObject <- function(sizeO=100,sizeE=100){
 require(data.table)
 require(zoo)

 #create the events  
 Events <- data.table(EventNumber = c(1:sizeE),
                      Location    = as.character(sample(c(1:floor(sizeO/10)),size=sizeE,replace=T)),
                      DayEvent    = rand.day(day.start="2007-01-01",
                                     day.end  ="2015-12-31",
                                     size=sizeE))

 #Create the objects
 Objects <- data.table(ObjectNumber = c(1:sizeO),
                       Location     = as.character(sample(c(1:floor(sizeO/10)),size=sizeO,replace=T)),
                       Day1 = rand.day(day.start="2007-01-01",
                                          day.end  ="2015-12-31",
                                          size=sizeO),
                       Day2 = rand.day(day.start="2007-01-01",
                                         day.end  ="2015-12-31",
                                         size=sizeO))

 Objects[, DayStart := as.Date(ifelse (Day1>Day2,Day2,Day1))]
 Objects[, DayEnd   := as.Date(ifelse (Day1<Day2,Day2,Day1))]
 Objects[,c("Day1","Day2"):=NULL]

 #Set keys right for the coupling/counting
 setkey(Objects,Location,DayStart,DayEnd)
 setkey(Events,Location,DayEvent)

 #Count the number of events
 system.time(
 Objects[,NumberEvents:=Events[Location,][DayEvent >= DayStart & DayEvent <= DayEnd,.N],by=list(DayStart,DayEnd,Location)]
 )
}

rand.day <- function(day.start,day.end,size) {
  dayseq <- seq.Date(as.Date(day.start),as.Date(day.end),by="day")
  dayselect <- sample(dayseq,size,replace=TRUE)
  return(dayselect)
}

对于 100 个对象和 100 个事件，此代码在 0.3 秒内在我的笔记本电脑上运行

> coupleEventObject()
   user  system elapsed 
   0.30    0.00    0.29 

但如果我增加对象的数量，这几乎与处理时间呈线性关系。

> coupleEventObject(sizeE=200,sizeO=6000)
   user  system elapsed 
  15.11    0.00   15.26 

因此，要计算 600 万个对象的事件数量，这大约需要 4 个小时，而且我必须这样做几次（不同类型的位置级别和）。有没有办法加快这个速度？感谢您的帮助和想法！

Answer 1

这是一个选项。主要思想是以每个组合首先存在的方式加入事件和对象，然后只计算有效值。正如您将看到的，新方法的运行速度要快得多，并且您会得到相同的结果。 顺便说一句...您可能必须更改随机日期生成器，因为我无权访问您的原始功能。

coupleEventObject1 <- function(sizeO=100,sizeE=100){
 require(data.table)
 require(zoo)

 #create the events  
 Events <- data.table(EventNumber = c(1:sizeE),
                      Location    = as.character(sample(c(1:floor(sizeO/10)),size=sizeE,replace=T)),
                      DayEvent    = as.Date(as.integer(runif(sizeE)*1000)))

 #Create the objects
 Objects <- data.table(ObjectNumber = c(1:sizeO),
                       Location     = as.character(sample(c(1:floor(sizeO/10)),size=sizeO,replace=T)),
                       Day1 = as.Date(as.integer(runif(sizeE)*1000)),
                       Day2 = as.Date(as.integer(runif(sizeE)*1000)))

 Objects[, DayStart := as.Date(ifelse (Day1>Day2,Day2,Day1))]
 Objects[, DayEnd   := as.Date(ifelse (Day1<Day2,Day2,Day1))]
 Objects[,c("Day1","Day2"):=NULL]

 #Set keys right for the coupling/counting
 setkey(Objects,Location,DayStart,DayEnd)
 setkey(Events,Location,DayEvent)

 #Count the number of events
 cat("First method:")
 cat(system.time(
 res1 <- Objects[,NumberEvents:=Events[Location,][DayEvent >= DayStart & DayEvent <= DayEnd,.N],by=list(DayStart,DayEnd,Location)]
 ))
 cat("\n")


 ## second method

 #Set keys right for the coupling/counting
 setkey(Objects,Location)
 setkey(Events,Location)

 #Count the number of events
 cat("Second method:")
 cat(system.time({
 oe <- Objects[Events,allow.cartesian=T]
 res2 <- oe[,sum(DayEvent >= DayStart & DayEvent <= DayEnd),by=list(ObjectNumber,DayStart,DayEnd,Location)]
 }))
 cat("\n")

 # comparing
 setkey(res1, ObjectNumber, Location, DayStart, DayEnd)
 setkey(res2, ObjectNumber, Location, DayStart, DayEnd)
 cat("Compare values: ", nrow(res1[res2][NumberEvents != V1,])," mismatches\n")

 return(list(res1=res1,res2=res2))
}

结果如下：

xx <- coupleEventObject1(200,6000)
First method:8.151 0.041 8.15 0 0
Second method:0.614 0.017 0.625 0 0
Compare values:  0  mismatches