# File tests/testthat/test-networkLite.R in package tergm, 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 2008-2023 Statnet Commons
################################################################################
## run tests conditionally on availability of the networkLite package
if(require("networkLite")) {
test_that("network and networkLite simulate and summarize formulas equally in tergm", {
net_size <- 100
bip_size <- 40
ffdir <- ~nodemix(~a) + absdiff(~b) + odegrange(2) + idegrange(2) +
gwesp(cutoff = 100) + mean.age + edge.ages + nodemix.mean.age(~a) +
gwnsp(0.3, fixed = TRUE)
ffundir <- ~nodemix(~a) + absdiff(~b) + concurrent + gwesp(cutoff = 100) +
mean.age + edge.ages + nodemix.mean.age(~a) +
gwnsp(0.3, fixed = TRUE)
for(directed in list(FALSE, TRUE)) {
for(bipartite in list(FALSE, bip_size)) {
if(directed && bipartite) {
next
}
if (directed) {
ff <- ffdir
} else {
ff <- ffundir
}
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, 3)
set.seed(0)
nw_1 <- simulate(nw ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
set.seed(0)
nwL_1 <- simulate(nwL ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
expect_s3_class(nwL_1, "networkLite")
expect_equal(as.edgelist(nw_1), as.edgelist(nwL_1))
expect_identical(nw_1 %n% "lasttoggle", nwL_1 %n% "lasttoggle")
expect_identical(nw_1 %n% "time", nwL_1 %n% "time")
expect_identical(summary(ff, basis = nw_1),
summary(ff, basis = nwL_1))
set.seed(0)
nw_2 <- simulate(nw_1 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
set.seed(0)
nwL_2 <- simulate(nwL_1 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
expect_s3_class(nwL_2, "networkLite")
expect_equal(as.edgelist(nw_2), as.edgelist(nwL_2))
expect_identical(nw_2 %n% "lasttoggle", nwL_2 %n% "lasttoggle")
expect_identical(nw_2 %n% "time", nwL_2 %n% "time")
expect_identical(summary(ff, basis = nw_2),
summary(ff, basis = nwL_2))
set.seed(0)
nw_3 <- simulate(nw_2 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
set.seed(0)
nwL_3 <- simulate(nwL_2 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, output = "final", dynamic = TRUE)
expect_s3_class(nwL_3, "networkLite")
expect_equal(as.edgelist(nw_3), as.edgelist(nwL_3))
expect_identical(nw_3 %n% "lasttoggle", nwL_3 %n% "lasttoggle")
expect_identical(nw_3 %n% "time", nwL_3 %n% "time")
expect_identical(summary(ff, basis = nw_3),
summary(ff, basis = nwL_3))
set.seed(0)
nw_4 <- simulate(nw_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE)
set.seed(0)
nwL_4 <- simulate(nwL_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE)
# comparison of networkDynamics
expect_equal(nw_4, nwL_4)
## for completeness, also get stats and changes as output
set.seed(0)
s <- simulate(nw_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE, output = "stats", stats = TRUE,
monitor = if(directed) ~edges + idegree(0:10) + odegree(0:10) +
mean.age + Form(~odegree(0:2))
else ~edges + degree(0:10) + mean.age +
Form(~degree(0:2)))
set.seed(0)
sL <- simulate(nwL_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE, output = "stats", stats = TRUE,
monitor = if(directed) ~edges + idegree(0:10) + odegree(0:10) +
mean.age + Form(~odegree(0:2))
else ~edges + degree(0:10) + mean.age +
Form(~degree(0:2)))
# comparison of stats
expect_equal(s, sL)
set.seed(0)
c <- simulate(nw_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE, output = "changes")
set.seed(0)
cL <- simulate(nwL_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE, output = "changes")
# comparison of changes
expect_equal(c, cL)
# again, without lasttoggle
nw_3 %n% "lasttoggle" <- NULL
nwL_3 %n% "lasttoggle" <- NULL
set.seed(0)
nw_4 <- simulate(nw_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE)
set.seed(0)
nwL_4 <- simulate(nwL_3 ~ Form(~edges + nodefactor("a") + nodecov(~b^2 + b)) +
Persist(~edges),
coef = coef, dynamic = TRUE)
# comparison of networkDynamics
expect_equal(nw_4, nwL_4)
}
}
})
test_that("conversions between network, networkLite, and networkDynamic behave as expected with non-atomic attributes", {
logit <- function(p) log(p/(1-p))
nw <- network.initialize(100, directed = FALSE)
## set some arbitrary non-atomic vertex attribute
set.vertex.attribute(nw, "vertex_attr",
lapply(seq_len(network.size(nw)),
function(i) { runif(rbinom(1,10,0.5)) } ))
nw <- san(nw ~ edges, target.stats = c(100))
## set some arbitrary non-atomic edge attribute
set.edge.attribute(nw, "edge_attr",
lapply(seq_len(network.edgecount(nw)),
function(i) { list(runif(rbinom(1,10,0.5))) } ))
## edge activities will be non-atomic
nwD <- simulate(nw ~ edges, coef = c(logit(1/10)), dynamic = TRUE, time.slices = 100)
for (dynamic in list(FALSE, TRUE)) {
if (dynamic == FALSE) {
nw_base <- nw
nwL <- as.networkLite(nw_base)
nw_rebase <- to_network_networkLite(nwL)
} else {
nw_base <- nwD
nwL <- as.networkLite(nw_base)
nw_rebase <- as.networkDynamic(nwL)
}
expect_identical(as.edgelist(nw_base), as.edgelist(nwL))
expect_identical(as.edgelist(nwL), as.edgelist(nw_rebase))
expect_identical(list.vertex.attributes(nw_base), list.vertex.attributes(nwL))
expect_identical(list.vertex.attributes(nwL), list.vertex.attributes(nw_rebase))
expect_identical(list.edge.attributes(nw_base), list.edge.attributes(nwL))
expect_identical(list.edge.attributes(nwL), list.edge.attributes(nw_rebase))
expect_identical(setdiff(list.network.attributes(nw_base), "mnext"), list.network.attributes(nwL))
expect_identical(list.network.attributes(nwL), setdiff(list.network.attributes(nw_rebase), "mnext"))
for (attrname in list.vertex.attributes(nwL)) {
for (unlist in list(FALSE, TRUE)) {
expect_identical(get.vertex.attribute(nw_base, attrname, unlist = unlist),
get.vertex.attribute(nwL, attrname, unlist = unlist))
expect_identical(get.vertex.attribute(nwL, attrname, unlist = unlist),
get.vertex.attribute(nw_rebase, attrname, unlist = unlist))
}
}
## need to consistently order edges before comparing edge attributes
el <- as.edgelist(nwL)
eidsD <- unlist(get.dyads.eids(nw_base, el[,1], el[,2]))
eidsLD <- unlist(get.dyads.eids(nw_rebase, el[,1], el[,2]))
for (attrname in list.edge.attributes(nwL)) {
eaD <- get.edge.attribute(nw_base, attrname, null.na = FALSE, unlist = FALSE)[eidsD]
eaL <- get.edge.attribute(nwL, attrname, null.na = FALSE, unlist = FALSE)
eaLD <- get.edge.attribute(nw_rebase, attrname, null.na = FALSE, unlist = FALSE)[eidsLD]
expect_identical(eaD, eaL)
expect_identical(eaL, eaLD)
}
for (attrname in list.network.attributes(nwL)) {
expect_identical(get.network.attribute(nw_base, attrname),
get.network.attribute(nwL, attrname))
expect_identical(get.network.attribute(nwL, attrname),
get.network.attribute(nw_rebase, attrname))
}
}
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.