R/interleave.R

Defines functions interleave

Documented in interleave

#' Interleave elements of shorter vectors (or lists) between elements of larger ones
#' 
#' Arranges elements of argument vectors or lists so that 
#' the first elements of all arguments get output then the second ones etc.
#' Arguments are reused to match the length of the largest argument minus 1.
#' 
#' @param ... vertors or lists to be interleaved
#' @return interleaved vector or list
#'
#' @examples
#' interleave(1:3, 0)
#' # [1] 1 0 2 0 3
#' 
#' interleave(1:3, -1:0, 11:14)
#' # [1]  1 -1 11  2  0 12  3 -1 13  1  0 14
#' 
#' interleave(LETTERS[1:3], "_", letters[1:3], "|") 
#' # [1] "A" "_" "a" "|" "B" "_" "b" "|" "C" "_" "c"
#'
#' @export
interleave <- function(...) {
  arg <- list(...)
  if (length(arg) < 2) return(arg[[1]])
  anylist <- any(sapply(arg, is.list, simplify = TRUE))
  len <- sapply(arg, length, simplify = TRUE)
  L <- max(len)
  iL <- tail(which(len == L), 1)
  replen <- ifelse(seq_along(len) > iL, L - 1, L)
  N <- sum(replen)
  reparg <- mapply(function(x, n) rep(x, length.out = n), arg, replen, SIMPLIFY = FALSE)
  ireorder <- rep(c(0, head(cumsum(replen), -1)), length.out = N) + 
    rep(1:L, each = length(arg), length.out = N)
  if (anylist) Reduce(function(x, y) c(x, as.list(y)), reparg, init = NULL)[ireorder]
  else Reduce(c, reparg)[ireorder]
}
avidclam/avidstart documentation built on May 17, 2019, 10:01 a.m.