4

I just started learning prolog and I'm stuck trying to solve this puzzle :

Alt

I tried to add some rules like this example http://swish.swi-prolog.org/example/houses_puzzle.pl but I couldn't come up with a solution.

What I tried so far:

% Render the houses term as a nice table.
:- use_rendering(table,
         [header(h('N1', 'N2', 'N3'))]).
numbers(Hs) :-
    length(Hs, 1),
    member(h(6,8,2), Hs),
    member(h(6,1,4), Hs),
    member(h(2,0,6), Hs),
    member(h(7,3,8), Hs),
    member(h(7,8,0), Hs),
    correct_and_placed(6, 8, 2, Hs).

correct_and_place(A, B, C, R).

But I don't even know how to write a rule that can check if a number is correct and on the right place.

William Okano
  • 370
  • 1
  • 3
  • 10
  • 1
    I would do this by generating all of the possible solutions and excluding the incorrect ones by applying the facts one by one. – Eugene Sh. Feb 21 '17 at 17:51
  • 1
    In your attempt, you set the length of list `Hs` to 1, meaning it only has exactly one element, but then check that it necessarily has 6 different unique elements. That will always fail. `correct_and_place/4` does nothing but succeed regardless of the arguments. – lurker Feb 21 '17 at 18:12

6 Answers6

4

To the existing answers, I would like to add a version using CLP(FD) constraints.

The two building blocks I shall use are num_correct/3 and num_well_placed/3.

First, num_correct/3, relating two lists of integers to the number of common elements:

num_correct(Vs, Ns, Num) :-
        foldl(num_correct_(Vs), Ns, 0, Num).

num_correct_(Vs, Num, N0, N) :-
        foldl(eq_disjunction(Num), Vs, 0, Disjunction),
        Disjunction #<==> T,
        N #= N0 + T.

eq_disjunction(N, V, D0, D0 #\/ (N #= V)).

Sample query:

?- num_correct([1,2,3], [3,5], Num).
Num = 1.

As is characteristic for pure relations, this also works for much more general queries, for example:

?- num_correct([A], [B], Num).
B#=A#<==>Num,
Num in 0..1.

Second, I use num_well_placed/3, which relates two lists of integers to the number of indices where corresponding elements are equal:

num_well_placed(Vs, Ns, Num) :-
        maplist(num_well_placed_, Vs, Ns, Bs),
        sum(Bs, #=, Num).

num_well_placed_(V, N, B) :- (V #= N) #<==> B.

Again, a sample query and answer:

?- num_well_placed([8,3,4], [0,3,4], Num).
Num = 2.

The following predicate simply combines these two:

num_correct_placed(Vs, Hs, C, P) :-
        num_correct(Vs, Hs, C),
        num_well_placed(Vs, Hs, P).

Thus, the whole puzzle can be formulated as follows:

lock(Vs) :-
        Vs = [_,_,_],
        Vs ins 0..9,
        num_correct_placed(Vs, [6,8,2], 1, 1),
        num_correct_placed(Vs, [6,1,4], 1, 0),
        num_correct_placed(Vs, [2,0,6], 2, 0),
        num_correct_placed(Vs, [7,3,8], 0, 0),
        num_correct_placed(Vs, [7,8,0], 1, 0).

No search at all is required in this case:

?- lock(Vs).
Vs = [0, 4, 2].

Moreover, if I generalize away the last hint, i.e., if I write:

lock(Vs) :-
        Vs = [_,_,_],
        Vs ins 0..9,
        num_correct_placed(Vs, [6,8,2], 1, 1),
        num_correct_placed(Vs, [6,1,4], 1, 0),
        num_correct_placed(Vs, [2,0,6], 2, 0),
        num_correct_placed(Vs, [7,3,8], 0, 0),
        * num_correct_placed(Vs, [7,8,0], 1, 0).

then the unique solution can still be determined without search:

?- lock(Vs).
Vs = [0, 4, 2].

In fact, I can even also take away the penultimate hint:

lock(Vs) :-
        Vs = [_,_,_],
        Vs ins 0..9,
        num_correct_placed(Vs, [6,8,2], 1, 1),
        num_correct_placed(Vs, [6,1,4], 1, 0),
        num_correct_placed(Vs, [2,0,6], 2, 0),
        * num_correct_placed(Vs, [7,3,8], 0, 0),
        * num_correct_placed(Vs, [7,8,0], 1, 0).

and still the solution is unique, although I now have to use label/1 to find it:

?- lock(Vs), label(Vs).
Vs = [0, 4, 2] ;
false.
mat
  • 40,498
  • 3
  • 51
  • 78
  • Is this a **maximal** generalization? – false Feb 21 '17 at 21:25
  • 1
    Thanks, looks like a great solution, but I couldn't make it work. I finally did the library clp(fd) be loaded but when I try to execute `num_correct_` it says that the arity for some predicates are wrong. I saw that `num_correct_` is `/4` but on the `num_correct` you 'call it' using only `Vs`. @edit: Seems I make some mistakes (maybe some typois) and also I forgot how the foldl works, but I remembered now and my comment is quite stupid. Sorry about that, flagged as correct answer since it's very didatic, works fine and introduced new knowledge about prolog. – William Okano Feb 22 '17 at 03:10
2

I hope there are better ways but...

You can implement "one number is correct and well placed" as follows

oneRightPlace(X, Y, Z, X, S2, S3) :-
  \+ member(Y, [S2, S3]),
  \+ member(Z, [S2, S3]).

oneRightPlace(X, Y, Z, S1, Y, S3) :-
  \+ member(X, [S1, S3]),
  \+ member(Z, [S1, S3]).

oneRightPlace(X, Y, Z, S1, S2, Z) :-
  \+ member(X, [S1, S2]),
  \+ member(Y, [S1, S2]).

For "one number is correct but wrong placed, you can use

oneWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(X, [S2, S3]),
  \+ member(Y, [S1, S2, S3]),
  \+ member(Z, [S1, S2, S3]).

oneWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(Y, [S1, S3]),
  \+ member(X, [S1, S2, S3]),
  \+ member(Z, [S1, S2, S3]).

oneWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(Z, [S1, S2]),
  \+ member(X, [S1, S2, S3]),
  \+ member(Y, [S1, S2, S3]).

For "two number are correct but wrong placed", you can write

twoWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(X, [S2, S3]),
  member(Y, [S1, S3]),
  \+ member(Z, [S1, S2, S3]).

twoWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(X, [S2, S3]),
  member(Z, [S1, S2]),
  \+ member(Y, [S1, S2, S3]).

twoWrongPlace(X, Y, Z, S1, S2, S3) :-
  member(Y, [S1, S3]),
  member(Z, [S1, S2]),
  \+ member(X, [S1, S2, S3]).

And, for "nothing is correct", become simply

zeroPlace(X, Y, Z, S1, S2, S3) :-
  \+ member(X, [S1, S2, S3]),
  \+ member(Y, [S1, S2, S3]),
  \+ member(Z, [S1, S2, S3]).

Now you can put all togheter and write

  member(S1, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]),
  member(S2, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]),
  member(S3, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]),
  oneRightPlace(6, 8, 2, S1, S2, S3),
  oneWrongPlace(6, 1, 4, S1, S2, S3),
  twoWrongPlace(2, 0, 6, S1, S2, S3),
  zeroPlace(7, 3, 8, S1, S2, S3),
  oneWrongPlace(7, 8, 0, S1, S2, S3).

obtaining (in S1, S2 and S3) the right solution.

The preceding examples are written without the use of clp(fd), that I don't know well but that (I suppose) can semplify a lot.

max66
  • 65,235
  • 10
  • 71
  • 111
2

So, as with all problems in this vein, I tend to be tempted to write a generic solver as opposed to a specific solver. Borrowing from a mastermind implementation I wrote a while ago (spawned by a question on here) I present the following:

compare(List,Reference,RightPlace,WrongPlace) takes two lists, and unifies RightPlace with the number of elements of the first list that appear at the same point in the second list, and WrongPlace with the number of elements that appear at a different point in the second list (where a duplicate element is only counted if it is duplicated in both lists). It does this using...

right_place(List,Reference,RightPlace) which wraps an accumulator and consumes elements from the head of each list, incrementing where they match, and...

any_match(List,Reference,Matches) which wraps an accumulator that consumes the head of the List list, and selects it from the Reference list where possible, incrementing where this occurs.

WrongPlace is then the number of RightPlace elements subtracted from the number of Matches.

Finally, find_solutions(Soln) creates a list of elements in the domain (0-9) using clpfd, then maps indomain to create the combinations. Each combination is then compared with each hint using forall, to ensure that all hint constraints are satisfied. Put it all together with the hints, and you get:

:- use_module(library(clpfd)).

compare(List,Reference,RightPlace,WrongPlace) :-
    right_place(List,Reference,RightPlace),
    any_match(List,Reference,Matches),
    WrongPlace #= Matches - RightPlace.

right_place(List,Reference,RightPlace) :-
    right_place(List,Reference,0,RightPlace).

right_place([],[],RightPlace,RightPlace).
right_place([Match|List],[Match|Reference],Accumulator,RightPlace) :-
    NewAccumulator is Accumulator + 1,
    right_place(List,Reference,NewAccumulator,RightPlace).
right_place([A|List],[B|Reference],Accumulator,RightPlace) :-
    A \= B,
    right_place(List,Reference,Accumulator,RightPlace).

any_match(List,Reference,Matches) :-
    any_match(List,Reference,0,Matches).

any_match([],_,Matches,Matches).
any_match([Match|List],Reference,Accumulator,Matches) :-
    select(Match,Reference,NewReference),
    NewAccumulator is Accumulator + 1,
    any_match(List,NewReference,NewAccumulator,Matches).
any_match([Match|List],Reference,Accumulator,Matches) :-
    \+member(Match,Reference),
    any_match(List,Reference,Accumulator,Matches).

find_solutions(Soln) :-
    length(Soln,3),
    Soln ins 0..9,
    maplist(indomain,Soln),
    forall(hint(X,Y,Z),compare(Soln,X,Y,Z)).

hint([6,8,2],1,0).
hint([6,1,4],0,1).
hint([2,0,6],0,2).
hint([7,3,8],0,0).
hint([7,8,0],0,1).
Jim Ashworth
  • 765
  • 6
  • 17
1

Not sure I need to explain this much. You generate all possibilities, and then you code the constraints.

code(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]),
  ( A = 6 ; B = 8 ; C = 2 ),
  ( A = 1, \+ member(B,[6,4]), \+ member(C,[6,4])
  ; A = 4, \+ member(B,[6,1]), \+ member(C,[6,1])
  ; B = 6, \+ member(A,[1,4]), \+ member(C,[1,4])
  ; B = 4, \+ member(A,[6,1]), \+ member(C,[6,1])
  ; C = 6, \+ member(B,[1,4]), \+ member(A,[1,4])
  ; C = 1, \+ member(B,[6,4]), \+ member(A,[6,4]) ),
  ( A = 0, B = 2, C \= 6
  ; A = 0, B = 6, C \= 2
  ; A = 6, B = 2, C \= 0
  ; B = 2, C = 0, A \= 6
  ; B = 6, C = 2, A \= 0
  ; B = 6, C = 0, A \= 2
  ; C = 2, A = 0, B \= 6
  ; C = 2, A = 6, B \= 0
  ; C = 0, A = 6, B \= 2 ),
  \+ member(A,[7,3,8]), \+ member(B,[7,3,8]), \+ member(C,[7,3,8]),
  ( A = 8, \+ member(B,[7,0]), \+ member(C,[7,0])
  ; A = 0, \+ member(B,[7,8]), \+ member(C,[7,8])
  ; B = 7, \+ member(A,[8,0]), \+ member(C,[8,0])
  ; B = 0, \+ member(A,[7,8]), \+ member(C,[7,8])
  ; C = 7, \+ member(B,[8,0]), \+ member(A,[8,0])
  ; C = 8, \+ member(B,[7,0]), \+ member(A,[7,0]) ).

Here is the result:

| ?- code(A,B,C).
A = 0,
B = 4,
C = 2 ? ;
no
Tomas By
  • 1,396
  • 1
  • 11
  • 23
0

As a generic solver, without using clpfd:

digits_length(3).

% Digits present, digits in right place
digit_clue([6,8,2], 1, 1).
digit_clue([6,1,4], 1, 0).
digit_clue([2,0,6], 2, 0).
% The last 2 clues are not needed
%digit_clue([7,3,8], 0, 0).
%digit_clue([7,8,0], 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)).
% 3,848 inferences, 0.001 CPU in 0.001 seconds (97% CPU, 6941839 Lips)
Ss = [[0,4,2]].
brebs
  • 3,462
  • 2
  • 3
  • 12
0

Another method, more succinct than my previous:

padlock(S) :-
    length(S, 3),
    present([6,8,2], S, 1, 0),
    present([6,1,4], S, 0, 1),
    present([2,0,6], S, 0, 2),
    present([7,3,8], S, 0, 0),
    present([7,8,0], 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,519 inferences, 0.001 CPU in 0.001 seconds (100% CPU, 11695261 Lips)
Ls = [[0, 4, 2]].
brebs
  • 3,462
  • 2
  • 3
  • 12