Methods for Function 'isSymmetric' in Package 'Matrix'

isSymmetric tests whether its argument is a symmetric square matrix, by default tolerating some numerical fuzz and requiring symmetric [dD]imnames in addition to symmetry in the mathematical sense. isSymmetric is a generic function in base, which has a method for traditional matrices of implicit class "matrix". Methods are defined here for various proper and virtual classes in Matrix, so that isSymmetric works for all objects inheriting from virtual class "Matrix".

# S4 method for class 'denseMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'CsparseMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'RsparseMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'TsparseMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'diagonalMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'indMatrix'
isSymmetric(object, checkDN = TRUE, ...)
# S4 method for class 'dgeMatrix'
isSymmetric(object, checkDN = TRUE, tol = 100 * .Machine$double.eps, tol1 = 8 * tol, ...)
# S4 method for class 'dgCMatrix'
isSymmetric(object, checkDN = TRUE, tol = 100 * .Machine$double.eps, ...)

Arguments

object

a "Matrix".

checkDN

a logical indicating whether symmetry of the Dimnames slot of object should be checked.

tol, tol1

numerical tolerances allowing approximate symmetry of numeric (rather than logical) matrices. See also isSymmetric.matrix.

...

further arguments passed to methods (typically methods for all.equal).

Value

A logical, either TRUE or FALSE (never NA).

Details

The Dimnames slot of object, say dn, is considered to be symmetric if and only if

• dn[[1]] and dn[[2]] are identical or one is NULL; and

• ndn <- names(dn) is NULL or ndn[1] and ndn[2] are identical or one is the empty string "".

Hence list(a=nms, a=nms) is considered to be symmetric, and so too are list(a=nms, NULL) and list(NULL, a=nms).

Note that this definition is looser than that employed by isSymmetric.matrix, which requires dn[1] and dn[2] to be identical, where dn is the dimnames attribute of a traditional matrix.

See also

forceSymmetric; symmpart and skewpart; virtual class "symmetricMatrix" and its subclasses.

Examples

isSymmetric(Diagonal(4)) # TRUE of course
#> [1] TRUE
M <- Matrix(c(1,2,2,1), 2,2)
isSymmetric(M) # TRUE (*and* of formal class "dsyMatrix")
#> [1] TRUE
isSymmetric(as(M, "generalMatrix")) # still symmetric, even if not "formally"
#> [1] TRUE
isSymmetric(triu(M)) # FALSE
#> [1] FALSE

## Look at implementations:
showMethods("isSymmetric", includeDefs = TRUE) # includes S3 generic from base
#> Function: isSymmetric (package base)
#> object="ANY"
#> function (object, ...) 
#> UseMethod("isSymmetric")
#> 
#> 
#> object="CsparseMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         .Call(R_sparse_is_symmetric, object, checkDN)
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="RsparseMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         .Call(R_sparse_is_symmetric, object, checkDN)
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="TsparseMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         .Call(R_sparse_is_symmetric, object, checkDN)
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="denseMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         .Call(R_dense_is_symmetric, object, checkDN)
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dgCMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dgRMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dgTMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dgeMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         tol1 = 8 * tol, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_dense_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         object <- .M2gen(object)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal.numeric(..., check.attributes = FALSE)
#>         }
#>         if (length(tol1)) {
#>             i. <- if (n <= 4L) 
#>                 1L:n
#>             else c(1L, 2L, n - 1L, n)
#>             for (i in i.) if (!isTRUE(ae(target = object[i, ], 
#>                 current = Cj(object[, i]), tolerance = tol1, 
#>                 ...))) 
#>                 return(FALSE)
#>         }
#>         isTRUE(ae(target = object@x, current = Cj(t(object))@x, 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="diagonalMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             if (ca(...) && !isSymmetricDN(object@Dimnames)) 
#>                 return(FALSE)
#>         }
#>         .M.kind(object) != "z" || object@diag != "N" || {
#>             x <- object@x
#>             isTRUE(all.equal.numeric(x, Conj(x), ...))
#>         }
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dtCMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dtRMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dtTMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_sparse_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal(..., check.attributes = FALSE)
#>         }
#>         isTRUE(ae(target = .M2V(object), current = .M2V(Cj(t(object))), 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dtpMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         tol1 = 8 * tol, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_dense_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         object <- .M2gen(object)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal.numeric(..., check.attributes = FALSE)
#>         }
#>         if (length(tol1)) {
#>             i. <- if (n <= 4L) 
#>                 1L:n
#>             else c(1L, 2L, n - 1L, n)
#>             for (i in i.) if (!isTRUE(ae(target = object[i, ], 
#>                 current = Cj(object[, i]), tolerance = tol1, 
#>                 ...))) 
#>                 return(FALSE)
#>         }
#>         isTRUE(ae(target = object@x, current = Cj(t(object))@x, 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="dtrMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, tol = 100 * .Machine$double.eps, 
#>         tol1 = 8 * tol, ...) 
#>     {
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             checkDN <- ca(...)
#>         }
#>         if (tol <= 0) 
#>             return(.Call(R_dense_is_symmetric, object, checkDN))
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN && !isSymmetricDN(object@Dimnames)) 
#>             return(FALSE)
#>         if (n == 0L) 
#>             return(TRUE)
#>         object <- .M2gen(object)
#>         Cj <- if (is.complex(object@x)) 
#>             Conj
#>         else identity
#>         ae <- function(check.attributes, ...) {
#>             all.equal.numeric(..., check.attributes = FALSE)
#>         }
#>         if (length(tol1)) {
#>             i. <- if (n <= 4L) 
#>                 1L:n
#>             else c(1L, 2L, n - 1L, n)
#>             for (i in i.) if (!isTRUE(ae(target = object[i, ], 
#>                 current = Cj(object[, i]), tolerance = tol1, 
#>                 ...))) 
#>                 return(FALSE)
#>         }
#>         isTRUE(ae(target = object@x, current = Cj(t(object))@x, 
#>             tolerance = tol, ...))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#> object="indMatrix"
#> function (object, ...) 
#> {
#>     .local <- function (object, checkDN = TRUE, ...) 
#>     {
#>         d <- object@Dim
#>         if ((n <- d[2L]) != d[1L]) 
#>             return(FALSE)
#>         if (checkDN) {
#>             ca <- function(check.attributes = TRUE, ...) check.attributes
#>             if (ca(...) && !isSymmetricDN(object@Dimnames)) 
#>                 return(FALSE)
#>         }
#>         perm <- object@perm
#>         all(perm[perm] == seq_len(n))
#>     }
#>     .local(object, ...)
#> }
#> 
#> 
#>