0

不久前我遇到了这个函数，它是为修复 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”会让你跳动加载......

4

1 回答 1

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)
}
于 2013-05-29T10:06:25.847 回答