R/AllClass.R

Defines functions .new .initialize

## README:
##
## Validity methods should assume that methods for superclasses have passed,
## following validObject(). We should _not_ be testing, e.g., length(Dim),
## typeof(Dimnames), etc. repeatedly ...
##
## When checking whether a class is validated correctly, take care to follow
## the 'contains' recursively!!


## initialize() method for Matrix and MatrixFactorization, which both
## allow Dimnames[[i]] to be a vector of type other than "character"
## and furthermore to be a vector of length zero rather than NULL ...
.initialize <- function(.Object, ...) {
    .Object <- callNextMethod()
    ## Suboptimal if ...names() is NULL but that will "never"
    ## happen if ...length() is nonzero:
    if(...length() && any(...names() == "Dimnames"))
        .Object@Dimnames <- fixupDN(.Object@Dimnames)
    .Object
}

## new() does not work at build time because native symbols such as
## 'Matrix_validate' needed for validity checking are not available ...
.new <- function(cl, ...) {
    def <- getClassDef(cl)
    structure(def@prototype, class = def@className, ...)
}


########################################################################
##  1. Matrix
########################################################################

## ====== Virtual Subclasses ===========================================

## ------ The Mother Class 'Matrix' ------------------------------------

## Virtual class of all Matrix objects
setClass("Matrix", contains = "VIRTUAL",
         slots = c(Dim = "integer", Dimnames = "list"),
         prototype = list(Dim = integer(2L), Dimnames = list(NULL, NULL)),
         validity = function(object) .Call(Matrix_validate, object))

setMethod("initialize", "Matrix", .initialize)


## ------ Virtual by structure -----------------------------------------

## Virtual class of composite matrices,
## i.e., those for which it makes sense to define a factorization
setClass("compMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(factors = "list"),
         validity = function(object) .Call(compMatrix_validate, object))

## Virtual class of matrices that are not symmetric, triangular, _or diagonal_
setClass("generalMatrix", contains = c("compMatrix", "VIRTUAL"))

## Virtual class of triangular matrices
setClass("triangularMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(uplo = "character", diag = "character"),
         prototype = list(uplo = "U", diag = "N"),
         validity = function(object) .Call(triangularMatrix_validate, object))

## Virtual class of symmetric matrices
setClass("symmetricMatrix", contains = c("compMatrix", "VIRTUAL"),
         slots = c(uplo = "character"),
         prototype = list(uplo = "U"),
         validity = function(object) .Call(symmetricMatrix_validate, object))


## ------ Virtual by kind ----------------------------------------------

## Virtual class of _n_onzero pattern matrices
## NB: only subclass ndenseMatrix requires an 'x' slot
setClass("nMatrix", contains = c("Matrix", "VIRTUAL"))

## Virtual class of logical matrices,
## * typically the result of comparisons, e.g., <dMatrix> <relop> <dMatrix>,
##   hence NA are allowed and distinct from TRUE, in contrast with nMatrix
setClass("lMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(x = "logical"),
         validity = function(object) .Call(lMatrix_validate, object))

## Virtual class of integer matrices
setClass("iMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(x = "integer"),
         validity = function(object) .Call(iMatrix_validate, object))

## Virtual class of double matrices
setClass("dMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(x = "numeric"),
         validity = function(object) .Call(dMatrix_validate, object))

## Virtual class of complex matrices
## * initial 'z' is derived from the names of LAPACK routines
setClass("zMatrix", contains = c("Matrix", "VIRTUAL"),
         slots = c(x = "complex"),
         validity = function(object) .Call(zMatrix_validate, object))


## ------ Virtual Dense ------------------------------------------------

## Virtual class of dense matrices
## * includes "unpacked" _and_ "packed" matrices
## * included diagonal matrices until 0.999375-11 (2008-07)
setClass("denseMatrix", contains = c("Matrix", "VIRTUAL"))


## ...... Virtual Dense ... by storage .................................

## Virtual class of dense, "unpacked" matrices, s.t. length(.@x) == m*n
setClass("unpackedMatrix", contains = c("denseMatrix", "VIRTUAL"),
         validity = function(object) .Call(unpackedMatrix_validate, object))

## Virtual class of dense, "packed" matrices, s.t. length(.@x) == n*(n+1)/2
setClass("packedMatrix", contains = c("denseMatrix", "VIRTUAL"),
         slots = c(uplo = "character"),
         prototype = list(uplo = "U"),
         validity = function(object) .Call(packedMatrix_validate, object))


## ...... Virtual Dense ... by kind ....................................

## Virtual class of dense, _n_onzero pattern matrices
setClass("ndenseMatrix", contains = c("nMatrix", "denseMatrix", "VIRTUAL"),
         slots = c(x = "logical"),
         validity = function(object) .Call(nMatrix_validate, object))

## Virtual class of dense, logical matrices
setClass("ldenseMatrix", contains = c("lMatrix", "denseMatrix", "VIRTUAL"))

if(FALSE) { # --NOT YET--
## Virtual class of dense, integer matrices
setClass("idenseMatrix", contains = c("iMatrix", "denseMatrix", "VIRTUAL"))
} # --NOT YET--

## Virtual class of dense, double matrices
setClass("ddenseMatrix", contains = c("dMatrix", "denseMatrix", "VIRTUAL"))

if(FALSE) { # --NOT YET--
## Virtual class of dense, complex matrices
setClass("zdenseMatrix", contains = c("zMatrix", "denseMatrix", "VIRTUAL"))
} # --NOT YET--


## ------ Virtual Sparse -----------------------------------------------

## Virtual class of sparse matrices
## * includes diagonal matrices since 0.999375-11 (2008-07)
setClass("sparseMatrix", contains = c("Matrix", "VIRTUAL"))


## ...... Virtual Sparse ... by storage ................................

## Virtual class of sparse matrices in compressed sparse column (CSC) format
setClass("CsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"),
         slots = c(i = "integer", p = "integer"),
         prototype = list(p = 0L), # to be valid
         validity = function(object) .Call(CsparseMatrix_validate, object))

## Virtual class of sparse matrices in compressed sparse row (CSR) format
setClass("RsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"),
         slots = c(p = "integer", j = "integer"),
         prototype = list(p = 0L), # to be valid
         validity = function(object) .Call(RsparseMatrix_validate, object))

## Virtual class of sparse matrices in triplet format
setClass("TsparseMatrix", contains = c("sparseMatrix", "VIRTUAL"),
         slots = c(i = "integer", j = "integer"),
         validity = function(object) .Call(TsparseMatrix_validate, object))

## Virtual class of diagonal matrices
setClass("diagonalMatrix", contains = c("sparseMatrix", "VIRTUAL"),
         slots = c(diag = "character"),
         prototype = list(diag = "N"),
         validity = function(object) .Call(diagonalMatrix_validate, object))

if(FALSE) { # --NOT YET--
## These methods would allow initialization of zero matrices _without_ 'p',
## as in the call new("dgCMatrix", Dim = c(6L, 6L)).  However, they would
## also incur a small performance penalty on all other new("..[CR]Matrix")
## calls.
setMethod("initialize", "CsparseMatrix",
          function(.Object, ...) {
              ## Suboptimal if ...names() is NULL or if 'Dim' is missing
              ## but that will "never" happen if ...length() is nonzero:
              if(...length() &&
                 all((nms <- ...names()) != "p") &&
                 length(w <- which(nms == "Dim")) &&
                 !is.character(validDim(d <- ...elt(w[1L]))))
                  callNextMethod(.Object, ..., p = integer(d[2L] + 1))
              else callNextMethod()
          })

setMethod("initialize", "RsparseMatrix",
          function(.Object, ...) {
              ## Suboptimal if ...names() is NULL or if 'Dim' is missing
              ## but that will "never" happen if ...length() is nonzero:
              if(...length() &&
                 all((nms <- ...names()) != "p") &&
                 length(w <- which(nms == "Dim")) &&
                 !is.character(validDim(d <- ...elt(w[1L]))))
                  callNextMethod(.Object, ..., p = integer(d[1L] + 1))
              else callNextMethod()
          })
} # --NOT YET--


## ...... Virtual Sparse ... by kind ...................................

## Virtual class of sparse, _n_onzero pattern matrices
## * these are the "pattern" matrices from "symbolic analysis" of sparse OPs
setClass("nsparseMatrix", contains = c("nMatrix", "sparseMatrix", "VIRTUAL"))

## Virtual class of sparse, logical matrices
setClass("lsparseMatrix", contains = c("lMatrix", "sparseMatrix", "VIRTUAL"))

if(FALSE) { # --NOT YET--
## Virtual class of sparse, integer matrices
setClass("isparseMatrix", contains = c("iMatrix", "sparseMatrix", "VIRTUAL"))
} # --NOT YET--

## Virtual class of sparse, double matrices
setClass("dsparseMatrix", contains = c("dMatrix", "sparseMatrix", "VIRTUAL"))

if(FALSE) { # --NOT YET--
## Virtual class of sparse, complex matrices
setClass("zsparseMatrix", contains = c("zMatrix", "sparseMatrix", "VIRTUAL"))
} # --NOT YET--


## ====== Non-Virtual Subclasses =======================================

## ------ Non-Virtual Dense --------------------------------------------

## ...... Dense, _n_onzero pattern .....................................

## Unpacked, general
setClass("ngeMatrix",
         contains = c("unpackedMatrix", "ndenseMatrix", "generalMatrix"))

## Unpacked, triangular
setClass("ntrMatrix",
         contains = c("unpackedMatrix", "ndenseMatrix", "triangularMatrix"))

## Unpacked, symmetric
setClass("nsyMatrix",
         contains = c("unpackedMatrix", "ndenseMatrix", "symmetricMatrix"))

## Packed, triangular
setClass("ntpMatrix",
         contains = c("packedMatrix", "ndenseMatrix", "triangularMatrix"))

## Packed, symmetric
setClass("nspMatrix",
         contains = c("packedMatrix", "ndenseMatrix", "symmetricMatrix"))


## ...... Dense, logical ...............................................

## Unpacked, general
setClass("lgeMatrix",
         contains = c("unpackedMatrix", "ldenseMatrix", "generalMatrix"))

## Unpacked, triangular
setClass("ltrMatrix",
         contains = c("unpackedMatrix", "ldenseMatrix", "triangularMatrix"))

## Unpacked, symmetric
setClass("lsyMatrix",
         contains = c("unpackedMatrix", "ldenseMatrix", "symmetricMatrix"))

## Packed, triangular
setClass("ltpMatrix",
         contains = c("packedMatrix", "ldenseMatrix", "triangularMatrix"))

## Packed, symmetric
setClass("lspMatrix",
         contains = c("packedMatrix", "ldenseMatrix", "symmetricMatrix"))


## ...... Dense, double ................................................

## Unpacked, general
setClass("dgeMatrix",
         contains = c("unpackedMatrix", "ddenseMatrix", "generalMatrix"))

## Unpacked, triangular
setClass("dtrMatrix",
         contains = c("unpackedMatrix", "ddenseMatrix", "triangularMatrix"))

## Unpacked, symmetric
setClass("dsyMatrix",
         contains = c("unpackedMatrix", "ddenseMatrix", "symmetricMatrix"))

## Unpacked, symmetric, positive semidefinite
setClass("dpoMatrix", contains = "dsyMatrix",
         validity = function(object) .Call(dpoMatrix_validate, object))

## Unpacked, symmetric, positive semidefinite, correlation
setClass("corMatrix", contains = "dpoMatrix",
         slots = c(sd = "numeric"),
         validity = function(object) .Call(corMatrix_validate, object))

## Packed, triangular
setClass("dtpMatrix",
         contains = c("packedMatrix", "ddenseMatrix", "triangularMatrix"))

## Packed, symmetric
setClass("dspMatrix",
         contains = c("packedMatrix", "ddenseMatrix", "symmetricMatrix"))

## Packed, symmetric, positive semidefinite
setClass("dppMatrix", contains = "dspMatrix",
         validity = function(object) .Call(dppMatrix_validate, object))

## Packed, symmetric, positive semidefinite, correlation
setClass("pcorMatrix", contains = "dppMatrix",
         slots = c(sd = "numeric"),
         validity = function(object) .Call(pcorMatrix_validate, object))


## ------ Non-Virtual Sparse -------------------------------------------

## ...... Sparse, nonzero pattern ......................................

## NB: Unlike [^n]sparseMatrix (below), there is no 'x' slot to validate here.

## CSC, general
setClass("ngCMatrix",
         contains = c("CsparseMatrix", "nsparseMatrix", "generalMatrix"))

## CSC, triangular
setClass("ntCMatrix",
         contains = c("CsparseMatrix", "nsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(tCMatrix_validate, object))

## CSC, symmetric
setClass("nsCMatrix",
         contains = c("CsparseMatrix", "nsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(sCMatrix_validate, object))

## CSR, general
setClass("ngRMatrix",
         contains = c("RsparseMatrix", "nsparseMatrix", "generalMatrix"))

## CSR, triangular
setClass("ntRMatrix",
         contains = c("RsparseMatrix", "nsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(tRMatrix_validate, object))

## CSR, symmetric
setClass("nsRMatrix",
         contains = c("RsparseMatrix", "nsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(sRMatrix_validate, object))

## Triplet general
setClass("ngTMatrix",
         contains = c("TsparseMatrix", "nsparseMatrix", "generalMatrix"))

## Triplet, triangular
setClass("ntTMatrix",
         contains = c("TsparseMatrix", "nsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(tTMatrix_validate, object))

## Triplet, symmetric
setClass("nsTMatrix",
         contains = c("TsparseMatrix", "nsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(sTMatrix_validate, object))

## Diagonal
setClass("ndiMatrix", contains = c("diagonalMatrix", "nMatrix"),
         slots = c(x = "logical"),
         validity = function(object) .Call(nMatrix_validate, object))


## ...... Sparse, logical ..............................................

## CSC, general
setClass("lgCMatrix",
         contains = c("CsparseMatrix", "lsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgCMatrix_validate, object))

## CSC, triangular
setClass("ltCMatrix",
         contains = c("CsparseMatrix", "lsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtCMatrix_validate, object))

## CSC, symmetric
setClass("lsCMatrix",
         contains = c("CsparseMatrix", "lsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsCMatrix_validate, object))

## CSR, general
setClass("lgRMatrix",
         contains = c("RsparseMatrix", "lsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgRMatrix_validate, object))

## CSR, triangular
setClass("ltRMatrix",
         contains = c("RsparseMatrix", "lsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtRMatrix_validate, object))

## CSR, symmetric
setClass("lsRMatrix",
         contains = c("RsparseMatrix", "lsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsRMatrix_validate, object))

## Triplet, general
setClass("lgTMatrix",
         contains = c("TsparseMatrix", "lsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgTMatrix_validate, object))

## Triplet, triangular
setClass("ltTMatrix",
         contains = c("TsparseMatrix", "lsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtTMatrix_validate, object))

## Triplet, symmetric
setClass("lsTMatrix",
         contains = c("TsparseMatrix", "lsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsTMatrix_validate, object))

## Diagonal
setClass("ldiMatrix", contains = c("diagonalMatrix", "lMatrix"))


## ...... Sparse, double ...............................................

## CSC, general
setClass("dgCMatrix",
         contains = c("CsparseMatrix", "dsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgCMatrix_validate, object))

## CSC, triangular
setClass("dtCMatrix",
         contains = c("CsparseMatrix", "dsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtCMatrix_validate, object))

## CSC, symmetric
setClass("dsCMatrix",
         contains = c("CsparseMatrix", "dsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsCMatrix_validate, object))

## CSR, general
setClass("dgRMatrix",
         contains = c("RsparseMatrix", "dsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgRMatrix_validate, object))

## CSR, triangular
setClass("dtRMatrix",
         contains = c("RsparseMatrix", "dsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtRMatrix_validate, object))

## CSR, symmetric
setClass("dsRMatrix",
         contains = c("RsparseMatrix", "dsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsRMatrix_validate, object))

## Triplet, general
setClass("dgTMatrix",
         contains = c("TsparseMatrix", "dsparseMatrix", "generalMatrix"),
         validity = function(object) .Call(xgTMatrix_validate, object))

## Triplet, triangular
setClass("dtTMatrix",
         contains = c("TsparseMatrix", "dsparseMatrix", "triangularMatrix"),
         validity = function(object) .Call(xtTMatrix_validate, object))

## Triplet, symmetric
setClass("dsTMatrix",
         contains = c("TsparseMatrix", "dsparseMatrix", "symmetricMatrix"),
         validity = function(object) .Call(xsTMatrix_validate, object))

## Diagonal
setClass("ddiMatrix", contains = c("diagonalMatrix", "dMatrix"))

if(FALSE) { # TODO
## CSC, symmetic, positive semidefinite
setClass("dpCMatrix", contains = "dsCMatrix",
         validity = function(object) TODO("test positive semidefiniteness"))

## CSR, symmetic, positive semidefinite
setClass("dpRMatrix", contains = "dsRMatrix",
         validity = function(object) TODO("test positive semidefiniteness"))

## Triplet, symmetic, positive semidefinite
setClass("dpTMatrix", contains = "dsTMatrix",
         validity = function(object) TODO("test positive semidefiniteness"))
} # TODO


## ...... Sparse, index ................................................

## Row or column index
setClass("indMatrix", contains = c("sparseMatrix", "generalMatrix"),
         slots = c(perm = "integer", margin = "integer"),
         prototype = list(margin = 1L), # to be valid
         validity = function(object) .Call(indMatrix_validate, object))

## Row or column permutation
setClass("pMatrix", contains = c("indMatrix"),
         validity = function(object) .Call(pMatrix_validate, object))


########################################################################
##  2. MatrixFactorization
########################################################################

## ------ The Mother Class "MatrixFactorization" -----------------------

setClass("MatrixFactorization", contains = "VIRTUAL",
         slots = c(Dim = "integer", Dimnames = "list"),
         prototype = list(Dim = integer(2L), Dimnames = list(NULL, NULL)),
         validity = function(object).Call(MatrixFactorization_validate, object))

setMethod("initialize", "MatrixFactorization", .initialize)


## ------ LU -----------------------------------------------------------

setClass("LU", contains = c("MatrixFactorization", "VIRTUAL"))

## Inherit most aspects of dgeMatrix without extending it

setClass("denseLU", contains = "LU",
         slots = c(x = "numeric", perm = "integer"),
         validity = function(object) {
             object. <- new("dgeMatrix")
             object.@Dim <- object@Dim
             object.@Dimnames <- object@Dimnames
             object.@x <- object@x
             if(is.character(valid <- validObject(object., test = TRUE)))
                 valid
             else .Call(denseLU_validate, object)
         })

setClass("sparseLU", contains = "LU",
         slots = c(L = "dtCMatrix", U = "dtCMatrix",
                   p = "integer", q = "integer"),
         prototype = list(L = .new("dtCMatrix", uplo = "L")),
         validity = function(object) .Call(sparseLU_validate, object))


## ------ QR -----------------------------------------------------------

setClass("QR", contains = c("MatrixFactorization", "VIRTUAL"))

if(FALSE) {
## MJ: It would nice to have symmetry with LU, but then we would need
##     to define methods already available for S3 class 'qr'.  Still ...
setClass("denseQR", contains = "QR",
         ## based on S3 class 'qr':
         slots = c(qr = "numeric", qraux = "numeric",
                   rank = "integer", pivot = "integer",
                   useLAPACK = "logical"),
         validity = function(object) .Call(denseQR_validate, object))
}

setClass("sparseQR", contains = "QR",
         slots = c(beta = "numeric", V = "dgCMatrix", R = "dgCMatrix",
                   p = "integer", q = "integer"),
         validity = function(object) .Call(sparseQR_validate, object))


## ------ Bunch-Kaufman ------------------------------------------------

setClass("BunchKaufmanFactorization",
         contains = c("MatrixFactorization", "VIRTUAL"))

## Inherit most aspects of dt[rp]Matrix without extending them

setClass("BunchKaufman", contains = "BunchKaufmanFactorization",
         slots = c(uplo = "character", x = "numeric", perm = "integer"),
         prototype = list(uplo = "U"),
         validity = function(object) {
             object. <- new("dtrMatrix")
             object.@Dim <- object@Dim
             object.@Dimnames <- object@Dimnames
             object.@uplo <- object@uplo
             object.@x <- object@x
             if(is.character(valid <- validObject(object., test = TRUE)))
                 valid
             else .Call(BunchKaufman_validate, object)
         })

setClass("pBunchKaufman", contains = "BunchKaufmanFactorization",
         slots = c(uplo = "character", x = "numeric", perm = "integer"),
         prototype = list(uplo = "U"),
         validity = function(object) {
             object. <- new("dtpMatrix")
             object.@Dim <- object@Dim
             object.@Dimnames <- object@Dimnames
             object.@uplo <- object@uplo
             object.@x <- object@x
             if(is.character(valid <- validObject(object., test = TRUE)))
                 valid
             else .Call(pBunchKaufman_validate, object)
         })


## ------ Cholesky -----------------------------------------------------

setClass("CholeskyFactorization",
         contains = c("MatrixFactorization", "VIRTUAL"))


## ...... Dense ........................................................

## Inherit most aspects of dt[rp]Matrix without extending them

setClass("Cholesky", contains = "CholeskyFactorization",
         slots = c(uplo = "character", x = "numeric", perm = "integer"),
         prototype = list(uplo = "U"),
         validity = function(object) {
             object. <- new("dtrMatrix")
             object.@Dim <- object@Dim
             object.@Dimnames <- object@Dimnames
             object.@uplo <- object@uplo
             object.@x <- object@x
             if(is.character(valid <- validObject(object., test = TRUE)))
                 valid
             else .Call(Cholesky_validate, object)
         })

setClass("pCholesky", contains = "CholeskyFactorization",
         slots = c(uplo = "character", x = "numeric", perm = "integer"),
         prototype = list(uplo = "U"),
         validity = function(object) {
             object. <- new("dtpMatrix")
             object.@Dim <- object@Dim
             object.@Dimnames <- object@Dimnames
             object.@uplo <- object@uplo
             object.@x <- object@x
             if(is.character(valid <- validObject(object., test = TRUE)))
                 valid
             else .Call(pCholesky_validate, object)
         })


## ...... Sparse .......................................................

## FIXME? simplicial symbolic factorization is specified entirely by
##        'colcount' and 'perm' ...
##        should 'p', 'i', 'nz', 'nxt', 'prv' slots all be emtpy ??
##        see comments in ../src/CHOLMOD/Core/cholmod_change_factor.c

## S4 representation of C struct 'cholmod_factor',
## from header ../src/CHOLMOD/Include/cholmod_core.h
setClass("CHMfactor", contains = c("CholeskyFactorization", "VIRTUAL"),
         slots = c(type = "integer", colcount = "integer", perm = "integer"),
         validity = function(object) .Call(CHMfactor_validate, object))

## Simplicial factorization
setClass("CHMsimpl", contains = c("CHMfactor", "VIRTUAL"),
         slots = c(p = "integer", i = "integer", nz = "integer",
                   nxt = "integer", prv = "integer"),
         prototype = list(type = c(0L, 1L, 0L, 1L, 0L, 0L),
                          p = 0L, nxt = c(-1L, 0L), prv = c(1L, -1L)),
         validity = function(object) .Call(CHMsimpl_validate, object))

setClass("nCHMsimpl", contains = "CHMsimpl") # symbolic factorization
setClass("dCHMsimpl", contains = "CHMsimpl",
         slots = c(x = "numeric"),
         validity = function(object) .Call(dCHMsimpl_validate, object))

## Supernodal factorization
setClass("CHMsuper", contains = c("CHMfactor", "VIRTUAL"),
         slots = c(super = "integer", pi = "integer", px = "integer",
                   s = "integer"),
         prototype = list(type = c(0L, 1L, 1L, 1L, 0L, 0L),
                          super = 0L, pi = 0L, px = 0L),
         validity = function(object) .Call(CHMsuper_validate, object))

setClass("nCHMsuper", contains = "CHMsuper") # symbolic factorization
setClass("dCHMsuper", contains = "CHMsuper",
         slots = c(x = "numeric"),
         validity = function(object) .Call(dCHMsuper_validate, object))


## ------ Schur --------------------------------------------------------

## For eigenvalues:
setClassUnion("number", members = c("numeric", "complex"))

setClass("SchurFactorization", contains = c("MatrixFactorization", "VIRTUAL"))

setClass("Schur", contains = "SchurFactorization",
         slots = c(Q = "Matrix", T = "Matrix", EValues = "number"),
         prototype = list(Q = .new("dgeMatrix"), T = .new("dgeMatrix")),
         validity = function(object) .Call(Schur_validate, object))


########################################################################
##  3. sparseVector
########################################################################

## ------ The Mother Class 'sparseVector' ------------------------------

setClass("sparseVector", contains = "VIRTUAL",
         slots = c(length = "numeric", i = "numeric"), # 1-based index!
         prototype = list(length = 0),
         validity = function(object) .Call(sparseVector_validate, object))

## Allow users to do new("[nlidz]sparseVector", i=, x=) with unsorted 'i'
setMethod("initialize", "sparseVector",
          function(.Object, i, x, ...) {
              if(has.x <- !missing(x))
                  x <- x # MJ: why is this necessary?
              if(!missing(i)) {
                  i.uns <- is.unsorted(i, strictly = TRUE)
                  i <-
                      if(is.na(i.uns) || !i.uns)
                          i
                      else {
                          ## we know that there are no NA, and the order of
                          ## ties does not matter (since ties are an error),
                          ## hence it is safe to use "quick" here
                          m <- if(is.integer(length(i))) "radix" else "quick"
                          if(.hasSlot(.Object, "x") && has.x) {
                              s <- sort.int(i, method = m, index.return = TRUE)
                              x <- x[s$ix]
                              s$x
                          } else sort.int(i, method = m)
                      }
              }
              callNextMethod()
          })


## ------ Non-Virtual Subclasses ---------------------------------------

setClass("nsparseVector", contains = "sparseVector")

setClass("lsparseVector", contains = "sparseVector",
         slots = c(x = "logical"),
         validity = function(object) .Call(lsparseVector_validate, object))

setClass("isparseVector", contains = "sparseVector",
         slots = c(x = "integer"),
         validity = function(object) .Call(isparseVector_validate, object))

setClass("dsparseVector", contains = "sparseVector",
         slots = c(x = "numeric"),
         validity = function(object) .Call(dsparseVector_validate, object))

setClass("zsparseVector", contains = "sparseVector",
         slots = c(x = "complex"),
         validity = function(object) .Call(zsparseVector_validate, object))


########################################################################
##  4. Index and more "miscellaneous" classes, but _not_ class unions
########################################################################

## Idea: represent x = c(seq(from1, to1, by1), seq(from2, to2, by2), ...)
##       as list(first = x[1L], rle = rle(diff(x)))
setOldClass("rle")
setClass("rleDiff",
         ## MJ: simpler would be slots = c(first=, lengths=, values=) ...
         slots = c(first = "numeric", rle = "rle"),
         prototype = list(first = integer(0L), rle = rle(integer(0L))),
         validity = function(object) {
             if(length(object@first) != 1L)
                 "'first' slot does not have length 1"
             else if(!is.list(rle <- object@rle))
                 "'rle' slot is not a list"
             else if(length(rle) != 2L)
                 "'rle' slot does not have length 2"
             else if(is.null(nms <- names(rle)) ||
                     anyNA(match(nms, c("lengths", "values"))))
                 "'rle' slot does not have names \"lengths\", \"values\""
             else if(!is.numeric(lens <- rle$lengths))
                 "'lengths' is not numeric"
             else if(!is.numeric(vals <- rle$values))
                 "'values' is not numeric"
             else if(length(lens) != length(vals))
                 "'lengths' and 'values' do not have equal length"
             else if(length(lens) == 0L)
                 TRUE
             else if(anyNA(lens))
                 "'lengths' contains NA"
             else if(is.double(lens)) {
                 if(!(all(is.finite(r <- range(lens))) &&
                      all(lens == trunc(lens))))
                     "'lengths' is not integer-valued"
                 else if(r[1L] < 1)
                     "'lengths' is not positive"
                 else TRUE
             } else {
                 if(min(lens) < 1L)
                     "'lengths' is not positive"
                 else TRUE
             }
         })

## Idea: represent x = c(seq(from1, to1, by1), seq(from2, to2, by2), ...)
##       as rbind(c(from1, from2, ...), c(to1, to2, ...), c(by1, by2, ...))
## MM: (2010-03-04) more efficient than "rleDiff" [TODO: write rleDiff<->seqMat]
## MJ: (2022-09-06) data.frame(from, to, by) could be _handled_ more efficiently
setClass("seqMat", contains = "matrix",
         prototype = matrix(integer(0L), nrow = 3L, ncol = 0L),
         validity = function(object) {
             if(!is.numeric(object))
                 "matrix is not numeric"
             else if(nrow(object) != 3L)
                 "matrix does not have 3 rows"
             else if(anyNA(object))
                 "matrix contains NA"
             else if(is.double(object) && !(all(is.finite(range(object))) &&
                                            all(object == trunc(object))))
                 "matrix is not integer-valued"
             else {
                 from <- object[1L, ]
                 to   <- object[2L, ]
                 by   <- object[3L, ]
                 if(any((from < to & by <= 0) | (from > to & by >= 0)))
                     "degenerate sequence(s): sign(to - from) != sign(by)"
                 else TRUE
             }
         })

## Idea: _ab_stract index
## MJ: (2022-09-06) why not just
##     setClassUnion("abIndex", members = c("numeric", "rleDiff", "seqMat")) ?
setClass("abIndex",
         slots = c(kind = "character", x = "numeric", rleD = "rleDiff"),
         prototype = list(kind = "int32", x = integer(0L)),
         validity = function(object) {
             ## MJ: should 'rleD' be "empty" if kind != "rleDiff" ?
             if(length(kind <- object@kind) != 1L)
                 "'kind' slot does not have length 1"
             else switch(kind,
                         "int32" =
                             if(is.integer(object@x))
                                 TRUE
                             else "kind=\"int32\" but 'x' slot is not of type \"integer\"",
                         "double" =
                             if(is.double(object@x))
                                 TRUE
                             else "kind=\"double\" but 'x' slot is not of type \"double\"",
                         "rleDiff" =
                             if(length(object@x) == 0L)
                                 TRUE
                             else "kind=\"rleDiff\" but 'x' slot is nonempty",
                         ## otherwise:
                         "'kind' is not \"int32\", \"double\", or \"rleDiff\"")
         })


########################################################################
##  5. Class unions
########################################################################

## NB: these exist mainly to reduce duplication of methods
## NB: numeric = { double, integer }

## Atomic vectors:
## * note that is(<atomic matrix>, "atomicVector") is FALSE
##   even though is.atomic(<atomic matrix>) is TRUE
setClassUnion("atomicVector",
              members = c("logical", "numeric", "complex", "raw", "character"))

## Numeric-like vectors:
## * for methods handling logical and integer as double
setClassUnion("numLike",
              members = c("logical", "numeric"))

## Index vectors:
## * for 'i' in x[i], x[i, ], x[, i], etc.
## * TODO: include rleDiff
setClassUnion("index",
              members = c("logical", "numeric", "character"))

## Subassignment values:
## * for 'value' in x[i, j] <- value
setClassUnion("replValue",
              members = c("logical", "numeric", "complex", "raw"))
setClassUnion("replValueSp",
              members = c("replValue", "sparseVector", "matrix", "Matrix"))

rm(.new, .initialize)

Try the Matrix package in your browser

Any scripts or data that you put into this service are public.

Matrix documentation built on Jan. 19, 2024, 1:11 a.m.