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