SCM

SCM Repository

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

Diff of /pkg/R/ddenseMatrix.R

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

revision 856, Tue Aug 16 20:20:13 2005 UTC revision 946, Wed Sep 28 08:56:42 2005 UTC
# Line 18  Line 18 
18  setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),  setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),
19            function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))            function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))
20    
21  setMethod("t", signature(x = "ddenseMatrix"),  ## Not really useful; now require *identical* class for result:
22            function(x) callGeneric(as(x, "dgeMatrix")))  ## setMethod("t", signature(x = "ddenseMatrix"),
23    ##        function(x) callGeneric(as(x, "dgeMatrix")))
24    
25  setMethod("tcrossprod", signature(x = "ddenseMatrix"),  setMethod("tcrossprod", signature(x = "ddenseMatrix"),
26            function(x) callGeneric(as(x, "dgeMatrix")))            function(x) callGeneric(as(x, "dgeMatrix")))
# Line 56  Line 57 
57            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))
58    
59    
60    ### NAMESPACE must export this -- also only for R version 2.2.x:
61    if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
62        ## for R 2.2.x (and later):
63    
64    ### cbind2
65        setMethod("cbind2", signature(x = "ddenseMatrix", y = "numeric"),
66                  function(x, y) {
67                      d <- dim(x); nr <- d[1]; nc <- d[2]
68                      y <- rep(y, length.out = nr)# 'silent procrustes'
69                      ## beware of (packed) triangular, symmetric, ...
70                      x <- as(x, "dgeMatrix")
71                      x@x <- c(x@x, as.double(y))
72                      x@Dim[2] <- nc + 1:1
73                      if(is.character(dn <- x@Dimnames[[2]]))
74                          x@Dimnames[[2]] <- c(dn, "")
75                      x
76                  })
77        ## the same, (x,y) <-> (y,x):
78        setMethod("cbind2", signature(x = "numeric", y = "ddenseMatrix"),
79                  function(x, y) {
80                      d <- dim(y); nr <- d[1]; nc <- d[2]
81                      x <- rep(x, length.out = nr)
82                      y <- as(y, "dgeMatrix")
83                      y@x <- c(as.double(x), y@x)
84                      y@Dim[2] <- nc + 1:1
85                      if(is.character(dn <- y@Dimnames[[2]]))
86                          y@Dimnames[[2]] <- c("", dn)
87                      y
88                  })
89    
90        setMethod("cbind2", signature(x = "ddenseMatrix", y = "matrix"),
91                  function(x, y) callGeneric(x, as(y, "dgeMatrix")))
92        setMethod("cbind2", signature(x = "matrix", y = "ddenseMatrix"),
93                  function(x, y) callGeneric(as(x, "dgeMatrix"), y))
94    
95        setMethod("cbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
96                  function(x, y) {
97                      nr <- rowCheck(x,y)
98                      ncx <- x@Dim[2]
99                      ncy <- y@Dim[2]
100                      ## beware of (packed) triangular, symmetric, ...
101                      hasDN <- !is.null(dnx <- dimnames(x)) |
102                               !is.null(dny <- dimnames(y))
103                      x <- as(x, "dgeMatrix")
104                      y <- as(y, "dgeMatrix")
105                      x@x <- c(x@x, y@x)
106                      x@Dim[2] <- ncx + ncy
107                      if(hasDN) {
108                          ## R and S+ are different in which names they take
109                          ## if they differ -- but there's no warning in any case
110                          rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
111                          cx <- dnx[[2]] ; cy <- dny[[2]]
112                          cn <- if(is.null(cx) && is.null(cy)) NULL
113                          else c(if(!is.null(cx)) cx else rep.int("", ncx),
114                                 if(!is.null(cy)) cy else rep.int("", ncy))
115                          x@Dimnames <- list(rn, cn)
116                      }
117                      x
118                  })
119    
120    ### rbind2 -- analogous to cbind2 --- more to do for @x though:
121    
122        setMethod("rbind2", signature(x = "ddenseMatrix", y = "numeric"),
123                  function(x, y) {
124                      if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "")
125                      new("dgeMatrix", Dim = x@Dim + 1:0,
126                          Dimnames = list(dn, x@Dimnames[[2]]),
127                          x = c(rbind2(as(x,"matrix"), y)))
128                  })
129        ## the same, (x,y) <-> (y,x):
130        setMethod("rbind2", signature(x = "numeric", y = "ddenseMatrix"),
131                  function(x, y) {
132                      if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn)
133                      new("dgeMatrix", Dim = y@Dim + 1:0,
134                          Dimnames = list(dn, y@Dimnames[[2]]),
135                          x = c(rbind2(x, as(y,"matrix"))))
136                  })
137    
138        setMethod("rbind2", signature(x = "ddenseMatrix", y = "matrix"),
139                  function(x, y) callGeneric(x, as(y, "dgeMatrix")))
140        setMethod("rbind2", signature(x = "matrix", y = "ddenseMatrix"),
141                  function(x, y) callGeneric(as(x, "dgeMatrix"), y))
142    
143        setMethod("rbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
144                  function(x, y) {
145                      nc <- colCheck(x,y)
146                      nrx <- x@Dim[1]
147                      nry <- y@Dim[1]
148                      dn <-
149                          if(!is.null(dnx <- dimnames(x)) |
150                             !is.null(dny <- dimnames(y))) {
151                              ## R and S+ are different in which names they take
152                              ## if they differ -- but there's no warning in any case
153                              list(if(is.null(rx <- dnx[[1]]) && is.null(ry <- dny[[1]]))
154                                   NULL else
155                                   c(if(!is.null(rx)) rx else rep.int("", nrx),
156                                     if(!is.null(ry)) ry else rep.int("", nry)),
157                                   if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]])
158    
159                          } else list(NULL, NULL)
160                      ## beware of (packed) triangular, symmetric, ...
161                      new("dgeMatrix", Dim = c(nrx + nry, nc), Dimnames = dn,
162                          x = c(rbind2(as(x,"matrix"), as(y,"matrix"))))
163                  })
164    
165    }## R-2.2.x ff

Legend:
Removed from v.856  
changed lines
  Added in v.946

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