steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

graphs: simplify by removing temporary namespace variables.

db4
John Benediktsson 2012-07-17 11:00:38 -07:00
parent 0c46a1834b
commit 75a1303a36
2 changed files with 13 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
core/graphs/graphs-docs.factor
View File

@ -16,9 +16,6 @@ $nl
ABOUT: "graphs" ABOUT: "graphs"
HELP: graph
{ $var-description "Temporary variable used by various graph words." } ;
HELP: add-vertex HELP: add-vertex
{ $values { "vertex" object } { "edges" "a sequence" } { "graph" "an assoc mapping vertices to sequences of edges" } } { $values { "vertex" object } { "edges" "a 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." } { $description "Adds a vertex to a directed graph, with " { $snippet "edges" } " as the outward edges from the vertex." }

41
core/graphs/graphs.factor
View File

@ -3,50 +3,35 @@
USING: assocs kernel namespaces sequences sets ; USING: assocs kernel namespaces sequences sets ;
IN: graphs IN: graphs
SYMBOL: graph
: if-graph ( vertex edges graph quot -- ) : if-graph ( vertex edges graph quot -- )
over dupd [ 3drop ] if ; inline
[ graph swap with-variable ]
[ 2drop 2drop ] if ; inline
: nest ( key -- hash ) : nest ( key graph -- hash )
graph get [ drop H{ } clone ] cache ; [ drop H{ } clone ] cache ; inline
: add-vertex ( vertex edges graph -- ) : add-vertex ( vertex edges graph -- )
[ [ dupd nest set-at ] with each ] if-graph ; inline [ [ nest dupd set-at ] curry with each ] if-graph ; inline
: (add-vertex) ( key value vertex -- )
rot nest set-at ;
: add-vertex* ( vertex edges graph -- ) : add-vertex* ( vertex edges graph -- )
[ [
swap [ (add-vertex) ] curry assoc-each swapd [ [ rot ] dip nest set-at ] 2curry assoc-each
] if-graph ; inline ] if-graph ; inline
: remove-vertex ( vertex edges graph -- ) : remove-vertex ( vertex edges graph -- )
[ [ graph get at delete-at ] with each ] if-graph ; inline [ [ at delete-at ] curry with each ] if-graph ; inline
: (remove-vertex) ( key value vertex -- )
rot graph get at delete-at drop ;
: remove-vertex* ( vertex edges graph -- ) : remove-vertex* ( vertex edges graph -- )
[ [
swap [ (remove-vertex) ] curry assoc-each swapd [ [ rot ] dip at delete-at drop ] 2curry assoc-each
] if-graph ; inline ] if-graph ; inline
SYMBOL: previous : (closure) ( obj assoc quot: ( elt -- assoc ) -- )
2over key? [
: (closure) ( obj quot: ( elt -- assoc ) -- ) 3drop
over previous get key? [
2drop
] [ ] [
over previous get conjoin 2over conjoin [ dip ] keep
[ call ] keep [ [ drop ] 3dip (closure) ] 2curry assoc-each
[ nip (closure) ] curry assoc-each
] if ; inline recursive ] if ; inline recursive
: closure ( obj quot -- assoc ) : closure ( obj quot -- assoc )
H{ } clone [ H{ } clone [ swap (closure) ] keep ; inline
previous [ (closure) ] with-variable
] keep ; inline