Question

我想通过在具有相同rowname的行中添加值来聚合矩阵的行。我目前的做法如下：

> M
  a b c d
1 1 1 2 0
1 2 3 4 2
2 3 0 1 2
3 4 2 5 2
> index <- as.numeric(rownames(M))
> M <- cbind(M,index)
> Dfmat <- data.frame(M)
> Dfmat <- aggregate(. ~ index, data = Dfmat, sum)
> M <- as.matrix(Dfmat)
> rownames(M) <- M[,"index"]
> M <- subset(M, select= -index)
> M
   a b c d
 1 3 4 6 2
 2 3 0 1 2
 3 4 2 5 2

这个appraoch的问题是我需要将它应用于许多非常大的矩阵（最多1.000行和30.000列）。在这些情况下，计算时间非常长（使用ddply时会出现同样的问题）。有没有更有效的方法来提出解决方案？原始输入矩阵是否来自tm包的DocumentTermMatrix有帮助吗？据我所知，它们以稀疏矩阵格式存储。

Answer 1

以下是使用by和colSums的解决方案，但由于by的默认输出而需要一些摆弄。

M <- matrix(1:9,3)
rownames(M) <- c(1,1,2)
t(sapply(by(M,rownames(M),colSums),identity))
  V1 V2 V3
1  3  9 15
2  3  6  9

Answer 2

Matrix.utils现在有一个聚合函数。这可以通过单行代码实现您的目标，并且比combineByRow解决方案快10倍，比by解决方案快100倍：

N <- 10000

m <- matrix( runif(N*100), nrow=N)
rownames(m) <- sample(1:(N/2),N,replace=T)

> microbenchmark(a<-t(sapply(by(m,rownames(m),colSums),identity)),b<-combineByRow(m),c<-aggregate.Matrix(m,row.names(m)),times = 10)
Unit: milliseconds
                                                  expr        min         lq       mean     median         uq        max neval
 a <- t(sapply(by(m, rownames(m), colSums), identity)) 6000.26552 6173.70391 6660.19820 6419.07778 7093.25002 7723.61642    10
                                  b <- combineByRow(m)  634.96542  689.54724  759.87833  732.37424  866.22673  923.15491    10
                c <- aggregate.Matrix(m, row.names(m))   42.26674   44.60195   53.62292   48.59943   67.40071   70.40842    10

> identical(as.vector(a),as.vector(c))
[1] TRUE

编辑：弗兰克是对的，rowum比任何这些解决方案都要快一些。如果您使用的是Matrix，尤其是稀疏的函数，或者除了sum之外您正在执行聚合，您还可以考虑使用这些其他函数中的另一个。

Answer 3

詹姆斯的答案按预期工作，但对于大型矩阵而言相当缓慢。这是avoids creating of new objects：

的版本

combineByRow <- function(m) {
    m <- m[ order(rownames(m)), ]

    ## keep track of previous row name
    prev <- rownames(m)[1]
    i.start <- 1
    i.end <- 1

    ## cache the rownames -- profiling shows that it takes
    ## forever to look at them
    m.rownames <- rownames(m)
    stopifnot(all(!is.na(m.rownames)))


    ## go through matrix in a loop, as we need to combine some unknown
    ## set of rows
    for (i in 2:(1+nrow(m))) {

        curr <- m.rownames[i]

        ## if we found a new row name (or are at the end of the matrix),
        ## combine all rows and mark invalid rows
        if (prev != curr || is.na(curr)) {

            if (i.start < i.end) {
                m[i.start,] <- apply(m[i.start:i.end,], 2, max)
                m.rownames[(1+i.start):i.end] <- NA
            }

            prev <- curr
            i.start <- i
        } else {
            i.end <- i
        }
    }

    m[ which(!is.na(m.rownames)),]    
}

测试它显示比使用by的答案快10倍（本例中为2秒对20秒）：

N <- 10000

m <- matrix( runif(N*100), nrow=N)
rownames(m) <- sample(1:(N/2),N,replace=T)

start <- proc.time()
m1 <- combineByRow(m)
print(proc.time()-start)

start <- proc.time()
m2 <- t(sapply(by(m,rownames(m),function(x) apply(x, 2, max)),identity))
print(proc.time()-start)

all(m1 == m2)

通过rowname在大矩阵中聚合行

3 个答案: