私のデータの非線形回帰を行う方法

Question

各温度データの温度と不快指数の値を設定しました。温度（x軸）と計算された不快指数値（y軸）の間にグラフをプロットすると、逆U字型の曲線が得られます。私は非線形回帰を行い、それをPMMLモデルに変換したいと考えています。私の目標は、一定の温度を与えると予測される不快感の値を得ることです。

以下のデータセット見つけてください：

Temp <- c(0,5,10,6 ,9,13,15,16,20,21,24,26,29,30,32,34,36,38,40,43,44,45, 50,60) 

Disc<-c(0.00,0.10,0.25,0.15,0.24,0.26,0.30,0.31,0.40,0.41,0.49,0.50,0.56, 0.80,0.90,1.00,1.00,1.00,0.80,0.50,0.40,0.20,0.15,0.00) 

がどのようにこのデータセットのために（おそらく?? nls付き）非線形回帰を行うには？

Answer 1

私はこれを見てみました、そして、私はそれが私たちのほとんど最初の考えとしてnlsを使用するのと同じくらい簡単ではないと思います。

nlsは、パラメトリックモデルに適合しますが、データ（散布図）からは妥当なモデル仮定を提案することは困難です。私はノンパラメトリックスムージングを使ってこのことをお勧めします。

カーネルスムージングksmooth、スムージングスプラインsmooth.spline、LOESS loessなど、多くの散布図のスムージング方法があります。私はsmooth.splineを使用することを好む、そしてここで我々はそれで何ができるかです：

fit <- smooth.spline(Temp, Disc) 

何それが取るとそれが返すため?smooth.splineをお読みください。私たちは、

plot(Temp, Disc) 
lines(fit, col = 2) 

によりフィットスプライン曲線を確認し、あなたが他の場所の予測を作りたいなら、predict機能（predict.smooth.spline）を使用することができます。私たちはTemp = 20とTemp = 44を予測する場合たとえば、私たちはrange(Temp)外

predict(fit, c(20,44))$y 
# [1] 0.3940963 0.3752191 

予測を使用することができ、それは潜在的な悪い外挿効果に苦しんでいるとして、推奨されません。

---

私はノンパラメトリックな方法に頼る前に、私はまた、回帰スプラインと直交多項式基底と非線形回帰を試みたが、彼らは満足のいく結果を提供していません。主な理由は、滑らかさにペナルティがないということです。例として、私はいくつかは、polyてみてください示しています

try1 <- lm(Disc ~ poly(Temp, degree = 3)) 
try2 <- lm(Disc ~ poly(Temp, degree = 4)) 
try3 <- lm(Disc ~ poly(Temp, degree = 5)) 

plot(Temp, Disc, ylim = c(-0.3,1.0)) 
x<- seq(min(Temp), max(Temp), length = 50) 
newdat <- list(Temp = x) 
lines(x, predict(try1, newdat), col = 2) 
lines(x, predict(try2, newdat), col = 3) 
lines(x, predict(try3, newdat), col = 4) 

私たちは、近似曲線が人工的であることがわかります。

Answer 2

次のように私たちは、多項式をフィットすることができますが、我々がより高度持っているようにデータをオーバーフィットするだろう：

m <- nls(Disc ~ a + b*Temp + c*Temp^2 + d*Temp^3 + e*Temp^4, start=list(a=0, b=1, c=1, d=1, e=1)) 
plot(Temp,Disc,pch=19) 
lines(Temp,predict(m),lty=2,col="red",lwd=3) 

m <- nls(Disc ~ a + b*Temp + c*Temp^2 + d*Temp^3 + e*Temp^4 + f*Temp^5, start=list(a=0, b=1, c=1, d=1, e=1, f=1)) 
lines(Temp,predict(m),lty=2,col="blue",lwd=3) 
m <- nls(Disc ~ a + b*Temp + c*Temp^2 + d*Temp^3 + e*Temp^4 + f*Temp^5 + g*Temp^6, start=list(a=0, b=1, c=1, d=1, e=1, f=1, g=1)) 
lines(Temp,predict(m),lty=2,col="green",lwd=3) 

m.poly <- lm(Disc ~ poly(Temp, degree = 15)) 
lines(Temp,predict(m),lty=2,col="yellow",lwd=3) 

legend(x = "topleft", legend = c("Deg 4", "Deg 5", "Deg 6", "Deg 20"), 
     col = c("red", "green", "blue", "yellow"), 
     lty = 2)