SCM

SCM Repository

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

Annotation of /pkg/R/ldenseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 954 - (view) (download)

1 : maechler 946 l2d_Matrix <- function(from) {
2 :     stopifnot(is(from, "lMatrix"))
3 :     newCl <- sub("^l", "d", class(from))
4 :     r <- new(newCl, x = as.double(from@x),
5 :     Dim = from@Dim, Dimnames = from@Dimnames,
6 :     factors = list()) ## FIXME: treat 'factors' smartly
7 :     if(is(r, "triangularMatrix")) {
8 :     r@uplo <- from@uplo
9 :     r@diag <- from@diag
10 :     } else if(is(r, "symmetricMatrix")) {
11 :     r@uplo <- from@uplo
12 :     }
13 :     r
14 :     }
15 :    
16 :     dummy_meth <- function(x) {
17 :     cl <- class(x)
18 :     as(callGeneric(as(x, sub("^l", "d", cl))), cl)
19 :     }
20 :    
21 :     setAs("lgeMatrix", "dgeMatrix", l2d_Matrix)
22 :     setAs("ltrMatrix", "dtrMatrix", l2d_Matrix)
23 :     setAs("ltpMatrix", "dtpMatrix", l2d_Matrix)
24 :     setAs("lsyMatrix", "dsyMatrix", l2d_Matrix)
25 :     setAs("lspMatrix", "dspMatrix", l2d_Matrix)
26 :    
27 :     setAs("lspMatrix", "lsyMatrix",
28 :     function(from) .Call("lspMatrix_as_lsyMatrix", from) )
29 :     setAs("lsyMatrix", "lspMatrix",
30 :     function(from) .Call("lsyMatrix_as_lspMatrix", from) )
31 :    
32 :     setAs("ltpMatrix", "ltrMatrix",
33 :     function(from) .Call("ltpMatrix_as_ltrMatrix", from) )
34 :     setAs("ltrMatrix", "ltpMatrix",
35 :     function(from) .Call("ltrMatrix_as_ltpMatrix", from) )
36 :    
37 :     setAs("ldenseMatrix", "matrix",
38 :     function(from) as(as(from, sub("^l", "d", class(from))), "matrix"))
39 :    
40 :     setAs("matrix", "ldenseMatrix",
41 :     function(from) callGeneric(as(from, "lgeMatrix")))
42 :    
43 :     setMethod("t", signature(x = "lgeMatrix"), t_geMatrix)
44 :     setMethod("t", signature(x = "ltrMatrix"), t_trMatrix)
45 :     setMethod("t", signature(x = "lsyMatrix"), t_trMatrix)
46 :     setMethod("t", signature(x = "ltpMatrix"),
47 :     function(x) as(callGeneric(as(x, "ltrMatrix")), "ltpMatrix"))
48 :     setMethod("t", signature(x = "lspMatrix"),
49 :     function(x) as(callGeneric(as(x, "lsyMatrix")), "lspMatrix"))
50 : maechler 954
51 :     setMethod("!", "ltrMatrix",
52 :     function(e1) {
53 :     e1@x <- !e1@x
54 :     ## And now we must fill in the '!FALSE' results :
55 :    
56 :     ## FIXME: the following should be .Call using
57 :     ## a variation of make_array_triangular:
58 :     r <- as(e1, "lgeMatrix")
59 :     n <- e1@Dim[1]
60 :     coli <- rep(1:n, each=n)
61 :     rowi <- rep(1:n, n)
62 :     Udiag <- e1@diag == "U"
63 :     log.i <-
64 :     if(e1@uplo == "U") {
65 :     if(Udiag) rowi >= coli else rowi > coli
66 :     } else {
67 :     if(Udiag) rowi <= coli else rowi < coli
68 :     }
69 :     r[log.i] <- TRUE
70 :     r
71 :     })
72 :    
73 :     setMethod("!", "ltpMatrix", function(e1) !as(x, "ltrMatrix"))
74 :    
75 :     ## for the other ldense* ones:
76 :     setMethod("!", "ldenseMatrix",
77 :     function(e1) { e1@x <- !e1@x ; e1 })

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