Adatta un termine sinusoidale ai dati

Anche se ho letto questo post, non ho ancora idea di come applicare questo ai miei dati e spero che qualcuno mi possa aiutare.

Ho i seguenti dati:

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

E ora voglio semplicemente montare un'onda sinusoidale

con le quattro incognite , , e ad esso.ω ϕ $A$$\omega$$\phi$$C$

Il resto del mio codice è il seguente

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")

Ma il risultato è davvero scarso.

Gradirei molto qualsiasi aiuto.

Saluti.

Se vuoi solo una buona stima di e non ti interessa molto del suo errore standard:$\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

(Un adattamento migliore potrebbe forse spiegare in qualche modo gli outlier di quella serie, riducendo la loro influenza.)

---

Se vuoi avere un'idea dell'incertezza in , potresti usare la verosimiglianza del profilo ( pdf1 , pdf2 - riferimenti su come ottenere CI o SE approssimativi dalla verosimiglianza del profilo o le sue varianti non sono difficili da individuare)$\omega$

(In alternativa, puoi inserire queste stime in nls ... e avviarle già convergenti.)

Come suggerito da @Stefan, diversi valori iniziali sembrano migliorare drasticamente l'adattamento. Ho osservato i dati per suggerire che gli omega dovrebbero essere circa , poiché i picchi sembravano distanti circa 20 unità.$2 \pi / 20$

Quando ho messo che in nls's startlist, ho avuto una curva che era molto più ragionevole, anche se ha ancora alcune distorsioni sistematiche.

A seconda di quale sia il tuo obiettivo con questo set di dati, potresti provare a migliorare l'adattamento aggiungendo termini aggiuntivi o usando un approccio non parametrico come un processo gaussiano con un kernel periodico.

Scelta automatica di un valore iniziale

Se vuoi scegliere la frequenza dominante, puoi usare una trasformata di Fourier veloce (FFT). Questo è fuori dalla mia area di competenza, quindi permetterò ad altre persone di inserire i dettagli se lo desiderano (specialmente sui passaggi 2 e 3), ma il Rcodice qui sotto dovrebbe funzionare.

# 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)

Puoi anche tracciare abs(truncated.fft)per vedere se ci sono altre frequenze importanti, ma dovrai giocherellare un po 'con il ridimensionamento dell'asse x.

Inoltre, credo che @Glen_b abbia ragione nel dire che il problema è convesso quando conosci Omega (o forse devi conoscere anche il phi? Non ne sono sicuro). In ogni caso, conoscere i valori di partenza per gli altri parametri non dovrebbe essere così importante come per omega se si trovano nel campo giusto. Probabilmente potresti ottenere stime decenti degli altri parametri dalla FFT, ma non sono sicuro di come funzionerebbe.

In alternativa a quanto è già stato detto, può valere la pena notare che un modello AR (2) della classe dei modelli ARIMA può essere utilizzato per generare previsioni con uno schema sinusoidale.

Un modello AR (2) può essere scritto come segue: dove è una costante, , sono parametri da stimare e è un termine di shock casuale. C ϕ 1 ϕ 2 a

Ora, non tutti i modelli AR (2) producono schemi di onde sinusoidali (noti anche come cicli stocastici ) nelle loro previsioni, ma ciò accade quando viene soddisfatta la seguente condizione:

Panratz (1991) ci dice quanto segue sui cicli stocastici:

Un modello di ciclo stocastico può essere pensato a un modello di onda sinusoidale distorto nel modello di previsione: è un'onda sinusoidale con un periodo stocastico (probabilistico), ampiezza e angolo di fase.

Per vedere se un tale modello potesse essere adattato ai dati ho usato la auto.arima()funzione del pacchetto di previsione per scoprire se avrebbe suggerito un modello AR (2). Si scopre che la auto.arima()funzione suggerisce un modello ARMA (2,2); non un modello AR (2) puro, ma va bene. Va bene perché un modello ARMA (2,2) contiene un componente AR (2), quindi si applica la stessa regola (sui cicli stocastici). Cioè, possiamo ancora verificare la suddetta condizione per vedere se verranno prodotte le previsioni sinusoidali.

I risultati di auto.arima(y)sono mostrati di seguito.

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

Ora controlliamo la condizione: e scopriamo che la condizione è effettivamente soddisfatta.

La trama seguente mostra la serie originale, y, l'adattamento del modello ARMA (2,2) e 14 previsioni fuori campione. Come si può vedere, le previsioni fuori campione seguono uno schema sinusoidale.

Tieni a mente due cose. 1) Questa è solo un'analisi molto rapida (usando uno strumento automatizzato) e un trattamento adeguato implicherebbe la metodologia Box-Jenkins. 2) Le previsioni ARIMA sono buone per le previsioni a breve termine, quindi potresti trovare che le previsioni a lungo termine dai modelli nelle risposte di @David J. Harris e @Glen_b siano più affidabili.

Infine, si spera che questa sia una bella aggiunta ad alcune risposte già molto istruttive.

Riferimento : previsione con modelli di regressione dinamica: Alan Pankratz, 1991, (John Wiley and Sons, New York), ISBN 0-471-61528-5

Gli attuali metodi per adattare una curva sin a un determinato set di dati richiedono una prima ipotesi dei parametri, seguita da un processo interattivo. Questo è un problema di regressione non lineare. Un metodo diverso consiste nel trasformare la regressione non lineare in regressione lineare grazie a una comoda equazione integrale. Quindi, non sono necessarie ipotesi iniziali e non è necessario un processo iterativo: il raccordo viene ottenuto direttamente. Nel caso della funzione y = a + r * sin (w * x + phi) o y = a + b * sin (w * x) + c * cos (w * x), vedere le pagine 35-36 del documento "Régression sinusoidale" pubblicato su Scribd: http://www.scribd.com/JJacquelin/documents Nel caso della funzione y = a + p * x + r * sin (w * x + phi): pagine 49-51 del capitolo "Regressione mista lineare e sinusoidale". In caso di funzioni più complicate, il processo generale è spiegato nel capitolo "Regressione sinusoidale generalizzata" pagine 54-61, seguito da un esempio numerico y = r * sin (w * x + phi) + (b / x) + c * ln (x), pagine 62-63

Se conosci il punto più basso e più alto dei tuoi dati di aspetto del coseno, puoi utilizzare questa semplice funzione per calcolare tutti i coefficienti di coseno:

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)
}

Di seguito viene utilizzato per simulare la variazione di temperatura durante il giorno con una funzione coseno, immettendo le ore e i valori di temperatura per l'ora più bassa e più calda:

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")

L'output è inferiore:

Un'altra opzione sta usando la funzione generica optim o nls. Ho provato che nessuno dei due è completamente robusto

Le seguenti funzioni prendono i dati in y e calcolano i parametri.

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])

l'uso è il seguente:

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)

Il codice seguente confronta i dati

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)