SCM

SCM Repository

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

Annotation of /pkg/R/pMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 954 - (view) (download)

1 : bates 638 #### Permutation Matrices -- Coercion and Methods
2 :    
3 :     setAs("integer", "pMatrix",
4 :     function(from) {
5 :     n <- length(from)
6 : maechler 657 nn <- names(from)
7 :     new("pMatrix", Dim = rep.int(n, 2), Dimnames = list(nn,nn),
8 :     perm = from)
9 : bates 638 })
10 :    
11 :     setAs("pMatrix", "matrix",
12 :     function(from) {
13 : maechler 657 fp <- from@perm
14 :     r <- diag(nrow = length(fp))[fp,]
15 :     if(.has.DN(from)) dimnames(r) <- from@Dimnames
16 :     r
17 : bates 638 })
18 :    
19 : maechler 865 ## coerce to 0/1 sparse matrix, i.e. sparse logical :
20 :     setAs("pMatrix", "lgTMatrix",
21 :     function(from) {
22 :     fp <- from@perm
23 :     d <- from@Dim
24 :     new("lgTMatrix", i = seq(length = d[1]) - 1:1, j = from@perm - 1:1,
25 :     Dim = d, Dimnames = from@Dimnames)
26 :     })
27 :    
28 : bates 638 setMethod("solve", signature(a = "pMatrix", b = "missing"),
29 :     function(a, b) {
30 :     bp <- ap <- a@perm
31 :     bp[ap] <- seq(along = ap)
32 : maechler 657 new("pMatrix", perm = bp, Dim = a@Dim,
33 :     Dimnames = rev(a@Dimnames))
34 : bates 638 }, valueClass = "pMatrix")
35 :    
36 : bates 653 setMethod("t", signature(x = "pMatrix"), function(x) solve(x))
37 :    
38 : bates 638 setMethod("%*%", signature(x = "matrix", y = "pMatrix"),
39 : bates 650 function(x, y) x[ , y@perm], valueClass = "matrix")
40 : bates 638
41 :     setMethod("%*%", signature(x = "pMatrix", y = "matrix"),
42 : bates 650 function(x, y) y[x@perm ,], valueClass = "matrix")
43 : bates 638
44 : maechler 657 setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"),
45 :     function(x, y) {
46 :     stopifnot(identical(d <- x@Dim, y@Dim))
47 :     n <- d[1]
48 :     ## FIXME: dimnames dealing: as with S3 matrix's %*%
49 :     x@perm <- x@perm[y@perm]
50 :     x
51 :     })
52 :    
53 : maechler 954 setMethod("%*%", signature(x = "Matrix", y = "pMatrix"),
54 :     function(x, y) x[, y@perm])
55 : bates 653
56 : maechler 954 setMethod("%*%", signature(x = "pMatrix", y = "Matrix"),
57 :     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