大型稀疏矩阵上的降维（SVD或PCA）

/ edit：现在可以进行进一步跟进，您可以使用irlba :: prcomp_irlba

/ edit：跟进我自己的帖子。 irlba现在具有“中心”和“比例”自变量，可用于计算主成分，例如：

pc <- M %*% irlba(M, nv=5, nu=0, center=colMeans(M), right_only=TRUE)$v

我Matrix想在机器学习算法中使用大量稀疏的功能：

library(Matrix)
set.seed(42)
rows <- 500000
cols <- 10000
i <- unlist(lapply(1:rows, function(i) rep(i, sample(1:5,1))))
j <- sample(1:cols, length(i), replace=TRUE)
M <- sparseMatrix(i, j)

因为此矩阵有很多列，所以我想将其维数减少到更易于管理的程度。我可以使用出色的irlba软件包执行SVD并返回前n个主要成分（此处显示5个；我可能会在实际数据集中使用100或500）：

library(irlba)
pc <- irlba(M, nu=5)$u

但是，我已经读过在执行PCA之前，应该将矩阵居中（从每一列中减去列均值）。这在我的数据集上很难做到，而且会破坏矩阵的稀疏性。

对未缩放的数据执行SVD，并将其直接输入到机器学习算法中有多“糟糕”？在保留矩阵稀疏性的同时，是否有任何有效的方法可以缩放此数据？

/ edit：B_miner引起我注意的“ PC”实际上应该是：

pc <- M %*% irlba(M, nv=5, nu=0)$v 

另外，我认为通过crossprod函数，whuber的答案应该很容易实现，在稀疏矩阵上这是非常快的：

system.time(M_Mt <- crossprod(M)) # 0.463 seconds
system.time(means <- colMeans(M)) #0.003 seconds

现在，我不太确定means在从减去之前对向量要做什么M_Mt，但是一旦确定就将发布。

/ edit3：这是Whuber代码的修改版本，在过程的每个步骤中都使用稀疏矩阵运算。 如果您可以将整个稀疏矩阵存储在内存中，则它可以非常快速地工作：

library('Matrix')
library('irlba')
set.seed(42)
m <- 500000
n <- 100
i <- unlist(lapply(1:m, function(i) rep(i, sample(25:50,1))))
j <- sample(1:n, length(i), replace=TRUE)
x <- sparseMatrix(i, j, x=runif(length(i)))

n_comp <- 50
system.time({
  xt.x <- crossprod(x)
  x.means <- colMeans(x)
  xt.x <- (xt.x - m * tcrossprod(x.means)) / (m-1)
  svd.0 <- irlba(xt.x, nu=0, nv=n_comp, tol=1e-10)
})
#user  system elapsed 
#0.148   0.030   2.923 

system.time(pca <- prcomp(x, center=TRUE))
#user  system elapsed 
#32.178   2.702  12.322

max(abs(pca$center - x.means))
max(abs(xt.x - cov(as.matrix(x))))
max(abs(abs(svd.0$v / pca$rotation[,1:n_comp]) - 1))

如果将列数设置为10,000，并将主组件数设置为25，则irlba基于PCA的PCA将花费大约17分钟的时间来计算50个近似主组件，并消耗大约6GB的RAM，这还不错。

首先，您确实确实想对数据进行居中。如果不是，则PCA的几何解释表明，第一个主成分将接近均值向量，并且所有后续PC均将正交于它，这将防止它们近似于任何一个碰巧接近该第一向量的PC。我们可以希望以后的大多数PC都大致正确，但是当前几台PC（最重要的PC）很可能是错误的时候，其价值值得怀疑。

那么该怎么办？PCA通过矩阵的奇异值分解进行。基本信息将包含在X X '中，在这种情况下为10000 x 10000矩阵：这可能是可管理的。它的计算涉及一列与下一列的点积的大约5000万次计算。$X$$X X'$$10000$$10000$

考虑任意两列，然后是和Z（其中每一个都是500000 -vector；将此维设为n）。让他们的手段是米$Y$$Z$$500000$$n$$m_Y$和，分别。您要计算的是，将1的n-向量写为1，$m_Z$$\mathbf{1}$$n$$1$

因为和米ž = 1 ⋅ Ž / Ñ。$m_Y = \mathbf{1}\cdot Y / n$$m_Z = \mathbf{1}\cdot Z/n$

这使您可以使用稀疏矩阵技术来计算$X X'$，其条目提供的价值，然后根据该调整的系数10000点的平均值。调整不应该受到损害，因为X X ′似乎不太稀疏。$Y\cdot Z$$10000$$X X'$

例

Rget.col$X$prcomp

m <- 500000 # Will be 500,000
n <- 100    # will be 10,000
library("Matrix")
x <- as(matrix(pmax(0,rnorm(m*n, mean=-2)), nrow=m), "sparseMatrix")
#
# Compute centered version of x'x by having at most two columns
# of x in memory at any time.
#
get.col <- function(i) x[,i] # Emulates reading a column
system.time({
  xt.x <- matrix(numeric(), n, n)
  x.means <- rep(numeric(), n)
  for (i in 1:n) {
    i.col <- get.col(i)
    x.means[i] <- mean(i.col)
    xt.x[i,i] <- sum(i.col * i.col)
    if (i < n) {
      for (j in (i+1):n) {
        j.col <- get.col(j)
        xt.x[i,j] <- xt.x[j,i] <- sum(j.col * i.col)
      }    
    }
  }
  xt.x <- (xt.x - m * outer(x.means, x.means, `*`)) / (m-1)
  svd.0 <- svd(xt.x / m)
}
)
system.time(pca <- prcomp(x, center=TRUE))
#
# Checks: all should be essentially zero.
#
max(abs(pca$center - x.means))
max(abs(xt.x - cov(x)))
max(abs(abs(svd.0$v / pca$rotation) - 1)) # (This is an unstable calculation.)