2
$\begingroup$

Newbie in Time Series question: I need to do a very simple (I think) regression of a time serie of the type:

$Y_{t}$ = $\sum_{j=1}^{p}b_{j}Y_{t-j}$ + $\sum_{j=1}^{q}c_{j}X_{t-j}$

and I can't figure it out how do it in Mathematica. Unfortunately Mathematica documentation if not clear about this, and so I a bit lost. Does anyone know a good tutorial for Time Series in Mathematica? And how should I start?

EDIT: I also need to calculate a Granger Causality. Is there any implemented method?

EDIT: Here is some data:

Y = {{0, 2.05648}, {1, 2.05648}, {2, 2.05648}, {3, 2.05648}, {4, 2.05648}, {5, 2.05648}, {6, 2.05648}, {7, 2.05648}, {8, 2.05648}, {9, 2.05649}, {10, 2.0565}, {11, 2.05653}, {12, 2.0566}, {13, 2.05681}, {14, 2.05738}, {15, 2.05891}, {16, 2.06304}, {17, 2.07403}, {18, 2.10222}, {19, 2.16834}, {20, 2.29539}, {21, 2.46685}, {22, 2.61407}, {23, 2.69885}, {24, 2.73691}, {25, 2.75207}, {26, 2.75782}, {27, 2.75996}, {28, 2.76075}, {29, 2.76104}, {30, 2.76115}, {31, 2.76119}, {32, 2.7612}}

and

X = {{0, 18}, {1, 19}, {2, 20}, {3, 30}, {4, 19}, {5, 19}, {6, 19}, {7, 17}, {8, 17}, {9, 18}, {10, 20}, {11, 16}, {12, 16}, {13, 16}, {14, 17}, {15, 35}, {16, 30}, {17, 59}, {18, 43}, {19, 39}, {20, 39}, {21, 30}, {22, 27}, {23, 20}, {24, 23}, {25, 33}, {26, 36}, {27, 44}, {28, 61}, {29, 78}, {30, 96}, {31, 100}}

Improve this question
$\endgroup$
4
  • $\begingroup$ Hola @miguel what version of Mathematica are you using? and can you post some data sample and any work you've tried so far? $\endgroup$
    – Zviovich
    Dec 5, 2014 at 21:08
  • $\begingroup$ Hi. I have just upload some data. I'm using Mathematica 9. Well, honestly, I can't show you anything because I'm really lost. I never used to work with Time Series, and so it's my first that I want to use Mathematica for it. $\endgroup$
    – Miguel
    Dec 5, 2014 at 21:24
  • $\begingroup$ See for example forums.wolfram.com/mathgroup/archive/2006/Jan/msg00642.html $\endgroup$
    – Dr. belisarius
    Dec 5, 2014 at 21:31
  • $\begingroup$ The built in functions for time series dont currently handle covariates. I highly recommend looking at RLink since R has some fantastic and very mature time series functionality like the auto.arima function. $\endgroup$
    – Andy Ross
    Dec 6, 2014 at 1:27

1 Answer 1

Reset to default
3
$\begingroup$

Here is an implementation of the regression of the type indicated in the equation.

y = {{0, 2.05648}, {1, 2.05648}, {2, 2.05648}, {3, 2.05648}, {4, 
   2.05648}, {5, 2.05648}, {6, 2.05648}, {7, 2.05648}, {8, 
   2.05648}, {9, 2.05649}, {10, 2.0565}, {11, 2.05653}, {12, 
   2.0566}, {13, 2.05681}, {14, 2.05738}, {15, 2.05891}, {16, 
   2.06304}, {17, 2.07403}, {18, 2.10222}, {19, 2.16834}, {20, 
   2.29539}, {21, 2.46685}, {22, 2.61407}, {23, 2.69885}, {24, 
   2.73691}, {25, 2.75207}, {26, 2.75782}, {27, 2.75996}, {28, 
   2.76075}, {29, 2.76104}, {30, 2.76115}, {31, 2.76119}, {32, 
   2.7612}};
x = {{0, 18}, {1, 19}, {2, 20}, {3, 30}, {4, 19}, {5, 19}, {6, 
   19}, {7, 17}, {8, 17}, {9, 18}, {10, 20}, {11, 16}, {12, 16}, {13, 
   16}, {14, 17}, {15, 35}, {16, 30}, {17, 59}, {18, 43}, {19, 
   39}, {20, 39}, {21, 30}, {22, 27}, {23, 20}, {24, 23}, {25, 
   33}, {26, 36}, {27, 44}, {28, 61}, {29, 78}, {30, 96}, {31, 100}};
xValues = x[[All, 2]];
yValues = y[[All, 2]];

The following function series[x,y,p,q] will allow me to obtain the results of the regression. That is the error between the prediction and the values of the series + the parameters of the regression.

Created several other functions to facilitate the computation of graphs, etc..

    series[x_, y_, p_, q_] := 
     Module[{b = Symbol["b" <> ToString[#]] & /@ Range[p], 
       c = Symbol["c" <> ToString[#]] & /@ Range[q], l = Length@x, 
       min = Min[p, q], fc, sc}, 
      fc = Table[Sum[b[[j]] y[[t - j]], {j, 1, p}], {t, p + 1, l}]; 
      sc = Table[Sum[c[[j]] x[[t - j]], {j, 1, q}], {t, q + 1, l}]; 
      If[p > q, fc = Join[ConstantArray[0, p - q], fc], 
       sc = Join[ConstantArray[0, q - p], sc]]; 
      NMinimize[
       Total[(#[[1]] - #[[2]])^2 & /@ 
         Transpose[{Total /@ Transpose[{fc, sc}], Drop[y, min]}]], 
       Join[b, c], Reals]]
seriesValues[x_, y_, p_, q_] := 
 Module[{b = Symbol["b" <> ToString[#]] & /@ Range[p], 
   c = Symbol["c" <> ToString[#]] & /@ Range[q], l = Length@x, 
   min = Min[p, q], fc, sc}, 
  fc = Table[Sum[b[[j]] y[[t - j]], {j, 1, p}], {t, p + 1, l}]; 
  sc = Table[Sum[c[[j]] x[[t - j]], {j, 1, q}], {t, q + 1, l}]; 
  If[p > q, fc = Join[ConstantArray[0, p - q], fc], 
   sc = Join[ConstantArray[0, q - p], sc]]; 
  Last@NMinimize[
    Total[(#[[1]] - #[[2]])^2 & /@ 
      Transpose[{Total /@ Transpose[{fc, sc}], Drop[y, min]}]], 
    Join[b, c], Reals]]
seriesPrediction[x_, y_, p_, q_] := 
 Module[{b = Symbol["b" <> ToString[#]] & /@ Range[p], 
   c = Symbol["c" <> ToString[#]] & /@ Range[q], l = Length@x, 
   min = Min[p, q], fc, sc}, 
  fc = Table[Sum[b[[j]] y[[t - j]], {j, 1, p}], {t, p + 1, l}]; 
  sc = Table[Sum[c[[j]] x[[t - j]], {j, 1, q}], {t, q + 1, l}]; 
  If[p > q, fc = Join[ConstantArray[0, p - q], fc], 
   sc = Join[ConstantArray[0, q - p], sc]]; 
  Total /@ Transpose[{fc, sc}]]

Explore different alternatives

Flatten[Table[{series[xValues, Most@yValues, i, j], i, j}, {i, 1, 
    8}, {j, 1, 8}], 1] // Sort
(*{{{0.000245998, {b1 -> 3.84299, b2 -> -6.85701, b3 -> 8.38577, 
    b4 -> -8.01898, b5 -> 6.28504, b6 -> -3.97163, b7 -> 1.67097, 
    b8 -> -0.324682, c1 -> -0.000407285, c2 -> 0.000414386, 
    c3 -> 0.000725565, c4 -> -0.000600485, c5 -> -0.000876084, 
    c6 -> -0.000100851, c7 -> -0.000505129, c8 -> 0.000108438}}, 8, 
  8}, {{0.000288402, {b1 -> 3.48744, b2 -> -5.66612, b3 -> 6.38801, 
    b4 -> -5.55299, b5 -> 3.8124, b6 -> -1.97005, b7 -> 0.514932, 
    c1 -> -0.0003576, c2 -> 0.000292707, c3 -> 0.000799256, 
    c4 -> -0.000233652, c5 -> -0.000873094, c6 -> -0.00036767, 
    c7 -> -0.000579723}}, 7, 7},...8*)

best = %[[All, 2 ;;]]
g = ListPlot[
     Evaluate[{seriesPrediction[xValues, 
         Most@yValues, #[[1]], #[[2]]] /. 
        seriesValues[xValues, Most@yValues, #[[1]], #[[2]]], 
       Drop[yValues, Min[#[[1]], #[[2]]] + 1]}], 
     Joined -> {True, False}, 
     PlotLabel -> 
      StringJoin["p=", ToString[#[[1]]], ", q=", 
       ToString[#[[2]]]]] & /@ best;
Grid[Partition[g, 4]]

enter image description here

You can implement the Granger Causality following @belisarius lead.

Improve this answer
$\endgroup$
1
  • $\begingroup$ Hi and Thanks very much! It is exactly what I was looking for. Thanks! $\endgroup$
    – Miguel
    Dec 7, 2014 at 0:25

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.