# R/Math.R In Matrix: Sparse and Dense Matrix Classes and Methods

```####--- All "Math" and "Math2" group methods for all Matrix classes (incl sparseVector) ------
####	     ====	=====

## "Design-bug":  log(x, base)  has *two* arguments // ditto for  "trunc()" !!
## ---> need "log" methods "everywhere to catch 2-arg case !

### ~~~~ Math, log ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

## FIXME:
## Once we start having non-virtual [iz]Matrix,
## many of these will need adjustment ...

## cum(min|max|sum|prod) return vector also for matrix arguments
Math.vecGenerics <- grep("^cum", getGroupMembers("Math"), value = TRUE)

###--------- dgeMatrix

setMethod("Math", signature(x = "dgeMatrix"), function(x)
{
if(.Generic %in% Math.vecGenerics)
callGeneric(x@x)
else {
x@x <- callGeneric(x@x)
x
}
})

setMethod("log", "dgeMatrix", function(x, base = exp(1))
{
x@x <- log(x@x, base)
x
})

###--------- ddenseMatrix

## Used for dt[rp]Matrix, ds[yp]Matrix (and subclasses, e.g., dpo*, cor*)
##' _only_, as dgeMatrix has its own method above

setMethod("Math", signature(x = "ddenseMatrix"), function(x)
{
if(.Generic %in% Math.vecGenerics)
## Result is a vector
return(callGeneric(.dense2g(x, ".")@x))
cld <- getClassDef(class(x))
if(extends(cld, "symmetricMatrix")) {
## Argument and result are symmetricMatrix
if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix"))
## But result is _not_ positive definite!
x <- as(x, if(po) "dsyMatrix" else "dspMatrix")
x@x <- callGeneric(x@x)
x@factors <- list()
x
} else if(is0(callGeneric(0))) {
## Argument and result are triangularMatrix
if(extends(cld, "MatrixFactorization"))
## But result is _not_ a factor or correlation
x <- as(x, if(.isPacked(x)) "dtpMatrix" else "dtrMatrix")
x@x <- callGeneric(x@x)
if(x@diag != "N" && isN1(f1 <- callGeneric(1)))
diag(x) <- f1
x
} else {
## Argument is triangularMatrix, result is generalMatrix
callGeneric(.dense2g(x, "."))
}
})

## "log" with *two* arguments
setMethod("log", signature(x = "ddenseMatrix"), function(x, base = exp(1))
{
cld <- getClassDef(class(x))
if(extends(cld, "symmetricMatrix")) {
## Argument and result are symmetricMatrix
if((po <- extends(cld, "dpoMatrix")) || extends(cld, "dppMatrix"))
## But result is _not_ positive definite
x <- as(x, if(po) "dsyMatrix" else "dspMatrix")
x@x <- log(x@x, base)
x@factors <- list()
x
} else {
## Argument is triangularMatrix, result is generalMatrix
log(.dense2g(x, "."), base)
}
})

###--------- denseMatrix

setMethod("Math", signature(x = "denseMatrix"),
function(x) callGeneric(..dense2d(x)))

setMethod("log", signature(x = "denseMatrix"),
function(x, base = exp(1)) log(..dense2d(x), base))

###--------- CsparseMatrix

setMethod("Math", signature(x = "CsparseMatrix"), function(x)
{
if(.Generic %in% Math.vecGenerics)
## Result is a vector
return(callGeneric(.sparse2m(x)))
if(isN0(callGeneric(0)))
## Result is a denseMatrix
return(callGeneric(.sparse2dense(x)))
## Result preserves sparseness and structure (symmetric, triangular)
cld <- getClassDef(cl <- class(x))
if(isN1(callGeneric(1)))
x <- .Call(R_sparse_diag_U2N, x)
if(extends(cld, "nsparseMatrix")) {
## No 'x' slot
r <- rep.int(callGeneric(1), length(x@i))
} else {
r <- callGeneric(x@x)
if(typeof(r) == typeof(x@x)) {
x@x <- r
return(x)
}
}
## e.g., abs( <lgC> ) -> dgC
y <- new(`substr<-`(MatrixClass(cl, cld), 1L, 1L, "d"))
y@x <- as.double(r)
nms <- slotNames(cld)
for(nm in nms[nms != "x"])
slot(y, nm) <- slot(x, nm)
y
}) ## {Math}

setMethod("log", signature(x = "CsparseMatrix"),
function(x, base = exp(1)) log(.sparse2dense(x), base))

###--------- diagonalMatrix

setMethod("Math", signature(x = "diagonalMatrix"), function(x)
{
if(.Generic %in% Math.vecGenerics)
## Result is a vector
return(callGeneric(.diag2m(x)))
unit <- x@diag != "N"
r <- callGeneric(if(unit) 1 else x@x)
if(isN0(f0 <- callGeneric(0))) {
## Result is dense, symmetric
## MJ: hmm ... what if the 'Dimnames' are asymmetric?
y <- new("dspMatrix")
n <- (y@Dim <- x@Dim)[1L]
y@Dimnames <- symmDN(x@Dimnames)
y@x <- rep.int(f0, 0.5 * n * (n + 1))
if(n > 0L)
diag(y) <- r
y
} else if(typeof(r) == typeof(x@x)) {
## Result is diagonal ... modify 'x'
if(!unit) {
x@x <- r
} else if(isN1(r)) {
x@x <- rep.int(r, x@Dim[1L])
x@diag <- "N"
}
x
} else {
## Result is diagonal ... modify new()
y <- new("ddiMatrix")
y@Dim <- x@Dim
y@Dimnames <- x@Dimnames
if(!unit)
y@x <- as.double(r)
else if(isN1(r))
y@x <- rep.int(as.double(r), x@Dim[1L])
else
y@diag <- "U"
y
}
}) ## {Math}

setMethod("log", "diagonalMatrix", function(x, base = exp(1))
{
## Result is dense, symmetric
## MJ: hmm ... what if the 'Dimnames' are asymmetric?
y <- new("dspMatrix")
n <- (y@Dim <- x@Dim)[1L]
y@Dimnames <- symmDN(x@Dimnames)
y@x <- rep.int(-Inf, 0.5 * n * (n + 1))
if(n > 0L)
diag(y) <- if(x@diag == "N") log(x@x, base) else 0
y
})

###--------- sparseMatrix

setMethod("Math", signature(x = "sparseMatrix"),
function(x) callGeneric(as(x, "CsparseMatrix")))

setMethod("log", signature(x = "sparseMatrix"),
function(x, base = exp(1)) log(as(x, "CsparseMatrix"), base))

###--------- sparseVector

setMethod("Math", signature(x = "sparseVector"), function(x)
{
if(.Generic %in% Math.vecGenerics || isN0(callGeneric(0)))
## Result is a (traditional) vector
return(callGeneric(sp2vec(x)))
## Result is a sparseVector
cld <- getClassDef(class(x))
if(extends(cld, "dsparseVector")) {
x@x <- callGeneric(x@x)
x
} else {
y <- new("dsparseVector")
y@x <-
if(extends(cld, "nsparseVector"))
rep.int(callGeneric(1), length(x@i))
else callGeneric(x@x)
y@i <- x@i
y@length <- x@length
y
}
})

setMethod("log", "sparseVector", function(x, base = exp(1))
{
lx <- rep.int(-Inf, x@length)
if(length(x@i) > 0L)
lx[x@i] <- if(is(x, "nsparseVector")) 0 else log(x@x, base)
lx
})

### ~~~~ Math2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

## NB: For round(), signif(), we have that Generic(u, k) |-> u
##     for all u in {0,1}, for all k, implying that "structure"
##     is invariant ... hence minimal "cases" are needed here

setMethod("Math2", signature(x = "dMatrix"),
function(x, digits) {
x@x <- callGeneric(x@x, digits = digits)
x
})

## As above, but first coercing to dMatrix:
setMethod("Math2", signature(x = "Matrix"),
function(x, digits) {
x <- as(x, "dMatrix")
x@x <- callGeneric(x@x, digits = digits)
x
})

setMethod("Math2", signature(x = "dsparseVector"),
function(x, digits) {
x@x <- callGeneric(x@x, digits = digits)
x
})

## As above, but first coercing to dsparseVector:
setMethod("Math2", signature(x = "sparseVector"),
function(x, digits) {
x <- as(x, "dsparseVector")
x@x <- callGeneric(x@x, digits = digits)
x
})

## ~~~~ Not group generic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

setMethod("zapsmall", signature(x = "dMatrix"),
function(x, digits = getOption("digits")) {
x@x <- zapsmall(x@x, digits)
x
})
```

## Try the Matrix package in your browser

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

Matrix documentation built on Nov. 11, 2022, 9:06 a.m.