! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel new-slots sequences vectors ;
+USING: accessors assocs hashtables hashtables.private kernel sequences ;
IN: digraphs
-TUPLE: digraph ;
-TUPLE: vertex value edges ;
+TUPLE: digraph < hashtable ;
: <digraph> ( -- digraph )
- digraph construct-empty H{ } clone over set-delegate ;
+ 0 digraph new [ reset-hash ] keep ;
+
+TUPLE: vertex value edges ;
: <vertex> ( value -- vertex )
- V{ } clone vertex construct-boa ;
+ V{ } clone vertex boa ;
: add-vertex ( key value digraph -- )
- >r <vertex> swap r> set-at ;
+ [ <vertex> swap ] dip set-at ;
: children ( key digraph -- seq )
at edges>> ;
: @edges ( from to digraph -- to edges ) swapd at edges>> ;
: add-edge ( from to digraph -- ) @edges push ;
-: delete-edge ( from to digraph -- ) @edges delete ;
+: delete-edge ( from to digraph -- ) @edges remove! drop ;
: delete-to-edges ( to digraph -- )
- [ nip dupd edges>> delete ] assoc-each drop ;
+ [ nip dupd edges>> remove! drop ] assoc-each drop ;
: delete-vertex ( key digraph -- )
2dup delete-at delete-to-edges ;
] if ;
: topological-sort ( digraph -- seq )
- dup clone V{ } clone spin
+ [ V{ } clone ] dip [ clone ] keep
[ drop (topological-sort) ] assoc-each drop reverse ;
: topological-sorted-values ( digraph -- seq )