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 865 - (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 : maechler 657
37 : bates 653 setMethod("t", signature(x = "pMatrix"), function(x) solve(x))
38 :    
39 : bates 638 setMethod("%*%", signature(x = "matrix", y = "pMatrix"),
40 : bates 650 function(x, y) x[ , y@perm], valueClass = "matrix")
41 : bates 638
42 :     setMethod("%*%", signature(x = "pMatrix", y = "matrix"),
43 : bates 650 function(x, y) y[x@perm ,], valueClass = "matrix")
44 : bates 638
45 : maechler 657 setMethod("%*%", signature(x = "pMatrix", y = "pMatrix"),
46 :     function(x, y) {
47 :     stopifnot(identical(d <- x@Dim, y@Dim))
48 :     n <- d[1]
49 :     ## FIXME: dimnames dealing: as with S3 matrix's %*%
50 :     x@perm <- x@perm[y@perm]
51 :     x
52 :     })
53 :    
54 : maechler 865 ## FIXME: the following methods can be rewritten when "[" methods for
55 : maechler 657 ## dgeMatrix are available
56 : bates 653
57 :     setMethod("%*%", signature(x = "dgeMatrix", y = "pMatrix"),
58 :     function(x, y) as(callGeneric(x, as(y, "matrix")), "dgeMatrix"),
59 :     valueClass = "dgeMatrix")
60 :    
61 :     setMethod("%*%", signature(x = "pMatrix", y = "dgeMatrix"),
62 :     function(x, y) as(callGeneric(as(x, "matrix"), y), "dgeMatrix"),
63 :     valueClass = "dgeMatrix")

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