source: project/release/4/amb/trunk/amb-money.scm @ 13799

Last change on this file since 13799 was 13799, checked in by Kon Lovett, 12 years ago

Save.

File size: 2.3 KB
Line 
1(require-extension amb)
2
3;; Assign different numerals to different symbols
4;;    '(s e n d m o r y)
5;; so the following is true:
6;;
7;; s e n d + m o r e = m o n e y
8;;
9;; Symbols s and m are not zero.
10;;
11;; The code below significantly prunes the solution space,
12;; so the result is found in few thousands trials, rather than
13;; in tens of millions of trials when no pruning is applied:
14;; (* 2 2 2 10 10 10 10 10 10 9 1) = 72,000,000
15;;
16;; The pruning is based on the following ideas:
17;; 1. The order of assignments is important, so the variables are
18;;    ordered in some specific way within the 'let* clause,
19;;    rather than the 'let one.
20;; 2. Later variables use the info from the previous ones to reduce
21their
22;;    domains. This is a constraint propagation mechanism for this
23puzzle.
24;; 3. Some assignments are deterministic (no amb or choose is directly
25used),
26;;    which significantly reduces the original domain space of a
27variable
28;;    from 10 (or 9) to 1 (or to 2 if we take into account the effect
29of
30;;    'modulo application)
31;;
32;; Example:
33;; (money) ==>
34;; ((4385 trials)
35;;  (s e n d + m o r e = m o n e y)
36;;  (9 5 6 7 + 1 0 8 5 = 1 0 6 5 2))
37;;
38(define (money)
39
40   (define (set-difference xs ys)
41      (filter (lambda(x)(not (member x ys))) xs))
42
43   (define (distinct? xs)
44      (cond
45         ((null? xs) #t)
46         ((member (car xs) (cdr xs)) #f)
47         (else (distinct? (cdr xs)))))
48
49   (define trial 0)
50
51   (let* (
52
53      (p1 (amb 0 1))
54      (p2 (amb 0 1))
55      (p3 (amb 0 1))
56
57      (d (choose '(0 1 2 3 4 5 6 7 8 9)))
58      (e (choose (set-difference '(0 1 2 3 4 5 6 7 8 9) (list d))))
59      (y (modulo (+ d e (* -10 p1)) 10))
60      (n (choose (set-difference '(0 1 2 3 4 5 6 7 8 9)
61         (list d e y))))
62      (r (modulo (+ (* 10 p2) e (- p1) (- n)) 10))
63      (o (modulo (+ (* 10 p3) n (- p2) (- e)) 10))
64
65      (m 1)
66      (s (modulo (+ (* 9 m) o (- p3)) 10)))
67
68
69      (set! trial (+ trial 1))
70
71      (assert (distinct? (list s e n d m o r y)))
72      (assert (= (+ d e)    (+ (* 10 p1) y)))
73      (assert (= (+ p1 n r) (+ (* 10 p2) e)))
74      (assert (= (+ p2 e o) (+ (* 10 p3) n)))
75      (assert (= (+ p3 s m) (+ (* 10 m)  o)))
76
77      ;; Result, including a number of recorded trials
78      (list
79         (list trial 'trials)
80         (list 's 'e 'n 'd '+ 'm 'o 'r 'e '= 'm 'o 'n 'e 'y)
81         (list s e n d '+ m o r e '= m o n e y))))
Note: See TracBrowser for help on using the repository browser.