The R Project SVN R-packages

Rev

Rev 4868 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4868 Rev 4953
Line 18... Line 18...
18 
 
 18 
 
19 
## R_to_CMatrix
 19 
## R_to_CMatrix
20 
## ------------ --> ../src/dgCMatrix.c
 20 
## ------------ --> ../src/dgCMatrix.c
21 
.R.2.C <- function(from) .Call(R_to_CMatrix, from)
 21 
.R.2.C <- function(from) .Call(R_to_CMatrix, from)
22 
 
 22 
 
23 
if(FALSE)## "slow" R-level workaround
 23 
if(FALSE)## "slow" unneeded R-level version
24 
.R.2.C <- function(from)
 24 
.R.2.C <- function(from)
25 
{
 25 
{
26 
    cl <- class(from)
 26 
    cl <- class(from)
27 
    valid <- c("dgRMatrix", "dsRMatrix", "dtRMatrix",
 27 
    valid <- c("dgRMatrix", "dsRMatrix", "dtRMatrix",
28 
               "lgRMatrix", "lsRMatrix", "ltRMatrix",
 28 
               "lgRMatrix", "lsRMatrix", "ltRMatrix",
Line 104... Line 104...
104 
setAs("RsparseMatrix", "dgeMatrix",
 104 
setAs("RsparseMatrix", "dgeMatrix",
105 
      function(from) as(.R.2.C(from), "dgeMatrix"))
 105 
      function(from) as(.R.2.C(from), "dgeMatrix"))
106 
setAs("RsparseMatrix", "matrix",
 106 
setAs("RsparseMatrix", "matrix",
107 
      function(from) as(.R.2.C(from), "matrix"))
 107 
      function(from) as(.R.2.C(from), "matrix"))
108 
 
 108 
 
109 
## **VERY** cheap substitutes:  work via dgC and t(.)
 109 
## **VERY** cheap substitute:  work via dgC and t(.)
110 
.viaC.to.dgR <- function(from) {
 110 
.viaC.to.dgR <- function(from) {
111 
    m <- as(t(from), "dgCMatrix")
 111 
    m <- as(t(from), "dgCMatrix")
112 
    new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
 112 
    new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
113 
	p = m@p, j = m@i, x = m@x)
 113 
	p = m@p, j = m@i, x = m@x)
114 
}
 114 
}
115 
 
 115 
 
- 
 
 116 
## one of the few coercions "to <specific>" {tested in ../tests/Class+Meth.R}
116 
setAs("matrix",    "dgRMatrix", .viaC.to.dgR)## one of the few coercions "to specific"
 117 
setAs("matrix", "dgRMatrix", .viaC.to.dgR)
- 
 
 118 
 
- 
 
 119 
## *very* cheap substitute:  work via t(.) and Csparse
- 
 
 120 
.viaC.to.R <- function(from) {
- 
 
 121 
    m <- as(t(from), "CsparseMatrix")# preserve symmetry/triangular
- 
 
 122 
    clx <- getClassDef(class(m))
- 
 
 123 
    has.x <- !extends(clx, "nsparseMatrix")## <==> has 'x' slot
- 
 
 124 
    ## instead of "d": .M.kind (m,cl)
- 
 
 125 
    ## instead of "g": ..M.shape(m,cl)
- 
 
 126 
    sh <- .M.shapeC(m,clx)
- 
 
 127 
    r <- new(paste(.M.kindC(clx), sh, "RMatrix", sep=""))
- 
 
 128 
    r@Dim <- dim(from)
- 
 
 129 
    r@Dimnames <-  .M.DN(from)
- 
 
 130 
    r@p <- m@p
- 
 
 131 
    r@j <- m@i
- 
 
 132 
    if(has.x)
- 
 
 133 
	r@x <- m@x
- 
 
 134 
    if(sh != "g") {
- 
 
 135 
	r@uplo <- m@uplo
- 
 
 136 
	if(sh == "t")
- 
 
 137 
	    r@diag <- m@diag
- 
 
 138 
    }
- 
 
 139 
    r
- 
 
 140 
}
- 
 
 141 
 
117 
setAs("matrix",    "RsparseMatrix", .viaC.to.dgR)
 142 
setAs("matrix",       "RsparseMatrix", .viaC.to.R)
118 
setAs("ddenseMatrix", "RsparseMatrix", .viaC.to.dgR)
 143 
setAs("ddenseMatrix", "RsparseMatrix", .viaC.to.R)
119 
setAs("dsparseMatrix", "RsparseMatrix", .viaC.to.dgR)
 144 
setAs("dsparseMatrix","RsparseMatrix", .viaC.to.R)
120 
 
 145 
 
121 
## symmetric: can use same 'p' slot
 146 
## symmetric: can use same 'p' slot
122 
setAs("dsCMatrix", "dsRMatrix",
 147 
setAs("dsCMatrix", "dsRMatrix",
123 
      function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
 148 
      function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
124 
	      p = from@p, j = from@i, x = from@x,
 149 
	      p = from@p, j = from@i, x = from@x,