MA(1) Parameter Estimates Comparison

Purpose

Compare the exact MLE estimate with Faster and Durbin for MA(1).

Initialization

<< FitARMA.m

Off[General::spell1, General::spell]

SDRelativeEfficiencyYvsX[X_List, Y_List] := 
      Module[
{μx = Mean[X], μy = 
            Mean[Y], σx, σy, σxy}, 
σx = Mean[(X - μx)^2]; 
σy = 
          Mean[(Y - μy)^2]; 
σxy = 
          Mean[(X - μx)*(Y - μy)]; 
e = μx/μy; 
Sqrt[(σx/μy^2 + (σy*μx^2)/μy^4 - (2*σxy*μx)/μy^3)/
            Length[X]]
]

On[General::spell1, General::spell]

ps = {10, 30}; ns = {50, 100, 200}; 
    ts = {-0.9, -0.6, -0.3, 0.0, 0.3, 0.6, 0.9};

ps = {10, 30}; ns = {50, 100, 200}; 
    ts = {-1.0, -0.9, -0.6, -0.3, 0.0, 0.3, 0.6, 0.9,  
        1.0};

MA1Durbin[z_,  p_] := 
      Module[{phis}, 
phis = 
          Prepend[-ARCoefficients /. 
              PacfDL[Sacvf[z,  MaxLag -> p], 
                LinearPredictor -> True], 1]; 
Total[
            Drop[phis, 1]*Drop[phis, -1]]/
          Total[phis^2]
]

simma1[ n_,  p_,  theta1_] := 
      Module[{z, t1, t2, t3, v = b = {0, 0, 0}}, 
z = 
          SimulateGaussianARMA[{}, {theta1}, n]; 
t1 = 
          MA1Fit[z]; 
t2 = GetARMAFit[0, 1, p, z] // 
              Flatten // Last; 
t3 = 
          MA1Durbin[z,  p]; 
{t1, t2, t3} - 
          theta1
]

simma1[50, 10, 0.0]

Final Simulation

NSIM = 1000;
ansDurbin = 
        Array[0 &,  {Length[ns], Length[ps], Length[ts],  
            NSIM}];
ansMLE = ansFaster = ansDurbin; SetSeed[32117];

t0 = TimeUsed[];
\(Timing[
Do[
        k = 0; 
While[
          k < NSIM, 
ans = 
            simma1[ns[[i1]], 
              ps[[i2]], 
              ts[[
                i3]]]; 
If[
            And @@ \((NumericQ /@ ans)\), \(k++\), 
            Print["Warning! skipping non-numeric", ans]; 
            Continue]; 
ansMLE[[i1, i2, 
              i3, k]] = 
            ans[[1]]; 
ansFaster[[i1, i2, i3, 
              k]] = 
            ans[[2]]; 
ansDurbin[[i1, i2, i3, 
              k]] = 
            ans[[3]];
]; 
If[i3 == Length[ts], 
          Print["Completed: {n,p} = ", {ns[[
                i1]], 
              ps[[i2]]}, \ " at ", \ 
            TimeUsed[] - t0]];
, {i1, Length[ns]}, {i2, 
          Length[ps]}, {i3, 
          Length[ts]}
]
]\)

First[%]/ 3600 Hour/Second

Save["d:/math/2007/faster/Durbin/SimData.m", {ansMLE, ansFaster, 
        ansDurbin}]

Input Simulation and Tabulate Results

Get["d:/math/2007/faster/Durbin/SimData.m"];

ps = {10, 30}; ns = {50, 100, 200}; NSIM = 100;

ts = {-1, -0.9, -0.6, -0.3, 0.0, 0.3, 0.6, 0.9,  
          1};

\(tr = 
      Table[StyleForm[
          StringForm[\*""\!\(θ\_1\)=``"", 
            NumberForm[ts[[j]], 1]], 
          FontColor -> RGBColor[0, 0, 1]], {j, Length[ts]}]\)

tc = 
      Table[StyleForm[
          StringForm["n=``", 
            NumberForm[ns[[j]], 0]], 
          FontColor -> RGBColor[0, 0, 1]], {j, Length[ns]}]

Basic Bias Computations

tbMLE = Map[Mean, ansMLE, {3}];
tbFaster = Map[Mean, ansFaster, {3}];
tbDurbin = Map[Mean, ansDurbin, {3}];

tbMLE10 = Transpose[
            tbMLE, {2, 1, 
              3}][[1]];
tbMLE30 = Transpose[
            tbMLE, {2, 1, 
              3}][[2]];
tbFaster10 = Transpose[
            tbFaster, {2, 1, 
              3}][[1]];
tbFaster30 = Transpose[
            tbFaster, {2, 1, 
              3}][[2]];
tbDurbin10 = Transpose[
            tbDurbin, {2, 1, 
              3}][[1]];
tbDurbin30 = Transpose[
            tbDurbin, {2, 1, 
              3}][[2]];

n = 10, Bias

tb = Transpose[{tbMLE10, tbFaster10, tbDurbin10}, {2, 3, 1}]

TableForm[Map[NumberForm[#, 3] &, tb, {3}], 
      TableDepth -> 2]

TableForm[Map[NumberForm[#, 3] &, tb, {3}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

p = 30, Bias

tb = Transpose[{tbMLE30, tbFaster30, tbDurbin30}, {2, 3, 1}]

TableForm[Map[NumberForm[#, 3] &, tb, {3}], 
      TableDepth -> 2]

TableForm[Map[NumberForm[#, 3] &, tb, {3}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

Basic MSE Computations

tbMLE = Map[Mean, ansMLE^2, {3}];
tbFaster = Map[Mean, ansFaster^2, {3}];
tbDurbin = Map[Mean, ansDurbin^2, {3}];

tbMLE10 = Transpose[
            tbMLE, {2, 1, 
              3}][[1]];
tbMLE30 = Transpose[
            tbMLE, {2, 1, 
              3}][[2]];
tbFaster10 = Transpose[
            tbFaster, {2, 1, 
              3}][[1]];
tbFaster30 = Transpose[
            tbFaster, {2, 1, 
              3}][[2]];
tbDurbin10 = Transpose[
            tbDurbin, {2, 1, 
              3}][[1]];
tbDurbin30 = Transpose[
            tbDurbin, {2, 1, 
              3}][[2]];

SD For Efficiency Ratios

X = ansMLE^2; Y = ansFaster^2; 
    sdFaster = Array[0 &, {3, 2, Length[ts]}]; 
    sdDurbin = sdFaster;

Dimensions[X]

Do[sdFaster[[i, j, k]] = 
        SDRelativeEfficiencyYvsX[
          X[[i, j, k]], 
          Y[[i, j, k]]], {i, 3}, {j, 
        2}, {k, Length[ts]}]

Y = ansDurbin^2;

Do[sdDurbin[[i, j, k]] = 
        SDRelativeEfficiencyYvsX[
          X[[i, j, k]], 
          Y[[i, j, k]]], {i, 3}, {j, 
        2}, {k, Length[ts]}]

sdFaster10 = Transpose[
            sdFaster, {2, 1, 
              3}][[1]];
sdFaster30 = Transpose[
            sdFaster, {2, 1, 
              3}][[2]];
sdDurbin10 = Transpose[
            sdDurbin, {2, 1, 
              3}][[1]];
sdDurbin30 = Transpose[
            sdDurbin, {2, 1, 
              3}][[2]];

Efficiency Ratio, p=10

tb = 
      Transpose[{tbMLE10/tbFaster10, tbMLE10/tbDurbin10}, {3, 2, 
          1}]

TableForm[Map[NumberForm[#, 3] &, tb, {2}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

Graphical Comparison

\(\(flab = \((StyleForm[#1, FontWeight -> "Bold", 
                FontSize -> 
                  10] &)\) /@ {\*""(Subscript[θ, 1])"", \ "Relative Efficiency"};\)\)

sd = Transpose[{sdFaster10, sdDurbin10}, {3, 2, 1}]

TableForm[Map[NumberForm[#, 3] &, sd, {2}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

(tb2 = Transpose[tb, {3, 2, 1}]) // Dimensions

(sd2 = Transpose[sd, {3, 2, 1}]) // Dimensions;

eps = 0.02; epi10 = {0, 0, 0};
\(Do[
\(epi10[[
            j]] = {AbsoluteThickness[
                3], {RGBColor[0, 0, 1], 
                Line /@ Transpose[
                    Transpose /@ {{ts - eps, 
                          tb2[[1, j]] - 
                            1.96*sd2[[1, 
                                j]]}, {ts - eps, 
                          tb2[[1, j]] + 
                            1.96*sd2[[1, 
                                j]]}}]}, 
{RGBColor[1, 0, 1], 
                Line /@ Transpose[
                    Transpose /@ {{ts + eps, 
                          tb2[[2, j]] - 
                            1.96*sd2[[2, 
                                j]]}, {ts + eps, 
                          tb2[[2, j]] + 
                            1.96*sd2[[2, 
                                j]]}}]}, 
{AbsoluteThickness[1], AbsoluteDashing[{5, 10}], 
                RGBColor[1, 0, 0], 
                Line[{{Min[ts], 1}, {Max[ts], 1}}]}
} // 
            Flatten;\)
, {j, 3}]\)

Do[
pl = 
        StyleForm[
          StringForm["n=``", 
            NumberForm[
              ns[[j]], {3, 2}]], 
          FontWeight -> "Bold", 
          FontSize -> 12]; 
Show[
        Graphics[epi10[[j]], 
          AxesOrigin -> {0, 0}, Frame -> True, 
          FrameLabel -> flab, FrameTicks -> {ts, Automatic}, 
          PlotLabel -> pl]]
, {j, 3}]

Efficiency Ratio, p=30

tb = 
      Transpose[{tbMLE30/tbFaster30, tbMLE30/tbDurbin30}, {3, 2, 
          1}]

TableForm[Map[NumberForm[#, 3] &, tb, {2}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

Graphical Comparison

\(\(flab = \((StyleForm[#1, FontWeight -> "Bold", 
                FontSize -> 
                  10] &)\) /@ {\*""(Subscript[θ, 1])"", \ "Relative Efficiency"};\)\)

sd = Transpose[{sdFaster10, sdDurbin10}, {3, 2, 1}]

TableForm[Map[NumberForm[#, 3] &, sd, {2}], TableDepth -> 2, 
      TableHeadings -> {tr, tc}]

(tb2 = Transpose[tb, {3, 2, 1}]) // Dimensions

(sd2 = Transpose[sd, {3, 2, 1}]) // Dimensions;

eps = 0.02; epi30 = {0, 0, 0};
\(Do[
\(epi30[[
            j]] = {AbsoluteThickness[
                3], {RGBColor[0, 0, 1], 
                Line /@ Transpose[
                    Transpose /@ {{ts - eps, 
                          tb2[[1, j]] - 
                            1.96*sd2[[1, 
                                j]]}, {ts - eps, 
                          tb2[[1, j]] + 
                            1.96*sd2[[1, 
                                j]]}}]}, 
{RGBColor[1, 0, 1], 
                Line /@ Transpose[
                    Transpose /@ {{ts + eps, 
                          tb2[[2, j]] - 
                            1.96*sd2[[2, 
                                j]]}, {ts + eps, 
                          tb2[[2, j]] + 
                            1.96*sd2[[2, 
                                j]]}}]}, 
{AbsoluteThickness[1], AbsoluteDashing[{5, 10}], 
                RGBColor[1, 0, 0], 
                Line[{{Min[ts], 1}, {Max[ts], 1}}]}
} // 
            Flatten;\)
, {j, 3}]\)

tsTicks = {{-1, -1}, {-0.6, -0.6}, {0, 0}, {0.6, 
            0.6}, {1, 1}};

Do[
pl = 
        StyleForm[
          StringForm["n=``", 
            NumberForm[
              ns[[j]], {3, 2}]], 
          FontWeight -> "Bold", 
          FontSize -> 12]; 
Show[
        Graphics[epi30[[j]], 
          AxesOrigin -> {0, 0}, Frame -> True, 
          FrameLabel -> flab, 
          FrameTicks -> {tsTicks, 
              Automatic}, 
PlotLabel -> 
            pl]]
, {j, 3}]