There is a path from the node x to the node y if there exist a sequence (x,x1),(x1,x2),...,(xn,y)∈E:
: path? \ x y -- flag | E --
swap >zst zfence
begin zover zover ztuck subimage \ E s s s'
union zdup dup smember \ E s s" f
if drop zdrop zdrop zdrop true exit
then zswap zover zet= \ E s" s=s"
if drop zdrop zdrop false exit
then
again ;
To make a pair on zst-stack from two integers of the data stack:
: ipair \ m n -- | -- (m,n)
2>r ( 2r> ) ;
Find the set s of all nodes in (V,E) without incoming arrows:
: sourceset \ (V,E) -- s
unfence image diff ;
Find the set s of all nodes in (V,E) without outgoing arrows:
: sinkset \ (V,E) -- s
unfence coimage diff ;
The next word merge the set on top of zst into the set on top of the xst leaving the result in xst.
: xzmerge \ s --
xst zst setmove
zswap zetmerge \ swap to build from right
zst xst setmove ;
Given a directed graph (V,E), a topological sort is an ordered list including all the elements in V once, (x1,...xn), sorted so that if there is a path from xi to xj, then i<j. Such paths exist if and only if there are no directed cycles.
Kahn's algorithm, from Wikipedia. |
: toposort \ (V,E) -- s
0 >xst \ empty set in x
zdup sourceset zst yst setmove \ source nodes in y
unfence znip \ drop V keep E
begin yst@ \ while source nodes left
while ysplit yst> dup \ remove node m
zdup >zst zfence zdup xzmerge \ add m to the set in x
subimage \ set of all n: m→n
begin zst@ \ while that set non empty
while zsplit zst> zswap \ remove node n, E tos
2dup ipair zfence diff \ E:=E\{(m,n)}
dup zdup >zst zfence \ build set of all nodes..
subcoimage zst@ 0= \ ..pointing at n
if >yst yfence ymerge \ add n to y-set if empty
else drop \ else drop n
then zdrop zswap \ drop set, swap E back
repeat zdrop drop \ drop empty set and node m
repeat yst> drop zst@ zdrop \ drop empty set and E
if xst setdrop 0 >zst \ if |E|>0 flag with empty set
else xst zst setmove \ else move the x-set to zst
zst> 1- >zst \ mark it as an ordered list
then ;
A directed graph without directed cycles is called a dag (directed acyclic graph):
: dag? \ -- f | (V,E) --
toposort zst@ 0= 0= zdrop ;
A loop is an edge from a node to itself and loopset gives the edge set to a graph in which all edges are loops. Can be used to filtrate the loops from digraphs.
: loopset \ V -- E
{ foreach ?do ( zst> dup ) loop } ;
Generate a random pair of nodes:
: randpair \ |V| -- | -- (m,n)
dup random 1+ swap random 1+ ipair ;
Generate a random digraph with certain number of vertices and edges.
: rand-digraph \ |V| |E| -- | -- (V,E)
{ over 1+ 1 ?do i loop }
0 >zst
begin over rand-pair zfence union zdup cardinality over =
until 2drop
pair ;
{ foreach ?do ( zst> dup ) loop } ;
Generate a random pair of nodes:
: randpair \ |V| -- | -- (m,n)
dup random 1+ swap random 1+ ipair ;
Generate a random digraph with certain number of vertices and edges.
: rand-digraph \ |V| |E| -- | -- (V,E)
{ over 1+ 1 ?do i loop }
0 >zst
begin over rand-pair zfence union zdup cardinality over =
until 2drop
pair ;
: rand-noloop-digraph \ |V| |E| -- | -- (V,E)
{ over 1+ 1 ?do i loop }
0 >zst
begin over rand-pair zfence union
zover loopset diff
zdup cardinality over =
until 2drop pair ;
{ over 1+ 1 ?do i loop }
0 >zst
begin over rand-pair zfence union
zover loopset diff
zdup cardinality over =
until 2drop pair ;
: rand-acyclic-digraph \ m n -- | -- (V,E)
begin 2dup rand-noloop-digraph zdup dag? 0=
while zdrop
repeat 2drop ;
begin 2dup rand-noloop-digraph zdup dag? 0=
while zdrop
repeat 2drop ;
10 20 rand-noloop-digraph ok
zdup cr zet.
({1,2,3,4,5,6,7,8,9,10},{(5,2),(2,5),(10,3),(9,3),(9,10),(3,7),(4,10),(8,4),(3,8),(5,4),(3,6),(2,8),(6,10),(10,6),(7,6),(10,2),(7,4),(6,2),(3,9),(3,1)}) ok
toposort zet. 0 ok
Already the two first edges builds a directed loop.
10 20 rand-acyclic-digraph zdup cr zet.
({1,2,3,4,5,6,7,8,9,10},{(4,7),(1,10),(3,8),(4,8),(5,6),(8,2),(3,7),(2,10),(4,10),(2,6),(1,2),(9,2),(3,4),(7,2),(1,3),(1,7),(4,6),(9,4),(3,5),(5,4)}) ok
toposort zet. (9,1,3,5,4,7,8,2,6,10) ok
zdup cr zet.
({1,2,3,4,5,6,7,8,9,10},{(5,2),(2,5),(10,3),(9,3),(9,10),(3,7),(4,10),(8,4),(3,8),(5,4),(3,6),(2,8),(6,10),(10,6),(7,6),(10,2),(7,4),(6,2),(3,9),(3,1)}) ok
toposort zet. 0 ok
Already
10 20 rand-acyclic-digraph zdup cr zet.
({1,2,3,4,5,6,7,8,9,10},{(4,7),(1,10),(3,8),(4,8),(5,6),(8,2),(3,7),(2,10),(4,10),(2,6),(1,2),(9,2),(3,4),(7,2),(1,3),(1,7),(4,6),(9,4),(3,5),(5,4)}) ok
toposort zet. (9,1,3,5,4,7,8,2,6,10) ok