tests/testthat/test-BipartiteSBM_sampler.R

In GrossSBM/sbm: Stochastic Blockmodels

set.seed(1234)

## Common parameters
nbNodes  <- c(100, 120)
blockProp <- list(row = c(.5, .5), col = c(1/3, 1/3, 1/3)) # group proportions
nbBlocks <- sapply(blockProp, length)

test_that("Construction, fields access and other basics work in class BipartiteSBM_Sampler (Bernoulli model, no covariate)", {

  ## BIPARTITE UNDIRECTED BERNOULLI SBM
  means <- matrix(runif(6), 2, 3)  # connectivity matrix
  connectParam <- list(mean = means)

  ## Basic construction - check for wrong specifications
  mySampler <- BipartiteSBM$new('bernoulli', nbNodes, blockProp, connectParam)
  expect_error(SimpleSBM$new('bernouilli',nbNodes, blockProp, connectParam))
  expect_error(SimpleSBM$new('bernoulli', -10    , blockProp, connectParam))
  expect_error(SimpleSBM$new('bernoulli', c(1,2) , blockProp, connectParam))
  expect_error(SimpleSBM$new('bernoulli', nbNodes, 2, connectParam))
  expect_error(SimpleSBM$new('bernoulli', nbNodes, c(0,1), connectParam))
  expect_error(SimpleSBM$new('bernoulli', nbNodes, blockProp, list(mean = matrix( 2, nbBlocks[1], nbBlocks[2]))))
  expect_error(SimpleSBM$new('bernoulli', nbNodes, blockProp, list(mean = matrix(-2, nbBlocks[1], nbBlocks[2]))))
  expect_error(SimpleSBM$new('bernoulli', nbNodes, FALSE, blockProp, list(mean = matrix(0, nbBlocks[1] - 1, nbBlocks[2]))))

  ## Checking class
  expect_true(inherits(mySampler, "SBM"))
  expect_true(inherits(mySampler, "BipartiteSBM"))

  ## Checking field access and format

  ## parameters
  expect_equal(mySampler$modelName, 'bernoulli')
  expect_equal(unname(mySampler$nbNodes), nbNodes)
  expect_equal(mySampler$nbDyads, nbNodes[1]*nbNodes[2])

  ## covariates
  expect_null(mySampler$covarExpect)
  expect_equal(mySampler$nbCovariates, 0)
  expect_equal(mySampler$covarList, list())
  expect_equal(mySampler$covarParam, numeric(0))

  expect_equal(mySampler$connectParam$mean, means)
  expect_null(mySampler$connectParam$var)

  ## network
  mySampler$rMemberships(store = TRUE)
  mySampler$rEdges(store = TRUE)
  expect_equal(dim(mySampler$expectation), nbNodes)
  expect_true(all(mySampler$expectation >= 0, na.rm = TRUE))
  expect_true(all(mySampler$expectation <= 1, na.rm = TRUE))
  expect_false(isSymmetric(mySampler$networkData))

  ## blocks
  expect_equal(mySampler$blockProp, blockProp)
  expect_equal(mySampler$nbBlocks, nbBlocks)
  expect_equivalent(dim(mySampler$indMemberships[[1]]), c(nbNodes[1], nbBlocks[1]))
  expect_equivalent(dim(mySampler$indMemberships[[2]]), c(nbNodes[2], nbBlocks[2]))
  expect_equal(sort(unique(mySampler$memberships[[1]])), 1:nbBlocks[1])
  expect_equal(sort(unique(mySampler$memberships[[2]])), 1:nbBlocks[2])
  expect_equal(length(mySampler$memberships[[1]]), nbNodes[1])
  expect_equal(length(mySampler$memberships[[2]]), nbNodes[2])

  ## covariates
  expect_equal(mySampler$nbCovariates, 0)
  expect_equal(mySampler$covarList, list())
  expect_equal(mySampler$covarParam, numeric(0))

})


test_that("Construction, fields access and other basics work in class BipartiteSBM_Sampler (Poisson model, no covariate)", {

  ## SIMPLE UNDIRECTED POISSON SBM
  means <- matrix(rbinom(6, 30, 0.25), 2, 3)  # connectivity matrix
  connectParam <- list(mean = means)

  ## Basic construction - check for wrong specifications
  mySampler <- BipartiteSBM$new('poisson', nbNodes, blockProp, connectParam)
  expect_error(BipartiteSBM$new('poison' , nbNodes, blockProp, connectParam))
  expect_error(BipartiteSBM$new('poisson', -10    , blockProp, connectParam))
  expect_error(BipartiteSBM$new('poisson', nbNodes, -2, connectParam))
  expect_error(BipartiteSBM$new('poisson', nbNodes,  c(0,1), connectParam))
  expect_error(BipartiteSBM$new('poisson', nbNodes, blockProp, list(mean = matrix(-2, nbBlocks[1], nbBlocks[2]))))
  expect_error(BipartiteSBM$new('poisson', nbNodes, blockProp, list(mean = matrix(2 , nbBlocks[1] - 1, nbBlocks[2]))))

  ## Checking class
  expect_true(inherits(mySampler, "SBM"))
  expect_true(inherits(mySampler, "BipartiteSBM"))

  ## Checking field access and format

  ## parameters
  expect_equal(mySampler$modelName, 'poisson')
  expect_equal(unname(mySampler$nbNodes), nbNodes)
  expect_equal(mySampler$nbDyads, nbNodes[1]*nbNodes[2])
  expect_equal(mySampler$connectParam$mean, means)
  expect_null(mySampler$connectParam$var)

  ## network
  mySampler$rMemberships(store = TRUE)
  mySampler$rEdges(store = TRUE)
  expect_equal(dim(mySampler$expectation), nbNodes)
  expect_true(all(mySampler$expectation >= 0, na.rm = TRUE))
  expect_false(isSymmetric(mySampler$networkData))

  ## blocks
  expect_equal(mySampler$blockProp, blockProp)
  expect_equal(mySampler$nbBlocks, nbBlocks)
  expect_equivalent(dim(mySampler$indMemberships[[1]]), c(nbNodes[1], nbBlocks[1]))
  expect_equivalent(dim(mySampler$indMemberships[[2]]), c(nbNodes[2], nbBlocks[2]))
  expect_equal(sort(unique(mySampler$memberships[[1]])), 1:nbBlocks[1])
  expect_equal(sort(unique(mySampler$memberships[[2]])), 1:nbBlocks[2])
  expect_equal(length(mySampler$memberships[[1]]), nbNodes[1])
  expect_equal(length(mySampler$memberships[[2]]), nbNodes[2])

  ## covariates
  expect_equal(mySampler$nbCovariates, 0)
  expect_equal(mySampler$covarList, list())
  expect_equal(mySampler$covarParam, numeric(0))
})

test_that("Construction, fields access and other basics work in class BipartiteSBM_Sampler (Gaussian model, no covariate)", {

  ## SIMPLE UNDIRECTED GAUSSIAN SBM
  means <- matrix(c(0.05, 0.95, 0.4, 0.98, 0.15, 0.6), 2, 3)  # connectivity matrix
  connectParam <- list(mean = means, var = .1)

  ## Basic construction - check for wrong specifications
  mySampler <- BipartiteSBM$new('gaussian', nbNodes, blockProp, connectParam)
  expect_error(BipartiteSBM$new('normal'  , nbNodes, blockProp, connectParam))
  expect_error(BipartiteSBM$new('gaussian', -10    , blockProp, connectParam))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, -2, connectParam))
  expect_error(BipartiteSBM$new('gaussian', nbNodes,  c(0,1), connectParam))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, blockProp, list(var = -1, mean = means)))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, blockProp, list(mean = matrix(runif(nbBlocks**2), nbBlocks, nbBlocks))))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, blockProp, list(var = 1 , mean = matrix(2 , nbBlocks - 1, nbBlocks))))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, blockProp, list(mean = matrix(-2, nbBlocks[1], nbBlocks[2]))))
  expect_error(BipartiteSBM$new('gaussian', nbNodes, blockProp, list(mean = matrix(2 , nbBlocks[1] - 1, nbBlocks[2]))))

  ## Checking class
  expect_true(inherits(mySampler, "SBM"))
  expect_true(inherits(mySampler, "BipartiteSBM"))

  ## Checking field access and format

  ## parameters
  expect_equal(mySampler$modelName, 'gaussian')
  expect_equal(unname(mySampler$nbNodes), nbNodes)
  expect_equal(mySampler$nbDyads, nbNodes[1]*nbNodes[2])
  expect_equal(mySampler$connectParam$mean, means)
  expect_gt(mySampler$connectParam$var, 0)

  ## network
  mySampler$rMemberships(store = TRUE)
  mySampler$rEdges(store = TRUE)
  expect_equal(dim(mySampler$expectation), nbNodes)
  expect_false(isSymmetric(mySampler$networkData))

  ## blocks
  expect_equal(mySampler$blockProp, blockProp)
  expect_equal(mySampler$nbBlocks, nbBlocks)
  expect_equivalent(dim(mySampler$indMemberships[[1]]), c(nbNodes[1], nbBlocks[1]))
  expect_equivalent(dim(mySampler$indMemberships[[2]]), c(nbNodes[2], nbBlocks[2]))
  expect_equal(sort(unique(mySampler$memberships[[1]])), 1:nbBlocks[1])
  expect_equal(sort(unique(mySampler$memberships[[2]])), 1:nbBlocks[2])
  expect_equal(length(mySampler$memberships[[1]]), nbNodes[1])
  expect_equal(length(mySampler$memberships[[2]]), nbNodes[2])

  ## covariates
  expect_equal(mySampler$nbCovariates, 0)
  expect_equal(mySampler$covarList, list())
  expect_equal(mySampler$covarParam, numeric(0))
})