ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

graph: Add 'node-reachable-count'.

Browse source 
* guix/graph.scm (node-reachable-count): New procedure.
* tests/graph.scm ("node-reachable-count"): New test.
This commit is contained in:
Ludovic Courtès 2016-05-23 23:03:23 +02:00
parent 623e4df42a
commit e144e3427d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
guix/graph.scm
View file

@ -39,6 +39,7 @@ (define-module (guix graph)
node-back-edges node-back-edges
traverse/depth-first traverse/depth-first
node-transitive-edges node-transitive-edges
node-reachable-count
%graphviz-backend %graphviz-backend
graph-backend? graph-backend?
@ -126,6 +127,13 @@ (define (node-transitive-edges nodes node-edges)
typically returned by 'node-edges' or 'node-back-edges'." typically returned by 'node-edges' or 'node-back-edges'."
(traverse/depth-first cons '() nodes node-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. ;;; Graphviz export.

13
tests/graph.scm
View file

@ -275,4 +275,17 @@ (define (edge->tuple source target)
(return (lset= eq? (node-transitive-edges (list p2) edges) (return (lset= eq? (node-transitive-edges (list p2) edges)
(list p1a p1b p0))))))) (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") (test-end "graph")