# SCM Repository

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

# Diff of /pkg/R/Matrix.R

revision 1332, Thu Jul 27 13:42:18 2006 UTC revision 1455, Mon Aug 28 15:35:44 2006 UTC
# Line 17  Line 17
17  setMethod("as.matrix", signature(x = "Matrix"), function(x) as(x, "matrix"))  setMethod("as.matrix", signature(x = "Matrix"), function(x) as(x, "matrix"))
18  ## for 'Matrix' objects, as.array() should be equivalent:  ## for 'Matrix' objects, as.array() should be equivalent:
19  setMethod("as.array",  signature(x = "Matrix"), function(x) as(x, "matrix"))  setMethod("as.array",  signature(x = "Matrix"), function(x) as(x, "matrix"))
20  ## head and tail apply to all Matrix objects for which subscripting is allowed
21  setMethod("head", signature(x = "Matrix"),  ## head and tail apply to all Matrix objects for which subscripting is allowed:
22            function(x, n = 6, ...)  ## if(paste(R.version\$major, R.version\$minor, sep=".") < "2.4") {
23            x[seq(len = min(n, nrow(x))), , drop = FALSE])      setMethod("head", signature(x = "Matrix"), utils:::head.matrix)
24  setMethod("tail", signature(x = "Matrix"),      setMethod("tail", signature(x = "Matrix"), utils:::tail.matrix)
25            function (x, n = 6, addrownums = TRUE, ...)  ## } else { # R 2.4.0 and newer
27            nrx <- nrow(x)  ##     setMethod("tail", signature(x = "Matrix"), utils::tail.matrix)
28            sel <- seq(to = nrx, length = min(n, nrx))  ## }
ans <- x[sel, , drop = FALSE]
rownames(ans) <- paste("[", sel, ",]", sep = "")
ans
})
29
30  ## slow "fall back" method {subclasses should have faster ones}:  ## slow "fall back" method {subclasses should have faster ones}:
31  setMethod("as.vector", signature(x = "Matrix", mode = "missing"),  setMethod("as.vector", signature(x = "Matrix", mode = "missing"),
32            function(x) as.vector(as(x, "matrix")))            function(x) as.vector(as(x, "matrix")))
33
34    ## mainly need these for "dMatrix" or "lMatrix" respectively, but why not general:
35    setMethod("as.numeric", signature(x = "Matrix"),
36              function(x, ...) as.numeric(as.vector(x)))
37    setMethod("as.logical", signature(x = "Matrix"),
38              function(x, ...) as.logical(as.vector(x)))
39
40
41  ## Note that isSymmetric is *not* exported  ## Note that isSymmetric is *not* exported
42  ## but that "base" has an isSymmetric() S3-generic since R 2.3.0  ## but that "base" has an isSymmetric() S3-generic since R 2.3.0
# Line 97  Line 98
98
99  Matrix <-  Matrix <-
100      function (data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL,      function (data = NA, nrow = 1, ncol = 1, byrow = FALSE, dimnames = NULL,
101                sparse = NULL)                sparse = NULL, forceCheck = FALSE)
102  {  {
103      sparseDefault <- function(m)      sparseDefault <- function(m)
104          prod(dim(m)) > 2*sum(as(m, "matrix") != 0)          prod(dim(m)) > 2*sum(as(m, "matrix") != 0)
# Line 106  Line 107
107      if(is.null(sparse) && (i.M || is(data, "matrix")))      if(is.null(sparse) && (i.M || is(data, "matrix")))
108          sparse <- sparseDefault(data)          sparse <- sparseDefault(data)
109
110      if (i.M) {      doDN <- TRUE
111        if (i.M && !forceCheck) {
112          sM <- is(data,"sparseMatrix")          sM <- is(data,"sparseMatrix")
113          if((sparse && sM) || (!sparse && !sM))          if((sparse && sM) || (!sparse && !sM))
114              return(data)              return(data)
# Line 132  Line 134
134                  sparse <- sparseDefault(data)                  sparse <- sparseDefault(data)
135              dimnames(data) <- dimnames              dimnames(data) <- dimnames
136          }          }
137      } else if (!is.null(dimnames))          doDN <- FALSE
138          dimnames(data) <- dimnames      }

139      ## 'data' is now a "matrix" or "Matrix"      ## 'data' is now a "matrix" or "Matrix"
140        if (doDN && !is.null(dimnames))
141            dimnames(data) <- dimnames
142
143      ## check for symmetric / triangular / diagonal :      ## check for symmetric / triangular / diagonal :
144      isSym <- isSymmetric(data)      isSym <- isSymmetric(data)

Legend:
 Removed from v.1332 changed lines Added in v.1455