Как мне решить, какой диапазон использовать в регрессии 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- кратная, если цель состоит в том, чтобы найти соответствие с наименьшим среднеквадратичным отклонением. Разделите ваши данные на k групп и, поочередно оставляя каждую группу, подберите модель лесса, используя k -1 группы данных и выбранное значение параметра сглаживания, и используйте эту модель для прогнозирования для оставленной группы. Сохраните прогнозные значения для пропущенной группы и затем повторяйте, пока каждая из k групп не будет пропущена один раз. Используя набор предсказанных значений, вычислите RMSEP. Затем повторите все это для каждого значения параметра сглаживания, который вы хотите настроить. Выберите тот параметр сглаживания, который дает самое низкое среднеквадратическое значение в CV.

Это, как вы можете видеть, довольно сложно в вычислительном отношении. Я был бы удивлен, если бы не было альтернативы обобщенной перекрестной проверке (GCV) истинному CV, которую вы могли бы использовать с LOESS - Hastie и др. (Раздел 6.2) указывают, что это довольно просто сделать и рассматривается в одном из их упражнений ,

Я предлагаю вам прочитать раздел 6.1.1, 6.1.2 и 6.2, а также разделы по регуляризации сглаживающих сплайнов (так как содержание применимо и здесь) в главе 5 Hastie et al. (2009) Элементы статистического обучения: интеллектуальный анализ данных, логический вывод и прогноз . 2-е издание. Springer. PDF можно скачать бесплатно.

Я предлагаю проверить обобщенные аддитивные модели (GAM, см. Пакет mgcv в R). Я просто узнаю о них сам, но они, кажется, автоматически выясняют, насколько "волнистость" оправдана данными. Я также вижу, что вы имеете дело с биномиальными данными (страйк против страйка), поэтому обязательно проанализируйте необработанные данные (т.е. не агрегируйте в пропорции, используйте необработанные данные шаг за шагом) и используйте family = 'binomial' (при условии, что вы собираетесь использовать 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-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% КИ начальной загрузки для каждой точки в пространстве и любые эффекты, которые я хочу вычислить.

Для регрессии Лесса я понимаю, что я не статистик, что вы можете выбрать свой диапазон на основе визуальной интерпретации (график с многочисленными значениями диапазона может выбрать тот с наименьшим количеством сглаживания, который кажется подходящим), или вы можете использовать перекрестную проверку (CV) или обобщенная перекрестная проверка (GCV). Ниже приведен код, который я использовал для GCV регрессии Лесса на основе кода из превосходной книги Такезавы « Введение в непараметрическую регрессию» (из стр. 219).

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