I have been asked to solve a Cryptarithmetic Puzzle using Prolog:
GIVE
* ME
------
MONEY
The above is the puzzle, I cannot figure out where is the problem, the result always returns false. Plus I am not allowed to use any library in SWI-Prolog.
solve(Z) :-
assign(Z,[0,1,2,3,4,5,6,7,8,9]),
check(Z).
find( VAL , G,I,V,E ) :- VAL is G * 1000 + I * 100 + V * 10 + E.
find2(VALR, M,E ) :- VALR is M * 10 + E.
find3(VALA, M,O,N,E,Y) :- VALA is M * 10000 + O * 1000 + N * 100 + E * 10 + Y.
check(Z) :-
G #>= 1,
M #>= 1,
find( VAL, G,I,V,E),
find2(VALR, M,E),
find3(VALA, M,O,N,E,Y),
VAL * VALR =:= VALA.
assign(Z,L) :-
permute(L,Z).
/* permute is similar to all_different in swi-prolog */
addany(X,K,[X|K]).
addany(X,[F|K],[F|L1]) :-
addany(X,K,L1).
permute([],[]).
permute([X|K],P) :-
permute(K,L1),
addany(X,L1,P).
Sample query:
?- solve([G,I,V,E,M,O,N,Y]).
false. % fails unexpectedly
The following article by Eric Weisstein and Ed Pegg will be useful. It offers several solutions for a similar problem in Mathematica.
Using a very brute-force approach, there are two solutions: 1072 * 92 = 98624 and 1092 * 72 = 78624. The code that I used:
In[16]:= Cases[
Permutations[
Range[0, 9], {5}], {g_, i_, v_, e_, m_} /; g > 0 && m > 0 :>
With[{dig = IntegerDigits[(g*10^3 + i*10^2 + v*10 + e) (10 m + e)]},
Join[{g, i, v, e, m}, dig[[{2, 3, 5}]]] /;
And[Length[dig] == 5, Unequal @@ dig, dig[[{1, 4}]] == {m, e},
Intersection[dig[[{2, 3, 5}]], {g, i, v, e, m}] === {} ]
]]
Out[16]= {{1, 0, 7, 2, 9, 8, 6, 4}, {1, 0, 9, 2, 7, 8, 6, 4}}