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 2174, Wed Apr 23 11:21:37 2008 UTC revision 2175, Wed Apr 23 11:23:50 2008 UTC
# Line 221  Line 221 
221            signature(x = "sparseMatrix"),            signature(x = "sparseMatrix"),
222            function(x) callGeneric(as(x, "CsparseMatrix")))            function(x) callGeneric(as(x, "CsparseMatrix")))
223    
224  ## further group methods -> see ./Ops.R  ## further group methods -> see ./Ops.R {"Summary": ./dMatrix.R }
225    
226    
227    
# Line 238  Line 238 
238  {  {
239      cl <- getClassDef(class(x))      cl <- getClassDef(class(x))
240      stopifnot(extends(cl, "sparseMatrix"))      stopifnot(extends(cl, "sparseMatrix"))
241        validObject(x) # have seen seg.faults for invalid objects
242      d <- dim(x)      d <- dim(x)
243      if(prod(d) > maxp) { # "Large" => will be "cut"      if(prod(d) > maxp) { # "Large" => will be "cut"
244          ## only coerce to dense that part which won't be cut :          ## only coerce to dense that part which won't be cut :
# Line 390  Line 391 
391                d <- dim(object)                d <- dim(object)
392                T <- as(object, "TsparseMatrix")                T <- as(object, "TsparseMatrix")
393                ## return a data frame (int, int,  {double|logical|...})  :                ## return a data frame (int, int,  {double|logical|...})  :
394                r <- data.frame(i = T@i + 1L, j = T@j + 1L, x = T@x)                r <- if(is(object,"nsparseMatrix"))
395                      data.frame(i = T@i + 1L, j = T@j + 1L)
396                  else data.frame(i = T@i + 1L, j = T@j + 1L, x = T@x)
397                attr(r, "header") <-                attr(r, "header") <-
398                    sprintf('%d x %d sparse Matrix of class "%s", with %d entries',                    sprintf('%d x %d sparse Matrix of class "%s", with %d entries',
399                            d[1], d[2], class(object),                            d[1], d[2], class(object), length(T@i))
                           nnzero(object, na.counted=TRUE))  
400                ## use ole' S3 technology for such a simple case                ## use ole' S3 technology for such a simple case
401                class(r) <- c("sparseSummary", class(r))                class(r) <- c("sparseSummary", class(r))
402                r                r
# Line 450  Line 452 
452            })            })
453    
454    
455    setMethod("determinant", signature(x = "sparseMatrix", logarithm = "missing"),
456              function(x, logarithm, ...)
457              determinant(x, logarithm = TRUE, ...))
458    setMethod("determinant", signature(x = "sparseMatrix", logarithm = "logical"),
459              function(x, logarithm = TRUE, ...)
460              determinant(as(x,"dsparseMatrix"), logarithm, ...))
461    
462    
463  setMethod("diag", signature(x = "sparseMatrix"),  setMethod("diag", signature(x = "sparseMatrix"),
464            function(x, nrow, ncol = n) diag(as(x, "CsparseMatrix")))            function(x, nrow, ncol = n) diag(as(x, "CsparseMatrix")))
465    
# Line 512  Line 522 
522                as(r, "symmetricMatrix")                as(r, "symmetricMatrix")
523            })            })
524    
525  setMethod("is.na", signature(x = "sparseMatrix"),  setMethod("is.na", signature(x = "sparseMatrix"),## NB: nsparse* have own method!
526            function(x) {            function(x) {
527                if(any((inax <- is.na(x@x)))) {                if(any((inax <- is.na(x@x)))) {
528                      cld <- getClassDef(class(x))
529                      if(extends(cld, "triangularMatrix") && x@diag == "U")
530                          inax <- is.na((x <- .diagU2N(x, cld))@x)
531                    r <- as(x, "lMatrix")# will be "lsparseMatrix" - *has* x slot                    r <- as(x, "lMatrix")# will be "lsparseMatrix" - *has* x slot
532                    r@x <- inax                    r@x <- inax
533                    as(r, "nMatrix") # a 'pattern matrix                    as(r, "nMatrix") # a 'pattern matrix
               } else {  
                   d <- x@Dim  
                   new("ngCMatrix", Dim = d, Dimnames = dimnames(x),  
                       i = integer(0), p = rep.int(0L, d[2]+1L))  
534                }                }
535                  else is.na_nsp(x)
536            })            })
537    
538    

Legend:
Removed from v.2174  
changed lines
  Added in v.2175

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