11
$\begingroup$

I'm using Mathematica's PrincipalComponents[] to do a principal components analysis on a data set with m data points and n variables (m > n). The command produces the m by $n$ matrix which contains the representation of each of the data in the principal components basis.

My question is -- how can I instead extract the principal component vector itself, as coefficients of original variable basis vectors? I'm aware you can do this with singular value decomposition or calculating the eigenvectors of the covariance matrix, but in doing those calculations there is an arbitrary choice of sign involved which might not be the same choice as PrincipalComponents[]. I want to see exactly the principal component vectors used by PrincipalComponents[].

$\endgroup$
6
  • 3
    $\begingroup$ I would say it's a duplicate of this: mathematica.stackexchange.com/q/37762/12 (though I'm not completely satisfied with that solution) $\endgroup$
    – Szabolcs
    Jun 7, 2018 at 18:37
  • $\begingroup$ @Szabolcs Thanks for the link; the command FindGeometricTransform[] does seem to work. However it also seems very slow, without getting into details, I'm doing a principal components analysis on a set with ~20 observations and ~15 variables. PrincipalComponents[] is very fast. FindGeometricTransform[] takes minutes. If I remove half the variables it takes a few seconds. Frustrating since one would think PrincipalComponents[] would have already calculated them. $\endgroup$ Jun 9, 2018 at 4:31
  • $\begingroup$ @Szabolcs I can update my previous comment to say that you can speed up FindGeometricTransform[] using the Method->"Linear" option, which the documentation says uses SVD just like PrincipalComponents[] should, so its speed is nearly instantaneous. Unfortunately I don't believe it orders the principal components by decreasing variance so this is still not the ideal solution. $\endgroup$ Jun 9, 2018 at 14:05
  • 2
    $\begingroup$ I'm sorry, I don't have a good solution for you. When I needed this last time, I went straight to SingularValueDecomposition precisely because I couldn't get the transformation from PrincipalComponents. $\endgroup$
    – Szabolcs
    Jun 9, 2018 at 16:54
  • 1
    $\begingroup$ I agree. I think it is worth contacting Wolfram Support about such issues and suggesting improvements for future versions. $\endgroup$
    – Szabolcs
    Jun 13, 2018 at 7:40

1 Answer 1

3
$\begingroup$

A possible alternative to PrincipalComponents is to use the KarhunenLoeveDecomposition. The resulting transformed points are identical up to very small numerical error when used like this. I have also experimented and I've not once produced a case where PCA and KLD disagree on orientation, at least in two dimensions:

pts = RandomVariate[BinormalDistribution[{0, 0}, {1, 0.6}, 0.99], 1000];
(* add some points further from the main band 
   so we can spot the orientation after the transforms by eye *)
pts = Join[pts, RandomPoint[Disk[{-2, -0.5}, 0.25], 30]];

pcs = PrincipalComponents[pts];
kld = KarhunenLoeveDecomposition[ Transpose[pts], Standardized -> True ];

(* max error of 10^-15 or thereabouts *)
Max[Abs[Transpose[First[kld]] - pcs]]

(* show the KLD transformed points *)
ListPlot[Transpose@First@kld]
(* show the PCA transformed points *)
ListPlot[pcs];

But the biggest advantage of KLD is you also get the principal vectors in the result too, unlike PrincipalComponents which gives the transformed points alone:

Show[ListPlot[pts], Graphics[{Arrow[{{0, 0}, #}] & /@ kld[[2]]}]]

kld vectors


If the points aren't mean centered already then you should do this yourself before applying the KLD:

pts = RandomVariate[BinormalDistribution[{2, 3}, {1, 0.6}, 0.99],1000];
pts = Join[pts, RandomPoint[Disk[{1, 1}, 0.25], 50]];

center = Mean[pts];
centeredpts = # - center & /@ pts;

pcs = PrincipalComponents[centeredpts];
kld = KarhunenLoeveDecomposition[Transpose[centeredpts], 
   Standardized -> True];

(*max error of 10^-15 or thereabouts*)
Max[Abs[Transpose[First[kld]] - pcs]]

(*show the KLD transformed points*)
ListPlot[Transpose@First@kld]
(*show the PCA transformed points*)
ListPlot[pcs]
decentered = # + center & /@ centeredpts;
Show[ListPlot[decentered], 
 Graphics[{Arrow[{center, center + #}] & /@ kld[[2]]}], 
 AspectRatio -> 1, PlotRange -> {{0, 5}, {0, 5}}]

mean centered kld

$\endgroup$
2
  • 1
    $\begingroup$ For more info, it doesn't work for data points which are not centered at the (0, 0). This is because PrincipalComponents[] will move the projected points to coordinates where the origin point is the center of all projected points, but KLD simply does the matrix multiplication. $\endgroup$
    – Yong Cheng
    Apr 4, 2023 at 2:08
  • $\begingroup$ @YongCheng I assumed the points are already mean centered. I have updated the answer with how to center the points prior to taking the KLD. $\endgroup$
    – flinty
    Apr 5, 2023 at 10:40

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