How to solve and how to use negation in this Prolog puzzle?

user_12345629 0
Viewed 110

I want to solve this logic puzzle with Prolog without using any built-in functions or libraries. The problem is I don't know how to formulate the negative terms in the code. The negative terms are in the second, the third, and the seventh part.

For example, if I want to negate East Africa in the second sentence like this: adventure(B, T), hunter(B, doctor), not(place(B, east_africa)), the solver won't know there is this option between the places.

The logic puzzle:

Five men sit at the table in the hunting club and talk about their latest incredible experiences. They all struggled one animal at a time, in strange circumstances. Based on the information provided, determine where these adventures took place, what kind of animals they were, and by what tools they struggled.

  1. The professor tossed the animal with a suddenly grabbed large stone.
  2. The doctor did not hunt in East Africa and was not attacked by a hippopotamus.
  3. The colonel’s rhino adventure was not in Central Africa, where one of the hunters chased away an animal with his bare hands.
  4. The bison attacked one of the hunters in North Africa.
  5. The fire chief hunted in South Africa.
  6. The puma was hit in the head by the captain with an empty gun.
  7. The hunter in West Africa did not have any guns, and he was not the one who fight his attacker with a garment.
  8. The elephant was not chased away with a stick.

The code I wrote:

solve(T) :-
    adventure(A, T), hunter(A, professor), tool(A, stone),
    adventure(B, T), hunter(B, doctor),
    adventure(C, T), hunter(C, colonel), animal(C, rhino),
    adventure(D, T), place(D, central_africa), tool(D, bare_hands),
    adventure(E, T), place(E, north_africa), animal(E, bison),
    adventure(F, T), hunter(F, fire_chief), place(F, south_africa),
    adventure(G, T), hunter(G, captain), animal(G, puma), tool(G, empty_gun),
    adventure(H, T), place(H, west_africa),
    adventure(I, T), animal(I, elephant).

adventure(X, adventures(X,_,_,_,_)).
adventure(X, adventures(_,X,_,_,_)).
adventure(X, adventures(_,_,X,_,_)).
adventure(X, adventures(_,_,_,X,_)).
adventure(X, adventures(_,_,_,_,X)).

hunter(a(X,_,_,_),X).
place(a(_,X,_,_),X).
animal(a(_,_,X,_),X).
tool(a(_,_,_,X),X).
zebra-puzzle prolog
2 Answers

This is an approach to solve the puzzle without Prolog built-ins and using negation by getting all of the information provided into the same form "negative" form. It may not be the most optimal solution but I think it can demonstrate thinking about the facts in a different way.

First let's encode the data and what an "adventure" is:

hunter(professor).
hunter(doctor).
hunter(colonel).
hunter(fire_chief).
hunter(captain).

tool(stone).
tool(hands).
tool(garment).
tool(gun).
tool(stick).

place(east_africa).
place(central_africa).
place(north_africa).
place(south_africa).
place(west_africa).

animal(rhino).
animal(hippo).
animal(bison).
animal(puma).
animal(elephant).

adventure([H, T, P, A]) :- hunter(H), tool(T), place(P), animal(A).

This provides a nice starting point for thinking about the problem, an "adventure" needs one of each of the four different items, and I chose to wrap that in a list for some comparison conditions later.

Using the rule above, we can trivially generate solutions with adventure(A). To make the solution conform to the puzzle, let's add a rule invalid/1 that takes an adventure-list so that we can query adventure(A), \+ invalid(A) and know that "A is an adventure that is not invalid"

% already invalid conditions from the puzzle
invalid([doctor, _, east_africa, _]).
invalid([doctor, _, _, hippo]).
invalid([colonel, _, central_africa, _]).
invalid([_, gun, west_africa, _]).
invalid([_, garment, west_africa, _]).
invalid([_, stick, _, elephant]).

% valid conditions from the puzzle negated
invalid([H, T, _, _]) :- 
    \+ ((H = professor, T = stone) ; (H \= professor, T \= stone)).
invalid([H, _, _, A]) :- 
    \+ ((H = colonel, A = rhino) ; (H \= colonel, A \= rhino)).
invalid([_, T, P, _]) :- 
    \+ ((T = hands, P = central_africa) ; (T \= hands, P \= central_africa)).
invalid([_, _, P, A]) :- 
    \+ ((P = north_africa, A = bison) ; (P \= north_africa, A \= bison)).
invalid([H, _, P, _]) :- 
    \+ ((H = fire_chief, P = south_africa) ; (H \= fire_chief, P \= south_africa)).
invalid([H, T, _, A]) :- 
    \+ ((H = captain, T = gun, A = puma) ; (H \= captain, T \= gun, A \= puma)).

This approach made it really easy to write what the "negative" conditions looked like, the generated adventure-list cannot match the invalid one ("The doctor was not in east africa", "the doctor did not encounter the hippo" etc.)

For the "positive" information in the puzzle, this requires logically negating it, leaving some messy looking conditions. Since all of the invalid predicates need to be proven false, the adventure-list needs to contain exactly what is in the puzzle or nothing at all ("the professor used the stone, or neither are mentioned", "the colonel met the rhino, or neither are mentioned") which is why the logical negation is xor-like ("the adventure is invalid if the professor used something other than the stone, or another hunter used the stone").

Using this it is possible to generate adventures that conform to the puzzle. Next let's generate a list of answers with the remaining uniqueness constraints:

solve(A) :- solve(A, []).
solve(A, A) :-
    A = [[professor|_], [doctor|_], [colonel|_], [fire_chief|_], [captain|_]].
solve(A, Adventures) :- 
    make_adventure(NewA, Adventures), 
    solve(A, [NewA|Adventures]).

make_adventure(A, Adventures) :-
    adventure(A), \+ invalid(A),
    unique_adventure(A, Adventures).

unique_adventure(_, []).
unique_adventure(U, [A|As]) :-
    unique_elements(U, A),
    unique_adventure(U, As).

unique_elements([], []).
unique_elements([U|Us], [A|As]) :- 
    U \= A, 
    unique_elements(Us, As).

solve is an accumulator that will require all adventure-list solutions are different by checking that elements in the same position are unique. This step is why I chose to wrap the adventure in a list.

The terminal condition of solve/2 is somewhat arbitrary, but chosen so that the result is a list of 5 adventures each starting with one of the hunters, otherwise solve will iterate though different solution orderings1.

make_adventure/2 will create a new adventure NewA, and compare it to the previously created Adventures list using unique_adventure/2. An adventure-list is different from another if elements at each position are different, this is checked with unique_elements/2.

Putting it all together solves the puzzle (formatted output for readability):

?- solve(A).
A = [
  [professor, stone, north_africa, bison], 
  [doctor, hands, central_africa, elephant], 
  [colonel, stick, west_africa, rhino], 
  [fire_chief, garment, south_africa, hippo], 
  [captain, gun, east_africa, puma]
] ;
false.

1 Using builtins, I'd be tempted to write a more generic terminal condition maybe enumerating the hunters like solve(A, A) :- findall(H, hunter(H), Hunters), maplist(nth0(0), A, Hunters).

user_5114850

Optimizing the performance, building on rayscan's answer:

invalid([doctor, _, east_africa, _]).
invalid([doctor, _, _, hippo]).
invalid([colonel, _, central_africa, _]).
invalid([_, gun, west_africa, _]).
invalid([_, garment, west_africa, _]).
invalid([_, stick, _, elephant]).

% valid conditions from the puzzle negated
invalid([H, T, _, _]) :-
    \+ ((H = professor, T = stone) ; (H \= professor, T \= stone)).
invalid([H, _, _, A]) :-
    \+ ((H = colonel, A = rhino) ; (H \= colonel, A \= rhino)).
invalid([_, T, P, _]) :-
    \+ ((T = hands, P = central_africa) ; (T \= hands, P \= central_africa)).
invalid([_, _, P, A]) :-
    \+ ((P = north_africa, A = bison) ; (P \= north_africa, A \= bison)).
invalid([H, _, P, _]) :-
    \+ ((H = fire_chief, P = south_africa) ; (H \= fire_chief, P \= south_africa)).
invalid([H, T, _, A]) :-
    \+ ((H = captain, T = gun, A = puma) ; (H \= captain, T \= gun, A \= puma)).


go(Sol) :-
    Hunters = [professor, doctor, colonel, fire_chief, captain],
    Tools = [stone, hands, garment, gun, stick],
    Places = [east_africa, central_africa, north_africa, south_africa, west_africa],
    Animals = [rhino, hippo, bison, puma, elephant],

    % Break symmetry by pre-specifying the hunters as the first element in the lists
    findall([H, _, _, _], member(H, Hunters), Sol),
    find_combs([Hunters, Tools, Places, Animals], Sol).

find_combs(CombLsts, [Comb|Sol]) :-
    maplist(select, Comb, CombLsts, Rem),
    \+ invalid(Comb),
    find_combs(Rem, Sol).
find_combs(CombLsts, _) :-
    maplist(=([]), CombLsts).

Result in swi-prolog:

?- time(findall(A, go(A), As)).
% 7,670 inferences, 0.005 CPU in 0.005 seconds (101% CPU, 1518784 Lips)
As = [[[professor,stone,north_africa,bison],[doctor,hands,central_africa,elephant],[colonel,stick,west_africa,rhino],[fire_chief,garment,south_africa,hippo],[captain,gun,east_africa,puma]]].

And a more elegant answer:

valid_comb([professor, stone, _, _]).
valid_comb([colonel, _, _, rhino]).
valid_comb([_, hands, central_africa, _]).
valid_comb([_, _, north_africa, bison]).
valid_comb([fire_chief, _, south_africa, _]).
valid_comb([captain, gun, _, puma]).

invalid_comb([doctor, _, east_africa, _]).
invalid_comb([doctor, _, _, hippo]).
invalid_comb([colonel, _, central_africa, _]).
invalid_comb([_, gun, west_africa, _]).
invalid_comb([_, garment, west_africa, _]).
invalid_comb([_, stick, _, elephant]).


go(Sol) :- 
    Hunters = [professor, doctor, colonel, fire_chief, captain],
    Tools = [stone, hands, garment, gun, stick],
    Places = [east_africa, central_africa, north_africa, south_africa, west_africa],
    Animals = [rhino, hippo, bison, puma, elephant],

    CombLsts = [Hunters, Tools, Places, Animals],

    % Break symmetry by pre-specifying the hunters as the first element in the lists
    findall([H, _, _, _], member(H, Hunters), Sol),

    % Do this only once
    findall(V, valid_comb(V), Vs),

    % Find a solution
    find_combs(CombLsts, Vs, Sol).


find_combs(CombLsts, Vs, [Comb|Sol]) :-
    % Select a combination, with remainder
    maplist(select, Comb, CombLsts, Rem),
    % Check validity each time, to fail quickly
    \+ invalid_comb(Comb),
    is_valid_comb(Comb, Vs),
    % Continue down this combination path
    find_combs(Rem, Vs, Sol).
find_combs(CombLsts, _, _) :-
    % Nothing left to try
    maplist(=([]), CombLsts).


is_valid_comb(C, Vs) :-
    % If any nonvar match, then all nonvar must match
    maplist(nonvar_match_all_if_any(C), Vs).

nonvar_match_all_if_any(L1, L2) :-
    % Unify both lists if they have any matching elements
    (nonvar_match_any(L1, L2) -> L1 = L2 ; true).

nonvar_match_any([H1|T1], [H2|T2]) :-
    % Is true if both elements are nonvar and equal
    (H1 == H2 -> true ; nonvar_match_any(T1, T2)).

Result:

?- time(findall(A, go(A), As)).
% 17,779 inferences, 0.005 CPU in 0.005 seconds (99% CPU, 3291722 Lips)
As = [[[professor,stone,north_africa,bison],[doctor,hands,central_africa,elephant],[colonel,stick,west_africa,rhino],[fire_chief,garment,south_africa,hippo],[captain,gun,east_africa,puma]]].
user_176283360
Related