滚动PCA并绘制主成分的比例方差

Question

我使用以下代码执行PCA：

PCA <- prcomp(Ret1, center = TRUE, scale. = TRUE) 
summary(PCA)

我得到以下结果：

#Importance of components:
#                          PC1    PC2     PC3     PC4
#Standard deviation     1.6338 0.9675 0.60446 0.17051
#Proportion of Variance 0.6673 0.2340 0.09134 0.00727
#Cumulative Proportion  0.6673 0.9014 0.99273 1.00000

我想要做的是针对特定窗口的滚动PCA（例如180天）。结果应该是一个矩阵，显示＆＃34;方差比例＆＃34;所有主要组成部分的时间。

我用

尝试了

rollapply(Ret1, 180, prcomp)

但这不起作用，我不知道如何保存＆＃34;方差比例＆＃34;对于矩阵中的每个时间步。

输出矩阵应如下所示：

#          PC1    PC2     PC3     PC4
#Period 1  0.6673 0.2340 0.09134 0.00727
#Period 2  0.7673 0.1340 0.09134 0.00727
# ....

以下是我的数据的一小部分Ret1：

             Cats            Dogs         Human           Frogs
2016-12-13  0.0084041063  6.518479e-03  6.096295e-04  5.781271e-03
2016-12-14 -0.0035340384 -8.150321e-03  4.418382e-04 -5.978296e-03
2016-12-15  0.0107522782  3.875708e-03 -1.784663e-02  3.012253e-03
2016-12-16  0.0033034130 -1.752174e-03 -1.753624e-03 -4.448850e-04
2016-12-17  0.0000000000  0.000000e+00  0.000000e+00  0.000000e+00
2016-12-18  0.0000000000  0.000000e+00  0.000000e+00  0.000000e+00
2016-12-19  0.0019876743  1.973190e-03 -8.577261e-03  1.996151e-03
2016-12-20  0.0033235161  3.630921e-03 -4.757395e-03  4.594355e-03
2016-12-21  0.0003401156 -2.460351e-03  3.708875e-03 -1.636413e-03
2016-12-22 -0.0010940147 -1.864724e-03 -7.991572e-03 -1.158029e-03
2016-12-23 -0.0005387228  1.250898e-03 -2.843725e-03  7.492594e-04
2016-12-24  0.0000000000  0.000000e+00  0.000000e+00  0.000000e+00
2016-12-25  0.0000000000  0.000000e+00  0.000000e+00  0.000000e+00
2016-12-26  0.0000000000  0.000000e+00  0.000000e+00  0.000000e+00
2016-12-27  0.0019465877  2.245918e-03  0.000000e+00  5.632058e-04
2016-12-28  0.0002396803 -8.391658e-03  8.307552e-03 -5.598988e-03
2016-12-29 -0.0020884556 -2.933868e-04  1.661246e-03 -7.010738e-04
2016-12-30  0.0026172923 -4.647865e-03  9.574997e-03 -2.889166e-03

我尝试了以下内容：

PCA <- function(x){
  Output=cumsum((apply((prcomp(x,center = TRUE, scale. = TRUE))$x, 2, var))/sum(vars))
  return(Output)}

window <- 10
data <- Ret1
result <- rollapply(data, window,PCA)
plot(result)

#Gives you the Proportion of Variance = cumsum((apply((prcomp(x,center = TRUE, scale. = TRUE))$x, 2, var))/sum(vars))

Answer 1

首先，使用$sdev prcomp的{​​{1}}结果，可以为您的目的编写正确的函数。我遗留了center = TRUE和scale. = TRUE因为它们是默认功能。

PCA <- function(x){
  oo <- prcomp(x)$sdev
  oo / sum(oo)
  }

现在，我们可以轻松地使用sapply进行滚动操作：

## for your mini dataset of 18 rows
window <- 10
n <- nrow(Ret1)
oo <- sapply(seq_len(n - window + 1), function (i) PCA(Ret1[i:(i + window - 1), ]))
oo <- t(oo)  ## an extra transposition as `sapply` does `cbind`

#           [,1]      [,2]       [,3]       [,4]
# [1,] 0.5206345 0.3251099 0.12789683 0.02635877
# [2,] 0.5722264 0.2493518 0.14588631 0.03253553
# [3,] 0.6051199 0.1973694 0.16151859 0.03599217
# [4,] 0.5195527 0.2874197 0.16497219 0.02805543
# [5,] 0.5682829 0.3100708 0.09456654 0.02707977
# [6,] 0.5344804 0.3149862 0.08912882 0.06140464
# [7,] 0.5954948 0.2542775 0.10434155 0.04588616
# [8,] 0.5627977 0.2581071 0.13068875 0.04840648
# [9,] 0.6089650 0.2559285 0.11022974 0.02487672

每列都是一台PC，而每一行都为该期间的每个组件提供了比例差异。

要进一步绘制结果，您可以使用matplot：

matplot(oo, type = "l", lty = 1, col = 1:4,
        xlab = "period", ylab = "proportional variance")

PCA 1-4用1：4的颜色勾画，即“黑色”，“红色”，“绿色”和“蓝色”。

其他评论：

• 如果您想使用zoo::rollapply，请执行

  oo <- zoo::rollapply(Ret1, window, PCA, by.column = FALSE)
  

• 准确地说，我正在报告比例标准偏差。如果你真的想要比例方差，机会PCA的功能是：

  PCA <- function(x){
    oo <- prcomp(x)$sdev ^ 2
    oo / sum(oo)
    }