A bit late to the game, but did someone say fastest?! This could be another good use of Rcpp
. This function (called mmult
) will by default multiply each column of a matrix by each successive element of a vector, but has the option to do this by column, by setting byrow = FALSE
. It also checks that m
and v
are of an appropriate size given the byrow
option. Anyway, it's fast (around 10-12 times quicker than the best native R answer)...
EDIT
@chris provided this great answer to another question I posed trying to get this to work with RcppArmadillo
. However it seems that the Rcpp
-only function I posted here is still around 8 times quicker than that, and around 70 times quicker than the OP method. Click the link for the code for @chris' function - it's beautifully simple.
I'll put the benchmarking at the top..
require( microbenchmark )
m <- microbenchmark( mat %*% diag(v) , mmult( mat , v ) , sweep(mat, 2, v, FUN = "*") , chris( mat , v ) , t( t(mat) * v ) , times = 100L )
print( m , "relative" , order = "median" , digits = 3 )
Unit: relative
expr min lq median uq max neval
mmult(mat, v) 1.00 1.00 1.00 1.00 1.00 100
chris(mat, v) 10.74 9.31 8.15 7.27 10.44 100
t(t(mat) * v) 9.65 8.75 8.30 15.33 9.52 100
sweep(mat, 2, v, FUN = "*") 20.51 18.35 22.18 21.39 16.94 100
mat %*% diag(v) 80.44 70.11 73.12 70.68 54.96 100
Browse on to see how mmult
works and returns the same result as OP...
require( Rcpp )
# Source code for our function
func <- 'NumericMatrix mmult( NumericMatrix m , NumericVector v , bool byrow = true ){
if( byrow );
if( ! m.nrow() == v.size() ) stop("Non-conformable arrays") ;
if( ! byrow );
if( ! m.ncol() == v.size() ) stop("Non-conformable arrays") ;
NumericMatrix out(m) ;
if( byrow ){
for (int j = 0; j < m.ncol(); j++) {
for (int i = 0; i < m.nrow(); i++) {
out(i,j) = m(i,j) * v[j];
}
}
}
if( ! byrow ){
for (int i = 0; i < m.nrow(); i++) {
for (int j = 0; j < m.ncol(); j++) {
out(i,j) = m(i,j) * v[i];
}
}
}
return out ;
}'
# Make it available
cppFunction( func )
# Use it
res1 <- mmult( m , v )
# OP function
res2 <- mat %*% diag(v)
# Same result?
identical( res1 , res2 ) # Yes!!
[1] TRUE