I'm getting "jumpy" loadings in rollapply PCA in R. Can I fix it?

Question

I have 10 years of daily returns data for 28 different currencies. I wish to extract the first principal component, but rather than operate PCA on the whole 10 years, I want to rollapply a 2 year window, because the currencies' behaviours evolve and so I wish to reflect this. However I have a major problem, that is that both the princomp() and prcomp() functions will often jump from positive to negative loadings in adjacent PCA analyses (ie 1 day apart). Have a look at the loading chart for the EUR currency:

Clearly I can't use this because adjacent loadings will jump from positive to negative, so my series which uses them will be erroneous. Now take a look at the absolute value of the EUR currency loading:

The problem is of course that I still cannot use this because you can see from the top chart that the loading does go from negative to positive and back at times, a characteristic which I need to preserve.

Is there any way I can get around this problem? Can I force the eigenvector orientation to always be the same in adjacent PCAs?

By the way this problem also occurs with the FactoMineR PCA() function. The code for the rollapply is here:

rollapply(retmat, windowl, function(x) 
  summary(princomp(x))$loadings[, 1], by.column = FALSE, 
  align = "right") -> princomproll

Answer 1

Whenever the plot jumps too much, reverse the orientation. One effective criterion is this: compute the total amount of jumps on all the components. Compute the total amount of jumps if the next eigenvector is negated. If the latter is less, negate the next eigenvector.

Here's an implementation. (I am not familiar with zoo, which might allow a more elegant solution.)

require(zoo)
amend <- function(result) {
  result.m <- as.matrix(result)
  n <- dim(result.m)[1]
  delta <- apply(abs(result.m[-1,] - result.m[-n,]), 1, sum)
  delta.1 <- apply(abs(result.m[-1,] + result.m[-n,]), 1, 
                   sum)
  signs <- c(1, cumprod(rep(-1, n-1) ^ (delta.1 <= delta)))
  zoo(result * signs)
}

As an example, let's run a random walk in an orthogonal group and jitter it a little for interest:

random.rotation <- function(eps) {
  theta <- rnorm(3, sd=eps)
  matrix(c(1, theta[1:2], -theta[1], 1, theta[3], 
                 -theta[2:3], 1), 3)
}
set.seed(17)
n.times <- 1000
x <- matrix(1., nrow=n.times, ncol=3)
for (i in 2:n.times) {
  x[i,] <- random.rotation(.05) %*% x[i-1,]
}

Here's the rolling PCA:

window <- 31
data <- zoo(x)
result <- rollapply(data, window, 
  function(x) summary(princomp(x))$loadings[, 1], 
               by.column = FALSE, align = "right")
plot(result)

Now the fixed version:

plot(amend(result))

Answer 2

@whuber is right that there isn't an orientation that's intrinsic to the data, but you could still enforce that your eigenvectors have positive correlation with some reference vector.

For instance, you could make the loadings for USD positive on all your eigenvectors (i.e., if USD's loading is negative, flip the signs of the entire vector). The overall direction of your vector is still arbitrary (since you could have used EUR or ZAR as your reference instead), but the first few axes of your PCA probably won't jump around nearly as much--especially because your rolling windows are so long.

Answer 3

What I did was to compute the L1 distance between successive eigenvectors. After normalizing this matrix I choose a z score threshold e.g. 1, so that if in any new rolling the change is above this threshold I flip the eigenvector, factors and loadings in order to have consistency in the rolling window. Personally I don't like to force given signs in some correlations since they can be very volatile depending of the macro drivers.