Interpretazione dei risultati della spline

Sto cercando di adattare una spline per un GLM usando R. Una volta adattato alla spline, voglio essere in grado di prendere il mio modello risultante e creare un file di modellazione in una cartella di lavoro di Excel.

Ad esempio, supponiamo di avere un set di dati in cui y è una funzione casuale di x e la pendenza cambia bruscamente in un punto specifico (in questo 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)

Ora mi adatto a questo usando

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

e i miei risultati mostrano

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

A questo punto, posso usare la funzione di previsione all'interno di r e ottenere risposte perfettamente accettabili. Il problema è che voglio usare i risultati del modello per creare una cartella di lavoro in Excel.

La mia comprensione della funzione di previsione è che, dato un nuovo valore "x", r inserisce quella nuova x nella funzione spline appropriata (o la funzione per valori superiori a 500 o quella per valori inferiori a 500), quindi prende quel risultato e si moltiplica per il coefficiente appropriato e da quel momento lo tratta come qualsiasi altro termine modello. Come posso ottenere queste funzioni spline?

(Nota: mi rendo conto che un GLM gamma collegato al log potrebbe non essere appropriato per il set di dati fornito. Non sto chiedendo come o quando adattarsi ai GLM. Sto fornendo tale set come esempio a fini di riproducibilità.)

È possibile decodificare le formule della spline senza dover inserire il Rcodice. Basta saperlo

• Una spline è una funzione polinomiale a tratti.

• I polinomi di grado sono determinati dai loro valori in punti.d + $d$$d+1$

• I coefficienti di un polinomio possono essere ottenuti tramite regressione lineare.

Pertanto, devi solo creare punti distanziati tra ciascuna coppia di nodi successivi (inclusi gli endpoint impliciti dell'intervallo di dati), prevedere i valori di spline e regredire la previsione rispetto alle potenze di$d+1$$x$$x^d$$d=3$$4\times 4=16$$d+1=4$$x$

$64$RR

Questo metodo funziona con qualsiasi software statistico, anche con software proprietario non documentato il cui codice sorgente non è disponibile.

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

(Le griglie verticali grigie nella Rversione mostrano dove si trovano i nodi interni.)

Ecco il Rcodice completo . È un trucco non sofisticato, che si basa interamente sulla pastefunzione per eseguire la manipolazione delle stringhe. (Un modo migliore sarebbe quello di creare un modello di formula e compilarlo utilizzando i comandi di sostituzione e sostituzione delle stringhe.)

#
# 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 prima formula di output spline (tra le quattro prodotte qui) è

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

Hai già fatto quanto segue:

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

Ora ti mostrerò come prevedere (la risposta) per x = 12 in due modi diversi: prima usando la funzione di previsione (il modo più semplice!)

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

Il secondo modo si basa direttamente sulla matrice del modello. Nota che ho usato exppoiché la funzione di collegamento utilizzata è log.

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

Si noti che in precedenza ho estratto il 12 ° elemento, poiché corrisponde a x = 12. Se si desidera prevedere una x al di fuori del set di allenamento, è possibile semplicemente utilizzare nuovamente la funzione di previsione. Diciamo che vogliamo trovare il valore di risposta previsto per x = 1100 allora

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

Potrebbe essere più semplice utilizzare la base di potenza troncata per le spline di regressione cubica, utilizzando il rmspacchetto R. Una volta adattato al modello, è possibile recuperare la rappresentazione algebrica della funzione spline adattata utilizzando le funzioni Functiono latexin rms.