# Interleaving vectors and matrices - part 3

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)))]
}

``````     [,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_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
• My `for` loop method is on par with others for my target dimensions (and has the added bonus of lowest memory allocatiions).