SCM Repository

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

Diff of /pkg/R/ddenseMatrix.R

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

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