1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
|
# Col union
# Form the union of columns in a and b. If there are columns of the same name in both a and b, take the column from a.
#
# @param data frame a
# @param data frame b
# @keyword internal
cunion <- function(a, b) {
if (length(a) == 0) return(b)
if (length(b) == 0) return(a)
cbind(a, b[setdiff(names(b), names(a))])
}
# Interleave (or zip) multiple units into one vector
interleave <- function(...) UseMethod("interleave")
#' @export
interleave.unit <- function(...) {
do.call("unit.c", do.call("interleave.default", lapply(list(...), as.list)))
}
#' @export
interleave.default <- function(...) {
vectors <- list(...)
# Check lengths
lengths <- unique(setdiff(vapply(vectors, length, integer(1)), 1L))
if (length(lengths) == 0) lengths <- 1
if (length(lengths) > 1) abort("`lengths` must be below 1")
# Replicate elements of length one up to correct length
singletons <- vapply(vectors, length, integer(1)) == 1L
vectors[singletons] <- lapply(vectors[singletons], rep, lengths)
# Interleave vectors
n <- lengths
p <- length(vectors)
interleave <- rep(1:n, each = p) + seq(0, p - 1) * n
unlist(vectors, recursive = FALSE)[interleave]
}
|
