Избегание петли через каждую строку и столбец

Question

Я столкнулся с этой функцией некоторое время назад, которое было создано для фиксации значений PCA. Проблема с функцией заключалась в том, что она не совместима с объектами временного ряда xts.

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

Полный образец может быть найден https://stats.stackexchange.com/questions/34396/im-getting-jumpy-loadings-in-rollapply-pca-in-r-can-i-fix-it

Проблема заключается в том, что применение функции на объекте XTS с несколькими столбцами и строками обыкновение решить эту проблему. Есть ли элегантный способ применения алгоритма для матрицы объектов xts?

Мое текущее решение, учитывая один столбец с несколькими строками, представляет собой цикл за строкой ..., который является медленным и утомительным. Представьте, что вам нужно сделать это и по колонке.

Спасибо,

Вот код, чтобы получить один начал:

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

черчения "princomproll" поможет вам Jumpy нагрузки ...

Answer 1

Это не очень очевидно, как Функция amend относится к сценарию ниже (поскольку он там не называется) или того, чего вы пытаетесь достичь. Есть несколько небольших изменений, которые могут быть сделаны. Я не профилировал разницу, но это немного читаемо, если ничего другого.

1. Вы удаляете первую и последнюю строки результата дважды.

2. rowSums может быть немного более эффективным для получения сумм строк, чем apply.

3. rep.int немного немного, чем 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) 
}