英文:
How can I fit data with flat lines over a specific range in R?
问题
我一直在尝试拟合一些具有在一定范围内的 x 值变化的平均 y 值的数据。我一直在尝试让这个工作，但已经有一段时间了。
例如，给定一些受控随机数据和所需的拟合：
library(tidyverse)
Data <- data.frame(Time = c(1:100, 101:500, 501:1000),
Value = c(runif(100, 0, 500),
runif(400, 500, 1000),
runif(500, 0, 100)),
Desired_fit = c(rep_len(250,100),
rep_len(750,400),
rep_len(50,500)))
plot(Data$Time, Data$Value)
lines(Data$Time, Data$Desired_fit, col = "red")
我尝试过对数据进行平滑处理、获取滑动平均值以及进行样条插值，但这些方法产生的是曲线拟合，而不是上面的 Desired_fit。实质上，我正在尝试在数据集中的每个拐点上拟合一条水平线。
我尝试过最接近的方法是使用 zoo 包中的 rollmean()：
library(zoo)
moving_average <- rollmean(Data$Value, 50, fill = NA)
plot(Data$Time, Data$Value)
lines(Data$Time, moving_average, col = "red")
非常感谢任何帮助或建议！谢谢！
英文:
I have been trying to fit some data with a change in the average y-values over a certain range of x values. I have been stuck on trying to get this to work for a little while now.
For example, given some controlled randomized data and a desired fit:
library(tidyverse)
Data <- data.frame(Time = c(1:100, 101:500, 501:1000),
Value = c(runif(100, 0, 500),
runif(400, 500, 1000),
runif(500, 0, 100)),
Desired_fit = c(rep_len(250,100),
rep_len(750,400),
rep_len(50,500)))
plot(Data$Time, Data$Value)
lines(Data$Time, Data$Desired_fit, col = "red")
I have tried to smooth, get a running average, and spline my data, but this produced a curve fit instead of the Desired_fit above. In essence, I am trying to fit a horizontal line across each inflection point in the data set.
The closest thing I have tried is by using the rollmean()from the zoo package:
library(zoo)
moving_average <- rollmean(Data$Value, 50, fill = NA)
plot(Data$Time, Data$Value)
lines(Data$time, moving_average, col = "red")
Any help or advice would be greatly appreciated!
Thank you!
答案1
得分: 3
使用 dpseg 计算分段断点。dp$segments 的每一行定义一个分段，其中 start 和 end 列是该分段的起始点和终止点的索引，x1 和 x2 列是相应的时间。最后绘制每个分段中数据的均值。
library(dpseg)
plot(Value ~ Time, Data)
dp <- with(Data, dpseg(x = Time, y = Value, jumps = TRUE))
segs <- dp$segments
xx <- with(segs, c(rbind(x1, x2)))
yy <- mapply(\(st,en) mean(Data$Value[st:en]), segs$start, segs$end) |> rep(each=2)
lines(xx, yy, col = "red", lwd = 3)
或者，如果不想要垂直线段，请用以下代码替换从上面的 xx<-... 行开始的所有内容。
nr <- nrow(segs)
for(i in 1:nr) with(segs[i, ],
segments(x0 = x1,
y0 = mean(Data$Value[start:end]),
x1 = x2, col = "red", lwd = 3))
（代码和图像的英文部分未翻译，仅提供翻译的 R 代码部分和图像链接）
英文:
Calculate the segment breakpoints using dpseg. Each row of dp$segments defines one segment with start and end
columns being indexes of start and end points of that segment and x1 and x2 columns being the corresponding times. Finally plot the means of the data in each segment.
library(dpseg)
plot(Value ~ Time, Data)
dp <- with(Data, dpseg(x = Time, y = Value, jumps = TRUE))
segs <- dp$segments
xx <- with(segs, c(rbind(x1, x2)))
yy <- mapply(\(st,en) mean(Data$Value[st:en]), segs$start, segs$end) |> rep(each=2)
lines(xx, yy, col = "red", lwd = 3)
Alternately replace everything from the xx<-... line onwards above with the following if the vertical line segments are not wanted.
nr <- nrow(segs)
for(i in 1:nr) with(segs[i, ],
segments(x0 = x1,
y0 = mean(Data$Value[start:end]),
x1 = x2, col = "red", lwd = 3))
Old
This did not work so well.
Calculate the breakpoints using breakpoints from strucchange and then plot.the data and the fitted values.
library(strucchange)
bp <- with(Data, breakpoints(Value ~ 1))
plot(Value ~ Time, Data)
lines(fitted(bp) ~ Time, Data, col = "red", lwd = 2)
Note
Since random numbers were used to generate the data in the question we used set.seed first to make it reproducible.
set.seed(123)
Data <- data.frame(Time = c(1:100, 101:500, 501:1000),
Value = c(runif(100, 0, 500),
runif(400, 500, 1000),
runif(500, 0, 100)),
Desired_fit = c(rep_len(250,100),
rep_len(750,400),
rep_len(50,500)))
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论