1. 技术文章
  2. Do a nonlinear least square (nls) fit for a sinusoidal model

Do a nonlinear least square (nls) fit for a sinusoidal model

由 妖精的绣舞 提交于 2019-12-03 14:53:48
Roland

First I replaced all "," in your data with "." (alternatively you could use the dec argument of read.table), then I removed rows with less elements (those in the end) and created a proper header.

Then I read in your data using data <- read.table(text="<paste the cleaned data here>", header=TRUE).

Then I did this:

values<-data[,3]
T <-data[,1]

r<-nls(values~C+alpha*sin(W*T+phi), 
       start=list(C=8958.34, alpha=115.886, W=0.0652, phi=14.9286))
summary(r)

And got this:

Formula: values ~ C + alpha * sin(W * T + phi)

Parameters:
       Estimate Std. Error  t value Pr(>|t|)    
C     8.959e+03  3.892e+00 2302.173  < 2e-16 ***
alpha 2.214e+01  5.470e+00    4.047 6.16e-05 ***
W     6.714e-02  2.031e-03   33.065  < 2e-16 ***
phi   1.334e+01  5.113e-01   26.092  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 80.02 on 423 degrees of freedom

Number of iterations to convergence: 21 
Achieved convergence tolerance: 5.952e-06

Then I plotted:

plot(values~T)
lines(predict(r)~T)

And got this:

Then I read this: https://stats.stackexchange.com/a/60997/11849

And did this:

raw.fft = fft(values)
truncated.fft = raw.fft[seq(1, length(values)/2 - 1)]
truncated.fft[1] = 0
W = which.max(abs(truncated.fft)) * 2 * pi / length(values)

r2<-nls(values~C+alpha*sin(W*T+phi), start=list(C=8958.34, alpha=115.886, W=W, phi=0))

lines(predict(r2)~T, col="red")  

summary(r2)

And got this:

And this:

Formula: values ~ C + alpha * sin(W * T + phi)

Parameters:
       Estimate Std. Error t value Pr(>|t|)    
C     8.958e+03  2.045e-01 43804.2   <2e-16 ***
alpha 1.160e+02  2.913e-01   398.0   <2e-16 ***
W     4.584e-02  1.954e-05  2345.6   <2e-16 ***
phi   2.325e+00  4.760e-03   488.5   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 4.204 on 423 degrees of freedom

Number of iterations to convergence: 9 
Achieved convergence tolerance: 1.07e-06

PS: Please note that it is an extremely bad idea to call a variable T. T is an alias for TRUE in R.

That kind of problem is plagued by local extrema. By expanding the sine, you can rewrite the model as 

C + alpha * sin(omega*T) + beta * cos(omega*T)

There is only one non-linear parameter left and you can use a grid search (or some robust optimization algorithm) on that parameter (and linear regression for the others).

d <- read.table( "tmp.csv", dec=",", header=TRUE, nrows=400)
x <- d[,1]
y <- d[,3]

f <- function( omega ) { 
  x1 <- sin( omega * x )
  x2 <- cos( omega * x )
  r <- lm( y ~ x1 + x2 )
  res <- mean( residuals(r)^2 )
  attr( res, "coef" ) <- coef(r)
  res
}
omegas <- seq( .001, .2, length=1000 )
res <- sapply(omegas, f)
plot( 
  omegas, res,
  las=1, 
  ylab = "Residuals", xlab = "Omega",
  main = "Objective function: multiple local minima" 
)


i <- which.min( res )
omega0 <- optimize(f, interval = c(omegas[i-1], omegas[i+1]))$minimum
p <- c( attr( f(omega0), "coef" ), omega0 )
plot( x, y )
lines( 
  x, 
  p[1] + p[2] * sin( p[4] * x ) + p[3] * cos( p[4] * x ),
  col = "orange", lwd=3 
)

标签
r
nls
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!