Question

到目前为止，这是我在R中所做的最具挑战性的事情，因为nls和LPPL对我来说都是新手。

以下是我一直在使用的脚本的一部分。 df是一个由两列组成的数据框，Date和Y，它们是S＆amp; P 500的收盘价。我不确定它是否相关，但日期从01-01-2003到12-31-开始 - 2007。

f <- function(pars, xx) {pars$a + pars$b*(pars$tc - xx)^pars$m * 
                    (1 + pars$c * cos(pars$omega*log(pars$tc - xx) + pars$phi))} 
# residual function
resids <- function(p, observed, xx) {df$Y - f(p,xx)}
# fit using Levenberg-Marquardt algorithm
nls.out <- nls.lm(par=list(a=1,b=-1,tc=5000, m=0.5, omega=1, phi=1, c=1 ), fn = resids, 
              observed = df$Y, xx = df$days)
# use output of L-M algorithm as starting estimates in nls(...)
par <- nls.out$par

nls.final <- nls(Y~a+b*(tc-days)^m * (1 + c * cos(omega * log(tc-days) + phi)),data=df, 
             start=c(a=par$a, b=par$b, tc=par$tc, m=par$m, omega=par$omega, phi=par$phi,         c=par$c))
summary(nls.final) # display statistics of the fit 
# append fitted values to df
df$pred <- predict(nls.final)

运行时，我收到以下消息：

Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates
In addition: Warning messages:
1: In log(pars$tc - xx) : NaNs produced
2: In log(pars$tc - xx) : NaNs produced

LPPL的公式可以在这个pdf文件的第5个屏幕上找到，http://www.chronostraders.com/wp-content/uploads/2013/08/Research_on_LPPL.pdf

你知道我哪里错了吗？这对于不同的模型正常工作，我更改了新方程的代码。感谢jlhoward发布此帖子的代码Using nls in R to re-create research。

感谢您的帮助。

根据jlhoward的评论，df.rda可以在这里下载：https://drive.google.com/file/d/0B4xAKSwsHiEBb2lvQWR6T3NzUjA/edit?usp=sharing

Answer 1

首先，一些小事：

nls(...)和nls.lm(...)都需要数字参数，而不是日期。所以你必须以某种方式转换。我刚刚添加了一个days列，它是自数据开始以来的天数。
你的F等式与等式不同。参考文献中有1个，所以我将其更改为对齐。

*

f <- function(pars, xx) 
         with(pars,(a + (tc - xx)^m * (b + c * cos(omega*log(tc - xx) + phi))))

现在主要问题是：你的起始估计是LM回归无法收敛。因此，nls.out$par中的值不是稳定的估算值。当您使用这些作为nls(...)的起点时，也会失败：

nls.out <- nls.lm(par=list(a=1,b=-1,tc=5000, m=0.5, omega=1, phi=1, c=1 ),
                  fn = resids, observed = df$Y, xx = df$days)
# Warning messages:
# 1: In log(pars$tc - xx) : NaNs produced
# 2: In log(pars$tc - xx) : NaNs produced
# ...
# 7: In nls.lm(par = list(a = 1, b = -1, tc = 5000, m = 0.5, omega = 1,  :
#   lmdif: info = -1. Number of iterations has reached `maxiter' == 50.

通常，您应该查看nls.out$status和nls.out$message以查看发生的情况。

你有一个包含7个参数的复杂模型。不幸的是，这导致回归具有许多局部最小值的情况。因此，即使您提供导致收敛的估计，它们也可能不是“有用的”。考虑：

nls.out <- nls.lm(par=list(a=1,b=1,tc=2000, m=-1, omega=1, phi=1, c=1 ), 
                  fn = resids, observed = df$Y, xx = df$days, 
                  control=nls.lm.control(maxiter=10000, ftol=1e-6, maxfev=1e6))
par <- nls.out$par
par
plot(df$Date,df$Y,type="l")
lines(df$Date,f(par,df$days))

这是一个稳定的结果（局部最小值），但c与b相比，振荡是不可见的。另一方面，这些起始估计产生了与参考相当匹配的拟合：

nls.out <- nls.lm(par=list(a=0,b=1000,tc=2000, m=-1, omega=10, phi=1, c=200 ), 
                  fn = resids, observed = df$Y, xx = df$days, 
                  control=nls.lm.control(maxiter=10000, ftol=1e-6, maxfev=1e6))

这确实产生了导致与nls(...)收敛的参数估计，但摘要显示参数估计不佳（仅tc和omeega具有p < 0.05）。

nls.final <- nls(Y~a+(tc-days)^m * (b + c * cos(omega * log(tc-days) + phi)),
                 data=df, start=par, algorithm="plinear",
                 control=nls.control(maxiter=1000, minFactor=1e-8))
summary(nls.final)

最后，使用起始估计非常接近的参考（无可否认地模拟了大萧条，而不是大衰退），给出了更好的结果：

nls.out <- nls.lm(par=list(a=600,b=-266,tc=3000, m=.5,omega=7.8,phi=-4,c=-14), 
                  fn = resids, observed = df$Y, xx = df$days, 
                  control=nls.lm.control(maxiter=10000, ftol=1e-6, maxfev=1e6))

R中的NLS和对数周期幂律（LPPL）

1 个答案: