SCM

SCM Repository

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

View of /pkg/R/pMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1548 - (download) (annotate)
Mon Sep 11 22:13:07 2006 UTC (12 years, 11 months ago) by maechler
File size: 2073 byte(s)
new nMatrix and subclasses; lsparse change to have x slot; many consequences
#### Permutation Matrices -- Coercion and Methods

## The typical   'constructor' : coerce from  'index'
setAs("integer", "pMatrix",
      function(from) {
          n <- length(from)
          nn <- names(from)
          new("pMatrix", Dim = rep.int(n, 2), Dimnames = list(nn,nn),
              perm = from)
      })

setAs("numeric", "pMatrix",
      function(from)
	  if(all(from == (i <- as.integer(from)))) as(i, "pMatrix")
	  else stop("coercion to 'pMatrix' only works from integer numeric"))

setAs("pMatrix", "matrix",
      function(from) {
	  fp <- from@perm
	  r <- diag(nrow = length(fp))[fp,]
	  if(.has.DN(from)) dimnames(r) <- from@Dimnames
	  r
      })

## coerce to 0/1 sparse matrix, i.e. sparse pattern
setAs("pMatrix", "ngTMatrix",
      function(from) {
          d <- from@Dim
	  new("ngTMatrix", i = seq(length = d[1]) - 1:1, j = from@perm - 1:1,
              Dim = d, Dimnames = from@Dimnames)
      })

setAs("pMatrix", "TsparseMatrix",
      function(from) as(from, "ngTMatrix"))

setMethod("solve", signature(a = "pMatrix", b = "missing"),
          function(a, b) {
              bp <- ap <- a@perm
              bp[ap] <- seq(along = ap)
              new("pMatrix", perm = bp, Dim = a@Dim,
                  Dimnames = rev(a@Dimnames))
          }, valueClass = "pMatrix")

setMethod("t", signature(x = "pMatrix"), function(x) solve(x))

setMethod("%*%", signature(x = "matrix", y = "pMatrix"),
	  function(x, y) x[ , y@perm], valueClass = "matrix")

setMethod("%*%", signature(x = "pMatrix", y = "matrix"),
	  function(x, y) y[x@perm ,], valueClass = "matrix")

setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"),
	  function(x, y) {
              stopifnot(identical(d <- x@Dim, y@Dim))
              n <- d[1]
              ## FIXME: dimnames dealing: as with S3 matrix's  %*%
              x@perm <- x@perm[y@perm]
              x
          })

setMethod("%*%", signature(x = "Matrix", y = "pMatrix"),
	  function(x, y) x[, y@perm])

setMethod("%*%", signature(x = "pMatrix", y = "Matrix"),
          function(x, y) y[x@perm , ])

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