Revision 064f27d90fcbda7122d5b74508651e2917cc3feb authored by Doug and Martin on 17 October 2011, 00:00:00 UTC, committed by Gabor Csardi on 17 October 2011, 00:00:00 UTC
1 parent a707be9
ndenseMatrix.R
#### "ndenseMatrix" - virtual class of nonzero pattern dense matrices
#### ------------
#### Contains nge*; ntr*, ntp*; nsy*, nsp*; ndi*
## Nonzero Pattern -> Double {of same structure}:
setAs("ngeMatrix", "dgeMatrix", function(from) n2d_Matrix(from, "ngeMatrix"))
setAs("nsyMatrix", "dsyMatrix", function(from) n2d_Matrix(from, "nsyMatrix"))
setAs("nspMatrix", "dspMatrix", function(from) n2d_Matrix(from, "nspMatrix"))
setAs("ntrMatrix", "dtrMatrix", function(from) n2d_Matrix(from, "ntrMatrix"))
setAs("ntpMatrix", "dtpMatrix", function(from) n2d_Matrix(from, "ntpMatrix"))
### NOTA BENE: Much of this is *very* parallel to ./ldenseMatrix.R
### ~~~~~~~~~~~~~~~~
setAs("ndenseMatrix", "ldenseMatrix", function(from) n2l_Matrix(from))
setAs("ngeMatrix", "lgeMatrix", function(from) n2l_Matrix(from, "ngeMatrix"))
setAs("nsyMatrix", "lsyMatrix", function(from) n2l_Matrix(from, "nsyMatrix"))
setAs("nspMatrix", "lspMatrix", function(from) n2l_Matrix(from, "nspMatrix"))
setAs("ntrMatrix", "ltrMatrix", function(from) n2l_Matrix(from, "ntrMatrix"))
setAs("ntpMatrix", "ltpMatrix", function(from) n2l_Matrix(from, "ntpMatrix"))
## all need be coercable to "ngeMatrix":
setAs("nsyMatrix", "ngeMatrix", function(from)
.Call(lsyMatrix_as_lgeMatrix, from, 1L))
setAs("ntrMatrix", "ngeMatrix", function(from)
.Call(ltrMatrix_as_lgeMatrix, from, 1L))
setAs("ntpMatrix", "ngeMatrix",
function(from) as(as(from, "ntrMatrix"), "ngeMatrix"))
setAs("nspMatrix", "ngeMatrix",
function(from) as(as(from, "nsyMatrix"), "ngeMatrix"))
## and the reverse
setAs("ngeMatrix", "ntpMatrix",
function(from) as(as(from, "ntrMatrix"), "ntpMatrix"))
setAs("ngeMatrix", "nspMatrix",
function(from) as(as(from, "nsyMatrix"), "nspMatrix"))
## packed <-> non-packed :
setAs("nspMatrix", "nsyMatrix",
function(from)
.Call(lspMatrix_as_lsyMatrix, from, 1L))
setAs("nsyMatrix", "nspMatrix",
function(from)
.Call(lsyMatrix_as_lspMatrix, from, 1L))
setAs("ntpMatrix", "ntrMatrix",
function(from)
.Call(ltpMatrix_as_ltrMatrix, from, 1L))
setAs("ntrMatrix", "ntpMatrix",
function(from)
.Call(ltrMatrix_as_ltpMatrix, from, 1L))
### -> symmetric :
if(FALSE) ## not sure if this is a good idea ... -- FIXME?
setIs("ngeMatrix", "nsyMatrix",
test = function(obj) isSymmetric(obj),
replace = function(obj, value) { ## copy all slots
for(n in slotNames(obj)) slot(obj, n) <- slot(value, n)
})
### Alternative (at least works):
setAs("ngeMatrix", "nsyMatrix",
function(from) {
if(isSymmetric(from))
new("nsyMatrix", x = from@x, Dim = from@Dim,
Dimnames = from@Dimnames, factors = from@factors)
else
stop("not a symmetric matrix; consider forceSymmetric() or symmpart()")
})
setAs("ngeMatrix", "ntrMatrix",
function(from) {
if(isT <- isTriangular(from))
new("ntrMatrix", x = from@x, Dim = from@Dim,
Dimnames = from@Dimnames, uplo = .if.NULL(attr(isT, "kind"), "U"))
## TODO: also check 'diag'
else stop("not a triangular matrix")
})
### ldense* <-> "matrix" :
## 1) "nge* :
setAs("ngeMatrix", "matrix",
function(from) array(from@x, dim = from@Dim, dimnames = from@Dimnames))
setAs("matrix", "ngeMatrix",
function(from) {
new("ngeMatrix",
x = as.logical(from),
Dim = as.integer(dim(from)),
Dimnames = .M.DN(from))
})
## 2) base others on "nge*":
setAs("matrix", "nsyMatrix",
function(from) as(as(from, "ngeMatrix"), "nsyMatrix"))
setAs("matrix", "nspMatrix",
function(from) as(as(from, "nsyMatrix"), "nspMatrix"))
setAs("matrix", "ntrMatrix",
function(from) as(as(from, "ngeMatrix"), "ntrMatrix"))
setAs("matrix", "ntpMatrix",
function(from) as(as(from, "ntrMatrix"), "ntpMatrix"))
## Useful if this was called e.g. for as(*, "nsyMatrix"), but it isn't
setAs("matrix", "ndenseMatrix", function(from) as(from, "ngeMatrix"))
setAs("ndenseMatrix", "matrix", ## uses the above l*M. -> lgeM.
function(from) as(as(from, "ngeMatrix"), "matrix"))
## dense |-> compressed :
## go via "l" because dense_to_Csparse can't be used for "n" [missing CHOLMOD function]
setAs("ndenseMatrix", "CsparseMatrix",
function(from) as(as(as(from, "lMatrix"), "CsparseMatrix"), "nMatrix"))
## setAs("ndenseMatrix", "sparseMatrix",
## function(from) as(as(as(from, "lMatrix"), "sparseMatrix"), "nMatrix"))
setAs("ndenseMatrix", "TsparseMatrix",
function(from) {
if(is(from, "generalMatrix")) {
## cheap but not so efficient:
ij <- which(as(from,"matrix"), arr.ind = TRUE) - 1L
new("ngTMatrix", i = ij[,1], j = ij[,2],
Dim = from@Dim, Dimnames = from@Dimnames,
factors = from@factors)
}
else
## triangular or symmetric (have *no* diagonal nMatrix)
## is delicate {packed or not, upper /lower indices ..} -> easy way
as(as(as(from, "lMatrix"), "TsparseMatrix"), "nMatrix")
})
## Not sure, if these are needed or more efficient than the above:
## First one probably is
setAs("ngeMatrix", "ngTMatrix",
function(from) {
## cheap but not so efficient:
ij <- which(as(from,"matrix"), arr.ind = TRUE) - 1L
new("ngTMatrix", i = ij[,1], j = ij[,2],
Dim = from@Dim, Dimnames = from@Dimnames,
factors = from@factors)
})
setAs("ngeMatrix", "ngCMatrix",
function(from) as(as(from, "ngTMatrix"), "ngCMatrix"))
setMethod("as.logical", signature(x = "ndenseMatrix"),
function(x, ...) as(x, "ngeMatrix")@x)
###----------------------------------------------------------------------
setMethod("t", signature(x = "ngeMatrix"), t_geMatrix)
setMethod("t", signature(x = "ntrMatrix"), t_trMatrix)
setMethod("t", signature(x = "nsyMatrix"), t_trMatrix)
setMethod("t", signature(x = "ntpMatrix"),
function(x) as(t(as(x, "ntrMatrix")), "ntpMatrix"))
setMethod("t", signature(x = "nspMatrix"),
function(x) as(t(as(x, "nsyMatrix")), "nspMatrix"))
## NOTE: "&" and "|" are now in group "Logic" c "Ops" --> ./Ops.R
## "!" is in ./not.R
setMethod("as.vector", signature(x = "ndenseMatrix", mode = "missing"),
function(x, mode) as(x, "ngeMatrix")@x)
setMethod("norm", signature(x = "ndenseMatrix", type = "character"),
function(x, type, ...)
.Call(dgeMatrix_norm, as(as(x,"dMatrix"),"dgeMatrix"), type),
valueClass = "numeric")
setMethod("rcond", signature(x = "ndenseMatrix", norm = "character"),
.rcond_via_d, valueClass = "numeric")
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...