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函数如何与它下面的脚本相关（因为它没有在那里调用），或者你想要实现的目标，这不是很明显。可以进行一些小的更改。我没有描述差异，但如果没有别的话，它会更具可读性。

您删除结果的第一行和最后一行。
rowSums获取行总和的效率可能略高于apply。
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)
}

避免每行和每列循环

1 个答案: