1

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).
Will Ness
  • 70,110
  • 9
  • 98
  • 181
LearnDude
  • 83
  • 8
  • Is https://stackoverflow.com/a/72419801/17628336 (the 2nd method in that answer) not elegant enough? – brebs Jun 15 '22 at 05:33

3 Answers3

2

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.

Will Ness
  • 70,110
  • 9
  • 98
  • 181
1

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))).
Will Ness
  • 70,110
  • 9
  • 98
  • 181
Peter Ludemann
  • 985
  • 6
  • 8
  • I believe this is no what OP is looking for. It may be used in the procedure he is looking for. – gusbro Jun 14 '22 at 21:47
  • @Peter Thanks for your answer. I'm looking for all_distinct but for atoms. It seems all_distinct only works for integers. – LearnDude Jun 15 '22 at 00:19
  • @gusbro Thanks. I did resort to brute force and made all_unique/5 that just checks all inequalities. And I also realized that I must ask about all adventures together. But it is still not working -- see update above. – LearnDude Jun 15 '22 at 05:14
  • @gusbro Also realizing that a more efficient way of generating valid combinations is needed. Just specifying five variables that can take five values each and then discarding ones with duplicates will throw away 1 - 5!/5^5 = 96% of tries. – LearnDude Jun 15 '22 at 05:48
  • Please answer the question in your answer - only link to support the content you've already written. – Enigmativity Jun 15 '22 at 06:24
  • 2
    @BjornEriksson "*five variables that can take five values each and then discarding ones with duplicates will throw away 96% of tries*" - this is where you get to your original "*they seem to be aimed at fast execution*" :-) The constraint solver is what joins the dots "if the professor is in west_africa, nobody else can be" and then won't generate the remaining solutions with other people in west_africa, saving the work of testing and throwing them away, dramatically reducing the search space, and speeding up finding of solutions. – TessellatingHeckler Jun 15 '22 at 19:00
  • 1
    Thanks @TessellatingHeckler. I'm not against that kind of programming at all; I just wanted to try fully declarative programming as part of my first week of learning this new language. Next up is exploring those functions you mention. :-) – LearnDude Jun 20 '22 at 18:55
  • There's some further discussion on "freeze" and combinatoric test&generate here: https://www.reddit.com/r/prolog/comments/yexwjm/how_to_handle_this_combinatorial_explosion/ – Peter Ludemann Oct 29 '22 at 19:17
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.

  1. 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).
LearnDude
  • 83
  • 8
  • That `all_different_atoms/1` is inefficient - it will check that element X isn't element Y, then *also* check that element Y isn't element X. – brebs Oct 08 '22 at 11:22