Extracting the principal component analysis vectors in the original basis

Question

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[].

Answer 1

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]]}]]

---

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}}]