Using Prolog to solve a brain teaser (Master Mind)

Question

A friend from work shared this with our whatsapp group:

This lock has a 3 digit code.
Can you guess it using only these hints?

We solved it using something akin to a truth table. I'm curious however, how would this be solved in Prolog?

Answer 1

Using same code as in https://stackoverflow.com/a/73433620/

padlock(S) :-
    length(S, 3),
    present([2,9,1], S, 1, 0),
    present([2,4,5], S, 0, 1),
    present([4,6,3], S, 0, 2),
    % 5,7,8 is an unnecessary clue
    present([5,7,8], S, 0, 0),
    present([5,6,9], S, 0, 1).

present(L, S, R, W) :-
    % Keep copy of full S
    present_(L, S, S, R, W).

present_([], [], _, 0, 0).
present_([H|T], [H|S], F, R, W) :-
    % Present and in right place
    present_(T, S, F, R0, W),
    R is R0 + 1.
present_([H|T], [HS|S], F, R, W) :-
    % Present but in wrong place
    dif(H, HS),
    member(H, F),
    present_(T, S, F, R, W0),
    W is W0 + 1.
present_([H|T], [_|S], F, R, W) :-
    % H is not present at all
    maplist(dif(H), F),
    present_(T, S, F, R, W).

Result in swi-prolog:

?- time(setof(L, padlock(L), Ls)).
% 7,466 inferences, 0.000 CPU in 0.000 seconds (99% CPU, 15485996 Lips)
Ls = [[3, 9, 4]].

Answer 2

Here is one with the "generate, then test" approach. Another approach would use 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).

Ready!

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

The above attempt is wrong, because...

The actual problem statement is sharper than suspected at first.

It is correctly stated thus:

"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)

This leads new code performing explicit counting of hits, because making the above explicit through membership checks is tedious.

This is ultimately the same as Will Ness' solution, just coded a bit differently.

Another problem appears: One has to count possible pairings when counting "values in the wrong place", i.e discard a paired element one it has been used in counting. See also: Master Mind Rule ambiguity. Using member/2 as I did won't do that, one has to use selectchk/3 to cut out the matched element and continue with the reduced list. The code below is fixed accordingly. The erroneous version works in this example, because the problem only surfaces for duplicate digits in the wrong place.

:- 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).

And indeed

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

Answer 3

Straightforward coding of the check predicate:

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 ).

Then simply transcribe the clues, no creativity involved:

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 ).

Running it:

23 ?- time( puzzle(X) ).
/* 13,931 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips) */
X = [3, 9, 4] ;
/* 20,671 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips) */
false.