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 956, Fri Sep 30 17:28:00 2005 UTC
# Line 1  Line 1 
1  ### Define Methods that can be inherited for all subclasses  ### Define Methods that can be inherited for all subclasses
2    
3    setAs("dgeMatrix", "lgeMatrix", d2l_Matrix)
4    setAs("dtrMatrix", "ltrMatrix", d2l_Matrix)
5    setAs("dtpMatrix", "ltpMatrix", d2l_Matrix)
6    setAs("dsyMatrix", "lsyMatrix", d2l_Matrix)
7    setAs("dspMatrix", "lspMatrix", d2l_Matrix)
8    
9  ## -- see also ./Matrix.R  e.g., for a show() method  ## -- see also ./Matrix.R  e.g., for a show() method
10    
11  ## These methods are the 'fallback' methods for all dense numeric  ## These methods are the 'fallback' methods for all dense numeric
# Line 18  Line 24 
24  setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),  setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),
25            function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))            function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))
26    
27  setMethod("t", signature(x = "ddenseMatrix"),  ## Not really useful; now require *identical* class for result:
28            function(x) callGeneric(as(x, "dgeMatrix")))  ## setMethod("t", signature(x = "ddenseMatrix"),
29    ##        function(x) callGeneric(as(x, "dgeMatrix")))
30    
31  setMethod("tcrossprod", signature(x = "ddenseMatrix"),  setMethod("tcrossprod", signature(x = "ddenseMatrix"),
32            function(x) callGeneric(as(x, "dgeMatrix")))            function(x) callGeneric(as(x, "dgeMatrix")))
# Line 46  Line 53 
53            function(x, logarithm, ...)            function(x, logarithm, ...)
54            callGeneric(as(x, "dgeMatrix"), logarithm))            callGeneric(as(x, "dgeMatrix"), logarithm))
55    
56  setMethod("expm", signature(x = "ddenseMatrix"),  ## now done for "dMatrix":
57            function(x) callGeneric(as(x, "dgeMatrix")))  ## setMethod("expm", signature(x = "ddenseMatrix"),
58    ##           function(x) callGeneric(as(x, "dgeMatrix")))
59    
60  setMethod("Schur", signature(x = "ddenseMatrix", vectors = "missing"),  setMethod("Schur", signature(x = "ddenseMatrix", vectors = "missing"),
61            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix")))            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix")))
# Line 56  Line 64 
64            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))            function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))
65    
66    
67    ### NAMESPACE must export this -- also only for R version 2.2.x:
68    if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
69        ## for R 2.2.x (and later):
70    
71    ### cbind2
72        setMethod("cbind2", signature(x = "ddenseMatrix", y = "numeric"),
73                  function(x, y) {
74                      d <- dim(x); nr <- d[1]; nc <- d[2]
75                      y <- rep(y, length.out = nr)# 'silent procrustes'
76                      ## beware of (packed) triangular, symmetric, ...
77                      x <- as(x, "dgeMatrix")
78                      x@x <- c(x@x, as.double(y))
79                      x@Dim[2] <- nc + 1:1
80                      if(is.character(dn <- x@Dimnames[[2]]))
81                          x@Dimnames[[2]] <- c(dn, "")
82                      x
83                  })
84        ## the same, (x,y) <-> (y,x):
85        setMethod("cbind2", signature(x = "numeric", y = "ddenseMatrix"),
86                  function(x, y) {
87                      d <- dim(y); nr <- d[1]; nc <- d[2]
88                      x <- rep(x, length.out = nr)
89                      y <- as(y, "dgeMatrix")
90                      y@x <- c(as.double(x), y@x)
91                      y@Dim[2] <- nc + 1:1
92                      if(is.character(dn <- y@Dimnames[[2]]))
93                          y@Dimnames[[2]] <- c("", dn)
94                      y
95                  })
96    
97        setMethod("cbind2", signature(x = "ddenseMatrix", y = "matrix"),
98                  function(x, y) callGeneric(x, as(y, "dgeMatrix")))
99        setMethod("cbind2", signature(x = "matrix", y = "ddenseMatrix"),
100                  function(x, y) callGeneric(as(x, "dgeMatrix"), y))
101    
102        setMethod("cbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
103                  function(x, y) {
104                      nr <- rowCheck(x,y)
105                      ncx <- x@Dim[2]
106                      ncy <- y@Dim[2]
107                      ## beware of (packed) triangular, symmetric, ...
108                      hasDN <- !is.null(dnx <- dimnames(x)) |
109                               !is.null(dny <- dimnames(y))
110                      x <- as(x, "dgeMatrix")
111                      y <- as(y, "dgeMatrix")
112                      x@x <- c(x@x, y@x)
113                      x@Dim[2] <- ncx + ncy
114                      if(hasDN) {
115                          ## R and S+ are different in which names they take
116                          ## if they differ -- but there's no warning in any case
117                          rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
118                          cx <- dnx[[2]] ; cy <- dny[[2]]
119                          cn <- if(is.null(cx) && is.null(cy)) NULL
120                          else c(if(!is.null(cx)) cx else rep.int("", ncx),
121                                 if(!is.null(cy)) cy else rep.int("", ncy))
122                          x@Dimnames <- list(rn, cn)
123                      }
124                      x
125                  })
126    
127    ### rbind2 -- analogous to cbind2 --- more to do for @x though:
128    
129        setMethod("rbind2", signature(x = "ddenseMatrix", y = "numeric"),
130                  function(x, y) {
131                      if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "")
132                      new("dgeMatrix", Dim = x@Dim + 1:0,
133                          Dimnames = list(dn, x@Dimnames[[2]]),
134                          x = c(rbind2(as(x,"matrix"), y)))
135                  })
136        ## the same, (x,y) <-> (y,x):
137        setMethod("rbind2", signature(x = "numeric", y = "ddenseMatrix"),
138                  function(x, y) {
139                      if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn)
140                      new("dgeMatrix", Dim = y@Dim + 1:0,
141                          Dimnames = list(dn, y@Dimnames[[2]]),
142                          x = c(rbind2(x, as(y,"matrix"))))
143                  })
144    
145        setMethod("rbind2", signature(x = "ddenseMatrix", y = "matrix"),
146                  function(x, y) callGeneric(x, as(y, "dgeMatrix")))
147        setMethod("rbind2", signature(x = "matrix", y = "ddenseMatrix"),
148                  function(x, y) callGeneric(as(x, "dgeMatrix"), y))
149    
150        setMethod("rbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
151                  function(x, y) {
152                      nc <- colCheck(x,y)
153                      nrx <- x@Dim[1]
154                      nry <- y@Dim[1]
155                      dn <-
156                          if(!is.null(dnx <- dimnames(x)) |
157                             !is.null(dny <- dimnames(y))) {
158                              ## R and S+ are different in which names they take
159                              ## if they differ -- but there's no warning in any case
160                              list(if(is.null(rx <- dnx[[1]]) && is.null(ry <- dny[[1]]))
161                                   NULL else
162                                   c(if(!is.null(rx)) rx else rep.int("", nrx),
163                                     if(!is.null(ry)) ry else rep.int("", nry)),
164                                   if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]])
165    
166                          } else list(NULL, NULL)
167                      ## beware of (packed) triangular, symmetric, ...
168                      new("dgeMatrix", Dim = c(nrx + nry, nc), Dimnames = dn,
169                          x = c(rbind2(as(x,"matrix"), as(y,"matrix"))))
170                  })
171    
172    }## R-2.2.x ff

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

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