Apply multiplication on all columns but only for rows that have positive values

user_10143946 0
Viewed 264

I have the following matrix:

 m <- as.matrix(data.frame(a = c(-1,2,3,4),
                b = c(-1,2,2,-4),
                c = c(-1,3,1,-2)))

I want to multiply every column with the corresponding value in vector v which is the same length as the number of columns in m. I want to only apply the multiplication to the positive values in that column.

v <- c(2,3,-3)

such that column a becomes (-1,4,6,8)

My dataset is large, so I'm looking for an elegant solution

r matrix
5 Answers

Multiply, then reset negative values:

# transpose and multiply per row
res <- t(m) * v
res <- t(res)

# then reset negatives to original value
res[m < 0] <- m[ m < 0 ]
res
#       a  b  c
# [1,] -1 -1 -1
# [2,]  4  6 -9
# [3,]  6  6 -3
# [4,]  8 -4 -2
user_6800680

You can use the condition m>0 to subset the result:

i <- m>0
#i <- which(m>0) #Maybe faster Alternative
m[i] <- (m %*% diag(v))[i]
#m[i] <- (m * v[col((m))])[i] #Maybe faster Alternative
m
#      a  b  c
#[1,] -1 -1 -1
#[2,]  4  6 -9
#[3,]  6  6 -3
#[4,]  8 -4 -2

Or another maybe fast version:

i <- +(m>0)
m * (v[col(m)]*i + 1 - i)
user_104885040 
to_upd <- which(m>0)
m[to_upd] <- (m * v[col(m)])[to_upd]
m
#       a  b  c
# [1,] -1 -1 -1
# [2,]  4  6 -9
# [3,]  6  6 -3
# [4,]  8 -4 -2

Data

v <- c(2,3,-3)
m <- cbind(
  a = c(-1,2,3,4),
  b = c(-1,2,2,-4),
  c = c(-1,3,1,-2)
)
user_45522950

You can do like this:

m * c(1, v)[col(m) * (m > 0) + 1L]
#R>       a  b  c
#R> [1,] -1 -1 -1
#R> [2,]  4  6 -9
#R> [3,]  6  6 -3
#R> [4,]  8 -4 -2

My dataset is large, so I'm looking for an elegant solution

If by elegant you mean fast, then this seems to be an as fast or faster solution compared with the other options:

# simulate a larger data set
set.seed(1)
n <- 10000
p <- 50
m <- matrix(rnorm(n * p), n)
v <- rnorm(p)

bench::mark(
  sindri_baldur = {
    to_upd <- which(m>0)
    res <- m
    res[to_upd] <- (res * v[col(res)])[to_upd]
    res
  },
  Ben = {
    res <- m
    res * c(1, v)[col(res) * (res > 0) + 1L]
  },
  GKi = {
    i <- m > 0
    res <- m
    res[i] <- (res %*% diag(v))[i]
    res
  },
  zx8754 = {
    res <- t(m) * v
    res <- t(res)
    res[m < 0] <- m[ m < 0 ]
    res
  }, min_time = 2)
#R> # A tibble: 4 x 13
#R>   expression         min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time 
#R>   <bch:expr>    <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> 
#R> 1 sindri_baldur   6.34ms    9.3ms     119.    16.22MB    1.02    235     2      1.97s 
#R> 2 Ben             5.01ms   5.22ms     190.     9.54MB    0.503   378     1      1.99s 
#R> 3 GKi            17.82ms  18.28ms      53.8   17.19MB    0.555    97     1       1.8s 
#R> 4 zx8754          9.03ms   9.26ms     107.    19.07MB    1.53    210     3      1.96s
user_58612440

Here is another base R option using msk as the mask

> m*t((msk <- t(m)>0)*v + !msk)
      a  b  c
[1,] -1 -1 -1
[2,]  4  6 -9
[3,]  6  6 -3
[4,]  8 -4 -2
user_121587570
Related