Как ускорить следующую функцию в R?

У меня есть фрейм данных под названием «рыночные данные», который содержит 3 000 000 строк (имена строк: от 1 до 3 000 000) и 2 столбца (имена столбцов: «середина», «бо»).

> head(marketdata)
    mid    bo  
1   250    0.05
2   251    0.07
3   252    0.13
4   249    0.08
5   250    0.12

Моя функция такова:

movingWindow <- function (submarketdata) {
   temp <- submarketdata[submarketdata$bo <= 0.1, ]   
   return( c(mean(temp$mid), NROW(temp)/100) )
}

result <- lapply(c(101:NROW(marketdata)), function(i) movingWindow( marketdata[ (i-99):i , ] ))

Например, для строки 101 я буду искать marketdata[2:101,]. Затем найдите те строки, которые имеют значение «bo» ‹= 0,1 как« эффективный образец ». И, наконец, вычислите среднее значение этих «эффективных образцов» и их процентное содержание.

Однако этот сценарий работает очень медленно. Чтобы закончить все 3 000 000 строк, потребовалось около 15 минут. Может ли кто-нибудь помочь мне ускорить это? Спасибо.


r optimization lapply
person Hang    schedule 12.12.2013    source источник
comment
Вам необходимо предоставить репрезентативную выборку marketdata. Прочтите этот FAQ.   -  person Roland    schedule 12.12.2013
comment
Что ж, вы достигли ок. 3333 вывода в секунду. Нет необходимости в вашей movingWindow функции, так как каждый из ее выходов легко векторизуется.   -  person Carl Witthoft    schedule 13.12.2013

Ответы (1)


arrow_upward
3
arrow_downward 

set.seed(42)
marketdata <- data.frame(mid=runif(200, 245, 255),
                 bo=runif(200, 0, 0.2))

movingWindow <- function (submarketdata) {
  temp <- submarketdata[submarketdata$bo <= 0.1, ]   
  return( c(mean(temp$mid), NROW(temp)/100) )
}

result <- t(sapply(c(101:NROW(marketdata)), function(i) movingWindow( marketdata[ (i-99):i , ] )))

#faster alternative:
library(zoo)
r1 <- rollmean(marketdata$bo <= 0.1, 100)
all.equal(r1[-1], result[,2])

r2 <- rollsum((marketdata$bo <= 0.1)*marketdata$mid, 100)/(100*r1)

result2 <- cbind(r2, r1)

#same result?
all.equal(result, unname(result2[-1,]))
#[1] TRUE

#base R alternative (assuming there are no NA values in your data)
r1a <- na.omit(filter(marketdata$bo <= 0.1, rep(0.01, 100)))
r2a <- na.omit(filter((marketdata$bo <= 0.1)*marketdata$mid, rep(1, 100)))/(100*r1a)
result2a <- cbind(r2a, r1a)

#same result?
all.equal(result, unname(result2a[-1,]))
#[1] TRUE

Альтернативы дают еще одно значение (первое значение). В остальном результаты идентичны, и обе альтернативы работают намного быстрее.

Тесты для примера:

Unit: microseconds
        expr        min        lq    median        uq       max neval
    original  19006.144 19435.262 20824.245 21243.524 52965.168   100
alternative1   1444.574  1525.774  1607.264  1646.524  3486.940   100
alternative2    975.366  1006.913  1071.305  1106.437  3117.709   100
person Roland    schedule 12.12.2013
comment
Разве ваше уравнение Alt # 2 r2a не должно вызывать r1a, а не r1? - person Carl Witthoft; 13.12.2013
comment
@CarlWitthoft Спасибо, исправил. - person Roland; 13.12.2013
comment
Привет, Роланд, большое спасибо за ваш пост. Однако я чувствую, что этот альтернативный метод дает другой результат по сравнению с моим исходным методом. В своей функции я вычисляю среднее значение выборок со столбцом bo ‹= 0,1 В ТЕЧЕНИЕ предыдущих 100 обновлений. Хотя я думаю, что вы вычислили предыдущие 100 образцов, которые удовлетворяют bo ‹= 0,1. - person Hang; 13.12.2013
comment
О, я вижу. Я сделал ошибку. Среднее значение фактически вычисляется с использованием rollsum / (100 * r1) вместо первой функции rollmean, которая возвращает количество эффективных выборок. Большое Вам спасибо. - person Hang; 13.12.2013