library(stats, pos = "package:base", verbose = FALSE)
library(utils, pos = "package:base", verbose = FALSE)
showClass("dCHMsimpl")
showClass("dCHMsuper")
set.seed(2)
m <- 1000L
n <- 200L
M <- rsparsematrix(m, n, 0.01)
A <- crossprod(M)
## With dimnames, to see that they are propagated :
dimnames(A) <- dn <- rep.int(list(paste0("x", seq_len(n))), 2L)
(ch.A <- Cholesky(A)) # pivoted, by default
str(e.ch.A <- expand2(ch.A, LDL = TRUE), max.level = 2L)
str(E.ch.A <- expand2(ch.A, LDL = FALSE), max.level = 2L)
ae1 <- function(a, b, ...) all.equal(as(a, "matrix"), as(b, "matrix"), ...)
ae2 <- function(a, b, ...) ae1(unname(a), unname(b), ...)
## A ~ P1' L1 D L1' P1 ~ P1' L L' P1 in floating point
stopifnot(exprs = {
identical(names(e.ch.A), c("P1.", "L1", "D", "L1.", "P1"))
identical(names(E.ch.A), c("P1.", "L" , "L." , "P1"))
identical(e.ch.A[["P1"]],
new("pMatrix", Dim = c(n, n), Dimnames = c(list(NULL), dn[2L]),
margin = 2L, perm = invertPerm(ch.A@perm, 0L, 1L)))
identical(e.ch.A[["P1."]], t(e.ch.A[["P1"]]))
identical(e.ch.A[["L1."]], t(e.ch.A[["L1"]]))
identical(E.ch.A[["L." ]], t(E.ch.A[["L" ]]))
identical(e.ch.A[["D"]], Diagonal(x = diag(ch.A)))
all.equal(E.ch.A[["L"]], with(e.ch.A, L1 %*% sqrt(D)))
ae1(A, with(e.ch.A, P1. %*% L1 %*% D %*% L1. %*% P1))
ae1(A, with(E.ch.A, P1. %*% L %*% L. %*% P1))
ae2(A[ch.A@perm + 1L, ch.A@perm + 1L], with(e.ch.A, L1 %*% D %*% L1.))
ae2(A[ch.A@perm + 1L, ch.A@perm + 1L], with(E.ch.A, L %*% L. ))
})
## Factorization handled as factorized matrix
## (in some cases only optionally, depending on arguments)
b <- rnorm(n)
stopifnot(identical(det(A), det(ch.A, sqrt = FALSE)),
identical(solve(A, b), solve(ch.A, b, system = "A")))
u1 <- update(ch.A, A , mult = sqrt(2))
u2 <- update(ch.A, t(M), mult = sqrt(2)) # updating with crossprod(M), not M
stopifnot(all.equal(u1, u2, tolerance = 1e-14))
Run the code above in your browser using DataLab