Как мне установить плавный гистерезис в R? - PullRequest
Новая
       112

Как мне установить плавный гистерезис в R?

0 голосов
/ 11 сентября 2018

У меня есть измерение, которое должно соответствовать гистерезису.Для наглядности я хотел бы построить линию, аппроксимирующую гистерезис, чтобы помочь объяснить этот паттерн.

Я создал пример на следующем изображении, используя код ниже.enter image description here

Я хотел бы получить вывод, похожий на зеленую кривую - однако у меня нет этих данных напрямую, и мне все равно, являются ли они заостренными.

Однако большинство функций сглаживания, таких как 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)

ОБНОВЛЕНИЕ

Как оказалось, моя реальная проблема немного отличается, я задаю другой вопрос, чтобы отразитьМоя актуальная проблема в вопросе: Как вписать плавный гистерезис в плохо распределенный набор данных?

1 Ответ

0 голосов
/ 11 сентября 2018 
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, сделайте два отдельных сглаживания, сглаживая каждое по переменной временной отметки. Затем объедините установленные значения из двух сглаживающих. Это общий способ сглаживания замкнутой кривой или петли. (См. Также вопросы и ответы: Сглаживание непрерывных 2D точек ) 

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)

...