滚动PCA并绘制主成分的比例方差 [英] Rolling PCA and plotting proportional variance of principal components

问题描述

我正在使用以下代码执行PCA:

I'm using the following code to perform 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

我想做的是针对特定窗口(例如180天)的滚动PCA.结果应该是一个矩阵，显示所有主要成分的方差比例"随时间的变化.

What I would like to do is a Rolling PCA for a specific window ( e.g. 180 days). The Result should be a matrix which shows the evolution of the "Proportion of Variance" of all principal components though time.

我尝试过

rollapply(Ret1, 180, prcomp)

但这是行不通的，我也不知道如何为矩阵中的每个时间步保存方差比例".

but this doesn't work and I have no Idea how to save the "Proportion of Variance" for each time step in matrix.

输出矩阵应如下所示:

#          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的微型子集:

Here is a mini subset of my data 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))

推荐答案

首先，可以使用prcomp的$sdev结果将适合您目的的正确函数编写如下.我剩下了center = TRUE和scale. = TRUE，因为它们是默认功能.

First, the correct function for your purpose may be written as follow, using $sdev result of prcomp. I have left over center = TRUE and scale. = TRUE as they are function default.

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

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

Now, we can easily use sapply to do rolling operation:

## 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，而每一行都给出了该时段内每个组件的比例方差.

Each column is a PC, while each row gives proportional variance for each component in that period.

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

To further plot the result, you can use matplot:

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

PCA 1-4以1:4的颜色绘制草图，即黑色"，红色"，绿色"和蓝色".

PCA 1-4 are sketched with colour 1:4, i.e., "black", "red", "green" and "blue".

其他评论:

• 如果要使用zoo::rollapply，请

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

准确地说，我正在报告成比例的标准偏差.如果您确实想要比例方差，则机会PCA函数可以:

Precisely, I am reporting proportional standard deviation. If you really want proportional variance, chance PCA function to:

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

这篇关于滚动PCA并绘制主成分的比例方差的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！