mikefc

Yesterday’s request for help got some great replies on twitter. I’ve collected them in this post and benchmarked them.

No one (besides myself) had the sheer audacity to inflict a for loop upon the world.

Huge thanks to the following people for their ideas! (in order of appearance)

Interleaving a row-vector with a matrix of the same width

I have a vector a row-vector and matrix of equal width

vec <- c(101, 102, 103)
mat <- matrix(c( 1,  2,  3,
                 4,  5,  6,
                 7,  8,  9,
                10, 11, 12), nrow = 4, byrow = TRUE)

Expected output after interleaving by column

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

My solution

This was my initial solution. I was concerned about whether the for loop could be done away with.

I did try a couple of solutions with an explicit rep() to try and avoid the for loop, but found the overhead of the extra memory allocation slowed things down.

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Interleave a matrix and a row-vector of the same width
#'
#'  * Create an empty matrix of double the width
#'  * Copy over the given matrix
#'  * Copy over the vector (using a for loop. quelle horreur!)
#'
#' @param m NxM matrix
#' @param v vector of length M
#'
#' @return N x M*2 matrix
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
interleave_coolbutuseless <- function(mat, vec) {
  res <- matrix(0, ncol = 2L * ncol(mat), nrow = nrow(mat))
  res[,c(T, F)] <- mat
  for (i in seq_along(vec)) {
    res[,2L * i] <- vec[i]
  }
  
  res
}

interleave_coolbutuseless(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Stuart Lee

interleave_stuartlee <- function(mat, vec) { 
  res <- matrix(0, ncol = 2L * ncol(mat), nrow = nrow(mat)) 
  res[, c(TRUE, FALSE)] <- mat 
  res[, c(FALSE, TRUE)] <- sort(rep(vec, nrow(mat))) 
  res 
}

interleave_stuartlee(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Gabe Becker

interleave_groundwalkgmb <- function(mat, vec) {
  vm       <- matrix(rep(vec, nrow(mat)), ncol = ncol(mat), byrow=TRUE) 
  res      <- rbind(mat, vm) 
  dim(res) <- c(nrow(mat), 2L * ncol(mat))
  res
}

interleave_groundwalkgmb(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solutions by Kara Woo

interleave_kara_woo_1 <- function(mat, vec) { 
  t(apply(mat, 1, function(x) unlist(purrr::map2(x, vec, c)))) 
}

interleave_kara_woo_1(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103
interleave_kara_woo_2 <- function(mat, vec) { 
  t(apply(mat, 1, function(x) unlist(mapply(c, x, vec)))) 
}

interleave_kara_woo_2(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Michael Sumner

interleave_mdsumner <- function(mat, vec) {
  matrix(
    rbind(
      mat, 
      matrix(rep(vec, each = nrow(mat)), ncol = ncol(mat))
    ), 
    nrow = nrow(mat)
  )
}

interleave_mdsumner(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Jake Westfall

interleave_CookieSci <- function(mat, vec) {
  Reduce(cbind, vec, mat)[,c(rbind(seq(vec), seq(vec)+length(vec)))]
}

interleave_CookieSci(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Brodie Gaslam

interleave_BrodieGaslam <- function(mat, vec) {
  matrix( aperm( array(c(mat, rep(vec, each=nrow(mat))), dim=c(dim(mat), 2)), c(1, 3, 2) ), nrow(mat) )
}

interleave_BrodieGaslam(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by Brendan Knapp

interleave_knapply <- function(mat, vec) { 
  matrix(rbind(mat, matrix(vec, nrow = nrow(mat), ncol = ncol(mat), byrow = TRUE)), nrow = nrow(mat)) 
}

interleave_knapply(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solutions by Edward Visel

interleave_alistaire_1 <- function(mat, vec) { 
  res <- array(dim = dim(mat) * 1:2)
  abind::afill(res, T, c(T, F)) <- mat
  abind::afill(res, T, c(F, T)) <- t(array(vec, rev(dim(mat))))
  
  res
}

interleave_alistaire_1(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103
interleave_alistaire_2 <- function(mat, vec) { 
  res <- array(dim = dim(mat) * 1:2)
  res[, c(T, F)] <- mat
  res[, c(F, T)] <- t(array(vec, rev(dim(mat))))
  
  res
}

interleave_alistaire_2(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Solution by David Mas-Ponte

interleave_davidmaasp <- function(mat, vec) { 
  new_idx         <- (1:ncol(mat)*2)-1 
  inter_idx       <- (1:ncol(mat)*2) 
  res             <- matrix(0, ncol = 2L * ncol(mat), nrow = nrow(mat))
  res[,new_idx]   <- mat
  res[,inter_idx] <- matrix(rep(vec, nrow(mat)), byrow=TRUE, ncol=length(vec)) 
  res 
}


interleave_davidmaasp(mat, vec)
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1  101    2  102    3  103
[2,]    4  101    5  102    6  103
[3,]    7  101    8  102    9  103
[4,]   10  101   11  102   12  103

Benchmarking

I’m only benchmarking for my my target problem size, but changing the dimensions of the initial matrix and vector changes the benchmarking results. Buyer beware!

N <- 1000
M <- 10
mat <- matrix(seq(M*N), nrow = N, ncol = M)
vec <- seq(M) + 100


res <- bench::mark(
  interleave_coolbutuseless(mat, vec),
  interleave_stuartlee(mat, vec), #
  interleave_groundwalkgmb(mat, vec),# 
  interleave_kara_woo_1(mat, vec),
  interleave_kara_woo_2(mat, vec),
  interleave_mdsumner(mat, vec), 
  interleave_CookieSci(mat, vec),
  interleave_BrodieGaslam(mat, vec),
  interleave_knapply(mat, vec),
  interleave_alistaire_1(mat, vec),
  interleave_alistaire_2(mat, vec),
  interleave_davidmaasp(mat, vec),
  
  check = TRUE
)
Table 1: Benchmarking results
expression median itr/sec mem_alloc
interleave_coolbutuseless(mat, vec) 147.96µs 5242 199.78KB
interleave_stuartlee(mat, vec) 444.51µs 1918 394.38KB
interleave_groundwalkgmb(mat, vec) 186.91µs 4171 348.11KB
interleave_kara_woo_1(mat, vec) 154.23ms 6 757.55KB
interleave_kara_woo_2(mat, vec) 36.1ms 26 946.52KB
interleave_mdsumner(mat, vec) 455.56µs 1882 484.12KB
interleave_CookieSci(mat, vec) 654.41µs 929 1.39MB
interleave_BrodieGaslam(mat, vec) 719.75µs 1184 725.27KB
interleave_knapply(mat, vec) 264.71µs 2856 406.51KB
interleave_alistaire_1(mat, vec) 3.08ms 288 985.5KB
interleave_alistaire_2(mat, vec) 209.15µs 3622 516.32KB
interleave_davidmaasp(mat, vec) 173.14µs 4355 320.55KB

And the winner is …

  • There’s not that much speed difference between the fastest methods.
  • Across a wider variety of benchmarks than I’ve shown here, Gabe Becker’s solution was often fastest.
  • My for loop method is on par with others for my target dimensions (and has the added bonus of lowest memory allocatiions).