SCM

SCM Repository

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

Diff of /pkg/R/Matrix.R

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

revision 871, Fri Aug 26 17:26:49 2005 UTC revision 908, Thu Sep 8 15:30:08 2005 UTC
# Line 40  Line 40 
40  ## should propagate to all subclasses:  ## should propagate to all subclasses:
41  setMethod("as.matrix", signature(x = "Matrix"), function(x) as(x, "matrix"))  setMethod("as.matrix", signature(x = "Matrix"), function(x) as(x, "matrix"))
42    
43    ## Note that isSymmetric is *not* exported
44    setMethod("isSymmetric", signature(object = "symmetricMatrix"),
45              function(object) TRUE)
46    setMethod("isSymmetric", signature(object = "triangularMatrix"),
47              ## FIXME: 'TRUE' if *diagonal*, i.e. return(isDiagonal(object))
48              function(object) FALSE)
49    
50  setMethod("dim", signature(x = "Matrix"),  setMethod("dim", signature(x = "Matrix"),
51            function(x) x@Dim, valueClass = "integer")            function(x) x@Dim, valueClass = "integer")
52  setMethod("dimnames", signature(x = "Matrix"), function(x) x@Dimnames)  setMethod("dimnames", signature(x = "Matrix"), function(x) x@Dimnames)
# Line 102  Line 109 
109  ### Subsetting "["  and  ### Subsetting "["  and
110  ### SubAssign  "[<-" : The "missing" cases can be dealt with here, "at the top":  ### SubAssign  "[<-" : The "missing" cases can be dealt with here, "at the top":
111    
112    ## Using "index" for indices should allow
113    ## integer (numeric), logical, or character (names!) indices :
114    
115  ## "x[]":  ## "x[]":
116  setMethod("[", signature(x = "Matrix",  setMethod("[", signature(x = "Matrix",
117                           i = "missing", j = "missing", drop = "ANY"),                           i = "missing", j = "missing", drop = "ANY"),
# Line 109  Line 119 
119  ## missing 'drop' --> 'drop = TRUE'  ## missing 'drop' --> 'drop = TRUE'
120  ##                     -----------  ##                     -----------
121  ## select rows  ## select rows
122  setMethod("[", signature(x = "Matrix", i = "numeric", j = "missing",  setMethod("[", signature(x = "Matrix", i = "index", j = "missing",
123                           drop = "missing"),                           drop = "missing"),
124            function(x,i,j, drop) callGeneric(x, i=i, drop= TRUE))            function(x,i,j, drop) callGeneric(x, i=i, drop= TRUE))
125  ## select columns  ## select columns
126  setMethod("[", signature(x = "Matrix", i = "missing", j = "numeric",  setMethod("[", signature(x = "Matrix", i = "missing", j = "index",
127                           drop = "missing"),                           drop = "missing"),
128            function(x,i,j, drop) callGeneric(x, j=j, drop= TRUE))            function(x,i,j, drop) callGeneric(x, j=j, drop= TRUE))
129  setMethod("[", signature(x = "Matrix", i = "numeric", j = "numeric",  setMethod("[", signature(x = "Matrix", i = "index", j = "index",
130                           drop = "missing"),                           drop = "missing"),
131            function(x,i,j, drop) callGeneric(x, i=i, j=j, drop= TRUE))            function(x,i,j, drop) callGeneric(x, i=i, j=j, drop= TRUE))
132    
133    ## bail out if any of (i,j,drop) is "non-sense"
134    setMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY", drop = "ANY"),
135              function(x,i,j, drop)
136              stop("invalid or not-yet-implemented 'Matrix' subsetting"))
137    
138  ## "FIXME:"  ## "FIXME:"
139  ## How can we get at   A[ ij ]  where ij is (i,j) 2-column matrix?  ## How can we get at   A[ ij ]  where ij is (i,j) 2-column matrix?
140  ##  and                A[ LL ]  where LL is a logical *vector*  ##  and                A[ LL ]  where LL is a logical *vector*
141    ## -> [.data.frame uses nargs() - can we do this in the *generic* ?
142    
143    
144  ### "[<-" : -----------------  ### "[<-" : -----------------
145    
146  ## x[] <- value :  ## x[] <- value :
147  setReplaceMethod("[", signature(x = "Matrix", i = "missing", j = "missing",  setReplaceMethod("[", signature(x = "Matrix", i = "missing", j = "missing",
148                                  value = "vector"),##  double/logical/...                                  value = "index"),##  double/logical/...
149            function (x, value) { x@x <- value ; validObject(x); x })            function (x, value) { x@x <- value ; validObject(x); x })
150    
151  ## Otherwise (value is not "vector"): bail out  ## Otherwise (value is not "index"): bail out
152  setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY",  setReplaceMethod("[", signature(x = "Matrix", i = "ANY", j = "ANY",
153                                  value = "ANY"),                                  value = "ANY"),
154            function (x, i, j, value) stop("RHS 'value' must be of class \"vector\""))            function (x, i, j, value)
155                     if(!is(value,"index"))
156                     stop("RHS 'value' must be of class \"index\"")
157                     else stop("unimplemented 'Matrix[<-' method"))
158    
159    
160    
161    ## NOTE: the following only works for R 2.2.x (and later) ---
162    ## ----  *and* 'Matrix' must have been *installed* by R >= 2.2.x
163    
164    if(paste(R.version$major, R.version$minor, sep=".") >= "2.2") {
165    
166        ## The trivial methods :
167        setMethod("cbind2", signature(x = "Matrix", y = "NULL"),
168                  function(x, y) x)
169        setMethod("cbind2", signature(x = "Matrix", y = "missing"),
170                  function(x, y) x)
171        setMethod("cbind2", signature(x = "NULL", y="Matrix"),
172                  function(x, y) x)
173    
174        ## Makes sure one gets x decent error message for the unimplemented cases:
175        setMethod("cbind2", signature(x = "Matrix", y = "Matrix"),
176                  function(x, y) {
177                      rowCheck(x,y)
178                      stop(gettextf("cbind2() method for (%s,%s) not-yet defined",
179                                    class(x), class(y)))
180                  })
181    
182  if(FALSE) ## The following can't work as long as cbind is function(..., *)      if (isGeneric("rbind2"))
183  setMethod("cbind", signature(a = "Matrix", b = "Matrix"),      setMethod("rbind2", signature(x = "Matrix", y = "Matrix"),
184            function(a, b, ...) {                function(x, y) {
185                da <- Dim(a)                    colCheck(x,y)
186                db <- Dim(b)                    stop(gettextf("rbind2() method for (%s,%s) not-yet defined",
187                if(da[1] != db[1])                                  class(x), class(y)))
                   stop("Matrices must have same number of rows for cbind()ing")  
188            })            })
189    }## R-2.2.x and newer

Legend:
Removed from v.871  
changed lines
  Added in v.908

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