Использование Пролога для решения головоломок (Master Mind) - PullRequest
Новая
       43

Использование Пролога для решения головоломок (Master Mind)

3 голосов
/ 17 апреля 2020

Друг с работы поделился этим с нашей группой WhatsApp:

Этот замок имеет код 3 di git.
Можете ли вы угадать его, используя только эти подсказки?

If you had to solve this using Prolog how'd you do it?

Мы решили это с помощью чего-то похожего на таблицу истинности. Мне любопытно, однако, как это можно решить в Прологе?

Ответы [ 2 ]

2 голосов
/ 17 апреля 2020

Простое кодирование предиката check : 

check( Solution, Guess, NValues, NPlaces ) :-
    Solution = [A,B,C],
    Guess   = [X,Y,Z],
    findall( t, (member(E, Guess), member(E, Solution)), Values ),
    length( Values, NValues ),
    ( A=X -> V1    is 1    ; V1      is 0  ),
    ( B=Y -> V2     is 1+V1 ; V2      is V1 ),
    ( C=Z -> NPlaces is 1+V2 ; NPlaces is V2 ).

Затем просто расшифруйте подсказки, без творческого подхода: 

puzzle( [A,B,C] ):-
    findall( X, between(0,9,X), XS ),
    select(A,XS,RA), select(B,RA,RB), member(C,RB),
    /* "291": one digit is right and in its place
       "245": one digit is right but in the wrong place
       "463": two digits are right but both are in the wrong place
       "578": all digits are wrong
       "569": one digit is right but in the wrong place */
    check( [A,B,C], [2,9,1], 1, 1 ),
    check( [A,B,C], [2,4,5], 1, 0 ),
    check( [A,B,C], [4,6,3], 2, 0 ),
    check( [A,B,C], [5,7,8], 0, 0 ),
    check( [A,B,C], [5,6,9], 1, 0 ).

Выполнение: 

<i>23 ?- time( puzzle(X) ).
/* 13,931 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips) */
X = [3, 9, 4] <b>;</b>
/* 20,671 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips) */
<b>false.</b></i>
2 голосов
/ 17 апреля 2020

Вот пример с подходом «создай, а затем проверь». Другой подход будет использовать CLP (FD). 

% This anchors the values of A,B,C to the digits

base([A,B,C])  :- member(A,[0,1,2,3,4,5,6,7,8,9]),
                  member(B,[0,1,2,3,4,5,6,7,8,9]),
                  member(C,[0,1,2,3,4,5,6,7,8,9]).

% "291": one digit is right and in its place
% "245": one digit is right but in the wrong place
% "463": two digits are right but both are in the wrong place
% "578": all digits are wrong
% "569": one digit is right but in the wrong place

clue1([A,B,C]) :- A=2 ; B=9; C=1.
clue2([A,B,C]) :- member(2,[B,C]); member(4,[A,C]); member(5,[A,B]).
clue3([A,B,C]) :- permutation([_,6,3], [A,B,C]), [A,B,C]\=[_,6,3].
clue3([A,B,C]) :- permutation([4,_,3], [A,B,C]), [A,B,C]\=[4,_,3].
clue3([A,B,C]) :- permutation([4,6,_], [A,B,C]), [A,B,C]\=[4,6,_].
clue4([A,B,C]) :- A\=5 , B\=7 , C\=8.
clue5([A,B,C]) :- member(5,[B,C]); member(6,[A,C]); member(9,[A,B]).

solution(L)    :- base(L),clue1(L),clue2(L),clue3(L),clue4(L),clue5(L).

Готов! 

?- setof(L,solution(L),Solutions).
Solutions = [[3, 9, 4], [4, 9, 6], [6, 9, 4]].

Вышеприведенная попытка неверна, потому что ...

Фактическое Постановка проблемы поначалу острее, чем предполагалось.

Правильно сформулировано так: 

"291": one digit is right and in its place
       (and of the other digits, none appears)
"245": one digit is right but in the wrong place
       (and of the other digits, none appears)
"463": two digits are right but both are in the wrong place
       (and the third digit does not appear)
"578": all digits are wrong
       (none of the digits appears in any solution)
"569": one digit is right but in the wrong place
       (and of the other digits, none appears)

Это приводит к тому, что новый код выполняет явный подсчет совпадений, потому что сделать вышесказанное явным путем проверки членства утомительно.

В конечном счете, это то же самое, что и решение Уилла Несса, только немного по-другому закодировано.

Появляется еще одна проблема : нужно сосчитать возможных пар при подсчете «значений в неправильном месте», то есть отбрасывать парный элемент, который использовался при подсчете. См. Также: Неопределенность правила главного ума . Используя member/2, поскольку я этого не сделаю, нужно использовать selectchk/3, чтобы вырезать соответствующий элемент и продолжить сокращенный список. Код ниже исправлен соответственно. Ошибочная версия работает в этом примере, потому что проблема появляется только для повторяющихся цифр в неправильном месте. 

:- use_module(library(clpfd)).

% This anchors the values of A,B,C to the digits

base([A,B,C])  :- member(A,[0,1,2,3,4,5,6,7,8,9]),
                  member(B,[0,1,2,3,4,5,6,7,8,9]),
                  member(C,[0,1,2,3,4,5,6,7,8,9]).

% "291": one digit is right and in its place
%        (and of the other digits, none appears)
% "245": one digit is right but in the wrong place
%        (and of the other digits, none appears)
% "463": two digits are right but both are in the wrong place
%        (and the third digit does not appear)
% "578": all digits are wrong
%        (== none of them appears in the solution)
% "569": one digit is right but in the wrong place
%        (and of the other digits, none appears)

% Compare guess against clue and:
%
% - Count the number of digits that are "on the right place"
%   and discard them, keeping the part of the guess and clue as
%   "rest" for the next step.
% - Count the number of digits that are "on the wrong place"
%   and discard any pairings found, which is done with 
%   selectchk/3. If one uses member/2 as opposed to 
%   selectchk/2, the "wrong place counting" is, well, wrong.

% Note: - Decisions (guards and subsequent commits) made explicit
%         Usual style would be to share variables in the head instead,
%         then have a "green" or "red" cut as first occurence in the body.
%       - Incrementing the counter is done "early" by a constraint "#="
%         instead of on return by an effective increment,
%         because I feel like it (but is this worse efficiency-wise?)
%       - Explicit repetiton of "selectchk/3" before the green cut,
%         because I want the Cut to stay Green (Could the compiler 
%         optimized this away and insert a Red Cut in the preceding
%         clause? Probably not because Prolog does not carry enough
%         information for it to do so)

right_place_counting([],[],0,[],[]).

right_place_counting([G|Gs],[C|Cs],CountOut,Grest,Crest) :-
   G=C,
   !,
   CountOut#=CountMed+1,
   right_place_counting(Gs,Cs,CountMed,Grest,Crest).

right_place_counting([G|Gs],[C|Cs],CountOut,[G|Grest],[C|Crest]) :-
   G\=C,
   !,
   right_place_counting(Gs,Cs,CountOut,Grest,Crest).

% ---

wrong_place_counting([],_,0).

wrong_place_counting([G|Gs],Cs,CountOut) :-
    selectchk(G,Cs,CsRest),
    !,
    CountOut#=CountMed+1,
    wrong_place_counting(Gs,CsRest,CountMed).

wrong_place_counting([G|Gs],Cs,CountOut) :-
    \+selectchk(G,Cs,_),
    !,
    wrong_place_counting(Gs,Cs,CountOut).

% ---

counting(Guess,Clue,RightPlaceCount,WrongPlaceCount) :-
   right_place_counting(Guess,Clue,RightPlaceCount,Grest,Crest),
   wrong_place_counting(Grest,Crest,WrongPlaceCount).


clue1(Guess) :- counting(Guess,[2,9,1],1,0).
clue2(Guess) :- counting(Guess,[2,4,5],0,1).
clue3(Guess) :- counting(Guess,[4,6,3],0,2).
clue4(Guess) :- counting(Guess,[5,7,8],0,0).
clue5(Guess) :- counting(Guess,[5,6,9],0,1).

solution(L)  :- base(L),clue1(L),clue2(L),clue3(L),clue4(L),clue5(L).

И действительно 

?- solution(L).
L = [3, 9, 4] ;
false.
...