File: lsparseMatrix.R

package info (click to toggle)
rmatrix 1.3-2-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 7,024 kB
  • sloc: ansic: 42,435; makefile: 330; sh: 180
file content (32 lines) | stat: -rw-r--r-- 998 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#### Superclass Methods for all sparse logical matrices


C2l <- function(from) {
    if(extends(cld <- getClassDef(class(from)), "lsparseMatrix"))
	return(from)
    ## else
    if(!(is.n <- extends(cld, "nsparseMatrix"))) {
        ## len.x <- length(from@x)
        from <- .Call(Csparse_drop, from, 0)
        ## did.drop <- length(from@x) != len.x
    }
    r <- as(.C2nC(from, extends(cld, "triangularMatrix")), "lsparseMatrix")
    if(!is.n && any(ina <- is.na(from@x))) { ## NAs must remain NA
        ## since we dropped, we "know"  that the 'x' slots match:
        stopifnot(length(from@x) == length(r@x))
        is.na(r@x) <- ina
    }
    r
}

setAs("CsparseMatrix", "lMatrix", C2l)
setAs("CsparseMatrix", "lsparseMatrix", C2l)

setAs("lsparseMatrix", "matrix",
      function(from) as(as(from, "ldenseMatrix"), "matrix"))

setAs("lsparseMatrix", "dsparseMatrix", function(from) as(from, "dMatrix"))



setMethod("image", "lsparseMatrix", function(x, ...) image(as(x,"dMatrix"), ...))