What this validates

These 50 networks are one synthetic organisational construct, regenerated 50 times with different random seeds. They are not 50 different organisations. The spread below is the seed-to-seed variation within a single structure. The question is a construction property: are the inputs to each index distinct rather than the same signal repeated, and do IOI and OSI measure different things. This is not a claim of field accuracy against real cases.

Nothing here uses the proprietary weighting or derivation. Every test reads the exported columns of targets.csv (the IOI inputs x1, x2, x3, the OSI inputs s1, s2, s3, s4, and the scored IOI, OSI) and is computed by the published packages car (VIF) and psych (Cronbach’s alpha).

1. Input distinctness (OECD/JRC Step 4)

The OECD/JRC Handbook, Step 4 (multivariate analysis), screens an index’s inputs three ways: the correlation among them, how many independent dimensions they span, and internal consistency (Cronbach’s alpha).

Statistic Median [min, max] across networks
Mean |input correlation| (Spearman) 0.39 [0.33, 0.49]
Worst |input correlation| 0.92 [0.87, 0.97]
IOI effective dimensionality (of 3) 2.34 [1.95, 2.77]
OSI effective dimensionality (of 4) 2.74 [2.50, 3.07]
Cronbach alpha, IOI block 0.71 [0.43, 0.80]
Cronbach alpha, OSI block 0.71 [0.66, 0.76]

Effective dimensionality near the input count means the inputs occupy separate directions. Cronbach’s alpha reads inversely here: these indexes are formative (their inputs are designed to be distinct, complementary dimensions, not interchangeable indicators of one trait), so the low-to-moderate alpha of 0.71 [0.43, 0.80] (IOI) and 0.71 [0.66, 0.76] (OSI) is the expected, corroborating result. A high alpha near 1 would warn the block was collapsing.

2. Variance inflation factor

VIF regresses each input on the others and reports 1 / (1 - R squared): 1 means the input carries its own signal, higher means more of it is recoverable from its block-mates (Belsley, Kuh & Welsch 1980; the 5 and 10 lines are heuristics, not cutoffs, O’Brien 2007). The chart shows each input’s VIF within its own index and pooled across both indexes, on a log scale. The gap between the two dots is the whole OEI argument.

Within its own index every input stays low (worst input IOI 1.93 [1.37, 3.18], OSI 1.93 [1.58, 3.14]), under the VIF 5 line in every regeneration: no input is redundant within its index. Pooled across both indexes the worst VIF rises to 52.95 [26.11, 94.14]. VIF thresholds assume one model, but IOI and OSI are separate indexes, so that jump measures shared input variance between them, which is why OEI is an aggregate of the two designed indexes rather than a separately engineered one.

3. Are IOI and OSI the same axis?

IOI and OSI rank people at Spearman 0.55 [0.14, 0.79]: related, because they share some inputs, but they order people differently enough that one is not the other in two hats. A second check, the overlap of the top five people by each index, agrees: a median of 3 of 5 shared.

4. Single-input sensitivity (OECD/JRC Step 7)

Step 7 (uncertainty and sensitivity) asks how much the result leans on any one input. The input-to-axis aggregation is not proprietary (only the upstream derivation of x*/s* is), so it is recovered openly with lm and reported: the fit confirms the assumed form reproduces the exported scores, after which each input is neutralised to its mean and the composite ranking is recomputed.

Across the 50 networks the assumed aggregation reproduces the exported scores at R squared 1.000 (median), so the perturbation runs on the right form. Neutralising any single input leaves the composite risk ranking at Spearman 0.894 or higher (median worst case): the index does not rest on one input. This is a first-order check; it does not capture interactions.

Verdict

Across 50 regenerations of one construct: within each index the inputs are non-redundant (worst input IOI 1.93 [1.37, 3.18], OSI 1.93 [1.58, 3.14], below the VIF 5 line in every run); IOI and OSI share some signal but rank people differently (median rank correlation 0.55, a median of 3 of 5 top people shared), not one index in two hats; OEI is an aggregate of the two; and no single input carries the composite ranking. These are construction properties, not a claim of field accuracy.

Scope

These analyses concern how the indexes are constructed, not whether they are correct about real people, and not whether the result holds across different organisational structures. Field accuracy on this subject matter (insider risk, individual opportunity) is client-confidential and cannot be a public artifact. That is a recognition of the problem’s nature, this effort is put forth in good faith to demonstrate the handling and seriousness the problem is afforded by Tessera Semita..

References

  • OECD & JRC (2008). Handbook on Constructing Composite Indicators. OECD Publishing. (Step 4 multivariate analysis; Step 7 uncertainty and sensitivity)
  • Belsley, D.A., Kuh, E. & Welsch, R.E. (1980). Regression Diagnostics. Wiley. (variance inflation factor)
  • O’Brien, R.M. (2007). A caution regarding rules of thumb for variance inflation factors. Quality & Quantity 41:673. (the VIF 5 / 10 heuristics)
  • Cronbach, L.J. (1951). Coefficient alpha and the internal structure of tests. Psychometrika 16:297.

Appendix: the code that produced every result

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

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

# Recognised, published implementations do the statistics: car::vif (variance
# inflation factor), psych::alpha (Cronbach's alpha); ggplot2 draws. Every number
# and figure is produced by the code in the Appendix, run against the published
# targets.csv files.
.need <- c("car", "psych", "ggplot2")
.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(car); library(psych); library(ggplot2)})

ts_navy <- "#0a1628"; ts_gold <- "#c4a265"; ts_stone <- "#8a8d91"
ts_text <- "#c8ccd0"; ts_dark <- "#060e1a"; ts_red <- "#c2553f"; ts_white <- "#e8eaed"
theme_tessera <- function(base = 13) {
  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.5),
          plot.caption = element_text(colour = ts_stone, size = base - 4, hjust = 0),
          legend.position = "top", legend.title = element_blank(),
          legend.text = element_text(colour = ts_text))
}

IOI_INPUTS <- c("x1", "x2", "x3"); OSI_INPUTS <- c("s1", "s2", "s3", "s4")
ALL_INPUTS <- c(IOI_INPUTS, OSI_INPUTS)
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()
read_internal <- function(p) {
  d <- read.csv(p, stringsAsFactors = FALSE)
  if ("boundary" %in% names(d)) d <- d[d$boundary == "internal", , drop = FALSE]
  d
}
nzc <- function(d, cols) cols[vapply(cols, function(c)
  is.numeric(d[[c]]) && sd(d[[c]], na.rm = TRUE) > 0, logical(1))]
# VIF per input via car::vif. VIF depends only on the predictor design matrix,
# not the response, so we read it off a model with a neutral response.
vif_each <- function(d, cols) {
  cc <- nzc(d, cols); out <- setNames(rep(NA_real_, length(cols)), cols)
  if (length(cc) < 2) return(out)
  d2 <- d[, cc, drop = FALSE]; d2$.y <- seq_len(nrow(d2))
  v <- tryCatch(car::vif(lm(reformulate(cc, response = ".y"), data = d2)),
                error = function(e) NULL)
  if (!is.null(v)) out[names(v)] <- v
  out
}
alpha_block <- function(d, cols) {
  cc <- nzc(d, cols); if (length(cc) < 2) return(NA_real_)
  suppressWarnings(tryCatch(
    psych::alpha(d[, cc, drop = FALSE], check.keys = FALSE, warnings = FALSE)$total$raw_alpha,
    error = function(e) NA_real_))
}
eff_dim <- function(d, cols) {
  cc <- nzc(d, cols); if (length(cc) < 2) return(NA_real_)
  lam <- sort(pmax(eigen(cor(d[, cc], method = "spearman"),
                         symmetric = TRUE, only.values = TRUE)$values, 0), decreasing = TRUE)
  tot <- sum(lam); if (tot <= 0) return(NA_real_); tot^2 / sum(lam^2)
}
screen <- function(d, cols) {
  cc <- nzc(d, cols); if (length(cc) < 2) return(c(NA_real_, NA_real_))
  m <- cor(d[, cc], method = "spearman"); off <- m[upper.tri(m)]
  c(mean(abs(off)), max(abs(off)))
}
topk_overlap <- function(d, k = 5) {
  if (!all(c("IOI", "OSI") %in% names(d))) return(NA_integer_)
  length(intersect(order(-d$IOI)[seq_len(k)], order(-d$OSI)[seq_len(k)]))
}
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)))]

within_mat <- pooled_mat <- matrix(NA_real_, length(nets), 7, dimnames = list(NULL, ALL_INPUTS))
rows <- vector("list", length(nets))
for (i in seq_along(nets)) {
  tp <- file.path(nets[i], "targets.csv"); if (!file.exists(tp)) next
  d <- read_internal(tp); if (!all(ALL_INPUTS %in% names(d))) next
  w <- c(vif_each(d, IOI_INPUTS), vif_each(d, OSI_INPUTS))
  p <- vif_each(d, ALL_INPUTS)
  within_mat[i, names(w)] <- w; pooled_mat[i, names(p)] <- p
  sc <- screen(d, ALL_INPUTS)
  rows[[i]] <- data.frame(
    ioi_vif = max(w[IOI_INPUTS], na.rm = TRUE), osi_vif = max(w[OSI_INPUTS], na.rm = TRUE),
    pooled_vif = max(p, na.rm = TRUE), mean_abs_corr = sc[1], max_abs_corr = sc[2],
    ioi_dim = eff_dim(d, IOI_INPUTS), osi_dim = eff_dim(d, OSI_INPUTS),
    alpha_ioi = alpha_block(d, IOI_INPUTS), alpha_osi = alpha_block(d, OSI_INPUTS),
    ioi_osi = if (sd(d$IOI) > 0 && sd(d$OSI) > 0) cor(d$IOI, d$OSI, method = "spearman") else NA_real_,
    overlap = topk_overlap(d, 5))
}
per <- do.call(rbind, rows); N <- nrow(per)
med <- function(x) median(x, na.rm = TRUE)
mr  <- function(x) sprintf("%.2f [%.2f, %.2f]", med(x), min(x, na.rm = TRUE), max(x, na.rm = TRUE))
vifw <- data.frame(input = ALL_INPUTS,
                   within = apply(within_mat, 2, med), pooled = apply(pooled_mat, 2, med),
                   index = c("IOI", "IOI", "IOI", "OSI", "OSI", "OSI", "OSI"))
knitr::kable(data.frame(
  Statistic = c("Mean |input correlation| (Spearman)", "Worst |input correlation|",
                "IOI effective dimensionality (of 3)", "OSI effective dimensionality (of 4)",
                "Cronbach alpha, IOI block", "Cronbach alpha, OSI block"),
  `Median [min, max] across networks` = c(
    mr(per$mean_abs_corr), mr(per$max_abs_corr), mr(per$ioi_dim), mr(per$osi_dim),
    mr(per$alpha_ioi), mr(per$alpha_osi)),
  check.names = FALSE))
dd <- rbind(data.frame(index = "IOI (of 3)", dim = per$ioi_dim),
            data.frame(index = "OSI (of 4)", dim = per$osi_dim))
ggplot(dd, aes(dim, index)) +
  geom_boxplot(fill = ts_navy, colour = ts_gold, outlier.colour = ts_stone, width = 0.5) +
  geom_jitter(height = 0.12, colour = ts_gold, alpha = 0.5, size = 1.3) +
  labs(title = "Independent dimensions each index's inputs span",
       subtitle = "participation ratio: near the input count = genuinely multidimensional; near 1 = one factor wearing hats",
       x = "effective dimensionality", y = NULL) +
  theme_tessera()
yl <- rev(ALL_INPUTS)
ggplot(vifw, aes(y = factor(input, levels = yl))) +
  geom_segment(aes(x = within, xend = pooled, yend = factor(input, levels = yl)),
               colour = ts_stone, linewidth = 0.6) +
  geom_vline(xintercept = c(5, 10), linetype = "dashed", colour = ts_red, alpha = 0.7) +
  annotate("text", x = 5, y = 7.4, label = "VIF 5", colour = ts_red, size = 3, hjust = 1.1) +
  annotate("text", x = 10, y = 7.4, label = "VIF 10", colour = ts_red, size = 3, hjust = -0.1) +
  geom_point(aes(x = within, colour = "within its own index"), size = 3.2) +
  geom_point(aes(x = pooled, colour = "pooled across both indexes"), size = 3.2) +
  scale_x_log10() +
  scale_colour_manual(values = c(`within its own index` = ts_gold,
                                 `pooled across both indexes` = ts_red)) +
  labs(title = "VIF: within each index vs pooled across both",
       subtitle = "median across 50 networks, log scale; the jump from gold to red is the shared variance between IOI and OSI",
       x = "VIF (log scale)", y = NULL) +
  theme_tessera()
ggplot(data.frame(r = per$ioi_osi), aes(r)) +
  geom_histogram(bins = 12, fill = ts_gold, colour = ts_dark) +
  geom_vline(xintercept = med(per$ioi_osi), colour = ts_red, linewidth = 1) +
  labs(title = "IOI vs OSI rank agreement across networks",
       subtitle = "Spearman rho: 0 = fully distinct, 1 = the same index twice",
       x = "Spearman rank correlation, IOI vs OSI", y = "networks") +
  theme_tessera()
ggplot(data.frame(o = per$overlap), aes(factor(o, levels = 0:5))) +
  geom_bar(fill = ts_gold, colour = ts_dark) +
  scale_x_discrete(drop = FALSE) +
  labs(title = "Do IOI and OSI flag the same top five people?",
       subtitle = "shared members of each index's top five, per network (5 = identical sets, 0 = disjoint)",
       x = "shared top-five members", y = "networks") +
  theme_tessera()
recover <- function(d, axis) lm(if (axis == "IOI")
  IOI ~ x1 + x2 + x3 + I(x1*x2) + I(x1*x3) + I(x2*x3) else
  OSI ~ s1 + s2 + s3 + s4 + I(s1*s2) + I(s1*s3) + I(s1*s4) + I(s2*s3) + I(s2*s4) + I(s3*s4),
  data = d)
loo <- lapply(nets, function(nd) {
  d <- read_internal(file.path(nd, "targets.csv"))
  if (!all(c(ALL_INPUTS, "IOI", "OSI") %in% names(d))) return(NULL)
  tryCatch({
    fi <- recover(d, "IOI"); fo <- recover(d, "OSI"); comp0 <- sqrt(pmax(d$IOI * d$OSI, 0))
    rhos <- vapply(ALL_INPUTS, function(c) {
      d2 <- d; d2[[c]] <- mean(d[[c]], na.rm = TRUE)
      if (c %in% IOI_INPUTS) { I1 <- predict(fi, d2); O1 <- d$OSI } else { O1 <- predict(fo, d2); I1 <- d$IOI }
      c1 <- sqrt(pmax(I1 * O1, 0)); if (sd(comp0) > 0 && sd(c1) > 0) cor(comp0, c1, method = "spearman") else NA_real_
    }, numeric(1))
    list(worst = min(rhos, na.rm = TRUE), r2 = min(summary(fi)$r.squared, summary(fo)$r.squared))
  }, error = function(e) NULL)
})
loo <- Filter(Negate(is.null), loo)
worst_rho <- vapply(loo, function(x) x$worst, numeric(1))
fit_r2    <- vapply(loo, function(x) x$r2, numeric(1))