Interpretando resultados do spline

Estou tentando ajustar um spline para um GLM usando R. Depois de ajustar o spline, quero poder pegar meu modelo resultante e criar um arquivo de modelagem em uma pasta de trabalho do Excel.

Por exemplo, digamos que eu tenho um conjunto de dados em que y é uma função aleatória de xe a inclinação muda abruptamente em um ponto específico (neste caso @ x = 500).

set.seed(1066)
x<- 1:1000
y<- rep(0,1000)

y[1:500]<- pmax(x[1:500]+(runif(500)-.5)*67*500/pmax(x[1:500],100),0.01)
y[501:1000]<-500+x[501:1000]^1.05*(runif(500)-.5)/7.5

df<-as.data.frame(cbind(x,y))

plot(df)

Agora eu me encaixo nisso usando

library(splines)
spline1 <- glm(y~ns(x,knots=c(500)),data=df,family=Gamma(link="log"))

e meus resultados mostram

summary(spline1)

Call:
glm(formula = y ~ ns(x, knots = c(500)), family = Gamma(link = "log"), 
    data = df)

Deviance Residuals: 
     Min       1Q   Median       3Q      Max  
-4.0849  -0.1124  -0.0111   0.0988   1.1346  

Coefficients:
                       Estimate Std. Error t value Pr(>|t|)    
(Intercept)             4.17460    0.02994  139.43   <2e-16 ***
ns(x, knots = c(500))1  3.83042    0.06700   57.17   <2e-16 ***
ns(x, knots = c(500))2  0.71388    0.03644   19.59   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for Gamma family taken to be 0.1108924)

    Null deviance: 916.12  on 999  degrees of freedom
Residual deviance: 621.29  on 997  degrees of freedom
AIC: 13423

Number of Fisher Scoring iterations: 9

Neste ponto, eu posso usar a função de previsão dentro de r e obter respostas perfeitamente aceitáveis. O problema é que eu quero usar os resultados do modelo para criar uma pasta de trabalho no Excel.

Meu entendimento da função de previsão é que, dado um novo valor "x", r conecta esse novo x na função spline apropriada (seja a função para valores acima de 500 ou a para valores abaixo de 500), então pega esse resultado e multiplica pelo coeficiente apropriado e a partir desse ponto o trata como qualquer outro termo modelo. Como obtenho essas funções spline?

(Observação: percebo que um GLM gama vinculado a log pode não ser apropriado para o conjunto de dados fornecido. Não estou perguntando como ou quando ajustar os GLMs. Estou fornecendo esse conjunto como um exemplo para fins de reprodutibilidade.)

Você pode fazer engenharia reversa das fórmulas de spline sem precisar entrar no Rcódigo. Basta saber que

• Um spline é uma função polinomial composta por partes.

• $d$$d+1$

• Os coeficientes de um polinômio podem ser obtidos via regressão linear.

$d+1$$x$$x^d$$d=3$$4\times 4=16$$d+1=4$$x$

$64$RR

Este método funcionará com qualquer software estatístico, mesmo software proprietário não documentado, cujo código fonte não esteja disponível.

$200, 500, 800$$(1, 1000)$RR

(As linhas de grade cinzas verticais na Rversão mostram onde estão os nós internos.)

Aqui está o Rcódigo completo . É um hack não sofisticado, confiando inteiramente na pastefunção para realizar a manipulação de strings. (Uma maneira melhor seria criar um modelo de fórmula e preenchê-lo usando comandos de correspondência e substituição de string.)

#
# Create and display a spline basis.
#
x <- 1:1000
n <- ns(x, knots=c(200, 500, 800))

colors <- c("Orange", "Gray", "tomato2", "deepskyblue3")
plot(range(x), range(n), type="n", main="R Version",
     xlab="x", ylab="Spline value")
for (k in attr(n, "knots")) abline(v=k, col="Gray", lty=2)
for (j in 1:ncol(n)) {
  lines(x, n[,j], col=colors[j], lwd=2)
}
#
# Export this basis in Excel-readable format.
#
ns.formula <- function(n, ref="A1") {
  ref.p <- paste("I(", ref, sep="")
  knots <- sort(c(attr(n, "Boundary.knots"), attr(n, "knots")))
  d <- attr(n, "degree")
  f <- sapply(2:length(knots), function(i) {
    s.pre <- paste("IF(AND(", knots[i-1], "<=", ref, ", ", ref, "<", knots[i], "), ", 
                   sep="")
    x <- seq(knots[i-1], knots[i], length.out=d+1)
    y <- predict(n, x)
    apply(y, 2, function(z) {
      s.f <- paste("z ~ x+", paste("I(x", 2:d, sep="^", collapse=")+"), ")", sep="")
      f <- as.formula(s.f)
      b.hat <- coef(lm(f))
      s <- paste(c(b.hat[1], 
            sapply(1:d, function(j) paste(b.hat[j+1], "*", ref, "^", j, sep=""))), 
            collapse=" + ")
      paste(s.pre, s, ", 0)", sep="")
    })
  })
  apply(f, 1, function(s) paste(s, collapse=" + "))
}
ns.formula(n) # Each line of this output is one basis formula: paste into Excel

A primeira fórmula de saída de spline (das quatro produzidas aqui) é

"IF(AND(1<=A1, A1<200), -1.26037447288906e-08 + 3.78112341937071e-08*A1^1 + -3.78112341940948e-08*A1^2 + 1.26037447313669e-08*A1^3, 0) + IF(AND(200<=A1, A1<500), 0.278894459758071 + -0.00418337927419299*A1^1 + 2.08792741929417e-05*A1^2 + -2.22580643138594e-08*A1^3, 0) + IF(AND(500<=A1, A1<800), -5.28222778473101 + 0.0291833541927414*A1^1 + -4.58541927409268e-05*A1^2 + 2.22309136420529e-08*A1^3, 0) + IF(AND(800<=A1, A1<1000), 12.500000000002 + -0.0375000000000067*A1^1 + 3.75000000000076e-05*A1^2 + -1.25000000000028e-08*A1^3, 0)"

R$x$$x$

Você já fez o seguinte:

> rm(list=ls())
> set.seed(1066)
> x<- 1:1000
> y<- rep(0,1000)
> y[1:500]<- pmax(x[1:500]+(runif(500)-.5)*67*500/pmax(x[1:500],100),0.01)
> y[501:1000]<-500+x[501:1000]^1.05*(runif(500)-.5)/7.5
> df<-as.data.frame(cbind(x,y))
> library(splines)
> spline1 <- glm(y~ns(x,knots=c(500)),data=df,family=Gamma(link="log"))
> 

Agora vou mostrar como prever (a resposta) para x = 12 de duas maneiras diferentes: Primeiro, usando a função de previsão (a maneira mais fácil!)

> new.dat=data.frame(x=12)
> predict(spline1,new.dat,type="response")
       1 
68.78721 

A segunda maneira é baseada diretamente na matriz do modelo. Nota: usei, exppois a função de link usada é log.

> m=model.matrix( ~ ns(df$x,knots=c(500))) 
> prd=exp(coefficients(spline1) %*% t(m)) 
> prd[12]
[1] 68.78721

Observe que, acima, extraí o 12º elemento, pois corresponde a x = 12. Se você deseja prever um x fora do conjunto de treinamento, basta usar novamente a função de previsão. Digamos que queremos encontrar o valor de resposta previsto para x = 1100 e, em seguida,

> predict(spline1, newdata=data.frame(x=1100),type="response")
       1 
366.3483 

Você pode achar mais fácil usar a base de potência truncada para splines de regressão cúbica, usando o rmspacote R. Depois de ajustar o modelo que você pode recuperar a representação algébrica da função spline equipada usando o Functionou latexfunções rms.