3

5つの（x、y）データポイントがあり、ポイント（x0、y0）で交差し、次の方程式に従う2本の線で構成される最適なソリューションを見つけようとしています。

y1 = (m1)(x1 - x0) + y0
y2 = (m2)(x2 - x0) + y0

具体的には、x=2とx=3の間で交差が発生する必要があります。コードを見てください：

#Initialize x1, y1, x2, y2
x1 <- c(1,2)
y1 <- c(10,10)

x2 <- c(3,4,5)
y2 <- c(20,30,40)

g <- c(TRUE, TRUE, FALSE, FALSE, FALSE)

q <- nls(c(y1, y2) ~ ifelse(g == TRUE, m1 * (x1 - x0) + y0, m2 * (x2 - x0) + y0), start = c(m1 = -1, m2 = 1, y0 = 0, x0 = 2), algorithm = "port", lower = c(m1 = -Inf, m2 = -Inf, y0 = -Inf, x0 = 2), upper = c(m1 = Inf, m2 = Inf, y0 = Inf, x0 = 3))
coef <- coef(q)
m1 <- coef[1]
m2 <- coef[2]
y0 <- coef[3]
x0 <- coef[4]

#Plot the original x1, y1, and x2, y2
plot(x1,y1,xlim=c(1,5),ylim=c(0,50))
points(x2,y2)

#Plot the fits
x1 <- c(1,2,3,4,5)
fit1 <- m1 * (x1 - x0) + y0
lines(x1, fit1, col="red")

x2   <- c(1,2,3,4,5)
fit2 <- m2 * (x2 - x0) + y0
lines(x2, fit2, col="blue")

したがって、そこにリストされているデータポイントを確認できます。次に、nlsを実行し、パラメーター、、、（m1勾配、および交点）を取得します。m2x0y0

しかし、解決策を見てください： ここに画像の説明を入力してください

明らかに、赤い線（最初の2つのポイントのみに基づいていると想定されています）は、最初の2つのポイントに最適な線ではありません。これは、最後の3つのポイントに依存するはずの青い線（2番目のフィット）の場合と同じです。ここで何が問題になっていますか？

4

2 に答える 2

3

これはセグメント化された回帰です。

# input data

x1 <- c(1,2); y1 <- c(10,10); x2 <- c(3,4,5);  y2 <- c(20,30,40) 
x  <- c(x1, x2); y <- c(y1, y2)

# segmented regression

library(segmented)
fm <- segmented.lm(lm(y ~ x), ~ x, NA, seg.control(stop.if.error = FALSE, K = 2))
summary(fm)

# plot

plot(fm)
points(y ~ x)

詳細について?lmは、、?segmented.lmを参照?seg.controlしてください。

于 2011-08-19T23:46:48.803 に答える
2

何が悪いのか正確にはわかりませんが、少し並べ替えることで機能させることができます。「人工的な「ゼロ残差」データには「nls」を使用しないでください。?nls」に関するコメントに注意してください。少しノイズを追加しました。

## Initialize x1, y1, x2, y2
x1 <- c(1,2)
y1 <- c(10,10)

x2 <- c(3,4,5)
y2 <- c(20,30,40)

## make single x, y vector
x <- c(x1,x2)
set.seed(1001)
## (add a bit of noise to avoid zero-residual artificiality)
y <- c(y1,y2)+rnorm(5,sd=0.01)

g <- c(TRUE,TRUE,FALSE,FALSE,FALSE) ## specify identities of points

## particular changes:
##   * you have lower=upper=2 for x0.  Did you want 2<x0<3?
##   * specified data argument explicitly (allows use of predict() etc.)
##   * changed name from 'q' to 'fit1' (avoid R built-in function)
fit1 <- nls(y ~ ifelse(g,m1,m1+delta_m)*(x - x0) + y0,
         start = c(m1 = -1, delta_m = 2, y0 = 0, x0 = 2),
         algorithm = "port",
         lower = c(m1 = -Inf, delta_m = 0, y0 = -Inf, x0 = 2),
         upper = c(m1 = Inf, delta_m = Inf, y0 = Inf, x0 = 3),
         data=data.frame(x,y))

#Plot the original 'data'
plot(x,y,col=rep(c("red","blue"),c(2,3)),
           xlim=c(1,5),ylim=c(0,50))

## add predicted values
xvec <- seq(1,5,length.out=101)
lines(xvec,predict(fit1,newdata=data.frame(x=xvec)))

編集ifelse： x位置ではなく、ポイントIDに基づく句

編集：2番目の勾配が>最初の勾配である必要があるように変更されました

もう一度見てみると、上記の問題はおそらく、単一のベクトルではなく、上記x1の別々のベクトルを使用していることが原因だと思います。これらはRによって複製され、ベクトルと一致するため、かなり混乱していたと思います。ひどく。たとえば、この簡略化された例は次のとおりです。x2xg

g <- c(TRUE, TRUE, FALSE, FALSE, FALSE)
ifelse(g,x1,x2)
## [1] 1 2 5 3 4

は、句で使用される前にx2拡張されることを示しています。最も恐ろしいのは、通常、次のような警告が表示されることです。(3 4 5 3 4)ifelse

> x2 + 1:5
[1] 4 6 8 7 9
Warning message:
In x2 + 1:5 :
  longer object length is not a multiple of shorter object length

しかし、この場合、警告はありません...

于 2011-08-19T22:34:54.837 に答える