Giảm kích thước (SVD hoặc PCA) trên một ma trận lớn, thưa thớt

/ chỉnh sửa: Theo dõi thêm bây giờ bạn có thể sử dụng irlba :: prcomp_irlba

/ chỉnh sửa: theo dõi trên bài viết của riêng tôi. irlbabây giờ có các đối số "trung tâm" và "tỷ lệ", cho phép bạn sử dụng nó để tính toán các thành phần nguyên tắc, ví dụ:

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

Tôi có một số lượng lớn Matrixcác tính năng mà tôi muốn sử dụng trong thuật toán học máy:

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)

Bởi vì ma trận này có nhiều cột, tôi muốn giảm kích thước của nó xuống một cái gì đó dễ quản lý hơn. Tôi có thể sử dụng gói irlba tuyệt vời để thực hiện SVD và trả về n thành phần chính đầu tiên (5 được hiển thị ở đây; tôi có thể sẽ sử dụng 100 hoặc 500 trên tập dữ liệu thực tế của mình):

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

Tuy nhiên, tôi đã đọc rằng trước khi thực hiện PCA, người ta phải căn giữa ma trận (trừ trung bình cột từ mỗi cột). Điều này rất khó thực hiện trên tập dữ liệu của tôi và hơn nữa sẽ phá hủy sự thưa thớt của ma trận.

Làm thế nào "xấu" là nó thực hiện SVD trên dữ liệu không có tỷ lệ và đưa nó thẳng vào một thuật toán học máy? Có cách nào hiệu quả để tôi có thể mở rộng dữ liệu này, trong khi vẫn giữ được độ thưa của ma trận không?

/ chỉnh sửa: A mang đến sự chú ý của tôi bởi B_miner, "PC" thực sự phải là:

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

Ngoài ra, tôi nghĩ rằng câu trả lời của người làm nên khá dễ thực hiện, thông qua crossprodchức năng, cực kỳ nhanh trên các ma trận thưa thớt:

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

Bây giờ tôi không chắc chắn phải làm gì với meansvectơ trước khi trừ đi M_Mt, nhưng sẽ đăng ngay khi tôi tìm ra nó.

/ edit3: Đây là phiên bản sửa đổi của mã trình duyệt, sử dụng các hoạt động ma trận thưa thớt cho từng bước của quy trình. Nếu bạn có thể lưu trữ toàn bộ ma trận thưa thớt trong bộ nhớ, nó sẽ hoạt động rất nhanh:

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

Nếu bạn đặt số lượng cột là 10.000 và số thành phần chính là 25, irlbaPCA dựa trên cơ sở sẽ mất khoảng 17 phút để tính 50 thành phần chính gần đúng và tiêu tốn khoảng 6GB RAM, điều này không quá tệ.

Trước hết, bạn thực sự muốn tập trung vào dữ liệu . Nếu không, cách giải thích hình học của PCA cho thấy thành phần chính đầu tiên sẽ gần với vectơ của phương tiện và tất cả các PC tiếp theo sẽ trực giao với nó, điều này sẽ ngăn chúng xấp xỉ bất kỳ PC nào xảy ra gần với vectơ đầu tiên đó. Chúng tôi có thể hy vọng rằng hầu hết các PC sau này sẽ gần đúng, nhưng giá trị của điều đó là đáng nghi ngờ khi có khả năng một số PC đầu tiên - những PC quan trọng nhất - sẽ khá sai.

$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'$

Thí dụ

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