正弦波項をデータに適合させる

私はこの投稿を読みましたが、これを自分のデータに適用する方法がまだわからず、誰かが私を助けてくれることを願っています。

次のデータがあります。

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

そして今、私は単純に正弦波に合わせたい

$$y(t)=A\cdot sin(\omega t+\phi) +C.$$

4つの未知数、\ omega、\ 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の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から他のパラメーターの適切な推定値を取得できますが、どのように機能するかはわかりません。

すでに述べたことの代替として、ARIMAモデルのクラスのAR（2）モデルを使用して、正弦波パターンの予測を生成できることに注意する価値があります。

AR（2）モデルは次のように書くことができます： ここで、は定数、、は推定されるパラメーター、はランダムな衝撃項です。 C ϕ 1 ϕ 2 a

$$\begin{equation} y_{t} = C + \phi_{1}y_{t-1} + \phi_{2}y_{t-2} + a_{t} \end{equation}$$ $C$$\phi_{1}$$\phi_{2}$$a_{t}$

現在、すべてのAR（2）モデルが予測で正弦波パターン（確率的サイクルとも呼ばれます）を生成するわけではありませんが、次の条件が満たされると発生します：

$$\begin{equation} \phi_{1}^{2} + 4 \phi_{2} < 0. \end{equation}$$

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

条件を確認しましょう： で、条件が実際に満たされていることがわかります。

$$\begin{equation} \phi_{1}^{2} + 4 \phi_{2} < 0\\ 1.7347^{2} + 4 (-0.8324) < 0 \\ -0.3202914 < 0 \end{equation}$$

以下のプロットは、元の系列y、ARMA（2,2）モデルの適合、および14のサンプル外予測を示しています。ご覧のとおり、サンプル外の予測は正弦波パターンに従います。

2つの点に留意してください。1）これは非常に迅速な分析（自動化ツールを使用）であり、適切な処理にはBox-Jenkinsの方法論に従うことが含まれます。2）ARIMA予測は短期予測が得意であるため、@ David J. Harrisと@Glen_bの回答のモデルからの長期予測の方が信頼性が高いことがわかります。

最後に、これがすでに非常に有益な回答に追加されることを願っています。

参照：動的回帰モデルによる予測：Alan Pankratz、1991、（John Wiley and Sons、ニューヨーク）、ISBN 0-471-61528-5

与えられたデータセットに正弦曲線を当てはめる現在の方法では、パラメーターの最初の推測が必要で、その後にインタラクティブなプロセスが必要です。これは非線形回帰の問題です。別の方法は、便利な積分方程式のおかげで、非線形回帰を線形回帰に変換することにあります。そうすれば、初期推測や反復プロセスの必要はありません。フィッティングは直接取得されます。関数y = a + r * sin（w * x + phi）またはy = a + b * sin（w * x）+ c * cos（w * x）の場合、論文の35〜36ページを参照してください。 Scribdで公開された「Regression sinusoidale」：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)
}

以下は、最低および最高の時間の時間と温度の値を入力することにより、コサイン関数を使用して1日を通して温度の変動をシミュレートするために使用されます。

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)