What this validates, and what it does not

This test asks whether the networks the model generates behave like real human organisations, measured against published structural signatures. It is a realism test, not an accuracy test: structural realism means the substrate is built like a real human network.

How these networks are made. Each network is produced by a generative agent-based model calibrated to documented social mechanisms: preference-based tie formation across behavioural dimensions, venue co-attendance, coworker-seeded referral that co-evolves with the graph, and host introductions. The networks are not hand-drawn and not resampled from one template. The question is whether that calibrated generator reproduces the signatures of real human networks across its 50 seed-to-seed regenerations. The statistics are computed by igraph and sna (cug.test); the full code is available for review in the Appendix.

1. What each fingerprint means

In plain terms Structural measure What it captures Real-network band
Cliquishness Mean local clustering how often two of someone’s contacts also know each other 0.15 to 0.60
Small-world Clustering vs Erdos-Renyi random how many times more clustered than a random network of the same density at least 3.00
Community structure Modularity (Louvain) whether the network splits into distinct, tightly-knit groups at least 0.30
Like connects to like Degree assortativity whether well-connected people tend to connect to other well-connected people 0.12 to 0.36

The band for each signature is the range documented for real human and organisational networks, and each cites its source:

Signature Source
Mean local clustering Empirical range across real benchmark social/organisational networks
Clustering vs Erdos-Renyi random Watts & Strogatz (1998), Nature 393:440 (clustering far above the ER reference C_rand = density)
Modularity (Louvain) Newman & Girvan (2004), Phys. Rev. E 69:026113 (Q above ~0.3 = real community structure)
Degree assortativity Newman (2002), Phys. Rev. Lett. 89:208701 (social networks mix assortatively by degree)

2. Where the generated networks land

Each row is one signature: the shaded band is the documented real-network range, and each gold dot is one of the 50 generated networks. The count is how many fall inside the published range.

3. Is the structure earned, or just chance? (CUG suite)

A single CUG test on one statistic is not a fair test, so we opted to run the whole battery of CUG tests across four statistics that capture different aspects of structure. For each network the suite holds the edge count fixed and regenerates the graph 200 times at random (a uniform G(n,m) null), recomputing four graph-level indices each time: clustering, and the concentration of degree, betweenness, and closeness centrality. The grey distribution is the pooled random null across all 50 networks; the gold marks are where the generated networks actually land.

Statistic Generated (median) Random null (median) SD above null Above null (p<0.05)
Transitivity 0.245 0.075 17 50 of 50
Degree centralization 0.122 0.047 8 50 of 50
Betweenness centralization 0.062 0.019 8 50 of 50
Closeness centralization 0.289 0.112 9 50 of 50

Every index sits far above its random null across all 50 networks. A uniform random graph of the same size and density reproduces none of them, so the structure is a property of how the networks are built instead of a density artifact.

Verdict

Across 50 seed-to-seed regenerations, the generated social networks hold the documented real-network signatures: cliquishness in band in 50 of 50, small-world in 50 of 50, community structure in 50 of 50, and like-connects-to-like in 49 of 50. The CUG suite confirms the structure is non-random across clustering and the concentration of degree, betweenness, and closeness centrality, in every network. The substrate is structurally realistic. This is a statement about structure, not a claim of field accuracy about any individual.

Scope

Structural realism is far from a verdict, consider it more akin to a substrate. It says the networks are built in a manner that passes tests the same way real human networks do. The use of synthetic netoworks is done because publishing real networks would violate client-confidential on this subject matter (insider risk, individual opportunity) and cannot be a public artifact but we do need to demonstrate methodological rigor in downstream testing and synthetic generation is the best available alternative. That being said, this is a recognition of the problem’s nature, not a dismissal of this methods applicability for down stream evaluations. This effort is put forth in good faith to demonstrate the handling and seriousness the problem is afforded by Tessera Semita.

References

  • Watts, D.J. & Strogatz, S.H. (1998). Collective dynamics of small-world networks. Nature 393:440.
  • Newman, M.E.J. (2002). Assortative mixing in networks. Phys. Rev. Lett. 89:208701.
  • Newman, M.E.J. & Girvan, M. (2004). Finding and evaluating community structure in networks. Phys. Rev. E 69:026113.
  • Butts, C.T. (2008). Social network analysis with sna. J. Stat. Soft. 24(6). (the conditional uniform graph test)

Appendix: the code that produced every result

Every number and figure above is produced by exactly the following code, run against the published validation_networks/*/adj_social.csv files. Nothing is entered by hand. Set the working directory to the project root (or this folder) and knit to reproduce it.

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE,
                      fig.align = "center", dev = "png", dpi = 150)

# Recognised packages do the work: igraph (structural fingerprint), sna::cug.test
# (Butts/statnet, the conditional uniform graph test), ggplot2 + patchwork (charts).
.need <- c("igraph", "sna", "ggplot2", "patchwork")
.miss <- .need[!vapply(.need, requireNamespace, logical(1), quietly = TRUE)]
if (length(.miss))
  stop("Install required packages: install.packages(c(",
       paste(sprintf('"%s"', .miss), collapse = ", "), "))")
suppressMessages({library(igraph); library(ggplot2); library(patchwork)})

ts_navy <- "#0a1628"; ts_gold <- "#c4a265"; ts_stone <- "#8a8d91"
ts_text <- "#c8ccd0"; ts_dark <- "#060e1a"; ts_red <- "#c2553f"
ts_white <- "#e8eaed"; ts_green <- "#6f9a4e"
theme_tessera <- function(base = 12) {
  theme_minimal(base_size = base) +
    theme(plot.background  = element_rect(fill = ts_dark, colour = NA),
          panel.background = element_rect(fill = ts_dark, colour = NA),
          panel.grid.major = element_line(colour = "#16222f", linewidth = 0.3),
          panel.grid.minor = element_blank(),
          text = element_text(colour = ts_text), axis.text = element_text(colour = ts_stone),
          plot.title = element_text(colour = ts_white, face = "bold"),
          plot.subtitle = element_text(colour = ts_stone, size = base - 2),
          plot.caption = element_text(colour = ts_stone, size = base - 3.5, hjust = 0),
          strip.text = element_text(colour = ts_white, face = "bold"),
          legend.position = "top", legend.title = element_blank(),
          legend.text = element_text(colour = ts_text))
}

proj_root <- function() {
  d <- normalizePath(getwd(), winslash = "/", mustWork = FALSE)
  for (i in 1:8) { if (dir.exists(file.path(d, "validation_networks"))) return(d)
    p <- dirname(d); if (identical(p, d)) break; d <- p }
  stop("Could not find 'validation_networks'. Set the working directory to the project root.")
}
ROOT <- proj_root()
REPS <- 200   # null replicates per network per CUG statistic (a few-minute render)
# Each structural signature, with a lay name, the technical name, the sourced
# acceptance band, and a one-line plain-English meaning. This is a standardised
# test, so every band states where its threshold comes from.
SIGS <- list(
  list(key = "mean_clustering", lay = "Cliquishness", tech = "Mean local clustering",
       band = c(0.15, 0.60), mean = "how often two of someone's contacts also know each other",
       src = "Empirical range across real benchmark social/organisational networks"),
  list(key = "clustering_vs_random", lay = "Small-world", tech = "Clustering vs Erdos-Renyi random",
       band = c(3, Inf), mean = "how many times more clustered than a random network of the same density",
       src = "Watts & Strogatz (1998), Nature 393:440 (clustering far above the ER reference C_rand = density)"),
  list(key = "modularity", lay = "Community structure", tech = "Modularity (Louvain)",
       band = c(0.30, Inf), mean = "whether the network splits into distinct, tightly-knit groups",
       src = "Newman & Girvan (2004), Phys. Rev. E 69:026113 (Q above ~0.3 = real community structure)"),
  list(key = "assortativity", lay = "Like connects to like", tech = "Degree assortativity",
       band = c(0.12, 0.36), mean = "whether well-connected people tend to connect to other well-connected people",
       src = "Newman (2002), Phys. Rev. Lett. 89:208701 (social networks mix assortatively by degree)"))
KEYS <- vapply(SIGS, `[[`, "", "key")
BAND <- setNames(lapply(SIGS, `[[`, "band"), KEYS)
in_band <- function(v, b) v >= b[1] & v <= b[2]
read_A <- function(p) {
  A <- as.matrix(read.csv(p, row.names = 1, check.names = FALSE))
  A <- (A > 0) * 1; diag(A) <- 0; A
}
# igraph structural fingerprint (for the bands). The small-world ratio uses the
# Watts-Strogatz Erdos-Renyi reference: C_rand = the ER expected clustering = density.
fingerprint <- function(A) {
  g <- igraph::graph_from_adjacency_matrix(A, mode = "max", diag = FALSE)
  Cobs <- igraph::transitivity(g, type = "localaverage")
  c(mean_clustering = Cobs,
    clustering_vs_random = Cobs / igraph::edge_density(g),
    modularity = suppressWarnings(igraph::modularity(igraph::cluster_louvain(g))),
    assortativity = suppressWarnings(igraph::assortativity_degree(g)))
}
# The CUG suite: four graph-level indices, each vs a uniform null that holds the
# edge count fixed (a G(n,m) null), via sna::cug.test. One test is not a fair test,
# so the whole battery runs. Closeness uses suminvundir (defined on disconnected graphs).
CUG_STATS <- list(
  "Transitivity"               = list(FUN = sna::gtrans,         args = list(mode = "graph")),
  "Degree centralization"      = list(FUN = sna::centralization, args = list(FUN = sna::degree, mode = "graph")),
  "Betweenness centralization" = list(FUN = sna::centralization, args = list(FUN = sna::betweenness, mode = "graph")),
  "Closeness centralization"   = list(FUN = sna::centralization, args = list(FUN = sna::closeness, mode = "graph", cmode = "suminvundir")))
cug_one <- function(A, s)
  do.call(sna::cug.test, list(dat = A, FUN = s$FUN, cmode = "edges", reps = REPS, FUN.args = s$args))

nets <- list.dirs(file.path(ROOT, "validation_networks"), recursive = FALSE, full.names = TRUE)
nets <- nets[grepl("/[0-9]+$", nets)]; nets <- nets[order(as.integer(basename(nets)))]
nets <- nets[file.exists(file.path(nets, "adj_social.csv"))]
set.seed(1)
fp <- lapply(nets, function(nd) {
  A <- read_A(file.path(nd, "adj_social.csv"))
  list(fp = fingerprint(A),
       cug = lapply(CUG_STATS, function(s) { ct <- cug_one(A, s)
         list(obs = ct$obs.stat, null = ct$rep.stat, p = ct$pgteobs) }))
})
M <- as.data.frame(do.call(rbind, lapply(fp, `[[`, "fp")))
N <- nrow(M)
hits <- sapply(KEYS, function(k) sum(in_band(M[[k]], BAND[[k]]), na.rm = TRUE))
med <- function(x) median(x, na.rm = TRUE)

cug_agg <- lapply(names(CUG_STATS), function(st) {
  obs <- sapply(fp, function(x) x$cug[[st]]$obs)
  null <- unlist(lapply(fp, function(x) x$cug[[st]]$null))
  ps  <- sapply(fp, function(x) x$cug[[st]]$p)
  list(stat = st, obs = obs, null = null,
       z = (mean(obs) - mean(null)) / sd(null), above = sum(ps < 0.05, na.rm = TRUE))
})
names(cug_agg) <- names(CUG_STATS)
knitr::kable(data.frame(
  `In plain terms` = vapply(SIGS, `[[`, "", "lay"),
  `Structural measure` = vapply(SIGS, `[[`, "", "tech"),
  `What it captures` = vapply(SIGS, `[[`, "", "mean"),
  `Real-network band` = vapply(SIGS, function(s)
    if (is.infinite(s$band[2])) sprintf("at least %.2f", s$band[1])
    else sprintf("%.2f to %.2f", s$band[1], s$band[2]), ""),
  check.names = FALSE))
knitr::kable(data.frame(Signature = vapply(SIGS, `[[`, "", "tech"),
                        Source = vapply(SIGS, `[[`, "", "src"), check.names = FALSE))
band_strip <- function(s) {
  v <- M[[s$key]]; b <- s$band
  xmax <- if (is.infinite(b[2])) max(v) * 1.05 else b[2]
  inb  <- sum(in_band(v, b), na.rm = TRUE)
  ggplot(data.frame(v = v), aes(v, 0)) +
    annotate("rect", xmin = b[1], xmax = xmax, ymin = -1, ymax = 1,
             fill = ts_green, alpha = 0.16) +
    geom_vline(xintercept = b[is.finite(b)], colour = ts_green, linetype = "dashed") +
    geom_jitter(height = 0.55, width = 0, colour = ts_gold, alpha = 0.8, size = 1.7) +
    scale_y_continuous(limits = c(-1.3, 1.3), breaks = NULL) +
    labs(title = s$lay,
         subtitle = sprintf("%s  -  %d of %d in band", s$tech, inb, length(v)),
         x = NULL, y = NULL) +
    theme_tessera(11)
}
Reduce(`/`, lapply(SIGS, band_strip))
nulldf <- do.call(rbind, lapply(cug_agg, function(a)
  data.frame(stat = a$stat, value = a$null)))
obsdf <- do.call(rbind, lapply(cug_agg, function(a)
  data.frame(stat = a$stat, value = a$obs)))
labdf <- do.call(rbind, lapply(cug_agg, function(a)
  data.frame(stat = a$stat, lab = sprintf("%.0f SD above random", a$z),
             x = -Inf, y = Inf)))
ggplot(nulldf, aes(value)) +
  geom_histogram(bins = 40, fill = ts_stone, alpha = 0.55, colour = NA) +
  geom_rug(data = obsdf, aes(value), colour = ts_gold, length = unit(0.06, "npc")) +
  geom_vline(data = aggregate(value ~ stat, obsdf, mean), aes(xintercept = value),
             colour = ts_gold, linewidth = 0.9) +
  geom_text(data = labdf, aes(x, y, label = lab), colour = ts_white, size = 3.2,
            hjust = -0.05, vjust = 1.6, inherit.aes = FALSE) +
  facet_wrap(~ stat, scales = "free", ncol = 2) +
  labs(title = "Generated networks vs a same-density random null",
       subtitle = "grey = pooled random null; gold marks and line = the generated networks",
       x = NULL, y = "density") +
  theme_tessera()
knitr::kable(data.frame(
  Statistic = names(cug_agg),
  `Generated (median)`  = sapply(cug_agg, function(a) sprintf("%.3f", median(a$obs))),
  `Random null (median)`= sapply(cug_agg, function(a) sprintf("%.3f", median(a$null))),
  `SD above null`       = sapply(cug_agg, function(a) sprintf("%.0f", a$z)),
  `Above null (p<0.05)` = sapply(cug_agg, function(a) sprintf("%d of %d", a$above, N)),
  check.names = FALSE, row.names = NULL))