core/graphs/graphs.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs kernel namespaces sequences sets ;
   4 IN: graphs
   5
   6 <PRIVATE
   7
   8 : if-graph ( vertex edges graph quot -- )
   9     dupd [ 3drop ] if ; inline
  10
  11 : nest ( key graph -- hash )
  12     [ drop H{ } clone ] cache ; inline
  13
  14 PRIVATE>
  15
  16 : add-vertex ( vertex edges graph -- )
  17     [ [ nest dupd set-at ] curry with each ] if-graph ; inline
  18
  19 : add-vertex* ( vertex edges graph -- )
  20     [
  21         swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
  22     ] if-graph ; inline
  23
  24 : remove-vertex ( vertex edges graph -- )
  25     [ [ at delete-at ] curry with each ] if-graph ; inline
  26
  27 : remove-vertex* ( vertex edges graph -- )
  28     [
  29         swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
  30     ] if-graph ; inline
  31
  32 <PRIVATE
  33
  34 : (closure) ( obj assoc quot: ( elt -- assoc ) -- )
  35     2over key? [
  36         3drop
  37     ] [
  38         2over conjoin [ dip ] keep
  39         [ [ drop ] 3dip (closure) ] 2curry assoc-each
  40     ] if ; inline recursive
  41
  42 PRIVATE>
  43
  44 : closure ( obj quot -- assoc )
  45     H{ } clone [ swap (closure) ] keep ; inline