tests/testthat/test-utils.R

# 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))
})

Try the sgdGMF package in your browser

Any scripts or data that you put into this service are public.

sgdGMF documentation built on April 3, 2025, 7:37 p.m.