--- /dev/null
+Slava Pestov
--- /dev/null
+USING: assocs hashtables help.markup help.syntax kernel sequences ;
+IN: graphs
+
+ARTICLE: "graphs" "Directed graph utilities"
+"Words for treating associative mappings as directed graphs can be found in the " { $vocab-link "graphs" } " vocabulary. A directed graph is represented as an assoc mapping each vertex to a set of edges entering that vertex, where the set is itself an assoc, with equal keys and values."
+$nl
+"To create a new graph, just create an assoc, for example by calling " { $link <hashtable> } ". To add vertices and edges to a graph:"
+{ $subsections add-vertex }
+"To remove vertices from the graph:"
+{ $subsections remove-vertex }
+"Since graphs are represented as assocs, they can be cleared out by calling " { $link clear-assoc } "."
+$nl
+"You can perform queries on the graph:"
+{ $subsections closure }
+"Directed graphs are used to maintain cross-referencing information for " { $link "definitions" } "." ;
+
+ABOUT: "graphs"
+
+HELP: add-vertex
+{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
+{ $description "Adds a vertex to a directed graph, with " { $snippet "edges" } " as the outward edges from the vertex." }
+{ $side-effects "graph" } ;
+
+HELP: remove-vertex
+{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
+{ $description "Removes a vertex from a graph, using the given edges sequence." }
+{ $notes "The " { $snippet "edges" } " sequence must equal the value passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
+{ $side-effects "graph" } ;
+
+HELP: closure
+{ $values { "obj" object } { "quot" { $quotation "( obj -- assoc )" } } { "assoc" "a new assoc" } }
+{ $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
--- /dev/null
+USING: graphs tools.test namespaces kernel sorting assocs ;
+
+H{ } "g" set
+{ 1 2 3 } "v" set
+
+[ ] [ "v" dup get "g" get add-vertex ] unit-test
+
+[ { "v" } ] [ 1 "g" get at keys ] unit-test
+
+H{
+ { 1 H{ { 1 1 } { 2 2 } } }
+ { 2 H{ { 3 3 } { 4 4 } } }
+ { 4 H{ { 4 4 } { 5 5 } } }
+} "g" set
+
+[ { 2 3 4 5 } ] [
+ 2 [ "g" get at ] closure keys natural-sort
+] unit-test
+
+H{ } "g" set
+
+[ ] [
+ "mary"
+ H{ { "billy" "one" } { "joey" "two" } }
+ "g" get add-vertex*
+] unit-test
+
+[ H{ { "mary" "one" } } ] [
+ "billy" "g" get at
+] unit-test
+
+[ ] [
+ "liz"
+ H{ { "billy" "four" } { "fred" "three" } }
+ "g" get add-vertex*
+] unit-test
+
+[ H{ { "mary" "one" } { "liz" "four" } } ] [
+ "billy" "g" get at
+] unit-test
+
+[ ] [
+ "mary"
+ H{ { "billy" "one" } { "joey" "two" } }
+ "g" get remove-vertex*
+] unit-test
+
+[ H{ { "liz" "four" } } ] [
+ "billy" "g" get at
+] unit-test
--- /dev/null
+! Copyright (C) 2006, 2007 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs kernel sequences sets ;
+IN: graphs
+
+<PRIVATE
+
+: if-graph ( vertex edges graph quot -- )
+ dupd [ 3drop ] if ; inline
+
+: nest ( key graph -- hash )
+ [ drop H{ } clone ] cache ; inline
+
+PRIVATE>
+
+: add-vertex ( vertex edges graph -- )
+ [ [ nest dupd set-at ] curry with each ] if-graph ; inline
+
+: add-vertex* ( vertex edges graph -- )
+ [
+ swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
+ ] if-graph ; inline
+
+: remove-vertex ( vertex edges graph -- )
+ [ [ at delete-at ] curry with each ] if-graph ; inline
+
+: remove-vertex* ( vertex edges graph -- )
+ [
+ swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
+ ] if-graph ; inline
+
+<PRIVATE
+
+: (closure) ( obj assoc quot: ( elt -- assoc ) -- )
+ 2over key? [
+ 3drop
+ ] [
+ 2over conjoin [ dip ] keep
+ [ [ drop ] 3dip (closure) ] 2curry assoc-each
+ ] if ; inline recursive
+
+PRIVATE>
+
+: closure ( obj quot -- assoc )
+ H{ } clone [ swap (closure) ] keep ; inline
--- /dev/null
+Directed graphs
--- /dev/null
+collections
-USING: tools.test math math.functions math.constants
-generic.standard generic.single strings sequences arrays kernel
-accessors words byte-arrays bit-arrays parser namespaces make
-quotations stack-checker vectors growable hashtables sbufs
-prettyprint byte-vectors bit-vectors specialized-vectors
-definitions generic sets graphs assocs grouping see eval
-classes.union classes.tuple compiler.units io.streams.string
-compiler.crossref math.order ;
+USING: accessors arrays assocs bit-arrays bit-vectors
+byte-arrays classes.tuple classes.union compiler.crossref
+compiler.units definitions eval generic generic.single
+generic.standard io.streams.string kernel make math
+math.constants math.functions namespaces parser quotations
+sequences specialized-vectors strings tools.test words ;
QUALIFIED-WITH: alien.c-types c
FROM: namespaces => set ;
SPECIALIZED-VECTOR: c:double
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: assocs hashtables help.markup help.syntax kernel sequences ;
-IN: graphs
-
-ARTICLE: "graphs" "Directed graph utilities"
-"Words for treating associative mappings as directed graphs can be found in the " { $vocab-link "graphs" } " vocabulary. A directed graph is represented as an assoc mapping each vertex to a set of edges entering that vertex, where the set is itself an assoc, with equal keys and values."
-$nl
-"To create a new graph, just create an assoc, for example by calling " { $link <hashtable> } ". To add vertices and edges to a graph:"
-{ $subsections add-vertex }
-"To remove vertices from the graph:"
-{ $subsections remove-vertex }
-"Since graphs are represented as assocs, they can be cleared out by calling " { $link clear-assoc } "."
-$nl
-"You can perform queries on the graph:"
-{ $subsections closure }
-"Directed graphs are used to maintain cross-referencing information for " { $link "definitions" } "." ;
-
-ABOUT: "graphs"
-
-HELP: add-vertex
-{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Adds a vertex to a directed graph, with " { $snippet "edges" } " as the outward edges from the vertex." }
-{ $side-effects "graph" } ;
-
-HELP: remove-vertex
-{ $values { "vertex" object } { "edges" sequence } { "graph" "an assoc mapping vertices to sequences of edges" } }
-{ $description "Removes a vertex from a graph, using the given edges sequence." }
-{ $notes "The " { $snippet "edges" } " sequence must equal the value passed to " { $link add-vertex } ", otherwise some vertices of the graph may continue to refer to the removed vertex." }
-{ $side-effects "graph" } ;
-
-HELP: closure
-{ $values { "obj" object } { "quot" { $quotation "( obj -- assoc )" } } { "assoc" "a new assoc" } }
-{ $description "Outputs a set of all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ;
+++ /dev/null
-USING: graphs tools.test namespaces kernel sorting assocs ;
-
-H{ } "g" set
-{ 1 2 3 } "v" set
-
-[ ] [ "v" dup get "g" get add-vertex ] unit-test
-
-[ { "v" } ] [ 1 "g" get at keys ] unit-test
-
-H{
- { 1 H{ { 1 1 } { 2 2 } } }
- { 2 H{ { 3 3 } { 4 4 } } }
- { 4 H{ { 4 4 } { 5 5 } } }
-} "g" set
-
-[ { 2 3 4 5 } ] [
- 2 [ "g" get at ] closure keys natural-sort
-] unit-test
-
-H{ } "g" set
-
-[ ] [
- "mary"
- H{ { "billy" "one" } { "joey" "two" } }
- "g" get add-vertex*
-] unit-test
-
-[ H{ { "mary" "one" } } ] [
- "billy" "g" get at
-] unit-test
-
-[ ] [
- "liz"
- H{ { "billy" "four" } { "fred" "three" } }
- "g" get add-vertex*
-] unit-test
-
-[ H{ { "mary" "one" } { "liz" "four" } } ] [
- "billy" "g" get at
-] unit-test
-
-[ ] [
- "mary"
- H{ { "billy" "one" } { "joey" "two" } }
- "g" get remove-vertex*
-] unit-test
-
-[ H{ { "liz" "four" } } ] [
- "billy" "g" get at
-] unit-test
+++ /dev/null
-! Copyright (C) 2006, 2007 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel sequences sets ;
-IN: graphs
-
-<PRIVATE
-
-: if-graph ( vertex edges graph quot -- )
- dupd [ 3drop ] if ; inline
-
-: nest ( key graph -- hash )
- [ drop H{ } clone ] cache ; inline
-
-PRIVATE>
-
-: add-vertex ( vertex edges graph -- )
- [ [ nest dupd set-at ] curry with each ] if-graph ; inline
-
-: add-vertex* ( vertex edges graph -- )
- [
- swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
- ] if-graph ; inline
-
-: remove-vertex ( vertex edges graph -- )
- [ [ at delete-at ] curry with each ] if-graph ; inline
-
-: remove-vertex* ( vertex edges graph -- )
- [
- swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
- ] if-graph ; inline
-
-<PRIVATE
-
-: (closure) ( obj assoc quot: ( elt -- assoc ) -- )
- 2over key? [
- 3drop
- ] [
- 2over conjoin [ dip ] keep
- [ [ drop ] 3dip (closure) ] 2curry assoc-each
- ] if ; inline recursive
-
-PRIVATE>
-
-: closure ( obj quot -- assoc )
- H{ } clone [ swap (closure) ] keep ; inline
+++ /dev/null
-Directed graphs
+++ /dev/null
-collections
projects / factor.git / commitdiff