Search code examples
rmatrixapplytapplyrowsum

Summing rows of a matrix based on column index


I am trying to go from a matrix that has columns that "belong together" to one where the row-sums of the relevant sub-matrices have been formed. I.e. going from

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16]
[1,]    1    5    9   13   17   21   25   29   33    37    41    45    49    53    57    61
[2,]    2    6   10   14   18   22   26   30   34    38    42    46    50    54    58    62
[3,]    3    7   11   15   19   23   27   31   35    39    43    47    51    55    59    63
[4,]    4    8   12   16   20   24   28   32   36    40    44    48    52    56    60    64

to

     [,1] [,2] [,3] [,4] [,5]
[1,]   15   30   46  185  220
[2,]   18   32   48  190  224
[3,]   21   34   50  195  228
[4,]   24   36   52  200  232

I assume there must be some much more elegant and faster way to do this than by looping over the indices as I do below (particularly, my real matrix would be more like 4000 by many thousands).

example <- matrix(1:64, nrow=4) myindex <- c(1,1,1,2,2,3,3,4,4,4,4,4,5,5,5,5) summed <- matrix( rep(unique(myindex), each=dim(example)[1]), nrow=dim(example)[1]) for (i in 1:length(unique(myindex))){ summed[,i] <- apply(X=example[,(myindex==i)], MARGIN=1, FUN=sum) }

It is probably my lack of experience with apply and tapply that prevents me from figuring this out. A fast dplyr approach would of course also be welcome.


Solution

  • We can use a one liner with sapply:

    sapply(unique(myindex), function(x) rowSums(example[, which(myindex == x), drop = FALSE]))
    
         [,1] [,2] [,3] [,4] [,5]
    [1,]   15   30   46  185  220
    [2,]   18   32   48  190  224
    [3,]   21   34   50  195  228
    [4,]   24   36   52  200  232
    

    We let sapply loop over all unique values of myindex, and use which to define the columns which should be included into the rowSums.


    Edit: Included drop = FALSE to prevent single indexes from simplifying to vector. Thanks @mt1022 for pointing out the bug!