如何编写 Prolog 求解器来解决这个逻辑问题？

Question

我花了一些时间学习 Prolog，对事实、规则、列表等 Prolog 概念有了一些基本的了解。但是还是觉得很难用Prolog作为解决逻辑问题的工具。比如下面这个：

Guess the number with following facts:
2741: A digit is right, but it's in the wrong place.
4132: Two digits are right, but it's in the wrong place.
7642: None of the digits are right.
9826: One digit is correct and in the right place.
5079: Two digits are right, one is in the right place and 
      the other is in the wrong place.

我手动解决了这个问题，答案是9013。请问如何写一个Prolog问题来解决这个问题？出于学习目的，现在我不喜欢使用任何模块。

Answer 1

将我之前关于此类谜题的代码进行归纳，我们得到

check( Sol, Guess, NValues-NPlaces ) :-
    findall( t, (member(E, Guess), member(E, Sol)), Values ),
    length( Values, NValues ), 
    maplist( eq, Sol, Guess, NS),
    sum_list( NS, NPlaces).

eq(A,B,X) :- A =:= B -> X=1 ; X=0.

select([X|XS],Dom) :- select(X,Dom,Dom2), select(XS,Dom2).
select([],_).

puzzle( [A,B,C,D] ) :-   
    Dom = [0, 1, 3, 5, 8, 9],          % using hint 3 
    select( [A,B,C,D], Dom),           % with unique digits
    maplist( check([A,B,C,D]), 
             [[2,7,4,1], [4,1,3,2], [9,8,2,6], [5,0,7,9]],
             [ 1-0,      2-0,       1-1,       2-1      ] ).

尝试一下：

164 ?- time( puzzle(X) ).
% 33,274 inferences, 0.016 CPU in 0.011 seconds (142% CPU, 2132935 Lips)
X = [9, 0, 1, 3] ;
% 5,554 inferences, 0.016 CPU in 0.002 seconds (780% CPU, 356023 Lips)
false.

或者我们可以内联定义，将它们融合在一起作为

mmd(Sol):-
  %%maplist( dif, [2,7,4,1], Sol),         % 1.
  maplist( dif, [4,1,3,2], Sol),           % 2.
  maplist( eq1, Sol, [9,8,2,6], NS4),
                      sum_list( NS4, 1),   % 4.
  maplist( eq1, Sol, [5,0,7,9], NS5),
                      sum_list( NS5, 1),   % 5.
  select( Sol, [0,1,3,5,8,9]),             % 3.

  %%findall( t, (member(E, [2,7,4,1]), member(E, Sol)), [_] ), % 1.
  findall( t, (member(E, [4,1,3,2]), member(E, Sol)), [_,_] ), % 2.
  %%findall( t, (member(E, [9,8,2,6]), member(E, Sol)), [_] ), % 4.
  findall( t, (member(E, [5,0,7,9]), member(E, Sol)), [_,_] ). % 5.

eq1(A,B,C) :- (A#=B,C=1 ; dif(A,B),C=0).

重新排列 sub-goals 以尽可能地限制搜索 space，因此 几乎立即 找到了解决方案，并且整体推论被削减得更多比一半：

167 ?- time( mmd(S) ).
% 1,219 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
S = [9, 0, 1, 3] ;
% 13,714 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
false.

正如在另一个答案中首先注意到的那样，并非所有线索实际上都是必需的，删除它们甚至可以减少解决此问题所需的推理数量。

Answer 2

这是我的解决方案：

% Digits in right place, Digits in wrong place
digit_clue([2, 7, 4, 1], 0, 1).  % Clue is not needed, to decide 9013
digit_clue([4, 1, 3, 2], 0, 2).
digit_clue([7, 6, 4, 2], 0, 0).
digit_clue([9, 8, 2, 6], 1, 0).
digit_clue([5, 0, 7, 9], 1, 1).


go(Solution) :-
    foreach(digit_clue(LstDigits, IntRight, IntWrong),
        add_clue(LstDigits, IntRight, IntWrong, Solution)),
    % Solution is 4 digits (without duplicates) in range 0-9
    element_list_selection([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], 4, Solution).


add_clue(LstDigits, IntRight, IntWrong, Solution) :-
    count_right_place(LstDigits, IntRight, Solution),
    count_wrong_place(LstDigits, IntWrong, Solution, Solution),
    IntNotPresent is 4 - (IntRight + IntWrong),
    count_not_present(LstDigits, IntNotPresent, Solution, Solution).


% Digit Head, Solution Tail, etc.
count_right_place([], 0, []).
count_right_place([DH|DT], IntRight, [SH|ST]) :-
    succ(IntRight0, IntRight),
    % This is the digit in the Solution
    DH = SH,
    count_right_place(DT, IntRight0, ST).

count_right_place([DH|DT], IntRight, [SH|ST]) :-
    % This is not the digit in the Solution
    dif(DH, SH),
    count_right_place(DT, IntRight, ST).


count_wrong_place([], 0, _Solution, []).
count_wrong_place([DH|DT], IntWrong, Solution, [SH|ST]) :-
    succ(IntWrong0, IntWrong),
    % Digit is in Solution
    member(DH, Solution),
    % ... but not in this position
    dif(DH, SH),
    count_wrong_place(DT, IntWrong0, Solution, ST).

count_wrong_place([_DH|DT], IntWrong, Solution, [_SH|ST]) :-
    % No info to add
    count_wrong_place(DT, IntWrong, Solution, ST).


count_not_present([], 0, _Solution, []).
count_not_present([DH|DT], IntNotPresent, Solution, [_SH|ST]) :-
    succ(IntNotPresent0, IntNotPresent),
    % Digit is not present in Solution
    maplist(dif(DH), Solution),
    count_not_present(DT, IntNotPresent0, Solution, ST).

count_not_present([_DH|DT], IntNotPresent, Solution, [_SH|ST]) :-
    % No info to add
    count_not_present(DT, IntNotPresent, Solution, ST).


% Select IntElements from LstFull (random order, no duplicates)
element_list_selection(LstFull, IntElements, LstSelection) :-
    length(LstSelection, IntElements),
    element_list_selection_(LstSelection, LstFull).

element_list_selection_([], _LstFull).
element_list_selection_([H|T], Lst) :-
    select(H, Lst, Lst0),
    element_list_selection_(T, Lst0).

结果swi-prolog：

?- time(findall(Sol, go(Sol), Sols)).
% 53,013 inferences, 0.008 CPU in 0.008 seconds (101% CPU, 6442489 Lips)
Sols = [[9,0,1,3]].

有趣的是，不需要 2741 提示。

如何编写 Prolog 求解器来解决这个逻辑问题？

How to write a Prolog solver to solve this logic problem?

prolog

cryptarithmetic-puzzle