Đếm số sự kiện đang diễn ra tại dấu thời gian

Question

Tôi có một chuỗi dấu thời gian đánh dấu sự bắt đầu và kết thúc của một số sự kiện nhất định.

library(chron) 
start <- structure(c(14246.3805439815, 14246.3902662037, 14246.3909606481, 
14246.3992939815, 14246.4013773148, 14246.4034606481, 14246.4062384259, 
14246.4069328704, 14246.4069328704, 14246.4097106481, 14246.4097106481, 
14246.4104050926, 14246.4117939815, 14246.4117939815, 14246.4117939815, 
14246.4145717593, 14246.4152546296, 14246.4152662037, 14246.4152662037, 
14246.4159606481), format = structure(c("m/d/y", "h:m:s"), .Names = c("dates", 
"times")), origin = structure(c(1, 1, 1970), .Names = c("month", 
"day", "year")), class = c("chron", "dates", "times")) 

finish <- structure(c(14246.436099537, 14246.4666550926, 14246.4083217593, 
14246.4374884259, 14246.4847106481, 14246.4867939815, 14246.4305439815, 
14246.4659606481, 14246.4520717593, 14246.9097106481, 14246.4930439815, 
14246.4763773148, 14246.4326273148, 14246.4291550926, 14246.4187384259, 
14246.9145717593, 14246.4395601852, 14246.4395717593, 14246.4395717593, 
14246.4367939815), format = structure(c("m/d/y", "h:m:s"), .Names = c("dates", 
"times")), origin = structure(c(1, 1, 1970), .Names = c("month", 
"day", "year")), class = c("chron", "dates", "times")) 

events <- data.frame(start, finish) 
head(event, 5) 

       start    finish 
1 (01/02/09 09:07:59) (01/02/09 10:27:59) 
2 (01/02/09 09:21:59) (01/02/09 11:11:59) 
3 (01/02/09 09:22:59) (01/02/09 09:47:59) 
4 (01/02/09 09:34:59) (01/02/09 10:29:59) 
5 (01/02/09 09:37:59) (01/02/09 11:37:59) 

Bây giờ tôi muốn đếm số lượng sự kiện đang được tiến hành tại dấu thời gian cụ thể.

intervals <- structure(c(14246.3958333333, 14246.40625, 14246.4166666667, 
14246.4270833333, 14246.4375), format = structure(c("m/d/y", 
"h:m:s"), .Names = c("dates", "times")), origin = structure(c(1, 
1, 1970), .Names = c("month", "day", "year")), class = c("chron", 
"dates", "times")) 

intervals 

[1] (01/02/09 09:30:00) (01/02/09 09:45:00) (01/02/09 10:00:00) (01/02/09 10:15:00) (01/02/09 10:30:00) 

Vì vậy, đầu ra tôi mong muốn là như sau:

  intervals count 
1 (01/01/09 09:30:00)  3 
2 (01/01/09 09:45:00)  7 
3 (01/01/09 10:00:00) 19 
4 (01/01/09 10:15:00) 18 
5 (01/01/09 10:30:00) 12 

Trong khi vấn đề là tầm thường để giải quyết programatically, tôi muốn thực hiện điều này cho 210.000 chu kỳ và hơn 1,2 triệu kiện. Cách tiếp cận hiện tại của tôi liên quan đến việc tận dụng gói data.table và toán tử & để kiểm tra xem một khoảng thời gian nằm giữa thời gian bắt đầu và kết thúc của mỗi sự kiện hay không.

library(data.table) 
events <- data.table(events) 
data.frame(intervals, count = sapply(1:5, function(i) sum(events[, start <= intervals[i] & intervals[i] <= finish]))) 

Nhưng xem xét kích thước dữ liệu của tôi, cách tiếp cận này tốn rất nhiều thời gian để chạy. Bất kỳ lời khuyên về lựa chọn thay thế tốt hơn để thực hiện điều này trong R?

Chúc mừng.

Answer 1

Có thể sử dụng dim() thay vì sum() và ldply() thay vì sapply() có thể nhanh hơn?

b<-function(i,df){ data.frame(i, count=dim(df[with(df, start<i & finish> i),])[1])}; 
ldply(intervals, b, events); 

     i count 
1 14246.40  3 
2 14246.41  7 
3 14246.42 19 
4 14246.43 18 
5 14246.44 12 

Tôi không quen thuộc với thư viện chron vì vậy tôi không làm i xuất hiện dưới dạng dấu thời gian. Lấy làm tiếc.

Answer 2

Bí mật của mã hoạt động nhanh trong R là giữ mọi thứ trong vectơ hoặc mảng, thực sự chỉ là mảng trong ngụy trang.

Đây là giải pháp sử dụng độc quyền các mảng R cơ bản. Mẫu dữ liệu của bạn rất nhỏ nên tôi sử dụng kết hợp replicate và system.time để đo lường hiệu suất.

Giải pháp của tôi nhanh gấp 6 lần giải pháp của bạn với sapply và data.table. (Giải pháp của tôi mất 0,6 giây để giải quyết dữ liệu mẫu nhỏ của bạn thiết lập 1.000 lần.)

Thời gian giải pháp của bạn

system.time(replicate(1000, 
    XX <- data.frame(
     intervals, 
     count = sapply(1:5, function(i) sum(events[, start <= intervals[i] & intervals[i] <= finish]))) 
)) 

    user system elapsed 
    4.04 0.05 4.11 

Giải pháp của tôi. Đầu tiên, tạo hai hàm trợ giúp để tạo các mảng có kích thước bằng nhau với các sự kiện chạy xuống các cột và các khoảng thời gian chạy qua các hàng. Sau đó làm một so sánh vector đơn giản tiếp theo colSums:

event.array <- function(x, interval){ 
    len <- length(interval) 
    matrix(rep(unclass(x), len), ncol=len) 
} 

intervals.array <- function(x, intervals){ 
    len <- length(x) 
    matrix(rep(unclass(intervals), len), nrow=len, byrow=TRUE) 
} 


a.start <- event.array(start, intervals) 
a.finish <- event.array(finish, intervals) 
a.intervals <- intervals.array(start, intervals) 

data.frame(intervals, 
      count=colSums(a.start <= a.intervals & a.finish >= a.intervals)) 

      intervals count 
1 (01/02/09 09:30:00)  3 
2 (01/02/09 09:45:00)  7 
3 (01/02/09 10:00:00) 19 
4 (01/02/09 10:15:00) 18 
5 (01/02/09 10:30:00) 12 

Thời gian giải pháp của tôi

system.time(replicate(1000, 
    YY <- data.frame(
      intervals, 
      count=colSums(a.start <= a.intervals & a.finish >= a.intervals)) 
)) 

    user system elapsed 
    0.67 0.02 0.69 

all.equal(XX, YY) 
[1] TRUE