R在稀疏矩阵上扫描

Question

我正在尝试将sweep函数应用于稀疏矩阵（dgCMatrix）。不幸的是，当我这样做时，我遇到了内存错误。扫描似乎将我的稀疏矩阵扩展为一个完整的密集矩阵。

是否有一种简便的方法来执行此功能而不会消耗我的内存？

这就是我想要做的。

sparse_matrix <- sweep(sparse_matrix, 1, vector_to_multiply, '*')

Answer 1

我第二个@ user20650的建议是使用形式为mat * vec的直接乘法，该乘法通过隐式循环mat将矩阵vec的每一列与向量vec相乘。

处理时间分析

我了解您在这里的主要要求是内存，但是对密集矩阵和稀疏矩阵执行microbenchmark和直接乘法的sweep比较很有趣：

# Sample data
library(Matrix)  
set.seed(2018)
mat <- matrix(sample(c(0, 1), 10^6, replace = T), nrow = 10^3)
mat_sparse <- Matrix(mat, sparse = T)
vec <- 1:dim(mat)[1]

library(microbenchmark)
res <- microbenchmark(
    sweep_dense = sweep(mat, 1, vec, '*'),
    sweep_sparse = sweep(mat_sparse, 1, vec, '*'),
    mult_dense = mat * vec,
    mult_sparse = mat_sparse * vec
)
res
Unit: milliseconds
         expr        min         lq       mean     median        uq      max
  sweep_dense   8.639459  10.038711  14.857274  13.064084  18.07434  32.2172
 sweep_sparse 116.649865 128.111162 162.736864 135.932811 155.63415 369.3997
   mult_dense   2.030882   3.193082   7.744076   4.033918   7.10471 184.9396
  mult_sparse  12.998628  15.020373  20.760181  16.894000  22.95510 201.5509

library(ggplot2)
autoplot(res)

平均而言，涉及稀疏矩阵的运算实际上比具有密集矩阵的运算稍慢。但是请注意，直接乘法比sweep快得多。

内存配置文件

我们可以使用memprof来分析不同方法的内存使用情况。

library(profmem)
mem <- list(
    sweep_dense = profmem(sweep(mat, 1, vec, '*')),
    sweep_sparse = profmem(sweep(mat_sparse, 1, vec, '*')),
    mult_dense = profmem(sweep(mat * vec)),
    mult_sparse = profmem(sweep(mat_sparse * vec)))
lapply(mem, function(x) utils:::format.object_size(sum(x$bytes), units = "Mb"))
#$sweep_dense
#[1] "15.3 Mb"
#
#$sweep_sparse
#[1] "103.1 Mb"
#
#$mult_dense
#[1] "7.6 Mb"
#
#$mult_sparse
#[1] "13.4 Mb"

说实话，我很惊讶使用稀疏矩阵的直接乘法的内存烙印不小于包含密集矩阵的记忆烙印。样本数据也许太简单了。可能值得用您的实际数据（或其代表子集）进行探索。

Answer 2

我正在处理一个NLP问题中的大型且非常稀疏的dgTMatrix矩阵（200k行和10k列）。经过数小时的思考，找到了一个好的解决方案，我为稀疏矩阵创建了另一个sweep函数。它非常快速且内存高效。将所有矩阵行乘以权重数组仅需1秒且不到1G的内存。对于margin = 1，它同时适用于dgCMatrix和dgTMatrix。

在这里：

sweep_sparse <- function(x, margin, stats, fun = "*") {
   f <- match.fun(fun)
   if (margin == 1) {
      idx <- x@i + 1
   } else {
      idx <- x@j + 1
   }
   x@x <- f(x@x, stats[idx])
   return(x)
}