{ 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
No comments:
Post a Comment