如何在R中加速以下功能?

时间:2013-12-12 19:41:22

标签: r optimization lapply

我有一个名为“marketdata”的数据框,其中包含3,000,000行(rownames:1到3,000,000)和2列(colnames:“mid”,“bo”)。

> 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”值&lt; = 0.1作为“有效样本”的行。最后计算这些“有效样本”的平均值及其百分比。

但是,这个脚本运行得很慢。花了大约15分钟完成所有3,000,000行。任何人都可以帮助我加快速度吗?谢谢。

1 个答案:

答案 0 :(得分:3)

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