绘制拟合的分段线性模型显示的断点比估计的要多

Question

今天我正在帮助一位朋友进行分段回归。我们试图用断点拟合分段回归，看看它是否比标准线性模型更适合数据。

我偶然发现了一个我无法理解的问题。当使用所提供的数据用单个断点拟合分段回归时，它确实适合单个断点。

然而，当您根据模型进行预测时，它会给出看起来像 2 个断点的信息。使用绘制模型时plot.segmented()不会出现此问题。

任何人都知道发生了什么以及我如何获得正确的预测（以及标准错误等）？或者我在代码中一般做错了什么？

# load packages
library(segmented)

# make data
d <- data.frame(x = c(0, 3, 13, 18, 19, 19, 26, 26, 33, 40, 49, 51, 53, 67, 70, 88
),
                y = c(0, 3.56211608128595, 10.5214485148819, 3.66063708049802, 6.11000808621074, 
                      5.51520423804034, 7.73043895812661, 7.90691392857039, 6.59626527933846, 
                      10.4413913666936, 8.71673928545967, 9.93374157928462, 1.214860139929, 
                      3.32428882257746, 2.65223361387063, 3.25440939462105))

# fit normal linear regression and segmented regression
lm1 <- lm(y ~ x, d)
seg_lm <- segmented(lm1, ~ x)

slope(seg_lm)
#> $x
#>            Est.  St.Err. t value CI(95%).l   CI(95%).u
#> slope1  0.17185 0.094053  1.8271 -0.033079  0.37677000
#> slope2 -0.15753 0.071933 -2.1899 -0.314260 -0.00079718

# make predictions
preds <- data.frame(x = d$x, preds = predict(seg_lm))

# plot segmented fit
plot(seg_lm, res = TRUE)

# plot predictions
lines(preds$preds ~ preds$x, col = 'red')

由reprex 包(v0.2.0)于 2018-07-27 创建。

Answer 1

这是一个纯粹的情节问题。

#Call: segmented.lm(obj = lm1, seg.Z = ~x)
#
#Meaningful coefficients of the linear terms:
#(Intercept)            x         U1.x  
#     2.7489       0.1712      -0.3291  
#
#Estimated Break-Point(s):
#psi1.x  
# 37.46  

断点估计位于 处x = 37.46，它不是任何采样位置：

d$x
# [1]  0  3 13 18 19 19 26 26 33 40 49 51 53 67 70 88

如果您使用这些采样位置的拟合值绘制绘图，

preds <- data.frame(x = d$x, preds = predict(seg_lm))
lines(preds$preds ~ preds$x, col = 'red')

您不会在视觉上看到那些拟合的两个段在断点处连接起来，因为lines只需将拟合值一一排列即可。plot.segmented相反，我们会观察断点并绘制正确的图。

请尝试以下操作：

## the fitted model is piecewise linear between boundary points and break points
xp <- c(min(d$x), seg_lm$psi[, "Est."], max(d$x))
yp <- predict(seg_lm, newdata = data.frame(x = xp))

plot(d, col = 8, pch = 19)  ## observations
lines(xp, yp)  ## fitted model
points(d$x, seg_lm$fitted, pch = 19)  ## fitted values
abline(v = d$x, col = 8, lty = 2)  ## highlight sampling locations