如何在R中设置平滑的磁滞? [英] How can I fit a smooth hysteresis in R?
问题描述
我有一个应该适合滞后的测量方法.出于可视化的目的,我想画一条近似于磁滞的线以帮助解释这种模式.
I have a measurment of which should fit an hysteresis. For visualisation purpose I would like to plot a line approximating the hysteresis to help explain this pattern.
我使用以下代码在下图中创建了一个示例.
I created an example in the following image using the code below.
我希望获得类似于绿色曲线的输出-但是我没有直接可用的数据,所以我不在乎它是否尖锐.
I would like to have an output similar to the green curve - however I don't have this data directly available, and I don't care whether it is pointy.
但是大多数平滑功能(例如我用蓝色绘制的smooth.spline
)都不允许循环.我能找到的最接近的是bezier
库-用红色绘制.在这里看不到很好,但是会产生一个循环,但是拟合效果很差(并且会发出一些警告,并且会花费一些时间).
However most smoothing functions such as smooth.spline
which I plotted in blue - allow no loops. The closest I can find is from the bezier
library - plotted in red. Not nicely visible here but it produces a loop, however it fits poorly (and gives some warnings and takes quite some time).
您能建议一种方法吗?
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)
更新
事实证明,我的实际问题略有不同,我问另一个问题以反映该问题中的实际问题:
As it turns out my actual problem is slightly different I ask another question to reflect my actual issue in the question: 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$measuredx
上平滑data$measuredy
,而是通过对每个时间戳变量进行平滑来分别进行两次平滑.然后结合两次平滑的拟合值.这是平滑闭合曲线或环路的一般方法. (另请参阅问题与解答:平滑连续2D点)
Instead of smoothing data$measuredy
directly over data$measuredx
, do two separate smoothing, by smoothing each against a time stamp variable. Then combine the fitted values from two smoothing. This is a general way for smoothing a closed curve or a loop. (See also Q & A: 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])
只是为了确保向量中的最后一个值与第一个一致,从而完成一个循环.
c(data$measuredx, data$measuredx[1])
for example is just to ensure that the last value in the vector agrees with the first, so that it completes a cycle.
由于smooth.spline
正在进行平滑而不是插值,因此曲线在左下角并未真正闭合,因此即使我们确保数据向量完成了一个循环,拟合的循环也可能不是闭合的.一个实际的解决方法是使用加权回归,在该位置上施加较大的权重以使其封闭.
The curve is not really closed at the bottom left corner, because smooth.spline
is doing smoothing not interpolation, so even if we have ensure that data vector completes a cycle, the fitted one may not be a closed one. A practical workaround is to use weighted regression, imposing heavy weight on this spot to make it closed.
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)
这篇关于如何在R中设置平滑的磁滞?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!