R: Эффективное извлечение событий (непрерывное увеличение переменной)

Question

Задача состоит в том, чтобы эффективно извлекать события из этих данных:

data <- structure(
      list(i = c(1, 1, 1, 2, 2, 2), t = c(1, 2, 3, 1, 3, 4), x = c(1, 1, 2, 1, 2, 3)), 
      .Names = c("i", "t", "x"), row.names = c(NA, -6L), class = "data.frame" 
     ) 

> data 
    i t x 
1 1 1 1 
2 1 2 1 
3 1 3 2 
4 2 1 1 
5 2 3 2 
6 2 4 3 

Давайте называть i факты, t время, и x это число выборов от i по адресу t.

Событие представляет собой непрерывную последовательность выборов одного факта. Факт 1 выбирается все время от t = 1 до t = 3 с суммой из 4 выборок. Но факт 2 делится на два события: первый от t = 1 до t = 1 (sum = 1), а второй от t = 3 до t = 4 (sum = 5). Таким образом, кадр данных событий должен выглядеть следующим образом:

> event 
    i from to sum 
1 1 1 3 4 
2 2 1 1 1 
3 2 3 4 5 

Этот код делает то, что нужно:

event <- structure(
      list(i = logical(0), from = logical(0), to = logical(0), sum = logical(0)), 
      .Names = c("i", "from", "to", "sum"), row.names = integer(0), 
      class = "data.frame" 
     ) 
l <- nrow(data) # get rows of data frame 
c <- 1 # set counter 
d <- 1 # set initial row of data to start with 
e <- 1 # set initial row of event to fill 
repeat{ 
    event[e,1] <- data[d,1] # store "i" in event data frame 
    event[e,2] <- data[d,2] # store "from" in event data frame 
    while((data[d+1,1] == data[d,1]) & (data[d+1,2] == data[d,2]+1)){ 
     c <- c+1 
     d <- d+1 
     if(d >= l) break 
    } 
    event[e,3] <- data[d,2] # store "to" in event data frame 
    event[e,4] <- sum(data[(d-c+1):d,3]) # store "sum" in event data frame 
    c <- 1 
    d <- d+1 
    e <- e+1 
} 

Проблема заключается в том, что этот код занимает 3 дня, чтобы извлечь события из данных кадр с 1 миллионом строк и мой кадр данных имеет 5 миллионов строк.

Как я могу сделать это более эффективным?

P.S .: В моем коде также имеется небольшая ошибка, связанная с завершением.

P.P.S .: Данные сортируются сначала i, затем по t.

Answer 1

Вы можете попробовать, если эта реализация dplyr быстрее?

library(dplyr) 

data <- structure(
    list(fact = c(1, 1, 1, 2, 2, 2), timing = c(1, 2, 3, 1, 3, 4), x = c(1, 1, 2, 1, 2, 3)), 
    .Names = c("fact", "timing", "x"), row.names = c(NA, -6L), class = "data.frame" 
) 

group_by(data, fact) %>% 
    mutate(fromto=cumsum(c(0, diff(timing) > 1))) %>% 
    group_by(fact, fromto) %>% 
    summarize(from=min(timing), to=max(timing), sumx=sum(x)) %>% 
    select(-fromto) %>% 
    ungroup() 

как об этом данные.table осуществление?

library(data.table) 
data <- structure(
    list(fact = c(1, 1, 1, 2, 2, 2), timing = c(1, 2, 3, 1, 3, 4), x = c(1, 1, 2, 1, 2, 3)), 
    .Names = c("fact", "timing", "x"), row.names = c(NA, -6L), class = "data.frame" 
) 
setDT(data)[, fromto:=cumsum(c(0, diff(timing) > 1)), by=fact] 
event <- data[, .(from=min(timing), to=max(timing), sumx=sum(x)), by=c("fact", "fromto")][,fromto:=NULL] 

##results when i enter event in the R console and my data.table package version is data.table_1.9.6 
> event 
    fact from to sumx 
1: 1 1 3 4 
2: 2 1 1 1 
3: 2 3 4 5 
> str(event) 
Classes ‘data.table’ and 'data.frame': 3 obs. of 4 variables: 
$ fact: num 1 2 2 
$ from: num 1 1 3 
$ to : num 3 1 4 
$ sumx: num 4 1 5 
- attr(*, ".internal.selfref")=<externalptr> 
> dput(event) 
structure(list(fact = c(1, 2, 2), from = c(1, 1, 3), to = c(3, 
1, 4), sumx = c(4, 1, 5)), row.names = c(NA, -3L), class = c("data.table", 
"data.frame"), .Names = c("fact", "from", "to", "sumx"), .internal.selfref = <pointer: 0x0000000000120788>) 

Ссылка detect intervals of the consequent integer sequences

Answer 2

Предполагая, что кадр данных сортируются в соответствии с data$t, вы можете попробовать что-то вроде этого

event <- NULL 
for (i in unique(data$i)) { 
    x <- data[data$i == i, ] 
    ev <- cumsum(c(1, diff(x$t)) > 1) 
    smry <- lapply(split(x, ev), function(z) c(i, range(z$t), sum(z$x))) 
    event <- c(event, smry) 
} 
event <- do.call(rbind, event) 
rownames(event) <- NULL 
colnames(event) <- c('i', 'from', 'to', 'sum') 

Результатом является матрица, а не кадр данных.