11

次のコードに非常によく似たローリング回帰を実行しています。

library(PerformanceAnalytics)
library(quantmod)
data(managers)

FL <- as.formula(Next(HAM1)~HAM1+HAM2+HAM3+HAM4)
MyRegression <- function(df,FL) {
  df <- as.data.frame(df)
  model <- lm(FL,data=df[1:30,])
  predict(model,newdata=df[31,])
}

system.time(Result <- rollapply(managers, 31, FUN="MyRegression",FL,
    by.column = FALSE, align = "right", na.pad = TRUE))

余分なプロセッサをいくつか持っているので、ローリング ウィンドウを並列化する方法を見つけようとしています。これが非ローリング回帰である場合、関数の適用ファミリーを使用して簡単に並列化できます...

4

2 に答える 2

10

明らかなものはlm.fit()代わりに使用することでlm()、式などの処理ですべてのオーバーヘッドが発生しないようにします.

更新:だから、私が言うべきことは明白であると言ったとき、私が言おうとしていたことは盲目的に明白でしたが、実装するのは一見困難でした!

ちょっといじった後、これを思いついた

library(PerformanceAnalytics)
library(quantmod)
data(managers)

最初の段階は、モデル マトリックスを事前に構築できることを理解することです。そのため、それを行い、それを Zoo オブジェクトに変換して で使用できるようにしrollapply()ます。

mmat2 <- model.frame(Next(HAM1) ~ HAM1 + HAM2 + HAM3 + HAM4, data = managers, 
                     na.action = na.pass)
mmat2 <- cbind.data.frame(mmat2[,1], Intercept = 1, mmat2[,-1])
mmatZ <- as.zoo(mmat2)

ここlm.fit()で、反復ごとに設計行列を作成することなく、重い作業を行うために使用する関数が必要です。

MyRegression2 <- function(Z) {
    ## store value we want to predict for
    pred <- Z[31, -1, drop = FALSE]
    ## get rid of any rows with NA in training data
    Z <- Z[1:30, ][!rowSums(is.na(Z[1:30,])) > 0, ]
    ## Next() would lag and leave NA in row 30 for response
    ## but we precomputed model matrix, so drop last row still in Z
    Z <- Z[-nrow(Z),]
    ## fit the model
    fit <- lm.fit(Z[, -1, drop = FALSE], Z[,1])
    ## get things we need to predict, in case pivoting turned on in lm.fit
    p <- fit$rank
    p1 <- seq_len(p)
    piv <- fit$qr$pivot[p1]
    ## model coefficients
    beta <- fit$coefficients
    ## this gives the predicted value for row 31 of data passed in
    drop(pred[, piv, drop = FALSE] %*% beta[piv])
}

タイミングの比較:

> system.time(Result <- rollapply(managers, 31, FUN="MyRegression",FL,
+                                 by.column = FALSE, align = "right", 
+                                 na.pad = TRUE))
   user  system elapsed 
  0.925   0.002   1.020 
> 
> system.time(Result2 <- rollapply(mmatZ, 31, FUN = MyRegression2,
+                                  by.column = FALSE,  align = "right",
+                                  na.pad = TRUE))
   user  system elapsed 
  0.048   0.000   0.05

これにより、オリジナルよりもかなり合理的な改善が得られます。そして、結果のオブジェクトが同じであることを確認します。

> all.equal(Result, Result2)
[1] TRUE

楽しみ！

于 2011-04-13T15:57:31.793 に答える