Ускорить цикл работы в R - PullRequest
180 голосов
/ 26 мая 2010

У меня большая проблема с производительностью в R. Я написал функцию, которая перебирает объект data.frame. Он просто добавляет новый столбец к data.frame и что-то накапливает. (простая операция). data.frame имеет примерно 850 тыс. Строк. Мой компьютер все еще работает (около 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)
}

Есть идеи, как ускорить эту операцию?

Ответы [ 9 ]

419 голосов
/ 04 июня 2010

Самая большая проблема и корень неэффективности - это индексирование data.frame, я имею в виду все эти строки, где вы используете temp[,].
Постарайтесь избежать этого как можно больше. Я взял твою функцию, поменяй индексацию и вот version_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))

Результат

performance

Вы можете видеть, что ваша версия экспоненциально зависит от 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.

performance

Настройка настроенного

Другим изменением является изменение в цикле индексации temp[i,9] на res[i] (что точно так же в итерации i-го цикла). Это опять разница между индексированием вектора и индексированием 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 строк ниже одной секунды.

performance

Если вы хотите, вы можете пойти дальше, я вижу, по крайней мере, две вещи, которые можно сделать:

  • написать код C, чтобы выполнить условное перечисление
  • если вы знаете, что в ваших данных максимальная последовательность не велика, вы можете изменить цикл на векторизованное время, что-то вроде

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

Код, используемый для моделирования и рисунков: доступен на GitHub .

134 голосов
/ 12 декабря 2011

Общие стратегии для ускорения кода 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 внесет свой вклад в работу сообщества в целом.
  • Рэдфорд Нил провел ряд оптимизаций, некоторые из которых были приняты в R Core, а многие другие были отменены.в pqR .

И, наконец, если все вышеперечисленное по-прежнему не дает вам так быстро, как вам нужно, возможно, вам придется перейти на быстрееязык для медленного фрагмента кода .Комбинация Rcpp и inline здесь делает замену только самой медленной части алгоритма кодом C ++ особенно легкой.Вот, например, моя первая попытка сделать это , и она срывает даже высоко оптимизированные решения R.

Если после всего этого у вас все еще есть проблемы, вам просто нужнобольше вычислительной мощности.Посмотрите на распараллеливание (http://cran.r -project.org / web / views / HighPerformanceComputing.html ) или даже решения на основе GPU (gpu-tools).

Ссылки на другие инструкции

34 голосов
/ 28 июня 2011

Если вы используете циклы 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 
17 голосов
/ 26 мая 2010

Это можно сделать намного быстрее, пропустив циклы с помощью индексов или вложенных 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."
7 голосов
/ 26 июля 2012

Как отметил Ари в конце своего ответа, пакеты 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 должен быть числовым, а не числовой матрицей или чем-то еще. Но я в основном уверен.

Edit: если вам все еще нужно больше скорости, OpenMP - это средство распараллеливания, подходящее для C++. Я не пробовал использовать его с inline, но он должен работать. Идея заключалась бы в том, чтобы в случае n ядер итерация цикла k была выполнена k % n. Подходящее введение можно найти в Matloff's Art of R Programming , доступно здесь , в главе 16, С использованием C .

6 голосов
/ 03 августа 2016

Мне не нравится переписывать код ... Также, конечно, 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)
3 голосов
/ 25 мая 2018

Ответы здесь великолепны. Один из второстепенных аспектов, который не был затронут, заключается в том, что вопрос « Мой ПК все еще работает (сейчас около 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)
}

Работает также с lapply.

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)
}
2 голосов
/ 26 мая 2010

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

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

0 голосов
/ 10 мая 2016

Обработка с 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

Если вы игнорируете возможные выгоды от фильтрации условий, это очень быстро. Очевидно, что если вы можете сделать расчет на подмножестве данных, это помогает.

...