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

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

提问人:Xiaoyong Guo 提问时间:2/17/2022 最后编辑:falseXiaoyong Guo 更新时间:2/19/2022 访问量:152

问:

我花了一些时间学习 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问题来解决这个问题?现在,出于学习目的,我不喜欢使用任何模块。

Prolog 密码学拼图

评论

0赞 Will Ness 2/17/2022
我曾经回答类似的问题。看看是否有帮助。:)
0赞 Enigmativity 2/17/2022
这回答了你的问题吗?使用 Prolog 解决脑筋急转弯 (Master Mind)
0赞 Enigmativity 2/17/2022
@WillNess - 对我来说似乎是重复的。
0赞 Will Ness 2/17/2022
@Enigmativity差不多 -- 这里是 4 位数字,那里是 3 位数字。几乎是一样的,是的。我刚刚找到了它。:)
0赞 Will Ness 2/17/2022
@Enigmativity我的意思是,我刚刚找到了那个链接,还没有考虑过它是否适合复制。仔细看,确实两个答案都有代码中的 3 位硬编码,所以,也许不是。 :)(?)

答:

1赞 Will Ness 2/17/2022 #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).

重新排列子目标以尽可能限制搜索空间,因此几乎可以立即找到解决方案,并且总体推论减少了一半以上:

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.

正如在另一个答案中首次注意到的那样,并不是所有线索都是真正需要的,删除它们甚至可以减少解决这个问题所需的推论数量。

1赞 brebs 2/18/2022 #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 提示。