SCM

SCM Repository

[matrix] Annotation of /pkg/Matrix/R/ddenseMatrix.R
ViewVC logotype

Annotation of /pkg/Matrix/R/ddenseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1391 - (view) (download)
Original Path: pkg/R/ddenseMatrix.R

1 : bates 686 ### Define Methods that can be inherited for all subclasses
2 :    
3 : maechler 956 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 : maechler 1391 setMethod("as.numeric", signature(x = "ddenseMatrix"),
10 :     function(x, ...) as(x, "dgeMatrix")@x)
11 :    
12 : maechler 792 ## -- see also ./Matrix.R e.g., for a show() method
13 :    
14 : bates 686 ## These methods are the 'fallback' methods for all dense numeric
15 : maechler 792 ## matrices in that they simply coerce the ddenseMatrix to a
16 :     ## dgeMatrix. Methods for special forms override these.
17 : bates 686
18 :     setMethod("norm", signature(x = "ddenseMatrix", type = "missing"),
19 :     function(x, type, ...) callGeneric(as(x, "dgeMatrix")))
20 :    
21 :     setMethod("norm", signature(x = "ddenseMatrix", type = "character"),
22 :     function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))
23 :    
24 :     setMethod("rcond", signature(x = "ddenseMatrix", type = "missing"),
25 :     function(x, type, ...) callGeneric(as(x, "dgeMatrix")))
26 :    
27 :     setMethod("rcond", signature(x = "ddenseMatrix", type = "character"),
28 :     function(x, type, ...) callGeneric(as(x, "dgeMatrix"), type))
29 :    
30 : maechler 946 ## Not really useful; now require *identical* class for result:
31 :     ## setMethod("t", signature(x = "ddenseMatrix"),
32 :     ## function(x) callGeneric(as(x, "dgeMatrix")))
33 : bates 686
34 : maechler 1087 setMethod("tcrossprod", signature(x = "ddenseMatrix", y = "missing"),
35 :     function(x, y = NULL) callGeneric(as(x, "dgeMatrix")))
36 : bates 686
37 :     setMethod("crossprod", signature(x = "ddenseMatrix", y = "missing"),
38 :     function(x, y = NULL) callGeneric(as(x, "dgeMatrix")))
39 :    
40 :     setMethod("diag", signature(x = "ddenseMatrix"),
41 :     function(x = 1, nrow, ncol = n) callGeneric(as(x, "dgeMatrix")))
42 :    
43 :     setMethod("solve", signature(a = "ddenseMatrix", b = "missing"),
44 :     function(a, b, ...) callGeneric(as(a, "dgeMatrix")))
45 :    
46 :     setMethod("solve", signature(a = "ddenseMatrix", b = "ANY"),
47 :     function(a, b, ...) callGeneric(as(a, "dgeMatrix"), b))
48 :    
49 :     setMethod("lu", signature(x = "ddenseMatrix"),
50 :     function(x, ...) callGeneric(as(x, "dgeMatrix")))
51 :    
52 : maechler 856 setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "missing"),
53 : bates 686 function(x, logarithm, ...) callGeneric(as(x, "dgeMatrix")))
54 :    
55 : maechler 856 setMethod("determinant", signature(x = "ddenseMatrix", logarithm = "logical"),
56 : bates 686 function(x, logarithm, ...)
57 :     callGeneric(as(x, "dgeMatrix"), logarithm))
58 :    
59 : maechler 954 ## now done for "dMatrix":
60 :     ## setMethod("expm", signature(x = "ddenseMatrix"),
61 :     ## function(x) callGeneric(as(x, "dgeMatrix")))
62 : bates 686
63 :     setMethod("Schur", signature(x = "ddenseMatrix", vectors = "missing"),
64 :     function(x, vectors, ...) callGeneric(as(x, "dgeMatrix")))
65 :    
66 :     setMethod("Schur", signature(x = "ddenseMatrix", vectors = "logical"),
67 :     function(x, vectors, ...) callGeneric(as(x, "dgeMatrix"), vectors))
68 :    
69 : maechler 792
70 : maechler 1331 ## Cheap version: work via "dgeMatrix" and use the group methods there:
71 :     ## FIXME(?): try to preserve "symmetric", "triangular", ...
72 :     setMethod("Arith", ## "+", "-", "*", "^", "%%", "%/%", "/"
73 :     signature(e1 = "ddenseMatrix", e2 = "ddenseMatrix"),
74 :     function(e1, e2) callGeneric(as(e1, "dgeMatrix"),
75 :     as(e2, "dgeMatrix")))
76 :     setMethod("Arith",
77 :     signature(e1 = "ddenseMatrix", e2 = "numeric"),
78 :     function(e1, e2) callGeneric(as(e1, "dgeMatrix"), e2))
79 :     setMethod("Arith",
80 :     signature(e1 = "numeric", e2 = "ddenseMatrix"),
81 :     function(e1, e2) callGeneric(e1, as(e2, "dgeMatrix")))
82 : maechler 908
83 : maechler 1331 setMethod("Math",
84 :     signature(x = "ddenseMatrix"),
85 :     function(x) callGeneric(as(x, "dgeMatrix")))
86 :    
87 :    
88 :    
89 :     ### for R 2.2.x (and later): -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
90 :    
91 : maechler 925 ### cbind2
92 : maechler 1331 setMethod("cbind2", signature(x = "ddenseMatrix", y = "numeric"),
93 :     function(x, y) {
94 :     d <- dim(x); nr <- d[1]; nc <- d[2]
95 :     y <- rep(y, length.out = nr) # 'silent procrustes'
96 :     ## beware of (packed) triangular, symmetric, ...
97 :     x <- as(x, "dgeMatrix")
98 :     x@x <- c(x@x, as.double(y))
99 :     x@Dim[2] <- nc + 1:1
100 :     if(is.character(dn <- x@Dimnames[[2]]))
101 :     x@Dimnames[[2]] <- c(dn, "")
102 :     x
103 :     })
104 :     ## the same, (x,y) <-> (y,x):
105 :     setMethod("cbind2", signature(x = "numeric", y = "ddenseMatrix"),
106 :     function(x, y) {
107 :     d <- dim(y); nr <- d[1]; nc <- d[2]
108 :     x <- rep(x, length.out = nr)
109 :     y <- as(y, "dgeMatrix")
110 :     y@x <- c(as.double(x), y@x)
111 :     y@Dim[2] <- nc + 1:1
112 :     if(is.character(dn <- y@Dimnames[[2]]))
113 :     y@Dimnames[[2]] <- c("", dn)
114 :     y
115 :     })
116 : maechler 908
117 : maechler 1331 setMethod("cbind2", signature(x = "ddenseMatrix", y = "matrix"),
118 :     function(x, y) callGeneric(x, as(y, "dgeMatrix")))
119 :     setMethod("cbind2", signature(x = "matrix", y = "ddenseMatrix"),
120 :     function(x, y) callGeneric(as(x, "dgeMatrix"), y))
121 : maechler 908
122 : maechler 1331 setMethod("cbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
123 :     function(x, y) {
124 :     nr <- rowCheck(x,y)
125 :     ncx <- x@Dim[2]
126 :     ncy <- y@Dim[2]
127 :     ## beware of (packed) triangular, symmetric, ...
128 :     hasDN <- !is.null(dnx <- dimnames(x)) |
129 :     !is.null(dny <- dimnames(y))
130 :     x <- as(x, "dgeMatrix")
131 :     y <- as(y, "dgeMatrix")
132 :     x@x <- c(x@x, y@x)
133 :     x@Dim[2] <- ncx + ncy
134 :     if(hasDN) {
135 :     ## R and S+ are different in which names they take
136 :     ## if they differ -- but there's no warning in any case
137 :     rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
138 :     cx <- dnx[[2]] ; cy <- dny[[2]]
139 :     cn <- if(is.null(cx) && is.null(cy)) NULL
140 :     else c(if(!is.null(cx)) cx else rep.int("", ncx),
141 :     if(!is.null(cy)) cy else rep.int("", ncy))
142 :     x@Dimnames <- list(rn, cn)
143 :     }
144 :     x
145 :     })
146 : maechler 908
147 : maechler 925 ### rbind2 -- analogous to cbind2 --- more to do for @x though:
148 : maechler 908
149 : maechler 1331 setMethod("rbind2", signature(x = "ddenseMatrix", y = "numeric"),
150 :     function(x, y) {
151 :     if(is.character(dn <- x@Dimnames[[1]])) dn <- c(dn, "")
152 :     new("dgeMatrix", Dim = x@Dim + 1:0,
153 :     Dimnames = list(dn, x@Dimnames[[2]]),
154 :     x = c(rbind2(as(x,"matrix"), y)))
155 :     })
156 :     ## the same, (x,y) <-> (y,x):
157 :     setMethod("rbind2", signature(x = "numeric", y = "ddenseMatrix"),
158 :     function(x, y) {
159 :     if(is.character(dn <- y@Dimnames[[1]])) dn <- c("", dn)
160 :     new("dgeMatrix", Dim = y@Dim + 1:0,
161 :     Dimnames = list(dn, y@Dimnames[[2]]),
162 :     x = c(rbind2(x, as(y,"matrix"))))
163 :     })
164 : maechler 925
165 : maechler 1331 setMethod("rbind2", signature(x = "ddenseMatrix", y = "matrix"),
166 :     function(x, y) callGeneric(x, as(y, "dgeMatrix")))
167 :     setMethod("rbind2", signature(x = "matrix", y = "ddenseMatrix"),
168 :     function(x, y) callGeneric(as(x, "dgeMatrix"), y))
169 : maechler 925
170 : maechler 1331 setMethod("rbind2", signature(x = "ddenseMatrix", y = "ddenseMatrix"),
171 :     function(x, y) {
172 :     nc <- colCheck(x,y)
173 :     nrx <- x@Dim[1]
174 :     nry <- y@Dim[1]
175 :     dn <-
176 :     if(!is.null(dnx <- dimnames(x)) |
177 :     !is.null(dny <- dimnames(y))) {
178 :     ## R and S+ are different in which names they take
179 :     ## if they differ -- but there's no warning in any case
180 :     list(if(is.null(rx <- dnx[[1]]) && is.null(ry <- dny[[1]]))
181 :     NULL else
182 :     c(if(!is.null(rx)) rx else rep.int("", nrx),
183 :     if(!is.null(ry)) ry else rep.int("", nry)),
184 :     if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]])
185 : maechler 925
186 : maechler 1331 } else list(NULL, NULL)
187 :     ## beware of (packed) triangular, symmetric, ...
188 :     new("dgeMatrix", Dim = c(nrx + nry, nc), Dimnames = dn,
189 :     x = c(rbind2(as(x,"matrix"), as(y,"matrix"))))
190 :     })

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