tests/testthat/test-constrain-egocentric.R

In ergm: Fit, Simulate and Diagnose Exponential-Family Models for Networks

#  File tests/testthat/test-constrain-egocentric.R in package ergm, part of the
#  Statnet suite of packages for network analysis, https://statnet.org .
#
#  This software is distributed under the GPL-3 license.  It is free,
#  open source, and has the attribution requirements (GPL Section 7) at
#  https://statnet.org/attribution .
#
#  Copyright 2003-2023 Statnet Commons
################################################################################

n <- 10
m <- 7

propw <- "TNT"
#propw <- "random"

repeat{
  a <- as.logical(rbinom(n, 1, .5))
  Mb <- Mi <- Mo <- matrix(0L,n,n)

  Mo[!a,] <- 1L
  Mi[,!a] <- 1L
  Mb <- Mo * Mi

  diag(Mo) <- diag(Mi) <- diag(Mb) <-0L

  if(any(Mo) && any(Mi) && any(Mb)) break
}

test_that("egocentric constraint, directed", {
  y0 <- network.initialize(n, directed=TRUE)
  y0 %v% "a" <- a

  y <- simulate(y0~edges, coef=100, constraints=~egocentric("a", dir="o"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))
  expect_equal(as.matrix(y), Mo, ignore_attr=TRUE)

  y <- simulate(y0~edges, coef=100, constraints=~egocentric("a", dir="i"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))
  expect_equal(as.matrix(y), Mi, ignore_attr=TRUE)

  y <- simulate(y0~edges, coef=100, constraints=~egocentric("a"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))
  expect_equal(as.matrix(y), Mb, ignore_attr=TRUE)
})

test_that("egocentric constraint, undirected", {
  y0 <- network.initialize(n, directed=FALSE)
  y0 %v% "a" <- a

  y <- simulate(y0~edges, coef=100, constraints=~egocentric("a"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))
  expect_equal(as.matrix(y), Mb, ignore_attr=TRUE)
})

## #### Unobserved ####

## y0 <- network.initialize(n, directed=TRUE)
## y0 %v% "a" <- a
## y0[2,3]<-NA
## y0[2,10]<-NA

## y <- simulate(y0~edges, coef=100, constraints=~egocentric("a")+observed, control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))

## M[]<-0
## M[2,3]<-1

## expect_equal(as.matrix(y), M, ignore_attr=TRUE)

#### Bipartite ####

y0 <- network.initialize(n, directed=FALSE, bipartite=m)

repeat{
  a <- as.logical(rbinom(n, 1L, .5))
  ae <- a[seq_len(m)]
  aa <- a[m+seq_len(n-m)]

  M <- matrix(1L,m,n-m)

  M[ae,] <- 0L
  M[,aa] <- 0L

  if(any(M)) break
}

y0 %v% "a" <- a

test_that("egocentric constraint, bipartite undirected", {
  y <- simulate(y0~edges, coef=100, constraints=~egocentric("a"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))
  expect_equal(as.matrix(y), M, ignore_attr=TRUE)
})

## #### Bipartite Unobserved ####

## y0 <- network.initialize(n, directed=FALSE, bipartite=m)
## y0 %v% "b" <- a
## y0[7,8]<-NA
## y0[6,9]<-NA

## y <- simulate(y0~edges, coef=100, constraints=~blockdiag("b")+observed, control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))

## M[]<-0
## M[6,2]<-1

## expect_equal(as.matrix(y), M, ignore_attr=TRUE)

## #### Multiple ####

## n <- 10
## a1 <- rep(1:4,1:4)
## a2 <- rep(1:2,each=5)

## M1<- matrix(0,n,n)
## for(i in unique(a1)){
##   M1[a1==i,a1==i]<-1
## }
## diag(M1)<-0

## M2<- matrix(0,n,n)
## for(i in unique(a2)){
##   M2[a2==i,a2==i]<-1
## }
## diag(M2)<-0

## M <- M1*M2

## y0 <- network.initialize(n, directed=FALSE)
## y0 %v% "b1" <- a1
## y0 %v% "b2" <- a2

## y <- simulate(y0~edges, coef=100, constraints=~blockdiag("b1") + blockdiag("b2"), control=control.simulate.formula(MCMC.burnin=10000,MCMC.prop.weight=propw))

## expect_equal(as.matrix(y), M, ignore_attr=TRUE)