Decomposition of a time series into sinusoids

4

2

I've noticed this interesting study on metatrader 4; see the picture below:

Where the financial timeseries is "decomposed" (deconvolved?) into a series of periodic sinusoidal functions. In the picture above the red line is the sum of three vectors (the two green and dark green/black) sinusoidal function.

I've looked into FourierDST and spectral analytical functions of Mathematica but wasn't able to approach this problem, could you please provide me me some pointers?

There are several ways to do this. If you have the data displayed, please share it. Otherwise, I will take some similar financial time series from FinancialData.

– Anton Antonov – 2019-04-14T19:03:51.137

2

Might this be Empirical Mode Decomposition? See https://mathematica.stackexchange.com/questions/28724/hilbert-huang-transform-package

– mikado – 2019-04-14T20:01:02.147

@mikado I tried the Empirical Mode Decomposition (EMD), did not get good results -- see my answer. (I have to say I did not try that hard to get better results with EMD...) – Anton Antonov – 2019-04-15T13:51:05.087

4

Applying Empirical Mode Decomposition

As suggested by @mikado in the comments:

Might this be Empirical Mode Decomposition? See mathematica.stackexchange.com/questions/28724/….

Does not work that well over the data obtained in the next section. (A good suggestion nevertheless.)

Extracting Sin/Cos terms with Quantile Regression

Not a full answer, because I am not sure is this what OP wants. If it is then I will elaborate... First, I used data obtained with FinancialData:

ts2 = FinancialData["EUROX", {{2015, 7, 1}, {2017, 1, 1}, "Day"}];
DateListPlot[ts2, PlotTheme -> "Detailed", AspectRatio -> 1/4, ImageSize -> 800]


Next, I followed the procedure described in this answer.

I derived/selected these curves:

Here are the corresponding terms:

The code

Import["https://raw.githubusercontent.com/antononcube/\

ts2 = FinancialData["EUROX", {{2015, 7, 1}, {2017, 1, 1}, "Day"}];
DateListPlot[ts2, PlotTheme -> "Detailed", AspectRatio -> 1/4,
ImageSize -> 800]

ts2 = QRMonUnit[ts2]⟹QRMonTakeData;

bFuncs = Prepend[
Flatten[Table[{Sin[b + h x], Cos[b + h x]}, {h, 1, 100, 1}, {b, 0, 1, 0.5}]], 1];
Length[bFuncs]

(* 601 *)

AbsoluteTiming[
qrObj2 =
QRMonUnit[ts2]⟹
QRMonRescale⟹
QRMonQuantileRegressionFit[bFuncs, 0.5]⟹
QRMonSetRegressionFunctionsPlotOptions[PlotStyle -> Red]⟹
QRMonPlot[PlotTheme -> "Detailed", AspectRatio -> 1/4, ImageSize -> Large];
]

(* {24.2521, Null} *)

qFunc2 = (qrObj2⟹QRMonTakeRegressionFunctions)[0.5][t];

terms = Cases[qFunc2, (f_?NumberQ*c_) :> {f, c}];
TakeLargestBy[terms, Abs@*First, 6]
ListPlot[terms[[All, 1]], PlotRange -> All, Filling -> Axis, PlotTheme -> "Scientific"]

(* {{15.1087, Sin[0. + t]}, {6.00884, Cos[1. + 3 t]}, {1.95579,
Sin[0. + 5 t]}, {0.875732, Cos[1. + 9 t]}, {0.549675,
Sin[0. + 11 t]}, {0.311493, Cos[1. + 21 t]}} *)


Re-do the fit with a more informed basis

largestTerms = TakeLargestBy[terms, First, 7]

(* {{15.1087, Sin[0. + t]}, {6.00884, Cos[1. + 3 t]}, {1.95579,
Sin[0. + 5 t]}, {0.875732, Cos[1. + 9 t]}, {0.549675,
Sin[0. + 11 t]}, {0.311493, Cos[1. + 21 t]}, {0.218136, Sin[0. + 18 t]}} *)

terms = SortBy[terms, -Abs[#[[1]]] &];

spans = {Span[1, 3], Span[4, 8], Span[9, 50]};
res =
Function[{terms, span},
QRMonUnit[ts2]⟹
QRMonRescale[Axes -> {True, False}]⟹
QRMonQuantileRegressionFit[Prepend[terms[[All, 2]], 1], 0.5]⟹
QRMonSetRegressionFunctionsPlotOptions[PlotStyle -> Red]⟹
QRMonPlot[PlotTheme -> "Detailed", AspectRatio -> 1/4, ImageSize -> Large, PlotLabel -> Row[{"span: ", span}]]⟹
QRMonTakeRegressionFunctions
],
{terms[[#]] & /@ spans, spans}
];

Block[{data = ts2, rData = qrObj2⟹QRMonTakeData, lines, rFunc},
rFunc = Rescale[x, {0, 1}, MinMax[data[[All, 1]]]];
lines = Outer[{rFunc /. x -> #2, #1[#2]} &, res[[All, 1]], rData[[All, 1]]];
Show[{
DateListPlot[data, PlotStyle -> {GrayLevel[0.3]},
PlotTheme -> "Detailed"],
ListLinePlot[lines, PlotRange -> All,
PlotStyle -> {Thickness[0.004]},
PlotLegends -> Map[Row[{"terms: ", #}] &, spans]]},
ImageSize -> 800, AspectRatio -> 1/4
]]

GridTableForm[
Map[{#, Simplify[
terms[[#]][[All, 2]] /.
t -> Rescale[t, MinMax[ts2[[All, 1]]], {0, 1}]]} &, spans],
TableHeadings -> {"span", "terms"}]


Spot on, please share the code. – Jerome Ibanes – 2019-04-15T23:41:19.553

@JeromeIbanes Just posted the code -- tell me if you have any problems running it or you need more explanations. – Anton Antonov – 2019-04-16T02:17:53.610

I seem to be getting quite different results, please review below:

[https://www.eskimo.com/~jibanes/tmp/aa.pdf]. – Jerome Ibanes – 2019-04-16T02:43:31.617

@JeromeIbanes The data is not ingested properly. Try to replace ts2 with a simple array with two numerical columns. Which Mathematica version are you using? – Anton Antonov – 2019-04-16T07:50:35.260

Thank you Anton! – Jerome Ibanes – 2019-04-17T00:51:14.097