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