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