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 1305 - (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 :     d <- from@Dim
23 :     new("lgTMatrix", i = seq(length = d[1]) - 1:1, j = from@perm - 1:1,
24 :     Dim = d, Dimnames = from@Dimnames)
25 :     })
26 :    
27 : maechler 1305 setAs("pMatrix", "TsparseMatrix",
28 :     function(from) as(from, "lgTMatrix"))
29 :    
30 : bates 638 setMethod("solve", signature(a = "pMatrix", b = "missing"),
31 :     function(a, b) {
32 :     bp <- ap <- a@perm
33 :     bp[ap] <- seq(along = ap)
34 : maechler 657 new("pMatrix", perm = bp, Dim = a@Dim,
35 :     Dimnames = rev(a@Dimnames))
36 : bates 638 }, valueClass = "pMatrix")
37 :    
38 : bates 653 setMethod("t", signature(x = "pMatrix"), function(x) solve(x))
39 :    
40 : bates 638 setMethod("%*%", signature(x = "matrix", y = "pMatrix"),
41 : bates 650 function(x, y) x[ , y@perm], valueClass = "matrix")
42 : bates 638
43 :     setMethod("%*%", signature(x = "pMatrix", y = "matrix"),
44 : bates 650 function(x, y) y[x@perm ,], valueClass = "matrix")
45 : bates 638
46 : maechler 657 setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"),
47 :     function(x, y) {
48 :     stopifnot(identical(d <- x@Dim, y@Dim))
49 :     n <- d[1]
50 :     ## FIXME: dimnames dealing: as with S3 matrix's %*%
51 :     x@perm <- x@perm[y@perm]
52 :     x
53 :     })
54 :    
55 : maechler 954 setMethod("%*%", signature(x = "Matrix", y = "pMatrix"),
56 :     function(x, y) x[, y@perm])
57 : bates 653
58 : maechler 954 setMethod("%*%", signature(x = "pMatrix", y = "Matrix"),
59 :     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