unmaintained: New home for misfit Factor vocabularies.

[factor-unmaintained.git] / graph-theory / sparse / sparse.factor

diff --git a/graph-theory/sparse/sparse.factor b/graph-theory/sparse/sparse.factor
new file mode 100644 (file)
index 0000000..5c6365b
--- /dev/null
+++ b/graph-theory/sparse/sparse.factor
@@ -0,0 +1,35 @@
+! Copyright (C) 2008 William Schlieper <schlieper@unc.edu>
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors kernel sequences arrays vectors sets assocs hashtables graph-theory namespaces fry ;
+
+IN: graph-theory.sparse
+
+TUPLE: sparse-graph alist ; 
+
+: <sparse-graph> ( -- sparse-graph )
+    H{ } clone sparse-graph boa ;
+
+: >sparse-graph ( graph -- sparse-graph )
+    [ vertices ] keep
+    '[ dup _ adjlist 2array ] map >hashtable sparse-graph boa ;
+
+INSTANCE: sparse-graph graph
+
+M: sparse-graph vertices
+    alist>> keys ;
+
+M: sparse-graph adjlist
+    alist>> at ;
+
+M: sparse-graph add-blank-vertex 
+    alist>> V{ } clone -rot set-at ;
+
+M: sparse-graph delete-blank-vertex
+    alist>> delete-at ;
+
+M: sparse-graph add-edge*
+    alist>> swapd at adjoin ;
+
+M: sparse-graph delete-edge*
+    alist>> swapd at delete ;