Як вирішити, який проміжок часу використовувати в регресії LOESS у R?

Я використовую LOESS регресійні моделі в R, і я хочу порівняти виходи 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) матиме різні результати, оскільки існує такий широкий діапазон розмірів вибірки.

Моє основне питання - як визначити проміжок вашої моделі? Більший проміжок більше згладжує придатність, тоді як нижній проміжок фіксує більше тенденцій, але вносить статистичний шум, якщо даних недостатньо. Я використовую більш високий проміжок для менших розмірів зразка і нижній проміжок для більших розмірів вибірки.

Що я повинен зробити? Яке хороше правило при встановленні проміжку для моделей регресії LOESS в R? Спасибі заздалегідь!

Перехресна перевірка часто використовується, наприклад, k- кратна, якщо метою є знайти відповідність з найнижчою RMSEP. Розподіліть свої дані на k групи і, залишаючи кожну групу по черзі, прилаштуйте лес-модель, використовуючи k- групи даних і вибране значення параметра згладжування, і використовуйте цю модель для прогнозування для вибутої групи. Збережіть передбачувані значення для вилученої групи, а потім повторюйте, поки кожна з k груп не буде виключена один раз. Використовуючи набір прогнозованих значень, обчисліть RMSEP. Потім повторіть усе для кожного значення параметра згладжування, який ви хочете налаштувати. Виберіть той параметр згладжування, який дає найнижчий RMSEP під CV.

Це, як бачите, досить обчислювально важко. Я був би здивований, якби не було узагальненої перехресної валідації (GCV) альтернативи справжньому резюме, яке ви могли б використовувати з LOESS - Hastie та ін (розділ 6.2), це вказує, що це зробити досить просто і висвітлено в одній з їх вправ .

Пропоную прочитати розділи 6.1.1, 6.1.2 та 6.2, а також розділи про регуляризацію згладжувальних сплайнів (оскільки тут також застосовується вміст) у главі 5 Hastie et al. (2009) Елементи статистичного навчання: видобуток даних, умовиводи та прогнозування . 2-е видання. Спрингер. PDF можна завантажити безкоштовно.

Я пропоную перевірити узагальнені моделі добавок (GAM, див. Пакет mgcv в R). Я просто дізнаюся про них сам, але вони, здається, автоматично з'ясовують, наскільки виправданість цих даних виправдана. Я також бачу, що ви маєте справу з біноміальними даними (удар або не страйк), тому не забудьте проаналізувати необроблені дані (тобто не агрегувати пропорції, використовувати необроблені дані пошагового кроку) та використовувати family = 'двочлен' (якщо припустити, що ви будете використовувати R). Якщо у вас є інформація про те, які окремі глечики та нападники вносять дані, ви, ймовірно, можете збільшити свою потужність, зробивши узагальнену змішану модель добавок (GAMM, див. Пакет gamm4 в R) та вказавши глечик і нападник як випадкові ефекти (і знову , встановлення сім'ї = 'двочлен'). Нарешті, ви, мабуть, хочете дозволити взаємодію між гладдюками X&Y, але я сам ніколи цього не пробував, тому не знаю, як це зробити. Модель gamm4 без взаємодії X * Y виглядатиме так:

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 ). Ви можете спробувати:

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). Нижче наведено код, який я використовував для GCV регресії лесових масивів на основі коду з чудової книги Такезава, Вступ до непараметричної регресії (від 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)
}

і зі своїми даними я зробив наступне:

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, але він повинен дати вам уявлення про те, як зробити GSV для регресії лесового пошуку, щоб знайти найкращий проміжок для використання більш об'єктивним способом, ніж простий візуальний огляд. На вищенаведеному сюжеті вас цікавить проміжок, який мінімізує функцію (найнижчий на графічній "кривій").

Якщо ви переходите на загальну модель добавок, ви можете використовувати 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))