mk: mapo (relational map) — 300/300 milestone
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
(mapo rel l1 l2) takes a 2-argument relation rel and asserts l2 is l1 with each element rel-related to its counterpart. Recursive on both lists in lockstep. Works forward (fixed l1, find l2), backward (fixed l2, find l1), or constraining mid-pipeline. Composes with intarith for arithmetic transforms: (mapo (fn (a b) (*o-i a a b)) (list 1 2 3 4) q) -> ((1 4 9 16)) 7 new tests, 300/300 cumulative.
This commit is contained in:
@@ -132,3 +132,11 @@
|
|||||||
(conde
|
(conde
|
||||||
((nullo l1) (nullo l2))
|
((nullo l1) (nullo l2))
|
||||||
((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime))))))
|
((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (samelengtho d d-prime))))))
|
||||||
|
|
||||||
|
(define
|
||||||
|
mapo
|
||||||
|
(fn
|
||||||
|
(rel l1 l2)
|
||||||
|
(conde
|
||||||
|
((nullo l1) (nullo l2))
|
||||||
|
((fresh (a d a-prime d-prime) (conso a d l1) (conso a-prime d-prime l2) (rel a a-prime) (mapo rel d d-prime))))))
|
||||||
|
|||||||
62
lib/minikanren/tests/mapo.sx
Normal file
62
lib/minikanren/tests/mapo.sx
Normal file
@@ -0,0 +1,62 @@
|
|||||||
|
;; lib/minikanren/tests/mapo.sx — relational map.
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-identity"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(mapo (fn (a b) (== a b)) (list 1 2 3) q))
|
||||||
|
(list (list 1 2 3)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-tag-each"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(mapo
|
||||||
|
(fn (a b) (== b (list :tag a)))
|
||||||
|
(list 1 2 3)
|
||||||
|
q))
|
||||||
|
(list
|
||||||
|
(list
|
||||||
|
(list :tag 1)
|
||||||
|
(list :tag 2)
|
||||||
|
(list :tag 3))))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-backward"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(mapo (fn (a b) (== a b)) q (list 1 2 3)))
|
||||||
|
(list (list 1 2 3)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-empty"
|
||||||
|
(run* q (mapo (fn (a b) (== a b)) (list) q))
|
||||||
|
(list (list)))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-duplicate"
|
||||||
|
(run* q (mapo (fn (a b) (== b (list a a))) (list :x :y) q))
|
||||||
|
(list (list (list :x :x) (list :y :y))))
|
||||||
|
|
||||||
|
(mk-test
|
||||||
|
"mapo-different-length-fails"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(mapo
|
||||||
|
(fn (a b) (== a b))
|
||||||
|
(list 1 2)
|
||||||
|
(list 1 2 3)))
|
||||||
|
(list))
|
||||||
|
|
||||||
|
;; mapo + arithmetic via intarith
|
||||||
|
(mk-test
|
||||||
|
"mapo-square-each"
|
||||||
|
(run*
|
||||||
|
q
|
||||||
|
(mapo
|
||||||
|
(fn (a b) (*o-i a a b))
|
||||||
|
(list 1 2 3 4)
|
||||||
|
q))
|
||||||
|
(list (list 1 4 9 16)))
|
||||||
|
|
||||||
|
(mk-tests-run!)
|
||||||
@@ -173,6 +173,10 @@ _(none yet)_
|
|||||||
|
|
||||||
_Newest first._
|
_Newest first._
|
||||||
|
|
||||||
|
- **2026-05-08** — **mapo (relational map) — 300 test milestone**: `(mapo
|
||||||
|
rel l1 l2)` succeeds when l2 is l1 with each element rel-related. Works
|
||||||
|
forward and backward; composes with intarith — `(mapo (fn (a b) (*o-i
|
||||||
|
a a b)) (1 2 3 4) q)` → `((1 4 9 16))`. 7 new tests, **300/300** cumulative.
|
||||||
- **2026-05-08** — **samelengtho**: classic miniKanren relation that
|
- **2026-05-08** — **samelengtho**: classic miniKanren relation that
|
||||||
succeeds when two lists have equal length. Symmetric — works to enumerate
|
succeeds when two lists have equal length. Symmetric — works to enumerate
|
||||||
both lists fresh: `(run 3 q (fresh (l1 l2) (samelengtho l1 l2) (== q
|
both lists fresh: `(run 3 q (fresh (l1 l2) (samelengtho l1 l2) (== q
|
||||||
|
|||||||
Reference in New Issue
Block a user