Встановити синусоїдальний термін до даних

Хоча я читаю цю публікацію, я все ще не маю уявлення, як застосувати це до власних даних і сподіваюся, що хтось може мені допомогти.

У мене є такі дані:

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

А тепер я просто хочу помістити синусоїду

з чотирма невідомими , , \ phi і 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 - посилання на отримання приблизних CI або SE з імовірності профілю або його варіанти не важко знайти)$\omega$

(Крім того, ви можете подати ці оцінки в nls ... і запустити їх уже зближеними.)

Як запропонував @Stefan, різні стартові значення суттєво покращують придатність. Я оглянув дані, щоб припустити, що омега повинна бути приблизно , оскільки піки виглядали так, що вони були приблизно 20 одиниць.$2 \pi / 20$

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

Залежно від того, яка ваша мета з цим набором даних, ви можете спробувати покращити придатність, додавши додаткові умови або використовуючи непараметричний підхід, як Гауссовий процес з періодичним ядром.

Вибір початкового значення автоматично

Якщо ви хочете вибрати домінуючу частоту, ви можете скористатися швидким перетворенням Фур'є (FFT). Це вихід із моєї області знань, тому я дозволю іншим людям заповнити деталі, якщо вони захочуть (особливо про кроки 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 правильно, що проблема опукла, коли ви знаєте омегу (а може, вам потрібно знати і фі? Я не впевнений). У будь-якому випадку, знання початкових значень для інших параметрів не повинно бути настільки важливим, як для омеги, якщо вони знаходяться в правильному тестовому просторі. Можливо, ви можете отримати гідні оцінки інших параметрів від FFT, але я не впевнений, як це буде працювати.

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

Панрац (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

Сучасні методи, щоб підходити кривій sin до заданого набору даних, потребують першої здогадки параметрів, а потім інтерактивного процесу. Це нелінійна проблема регресії. Інший метод полягає в перетворенні нелінійної регресії в лінійну регресію завдяки зручному інтегральному рівнянню. Тоді немає необхідності в початковій здогадці і немає необхідності в ітераційному процесі: підгонка безпосередньо виходить. У випадку функції 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.scribd.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)