interleave matrix and vector

interleave.Rmd

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

```{r}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' 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)
```


Solution by [Stuart Lee](https://twitter.com/_StuartLee) 
------------------------------------------------------------------------------

```{r}
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)
```


Solution by [Gabe Becker](https://twitter.com/groundwalkergmb) 
------------------------------------------------------------------------------

```{r}
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)
```


Solutions by [Kara Woo](https://twitter.com/kara_woo) 
------------------------------------------------------------------------------

```{r}
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)
```


```{r}
interleave_kara_woo_2 <- function(mat, vec) { 
  t(apply(mat, 1, function(x) unlist(mapply(c, x, vec)))) 
}

interleave_kara_woo_2(mat, vec)
```




Solution by [Michael Sumner](https://twitter.com/mdsumner) 
------------------------------------------------------------------------------

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

interleave_mdsumner(mat, vec)
```






Solution by [Jake Westfall](https://twitter.com/CookieSci) 
------------------------------------------------------------------------------

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

interleave_CookieSci(mat, vec)
```


Solution by [Brodie Gaslam](https://twitter.com/BrodieGaslam) 
------------------------------------------------------------------------------

```{r}
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)
```



Solution by [Brendan Knapp](https://twitter.com/knapply_) 
------------------------------------------------------------------------------

```{r}
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)
```



Solutions by [Edward Visel](https://twitter.com/alistaire) 
------------------------------------------------------------------------------

```{r}
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)
```


```{r}
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)
```



Solution by [David Mas-Ponte](https://twitter.com/davidmasp) 
------------------------------------------------------------------------------

```{r}
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)
```




# 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!

```{r warning=FALSE}
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
)

```