# SCM Repository

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

# Diff of /pkg/R/sparseMatrix.R

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: