2

遅延変数を使用して時系列を予測するために、dyn または dynlm を使用しています。

ただし、どちらの場合も予測関数は一度に 1 つのタイム ステップのみを評価し、私のコンピューターでは 1 ステップあたり 24 ミリ秒、または私のデータセットでは約 1.8 時間という一定の時間を要します。 10秒。

だから、おそらく最速の方法は、式を手で評価することだと思いますか?

それで、data.frameまたは現在の環境などで値を指定して数式を評価する方法はありますか?

私は次のようなことを考えています：

evalMagic( load ~ temperature + time, data.frame( temperature = 10, time = 4 ) )

これを書いているとき、次のような係数を何らかの方法で処理する必要があると思います。

evalMagic( load ~ temperature + time, data.frame( temperature = 10, time = 4 ), model$coefficients )

.... したがって、これにより次のような疑問が生じます。

  • これは予測が行うべきことではありませんか？
  • なぜ予測が遅いのですか？
  • 予測を少し速くするために必要なオプションは何ですか? 結局のところ、行列などを反転しているわけではありません。ちょっとした算数です。
4

2 に答える 2

2

最後に、独自のラグ実装を作成しました。それはハッキーで美しくはありませんが、はるかに高速です。それは私のくだらないラップトップで4秒で1000行を処理することができます。

# lags is a data.frame, eg:
#   var  amount
#   y    1
#   y    2
addLags <- function( dataset, lags ) {
    N <- nrow(dataset)
    print(lags)
    if( nrow(lags) > 0 ) {
        print(lags)
        for( j in 1:nrow(lags) ) {
            sourcename <- as.character( lags[j,"var"] )
            k <- lags[j,"amount"]
            cat("k",k,"sourcename",sourcename,"\n")
            lagcolname <- sprintf("%s_%d",sourcename,k)
            dataset[,lagcolname] <- c(rep(0,k), dataset[1:(N-k),sourcename])
        }
    }
    dataset
}

lmLagged <- function( formula, train, lags ) {
    # get largest lag, and skip that
    N <- nrow(train)
    skip <- 0
    for( j in 1:nrow(lags) ) {
        k <- lags[j,"amount"]
        skip <- max(k,skip)
    }
    print(train)
    train <- addLags( train, lags )
    print(train)
    lm( formula, train[(skip+1):N,] )
}

# pass in training data, test data,
# it will step through one by one
# need to give dependent var name
# lags is a data.frame, eg:
#   var amount
#   y    1
#   y    2
predictLagged <- function( model, train, test, dependentvarname, lags ) {
    Ntrain <- nrow(train)
    Ntest <- nrow(test)
    test[,dependentvarname] <- NA
    testtraindata <- rbind( train, test )
    testtraindata <- addLags( testtraindata, lags )
    for( i in 1:Ntest ) {
       thistestdata <- testtraindata[Ntrain + i,]
       result <- predict(model,newdata=thistestdata)
       for( j in 1:nrow(lags) ) {
            sourcename <- lags[j,"var"]
            k <- lags[j,"amount"]
            lagcolname <- sprintf("%s_%d",sourcename,k)
            testtraindata[Ntrain + i + k,lagcolname] <- result
       }
       testtraindata[Ntrain+i,dependentvarname] <- result
    }
    return( testtraindata[(Ntrain+1):(Ntrain + Ntest),dependentvarname] )    
}

library("RUnit")

# size of training data
N <- 6
predictN <- 50

# create training data, which we can get exact fit on
set.seed(1)
x = sample( 100, N )
traindata <- numeric()
traindata[1] <- 1 + 1.1 * x[1]
traindata[2] <- 2 + 1.1 * x[2]
for( i in 3:N ) {
   traindata[i] <- 0.5 + 0.3 * traindata[i-2] - 0.8 * traindata[i-1] + 1.1 * x[i]
}
train <- data.frame(x = x, y = traindata, foo = 1)
#train$x <- NULL

# create testing data, bunch of NAs
test <- data.frame( x = sample(100,predictN), y = rep(NA,predictN), foo = 1)

# specify which lags we need to handle
# one row per lag, with name of variable we are lagging, and the distance
# we can then use these in the formula, eg y_1, and y_2
# are y lagged by 1 and 2 respectively
# It's hacky but it kind of works...
lags <- data.frame( var = c("y","y"), amount = c(1,2) ) 

# fit a model
model <- lmLagged(  y ~ x + y_1 + y_2, train, lags )
# look at the model, it's a perfect fit. Nice!
print(model)

print(system.time( test <- predictLagged( model, train, test, "y", lags ) ))
#checkEqualsNumeric( 69.10228, test[56-6], tolerance = 0.0001 )
#checkEquals( 2972.159, test$y[106-6] )
print(test)

# nice plot
plot(test, type='l')

出力：

> source("test/test.regressionlagged.r",echo=F)

Call:
lm(formula = formula, data = train[(skip + 1):N, ])

Coefficients:
(Intercept)            x          y_1          y_2  
        0.5          1.1         -0.8          0.3  

   user  system elapsed 
  0.204   0.000   0.204 
 [1]  -19.108620  131.494916  -42.228519   80.331290  -54.433588   86.846257
 [7]  -13.807082   77.199543   12.698241   64.101270   56.428457   72.487616
[13]   -3.161555   99.575529    8.991110   44.079771   28.433517    3.077118
[19]   30.768361   12.008447    2.323751   36.343533   67.822299  -13.154779
[25]   72.070513  -11.602844  115.003429  -79.583596  164.667906 -102.309403
[31]  193.347894 -176.071136  254.361277 -225.010363  349.216673 -299.076448
[37]  400.626160 -371.223862  453.966938 -420.140709  560.802649 -542.284332
[43]  701.568260 -679.439907  839.222404 -773.509895  897.474637 -935.232679
[49] 1022.328534 -991.232631

これらの91行のコードには約12時間の作業があります。OK、PlantsandZombiesを少しプレイしたことを告白します。だから、10時間。加えて、昼食と夕食。それでも、とにかくかなり多くの作業があります。

ForecastNを1000に変更すると、system.time呼び出しから約4.1秒かかります。

私はそれがより速いと思います：

  • 時系列は使用しません。私はそれが物事をスピードアップすると思う
  • 動的lmライブラリは使用せず、通常のlmのみを使用します。少し速いと思います
  • 予測ごとに1行のデータのみをpredictに渡します。これは非常に高速であると思います。たとえば、dyn $ lmまたはdynmlmを使用すると、ラグが30の場合、31行のデータをpredictAFAIKに渡す必要があります。
  • 反復ごとにラグ値をインプレースで更新するだけなので、data.frame/matrixのコピーが大幅に少なくなります

編集：predictLaggedが単なる数値ベクトルではなく複数列のデータフレームを返すマイナーなバグを修正しましたEdit2：複数の変数を追加できないマイナーなバグを修正しました。また、ラグのコメントとコードを調整し、ラグの構造を「name」と「lags」の代わりに「var」と「amount」に変更しました。また、テストコードを更新して、2番目の変数を追加しました。

編集：このバージョンにはたくさんのバグがあります。これは、もう少しユニットテストして修正したためですが、コピーと貼り付けには非常に時間がかかるため、この投稿を数日で更新します。 、締め切りが過ぎたら。

于 2012-10-27T18:24:34.363 に答える
1

多分あなたはこれを探しています：

fastlinpred <- function(formula, newdata, coefs) {
   X <- model.matrix( formula, data=newdata)
   X %*% coefs
}
coefs <- c(1,2,3) 
dd <- data.frame( temperature = 10, time = 4 )
fastlinpred(  ~ temperature + time, 
      dd , coefs )

これは、数式に RHS のみがあることを前提としています (数式の LHS を削除するには、 を実行しますform[-2])。

これは確かに のオーバーヘッドの多くを取り除きますがpredict.lm、それがあなたが望むほど速いかどうかはわかりません。 model.matrix内部機械もたくさんあります。

于 2012-10-27T16:15:56.417 に答える