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 SYMBOL: graph
   7
   8 : if-graph ( vertex edges graph quot -- )
   9     over
  10     [ graph swap with-variable ]
  11     [ 2drop 2drop ] if ; inline
  12
  13 : nest ( key -- hash )
  14     graph get [ drop H{ } clone ] cache ;
  15
  16 : add-vertex ( vertex edges graph -- )
  17     [ [ dupd nest set-at ] with each ] if-graph ; inline
  18
  19 : (add-vertex) ( key value vertex -- )
  20     rot nest set-at ;
  21
  22 : add-vertex* ( vertex edges graph -- )
  23     [
  24         swap [ (add-vertex) ] curry assoc-each
  25     ] if-graph ; inline
  26
  27 : remove-vertex ( vertex edges graph -- )
  28     [ [ graph get at delete-at ] with each ] if-graph ; inline
  29
  30 : (remove-vertex) ( key value vertex -- )
  31     rot graph get at delete-at drop ;
  32
  33 : remove-vertex* ( vertex edges graph -- )
  34     [
  35         swap [ (remove-vertex) ] curry assoc-each
  36     ] if-graph ; inline
  37
  38 SYMBOL: previous
  39
  40 : (closure) ( obj quot: ( elt -- assoc ) -- )
  41     over previous get key? [
  42         2drop
  43     ] [
  44         over previous get conjoin
  45         dup slip
  46         [ nip (closure) ] curry assoc-each
  47     ] if ; inline recursive
  48
  49 : closure ( obj quot -- assoc )
  50     H{ } clone [
  51         previous [ (closure) ] with-variable
  52     ] keep ; inline