SCM

SCM Repository

[matrix] Diff of /pkg/Matrix/R/diagMatrix.R
ViewVC logotype

Diff of /pkg/Matrix/R/diagMatrix.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2183, Thu Apr 24 10:58:51 2008 UTC revision 2185, Sat Apr 26 20:33:16 2008 UTC
# Line 181  Line 181 
181  setAs("diagonalMatrix", "generalMatrix", # prefer sparse:  setAs("diagonalMatrix", "generalMatrix", # prefer sparse:
182        function(from) as(as(from, "CsparseMatrix"), "generalMatrix"))        function(from) as(as(from, "CsparseMatrix"), "generalMatrix"))
183    
184  .diag.x <- function(m) {  .diag.x <- function(m) if(m@diag == "U") rep.int(as1(m@x), m@Dim[1]) else m@x
     if(m@diag == "U")  
         rep.int(if(is.numeric(m@x)) 1. else TRUE, m@Dim[1])  
     else m@x  
 }  
185    
186  .diag.2N <- function(m) {  .diag.2N <- function(m) {
187      if(m@diag == "U") m@diag <- "N"      if(m@diag == "U") m@diag <- "N"
188      m      m
189  }  }
190    
 if(FALSE) {  
 ## given the above, the following  4  coercions should be all unneeded;  
 ## we prefer triangular to general:  
 setAs("ddiMatrix", "dgTMatrix",  
       function(from) {  
           .Deprecated("as(, \"sparseMatrix\")")  
           n <- from@Dim[1]  
           i <- seq_len(n) - 1L  
           new("dgTMatrix", i = i, j = i, x = .diag.x(from),  
               Dim = c(n,n), Dimnames = from@Dimnames) })  
   
 setAs("ddiMatrix", "dgCMatrix",  
       function(from) as(as(from, "sparseMatrix"), "dgCMatrix"))  
   
 setAs("ldiMatrix", "lgTMatrix",  
       function(from) {  
           .Deprecated("as(, \"sparseMatrix\")")  
           n <- from@Dim[1]  
           if(from@diag == "U") { # unit-diagonal  
               x <- rep.int(TRUE, n)  
               i <- seq_len(n) - 1L  
           } else { # "normal"  
               nz <- nz.NA(from@x, na. = TRUE)  
               x <- from@x[nz]  
               i <- which(nz) - 1L  
           }  
           new("lgTMatrix", i = i, j = i, x = x,  
               Dim = c(n,n), Dimnames = from@Dimnames) })  
   
 setAs("ldiMatrix", "lgCMatrix",  
       function(from) as(as(from, "lgTMatrix"), "lgCMatrix"))  
 }##{unused}  
   
191  setAs("ddiMatrix", "dgeMatrix",  setAs("ddiMatrix", "dgeMatrix",
192        function(from) .Call(dup_mMatrix_as_dgeMatrix, from))        function(from) .Call(dup_mMatrix_as_dgeMatrix, from))
193  setAs("ddiMatrix", "ddenseMatrix",  setAs("ddiMatrix", "ddenseMatrix",
# Line 273  Line 236 
236        })        })
237    
238    
239  ## In order to evade method dispatch ambiguity warnings,  setMethod("diag", signature(x = "diagonalMatrix"),
 ## we use this hack instead of signature  x = "diagonalMatrix" :  
 diCls <- names(getClass("diagonalMatrix")@subclasses)  
 for(cls in diCls) {  
     setMethod("diag", signature(x = cls),  
240                function(x = 1, nrow, ncol) .diag.x(x))                function(x = 1, nrow, ncol) .diag.x(x))
 }  
   
241    
242  subDiag <- function(x, i, j, ..., drop) {  subDiag <- function(x, i, j, ..., drop) {
243      x <- as(x, "sparseMatrix")      x <- as(x, "sparseMatrix")
# Line 387  Line 344 
344  setMethod("chol", signature(x = "ldiMatrix"), function(x, pivot, ...) x)  setMethod("chol", signature(x = "ldiMatrix"), function(x, pivot, ...) x)
345    
346  setMethod("determinant", signature(x = "diagonalMatrix", logarithm = "logical"),  setMethod("determinant", signature(x = "diagonalMatrix", logarithm = "logical"),
347            function(x, logarithm, ...)            function(x, logarithm, ...) mkDet(.diag.x(x), logarithm))
           mkDet(if(x@diag == "U") rep.int(as1(x@x), x@Dim[1]) else x@x,  
                 logarithm))  
348    
349  setMethod("norm", signature(x = "diagonalMatrix", type = "character"),  setMethod("norm", signature(x = "diagonalMatrix", type = "character"),
350            function(x, type, ...) {            function(x, type, ...) {
# Line 614  Line 569 
569  }  }
570    
571  ### This would be *the* way, but we get tons of "ambiguous method dispatch"  ### This would be *the* way, but we get tons of "ambiguous method dispatch"
572    ## we use this hack instead of signature  x = "diagonalMatrix" :
573    diCls <- names(getClass("diagonalMatrix")@subclasses)
574  if(FALSE) {  if(FALSE) {
575  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "diagonalMatrix"),  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "diagonalMatrix"),
576            diagOdiag)            diagOdiag)

Legend:
Removed from v.2183  
changed lines
  Added in v.2185

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