スプライン結果の解釈

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

この方法は、ソースコードが利用できない文書化されていない独自のソフトウェアでさえ、統計ソフトウェアで機能します。

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

次に、2つの異なる方法でx = 12の（応答）を予測する方法を示します。まず、予測関数を使用する（簡単な方法！）

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

2番目の方法は、モデルマトリックスに直接基づいています。注使用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パッケージを使用すると、キュービック回帰スプラインの切り捨てられた累乗基底を使用する方が簡単な場合があります。モデルを近似したら、Functionまたはのlatex関数を使用して、近似スプライン関数の代数表現を取得できますrms。