tests/testthat/test-vglmfit.R

In sgdGMF: Estimation of Generalized Matrix Factorization Models via Stochastic Gradient Descent

# file: test-vglmfit.R
# author: Cristian Castiglione
# creation: 23/03/2024
# last change: 04/10/2024

testthat::test_that("Multivariate OLS fitting", {
  n = 100; m = 10; p = 5; q = p+1

  O = matrix(rexp(n*m, rate = 2.0), nrow = n, ncol = m)
  X = cbind(1, matrix(rnorm(n*p, mean = 0.0, sd = 1.0),  nrow = n, ncol = p))
  B = matrix(rnorm(m*q, mean = 0.1, sd = 0.25), nrow = m, ncol = q)
  E = matrix(rnorm(n*m, mean = 0.0, sd = 0.1), nrow = n, ncol = m)
  Y = O + tcrossprod(X, B) + E

  B.hat = ols.fit.coef(Y, X, offset = O)
  mu.hat = O + tcrossprod(X, B.hat)
  res.hat = Y - mu.hat

  # Check the dimension and the basic properties of the estimates
  testthat::expect_equal(c(m, q), dim(B.hat))
  testthat::expect_equal(crossprod(X, mu.hat), crossprod(X, Y))
  testthat::expect_equal(matrix(0, q, m), crossprod(X, res.hat))
  testthat::expect_equal(0, mean(res.hat))
})


testthat::test_that("Binomial VGLM fitting", {
  n = 100; m = 10; p = 5; q = p+1
  family = binomial(link = "probit")

  O = matrix(rexp(n*m, rate = 2.0), nrow = n, ncol = m)
  X = cbind(1, matrix(rnorm(n*p, mean = 0.0, sd = 1.0),  nrow = n, ncol = p))
  B = matrix(rnorm(m*q, mean = 0.1, sd = 0.25), nrow = m, ncol = q)
  eta = O + tcrossprod(X, B)
  mu = family$linkinv(eta)
  Y = matrix(rbinom(n*m, size = 1, prob = mu), nrow = n, ncol = m)

  B.hat = vglm.fit.coef(Y, X, family, offset = O, parallel = FALSE)
  eta.hat = O + tcrossprod(X, B.hat)
  mu.hat = family$linkinv(eta.hat)
  dmu.hat = family$mu.eta(eta.hat)
  var.hat = family$variance(mu.hat)
  res.hat = (Y - mu.hat) * dmu.hat / var.hat

  # Check the dimension and the basic properties of the estimates
  testthat::expect_equal(c(m, q), dim(B.hat))
  testthat::expect_true(mean(crossprod(X, res.hat)) < 1e-04)
})

testthat::test_that("Poisson VGLM fitting", {
  n = 100; m = 10; p = 5; q = p+1
  family = poisson(link = "log")

  O = matrix(rexp(n*m, rate = 2.0), nrow = n, ncol = m)
  X = cbind(1, matrix(rnorm(n*p, mean = 0.0, sd = 1.0),  nrow = n, ncol = p))
  B = matrix(rnorm(m*q, mean = 0.1, sd = 0.25), nrow = m, ncol = q)
  eta = O + tcrossprod(X, B)
  mu = family$linkinv(eta)
  Y = matrix(rpois(n*m, lambda = mu), nrow = n, ncol = m)

  B.hat = vglm.fit.coef(Y, X, family, offset = O, parallel = FALSE)
  eta.hat = O + tcrossprod(X, B.hat)
  mu.hat = family$linkinv(eta.hat)
  dmu.hat = family$mu.eta(eta.hat)
  var.hat = family$variance(mu.hat)
  res.hat = (Y - mu.hat) * dmu.hat / var.hat

  # Check the dimension and the basic properties of the estimates
  testthat::expect_equal(c(m, q), dim(B.hat))
  testthat::expect_true(mean(crossprod(X, res.hat)) < 1e-04)
})

testthat::test_that("Gamma VGLM fitting", {
  n = 100; m = 10; p = 5; q = p+1
  family = Gamma(link = "log")

  O = matrix(rexp(n*m, rate = 2.0), nrow = n, ncol = m)
  X = cbind(1, matrix(rnorm(n*p, mean = 0.0, sd = 1.0),  nrow = n, ncol = p))
  B = matrix(rnorm(m*q, mean = 0.1, sd = 0.25), nrow = m, ncol = q)
  eta = O + tcrossprod(X, B)
  mu = family$linkinv(eta)
  Y = matrix(rgamma(n*m, shape = 2, rate = 2 / mu), nrow = n, ncol = m)

  B.hat = vglm.fit.coef(Y, X, family, offset = O, parallel = FALSE)
  eta.hat = O + tcrossprod(X, B.hat)
  mu.hat = family$linkinv(eta.hat)
  dmu.hat = family$mu.eta(eta.hat)
  var.hat = family$variance(mu.hat)
  res.hat = (Y - mu.hat) * dmu.hat / var.hat

  # Check the dimension and the basic properties of the estimates
  testthat::expect_equal(c(m, q), dim(B.hat))
  testthat::expect_true(mean(crossprod(X, res.hat)) < 1e-03)
})