SCM

SCM Repository

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

Annotation of /pkg/R/dsparseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1315 - (view) (download)

1 : maechler 925 ## For multiplication operations, sparseMatrix overrides other method
2 :     ## selections. Coerce a ddensematrix argument to a dgeMatrix.
3 :    
4 :     setMethod("%*%", signature(x = "dsparseMatrix", y = "ddenseMatrix"),
5 :     function(x, y) callGeneric(x, as(y, "dgeMatrix")))
6 :    
7 :     setMethod("%*%", signature(x = "ddenseMatrix", y = "dsparseMatrix"),
8 :     function(x, y) callGeneric(as(x, "dgeMatrix"), y))
9 :    
10 :     setMethod("crossprod", signature(x = "dsparseMatrix", y = "ddenseMatrix"),
11 :     function(x, y = NULL) callGeneric(x, as(y, "dgeMatrix")))
12 :    
13 :     setMethod("crossprod", signature(x = "ddenseMatrix", y = "dsparseMatrix"),
14 :     function(x, y = NULL) callGeneric(as(x, "dgeMatrix"), y))
15 :    
16 : maechler 1315 setMethod("diag", signature(x = "dsparseMatrix"),
17 :     function(x, nrow, ncol = n) diag(as(x, "dgCMatrix")))
18 :    
19 : maechler 925 ## and coerce dsparse* to dgC*
20 :     setMethod("%*%", signature(x = "dsparseMatrix", y = "dgeMatrix"),
21 :     function(x, y) callGeneric(as(x, "dgCMatrix"), y))
22 :    
23 :     setMethod("%*%", signature(x = "dgeMatrix", y = "dsparseMatrix"),
24 :     function(x, y) callGeneric(x, as(y, "dgCMatrix")))
25 :    
26 :     setMethod("crossprod", signature(x = "dsparseMatrix", y = "dgeMatrix"),
27 :     function(x, y = NULL) callGeneric(as(x, "dgCMatrix"), y))
28 :    
29 :     ## NB: there's already
30 :     ## ("CsparseMatrix", "missing") and ("TsparseMatrix", "missing") methods
31 :    
32 :     setMethod("crossprod", signature(x = "dgeMatrix", y = "dsparseMatrix"),
33 :     function(x, y = NULL) callGeneric(x, as(y, "dgCMatrix")))
34 :    
35 : maechler 946 setMethod("image", "dsparseMatrix",
36 :     function(x, ...) image(as(x, "dgTMatrix"), ...))
37 :    
38 : maechler 956 setMethod("kronecker", signature(X = "dsparseMatrix", Y = "dsparseMatrix"),
39 :     function (X, Y, FUN = "*", make.dimnames = FALSE, ...)
40 :     callGeneric(as(X, "dgTMatrix"),as(Y, "dgTMatrix")))
41 : maechler 946
42 : maechler 956
43 : maechler 925 ## Group Methods, see ?Arith (e.g.)
44 :     ## -----
45 :    
46 : maechler 1226 setMethod("Arith", ## "+", "-", "*", "^", "%%", "%/%", "/"
47 :     signature(e1 = "dsparseMatrix", e2 = "dsparseMatrix"),
48 :     function(e1, e2) callGeneric(as(e1, "dgCMatrix"),
49 :     as(e2, "dgCMatrix")))
50 :     setMethod("Arith",
51 :     signature(e1 = "dsparseMatrix", e2 = "numeric"),
52 :     function(e1, e2) callGeneric(as(e1, "dgCMatrix"), e2))
53 :     setMethod("Arith",
54 :     signature(e1 = "numeric", e2 = "dsparseMatrix"),
55 :     function(e1, e2) callGeneric(e1, as(e2, "dgCMatrix")))
56 : maechler 925
57 :     setMethod("Math",
58 : maechler 946 signature(x = "dsparseMatrix"),
59 :     function(x) {
60 :     r <- callGeneric(as(x, "dgCMatrix"))
61 :     if(is(r, "dsparseMatrix")) as(r, class(x))
62 :     })
63 : maechler 925
64 : maechler 946 if(FALSE) ## unneeded with "Math2" in ./dMatrix.R
65 : maechler 925 setMethod("Math2",
66 : maechler 946 signature(x = "dsparseMatrix", digits = "numeric"),
67 :     function(x, digits) {
68 :     r <- callGeneric(as(x, "dgCMatrix"), digits = digits)
69 :     if(is(r, "dsparseMatrix")) as(r, class(x))
70 :     })
71 : maechler 925
72 :    
73 :     ### cbind2 / rbind2
74 :     if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
75 :     ## for R 2.2.x (and later):
76 :    
77 :     ### cbind2
78 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "numeric"),
79 :     function(x, y) {
80 :     d <- dim(x); nr <- d[1]; nc <- d[2]; cl <- class(x)
81 :     x <- as(x, "dgCMatrix")
82 :     if(nr > 0) {
83 :     y <- rep(y, length.out = nr) # 'silent procrustes'
84 :     n0y <- y != 0
85 :     n.e <- length(x@i)
86 :     x@i <- c(x@i, (0:(nr-1))[n0y])
87 :     x@p <- c(x@p, n.e + sum(n0y))
88 :     x@x <- c(x@x, y[n0y])
89 :     } else { ## nr == 0
90 :    
91 :     }
92 :     x@Dim[2] <- nc + 1:1
93 :     if(is.character(dn <- x@Dimnames[[2]]))
94 :     x@Dimnames[[2]] <- c(dn, "")
95 :     x
96 :     })
97 :     ## the same, (x,y) <-> (y,x):
98 :     setMethod("cbind2", signature(x = "numeric", y = "dsparseMatrix"),
99 :     function(x, y) {
100 :     d <- dim(y); nr <- d[1]; nc <- d[2]; cl <- class(y)
101 :     y <- as(y, "dgCMatrix")
102 :     if(nr > 0) {
103 :     x <- rep(x, length.out = nr) # 'silent procrustes'
104 :     n0x <- x != 0
105 :     y@i <- c((0:(nr-1))[n0x], y@i)
106 :     y@p <- c(0:0, sum(n0x) + y@p)
107 :     y@x <- c(x[n0x], y@x)
108 :     } else { ## nr == 0
109 :    
110 :     }
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 :    
117 :    
118 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "matrix"),
119 :     function(x, y) callGeneric(x, as(y, "dgCMatrix")))
120 :     setMethod("cbind2", signature(x = "matrix", y = "dsparseMatrix"),
121 :     function(x, y) callGeneric(as(x, "dgCMatrix"), y))
122 :    
123 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
124 :     function(x, y) {
125 :     nr <- rowCheck(x,y)
126 :     ## beware of (packed) triangular, symmetric, ...
127 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
128 :     dny <- dimnames(y)), is.null))
129 : maechler 1280 ans <- .Call(Csparse_horzcat,
130 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
131 : maechler 925 if(hasDN) {
132 :     ## R and S+ are different in which names they take
133 :     ## if they differ -- but there's no warning in any case
134 :     rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
135 :     cx <- dnx[[2]] ; cy <- dny[[2]]
136 :     cn <- if(is.null(cx) && is.null(cy)) NULL
137 : bates 1218 else c(if(!is.null(cx)) cx else rep.int("", ncol(x)),
138 :     if(!is.null(cy)) cy else rep.int("", ncol(y)))
139 :     ans@Dimnames <- list(rn, cn)
140 : maechler 925 }
141 : bates 1218 ans
142 : maechler 925 })
143 :    
144 : bates 1218 setMethod("rbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
145 :     function(x, y) {
146 :     nr <- colCheck(x,y)
147 :     ## beware of (packed) triangular, symmetric, ...
148 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
149 :     dny <- dimnames(y)), is.null))
150 : maechler 1280 ans <- .Call(Csparse_vertcat,
151 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
152 : bates 1218 if(hasDN) {
153 :     ## R and S+ are different in which names they take
154 :     ## if they differ -- but there's no warning in any case
155 :     cn <- if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]
156 :     rx <- dnx[[1]] ; ry <- dny[[1]]
157 :     rn <- if(is.null(rx) && is.null(ry)) NULL
158 :     else c(if(!is.null(rx)) rx else rep.int("", nrow(x)),
159 :     if(!is.null(ry)) ry else rep.int("", nrow(y)))
160 :     ans@Dimnames <- list(rn, cn)
161 :     }
162 :     ans
163 :     })
164 : maechler 925
165 :     }## 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