SCM

SCM Repository

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

Annotation of /pkg/R/dtCMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1548 - (view) (download)

1 : bates 1507 #### Triangular Sparse Matrices in compressed column-oriented format
2 : bates 70
3 : maechler 1548 setAs("dtCMatrix", "ltCMatrix",
4 : maechler 956 function(from) new("ltCMatrix", i = from@i, p = from@p,
5 : maechler 1548 uplo = from@uplo, diag = from@diag,
6 :     x = as.logical(from@x),
7 :     ## FIXME?: use from@factors smartly
8 :     Dim = from@Dim, Dimnames = from@Dimnames))
9 :     setAs("dtCMatrix", "ntCMatrix", # just drop 'x' slot:
10 :     function(from) new("ntCMatrix", i = from@i, p = from@p,
11 :     uplo = from@uplo, diag = from@diag,
12 :     ## FIXME?: use from@factors smartly
13 :     Dim = from@Dim, Dimnames = from@Dimnames))
14 : bates 923
15 : maechler 1548
16 : maechler 1174 setAs("matrix", "dtCMatrix",
17 :     function(from) as(as(from, "dtTMatrix"), "dtCMatrix"))
18 :    
19 : maechler 959 setAs("dtCMatrix", "dgCMatrix",
20 :     function(from) {
21 : bates 1507 if (from@diag == "U")
22 :     from <- .Call(Csparse_diagU2N, from)
23 :     new("dgCMatrix",
24 :     i = from@i, p = from@p, x = from@x,
25 :     Dim = from@Dim, Dimnames = from@Dimnames)
26 : maechler 959 })
27 :    
28 : bates 1507 setAs("dtCMatrix", "dgTMatrix",
29 :     function(from) {
30 :     if (from@diag == "U") from <- .Call(Csparse_diagU2N, from)
31 :     ## ignore triangularity in conversion to TsparseMatrix
32 :     .Call(Csparse_to_Tsparse, from, FALSE)
33 :     })
34 :    
35 : maechler 1238 setAs("dgCMatrix", "dtCMatrix", # to triangular:
36 :     function(from) as(as(as(from, "dgTMatrix"), "dtTMatrix"), "dtCMatrix"))
37 :    
38 : bates 483 setAs("dtCMatrix", "dgeMatrix",
39 : bates 477 function(from) as(as(from, "dgTMatrix"), "dgeMatrix"))
40 : maechler 1174
41 :     ## These are all needed because cholmod doesn't support triangular:
42 :     ## (see end of ./Csparse.R )
43 :     setAs("dtCMatrix", "dtTMatrix",
44 :     function(from) {# and this is not elegant:
45 :     x <- as(from, "dgTMatrix")
46 : bates 1366 if (from@diag == "U") { ## drop diagonal entries '1':
47 :     i <- x@i; j <- x@j
48 :     nonD <- i != j
49 :     xx <- x@x[nonD] ; i <- i[nonD] ; j <- j[nonD]
50 :     } else {
51 :     xx <- x@x; i <- x@i; j <- x@j
52 :     }
53 :     new("dtTMatrix", x = xx, i = i, j = j, Dim = x@Dim,
54 :     Dimnames = x@Dimnames, uplo = from@uplo, diag = from@diag)
55 : maechler 1174 })
56 :    
57 : bates 1366 ## Now that we support triangular matrices use the inherited method.
58 :     ## setAs("dtCMatrix", "TsparseMatrix", function(from) as(from, "dtTMatrix"))
59 : bates 1251
60 : maechler 1174 setAs("dtCMatrix", "dtrMatrix",
61 :     function(from) as(as(from, "dtTMatrix"), "dtrMatrix"))
62 : bates 1251
63 : maechler 1253 ## using diagU2N() from ./Auxiliaries.R :
64 : bates 1251 setMethod("solve", signature(a = "dtCMatrix", b = "missing"),
65 :     function(a, b, ...) {
66 : maechler 1331 if (a@diag == "U") {
67 :     if (a@uplo == "U")
68 :     return(.Call(dtCMatrix_upper_solve, a))
69 :     else
70 :     return(t(.Call(dtCMatrix_upper_solve, t(a))))
71 :     }
72 :     .Call(dtCMatrix_solve, a)
73 : maechler 1253 }, valueClass = "dtCMatrix")
74 : bates 1251
75 :     setMethod("solve", signature(a = "dtCMatrix", b = "dgeMatrix"),
76 :     function(a, b, ...) {
77 : bates 1387 # if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
78 :     if (a@diag == "U") a <- .Call(Csparse_diagU2N, a)
79 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, b, TRUE)
80 : maechler 1253 }, valueClass = "dgeMatrix")
81 : bates 1251
82 :     setMethod("solve", signature(a = "dtCMatrix", b = "matrix"),
83 :     function(a, b, ...) {
84 : bates 1387 # if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
85 :     if (a@diag == "U") a <- .Call(Csparse_diagU2N, a)
86 : bates 1251 storage.mode(b) <- "double"
87 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, b, FALSE)
88 : bates 1251 }, valueClass = "dgeMatrix")
89 :    
90 : bates 1387 ## Isn't this case handled by the method for (a = "Matrix', b =
91 :     ## "numeric") in ./Matrix.R? Or is this method defined here for
92 :     ## the as.double coercion?
93 : bates 1251 setMethod("solve", signature(a = "dtCMatrix", b = "numeric"),
94 :     function(a, b, ...) {
95 : maechler 1253 if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
96 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, as.matrix(as.double(b)),
97 :     FALSE)
98 : maechler 1253 }, valueClass = "dgeMatrix")

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