Faster implementation of verbal arithmetic in Prolog

Question

I already made a working generalized verbal arithmetic solver in Prolog but it's too slow. It takes 8 minutes just to run the simple expression S E N D + M O R E = M O N E Y. Can someone help me make it run faster?

/* verbalArithmetic(List,Word1,Word2,Word3) where List is the list of all 
   possible letters in the words. The SEND+MORE = MONEY expression would then
   be represented as
    verbalArithmetic([S,E,N,D,M,O,R,Y],[S,E,N,D],[M,O,R,E],[M,O,N,E,Y]). */

validDigit(X) :- member(X,[0,1,2,3,4,5,6,7,8,9]).
validStart(X) :- member(X,[1,2,3,4,5,6,7,8,9]).
assign([H|[]]) :- validDigit(H).         
assign([H|Tail]) :- validDigit(H), assign(Tail), fd_all_different([H|Tail]).

findTail(List,H,T) :- append(H,[T],List).

convert([T],T) :- validDigit(T).
convert(List,Num) :- findTail(List,H,T), convert(H,HDigit), Num is (HDigit*10+T).

verbalArithmetic(WordList,[H1|Tail1],[H2|Tail2],Word3) :- 
    validStart(H1), validStart(H2), assign(WordList), 
    convert([H1|Tail1],Num1),convert([H2|Tail2],Num2), convert(Word3,Num3), 
    Sum is Num1+Num2, Num3 = Sum.

Answer 1

Consider using finite domain constraints, for example, in SWI-Prolog:

:- use_module(library(clpfd)).

puzzle([S,E,N,D] + [M,O,R,E] = [M,O,N,E,Y]) :-
        Vars = [S,E,N,D,M,O,R,Y],
        Vars ins 0..9,
        all_different(Vars),
                  S*1000 + E*100 + N*10 + D +
                  M*1000 + O*100 + R*10 + E #=
        M*10000 + O*1000 + N*100 + E*10 + Y,
        M #\= 0, S #\= 0.

Example query:

?- time((puzzle(As+Bs=Cs), label(As))).
% 5,803 inferences, 0.002 CPU in 0.002 seconds (98% CPU, 3553582 Lips)
As = [9, 5, 6, 7],
Bs = [1, 0, 8, 5],
Cs = [1, 0, 6, 5, 2] ;
% 1,411 inferences, 0.001 CPU in 0.001 seconds (97% CPU, 2093472 Lips)
false.

Answer 2

Poor performance here is due to forming all possible letter assignments before checking if any are feasible.

My advice is "fail early, fail often". That is, push as many checks for failure as early as possible into the assignment steps, thus pruning the search tree.

Klas Lindbäck makes some good suggestions. As a generalization, when adding two numbers the carry is at most one in each place. So the assignment of distinct digits to letters from left to right can be checked with allowance for the possibility of an as-yet-undetermined carry in the rightmost places. (Of course in the final "units" place, there is no carry.)

It's a lot to think about, which is why constraint logic, as mat suggests (and which you've already broached with fd_all_different/1), is such a convenience.

---

Added: Here's a Prolog solution without constraint logic, using just one auxiliary predicate omit/3:

omit(H,[H|T],T).
omit(X,[H|T],[H|Y]) :- omit(X,T,Y).

which both selects an item from a list and produces the shortened list without that item.

Here then is the code for sendMoreMoney/3 that searches by evaluating the sum from left to right:

sendMoreMoney([S,E,N,D],[M,O,R,E],[M,O,N,E,Y]) :-
    M = 1,
    omit(S,[2,3,4,5,6,7,8,9],PoolO),
    (CarryS = 0 ; CarryS = 1),
    %% CarryS + S + M =      M*10 + O
    O is (CarryS + S + M) - (M*10), 
    omit(O,[0|PoolO],PoolE),
    omit(E,PoolE,PoolN),
    (CarryE = 0 ; CarryE = 1),
    %% CarryE + E + O = CarryS*10 + N
    N is (CarryE + E + O) - (CarryS*10),
    omit(N,PoolN,PoolR),
    (CarryN = 0 ; CarryN = 1),
    %% CarryN + N + R = CarryE*10 + E
    R is (CarryE*10 + E) - (CarryN + N),
    omit(R,PoolR,PoolD),
    omit(D,PoolD,PoolY),
    %%          D + E = CarryN*10 + Y
    Y is (D + E) - (CarryN*10),
    omit(Y,PoolY,_).

We get off to a quick start by observing that M must be the nonzero carry from the leftmost digits sum, hence 1, and that S must be some other nonzero digit. The comments show steps where additional letters may be deterministically assigned values based on choices already made.

---

Added(2): Here is a "general" cryptarithm solver for two summands, which need not have the same length/number of "places". Code for length/2 is omitted as a fairly common built-in predicate, and taking up the suggestion by Will Ness, calls to omit/3 are replaced by select/3 for convenience of SWI-Prolog users.

I've tested this with Amzi! and SWI-Prolog using those alphametics examples from Cryptarithms.com which involve two summands, each of which has a unique solution. I also made up an example with a dozen solutions, I + AM = BEN, to test proper backtracking.

solveCryptarithm([H1|T1],[H2|T2],Sum) :-
    operandAlign([H1|T1],[H2|T2],Sum,AddTop,AddPad,Carry,TSum,Pool),
    solveCryptarithmAux(H1,H2,AddTop,AddPad,Carry,TSum,Pool).

operandAlign(Add1,Add2,Sum,AddTop,AddPad,Carry,TSum,Pool) :-
    operandSwapPad(Add1,Add2,Length,AddTop,AddPad),
    length(Sum,Size),
    (   Size = Length
     -> ( Carry = 0, Sum = TSum , Pool = [1|Peel] )
     ;  ( Size is Length+1, Carry = 1, Sum = [Carry|TSum], Pool = Peel )
    ),
    Peel = [2,3,4,5,6,7,8,9,0].

operandSwapPad(List1,List2,Length,Longer,Padded) :-
    length(List1,Length1),
    length(List2,Length2),
    (   Length1 >= Length2
     -> ( Length = Length1, Longer = List1, Shorter = List2, Pad is Length1 - Length2 )
     ;  ( Length = Length2, Longer = List2, Shorter = List1, Pad is Length2 - Length1 )
    ),
    zeroPad(Shorter,Pad,Padded).

zeroPad(L,0,L).
zeroPad(L,K,P) :-
    K > 0,
    M is K-1,
    zeroPad([0|L],M,P).

solveCryptarithmAux(_,_,[],[],0,[],_).
solveCryptarithmAux(NZ1,NZ2,[H1|T1],[H2|T2],CarryOut,[H3|T3],Pool) :-
    ( CarryIn = 0 ; CarryIn = 1 ),   /* anticipatory carry */
    (   var(H1)
     -> select(H1,Pool,P_ol)
     ;  Pool = P_ol
    ),
    (   var(H2)
     -> select(H2,P_ol,P__l)
     ;  P_ol = P__l
    ),
    (   var(H3)
     -> ( H3 is H1 + H2 + CarryIn - 10*CarryOut, select(H3,P__l,P___) )
     ;  ( H3 is H1 + H2 + CarryIn - 10*CarryOut, P__l = P___ )
    ),
    NZ1 \== 0,
    NZ2 \== 0,
    solveCryptarithmAux(NZ1,NZ2,T1,T2,CarryIn,T3,P___).

I think this illustrates that the advantages of left-to-right search/evaluation can be attained in a "generalized" solver, increasing the number of inferences by roughly a factor of two in comparison with the earlier "tailored" code.

Answer 3

Note: This answer discusses an algorithm for reducing the number of combinations that need to be tried. I don't know Prolog, so I can't provide any code snippets.

The trick to speed up a brute force solution is shortcuts. If you can identify a range of combinations that are invalid you can reduce the number of combinations substantially.

Take the example in hand. When a human solves it, she immediately notices that MONEY has 5 digits while SEND and MORE only have 4, so the M in MONEY must be the digit 1. 90% of the combinations gone!

When constructing an algorithm for a computer, we try to use shortcuts that apply to all possible input first. If they fail to give the required performance we start looking at shortcuts that only apply to specific combinations of input. So we leave the M=1 shortcut for now.

Instead, I would focus on the last digits. We know that (D+E) mod 10 = Y. That's our 90% reduction in the number of combinations to try.

That step should bring exacution to just under a minute.

What can we do if that's not enough? Next step: Look at the second to last digit! We know that (N+R+carry from D+E) mod 10 = E.

Since we are testing through all valid combinations of the last digit, for each test we will know whether the carry is 0 or 1. A complication (for the code) that further reduces the number of combinations to be tested is that we will encounter duplicates (a letter gets mapped to a number that is already assigned to another letter). When we encounter a duplicate, we can advance to the next combination without going further down the chain.

Good luck with your assignment!