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 1654 - (view) (download)

1 : maechler 925 ## For multiplication operations, sparseMatrix overrides other method
2 :     ## selections. Coerce a ddensematrix argument to a dgeMatrix.
3 :    
4 : bates 1460 ## setMethod("%*%", signature(x = "dsparseMatrix", y = "ddenseMatrix"),
5 :     ## function(x, y) callGeneric(x, as(y, "dgeMatrix")))
6 : maechler 925
7 : bates 1460 ## setMethod("%*%", signature(x = "ddenseMatrix", y = "dsparseMatrix"),
8 :     ## function(x, y) callGeneric(as(x, "dgeMatrix"), y))
9 : maechler 925
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 : bates 1460 ## setMethod("%*%", signature(x = "dsparseMatrix", y = "dgeMatrix"),
18 :     ## function(x, y) callGeneric(as(x, "dgCMatrix"), y))
19 : maechler 925
20 : bates 1460 ## setMethod("%*%", signature(x = "dgeMatrix", y = "dsparseMatrix"),
21 :     ## function(x, y) callGeneric(x, as(y, "dgCMatrix")))
22 : maechler 925
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 : maechler 1467 callGeneric(as(X, "dgTMatrix"), as(Y, "dgTMatrix")))
38 : maechler 946
39 : maechler 1654 setMethod("chol", signature(x = "dsparseMatrix", pivot = "ANY"),
40 :     function(x, pivot, ...) {
41 :     px <- as(x, "dsCMatrix")
42 :     if (isTRUE(validObject(px, test=TRUE))) chol(px, pivot)
43 :     else stop("'x' is not positive definite -- chol() undefined.")
44 :     })
45 :    
46 : maechler 1467 setMethod("lu", signature(x = "dsparseMatrix"),
47 :     function(x, ...) callGeneric(as(x, "dgCMatrix")))
48 : maechler 956
49 : maechler 1467
50 : maechler 925 ## Group Methods, see ?Arith (e.g.)
51 :     ## -----
52 :    
53 : maechler 1472 ##-> now moved to ./Csparse.R (and 'up' to ./sparseMatrix.R):
54 : maechler 1331 ## "Math2" is in ./dMatrix.R
55 : maechler 925
56 :    
57 :     ### cbind2
58 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "numeric"),
59 :     function(x, y) {
60 :     d <- dim(x); nr <- d[1]; nc <- d[2]; cl <- class(x)
61 :     x <- as(x, "dgCMatrix")
62 :     if(nr > 0) {
63 :     y <- rep(y, length.out = nr) # 'silent procrustes'
64 :     n0y <- y != 0
65 :     n.e <- length(x@i)
66 :     x@i <- c(x@i, (0:(nr-1))[n0y])
67 :     x@p <- c(x@p, n.e + sum(n0y))
68 :     x@x <- c(x@x, y[n0y])
69 :     } else { ## nr == 0
70 :    
71 :     }
72 :     x@Dim[2] <- nc + 1:1
73 :     if(is.character(dn <- x@Dimnames[[2]]))
74 :     x@Dimnames[[2]] <- c(dn, "")
75 :     x
76 :     })
77 :     ## the same, (x,y) <-> (y,x):
78 :     setMethod("cbind2", signature(x = "numeric", y = "dsparseMatrix"),
79 :     function(x, y) {
80 :     d <- dim(y); nr <- d[1]; nc <- d[2]; cl <- class(y)
81 :     y <- as(y, "dgCMatrix")
82 :     if(nr > 0) {
83 :     x <- rep(x, length.out = nr) # 'silent procrustes'
84 :     n0x <- x != 0
85 :     y@i <- c((0:(nr-1))[n0x], y@i)
86 :     y@p <- c(0:0, sum(n0x) + y@p)
87 :     y@x <- c(x[n0x], y@x)
88 :     } else { ## nr == 0
89 :    
90 :     }
91 :     y@Dim[2] <- nc + 1:1
92 :     if(is.character(dn <- y@Dimnames[[2]]))
93 :     y@Dimnames[[2]] <- c(dn, "")
94 :     y
95 :     })
96 :    
97 :    
98 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "matrix"),
99 :     function(x, y) callGeneric(x, as(y, "dgCMatrix")))
100 :     setMethod("cbind2", signature(x = "matrix", y = "dsparseMatrix"),
101 :     function(x, y) callGeneric(as(x, "dgCMatrix"), y))
102 :    
103 :     setMethod("cbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
104 :     function(x, y) {
105 :     nr <- rowCheck(x,y)
106 :     ## beware of (packed) triangular, symmetric, ...
107 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
108 :     dny <- dimnames(y)), is.null))
109 : maechler 1280 ans <- .Call(Csparse_horzcat,
110 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
111 : maechler 925 if(hasDN) {
112 :     ## R and S+ are different in which names they take
113 :     ## if they differ -- but there's no warning in any case
114 :     rn <- if(!is.null(dnx[[1]])) dnx[[1]] else dny[[1]]
115 :     cx <- dnx[[2]] ; cy <- dny[[2]]
116 :     cn <- if(is.null(cx) && is.null(cy)) NULL
117 : bates 1218 else c(if(!is.null(cx)) cx else rep.int("", ncol(x)),
118 :     if(!is.null(cy)) cy else rep.int("", ncol(y)))
119 :     ans@Dimnames <- list(rn, cn)
120 : maechler 925 }
121 : bates 1218 ans
122 : maechler 925 })
123 :    
124 : bates 1218 setMethod("rbind2", signature(x = "dsparseMatrix", y = "dsparseMatrix"),
125 :     function(x, y) {
126 :     nr <- colCheck(x,y)
127 :     ## beware of (packed) triangular, symmetric, ...
128 : maechler 1226 hasDN <- !all(lapply(c(dnx <- dimnames(x),
129 :     dny <- dimnames(y)), is.null))
130 : maechler 1280 ans <- .Call(Csparse_vertcat,
131 : maechler 1226 as(x, "dgCMatrix"), as(y, "dgCMatrix"))
132 : bates 1218 if(hasDN) {
133 :     ## R and S+ are different in which names they take
134 :     ## if they differ -- but there's no warning in any case
135 :     cn <- if(!is.null(dnx[[2]])) dnx[[2]] else dny[[2]]
136 :     rx <- dnx[[1]] ; ry <- dny[[1]]
137 :     rn <- if(is.null(rx) && is.null(ry)) NULL
138 :     else c(if(!is.null(rx)) rx else rep.int("", nrow(x)),
139 :     if(!is.null(ry)) ry else rep.int("", nrow(y)))
140 :     ans@Dimnames <- list(rn, cn)
141 :     }
142 :     ans
143 :     })
144 : maechler 925

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