relations: shape queries (siblings, in/out-degree, undirected connected?) computed in SX + 18 tests

Keep the Datalog ruleset minimal — every dl-query re-saturates, so shape
queries are SX BFS over erel, not extra closures. 110/110.

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

lib/relations/api.sx

@@ -84,3 +84,19 @@
 (define
   relations/acyclic?
   (fn (kind) (relations-acyclic? (relations-ensure-db!) kind)))
+
+(define
+  relations/siblings
+  (fn (node kind) (relations-siblings (relations-ensure-db!) node kind)))
+
+(define
+  relations/out-degree
+  (fn (node kind) (relations-out-degree (relations-ensure-db!) node kind)))
+
+(define
+  relations/in-degree
+  (fn (node kind) (relations-in-degree (relations-ensure-db!) node kind)))
+
+(define
+  relations/connected?
+  (fn (a b kind) (relations-connected? (relations-ensure-db!) a b kind)))

lib/relations/conformance.conf

@@ -26,4 +26,5 @@ SUITES=(
   "reach:lib/relations/tests/reach.sx:(relations-reach-tests-run!)"
   "path:lib/relations/tests/path.sx:(relations-path-tests-run!)"
   "fed:lib/relations/tests/fed.sx:(relations-fed-tests-run!)"
+  "shape:lib/relations/tests/shape.sx:(relations-shape-tests-run!)"
 )

lib/relations/engine.sx

@@ -1,8 +1,14 @@
-;; lib/relations/engine.sx — recursive reachability + roots/leaves + cycles.
+;; lib/relations/engine.sx — recursive reachability + roots/leaves + cycles +
+;; shape queries.
 ;;
-;; The whole engine is one Datalog ruleset, derived from the EFFECTIVE relation
-;; `erel`, not raw `rel`. `erel` unions local edges with trust-gated federated
-;; edges:
+;; The Datalog ruleset is deliberately MINIMAL — every dl-query re-saturates it,
+;; so each added recursive relation taxes every query in every suite. Reachability
+;; (`reach`/`reach_any`), node membership (`rnode`) and root/leaf are the only
+;; derived relations; the shape queries (siblings, undirected connectivity) are
+;; computed in SX over the fast direct `erel` queries, NOT as extra closures.
+;;
+;; The ruleset derives from the EFFECTIVE relation `erel`, not raw `rel`. `erel`
+;; unions local edges with trust-gated federated edges:
 ;;
 ;;   erel(S,D,K) :- rel(S,D,K).                       ; local edge, always
 ;;   erel(S,D,K) :- peer_rel(P,S,D,K), trust(P).      ; peer edge, gated by trust
@@ -18,13 +24,11 @@
 ;;   reach(K,X,Y) :- erel(X,Y,K).                  ; one hop
 ;;   reach(K,X,Y) :- erel(X,Z,K), reach(K,Z,Y).    ; transitive
 ;;
-;; `reach_any` is the kind-agnostic closure (any edge, any kind) used for
-;; mixed-kind reachability — distinct from single-kind `reach`.
-;;
-;; rnode collects the nodes touched by a kind; root/leaf are those with no
-;; incoming / no outgoing edge (stratified negation over has_parent/has_child).
-;; Cycles are ordinary data: `reach(K,X,X)` simply holds for nodes on a cycle —
-;; cycle?/acyclic? are queries, not errors. Do not assume a DAG.
+;; `reach_any` is the kind-agnostic closure (any edge, any kind) for mixed-kind
+;; reachability. rnode collects the nodes touched by a kind; root/leaf are those
+;; with no incoming / no outgoing edge (stratified negation). Cycles are ordinary
+;; data: `reach(K,X,X)` simply holds for nodes on a cycle — cycle?/acyclic? are
+;; queries, not errors. Do not assume a DAG.
 
 (define
   relations-rules
@@ -47,6 +51,44 @@
   relations-pluck
   (fn (substs key) (map (fn (s) (get s key)) substs)))
 
+;; Membership without host-name clashes (schema.sx defines relations-member?,
+;; but engine.sx may load before schema in ad-hoc sessions — keep a local copy).
+(define
+  relations-eng-member?
+  (fn
+    (x xs)
+    (cond
+      ((= (len xs) 0) false)
+      ((= (first xs) x) true)
+      (else (relations-eng-member? x (rest xs))))))
+
+(define
+  relations-concat-map
+  (fn
+    (f xs)
+    (if
+      (= (len xs) 0)
+      (list)
+      (append (f (first xs)) (relations-concat-map f (rest xs))))))
+
+(define
+  relations-dedup
+  (fn
+    (xs)
+    (if
+      (= (len xs) 0)
+      (list)
+      (let
+        ((r (relations-dedup (rest xs))))
+        (if
+          (relations-eng-member? (first xs) r)
+          r
+          (append (list (first xs)) r))))))
+
+(define
+  relations-without
+  (fn (x xs) (filter (fn (e) (not (= e x))) xs)))
+
 ;; Direct children: every Dst with an effective edge erel(node, Dst, kind).
 (define
   relations-children-of
@@ -144,3 +186,51 @@
     (=
       (len (dl-query db (list (quote reach) kind (quote X) (quote X))))
       0)))
+
+;; Siblings: nodes sharing a parent with node under kind (excluding node).
+;; Computed in SX over direct queries — no extra Datalog closure.
+(define
+  relations-siblings
+  (fn
+    (db node kind)
+    (relations-without
+      node
+      (relations-dedup
+        (relations-concat-map
+          (fn (p) (relations-children-of db p kind))
+          (relations-parents-of db node kind))))))
+
+;; Out-degree: number of direct children under kind.
+(define
+  relations-out-degree
+  (fn (db node kind) (len (relations-children-of db node kind))))
+
+;; In-degree: number of direct parents under kind.
+(define
+  relations-in-degree
+  (fn (db node kind) (len (relations-parents-of db node kind))))
+
+;; Undirected BFS frontier expansion: grow `visited` by neighbours (either
+;; direction) until the frontier is empty. Reuses the fast `erel` queries.
+(define
+  relations-ureach-bfs
+  (fn
+    (db kind frontier visited)
+    (if
+      (= (len frontier) 0)
+      visited
+      (let
+        ((fresh (filter (fn (n) (not (relations-eng-member? n visited))) (relations-dedup (relations-concat-map (fn (n) (relations-related db n kind)) frontier)))))
+        (relations-ureach-bfs db kind fresh (append visited fresh))))))
+
+;; Weakly connected: a and b joined by a path ignoring edge direction, under
+;; kind. (Reflexive — a node is connected to itself.)
+(define
+  relations-connected?
+  (fn
+    (db a b kind)
+    (or
+      (= a b)
+      (relations-eng-member?
+        b
+        (relations-ureach-bfs db kind (list a) (list a))))))

lib/relations/scoreboard.json

@@ -1,13 +1,14 @@
 {
   "lang": "relations",
-  "total_passed": 92,
+  "total_passed": 110,
   "total_failed": 0,
-  "total": 92,
+  "total": 110,
   "suites": [
     {"name":"direct","passed":22,"failed":0,"total":22},
     {"name":"reach","passed":24,"failed":0,"total":24},
     {"name":"path","passed":24,"failed":0,"total":24},
-    {"name":"fed","passed":22,"failed":0,"total":22}
+    {"name":"fed","passed":22,"failed":0,"total":22},
+    {"name":"shape","passed":18,"failed":0,"total":18}
   ],
-  "generated": "2026-06-07T12:14:10+00:00"
+  "generated": "2026-06-07T12:55:58+00:00"
 }

lib/relations/scoreboard.md

@@ -1,6 +1,6 @@
 # relations scoreboard
 
-**92 / 92 passing** (0 failure(s)).
+**110 / 110 passing** (0 failure(s)).
 
 | Suite | Passed | Total | Status |
 |-------|--------|-------|--------|
@@ -8,3 +8,4 @@
 | reach | 24 | 24 | ok |
 | path | 24 | 24 | ok |
 | fed | 22 | 22 | ok |
+| shape | 18 | 18 | ok |

lib/relations/tests/shape.sx

@@ -0,0 +1,161 @@
+;; lib/relations/tests/shape.sx — extension: siblings, degree, undirected
+;; connectivity.
+
+(define relations-st-pass 0)
+(define relations-st-fail 0)
+(define relations-st-failures (list))
+
+(define
+  relations-st-check!
+  (fn
+    (name got expected)
+    (if
+      (= got expected)
+      (set! relations-st-pass (+ relations-st-pass 1))
+      (do
+        (set! relations-st-fail (+ relations-st-fail 1))
+        (append!
+          relations-st-failures
+          (str name "\n    expected: " expected "\n    got:      " got))))))
+
+(define
+  relations-st-subset?
+  (fn
+    (xs ys)
+    (cond
+      ((= (len xs) 0) true)
+      ((relations-member? (first xs) ys)
+        (relations-st-subset? (rest xs) ys))
+      (else false))))
+
+(define
+  relations-st-set=?
+  (fn
+    (xs ys)
+    (and
+      (= (len xs) (len ys))
+      (relations-st-subset? xs ys)
+      (relations-st-subset? ys xs))))
+
+;; A small tree plus a disconnected pair.
+;;   parent: p->a, p->b, p->c, a->d ; q->r (disconnected)
+;;   member: m->x, m->y (a different kind, same db)
+(define
+  relations-st-fixture
+  (fn
+    ()
+    (relations-build-db
+      (list
+        (relations-rel (quote p) (quote a) (quote parent))
+        (relations-rel (quote p) (quote b) (quote parent))
+        (relations-rel (quote p) (quote c) (quote parent))
+        (relations-rel (quote a) (quote d) (quote parent))
+        (relations-rel (quote q) (quote r) (quote parent))
+        (relations-rel (quote m) (quote x) (quote member))
+        (relations-rel (quote m) (quote y) (quote member))))))
+
+(define
+  relations-st-run-all!
+  (fn
+    ()
+    (let
+      ((db (relations-st-fixture)))
+      (do
+        (relations-st-check!
+          "siblings of a"
+          (relations-st-set=?
+            (relations-siblings db (quote a) (quote parent))
+            (list (quote b) (quote c)))
+          true)
+        (relations-st-check!
+          "only child has no siblings"
+          (relations-siblings db (quote d) (quote parent))
+          (list))
+        (relations-st-check!
+          "siblings respect kind"
+          (relations-st-set=?
+            (relations-siblings db (quote x) (quote member))
+            (list (quote y)))
+          true)
+        (relations-st-check!
+          "no cross-kind siblings"
+          (relations-siblings db (quote a) (quote member))
+          (list))
+        (relations-st-check!
+          "out-degree of p"
+          (relations-out-degree db (quote p) (quote parent))
+          3)
+        (relations-st-check!
+          "out-degree of a"
+          (relations-out-degree db (quote a) (quote parent))
+          1)
+        (relations-st-check!
+          "out-degree of leaf"
+          (relations-out-degree db (quote d) (quote parent))
+          0)
+        (relations-st-check!
+          "in-degree of a"
+          (relations-in-degree db (quote a) (quote parent))
+          1)
+        (relations-st-check!
+          "in-degree of root"
+          (relations-in-degree db (quote p) (quote parent))
+          0)
+        (relations-st-check!
+          "siblings are connected"
+          (relations-connected? db (quote b) (quote c) (quote parent))
+          true)
+        (relations-st-check!
+          "cousin connected (b <-> d)"
+          (relations-connected? db (quote b) (quote d) (quote parent))
+          true)
+        (relations-st-check!
+          "self connected"
+          (relations-connected? db (quote a) (quote a) (quote parent))
+          true)
+        (relations-st-check!
+          "disconnected components not connected"
+          (relations-connected? db (quote a) (quote q) (quote parent))
+          false)
+        (relations-st-check!
+          "directed-unreachable but undirected-connected"
+          (and
+            (not
+              (relations-reachable? db (quote b) (quote c) (quote parent)))
+            (relations-connected? db (quote b) (quote c) (quote parent)))
+          true)
+        (relations-st-check!
+          "connectivity respects kind"
+          (relations-connected? db (quote a) (quote x) (quote member))
+          false)
+        (do
+          (relations/load!
+            (list
+              (relations-rel (quote g) (quote h) (quote parent))
+              (relations-rel (quote g) (quote i) (quote parent))))
+          (relations-st-check!
+            "api siblings"
+            (relations-st-set=?
+              (relations/siblings (quote h) (quote parent))
+              (list (quote i)))
+            true)
+          (relations-st-check!
+            "api out-degree"
+            (relations/out-degree (quote g) (quote parent))
+            2)
+          (relations-st-check!
+            "api connected"
+            (relations/connected? (quote h) (quote i) (quote parent))
+            true)
+          (relations/load! (list)))))))
+
+(define
+  relations-shape-tests-run!
+  (fn
+    ()
+    (do
+      (set! relations-st-pass 0)
+      (set! relations-st-fail 0)
+      (set! relations-st-failures (list))
+      (relations-st-run-all!)
+      {:failures relations-st-failures :total (+ relations-st-pass relations-st-fail) :passed relations-st-pass :failed relations-st-fail})))

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` → **92/92** (Phases 1–4 complete)
+`bash lib/relations/conformance.sh` → **110/110** (Phases 1–4 complete + extensions)
 
 ## Ground rules
 
@@ -98,8 +98,27 @@ lib/relations/federation.sx
 - [x] `lib/relations/tests/fed.sx` — federated reachability chains, trust gating,
   revocation
 
+## Extensions (post-roadmap)
+
+- [x] **shape queries** — `siblings` (nodes sharing a parent), `out-degree`/
+  `in-degree`, weakly-connected `connected?` (undirected reachability). Computed in
+  SX over the fast direct `erel` queries (BFS) — deliberately NOT added as Datalog
+  closures, to keep the per-query saturation cheap. `lib/relations/tests/shape.sx`.
+
 ## Progress log
 
+- **Extension: shape queries** (110/110). Added `relations-siblings`,
+  `relations-out-degree`/`-in-degree`, `relations-connected?` (+ `relations/...`
+  current-db wrappers) and `shape.sx` (18 tests). Design note: an earlier attempt
+  added `sibling`/`uedge`/`ureach` as Datalog rules in the global `relations-rules`;
+  because every `dl-query` re-saturates the whole program, the extra recursive
+  undirected closure taxed EVERY query in EVERY suite and the full run blew past
+  10 min. Reverted the ruleset to the Phase-4 set and compute these in SX instead:
+  siblings = children-of(parents-of(node)) − node; connected? = undirected BFS
+  expanding `relations-related` (children ∪ parents) per frontier with a visited
+  set. No new saturation cost; other suites unaffected. NB: the full 110-test
+  conformance takes several minutes under shared-machine contention (sibling loops)
+  — run with `timeout 1200` in the background; individual suites run in seconds.
 - **Phase 4 — federation** (92/92). Re-derived acl's trust-gate shape (not
   copied). engine.sx now derives the whole engine from an EFFECTIVE relation
   `erel` rather than raw `rel`: `erel(S,D,K) :- rel(S,D,K)` (local, always) and