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 1173, Mon Jan 16 20:02:16 2006 UTC revision 1174, Mon Jan 16 20:03:48 2006 UTC
# Line 17  Line 17 
17            function(x) as.vector(as(x, "matrix")))            function(x) as.vector(as(x, "matrix")))
18    
19    
20  ## Note that isSymmetric is *not* exported ---  ## Note that isSymmetric is *not* exported
21  ## but also note that "base" eigen now (R 2.3.0) has an isSymmetric()  ## but that "base" has an isSymmetric() S3-generic since R 2.3.0
22  setMethod("isSymmetric", signature(object = "symmetricMatrix"),  setMethod("isSymmetric", signature(object = "symmetricMatrix"),
23            function(object,tol) TRUE)            function(object,tol) TRUE)
24  setMethod("isSymmetric", signature(object = "triangularMatrix"),  setMethod("isSymmetric", signature(object = "triangularMatrix"),
25            ## FIXME: 'TRUE' if *diagonal*, i.e. return(isDiagonal(object))            ## TRUE iff diagonal:
26            function(object,tol) FALSE)            function(object,tol) isDiagonal(object))
27    if(paste(R.version$major, R.version$minor, sep=".") < "2.3")
28        ## need a "matrix" method as in R 2.3 and later
29        setMethod("isSymmetric", signature(object = "matrix"),
30                  function(object, tol = 100*.Machine$double.eps, ...)
31              {
32                  ## pretest: is it square?
33                  d <- dim(object)
34                  if(d[1] != d[2]) return(FALSE)
35                  test <-
36                      if(is.complex(object))
37                          all.equal.numeric(object, Conj(t(object)), tol = tol, ...)
38                      else              # numeric, character, ..
39                          all.equal(object, t(object), tol = tol, ...)
40                  isTRUE(test)
41              })
42    
43    
44  setMethod("isTriangular", signature(object = "triangularMatrix"),  setMethod("isTriangular", signature(object = "triangularMatrix"),
45            function(object,tol) TRUE)            function(object,tol) TRUE)
46    setMethod("isTriangular", signature(object = "matrix"),
47              .is.triangular)
48    
49    setMethod("isDiagonal", signature(object = "matrix"), .is.diagonal)
50    
51    
 setMethod("isDiagonal", signature(object = "sparseMatrix"),  
           function(object) {  
               gT <- as(object, "TsparseMatrix")  
               all(gT@i == gT@j)  
           })  
52    
53  setMethod("dim", signature(x = "Matrix"),  setMethod("dim", signature(x = "Matrix"),
54            function(x) x@Dim, valueClass = "integer")            function(x) x@Dim, valueClass = "integer")
# Line 84  Line 100 
100      }      }
101    
102      ## 'data' is now a "matrix" or "Matrix"      ## 'data' is now a "matrix" or "Matrix"
103      ## FIXME: consider it's type (logical,....)  
104      ## ctype <- substr(class(data), 1,1) # "d", "l", ...      ## check for symmetric / triangular / diagonal :
105      ## FIXME(2): check for symmetric / triangular / ...      isSym <- isSymmetric(data)
106        if((isTri <- !isSym))
107            isTri <- isTriangular(data)
108        isDiag <- isSym # cannot be diagonal if it isn't symmetric
109        if(isDiag)
110            isDiag <- isDiagonal(data)
111    
112  ### TODO: Compare with as.Matrix() and its tests in ./dgeMatrix.R  ### TODO: Compare with as.Matrix() and its tests in ./dgeMatrix.R
113      if(sparse)  
114          as(data, "dgCMatrix")      ## Find proper matrix class 'cl'
115      else      cl <-
116          as(data, "dgeMatrix")          if(isDiag)
117                "diagonalMatrix" # -> will automatically check for type
118            else {
119                ## consider it's type
120                ctype <-
121                    if(is(data,"Matrix")) class(data)
122                    else {
123                        if("complex" == (ctype <- typeof(data)))
124                            "z" else ctype
125                    }
126                ctype <- substr(ctype, 1,1) # "d", "l", "i" or "z"
127                if(ctype == "z")
128                    stop("complex matrices not yet implemented in Matrix package")
129                if(ctype == "i") {
130                    warning("integer matrices not yet implemented in 'Matrix'; ",
131                            "using 'double' ones'")
132                    ctype <- "d"
133                }
134                paste(ctype,
135                      if(sparse) {
136                          if(isSym) "sCMatrix" else
137                          if(isTri) "tCMatrix" else "gCMatrix"
138                      } else { ## dense
139                          if(isSym) "syMatrix" else
140                          if(isTri) "trMatrix" else "geMatrix"
141                      }, sep="")
142            }
143    
144        ## Now coerce and return
145        as(data, cl)
146  }  }
147    
148  ## Methods for operations where one argument is numeric  ## Methods for operations where one argument is numeric

Legend:
Removed from v.1173  
changed lines
  Added in v.1174

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