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 1654, Fri Oct 27 16:58:15 2006 UTC revision 1655, Mon Oct 30 17:16:27 2006 UTC
# Line 86  Line 86 
86  setAs("diagonalMatrix", "generalMatrix", # prefer sparse:  setAs("diagonalMatrix", "generalMatrix", # prefer sparse:
87        function(from) as(from, paste(.M.kind(from), "gCMatrix", sep='')))        function(from) as(from, paste(.M.kind(from), "gCMatrix", sep='')))
88    
89    .diag.x <- function(m) {
90        if(m@diag == "U")
91            rep.int(if(is.numeric(m@x)) 1. else TRUE,
92                    m@Dim[1])
93        else m@x
94    }
95    
96    .diag.2N <- function(m) {
97        if(m@diag == "U") m@diag <- "N"
98        m
99    }
100    
101  ## given the above, the following  4  coercions should be all unneeded;  ## given the above, the following  4  coercions should be all unneeded;
102  ## we prefer triangular to general:  ## we prefer triangular to general:
103  setAs("ddiMatrix", "dgTMatrix",  setAs("ddiMatrix", "dgTMatrix",
# Line 93  Line 105 
105            .Deprecated("as(, \"sparseMatrix\")")            .Deprecated("as(, \"sparseMatrix\")")
106            n <- from@Dim[1]            n <- from@Dim[1]
107            i <- seq_len(n) - 1:1            i <- seq_len(n) - 1:1
108            new("dgTMatrix", i = i, j = i,            new("dgTMatrix", i = i, j = i, x = .diag.x(from),
               x = if(from@diag == "U") rep(1,n) else from@x,  
109                Dim = c(n,n), Dimnames = from@Dimnames) })                Dim = c(n,n), Dimnames = from@Dimnames) })
110    
111  setAs("ddiMatrix", "dgCMatrix",  setAs("ddiMatrix", "dgCMatrix",
112        function(from) as(as(from, "dgTMatrix"), "dgCMatrix"))        function(from) as(as(from, "sparseMatrix"), "dgCMatrix"))
113    
114  setAs("ldiMatrix", "lgTMatrix",  setAs("ldiMatrix", "lgTMatrix",
115        function(from) {        function(from) {
# Line 305  Line 316 
316    
317  ### ---------------- diagonal  o  sparse  -----------------------------  ### ---------------- diagonal  o  sparse  -----------------------------
318    
319    
320    ## Use function for several signatures, in order to evade
321    ## ambiguous dispatch for "ddi", since there's also Arith(ddense., ddense.)
322    diagOdiag <- function(e1,e2) { # result should also be diagonal
323        r <- callGeneric(.diag.x(e1), .diag.x(e2)) # error if not "compatible"
324        if(is.numeric(r)) {
325            if(is.numeric(e2@x)) {
326                e2@x <- r; return(.diag.2N(e2)) }
327            if(!is.numeric(e1@x))
328                ## e.g. e1, e2 are logical;
329                e1 <- as(e1, "dMatrix")
330        }
331        else if(is.logical(r))
332            e1 <- as(e1, "lMatrix")
333        else stop("intermediate 'r' is of type", typeof(r))
334        e1@x <- r
335        .diag.2N(e1)
336    }
337    
338    setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "diagonalMatrix"),
339              diagOdiag)
340    ## These two are just for method disambiguation:
341    setMethod("Ops", signature(e1 = "ddiMatrix", e2 = "diagonalMatrix"),
342              diagOdiag)
343    setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "ddiMatrix"),
344              diagOdiag)
345    
346    ## For almost everything else, diag* shall be treated "as sparse" :
347  ## These are cheap implementations via coercion  ## These are cheap implementations via coercion
348    
349    ## for disambiguation
350  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "sparseMatrix"),  setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "sparseMatrix"),
351            function(e1,e2) callGeneric(as(e1, "sparseMatrix"), e2))            function(e1,e2) callGeneric(as(e1, "sparseMatrix"), e2))
352  setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "diagonalMatrix"),  setMethod("Ops", signature(e1 = "sparseMatrix", e2 = "diagonalMatrix"),
353            function(e1,e2) callGeneric(e1, as(e2, "sparseMatrix")))            function(e1,e2) callGeneric(e1, as(e2, "sparseMatrix")))
354    ## in general:
355    setMethod("Ops", signature(e1 = "diagonalMatrix", e2 = "ANY"),
356              function(e1,e2) callGeneric(as(e1,"sparseMatrix"), e2))
357    setMethod("Ops", signature(e1 = "ANY", e2 = "diagonalMatrix"),
358              function(e1,e2) callGeneric(e1, as(e2,"sparseMatrix")))
359    
360    
361    
362  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()  ## FIXME?: In theory, this can be done *FASTER*, in some cases, via tapply1()
363    

Legend:
Removed from v.1654  
changed lines
  Added in v.1655

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