Plot Ellipse based on EigenSystem

Question

Please consider the following :

covMatrice = {{34.925, -10.21}, {-10.21, 22.462}};

COG = Mean@(Nfixations["d"][[1]])[[All, 1]];

fixations = {{19.4688, 17.4281}, {18.0563, 21.7156}, {13.0219, 24.7219}, 
         {22.9594,25.5219}, {28.5406, 24.6719}, {27.0688, 17.1656}, 
         {27.6781,16.325}, {28.9281, 10.7719}, {16.025, 13.6625}, 
         {19.1313, 17.1094}};


With[{
      eigVec = Eigenvectors[covMatrice],
      eigVal = Eigenvalues[covMatrice]},
      Graphics[{
                White, Rectangle @@ frmXY, 
                Black, Disk[#, .5] & /@ fixations, 
                Red, Line[(# + COG) & /@
                           {eigVec[[1]]*eigVal[[1]]/5, 
                           {0, 0},
                           eigVec[[2]]*eigVal[[2]]/5}]}]]

How could I draw an ellipse representing on the EigenSystem given that Neither Disk or Circle enable to implement an "orientation" ?

A rough example of my desired output as drawn using PPT :

Answer 1

You can use Rotate to draw the ellipse too. Note that knowing the eigenvectors is the same as knowing the orientation of the ellipse, so there is no necessity to favour GeometricTransformation over Rotate. So, to orient your ellipse along the first eigenvector (corresponding to the largest eigenvalue), it is as simple as:

Graphics[Rotate[Disk[meanVec, eigVals], ArcTan @@ eigVecs[[1]]]]

where meanVec is the mean (here, I've taken it to be {0,0})

---

Going by your comment under rcollyer's answer, here's a example reproducing your desired figure with simple shifting (change the center of the disk) and rotation of the disk. This approach will be simpler to follow (as the transformations are spelled out), if you do not understand what GeometricTransformation does. Modifying rcollyer's module,

Module[{mat = #, avg = Mean@fixations, eigVals, eigVecs},
   {eigVals, eigVecs} = Eigensystem@mat;
   Graphics[{{Black, Disk[#, .5] & /@ fixations}, 
      {Directive[Opacity[0.1], Red, EdgeForm[Gray]], 
          Rotate[Disk[avg, eigVals/5], ArcTan @@ eigVecs[[1]]]}
   }]
]&@covMatrice

Answer 2

The simplest approach is to rotate an ellipse aligned with the coordinate axes to axes specified by the eigenvectors. Using your matrix,

{evals, evects} = Eigensystem@covMatrice
(*
=> {{40.6549, 16.7321}, {{-0.872057, 0.489405}, {-0.489405, -0.872057}}}
*)

Graphics[ GeometricTransformation[ Disk[{0,0}, evals], evecs\[Transpose] ] ]

produces

Edit: From the comments, the previous code was incomplete in that the ellipse needed to be centered over the other graphics objects. GeometricTransformation functions by taking as its second argument a TransformationFunction and applying it to the Graphics objects passed in via its first argument. An alternate form of GeometricTransformation accepts a matrix representing the transformation, instead, and that is what the above code uses. In essence, every point, r, in the object is turned into m.r, where m is the matrix. The third form accepts a matrix and a translation vector, v, transforming each point into m.r + v. The following code uses that form to center the ellipse at the mean position of the fixations:

Module[{mat = #, avg = Mean@fixations, g, evals, evecs},
  {evals, evecs} = Eigensystem@mat;
  g = GeometricTransformation[#, {evecs\[Transpose], avg}] &;
  Graphics[{
    {Black, Disk[#, .5] & /@ fixations},
    {Directive[Opacity[0.1], Red,  EdgeForm[Gray]], g@Disk[{0, 0}, evals/5]},
    {Red, Line[(# + avg) & /@ Riffle[evecs evals/5, {{0, 0}}] ]}
  }]
] & @ covMatrice

which produces

I consider this method superior to Rotate in that no other calculations are needed.

Answer 3

If you know the angle, try using Rotate, simple example:

Graphics[{Rotate[Disk[{0, 0}, {1, 2}], \[Pi]/4]}]

(note: the two argument form of Rotate rotates around the center of the primitive)

Here is a more complete example with a Manipulate:

Manipulate[
 Graphics[{
   Lighter[Pink],
   EdgeForm[{AbsoluteThickness[3], Gray}],
   Rotate[Disk[{cx, cy}, {rx, ry}], a, {cx, cy}],
   {Red, Rotate[
     Line[{{cx, cy}, {cx + rx, cy}}], a, {cx, cy}]},
   {Red, Rotate[
     Line[{{cx, cy}, {cx, cy + ry}}], a, {cx, cy}]},
   {Blue, Line[{{0, 0}, {cx, cy}}]}
   }, PlotRange -> 7, Axes -> True, GridLines -> Automatic],
 {{a, 2}, 0, 2 \[Pi]},
 {{rx, 3}, .5, 3},
 {{ry, 1}, .5, 3},
 {{cx, 3}, -3, 3},
 {{cy, 3}, -3, 3}
 ]

(If you don't know the angle, @rcollyer's answer seems the more useful one).

Answer 4

Another approach to solving your problem would be to use the MultivariateStatistics package, which includes the EllipsoidQuantile function. Here's an example:

Needs["MultivariateStatistics`"]

fixations = {{19.4688, 17.4281}, {18.0563, 21.7156}, {13.0219, 
24.7219}, {22.9594, 25.5219}, {28.5406, 24.6719}, {27.0688, 
17.1656}, {27.6781, 16.325}, {28.9281, 10.7719}, {16.025, 
13.6625}, {19.1313, 17.1094}};

e50 = EllipsoidQuantile[fixations, 0.5]; (* use the median ellipse for this example *)

Now extract the ellipse axes and plot it:

major1 = e50[[1]] + e50[[3]]\[Transpose].{e50[[2, 1]], 0}; (* construct the major and minor axes for plotting *)
major2 = e50[[1]] - e50[[3]]\[Transpose].{e50[[2, 1]], 0};
minor1 = e50[[1]] + e50[[3]]\[Transpose].{0, e50[[2, 2]]};
minor2 = e50[[1]] - e50[[3]]\[Transpose].{0, e50[[2, 2]]};

Show[
 ListPlot[fixations, AspectRatio -> Automatic, 
  PlotRange -> {All, {10, 30}}],
 Graphics[{Red, Thick, e50}],
 Graphics[{Red, Thick, Line[{major1, major2}]}],
 Graphics[{Red, Thick, Line[{minor1, minor2}]}]
 ]

Your example data doesn't have many points which makes it difficult (for me at least) to visualize the answer. Assuming the data are Normally distributed, you can generate some extra points this way:

mean = e50[[1]];
covMatrice = {{34.925, -10.21}, {-10.21, 22.462}};
\[ScriptCapitalD] = MultinormalDistribution[mean, covMatrice];
data = RandomVariate[\[ScriptCapitalD], 1000];
Histogram3D[data]

e50 = EllipsoidQuantile[data, 0.5];
major1 = e50[[1]] + e50[[3]]\[Transpose].{e50[[2, 1]], 0};
major2 = e50[[1]] - e50[[3]]\[Transpose].{e50[[2, 1]], 0};
minor1 = e50[[1]] + e50[[3]]\[Transpose].{0, e50[[2, 2]]};
minor2 = e50[[1]] - e50[[3]]\[Transpose].{0, e50[[2, 2]]};

Show[
 ListPlot[data, AspectRatio -> Automatic,PlotRange -> {All, {10, 30}}],
 Graphics[{Red, Thick, e50}],
 Graphics[{Red, Thick, Line[{major1, major2}]}],
 Graphics[{Red, Thick, Line[{minor1, minor2}]}]
 ]