SCM

SCM Repository

[matrix] Annotation of /pkg/R/Csparse.R
ViewVC logotype

Annotation of /pkg/R/Csparse.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1270 - (view) (download)

1 : bates 923 setMethod("crossprod", signature(x = "CsparseMatrix", y = "missing"),
2 : bates 1267 function(x, y = NULL) {
3 : maechler 1270 a <- .Call("Csparse_crossprod", x, trans = FALSE, triplet = FALSE,
4 :     PACKAGE = "Matrix")
5 :     switch(substr(class(a)[1], 1, 1),
6 :     "d" ={ new("dsCMatrix", i = a@i, p = a@p, x = a@x,
7 :     Dim = a@Dim, Dimnames = a@Dimnames, uplo = "U",
8 :     factors = list()) },
9 :     "l" ={ new("lsCMatrix", i = a@i, p = a@p,
10 :     Dim = a@Dim, Dimnames = a@Dimnames, uplo = "U",
11 :     factors = list()) })
12 :     })
13 : bates 923
14 : bates 1267
15 : bates 923 setMethod("t", signature(x = "CsparseMatrix"),
16 : maechler 958 function(x)
17 :     .Call("Csparse_transpose", x, PACKAGE = "Matrix"))
18 :    
19 : maechler 1087 setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "missing"),
20 : bates 1267 function(x, y = NULL) {
21 : maechler 1270 a <- .Call("Csparse_crossprod", x, trans = TRUE, triplet = FALSE,
22 :     PACKAGE = "Matrix")
23 :     switch(substr(class(a)[1], 1, 1),
24 :     "d" ={ new("dsCMatrix", i = a@i, p = a@p, x = a@x,
25 :     Dim = a@Dim, Dimnames = a@Dimnames, uplo = "L",
26 :     factors = list()) },
27 :     "l" ={ new("lsCMatrix", i = a@i, p = a@p,
28 :     Dim = a@Dim, Dimnames = a@Dimnames, uplo = "L",
29 :     factors = list()) })
30 :     })
31 : bates 1267
32 : maechler 1087 ## FIXME (TODO):
33 :     ## setMethod("tcrossprod", signature(x = "CsparseMatrix", y = "CsparseMatrix"),
34 :     ## function(x, y)
35 :     ## .Call("Csparse_crossprod_2", x, y, trans = TRUE, triplet = FALSE,
36 :     ## PACKAGE = "Matrix"))
37 : bates 1059
38 : maechler 1087
39 : bates 1059 setMethod("%*%", signature(x = "CsparseMatrix", y = "CsparseMatrix"),
40 :     function(x, y) .Call("Csparse_Csparse_prod", x, y, PACKAGE = "Matrix"))
41 :    
42 :     setMethod("%*%", signature(x = "CsparseMatrix", y = "denseMatrix"),
43 :     function(x, y) .Call("Csparse_dense_prod", x, y, PACKAGE = "Matrix"))
44 :    
45 : maechler 1174
46 :     ## FIXME: the is(*,"generalMatrix") test at least makes these work,
47 :     ## but they are still ``wrong'', since triangularity is lost :
48 :    
49 : bates 1059 setAs("CsparseMatrix", "TsparseMatrix",
50 : maechler 1174 function(from) {
51 :     if(!is(from, "generalMatrix")) { ## e.g. for triangular | symmetric
52 :     if (is(from, "dMatrix")) from <- as(from, "dgCMatrix")
53 :     else if(is(from, "lMatrix")) from <- as(from, "lgCMatrix")
54 :     else if(is(from, "zMatrix")) from <- as(from, "zgCMatrix")
55 :     else stop("undefined method for class ", class(from))
56 :     }
57 :     .Call("Csparse_to_Tsparse", from, PACKAGE = "Matrix")
58 :     })
59 : bates 1059
60 :     setAs("CsparseMatrix", "denseMatrix",
61 : maechler 1174 function(from) {
62 :     if(!is(from, "generalMatrix")) { ## e.g. for triangular | symmetric
63 :     if (is(from, "dMatrix")) from <- as(from, "dgCMatrix")
64 :     else if(is(from, "lMatrix")) from <- as(from, "lgCMatrix")
65 :     else if(is(from, "zMatrix")) from <- as(from, "zgCMatrix")
66 :     else stop("undefined method for class ", class(from))
67 :     }
68 :     .Call("Csparse_to_dense", from, PACKAGE = "Matrix")
69 :     })
70 : bates 1265
71 : bates 1268 setMethod("tril", "CsparseMatrix",
72 :     function(x, k = 0, ...) {
73 :     k <- as.integer(k[1])
74 : bates 1265 dd <- dim(x)
75 : bates 1268 stopifnot(k >= -dd[1], k <= 0)
76 :     .Call("Csparse_band", x, -(dim(x)[1]), k)
77 : bates 1265 })
78 :    
79 : bates 1268 setMethod("triu", "CsparseMatrix",
80 :     function(x, k = 0, ...) {
81 :     k <- as.integer(k[1])
82 : bates 1265 dd <- dim(x)
83 : bates 1268 stopifnot(k >= 0, k <= dd[1])
84 :     .Call("Csparse_band", x, k, dd[2])
85 : bates 1265 })
86 : bates 1268
87 :     setMethod("band", "CsparseMatrix",
88 :     function(x, k1, k2, ...) {
89 :     k1 <- as.integer(k1[1])
90 :     k2 <- as.integer(k2[1])
91 :     dd <- dim(x)
92 :     stopifnot(k1 <= k2, k1 >= -dd[1], k2 <= dd[1])
93 :     .Call("Csparse_band", x, k1, k2)
94 :     })

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