library(stats, pos = "package:base", verbose = FALSE)
library(utils, pos = "package:base", verbose = FALSE)
showClass("BunchKaufman")
set.seed(1)
n <- 6L
(A <- forceSymmetric(Matrix(rnorm(n * n), n, n)))
## With dimnames, to see that they are propagated :
dimnames(A) <- rep.int(list(paste0("x", seq_len(n))), 2L)
(bk.A <- BunchKaufman(A))
str(e.bk.A <- expand2(bk.A, complete = FALSE), max.level = 2L)
str(E.bk.A <- expand2(bk.A, complete = TRUE), max.level = 2L)
## Underlying LAPACK representation
(m.bk.A <- as(bk.A, "dtrMatrix"))
stopifnot(identical(as(m.bk.A, "matrix"), `dim<-`(bk.A@x, bk.A@Dim)))
## Number of factors is 2*b+1, b <= n, which can be nontrivial ...
(b <- (length(E.bk.A) - 1L) %/% 2L)
ae1 <- function(a, b, ...) all.equal(as(a, "matrix"), as(b, "matrix"), ...)
ae2 <- function(a, b, ...) ae1(unname(a), unname(b), ...)
## A ~ U DU U', U := prod(Pk Uk) in floating point
stopifnot(exprs = {
identical(names(e.bk.A), c("U", "DU", "U."))
identical(e.bk.A[["U" ]], Reduce(`%*%`, E.bk.A[seq_len(b)]))
identical(e.bk.A[["U."]], t(e.bk.A[["U"]]))
ae1(A, with(e.bk.A, U %*% DU %*% U.))
})
## Factorization handled as factorized matrix
b <- rnorm(n)
stopifnot(identical(det(A), det(bk.A)),
identical(solve(A, b), solve(bk.A, b)))
Run the code above in your browser using DataLab