按 R 中的列名组聚合矩阵（或 data.frame）

Question

I have a large matrix with about 3000 columns x 3000 rows. I'd like to aggregate (calculate the mean) grouped by column names for every row. Each column is named similar to this method...(and in random order)

 Tree Tree House House Tree Car Car House

I would need the data result (aggregation of mean of every row) to have the following columns:

  Tree House Car

• the tricky part (at least for me) is that I do not know all the column names and they are all in random order!

Answer 1

You could try

res1 <- vapply(unique(colnames(m1)), function(x) 
      rowMeans(m1[,colnames(m1)== x,drop=FALSE], na.rm=TRUE),
                             numeric(nrow(m1)) )

Or

res2 <-  sapply(unique(colnames(m1)), function(x) 
       rowMeans(m1[,colnames(m1)== x,drop=FALSE], na.rm=TRUE) )

identical(res1,res2)
#[1] TRUE

Another option might be to reshape into long form and then do the aggregation

 library(data.table)
 res3 <-dcast.data.table(setDT(melt(m1)), Var1~Var2, fun=mean)[,Var1:= NULL]
 identical(res1, as.matrix(res3))
 [1] TRUE

Benchmarks

It seems like the first two methods are slightly faster for a 3000*3000 matrix

set.seed(24)
m1 <- matrix(sample(0:40, 3000*3000, replace=TRUE), 
   ncol=3000, dimnames=list(NULL, sample(c('Tree', 'House', 'Car'),
    3000,replace=TRUE)))

library(microbenchmark)

f1 <-function() {vapply(unique(colnames(m1)), function(x) 
     rowMeans(m1[,colnames(m1)== x,drop=FALSE], na.rm=TRUE),
                           numeric(nrow(m1)) )}
f2 <- function() {sapply(unique(colnames(m1)), function(x) 
       rowMeans(m1[,colnames(m1)== x,drop=FALSE], na.rm=TRUE) )}

f3 <- function() {dcast.data.table(setDT(melt(m1)), Var1~Var2, fun=mean)[,
            Var1:= NULL]}

microbenchmark(f1(), f2(), f3(), unit="relative", times=10L)
#   Unit: relative
# expr      min       lq     mean   median       uq      max neval
# f1() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000    10
# f2() 1.026208 1.027723 1.037593 1.034516 1.028847 1.079004    10
# f3() 4.529037 4.567816 4.834498 4.855776 4.930984 5.529531    10

data

 set.seed(24)
 m1 <- matrix(sample(0:40, 10*40, replace=TRUE), ncol=10, 
     dimnames=list(NULL, sample(c("Tree", "House", "Car"), 10, replace=TRUE)))

Answer 2

I came up with my own solution. I first just transpose the matrix (called test_mean) so the columns become rows,then:

# removing numbers from rownames
rownames(test_mean)<-gsub("[0-9.]","",rownames(test_mean))


#aggregate by rownames
test_mean<-aggregate(test_mean, by=list(rownames(test_mean)), FUN=mean)

Answer 3

matrixStats:rowMeans2 with some coercive help from data.table, for the win!

Adding it to benchmarking from @akrun we get:

f4<- function() {
  ucn<-unique(colnames(m1))
  as.matrix(setnames(setDF(lapply(ucn, function(n) rowMeans2(m1,cols=colnames(m1)==n)))
                    ,ucn))
  }

> all.equal(f4(),f1())
[1] TRUE

> microbenchmark(f1(), f2(), f3(), f4(), unit="relative", times=10L)
Unit: relative
 expr       min        lq      mean    median        uq       max neval cld
 f1()  1.837496  1.841282  1.823375  1.834471  1.818822  1.749826    10  b 
 f2()  1.760133  1.825352  1.817355  1.826257  1.838439  1.793824    10  b 
 f3() 15.451106 15.606912 15.847117 15.586192 16.626629 16.104648    10   c
 f4()  1.000000  1.000000  1.000000  1.000000  1.000000  1.000000    10 a