Подгонка синусоидального термина к данным

Хотя я читаю этот пост, я все еще не знаю, как применить это к моим собственным данным, и надеюсь, что кто-то может мне помочь.

У меня есть следующие данные:

y <- c(11.622967, 12.006081, 11.760928, 12.246830, 12.052126, 12.346154, 12.039262, 12.362163, 12.009269, 11.260743, 10.950483, 10.522091,  9.346292,  7.014578,  6.981853,  7.197708,  7.035624,  6.785289, 7.134426,  8.338514,  8.723832, 10.276473, 10.602792, 11.031908, 11.364901, 11.687638, 11.947783, 12.228909, 11.918379, 12.343574, 12.046851, 12.316508, 12.147746, 12.136446, 11.744371,  8.317413, 8.790837, 10.139807,  7.019035,  7.541484,  7.199672,  9.090377,  7.532161,  8.156842,  9.329572, 9.991522, 10.036448, 10.797905)
t <- 18:65

И теперь я просто хочу соответствовать синусоидальной волне

с четырьмя неизвестными , ω , ϕ и C к нему.$A$$\omega$$\phi$$C$

Остальная часть моего кода выглядит следующим образом

res <- nls(y ~ A*sin(omega*t+phi)+C, data=data.frame(t,y), start=list(A=1,omega=1,phi=1,C=1))
co <- coef(res)

fit <- function(x, a, b, c, d) {a*sin(b*x+c)+d}

# Plot result
plot(x=t, y=y)
curve(fit(x, a=co["A"], b=co["omega"], c=co["phi"], d=co["C"]), add=TRUE ,lwd=2, col="steelblue")

Но результат действительно плохой.

Я был бы очень признателен за любую помощь.

Приветствия.

Если вы просто хотите получить хорошую оценку и не беспокоитесь о ее стандартной ошибке:$\omega$

ssp <- spectrum(y)  
per <- 1/ssp$freq[ssp$spec==max(ssp$spec)]
reslm <- lm(y ~ sin(2*pi/per*t)+cos(2*pi/per*t))
summary(reslm)

rg <- diff(range(y))
plot(y~t,ylim=c(min(y)-0.1*rg,max(y)+0.1*rg))
lines(fitted(reslm)~t,col=4,lty=2)   # dashed blue line is sin fit

# including 2nd harmonic really improves the fit
reslm2 <- lm(y ~ sin(2*pi/per*t)+cos(2*pi/per*t)+sin(4*pi/per*t)+cos(4*pi/per*t))
summary(reslm2)
lines(fitted(reslm2)~t,col=3)    # solid green line is periodic with second harmonic

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

---

Если вы хотите получить представление о неопределенности в , вы можете использовать вероятность профиля ( pdf1 , pdf2)$\omega$ - ссылки на получение приблизительных CI или SE по вероятности профиля или их варианты не сложно найти)

(В качестве альтернативы, вы могли бы подать эти оценки в nls ... и начать его уже сходились.)

$2 \pi / 20$

Когда я положил , что в nls«s startсписок, я получил кривую , которая была гораздо более разумным, хотя он все еще имеет некоторые систематические ошибки.

В зависимости от вашей цели с этим набором данных, вы можете попытаться улучшить подбор, добавив дополнительные термины или используя непараметрический подход, такой как гауссовский процесс с периодическим ядром.

Выбор начального значения автоматически

Если вы хотите выбрать доминирующую частоту, вы можете использовать быстрое преобразование Фурье (БПФ). Это выход из моей области знаний, поэтому я позволю другим людям заполнить детали, если они захотят (особенно о шагах 2 и 3), но приведенный Rниже код должен работать.

# Step 1: do the FFT
raw.fft = fft(y)

# Step 2: drop anything past the N/2 - 1th element.
# This has something to do with the Nyquist-shannon limit, I believe
# (https://en.wikipedia.org/wiki/Nyquist%E2%80%93Shannon_sampling_theorem)
truncated.fft = raw.fft[seq(1, length(y)/2 - 1)]

# Step 3: drop the first element. It doesn't contain frequency information.
truncated.fft[1] = 0

# Step 4: the importance of each frequency corresponds to the absolute value of the FFT.
# The 2, pi, and length(y) ensure that omega is on the correct scale relative to t.
# Here, I set omega based on the largest value using which.max().
omega = which.max(abs(truncated.fft)) * 2 * pi / length(y)

Вы также можете составить график, abs(truncated.fft)чтобы увидеть, есть ли другие важные частоты, но вам придется немного поэкспериментировать с масштабированием оси x.

Кроме того, я считаю, что @Glen_b правильно, что проблема выпуклая, если вы знаете омегу (или, может быть, вам тоже нужно знать фи? Я не уверен). В любом случае, знание начальных значений для других параметров не должно быть столь же важным, как для омеги, если они находятся в правильном поле. Вы могли бы, вероятно, получить приличные оценки других параметров из БПФ, но я не уверен, как это будет работать.

В качестве альтернативы тому, что уже было сказано, возможно, стоит отметить, что модель AR (2) из ​​класса моделей ARIMA может использоваться для создания прогнозов с синусоидальной диаграммой.

Panratz (1991) говорит нам следующее о стохастических циклах:

Образец стохастического цикла можно представить как искаженный образец синусоиды в прогнозе: это синусоида со стохастическим (вероятностным) периодом, амплитудой и фазовым углом.

Чтобы увидеть, можно ли auto.arima()подобрать такую ​​модель к данным, я использовал функцию из пакета прогноза, чтобы выяснить, будет ли она предлагать модель AR (2). Оказывается, что auto.arima()функция предлагает модель ARMA (2,2); не чистая модель AR (2), но это нормально. Это нормально, потому что модель ARMA (2,2) содержит компонент AR (2), поэтому применяется то же правило (о стохастических циклах). Таким образом, мы все еще можем проверить вышеупомянутое условие, чтобы видеть, будут ли производиться синусоидальные прогнозы.

Результаты auto.arima(y)показаны ниже.

Series: y 
ARIMA(2,0,2) with non-zero mean 

Coefficients:
         ar1      ar2      ma1     ma2  intercept
      1.7347  -0.8324  -1.2474  0.6918    10.2727
s.e.  0.1078   0.0981   0.1167  0.1911     0.5324

sigma^2 estimated as 0.6756:  log likelihood=-60.14
AIC=132.27   AICc=134.32   BIC=143.5

График ниже показывает исходную серию y, соответствие модели ARMA (2,2) и 14 прогнозов вне выборки. Как видно, прогнозы вне выборки следуют синусоидальной схеме.

Имейте в виду две вещи. 1) Это просто очень быстрый анализ (с использованием автоматизированного инструмента), и для правильной обработки необходимо следовать методологии Бокса-Дженкинса. 2) Прогнозы ARIMA хороши при краткосрочном прогнозировании, поэтому вы можете посчитать, что долгосрочные прогнозы по моделям в ответах @David J. Harris и @Glen_b более надежны.

Наконец, надеюсь, это хорошее дополнение к некоторым уже очень информативным ответам.

Ссылка : Прогнозирование с использованием моделей динамической регрессии: Алан Панкрац, 1991 (Джон Уили и сыновья, Нью-Йорк), ISBN 0-471-61528-5

Текущие методы для подгонки синусоидальной кривой к заданному набору данных требуют первого угадывания параметров с последующим интерактивным процессом. Это проблема нелинейной регрессии. Другой метод состоит в преобразовании нелинейной регрессии в линейную регрессию благодаря удобному интегральному уравнению. Тогда нет необходимости в первоначальном предположении и в итеративном процессе: подгонка получается напрямую. В случае функции y = a + r * sin (w * x + phi) или y = a + b * sin (w * x) + c * cos (w * x), см. Стр. 35-36 статьи. "Régression sinusoidale" опубликовано на Scribd: http://www.scribed.com/JJacquelin/documents В случае функции y = a + p * x + r * sin (w * x + phi): стр. 49-51 главы «Смешанные линейные и синусоидальные регрессии». В случае более сложных функций общий процесс объясняется в главе «Обобщенная синусоидальная регрессия», страницы 54–61, после чего следует числовой пример y = r * sin (w * x + phi) + (b / x) + c * ln (x), стр. 62-63

Если вам известна самая низкая и самая высокая точка ваших косинусоидальных данных, вы можете использовать эту простую функцию для вычисления всех косинусных коэффициентов:

getMyCosine <- function(lowest_point=c(pi,-1), highest_point=c(0,1)){
  cosine <- list(
    T = pi / abs(highest_point[1] - lowest_point[1]),
    b = - highest_point[1],
    k = (highest_point[2] + lowest_point[2]) / 2,
    A = (highest_point[2] - lowest_point[2]) / 2
  )
  return(cosine)
}

Ниже он используется для имитации изменения температуры в течение дня с помощью функции косинуса путем ввода часов и значений температуры для самого низкого и самого теплого часа:

c <- getMyCosine(c(4,10),c(17,25)) 
# lowest temprature at 4:00 (10 degrees), highest at 17:00 (25 degrees)

x = seq(0,23,by=1);  y = c$A*cos(c$T*(x +c$b))+c$k ; 
library(ggplot2);   qplot(x,y,geom="step")

Выход ниже:

Другой вариант - использование универсальной функции optim или nls. Я пробовал оба, ни один из них не является полностью надежным

Следующие функции принимают данные в y и вычисляют параметры.

calc.period <- function(y,t)
{     
   fs <- 1/(t[2]-t[1])
   ssp <- spectrum(y,plot=FALSE )  
   fN <- ssp$freq[which.max(ssp$spec)]
   per <- 1/(fN*fs)
   return(per)
 }

fit.sine<- function(y, t)
{ 
  data <- data.frame(x = as.vector(t), y=as.vector(y))
  min.RSS <- function (data, par){
    with(data, sum((par[1]*sin(2*pi*par[2]*x + par[3])+par[4]-y )^2))
  }  
  amp = sd(data$y)*2.**0.5
  offset = mean(data$y)
  fest <- 1/calc.period(y,t)
  guess = c( amp, fest,  0,   offset)
  #res <- optim(par=guess, fn = min.RSS, data=data ) 
  r<-nls(y~offset+A*sin(2*pi*f*t+phi), 
     start=list(A=amp, f=fest, phi=0, offset=offset))
  res <- list(par=as.vector(r$m$getPars()))
  return(res)
}

 genSine <- function(t, params)
     return( params[1]*sin(2*pi*params[2]*t+ params[3])+params[4])

использование следующее:

t <- seq(0, 10, by = 0.01)
A <- 2 
f <- 1.5
phase <- 0.2432
offset <- -2

y <- A*sin(2*pi*f*t +phase)+offset + rnorm(length(t), mean=0, sd=0.2)

reslm1 <- fit.sine(y = y, t= t)

Следующий код сравнивает данные

ysin <- genSine(as.vector(t), params=reslm1$par)
ysin.cor <- genSine(as.vector(t), params=c(A, f, phase, offset))

plot(t, y)
lines(t, ysin, col=2)
lines(t, ysin.cor, col=3)