sourcelibs/Graphs/src/Graphs.xtl
1⍝# Graphs: graphs as adjacency matrices -- from edges, degrees,
2⍝# reachability, shortest paths, breadth-first levels, connected
3⍝# components.
4⍝# Import it with an alias of your choice: "g:" u_se< "Graphs".
5⍝# Put libs/Graphs/src on XETAL_PATH ("just path"); the reference is libs/Graphs/docs.
6⍝# Names with l: are exported; those under h: are private to this file.
7⍝#
8⍝# A graph of n nodes, numbered 1 to n, is an n by n matrix: item i j
9⍝# is 1 when there is an edge from i to j (or, for s_hortest, the
10⍝# edge's length, 0 meaning none). Walks are matrix products: with the
11⍝# inner product '| '& a step from every node at once, with 'm_in '+
12⍝# the shortest way through one more node.
13
14far ← 1000000000000.0 ⍝ the length of no path
15
16⍝## Building
17
18⍝# n a_djacency edges: the n by n matrix of the edges, given as 2 rows,
19⍝# from over to (directed).
20ˡa̲djacency ← { n e →
21 at ← (n × (f̲irst e) − 1) + f̲irst 1 d̲rop e ⍝ (from - 1) times n, plus to
22 0 + (n c̲at n) r̲eshape (r̲ange n × n) m̲ember? at ⍝ 0 + : as Ints
23}
24
25⍝# n w_eighted edges: the n by n matrix of edge lengths, given as 3
26⍝# rows, from over to over length (directed; 0 where there is no edge).
27ˡw̲eighted ← { n e →
28 at ← (n × (f̲irst e) − 1) + f̲irst 1 d̲rop e
29 len ← f̲irst 2 d̲rop e
30 (n c̲at n) r̲eshape '{ c → k ← w̲here at = c◆ 0 = t̲ally k ? 0◆ f̲irst (f̲irst k) s̲elect len } e̲ach r̲ange n × n
31}
32
33⍝# u_ndirected m: the graph with every edge going both ways.
34ˡu̲ndirected ← { m → m ∨ o̲\ m }
35
36⍝# o_utDegree m, i_nDegree m: how many edges leave and reach each node.
37ˡo̲utDegree ← { m → '+ r̲/₂ m }
38ˡi̲nDegree ← { m → '+ r̲/ m }
39
40⍝## Reachability
41
42⍝# Walks of length 1 to 2k: m with m times itself or-ed in, until it
43⍝# no longer grows.
44ʰc̲lose ← { m →
45 n ← m ∨ m '∨ '∧ i̲nner m
46 n m̲atch m ? m
47 ʰc̲lose n
48}
49
50⍝# r_each m: item i j is 1 when j can be reached from i by one or more
51⍝# edges (Warshall's transitive closure, by repeated squaring).
52ˡr̲each ← { m → ʰc̲lose 0 < m }
53
54⍝## Paths
55
56⍝# Min-plus products until the distances settle.
57ʰr̲elax ← { d →
58 e ← d 'm̲in '+ i̲nner d
59 e m̲atch d ? d
60 ʰr̲elax e
61}
62
63⍝# s_hortest w: the length of the shortest path from i to j, for edge
64⍝# lengths w (0 meaning no edge); 0 from a node to itself, -1 where
65⍝# there is no path (Floyd-Warshall by min-plus products).
66ˡs̲hortest ← { w →
67 n ← t̲ally w
68 i ← (r̲ange n) '= t̲able r̲ange n
69 d ← (f̲loat w) + far × f̲loat (w = 0) ∧ n̲ot i
70 r ← ʰr̲elax d
71 r − (f̲loat r ≥ far) × 1.0 + r ⍝ -1 where nothing reached
72}
73
74⍝## Levels and components
75
76⍝# The breadth-first frontier from seen nodes s, level by level.
77ʰb̲fs ← { m s f k lv →
78 0 = '+ r̲/ f ? lv
79 nxt ← (f '∨ '∧ i̲nner m) ∧ n̲ot s
80 ((((m ʰb̲fs s ∨ nxt)_ nxt)_ k + 1)_ lv + (k + 1) × nxt)
81}
82
83⍝# m l_evels s: how many edges from node s to each node (0 for s
84⍝# itself), -1 where it cannot be reached (breadth-first search).
85ˡl̲evels ← { m s →
86 (s < 1) ∨ s > t̲ally m ? @ p̲anic< "the graph's nodes are 1 to {t_ally m}: there is no node {s}"
87 n ← t̲ally m
88 start ← (r̲ange n) = s
89 lv ← ((((m ʰb̲fs start)_ start)_ 0)_ (r̲ange n) × 0)
90 lv − (lv = 0) ∧ n̲ot start
91}
92
93⍝# c_omponents m: each node's component, numbered 1, 2, ... in order of
94⍝# their least node (edges taken both ways).
95ˡc̲omponents ← { m →
96 n ← t̲ally m
97 r ← (ˡr̲each ˡu̲ndirected m) ∨ (r̲ange n) '= t̲able r̲ange n
98 first ← '{ i → f̲irst w̲here i s̲elect r } e̲ach r̲ange n
99 (u̲nique first) i̲ndexOf first
100}
p̲anic< expands to
(⎕P̲ANIC ("the graph's nodes are 1 to " c̲at (f̲ormat (t̲ally m)) c̲at ": there is no node " c̲at (f̲ormat (s))))