Faster implementation of verbal arithmetic in Prolog

I already made a working generalized speech arithmetic algorithm in Prolog, but it is too slow. It takes 8 minutes to run a simple expression. SEND + MORE = MONE Y. Can someone help me speed up the execution?

/* 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. 
+7
source share
6 answers

Consider the use of destination domain restrictions , 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. 

Request example:

 ?- 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. 
+6
source

Poor performance here is due to the formation of all possible letter assignments before checking if this is possible.

My advice is: "Failure early, not often." That is, click as many failures checks as possible on the assignment steps as early as possible, thereby trimming the search tree.

Klas Lindbäck offers good deals. As a generalization, when adding two numbers, carry no more than one in each place. Thus, the assignment of individual numbers to letters from left to right can be checked with the possibility of transfer as yet undefined in the rightmost places. (Of course, there is no carrying in the “units” finale.)

There is a lot to think about, so the logic of restrictions, as suggested by matte (and which you have already discussed with fd_all_different / 1 ), is such a convenience.


Added: Here is the Prolog solution without logic of restrictions, using only one auxiliary predicate to omit / 3 :

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

which selects an item from the list and creates a shortened list without this item.

Then the code for sendMoreMoney / 3 , which performs a search evaluating the amount 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 quickly begin by observing that M must be a nonzero carry from the leftmost digit of the digits, therefore 1 and that S must be some other nonzero digit. The comments show the steps in which additional letters can be deterministically assigned values ​​based on choices already made.


Added (2): Here is a “common” crypto-solver for two terms that should not have the same length / number of “places”. The code for length / 2 is omitted as a fairly common built-in predicate, and, accepting Will Ness's suggestion, omit calls / 3 are replaced by select / 3 for the convenience of SWI-Prolog users.

I tested it with Amzi! and SWI-Prolog using these examples of alpha-america from Cryptarithms.com , which include two terms, each of which has a unique solution. I also made an example with a dozen solutions, I + AM = BEN, to check for 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 searching / evaluating from left to right can be achieved in a “generalized” solver, increasing the number of conclusions by about two times compared to the earlier “adapted” code.

+4
source

Note. This answer discusses an algorithm to reduce the number of combinations that you need to try. I do not know Prolog, so I cannot provide code snippets.

The trick to speeding brute force decisions is shortcuts. If you can determine the range of invalid combinations, you can significantly reduce the number of combinations.

Take an example in hand. When a person solves it, she immediately notices that MONEY has 5 digits, and SEND and MORE are only 4, so M in MONEY should be the number 1. 90% of the combinations are gone!

When constructing an algorithm for a computer, we try to use shortcuts that apply to all possible inputs. If they do not give the required performance, we start looking for shortcuts that apply only to specific input combinations. So, we leave the label M = 1 at the moment.

Instead, I would focus on the final numbers. We know that (D + E) mod 10 = Y. This is our 90% reduction in the number of combinations to try.

This step should be completed in less than a minute.

What can we do if this is not enough? Next step: Look at the second digit! We know that (N + R + are carried from D + E) mod 10 = E.

Since we test all valid combinations of the last digit, for each test we will know whether the hyphenation is 0 or 1. The complication (for the code), which further reduces the number of tested combinations, is that we will encounter duplicates (the letter receives matching with a number that is already assigned to another letter). When we encounter a duplicate, we can move on to the next combination without moving further down the chain.

Good luck with your work!

+3
source

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 it with a simple linear recursion.

More importantly, when you select one possible digit from your 0..9 domain, you should no longer use this digit for the following options:

 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 gradually select your numbers from your 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 hyphen, add a derivative digit with a new hyphen (say 4+8 (0) = 2 (1) ie 12):

 add(A,B,C1,D,C2):- N is A+B+C1, D is N mod 10, C2 is N // 10 . 

Thus, money_puzzle/1 is executed instantly due to the gradual nature in which the numbers are selected and tested immediately:

 ?- 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) 

Now the task is to make it general.

+2
source

Here I take it upon myself. I use , , and 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). 

Put mapfoldl/5 for 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(FA,'.'-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 all the 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). 

Give it a try!

  ? - 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, nine].
 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

Take a few more and try a few 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
+2
source

Will there be a 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. 
+1
source

All Articles