Stima del punto di rottura in un modello lineare spezzato / a tratti con effetti casuali in R [codice e output inclusi]


14

Qualcuno può dirmi come fare in modo che R valuti il ​​punto di interruzione in un modello lineare a tratti (come parametro fisso o casuale), quando devo anche stimare altri effetti casuali?

Di seguito ho incluso un esempio di giocattolo che si adatta a una regressione di un bastone da hockey / bastone rotto con varianze casuali di pendenza e una varianza casuale di intercettazione y per un punto di interruzione di 4. Voglio stimare il punto di interruzione invece di specificarlo. Potrebbe essere un effetto casuale (preferibile) o un effetto fisso.

library(lme4)
str(sleepstudy)

#Basis functions
bp = 4
b1 <- function(x, bp) ifelse(x < bp, bp - x, 0)
b2 <- function(x, bp) ifelse(x < bp, 0, x - bp)

#Mixed effects model with break point = 4
(mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy))

#Plot with break point = 4
xyplot(
        Reaction ~ Days | Subject, sleepstudy, aspect = "xy",
        layout = c(6,3), type = c("g", "p", "r"),
        xlab = "Days of sleep deprivation",
        ylab = "Average reaction time (ms)",
        panel = function(x,y) {
        panel.points(x,y)
        panel.lmline(x,y)
        pred <- predict(lm(y ~ b1(x, bp) + b2(x, bp)), newdata = data.frame(x = 0:9))
            panel.lines(0:9, pred, lwd=1, lty=2, col="red")
        }
    )

Produzione:

Linear mixed model fit by REML 
Formula: Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject) 
   Data: sleepstudy 
  AIC  BIC logLik deviance REMLdev
 1751 1783 -865.6     1744    1731
Random effects:
 Groups   Name         Variance Std.Dev. Corr          
 Subject  (Intercept)  1709.489 41.3460                
          b1(Days, bp)   90.238  9.4994  -0.797        
          b2(Days, bp)   59.348  7.7038   0.118 -0.008 
 Residual               563.030 23.7283                
Number of obs: 180, groups: Subject, 18

Fixed effects:
             Estimate Std. Error t value
(Intercept)   289.725     10.350  27.994
b1(Days, bp)   -8.781      2.721  -3.227
b2(Days, bp)   11.710      2.184   5.362

Correlation of Fixed Effects:
            (Intr) b1(D,b
b1(Days,bp) -0.761       
b2(Days,bp) -0.054  0.181

Regressione del bastone rotto adatta a ciascun individuo


1
Qualche modo per rendere bp un effetto casuale?
djhocking del

Risposte:


20

Un altro approccio sarebbe avvolgere la chiamata a lmer in una funzione che passa il punto di interruzione come parametro, quindi ridurre al minimo la deviazione del modello adattato in base al punto di interruzione usando il comando di ottimizzazione. Ciò massimizza la probabilità del log del profilo per il punto di interruzione e, in generale (vale a dire, non solo per questo problema) se la funzione interna al wrapper (in questo caso lmer) trova le stime di massima verosimiglianza subordinate al parametro passato ad esso, l'intero la procedura trova le stime congiunte di massima verosimiglianza per tutti i parametri.

library(lme4)
str(sleepstudy)

#Basis functions
bp = 4
b1 <- function(x, bp) ifelse(x < bp, bp - x, 0)
b2 <- function(x, bp) ifelse(x < bp, 0, x - bp)

#Wrapper for Mixed effects model with variable break point
foo <- function(bp)
{
  mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy)
  deviance(mod)
}

search.range <- c(min(sleepstudy$Days)+0.5,max(sleepstudy$Days)-0.5)
foo.opt <- optimize(foo, interval = search.range)
bp <- foo.opt$minimum
bp
[1] 6.071932
mod <- lmer(Reaction ~ b1(Days, bp) + b2(Days, bp) + (b1(Days, bp) + b2(Days, bp) | Subject), data = sleepstudy)

Per ottenere un intervallo di confidenza per il punto di interruzione, è possibile utilizzare la probabilità del profilo . Aggiungi, ad esempio, qchisq(0.95,1)alla devianza minima (per un intervallo di confidenza del 95%), quindi cerca i punti in cui foo(x)è uguale al valore calcolato:

foo.root <- function(bp, tgt)
{
  foo(bp) - tgt
}
tgt <- foo.opt$objective + qchisq(0.95,1)
lb95 <- uniroot(foo.root, lower=search.range[1], upper=bp, tgt=tgt)
ub95 <- uniroot(foo.root, lower=bp, upper=search.range[2], tgt=tgt)
lb95$root
[1] 5.754051
ub95$root
[1] 6.923529

Precisione un po 'asimmetrica, ma non negativa per questo problema del giocattolo. Un'alternativa sarebbe quella di avviare la procedura di stima, se si dispone di dati sufficienti per rendere affidabile l'avvio.


Grazie - è stato molto utile. Questa tecnica è chiamata procedura di stima in due fasi o ha un nome standard a cui potrei fare riferimento / cercare?
chiuso il

È la massima probabilità, o lo sarebbe se lmer massimizzasse la probabilità (penso che il valore predefinito sia in realtà REML, è necessario passare un parametro REML = FALSE a lmer per ottenere stime ML). appena stimato in modo annidato piuttosto che tutto in una volta. Ho aggiunto alcuni chiarimenti all'inizio della risposta.
jbowman,

Ho avuto alcuni problemi di ottimizzazione e ampi elementi della configurazione quando ho invertito la probabilità del profilo con i miei dati reali, ma ho ottenuto elementi di avvio più stretti nella mia implementazione. Stavi immaginando un bootstrap non parametrico con campionamento con sostituzione sui vettori di dati dei soggetti? Vale a dire, per i dati relativi al sonno, ciò comporterebbe il campionamento con la sostituzione dai 18 vettori (soggetto) di 10 punti dati, senza fare alcun ricampionamento nel vettore di dati di un soggetto.
chiuso il

Sì, stavo immaginando un bootstrap non parametrico come descrivi, ma in parte è perché non so molto sulle tecniche di bootstrap avanzate che potrebbero (o non essere) applicabili. Gli elementi della configurazione e la bootstrap basati sulla verosimiglianza del profilo sono entrambi asintoticamente precisi, ma è possibile che bootstrap sia significativamente migliore per il tuo campione.
jbowman,

5

La soluzione proposta da jbowman è molto buona, aggiungendo solo alcune osservazioni teoriche:

  • Data la discontinuità della funzione indicatore utilizzata, la probabilità del profilo potrebbe essere molto irregolare, con minimi locali multipli, quindi i normali ottimizzatori potrebbero non funzionare. La solita soluzione per tali "modelli di soglia" è utilizzare invece la più ingombrante ricerca della griglia, valutando la deviazione in corrispondenza di ogni possibile giorno di breakpoint / soglia realizzato (e non a valori intermedi, come nel codice). Vedi il codice in fondo.

  • All'interno di questo modello non standard, in cui viene stimato il breakpoint, la devianza di solito non ha la distribuzione standard. Solitamente vengono utilizzate procedure più complicate. Vedi il riferimento a Hansen (2000) di seguito.

  • Il bootstrap non è sempre coerente in questo senso, vedi Yu (di prossima pubblicazione) di seguito.

  • Infine, non mi è chiaro il motivo per cui stai trasformando i dati ricentrando i giorni (ovvero, bp - x anziché solo x). Vedo due problemi:

    1. Con questa procedura, crei giorni artificiali come 6,1 giorni, 4,1 ecc. Non sono sicuro di come interpretare il risultato di 6.07, ad esempio, poiché hai osservato solo valori per il giorno 6 e il giorno 7? (in un modello di breakpoint standard, qualsiasi valore della soglia tra 6 e 7 dovrebbe fornire lo stesso coefficiente / devianza)
    2. b1 e b2 hanno il significato opposto, poiché per b1 giorni stanno diminuendo, mentre aumentano per b2? Quindi il test informale di nessun punto di interruzione è b1! = - b2

Riferimenti standard per questo sono:

  • Standard OLS: Hansen (2000) Campione di divisione e stima della soglia, Econometrica, Vol. 68, n. 3. (maggio 2000), pagg. 575-603.
  • Modelli più esotici: Lee, Seo, Shin (2011) Test per gli effetti soglia nei modelli di regressione, Journal of American Statistical Association (Theory and Methods) (2011), 106, 220-231
  • Ping Yu (di prossima pubblicazione) The Bootstrap in Threshold Regression ", Teoria econometrica.

Codice:

# Using grid search over existing values:
search.grid <- sort(unique(subset(sleepstudy, Days > search.range[1] &
Days<search.range[2], "Days", drop=TRUE)))

res <- unlist(lapply(as.list(search.grid), foo))

plot(search.grid, res, type="l")
bp_grid <- search.grid[which.min(res)]

0

Potresti provare un modello MARS . Tuttavia, non sono sicuro di come specificare effetti casuali. earth(Reaction~Days+Subject, sleepstudy)


1
Grazie: ho sfogliato la documentazione del pacchetto ma non sembra supportare effetti casuali.
chiuso il

0

Questo è un articolo che propone un MARS a effetti misti. Come menzionato @lockedoff, non vedo alcuna implementazione dello stesso in nessun pacchetto.

Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.