tests/testthat/test-model.R

In ernm: Exponential-Family Random Network Models

# Tests for model fitting that may reveal problems with the some part of the fitting procedure
context("model tests")

library(testthat)
library(network)
library(ernm)
data("samplike")

test_that("models", {
    
    # make undirected for ease:
    adj_matrix <- as.matrix(samplike, matrix.type = "adjacency")
    undirected_adj_matrix <- adj_matrix | t(adj_matrix)
    undirected_net <- network(undirected_adj_matrix, directed = FALSE)
    set.vertex.attribute(undirected_net, "cloisterville ", samplike %v% 'cloisterville ')
    set.vertex.attribute(undirected_net, "group", samplike %v% 'group')
    samplike_undir <- undirected_net
    
    # Display the undirected network
    samplike <- as.network(samplike_undir, directed = FALSE)
    
    # Test MRF version of ERNM
    MRF <- ernm(samplike_undir ~ edges + homophily("group") + logisticNeighbors('group','group','Loyal') | group,
                tapered = FALSE,
                verbose = FALSE)
    
    # Test ERGM verision of ERNM
    ERGM <- ernm(samplike_undir ~ edges + gwesp(0.5) + gwdegree(0.5) + homophily("group") + logisticNeighbors('group','group','Loyal'),
                 tapered = FALSE,
                 verbose = FALSE)
    
    # Test ERNM
    t_1 <- proc.time()[3]
    ERNM <- ernm(samplike_undir ~ edges + gwesp(0.5) + gwdegree(0.5) + homophily("group") + logisticNeighbors('group','group','Loyal') | group,
                 tapered = FALSE,
                 verbose = FALSE)
    t_1 <- proc.time()[3] - t_1
    
    # Test tapered ERNM:
    ERNM_formula <- as.formula("samplike_undir ~edges + gwesp(0.5) + gwdegree(0.5) + homophily('group') + logisticNeighbors('group','group','Loyal') | group")
    stats <- ernm::calculateStatistics(ERNM_formula)
    t_2 <- proc.time()[3]
    ERNM_tapered_1 <- ernm(ERNM_formula,
                           tapered = TRUE,
                           modelArgs = list(tau = 1 / (3^2 * (stats + 5)),
                                            centers = stats,
                                            modelClass = 'TaperedModel'),
                           verbose = FALSE)
    t_2 <- proc.time()[3] - t_2
    
    # Test tapered ERNM:
    # more tapering needed here
    ERNM_formula <- as.formula("samplike_undir ~ edges + triangles() + star(2) + homophily('group') + logisticNeighbors('group','group','Loyal') | group")
    stats <- ernm::calculateStatistics(ERNM_formula)
    ERNM_tapered_2 <- ernm(ERNM_formula,
                           tapered = TRUE,
                           modelArgs = list(tau = 1 / (2 * (stats + 5)),
                                            centers = stats,
                                            modelClass = 'TaperedModel'),
                           verbose = FALSE)
    
    
    # All models should converge
    testthat::expect_true(ERGM$converged)
    testthat::expect_true(MRF$converged)
    testthat::expect_true(ERNM$converged)
    testthat::expect_true(ERNM_tapered_1$converged)
    testthat::expect_true(ERNM_tapered_2$converged)
}
)