diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-05-23 23:03:23 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-05-24 00:06:01 +0200 |
| commit | e144e3427da93b962c7620ce2bd64add8c83cfdc (patch) | |
| tree | 2f1cd6dd65e764e8dab09d5fa97f86a62664617d | |
| parent | 623e4df42abd024e0a62ef0b30f9b550f37cba57 (diff) | |
graph: Add 'node-reachable-count'.
* guix/graph.scm (node-reachable-count): New procedure.
* tests/graph.scm ("node-reachable-count"): New test.
| -rw-r--r-- | guix/graph.scm | 8 | ||||
| -rw-r--r-- | tests/graph.scm | 13 |
2 files changed, 21 insertions, 0 deletions
diff --git a/guix/graph.scm b/guix/graph.scm index af589c5c679..735d340c2c1 100644 --- a/guix/graph.scm +++ b/guix/graph.scm | |||
| @@ -39,6 +39,7 @@ | |||
| 39 | node-back-edges | 39 | node-back-edges |
| 40 | traverse/depth-first | 40 | traverse/depth-first |
| 41 | node-transitive-edges | 41 | node-transitive-edges |
| 42 | node-reachable-count | ||
| 42 | 43 | ||
| 43 | %graphviz-backend | 44 | %graphviz-backend |
| 44 | graph-backend? | 45 | graph-backend? |
| @@ -126,6 +127,13 @@ procedure that, given a node, returns its list of direct dependents; it is | |||
| 126 | typically returned by 'node-edges' or 'node-back-edges'." | 127 | typically returned by 'node-edges' or 'node-back-edges'." |
| 127 | (traverse/depth-first cons '() nodes node-edges)) | 128 | (traverse/depth-first cons '() nodes node-edges)) |
| 128 | 129 | ||
| 130 | (define (node-reachable-count nodes node-edges) | ||
| 131 | "Return the number of nodes reachable from NODES along NODE-EDGES." | ||
| 132 | (traverse/depth-first (lambda (_ count) | ||
| 133 | (+ 1 count)) | ||
| 134 | 0 | ||
| 135 | nodes node-edges)) | ||
| 136 | |||
| 129 | 137 | ||
| 130 | ;;; | 138 | ;;; |
| 131 | ;;; Graphviz export. | 139 | ;;; Graphviz export. |
diff --git a/tests/graph.scm b/tests/graph.scm index 32317195d71..1ce06cc8179 100644 --- a/tests/graph.scm +++ b/tests/graph.scm | |||
| @@ -275,4 +275,17 @@ edges." | |||
| 275 | (return (lset= eq? (node-transitive-edges (list p2) edges) | 275 | (return (lset= eq? (node-transitive-edges (list p2) edges) |
| 276 | (list p1a p1b p0))))))) | 276 | (list p1a p1b p0))))))) |
| 277 | 277 | ||
| 278 | (test-equal "node-reachable-count" | ||
| 279 | '(3 3) | ||
| 280 | (run-with-store %store | ||
| 281 | (let* ((p0 (dummy-package "p0")) | ||
| 282 | (p1a (dummy-package "p1a" (inputs `(("p0" ,p0))))) | ||
| 283 | (p1b (dummy-package "p1b" (inputs `(("p0" ,p0))))) | ||
| 284 | (p2 (dummy-package "p2" (inputs `(("p1a" ,p1a) ("p1b" ,p1b)))))) | ||
| 285 | (mlet* %store-monad ((all -> (list p2 p1a p1b p0)) | ||
| 286 | (edges (node-edges %package-node-type all)) | ||
| 287 | (back (node-back-edges %package-node-type all))) | ||
| 288 | (return (list (node-reachable-count (list p2) edges) | ||
| 289 | (node-reachable-count (list p0) back))))))) | ||
| 290 | |||
| 278 | (test-end "graph") | 291 | (test-end "graph") |
