Как улучшить скорость для таблицы с миллионами строк - PullRequest
Новая
       14

Как улучшить скорость для таблицы с миллионами строк

0 голосов
/ 08 ноября 2018

Я новичок в R и Stack Overflow и надеюсь, что вы сможете мне помочь с вопросом, который у меня возник. Я написал следующий кусок кода: 

my = matrix(c(1,1,1,1,1,1,1,1,1,1,
          2,2,2,2,2,2,2,
          0,1,2,3,5,6,7,10,11,14,
          0,1,2,3,4,6,10),ncol = 2, nrow = 17)
colnames(my) = c("ID", "AGE")
my = as.data.frame(my)
my$new = my$ID
system.time(for (i in 1:length(my$ID)) {


ifelse(my$ID[i]==my$ID[i-1],
     ifelse(my$AGE[i]-my$AGE[i-1]==1, my$new[i]<-my$new[i-1],my$new[i]<-my$new[i-1]+0.1),
     my$new[i]<-my$ID[i])
})

Он смотрит на ID и AGE, и если AGE не равен предыдущему AGE + 1, то он добавляет 0,1 к ID и сохраняет это в столбце «new». Вот вывод: 

   ID AGE new
1   1   0 1.0
2   1   1 1.0
3   1   2 1.0
4   1   3 1.0
5   1   5 1.1
6   1   6 1.1
7   1   7 1.1
8   1  10 1.2
9   1  11 1.2
10  1  14 1.3
11  2   0 2.0
12  2   1 2.0
13  2   2 2.0
14  2   3 2.0
15  2   4 2.0
16  2   6 2.1
17  2  10 2.2

Проблема в том, что это действительно быстро для наборов данных, скажем, из 1000 строк, но когда я пробую это на моем фактическом наборе данных, который имеет более 8,5 м строк, мне кажется, что он никогда этого не сделает - я пытался ждать несколько часов безуспешно.

Буду очень признателен, если вы предложите способ улучшить скорость / эффективность.

1 Ответ

0 голосов
/ 08 ноября 2018

При работе с большими наборами данных вам нужно попытаться векторизовать ваши расчеты для повышения скорости.

Вот пример использования пакета dplyr (поскольку функция lag необходима для определения предыдущего значенияиз AGE): 

require(dplyr) # for group_by, mutate and %>%
require(microbenchmark) # to compare codes
# Your data
my           <- matrix(c(1,1,1,1,1,1,1,1,1,1,
                         2,2,2,2,2,2,2,
                         0,1,2,3,5,6,7,10,11,14,
                         0,1,2,3,4,6,10), ncol=2, nrow=17)
colnames(my) <- c("ID", "AGE")
my           <- as.data.frame(my)
my$new       <- my$ID
my2          <- my[rep(1:nrow(my), times=100),] # larger dataset

# Your function
f1 <- function(my) {
    for (i in 1:length(my$ID)) {
        ifelse(my$ID[i]==my$ID[i-1],
               ifelse(my$AGE[i]-my$AGE[i-1]==1, my$new[i] <- my$new[i-1],
                                                my$new[i] <- my$new[i-1]+0.1),
               my$new[i] <- my$ID[i])
    }
}

# dplyr function
f2 <- function(my) {
    my %>% group_by(ID) %>% # Work by ID
        mutate(new2=ifelse(is.na(lag(AGE)),  # If lag(AGE) is NA, it's the first record for the ID
                           FALSE,            # Thus, no increase of new3
                           AGE!=lag(AGE)+1), # new3=TRUE if AGE != 1+previous AGE
               new3=new+cumsum(new2)/10)     # increase the decimal if TRUE for the previous new2
}

С небольшим набором данных цикл for более эффективен, но с большим набором данных улучшение очевидно: 

# Compare codes
microbenchmark(f1(my), f2(my),
               f1(my2), f2(my2))
Unit: milliseconds
    expr        min         lq       mean     median         uq       max neval cld
  f1(my)   1.470699   1.957855   2.750798   2.049954   2.243380  62.34942   100  a 
  f2(my)   2.741614   3.853356   4.235745   4.147085   4.421738  10.84871   100  a 
 f1(my2) 156.986927 215.515605 218.806729 222.390968 228.362988 290.19161   100   b
 f2(my2)   3.398812   4.377638   5.128953   4.659674   5.161190  28.97461   100  a
...