--- 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)
--- 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))
--- 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
--- 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)))))
+