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 972, Fri Oct 7 20:13:24 2005 UTC revision 973, Fri Oct 7 20:15:08 2005 UTC
# Line 71  Line 71 
71                cl <- class(x)                cl <- class(x)
72                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
73                x <- callGeneric(x = as(x, viaCl), i=i, drop=drop)                x <- callGeneric(x = as(x, viaCl), i=i, drop=drop)
74                if(!is(x,"Matrix")) x else as(x, cl)                ## try_as(x, c(cl, sub("T","C", viaCl)))
75                  if(is(x, "Matrix") && extends(cl, "CsparseMatrix"))
76                      as(x, sub("T","C", viaCl)) else x
77            })            })
78    
79  setMethod("[", signature(x = "sparseMatrix", i = "missing", j = "index",  setMethod("[", signature(x = "sparseMatrix", i = "missing", j = "index",
# Line 80  Line 82 
82                cl <- class(x)                cl <- class(x)
83                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
84                x <- callGeneric(x = as(x, viaCl), j=j, drop=drop)                x <- callGeneric(x = as(x, viaCl), j=j, drop=drop)
85                if(!is(x,"Matrix")) x else as(x, cl)                ## try_as(x, c(cl, sub("T","C", viaCl)))
86                  if(is(x, "Matrix") && extends(cl, "CsparseMatrix"))
87                      as(x, sub("T","C", viaCl)) else x
88            })            })
89    
90  setMethod("[", signature(x = "sparseMatrix",  setMethod("[", signature(x = "sparseMatrix",
# Line 89  Line 93 
93                cl <- class(x)                cl <- class(x)
94                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"                viaCl <- if(is(x,"dMatrix")) "dgTMatrix" else "lgTMatrix"
95                x <- callGeneric(x = as(x, viaCl), i=i, j=j, drop=drop)                x <- callGeneric(x = as(x, viaCl), i=i, j=j, drop=drop)
96                if(!is(x,"Matrix")) x else as(x, cl)                ## try_as(x, c(cl, sub("T","C", viaCl)))
97                  if(is(x, "Matrix") && extends(cl, "CsparseMatrix"))
98                      as(x, sub("T","C", viaCl)) else x
99            })            })
100    
101    
# Line 146  Line 152 
152    
153    
154  ## not exported:  ## not exported:
155  setMethod("isSymmetric", signature(object = "sparseMatrix"),  setMethod("isSymmetric", signature(object = "sparseMatrix", tol = "ANY"),
156            function(object, ...) {            function(object, tol = 100*.Machine$double.eps) {
157                ## pretest: is it square?                ## pretest: is it square?
158                d <- dim(object)                d <- dim(object)
159                if(d[1] != d[2]) return(FALSE)                if(d[1] != d[2]) return(FALSE)
160                ## else slower test                ## else slower test
161                if (is(object("dMatrix")))                if (is(object, "dMatrix"))
162                    ## use gC; "T" (triplet) is *not* unique!                    ## use gC; "T" (triplet) is *not* unique!
163                    isTRUE(all.equal(as(object, "dgCMatrix"),                    isTRUE(all.equal(as(object, "dgCMatrix"),
164                                     as(t(object), "dgCMatrix"), ...))                                     as(t(object), "dgCMatrix"), tol = tol))
165                else if (is(object("lMatrix")))                else if (is(object, "lMatrix"))
166                    ## test for exact equality; FIXME(?): identical() too strict?                    ## test for exact equality; FIXME(?): identical() too strict?
167                    identical(as(object, "lgCMatrix"),                    identical(as(object, "lgCMatrix"),
168                              as(t(object), "lgCMatrix"))                              as(t(object), "lgCMatrix"))
169                else stop("not yet implemented")                else stop("not yet implemented")
170            })            })
   
   

Legend:
Removed from v.972  
changed lines
  Added in v.973

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