Інтерпретація результатів сплайну

Я намагаюся встановити сплайн для GLM за допомогою R. Після того, як я підганяю сплайн, я хочу мати змогу взяти отриману модель і створити файл моделювання в робочій книжці Excel.

Наприклад, скажімо, у мене є набір даних, де y - випадкова функція x, а нахил різко змінюється в певній точці (в даному випадку @ 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)

Я зараз підхожу до цього, використовуючи

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

і мої результати показують

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

На цьому етапі я можу використовувати функцію передбачення в межах r і отримувати цілком прийнятні відповіді. Проблема полягає в тому, що я хочу використовувати результати моделей для створення робочої книги в Excel.

Моє розуміння функції передбачення полягає в тому, що, отримавши нове значення "x", r додає новий x у відповідну функцію сплайну (або функцію для значень вище 500, або функцію для значень нижче 500), тоді вона бере цей результат і множиться він за відповідним коефіцієнтом і з цього моменту трактує його як будь-який інший модельний термін. Як отримати ці функції сплайну?

(Примітка. Я розумію, що пов'язана з журналом гамма GLM може не відповідати наданому набору даних. Я не запитую про те, як і коли потрібно підходити до GLM. Я надаю цей набір як приклад для цілей відтворення.)

Ви можете змінити інженерні формули сплайну, не входячи в Rкод. Досить це знати

• Шпонка - це кускова поліноміальна функція.

• $d$$d+1$

• Коефіцієнти многочлена можна отримати за допомогою лінійної регресії.

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

$64$RR

Цей метод буде працювати з будь-яким статистичним програмним забезпеченням, навіть без документального власного програмного забезпечення, вихідний код якого недоступний.

Ось приклад, взятий із запитання, але модифікований, щоб мати вузли у трьох внутрішніх точках ($200, 500, 800$$(1, 1000)$RR

(Вертикальні сірі лінії сітки у Rверсії показують, де знаходяться внутрішні вузли.)

Ось повний Rкод. Це непрофілізований хак, повністю покладаючись на pasteфункцію здійснення струнних маніпуляцій. (Кращим способом було б створити шаблон формули та заповнити його, використовуючи команди узгодження рядків та команди підстановки.)

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

Перша формула виходу сплайну (з чотирьох вироблених тут)

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

Ви вже зробили наступне:

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

Тепер я покажу вам, як спрогнозувати (відповідь) для x = 12 двома різними способами: Спочатку за допомогою функції передбачення (простий спосіб!)

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

Другий спосіб заснований безпосередньо на матриці моделі. Примітка, яку я використовував, expоскільки функція зв'язку використовується журналом.

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

Зауважте, що я видобув 12-й елемент, оскільки це відповідає x = 12. Якщо ви хочете передбачити х за межами навчального набору, тоді просто можете знову використовувати функцію передбачення. Скажімо, ми хочемо знайти передбачуване значення відповіді для x = 1100 тоді

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

Можливо, вам буде легше використовувати усічену потужність для кубічних регресійних сплайнів, використовуючи rmsпакет R. Після того, як ви підходите до моделі, ви можете отримати алгебраїчне подання вбудованої функції сплайну за допомогою функцій Functionабо latexв rms.