# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1478614277 0
# Node ID f5d201dead81cfe387b18c9342ade90b3cf33044
# Parent  f5713558cc484a8e12be2c1497278080755a088a
Add `reachablep`

diff -r f5713558cc48 -r f5d201dead81 docs/03-reference.markdown
--- a/docs/03-reference.markdown	Mon Nov 07 00:01:20 2016 +0000
+++ b/docs/03-reference.markdown	Tue Nov 08 14:11:17 2016 +0000
@@ -240,6 +240,22 @@
 
 Return a fresh list of the predecessors of `vertex`.
 
+### `REACHABLEP` (function)
+
+    (REACHABLEP DIGRAPH START TARGET &KEY (STRATEGY :BREADTH-FIRST))
+
+Return `t` if it is possible to reach `target` from `start`, otherwise `nil`.
+
+  All vertices are reachable from themselves.
+
+  Otherwise a `target` is reachable from `start` if a directed path exists from
+  the start to the target.
+
+  `strategy` will be used to determine how to traverse the graph when searching
+  for a path, and can be one of `:breadth-first` or `:depth-first`.
+
+  
+
 ### `REMOVE-EDGE` (function)
 
     (REMOVE-EDGE DIGRAPH PREDECESSOR SUCCESSOR)
diff -r f5713558cc48 -r f5d201dead81 package.lisp
--- a/package.lisp	Mon Nov 07 00:01:20 2016 +0000
+++ b/package.lisp	Tue Nov 08 14:11:17 2016 +0000
@@ -39,4 +39,6 @@
 
     :topological-sort
 
+    :reachablep
+
     :copy-digraph))
diff -r f5713558cc48 -r f5d201dead81 src/directed-graph.lisp
--- a/src/directed-graph.lisp	Mon Nov 07 00:01:20 2016 +0000
+++ b/src/directed-graph.lisp	Tue Nov 08 14:11:17 2016 +0000
@@ -417,6 +417,29 @@
     (nreverse result)))
 
 
+(defun reachablep (digraph start target &key (strategy :breadth-first))
+  "Return `t` if it is possible to reach `target` from `start`, otherwise `nil`.
+
+  All vertices are reachable from themselves.
+
+  Otherwise a `target` is reachable from `start` if a directed path exists from
+  the start to the target.
+
+  `strategy` will be used to determine how to traverse the graph when searching
+  for a path, and can be one of `:breadth-first` or `:depth-first`.
+
+  "
+  (let* ((traverse (ecase strategy
+                     (:breadth-first #'mapc-breadth-first)
+                     (:depth-first #'mapc-depth-first)))
+         (test (digraph-test digraph))
+         (check (lambda (vertex)
+                  (when (funcall test vertex target)
+                    (return-from reachablep t)))))
+    (funcall traverse check digraph start)
+    nil))
+
+
 ;;;; Scratch ------------------------------------------------------------------
 (defun make-test-digraph ()
   ;; a ---->  middle  ----> z         ORPHAN
diff -r f5713558cc48 -r f5d201dead81 test/tests.lisp
--- a/test/tests.lisp	Mon Nov 07 00:01:20 2016 +0000
+++ b/test/tests.lisp	Tue Nov 08 14:11:17 2016 +0000
@@ -191,3 +191,12 @@
     (is (= 1 (degree-out g 'z)))
     (is (= 0 (degree g 'orphan)))))
 
+
+(define-test reachablep
+  (let ((g (make-simple-digraph)))
+    (is (reachablep g 'orphan 'orphan))
+    (is (reachablep g 'b 'a))
+    (is (reachablep g 'b 'z))
+    (is (not (reachablep g 'a 'b)))
+    (is (not (reachablep g 'z 'orphan)))))
+