2006-03-27 03:10:58 -05:00
|
|
|
! Copyright (C) 2006 Slava Pestov.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
|
IN: graphs
|
|
|
|
|
USING: hashtables kernel namespaces sequences ;
|
|
|
|
|
|
|
|
|
|
: if-graph over [ bind ] [ 2drop 2drop ] if ; inline
|
|
|
|
|
|
|
|
|
|
: (add-vertex) ( vertex edges -- | edges: vertex -- seq )
|
|
|
|
|
dupd call [ dupd nest set-hash ] each-with ; inline
|
|
|
|
|
|
|
|
|
|
: add-vertex ( vertex edges graph -- | edges: vertex -- seq )
|
|
|
|
|
[ (add-vertex) ] if-graph ; inline
|
|
|
|
|
|
2006-06-04 02:00:59 -04:00
|
|
|
: build-graph ( seq edges graph -- | edges: vertex -- seq )
|
2006-03-27 03:10:58 -05:00
|
|
|
[
|
|
|
|
|
namespace clear-hash
|
|
|
|
|
swap [ swap (add-vertex) ] each-with
|
|
|
|
|
] if-graph ;
|
|
|
|
|
|
2006-04-03 02:18:56 -04:00
|
|
|
: (remove-vertex) ( vertex graph -- ) nest remove-hash ;
|
2006-03-27 03:10:58 -05:00
|
|
|
|
|
|
|
|
: remove-vertex ( vertex edges graph -- )
|
2006-06-10 00:53:29 -04:00
|
|
|
[
|
|
|
|
|
dupd call [ namespace hash ?remove-hash ] each-with
|
|
|
|
|
] if-graph ; inline
|
2006-03-27 03:10:58 -05:00
|
|
|
|
|
|
|
|
: in-edges ( vertex graph -- seq )
|
|
|
|
|
?hash dup [ hash-keys ] when ;
|
|
|
|
|
|
|
|
|
|
: closure, ( value key -- old )
|
2006-06-10 01:30:16 -04:00
|
|
|
building get [ hash swap ] 2keep set-hash ;
|
2006-03-27 03:10:58 -05:00
|
|
|
|
|
|
|
|
: (closure) ( key hash -- )
|
|
|
|
|
tuck ?hash dup [
|
|
|
|
|
[
|
|
|
|
|
drop dup dup closure,
|
|
|
|
|
[ 2drop ] [ swap (closure) ] if
|
|
|
|
|
] hash-each-with
|
|
|
|
|
] [
|
|
|
|
|
2drop
|
|
|
|
|
] if ;
|
|
|
|
|
|
|
|
|
|
: closure ( vertex graph -- seq )
|
|
|
|
|
[
|
2006-06-10 01:30:16 -04:00
|
|
|
H{ } clone building set
|
2006-03-27 03:10:58 -05:00
|
|
|
(closure)
|
2006-06-10 01:30:16 -04:00
|
|
|
building get hash-keys
|
2006-03-27 03:10:58 -05:00
|
|
|
] with-scope ;
|