Как рассчитать количество вхождений в минуту для большого набора данных

У меня есть набор данных с 500 тыс. встреч продолжительностью от 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

Он создает фрейм данных, в котором перечислены все «активные» встречи за каждую минуту. Большой набор данных охватывает полный год (~ 525 600 минут). При средней продолжительности встречи 18 минут я ожидаю, что соединение sql создаст набор данных с ~ 5 миллионами строк, которые я могу использовать для создания графиков занятости для различных факторов (местоположение/комната и т. д.).

Основываясь на решении 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

r data.table time sqldf snowfall
person TimV    schedule 18.06.2013    source источник
comment
Приятно голосовать за полезные ответы. Просто указатель.   -  person Arun    schedule 19.06.2013

Ответы (3)


arrow_upward
3
arrow_downward

Разве это лучше?

Создайте пустой вектор времени и пустой вектор счета.

 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))
person Geoffrey Absalom    schedule 18.06.2013
comment
Спасибо, Джеффри, но это не учитывает количество встреч, которые активны в течение определенного периода. Это говорит мне о том, что есть две встречи, которые начинаются в 9:00, но не учитывают активные встречи (уже начатые, но не законченные). Мне нужны графики занятости в минуту, чтобы иметь возможность изучать пики в действительно загруженные периоды. - person TimV; 18.06.2013
comment
Хи, Гоффри, твое решение заняло 9 секунд для всего моего набора данных. Я боролся с этим часами. Большое спасибо за ваш вклад. Я смотрел в неправильном направлении: было действительно разумно собрать все время начала и окончания встреч и определить занятость на основе этого. Учитывая скорость расчета, я могу построить графики занятости для каждого местоположения или комнаты с некоторыми циклами for, поэтому я считаю, что мой вопрос решен. - person TimV; 18.06.2013

arrow_upward
0
arrow_downward

Я не совсем уверен, понимаю ли я вашу цель. Тем не менее, это может быть полезно:

#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

Я не проверял это, особенно на скорость.

person Roland    schedule 18.06.2013
comment
Спасибо, Роланд. интересный подход, но я искал общую заполняемость в минуту и ​​возможность подмножества заполняемости для местоположения и комнаты. - person TimV; 18.06.2013

arrow_upward
0
arrow_downward

Вот стратегия - упорядочить по времени начала, затем удалить данные из списка, перейдя в начало, конец, начало, конец,... и посмотреть, нужно ли изменить порядок этого вектора. Если это не так, то конфликтов нет, а если есть, вы можете увидеть, сколько встреч (и какие встречи, если хотите) конфликтуют друг с другом.

# 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]

Возможно, формулу перехода от несовпадающего порядка к правильным индексам выше можно упростить, я не тратил слишком много времени на размышления об этом и просто использовал первое, что выполнило свою работу.

person eddi    schedule 18.06.2013