带R的分段回归:绘制线段

带R的分段回归:绘制线段,r,plot,piecewise,R,Plot,Piecewise,我得了54分。它们代表产品的提供和需求。我想表明报价中有一个断点 首先,我对x轴(offer)进行排序,并删除出现两次的值。我有47个值,但是我删除了第一个和最后一个值(把它们看作断点是没有意义的)。断开长度为45: Break<-(sort(unique(offer))[2:46]) 更重要的是,我的情节中的台词真的很奇怪 以下是我的数据: demand <- c(1155, 362, 357, 111, 703, 494, 410, 63, 616, 468, 973, 23

我得了54分。它们代表产品的提供和需求。我想表明报价中有一个断点

首先,我对x轴(offer)进行排序,并删除出现两次的值。我有47个值,但是我删除了第一个和最后一个值(把它们看作断点是没有意义的)。断开长度为45:

Break<-(sort(unique(offer))[2:46])
更重要的是,我的情节中的台词真的很奇怪

以下是我的数据:

demand <- c(1155, 362, 357, 111, 703, 494, 410, 63, 616, 468, 973, 235,
            180, 69, 305, 106, 155, 422, 44, 1008, 225, 321, 1001, 531, 143,
            251, 216, 57, 146, 226, 169, 32, 75, 102, 4, 68, 102, 462, 295,
            196, 50, 739, 287, 226, 706, 127, 85, 234, 153, 4, 373, 54, 81,
            18)
offer <- c(39.3, 23.5, 22.4, 6.1, 35.9, 35.5, 23.2, 9.1, 27.5, 28.6, 41.3,
           16.9, 18.2, 9, 28.6, 12.7, 11.8, 27.9, 21.6, 45.9, 11.4, 16.6,
           40.7, 22.4, 17.4, 14.3, 14.6, 6.6, 10.6, 14.3, 3.4, 5.1, 4.1,
           4.1, 1.7, 7.5, 7.8, 22.6, 8.6, 7.7, 7.8, 34.7, 15.6, 18.5, 35,
           16.5, 11.3, 7.7, 14.8, 2, 12.4, 9.2, 11.8, 3.9)

demand奇怪的线条仅仅是由于点的绘制顺序。
以下内容看起来应该更好:

i <- order(offer)
lines(offer[i], predict(model,list(offer))[i])

另外,
(offerVincent让你走上了正确的轨道。在结果图中,线条唯一“奇怪”的地方是,
线条
在每个连续点之间画了一条线,这意味着如果它只是连接每条线的两端,你就会看到“跳跃”

如果不需要该连接器,则必须将
调用分成两部分

另外,我觉得你可以简化一下你的回归。以下是我所做的:

#After reading your data into dat
Break <- 22.4
dat$grp <- dat$offer < Break

#Note the addition of the grp variable makes this a bit easier to read
m <- lm(demand~offer*grp,data = dat)
dat$pred <- predict(m)

plot(dat$offer,dat$demand)
dat <- dat[order(dat$offer),]
with(subset(dat,offer < Break),lines(offer,pred))
with(subset(dat,offer >= Break),lines(offer,pred))
#将数据读入dat后

中断这里是使用
ggplot2
的更简单方法

require(ggplot2)
qplot(offer, demand, group = offer > 22.4, geom = c('point', 'smooth'), 
   method = 'lm', se = F, data = dat)
编辑。我还建议您看看这个支持自动检测和估计分段回归模型的软件包
segmented

更新:

下面是一个使用R包自动检测中断的示例

library(segmented)
set.seed(12)
xx <- 1:100
zz <- runif(100)
yy <- 2 + 1.5*pmax(xx - 35, 0) - 1.5*pmax(xx - 70, 0) + 15*pmax(zz - .5, 0) + 
  rnorm(100,0,2)
dati <- data.frame(x = xx, y = yy, z = zz)
out.lm <- lm(y ~ x, data = dati)
o <- segmented(out.lm, seg.Z = ~x, psi = list(x = c(30,60)),
  control = seg.control(display = FALSE)
)
dat2 = data.frame(x = xx, y = broken.line(o)$fit)

library(ggplot2)
ggplot(dati, aes(x = x, y = y)) +
  geom_point() +
  geom_line(data = dat2, color = 'blue')
库(分段)
种子(12)

xx感谢您的回答!我仍然有警告消息:“警告消息:在predict.lm(model2,list(offer)):从秩缺陷拟合进行预测可能会产生误导”。结果更好:我只有一个分段段,但我不明白为什么有3个段(即,我的两个段没有自然连接…)你能解释一下为什么这样做会很顺利吗?直觉上认为第一部分是22.4-offer,第二部分是22.4-offer。第一部分的意思不是“如果offer小于22.4,那么计算出的offer-22.4”,这意味着它将产生负协变量?因此,当我们估计输入时,我们的系数将与这些负值相乘?54个点似乎不是检测此类转换的大量点。您可以选择在stats.stackexchange.com上发布此信息,并提出具体问题,如果这足够检测到t数据中的断点。仅我的2 ct。我认为这在统计上是相当可疑的。最好在模型本身中估计断点(尽管这使其非线性)。你不能相信当前非正式估算过程中的p-VAL或标准误差。54分不是很大,我同意,但我的线性回归和分段线性回归都是显著的。此外,分段线性模型的剩余标准误差为103.9,而线性模型的剩余标准误差为121.3,其中0度以下两个f自由。分段模型明显更好。感谢您提出使用“分段”软件包的想法。Muggeo,V.M.R.(2003)估算具有未知断点的回归模型。医学统计22,3055–3071“这是一篇有趣的论文,可以了解包中发生了什么。特别是,它对我使用的代码有一个优势:两个段是连接的!在“R书”中,作者没有提到他的段是不连接的,甚至还展示了一个带有连接段的绘图…其中有一个使用ggplot()和segmented()的示例?我似乎在任何地方都找不到。我添加了一个使用
ggplot
segmented
的示例。在
qplot(…)
之后,我得到
错误:未知参数:方法,se
i <- order(offer)
lines(offer[i], predict(model,list(offer))[i])
> lm(demand~(offer<22.4)*offer + (offer>=22.4)*offer)
Call:
lm(formula = demand ~ (offer < 22.4) * offer + (offer >= 22.4) * offer)
Coefficients:
            (Intercept)         offer < 22.4TRUE                    offer  
                -309.46                   356.08                    29.86  
      offer >= 22.4TRUE   offer < 22.4TRUE:offer  offer:offer >= 22.4TRUE  
                     NA                   -20.79                       NA  
model <- lm(
  demand ~ ifelse(offer<22.4,offer-22.4,0) 
           + ifelse(offer>=22.4,offer-22.4,0) )
#After reading your data into dat
Break <- 22.4
dat$grp <- dat$offer < Break

#Note the addition of the grp variable makes this a bit easier to read
m <- lm(demand~offer*grp,data = dat)
dat$pred <- predict(m)

plot(dat$offer,dat$demand)
dat <- dat[order(dat$offer),]
with(subset(dat,offer < Break),lines(offer,pred))
with(subset(dat,offer >= Break),lines(offer,pred))
require(ggplot2)
qplot(offer, demand, group = offer > 22.4, geom = c('point', 'smooth'), 
   method = 'lm', se = F, data = dat)
library(segmented)
set.seed(12)
xx <- 1:100
zz <- runif(100)
yy <- 2 + 1.5*pmax(xx - 35, 0) - 1.5*pmax(xx - 70, 0) + 15*pmax(zz - .5, 0) + 
  rnorm(100,0,2)
dati <- data.frame(x = xx, y = yy, z = zz)
out.lm <- lm(y ~ x, data = dati)
o <- segmented(out.lm, seg.Z = ~x, psi = list(x = c(30,60)),
  control = seg.control(display = FALSE)
)
dat2 = data.frame(x = xx, y = broken.line(o)$fit)

library(ggplot2)
ggplot(dati, aes(x = x, y = y)) +
  geom_point() +
  geom_line(data = dat2, color = 'blue')