Сокращение времени для вложенных циклов в r

Question

Я пытаюсь извлечь некоторую информацию из набора данных длиной около 178 000 строк. У меня есть кадр данных с примерно 9 переменными, но я использую только 3 из них для этой части. Очень небольшая часть этих данных может выглядеть примерно так:

date <- as.Date(c("2016-09-17", "2016-09-14", "2016-09-17", "2016-09-13","2016-09-17")) 
idnum <- c("1", "2", "1", "1", "1") 
hour <- round(as.numeric(c("15.75", "16.34", "16.12", "15.53", "17.10")), digits = 2) 

all <- data.frame(date, idnum, hour) 

Давать это:

date  idnum  hour 
2016-09-17  1  15.75 
2016-09-14  2  16.34 
2016-09-17  1  16.12 
2016-09-13  1  15.53 
2016-09-17  1  17.10 

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

date  idnum  hour close 
2016-09-17  1  15.75  1 
2016-09-14  2  16.34  0 
2016-09-17  1  16.12  2 
2016-09-13  1  15.53  0 
2016-09-17  1  17.10  1 

Я получил следующий код, чтобы работать для этого небольшого набора данных

all$close <- 0 
m <- 1 

for (i in m:nrow(all)) { 
    for (j in 1:nrow(all)) { 
     if(i != j & all$date[i] == all$date[j] & all$idnum[i] == idnum[j] 
      & abs(all$hour[i] - all$hour[j]) <= 1) { 
      all$close[i] <- all$close[i] + 1        
     } else { 
      all$close[i] <- all$close[i] 
     } 
    } 
    m = m + 1 
} 

Однако, как только я расширяю это к большему числу строк, время выполнения очень велико. Есть ли более эффективный способ сделать это в r?

Answer 1

Для отсортированного вектора x, findInterval(x+1, x) - findInterval(x-1, x) дает число наблюдений, попадающее в течение указанного интервала (x[i]-1, x[i]+1) для каждого наблюдения x[i].

library(dplyr)  
all %>% 
    group_by(idnum, date) %>% 
    arrange(hour) %>% 
    mutate(close1 = findInterval(hour+1, hour) - findInterval(hour-1, hour) - 1) 

# Source: local data frame [5 x 4] 
# Groups: idnum, date [3] 

#  date idnum hour close 
#  <date> <fctr> <dbl> <dbl> 
# 1 2016-09-17  1 15.75  1 
# 2 2016-09-14  2 16.34  0 
# 3 2016-09-17  1 16.12  2 
# 4 2016-09-13  1 15.53  0 
# 5 2016-09-17  1 17.10  1 

Для сравнения,

set.seed(1234) 
date <- as.Date("2016-1-1") + sample(1:1000, 10000, TRUE) 
idnum <- sample(1:100, 1e4, TRUE) 
hour <- sample(0:239, 10000, TRUE)/10 
all <- data.frame(date, idnum, hour) 

system.time(
all <- all %>% 
    group_by(idnum, date) %>% 
    arrange(hour) %>% 
    mutate(close1 = findInterval(hour+1, hour) - findInterval(hour-1, hour) - 1) 
) 
# user system elapsed 
# 0.25 0.00 0.27