From 1121122002d1763a8549356fc5804dab2cb1cb95 Mon Sep 17 00:00:00 2001
From: Matt Revelle <mrevelle@gmail.com>
Date: Sat, 12 Jan 2019 21:16:30 -0700
Subject: [PATCH 1/2] Added simple-paths function and tests.

---
 src/loom/alg.cljc       | 40 ++++++++++++++++++++++++++++++++++++++++
 test/loom/test/alg.cljc | 23 ++++++++++++++++++++++-
 2 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/src/loom/alg.cljc b/src/loom/alg.cljc
index b3008b1..5dcabcf 100644
--- a/src/loom/alg.cljc
+++ b/src/loom/alg.cljc
@@ -283,6 +283,46 @@ can use these functions."
       [start]
       (bf-traverse g start :f vector)))))
 
+(defn simple-paths
+  "Finds all simple paths from start node to end node. Paths are represented as
+  a collection of nodes in traversal order."
+  [g start end & {:keys [max-depth] :or {max-depth nil}}]
+  (if (= start end)
+    [[]]
+    (letfn [(create-path-map []
+              {:members #{}
+               :path []})
+            (add-path-node [pm n]
+              (-> pm
+                  (update :members conj n)
+                  (update :path conj n)))]
+      (loop [q #?(:clj clojure.lang.PersistentQueue/EMPTY
+                  :cljs cljs.core/PersistentQueue.EMPTY)
+             completed-paths []
+             p (-> (create-path-map)
+                   (add-path-node start))]
+        (let [p-last (-> p :path peek)
+              unseen-succs (filter (comp not (:members p)) (successors g p-last))
+              succ-ps (map (partial add-path-node p) unseen-succs)
+              updated-q (reduce conj q (filter (fn [succ-p]
+                                                 ;; Check if not a completed path and not
+                                                 ;; longer than max-depth, if specified
+                                                 (and (-> succ-p :path peek (= end) not)
+                                                      (if (nil? max-depth)
+                                                        true
+                                                        (-> succ-p :path count (< max-depth)))))
+                                               succ-ps))
+              updated-completed-paths (reduce conj
+                                              completed-paths
+                                              (->> succ-ps
+                                                   (filter (comp (partial = end) peek :path))
+                                                   (map :path)))]
+          (if (-> updated-q empty? not)
+            (recur (pop updated-q)
+                   updated-completed-paths
+                   (peek updated-q))
+            updated-completed-paths))))))
+
 (defn- bellman-ford-transform
   "Helper function for Johnson's algorithm. Uses Bellman-Ford to remove negative weights."
   [wg]
diff --git a/test/loom/test/alg.cljc b/test/loom/test/alg.cljc
index 25d9565..fa7738c 100644
--- a/test/loom/test/alg.cljc
+++ b/test/loom/test/alg.cljc
@@ -12,7 +12,7 @@
                               bipartite-color bipartite? bipartite-sets
                               coloring? greedy-coloring prim-mst-edges
                               prim-mst-edges prim-mst astar-path astar-dist
-                              degeneracy-ordering maximal-cliques
+                              degeneracy-ordering maximal-cliques simple-paths
                               subgraph? eql? isomorphism?]]
             [loom.derived :refer [mapped-by]]
             clojure.walk
@@ -238,6 +238,27 @@
        #?@(:clj [[:a :e :j] (bf-path-bi g4 :a :j)
                  true (some #(= % (bf-path-bi g5 :g :d)) [[:g :a :b :d] [:g :f :e :d]])])))
 
+(deftest simple-paths-test
+  (are [expected got] (= expected got)
+       [[]] (simple-paths g6 0 0)
+       [[]] (simple-paths g5 :a :a)
+       (set [[:a :b :d]
+             [:a :c :e :d]
+             [:a :c :f :e :d]
+             [:a :b :c :e :d]
+             [:a :b :c :f :e :d]]) (set (simple-paths g5 :a :d))
+       (set [[0 1 3 4]
+             [0 1 2 4]]) (set (simple-paths g6 0 4))
+       (set [[:a :b :d]]) (set (simple-paths g11 :a :d))
+       (set [[:a :b :e :f :g]
+             [:a :b :f :g]
+             [:a :b :c :g]
+             [:a :b :c :d :h :g]]) (set (simple-paths g10 :a :g))
+       (set [[:a :b :e :f :g]
+             [:a :b :f :g]
+             [:a :b :c :g]]) (set (simple-paths g10 :a :g :max-depth 5))
+       (set []) (set (simple-paths g10 :a :g :max-depth 2))))
+
 (deftest dijkstra-test
   (are [expected got] (= expected got)
        [:a :c :h :j] (dijkstra-path g4 :a :j)

From 23a1515efebac352c0a0910a158e97f9d3a189cf Mon Sep 17 00:00:00 2001
From: Matt Revelle <mrevelle@gmail.com>
Date: Sat, 12 Jan 2019 21:27:57 -0700
Subject: [PATCH 2/2] Changed result for simple-paths when start and end node
 are the same.

---
 src/loom/alg.cljc       | 2 +-
 test/loom/test/alg.cljc | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/loom/alg.cljc b/src/loom/alg.cljc
index 5dcabcf..e4ad805 100644
--- a/src/loom/alg.cljc
+++ b/src/loom/alg.cljc
@@ -288,7 +288,7 @@ can use these functions."
   a collection of nodes in traversal order."
   [g start end & {:keys [max-depth] :or {max-depth nil}}]
   (if (= start end)
-    [[]]
+    [[start]]
     (letfn [(create-path-map []
               {:members #{}
                :path []})
diff --git a/test/loom/test/alg.cljc b/test/loom/test/alg.cljc
index fa7738c..efe7337 100644
--- a/test/loom/test/alg.cljc
+++ b/test/loom/test/alg.cljc
@@ -240,8 +240,8 @@
 
 (deftest simple-paths-test
   (are [expected got] (= expected got)
-       [[]] (simple-paths g6 0 0)
-       [[]] (simple-paths g5 :a :a)
+       [[0]] (simple-paths g6 0 0)
+       [[:a]] (simple-paths g5 :a :a)
        (set [[:a :b :d]
              [:a :c :e :d]
              [:a :c :f :e :d]