SCM

SCM Repository

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

Diff of /pkg/R/pMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 656, Wed Mar 16 16:55:32 2005 UTC revision 657, Wed Mar 16 16:57:52 2005 UTC
# Line 3  Line 3 
3  setAs("integer", "pMatrix",  setAs("integer", "pMatrix",
4        function(from) {        function(from) {
5            n <- length(from)            n <- length(from)
6            new("pMatrix", Dim = rep.int(n, 2), perm = from)            nn <- names(from)
7              new("pMatrix", Dim = rep.int(n, 2), Dimnames = list(nn,nn),
8                  perm = from)
9        })        })
10    
11  setAs("pMatrix", "matrix",  setAs("pMatrix", "matrix",
12        function(from) {        function(from) {
13            fp <- from@perm            fp <- from@perm
14            diag(nrow = length(fp))[fp , ]            r <- diag(nrow = length(fp))[fp,]
15              if(.has.DN(from)) dimnames(r) <- from@Dimnames
16              r
17        })        })
18    
19  setMethod("solve", signature(a = "pMatrix", b = "missing"),  setMethod("solve", signature(a = "pMatrix", b = "missing"),
20            function(a, b) {            function(a, b) {
21                bp <- ap <- a@perm                bp <- ap <- a@perm
22                bp[ap] <- seq(along = ap)                bp[ap] <- seq(along = ap)
23                new("pMatrix", Dim = a@Dim, perm = bp)                new("pMatrix", perm = bp, Dim = a@Dim,
24                      Dimnames = rev(a@Dimnames))
25            }, valueClass = "pMatrix")            }, valueClass = "pMatrix")
26    
27    
28  setMethod("t", signature(x = "pMatrix"), function(x) solve(x))  setMethod("t", signature(x = "pMatrix"), function(x) solve(x))
29    
30  setMethod("%*%", signature(x = "matrix", y = "pMatrix"),  setMethod("%*%", signature(x = "matrix", y = "pMatrix"),
# Line 27  Line 33 
33  setMethod("%*%", signature(x = "pMatrix", y = "matrix"),  setMethod("%*%", signature(x = "pMatrix", y = "matrix"),
34            function(x, y) y[x@perm ,], valueClass = "matrix")            function(x, y) y[x@perm ,], valueClass = "matrix")
35    
36    setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"),
37              function(x, y) {
38                  stopifnot(identical(d <- x@Dim, y@Dim))
39                  n <- d[1]
40                  ## FIXME: dimnames dealing: as with S3 matrix's  %*%
41                  x@perm <- x@perm[y@perm]
42                  x
43              })
44    
45  ## the following methods can be rewritten when "[" methods for  ## the following methods can be rewritten when "[" methods for
46  ## dgeMatrix are available  ## dgeMatrix are available
47    

Legend:
Removed from v.656  
changed lines
  Added in v.657

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge