## SEND + MORE = MONEY, Part 2

### August 3, 2012

In the previous exercise we wrote programs to solve the cryptarithm SEND + MORE = MONEY. In today’s exercise we will be more general, writing programs that solve any cryptarithm of the form x + y = z. Cryptarithms can be even more general, such as TED + HAS + GOOD = TASTE, but the extension to such forms is straight forward, and we don’t bother. Making cryptarithms general means we have to provide more infrastructure, beginning with a function `make-key` that makes a list of all the letters present in a cryptarithm and extends it to length ten by adding nulls (the underscore) if necessary; the key for SEND + MORE = MONEY looks like `(#\_ #\_ #\y #\r #\o #\m #\d #\n #\e #\s)`:

```(define (make-key . words)   (let loop ((cs (mappend string->list words)) (ks (list)))     (cond ((null? cs)             (append (make-list (- 10 (length ks)) #\_) ks))           ((member (car cs) ks) (loop (cdr cs) ks))           (else (loop (cdr cs) (cons (car cs) ks))))))```

The key could be stored as list or a vector; there are advantages and disadvantages to each. We choose a list, because lists are ubiquitous in Scheme. Function `lookup` converts a letter to a digit by linear search, and function `number` converts a string to a number by calling `lookup` repeatedly:

```(define (lookup k ks)   (let loop ((i 0) (ks ks))     (if (char=? (car ks) k) i       (loop (+ i 1) (cdr ks)))))```

```(define (number cs ks)   (let loop ((s 0) (cs cs))     (if (null? cs) s       (loop (+ (* 10 s) (lookup (car cs) ks)) (cdr cs)))))```

The two functions that implement the hill-climbing operators are `swap` and `score`; `swap` returns a newly-allocated list with two (possibly-identical) elements interchanged, but is careful not to return a key that makes an invalid number starting with a zero digit, and `score` returns the difference between the sum of the first two operands in the cryptarithm and its total:

```(define (swap ks a b firsts) ; fix this   (let* ((vs (list->vector ks))          (t (vector-ref vs a)))     (vector-set! vs a (vector-ref vs b))     (vector-set! vs b t)     (if (member (vector-ref vs 0) firsts)         ks (vector->list vs))))```

```(define (score xs ys zs key)   (abs (- (number zs key) (number ys key) (number xs key))))```

The last bit of infrastructure that we need writes the output in a convenient form:

```(define (output xs ks)   (let loop ((xs xs) (zs (list)))     (if (null? xs) (reverse zs)       (loop (cdr xs) (cons (lookup (car xs) ks) zs)))))```

We are ready now for the hill-climbing function. Input is the three words in the form of a string. The initial `let` converts all three input strings to lists of characters, makes a list of the letters which cannot represent zero, chooses an initial key, and scores it. The main loop keeps the key and the score and, unless a solution has been found, at each step computes and scores a modified key and keeps both if they are an improvement:

```(define (solve x y z)   (let* ((xs (string->list x))          (ys (string->list y))          (zs (string->list z))          (firsts (map car (list xs ys zs)))          (ks (make-key x y z))          (s (score xs ys zs ks)))     (let loop ((ks ks) (s s))       (if (zero? s)           (list (output xs ks) (output ys ks) (output zs ks))           (let* ((new-ks (swap ks (randint 10) (randint 10) firsts))                  (new-s (score xs ys zs new-ks)))             (if (< new-s s) (loop new-ks new-s) (loop ks s)))))))```

Here’s a sample run:

```> (solve "SEND" "MORE" "MONEY") ^C > (solve "SEND" "MORE" "MONEY") ^C > (solve "SEND" "MORE" "MONEY") ^C > (solve "SEND" "MORE" "MONEY") ^C > (solve "SEND" "MORE" "MONEY") ((9 5 6 7) (1 0 8 5) (1 0 6 5 2))```

The first four runs had to be aborted when they reached local optimums, and the fifth run found a solution in about a tenth of a second.

The change that fixes the problem of getting stuck in a local optimum is quite simple. The `if` statement on the last line gains a second clause, and is satisfied if the new key improves the current key or, if the new key is worse than the current key, one time in a hundred:

```(define (solve x y z)   (let* ((xs (string->list x))          (ys (string->list y))          (zs (string->list z))          (firsts (map car (list xs ys zs)))          (ks (make-key x y z))          (s (score xs ys zs ks)))     (let loop ((ks ks) (s s))       (if (zero? s)           (list (output xs ks) (output ys ks) (output zs ks))           (let* ((new-ks (swap ks (randint 10) (randint 10) firsts))                  (new-s (score xs ys zs new-ks)))             (if (or (< new-s s) (zero? (randint 100)))                 (loop new-ks new-s)                 (loop ks s)))))))```

Here’s a sample run:

```> (solve "SEND" "MORE" "MONEY") ((9 5 6 7) (1 0 8 5) (1 0 6 5 2)) > (solve "CROSS" "ROADS" "DANGER") ((9 6 2 3 3) (6 2 5 1 3) (1 5 8 7 4 6)) > (solve "GREEN" "ORANGE" "COLORS") ((8 3 4 4 6) (1 3 5 6 8 4) (2 1 9 1 3 0)) > (solve "TAURUS" "PISCES" "SCORPIO") ((8 5 9 0 9 1) (4 6 1 3 7 1) (1 3 2 0 4 6 2)) > (solve "FIFTY" "STATES" "AMERICA") ((6 5 6 8 2) (9 8 1 8 4 9) (1 0 4 7 5 3 1)) > (solve "THIS" "SIZE" "SHORT") ((9 0 5 1) (1 5 7 8) (1 0 6 2 9)) > (solve "LYNNE" "LOOKS" "SLEEPY") ((9 4 5 5 3) (9 8 8 2 1) (1 9 3 3 7 4)) > (solve "NINE" "FINE" "WIVES") ((7 6 7 5) (8 6 7 5) (1 6 3 5 0))```

It works every time, typically in somewhere between a tenth and a half a second, depending on the random number sequence, which is much better than the half minute required by the programs of the prior exercise.

We used `mappend`, `make-list` and `randint` from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/40TnHqmA.

Pages: 1 2

### 6 Responses to “SEND + MORE = MONEY, Part 2”

1. David said

Prolog code (mostly since the first exercise was in Prolog, there’s little other reason to use it here, it’s not particularly well suited…)

```split(List, Nth, X, A, B) :-
append(A, [X|B], List),
length(A, Nth), !.

swap(List, I, J, List) :- I == J.
swap(List, I, J, Result) :-
I > J,
swap(List, J, I, Result).
swap(List, I, J, Result) :-
split(List, I, X1, Left, Rest),
I2 is J - I - 1,
split(Rest, I2, X2, Mid, Right),
append([Left, [X2], Mid, [X1], Right], Result).

randomSwap(Key0, FirstSet, Key) :-
I is random(10), J is random(10), swap(Key0, I, J, Key1),
[X|_] = Key1, (member(X, FirstSet) -> Key = Key0 ; Key = Key1).

transition(S1, S2) :- S1 > S2.
transition(_, _) :- X is random(100), X == 0.

climb(_, _, _, _, Key, 0, Key).
climb(Xs, Ys, Zs, FirstSet, Key, Score, FinalKey) :-
randomSwap(Key, FirstSet, NewKey),
score(Xs, Ys, Zs, NewKey, NewScore),
(transition(Score, NewScore)
-> climb(Xs, Ys, Zs, FirstSet, NewKey, NewScore, FinalKey)
; climb(Xs, Ys, Zs, FirstSet, Key, Score, FinalKey)).

score(Xs, Ys, Zs, Key, Score) :-
number(Xs, Key, 0, X),
number(Ys, Key, 0, Y),
number(Zs, Key, 0, Z),
Score is abs(X + Y - Z).

number([], _, X, Y) :- Y = X.
number([A|As], Key, Acc, Result) :-
nth0(N0, Key, A),
N is 10*Acc + N0,
number(As, Key, N, Result).

strtoatoms("", []).
strtoatoms([Ch|Str], [A|As]) :-
name(A, [Ch]),
strtoatoms(Str, As).

repeat(_, 0, []).
repeat(X, Count, [X|Y]) :-
succ(DecCount, Count), repeat(X, DecCount, Y).

length(Key, L), L =< 10,

make_key(X, Y, Z, Key) :-
Lists = [X, Y, Z], append(Lists, Key0), sort(Key0, Key1), pad(Key1, Key).

solve(S1, S2, S3, X, Y, Z) :-
strtoatoms(S1, Xs),
strtoatoms(S2, Ys),
strtoatoms(S3, Zs),
[A|_] = Xs, [B|_] = Ys, [C|_] = Zs, sort([A,B,C], FirstSet),
make_key(Xs, Ys, Zs, InitialKey),
score(Xs, Ys, Zs, InitialKey, InitialScore),
climb(Xs, Ys, Zs, FirstSet, InitialKey, InitialScore, FinalKey),
number(Xs, FinalKey, 0, X),
number(Ys, FinalKey, 0, Y),
number(Zs, FinalKey, 0, Z),
!.

29 ?- solve("send", "more", "money", X,Y,Z).
X = 9567,
Y = 1085,
Z = 10652.

24 ?- solve("fifty","states","america",X,Y,Z).
X = 65682,
Y = 981849,
Z = 1047531.
```
2. A Python 2.7 solution based on original Scheme solution:

```
import random
import time

def random_solution(*words):
solution = list(set(''.join(words)))
if len(solution) < 10:
for _ in xrange(len(solution), 10):
solution.append("_")
return solution

def number(word, solution):
n = 0
for letter in word:
n = n * 10 + lookup(letter, solution)
return n

def lookup(letter, solution):
for i, l in enumerate(solution):
if letter == l:
return i

def score(solution, *words):
nums = [number(word, solution) for word in words]
return abs(sum(nums[:-1]) - nums[-1])

def alter_solution(solution, first_letters):
altered = solution[:]
i = random.randint(0, 9)
j = random.randint(0, 9)
altered[i], altered[j] = altered[j], altered[i]
if altered in first_letters:
return solution
return altered

def print_solution(solution, *words):
nums = [str(number(word, solution)) for word in words]
print("%s = %s" % (' + '.join(nums[:-1]), nums[-1]))

def solve(*words):
start = time.clock()
first_letters = set([word for word in words])
best_solution = random_solution(*words)
best_score = score(best_solution, *words)
while True:
if best_score == 0:
break
alt_sol = alter_solution(best_solution, first_letters)
alt_score = score(alt_sol, *words)
if alt_score < best_score or random.randint(1, 100) == 1:
best_score = alt_score
best_solution = alt_sol
print_solution(best_solution, *words)
print("%.2f" % (time.clock() - start))

solve('send', 'more', 'money')
solve('green', 'orange', 'colors')
solve('taurus', 'pisces', 'scorpio')
solve('fifty', 'states', 'america')
solve('this', 'size', 'short')
solve('lynne', 'looks', 'sleepy')
solve('nine', 'fine', 'wives')
solve('ted', 'has', 'good', 'taste')

```
3. […] was a post at Programming Praxis about the old mathematical problem SEND + MORE = MONEY. Basically, you have the following […]

4. JP said

I went ahead and wrote a Scheme version before I actually read yours but they actually ended up pretty similar. Check it out here.

5. Emre said

Can you put the C version of this? Thank you.