3

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?

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

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

5

3 Answers 3

2

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.
2
  • normally I'd try to be clever and minimize generation by interspersing the checks, but you selected all upfront, and so did I. :) :) and it did allow for this simplistic code.
    – Will Ness
    Apr 17, 2020 at 17:58
  • So, I recoded for the reformulated problem, using counting too, arriving at a neighbouring way of doing things. YES Apr 17, 2020 at 20:52
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.
8
  • Hi @david, thanks for taking a crack at it. I think only 394 is the correct answer. Based on rule 5... digits 9 & 6 can't both be in the answer Apr 17, 2020 at 17:18
  • I think clue3 isn't coded quite right. (I think it is implied that only two digits are right, i.e. not all three)
    – Will Ness
    Apr 17, 2020 at 17:18
  • If three were right, it would say so. That's how I read it. Your results do not contradict it, but code for clue/3 allows it, I think.
    – Will Ness
    Apr 17, 2020 at 17:25
  • 1
    Hi @DavidTonhofer, [4, 9, 6] or [6, 9, 4] can't be an answer since clue 5 says *One digit is right ...". It means therefore and 9 and 6 can't both be a part of the answer. It has to contain either 9 or 6. Apr 17, 2020 at 17:53
  • 1
    @DavidTonhofer rep = 7,777 heh heh. :)
    – Will Ness
    Apr 17, 2020 at 17:56
0

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

digits_length(3).

digit_clue([2,9,1], 1, 1).
digit_clue([2,4,5], 1, 0).
digit_clue([4,6,3], 2, 0).
digit_clue([5,7,8], 0, 0).
digit_clue([5,6,9], 1, 0).

go(Sol) :-
    digits_length(Len),
    length(Sol, Len),
    findall(clue(Digits, PR, RP), digit_clue(Digits, PR, RP), Clues),
    add_digit_clues(Clues, Sol),
    maplist(between(0, 9), Sol).

add_digit_clues([], _).
add_digit_clues([clue(Digits, PR, RP)|T], Sol) :-
    add_digit_clue(Digits, Digits, PR, RP, Sol),
    add_digit_clues(T, Sol).

add_digit_clue([], _, 0, 0, _).
add_digit_clue([H|T], DigitsOrig, PR, RP, Sol) :-
    compare(Comp, PR, 0),
    add_clue(Comp, [H|T], DigitsOrig, PR, RP, RP0, Digits0, PR0, Sol),
    add_digit_clue(Digits0, DigitsOrig, PR0, RP0, Sol).

add_clue('=', Digits, _DigitsOrig, 0, 0, 0, [], 0, Sol) :-
    % None in Digits are in Sol
    list_elems_not_in_list(Digits, Sol).

add_clue('>', Digits, DigitsOrig, PR, RP, RP0, Digits0, PR0, Sol) :-
    succ(PR0, PR),
    compare(Comp, PR, RP),
    add_clue_rp(Comp, Digits, DigitsOrig, RP, RP0, Digits0, Sol).

add_clue_rp(Comp, Digits, DigitsOrig, RP, RP0, Digits0, Sol) :-
    (   Comp = '>',
        present_wrong_place(Digits, DigitsOrig, RP, RP0, Digits0, Sol)
    ;   present_right_place(Digits, DigitsOrig, RP, RP0, Digits0, Sol)
    ).

present_right_place(Digits, DigitsOrig, RP, RP0, Digits0, Sol) :-
    succ(RP0, RP),
    select(Digit, Digits, Digits0),
    nth0(Pos, DigitsOrig, Digit),
    nth0(Pos, Sol, Digit).

present_wrong_place(Digits, DigitsOrig, RP, RP, Digits0, Sol) :-
    select(Digit, Digits, Digits0),
    nth0(Pos, DigitsOrig, Digit),
    nth0(Pos, Sol, DigitSol),
    % The digit is in a different position, in Sol
    dif(Digit, DigitSol),
    member(Digit, Sol).

list_elems_not_in_list([], _).
list_elems_not_in_list([H|T], Lst) :-
    maplist(dif(H), Lst),
    list_elems_not_in_list(T, Lst).

Result in swi-prolog:

?- time(setof(S, go(S), Ss)).
% 4,218 inferences, 0.001 CPU in 0.001 seconds (99% CPU, 5254530 Lips)
Ss = [[3,9,4]].

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.