# SCM Repository

[matrix] View of /pkg/R/dtpMatrix.R
 [matrix] / pkg / R / dtpMatrix.R

# View of /pkg/R/dtpMatrix.R

Thu Mar 31 17:10:16 2005 UTC (14 years, 10 months ago) by bates
File size: 3514 byte(s)
`Moving methods for operations with numeric to the Matrix class and with integer to the dMatrix class`
```#### Triangular Packed Matrices -- Coercion and Methods

setAs("dtpMatrix", "dtrMatrix",
function(from) .Call("dtpMatrix_as_dtrMatrix", from) )

setAs("dtpMatrix", "dgeMatrix",
function(from) as(as(from, "dtrMatrix"), "dgeMatrix"))

setAs("dtpMatrix", "matrix",
function(from) as(as(from, "dtrMatrix"), "matrix"))
setAs("matrix", "dtpMatrix",
function(from) as(as(from, "dtrMatrix"), "dtpMatrix"))

setMethod("%*%", signature(x = "dtpMatrix", y = "dgeMatrix"),
function(x, y) .Call("dtpMatrix_dgeMatrix_mm", x, y))
setMethod("%*%", signature(x = "dgeMatrix", y = "dtpMatrix"),
function(x, y) .Call("dgeMatrix_dtpMatrix_mm", x, y))
## %*% should always work for  <fooMatrix> %*% <fooMatrix>
setMethod("%*%", signature(x = "dtpMatrix", y = "dtpMatrix"),
function(x, y)
## FIXME: this is cheap; could we optimize chosing the better of
## callGeneric(x, as(y, "dgeMatrix"))  and
## callGeneric(as(x "dgeMatrix"), y))  depending on their 'uplo' ?
callGeneric(x, as(y, "dgeMatrix")))

## dtpMatrix <-> matrix : will be used by the "numeric" one
setMethod("%*%", signature(x = "dtpMatrix", y = "matrix"),
function(x, y) callGeneric(x, as(y, "dgeMatrix")))
setMethod("%*%", signature(x = "matrix", y = "dtpMatrix"),
function(x, y) callGeneric(as(x, "dgeMatrix"), y))

## dtpMatrix <-> numeric : the auxiliary functions are R version specific!
##setMethod("%*%", signature(x = "dtpMatrix", y = "numeric"), .M.v)
##setMethod("%*%", signature(x = "numeric", y = "dtpMatrix"), .v.M)

setMethod("determinant", signature(x = "dtpMatrix", logarithm = "missing"),
function(x, logarithm, ...) determinant(x, TRUE))

setMethod("determinant", signature(x = "dtpMatrix", logarithm = "logical"),
function(x, logarithm, ...) {
dg <- diag(x)
if (logarithm) {
modulus <- sum(log(abs(dg)))
sgn <- prod(sign(dg))
} else {
modulus <- prod(dg)
sgn <- sign(modulus)
modulus <- abs(modulus)
}
attr(modulus, "logarithm") <- logarithm
val <- list(modulus = modulus, sign = sgn)
class(val) <- "det"
val
})

setMethod("diag", signature(x = "dtpMatrix"),
function(x = 1, nrow, ncol = n) .Call("dtpMatrix_getDiag", x),
valueClass = "numeric")

setMethod("norm", signature(x = "dtpMatrix", type = "character"),
function(x, type, ...)
.Call("dtpMatrix_norm", x, type),
valueClass = "numeric")

setMethod("norm", signature(x = "dtpMatrix", type = "missing"),
function(x, type, ...)
.Call("dtpMatrix_norm", x, "O"),
valueClass = "numeric")

setMethod("rcond", signature(x = "dtpMatrix", type = "character"),
function(x, type, ...)
.Call("dtpMatrix_rcond", x, type),
valueClass = "numeric")

setMethod("rcond", signature(x = "dtpMatrix", type = "missing"),
function(x, type, ...)
.Call("dtpMatrix_rcond", x, "O"),
valueClass = "numeric")

setMethod("solve", signature(a = "dtpMatrix", b="missing"),
function(a, b, ...)
.Call("dtpMatrix_solve", a),
valueClass = "dtpMatrix")

setMethod("solve", signature(a = "dtpMatrix", b="matrix"),
function(a, b, ...)
.Call("dtpMatrix_matrix_solve", a, b),
valueClass = "matrix")

setMethod("t", signature(x = "dtpMatrix"),
function(x) as(t(as(x, "dtrMatrix")), "dtpMatrix"),
valueClass = "dtpMatrix")

setMethod("unpack", signature(x = "dtpMatrix"),
function(x, ...) as(x, "dtrMatrix"),
valueClass = "dtrMatrix")
###
```