Nothing
# file: test-utils.R
# author: Cristian Castiglione
# creation: 05/02/2024
# last change: 25/02/2024
testthat::test_that("Whitening matrix", {
n = 100; m = 10; d = 5
U = matrix(rnorm(n*d), n, d)
V = matrix(rnorm(d*d), d, d)
X = U %*% V
S = cov(X)
W.zca = whitening.matrix(cov(X), method = "ZCA")
W.pca = whitening.matrix(cov(X), method = "PCA")
W.zca.cor = whitening.matrix(cov(X), method = "ZCA-cor")
W.pca.cor = whitening.matrix(cov(X), method = "ZCA-cor")
W.chol = whitening.matrix(cov(X), method = "Cholesky")
# Check if the whitening matrix corresponds to the inverse covariance
testthat::expect_equal(cov(X %*% W.zca), diag(d))
testthat::expect_equal(crossprod(W.zca), solve(S))
testthat::expect_equal(crossprod(W.pca), solve(S))
testthat::expect_equal(crossprod(W.zca.cor), solve(S))
testthat::expect_equal(crossprod(W.pca.cor), solve(S))
testthat::expect_equal(crossprod(W.chol), solve(S))
})
testthat::test_that("QR orthogonalization", {
n = 100; m = 10; d = 5
old = list(U = matrix(rnorm(n*d), n, d), V = matrix(rnorm(m*d), m, d))
new = normalize.uv(old$U, old$V, method = "qr")
# Check if the matrix reconstruction is the same
testthat::expect_equal(tcrossprod(new$U, new$V), tcrossprod(old$U, old$V))
# Check if the orthogonalized U has identity variance
testthat::expect_equal(var(new$U), diag(d))
# Check if the orthogonalized V is lower triangular
testthat::expect_equal(new$V[upper.tri(new$V)], rep(0, floor(d * (d-1) / 2)))
})
testthat::test_that("SVD orthogonalization", {
n = 100; m = 10; d = 5
old = list(U = matrix(rnorm(n*d), n, d), V = matrix(rnorm(m*d), m, d))
new = normalize.uv(old$U, old$V, method = "svd")
svds = RSpectra::svds(tcrossprod(new$U, new$V), d)$d
# Check if the matrix reconstruction is the same
testthat::expect_equal(tcrossprod(new$U, new$V), tcrossprod(old$U, old$V))
# Check if U is a scaled orthogonal matrix
testthat::expect_equal(crossprod(new$U), diag(d))
# Check if V is a scaled orthogonal matrix
testthat::expect_equal(crossprod(new$V), diag(colSums(new$V^2)))
# Check if U and V have the column norm
testthat::expect_equal(colSums(new$V^2), RSpectra::svds(tcrossprod(new$U, new$V), d)$d^2)
})
testthat::test_that("GMF data simulation", {
n = 100; m = 10; d = 5
pois = sim.gmf.data(n = n, m = m, ncomp = d, family = poisson())
bin = sim.gmf.data(n = n, m = m, ncomp = d, family = binomial())
gam = sim.gmf.data(n = n, m = m, ncomp = d, family = Gamma(link = "log"))
# Check if the matrices have the correct dimensions
testthat::expect_equal(dim(pois$Y), c(n,m))
testthat::expect_equal(dim(bin$Y), c(n,m))
testthat::expect_equal(dim(gam$Y), c(n,m))
testthat::expect_equal(dim(pois$eta), c(n,m))
testthat::expect_equal(dim(bin$eta), c(n,m))
testthat::expect_equal(dim(gam$eta), c(n,m))
testthat::expect_equal(dim(pois$mu), c(n,m))
testthat::expect_equal(dim(bin$mu), c(n,m))
testthat::expect_equal(dim(gam$mu), c(n,m))
testthat::expect_equal(dim(pois$U), c(n,d))
testthat::expect_equal(dim(bin$U), c(n,d))
testthat::expect_equal(dim(gam$U), c(n,d))
testthat::expect_equal(dim(pois$V), c(m,d))
testthat::expect_equal(dim(bin$V), c(m,d))
testthat::expect_equal(dim(gam$V), c(m,d))
# Check if the generated data respect their natural constraints
testthat::expect_true(all(pois$Y >= 0 & is.integer(pois$Y)))
testthat::expect_true(all(bin$Y %in% c(0,1) & is.integer(pois$Y)))
testthat::expect_true(all(gam$Y > 0))
testthat::expect_true(all(pois$mu >= 0))
testthat::expect_true(all(bin$mu >= 0 & bin$mu <= 1))
testthat::expect_true(all(gam$mu > 0))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.