From ffe3ec25ac3c66acf8d6af5f18cfac20d7e33861 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 12:06:04 +0000 Subject: [PATCH] relations: Phase 3 path explanation + distance + mixed-kind reachability (explain.sx, reach_any) + 24 tests Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/relations/conformance.conf | 2 + lib/relations/engine.sx | 21 ++++ lib/relations/explain.sx | 86 +++++++++++++++ lib/relations/scoreboard.json | 9 +- lib/relations/scoreboard.md | 3 +- lib/relations/tests/path.sx | 192 +++++++++++++++++++++++++++++++++ plans/relations-on-sx.md | 28 ++++- 7 files changed, 331 insertions(+), 10 deletions(-) create mode 100644 lib/relations/explain.sx create mode 100644 lib/relations/tests/path.sx diff --git a/lib/relations/conformance.conf b/lib/relations/conformance.conf index 129bb74b..dbc8652b 100644 --- a/lib/relations/conformance.conf +++ b/lib/relations/conformance.conf @@ -17,9 +17,11 @@ PRELOADS=( lib/relations/schema.sx lib/relations/engine.sx lib/relations/api.sx + lib/relations/explain.sx ) SUITES=( "direct:lib/relations/tests/direct.sx:(relations-direct-tests-run!)" "reach:lib/relations/tests/reach.sx:(relations-reach-tests-run!)" + "path:lib/relations/tests/path.sx:(relations-path-tests-run!)" ) diff --git a/lib/relations/engine.sx b/lib/relations/engine.sx index af75696b..d8ac6f6f 100644 --- a/lib/relations/engine.sx +++ b/lib/relations/engine.sx @@ -8,6 +8,9 @@ ;; reach(K,X,Y) :- rel(X,Y,K). ; one hop ;; reach(K,X,Y) :- rel(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 — @@ -18,6 +21,8 @@ (quote ((reach K X Y <- (rel X Y K)) (reach K X Y <- (rel X Z K) (reach K Z Y)) + (reach_any X Y <- (rel X Y K)) + (reach_any X Y <- (rel X Z K) (reach_any Z Y)) (rnode K X <- (rel X Y K)) (rnode K Y <- (rel X Y K)) (has_parent K Y <- (rel X Y K)) @@ -55,6 +60,22 @@ (db a b kind) (> (len (dl-query db (list (quote reach) kind a b))) 0))) +;; Mixed-kind: descendants reachable from node over edges of ANY kind. +(define + relations-descendants-any + (fn + (db node) + (relations-pluck + (dl-query db (list (quote reach_any) node (quote Y))) + :Y))) + +;; Mixed-kind: is b reachable from a over edges of ANY kind? +(define + relations-reachable-any? + (fn + (db a b) + (> (len (dl-query db (list (quote reach_any) a b))) 0))) + ;; Roots: nodes touched by kind with no incoming edge. (define relations-roots diff --git a/lib/relations/explain.sx b/lib/relations/explain.sx new file mode 100644 index 00000000..09369f8c --- /dev/null +++ b/lib/relations/explain.sx @@ -0,0 +1,86 @@ +;; lib/relations/explain.sx — the connecting path: relations' answer to acl's +;; proof tree. +;; +;; A `reach(K,a,b)` derivation is a chain of one-hop `rel` facts a→…→b. The path +;; IS that derivation read off as the node sequence. lib/datalog/ records derived +;; facts but not provenance, so we re-derive the chain over the saturated edge +;; set — but breadth-first, so the path returned is a SHORTEST derivation (fewest +;; hops). Every consecutive pair in the result is a real rel(x,y,kind) fact; no +;; edges are invented. Cycles are handled by a visited set, so cyclic data +;; terminates rather than looping. +;; +;; (relations-path db a b kind) → (a … b) | nil +;; (relations-distance db a b k) → hop count | nil + +(define relations-last (fn (xs) (nth xs (- (len xs) 1)))) + +(define + relations-filter-unseen + (fn (xs seen) (filter (fn (x) (not (relations-member? x seen))) xs))) + +;; Breadth-first over the kind's edge set. `queue` is a list of partial paths +;; (each a node list ending at its frontier node); `visited` is every node ever +;; enqueued, so each node is expanded once and the first path to reach b is a +;; shortest one. +(define + relations-path-bfs + (fn + (db b kind queue visited) + (if + (= (len queue) 0) + nil + (let + ((path (first queue))) + (let + ((node (relations-last path))) + (if + (= node b) + path + (let + ((succs (relations-filter-unseen (relations-children-of db node kind) visited))) + (relations-path-bfs + db + b + kind + (append + (rest queue) + (map (fn (s) (append path (list s))) succs)) + (append visited succs))))))))) + +;; The connecting chain a→…→b under kind (shortest), or nil if unreachable. +;; a = b returns the trivial one-node path. +(define + relations-path + (fn + (db a b kind) + (if + (= a b) + (list a) + (relations-path-bfs db b kind (list (list a)) (list a))))) + +;; Hop count of the shortest path (0 for a=b), or nil if unreachable. +(define + relations-distance + (fn + (db a b kind) + (let + ((p (relations-path db a b kind))) + (if (= p nil) nil (- (len p) 1))))) + +;; --- current-db convenience layer --- + +(define + relations/path + (fn (a b kind) (relations-path (relations-ensure-db!) a b kind))) + +(define + relations/distance + (fn (a b kind) (relations-distance (relations-ensure-db!) a b kind))) + +(define + relations/descendants-any + (fn (node) (relations-descendants-any (relations-ensure-db!) node))) + +(define + relations/reachable-any? + (fn (a b) (relations-reachable-any? (relations-ensure-db!) a b))) diff --git a/lib/relations/scoreboard.json b/lib/relations/scoreboard.json index 499c91f1..40b93347 100644 --- a/lib/relations/scoreboard.json +++ b/lib/relations/scoreboard.json @@ -1,11 +1,12 @@ { "lang": "relations", - "total_passed": 46, + "total_passed": 70, "total_failed": 0, - "total": 46, + "total": 70, "suites": [ {"name":"direct","passed":22,"failed":0,"total":22}, - {"name":"reach","passed":24,"failed":0,"total":24} + {"name":"reach","passed":24,"failed":0,"total":24}, + {"name":"path","passed":24,"failed":0,"total":24} ], - "generated": "2026-06-07T11:51:39+00:00" + "generated": "2026-06-07T12:04:11+00:00" } diff --git a/lib/relations/scoreboard.md b/lib/relations/scoreboard.md index 44e38ec5..e662ad83 100644 --- a/lib/relations/scoreboard.md +++ b/lib/relations/scoreboard.md @@ -1,8 +1,9 @@ # relations scoreboard -**46 / 46 passing** (0 failure(s)). +**70 / 70 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | direct | 22 | 22 | ok | | reach | 24 | 24 | ok | +| path | 24 | 24 | ok | diff --git a/lib/relations/tests/path.sx b/lib/relations/tests/path.sx new file mode 100644 index 00000000..e14c09e9 --- /dev/null +++ b/lib/relations/tests/path.sx @@ -0,0 +1,192 @@ +;; lib/relations/tests/path.sx — Phase 3: typed relations, path, distance. + +(define relations-pt-pass 0) +(define relations-pt-fail 0) +(define relations-pt-failures (list)) + +(define + relations-pt-check! + (fn + (name got expected) + (if + (= got expected) + (set! relations-pt-pass (+ relations-pt-pass 1)) + (do + (set! relations-pt-fail (+ relations-pt-fail 1)) + (append! + relations-pt-failures + (str name "\n expected: " expected "\n got: " got)))))) + +(define + relations-pt-subset? + (fn + (xs ys) + (cond + ((= (len xs) 0) true) + ((relations-member? (first xs) ys) + (relations-pt-subset? (rest xs) ys)) + (else false)))) + +(define + relations-pt-set=? + (fn + (xs ys) + (and + (= (len xs) (len ys)) + (relations-pt-subset? xs ys) + (relations-pt-subset? ys xs)))) + +;; Two kinds coexisting in one db. +;; parent: a->b, b->c, c->d, a->c (shortcut), x->y (disconnected) +;; member: c->m, m->n (crosses into a different kind) +(define + relations-pt-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 c) (quote d) (quote parent)) + (relations-rel (quote a) (quote c) (quote parent)) + (relations-rel (quote x) (quote y) (quote parent)) + (relations-rel (quote c) (quote m) (quote member)) + (relations-rel (quote m) (quote n) (quote member)))))) + +;; A cycle with an exit: u->v->w->u, w->exit. +(define + relations-pt-cyc-fixture + (fn + () + (relations-build-db + (list + (relations-rel (quote u) (quote v) (quote parent)) + (relations-rel (quote v) (quote w) (quote parent)) + (relations-rel (quote w) (quote u) (quote parent)) + (relations-rel (quote w) (quote exit) (quote parent)))))) + +(define + relations-pt-run-all! + (fn + () + (let + ((db (relations-pt-fixture)) (cyc (relations-pt-cyc-fixture))) + (do + (relations-pt-check! + "shortest path a->d" + (relations-path db (quote a) (quote d) (quote parent)) + (list (quote a) (quote c) (quote d))) + (relations-pt-check! + "distance a->d is 2" + (relations-distance db (quote a) (quote d) (quote parent)) + 2) + (relations-pt-check! + "direct edge path a->c" + (relations-path db (quote a) (quote c) (quote parent)) + (list (quote a) (quote c))) + (relations-pt-check! + "distance a->c is 1" + (relations-distance db (quote a) (quote c) (quote parent)) + 1) + (relations-pt-check! + "path b->d" + (relations-path db (quote b) (quote d) (quote parent)) + (list (quote b) (quote c) (quote d))) + (relations-pt-check! + "self path" + (relations-path db (quote a) (quote a) (quote parent)) + (list (quote a))) + (relations-pt-check! + "self distance is 0" + (relations-distance db (quote a) (quote a) (quote parent)) + 0) + (relations-pt-check! + "unknown target -> nil path" + (relations-path db (quote a) (quote zzz) (quote parent)) + nil) + (relations-pt-check! + "unknown target -> nil distance" + (relations-distance db (quote a) (quote zzz) (quote parent)) + nil) + (relations-pt-check! + "disconnected -> nil path" + (relations-path db (quote a) (quote y) (quote parent)) + nil) + (relations-pt-check! + "no parent path crosses into member edge" + (relations-path db (quote a) (quote m) (quote parent)) + nil) + (relations-pt-check! + "member path c->m" + (relations-path db (quote c) (quote m) (quote member)) + (list (quote c) (quote m))) + (relations-pt-check! + "member path c->n" + (relations-path db (quote c) (quote n) (quote member)) + (list (quote c) (quote m) (quote n))) + (relations-pt-check! + "mixed-kind reachable a->m" + (relations-reachable-any? db (quote a) (quote m)) + true) + (relations-pt-check! + "mixed-kind reachable a->n" + (relations-reachable-any? db (quote a) (quote n)) + true) + (relations-pt-check! + "single-kind a->m not reachable under parent" + (relations-reachable? db (quote a) (quote m) (quote parent)) + false) + (relations-pt-check! + "mixed-kind descendants of a include cross-kind nodes" + (relations-pt-set=? + (relations-descendants-any db (quote a)) + (list (quote b) (quote c) (quote d) (quote m) (quote n))) + true) + (relations-pt-check! + "single-kind descendants of a under parent only" + (relations-pt-set=? + (relations-descendants db (quote a) (quote parent)) + (list (quote b) (quote c) (quote d))) + true) + (relations-pt-check! + "path out of a cycle" + (relations-path cyc (quote u) (quote exit) (quote parent)) + (list (quote u) (quote v) (quote w) (quote exit))) + (relations-pt-check! + "distance out of a cycle is 3" + (relations-distance cyc (quote u) (quote exit) (quote parent)) + 3) + (do + (relations/load! + (list + (relations-rel (quote r1) (quote r2) (quote parent)) + (relations-rel (quote r2) (quote r3) (quote parent)) + (relations-rel (quote r3) (quote r4) (quote link)))) + (relations-pt-check! + "api path" + (relations/path (quote r1) (quote r3) (quote parent)) + (list (quote r1) (quote r2) (quote r3))) + (relations-pt-check! + "api distance" + (relations/distance (quote r1) (quote r3) (quote parent)) + 2) + (relations-pt-check! + "api mixed-kind reachable across parent+link" + (relations/reachable-any? (quote r1) (quote r4)) + true) + (relations-pt-check! + "api single-kind not reachable across kinds" + (relations/reachable? (quote r1) (quote r4) (quote parent)) + false) + (relations/load! (list))))))) + +(define + relations-path-tests-run! + (fn + () + (do + (set! relations-pt-pass 0) + (set! relations-pt-fail 0) + (set! relations-pt-failures (list)) + (relations-pt-run-all!) + {:failures relations-pt-failures :total (+ relations-pt-pass relations-pt-fail) :passed relations-pt-pass :failed relations-pt-fail}))) diff --git a/plans/relations-on-sx.md b/plans/relations-on-sx.md index 6cc26b6e..669c82ee 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` → **46/46** (Phases 1–2 complete) +`bash lib/relations/conformance.sh` → **70/70** (Phases 1–3 complete) ## Ground rules @@ -81,11 +81,11 @@ lib/relations/federation.sx ## Phase 3 — Typed relations + path explanation -- [ ] multiple kinds coexisting; mixed-kind vs single-kind reachability -- [ ] `lib/relations/explain.sx` — `(path db a b kind)` returns the connecting +- [x] multiple kinds coexisting; mixed-kind vs single-kind reachability +- [x] `lib/relations/explain.sx` — `(path db a b kind)` returns the connecting chain (the relationship equivalent of acl's proof tree), nil if unreachable -- [ ] `(distance db a b kind)` (hops) + shortest-path selection -- [ ] `lib/relations/tests/path.sx` — path correctness, shortest among many, no-path +- [x] `(distance db a b kind)` (hops) + shortest-path selection +- [x] `lib/relations/tests/path.sx` — path correctness, shortest among many, no-path ## Phase 4 — Federation @@ -100,6 +100,24 @@ lib/relations/federation.sx ## Progress log +- **Phase 3 — typed relations + path explanation** (70/70). New `explain.sx`: + `relations-path(db,a,b,kind)` is relations' answer to acl's proof tree — the + `reach(K,a,b)` derivation read off as the node chain. lib/datalog/ keeps no + provenance, so the chain is re-derived breadth-first over the saturated edge set + (`relations-children-of` per frontier node) so the returned path is a SHORTEST + derivation; every consecutive pair is a real `rel` fact (no invented edges) and + a visited set makes cyclic data terminate. `relations-distance` = hops (0 for + a=b, nil if unreachable). Mixed-kind reachability added to engine.sx as a + kind-agnostic `reach_any` closure (`relations-descendants-any`, + `relations-reachable-any?`) — distinct from single-kind `reach`, so tests show a + parent+member graph where a→m is reachable cross-kind but not under `parent` + alone. api/explain grew `relations/path`, `/distance`, `/descendants-any`, + `/reachable-any?` current-db wrappers. path.sx covers shortest-among-many + (a→c→d beats a→b→c→d), direct edge, self path, no-path/disconnected, kind + isolation in paths, mixed vs single kind, and path-out-of-a-cycle. Note: the + dict-mode conformance driver has no per-suite timeout and the shared machine is + contended by sibling loops — a full run can take a few minutes; the path suite + alone runs in <1s. - **Phase 2 — reachability + cycles** (46/46). New `engine.sx` is one Datalog ruleset. Reachability is kind-parameterised — `reach(K,X,Y)` carries the kind as its first arg so a transitive walk over `parent` never leaks through `reply`