Ускорьте работу цикла в R

У меня большая проблема с производительностью в 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)
}

Любые идеи о том, как ускорить эту операцию?

ОТВЕТЫ

Ответ 1

Самая большая проблема и корень неэффективности - это индексирование 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 от 10000 до 100 000 на 10000.

performance

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

Другая настройка - это изменение в индексе цикла 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 строк ниже одной секунды.

performance

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

  • напишите код C, чтобы сделать условную cumsum

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

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

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

Ответ 2

Общие стратегии ускорения кода R

Сначала выясните , где медленная часть. Нет необходимости оптимизировать код, который не работает медленно. Для небольших количеств кода, простое мышление через него может работать. Если это не удастся, могут оказаться полезными RProf и аналогичные инструменты профилирования.

Как только вы выясните узкое место, подумайте о более эффективных алгоритмах для того, чтобы делать то, что вы хотите. Расчеты должны выполняться только один раз, если это возможно, поэтому:

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

Затем вы можете избежать особых общих проблем:

  • cbind очень быстро замедлит вас.
  • Инициализируйте свои структуры данных, затем заполните их вместо того, чтобы расширять их каждый время.
  • Даже при предварительном распределении вы можете переключиться на подход "за кадром", а не на подход по принципу "по порядку", но это может не стоить проблем.
  • Посмотрите R Inferno, чтобы избежать ошибок.

Попробуйте лучше векторизация, которая может часто, но не всегда помогает. В этом отношении, по сути, векторизованные команды, такие как ifelse, diff и т.п., Будут обеспечивать большее улучшение, чем команды команд apply (которые не обеспечивают никакого ускорения скорости по хорошо записанному циклу).

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

Затем рассмотрим оптимизированные пакеты. data.table пакет может обеспечить массовый прирост скорости, когда его использование возможно, при манипулировании данными и при чтении больших объемов данных (fread).

Затем попробуйте увеличить скорость с помощью более эффективных способов вызова R:

  • Скомпилируйте свой R script. Или используйте пакеты Ra и jit для компиляции "точно вовремя" (у Dirk есть пример в этой презентации).
  • Убедитесь, что вы используете оптимизированный BLAS. Они обеспечивают все преимущества скорости. Честно говоря, стыдно, что R не использует автоматически самую эффективную библиотеку при установке. Надеемся, что R R будет способствовать работе, которую они сделали здесь, всему сообществу.
  • Radford Neal проделал кучу оптимизаций, некоторые из которых были приняты в R Core и многие другие, которые были разветвлены на pqR.

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

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

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

Ответ 3

Если вы используете циклы 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

Ответ 4

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

Ответ 5

Как сказал Ари в конце своего ответа, пакеты 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. Соответствующее введение найдено в Matloff The Art of R Programming, доступно здесь, в главе 16, Прибегать к C.

Ответ 6

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

Ответ 7

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

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

Ответ 8

Обработка с помощью 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

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