SCM

SCM Repository

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

Diff of /pkg/R/sparseMatrix.R

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

revision 924, Mon Sep 19 08:40:29 2005 UTC revision 925, Mon Sep 19 19:01:31 2005 UTC
# Line 1  Line 1 
1  ### Define Methods that can be inherited for all subclasses  ### Define Methods that can be inherited for all subclasses
2    
3  ## An idea: Coercion between *VIRTUAL* classes  ### Idea: Coercion between *VIRTUAL* classes -- as() chooses "closest" classes
4  ## -- making sure that result is *actual*!  ### ----  should also work e.g. for  dense-triangular --> sparse-triangular !
   
5  ## setAs("denseMatrix", "sparseMatrix",  ## setAs("denseMatrix", "sparseMatrix",
6  ##       function(from) {  ##       function(from) {
7    ##            as(as(from, "dgeMatrix")
8  ##       })  ##       })
9    
10  ## setAs("dMatrix", "lMatrix",  ## setAs("dMatrix", "lMatrix",
# Line 12  Line 12 
12  ##       })  ##       })
13    
14    
 ## For multiplication operations, sparseMatrix overrides other method  
 ## selections.  Coerce a ddensematrix argument to a dgeMatrix.  
   
 setMethod("%*%", signature(x = "sparseMatrix", y = "ddenseMatrix"),  
           function(x, y) callGeneric(x, as(y, "dgeMatrix")))  
   
 setMethod("%*%", signature(x = "ddenseMatrix", y = "sparseMatrix"),  
           function(x, y) callGeneric(as(x, "dgeMatrix"), y))  
   
 setMethod("crossprod", signature(x = "sparseMatrix", y = "ddenseMatrix"),  
           function(x, y = NULL) callGeneric(x, as(y, "dgeMatrix")))  
   
 setMethod("crossprod", signature(x = "ddenseMatrix", y = "sparseMatrix"),  
           function(x, y = NULL) callGeneric(as(x, "dgeMatrix"), y))  
   
15  ## "graph" coercions -- this needs the graph package which is currently  ## "graph" coercions -- this needs the graph package which is currently
16  ##  -----               *not* required on purpose  ##  -----               *not* required on purpose
17  ## Note: 'undirected' graph <==> 'symmetric' matrix  ## Note: 'undirected' graph <==> 'symmetric' matrix
# Line 75  Line 60 
60    
61  ### Subsetting -- basic things (drop = "missing") are done in ./Matrix.R  ### Subsetting -- basic things (drop = "missing") are done in ./Matrix.R
62    
63  ## 1)  dsparse -> dgT  ### FIXME : we defer to the "*gT" -- conveniently, but not efficient for gC !
 setMethod("[", signature(x = "dsparseMatrix", i = "index", j = "missing",  
                          drop = "logical"),  
           function (x, i, j, drop)  
           callGeneric(x = as(x, "dgTMatrix"), i=i, drop=drop))  
64    
65  setMethod("[", signature(x = "dsparseMatrix", i = "missing", j = "index",  ## [dl]sparse -> [dl]gT   -- treat both in one via superclass
66                           drop = "logical"),  ##                        -- more useful when have "z" (complex) and even more
           function (x, i, j, drop)  
           callGeneric(x = as(x, "dgTMatrix"), j=j, drop=drop))  
67    
68  setMethod("[", signature(x = "dsparseMatrix",  setMethod("[", signature(x = "sparseMatrix", i = "index", j = "missing",
                          i = "index", j = "index", drop = "logical"),  
           function (x, i, j, drop)  
           callGeneric(x = as(x, "dgTMatrix"), i=i, j=j, drop=drop))  
   
 ## 2)  lsparse -> lgT  
 setMethod("[", signature(x = "lsparseMatrix", i = "index", j = "missing",  
69                           drop = "logical"),                           drop = "logical"),
70            function (x, i, j, drop)            function (x, i, j, drop) {
71            callGeneric(x = as(x, "lgTMatrix"), i=i, drop=drop))                cl <- class(x)
72                  viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
73                  x <- callGeneric(x = as(x, viaCl), i=i, drop=drop)
74                  if(!is(x,"Matrix")) x else as(x, cl)
75              })
76    
77  setMethod("[", signature(x = "lsparseMatrix", i = "missing", j = "index",  setMethod("[", signature(x = "sparseMatrix", i = "missing", j = "index",
78                           drop = "logical"),                           drop = "logical"),
79            function (x, i, j, drop)            function (x, i, j, drop) {
80            callGeneric(x = as(x, "lgTMatrix"), j=j, drop=drop))                cl <- class(x)
81                  viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
82                  x <- callGeneric(x = as(x, viaCl), j=j, drop=drop)
83                  if(!is(x,"Matrix")) x else as(x, cl)
84              })
85    
86  setMethod("[", signature(x = "lsparseMatrix",  setMethod("[", signature(x = "sparseMatrix",
87                           i = "index", j = "index", drop = "logical"),                           i = "index", j = "index", drop = "logical"),
88            function (x, i, j, drop)            function (x, i, j, drop) {
89            callGeneric(x = as(x, "lgTMatrix"), i=i, j=j, drop=drop))                cl <- class(x)
90                  viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
91                  x <- callGeneric(x = as(x, viaCl), i=i, j=j, drop=drop)
92                  if(!is(x,"Matrix")) x else as(x, cl)
93              })
94    
95    
96    
# Line 179  Line 164 
164                              as(t(object), "lgCMatrix"))                              as(t(object), "lgCMatrix"))
165                else stop("not yet implemented")                else stop("not yet implemented")
166            })            })
167    
168    

Legend:
Removed from v.924  
changed lines
  Added in v.925

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