如何在R中拟合平滑滞后？

我有一个测量值，它应该符合磁滞。为了直观起见，我想画一条近似磁滞的线来帮助解释这个模式

我使用下面的代码在下图中创建了一个示例。

我希望有一个类似于绿色曲线的输出-但是我没有直接可用的数据，我也不关心它是否尖锐

但是，我用蓝色绘制的大多数平滑函数（如

smooth.spline

）不允许循环。我能找到的最接近的是贝塞尔库-以红色绘制。虽然在这里看不清楚，但它会生成一个循环，但是它的匹配性很差（并且会给出一些警告，并且需要相当长的时间）

你能推荐一种方法吗

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)

set.seed（12345）
向上的

c（data$measuredx，data$measuredx[1]）
例如，只是为了确保向量中的最后一个值与第一个值一致，从而完成一个循环


曲线在左下角不是真正闭合的，因为
平滑。样条曲线
进行的是平滑而不是插值，因此即使我们确保数据向量完成一个周期，拟合的曲线也可能不是闭合曲线。一个实用的解决方法是使用加权回归，在这个点上施加很重的权重以使其闭合

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)

t

c（data$measuredx，data$measuredx[1]）
例如，只是为了确保向量中的最后一个值与第一个值一致，从而完成一个循环


曲线在左下角不是真正闭合的，因为
平滑。样条曲线
进行的是平滑而不是插值，因此即使我们确保数据向量完成一个周期，拟合的曲线也可能不是闭合曲线。一个实用的解决方法是使用加权回归，在这个点上施加很重的权重以使其闭合

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)

t
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)