Interpretation von Spline-Ergebnissen

Ich versuche, mithilfe von R einen Spline für eine GLM anzupassen. Sobald ich den Spline angepasst habe, möchte ich in der Lage sein, mein resultierendes Modell zu nehmen und eine Modellierungsdatei in einer Excel-Arbeitsmappe zu erstellen.

Angenommen, ich habe eine Datenmenge, in der y eine Zufallsfunktion von x ist und die Steigung sich an einem bestimmten Punkt abrupt ändert (in diesem Fall @ 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)

Ich passe das jetzt mit an

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

und meine Ergebnisse zeigen

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

Zu diesem Zeitpunkt kann ich die Vorhersagefunktion in r verwenden und absolut akzeptable Antworten erhalten. Das Problem ist, dass ich die Modellergebnisse verwenden möchte, um eine Arbeitsmappe in Excel zu erstellen.

Mein Verständnis der Vorhersagefunktion ist, dass r bei einem neuen "x" -Wert dieses neue x in die entsprechende Spline-Funktion (entweder die Funktion für Werte über 500 oder die für Werte unter 500) einfügt, dieses Ergebnis dann aufnimmt und multipliziert Es wird mit dem entsprechenden Koeffizienten behandelt und von diesem Punkt an wie jeder andere Modellbegriff. Wie bekomme ich diese Spline-Funktionen?

(Hinweis: Ich stelle fest, dass ein log-verknüpftes Gamma-GLM möglicherweise nicht für den bereitgestellten Datensatz geeignet ist. Ich frage nicht, wie oder wann GLMs angepasst werden sollen. Ich stelle diesen Satz als Beispiel für Reproduzierbarkeitszwecke bereit.)

Sie können die Spline-Formeln rückentwickeln, ohne in den RCode einsteigen zu müssen. Es genügt zu wissen, dass

• Ein Spline ist eine stückweise Polynomfunktion.

• Polynome vom Grad werden durch ihre Werte bei d + 1 Punkten bestimmt.$d$$d+1$

• Die Koeffizienten eines Polynoms können durch lineare Regression erhalten werden.

$d+1$$x$$x^d$$d=3$$4\times 4=16$$d+1=4$Koeffizienten. Da es sich um relativ hohe Potenzen von handelt, muss unbedingt die Genauigkeit der Koeffizienten eingehalten werden. Wie Sie sich vorstellen können, kann die vollständige Formel für jedes Spline-Basiselement ziemlich lang werden!$x$

$64$RR

Diese Methode funktioniert mit jeder statistischen Software, auch mit undokumentierter proprietärer Software, deren Quellcode nicht verfügbar ist.

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

(Die vertikalen grauen Gitterlinien in der RVersion zeigen, wo sich die inneren Knoten befinden.)

Hier ist der vollständige RCode. Es ist ein ungekünstelter Hack, der sich ausschließlich auf die pasteFunktion verlässt , um die String-Manipulation durchzuführen. (Besser wäre es, eine Formelvorlage zu erstellen und diese mit den Befehlen für String-Matching und -Substitution auszufüllen.)

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

Die erste Spline-Ausgabeformel (von den vier hier erzeugten) lautet

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

Sie haben bereits Folgendes getan:

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

Jetzt zeige ich Ihnen, wie Sie die Antwort für x = 12 auf zwei verschiedene Arten vorhersagen können: Verwenden Sie zuerst die Vorhersagefunktion (die einfache Methode!).

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

Der 2. Weg basiert direkt auf der Modellmatrix. Hinweis Ich habe verwendet, expda die verwendete Link-Funktion log ist.

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

Beachten Sie, dass ich oben das 12. Element extrahiert habe, da dies x = 12 entspricht. Wenn Sie für ein x außerhalb des Trainingssatzes vorhersagen möchten, können Sie einfach wieder die Vorhersagefunktion verwenden. Nehmen wir an, wir wollen dann den vorhergesagten Antwortwert für x = 1100 finden

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

Mit dem R- rmsPaket ist es möglicherweise einfacher, die abgeschnittene Leistungsbasis für kubische Regressionssplines zu verwenden . Sobald Sie das Modell angepasst haben, können Sie die algebraische Darstellung der angepassten Spline-Funktion mit den Funktionen Functionoder latexin abrufen rms.