如何在大型稀疏矩陣中組合具有相同名稱的列

Question

我有一個來自Matrix包的稀疏 dgTMatrix ，它選擇了一些重復的colnames 。 我想通過對具有相同名稱的列求和來組合這些，形成一個簡化的矩陣。

我找到了這篇文章，我將其改編為稀疏矩陣運算。 但是：在大型物體上它仍然很慢。 我想知道是否有人有更好的解決方案，可以直接對稀疏矩陣的索引元素進行操作，這樣會更快。 例如， A@j索引（從零開始） A@Dimnames[[2]]的標簽，這些標簽可以被壓縮並用於重新索引A@j 。 （注意：這就是為什么我使用三元組稀疏矩陣形式而不是列稀疏矩陣的Matrix默認值，因為每次計算出p值都會讓我頭疼。）

require(Matrix)

# set up a (triplet) sparseMatrix
A <- sparseMatrix(i = c(1, 2, 1, 2, 1, 2), j = 1:6, x = rep(1:3, 2), 
                  giveCsparse = FALSE,
                  dimnames = list(paste0("r", 1:2), rep(letters[1:3], 2)))
A
## 2 x 6 sparse Matrix of class "dgTMatrix"
##    a b c a b c
## r1 1 . 3 . 2 .
## r2 . 2 . 1 . 3

str(A)
## Formal class 'dgTMatrix' [package "Matrix"] with 6 slots
##   ..@ i       : int [1:6] 0 1 0 1 0 1
##   ..@ j       : int [1:6] 0 1 2 3 4 5
##   ..@ Dim     : int [1:2] 2 6
##   ..@ Dimnames:List of 2
##   .. ..$ : chr [1:2] "r1" "r2"
##   .. ..$ : chr [1:6] "a" "b" "c" "a" ...
##   ..@ x       : num [1:6] 1 2 3 1 2 3
##   ..@ factors : list()

# my matrix-based attempt
OP1 <- function(x) {
    nms <- colnames(x)
    if (any(duplicated(nms))) 
        x <- x %*% Matrix(sapply(unique(nms),"==", nms))
    x
} 
OP1(A)
## 2 x 3 sparse Matrix of class "dgCMatrix"
##    a b c
## r1 1 2 3
## r2 1 2 3

它運行良好，但在我打算使用它的巨大稀疏對象上似乎很慢。 這是一個更大的項目：

# now something bigger, for testing
set.seed(10)
nr <- 10000     # rows
nc <- 26*100    # columns - 100 repetitions of a-z
nonZeroN <- round(nr * nc / 3)  # two-thirds sparse
B <- sparseMatrix(i = sample(1:nr, size = nonZeroN, replace = TRUE), 
                  j = sample(1:nc, size = nonZeroN, replace = TRUE),
                  x = round(runif(nonZeroN)*5+1),
                  giveCsparse = FALSE, 
                  dimnames =  list(paste0("r", 1:nr), rep(letters, nc/26)))
print(B[1:5, 1:10], col.names = TRUE)
## 5 x 10 sparse Matrix of class "dgTMatrix"
##     a b c  d e f g h i  j
## r1  . . 5  . . 2 . . .  .
## r2  . . .  . . . . . .  4
## r4  . . .  . . . . 3 3  .
## r3  2 2 .  3 . . . 3 .  .
## r5  3 . .  1 . . . . .  5

require(microbenchmark)
microbenchmark(OPmatrixCombine1 = OP1(B), times = 30)
## Unit: milliseconds
##             expr      min       lq     mean   median       uq      max neval
## OPmatrixCombine1 578.9222 619.3912 665.6301 631.4219 646.2716 1013.777    30

有沒有更好的方法，更好意味着更快，並且如果可能的話，不需要構建額外的大型對象？

Answer 1

這是使用我想到的索引重新索引的嘗試，這是我在朋友的幫助下想出來的（帕特里克是你嗎？）。 它重新索引j值，並使用sparseMatrix()的非常方便的功能，將x值加在一起，用於索引位置相同的元素。

OP2 <- function(x) {
    nms <- colnames(x)
    uniquenms <- unique(nms)
    # build the sparseMatrix again: x's with same index values are automatically
    # added together, keeping in mind that indexes stored from 0 but built from 1
    sparseMatrix(i = x@i + 1, 
                 j = match(nms, uniquenms)[x@j + 1],
                 x = x@x,
                 dimnames = list(rownames(x), uniquenms),
                 giveCsparse = FALSE)
}

結果是一樣的：

OP2(A)
## 2 x 3 sparse Matrix of class "dgCMatrix"
##    a b c
## r1 1 2 3
## r2 1 2 3

all.equal(as(OP1(B), "dgTMatrix"), OP2(B))
## [1] TRUE

但更快：

require(microbenchmark)
microbenchmark(OPmatrixCombine1 = OP1(B), 
               OPreindexSparse = OP2(B),
               times = 30)
## Unit: relative
##              expr      min       lq     mean   median       uq      max neval
##  OPmatrixCombine1 1.756769 1.307651 1.360487 1.341814 1.346864 1.460626    30
##   OPreindexSparse 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    30