steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rice things up a bit

db4
Slava Pestov 2008-07-20 03:53:12 -05:00
parent 95a8e6cb8a
commit bbb5d7365c
1 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
extra/disjoint-sets/disjoint-sets.factor
View File

@ -38,7 +38,9 @@ TUPLE: disjoint-set
PRIVATE> PRIVATE>
: representative ( a disjoint-set -- p ) GENERIC: representative ( a disjoint-set -- p )
M: disjoint-set representative
2dup representative? [ drop ] [ 2dup representative? [ drop ] [
[ [ parent ] keep representative dup ] 2keep set-parent [ [ parent ] keep representative dup ] 2keep set-parent
] if ; ] if ;
@ -59,26 +61,28 @@ PRIVATE>
: <disjoint-set> ( -- disjoint-set ) : <disjoint-set> ( -- disjoint-set )
H{ } clone H{ } clone H{ } clone disjoint-set boa ; H{ } clone H{ } clone H{ } clone disjoint-set boa ;
: add-atom ( a disjoint-set -- ) GENERIC: add-atom ( a disjoint-set -- )
M: disjoint-set add-atom
[ dupd parents>> set-at ] [ dupd parents>> set-at ]
[ 0 -rot ranks>> set-at ] [ 0 -rot ranks>> set-at ]
[ 1 -rot counts>> set-at ] [ 1 -rot counts>> set-at ]
2tri ; 2tri ;
: equiv-set-size ( a disjoint-set -- n ) GENERIC: equiv-set-size ( a disjoint-set -- n )
[ representative ] keep count ;
: equiv? ( a b disjoint-set -- ? ) M: disjoint-set equiv-set-size [ representative ] keep count ;
representatives = ; inline
:: equate ( a b disjoint-set -- ) GENERIC: equiv? ( a b disjoint-set -- ? )
M: disjoint-set equiv? representatives = ;
GENERIC: equate ( a b disjoint-set -- )
M:: disjoint-set equate ( a b disjoint-set -- )
a b disjoint-set representatives a b disjoint-set representatives
2dup = [ 2drop ] [ 2dup = [ 2drop ] [
2dup disjoint-set ranks 2dup disjoint-set ranks
[ swap ] [ over disjoint-set inc-rank ] [ ] branch [ swap ] [ over disjoint-set inc-rank ] [ ] branch
disjoint-set link-sets disjoint-set link-sets
] if ; ] if ;
HINTS: equate disjoint-set ;
HINTS: representative disjoint-set ;
HINTS: equiv-set-size disjoint-set ;