## Saturday, May 14, 2016

### Simple graphs

The idea of using stacks for sets is not a bad idea - in my opinion. Besides from the simplified garbage collecton there is the benefit that the data can be accessed in arrays (in the stacks), which at least can be used to define some fast primitive routines. The set routines are not slow. When enumerating all the cards in a deck from 0 to 51, Zet can calculate the set of all 1326 possible hold cards in Texas hold´em poker in a few hundredths of a second. On my Android:

{ 0 52 | all } utime 2 power# utime 2swap d- cr d. cardinality cr .

29099
1326

Here utime counts in μs.

Formally a simple graph is a set of vertices V and a subset of all unordered pairs of vertices E. Visually, a simple graph is a collection of verticies joined by zero or one edges and which consist no loops.

A subgraph (V,E) of a simple graph (V',E') is a graph such that V is a subset of V' and E of E'.

: subgraph \ -- flag | (V,E) (V',E') --

unfence zrot unfence
zrot subset
zswap subset and ;

There is a maximal subgraph for each subset V generated by E'.

\ E = intersection of E' and power#(2,V)

: edges~ \ E' V -- E
2 power# intersection ;

But this straightforward implementation is inefficient. About 20 times faster is:

: edges \ E' V -- E

0 >xst
zst yst setmove
foreach \ {u,v}∈E'
?do zdup unfence yzcopy1 member
if yzcopy1 member
if zfence xzmerge
else zdrop
then
else zst> drop zdrop
then
loop yst setdrop xst zst setmove ;

To make a random simple graph with v vertices and with an edge between two vertices in m cases of n:

: randgraph \ m n v -- | -- (V,E)

loc{ m n v }
0 >xst
{ v 0 do i 1+ loop }
zdup 2 power# foreach \ {u,v}
do n random m <
if zfence xzmerge
else zdrop
then
loop xst zst setmove pair ;

The word extend creates a superset to the graph created by edges where all edges connected to V is submitted plus all edges connected to the submitted points.

\ V={x∈V'|y∈V" & {x,y}∈E'}

\ E={{x,y}∈E'|x∈V & y∈V}
: extend \ E' V" -- (V,E)
zswap zst yst setmove
zst xst setcopy
foreach \ v∈V"
do zst> yzcopy1
begin zst@
while zsplit zdup dup smember
if xzmerge
else zdrop
then
repeat zet> 2drop
loop xst zst setmove
set-sort reduce
yst zst setmove
zover edges pair ;

Counts all isolated points in a graph:

: isolated-vertices# \ -- n | (V,E) --
unfence 0 dup loc{ flag }
zst yst setmove
foreach
do zst> yzcopy1 true to flag
begin zst@ flag and
while zsplit dup smember 0= to flag
repeat zdrop drop flag -
loop yst zst setmove zdrop ;

4 5 9 randgraph zdup cr zet.

({1,2,3,4,5,6,7,8,9},{{8,9},{7,9},{6,9},{5,9},{4,9},{3,9},{2,9},{1,9},{6,8},{4,8},{1,8},{6,7},{5,7},{3,7},{2,7},{1,7},{5,6},{4,6},{3,6},{2,6},{1,6},{4,5},{3,5},{2,5},{3,4},{2,4},{1,4},{1,3}}) ok

isolated-vertices# . 0  ok

Counts all isolated components in a graph:

: components# \ -- n | (V,E) --
zdup 0 >xst
unfence
znip zst yst setcopy
foreach
do begin yzcopy1 zover
extend unfence zdrop ztuck zet=
until zfence xzmerge
loop yst setdrop
xst zst setmove reduce cardinality
isolated-vertices# + ;

Due to the formula for vertices, edges and components for a forest, that is, a graph without circuits, v=e+c:

: forest? \ -- flag | (V,E) --

zdup unfence
cardinality \ e
cardinality \ v
components# \ c
rot + = ;

4 5 9 randgraph zdup cr zet.
({1,2,3,4,5,6,7,8,9},{{7,9},{6,9},{5,9},{4,9},{3,9},{2,9},{6,8},{5,8},{4,8},{3,8},{2,8},{1,8},{5,7},{4,7},{3,7},{1,7},{5,6},{4,6},{3,6},{2,6},{1,6},{4,5},{3,5},{2,5},{1,5},{3,4},{2,4},{1,4},{2,3},{1,2}}) ok

forest? . 0  ok

\ Using set-sort to sort a vector

: vector-sort \ s -- s'
set-sort zst> 1- >zst ;

\ check if E is a cycle

: cycle \ -- flag | E --
zdup multiunion
zdup cardinality true loc{ v flag }
zover zdup cardinality v = 0=
if triplet zdrop false exit
then pair components# 1 >
if zdrop false exit
then 0 >xst foreach
do xzmerge
loop xst zst setmove
zet> cs sort 2 - 0
do over = flag and to flag
over > flag and to flag
+loop = flag and ;

: clear-table \ s --
do zst> max
loop cells erase ;

: cyc!check \ n -- flag
cells pad + 1 over +! @ 2 > ;

\ Test if (V,E) is 2-regular

: 2-regular \ -- flag | (V,E) --
unfence zswap clear-table
begin zst@
while zsplit unfence
zst> cyc!check if zst> drop zdrop false exit then
zst> cyc!check if zdrop false exit then
repeat zdrop true ;

4 5 9 randgraph zdup cr zet.
({1,2,3,4,5,6,7,8,9},{{8,9},{7,9},{6,9},{4,9},{3,9},{2,9},{7,8},{6,8},{5,8},{4,8},{2,8},{1,8},{6,7},{4,7},{2,7},{1,7},{4,6},{2,6},{1,6},{4,5},{3,5},{1,5},{3,4},{1,4},{1,3},{1,2}}) ok

2-regular . 0  ok