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)	134.49µs	5502	199.78KB
interleave_stuartlee(mat, vec)	532.61µs	1604	394.38KB
interleave_groundwalkgmb(mat, vec)	237.49µs	3288	348.19KB
interleave_kara_woo_1(mat, vec)	127.77ms	8	757.59KB
interleave_kara_woo_2(mat, vec)	37.27ms	24	946.52KB
interleave_mdsumner(mat, vec)	496.8µs	1639	484.12KB
interleave_CookieSci(mat, vec)	831.47µs	922	1.39MB
interleave_BrodieGaslam(mat, vec)	689.41µs	1070	725.27KB
interleave_knapply(mat, vec)	258.12µs	3060	406.51KB
interleave_alistaire_1(mat, vec)	4.94ms	186	767.38KB
interleave_alistaire_2(mat, vec)	321.57µs	2372	516.99KB
interleave_davidmaasp(mat, vec)	225.02µs	3472	320.55KB

Loading required namespace: tidyr

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).

Interleaving vectors and matrices - part 3