giles
b4c1253891
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Defines a small graph as a fact list, edgeo for fact lookup, and patho
that recursively constructs paths. Direct-edge clause yields (x y);
otherwise traverse one edge to z, recurse for z->y, prepend x.
Enumerates all paths between two nodes, including alternates through
shortcut edges:
(run* q (patho :a :d q))
-> ((:a :b :c :d) (:a :c :d)) ; both routes
6 new tests, 316/316 cumulative.
71 lines
1.7 KiB
Plaintext
71 lines
1.7 KiB
Plaintext
;; lib/minikanren/tests/graph.sx — directed-graph reachability via patho.
|
|
|
|
(define
|
|
test-edges
|
|
(list (list :a :b) (list :b :c) (list :c :d) (list :a :c) (list :d :e)))
|
|
|
|
(define edgeo (fn (from to) (membero (list from to) test-edges)))
|
|
|
|
(define
|
|
patho
|
|
(fn
|
|
(x y path)
|
|
(conde
|
|
((edgeo x y) (== path (list x y)))
|
|
((fresh (z mid-path) (edgeo x z) (patho z y mid-path) (conso x mid-path path))))))
|
|
|
|
;; --- direct edges ---
|
|
|
|
(mk-test "patho-direct" (run* q (patho :a :b q)) (list (list :a :b)))
|
|
|
|
(mk-test "patho-no-direct-edge" (run* q (patho :e :a q)) (list))
|
|
|
|
;; --- indirect ---
|
|
|
|
(mk-test
|
|
"patho-multi-hop"
|
|
(let
|
|
((paths (run* q (patho :a :d q))))
|
|
(and
|
|
(= (len paths) 2)
|
|
(and
|
|
(some (fn (p) (= p (list :a :b :c :d))) paths)
|
|
(some (fn (p) (= p (list :a :c :d))) paths))))
|
|
true)
|
|
|
|
(mk-test
|
|
"patho-to-leaf"
|
|
(let
|
|
((paths (run* q (patho :a :e q))))
|
|
(and
|
|
(= (len paths) 2)
|
|
(and
|
|
(some (fn (p) (= p (list :a :b :c :d :e))) paths)
|
|
(some (fn (p) (= p (list :a :c :d :e))) paths))))
|
|
true)
|
|
|
|
;; --- enumeration with multiplicity ---
|
|
;; Each path contributes one tuple, so reachable nodes can repeat. Here
|
|
;; targets are: b (1 path), c (2 paths), d (2 paths), e (2 paths) = 7.
|
|
|
|
(mk-test
|
|
"patho-enumerate-from-a-with-multiplicity"
|
|
(let
|
|
((targets (run* q (fresh (path) (patho :a q path)))))
|
|
(and
|
|
(= (len targets) 7)
|
|
(and
|
|
(some (fn (t) (= t :b)) targets)
|
|
(and
|
|
(some (fn (t) (= t :c)) targets)
|
|
(and
|
|
(some (fn (t) (= t :d)) targets)
|
|
(some (fn (t) (= t :e)) targets))))))
|
|
true)
|
|
|
|
;; --- unreachable target ---
|
|
|
|
(mk-test "patho-unreachable" (run* q (patho :a :z q)) (list))
|
|
|
|
(mk-tests-run!)
|