Prolog Cryptarithmetic Puzzle

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 us开发者_高级运维e 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

Let's get right to the heart of the matter!

• Every permutation of [0,1,2,3,4,5,6,7,8,9] is a list of length 10.
• [G,I,V,E,M,O,N,Y] is a list of length 8.
• No permutation of [0,1,2,3,4,5,6,7,8,9] can be unified with [G,I,V,E,M,O,N,Y].

As a quick-fix, adapt the definition of check/1 like this:

check([G,I,V,E,M,O,N,Y,_,_]) :-
   find( VAL,  G,I,V,E), 
   G >= 1,
   find2(VALR, M,E),
   M >= 1,
   find3(VALA, M,O,N,E,Y),
   VAL * VALR =:= VALA.

Then, run the following "fixed" query:

?- Expr = ([G,I,V,E]*[M,E] = [M,O,N,E,Y]),
   Zs   = [G,I,V,E,M,O,N,Y,_,_],
   time(solve(Zs)).
% 24,641,436 inferences, 7.692 CPU in 7.709 seconds (100% CPU, 3203506 Lips)
Expr = ([1,0,7,2] * [9,2] = [9,8,6,2,4]),
Zs   = [1,0,7,2,9,8,6,4,3,5] ;
% 7,355 inferences, 0.007 CPU in 0.007 seconds (100% CPU, 1058235 Lips)
Expr = ([1,0,7,2] * [9,2] = [9,8,6,2,4]),      % redundant
Zs   = [1,0,7,2,9,8,6,4,5,3] ;
% 6,169,314 inferences, 1.935 CPU in 1.939 seconds (100% CPU, 3188312 Lips)
Expr = ([1,0,9,2] * [7,2] = [7,8,6,2,4]),
Zs   = [1,0,9,2,7,8,6,4,3,5] ;
% 7,355 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 1360603 Lips)
Expr = ([1,0,9,2] * [7,2] = [7,8,6,2,4]),      % redundant
Zs   = [1,0,9,2,7,8,6,4,5,3] ;
% 6,234,555 inferences, 1.955 CPU in 1.959 seconds (100% CPU, 3189462 Lips)
false.

Here's another way to solve the problem:

First, use clpfd!

:- use_module(library(clpfd)).

Second, (re-)use code presented earlier in my answer to the related question Faster implementation of verbal arithmetic in Prolog:

?- Expr = ([G,I,V,E] * [M,E] #= [M,O,N,E,Y]),
   Zs   = [G,I,V,E,M,O,N,Y],
   crypt_arith_(Expr,Zs),
   time(labeling([],Zs)).
% 397,472 inferences, 0.088 CPU in 0.088 seconds (100% CPU, 4521899 Lips)
Expr = ([1,0,7,2] * [9,2] #= [9,8,6,2,4]), Zs = [1,0,7,2,9,8,6,4] ;
% 128,982 inferences, 0.037 CPU in 0.037 seconds (100% CPU, 3502788 Lips)
Expr = ([1,0,9,2] * [7,2] #= [7,8,6,2,4]), Zs = [1,0,9,2,7,8,6,4] ;
% 77,809 inferences, 0.028 CPU in 0.028 seconds (100% CPU, 2771783 Lips)
false.

No redundant solutions. Orders of magnitude faster than "generate & test". clpfd rocks!

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}}