Agrupar filas en una matriz grande por nombre de fila

Question

Me gustaría agregar las filas de una matriz agregando los valores en las filas que tienen el mismo nombre de fila. Mi enfoque actual es la siguiente:

> 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 

El problema de esta appraoch es que necesito para aplicarlo a una serie de matrices muy grandes (hasta 1.000 filas y 30.000 columnas). En estos casos, el tiempo de cálculo es muy alto (el mismo problema cuando se usa ddply). ¿Hay una persona más eficiente para encontrar la solución? ¿Ayuda que las matrices de entrada originales sean DocumentTermMatrix del paquete tm? Por lo que yo sé, están almacenados en un formato de matriz dispersa.

Answer 1

Aquí hay una solución que usa by y colSums, pero requiere algunos ajustes debido a la salida predeterminada de 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

La respuesta de James funciona como se esperaba, pero es bastante lenta para las matrices grandes. Aquí está una versión que 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)),]  
} 

Prueba Esto demuestra que se trata de 10x más rápido que la respuesta usando by (2 frente a 20 segundos en este ejemplo):

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) 

Answer 3

ahora hay un agregado función en Matrix.utils. Esto se puede lograr lo que desea con una sola línea de código y es aproximadamente 10 veces más rápido que la solución combineByRow y 100 veces más rápido que la solución by:

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 

EDIT: Frank es correcto, rowsum es algo más rápido que cualquiera de estos soluciones. Debería considerar usar otra de estas otras funciones solo si estuviera usando un Matrix, especialmente uno escaso, o si estaba realizando una agregación además de sum.