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

1 : bates 483 setMethod("t", signature(x = "dtCMatrix"),
2 : bates 1209 function(x) {
3 : maechler 1280 tg <- .Call(csc_transpose, x)
4 : bates 1259 new("dtCMatrix", Dim = tg@Dim, Dimnames = x@Dimnames[2:1],
5 : bates 1209 p = tg@p, i = tg@i, x = tg@x, diag = x@diag,
6 :     uplo = ifelse(x@uplo == "U", "L", "U"))
7 :     }, valueClass = "dtCMatrix")
8 : bates 70
9 : maechler 1202 setAs("dtCMatrix", "ltCMatrix", # just drop 'x' slot:
10 : maechler 956 function(from) new("ltCMatrix", i = from@i, p = from@p,
11 :     uplo = from@uplo, diag = from@diag,
12 : maechler 1202 ## FIXME?: use from@factors smartly
13 : maechler 956 Dim = from@Dim, Dimnames = from@Dimnames))
14 : bates 923
15 : maechler 1174 setAs("matrix", "dtCMatrix",
16 :     function(from) as(as(from, "dtTMatrix"), "dtCMatrix"))
17 :    
18 : maechler 959 setAs("dtCMatrix", "dgCMatrix",
19 :     function(from) {
20 :     if(from@diag == "U") { ## add diagonal of 1's
21 :     ##FIXME: do this smartly - directly {in C or R}
22 :     as(as(from, "dgTMatrix"), "dgCMatrix")
23 :     }
24 :     else
25 :     new("dgCMatrix",
26 :     i = from@i, p = from@p, x = from@x,
27 :     Dim = from@Dim, Dimnames = from@Dimnames)
28 :     })
29 :    
30 : maechler 1238 setAs("dgCMatrix", "dtCMatrix", # to triangular:
31 :     function(from) as(as(as(from, "dgTMatrix"), "dtTMatrix"), "dtCMatrix"))
32 :    
33 : bates 483 setAs("dtCMatrix", "dgTMatrix",
34 : bates 1037 function(from)
35 : maechler 1280 .Call(tsc_to_dgTMatrix, from))
36 : bates 70
37 : bates 483 setAs("dtCMatrix", "dgeMatrix",
38 : bates 477 function(from) as(as(from, "dgTMatrix"), "dgeMatrix"))
39 : maechler 1174
40 :     ## These are all needed because cholmod doesn't support triangular:
41 :     ## (see end of ./Csparse.R )
42 :     setAs("dtCMatrix", "dtTMatrix",
43 :     function(from) {# and this is not elegant:
44 :     x <- as(from, "dgTMatrix")
45 : maechler 1253 if (from@diag == "U") { ## drop diagonal entries '1':
46 :     i <- x@i; j <- x@j
47 :     nonD <- i != j
48 :     xx <- x@x[nonD] ; i <- i[nonD] ; j <- j[nonD]
49 :     } else {
50 :     xx <- x@x; i <- x@i; j <- x@j
51 :     }
52 :     new("dtTMatrix", x = xx, i = i, j = j, Dim = x@Dim,
53 :     Dimnames = x@Dimnames, uplo = from@uplo, diag = from@diag)
54 : maechler 1174 })
55 :    
56 :     setAs("dtCMatrix", "TsparseMatrix", function(from) as(from, "dtTMatrix"))
57 : bates 1251
58 : maechler 1174 setAs("dtCMatrix", "dtrMatrix",
59 :     function(from) as(as(from, "dtTMatrix"), "dtrMatrix"))
60 : bates 1251
61 : maechler 1253 ## using diagU2N() from ./Auxiliaries.R :
62 : bates 1251 setMethod("solve", signature(a = "dtCMatrix", b = "missing"),
63 :     function(a, b, ...) {
64 : maechler 1331 if (a@diag == "U") {
65 :     if (a@uplo == "U")
66 :     return(.Call(dtCMatrix_upper_solve, a))
67 :     else
68 :     return(t(.Call(dtCMatrix_upper_solve, t(a))))
69 :     }
70 :     .Call(dtCMatrix_solve, a)
71 : maechler 1253 }, valueClass = "dtCMatrix")
72 : bates 1251
73 :     setMethod("solve", signature(a = "dtCMatrix", b = "dgeMatrix"),
74 :     function(a, b, ...) {
75 : maechler 1253 if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
76 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, b, TRUE)
77 : maechler 1253 }, valueClass = "dgeMatrix")
78 : bates 1251
79 :     setMethod("solve", signature(a = "dtCMatrix", b = "matrix"),
80 :     function(a, b, ...) {
81 : maechler 1253 if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
82 : bates 1251 storage.mode(b) <- "double"
83 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, b, FALSE)
84 : bates 1251 }, valueClass = "dgeMatrix")
85 :    
86 :     setMethod("solve", signature(a = "dtCMatrix", b = "numeric"),
87 :     function(a, b, ...) {
88 : maechler 1253 if (a@diag == "U") a <- as(diagU2N(a), "dtCMatrix")
89 : maechler 1280 .Call(dtCMatrix_matrix_solve, a, as.matrix(as.double(b)),
90 :     FALSE)
91 : 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