Estimando o ponto de interrupção em um modelo linear quebrado / pedaço quebrado com efeitos aleatórios em R [código e saída incluídos]

Alguém pode me dizer como R estimar o ponto de interrupção em um modelo linear por partes (como um parâmetro fixo ou aleatório), quando eu também precisar estimar outros efeitos aleatórios?

Incluí um exemplo de brinquedo abaixo que se encaixa em uma regressão de taco de hóquei / taco quebrado com variações aleatórias de inclinação e uma variação aleatória de intercepto em y para um ponto de interrupção de 4. Quero estimar o ponto de interrupção em vez de especificá-lo. Pode ser um efeito aleatório (preferível) ou um efeito fixo.

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

Resultado:

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

Outra abordagem seria envolver a chamada ao immer em uma função que é passada no ponto de interrupção como parâmetro e, em seguida, minimizar o desvio do modelo ajustado, dependendo do ponto de interrupção, usando o recurso de otimização. Isso maximiza a probabilidade do log de perfil para o ponto de interrupção e, em geral (isto é, não apenas para esse problema), se a função interior do wrapper (neste caso, o lmer) encontrar estimativas máximas de probabilidade, dependendo do parâmetro passado a ele, O procedimento localiza as estimativas de probabilidade máxima conjunta para todos os 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 obter um intervalo de confiança para o ponto de interrupção, você pode usar a probabilidade do perfil . Adicione, por exemplo, qchisq(0.95,1)ao desvio mínimo (para um intervalo de confiança de 95%) e procure pontos ondefoo(x) é igual ao 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

Precisão um pouco assimétrica, mas não ruim para esse problema de brinquedo. Uma alternativa seria inicializar o procedimento de estimativa, se você tiver dados suficientes para torná-lo confiável.

A solução proposta por jbowman é muito boa, apenas adicionando algumas observações teóricas:

• Dada a descontinuidade da função do indicador usada, a probabilidade do perfil pode ser altamente irregular, com vários mínimos locais, portanto, os otimizadores comuns podem não funcionar. A solução usual para esses "modelos de limite" é usar a pesquisa de grade mais complicada, avaliando o desvio em cada possível ponto de interrupção / dias de limiar realizados (e não nos valores intermediários, conforme feito no código). Veja o código na parte inferior.

• Dentro deste modelo não padrão, onde o ponto de interrupção é estimado, o desvio geralmente não possui a distribuição padrão. Procedimentos mais complicados são geralmente usados. Veja a referência a Hansen (2000) abaixo.

• O bootstrap nem sempre é consistente nesse sentido, veja Yu (a seguir) abaixo.

• Por fim, não está claro para mim por que você está transformando os dados centrando-se novamente nos Dias (ou seja, bp - x em vez de apenas x). Eu vejo dois problemas:

  1. Com esse procedimento, você cria dias artificiais, como 6,1 dias, 4,1 etc. etc. Não sei como interpretar o resultado de 6,07, por exemplo, uma vez que você só observou valores para os dias 6 e 7? (em um modelo de ponto de interrupção padrão, qualquer valor do limite entre 6 e 7 deve fornecer o mesmo coef / desvio)
  2. b1 e b2 têm o significado oposto, pois para b1 os dias estão diminuindo, enquanto aumentam para b2? Portanto, o teste informal de nenhum ponto de interrupção é b1! = - b2

As referências padrão para isso são:

• OLS padrão: Hansen (2000) Splitting e Threshold Estimativa de Amostras, Econometrica, vol. 68, n ° 3. (maio de 2000), pp. 575-603.
• Modelos mais exóticos: Lee, Seo, Shin (2011) Teste para efeitos de limiar em modelos de regressão, Jornal da Associação Estatística Americana (Teoria e Métodos) (2011), 106, 220-231
• Ping Yu (a ser publicado) O Bootstrap na regressão de limite ", Teoria 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)]

Você pode tentar um modelo MARS . No entanto, não sei como especificar efeitos aleatórios. earth(Reaction~Days+Subject, sleepstudy)

Este é um artigo que propõe efeitos MARS mistos. Como o @lockedoff mencionou, não vejo nenhuma implementação do mesmo em nenhum pacote.