我有一个适合滞后的测量。出于可视化目的,我想绘制一条近似滞后的线来帮助解释这种模式。
我想有一个类似于绿色曲线的输出 - 但是我没有直接获得这些数据,我不在乎它是否是尖头。
然而,大多数平滑函数,例如smooth.spline
,我用蓝色绘制 - 不允许循环。我能找到的最接近的是来自bezier
的图书馆 - 用红色绘制。在这里看不太清楚,但它会产生一个循环,但是它很不合适(并且会给出一些警告,并且需要相当长的时间)。
你能建议一个方法吗?
set.seed(12345)
up <- seq(0,1,length.out=100)^3
down <- sqrt(seq(1,0,length.out=100))
x <- c(seq(0,1,length.out=length(up)),
seq(1,0, length.out=length(down)))
data <- data.frame(x=x, y=c(up,down),
measuredx=x + rnorm(length(x))*0.01,
measuredy=c(up,down) + rnorm(length(up)+length(down))*0.03)
with(data,plot(measuredx,measuredy, type = "p"))
with(data,lines(x,y, col='green'))
sp <- with(data,smooth.spline(measuredx, measuredy))
with(sp, lines(x,y, col="blue"))
library(bezier)
bf <- bezierCurveFit(as.matrix(data[,c(1,3)]))
lines(bezier(t=seq(0, 1, length=500), p=bf$p), col="red", cex=0.25)
UPDATE
事实证明我的实际问题略有不同,我问另一个问题,以反映我在问题中的实际问题:How to fit a smooth hysteresis in a poorly distributed data set?
set.seed(12345)
up <- seq(0,1,length.out=100)^3
down <- sqrt(seq(1,0,length.out=100))
x <- c(seq(0,1,length.out=length(up)),
seq(1,0, length.out=length(down)))
data <- data.frame(x=x, y=c(up,down),
measuredx=x + rnorm(length(x))*0.01,
measuredy=c(up,down) + rnorm(length(up)+length(down))*0.03)
不是直接在data$measuredy
上平滑data$measuredx
,而是通过平滑每个时间戳变量进行两次单独的平滑。然后结合两次平滑的拟合值。这是平滑闭合曲线或循环的一般方法。 (另见问答:Smoothing Continuous 2D Points)
t <- seq_len(nrow(data) + 1)
xs <- smooth.spline(t, c(data$measuredx, data$measuredx[1]))$y
ys <- smooth.spline(t, c(data$measuredy, data$measuredy[1]))$y
with(data, plot(measuredx, measuredy))
lines(xs, ys)
例如,c(data$measuredx, data$measuredx[1])
只是为了确保向量中的最后一个值与第一个值一致,以便它完成一个循环。
曲线在左下角并未真正关闭,因为smooth.spline
正在进行平滑而不是插值,所以即使我们确保数据向量完成一个循环,拟合的也可能不是闭合的。一个实际的解决方法是使用加权回归,在这个位置上施加重量以使其关闭。
t <- seq_len(nrow(data) + 1)
w <- rep(1, length(t)) ## initially identical weight everywhere
w[c(1, length(w))] <- 100000 ## give heavy weight
xs <- smooth.spline(t, c(data$measuredx, data$measuredx[1]), w)$y
ys <- smooth.spline(t, c(data$measuredy, data$measuredy[1]), w)$y
with(data, plot(measuredx, measuredy), col = 8)
lines(xs, ys, lwd = 2)