# SCM Repository

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

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

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