Import extra/unionfind, a disjoint set datastructure

db4
Eric Mertens 2008-04-08 23:22:28 -07:00
parent c6e1347c67
commit 639871900a
3 changed files with 73 additions and 0 deletions

View File

@ -0,0 +1 @@
Eric Mertens

View File

@ -0,0 +1 @@
A efficient implementation of a disjoint-set datastructure

View File

@ -0,0 +1,71 @@
USING: accessors arrays combinators kernel math sequences namespaces ;
IN: unionfind
<PRIVATE
TUPLE: unionfind parents ranks counts ;
SYMBOL: uf
: count ( a -- n )
uf get counts>> nth ;
: add-count ( p a -- )
count [ + ] curry uf get counts>> swap change-nth ;
: parent ( a -- p )
uf get parents>> nth ;
: set-parent ( p a -- )
uf get parents>> set-nth ;
: link-sets ( p a -- )
[ set-parent ]
[ add-count ] 2bi ;
: rank ( a -- r )
uf get ranks>> nth ;
: inc-rank ( a -- )
uf get ranks>> [ 1+ ] change-nth ;
: topparent ( a -- p )
[ parent ] keep
2dup = [
[ topparent ] dip
2dup set-parent
] unless drop ;
PRIVATE>
: <unionfind> ( n -- unionfind )
[ >array ]
[ 0 <array> ]
[ 1 <array> ] tri
unionfind construct-boa ;
: equiv-set-size ( a uf -- n )
uf [ topparent count ] with-variable ;
: equiv? ( a b uf -- ? )
uf [ [ topparent ] bi@ = ] with-variable ;
: equate ( a b uf -- )
uf [
[ topparent ] bi@
2dup [ rank ] compare sgn
{
{ -1 [ swap link-sets ] }
{ 1 [ link-sets ] }
{ 0 [
2dup =
[ 2drop ]
[
[ link-sets ]
[ drop inc-rank ] 2bi
] if
]
}
} case
] with-variable ;