factor/basis/graphs/graphs.factor

46 lines
1.1 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.
2013-03-05 13:34:47 -05:00
USING: assocs kernel sequences sets ;
2007-09-20 18:09:08 -04:00
IN: graphs
2012-08-30 14:31:52 -04:00
<PRIVATE
2007-09-20 18:09:08 -04:00
: if-graph ( vertex edges graph quot -- )
dupd [ 3drop ] if ; inline
2007-09-20 18:09:08 -04:00
: nest ( key graph -- hash )
[ drop H{ } clone ] cache ; inline
2007-09-20 18:09:08 -04:00
2012-08-30 14:31:52 -04:00
PRIVATE>
2007-09-20 18:09:08 -04:00
: add-vertex ( vertex edges graph -- )
[ [ nest dupd set-at ] curry with each ] if-graph ; inline
2008-01-12 04:25:16 -05:00
: add-vertex* ( vertex edges graph -- )
[
swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
2008-01-12 04:25:16 -05:00
] if-graph ; inline
2007-09-20 18:09:08 -04:00
: remove-vertex ( vertex edges graph -- )
[ [ at delete-at ] curry with each ] if-graph ; inline
2008-01-12 04:25:16 -05:00
: remove-vertex* ( vertex edges graph -- )
[
swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
2008-01-12 04:25:16 -05:00
] if-graph ; inline
2012-08-30 14:31:52 -04:00
<PRIVATE
: (closure) ( vertex assoc quot: ( vertex -- assoc ) -- )
2over key? [
3drop
] [
2over conjoin [ dip ] keep
[ [ drop ] 3dip (closure) ] 2curry assoc-each
] if ; inline recursive
2007-09-20 18:09:08 -04:00
2012-08-30 14:31:52 -04:00
PRIVATE>
: closure ( vertex quot: ( vertex -- assoc ) -- assoc )
H{ } clone [ swap (closure) ] keep ; inline