/
rbind-fill-matrix.r
78 lines (70 loc) · 2.42 KB
/
rbind-fill-matrix.r
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#' Bind matrices by row, and fill missing columns with NA.
#'
#' The matrices are bound together using their column names or the column
#' indices (in that order of precedence.) Numeric columns may be converted to
#' character beforehand, e.g. using format. If a matrix doesn't have
#' colnames, the column number is used. Note that this means that a
#' column with name \code{"1"} is merged with the first column of a matrix
#' without name and so on. The returned matrix will always have column names.
#'
#' Vectors are converted to 1-column matrices.
#'
#' Matrices of factors are not supported. (They are anyways quite
#' inconvenient.) You may convert them first to either numeric or character
#' matrices. If a matrices of different types are merged, then normal
#' covnersion precendence will apply.
#'
#' Row names are ignored.
#'
#' @param ... the matrices to rbind. The first argument can be a list of
#' matrices, in which case all other arguments are ignored.
#' @return a matrix with column names
#' @author C. Beleites
#' @seealso \code{\link[base]{rbind}}, \code{\link[base]{cbind}},
#' \code{\link[plyr]{rbind.fill}}
#' @family binding functions
#' @export
#' @keywords manip
#' @examples
#' A <- matrix (1:4, 2)
#' B <- matrix (6:11, 2)
#' A
#' B
#' rbind.fill.matrix (A, B)
#'
#' colnames (A) <- c (3, 1)
#' A
#' rbind.fill.matrix (A, B)
#'
#' rbind.fill.matrix (A, 99)
rbind.fill.matrix <- function(...) {
matrices <- list(...)
if (length(matrices) == 0) return()
if (is.list(matrices[[1]]) && !is.matrix(matrices[[1]])) {
matrices <- matrices[[1]]
}
## check the arguments
tmp <- unlist(lapply(matrices, is.factor))
if (any(tmp)) {
stop("Input ", paste(which(tmp), collapse = ", "), " is a factor and ",
"needs to be converted first to either numeric or character.")
}
matrices[] <- lapply(matrices, as.matrix)
# Work out common column names
lcols <- lapply(matrices, function(x) amv_dimnames(x)[[2]])
cols <- unique(unlist(lcols))
# Calculate rows in output
rows <- unlist(lapply(matrices, nrow))
nrows <- sum(rows)
# Generate output template
output <- matrix(NA, nrow = nrows, ncol = length(cols))
colnames(output) <- cols
# Compute start and length for each matrix
pos <- matrix(c(cumsum(rows) - rows + 1, rows), ncol = 2)
## fill in the new matrix
for(i in seq_along(rows)) {
rng <- seq(pos[i, 1], length = pos[i, 2])
output[rng, lcols[[i]]] <- matrices[[i]]
}
output
}