Faster implementation of verbal arithmetic in Prolog - performance

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!

Answer 4

Here's my take on it. I use clpfd, dcg,
and meta-predicate mapfoldl/5:
:- meta_predicate mapfoldl(4,?,?,?,?).
mapfoldl(P_4,Xs,Zs, S0,S) :-
list_mapfoldl_(Xs,Zs, S0,S, P_4).
:- meta_predicate list_mapfoldl_(?,?,?,?,4).
list_mapfoldl_([],[], S,S, _).
list_mapfoldl_([X|Xs],[Y|Ys], S0,S, P_4) :-
call(P_4,X,Y,S0,S1),
list_mapfoldl_(Xs,Ys, S1,S, P_4).
Let's put mapfoldl/5 to good use and do some verbal arithmetic!
:- use_module(library(clpfd)).
:- use_module(library(lambda)).
digits_number(Ds,Z) :-
Ds = [D0|_],
Ds ins 0..9,
D0 #\= 0, % most-significant digit must not equal 0
reverse(Ds,Rs),
length(Ds,N),
numlist(1,N,Es), % exponents (+1)
maplist(\E1^V^(V is 10**(E1-1)),Es,Ps),
scalar_product(Ps,Rs,#=,Z).
list([]) --> [].
list([E|Es]) --> [E], list(Es).
cryptarithexpr_value([V|Vs],X) -->
{ digits_number([V|Vs],X) },
list([V|Vs]).
cryptarithexpr_value(T0,T) -->
{ functor(T0,F,A) },
{ dif(F-A,'.'-2) },
{ T0 =.. [F|Args0] },
mapfoldl(cryptarithexpr_value,Args0,Args),
{ T =.. [F|Args] }.
crypt_arith_(Expr,Zs) :-
phrase(cryptarithexpr_value(Expr,Goal),Zs0),
( member(Z,Zs0), \+var(Z)
-> throw(error(uninstantiation_error(Expr),crypt_arith_/2))
; true
),
sort(Zs0,Zs),
all_different(Zs),
call(Goal).
Quick and dirty hack to dump all solutions found:
solve_n_dump(Opts,Eq) :-
( crypt_arith_(Eq,Zs),
labeling(Opts,Zs),
format('Eq = (~q), Zs = ~q.~n',[Eq,Zs]),
false
; true
).
solve_n_dump(Eq) :- solve_n_dump([],Eq).
Let's try it!
?- solve_n_dump([S,E,N,D]+[M,O,R,E] #= [M,O,N,E,Y]).
Eq = ([9,5,6,7]+[1,0,8,5]#=[1,0,6,5,2]), Zs = [9,5,6,7,1,0,8,2].
true.
?- solve_n_dump([C,R,O,S,S]+[R,O,A,D,S] #= [D,A,N,G,E,R]).
Eq = ([9,6,2,3,3]+[6,2,5,1,3]#=[1,5,8,7,4,6]), Zs = [9,6,2,3,5,1,8,7,4].
true.
?- solve_n_dump([F,O,R,T,Y]+[T,E,N]+[T,E,N] #= [S,I,X,T,Y]).
Eq = ([2,9,7,8,6]+[8,5,0]+[8,5,0]#=[3,1,4,8,6]), Zs = [2,9,7,8,6,5,0,3,1,4].
true.
?- solve_n_dump([E,A,U]*[E,A,U] #= [O,C,E,A,N]).
Eq = ([2,0,3]*[2,0,3]#=[4,1,2,0,9]), Zs = [2,0,3,4,1,9].
true.
?- solve_n_dump([N,U,M,B,E,R] #= 3*[P,R,I,M,E]).
% same as: [N,U,M,B,E,R] #= [P,R,I,M,E]+[P,R,I,M,E]+[P,R,I,M,E]
Eq = (3*[5,4,3,2,8]#=[1,6,2,9,8,4]), Zs = [5,4,3,2,8,1,6,9].
true.
?- solve_n_dump(3*[C,O,F,F,E,E] #= [T,H,E,O,R,E,M]).
Eq = (3*[8,3,1,1,9,9]#=[2,4,9,3,5,9,7]), Zs = [8,3,1,9,2,4,5,7].
true.
Let's do some more and try some different labeling options:
?- time(solve_n_dump([],[D,O,N,A,L,D]+[G,E,R,A,L,D] #= [R,O,B,E,R,T])).
Eq = ([5,2,6,4,8,5]+[1,9,7,4,8,5]#=[7,2,3,9,7,0]), Zs = [5,2,6,4,8,1,9,7,3,0].
% 35,696,801 inferences, 3.929 CPU in 3.928 seconds (100% CPU, 9085480 Lips)
true.
?- time(solve_n_dump([ff],[D,O,N,A,L,D]+[G,E,R,A,L,D] #= [R,O,B,E,R,T])).
Eq = ([5,2,6,4,8,5]+[1,9,7,4,8,5]#=[7,2,3,9,7,0]), Zs = [5,2,6,4,8,1,9,7,3,0].
% 2,902,871 inferences, 0.340 CPU in 0.340 seconds (100% CPU, 8533271 Lips)
true.

Answer 5

Will Ness style, generalized (but assuming length(A) <= length(B)) solver:
money_puzzle(A, B, C) :-
maplist(reverse, [A,B,C], [X,Y,Z]),
numlist(0, 9, Dom),
swc(0, Dom, X,Y,Z),
A \= [0|_], B \= [0|_].
swc(C, D0, [X|Xs], [Y|Ys], [Z|Zs]) :-
peek(D0, X, D1),
peek(D1, Y, D2),
peek(D2, Z, D3),
S is X+Y+C,
( S > 9 -> Z is S - 10, C1 = 1 ; Z = S, C1 = 0 ),
swc(C1, D3, Xs, Ys, Zs).
swc(C, D0, [], [Y|Ys], [Z|Zs]) :-
peek(D0, Y, D1),
peek(D1, Z, D2),
S is Y+C,
( S > 9 -> Z is S - 10, C1 = 1 ; Z = S, C1 = 0 ),
swc(C1, D2, [], Ys, Zs).
swc(0, _, [], [], []).
swc(1, _, [], [], [1]).
peek(D, V, R) :- var(V) -> select(V, D, R) ; R = D.
performance:
?- time(money_puzzle([S,E,N,D],[M,O,R,E],[M,O,N,E,Y])).
% 38,710 inferences, 0.016 CPU in 0.016 seconds (100% CPU, 2356481 Lips)
S = 9,
E = 5,
N = 6,
D = 7,
M = 1,
O = 0,
R = 8,
Y = 2 ;
% 15,287 inferences, 0.009 CPU in 0.009 seconds (99% CPU, 1685686 Lips)
false.
?- time(money_puzzle([D,O,N,A,L,D],[G,E,R,A,L,D],[R,O,B,E,R,T])).
% 14,526 inferences, 0.008 CPU in 0.008 seconds (99% CPU, 1870213 Lips)
D = 5,
O = 2,
N = 6,
A = 4,
L = 8,
G = 1,
E = 9,
R = 7,
B = 3,
T = 0 ;
% 13,788 inferences, 0.009 CPU in 0.009 seconds (99% CPU, 1486159 Lips)
false.

Answer 6

You have
convert([A,B,C,D]) => convert([A,B,C])*10 + D
=> (convert([A,B])*10+C)*10+D => ...
=> ((A*10+B)*10+C)*10+D
So, you can express this with a simple linear recursion.
More importantly, when you pick one possible digit from your domain 0..9, you shouldn't use that digit anymore for subsequent choices:
selectM([A|As],S,Z):- select(A,S,S1),selectM(As,S1,Z).
selectM([],Z,Z).
select/3 is available in SWI Prolog. Armed with this tool, you can select your digits gradually from your thus narrowing domain:
money_puzzle( [[S,E,N,D],[M,O,R,E],[M,O,N,E,Y]]):-
Dom = [0,1,2,3,4,5,6,7,8,9],
selectM([D,E], Dom,Dom1), add(D,E,0, Y,C1), % D+E=Y
selectM([Y,N,R],Dom1,Dom2), add(N,R,C1,E,C2), % N+R=E
select( O, Dom2,Dom3), add(E,O,C2,N,C3), % E+O=N
selectM([S,M], Dom3,_), add(S,M,C3,O,M), % S+M=MO
S \== 0, M \== 0.
We can add two digits with a carry, add produce a resulting digit with new carry (say, 4+8 (0) = 2 (1) i.e. 12):
add(A,B,C1,D,C2):- N is A+B+C1, D is N mod 10, C2 is N // 10 .
Thus implemented, money_puzzle/1 runs instantaneously, thanks to the gradual nature in which the digits are picked and tested right away:
?- time( money_puzzle(X) ).
% 27,653 inferences, 0.02 CPU in 0.02 seconds (100% CPU, 1380662 Lips)
X = [[9, 5, 6, 7], [1, 0, 8, 5], [1, 0, 6, 5, 2]] ;
No
?- time( (money_puzzle(X),fail) ).
% 38,601 inferences, 0.02 CPU in 0.02 seconds (100% CPU, 1927275 Lips)
The challenge becomes now to make it generic.