使用 Prolog 解决脑筋急转弯 (Master Mind)
Using Prolog to solve a brain teaser (Master Mind)
一位同事与我们的 whatsapp 群组分享了这个：
This lock has a 3 digit code.
Can you guess it using only these hints?
我们使用类似于真理的东西解决了它 table。不过我很好奇，这在 Prolog 中是如何解决的？
这是一个采用 "generate, then test" 方法的方法。另一种方法是使用 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)
这导致新代码执行显式的命中计数，因为通过成员资格检查使上述内容显式是乏味的。
这与 Will Ness 的解决方案基本相同，只是编码略有不同。
又出现了一个问题：在计算"values in the wrong place"时，必须计算可能的配对，即丢弃一个配对元素已用于计数。另请参阅：Master Mind Rule ambiguity. Using member/2 as I did won't do that, one has to use 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.
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>
一位同事与我们的 whatsapp 群组分享了这个：
This lock has a 3 digit code.
Can you guess it using only these hints?
我们使用类似于真理的东西解决了它 table。不过我很好奇，这在 Prolog 中是如何解决的？
这是一个采用 "generate, then test" 方法的方法。另一种方法是使用 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)
这导致新代码执行显式的命中计数，因为通过成员资格检查使上述内容显式是乏味的。
这与 Will Ness 的解决方案基本相同，只是编码略有不同。
又出现了一个问题：在计算"values in the wrong place"时，必须计算可能的配对，即丢弃一个配对元素已用于计数。另请参阅：Master Mind Rule ambiguity. Using member/2 as I did won't do that, one has to use 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.
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>