Prolog - animal puzzle, need to force each atom to be used only once

Question

I've seen a few posts on SO discussing this puzzle, but they seem to be aimed at fast execution and I don't really understand what's going on. I'm trying to keep it very simple and want to write something that is declarative and human readable.

I've come most of the way, but I need help adding a condition that says that each atom can only be used in adventure each.

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.

Here is what I've done:

hunter(professor).
hunter(doctor).
hunter(colonel).
hunter(fire_chief).
hunter(captain).
animal(rhino).
animal(bison).
animal(puma).
animal(hippo).
animal(elephant).
tool(stick).
tool(empty_gun).
tool(garment).
tool(hands).
tool(stone).
location(north_africa).
location(central_africa).
location(south_africa).
location(west_africa).
location(east_africa).

adventure([H, A, T, L]) :-
    hunter(H),
    animal(A),
    tool(T),
    location(L),
    not( invalid([H, A, T, L]) ),
    iff( H = professor, T = stone),
    iff( H = colonel, A = rhino),
    iff( H = fire_chief, L = south_africa),
    iff( A = bison, L = north_africa),
    iff( T = hands, L = central_africa),
    iff( H = captain, A = puma),
    iff( H = captain, T = empty_gun).

invalid_list([
    [doctor, _, _, east_africa],
    [doctor, hippo, _, _],
    [colonel, _, _, central_africa],
    [_, rhino, _, central_africa],
    [_, _, empty_gun, west_africa],
    [_, _, garment, west_africa],
    [_, elephant, stick, _]
]).
invalid(A) :- invalid_list(LL), member(A, LL).

iff(A, B) :- A , B ; not(A) , not(B).

That gives me the following output. I can of course manually take this to the solution, but I want to implement the last step where each atom can only be used once.

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

Update:

1. I created all_unique/5 that does all crosswise inequality comparisons.
2. I realized I need to ask about all adventures at the same time.

The updated program gets stuck in a recursive loop. I'm not sure why.

all_adventures([
    [H1, A1, T1, L1],
    [H2, A2, T2, L2],
    [H3, A3, T3, L3],
    [H4, A4, T4, L4],
    [H5, A5, T5, L5]
    ]) :-
    H1  = professor,
    H2  = doctor,
    H3  = colonel,
    H4  = fire_chief,
    H5  = captain,
    animal(A1),
    animal(A2),
    animal(A3),
    animal(A4),
    animal(A5),
    tool(T1),
    tool(T2),
    tool(T3),
    tool(T4),
    tool(T5),
    location(L1),
    location(L2),
    location(L3),
    location(L4),
    location(L5),  
    all_unique(A1, A2, A3, A4, A5),
    all_unique(T1, T2, T3, T4, T5),
    all_unique(L1, L2, L3, L4, L5),
    adventure([H1, A1, T1, L1]),
    adventure([H2, A2, T2, L2]),
    adventure([H3, A3, T3, L3]),
    adventure([H4, A4, T4, L4]),
    adventure([H5, A5, T5, L5]).

1 ?- all_adventures(X).

Answer 1

Figured this one out in a way that I'm happy with, with the help of @gusbro. This code feels non-contrived and easy to read, just like I wanted.

Synopsis:

1. An adventure is a 4-tuple that satisfies the conditions in the clues.

1a). Excluding conditions are easily pattern-matched in a list with wildcards (_).

1b) Requirement conditions need to be expressed as iff clauses.

2. We need to ask about which variables satisfy all five adventures at the same time, while requiring that no atom is re-used.

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

hunter(professor).
hunter(doctor).
hunter(colonel).
hunter(fire_chief).
hunter(captain).
animal(rhino).
animal(bison).
animal(puma).
animal(hippo).
animal(elephant).
tool(stick).
tool(empty_gun).
tool(garment).
tool(hands).
tool(stone).
location(north_africa).
location(central_africa).
location(south_africa).
location(west_africa).
location(east_africa).

adventure([H, A, T, L]) :-
    hunter(H),
    animal(A),
    tool(T),
    location(L),
    not( invalid([H, A, T, L]) ),
    iff( H = professor, T = stone),
    iff( H = colonel, A = rhino),
    iff( H = fire_chief, L = south_africa),
    iff( A = bison, L = north_africa),
    iff( T = hands, L = central_africa),
    iff( H = captain, A = puma),
    iff( H = captain, T = empty_gun).


all_adventures([
    [A1, T1, L1],
    [A2, T2, L2],
    [A3, T3, L3],
    [A4, T4, L4],
    [A5, T5, L5]
    ]) :-
    adventure([professor, A1, T1, L1]),
    adventure([doctor, A2, T2, L2]),
    adventure([colonel, A3, T3, L3]),
    adventure([fire_chief, A4, T4, L4]),
    adventure([captain, A5, T5, L5]),
    
    all_different_atoms([A1, A2, A3, A4, A5]),
    all_different_atoms([T1, T2, T3, T4, T5]),
    all_different_atoms([L1, L2, L3, L4, L5]).


invalid_list([
    [doctor, _, _, east_africa],
    [doctor, hippo, _, _],
    [colonel, _, _, central_africa],
    [_, rhino, _, central_africa],
    [_, _, empty_gun, west_africa],
    [_, _, garment, west_africa],
    [_, elephant, stick, _]
]).
invalid(A) :- invalid_list(LL), member(A, LL).

iff(A, B) :- A , B ; not(A) , not(B).

all_different_atoms(X):- \+((select(M,X,Y), member(M,Y))).

1 ?- all_adventures(X).

Answer 2

https://www.swi-prolog.org/pldoc/man?predicate=all_distinct/1

(all_distinct/1 is part of the finite domain constraint solving module)

EDIT: as pointed out, this only works with integers. You could, of course, map all the atoms to integers, but that's a bit painful.

Here's a predicate that's not terribly fast but will verify that all the items in a list are different and works with any Prolog term (numbers, atoms, strings, etc.):

all_unique(List) :- all_unique(List, []).

all_unique([], _).
all_unique([X|Xs], Seen) :-
    \+ member(X, Seen),
    all_unique(Xs, [X|Seen]).

But, as pointed out, it must only be used with a fully ground argument List, which leads to a brute-force solution, with many unnecessary tests.

Instead, you can make a version of all_unique/1 that delays until things are sufficiently instantiated. To do this, change the line \+ member(X, Seen) to freeze(X, \+ member(X, Seen)). You can see it working with this query:

?- List=[A,B,C], forall((all_unique(List), between(1,3,A), between(1,3,B), between(1,3,C), writeln(List))).

and also:

?- List=[A,B,C], all_unique(List), forall((between(1,3,A), between(1,3,B), between(1,3,C), writeln(List))).

Answer 3

What I'd consider a standard way to do this kind of puzzles is to make unique selections from a shrinking domain.

Each choice made removes the chosen element from the given domain, so it's not among the choices to be made next anymore.

This way the choices are guaranteed to be unique by construction. This is done by select/2 predicate below.

The second mechanism is using member to progressively instantiate parts of the shared table representing the solution Sol:

hunters(   [professor, doctor, colonel, fire_chief, captain] ).
animals(   [rhino,      bison,    puma,   hippo,   elephant] ).
tools(     [stick,        gun, garment,   hands,    stone  ] ).
locations( [north,    central,   south,   west,     east   ] ).

select( [A|B], C) :- select( A,C,D), select( B,D).
select( [], _).

p(A,B,C,D,[A,B,C,D]).

sol(Sol) :- 
  hunters(Hs),    animals(As), 
                          tools(Ts),
                                 locations(Ls),
  maplist( p, Hs,      A,     T,     L,        Sol),

  member( [professor,  _   , stone,  _     ] , Sol),
  member( [colonel,   rhino,  _   ,  _     ] , Sol),
  member( [_,          _   , hands, central] , Sol),
  member( [_,         bison,   _  , north  ] , Sol),
  member( [fire_chief, _   ,   _  , south  ] , Sol),
  member( [captain,   puma ,  gun ,  _     ] , Sol),
  member( [_,          _   ,   TW , west   ] , Sol),

  select( T, Ts),  TW \= gun, TW \= garment,
  select( A, As),
  select( L, Ls),

  \+ member( [doctor,  _,    _,    east] , Sol),
  \+ member( [doctor, hippo, _,    _   ] , Sol),
  \+ member( [colonel, _,    _, central] , Sol),
  \+ member( [_, elephant,  stick,    _] , Sol).

First, the positive rules are stated with some member statements.

Then the instantiations are completed with select calls. Both member and select progressively incrementally instantiate the common, shared store of knowledge, the solution Sol. Incompatible instantiations are rejected, the control backtracks, and different choices are consequently made.

The negative rules are stated after the relevant instantiations are made, as soon as possible -- but not sooner. This produces

26 ?- time(sol(_X)), maplist(writeln,_X).
% 190 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)

[professor,  bison,    stone,   north  ]
[doctor,     elephant, hands,   central]
[colonel,    rhino,    stick,   west   ]
[fire_chief, hippo,    garment, south  ]
[captain,    puma,     gun,     east   ]

true ;

% 1,029 inferences, 0.000 CPU in 0.000 seconds (?% CPU, Infinite Lips)

false.

Your way makes 600x (that's six hundred times more) inferences to get to the same result, and 700x more to complete the search:

30 ?- time( all_adventures(_X)), maplist(writeln,_X).
% 122,782 inferences, 0.031 CPU in 0.030 seconds (104% CPU, 3935295 Lips)

[bison,   stone,    north_africa  ]
[elephant,hands,    central_africa]
[rhino,   stick,    west_africa   ]
[hippo,   garment,  south_africa  ]
[puma,    empty_gun,east_africa   ]

true ;

% 719,071 inferences, 0.078 CPU in 0.080 seconds (97% CPU, 9218800 Lips)

false.

it's also considerably longer, so might be harder to comprehend.

---

Even more "tight" formulation can be made using select/2 with mutually exclusive positive rules, instead of the individual member calls. This use of select/2 makes it kind of "multi-member":

sol(Sol) :- 
  hunters(Hs),    animals(As), 
                          tools(Ts),
                                 locations(Ls),
  maplist( p, Hs,      A,     T,     L,        Sol),

  select( [ [professor,  _   , stone,  _     ] 
          , [colonel,   rhino,  _   ,  _     ] 
          , [fire_chief, _   ,   _  , south  ]
          , [captain,   puma ,  gun ,  _     ] ], Sol),
  select( [ [_,          _   , hands, central] 
          , [_,         bison,   _  , north  ] 
          , [_,          _   ,   TW , west   ] ], Sol),

  select( T, Ts),  TW \= gun, TW \= garment,
  select( A, As),
  select( L, Ls),

  \+ member( [doctor,  _,    _,    east] , Sol),
  \+ member( [doctor, hippo, _,    _   ] , Sol),
  \+ member( [colonel, _,    _, central] , Sol),
  \+ member( [_, elephant,  stick,    _] , Sol).

The improvement in efficiency is very small though, now taking 183 inferences to find the solution, and 916 to finish up the search.