tests/testthat/test-term-project.R

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

#  File tests/testthat/test-term-project.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-2025 Statnet Commons
################################################################################
n <- 20
b <- 5

nw0 <- network.initialize(n, bipartite = b, directed = FALSE)
nw0 %v% "b1" <- c(rnorm(b), rep(NA, n-b))
nw0 %v% "b2" <- c(rep(NA, b), rnorm(n-b))
nw1 <- simulate(nw0 ~ edges, coef = 0)
nw2 <- simulate(nw0 ~ edges, coef = 0)
m1 <- as.matrix(nw1)
m2 <- as.matrix(nw2)

nw1.absdiff.b1 <- sum(abs(outer(na.omit(nw1 %v% "b1"), na.omit(nw1 %v% "b1"), FUN = "-")) * tcrossprod(m1))/2
nw1.absdiff.b2 <- sum(abs(outer(na.omit(nw1 %v% "b2"), na.omit(nw1 %v% "b2"), FUN = "-")) * crossprod(m1))/2
nw2.absdiff.b1 <- sum(abs(outer(na.omit(nw2 %v% "b1"), na.omit(nw2 %v% "b1"), FUN = "-")) * tcrossprod(m2))/2
nw2.absdiff.b2 <- sum(abs(outer(na.omit(nw2 %v% "b2"), na.omit(nw2 %v% "b2"), FUN = "-")) * crossprod(m2))/2

f <- nw1 ~ Project(~ absdiff("b1"), 1) + Proj1(~absdiff("b1")) + Project(~absdiff("b2"), 2) + Proj2(~absdiff("b2"))

test_that("Projection(), Proj1(), and Proj2() summary", {
  expect_equal(summary(f),
               c(`Proj1~absdiff.sum.b1` = nw1.absdiff.b1, `Proj1~absdiff.sum.b1` = nw1.absdiff.b1,
                 `Proj2~absdiff.sum.b2` = nw1.absdiff.b2, `Proj2~absdiff.sum.b2` = nw1.absdiff.b2))
})

test_that("Projection(), Proj1(), and Proj2() change", {
  changes <- as.matrix(xor(nw1, nw2), matrix.type = "edgelist")
  expect_equal(c(ergm.godfather(f, changes = changes)),
               rep(c(nw2.absdiff.b1, nw2.absdiff.b2), each = 2))
})