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 2112, Mon Feb 18 08:24:46 2008 UTC revision 2113, Mon Feb 18 08:27:41 2008 UTC
# Line 167  Line 167 
167                           drop = "logical"),                           drop = "logical"),
168            function (x, i,j, ..., drop) {            function (x, i,j, ..., drop) {
169                cld <- getClassDef(class(x))                cld <- getClassDef(class(x))
170                if(!extends(cld, "generalMatrix")) x <- as(x, "generalMatrix")  ##> why should this be needed; can still happen in <Tsparse>[..]:
171    ##>           if(!extends(cld, "generalMatrix")) x <- as(x, "generalMatrix")
172  ##            viaCl <- paste(.M.kind(x, cld), "gTMatrix", sep='')  ##            viaCl <- paste(.M.kind(x, cld), "gTMatrix", sep='')
173                x <- callGeneric(x = as(x, "TsparseMatrix"), i=i, drop=drop)                x <- as(x, "TsparseMatrix")[i, , drop=drop]
174    ##simpler than x <- callGeneric(x = as(x, "TsparseMatrix"), i=i, drop=drop)
175                ## try_as(x, c(cl, sub("T","C", viaCl)))                ## try_as(x, c(cl, sub("T","C", viaCl)))
176                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))
177                    as(x, "CsparseMatrix") else x                    as(x, "CsparseMatrix") else x
# Line 179  Line 181 
181                           drop = "logical"),                           drop = "logical"),
182            function (x,i,j, ..., drop) {            function (x,i,j, ..., drop) {
183                cld <- getClassDef(class(x))                cld <- getClassDef(class(x))
184                if(!extends(cld, "generalMatrix")) x <- as(x, "generalMatrix")  ##> why should this be needed; can still happen in <Tsparse>[..]:
185    ##>           if(!extends(cld, "generalMatrix")) x <- as(x, "generalMatrix")
186  ##            viaCl <- paste(.M.kind(x, cld), "gTMatrix", sep='')  ##            viaCl <- paste(.M.kind(x, cld), "gTMatrix", sep='')
187                x <- callGeneric(x = as(x, "TsparseMatrix"), j=j, drop=drop)  
188                  x <- as(x, "TsparseMatrix")[, j, drop=drop]
189    ##simpler than x <- callGeneric(x = as(x, "TsparseMatrix"), j=j, drop=drop)
190                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))
191                    as(x, "CsparseMatrix") else x                    as(x, "CsparseMatrix") else x
192            })            })
# Line 191  Line 196 
196            function (x, i, j, ..., drop) {            function (x, i, j, ..., drop) {
197                cld <- getClassDef(class(x))                cld <- getClassDef(class(x))
198                ## be smart to keep symmetric indexing of <symm.Mat.> symmetric:                ## be smart to keep symmetric indexing of <symm.Mat.> symmetric:
199                doSym <- (extends(cld, "symmetricMatrix") &&  ##>           doSym <- (extends(cld, "symmetricMatrix") &&
200                          length(i) == length(j) && all(i == j))  ##>                     length(i) == length(j) && all(i == j))
201                if(!doSym && !extends(cld, "generalMatrix"))  ##> why should this be needed; can still happen in <Tsparse>[..]:
202                    x <- as(x, "generalMatrix")  ##>           if(!doSym && !extends(cld, "generalMatrix"))
203    ##>               x <- as(x, "generalMatrix")
204  ##            viaCl <- paste(.M.kind(x, cld),  ##            viaCl <- paste(.M.kind(x, cld),
205  ##                           if(doSym) "sTMatrix" else "gTMatrix", sep='')  ##                           if(doSym) "sTMatrix" else "gTMatrix", sep='')
206                x <- callGeneric(x = as(x, "TsparseMatrix"), i=i, j=j, drop=drop)                x <- as(x, "TsparseMatrix")[i, j, drop=drop]
207                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))                if(is(x, "Matrix") && extends(cld, "CsparseMatrix"))
208                    as(x, "CsparseMatrix") else x                    as(x, "CsparseMatrix") else x
209            })            })
# Line 400  Line 406 
406  }  }
407    
408  setMethod("isSymmetric", signature(object = "sparseMatrix"),  setMethod("isSymmetric", signature(object = "sparseMatrix"),
409            function(object, tol = 100*.Machine$double.eps) {            function(object, tol = 100*.Machine$double.eps, ...) {
410                ## pretest: is it square?                ## pretest: is it square?
411                d <- dim(object)                d <- dim(object)
412                if(d[1] != d[2]) return(FALSE)                if(d[1] != d[2]) return(FALSE)
# Line 408  Line 414 
414                if (is(object, "dMatrix"))                if (is(object, "dMatrix"))
415                    ## use gC; "T" (triplet) is *not* unique!                    ## use gC; "T" (triplet) is *not* unique!
416                    isTRUE(all.equal(.as.dgC.0.factors(  object),                    isTRUE(all.equal(.as.dgC.0.factors(  object),
417                                     .as.dgC.0.factors(t(object)), tol = tol))                                     .as.dgC.0.factors(t(object)),
418                                       tol = tol, ...))
419                else if (is(object, "lMatrix"))                else if (is(object, "lMatrix"))
420                    ## test for exact equality; FIXME(?): identical() too strict?                    ## test for exact equality; FIXME(?): identical() too strict?
421                    identical(as(object, "lgCMatrix"),                    identical(as(object, "lgCMatrix"),

Legend:
Removed from v.2112  
changed lines
  Added in v.2113

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