Пролог-криптарифметическая головоломка

Меня попросили решить криптарифметическую головоломку с использованием Пролога:

GIVE
* ME 
------
MONEY

Вышеупомянутая головоломка, я не могу понять, в чем проблема, результат всегда возвращает false. Кроме того, мне не разрешено использовать какую-либо библиотеку в 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).

Пример запроса:

?- solve([G,I,V,E,M,O,N,Y]).
false.                          % fails unexpectedly

person kyo    schedule 15.04.2011    source источник


Ответы (2)


Следующая статья Эрика Вайсштейна и Эда Пегга будет полезна. Он предлагает несколько решений аналогичной задачи в системе Mathematica.

Используя очень грубый подход, есть два решения: 1072 * 92 = 98624 и 1092 * 72 = 78624. Код, который я использовал:

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}}
person Sasha    schedule 17.04.2011
comment
Ну, Mathematica не очень похожа на Prolog. (На самом деле ни один язык, кроме Пролога, не очень похож на Пролог, если на то пошло….) [На самом деле ошибка в коде OP, вероятно, находится в перестановке, поэтому что-то вроде встроенных перестановок Mathematica выходит за рамки OP.] - person ShreevatsaR; 18.04.2011
comment
@ShreevatsaR. Реализация permute не была реальной проблемой. Подробности смотрите в моем ответе выше... - person repeat; 13.08.2015

Давайте сразу к сути дела!

  • Каждая перестановка [0,1,2,3,4,5,6,7,8,9] представляет собой список длиной 10.
  • [G,I,V,E,M,O,N,Y] — это список длиной 8.
  • Никакая перестановка [0,1,2,3,4,5,6,7,8,9] не может быть объединена с [G,I,V,E,M,O,N,Y].

В качестве быстрого исправления адаптируйте определение check/1 следующим образом:

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.

Затем выполните следующий «фиксированный» запрос:

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

Вот еще один способ решения проблемы:

Во-первых, используйте clpfd! >

:- use_module(library(clpfd)).

Во-вторых, (повторно) используйте код, представленный ранее в мой ответ на соответствующий вопрос Более быстрая реализация вербальной арифметики в Прологе:

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

Никаких лишних решений. На несколько порядков быстрее, чем «генерировать и тестировать». clpfd потрясает!

person repeat    schedule 12.08.2015