Cách tính số lần xuất hiện mỗi phút cho tập dữ liệu lớn

Question

Tôi có tập dữ liệu với các cuộc hẹn 500k kéo dài từ 5 đến 60 phút.

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 

Tôi muốn tính toán số các cuộc hẹn đồng thời trong tổng số, mỗi địa điểm, và mỗi Phòng (và một số yếu tố khác trong tập dữ liệu ban de).

Tôi đã cố gắng sử dụng mysql gói để thực hiện một trái tham gia, mà làm việc cho một tập dữ liệu nhỏ, nhưng sẽ mãi mãi cho toàn bộ tập dữ liệu:

# 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 

Nó tạo ra một khung dữ liệu mà tất cả các cuộc hẹn "hoạt động" được liệt kê cho mỗi phút. Tập dữ liệu lớn bao gồm cả năm (~ 525600 phút). Với thời gian cuộc hẹn trung bình là 18 phút, tôi hy vọng việc tham gia sql sẽ tạo ra một tập dữ liệu với ~ 5 triệu hàng, tôi có thể sử dụng để tạo các khoảng trống cho các yếu tố khác nhau (Vị trí/Phòng vv).

xây dựng trên giải pháp sapply đề xuất trong How to count number of concurrent users Tôi đã cố gắng sử dụng data.table và snowfall như sau:

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 

Giải pháp này là nhanh chóng, mất ~ 18 giây để tính toán 1 ngày (khoảng 2 giờ cho một năm đầy đủ) . Nhược điểm là tôi không thể tạo tập hợp con của số lượng các cuộc hẹn đồng thời cho các yếu tố nhất định (Vị trí, Phòng vv). Tôi có cảm giác phải có một cách tốt hơn để làm điều này .. bất kỳ lời khuyên nào?

CẬP NHẬT: Giải pháp cuối cùng trông như thế này, dựa trên câu trả lời của Geoffrey. Ví dụ này cho thấy cách xác định vị trí của từng vị trí.

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

Điều này có tốt hơn không.

Tạo vectơ thời gian trống và vectơ số trống.

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)) 

Answer 2

Tôi không chắc chắn, nếu tôi hiểu mục tiêu của bạn. Tuy nhiên, điều này có thể được sử dụng:

#I changed the example to actually have concurrent appointments 
DF <- read.table(text="    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 09: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",header=TRUE,sep=",",stringsAsFactors=FALSE) 

DF$Start <- as.POSIXct(DF$Start,format="%Y-%d-%m %H:%M:%S",tz="GMT") 
DF$End <- as.POSIXct(DF$End,format="%Y-%d-%m %H:%M:%S",tz="GMT") 

library(data.table) 
DT <- data.table(DF) 
DT[,c("Start_num","End_num"):=lapply(.SD,as.numeric),.SDcols=1:2] 

fun <- function(s,e) { 
    require(intervals) 
    mat <- cbind(s,e) 
    inter <- Intervals(mat,closed=c(FALSE,FALSE),type="R") 
    io <- interval_overlap(inter, inter) 
    tablengths <- table(sapply(io,length))[-1] 
    sum(c(0,as.vector(tablengths/as.integer(names(tablengths))))) 
} 

#number of overlapping events per room and location 
DT[,fun(Start_num,End_num),by=list(Location,Room)] 
#  Location Room V1 
#1: LocationA RoomA 1 
#2: LocationA RoomB 0 

Tôi đã không kiểm tra điều này, đặc biệt là không cho tốc độ.

Answer 3

Đây là một chiến lược - sắp xếp theo thời gian bắt đầu, sau đó bỏ liệt kê dữ liệu bằng cách bắt đầu, kết thúc, bắt đầu, kết thúc, ... và xem liệu vectơ đó có cần được sắp xếp lại hay không. Nếu không, thì không có xung đột và nếu bạn có thể thấy có bao nhiêu cuộc hẹn (và các cuộc hẹn nếu bạn thích) xung đột với nhau.

# Using Roland's example: 
DF <- read.table(text="    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 09: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",header=TRUE,sep=",",stringsAsFactors=FALSE) 

dt = data.table(DF) 

# the conflicting appointments 
dt[order(Start), 
    .SD[unique((which(order(c(rbind(Start, End))) != 1:(2*.N)) - 1) %/% 2 + 1)], 
    by = list(Location, Room)] 
# Location Room    Start     End 
#1: LocationA RoomA 2012-01-02 08:50:00 2012-01-02 09:55:00 
#2: LocationA RoomA 2012-01-02 09:00:00 2012-01-02 09:10:00 

# and a speedier version of the above, that avoids constructing the full .SD: 
dt[dt[order(Start), 
     .I[unique((which(order(c(rbind(Start, End))) != 1:(2*.N)) - 1) %/% 2 + 1)], 
     by = list(Location, Room)]$V1] 

Có lẽ công thức để chuyển từ thứ tự chưa sửa sang chỉ mục ở trên có thể được đơn giản hóa, tôi không dành quá nhiều thời gian nghĩ về nó và chỉ sử dụng thứ đầu tiên hoàn thành công việc.