Avoiding Looping Through Every row and column

Question

I came across this function a while back that was created for fixing PCA values. The problem with the function was that it wasn't compatible xts time series objects.

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

Full sample can be found https://stats.stackexchange.com/questions/34396/im-getting-jumpy-loadings-in-rollapply-pca-in-r-can-i-fix-it

The problem is that applying the function on a xts object with multiple columns and rows wont solve the problem. Is there a elegant way of applying the algorithm for a matrix of xts objects?

My current solution given a single column with multiple row is to loop through row by row...which is slow and tedious. Imagine having to do it column by column also.

Thanks,

Here is some code to get one started:

rm(list=ls())
require(RCurl)
sit = getURLContent('https://github.com/systematicinvestor/SIT/raw/master/sit.gz',         binary=TRUE, followlocation = TRUE, ssl.verifypeer = FALSE)
con = gzcon(rawConnection(sit, 'rb'))
source(con)
close(con)
load.packages('quantmod')


data <- new.env()

tickers<-spl("VTI,IEF,VNQ,TLT")
getSymbols(tickers, src = 'yahoo', from = '1980-01-01', env = data, auto.assign = T)
for(i in ls(data)) data[[i]] = adjustOHLC(data[[i]], use.Adjusted=T)

bt.prep(data, align='remove.na', dates='1990::2013')

prices<-data$prices[,-10]  #don't include cash
retmat<-na.omit(prices/mlag(prices) - 1)


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

require(lattice)
xyplot(amend(pruncomproll))

plotting "princomproll" will get you jumpy loadings...

Richie Cotton Richie Cotton · Accepted Answer · 2013-05-29T10:06:25

It isn't very obvious how the amend function relates to the script below it (since it isn't called there), or what you are trying to achieve. There are a couple of small changes that can be made. I haven't profiled the difference, but it's a little more readable if nothing else.

You remove the first and last rows of the result twice.
rowSums might be slightly more efficient for getting the row sums than apply.
rep.int is a little bit fster than rep.

amend <- function(result) {
  result <- as.matrix(result)
  n <- nrow(result)
  without_first_row <- result[-1,]
  without_last_row <- result[-n,]
  delta_minus <- rowSums(abs(without_first_row - without_last_row))
  delta_plus <- rowSums(abs(without_first_row + without_last_row))
  signs <- c(1, cumprod(rep.int(-1, n-1) ^ (delta_plus <= delta_minus)))
  zoo(result * signs)
}

Avoiding Looping Through Every row and column

1 Answers