스플라인 결과 해석

R을 사용하여 GLM에 대한 스플라인을 맞추려고합니다. 스플라인에 맞으면 결과 모델을 가져 와서 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위에서 설명한대로 Excel과 유사한 수식으로 다시 포맷 한 다음 복사하여 Excel에 붙여 넣기 만하면됩니다.

이 방법은 소스 코드를 사용할 수없는 문서화되지 않은 독점 소프트웨어를 포함한 모든 통계 소프트웨어에서 작동합니다.

$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

첫 번째 스플라인 출력 공식 (여기서 생성 된 4 개 중)은

"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를 예측하려면 간단히 예측 기능을 다시 사용할 수 있습니다. x = 1100에 대해 예측 된 반응 값을 찾고 싶다고하자

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

R rms패키지를 사용하여 3 차 회귀 스플라인에 대해 잘린 전력 기준을 사용하는 것이 더 쉽다는 것을 알 수 있습니다 . 모델을 맞추면의 Function또는 latex함수를 사용하여 피팅 된 스플라인 함수의 대수적 표현을 검색 할 수 있습니다 .rms .