SCM

SCM Repository

[matrix] View of /pkg/R/Rsparse.R
ViewVC logotype

View of /pkg/R/Rsparse.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1747 - (download) (annotate)
Mon Jan 29 20:17:33 2007 UTC (12 years, 7 months ago) by maechler
File size: 4699 byte(s)
many more coercions for diag(), "!", etc; see ChangeLog
#### Sparse Matrices in Compressed row-oriented format
####                               --- "R"

### ``mainly for completeness'' --- we *do* favour Csparse
##    - - - - - - - - - - - -   hence only "minimal" methods here !
##  see also ./SparseM-conv.R

### contains = "dMatrix"

setAs("RsparseMatrix", "TsparseMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))

setAs("RsparseMatrix", "CsparseMatrix",
      function(from) .Call(R_to_CMatrix, from))

##--- and all these are just "the essential low-level coercions" : ----------

setAs("dgRMatrix", "matrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
setAs("lgRMatrix", "matrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))
setAs("ngRMatrix", "matrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "matrix"))

setAs("dgRMatrix", "dgeMatrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "dgeMatrix"))
setAs("lgRMatrix", "lgeMatrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "lgeMatrix"))
setAs("ngRMatrix", "ngeMatrix",
      function(from) as(.Call(compressed_to_TMatrix, from, FALSE), "ngeMatrix"))

setAs("dgRMatrix", "dgCMatrix",
      function(from) .Call(R_to_CMatrix, from))
setAs("lgRMatrix", "lgCMatrix",
      function(from) .Call(R_to_CMatrix, from))
setAs("ngRMatrix", "ngCMatrix",
      function(from) .Call(R_to_CMatrix, from))
## really needed? :
setAs("dgRMatrix", "CsparseMatrix", function(from) as(from, "dgCMatrix"))


setAs("dgRMatrix", "dgTMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("lgRMatrix", "lgTMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("ngRMatrix", "ngTMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))

setAs("dsRMatrix", "dsyMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("lsRMatrix", "lsyMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("nsRMatrix", "nsyMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))

setAs("dtRMatrix", "dtrMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("ltRMatrix", "ltrMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))
setAs("ntRMatrix", "ntrMatrix",
      function(from) .Call(compressed_to_TMatrix, from, FALSE))

##setAs("matrix", "dgRMatrix",
##      function(from) {
##          storage.mode(from) <- "double"
##          .Call(matrix_to_csc, from)
##      })

## **VERY** cheap substitutes:  work via dgC and t(.)
.to.dgR <- function(from) {
    m <- as(t(from), "dgCMatrix")
    new("dgRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
	p = m@p, j = m@i, x = m@x)
}

setAs("matrix",    "dgRMatrix", .to.dgR)
setAs("dgeMatrix", "dgRMatrix", .to.dgR)
setAs("dgCMatrix", "dgRMatrix", .to.dgR)
setAs("dgTMatrix", "dgRMatrix", .to.dgR)

setAs("dsCMatrix", "dsRMatrix",
      function(from) new("dsRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
	      p = from@p, j = from@i, x = from@x,
	      uplo = if (from@uplo == "U") "L" else "U"))

setAs("dtCMatrix", "dtRMatrix",
      function(from) new("dtRMatrix", Dim = dim(from), Dimnames = .M.DN(from),
	      p = from@p, j = from@i, x = from@x, diag = from@diag,
	      uplo = if (from@uplo == "U") "L" else "U"))


##setAs("dgRMatrix", "dgeMatrix",
##      function(from) .Call(csc_to_dgeMatrix, from))

##setAs("matrix", "dgRMatrix",
##      function(from) {
##          storage.mode(from) <- "double"
##          .Call(matrix_to_csc, from)
##      })


##setMethod("diag", signature(x = "dgRMatrix"),
##          function(x = 1, nrow, ncol = n) .Call(csc_getDiag, x))

## try to define for "Matrix" -- once and for all -- but that fails -- why? __ FIXME __
## setMethod("dim", signature(x = "dgRMatrix"),
##           function(x) x@Dim, valueClass = "integer")

##setMethod("t", signature(x = "dgRMatrix"),
##          function(x) .Call(csc_transpose, x),
##          valueClass = "dgRMatrix")

setMethod("image", "dgRMatrix",
          function(x, ...) {
              x <- as(x, "dgTMatrix")
              callGeneric()
          })

setMethod("t", "RsparseMatrix",
	  function(x) as_Rsparse(t(as_Tsparse(x))))


## Want tril(), triu(), band() --- just as "indexing" ---
## return a "close" class:
setMethod("tril", "RsparseMatrix",
	  function(x, k = 0, ...) as_Rsparse(tril(as_Csparse(x), k = k, ...)))
setMethod("triu", "RsparseMatrix",
	  function(x, k = 0, ...) as_Rsparse(triu(as_Csparse(x), k = k, ...)))
setMethod("band", "RsparseMatrix",
	  function(x, k1, k2, ...)
	  as_Rsparse(band(as_Csparse(x), k1 = k1, k2 = k2, ...)))

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