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