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

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

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.

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

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

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