Прискорити роботу циклу в R

У мене в Р. є велика проблема продуктивності. Я написав функцію, яка перетворюється на data.frameоб'єкт. Він просто додає новий стовпчик до data.frameі щось накопичує. (проста операція). data.frameМає приблизно 850K рядків. Мій ПК все ще працює (близько 10 год), і я не маю уявлення про час виконання.

dayloop2 <- function(temp){
    for (i in 1:nrow(temp)){    
        temp[i,10] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                temp[i,10] <- temp[i,9] + temp[i-1,10]                    
            } else {
                temp[i,10] <- temp[i,9]                                    
            }
        } else {
            temp[i,10] <- temp[i,9]
        }
    }
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

Будь-які ідеї, як пришвидшити цю операцію?

Найбільша проблема та неефективність - це індексація data.frame, я маю на увазі всі ці рядки, де ви користуєтесь temp[,].
Намагайтеся максимально уникати цього. Я взяв вашу функцію, змінив індексацію і ось версія_A

dayloop2_A <- function(temp){
    res <- numeric(nrow(temp))
    for (i in 1:nrow(temp)){    
        res[i] <- i
        if (i > 1) {             
            if ((temp[i,6] == temp[i-1,6]) & (temp[i,3] == temp[i-1,3])) { 
                res[i] <- temp[i,9] + res[i-1]                   
            } else {
                res[i] <- temp[i,9]                                    
            }
        } else {
            res[i] <- temp[i,9]
        }
    }
    temp$`Kumm.` <- res
    return(temp)
}

Як ви бачите, я створюю вектор, resякий збирає результати. Наприкінці я додаю його, data.frameі мені не потрібно возитися з іменами. То як же краще?

Я виконую кожну функцію data.frameз nrowвід 1000 до 10000 на 1000 і вимірюю час за допомогоюsystem.time

X <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
system.time(dayloop2(X))

Результат є

Ви можете бачити, що від вашої версії залежить експоненціально nrow(X). Модифікована версія має лінійне відношення, і проста lmмодель передбачає, що для обчислення 850 000 рядків потрібно 6 хвилин і 10 секунд.

Сила векторизації

Як стверджують Шейн та Калімо, у своїх відповідях векторизація є запорукою кращої продуктивності. З вашого коду ви можете перейти за межі циклу:

• кондиціонування
• ініціалізація результатів (які є temp[i,9])

Це призводить до цього коду

dayloop2_B <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in 1:nrow(temp)) {
        if (cond[i]) res[i] <- temp[i,9] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

Порівняйте результат для цієї функції, цього разу nrowвід 10 000 до 100 000 на 10 000.

Налаштування налаштованого

Ще одна зміна полягає в зміні циклу, що індексує temp[i,9]на res[i](які точно однакові в i-й ітерації циклу). Це знову ж різниця між індексуванням вектора та індексацією a data.frame.
Друга річ: коли ви дивитесь на цикл, ви бачите, що не потрібно перебирати цикл на всіх i, а лише на ті, що відповідають умовам.
Тож ось ми йдемо

dayloop2_D <- function(temp){
    cond <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
    res <- temp[,9]
    for (i in (1:nrow(temp))[cond]) {
        res[i] <- res[i] + res[i-1]
    }
    temp$`Kumm.` <- res
    return(temp)
}

Ефективність, яку ви отримуєте, дуже залежить від структури даних. Точно - на відсотки TRUEзначень у стані. Для моїх модельованих даних потрібен час обчислення на 850 000 рядків нижче однієї секунди.

Я хочу, щоб ви могли піти далі, я бачу принаймні дві речі, які можна зробити:

• написати Cкод для виконання умовного закінчення

• якщо ви знаєте, що у ваших даних максимальна послідовність даних не велика, то ви можете змінити цикл на векторизований, а щось подібне

  while (any(cond)) {
      indx <- c(FALSE, cond[-1] & !cond[-n])
      res[indx] <- res[indx] + res[which(indx)-1]
      cond[indx] <- FALSE
  }
  

Код, який використовується для моделювання та фігур, доступний на GitHub .

Загальні стратегії прискорення R-коду

Спочатку з’ясуйте, де насправді знаходиться повільна частина. Не потрібно оптимізувати код, який не працює повільно. Для невеликої кількості коду може працювати просто продумування. Якщо це не вдасться, RProf та подібні інструменти для профілювання можуть бути корисними.

Як тільки ви з’ясуєте вузьке місце, подумайте про ефективніші алгоритми для того, щоб робити те, що ви хочете. Розрахунки слід проводити лише один раз, якщо можливо, так:

• Зберігайте результати та отримуйте доступ до них, а не повторного перерахунку
• Вийміть не петлі, що залежать від циклу, з циклів
• Уникайте необхідних обчислень (наприклад , не використовуйте регулярні вирази з фіксованим пошуком )

Використання більш ефективних функцій може призвести до помірного або великого збільшення швидкості. Наприклад, paste0приносить невеликий приріст ефективності, але .colSums()його родичі отримують дещо більш виражені переваги. meanце особливо повільно .

Тоді ви можете уникнути деяких особливо поширених неприємностей :

• cbind сповільнить вас дуже швидко.
• Ініціалізуйте свої структури даних, а потім заповніть їх, а не розширюйте їх кожен раз .
• Навіть при попередньому виділенні ви можете перейти на підхід проходження посилань, а не на підхід прохідної вартості, але це може бути не варте клопоту.
• Погляньте на R Inferno, щоб отримати більше підводних каменів.

Спробуйте покращити векторизацію , яка може часто, але не завжди допомогти. У зв'язку з цим, за своєю суттю векторизованних команди типу ifelse, diffтощо забезпечить більше поліпшення , ніж в applyродині команд (які мало забезпечують , щоб не підвищення швидкості над добре написаної петлею).

Ви також можете спробувати надати додаткову інформацію для функцій R . Наприклад, використовуйте, vapplyа неsapply вказуйте colClassesпід час читання в текстових даних . Швидкість швидкості буде різною залежно від того, скільки здогадок ви усунете.

Далі розглянемо оптимізовані пакети : data.tableПакет може виробляти величезні швидкості, коли це можливо, при маніпулюванні даними та при читанні великої кількості даних ( fread).

Далі спробуйте досягти швидкості за допомогою більш ефективних засобів виклику R :

• Складіть свій R-сценарій. Або використовуйте Raі jitпакунки в концерті для вчасного складання (Дірк має приклад у цій презентації ).
• Переконайтеся, що ви використовуєте оптимізовану BLAS. Вони забезпечують всебічне підвищення швидкості. Чесно кажучи, прикро, що R автоматично не використовує найефективнішу бібліотеку при встановленні. Сподіваємось, Revolution R сприятиме роботі, яку вони тут зробили, для всієї громади.
• Radford Neal здійснив купу оптимізацій, деякі з яких були прийняті в R Core, а багато інших, які були роздвоєні в pqR .

І нарешті, якщо все вищезазначене все ще не дає вам настільки швидко, як вам потрібно, можливо, вам доведеться перейти до більш швидкої мови для фрагмента повільного коду . Поєднання Rcppі inlineтут робить заміну лише найповільнішої частини алгоритму кодом C ++ особливо простою. Наприклад, це моя перша спроба зробити це , і це здуває навіть дуже оптимізовані R-рішення.

Якщо після цього все-таки у вас залишилися проблеми, вам просто потрібно більше обчислювальної потужності. Погляньте на паралелізацію ( http://cran.r-project.org/web/views/HighPerformanceComputing.html ) або навіть на основі GPU-рішень ( gpu-tools).

Посилання на інші вказівки

• http://www.noamross.net/blog/2013/4/25/faster-talk.html

Якщо ви використовуєте forпетлі, ви, швидше за все, кодуєте R так, як якщо б це був C або Java або щось інше. Правильний векторний код R надзвичайно швидкий.

Візьмемо для прикладу ці два простих біта коду для створення списку з 10 000 цілих чисел послідовно:

Перший приклад коду - як кодувати цикл, використовуючи традиційну парадигму кодування. На це потрібно 28 секунд

system.time({
    a <- NULL
    for(i in 1:1e5)a[i] <- i
})
   user  system elapsed 
  28.36    0.07   28.61 

Ви можете отримати майже 100-кратне покращення за допомогою простої дії попереднього розподілу пам'яті:

system.time({
    a <- rep(1, 1e5)
    for(i in 1:1e5)a[i] <- i
})

   user  system elapsed 
   0.30    0.00    0.29 

Але при використанні базового R-вектора за допомогою оператора двокрапки :ця операція практично миттєва:

system.time(a <- 1:1e5)

   user  system elapsed 
      0       0       0 

Це можна зробити набагато швидше, пропустивши цикли за допомогою індексів або вкладених ifelse()операторів.

idx <- 1:nrow(temp)
temp[,10] <- idx
idx1 <- c(FALSE, (temp[-nrow(temp),6] == temp[-1,6]) & (temp[-nrow(temp),3] == temp[-1,3]))
temp[idx1,10] <- temp[idx1,9] + temp[which(idx1)-1,10] 
temp[!idx1,10] <- temp[!idx1,9]    
temp[1,10] <- temp[1,9]
names(temp)[names(temp) == "V10"] <- "Kumm."

Мені не подобається переписувати код ... Також, звичайно, ifelse та lapply - кращі варіанти, але іноді важко зробити це підходящим.

Часто я використовую data.frames як один із таких списків df$var[i]

Ось складений приклад:

nrow=function(x){ ##required as I use nrow at times.
  if(class(x)=='list') {
    length(x[[names(x)[1]]])
  }else{
    base::nrow(x)
  }
}

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
})

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  d=as.list(d) #become a list
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  d=as.data.frame(d) #revert back to data.frame
})

версія data.frame:

   user  system elapsed 
   0.53    0.00    0.53

версія списку:

   user  system elapsed 
   0.04    0.00    0.03 

У 17 разів швидше використовувати список векторів, ніж фрейм data.frame.

Будь-які коментарі щодо того, чому внутрішньо data.frames настільки повільні в цьому плані? Можна було б подумати, що вони діють як списки ...

Для ще швидшого коду зробіть це class(d)='list'замість d=as.list(d)іclass(d)='data.frame'

system.time({
  d=data.frame(seq=1:10000,r=rnorm(10000))
  d$foo=d$r
  d$seq=1:5
  class(d)='list'
  mark=NA
  for(i in 1:nrow(d)){
    if(d$seq[i]==1) mark=d$r[i]
    d$foo[i]=mark
  }
  class(d)='data.frame'
})
head(d)

Як згадував Арі наприкінці своєї відповіді, пакети Rcppта inlineпакети дозволяють зробити речі швидко швидкими. Як приклад, спробуйте цей inlineкод (попередження: не перевірено):

body <- 'Rcpp::NumericMatrix nm(temp);
         int nrtemp = Rccp::as<int>(nrt);
         for (int i = 0; i < nrtemp; ++i) {
             temp(i, 9) = i
             if (i > 1) {
                 if ((temp(i, 5) == temp(i - 1, 5) && temp(i, 2) == temp(i - 1, 2) {
                     temp(i, 9) = temp(i, 8) + temp(i - 1, 9)
                 } else {
                     temp(i, 9) = temp(i, 8)
                 }
             } else {
                 temp(i, 9) = temp(i, 8)
             }
         return Rcpp::wrap(nm);
        '

settings <- getPlugin("Rcpp")
# settings$env$PKG_CXXFLAGS <- paste("-I", getwd(), sep="") if you want to inc files in wd
dayloop <- cxxfunction(signature(nrt="numeric", temp="numeric"), body-body,
    plugin="Rcpp", settings=settings, cppargs="-I/usr/include")

dayloop2 <- function(temp) {
    # extract a numeric matrix from temp, put it in tmp
    nc <- ncol(temp)
    nm <- dayloop(nc, temp)
    names(temp)[names(temp) == "V10"] <- "Kumm."
    return(temp)
}

Існує аналогічна процедура для #includeречей, де ви просто передаєте параметр

inc <- '#include <header.h>

до cxxfunction, як include=inc. Що насправді класно в цьому, це те, що він робить все посилання та компіляцію для вас, тому прототипування дійсно швидко.

Відмова: Я не зовсім впевнений, що клас tmp повинен бути числовим, а не числовою матрицею чи чимось іншим. Але я здебільшого впевнений.

Редагувати: якщо після цього вам все ж потрібна більша швидкість, OpenMP - це засіб паралелізації C++. Я не намагався його використовувати inline, але це має працювати. Ідея була б, в разі nядер, є цикл ітерація kбути здійснена шляхом k % n. Відповідне введення знайдене в програмі «Мистецтво R» Матлоффа , доступній тут , у главі 16, « Звернення до С» .

Відповіді тут чудові. Один незначний аспект, який не охоплюється, полягає в тому, що в запитанні зазначено " Мій ПК все ще працює (близько 10 годин зараз), і я не маю поняття про час виконання ". Я завжди ввожу наступний код у цикли, коли розробляю, щоб відчути, як зміни, здається, впливають на швидкість, а також для моніторингу, скільки часу буде потрібно для його завершення.

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    cat(round(i/nrow(temp)*100,2),"%    \r") # prints the percentage complete in realtime.
    # do stuff
  }
  return(blah)
}

Працює і з ноутбуком.

dayloop2 <- function(temp){
  temp <- lapply(1:nrow(temp), function(i) {
    cat(round(i/nrow(temp)*100,2),"%    \r")
    #do stuff
  })
  return(temp)
}

Якщо функція в циклі досить швидка, але кількість циклів велика, то слід розглянути можливість друку кожного разу так часто, оскільки друк на консолі має накладні витрати. напр

dayloop2 <- function(temp){
  for (i in 1:nrow(temp)){
    if(i %% 100 == 0) cat(round(i/nrow(temp)*100,2),"%    \r") # prints every 100 times through the loop
    # do stuff
  }
  return(temp)
}

У R ви часто можете прискорити обробку циклу, використовуючи applyсімейні функції (у вашому випадку це, мабуть, було б replicate). Погляньте на plyrпакет, який містить смужки прогресу.

Інший варіант - взагалі уникати циклів і замінювати їх векторизованою арифметикою. Я не впевнений, що саме ви робите, але ви, ймовірно, можете застосувати свою функцію до всіх рядків одночасно:

temp[1:nrow(temp), 10] <- temp[1:nrow(temp), 9] + temp[0:(nrow(temp)-1), 10]

Це буде набагато швидше, і тоді ви можете відфільтрувати рядки за своїм станом:

cond.i <- (temp[i, 6] == temp[i-1, 6]) & (temp[i, 3] == temp[i-1, 3])
temp[cond.i, 10] <- temp[cond.i, 9]

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

Обробка з data.table- це життєздатний варіант:

n <- 1000000
df <- as.data.frame(matrix(sample(1:10, n*9, TRUE), n, 9))
colnames(df) <- paste("col", 1:9, sep = "")

library(data.table)

dayloop2.dt <- function(df) {
  dt <- data.table(df)
  dt[, Kumm. := {
    res <- .I;
    ifelse (res > 1,             
      ifelse ((col6 == shift(col6, fill = 0)) & (col3 == shift(col3, fill = 0)) , 
        res <- col9 + shift(res)                   
      , # else
        res <- col9                                 
      )
     , # else
      res <- col9
    )
  }
  ,]
  res <- data.frame(dt)
  return (res)
}

res <- dayloop2.dt(df)

m <- microbenchmark(dayloop2.dt(df), times = 100)
#Unit: milliseconds
#       expr      min        lq     mean   median       uq      max neval
#dayloop2.dt(df) 436.4467 441.02076 578.7126 503.9874 575.9534 966.1042    10

Якщо проігнорувати можливі вигоди від фільтрації умов, це дуже швидко. Очевидно, що якщо ви можете зробити розрахунок за підмножиною даних, це допомагає.