SCM

SCM Repository

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

Annotation of /pkg/R/lMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2256 - (view) (download)

1 : maechler 1747 setAs("matrix", "lMatrix",
2 :     function(from) { storage.mode(from) <- "logical" ; Matrix(from) })
3 :    
4 : mmaechler 2175 ## NOTE: This is *VERY* parallel to ("dMatrix" -> "nMatrix") in ./dMatrix.R :
5 : maechler 1548 setAs("lMatrix", "nMatrix",
6 :     function(from) {
7 :     if(any(is.na(from@x)))
8 :     stop("\"lMatrix\" object with NAs cannot be coerced to \"nMatrix\"")
9 : mmaechler 2175 ## i.e. from@x are only TRUE or FALSE
10 :     cld <- getClassDef(cl <- class(from))
11 :     if(extends(cld, "diagonalMatrix")) { # have no "ndi*" etc class
12 : maechler 1654 cl <- class(from <- as(from, "sparseMatrix"))
13 : mmaechler 2175 isSp <- TRUE
14 :     } else {
15 :     isSp <- extends(cld, "sparseMatrix")
16 :     if(isSp && !all(from@x)) {
17 : mmaechler 2256 from <- drop0(from) # was drop0(from, cld)
18 : mmaechler 2175 if(cl != (c. <- class(from)))
19 :     cld <- getClassDef(cl <- c.)
20 :     }
21 :     }
22 :     sNams <- slotNames(cld)
23 :     copyClass(from, sub("^l", "n", cl),
24 :     if(isSp) sNams[sNams != "x"] else sNams)
25 : maechler 1548 })
26 :    
27 :     ## and the reverse as well :
28 :    
29 :     setAs("nMatrix", "lMatrix",
30 :     function(from) {
31 : mmaechler 2175 cld <- getClassDef(cl <- class(from))
32 :     r <- copyClass(from, sub("^n", "l", cl), slotNames(cld))
33 :     if(extends(cld, "sparseMatrix"))
34 :     r@x <- rep.int(TRUE, length(if(!extends(cld, "RsparseMatrix"))
35 :     from@i else from@j))
36 : maechler 1548 r
37 :     })
38 :    
39 :     setAs("dMatrix", "lMatrix",
40 :     function(from) {
41 : mmaechler 2183 cld <- getClassDef(newCl <- class2(cl <- class(from), "l"))
42 : mmaechler 2175 sNams <- slotNames(cld)
43 : mmaechler 2183 r <- copyClass(from, newCl, sNames = sNams[sNams != "x"])
44 : maechler 1548 r@x <- as.logical(from@x)
45 :     r
46 :     })
47 :    
48 :     setAs("lMatrix", "dMatrix",
49 :     function(from) {
50 : mmaechler 2175 cld <- getClassDef(cl <- class(from))
51 :     sNams <- slotNames(cld)
52 :     r <- copyClass(from, newCl = sub("^l", "d", cl),
53 :     sNames = sNams[sNams != "x"])
54 : maechler 1548 r@x <- as.double(from@x)
55 :     r
56 :     })
57 : maechler 1571
58 :     ## needed at least for lsparse* :
59 :     setAs("lMatrix", "dgCMatrix",
60 :     function(from) as(as(from, "lgCMatrix"), "dgCMatrix"))
61 : maechler 1705
62 : maechler 2005 ## all() methods ---> ldenseMatrix.R and lsparseMatrix.R
63 :    
64 :     setMethod("any", signature(x = "lMatrix"),
65 :     function(x, ..., na.rm = FALSE)
66 :     ## logical unit-triangular has TRUE diagonal:
67 :     (prod(dim(x)) >= 1 && is(x, "triangularMatrix") && x@diag == "U") ||
68 :     any(x@x, ..., na.rm = na.rm))

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