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

## No comments:

## Post a Comment