Optimal exponential smoothing: Why is NMinimize so slow?

Questions
, , ,
1

Hello, I apply the exponential smoothing technique to some time series and would like to calculate the optimum smoothing constant (a) that minimize the in-sample sum-of-squared forecast errors with Mathematica. Unfortunately, this takes forever in Mathematica.
For the exponential smoothing technique please refer to e.g. Exponential smoothing - Wikipedia

Let’s use some random GBM data

data = RandomFunction[
    GeometricBrownianMotionProcess[0.01, 0.1, 100], {1, 100, 1}][
   "ValueList"][[1]];

Calculate simple returns

returns = Differences[data]/Drop[data, -1];

Apply the exponential smoothing technique (with constant a)

smooth = ExponentialMovingAverage[returns, a];

And use NMinimize to search for the a that minimizes the “forecast error”:

NMinimize[Total[(Drop[returns, 1] - Drop[smooth, -1])^2], 
  a]

With my machine and Mathematica 10.0.1 this takes approximately 16 seconds, i.e. an eternity. If I do the same in R or Excel this takes a miniscule amount of time.
I have the feeling that NMinimize is slow because it takes much time to evaluate the symbolic smooth expression.
What am I doing wrong? Is there a way to speed things up? Any hints would be appreciated.

Thanks,
Michael

2

smooths = Simplify[smooth];

NMinimize[Total[(Drop[returns, 1] - Drop[smooths, -1])^2], a]

takes a little less than two seconds on my computer, compared to 15 seconds using smooth.

3

Thanks for looking into this Frank! I also thought about Simplify before, but unfortunately it doesn’t scale. If you generate a path of length 1,000 then

Simplify[smooth]

takes forever (I aborted the evaluation). And a time series sample of size 1,000 isn’t even large (approx. 1 day of 1 minute bars)… Do you have any other ideas?

4

Define the objective so that it only exists for explicit numeric values of a. Can be done like this.

data = RandomFunction[
     GeometricBrownianMotionProcess[0.01, 0.1, 100], {1, 100, 1}][
    "ValueList"][[1]];
returns = Differences[data]/Drop[data, -1]
Clear[smooth];
smooth[a_] := ExponentialMovingAverage[returns, a]
ff[a_?NumberQ] := Total[(Drop[returns, 1] - Drop[smooth[a], -1])^2]

Now NMinimize is notably faster.

Timing[NMinimize[ff[a], a]]

Out[659]= {1.824000, {0.892557135365, {a -> 0.085192215858}}}

FindMinimum is faster still, by nearly two orders of magnitude.

Timing[FindMinimum[ff[a], {a, 0}]]

Out[660]= {0.040000, {0.892557135365, {a -> 0.0851922052551}}}
5

Thanks a lot Daniel! This seems to work like a charm (also in more difficult contexts).