Merge pull request #46 from yetanalytics/fix-kosaraju

Fix cycle detection bug
yetanalytics · May 2, 2023 · 0bd5aa1 · 0bd5aa1
2 parents 9a5e84b + d1ad479
commit 0bd5aa1
Show file tree

Hide file tree

Showing 4 changed files with 175 additions and 9 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,6 +1,9 @@
 # Change Log
 All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
 
+## 0.5.4 - 2023-05-02
+- Fix bug in Pattern cycle detection where non-cyclic paths were incorrectly flagged as cycles.
+
 ## 0.5.3 - 2022-10-24
 - Update GitHub CD and CI to remove deprecation warnings.
 

diff --git a/README.md b/README.md
@@ -9,7 +9,7 @@ A Clojure library for validating xAPI Profiles, according to the [xAPI Profile s
 Add the following to the `:deps` map in your `deps.edn` file:
 
 ```clojure
-com.yetanalytics/project-pan {:mvn/version "0.5.3"
+com.yetanalytics/project-pan {:mvn/version "0.5.4"
                               :exclusions [org.clojure/clojure
                                            org.clojure/clojurescript]}
 ```
@@ -73,6 +73,6 @@ Besides validating whole Profiles, you can also use library methods and specs to
 
 ## License
 
-Copyright © 2019-2022 Yet Analytics, Inc.
+Copyright © 2019-2023 Yet Analytics, Inc.
 
 Project Pan is licensed under the Apache License, Version 2.0. See [LICENSE](LICENSE) for the full license text
diff --git a/src/main/com/yetanalytics/pan/graph.cljc b/src/main/com/yetanalytics/pan/graph.cljc
@@ -275,12 +275,24 @@
          visited visited
          result  []]
     (if-some [n (peek stack)]
-      (let [visited*     (conj visited n)
-            all-outs     (get-in graph [:adj n])
-            unvisit-outs (cset/difference all-outs visited*)]
-        (if (empty? unvisit-outs)
-          (recur (pop stack) visited* (conj result n))
-          (recur (apply conj stack unvisit-outs) visited* result)))
+      (if (contains? visited n)
+        ;; Note 1: Leaf nodes are visited twice, first to visit it, then
+        ;; to pop it off the stack and push it on the result list.
+        ;; Note 2: The stack may contain duplicate nodes if there are two
+        ;; paths that are in-adjacent to that node. Thus we must ensure that
+        ;; any node only shows up once in the result list.
+        (let [stack*  (pop stack)
+              result* (cond-> result
+                        (not (some #{n} result))
+                        (conj n))]
+          (recur stack* visited result*))
+        ;; Visit any unvisited nodes; exclude visited nodes from the stack
+        ;; as a micro-optimization.
+        (let [visited* (conj visited n)
+              all-outs (get-in graph [:adj n])
+              unv-outs (cset/difference all-outs visited*)
+              stack*   (into stack unv-outs)]
+          (recur stack* visited* result)))
       [result visited])))
 
 (defn- scc-forward-dfs
@@ -357,3 +369,4 @@
 
 (s/def ::singleton-sccs
   (s/coll-of ::singleton-scc :kind vector?))
+
diff --git a/src/test/com/yetanalytics/pan/graph_test.cljc b/src/test/com/yetanalytics/pan/graph_test.cljc
@@ -72,6 +72,109 @@
   (-> (graph/new-digraph)
       (graph/add-nodes (map (fn [n] [n]) (range 0 11)))))
 
+(defn- transpose
+  [adj]
+  (reduce-kv (fn [m in outs]
+               (reduce (fn [m* out]
+                         (update m* out (fnil conj #{in}) in))
+                       m
+                       outs))
+             {}
+             adj))
+
+;; Examples taken from the TC3 pofile
+(def ex-scc-graph-4-nodes
+  #{"soft-buddy-looped-after-init-prior-termination"
+    "soft-buddy-looped-optional-played"
+    "soft-buddy-looped-played"
+    "soft-buddy-looped-after-played-branch"
+    "soft-buddy-looped-with-completion"
+    "soft-buddy-looped-without-completion"
+    "completed:soft_buddy_looped"
+    "soft-buddy-looped-after-branch-prior-completion-zero+"
+    "soft-buddy-looped-after-branch-prior-completion"
+    "soft-buddy-looped-pause"
+    "paused:soft-buddy-looped"
+    "soft-buddy-looped-maybe-resume"
+    "soft-buddy-looped-maybe-any-time"
+    "played:soft_buddy_looped"
+    "soft-buddy-looped-any-time-after-init-but-before-termination"
+    "volumechange:soft_buddy_looped"
+    "seeked:soft_buddy_looped"})
+
+(def ex-scc-graph-4-adj
+  {"soft-buddy-looped-after-init-prior-termination"
+   #{"soft-buddy-looped-optional-played"
+     "soft-buddy-looped-maybe-any-time"}
+   "soft-buddy-looped-optional-played"
+   #{"soft-buddy-looped-played"}
+   "soft-buddy-looped-played"
+   #{"soft-buddy-looped-after-played-branch"
+     "soft-buddy-looped-maybe-any-time"
+     "played:soft_buddy_looped"}
+   "soft-buddy-looped-after-played-branch"
+   #{"soft-buddy-looped-with-completion"
+     "soft-buddy-looped-without-completion"}
+   "soft-buddy-looped-with-completion"
+   #{"soft-buddy-looped-without-completion"
+     "completed:soft_buddy_looped"}
+   "completed:soft_buddy_looped"
+   #{}
+   "soft-buddy-looped-without-completion"
+   #{"soft-buddy-looped-after-branch-prior-completion-zero+"
+     "soft-buddy-looped-maybe-any-time"}
+   "soft-buddy-looped-after-branch-prior-completion-zero+"
+   #{"soft-buddy-looped-after-branch-prior-completion"}
+   "soft-buddy-looped-after-branch-prior-completion"
+   #{"soft-buddy-looped-any-time-after-init-but-before-termination"
+     "soft-buddy-looped-pause"}
+   "soft-buddy-looped-pause"
+   #{"paused:soft-buddy-looped"
+     "soft-buddy-looped-maybe-resume"
+     "soft-buddy-looped-maybe-any-time"}
+   "paused:soft-buddy-looped"
+   #{}
+   "soft-buddy-looped-maybe-resume"
+   #{"played:soft_buddy_looped"}
+   "played:soft_buddy_looped"
+   #{}
+   "soft-buddy-looped-maybe-any-time"
+   #{"soft-buddy-looped-any-time-after-init-but-before-termination"}
+   "soft-buddy-looped-any-time-after-init-but-before-termination"
+   #{"volumechange:soft_buddy_looped"
+     "seeked:soft_buddy_looped"}
+   "volumechange:soft_buddy_looped"
+   #{}
+   "seeked:soft_buddy_looped"
+   #{}})
+
+(def ex-scc-graph-4
+  {:nodeset ex-scc-graph-4-nodes
+   :adj     ex-scc-graph-4-adj
+   :in      (transpose ex-scc-graph-4-adj)})
+
+(def ex-scc-graph-5-nodes ex-scc-graph-4-nodes)
+
+(def ex-scc-graph-5-adj
+  (-> ex-scc-graph-4-adj
+      (update "volumechange:soft_buddy_looped" conj "seeked:soft_buddy_looped")
+      (update "seeked:soft_buddy_looped" conj "volumechange:soft_buddy_looped")))
+
+(def ex-scc-graph-5
+  {:nodeset ex-scc-graph-5-nodes
+   :adj     ex-scc-graph-5-adj
+   :in      (transpose ex-scc-graph-5-adj)})
+
+(def ex-scc-graph-6-adj
+  (-> ex-scc-graph-5-adj
+      (update "volumechange:soft_buddy_looped" conj "soft-buddy-looped-after-init-prior-termination")
+      (update "soft-buddy-looped-after-init-prior-termination" conj "volumechange:soft_buddy_looped")))
+
+(def ex-scc-graph-6
+  {:nodeset ex-scc-graph-4-nodes
+   :adj     ex-scc-graph-6-adj
+   :in      (transpose ex-scc-graph-6-adj)})
+
 (deftest scc-test
   (testing "Kosaraju's algorithm"
     (is (= #{#{:a :b :c} #{:d :e :f}}
@@ -80,4 +183,51 @@
     (is (= #{#{2 4 10} #{1 3 5 6} #{11} #{7 8 9}}
            (->> (graph/scc ex-scc-graph-2) (map set) set)))
     (is (= [[0] [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]]
-           (->> (graph/scc ex-scc-graph-3) sort vec)))))
+           (->> (graph/scc ex-scc-graph-3) sort vec)))
+    ;; Fixed bug where false positive cycles were detected, due to the
+    ;; finishing order potentially having duplicate nodes from multiple visits
+    (let [scc-4 (graph/scc ex-scc-graph-4)]
+      (is (every? #(= 1 (count %)) scc-4))
+      (is (= (count (:nodeset ex-scc-graph-4))
+             (count scc-4))))
+    (let [scc-5 (graph/scc ex-scc-graph-5)]
+      (is (some #{["volumechange:soft_buddy_looped" "seeked:soft_buddy_looped"]
+                  ["seeked:soft_buddy_looped" "volumechange:soft_buddy_looped"]}
+                scc-5)))
+    (let [scc-6 (graph/scc ex-scc-graph-6)]
+      (is (= #{;; This forms the main cycle
+               ["seeked:soft_buddy_looped"
+                "volumechange:soft_buddy_looped"
+                "soft-buddy-looped-after-init-prior-termination"
+                "soft-buddy-looped-optional-played"
+                "soft-buddy-looped-played"
+                "soft-buddy-looped-after-played-branch"
+                "soft-buddy-looped-with-completion"
+                "soft-buddy-looped-without-completion"
+                "soft-buddy-looped-after-branch-prior-completion-zero+"
+                "soft-buddy-looped-after-branch-prior-completion"
+                "soft-buddy-looped-pause"
+                "soft-buddy-looped-maybe-any-time"
+                "soft-buddy-looped-any-time-after-init-but-before-termination"]
+               ;; These nodes branch off from the main cycle
+               ["completed:soft_buddy_looped"]
+               ["soft-buddy-looped-maybe-resume"]
+               ["played:soft_buddy_looped"]
+               ["paused:soft-buddy-looped"]}
+             (set scc-6))))))
+
+(comment
+  ;; To show the above graph on graphviz:
+  #?(:clj
+     (->> ex-scc-graph-4-adj
+          (reduce-kv
+           (fn [acc in outs]
+             (reduce
+              (fn [acc* out]
+                (str acc* (format "\"%s\" -> \"%s\";\n" in out)))
+              acc
+              outs))
+           "")
+          (format "digraph scc_graph {\n%s\n}")
+          (spit "out.dot")))
+  )