Come faccio a decidere quale intervallo utilizzare nella regressione LOESS in R?

Sto eseguendo modelli di regressione LOESS in R e desidero confrontare le uscite di 12 modelli diversi con dimensioni del campione variabili. Posso descrivere i modelli attuali in modo più dettagliato se aiuta a rispondere alla domanda.

Ecco le dimensioni del campione:

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

Il modello di regressione LOESS è un adattamento superficiale, in cui la posizione X e la posizione Y di ciascun campo da baseball viene utilizzata per prevedere la probabilità di colpo oscillante, oscillante. Tuttavia, vorrei fare un confronto tra tutti e 12 questi modelli, ma l'impostazione dello stesso intervallo (ovvero intervallo = 0,5) produrrà risultati diversi poiché esiste una gamma così ampia di dimensioni del campione.

La mia domanda di base è come determinare la durata del modello? Uno span più elevato uniforma di più l'adattamento, mentre uno span inferiore cattura più trend ma introduce rumore statistico se i dati sono troppo pochi. Uso un intervallo maggiore per campioni di dimensioni inferiori e un intervallo inferiore per campioni di dimensioni maggiori.

Cosa dovrei fare? Qual è una buona regola empirica quando si imposta l'intervallo per i modelli di regressione LOESS in R? Grazie in anticipo!

Spesso viene utilizzata una convalida incrociata, ad esempio k -fold, se l'obiettivo è trovare un accoppiamento con RMSEP più basso. Dividi i tuoi dati in k gruppi e, escludendo ogni gruppo a turno, adatta un modello loess usando i gruppi k -1 di dati e un valore scelto del parametro smoothing, e usa quel modello per prevedere il gruppo lasciato fuori. Memorizzare i valori previsti per il gruppo lasciato fuori e quindi ripetere fino a quando ciascuno dei gruppi k è stato lasciato fuori una volta. Utilizzando l'insieme dei valori previsti, calcolare RMSEP. Quindi ripeti tutto per ogni valore del parametro smoothing su cui desideri sintonizzarti. Seleziona quel parametro di smoothing che dà il RMSEP più basso sotto CV.

Questo, come puoi vedere, è abbastanza pesante dal punto di vista computazionale. Sarei sorpreso se non ci fosse un'alternativa generalizzata di convalida incrociata (GCV) al vero CV che potresti usare con LOESS - Hastie et al (sezione 6.2) indicano che questo è abbastanza semplice da fare ed è trattato in uno dei loro esercizi .

Ti suggerisco di leggere le sezioni 6.1.1, 6.1.2 e 6.2, oltre alle sezioni sulla regolarizzazione delle spline leviganti (poiché il contenuto si applica anche qui) nel capitolo 5 di Hastie et al. (2009) The Elements of Statistical Learning: Data mining, inferenza e previsione . 2a edizione. Springer. Il PDF può essere scaricato gratuitamente.

Suggerisco di verificare i modelli di additivi generalizzati (GAM, vedere il pacchetto mgcv in R). Sto solo imparando su di loro, ma sembrano capire automaticamente quanta "trasandatezza" sia giustificata dai dati. Vedo anche che hai a che fare con dati binomiali (strike vs non strike), quindi assicurati di analizzare i dati grezzi (cioè non aggregare in proporzioni, utilizzare i dati grezzi passo per passo) e usare family = 'binomial' (supponendo che stai per usare R). Se hai informazioni su quali singoli lanciatori e battitori stanno contribuendo ai dati, puoi probabilmente aumentare la tua potenza facendo un modello misto additivo generalizzato (GAMM, vedi il pacchetto gamm4 in R) e specificando brocca e battitore come effetti casuali (e ancora , setting family = 'binomial'). Finalmente, probabilmente vorrai consentire un'interazione tra i smooth di X & Y, ma non l'ho mai provato da solo, quindi non so come farlo. Un modello gamm4 senza l'interazione X * Y sarebbe simile 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)

Vieni a pensarci bene, probabilmente vorrai lasciare che i smooths cambino all'interno di ogni livello di tipo di pitch e di pastella. Questo rende il problema più difficile poiché non ho ancora scoperto come lasciare che i smooths possano variare di più variabili in un modo che successivamente produce test analitici significativi ( vedi le mie domande all'elenco R-SIG-Mixed-Models ). Puoi provare:

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)

Ma questo non fornirà test significativi degli smooth. Nel tentativo di risolvere questo problema da solo, ho usato il ricampionamento bootstrap dove ad ogni iterazione ottengo le previsioni del modello per l'intero spazio dati, quindi calcolo i CI del 95% di boottap per ogni punto nello spazio e tutti gli effetti che mi interessa calcolare.

Per una regressione di loess, la mia comprensione come non statistico è che puoi scegliere il tuo span in base all'interpretazione visiva (un diagramma con numerosi valori di span può scegliere quello con il minor ammontare di smoothing che sembra appropriato) oppure puoi usare la validazione incrociata (CV) o validazione incrociata generalizzata (GCV). Di seguito è riportato il codice che ho usato per GCV di una regressione di loess basata sul codice dell'eccellente libro di Takezawa, Introduzione alla regressione non parametrica (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 con i miei dati ho fatto quanto segue:

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)

Mi dispiace che il codice sia piuttosto sciatto, questa è stata una delle mie prime volte usando R, ma dovrebbe darti un'idea di come fare GSV per la regressione del loess per trovare l'intervallo migliore da usare in un modo più oggettivo della semplice ispezione visiva. Sul grafico sopra, sei interessato allo span che minimizza la funzione (il più basso sulla "curva" tracciata).

Se si passa a un modello di additivo generato, è possibile utilizzare la gam()funzione dal pacchetto mgcv , in cui l'autore ci assicura :

Quindi, la scelta esatta di k non è generalmente critica: dovrebbe essere scelta per essere abbastanza grande da essere ragionevolmente sicuro di avere abbastanza gradi di libertà per rappresentare ragionevolmente bene la "verità" sottostante, ma abbastanza piccola da mantenere una ragionevole efficienza computazionale. Chiaramente "grande" e "piccolo" dipendono dal particolare problema affrontato.

( kqui è il parametro gradi di libertà per il più liscio, che è simile al parametro smoothness di loess)

È possibile scrivere da zero il proprio ciclo di convalida incrociata che utilizza la loess()funzione dal statspacchetto.

1. Imposta una cornice dati giocattolo.

   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. Imposta variabili utili per gestire il ciclo di convalida incrociata.

   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. Esegui un forciclo nidificato ripetendo ogni possibilità di span in span.seqe ogni fold in 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. Traccia i tuoi risultati.

   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)

Usa il pacchetto locfit. È una versione leggermente modificata del loess ma molto più veloce. Ha anche una funzione integrata per calcolare gcv http://www.statistik.lmu.de/~leiten/Lehre/Material/GLM_0708/Tutorium/locfit.pdf

Il pacchetto fANCOVA fornisce un modo automatizzato per calcolare l'intervallo ideale usando gcv o 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))