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 --
  pad 0 foreach
  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

1 comment:

  1. If you need your ex-girlfriend or ex-boyfriend to come crawling back to you on their knees (no matter why you broke up) you have to watch this video
    right away...

    (VIDEO) Get your ex back with TEXT messages?

    ReplyDelete