factor/core/graphs/graphs.factor

53 lines
1.3 KiB
Factor
Raw Normal View History

2007-09-20 18:09:08 -04:00
! Copyright (C) 2006, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
2008-06-11 03:58:38 -04:00
USING: assocs kernel namespaces sequences sets ;
2007-09-20 18:09:08 -04:00
IN: graphs
SYMBOL: graph
: if-graph ( vertex edges graph quot -- )
over
[ graph swap with-variable ]
[ 2drop 2drop ] if ; inline
: nest ( key -- hash )
graph get [ drop H{ } clone ] cache ;
: add-vertex ( vertex edges graph -- )
2008-01-09 17:36:30 -05:00
[ [ dupd nest set-at ] with each ] if-graph ; inline
2007-09-20 18:09:08 -04:00
2008-01-12 04:25:16 -05:00
: (add-vertex) ( key value vertex -- )
rot nest set-at ;
: add-vertex* ( vertex edges graph -- )
[
swap [ (add-vertex) ] curry assoc-each
] if-graph ; inline
2007-09-20 18:09:08 -04:00
: remove-vertex ( vertex edges graph -- )
2008-01-09 17:36:30 -05:00
[ [ graph get at delete-at ] with each ] if-graph ; inline
2007-09-20 18:09:08 -04:00
2008-01-12 04:25:16 -05:00
: (remove-vertex) ( key value vertex -- )
rot graph get at delete-at drop ;
: remove-vertex* ( vertex edges graph -- )
[
swap [ (remove-vertex) ] curry assoc-each
] if-graph ; inline
2007-09-20 18:09:08 -04:00
SYMBOL: previous
2008-07-18 20:22:59 -04:00
: (closure) ( obj quot: ( elt -- assoc ) -- )
2007-09-20 18:09:08 -04:00
over previous get key? [
2drop
] [
2008-06-11 03:58:38 -04:00
over previous get conjoin
[ call ] keep
2007-09-20 18:09:08 -04:00
[ nip (closure) ] curry assoc-each
2008-07-18 20:22:59 -04:00
] if ; inline recursive
2007-09-20 18:09:08 -04:00
: closure ( obj quot -- assoc )
H{ } clone [
previous [ (closure) ] with-variable
] keep ; inline