tests/testthat/test-ergm-godfather.R

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

#  File tests/testthat/test-ergm-godfather.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
################################################################################

nwd <- network.initialize(4, dir=TRUE)
nwd[,,names.eval="w",add.edges=TRUE] <-
  matrix(c(0,1,2,0,
           0,0,1,3,
           1,0,0,0,
           1,4,1,0),
         4,4,
         byrow=TRUE)

nwu <- network.initialize(4, dir=FALSE)
nwu[,,names.eval="w",add.edges=TRUE] <-
  matrix(c(0,1,2,0,
           1,0,1,3,
           2,1,0,0,
           0,3,0,0),
         4,4,
         byrow=TRUE)


test_that("ergm.godfather() with toggles", {
  gf <- ergm.godfather(nwd~edges+triangles, changes=list(matrix(c(1,2,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE),
                                                        matrix(c(1,3,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE)),
                       stats.start=TRUE)

  expect_equal(as.matrix(gf),
               matrix(c(8,8,
                        6,2,
                        6,3),
                      ncol=2,byrow=TRUE), ignore_attr=TRUE)
})

test_that("ergm.godfather() with toggles, relative statistics", {
  gf <- ergm.godfather(nwd~edges+triangles, changes=list(matrix(c(1,2,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE),
                                                        matrix(c(1,3,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE)),
                       changes.only=TRUE)

  expect_equal(as.matrix(gf),
               matrix(c(-2,-6,
                        -2,-5),
                      ncol=2,byrow=TRUE), ignore_attr=TRUE)
})

test_that("ergm.godfather() with values", {
  gf <- ergm.godfather(nwd~edges+triangles, changes=list(matrix(c(1,2,1,
                                                                 2,3,0),
                                                               ncol=3,byrow=TRUE),
                                                        matrix(c(1,3,1,
                                                                 2,3,1),
                                                               ncol=3,byrow=TRUE)))

  expect_equal(as.matrix(gf),
               matrix(c(7,4,
                        8,8),
                      ncol=2,byrow=TRUE), ignore_attr=TRUE)
})

test_that("undirected ergm.godfather() with toggles", {
  gf <- ergm.godfather(nwu~edges+triangles, changes=list(matrix(c(1,2,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE),
                                                        matrix(c(1,3,
                                                                 2,3),
                                                               ncol=2,byrow=TRUE)),
                       stats.start=TRUE)

  expect_equal(as.matrix(gf),
               matrix(c(4,1,
                        2,0,
                        2,0),
                      ncol=2,byrow=TRUE), ignore_attr=TRUE)
})


test_that("undirected ergm.godfather() with values", {
  gf <- ergm.godfather(nwu~edges+triangles, changes=list(matrix(c(1,2,1,
                                                                 2,3,0),
                                                               ncol=3,byrow=TRUE),
                                                        matrix(c(1,3,1,
                                                                 2,3,1),
                                                               ncol=3,byrow=TRUE)))

  expect_equal(as.matrix(gf),
               matrix(c(3,0,
                        4,1),
                      ncol=2,byrow=TRUE), ignore_attr=TRUE)
})


test_that("valued ergm.godfather()", {
  gf <- ergm.godfather(nwd~nonzero+sum+transitiveweights(), response="w",
                       changes=list(matrix(c(1,2,1,
                                             2,3,0),
                                           ncol=3,byrow=TRUE),
                                    matrix(c(1,3,1,
                                             2,3,1),
                                           ncol=3,byrow=TRUE)))

  expect_equal(as.matrix(gf),
               matrix(c(7,13,3,
                        8,13,5),
                      ncol=3,byrow=TRUE), ignore_attr=TRUE)
})


test_that("valued ergm.godfather() returning the network", {
  gf <- ergm.godfather(nwd~nonzero+sum+transitiveweights(), response="w",
                       changes=list(matrix(c(1,2,1,
                                             2,3,0),
                                           ncol=3,byrow=TRUE),
                                    matrix(c(1,3,1,
                                             2,3,1),
                                           ncol=3,byrow=TRUE)),
                       end.network=TRUE)

  expect_equal(as.matrix(gf, attrname="w"),
               matrix(c(0,1,1,0,
                        0,0,1,3,
                        1,0,0,0,
                        1,4,1,0),
                      4,4,
                      byrow=TRUE), ignore_attr=TRUE
               )
})


test_that("undirected valued ergm.godfather()", {
  gf <- ergm.godfather(nwu~nonzero+sum+transitiveweights(), response="w",
                       changes=list(matrix(c(1,2,1,
                                             2,3,0),
                                           ncol=3,byrow=TRUE),
                                    matrix(c(1,3,1,
                                             2,3,1),
                                           ncol=3,byrow=TRUE)))

  expect_equal(as.matrix(gf),
               matrix(c(3,6,0,
                        4,6,3),
                      ncol=3,byrow=TRUE), ignore_attr=TRUE)
})


test_that("undirected valued ergm.godfather() returning the network", {
  gf <- ergm.godfather(nwu~nonzero+sum+transitiveweights(), response="w",
                       changes=list(matrix(c(1,2,1,
                                             2,3,0),
                                           ncol=3,byrow=TRUE),
                                    matrix(c(1,3,1,
                                             2,3,1),
                                           ncol=3,byrow=TRUE)),
                       end.network=TRUE)

  expect_equal(as.matrix(gf, attrname="w"),
               matrix(c(0,1,1,0,
                        1,0,1,3,
                        1,1,0,0,
                        0,3,0,0),
                      4,4,
                      byrow=TRUE), ignore_attr=TRUE
               )
})