## Tuesday, February 23, 2016

### Directed graphs

A relation (V,V,E) is equivalent with a directed graph (V,E), where E⊆V×V is the set of edges and V is the set of vertices.

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 ;

: 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 ;

: rand-acyclic-digraph \ m n -- | -- (V,E)
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