RのLOESS回帰で使用するスパンを決定するにはどうすればよいですか？

RでLOESS回帰モデルを実行していますが、12の異なるモデルの出力をさまざまなサンプルサイズで比較したいと思います。質問への回答に役立つ場合は、実際のモデルをより詳細に説明できます。

サンプルサイズは次のとおりです。

Fastballs vs RHH 2008-09: 2002
Fastballs vs LHH 2008-09: 2209
Fastballs vs RHH 2010: 527 
Fastballs vs LHH 2010: 449

Changeups vs RHH 2008-09: 365
Changeups vs LHH 2008-09: 824
Changeups vs RHH 2010: 201
Changeups vs LHH 2010: 330

Curveballs vs RHH 2008-09: 488
Curveballs vs LHH 2008-09: 483
Curveballs vs RHH 2010: 213
Curveballs vs LHH 2010: 162

LOESS回帰モデルはサーフェスフィットであり、各野球ピッチのX位置とY位置を使用してsw、スイングストライクの確率を予測します。ただし、これらの12のモデルすべてを比較したいのですが、サンプルサイズが非常に広いため、同じスパン（つまり、スパン= 0.5）を設定すると、異なる結果が生じます。

私の基本的な質問は、モデルのスパンをどのように決定するのですか？スパンが大きいとフィットがよりスムーズになり、スパンが小さいとより多くのトレンドがキャプチャされますが、データが少なすぎると統計上のノイズが発生します。サンプルサイズが小さい場合はスパンを大きくし、サンプルサイズが大きい場合はスパンを小さくします。

私は何をすべきか？RのLOESS回帰モデルのスパンを設定するときの良い経験則は何ですか？前もって感謝します！

RMSEPが最小の近似を見つけることを目的とする場合、k分割などの交差検証がよく使用されます。データをk個のグループに分割し、各グループを順番に除外して、k -1 個のデータグループと選択した平滑化パラメーターの値を使用して黄土モデルを近似し、そのモデルを使用して除外グループを予測します。除外されたグループの予測値を保存し、k個のグループのそれぞれが1回除外されるまで繰り返します。予測値のセットを使用して、RMSEPを計算します。次に、調整する平滑化パラメーターの各値について、すべてを繰り返します。CVで最小のRMSEPを与える平滑化パラメーターを選択します。

ご覧のとおり、これはかなり計算量が多くなります。LOESSで使用できる真のCVに代わる一般化された相互検証（GCV）がない場合、私は驚くでしょう-Hastieら（セクション6.2）は、これが非常に簡単であり、演習の1つでカバーされていることを示します。

Hastie et al。の第5章のセクション6.1.1、6.1.2および6.2に加えて、スムージングスプラインの正則化に関するセクション（内容もここに適用されるため）を読むことをお勧めします。（2009）統計学習の要素：データマイニング、推論、予測。第2版​​。スプリンガー。PDFは無料でダウンロードできます。

一般化された加法モデル（GAM、Rのmgcvパッケージを参照）をチェックすることをお勧めします。私はそれらについて自分自身で学んでいますが、データによって「ウィググリネス」がどれだけ正当化されるかを自動的に把握しているようです。また、二項データ（ストライクとストライクではない）を扱っているので、生データを分析して（つまり、比率に集約せずに、ピッチごとの生データを使用して）、family = 'binomial'（Rを使用すると仮定）。個々の投手と打者がデータにどのような貢献をしているかについての情報がある場合は、一般化された加法混合モデル（GAMM、Rのgamm4パッケージを参照）を実行し、投手と打者をランダム効果として指定することで（そして再び） 、family = 'binomial'）を設定します。最後に、おそらく、XとYのスムース間の相互作用を許可したいのですが、私はこれを自分で試したことがないので、その方法についてはわかりません。X * Y相互作用のないgamm4モデルは次のようになります。

fit = gamm4(
    formula = strike ~ s(X) + s(Y) + pitch_type*batter_handedness + (1|pitcher) + (1|batter)
    , data = my_data
    , family = 'binomial'
)
summary(fit$gam)

考えてみると、おそらくピッチの種類と打者の利き手のレベルごとに滑らかさを変えたいと思うでしょう。これにより、意味のある分析テストを後で生成する方法で複数の変数によって平滑化を変化させる方法をまだ見つけていないため、問題がより困難になります（R-SIG-Mixed-Modelsリストへのクエリを参照）。あなたが試すことができます：

my_data$dummy = factor(paste(my_data$pitch_type,my_data$batter_handedness))
fit = gamm4(
    formula = strike ~ s(X,by=dummy) + s(Y,by=dummy) + pitch_type*batter_handedness + (1|pitcher) + (1|batter)
    , data = my_data
    , family = 'binomial'
)
summary(fit$gam)

しかし、これはスムーズの意味のあるテストを提供しません。この問題を自分で解決するために、ブートストラップリサンプリングを使用して、各反復で完全なデータ空間のモデル予測を取得し、空間内の各ポイントのブートストラップ95％CIと計算したい任意の効果を計算しました。

レス回帰の場合、非統計学者としての私の理解は、視覚的な解釈に基づいてスパンを選択できることです（多数のスパン値を持つプロットは、適切と思われるスムージングの量が最も少ないものを選択できます）、またはクロス検証を使用できます（CV）または一般化された相互検証（GCV）。以下は、竹沢の優れた本であるノンパラメトリック回帰入門（p219から）のコードに基づくレス回帰のGCVに使用したコードです。

locv1 <- function(x1, y1, nd, span, ntrial)
{
locvgcv <- function(sp, x1, y1)
{
    nd <- length(x1)

    assign("data1", data.frame(xx1 = x1, yy1 = y1))
    fit.lo <- loess(yy1 ~ xx1, data = data1, span = sp, family = "gaussian", degree = 2, surface = "direct")
    res <- residuals(fit.lo)

    dhat2 <- function(x1, sp)
    {
        nd2 <- length(x1)
        diag1 <- diag(nd2)
        dhat <- rep(0, length = nd2)

        for(jj in 1:nd2){
            y2 <- diag1[, jj]
            assign("data1", data.frame(xx1 = x1, yy1 = y2))
            fit.lo <- loess(yy1 ~ xx1, data = data1, span = sp, family = "gaussian", degree = 2, surface = "direct")
            ey <- fitted.values(fit.lo)
            dhat[jj] <- ey[jj]
            }
            return(dhat)
        }

        dhat <- dhat2(x1, sp)
        trhat <- sum(dhat)
        sse <- sum(res^2)

        cv <- sum((res/(1 - dhat))^2)/nd
        gcv <- sse/(nd * (1 - (trhat/nd))^2)

        return(gcv)
    }

    gcv <- lapply(as.list(span1), locvgcv, x1 = x1, y1 = y1)
    #cvgcv <- unlist(cvgcv)
    #cv <- cvgcv[attr(cvgcv, "names") == "cv"]
    #gcv <- cvgcv[attr(cvgcv, "names") == "gcv"]

    return(gcv)
}

そして私のデータで、私は次のことをしました：

nd <- length(Edge2$Distance)
xx <- Edge2$Distance
yy <- lcap

ntrial <- 50
span1 <- seq(from = 0.5, by = 0.01, length = ntrial)

output.lo <- locv1(xx, yy, nd, span1, ntrial)
#cv <- output.lo
gcv <- output.lo

plot(span1, gcv, type = "n", xlab = "span", ylab = "GCV")
points(span1, gcv, pch = 3)
lines(span1, gcv, lwd = 2)
gpcvmin <- seq(along = gcv)[gcv == min(gcv)]
spangcv <- span1[pgcvmin]
gcvmin <- cv[pgcvmin]
points(spangcv, gcvmin, cex = 1, pch = 15)

申し訳ありませんが、コードはかなりずさんです。これはRを使用する初めての試みの1つですが、単純な目視検査よりも客観的な方法で使用するのに最適なスパンを見つけるために、レス回帰のGSVを実行する方法のアイデアを提供する必要があります。上記のプロットでは、関数を最小化するスパン（プロットされた「曲線」で最も低い）に関心があります。

あなたはgenerlized加法モデルに切り替えた場合は、使用することができますgam()から機能をmgcvの作者がどのパッケージ、私たちを保証します：

そのため、kの正確な選択は一般的に重要ではありません。基になる「真実」を合理的に十分に表現するのに十分な自由度があることを十分に確信できるほど十分に大きく選択する必要がありますが、合理的な計算効率を維持するのに十分小さいです。明らかに「大」と「小」は、対処する特定の問題に依存しています。

（kここに、スムーザーの自由度パラメーターがあります。これは、黄土の滑らかさパラメーターに似ています）

パッケージのloess()関数を使用する独自の相互検証ループをゼロから作成できstatsます。

1. おもちゃのデータフレームを設定します。

   set.seed(4)
   x <- rnorm(n = 500)
   y <- (x)^3 + (x - 3)^2 + (x - 8) - 1 + rnorm(n = 500, sd = 0.5)
   plot(x, y)
   df <- data.frame(x, y)

2. 交差検証ループを処理するための便利な変数を設定します。

   span.seq <- seq(from = 0.15, to = 0.95, by = 0.05) #explores range of spans
   k <- 10 #number of folds
   set.seed(1) # replicate results
   folds <- sample(x = 1:k, size = length(x), replace = TRUE)
   cv.error.mtrx <- matrix(rep(x = NA, times = k * length(span.seq)), 
                           nrow = length(span.seq), ncol = k)

3. でfor各スパンの可能性を反復するネストされたループを実行し、span.seq各フォールドを実行しfoldsます。

   for(i in 1:length(span.seq)) {
     for(j in 1:k) {
       loess.fit <- loess(formula = y ~ x, data = df[folds != j, ], span = span.seq[i])
       preds <- predict(object = loess.fit, newdata = df[folds == j, ])
       cv.error.mtrx[i, j] <- mean((df$y[folds == j] - preds)^2, na.rm = TRUE)
       # some predictions result in `NA` because of the `x` ranges in each fold
    }
   }

4. $$CV_{(10)} = \frac{1}{10} \sum_{i=1}^{10} MSE_i$$

   cv.errors <- rowMeans(cv.error.mtrx)

5. $MSE$

   best.span.i <- which.min(cv.errors)
   best.span.i
   span.seq[best.span.i]

6. 結果をプロットします。

   plot(x = span.seq, y = cv.errors, type = "l", main = "CV Plot")
   points(x = span.seq, y = cv.errors, 
          pch = 20, cex = 0.75, col = "blue")
   points(x = span.seq[best.span.i], y = cv.errors[best.span.i], 
          pch = 20, cex = 1, col = "red")
   
   best.loess.fit <- loess(formula = y ~ x, data = df, 
                           span = span.seq[best.span.i])
   
   x.seq <- seq(from = min(x), to = max(x), length = 100)
   
   plot(x = df$x, y = df$y, main = "Best Span Plot")
   lines(x = x.seq, y = predict(object = best.loess.fit, 
                                newdata = data.frame(x = x.seq)), 
         col = "red", lwd = 2)

locfitパッケージを使用します。黄土のわずかに変更されたバージョンですが、ずっと高速です。また、gcv http://www.statistik.lmu.de/~leiten/Lehre/Material/GLM_0708/Tutorium/locfit.pdfを計算する組み込み関数もあり ます。

fANCOVAのパッケージには、GCVまたはAICを使用して理想的なスパンを計算する自動化された方法を提供します。

FTSE.lo3 <- loess.as(Index, FTSE_close, degree = 1, criterion = c("aicc", "gcv")[2], user.span = NULL, plot = F)
FTSE.lo.predict3 <- predict(FTSE.lo3, data.frame(Index=Index))