tests/testthat/test-sample.R

In GrossSBM/sbm: Stochastic Blockmodels

test_that("multiplex sampler works", {

  ## Independent multiplex
  Nnodes <- 40
  blockProp <- c(.4,.6)
  nbLayers <- 2
  connectParam <- list(list(mean=matrix(rbeta(4,.5,.5),2,2)),list(mean=matrix(rexp(4,.5),2,2)))
  model <- c("bernoulli","poisson")
  type <- "directed"
  sampMultiplexIndep <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type=type)

  expect_equal(dim(sampMultiplexIndep$listSBM[[2]]$networkData),c(Nnodes,Nnodes))
  expect_equal(length(sampMultiplexIndep$memberships[[1]]),Nnodes)


  ## Independent bipartite multiplex
  Nnodes <- c(40,30)
  blockProp <- list(c(.4,.6),rep(.5,2))
  nbLayers <- 2
  connectParam <- list(list(mean=matrix(rbeta(4,.5,.5),2,2)),list(mean=matrix(rexp(4,.5),2,2)))
  model <- c("bernoulli","poisson")
  type <- "bipartite"
  sampMultiplexIndep <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type=type)

  expect_equal(dim(sampMultiplexIndep$listSBM[[2]]$networkData),Nnodes)
  expect_equal(length(sampMultiplexIndep$memberships[[1]]),Nnodes[1])
  expect_equal(length(sampMultiplexIndep$memberships[[2]]),Nnodes[2])


  # Dependent bernoulli multiplex
  Q <- 2
  P00<-matrix(runif(Q*Q),Q,Q)
  P10<-matrix(runif(Q*Q),Q,Q)
  P01<-matrix(runif(Q*Q),Q,Q)
  P11<-matrix(runif(Q*Q),Q,Q)
  SumP<-P00+P10+P01+P11
  P00<-P00/SumP
  P01<-P01/SumP
  P10<-P10/SumP
  P11<-P11/SumP
  connectParam = list()
  connectParam$prob00 = P00
  connectParam$prob01 = P01
  connectParam$prob10 = P10
  connectParam$prob11 = P11
  model = rep("bernoulli",2)
  type = "directed"
  nbLayers = 2
  Nnodes = 40
  blockProp = c(.6,.4)
  sampMultiplexDepBern <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type=type,dependent=TRUE)

  expect_equal(length(sampMultiplexDepBern$memberships[[1]]),Nnodes)
  expect_equal(dim(sampMultiplexDepBern$listSBM[[1]]$networkData),rep(Nnodes,2))

  expect_error(sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type="undirected",dependent=TRUE))

  Nnodes <- c(40,30)
  blockProp <- list(c(.4,.6),rep(.5,2))
  sampMultiplexDepBern <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type="bipartite",dependent=TRUE)
  expect_equal(length(sampMultiplexDepBern$memberships),2)
  expect_equal(dim(sampMultiplexDepBern$listSBM[[1]]$networkData),Nnodes)


  # dependent Gaussian multiplex
  Q <- 3
  nbLayers <- 2
  connectParam <- list()
  connectParam$mu <- vector("list",nbLayers)
  connectParam$mu[[1]] <- matrix(rnorm(Q*Q),Q,Q)*10
  connectParam$mu[[2]] <- matrix(rnorm(Q*Q),Q,Q)*2
  connectParam$Sigma <- matrix(c(2,1,1,4),nbLayers,nbLayers)
  model <- rep("gaussian",2)
  type <- "directed"
  Nnodes <- 60
  blockProp <- c(.3,.3,.4)
  sampMultiplexDepGau <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type="undirected",dependent=TRUE)

  expect_equal(length(unique(sampMultiplexDepGau$memberships[[1]])),Q)
  expect_equal(sampMultiplexDepGau$listSBM[[1]]$modelName,"gaussian")
  expect_equal(dim(sampMultiplexDepGau$listSBM[[1]]$networkData),rep(Nnodes,2))


  Nnodes <- c(40,30)
  blockProp <- list(c(.4,.6),rep(.5,2))
  Q <- 2
  connectParam$mu[[1]] <- matrix(rnorm(Q*Q),Q,Q)*10
  connectParam$mu[[2]] <- matrix(rnorm(Q*Q),Q,Q)*2
  sampMultiplexDepGau <- sampleMultiplexSBM(nbNodes = Nnodes,blockProp = blockProp,nbLayers = nbLayers,connectParam = connectParam,model=model,type="bipartite",dependent=TRUE)
  expect_equal(length(sampMultiplexDepGau$memberships),2)
  expect_equal(dim(sampMultiplexDepGau$listSBM[[1]]$networkData),Nnodes)
  expect_equal(sampMultiplexDepGau$listSBM[[2]]$modelName,"gaussian")


})