03/03: graph: Add 'node-reachable-count'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e144e3427da93b962c7620ce2bd64add8c83cfdc
Author: Ludovic Courtès <address@hidden>
Date:   Mon May 23 23:03:23 2016 +0200

    graph: Add 'node-reachable-count'.
    
    * guix/graph.scm (node-reachable-count): New procedure.
    * tests/graph.scm ("node-reachable-count"): New test.
---
 guix/graph.scm  |    8 ++++++++
 tests/graph.scm |   13 +++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/guix/graph.scm b/guix/graph.scm
index af589c5..735d340 100644
--- a/guix/graph.scm
+++ b/guix/graph.scm
@@ -39,6 +39,7 @@
             node-back-edges
             traverse/depth-first
             node-transitive-edges
+            node-reachable-count
 
             %graphviz-backend
             graph-backend?
@@ -126,6 +127,13 @@ procedure that, given a node, returns its list of direct 
dependents; it is
 typically returned by 'node-edges' or 'node-back-edges'."
   (traverse/depth-first cons '() nodes node-edges))
 
+(define (node-reachable-count nodes node-edges)
+  "Return the number of nodes reachable from NODES along NODE-EDGES."
+  (traverse/depth-first (lambda (_ count)
+                          (+ 1 count))
+                        0
+                        nodes node-edges))
+
 
 ;;;
 ;;; Graphviz export.
diff --git a/tests/graph.scm b/tests/graph.scm
index 3231719..1ce06cc 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -275,4 +275,17 @@ edges."
         (return (lset= eq? (node-transitive-edges (list p2) edges)
                        (list p1a p1b p0)))))))
 
+(test-equal "node-reachable-count"
+  '(3 3)
+  (run-with-store %store
+    (let* ((p0  (dummy-package "p0"))
+           (p1a (dummy-package "p1a" (inputs `(("p0" ,p0)))))
+           (p1b (dummy-package "p1b" (inputs `(("p0" ,p0)))))
+           (p2  (dummy-package "p2" (inputs `(("p1a" ,p1a) ("p1b" ,p1b))))))
+      (mlet* %store-monad ((all -> (list p2 p1a p1b p0))
+                           (edges  (node-edges %package-node-type all))
+                           (back   (node-back-edges %package-node-type all)))
+        (return (list (node-reachable-count (list p2) edges)
+                      (node-reachable-count (list p0) back)))))))
+
 (test-end "graph")