Interprétation des résultats de spline

J'essaie d'adapter une spline pour un GLM à l'aide de R. Une fois que j'ai ajusté la spline, je veux pouvoir prendre mon modèle résultant et créer un fichier de modélisation dans un classeur Excel.

Par exemple, supposons que j'ai un ensemble de données où y est une fonction aléatoire de x et la pente change brusquement à un point spécifique (dans ce cas @ 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)

J'adapte maintenant ceci en utilisant

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

et mes résultats montrent

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

À ce stade, je peux utiliser la fonction de prédiction dans r et obtenir des réponses parfaitement acceptables. Le problème est que je veux utiliser les résultats du modèle pour créer un classeur dans Excel.

Ma compréhension de la fonction prédire est que, étant donné une nouvelle valeur "x", r branche ce nouveau x dans la fonction spline appropriée (soit la fonction pour les valeurs supérieures à 500 ou celle pour les valeurs inférieures à 500), alors il prend ce résultat et multiplie il par le coefficient approprié et à partir de ce point le traite comme tout autre terme de modèle. Comment obtenir ces fonctions splines?

(Remarque: je me rends compte qu'un GLM gamma lié au journal peut ne pas être approprié pour l'ensemble de données fourni. Je ne demande pas comment ni quand adapter les GLM. Je fournis cet ensemble comme exemple à des fins de reproductibilité.)

Vous pouvez effectuer une rétro-ingénierie des formules splines sans avoir à entrer dans le Rcode. Il suffit de savoir que

• Une spline est une fonction polynomiale par morceaux.

• $d$$d+1$

• Les coefficients d'un polynôme peuvent être obtenus par régression linéaire.

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

$64$RR

Cette méthode fonctionnera avec tous les logiciels statistiques, même les logiciels propriétaires non documentés dont le code source n'est pas disponible.

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

(Les quadrillages gris verticaux dans la Rversion indiquent où se trouvent les nœuds internes.)

Voici le Rcode complet . C'est un hack non sophistiqué, reposant entièrement sur la pastefonction pour effectuer la manipulation de chaîne. (Une meilleure façon serait de créer un modèle de formule et de le remplir à l'aide de commandes de correspondance et de substitution de chaînes.)

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

La première formule de sortie spline (sur les quatre produites ici) est

"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$

Vous avez déjà fait ce qui suit:

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

Maintenant, je vais vous montrer comment prédire (la réponse) pour x = 12 de deux manières différentes: D'abord en utilisant la fonction de prédiction (le plus simple!)

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

La 2ème voie est basée directement sur la matrice du modèle. Remarque J'ai utilisé expcar la fonction de liaison utilisée est log.

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

Notez que ci-dessus j'ai extrait le 12ème élément, car cela correspond à x = 12. Si vous souhaitez prédire un x en dehors de l'ensemble d'entraînement, vous pouvez simplement utiliser à nouveau la fonction de prédiction. Disons que nous voulons trouver la valeur de réponse prédite pour x = 1100 puis

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

Vous pouvez trouver plus facile d'utiliser la base de puissance tronquée pour les splines de régression cubique, en utilisant le rmspackage R. Une fois le modèle ajusté, vous pouvez récupérer la représentation algébrique de la fonction spline ajustée à l'aide des fonctions Functionou .latexrms