如何计算大型数据集的每分钟发生次数

Question

我有一个500k约会的数据集,持续时间在5到60分钟之间.

tdata <- structure(list(Start = structure(c(1325493000, 1325493600, 1325494200, 1325494800, 1325494800, 1325495400, 1325495400, 1325496000, 1325496000, 1325496600, 1325496600, 1325497500, 1325497500, 1325498100, 1325498100, 1325498400, 1325498700, 1325498700, 1325499000, 1325499300), class = c("POSIXct", "POSIXt"), tzone = "GMT"), End = structure(c(1325493600, 1325494200, 1325494500, 1325495400, 1325495400, 1325496000, 1325496000, 1325496600, 1325496600, 1325496900, 1325496900, 1325498100, 1325498100, 1325498400, 1325498700, 1325498700, 1325499000, 1325499300, 1325499600, 1325499600), class = c("POSIXct", "POSIXt"), tzone = "GMT"), Location = c("LocationA", "LocationA", "LocationA", "LocationA", "LocationA", "LocationA", "LocationA", "LocationA", "LocationA", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB", "LocationB"), Room = c("RoomA", "RoomA", "RoomA", "RoomA", "RoomB", "RoomB", "RoomB", "RoomB", "RoomB", "RoomB", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA", "RoomA")), .Names = c("Start", "End", "Location", "Room"), row.names = c(NA, 20L), class = "data.frame")

> head(tdata)
                Start                 End  Location  Room
1 2012-01-02 08:30:00 2012-01-02 08:40:00 LocationA RoomA
2 2012-01-02 08:40:00 2012-01-02 08:50:00 LocationA RoomA
3 2012-01-02 08:50:00 2012-01-02 08:55:00 LocationA RoomA
4 2012-01-02 09:00:00 2012-01-02 09:10:00 LocationA RoomA
5 2012-01-02 09:00:00 2012-01-02 09:10:00 LocationA RoomB
6 2012-01-02 09:10:00 2012-01-02 09:20:00 LocationA RoomB

我想计算总共,每个位置和每个房间的并发约会数(以及原始数据集中的其他几个因素).

我已经尝试使用mysql包来执行左连接,这适用于小数据集,但对于整个数据集需要永久:

# SQL Join.
start.min <- min(tdata$Start, na.rm=T)
end.max <- max(tdata$End, na.rm=T)
tinterval <- seq.POSIXt(start.min, end.max, by = "mins")
tinterval <- as.data.frame(tinterval)

library(sqldf)
system.time(
  output <- sqldf("SELECT *
              FROM tinterval 
              LEFT JOIN tdata 
              ON tinterval.tinterval >= tdata.Start
              AND tinterval.tinterval < tdata.End "))

head(output)
            tinterval               Start                 End  Location  Room
1 2012-01-02 09:30:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA
2 2012-01-02 09:31:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA
3 2012-01-02 09:32:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA
4 2012-01-02 09:33:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA
5 2012-01-02 09:34:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA
6 2012-01-02 09:35:00 2012-01-02 09:30:00 2012-01-02 09:40:00 LocationA RoomA

它创建了一个数据框,其中列出了每分钟的所有"活动"约会.大型数据集涵盖整整一年(约525600分钟).平均约会时间为18分钟,我希望sql join能够创建一个包含约500万行的数据集,我可以用它来创建不同因素(位置/房间等)的占用情况.

在sapply解决方案构建在建议如何计算并发用户数我尝试使用data.table与snowfall如下:

require(snowfall) 
require(data.table)
sfInit(par=T, cpu=4)
sfLibrary(data.table)

tdata <- data.table(tdata)
tinterval <- seq.POSIXt(start.min, end.max, by = "mins")
setkey(tdata, Start, End)
sfExport("tdata") # "Transport" data to cores

system.time( output <- data.frame(tinterval,sfSapply(tinterval, function(i) length(tdata[Start <= i & i < End,Start]) ) ) )

> head(output)
            tinterval sfSapply.tinterval..function.i..length.tdata.Start....i...i...
1 2012-01-02 08:30:00                                                              1
2 2012-01-02 08:31:00                                                              1
3 2012-01-02 08:32:00                                                              1
4 2012-01-02 08:33:00                                                              1
5 2012-01-02 08:34:00                                                              1
6 2012-01-02 08:35:00                                                              1

这个解决方案很快,计算1天需要大约18秒(全年约2小时).缺点是我无法为某些因素(位置,房间等)创建并发约会数的子集.我觉得必须有更好的方法来做这个...任何建议？

更新:根据杰弗里的回答,最终解决方案看起来像这样.该示例显示了如何确定每个位置的占用率.

setkey(tdata, Location, Start, End)
vecTime <- seq(from=tdata$Start[1],to=tdata$End[nrow(tdata)],by=60)
res <- data.frame(time=vecTime)

for(i in 1:length(unique(tdata$Location)) ) { 
  addz <- array(0,length(vecTime))
  remz <- array(0,length(vecTime))

  tdata2 <- tdata[J(unique(tdata$Location)[i]),] # Subset a certain location.

  startAgg <- aggregate(tdata2$Start,by=list(tdata2$Start),length)
  endAgg <- aggregate(tdata2$End,by=list(tdata2$End),length)
  addz[which(vecTime %in% startAgg$Group.1 )] <- startAgg$x
  remz[which(vecTime %in% endAgg$Group.1)] <- -endAgg$x

  res[,c( unique(tdata$Location)[i] )] <- cumsum(addz + remz)
}

> head(res)
                 time LocationA LocationB
1 2012-01-01 03:30:00         1         0
2 2012-01-01 03:31:00         1         0
3 2012-01-01 03:32:00         1         0
4 2012-01-01 03:33:00         1         0
5 2012-01-01 03:34:00         1         0
6 2012-01-01 03:35:00         1         0

Answer 1

这样好点了吗。

创建空白时间向量和空白计数向量。

 vecTime <- seq(from=tdata$Start[1],to=tdata$End[nrow(tdata)],by=60)
 addz <- array(0,length(vecTime))
 remz <- array(0,length(vecTime))


 startAgg <- aggregate(tdata$Start,by=list(tdata$Start),length)
 endAgg <- aggregate(tdata$End,by=list(tdata$End),length)
 addz[which(vecTime %in% startAgg$Group.1 )] <- startAgg$x
 remz[which(vecTime %in% endAgg$Group.1)] <- -endAgg$x
 res <- data.frame(time=vecTime,occupancy=cumsum(addz + remz))