Como decido qual intervalo usar na regressão LOESS em R?

Estou executando modelos de regressão LOESS em R e quero comparar as saídas de 12 modelos diferentes com tamanhos de amostra variados. Posso descrever os modelos reais em mais detalhes, se ajudar a responder à pergunta.

Aqui estão os tamanhos das amostras:

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

O modelo de regressão LOESS é um ajuste de superfície, onde a localização X e a localização Y de cada campo de beisebol são usadas para prever a probabilidade de golpe sw, swing. No entanto, eu gostaria de comparar entre todos os 12 desses modelos, mas definir o mesmo intervalo (ou seja, intervalo = 0,5) produzirá resultados diferentes, pois existe uma variedade tão grande de tamanhos de amostra.

Minha pergunta básica é como você determina a extensão do seu modelo? Uma amplitude maior suaviza mais o ajuste, enquanto uma amplitude menor captura mais tendências, mas introduz ruído estatístico se houver poucos dados. Eu uso um intervalo maior para amostras menores e um intervalo menor para amostras maiores.

O que devo fazer? O que é uma boa regra geral ao definir o alcance dos modelos de regressão LOESS no R? Desde já, obrigado!

Uma validação cruzada é frequentemente usada, por exemplo, k- fold, se o objetivo é encontrar um ajuste com o menor RMSEP. Divida seus dados em k grupos e, deixando cada grupo de fora por sua vez, ajuste um modelo loess usando os grupos k -1 de dados e um valor escolhido do parâmetro de suavização e use esse modelo para prever o grupo deixado de fora. Armazene os valores previstos para o grupo deixado de fora e repita até que cada um dos k grupos tenha sido deixado de fora uma vez. Usando o conjunto de valores previstos, calcule o RMSEP. Em seguida, repita a coisa toda para cada valor do parâmetro de suavização que você deseja ajustar. Selecione o parâmetro de suavização que fornece o menor RMSEP em CV.

Isto é, como você pode ver, bastante computacionalmente pesado. Eu ficaria surpreso se não houvesse uma alternativa de validação cruzada generalizada (GCV) ao CV verdadeiro que você pudesse usar com LOESS - Hastie et al (seção 6.2) indicam que isso é bastante simples de fazer e é abordado em um de seus exercícios .

Sugiro que você leia as seções 6.1.1, 6.1.2 e 6.2, além das seções sobre regularização de splines de suavização (como o conteúdo também se aplica aqui) no capítulo 5 de Hastie et al. (2009) Os elementos do aprendizado estatístico: mineração, inferência e previsão de dados . 2ª Edição. Springer. O PDF pode ser baixado gratuitamente.

Sugiro verificar modelos aditivos generalizados (GAM, consulte o pacote mgcv em R). Eu mesmo estou aprendendo sobre eles, mas eles parecem descobrir automaticamente o quanto "perversidade" é justificado pelos dados. Também vejo que você está lidando com dados binomiais (aviso versus aviso), portanto, analise os dados brutos (ou seja, não agregue proporções, use os dados brutos passo a passo) e use family = 'binomial' (assumindo que você usará R). Se você tiver informações sobre quais arremessadores e rebatedores individuais estão contribuindo para os dados, provavelmente poderá aumentar seu poder fazendo um modelo misto aditivo generalizado (GAMM, consulte o pacote gamm4 em R) e especificando arremessador e rebatedor como efeitos aleatórios (e novamente , definindo família = 'binomial'). Finalmente, você provavelmente deseja permitir uma interação entre os efeitos de X e Y, mas nunca tentei isso sozinho, então não sei como fazer isso. Um modelo gamm4 sem a interação X * Y seria semelhante a:

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

Venha para pensar sobre isso, você provavelmente deseja permitir que as suavidades variem dentro de cada nível do tipo de afinação e capacidade da massa. Isso torna o problema mais difícil, pois ainda não descobri como permitir que os suavizados variem por várias variáveis ​​de uma maneira que posteriormente produz testes analíticos significativos ( consulte minhas consultas na lista de modelos mistos R-SIG ). Você poderia tentar:

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)

Mas isso não dará testes significativos dos suaves. Ao tentar resolver esse problema, usei a reamostragem de autoinicialização em que, em cada iteração, obtenho as previsões do modelo para todo o espaço de dados e, em seguida, calculo os ICs de inicialização de 95% para cada ponto do espaço e quaisquer efeitos que pretendo calcular.

Para uma regressão loess, no meu entendimento como não estatístico, é que você pode escolher seu período com base na interpretação visual (o gráfico com numerosos valores de período pode escolher aquele com a menor quantidade de suavização que parecer apropriada) ou você pode usar a validação cruzada (CV) ou validação cruzada generalizada (GCV). Abaixo está o código que eu usei para o GCV de uma regressão loess com base no código do excelente livro de Takezawa, Introdução à regressão não paramétrica (da 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)
}

e com meus dados, fiz o seguinte:

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)

Desculpe, o código é um tanto desleixado, essa foi uma das minhas primeiras vezes usando R, mas deve lhe dar uma idéia de como fazer GSV para regressão de loess para encontrar o melhor espaço para usar de uma maneira mais objetiva do que a simples inspeção visual. No gráfico acima, você está interessado no intervalo que minimiza a função (mais baixo na "curva" plotada).

Se você mudar para um modelo de aditivo generlizado, poderá usar a gam()função do pacote mgcv , no qual o autor nos garante :

Portanto, a escolha exata de k geralmente não é crítica: ela deve ser escolhida para ser grande o suficiente para que você tenha razoavelmente certeza de ter graus de liberdade suficientes para representar razoavelmente bem a "verdade" subjacente, mas pequena o suficiente para manter uma eficiência computacional razoável. Claramente 'grande' e 'pequeno' dependem do problema específico que está sendo tratado.

( kaqui está o parâmetro dos graus de liberdade para o mais suave, semelhante ao parâmetro de suavidade do loess)

Você pode escrever seu próprio loop de validação cruzada do zero que usa a loess()função do statspacote.

1. Configure um quadro de dados de brinquedo.

   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. Configure variáveis ​​úteis para lidar com o loop de validação cruzada.

   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. Execute um forloop aninhado iterando sobre cada possibilidade de extensão em span.seqe cada dobra 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. Plote seus resultados.

   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)

Use o pacote locfit. É uma versão ligeiramente modificada do loess, mas muito mais rápida. Ele também possui uma função integrada para calcular o gcv http://www.statistik.lmu.de/~leiten/Lehre/Material/GLM_0708/Tutorium/locfit.pdf

O pacote fANCOVA fornece uma maneira automatizada de calcular o intervalo ideal usando gcv ou 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))