From 9cc73c94922c303e2809ad6def60cceadf6d1964 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 21 Mar 2016 10:17:29 -0700 Subject: [PATCH] graphs: move to core and simplify. 1. remove add-vertex* and remove-vertex* that contradicted the documentation. 2. graphs use hash-sets of edges instead of hashtables of {edge,edge} pairs. 3. make graphs:closure work like classes:closure, use in classes. --- basis/compiler/crossref/crossref.factor | 14 +++++-- basis/graphs/graphs-tests.factor | 50 ----------------------- basis/graphs/graphs.factor | 45 -------------------- core/classes/classes.factor | 20 ++------- {basis => core}/graphs/authors.txt | 0 {basis => core}/graphs/graphs-docs.factor | 17 ++++---- core/graphs/graphs-tests.factor | 18 ++++++++ core/graphs/graphs.factor | 29 +++++++++++++ {basis => core}/graphs/summary.txt | 0 {basis => core}/graphs/tags.txt | 0 10 files changed, 70 insertions(+), 123 deletions(-) delete mode 100644 basis/graphs/graphs-tests.factor delete mode 100644 basis/graphs/graphs.factor rename {basis => core}/graphs/authors.txt (100%) rename {basis => core}/graphs/graphs-docs.factor (59%) create mode 100644 core/graphs/graphs-tests.factor create mode 100644 core/graphs/graphs.factor rename {basis => core}/graphs/summary.txt (100%) rename {basis => core}/graphs/tags.txt (100%) diff --git a/basis/compiler/crossref/crossref.factor b/basis/compiler/crossref/crossref.factor index 2e81f2674a..09f092dbcd 100644 --- a/basis/compiler/crossref/crossref.factor +++ b/basis/compiler/crossref/crossref.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs combinators fry graphs grouping kernel namespaces +USING: assocs combinators fry grouping kernel namespaces sequences sets stack-checker.dependencies words ; IN: compiler.crossref @@ -58,9 +58,17 @@ generic-call-site-crossref [ H{ } clone ] initialize "effect-dependencies" "conditional-dependencies" "definition-dependencies" [ (store-dependencies) ] tri-curry@ tri-curry* tri ; +: add-xref ( word dependencies crossref -- ) + rot '[ + swap _ [ drop H{ } clone ] cache _ swap set-at + ] assoc-each ; + +: remove-xref ( word dependencies crossref -- ) + [ keys ] dip '[ _ at delete-at ] with each ; + : (compiled-xref) ( word dependencies generic-dependencies -- ) compiled-crossref generic-call-site-crossref - [ get add-vertex* ] bi-curry@ bi-curry* bi ; + [ get add-xref ] bi-curry@ bi-curry* bi ; : compiled-xref ( word dependencies generic-dependencies -- ) [ only-xref ] bi@ @@ -86,7 +94,7 @@ generic-call-site-crossref [ H{ } clone ] initialize join-dependencies ; : (compiled-unxref) ( word dependencies variable -- ) - get remove-vertex* ; + get remove-xref ; : generic-call-sites ( word -- alist ) "generic-call-sites" word-prop 2 group ; diff --git a/basis/graphs/graphs-tests.factor b/basis/graphs/graphs-tests.factor deleted file mode 100644 index 9e06078535..0000000000 --- a/basis/graphs/graphs-tests.factor +++ /dev/null @@ -1,50 +0,0 @@ -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 diff --git a/basis/graphs/graphs.factor b/basis/graphs/graphs.factor deleted file mode 100644 index ce561d96c9..0000000000 --- a/basis/graphs/graphs.factor +++ /dev/null @@ -1,45 +0,0 @@ -! Copyright (C) 2006, 2007 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: assocs kernel sequences sets ; -IN: graphs - - - -: add-vertex ( vertex edges graph -- ) - [ [ nest conjoin ] 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 - - - -: closure ( vertex quot: ( vertex -- assoc ) -- assoc ) - H{ } clone [ swap (closure) ] keep ; inline diff --git a/core/classes/classes.factor b/core/classes/classes.factor index f4623225b4..cd07c4a65b 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs combinators definitions kernel +USING: accessors assocs combinators definitions graphs kernel make namespaces quotations sequences sets words words.symbol ; IN: classes @@ -135,18 +135,6 @@ GENERIC: implementors ( class/classes -- seq ) : class-usage ( class -- seq ) update-map get at members ; - - : class-usages ( class -- seq ) [ class-usage ] closure members ; @@ -157,12 +145,10 @@ M: sequence implementors [ implementors ] gather ; } ". To add vertices and edges to a graph:" { $subsections add-vertex } @@ -10,23 +11,23 @@ $nl { $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:" +"You can perform queries on a 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" } } +{ $values { "vertex" object } { "edges" sequence } { "graph" "an " { $link assoc } " mapping vertices to " { $link hash-set } " 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" } } +{ $values { "vertex" object } { "edges" sequence } { "graph" "an " { $link assoc } " mapping vertices to " { $link unordered-set } "s 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." } +{ $notes "The " { $snippet "edges" } " sequence must have all the values 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 { "vertex" object } { "quot" { $quotation ( vertex -- 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" } "." } ; +{ $values { "vertex" object } { "quot" { $quotation ( vertex -- edges ) } } { "set" hash-set } } +{ $description "Outputs all vertices reachable from " { $snippet "vertex" } " via edges given by the quotation. The set always includes " { $snippet "vertex" } "." } ; diff --git a/core/graphs/graphs-tests.factor b/core/graphs/graphs-tests.factor new file mode 100644 index 0000000000..807d347d6a --- /dev/null +++ b/core/graphs/graphs-tests.factor @@ -0,0 +1,18 @@ +USING: assocs graphs kernel namespaces sets sorting tools.test ; + +H{ } "g" set +{ 1 2 3 } "v" set + +{ } [ "v" dup get "g" get add-vertex ] unit-test + +{ { "v" } } [ 1 "g" get at members ] unit-test + +H{ + { 1 HS{ 1 2 } } + { 2 HS{ 3 4 } } + { 4 HS{ 4 5 } } +} "g" set + +{ { 2 3 4 5 } } [ + 2 [ "g" get at members ] closure members natural-sort +] unit-test diff --git a/core/graphs/graphs.factor b/core/graphs/graphs.factor new file mode 100644 index 0000000000..098a704769 --- /dev/null +++ b/core/graphs/graphs.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2006, 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs kernel sequences sets ; +IN: graphs + + + +: add-vertex ( vertex edges graph -- ) + [ nest adjoin ] curry with each ; inline + +: remove-vertex ( vertex edges graph -- ) + [ at delete ] curry with each ; inline + + + +: closure ( vertex quot: ( vertex -- edges ) -- set ) + HS{ } clone [ swap (closure) ] keep ; inline diff --git a/basis/graphs/summary.txt b/core/graphs/summary.txt similarity index 100% rename from basis/graphs/summary.txt rename to core/graphs/summary.txt diff --git a/basis/graphs/tags.txt b/core/graphs/tags.txt similarity index 100% rename from basis/graphs/tags.txt rename to core/graphs/tags.txt