tests/testthat/test-ldl.R

In mcompanion: Objects and Methods for Multi-Companion Matrices

test_that(".ldl() and .udu() work.", { ## can beused also as examples
    m <- matrix(c(5,1,1,3),2,2)
    m.ldl <- mcompanion:::.ldl(m)
    m.udu <- mcompanion:::.udu(m)
    ml <- m.ldl$L %*% diag(m.ldl$d) %*% t(m.ldl$L)
    mu <- m.udu$U %*% diag(m.udu$d) %*% t(m.udu$U)
    expect_equal(ml, m)
    expect_equal(mu, m)
    expect_equal(mu, ml)

    x <- matrix(c(1:5, (1:5)^2), 5, 2)
    x <- cbind(x, x[, 1] + 3*x[, 2]) #3rd column is linear combination columns 1-2
    colnames(x) <- letters[20:22]

    m <- crossprod(x)
    expect_equal(qr(m)$rank, 2)  # is 2, as it should be

    ## TODO: make these smarter.
    ##
    ## These are volatile, so commenting out.  though the only problem currently seems to be
    ## on Atlas ("Additional issues" on CRAN):
    ##       
    ##   * checking tests ...
    ##     Running ‘testthat.R’
    ##    ERROR
    ##   Running the tests in ‘tests/testthat.R’ failed.
    ##   Complete output:
    ##     > library(testthat)
    ##     > library(mcompanion)
    ##     > 
    ##     > test_check("mcompanion")
    ##     ── 1. Failure: .ldl() and .udu() work. (@test-ldl.R#20)  ───────────────────────
    ##     `chol(m)` did not throw an error.
    ##     
    ##     ── 2. Failure: .ldl() and .udu() work. (@test-ldl.R#21)  ───────────────────────
    ##     `mcompanion:::.ldl(m)` did not throw an error.
    ##     
    ##     ── 3. Error: .ldl() and .udu() work. (@test-ldl.R#23)  ─────────────────────────
    ##     the leading minor of order 3 is not positive definite
    ##     Backtrace:
    ##      1. mcompanion:::.udu(m)
    ##      2. mcompanion:::.ldl(S)
    ##      5. base::chol.default(x)
    ##     
    ##     ══ testthat results  ═══════════════════════════════════════════════════════════
    ##     [ OK: 96 | SKIPPED: 4 | WARNINGS: 0 | FAILED: 3 ]
    ##     1. Failure: .ldl() and .udu() work. (@test-ldl.R#20) 
    ##     2. Failure: .ldl() and .udu() work. (@test-ldl.R#21) 
    ##     3. Error: .ldl() and .udu() work. (@test-ldl.R#23) 
    ##     
    ##     Error: testthat unit tests failed
    ##     Execution halted
    ## 
    ## msg3_notpd <- "the leading minor of order 3 is not positive definite"
    ## 
    ## expect_error(chol(m), msg3_notpd)
    ## expect_error(mcompanion:::.ldl(m), msg3_notpd)
    ## 
    ## m.udu <- mcompanion:::.udu(m)
    ## mu <- m.udu$U %*% diag(m.udu$d) %*% t(m.udu$U)
    ## expect_false(all(mu == m))
    ## expect_lt(max(abs(mu - m)), 1e-11)

    msg_rank <- "the matrix is either rank-deficient or indefinite"
    msg_rank <- NULL # for v0.5.7; we expect above message but not wise to check the text,
                     # it changed to 'the matrix ... or not positive definite' recently)
    expect_warning(mcho <- chol(m, pivot = TRUE), msg_rank)
    expect_equal(attr(mcho, "pivot"), c(3L,1L,2L))
    expect_equal(attr(mcho, "rank"),2)
    oo <- order(attr(mcho, "pivot"))
    expect_lt(max(abs(t(mcho[ , oo]) %*% mcho[ , oo] - m)), 1e-11)
         #   t u            v
         # t 0 0 0.000000e+00
         # u 0 0 0.000000e+00
         # v 0 0 1.818989e-12
    expect_true(all((t(mcho[ , oo]) %*% mcho[ , oo] - m)[1:5] == 0))

    ##
    x <- structure(c(5, 1, 1, 3), .Dim = c(2L, 2L))
    xldl <- .ldl(x)
    x.fromldl <- xldl$L %*% diag(xldl$d) %*% t(xldl$L)
    ## it is too much to expect restored object to be exactly the same as x:
    expect_false(all(x == x.fromldl))
    ## but the differences are very small:
    expect_equal(x[1,2], x.fromldl[1,2])
    expect_equal(x[2,1], x.fromldl[2,1])
    expect_lt(abs(x[1,1] - x.fromldl[1,1]), 1e-15)
    expect_lt(abs(x[2,2] - x.fromldl[2,2]), 1e-15)
})

test_that("permute_var() and permute_synch() work.", {
    Cl <- cor(longley) # example for 'cor'
    nc <- ncol(Cl)
    v <- 1:nc
    names(v) <- colnames(Cl)
    all(permute_var(Cl) == Cl[ncol(Cl):1, ncol(Cl):1])
    p1 <- sample(nc)
    all(permute_var(Cl, p1) == Cl[p1, p1])
    expect_true(all(replicate(10,
                              {p <- sample(nc)
                               all(permute_var(Cl, p) == Cl[p, p])
                           })))

    Cla <- permute_synch(list(Cl, v))
    Clb <- permute_synch(list(v, Cl))
    expect_identical(Cla[[1]], Clb[[2]])
    expect_identical(Cla[[2]], Clb[[1]])

})