SCM

SCM Repository

[matrix] Annotation of /pkg/R/denseMatrix.R
ViewVC logotype

Annotation of /pkg/R/denseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1673 - (view) (download)

1 : maechler 925 ### Simple fallback methods for all dense matrices
2 : maechler 871 ### These are "cheap" to program, but potentially far from efficient;
3 :     ### Methods for specific subclasses will overwrite these:
4 :    
5 : maechler 1472 setAs("ANY", "denseMatrix", function(from) Matrix(from, sparse=FALSE))
6 :    
7 :    
8 : maechler 1226 ## dense to sparse:
9 : maechler 925 setAs("denseMatrix", "dsparseMatrix",
10 : maechler 1226 ## MM thought that as() will take the ``closest'' match; but that fails!
11 :     ## function(from) as(as(from, "dgeMatrix"), "dsparseMatrix"))
12 :     function(from) as(as(from, "dgeMatrix"), "dgCMatrix"))
13 : maechler 925
14 : maechler 1174 setAs("denseMatrix", "CsparseMatrix",
15 :     function(from) {
16 : maechler 1331 cl <- class(from)
17 :     notGen <- !is(from, "generalMatrix")
18 :     if (notGen) { ## e.g. for triangular | symmetric
19 : maechler 1174 ## FIXME: this is a *waste* in the case of packed matrices!
20 : maechler 1331 if (extends(cl, "dMatrix")) from <- as(from, "dgeMatrix")
21 : maechler 1548 else if(extends(cl, "nMatrix")) from <- as(from, "ngeMatrix")
22 : maechler 1331 else if(extends(cl, "lMatrix")) from <- as(from, "lgeMatrix")
23 :     else if(extends(cl, "zMatrix")) from <- as(from, "zgeMatrix")
24 :     else stop("undefined method for class ", cl)
25 : maechler 1174 }
26 : maechler 1618 ## FIXME: contrary to its name, this only works for "dge*" :
27 : maechler 1280 .Call(dense_to_Csparse, from)
28 : maechler 1174 })
29 : maechler 925
30 : maechler 1174 setAs("denseMatrix", "TsparseMatrix",
31 :     function(from) as(as(from, "CsparseMatrix"), "TsparseMatrix"))
32 :    
33 :    
34 : maechler 956 setMethod("show", signature(object = "denseMatrix"),
35 :     function(object) prMatrix(object))
36 :     ##- ## FIXME: The following is only for the "dMatrix" objects that are not
37 :     ##- ## "dense" nor "sparse" -- i.e. "packed" ones :
38 :     ##- ## But these could be printed better -- "." for structural zeros.
39 :     ##- setMethod("show", signature(object = "dMatrix"), prMatrix)
40 :     ##- ## and improve this as well:
41 :     ##- setMethod("show", signature(object = "pMatrix"), prMatrix)
42 :     ##- ## this should now be superfluous [keep for safety for the moment]:
43 :    
44 : maechler 886 ## Using "index" for indices should allow
45 : maechler 875 ## integer (numeric), logical, or character (names!) indices :
46 :    
47 : maechler 1329 ## use geClass() when 'i' or 'j' are missing:
48 :     ## since symmetric, triangular, .. will not be preserved anyway:
49 : maechler 886 setMethod("[", signature(x = "denseMatrix", i = "index", j = "missing",
50 : maechler 871 drop = "logical"),
51 : maechler 1329 function (x, i, drop) {
52 :     r <- as(x, "matrix")[i, , drop=drop]
53 :     if(is.null(dim(r))) r else as(r, geClass(x))
54 :     })
55 : maechler 871
56 : maechler 886 setMethod("[", signature(x = "denseMatrix", i = "missing", j = "index",
57 : maechler 871 drop = "logical"),
58 : maechler 1329 function (x, j, drop) {
59 :     r <- as(x, "matrix")[, j, drop=drop]
60 :     if(is.null(dim(r))) r else as(r, geClass(x))
61 :     })
62 : maechler 871
63 : maechler 886 setMethod("[", signature(x = "denseMatrix", i = "index", j = "index",
64 : maechler 871 drop = "logical"),
65 : maechler 1329 function (x, i, j, drop) {
66 :     r <- callGeneric(x = as(x, "matrix"), i=i, j=j, drop=drop)
67 : maechler 1673 if(is.null(dim(r)))
68 :     r
69 :     else {
70 :     cl <- class(x)
71 :     if(extends(cl, "symmetricMatrix") &&
72 :     length(i) == length(j) && all(i == j))
73 :     as(r, cl) ## keep original symmetric class
74 :     else as_geClass(r, cl)
75 :     }
76 : maechler 1329 })
77 : maechler 871
78 : maechler 965 ## Now the "[<-" ones --- see also those in ./Matrix.R
79 : maechler 871 ## It's recommended to use setReplaceMethod() rather than setMethod("[<-",.)
80 :     ## even though the former is currently just a wrapper for the latter
81 :    
82 : maechler 965 ## FIXME: 1) These are far from efficient
83 :     ## ----- 2) value = "numeric" is only ok for "ddense*"
84 : maechler 886 setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "missing",
85 : maechler 1673 value = "replValue"),
86 : maechler 1329 function (x, i, value) {
87 :     r <- as(x, "matrix")
88 :     r[i, ] <- value
89 :     as(r, geClass(x))
90 :     })
91 : maechler 871
92 : maechler 886 setReplaceMethod("[", signature(x = "denseMatrix", i = "missing", j = "index",
93 : maechler 1673 value = "replValue"),
94 : maechler 1329 function (x, j, value) {
95 :     r <- as(x, "matrix")
96 :     r[, j] <- value
97 :     as(r, geClass(x))
98 :     })
99 : maechler 871
100 : maechler 886 setReplaceMethod("[", signature(x = "denseMatrix", i = "index", j = "index",
101 : maechler 1673 value = "replValue"),
102 : maechler 1329 function (x, i, j, value) {
103 :     r <- as(x, "matrix")
104 :     r[i, j] <- value
105 :     as_geClass(r, class(x)) ## was as(r, class(x))
106 :     })
107 : maechler 871
108 :    
109 : maechler 1108 setMethod("isSymmetric", signature(object = "denseMatrix"),
110 : maechler 973 function(object, tol = 100*.Machine$double.eps) {
111 : maechler 886 ## pretest: is it square?
112 :     d <- dim(object)
113 :     if(d[1] != d[2]) return(FALSE)
114 :     ## else slower test
115 : maechler 973 if (is(object,"dMatrix"))
116 : maechler 886 isTRUE(all.equal(as(object, "dgeMatrix"),
117 : maechler 973 as(t(object), "dgeMatrix"), tol = tol))
118 : maechler 1548 else if (is(object, "nMatrix"))
119 :     identical(as(object, "ngeMatrix"),
120 :     as(t(object), "ngeMatrix"))
121 : maechler 973 else if (is(object, "lMatrix"))# not possible currently
122 : maechler 886 ## test for exact equality; FIXME(?): identical() too strict?
123 :     identical(as(object, "lgeMatrix"),
124 :     as(t(object), "lgeMatrix"))
125 : maechler 1165 else if (is(object, "zMatrix"))
126 :     stop("'zMatrix' not yet implemented")
127 :     else if (is(object, "iMatrix"))
128 :     stop("'iMatrix' not yet implemented")
129 : maechler 886 })
130 : bates 1059
131 : maechler 1165 setMethod("isTriangular", signature(object = "triangularMatrix"),
132 : maechler 1376 function(object, ...) TRUE)
133 : maechler 1165
134 : maechler 1238 setMethod("isTriangular", signature(object = "denseMatrix"), isTriMat)
135 : maechler 1165
136 : maechler 1174 setMethod("isDiagonal", signature(object = "denseMatrix"), .is.diagonal)
137 : maechler 1290
138 :     .as.dge.Fun <- function(x, na.rm = FALSE, dims = 1) {
139 :     x <- as(x, "dgeMatrix")
140 :     callGeneric()
141 :     }
142 :     setMethod("colSums", signature(x = "denseMatrix"), .as.dge.Fun)
143 :     setMethod("colMeans", signature(x = "denseMatrix"), .as.dge.Fun)
144 :     setMethod("rowSums", signature(x = "denseMatrix"), .as.dge.Fun)
145 :     setMethod("rowMeans", signature(x = "denseMatrix"), .as.dge.Fun)

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