SCM

SCM Repository

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

View of /pkg/R/ldenseMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 954 - (download) (annotate)
Wed Sep 28 19:34:31 2005 UTC (13 years, 10 months ago) by maechler
File size: 2649 byte(s)
more "Compare" and some "!" methods; expm() for sparse; updated tests
l2d_Matrix <- function(from) {
    stopifnot(is(from, "lMatrix"))
    newCl <- sub("^l", "d", class(from))
    r <- new(newCl, x = as.double(from@x),
             Dim = from@Dim, Dimnames = from@Dimnames,
             factors = list()) ## FIXME: treat 'factors' smartly
    if(is(r, "triangularMatrix")) {
        r@uplo <- from@uplo
        r@diag <- from@diag
    } else if(is(r, "symmetricMatrix")) {
        r@uplo <- from@uplo
    }
    r
}

dummy_meth <- function(x) {
    cl <- class(x)
    as(callGeneric(as(x, sub("^l", "d", cl))), cl)
}

setAs("lgeMatrix", "dgeMatrix", l2d_Matrix)
setAs("ltrMatrix", "dtrMatrix", l2d_Matrix)
setAs("ltpMatrix", "dtpMatrix", l2d_Matrix)
setAs("lsyMatrix", "dsyMatrix", l2d_Matrix)
setAs("lspMatrix", "dspMatrix", l2d_Matrix)

setAs("lspMatrix", "lsyMatrix",
      function(from) .Call("lspMatrix_as_lsyMatrix", from) )
setAs("lsyMatrix", "lspMatrix",
      function(from) .Call("lsyMatrix_as_lspMatrix", from) )

setAs("ltpMatrix", "ltrMatrix",
      function(from) .Call("ltpMatrix_as_ltrMatrix", from) )
setAs("ltrMatrix", "ltpMatrix",
      function(from) .Call("ltrMatrix_as_ltpMatrix", from) )

setAs("ldenseMatrix", "matrix",
      function(from) as(as(from, sub("^l", "d", class(from))), "matrix"))

setAs("matrix", "ldenseMatrix",
      function(from) callGeneric(as(from, "lgeMatrix")))

setMethod("t", signature(x = "lgeMatrix"), t_geMatrix)
setMethod("t", signature(x = "ltrMatrix"), t_trMatrix)
setMethod("t", signature(x = "lsyMatrix"), t_trMatrix)
setMethod("t", signature(x = "ltpMatrix"),
          function(x) as(callGeneric(as(x, "ltrMatrix")), "ltpMatrix"))
setMethod("t", signature(x = "lspMatrix"),
          function(x) as(callGeneric(as(x, "lsyMatrix")), "lspMatrix"))

setMethod("!", "ltrMatrix",
          function(e1) {
              e1@x <- !e1@x
              ## And now we must fill in the '!FALSE' results :

              ## FIXME: the following should be .Call using
              ##        a variation of make_array_triangular:
              r <- as(e1, "lgeMatrix")
              n <- e1@Dim[1]
              coli <- rep(1:n, each=n)
              rowi <- rep(1:n, n)
              Udiag <- e1@diag == "U"
              log.i <-
                  if(e1@uplo == "U") {
                      if(Udiag) rowi >= coli else rowi > coli
                  } else {
                      if(Udiag) rowi <= coli else rowi < coli
                  }
              r[log.i] <- TRUE
              r
          })

setMethod("!", "ltpMatrix", function(e1) !as(x, "ltrMatrix"))

## for the other ldense* ones:
setMethod("!", "ldenseMatrix",
          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