SCM

SCM Repository

[matrix] Diff of /pkg/R/dsparseMatrix.R
ViewVC logotype

Diff of /pkg/R/dsparseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1217, Fri Feb 10 16:58:35 2006 UTC revision 1218, Mon Feb 20 22:47:20 2006 UTC
# Line 121  Line 121 
121      setMethod("cbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),      setMethod("cbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
122                function(x, y) {                function(x, y) {
123                    nr <- rowCheck(x,y)                    nr <- rowCheck(x,y)
                   ncx <- x@Dim[2]  
                   ncy <- y@Dim[2]  
124                    ## beware of (packed) triangular, symmetric, ...                    ## beware of (packed) triangular, symmetric, ...
125                    hasDN <- !is.null(dnx <- dimnames(x)) |                    hasDN <- !all(lapply(c(dnx <- dimnames(x), dny <- dimnames(y)), is.null))
126                             !is.null(dny <- dimnames(y))                    ans <- .Call("Csparse_horzcat", as(x, "dgCMatrix"), as(y, "dgCMatrix"))
                   x <- as(x, "dgCMatrix")  
                   y <- as(y, "dgCMatrix")  
                   ne.x <- length(x@i)  
                   x@i <- c(x@i, y@i)  
                   x@p <- c(x@p, ne.x + y@p[-1])  
                   x@x <- c(x@x, y@x)  
                   x@Dim[2] <- ncx + ncy  
127                    if(hasDN) {                    if(hasDN) {
128                        ## R and S+ are different in which names they take                        ## R and S+ are different in which names they take
129                        ## if they differ -- but there's no warning in any case                        ## if they differ -- but there's no warning in any case
130                        rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]                        rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
131                        cx <- dnx[[2]] ; cy <- dny[[2]]                        cx <- dnx[[2]] ; cy <- dny[[2]]
132                        cn <- if(is.null(cx) && is.null(cy)) NULL                        cn <- if(is.null(cx) && is.null(cy)) NULL
133                        else c(if(!is.null(cx)) cx else rep.int("", ncx),                        else c(if(!is.null(cx)) cx else rep.int("", ncol(x)),
134                               if(!is.null(cy)) cy else rep.int("", ncy))                               if(!is.null(cy)) cy else rep.int("", ncol(y)))
135                        x@Dimnames <- list(rn, cn)                        ans@Dimnames <- list(rn, cn)
136                    }                    }
137                    x                    ans
138                })                })
139    
140  ### rbind2 -- analogous to cbind2 --- more to do for @x though:      setMethod("rbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
141                  function(x, y) {
142                      nr <- colCheck(x,y)
143                      ## beware of (packed) triangular, symmetric, ...
144                      hasDN <- !all(lapply(c(dnx <- dimnames(x), dny <- dimnames(y)), is.null))
145                      ans <- .Call("Csparse_vertcat", as(x, "dgCMatrix"), as(y, "dgCMatrix"))
146                      if(hasDN) {
147                          ## R and S+ are different in which names they take
148                          ## if they differ -- but there's no warning in any case
149                          cn <- if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]
150                          rx <- dnx[[1]] ; ry <- dny[[1]]
151                          rn <- if(is.null(rx) && is.null(ry)) NULL
152                          else c(if(!is.null(rx)) rx else rep.int("", nrow(x)),
153                                 if(!is.null(ry)) ry else rep.int("", nrow(y)))
154                          ans@Dimnames <- list(rn, cn)
155                      }
156                      ans
157                  })
158    
159  }## R-2.2.x ff  }## R-2.2.x ff

Legend:
Removed from v.1217  
changed lines
  Added in v.1218

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge