Riduzione della dimensionalità (SVD o PCA) su una matrice ampia e sparsa

/ modifica: ulteriori follow-up ora è possibile utilizzare irlba :: prcomp_irlba

/ modifica: follow-up sul mio post. irlbaora ha argomenti "center" e "scale", che ti permettono di usarlo per calcolare i componenti principali, ad esempio:

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

Ho una vasta gamma Matrixdi funzioni che vorrei utilizzare in un algoritmo di machine learning:

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)

Poiché questa matrice ha molte colonne, vorrei ridurre la sua dimensionalità a qualcosa di più gestibile. Posso usare l'eccellente pacchetto irlba per eseguire SVD e restituire i primi n componenti principali (5 mostrati qui; probabilmente userò 100 o 500 sul mio set di dati effettivo):

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

Tuttavia, ho letto che prima di eseguire la PCA, si dovrebbe centrare la matrice (sottrarre la media della colonna da ciascuna colonna). Questo è molto difficile da fare sul mio set di dati e inoltre distruggerebbe la scarsità della matrice.

Quanto è "cattivo" eseguire SVD sui dati non scalati e inserirli direttamente in un algoritmo di apprendimento automatico? Esistono modi efficaci per scalare questi dati, preservando la scarsità della matrice?

/ modifica: A portato alla mia attenzione da B_miner, i "PC" dovrebbero essere davvero:

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

Inoltre, penso che la risposta di Whuber dovrebbe essere abbastanza facile da implementare, tramite la crossprodfunzione, che è estremamente veloce su matrici sparse:

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

Ora non sono sicuro di cosa fare al meansvettore prima di sottrarre M_Mt, ma pubblicherò non appena lo capirò.

/ edit3: ecco la versione modificata del codice di whuber, usando operazioni con matrici sparse per ogni fase del processo. Se riesci a memorizzare l'intera matrice sparsa in memoria, funziona molto rapidamente:

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))

Se si imposta il numero di colonne su 10.000 e il numero di componenti principali su 25, il irlbaPCA basato su circa 17 minuti impiega circa 17 minuti per calcolare 50 componenti principali approssimativi e consuma circa 6 GB di RAM, il che non è poi così male.

Prima di tutto, vuoi davvero centrare i dati . In caso contrario, l' interpretazione geometrica del PCA mostra che il primo componente principale sarà vicino al vettore dei mezzi e tutti i PC successivi saranno ortogonali ad esso, il che impedirà loro di avvicinarsi a qualsiasi PC che si trova vicino a quel primo vettore. Possiamo sperare che la maggior parte dei PC successivi sia approssimativamente corretta, ma il valore di ciò è discutibile quando è probabile che i primi diversi PC - i più importanti - siano abbastanza sbagliati.

$X$$X X'$$10000$$10000$

$Y$$Z$$500000$$n$$m_Y$$m_Z$$\mathbf{1}$$n$$1$

$m_Y = \mathbf{1}\cdot Y / n$$m_Z = \mathbf{1}\cdot Z/n$

$X X'$$Y\cdot Z$$10000$$X X'$

Esempio

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.)