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 925 - (view) (download)
Original Path: pkg/R/ddenseMatrix.R

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

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