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 2238, Fri Jul 25 08:04:22 2008 UTC revision 2239, Mon Jul 28 19:26:40 2008 UTC
# Line 214  Line 214 
214  ## ddi*:  ## ddi*:
215  diag2tT <- function(from) .diag2tT(from, "U", "d")  diag2tT <- function(from) .diag2tT(from, "U", "d")
216  setAs("ddiMatrix", "triangularMatrix", diag2tT)  setAs("ddiMatrix", "triangularMatrix", diag2tT)
217  setAs("ddiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ddiMatrix", "sparseMatrix", diag2tT)
218  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
219  setAs("ddiMatrix", "TsparseMatrix", diag2tT)  setAs("ddiMatrix", "TsparseMatrix", diag2tT)
220  setAs("ddiMatrix", "CsparseMatrix",  setAs("ddiMatrix", "CsparseMatrix",
# Line 225  Line 225 
225  ## ldi*:  ## ldi*:
226  diag2tT <- function(from) .diag2tT(from, "U", "l")  diag2tT <- function(from) .diag2tT(from, "U", "l")
227  setAs("ldiMatrix", "triangularMatrix", diag2tT)  setAs("ldiMatrix", "triangularMatrix", diag2tT)
228  setAs("ldiMatrix", "sparseMatrix", diag2tT)  ##_no_longer_ setAs("ldiMatrix", "sparseMatrix", diag2tT)
229  ## needed too (otherwise <dense> -> Tsparse is taken):  ## needed too (otherwise <dense> -> Tsparse is taken):
230  setAs("ldiMatrix", "TsparseMatrix", diag2tT)  setAs("ldiMatrix", "TsparseMatrix", diag2tT)
231  setAs("ldiMatrix", "CsparseMatrix",  setAs("ldiMatrix", "CsparseMatrix",
# Line 331  Line 331 
331            function(x = 1, nrow, ncol) .diag.x(x))            function(x = 1, nrow, ncol) .diag.x(x))
332    
333  subDiag <- function(x, i, j, ..., drop) {  subDiag <- function(x, i, j, ..., drop) {
334      x <- as(x, "sparseMatrix")      x <- as(x, "TsparseMatrix")
335      x <- if(missing(i))      x <- if(missing(i))
336          x[, j, drop=drop]          x[, j, drop=drop]
337      else if(missing(j))      else if(missing(j))
# Line 355  Line 355 
355  ## FIXME: this now fails because the "denseMatrix" methods come first in dispatch  ## FIXME: this now fails because the "denseMatrix" methods come first in dispatch
356  ## Only(?) current bug:  x[i] <- value  is wrong when  i is *vector*  ## Only(?) current bug:  x[i] <- value  is wrong when  i is *vector*
357  replDiag <- function(x, i, j, ..., value) {  replDiag <- function(x, i, j, ..., value) {
358      x <- as(x, "sparseMatrix")      x <- as(x, "TsparseMatrix")
359      if(missing(i))      if(missing(i))
360          x[, j] <- value          x[, j] <- value
361      else if(missing(j)) { ##  x[i , ] <- v  *OR*   x[i] <- v      else if(missing(j)) { ##  x[i , ] <- v  *OR*   x[i] <- v
# Line 400  Line 400 
400                               x@x[ii] <- value                               x@x[ii] <- value
401                               x                               x
402                           } else { ## no longer diagonal, but remain sparse:                           } else { ## no longer diagonal, but remain sparse:
403                               x <- as(x, "sparseMatrix")                               x <- as(x, "TsparseMatrix")
404                               x[i] <- value                               x[i] <- value
405                               x                               x
406                           }                           }
# Line 417  Line 417 
417                   function(x,i,j, ..., value) replDiag(x, j=j, value=value))                   function(x,i,j, ..., value) replDiag(x, j=j, value=value))
418    
419  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index",  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "missing", j = "index",
420                                  value = "scarceMatrix"),                                  value = "sparseMatrix"),
421                   function (x, i, j, ..., value)                   function (x, i, j, ..., value)
422                   callGeneric(x=x, , j=j, value = as(value, "sparseVector")))                   callGeneric(x=x, , j=j, value = as(value, "sparseVector")))
423  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing",  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "missing",
424                                  value = "scarceMatrix"),                                  value = "sparseMatrix"),
425                   function (x, i, j, ..., value)                   function (x, i, j, ..., value)
426                   callGeneric(x=x, i=i, , value = as(value, "sparseVector")))                   callGeneric(x=x, i=i, , value = as(value, "sparseVector")))
427  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index",  setReplaceMethod("[", signature(x = "diagonalMatrix", i = "index", j = "index",
428                                  value = "scarceMatrix"),                                  value = "sparseMatrix"),
429                   function (x, i, j, ..., value)                   function (x, i, j, ..., value)
430                   callGeneric(x=x, i=i, j=j, value = as(value, "sparseVector")))                   callGeneric(x=x, i=i, j=j, value = as(value, "sparseVector")))
431    
# Line 591  Line 591 
591  ##           })  ##           })
592    
593  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("crossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
594            function(x, y = NULL) crossprod(as(x, "sparseMatrix"), y))            function(x, y = NULL) crossprod(as(x, "TsparseMatrix"), y))
595    
596  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("crossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
597            function(x, y = NULL) crossprod(x, as(y, "sparseMatrix")))            function(x, y = NULL) crossprod(x, as(y, "TsparseMatrix")))
598    
599  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("tcrossprod", signature(x = "diagonalMatrix", y = "sparseMatrix"),
600            function(x, y = NULL) tcrossprod(as(x, "sparseMatrix"), y))            function(x, y = NULL) tcrossprod(as(x, "TsparseMatrix"), y))
601    
602  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("tcrossprod", signature(x = "sparseMatrix", y = "diagonalMatrix"),
603            function(x, y = NULL) tcrossprod(x, as(y, "sparseMatrix")))            function(x, y = NULL) tcrossprod(x, as(y, "TsparseMatrix")))
604    
605    
606  ## 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()
607  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),  setMethod("%*%", signature(x = "diagonalMatrix", y = "sparseMatrix"),
608            function(x, y) as(x, "sparseMatrix") %*% y)            function(x, y) as(x, "TsparseMatrix") %*% y)
609  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),  setMethod("%*%", signature(x = "sparseMatrix", y = "diagonalMatrix"),
610            function(x, y) x %*% as(y, "sparseMatrix"))            function(x, y) x %*% as(y, "TsparseMatrix"))
611  ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)  ## NB: The previous is *not* triggering for  "ddi" o "dgC" (= distance 3)
612  ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.  ##     since there's a "ddense" o "Csparse" at dist. 2 => triggers first.
613  ## ==> do this:  ## ==> do this:

Legend:
Removed from v.2238  
changed lines
  Added in v.2239

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