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