1#  File src/library/methods/R/rbind.R
2#  Part of the R package, https://www.R-project.org
3#
4#  Copyright (C) 1995-2018 The R Core Team
5#
6#  This program is free software; you can redistribute it and/or modify
7#  it under the terms of the GNU General Public License as published by
8#  the Free Software Foundation; either version 2 of the License, or
9#  (at your option) any later version.
10#
11#  This program is distributed in the hope that it will be useful,
12#  but WITHOUT ANY WARRANTY; without even the implied warranty of
13#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14#  GNU General Public License for more details.
15#
16#  A copy of the GNU General Public License is available at
17#  https://www.R-project.org/Licenses/
18
19#### S4-ized  rbind() --- this is entirely parallel to ./cbind() --- KEEP IN SYNC!
20###  -------------------- built by
21## s/cbind/rbind/ ; s/nrow/N_COL/; s/column/row/; s/colnam/rownam/;
22## s/ncol/nrow/ ; s/N_COL/ncol/; s/d[2L]/d[1L]/
23
24rbind <- function(..., deparse.level = 1)
25{
26    has.dl <- !missing(deparse.level)
27    deparse.level <- as.integer(deparse.level)
28    if(identical(deparse.level, -1L)) deparse.level <- 0L # our hack
29    stopifnot(0 <= deparse.level, deparse.level <= 2)
30
31    argl <- list(...)
32    ## remove trailing 'NULL's:
33    na <- nargs() - has.dl
34    while(na > 0L && is.null(argl[[na]])) { argl <- argl[-na]; na <- na - 1L }
35    if(na == 0) return(NULL)
36    symarg <- as.list(substitute(list(...)))[-1L] # symbolic argument (names)
37    nmsym <- names(symarg)
38    ## Give *names* depending on deparse.level {for non-matrix}:
39    nm <- c( ## 0:
40	function(i) NULL,
41	## 1:
42	function(i) if(is.symbol(s <- symarg[[i]])) deparse(s) else NULL,
43	## 2:
44	function(i) deparse(symarg[[i]])[[1L]])[[ 1L + deparse.level ]]
45    Nms <- function(i) { if(!is.null(s <- nmsym[i]) && nzchar(s)) s else nm(i) }
46    if(na == 1) {
47	if(isS4(..1)) {
48	    r <- rbind2(..1)
49	    if(length(dim(..1)) < 2L && length(dim(r)) == 2L)
50		rownames(r) <- Nms(1)
51	    return(r)
52	}
53	else return(base::rbind(..., deparse.level = deparse.level))
54    }
55
56    ## else :  na >= 2
57
58    if(na == 2) {
59	fix.na <- FALSE
60    }
61    else { ## na >= 3 arguments
62	## determine ncol(<result>)  for e.g.,	rbind(diag(2), 1, 2)
63	## only when the last two argument have *no* dim attribute:
64	nrs <- unname(lapply(argl, ncol)) # of length na
65	iV <- vapply(nrs, is.null, NA)# is 'vector'
66	fix.na <- identical(nrs[(na-1L):na], list(NULL,NULL))
67	if(fix.na) {
68	    ## "fix" last argument, using 1-row `matrix' of proper ncol():
69	    nr <- max(if(all(iV)) lengths(argl) else unlist(nrs[!iV]))
70	    argl[[na]] <- rbind(rep(argl[[na]], length.out = nr),
71				deparse.level = 0)
72	    ## and since it's a 'matrix' now, rbind() below may not name it
73	}
74	## if(deparse.level) {
75	    if(fix.na)
76		fix.na <- !is.null(Nna <- Nms(na))
77	## }
78    }
79
80    Nrow <- function(x) {
81	d <- dim(x); if(length(d) == 2L) d[1L] else as.integer(length(x) > 0L) }
82    setN <- function(i, nams)
83	rownames(r)[i] <<- if(is.null(nams)) "" else nams
84
85    r <- argl[[na]]
86    for(i in (na-1L):1L) {
87    d2 <- dim(r)
88    r <- rbind2(argl[[i]], r)
89    ## if(deparse.level == 0)
90    ##     if(i == 1L) return(r) else next
91    ism1 <- !is.null(d1 <- dim(argl[[i]])) && length(d1) == 2L
92    ism2 <- !is.null(d2)                   && length(d2) == 2L
93    if(ism1 && ism2) ## two matrices
94	next
95
96    ## else -- Setting rownames correctly
97    ##	       when one was not a matrix [needs some diligence!]
98    nn1 <- !is.null(N1 <- if(       (l1 <- Nrow(argl[[i]])) && !ism1) Nms(i)) # else NULL
99    nn2 <- !is.null(N2 <- if(i == na-1L && Nrow(argl[[na]]) && !ism2) Nms(na))
100    if(nn1 || nn2) {
101	if(is.null(rownames(r)))
102	    rownames(r) <- rep.int("", nrow(r))
103	if(nn1) setN(1,	 N1)
104	if(nn2) setN(1+l1, N2)
105    }
106    }
107
108    if(fix.na) {
109	if(is.null(rownames(r)))
110	    rownames(r) <- rep.int("", nrow(r))
111	setN(nrow(r), Nna)
112    }
113    r
114}
115