Bagaimana cara memutuskan rentang apa yang akan digunakan dalam regresi LOESS di R?

Saya menjalankan model regresi LOESS dalam R, dan saya ingin membandingkan output dari 12 model yang berbeda dengan ukuran sampel yang bervariasi. Saya dapat menjelaskan model yang sebenarnya lebih terinci jika itu membantu dengan menjawab pertanyaan.

Berikut adalah ukuran sampel:

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

Model regresi LOESS adalah fit permukaan, di mana lokasi X dan lokasi Y dari masing-masing lapangan baseball digunakan untuk memprediksi probabilitas sw, pukulan ayun. Namun, saya ingin membandingkan antara 12 model ini, tetapi pengaturan rentang yang sama (yaitu rentang = 0,5) akan menghasilkan hasil yang berbeda karena ada berbagai ukuran sampel.

Pertanyaan dasar saya adalah bagaimana Anda menentukan rentang model Anda? Rentang yang lebih tinggi memuluskan fit lebih banyak, sementara rentang yang lebih rendah menangkap lebih banyak tren tetapi memperkenalkan kebisingan statistik jika ada terlalu sedikit data. Saya menggunakan rentang yang lebih tinggi untuk ukuran sampel yang lebih kecil dan rentang yang lebih rendah untuk ukuran sampel yang lebih besar.

Apa yang harus saya lakukan? Apa aturan praktis yang baik ketika menetapkan rentang untuk model regresi LOESS di R? Terima kasih sebelumnya!

Validasi silang sering digunakan, misalnya k- lipat, jika tujuannya adalah menemukan kecocokan dengan RMSEP terendah. Bagi data Anda menjadi kelompok k dan, biarkan masing-masing kelompok keluar, muat model loess menggunakan kelompok data k -1 dan nilai yang dipilih dari parameter smoothing, dan gunakan model itu untuk memprediksi untuk kelompok yang ditinggalkan. Simpan nilai yang diprediksi untuk kelompok yang ditinggalkan dan kemudian ulangi sampai masing-masing kelompok k telah ditinggalkan satu kali. Menggunakan set nilai yang diprediksi, hitung RMSEP. Kemudian ulangi semuanya untuk setiap nilai parameter penghalusan yang ingin Anda sempurnakan. Pilih parameter smoothing yang menghasilkan RMSEP terendah di bawah CV.

Seperti yang Anda lihat, ini adalah komputasi yang cukup berat. Saya akan terkejut jika tidak ada alternatif lintas-validasi umum (GCV) untuk CV sejati yang dapat Anda gunakan dengan LOESS - Hastie et al (bagian 6.2) menunjukkan ini cukup sederhana untuk dilakukan dan dibahas dalam salah satu latihan mereka .

Saya sarankan Anda membaca bagian 6.1.1, 6.1.2 dan 6.2, ditambah bagian tentang regularisasi dari splines smoothing (seperti konten berlaku di sini juga) dalam Bab 5 dari Hastie et al. (2009) Elemen Pembelajaran Statistik: Penambangan data, inferensi, dan prediksi . Edisi ke-2. Peloncat. PDF dapat diunduh secara gratis.

Saya sarankan untuk memeriksa model aditif umum (GAM, lihat paket mgcv dalam R). Saya hanya belajar tentang mereka sendiri, tetapi mereka tampaknya secara otomatis mencari tahu berapa banyak "kegoyahan" dibenarkan oleh data. Saya juga melihat bahwa Anda berurusan dengan data binomial (mogok vs bukan mogok), jadi pastikan untuk menganalisis data mentah (mis. Jangan agregat ke proporsi, gunakan data pitch-by-pitch yang mentah) dan gunakan family = 'binomial' (dengan asumsi Anda akan menggunakan R). Jika Anda memiliki informasi tentang kontribusi pitcher dan hitter pada data, Anda mungkin dapat meningkatkan kekuatan Anda dengan melakukan model campuran aditif umum (GAMM, lihat paket gamm4 dalam R) dan tentukan pitcher dan hitter sebagai efek acak (dan lagi , pengaturan family = 'binomial'). Akhirnya, Anda mungkin ingin mengizinkan interaksi antara smooth X & Y, tapi saya belum pernah mencobanya sendiri jadi saya tidak tahu bagaimana cara melakukannya. Model gamm4 tanpa interaksi X * Y akan terlihat seperti:

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

Kalau dipikir-pikir, Anda mungkin ingin membiarkan smooths bervariasi dalam setiap tingkat jenis pitch dan adonan kidal. Ini membuat masalah lebih sulit karena saya belum menemukan cara untuk membiarkan smooths bervariasi oleh beberapa variabel dengan cara yang kemudian menghasilkan tes analitik yang bermakna ( lihat pertanyaan saya ke daftar R-SIG-Mixed-Models ). Kamu bisa mencoba:

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)

Tapi ini tidak akan memberikan tes yang berarti dari smooths. Dalam mencoba menyelesaikan masalah ini sendiri, saya telah menggunakan bootstrap resampling di mana pada setiap iterasi saya mendapatkan prediksi model untuk ruang data lengkap kemudian menghitung bootstap 95% CI untuk setiap titik di ruang dan setiap efek yang ingin saya hitung.

Untuk regresi loess, pemahaman saya sebagai non-ahli statistik, adalah bahwa Anda dapat memilih rentang berdasarkan interpretasi visual (plot dengan banyak nilai rentang dapat memilih yang dengan jumlah smoothing paling sedikit yang tampaknya sesuai) atau Anda dapat menggunakan validasi silang (CV) atau validasi silang umum (GCV). Di bawah ini adalah kode yang saya gunakan untuk GCV dari regresi loess berdasarkan kode dari buku Takezawa yang bagus, Pengantar Regresi Nonparametrik (dari p219).

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)
}

dan dengan data saya, saya melakukan hal berikut:

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)

Maaf kodenya agak ceroboh, ini adalah salah satu kali pertama saya menggunakan R, tetapi harus memberi Anda gagasan tentang bagaimana melakukan GSV untuk regresi loess untuk menemukan rentang terbaik untuk digunakan dalam cara yang lebih objektif daripada inspeksi visual sederhana. Pada plot di atas, Anda tertarik pada rentang yang meminimalkan fungsi (terendah pada "kurva" yang diplot).

Jika Anda beralih ke model aditif umum, Anda dapat menggunakan gam()fungsi dari paket mgcv , di mana penulis meyakinkan kami :

Jadi, pilihan tepat k umumnya tidak kritis: harus dipilih untuk menjadi cukup besar sehingga Anda cukup yakin memiliki derajat kebebasan yang cukup untuk mewakili 'kebenaran' yang mendasarinya dengan cukup baik, tetapi cukup kecil untuk mempertahankan efisiensi komputasi yang masuk akal. Jelas 'besar' dan 'kecil' tergantung pada masalah tertentu yang sedang ditangani.

(di ksini adalah parameter derajat kebebasan untuk lebih halus, yang mirip dengan parameter kelancaran loess ')

Anda bisa menulis loop validasi silang Anda sendiri dari awal yang menggunakan loess()fungsi dari statspaket.

1. Siapkan kerangka data mainan.

   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. Siapkan variabel yang berguna untuk menangani loop validasi silang.

   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. Jalankan forperulangan bersarang di setiap kemungkinan rentang span.seq, dan setiap lipatan 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 hasil Anda.

   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)

Gunakan paket locfit. Versi loess yang sedikit dimodifikasi tetapi jauh lebih cepat. Ini juga memiliki fungsi bawaan untuk menghitung gcv http://www.statistik.lmu.de/~leiten/Lehre/Material/GLM_0708/Tutorium/locfit.pdf

The fANCOVA paket menyediakan cara otomatis untuk menghitung rentang ideal menggunakan GCV atau 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))