diff options
Diffstat (limited to 'module/util/graph.scm')
-rw-r--r-- | module/util/graph.scm | 93 |
1 files changed, 0 insertions, 93 deletions
diff --git a/module/util/graph.scm b/module/util/graph.scm deleted file mode 100644 index 999da743..00000000 --- a/module/util/graph.scm +++ /dev/null @@ -1,93 +0,0 @@ -;;; Commentary: -;; An immutable directed graph. -;; Most operations are O(n), since there is no total -;; order on symbols in scheme. -;;; Code: - -(define-module (util graph) - :use-module (util) - :use-module (srfi srfi-1) - :use-module (srfi srfi-9 gnu)) - -;; Immutable directed graph -(define-immutable-record-type <graph> - (make-graph% nodes edges node-key-proc node-equal?) - graph? - (nodes graph-nodes) - (edges graph-edges) ; (list (symb . symb)) - (node-key-proc node-key-proc) ; node → symb - (node-equal? node-equal?) ; node, node -> symb - ) - -(define*-public (make-graph optional: - (node-key-proc identity) - (node-equal? eq?)) - (make-graph% '() '() node-key-proc node-equal?)) - -(define*-public (rebuild-graph optional: old-graph - (nodes '()) (edges '())) - (make-graph% nodes edges - (if old-graph (node-key-proc old-graph) identity) - (if old-graph (node-equal? old-graph) eq?))) - -(define-public (graph-empty? graph) - (null? (graph-nodes graph))) - -;; Add node to graph. Adds directed edges from node to neighbours -;; graph, node, (list node-key) → graph -(define-public (add-node graph node edge-neighbours) - (rebuild-graph - graph - (lset-adjoin (node-equal? graph) (graph-nodes graph) - node) - (lset-union equal? (graph-edges graph) - (map (lambda (o) (cons ((node-key-proc graph) node) o)) - edge-neighbours)))) - -;; get node by key -(define-public (get-node graph key) - (find (lambda (node) (eq? key ((node-key-proc graph) node))) - (graph-nodes graph))) - -;; Remove node by @var{node-equal?} -(define-public (remove-node graph node) - (rebuild-graph - graph - (remove (lambda (other) ((node-equal? graph) node other)) - (graph-nodes graph)) - (let ((key ((node-key-proc graph) node))) - (remove (lambda (edge) (or (eq? key (car edge)) - (eq? key (cdr edge)))) - (graph-edges graph))))) - -;; NOTE this is O(n^2) (maybe, sort of?) -;; Getting it faster would require building an index, which -;; is hard since there isn't a total order on symbols. -(define-public (find-node-without-dependencies graph) - (find (lambda (node) - (let ((key ((node-key-proc graph) node))) - (not (find (lambda (edge) (eq? key (car edge))) (graph-edges graph))))) - (graph-nodes graph))) - -;; graph → node x graph -(define-public (find-and-remove-node-without-dependencies graph) - (let ((node (find-node-without-dependencies graph))) - (unless node - (throw 'graph-error 'find-and-remove-node-without-dependencies - "No node without dependencies in graph" '() graph)) - (values node (remove-node graph node)))) - -;; Assumes that the edges of the graph are dependencies. -;; Returns a list of all nodes so that each node is before its dependants. -;; A missing dependency (and probably a loop) is an error, and currently -;; leads to some weird error messages. -(define-public (resolve-dependency-graph graph) - (catch 'graph-error - (lambda () - (let loop ((graph graph)) - (if (graph-empty? graph) - '() - (let* ((node graph* (find-and-remove-node-without-dependencies graph))) - (cons node (loop graph*)))))) - (lambda (err caller fmt args graph . data) - graph))) |