tests/testthat/test-networkLite.R

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

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

## tests are run conditionally on the availability of the networkLite package
if(require("networkLite")) {

  test_that("network and networkLite simulate and summarize formulas equally in ergm", {

    net_size <- 100
    bip_size <- 40

    ffdir <- ~nodemix(~a) + absdiff(~b) + odegrange(2) + idegrange(2) + gwesp +
              gwnsp(0.3, fixed=TRUE)
    ffundir <- ~nodemix(~a) + absdiff(~b) + concurrent + gwesp +
                gwnsp(0.3, fixed=TRUE)

    for(directed in list(FALSE, TRUE)) {
      for(bipartite in list(FALSE, bip_size)) {
        if(directed && bipartite) {
          next
        }

        set.seed(0)
        nw <- network.initialize(net_size, directed = directed,
                                 bipartite = bipartite)
        nw %v% "a" <- rep(letters[1:5], length.out = net_size)
        nw %v% "b" <- runif(net_size)

        nwL <- as.networkLite(nw)

        coef <- c(-4, 1, 1.5, 0.5, -1, 0.5)

        set.seed(0)
        nw_1 <- simulate(nw ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                         coef = coef, output = "network")
        set.seed(0)
        nwL_1 <- simulate(nwL ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                          coef = coef, output = "network")
        expect_s3_class(nwL_1, "networkLite")

        expect_equal(as.edgelist(nw_1), as.edgelist(nwL_1))
        if(directed) {
          expect_identical(summary(ffdir, basis = nw_1),
                           summary(ffdir, basis = nwL_1))
        } else {
          expect_identical(summary(ffundir, basis = nw_1),
                           summary(ffundir, basis = nwL_1))
        }

        set.seed(0)
        nw_2 <- simulate(nw_1 ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                         coef = coef, output = "network")
        set.seed(0)
        nwL_2 <- simulate(nwL_1 ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                          coef = coef, output = "network")
        expect_s3_class(nwL_2, "networkLite")

        expect_equal(as.edgelist(nw_2), as.edgelist(nwL_2))
        if(directed) {
          expect_identical(summary(ffdir, basis = nw_2),
                           summary(ffdir, basis = nwL_2))
        } else {
          expect_identical(summary(ffundir, basis = nw_2),
                           summary(ffundir, basis = nwL_2))
        }
      }
    }
  })

  test_that("network and networkLite simulate equally in san", {

    net_size <- 100
    bip_size <- 40

    ffdir <- ~nodemix(~a) + absdiff(~b) + odegrange(2) + idegrange(2) + gwesp +
              gwnsp(0.3, fixed=TRUE)
    ffundir <- ~nodemix(~a) + absdiff(~b) + concurrent + gwesp +
                gwnsp(0.3, fixed=TRUE)

    for(directed in list(FALSE, TRUE)) {
      for(bipartite in list(FALSE, bip_size)) {
        if(directed && bipartite) {
          next
        }

        set.seed(0)
        nw <- network.initialize(net_size, directed = directed,
                                 bipartite = bipartite)
        nw %v% "a" <- rep(letters[1:5], length.out = net_size)
        nw %v% "b" <- runif(net_size)

        nwL <- as.networkLite(nw)

        set.seed(0)
        nw_1 <- san(nw ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                    target.stats = c(1000, 500, 300, 200, 600, 1500))
        set.seed(0)
        nwL_1 <- san(nwL ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                     target.stats = c(1000, 500, 300, 200, 600, 1500))
        expect_s3_class(nwL_1, "networkLite")

        expect_equal(as.edgelist(nw_1), as.edgelist(nwL_1))
        if(directed) {
          expect_identical(summary(ffdir, basis = nw_1),
                           summary(ffdir, basis = nwL_1))
        } else {
          expect_identical(summary(ffundir, basis = nw_1),
                           summary(ffundir, basis = nwL_1))
        }

        set.seed(0)
        nw_2 <- san(nw_1 ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                    target.stats = c(800, 400, 200, 100, 600, 1200))
        set.seed(0)
        nwL_2 <- san(nwL_1 ~ edges + nodefactor("a") + nodecov(~b^2 + b),
                     target.stats = c(800, 400, 200, 100, 600, 1200))
        expect_s3_class(nwL_2, "networkLite")

        expect_equal(as.edgelist(nw_2), as.edgelist(nwL_2))
        if(directed) {
          expect_identical(summary(ffdir, basis = nw_2),
                           summary(ffdir, basis = nwL_2))
        } else {
          expect_identical(summary(ffundir, basis = nw_2),
                           summary(ffundir, basis = nwL_2))
        }
      }
    }
  })

  test_that("network and networkLite fit and simulate equal missing-data ergms", {

    net_size <- 50
    bip_size <- 20

    for(directed in list(FALSE, TRUE)) {
      for(bipartite in list(FALSE, bip_size)) {
        if(directed && bipartite) {
          next
        }
        if(directed) {
          ergm_formula <- ~edges + odegree(1) + absdiff("age")
        } else {
          ergm_formula <- ~edges + degree(1) + absdiff("age")
        }
        set.seed(0)
        nwL <- networkLite(net_size, directed = directed, bipartite = bipartite)
        nwL <- san(nwL ~ edges, target.stats = network.dyadcount(nwL)/10)
        nwL %v% "age" <- runif(net_size)
        na <- sample(c(FALSE,TRUE),network.edgecount(nwL),TRUE)

        set.seed(0)
        eL <- ergm(ergm_formula, basis = nwL,
                   control = list(MCMLE.effectiveSize = NULL))
        set.edge.attribute(nwL, "na", na)
        set.seed(0)
        eLna <- ergm(ergm_formula, basis = nwL,
                     control = list(MCMLE.effectiveSize = NULL))
        eL2 <- simulate(eLna)
        expect_s3_class(eL2, "networkLite")

        set.seed(0)
        nw <- network.initialize(net_size, directed = directed,
                                 bipartite = bipartite)
        nw <- san(nw ~ edges, target.stats = network.dyadcount(nw)/10)
        nw %v% "age" <- runif(net_size)
        na <- sample(c(FALSE,TRUE),network.edgecount(nw),TRUE)

        set.seed(0)
        e <- ergm(ergm_formula, basis = nw,
                  control = list(MCMLE.effectiveSize = NULL))
        set.edge.attribute(nw, "na", na)
        set.seed(0)
        ena <- ergm(ergm_formula, basis = nw,
                    control = list(MCMLE.effectiveSize = NULL))
        e2 <- simulate(ena)

        expect_equal(coef(e), coef(eL))
        expect_equal(coef(ena), coef(eLna))
        expect_equal(as.edgelist(e2), as.edgelist(eL2))
        expect_equal(as.edgelist(e2, attrname = "na"),
                     as.edgelist(eL2, attrname = "na"))
      }
    }
  })

  test_that("network and networkLite fit and simulate equal valued ergms", {

    net_size <- 50
    bip_size <- 20

    for(directed in list(FALSE, TRUE)) {
      for(bipartite in list(FALSE, bip_size)) {
        if(directed && bipartite) {
          next
        }

        set.seed(0)
        nwL <- networkLite(net_size, directed = directed,
                           bipartite = bipartite)
        nwL <- san(nwL ~ edges, target.stats = network.dyadcount(nwL))
        nwL %v% "age" <- runif(net_size)
        set.edge.attribute(nwL, "w", runif(network.edgecount(nwL)))
        eL <- ergm(nwL ~ absdiff("age"), response = "w", reference = ~Unif(0,1),
                   control = list(MCMLE.effectiveSize = NULL))
        eL2 <- simulate(eL)
        expect_s3_class(eL2, "networkLite")

        set.seed(0)
        nw <- network.initialize(net_size, directed = directed,
                                 bipartite = bipartite)
        nw <- san(nw ~ edges, target.stats = network.dyadcount(nw))
        nw %v% "age" <- runif(net_size)
        set.edge.attribute(nw, "w", runif(network.edgecount(nw)))
        e <- ergm(nw ~ absdiff("age"), response = "w", reference = ~Unif(0,1),
                  control = list(MCMLE.effectiveSize = NULL))
        e2 <- simulate(e)

        expect_equal(coef(e), coef(eL))
        expect_equal(as.edgelist(e2, attrname = "w"),
                     as.edgelist(eL2, attrname = "w"))
      }
    }
  })

}