coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

mk: phase 6 piece B — bounds-consistency for fd-plus + fd-times
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
Details

Browse Source 
fd-plus-prop now propagates in the four partial- and all-domain cases
(vvn, nvv, vnv, vvv) by interval reasoning:
  x in [z.min - y.max .. z.max - y.min]
  y in [z.min - x.max .. z.max - x.min]
  z in [x.min + y.min .. x.max + y.max]

Helpers added:
  fd-narrow-or-skip — common "no-domain? skip; else filter & set" path.
  fd-int-floor-div / fd-int-ceil-div — integer-division wrappers because
    SX `/` returns rationals; floor/ceil computed via (a - (mod a b)).

fd-times-prop gets the same treatment for positive domains. Mixed-sign
domains pass through (sound, but no narrowing).

10 new tests in clpfd-bounds.sx demonstrate domains shrinking BEFORE
labelling: x+y=10 with x in {1..10}, y in {1..3} narrows x to {7..9};
3*y=z narrows z to {3..12}; impossible bounds (x+y=100, x,y in {1..10})
return :no-subst directly. 132/132 across the clpfd test files.

Suggested next: Piece D (send-more-money + Sudoku 4x4) to validate
this against larger puzzles.
This commit is contained in:
giles
2026-05-09 13:18:29 +00:00
parent 5c51f5ef8f
commit d1817e026d
2 changed files with 572 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

316
lib/minikanren/tests/clpfd-bounds.sx Normal file
View File

@@ -0,0 +1,316 @@
;; lib/minikanren/tests/clpfd-bounds.sx — Phase 6 piece B: bounds-consistency
;; for fd-plus and fd-times in the partial- and all-domain cases.
;;
;; We probe domains directly (peek at the FD store) before any labelling
;; happens. This isolates the propagator's narrowing behaviour from the
;; search engine.
(define
probe-dom
(fn
(goal var-key)
(let
((s (first (stream-take 1 (goal empty-s)))))
(cond ((= s nil) :no-subst) (:else (fd-domain-of s var-key))))))
;; --- fd-plus partial-domain narrowing ---
(mk-test
"fd-plus-vvn-narrows-x"
(let
((x (mk-var "x")) (y (mk-var "y")))
(probe-dom
(mk-conj
(fd-in
x
(list
1
2
3
4
5
6
7
8
9
10))
(fd-in y (list 1 2 3))
(fd-plus x y 10))
"x"))
(list 7 8 9))
(mk-test
"fd-plus-vvn-narrows-y"
(let
((x (mk-var "x")) (y (mk-var "y")))
(probe-dom
(mk-conj
(fd-in
x
(list
1
2
3
4
5
6
7
8
9
10))
(fd-in y (list 1 2 3))
(fd-plus x y 10))
"y"))
(list 1 2 3))
(mk-test
"fd-plus-nvv-narrows"
(let
((y (mk-var "y")) (z (mk-var "z")))
(probe-dom
(mk-conj
(fd-in y (list 1 2 3))
(fd-in
z
(list
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20))
(fd-plus 5 y z))
"z"))
(list 6 7 8))
(mk-test
"fd-plus-vvv-narrows-z"
(let
((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
(probe-dom
(mk-conj
(fd-in x (list 1 2 3))
(fd-in y (list 1 2 3))
(fd-in
z
(list
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20))
(fd-plus x y z))
"z"))
(list 2 3 4 5 6))
(mk-test
"fd-plus-vvv-narrows-x"
(let
((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
(probe-dom
(mk-conj
(fd-in
x
(list
1
2
3
4
5
6
7
8
9
10))
(fd-in y (list 1 2 3))
(fd-in z (list 5 6 7))
(fd-plus x y z))
"x"))
(list 2 3 4 5 6))
;; --- fd-times partial-domain narrowing (positive domains) ---
(mk-test
"fd-times-vvn-narrows"
(let
((x (mk-var "x")) (y (mk-var "y")))
(probe-dom
(mk-conj
(fd-in
x
(list
1
2
3
4
5
6))
(fd-in
y
(list
1
2
3
4
5
6))
(fd-times x y 12))
"x"))
(list 2 3 4 5 6))
(mk-test
"fd-times-nvv-narrows"
(let
((y (mk-var "y")) (z (mk-var "z")))
(probe-dom
(mk-conj
(fd-in y (list 1 2 3 4))
(fd-in
z
(list
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20))
(fd-times 3 y z))
"z"))
(list
3
4
5
6
7
8
9
10
11
12))
(mk-test
"fd-times-vvv-narrows"
(let
((x (mk-var "x")) (y (mk-var "y")) (z (mk-var "z")))
(probe-dom
(mk-conj
(fd-in x (list 1 2 3))
(fd-in y (list 1 2 3))
(fd-in
z
(list
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20))
(fd-times x y z))
"z"))
(list
1
2
3
4
5
6
7
8
9))
;; --- bounds force impossible branches to fail early ---
(mk-test
"fd-plus-impossible-via-bounds"
(let
((x (mk-var "x")) (y (mk-var "y")))
(probe-dom
(mk-conj
(fd-in
x
(list
1
2
3
4
5
6
7
8
9
10))
(fd-in
y
(list
1
2
3
4
5
6
7
8
9
10))
(fd-plus x y 100))
"x"))
:no-subst)
(mk-tests-run!)