Estimación del punto de ruptura en un modelo lineal de barra rota / por partes con efectos aleatorios en R [código y salida incluidos]

¿Puede alguien decirme cómo hacer que R calcule el punto de ruptura en un modelo lineal por partes (como un parámetro fijo o aleatorio), cuando también necesito estimar otros efectos aleatorios?

He incluido un ejemplo de juguete a continuación que se ajusta a una regresión de palo de hockey / palo roto con variaciones de pendiente aleatorias y una variación de intersección y aleatoria para un punto de ruptura de 4. Quiero estimar el punto de ruptura en lugar de especificarlo. Podría ser un efecto aleatorio (preferible) o un efecto fijo.

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

Salida:

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

Otro enfoque sería envolver la llamada a lmer en una función que pasa el punto de interrupción como parámetro, luego minimizar la desviación del modelo ajustado condicional al punto de interrupción usando optimizar. Esto maximiza la probabilidad de registro del perfil para el punto de interrupción y, en general (es decir, no solo para este problema) si la función interior del envoltorio (lmer en este caso) encuentra estimaciones de probabilidad máxima condicionadas al parámetro que se le pasa, el conjunto El procedimiento encuentra las estimaciones conjuntas de máxima verosimilitud para todos los parámetros.

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)

Para obtener un intervalo de confianza para el punto de interrupción, puede usar la probabilidad de perfil . Agregue, por ejemplo, qchisq(0.95,1)a la desviación mínima (para un intervalo de confianza del 95%) y luego busque puntos donde foo(x)sea ​​igual al valor calculado:

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

Algo asimétrico, pero no es una mala precisión para este problema del juguete. Una alternativa sería arrancar el procedimiento de estimación, si tiene suficientes datos para hacer que el arranque sea confiable.

La solución propuesta por jbowman es muy buena, solo agrega algunas observaciones teóricas:

• Dada la discontinuidad de la función del indicador utilizada, la probabilidad de perfil puede ser muy errática, con múltiples mínimos locales, por lo que los optimizadores habituales podrían no funcionar. La solución habitual para tales "modelos de umbral" es utilizar, en cambio, la búsqueda de cuadrícula más engorrosa, evaluando la desviación en cada posible punto de ruptura / días de umbral realizados (y no en valores intermedios, como se hace en el código). Ver código en la parte inferior.

• Dentro de este modelo no estándar, donde se estima el punto de ruptura, la desviación generalmente no tiene la distribución estándar. Generalmente se usan procedimientos más complicados. Ver la referencia a Hansen (2000) a continuación.

• El bootstrap tampoco es siempre consistente a este respecto, ver Yu (de próxima publicación) a continuación.

• Finalmente, no me queda claro por qué está transformando los datos al volver a centrarse en los Días (es decir, bp - x en lugar de solo x). Veo dos problemas:

  1. Con este procedimiento, crea días artificiales como 6.1 días, 4.1, etc. No estoy seguro de cómo interpretar el resultado de 6.07, por ejemplo, ya que solo observó valores para el día 6 y el día 7. (en un modelo de punto de interrupción estándar, cualquier valor del umbral entre 6 y 7 debería proporcionarle el mismo coeficiente / desviación)
  2. b1 y b2 tienen el significado opuesto, ya que para b1 los días disminuyen, mientras que aumentan para b2? Entonces, la prueba informal de ningún punto de interrupción es b1! = - b2

Las referencias estándar para esto son:

• OLS estándar: Hansen (2000) Muestra de división y estimación de umbral, Econometrica, vol. 68, núm. 3. (mayo de 2000), págs. 575-603.
• Modelos más exóticos: Lee, Seo, Shin (2011) Pruebas de efectos de umbral en modelos de regresión, Journal of the American Statistical Association (Theory and Methods) (2011), 106, 220-231
• Ping Yu (de próxima aparición) La rutina de arranque en la regresión umbral ", teoría econométrica.

Código:

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

Puedes probar un modelo MARS . Sin embargo, no estoy seguro de cómo especificar efectos aleatorios. earth(Reaction~Days+Subject, sleepstudy)

Este es un documento que propone un MARS de efectos mixtos. Como @lockedoff mencionó, no veo ninguna implementación de la misma en ningún paquete.