tests/testthat/test-u-function.R

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

#  File tests/testthat/test-u-function.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 <- 4

test_that("Private storage, auxiliaries, and auxiliaries of auxiliaries", {
  nw <- network.initialize(n, dir=TRUE)
  nw[1,2] <- 1
  nw[1,3] <- 1
  nw[3,2] <- 1

  s <- summary(nw~edges+test.abs.edges.minus.5+test.abs.edges.minus.5(FALSE)+sociomatrix+discord.sociomatrix+discord.inter.union.net(nw, implementation="Network"))
  expect_true(all(abs(s[1]-5)==s[2]) && all(abs(s[1]-5)==s[3]))
  expect_equal(s[3+seq_len(n^2)], c(as.matrix(nw)), ignore_attr=TRUE)
  expect_true(all(s[3+n^2+seq_len(n^2)]==0))
  sim <- simulate(nw~edges,monitor=~test.abs.edges.minus.5+test.abs.edges.minus.5(FALSE)+sociomatrix+discord.sociomatrix+discord.inter.union.net(nw, implementation="Network"), coef=0, nsim=20, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1))
  s <- attr(sim, "stats")
  expect_true(all(abs(s[,1]-5)==s[,2]) && all(abs(s[,1]-5)==s[,3]))
  sim.dyads <- t(sapply(lapply(sim, as.matrix), c))
  expect_equal(sim.dyads, s[,3+seq_len(n^2)], ignore_attr=TRUE)
  expect_true(all(t(t(sim.dyads)!=c(as.matrix(nw)))==s[,3+n^2+seq_len(n^2)]))
})

test_that("Multiple auxiliaries in one term", {
  data(florentine)
  floempty <- flomarriage
  floempty[,] <- 0

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(floempty, implementation="Network"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flomarriage, implementation="Network"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flobusiness, implementation="Network"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(floempty, implementation="DyadSet"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flomarriage, implementation="DyadSet"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flobusiness, implementation="DyadSet"), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats")
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))
})

test_that("multiple auxiliaries in one term: multiplicitous proposal", {
  data(florentine)
  floempty <- flomarriage
  floempty[,] <- 0

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(floempty), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats", constraints=~degrees)
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flomarriage), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats", constraints=~degrees)
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))

  sim <- simulate(flomarriage~edges,monitor=~discord.inter.union.net(flobusiness), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1), output="stats", constraints=~degrees)
  expect_true(all(sim[,2:4]^2-sim[,5:7]==0))
})

test_that("Multiplicitous proposal", {
  nw <- network.initialize(4, dir=TRUE)
  nw[1,2,names.eval="v",add.edges=TRUE] <- 1
  nw[1,3,names.eval="v",add.edges=TRUE] <- 1
  nw[3,2,names.eval="v",add.edges=TRUE] <- 1
  nw %ergmlhs% "response" <- "v"

  sim <- simulate(nw~sum,monitor=~test.abs.sum.minus.5+test.abs.sum.minus.5(FALSE)+test.abs.sum.minus.5(FALSE,TRUE)+sociomatrix, reference=~DiscUnif(-1,2), coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1,MCMC.prop.weights="random2"))
  s <- attr(sim, "stats")
  expect_true(all(abs(s[,1]-5)==s[,2]) && all(abs(s[,1]-5)==s[,3]) && all(abs(s[,1]-5)==s[,4]))
  sim.dyads <- t(sapply(lapply(sim, as.matrix, attrname="v"), c))
  expect_true(all(sim.dyads==s[,-(1:4)]))
})

test_that("Ergm.count_test", {
  library(ergm.count)
  nw <- network.initialize(4, dir=TRUE)
  nw[1,2,names.eval="v",add.edges=TRUE] <- 1
  nw[1,3,names.eval="v",add.edges=TRUE] <- 1
  nw[3,2,names.eval="v",add.edges=TRUE] <- 1
  nw %ergmlhs% "response" <- "v"
  s <- summary(nw~sum+test.abs.sum.minus.5+test.abs.sum.minus.5(FALSE)+test.abs.sum.minus.5(FALSE,TRUE)+sociomatrix)
  expect_true(all(abs(s[1]-5)==s[2]) && all(abs(s[1]-5)==s[3]) && all(abs(s[1]-5)==s[4]))
  expect_true(all(s[-(1:4)]==c(as.matrix(nw, attrname="v"))))
  sim <- simulate(nw~sum,monitor=~test.abs.sum.minus.5+test.abs.sum.minus.5(FALSE)+test.abs.sum.minus.5(FALSE,TRUE)+sociomatrix, reference=~Poisson, coef=0, nsim=100, control=control.simulate.formula(MCMC.burnin=0,MCMC.interval=1))
  s <- attr(sim, "stats")
  expect_true(all(abs(s[,1]-5)==s[,2]) && all(abs(s[,1]-5)==s[,3]) && all(abs(s[,1]-5)==s[,4]))
  sim.dyads <- t(sapply(lapply(sim, as.matrix, attrname="v"), c))
  expect_true(all(sim.dyads==s[,-(1:4)]))
})