NLS And Log-Periodic Power Law (LPPL) in R

Question

This is the most challenging thing I have done in R so far in that both nls and LPPL are fairly new to me.

Below is a portion of script I have been working with. df

Answer 1

First, a couple of minor things:

1. Both nls(...) and nls.lm(...) require numeric arguments, not dates. So you have to convert somehow. I just added a days column that is the number of days since the start of your data.
2. Your equation for F is different from Eqn. 1 in the reference, so I changed it to align.

*

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

Now for the major issue: Your starting estimates are such that the LM regression fails to converge. As a result, the values in nls.out$par are not stable estimates. When you use these as the starting point for nls(...), that fails as well:

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.

Generally, you should look to nls.out$status and nls.out$message to see what happened.

You have a complex model with 7 parameters. Unfortunately this leads to a situation where the regression has many local minima. Consequently, even if you provide estimates which lead to convergence, they might not be "useful". Consider:

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

This is a stable result (local minimum), but c is so small compared to b that the oscillations are invisible. On the other hand, these starting estimates produce a fit which matched the reference fairly closely:

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

This does produce parameter estimates which lead to convergence with nls(...), but the summary shows that the parameters are poorly estimated (only tc and omeega have 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)

Finally, using starting estimates very close the the reference (which admittedly is modeling the Great Depression, not the Great recession), gives a result which is even better:

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