relations: weakly-connected components (component, components partition, count) + 11 tests

tree.sx, reuses ureach-bfs. 158/158 across 9 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/relations/tests/comp.sx

@@ -0,0 +1,144 @@
+;; lib/relations/tests/comp.sx — extension: weakly-connected components.
+
+(define relations-cp-pass 0)
+(define relations-cp-fail 0)
+(define relations-cp-failures (list))
+
+(define
+  relations-cp-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! relations-cp-pass (+ relations-cp-pass 1))
+      (do
+        (set! relations-cp-fail (+ relations-cp-fail 1))
+        (append!
+          relations-cp-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define
+  relations-cp-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-member? (first xs) ys)
+        (relations-cp-subset? (rest xs) ys))
+      (else false))))
+
+(define
+  relations-cp-set=?
+  (fn
+    (xs ys)
+    (and
+      (= (len xs) (len ys))
+      (relations-cp-subset? xs ys)
+      (relations-cp-subset? ys xs))))
+
+;; Does `comps` (a list of node-lists) contain a component set-equal to `want`?
+(define
+  relations-cp-has-comp?
+  (fn
+    (comps want)
+    (cond
+      ((= (len comps) 0) false)
+      ((relations-cp-set=? (first comps) want) true)
+      (else (relations-cp-has-comp? (rest comps) want)))))
+
+;; Three parent components + a separate member graph.
+;;   parent: a->b, b->c ; x->y ; z->z (self-loop, its own component)
+;;   member: m->n
+(define
+  relations-cp-fixture
+  (fn
+    ()
+    (relations-build-db
+      (list
+        (relations-rel (quote a) (quote b) (quote parent))
+        (relations-rel (quote b) (quote c) (quote parent))
+        (relations-rel (quote x) (quote y) (quote parent))
+        (relations-rel (quote z) (quote z) (quote parent))
+        (relations-rel (quote m) (quote n) (quote member))))))
+
+(define
+  relations-cp-run-all!
+  (fn
+    ()
+    (let
+      ((db (relations-cp-fixture)))
+      (do
+        (relations-cp-check!
+          "component of a"
+          (relations-cp-set=?
+            (relations-component db (quote a) (quote parent))
+            (list (quote a) (quote b) (quote c)))
+          true)
+        (relations-cp-check!
+          "component of c (same as a, undirected)"
+          (relations-cp-set=?
+            (relations-component db (quote c) (quote parent))
+            (list (quote a) (quote b) (quote c)))
+          true)
+        (relations-cp-check!
+          "self-loop node is its own component"
+          (relations-cp-set=?
+            (relations-component db (quote z) (quote parent))
+            (list (quote z)))
+          true)
+        (relations-cp-check!
+          "three parent components"
+          (relations-component-count db (quote parent))
+          3)
+        (relations-cp-check!
+          "one member component"
+          (relations-component-count db (quote member))
+          1)
+        (let
+          ((comps (relations-components db (quote parent))))
+          (do
+            (relations-cp-check!
+              "partition includes a-b-c"
+              (relations-cp-has-comp?
+                comps
+                (list (quote a) (quote b) (quote c)))
+              true)
+            (relations-cp-check!
+              "partition includes x-y"
+              (relations-cp-has-comp? comps (list (quote x) (quote y)))
+              true)
+            (relations-cp-check!
+              "partition includes z"
+              (relations-cp-has-comp? comps (list (quote z)))
+              true)))
+        (relations-cp-check!
+          "kind isolation: member component count is 1"
+          (relations-component-count db (quote member))
+          1)
+        (do
+          (relations/load!
+            (list
+              (relations-rel (quote p) (quote q) (quote parent))
+              (relations-rel (quote r) (quote s) (quote parent))))
+          (relations-cp-check!
+            "api component"
+            (relations-cp-set=?
+              (relations/component (quote p) (quote parent))
+              (list (quote p) (quote q)))
+            true)
+          (relations-cp-check!
+            "api component-count"
+            (relations/component-count (quote parent))
+            2)
+          (relations/load! (list)))))))
+
+(define
+  relations-comp-tests-run!
+  (fn
+    ()
+    (do
+      (set! relations-cp-pass 0)
+      (set! relations-cp-fail 0)
+      (set! relations-cp-failures (list))
+      (relations-cp-run-all!)
+      {:failures relations-cp-failures :total (+ relations-cp-pass relations-cp-fail) :passed relations-cp-pass :failed relations-cp-fail})))