mk: phase 4C — permuteo (with inserto helper)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s

inserto a l p: p is l with a inserted at some position. Recursive: head
of l first, then push past head and recurse.

permuteo l p: classical recursive permutation. Empty -> empty; otherwise
take a head off l, recursively permute the tail, insert head at any
position in the recursive result.

7 new tests including all-6-perms-of-3 as a set check (independent of
generation order). 208/208 cumulative.
This commit is contained in:
2026-05-08 07:22:41 +00:00
parent a038d41815
commit b8a0c504bc
3 changed files with 86 additions and 1 deletions

View File

@@ -65,3 +65,19 @@
(conde
((nullo l) (== n :z))
((fresh (a d n-1) (conso a d l) (== n (list :s n-1)) (lengtho d n-1))))))
(define
inserto
(fn
(a l p)
(conde
((conso a l p))
((fresh (h t pt) (conso h t l) (conso h pt p) (inserto a t pt))))))
(define
permuteo
(fn
(l p)
(conde
((nullo l) (nullo p))
((fresh (a d perm-d) (conso a d l) (permuteo d perm-d) (inserto a perm-d p))))))

View File

@@ -224,4 +224,68 @@
(run 1 q (lengtho q (list :s (list :s :z))))
(list (list (make-symbol "_.0") (make-symbol "_.1"))))
;; --- inserto ---
(mk-test
"inserto-front"
(run* q (inserto 0 (list 1 2 3) q))
(list
(list 0 1 2 3)
(list 1 0 2 3)
(list 1 2 0 3)
(list 1 2 3 0)))
(mk-test
"inserto-empty"
(run* q (inserto 0 (list) q))
(list (list 0)))
;; --- permuteo ---
(mk-test "permuteo-empty" (run* q (permuteo (list) q)) (list (list)))
(mk-test
"permuteo-singleton"
(run* q (permuteo (list 42) q))
(list (list 42)))
(mk-test
"permuteo-two"
(run* q (permuteo (list 1 2) q))
(list (list 1 2) (list 2 1)))
(mk-test
"permuteo-three-as-set"
(let
((perms (run* q (permuteo (list 1 2 3) q))))
(and
(= (len perms) 6)
(and
(some (fn (p) (= p (list 1 2 3))) perms)
(and
(some
(fn (p) (= p (list 2 1 3)))
perms)
(and
(some
(fn (p) (= p (list 1 3 2)))
perms)
(and
(some
(fn (p) (= p (list 2 3 1)))
perms)
(and
(some
(fn (p) (= p (list 3 1 2)))
perms)
(some
(fn (p) (= p (list 3 2 1)))
perms))))))))
true)
(mk-test
"permuteo-backward-finds-input"
(run 1 q (permuteo q (list "a" "b" "c")))
(list (list "a" "b" "c")))
(mk-tests-run!)