tests/testthat/test_GGM.R

In gif: Graphical Independence Filtering

library(testthat)
library(gif)
library(MASS)
context("hgt function")
skip_on_cran()

test_that("Error if computation matrix for hgt is wrong!", {
  target_matrix <- matrix(c(1.0725, 0.4958, 0, 0.4958, 1.0196, 0.4319, 0, 0.4319, 0.9802), nrow = 3, ncol = 3)
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  x <- ggm.generator(num, sigma_inv)
  non_zero_num <- sum(sigma_inv != 0) - p
  res <- hgt(x, size = non_zero_num / 2)
  omega <- as.matrix(res[["Omega"]])
  omega <- round(omega, 4)
  for(i in 1:3) {
    for(j in 1:3) {
      expect_equal(omega[i, j], target_matrix[i, j])
    }
  }
})

test_that("Error if the size of the output active.entry doesn't match the arguments size in hgt!", {
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  non_zero_num <- sum(sigma_inv != 0) - p
  x <- ggm.generator(num, sigma_inv)
  res <- hgt(x, size = non_zero_num / 2)
  active.entry <- res[["active.entry"]]
  expect_equal(nrow(active.entry), non_zero_num / 2)
})

test_that("Error if active.entry is changed when it is given directly in hgt!", {
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  x <- ggm.generator(num, sigma_inv)
  non_zero_index <- which(as.matrix(sigma_inv) != 0, arr.ind = TRUE)
  active.entry <- non_zero_index[which(non_zero_index[,1] < non_zero_index[,2]),]
  res <- hgt(x, active.entry = active.entry)
  expect_equal(res[["active.entry"]], active.entry)
})

test_that("Error if computation matrix for sgt is wrong!", {
  target_matrix <- matrix(c(1.1362, 0.4846, -0.2459, 0.4846, 1.0048, 0.4224, -0.2459, 0.4224, 1.0430), nrow = 3, ncol = 3)
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  x <- ggm.generator(num, sigma_inv)
  res <- sgt(x, lambda = 0.01)
  omega <- as.matrix(res[["Omega"]])
  omega <- round(omega, 4)
  for(i in 1:3) {
    for(j in 1:3) {
      expect_equal(omega[i, j], target_matrix[i, j])
    }
  }
})

test_that("Error if the size of the output active.entry doesn't match the arguments size in sgt!", {
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  non_zero_num <- sum(sigma_inv != 0) - p
  x <- ggm.generator(num, sigma_inv)
  res <- sgt(x, size = non_zero_num / 2)
  active.entry <- res[["active.entry"]]
  expect_equal(nrow(active.entry), non_zero_num / 2)
})

test_that("Error if the acyclic diagnostic is wrong in sgt!", {
  set.seed(1)
  num <- 100
  p <- 3
  sigma_inv <- diag(1, p, p)
  for(i in 1:(p - 1)) {
    sigma_inv[i, i + 1] <- 0.5
    sigma_inv[i + 1, i] <- 0.5
  }
  non_zero_num <- sum(sigma_inv != 0) - p
  x <- ggm.generator(num, sigma_inv)
  res <- sgt(x, size = non_zero_num / 2)
  expect_equal(res[["is.acyclic"]], TRUE)
})