Пролог Криптарифметическая головоломка - PullRequest
4 голосов
/ 15 апреля 2011

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

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

Ответы [ 2 ]

2 голосов
/ 12 августа 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(<b>[G,I,V,E,M,O,N,Y,_,_]</b>) :-
   find( VAL,  G,I,V,E), 
   <b>G >= 1</b>,
   find2(VALR, M,E),
   <b>M >= 1</b>,
   find3(VALA, M,O,N,E,Y),
   VAL * VALR =:= VALA.

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

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

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

Сначала использовать !

:- 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 <b>0.088</b> 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 <b>0.037</b> 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 <b>0.028</b> seconds (100% CPU, 2771783 Lips)
false.

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

0 голосов
/ 18 апреля 2011

Следующая статья Эрика Вайштайна и Эда Пегга * будет полезна.Он предлагает несколько решений для аналогичной проблемы в 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}}
...