diff --git a/lib/relations/conformance.conf b/lib/relations/conformance.conf index b2607122..5d82c840 100644 --- a/lib/relations/conformance.conf +++ b/lib/relations/conformance.conf @@ -31,4 +31,5 @@ SUITES=( "tree:lib/relations/tests/tree.sx:(relations-tree-tests-run!)" "routes:lib/relations/tests/routes.sx:(relations-routes-tests-run!)" "bulk:lib/relations/tests/bulk.sx:(relations-bulk-tests-run!)" + "comp:lib/relations/tests/comp.sx:(relations-comp-tests-run!)" ) diff --git a/lib/relations/scoreboard.json b/lib/relations/scoreboard.json index 260679b4..c8b3c717 100644 --- a/lib/relations/scoreboard.json +++ b/lib/relations/scoreboard.json @@ -1,8 +1,8 @@ { "lang": "relations", - "total_passed": 147, + "total_passed": 158, "total_failed": 0, - "total": 147, + "total": 158, "suites": [ {"name":"direct","passed":22,"failed":0,"total":22}, {"name":"reach","passed":24,"failed":0,"total":24}, @@ -11,7 +11,8 @@ {"name":"shape","passed":18,"failed":0,"total":18}, {"name":"tree","passed":16,"failed":0,"total":16}, {"name":"routes","passed":9,"failed":0,"total":9}, - {"name":"bulk","passed":12,"failed":0,"total":12} + {"name":"bulk","passed":12,"failed":0,"total":12}, + {"name":"comp","passed":11,"failed":0,"total":11} ], - "generated": "2026-06-07T13:26:23+00:00" + "generated": "2026-06-07T13:42:22+00:00" } diff --git a/lib/relations/scoreboard.md b/lib/relations/scoreboard.md index 34556212..0b602b7d 100644 --- a/lib/relations/scoreboard.md +++ b/lib/relations/scoreboard.md @@ -1,6 +1,6 @@ # relations scoreboard -**147 / 147 passing** (0 failure(s)). +**158 / 158 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -12,3 +12,4 @@ | tree | 16 | 16 | ok | | routes | 9 | 9 | ok | | bulk | 12 | 12 | ok | +| comp | 11 | 11 | ok | diff --git a/lib/relations/tests/comp.sx b/lib/relations/tests/comp.sx new file mode 100644 index 00000000..1cd7593b --- /dev/null +++ b/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}))) diff --git a/lib/relations/tree.sx b/lib/relations/tree.sx index 931ef883..96463e91 100644 --- a/lib/relations/tree.sx +++ b/lib/relations/tree.sx @@ -103,6 +103,37 @@ ;; --- current-db convenience layer --- +(define + relations-component + (fn + (db node kind) + (relations-ureach-bfs db kind (list node) (list node)))) + +(define + relations-components-loop + (fn + (db kind remaining acc) + (if + (= (len remaining) 0) + acc + (let + ((comp (relations-component db (first remaining) kind))) + (relations-components-loop + db + kind + (filter (fn (n) (not (relations-eng-member? n comp))) remaining) + (append acc (list comp))))))) + +(define + relations-component-count + (fn (db kind) (len (relations-components db kind)))) + +(define + relations-components + (fn + (db kind) + (relations-components-loop db kind (relations-nodes db kind) (list)))) + (define relations/common-ancestors (fn @@ -116,3 +147,15 @@ (define relations/topo-order (fn (kind) (relations-topo-order (relations-ensure-db!) kind))) + +(define + relations/component + (fn (node kind) (relations-component (relations-ensure-db!) node kind))) + +(define + relations/components + (fn (kind) (relations-components (relations-ensure-db!) kind))) + +(define + relations/component-count + (fn (kind) (relations-component-count (relations-ensure-db!) kind))) diff --git a/plans/relations-on-sx.md b/plans/relations-on-sx.md index a9a6f1a8..c2f1b516 100644 --- a/plans/relations-on-sx.md +++ b/plans/relations-on-sx.md @@ -18,7 +18,7 @@ links. Reuses `lib/datalog/` — does not reimplement the engine. ## Status (rolling) -`bash lib/relations/conformance.sh` → **147/147** (Phases 1–4 complete + extensions) +`bash lib/relations/conformance.sh` → **158/158** (Phases 1–4 complete + extensions) ## Ground rules @@ -114,9 +114,22 @@ lib/relations/federation.sx cleanup: retract every local edge touching a node, all kinds, both directions — for domain object deletion; leaves federated peer links alone). api.sx, `lib/relations/tests/bulk.sx`. +- [x] **weakly-connected components** — `component` (the undirected cluster of a + node), `components` (partition of all nodes for a kind), `component-count`. In + tree.sx, reusing `ureach-bfs`. `lib/relations/tests/comp.sx`. ## Progress log +- **Extension: weakly-connected components** (158/158). `relations-component` + (the undirected cluster containing a node = `ureach-bfs` from it), + `relations-components` (greedy partition: pop a remaining node, take its + component, repeat) and `relations-component-count`, in tree.sx, + `relations/...` + wrappers. `lib/relations/tests/comp.sx` (11 tests: cluster from either end, self- + loop as its own component, partition contents, count, kind isolation, api). + Engine surface now feels SATURATED — base roadmap + 5 graph-algorithm extensions + cover direct/transitive/undirected reach, paths (shortest + all routes), cycles, + roots/leaves, siblings/degree, ancestors/LCA/topo, components, federation, and + bulk lifecycle. Pacing down. - **Extension: bulk lifecycle** (147/147). `relations-relate-many!` (batch `dl-assert!` over a list of (src dst kind) triples) and `relations-unrelate-node!` (query `rel` for every edge with the node as src or dst, across all kinds, then