避免循環遍歷每行和每列

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」將讓你心驚肉跳負荷......

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