我有两个想法,都有缺点。也许你可以根据自己的需要调整其中之一。很抱歉,目前无法访问云端硬盘,因此使用了一些仿真数据。
1 “手动” 多项式拟合模型
在这里你可以指定你最喜欢的机型,某些领域可能是LM的,一些多项式等
代码:
library(segmented)
library(ggplot2)
library(data.table)
# Data
set.seed(12)
xx <- 1:100
yy <- 2 + 1.5 * pmax(xx-35, 0) - 1.5 * pmax(xx-70, 0) + 15 * pmax(runif(100) - 0.5, 0) + rnorm(100, 0, 2)
dt <- data.table(x = xx, y = yy, type = 'act')
dt_all <- copy(dt)
# lm
lm_lin <- lm(y ~ x, data = dt)
summary(lm_lin)
# Find segments
lm_seg <- segmented(
lm_lin, seg.Z = ~ x, psi = list(x = c(30, 80)))
# "Manual" lm's
breaks <- unname(lm_seg$psi[, 'Est.'])
lm_poly1 <- lm(y ~ poly(x, 4), data = dt[x < breaks[1], ])
lm_2 <- lm(y ~ x, data = dt[x > breaks[1] & x < breaks[2], ])
lm_poly3 <- lm(y ~ poly(x, 4), data = dt[x > breaks[2], ])
dt_all <- rbind(
dt_all,
data.table(x = xx, y = c(
predict(lm_poly1),
predict(lm_2),
predict(lm_poly3)),
type = 'lm_poly'
)
)
2.使用来自segmented
和某些样条的断点拟合一个gam模型
在这里你会得到一个段之间的平滑过渡,但是你对发生的事情的控制很少。
# Using splines for smooth segments
library(mgcv)
spl <- gam(y ~ s(x, bs = "cc", k = 12), data = dt, knots = list(xx = breaks))
# Plot
dt_all <- rbind(dt_all, data.table(x = xx, y = predict(spl), type = 'spl'))
ggplot(dt_all, aes(x = x, y = y)) + geom_point(size = 1) +
facet_grid(. ~ type) + theme_minimal()
两者都可以使用例如进行list()
和lapply()
自动化一点(用于不同数量的休息等)。
编辑:
通过的poly
和s
你可以稍微“更好的”拟合模型改变参数,但在边缘gam
错误是相当大的,看到degree = 6
和k = 30
:
您是否需要使用'segmented'软件包,或者只需对数据集进行子集并为每个段构建单独的'lm'模型? – C8H10N4O2
是的,因为我希望休息时间也可以用一些起始值进行计算,如示例 –
准确地说,这是确切数据的确切问题http://stackoverflow.com/q/42643638/4729183 –