按 R 中的列名組聚合矩陣（或 data.frame）

Question

我有一個大約 3000 列 x 3000 行的大矩陣。 我想聚合（計算平均值）按每一行的列名分組。 每列的名稱類似於此方法...（並以隨機順序）

 Tree Tree House House Tree Car Car House

我需要數據結果（每行平均值的聚合）具有以下列：

  Tree House Car

• 棘手的部分（至少對我而言）是我不知道所有列名，而且它們的順序都是隨機的！

Answer 1

你可以試試

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

或者

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

identical(res1,res2)
#[1] TRUE

另一種選擇可能是重塑為長形式，然后進行聚合

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

基准

對於 3000*3000 矩陣，前兩種方法似乎稍快

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

數據

 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

我想出了我自己的解決方案。 我首先只是轉置矩陣（稱為 test_mean），使列變為行，然后：

# 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與matrixStats:rowMeans2的一些強制幫助，為勝利！

將其添加到@akrun 的基准測試中，我們得到：

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