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 1331 - (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 1331 ## Cheap version: work via "dgCMatrix" and use the group methods there:
47 :     ## NB: have also CsparseMatrix methods (-> ./Csparse.R )
48 :     ## which may preserve "symmetric", "triangular", ...
49 :     ## those must trigger *before* these [currently works via alphabetic order..!]
50 : maechler 1226 setMethod("Arith", ## "+", "-", "*", "^", "%%", "%/%", "/"
51 :     signature(e1 = "dsparseMatrix", e2 = "dsparseMatrix"),
52 :     function(e1, e2) callGeneric(as(e1, "dgCMatrix"),
53 :     as(e2, "dgCMatrix")))
54 :     setMethod("Arith",
55 :     signature(e1 = "dsparseMatrix", e2 = "numeric"),
56 :     function(e1, e2) callGeneric(as(e1, "dgCMatrix"), e2))
57 :     setMethod("Arith",
58 :     signature(e1 = "numeric", e2 = "dsparseMatrix"),
59 :     function(e1, e2) callGeneric(e1, as(e2, "dgCMatrix")))
60 : maechler 925
61 : maechler 1331
62 : maechler 925 setMethod("Math",
63 : maechler 946 signature(x = "dsparseMatrix"),
64 :     function(x) {
65 :     r <- callGeneric(as(x, "dgCMatrix"))
66 :     if(is(r, "dsparseMatrix")) as(r, class(x))
67 :     })
68 : maechler 925
69 : maechler 1331 ## "Math2" is in ./dMatrix.R
70 : maechler 925
71 :    
72 :     ### cbind2 / rbind2
73 :     if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
74 :     ## for R 2.2.x (and later):
75 :    
76 :     ### cbind2
77 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "numeric"),
78 :     function(x, y) {
79 :     d <- dim(x); nr <- d[1]; nc <- d[2]; cl <- class(x)
80 :     x <- as(x, "dgCMatrix")
81 :     if(nr > 0) {
82 :     y <- rep(y, length.out = nr) # 'silent procrustes'
83 :     n0y <- y != 0
84 :     n.e <- length(x@i)
85 :     x@i <- c(x@i, (0:(nr-1))[n0y])
86 :     x@p <- c(x@p, n.e + sum(n0y))
87 :     x@x <- c(x@x, y[n0y])
88 :     } else { ## nr == 0
89 :    
90 :     }
91 :     x@Dim[2] <- nc + 1:1
92 :     if(is.character(dn <- x@Dimnames[[2]]))
93 :     x@Dimnames[[2]] <- c(dn, "")
94 :     x
95 :     })
96 :     ## the same, (x,y) <-> (y,x):
97 :     setMethod("cbind2", signature(x = "numeric", y = "dsparseMatrix"),
98 :     function(x, y) {
99 :     d <- dim(y); nr <- d[1]; nc <- d[2]; cl <- class(y)
100 :     y <- as(y, "dgCMatrix")
101 :     if(nr > 0) {
102 :     x <- rep(x, length.out = nr) # 'silent procrustes'
103 :     n0x <- x != 0
104 :     y@i <- c((0:(nr-1))[n0x], y@i)
105 :     y@p <- c(0:0, sum(n0x) + y@p)
106 :     y@x <- c(x[n0x], y@x)
107 :     } else { ## nr == 0
108 :    
109 :     }
110 :     y@Dim[2] <- nc + 1:1
111 :     if(is.character(dn <- y@Dimnames[[2]]))
112 :     y@Dimnames[[2]] <- c(dn, "")
113 :     y
114 :     })
115 :    
116 :    
117 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "matrix"),
118 :     function(x, y) callGeneric(x, as(y, "dgCMatrix")))
119 :     setMethod("cbind2", signature(x = "matrix", y = "dsparseMatrix"),
120 :     function(x, y) callGeneric(as(x, "dgCMatrix"), y))
121 :    
122 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
123 :     function(x, y) {
124 :     nr <- rowCheck(x,y)
125 :     ## beware of (packed) triangular, symmetric, ...
126 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
127 :     dny <- dimnames(y)), is.null))
128 : maechler 1280 ans <- .Call(Csparse_horzcat,
129 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
130 : maechler 925 if(hasDN) {
131 :     ## R and S+ are different in which names they take
132 :     ## if they differ -- but there's no warning in any case
133 :     rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
134 :     cx <- dnx[[2]] ; cy <- dny[[2]]
135 :     cn <- if(is.null(cx) && is.null(cy)) NULL
136 : bates 1218 else c(if(!is.null(cx)) cx else rep.int("", ncol(x)),
137 :     if(!is.null(cy)) cy else rep.int("", ncol(y)))
138 :     ans@Dimnames <- list(rn, cn)
139 : maechler 925 }
140 : bates 1218 ans
141 : maechler 925 })
142 :    
143 : bates 1218 setMethod("rbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
144 :     function(x, y) {
145 :     nr <- colCheck(x,y)
146 :     ## beware of (packed) triangular, symmetric, ...
147 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
148 :     dny <- dimnames(y)), is.null))
149 : maechler 1280 ans <- .Call(Csparse_vertcat,
150 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
151 : bates 1218 if(hasDN) {
152 :     ## R and S+ are different in which names they take
153 :     ## if they differ -- but there's no warning in any case
154 :     cn <- if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]
155 :     rx <- dnx[[1]] ; ry <- dny[[1]]
156 :     rn <- if(is.null(rx) && is.null(ry)) NULL
157 :     else c(if(!is.null(rx)) rx else rep.int("", nrow(x)),
158 :     if(!is.null(ry)) ry else rep.int("", nrow(y)))
159 :     ans@Dimnames <- list(rn, cn)
160 :     }
161 :     ans
162 :     })
163 : maechler 925
164 :     }## 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