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

disjoint-sets now usesallows arbitrary keys

db4
Slava Pestov 2008-07-20 03:49:31 -05:00
parent 9e685d7ac4
commit 95a8e6cb8a
1 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,43 +1,50 @@
! Copyright (C) 2008 Eric Mertens. ! Copyright (C) 2008 Eric Mertens.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays hints kernel locals math sequences ; USING: accessors arrays hints kernel locals math hashtables
assocs ;
IN: disjoint-sets IN: disjoint-sets
TUPLE: disjoint-set
{ parents hashtable read-only }
{ ranks hashtable read-only }
{ counts hashtable read-only } ;
<PRIVATE <PRIVATE
TUPLE: disjoint-set parents ranks counts ;
: count ( a disjoint-set -- n ) : count ( a disjoint-set -- n )
counts>> nth ; inline counts>> at ; inline
: add-count ( p a disjoint-set -- ) : add-count ( p a disjoint-set -- )
[ count [ + ] curry ] keep counts>> swap change-nth ; inline [ count [ + ] curry ] keep counts>> swap change-at ; inline
: parent ( a disjoint-set -- p ) : parent ( a disjoint-set -- p )
parents>> nth ; inline parents>> at ; inline
: set-parent ( p a disjoint-set -- ) : set-parent ( p a disjoint-set -- )
parents>> set-nth ; inline parents>> set-at ; inline
: link-sets ( p a disjoint-set -- ) : link-sets ( p a disjoint-set -- )
[ set-parent ] [ set-parent ] [ add-count ] 3bi ; inline
[ add-count ] 3bi ; inline
: rank ( a disjoint-set -- r ) : rank ( a disjoint-set -- r )
ranks>> nth ; inline ranks>> at ; inline
: inc-rank ( a disjoint-set -- ) : inc-rank ( a disjoint-set -- )
ranks>> [ 1+ ] change-nth ; inline ranks>> [ 1+ ] change-at ; inline
: representative? ( a disjoint-set -- ? ) : representative? ( a disjoint-set -- ? )
dupd parent = ; inline dupd parent = ; inline
PRIVATE>
: representative ( a disjoint-set -- p ) : representative ( a disjoint-set -- p )
2dup representative? [ drop ] [ 2dup representative? [ drop ] [
[ [ parent ] keep representative dup ] 2keep set-parent [ [ parent ] keep representative dup ] 2keep set-parent
] if ; ] if ;
<PRIVATE
: representatives ( a b disjoint-set -- r r ) : representatives ( a b disjoint-set -- r r )
[ representative ] curry bi@ ; inline [ representative ] curry bi@ ; inline
@ -49,11 +56,14 @@ TUPLE: disjoint-set parents ranks counts ;
PRIVATE> PRIVATE>
: <disjoint-set> ( n -- disjoint-set ) : <disjoint-set> ( -- disjoint-set )
[ >array ] H{ } clone H{ } clone H{ } clone disjoint-set boa ;
[ 0 <array> ]
[ 1 <array> ] tri : add-atom ( a disjoint-set -- )
disjoint-set boa ; [ dupd parents>> set-at ]
[ 0 -rot ranks>> set-at ]
[ 1 -rot counts>> set-at ]
2tri ;
: equiv-set-size ( a disjoint-set -- n ) : equiv-set-size ( a disjoint-set -- n )
[ representative ] keep count ; [ representative ] keep count ;