CODEWITHSUNDEEP
prologcryptarithmetic-puzzle
Xiaoyong Guo
Xiaoyong Guo

Reputation: 393

How to write a Prolog solver to solve this logic problem?

I have spent some time learning Prolog, and have some basic understanding of Prolog concepts like facts, rules, lists. But still find it hard to use Prolog as a tool to solve logic problems. For example, the following one:

Guess the number with following facts:
2741: A digit is right, but it's in the wrong place.
4132: Two digits are right, but it's in the wrong place.
7642: None of the digits are right.
9826: One digit is correct and in the right place.
5079: Two digits are right, one is in the right place and 
      the other is in the wrong place.

I manually solved this problem, the answer is 9013. How can I write a Prolog problem to solve this problem? Right now I prefer not using any modules, for learning purposes.

Upvotes: 1

Views: 202

Answers (2)

brebs
brebs

Reputation: 4428

Here's my solution:

% Digits in right place, Digits in wrong place
digit_clue([2, 7, 4, 1], 0, 1).  % Clue is not needed, to decide 9013
digit_clue([4, 1, 3, 2], 0, 2).
digit_clue([7, 6, 4, 2], 0, 0).
digit_clue([9, 8, 2, 6], 1, 0).
digit_clue([5, 0, 7, 9], 1, 1).


go(Solution) :-
    foreach(digit_clue(LstDigits, IntRight, IntWrong),
        add_clue(LstDigits, IntRight, IntWrong, Solution)),
    % Solution is 4 digits (without duplicates) in range 0-9
    element_list_selection([0, 1, 2, 3, 4, 5, 6, 7, 8, 9], 4, Solution).


add_clue(LstDigits, IntRight, IntWrong, Solution) :-
    count_right_place(LstDigits, IntRight, Solution),
    count_wrong_place(LstDigits, IntWrong, Solution, Solution),
    IntNotPresent is 4 - (IntRight + IntWrong),
    count_not_present(LstDigits, IntNotPresent, Solution, Solution).


% Digit Head, Solution Tail, etc.
count_right_place([], 0, []).
count_right_place([DH|DT], IntRight, [SH|ST]) :-
    succ(IntRight0, IntRight),
    % This is the digit in the Solution
    DH = SH,
    count_right_place(DT, IntRight0, ST).

count_right_place([DH|DT], IntRight, [SH|ST]) :-
    % This is not the digit in the Solution
    dif(DH, SH),
    count_right_place(DT, IntRight, ST).


count_wrong_place([], 0, _Solution, []).
count_wrong_place([DH|DT], IntWrong, Solution, [SH|ST]) :-
    succ(IntWrong0, IntWrong),
    % Digit is in Solution
    member(DH, Solution),
    % ... but not in this position
    dif(DH, SH),
    count_wrong_place(DT, IntWrong0, Solution, ST).

count_wrong_place([_DH|DT], IntWrong, Solution, [_SH|ST]) :-
    % No info to add
    count_wrong_place(DT, IntWrong, Solution, ST).


count_not_present([], 0, _Solution, []).
count_not_present([DH|DT], IntNotPresent, Solution, [_SH|ST]) :-
    succ(IntNotPresent0, IntNotPresent),
    % Digit is not present in Solution
    maplist(dif(DH), Solution),
    count_not_present(DT, IntNotPresent0, Solution, ST).

count_not_present([_DH|DT], IntNotPresent, Solution, [_SH|ST]) :-
    % No info to add
    count_not_present(DT, IntNotPresent, Solution, ST).


% Select IntElements from LstFull (random order, no duplicates)
element_list_selection(LstFull, IntElements, LstSelection) :-
    length(LstSelection, IntElements),
    element_list_selection_(LstSelection, LstFull).

element_list_selection_([], _LstFull).
element_list_selection_([H|T], Lst) :-
    select(H, Lst, Lst0),
    element_list_selection_(T, Lst0).

Result in swi-prolog:

?- time(findall(Sol, go(Sol), Sols)).
% 53,013 inferences, 0.008 CPU in 0.008 seconds (101% CPU, 6442489 Lips)
Sols = [[9,0,1,3]].

Interestingly, the 2741 hint is not needed.

Upvotes: 1

Will Ness
Will Ness

Reputation: 71074

Generalizing my code from the previous entry about this type of puzzle, we get

check( Sol, Guess, NValues-NPlaces ) :-
    findall( t, (member(E, Guess), member(E, Sol)), Values ),
    length( Values, NValues ), 
    maplist( eq, Sol, Guess, NS),
    sum_list( NS, NPlaces).

eq(A,B,X) :- A =:= B -> X=1 ; X=0.

select([X|XS],Dom) :- select(X,Dom,Dom2), select(XS,Dom2).
select([],_).

puzzle( [A,B,C,D] ) :-   
    Dom = [0, 1, 3, 5, 8, 9],          % using hint 3 
    select( [A,B,C,D], Dom),           % with unique digits
    maplist( check([A,B,C,D]), 
             [[2,7,4,1], [4,1,3,2], [9,8,2,6], [5,0,7,9]],
             [ 1-0,      2-0,       1-1,       2-1      ] ).

Trying it out:

164 ?- time( puzzle(X) ).
% 33,274 inferences, 0.016 CPU in 0.011 seconds (142% CPU, 2132935 Lips)
X = [9, 0, 1, 3] ;
% 5,554 inferences, 0.016 CPU in 0.002 seconds (780% CPU, 356023 Lips)
false.

Or we can inline the definitions, fusing them together as

mmd(Sol):-
  %%maplist( dif, [2,7,4,1], Sol),         % 1.
  maplist( dif, [4,1,3,2], Sol),           % 2.
  maplist( eq1, Sol, [9,8,2,6], NS4),
                      sum_list( NS4, 1),   % 4.
  maplist( eq1, Sol, [5,0,7,9], NS5),
                      sum_list( NS5, 1),   % 5.
  select( Sol, [0,1,3,5,8,9]),             % 3.

  %%findall( t, (member(E, [2,7,4,1]), member(E, Sol)), [_] ), % 1.
  findall( t, (member(E, [4,1,3,2]), member(E, Sol)), [_,_] ), % 2.
  %%findall( t, (member(E, [9,8,2,6]), member(E, Sol)), [_] ), % 4.
  findall( t, (member(E, [5,0,7,9]), member(E, Sol)), [_,_] ). % 5.

eq1(A,B,C) :- (A#=B,C=1 ; dif(A,B),C=0).

rearranging the sub-goals to constrain the search space as much as possible, so the solution is found almost instantly and the inferences overall are cut more than in half:

167 ?- time( mmd(S) ).
% 1,219 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
S = [9, 0, 1, 3] ;
% 13,714 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
false.

As was first noticed in the other answer, not all clues are actually needed, and removing them even reduces the number of inferences needed to solve this by some additional small margin.

Upvotes: 1

Related Questions