Supply Chain Network Analysis Dashboard

Network Topology Map

R Code

# ── Network topology visualization with igraph ──
library(igraph)
library(ggraph)
library(tidygraph)

# Create graph from edge list
g <- graph_from_data_frame(edges, directed = TRUE, vertices = nodes)

# Assign tier-based layout (left-to-right)
V(g)$tier_x <- match(V(g)$tier, c("Raw","Component","Manufacturer","Distribution","Market"))
layout_mat <- cbind(V(g)$tier_x, V(g)$tier_y)

# Plot with ggraph
ggraph(g, layout = layout_mat) +
  geom_edge_link(arrow = arrow(length = unit(2, "mm")),
                  color = "#999", alpha = 0.5) +
  geom_node_point(aes(color = tier, size = betweenness)) +
  geom_node_text(aes(label = name), size = 2.5, repel = TRUE) +
  scale_color_manual(values = tier_colors) +
  theme_void()

Betweenness Centrality Ranking

R Code

# ── Betweenness centrality ──
V(g)$betweenness <- betweenness(g, directed = TRUE)

# Rank and plot
btw_df <- data.frame(
  node = V(g)$name,
  tier = V(g)$tier,
  btw  = V(g)$betweenness
) |> arrange(desc(btw))

ggplot(btw_df, aes(x = reorder(node, btw), y = btw, fill = tier)) +
  geom_col() +
  geom_hline(yintercept = 20, linetype = "dashed", color = "#C0392B") +
  coord_flip() +
  scale_fill_manual(values = tier_colors) +
  theme_minimal()

Degree Analysis

R Code

# ── Degree analysis ──
degree_df <- data.frame(
  node       = V(g)$name,
  tier       = V(g)$tier,
  in_degree  = degree(g, mode = "in"),
  out_degree = degree(g, mode = "out"),
  total      = degree(g, mode = "all"),
  btw        = betweenness(g, directed = TRUE)
) |> arrange(desc(btw))

Disruption Scenario: Mfg-3 Removal

Paths Before

Paths After

Paths Lost

Impact

21%

Affected Downstream Nodes

DC-1DC-3Market-1Market-3Market-4Market-5

R Code

# ── Disruption impact analysis ──
# Count all simple paths from Raw tier to Market tier
raw_nodes <- V(g)[tier == "Raw"]
mkt_nodes <- V(g)[tier == "Market"]

paths_before <- length(all_simple_paths(g, from = raw_nodes, to = mkt_nodes))

# Remove Mfg-3 and recount
g_disrupted <- delete_vertices(g, "Mfg-3")
paths_after <- length(all_simple_paths(g_disrupted, from = raw_nodes, to = mkt_nodes))

paths_lost <- paths_before - paths_after
pct_impact <- paths_lost / paths_before * 100

# Identify affected downstream nodes
downstream <- subcomponent(g, "Mfg-3", mode = "out")
cat("Affected nodes:", V(g)[downstream]$name)

Community Structure (Louvain)

Inter-Cluster Connectivity

R Code

# ── Community detection (Louvain) ──
# Convert to undirected for community detection
g_undir <- as.undirected(g, mode = "collapse")
communities <- cluster_louvain(g_undir)

# Examine membership
membership(communities)
sizes(communities)
modularity(communities)

# Inter-cluster connectivity matrix
crossing_edges <- crossing(communities, g_undir)
# Tabulate edges between each cluster pair

Tier Summary

Tier Comparison

R Code

# ── Tier-level summary statistics ──
tier_summary <- nodes_df |>
  group_by(tier) |>
  summarise(
    n_nodes   = n(),
    avg_deg   = mean(degree),
    avg_btw   = mean(betweenness),
    max_btw   = max(betweenness),
    .groups   = "drop"
  )

# Small multiples bar chart
ggplot(tier_summary, aes(x = tier, y = avg_btw, fill = tier)) +
  geom_col() +
  facet_wrap(~metric, scales = "free_y") +
  theme_minimal()

Risk Heat Map

R Code

# ── Multi-dimensional risk scoring ──
risk_df <- nodes_df |>
  mutate(
    risk_btw = case_when(
      betweenness >= 25 ~ "High",
      betweenness >= 10 ~ "Medium",
      TRUE ~ "Low"
    ),
    risk_single = case_when(
      in_degree <= 1 & tier != "Raw" ~ "High",
      in_degree == 2 ~ "Medium",
      TRUE ~ "Low"
    ),
    risk_cluster = case_when(
      cluster_size <= 2 ~ "High",
      cluster_size <= 4 ~ "Medium",
      TRUE ~ "Low"
    )
  )