### Coercion and Methods for Dense Numeric Symmetric Matrices ## or rather setIs() {since test can fail ?} setAs("dgeMatrix", "dsyMatrix", function(from) { if(isSymmetric(from)) new("dsyMatrix", x = from@x, Dim = from@Dim, Dimnames = from@Dimnames, factors = from@factors) else stop("not a symmetric matrix") }) setAs("matrix", "dsyMatrix", function(from) as(as(from, "dgeMatrix"), "dsyMatrix")) setAs("dsyMatrix", "matrix", function(from) .Call(dsyMatrix_as_matrix, from)) setAs("dsyMatrix", "dspMatrix", function(from) .Call(dsyMatrix_as_dspMatrix, from)) setAs("dsyMatrix", "dsTMatrix", function(from) { # 'dsT': only store upper *or* lower ## working via "matrix" : not very efficient (FIXME) ij <- which((m <- as(from,"matrix")) != 0, arr.ind = TRUE) uplo <- from@uplo ij <- ij[if(uplo == "U") ij[,1] <= ij[,2] else ij[,1] >= ij[,2] , , drop = FALSE] new("dsTMatrix", i = ij[,1] - 1:1, j = ij[,2] - 1:1, x = as.vector(m[ij]), uplo = uplo, Dim = from@Dim, Dimnames = from@Dimnames) }) setAs("dsyMatrix", "dsCMatrix", function(from) as(as(from, "dsTMatrix"), "dsCMatrix")) ## Note: Just *because* we have an explicit dtr -> dge coercion, ## show( ) is not okay, and we need our own: setMethod("show", "dsyMatrix", function(object) prMatrix(object)) setMethod("rcond", signature(x = "dsyMatrix", type = "character"), function(x, type, ...) .Call(dsyMatrix_rcond, x, type), valueClass = "numeric") setMethod("rcond", signature(x = "dsyMatrix", type = "missing"), function(x, type, ...) .Call(dsyMatrix_rcond, x, "O"), valueClass = "numeric") setMethod("%*%", signature(x = "dsyMatrix", y = "ddenseMatrix"), function(x, y) .Call(dsyMatrix_matrix_mm, x, y, FALSE)) setMethod("%*%", signature(x = "dsyMatrix", y = "matrix"), function(x, y) .Call(dsyMatrix_matrix_mm, x, y, FALSE)) setMethod("%*%", signature(x = "ddenseMatrix", y = "dsyMatrix"), function(x, y) .Call(dsyMatrix_matrix_mm, y, x, TRUE)) setMethod("solve", signature(a = "dsyMatrix", b = "missing"), function(a, b, ...) .Call(dsyMatrix_solve, a), valueClass = "dsyMatrix") setMethod("solve", signature(a = "dsyMatrix", b = "matrix"), function(a, b, ...) .Call(dsyMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("solve", signature(a = "dsyMatrix", b = "ddenseMatrix"), function(a, b, ...) .Call(dsyMatrix_matrix_solve, a, b), valueClass = "dgeMatrix") setMethod("norm", signature(x = "dsyMatrix", type = "character"), function(x, type, ...) .Call(dsyMatrix_norm, x, type), valueClass = "numeric") setMethod("norm", signature(x = "dsyMatrix", type = "missing"), function(x, type, ...) .Call(dsyMatrix_norm, x, "O"), valueClass = "numeric") ## Should this create the opposite storage format - i.e. "U" -> "L" ## and vice-versa? ## MM: I think yes, since the other part can be filled arbitrarily (wrongly) ##WAS setMethod("t", signature(x = "dsyMatrix"), function(x) x) setMethod("t", signature(x = "dsyMatrix"), t_trMatrix, valueClass = "dsyMatrix") ## The following has the severe effect of making ## "dsyMatrix" a subclass of "dpoMatrix" and since the reverse is ## by definition of "dpoMatrix", the class-hierarchy gets a *cycle* ! ## setIs("dsyMatrix", "dpoMatrix", test = function(obj) "try-error" != class(try(.Call(dpoMatrix_chol, obj), silent=TRUE)), replace = function(obj, value) { ## copy all slots (is needed) for(n in slotNames(obj)) slot(obj, n) <- slot(value, n) obj }) ## Now that we have "chol", we can define "determinant" methods, ## exactly like in ./dsCMatrix.R ## DB - Probably figure out how to use the BunchKaufman decomposition instead ## {{FIXME: Shouldn't it be possible to have "determinant" work by ## default automatically for "Matrix"es when there's a "chol" method available? ## ..> work with ss <- selectMethod("chol", signature("dgCMatrix")) ## -- not have to define showMethod("determinant", ...) for all classes