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.

About these ads

Pages: 1 2

5 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).
    
    pad(Key, K) :-
    	length(Key, L), L =< 10,
    	PadLen is 10 - L,
    	repeat('_', PadLen, Padding),
    	append(Key, Padding, K).
    
    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[0] 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[0] 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('cross', 'roads', 'danger')
    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.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 628 other followers

%d bloggers like this: