Contando el número de eventos en curso en una marca de tiempo

Question

Tengo una serie de marcas de tiempo que marcan el comienzo y el final de ciertos eventos.

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) 

Ahora deseo contar cuántos eventos están en curso en sellos de tiempo específicos.

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) 

Así que la salida de deseo es el siguiente:

  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 

Si bien el problema es trivial para resolver mediante programación, deseo de lograr esto de 210.000 intervalos y más de 1,2 millones de eventos. Mi enfoque actual implica aprovechar el paquete data.table y el operador & para verificar si hay un intervalo entre el inicio y el final de cada evento.

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

Pero teniendo en cuenta el tamaño de mis datos, este enfoque tarda mucho tiempo en ejecutarse. ¿Algún consejo sobre mejores alternativas para lograr esto en R?

Saludos.

Answer 1

tal vez usando dim() en lugar de sum() y ldply() en lugar de sapply() podría ser más rápido?

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 

No estoy familiarizado con la biblioteca de Chron así que did't hacen i salir como un sello de tiempo. Lo siento.

Answer 2

El secreto del código de ejecución rápida en R es mantener todo en vectores, o arrays, que en realidad son solo matrices disfrazadas.

Aquí hay una solución que hace uso exclusivamente de matrices base R. Su muestra de datos es pequeña, así que uso replicate y system.time combinados para medir el rendimiento.

Mi solución es aproximadamente 6 veces más rápido que su solución con sapply y data.table. (Mi solución tarda 0,6 segundos para resolver sus datos de muestra pequeño conjunto 1.000 veces.)

El tiempo de su solució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 

Mi solución. Primero crea dos funciones auxiliares para crear matrices de igual tamaño con eventos que se ejecutan en las columnas e intervalos que se ejecutan en las filas. A continuación, realice una comparación simple del vector seguido por 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 

Timing mi solución

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