SCM

SCM Repository

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

Diff of /pkg/R/ldenseMatrix.R

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

revision 1200, Mon Jan 23 16:01:20 2006 UTC revision 1201, Mon Jan 23 16:04:12 2006 UTC
# Line 1  Line 1 
1    #### "ldenseMatrix" - virtual class of logical dense matrices
2    ####  ------------
3    #### Contains  lge*;  ltr*, ltp*;  lsy*, lsp*;   ldi*
4    
5    ## Logical -> Double {of same structure}:
6    
7  setAs("lgeMatrix", "dgeMatrix", l2d_Matrix)  setAs("lgeMatrix", "dgeMatrix", l2d_Matrix)
 setAs("ltrMatrix", "dtrMatrix", l2d_Matrix)  
 setAs("ltpMatrix", "dtpMatrix", l2d_Matrix)  
8  setAs("lsyMatrix", "dsyMatrix", l2d_Matrix)  setAs("lsyMatrix", "dsyMatrix", l2d_Matrix)
9  setAs("lspMatrix", "dspMatrix", l2d_Matrix)  setAs("lspMatrix", "dspMatrix", l2d_Matrix)
10    setAs("ltrMatrix", "dtrMatrix", l2d_Matrix)
11    setAs("ltpMatrix", "dtpMatrix", l2d_Matrix)
12    
13    ## all need be coercable to "lgeMatrix":
14    
15    setAs("lsyMatrix", "lgeMatrix",  function(from)
16          .Call("lsyMatrix_as_lgeMatrix", from, PACKAGE = "Matrix"))
17    setAs("ltrMatrix", "lgeMatrix",  function(from)
18          .Call("ltrMatrix_as_lgeMatrix", from, PACKAGE = "Matrix"))
19    setAs("ltpMatrix", "lgeMatrix",
20          function(from) as(as(from, "ltrMatrix"), "lgeMatrix"))
21    setAs("lspMatrix", "lgeMatrix",
22          function(from) as(as(from, "lsyMatrix"), "lgeMatrix"))
23    
24    ## packed <->  non-packed :
25    
26  setAs("lspMatrix", "lsyMatrix",  setAs("lspMatrix", "lsyMatrix",
27        function(from)        function(from)
# Line 20  Line 39 
39        function(from)        function(from)
40        .Call("ltrMatrix_as_ltpMatrix", from, PACKAGE = "Matrix"))        .Call("ltrMatrix_as_ltpMatrix", from, PACKAGE = "Matrix"))
41    
 setAs("ldenseMatrix", "matrix",  
       function(from) as(as(from, sub("^l", "d", class(from))), "matrix"))  
42    
43  setAs("matrix", "ldenseMatrix",  ### -> symmetric :
44        function(from) callGeneric(as(from, "lgeMatrix")))  
45    if(FALSE) ## cannot easily work around R bug  -- FIXME --
46    setIs("lgeMatrix", "lsyMatrix",
47    ### BUG in R: this fails, because isSymmetric() is namespace hidden and NOT found
48    ##B      test = function(obj) isSymmetric(obj),
49    ##B and this fails too:
50    ##B      test = function(obj) Matrix:::isSymmetric(obj),
51          replace = function(obj, value) {
52              ## copy all slots
53              for(n in slotNames(obj)) slot(obj, n) <- slot(value, n)
54          })
55    
56    ### Alternative (at least works):
57    setAs("lgeMatrix", "lsyMatrix",
58          function(from) {
59              if(isSymmetric(from))
60                  new("lsyMatrix", x = from@x, Dim = from@Dim,
61                      Dimnames = from@Dimnames, factors = from@factors)
62              else stop("not a symmetric matrix")
63          })
64    
65    
66    ###  ldense* <-> "matrix" :
67    
68    ## 1) "lge* :
69    setAs("lgeMatrix", "matrix",
70          function(from) array(from@x, dim = from@Dim, dimnames = from@Dimnames))
71    
72    setAs("matrix", "lgeMatrix",
73          function(from) {
74              new("lgeMatrix",
75                  x = as.logical(from),
76                  Dim = as.integer(dim(from)),
77                  Dimnames =
78                  if(!is.null(dn <- dimnames(from))) dn else list(NULL,NULL)
79                  )
80          })
81    
82    ## 2) base others on "lge*":
83    
84    ## Useful if this was called e.g. for as(*, "lsyMatrix"), but it isn't:
85    setAs("matrix", "ldenseMatrix", function(from) as(from, "lgeMatrix"))
86    setAs("matrix", "lsyMatrix",
87          function(from) as(as(from, "lgeMatrix"), "lsyMatrix"))
88    
89    setAs("ldenseMatrix", "matrix", ## uses the above l*M. -> lgeM.
90          function(from) as(as(from, "lgeMatrix"), "matrix"))
91    
92    ## dense |-> compressed :
93    
94    setAs("lgeMatrix", "lgTMatrix",
95          function(from) {
96              ##  cheap but not so efficient:
97              ij <- which(as(from,"matrix"), arr.ind = TRUE) - 1:1
98              new("lgTMatrix", i = ij[,1], j = ij[,2],
99                  Dim = from@Dim, Dimnames = from@Dimnames,
100                  factors = from@factors)
101          })
102    
103    ###----------------------------------------------------------------------
104    
105    
106  setMethod("t", signature(x = "lgeMatrix"), t_geMatrix)  setMethod("t", signature(x = "lgeMatrix"), t_geMatrix)
107  setMethod("t", signature(x = "ltrMatrix"), t_trMatrix)  setMethod("t", signature(x = "ltrMatrix"), t_trMatrix)
# Line 61  Line 138 
138  ## for the other ldense* ones:  ## for the other ldense* ones:
139  setMethod("!", "ldenseMatrix",  setMethod("!", "ldenseMatrix",
140            function(e1) { e1@x <- !e1@x ; e1 })            function(e1) { e1@x <- !e1@x ; e1 })
141    
142    
143    setMethod("as.vector", signature(x = "ldenseMatrix", mode = "missing"),
144              function(x) as(x, "lgeMatrix")@x)
145    

Legend:
Removed from v.1200  
changed lines
  Added in v.1201

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