Added simple-paths function and tests

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)
+    [[start]]
+    (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]

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)
+       [[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]
+             [: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)