Related
I recently started learning Prolog for fun. I found the following murder mystery puzzle. Since I don't know much about Prolog except the basics, I cannot really evaluate the solution provided in the link, however, it didn't seem particularly nice to me. My solution is not enough to generate the correct answers so I'm looking for some pointers as to how to get there or if it's at all possible to get there with my approach. Here's the puzzle just in case the link goes down:
To discover who killed Mr. Boddy, you need to learn where each person
was, and what weapon was in the room. Clues are scattered throughout
the quiz (you cannot solve question 1 until all 10 are read).
To begin, you need to know the suspects. There are three men (George,
John, Robert) and three women (Barbara, Christine, Yolanda). Each
person was in a different room (Bathroom, Dining Room, Kitchen, Living
Room, Pantry, Study). A suspected weapon was found in each room (Bag,
Firearm, Gas, Knife, Poison, Rope). Who was found in the kitchen?
Clue 1: The man in the kitchen was not found with the rope, knife, or
bag. Which weapon, then, which was not the firearm, was found in the
kitchen?
Clue 2: Barbara was either in the study or the bathroom; Yolanda was
in the other. Which room was Barbara found in?
Clue 3: The person with the bag, who was not Barbara nor George, was
not in the bathroom nor the dining room. Who had the bag in the room
with them?
Clue 4: The woman with the rope was found in the study. Who had the
rope?
Clue 5: The weapon in the living room was found with either John or
George. What weapon was in the living room?
Clue 6: The knife was not in the dining room. So where was the knife?
Clue 7: Yolanda was not with the weapon found in the study nor the
pantry. What weapon was found with Yolanda?
Clue 8: The firearm was in the room with George. In which room was the
firearm found?
It was discovered that Mr. Boddy was gassed in the pantry. The suspect
found in that room was the murderer. Who, then, do you point the
finger towards?
Here's the link to the author's solution.
Here's my attempted solution:
male(george).
male(john).
male(robert).
female(barbara).
female(christine).
female(yolanda).
person(X) :- male(X).
person(X) :- female(X).
room(kitchen).
room(bathroom).
room(diningroom).
room(livingroom).
room(pantry).
room(study).
weapon(bag).
weapon(firearm).
weapon(gas).
weapon(knife).
weapon(poison).
weapon(rope).
/*
Clue 1: The man in the kitchen was not found with
the rope, knife, or bag.
Which weapon, then, which was not the firearm,
was found in the kitchen?
*/
/* X is Weapon, Y is Room, Z is Person */
killer(X, Y, Z) :-
room(Y) = room(kitchen),
male(Z),
dif(weapon(X), weapon(rope)),
dif(weapon(X), weapon(knife)),
dif(weapon(X), weapon(bag)),
dif(weapon(X), weapon(firearm)).
/*
Clue 2: Barbara was either in the study or the bathroom;
Yolanda was in the other.
Which room was Barbara found in?
*/
/* It was easy to deduce the following from other data */
killer(X, Y, Z) :-
female(Z) = female(barbara),
room(study) = room(Y).
killer(X, Y, Z) :-
female(Z) = female(yolanda),
room(bathroom) = room(Y).
/*
Clue 3: The person with the bag, who was not Barbara nor
George, was not in the bathroom nor the dining room.
Who had the bag in the room with them?
*/
killer(X, Y, Z) :-
weapon(bag) = weapon(X),
dif(room(Y), room(bathroom)),
dif(room(Y), room(diningroom)),
dif(person(Z), male(george)),
dif(person(Z), female(barbara)).
/*
Clue 4: The woman with the rope was found in the study.
Who had the rope?
*/
killer(X, Y, Z) :-
weapon(rope) = weapon(X),
room(study) = room(Y),
female(Z).
/*
Clue 5: The weapon in the living room was found with either
John or George. What weapon was in the living room?
*/
killer(X, Y, Z) :-
room(Y) = room(livingroom),
dif(male(Z), male(robert)).
/*
Clue 6: The knife was not in the dining room.
So where was the knife?
*/
killer(X, Y, Z) :-
weapon(knife) = weapon(X),
room(Y) \= room(diningroom).
/*
Clue 7: Yolanda was not with the weapon found
in the study nor the pantry.
What weapon was found with Yolanda?
*/
killer(X, Y, Z) :-
female(yolanda) = female(Z),
dif(room(study), room(Y)),
dif(room(pantry), room(Y)).
/*
Clue 8: The firearm was in the room with George.
In which room was the firearm found?
*/
killer(X, Y, Z) :-
weapon(firearm) = weapon(X),
male(george) = male(Z).
/*
It was discovered that Mr. Boddy was gassed in the pantry.
The suspect found in that room was the murderer.
Who, then, do you point the finger towards?
*/
killer(X, Y, Z) :-
room(Y) = room(pantry),
weapon(X) = weapon(gas).
I took a more positive approach to this problem. Rather than trying any form of negation I went with just plain unification.
Key is this predicate pair:
members([],_).
members([M|Ms],Xs) :- select(M,Xs,Ys),members(Ms,Ys).
This is a basic permutation predicate. It will take a list of the first argument and try to unify against all permutations of second list.
Now a lot of the rules became quite easy to express:
For example, clue 1:
clue1(House) :- members([[P,kitchen,_],[_,_,rope],[_,_,knife],[_,_,bag],[_,_,firearm]],House),man(P).
So this meant that the rope, knife, bag and firearm were all members of the house, but in different rooms than the kitchen. Prolog would keep backtracking util it found a fit for these items.
Here's my full solution:
man(george).
man(john).
man(robert).
woman(barbara).
woman(christine).
woman(yolanda).
members([],_).
members([M|Ms],Xs) :- select(M,Xs,Ys),members(Ms,Ys).
clue1(House) :- members([[P,kitchen,_],[_,_,rope],[_,_,knife],[_,_,bag],[_,_,firearm]],House),man(P).
clue2(House) :- member([barbara,study,_],House), member([yolanda,bathroom,_],House).
clue2(House) :- member([barbara,bathroom,_],House), member([yolanda,study,_],House).
clue3(House) :- members([[_,_,bag],[barbara,_,_],[george,_,_]],House),members([[_,_,bag],[_,bathroom,_],[_,dining_room,_]],House).
clue4(House) :- members([[P,study,rope]],House),woman(P).
clue5(House) :- members([[john,living_room,_]],House).
clue5(House) :- members([[george,living_room,_]],House).
clue6(House) :- members([[_,_,knife],[_,dining_room,_]],House).
clue7(House) :- members([[yolanda,_,_],[_,study,_],[_,pantry,_]],House).
clue8(House) :- member([george,_,firearm],House).
clue9(House,P) :- members([[P,pantry,gas]],House).
solve(X) :-
House = [[_,bathroom,_],[_,dining_room,_],[_,kitchen,_],[_,living_room,_],[_,pantry,_],[_,study,_]],
clue1(House),
clue2(House),
clue3(House),
clue4(House),
clue5(House),
clue6(House),
clue7(House),
clue8(House),
clue9(House,X),
members([[george,_,_],[john,_,_],[robert,_,_],[barbara,_,_],[christine,_,_],[yolanda,_,_]],House),
members([[_,_,bag],[_,_,firearm],[_,_,gas],[_,_,knife],[_,_,poison],[_,_,rope]],House),
write(House),
true.
That gave me:
?- solve(X).
[[yolanda,bathroom,knife],[george,dining_room,firearm],[robert,kitchen,poison],[john,living_room,bag],[christine,pantry,gas],[barbara,study,rope]]
X = christine .
Edit: See an improved version of the reference solution at https://swish.swi-prolog.org/p/crime_constraints.pl.
I agree that the solution you linked to is ugly, but it does use the right approach. Yours isn't quite going in the right direction. Some remarks:
/* X is Weapon, Y is Room, Z is Person */
Why not use the variable names Weapon, Room, and Person then? It makes your program much easier to read.
weapon(rope) = weapon(X)
This is exactly equivalent to just writing X = rope or rope = X.
But apart from these there are other two big problems with the way you are approaching this puzzle:
First, you are not modeling relationships between your objects as data. For example, for "The woman with the rope was found in the study." you have this clause:
killer(X, Y, Z) :-
weapon(rope) = weapon(X),
room(study) = room(Y),
female(Z).
This does indeed have three solutions that you can interpret as "a relation killer(rope, study, barbara), killer(rope, study, christine), or killer(rope, study, yolanda)", but your program doesn't know how to interpret it that way. You don't actually construct data that expresses this relationship. This is what the solution you linked to does correctly: It models rooms and weapons as variables which can be bound to atoms representing persons. Thus it can express this clue as woman(Rope) ("the person with the Rope is a woman") and Rope = Study ("the rope and the study are associated with the same person").
The second big problem is that you are modeling all clues as different clauses of the same predicate. This is wrong because in Prolog the different clauses of a predicate express a choice: Something holds if the first clause holds or the second clause holds or the third clause holds, etc. But you want to express that the first clue holds and the second clue holds and the third clue holds, etc. And "and" is expressed by combining the different conditions with , in the body of one clause. This is why the linked solution has different predicates clue1, clue2, etc., all of which are called from the body of one big predicate.
Derive Rules from the clues in sequence
Each person was in a different room (Bathroom, Dining Room, Kitchen,
Living Room, Pantry, Study). A suspected weapon was found in each room
(Bag, Firearm, Gas, Knife, Poison, Rope).
unique(A,B,C,D,E,F) :-
A \= B, A \= C, A \= D, A \= E, A \= F,
B \= C, B \= D, B \= E, B \= F,
C \= D, C \= E, C \= F,
D \= E, D \= F,
E \= F.
suspicious(pwr(george,WA,RA), pwr(john,WB,RB), pwr(robert,WC,RC), pwr(barbara,WD,RD), pwr(christine,WE,RE), pwr(yolanda,WF,RF)) :-
weapon(WA), weapon(WB), weapon(WC), weapon(WD), weapon(WE), weapon(WF),
unique(WA,WB,WC,WD,WE,WF),
room(RA), room(RB), room(RC), room(RD), room(RE), room(RF),
unique(RA,RB,RC,RD,RE,RF).
Now let us examine
Clue 1: The man in the kitchen was not found with the rope, knife, or
bag. Which weapon, then, which was not the firearm, was found in the
kitchen?
clue1(L) :-
oneof(pwr(P,W,kitchen),L),
male(P),
weapon(W),
W \= rope, W \= knife, W \= bag, W \= firearm.
We do this for each of the 8 clues and finally
It was discovered that Mr. Boddy was gassed in the pantry. The suspect
found in that room was the murderer. Who, then, do you point the
finger towards?
killer(X, L) :- member(pwr(X,gas,pantry),L).
resolved(X) :-
suspicious(A,B,C,D,E,F),
L = [A,B,C,D,E,F],
clue1(L),
clue2(L),
clue3(L),
clue4(L),
clue5(L),
clue6(L),
clue7(L),
clue8(L),
killer(X, L).
The full program could be found and run. The inference is rather slow (but faster than the authors solution).
Why consider it a better design to use relations instead of Variable bindings?
I understand a prolog program as a ruleset to derive knowledge. That means:
Each relation in prolog should describe a relation in the domain
Adding entities (Weapons, Persons, Rooms) to the world should not make the ruleset obsolete. The problem has not changed (we only extended the world) so the rules and queries need not to be touched.
Extending the problem (e.g. by adding a seventh location) should have minimal impact
Not every aspect is optimal in the referenced solution, some may be better expressed if one is more familiar with prolog.
Why do I think that a ruleset should be robust to world changes?
I used datalog in program analysis. That means that each relation in source code (or byte code) was modeled as facts and the rules inferred types, security vulnerabilities, design patterns etc. There were multiple millions of facts and multiple thousands of ruleset code. Adding an entity (e.g. a source code line, a type annotation) should not drive me to reimplement the ruleset code (which was quite hard to write it correctly).
Why do I think that using implicit relations is bad code?
Consider this code from the reference solution, it is totally misleading:
clue1(Bathroom, Dining, Kitchen, Livingroom, Pantry, Study, Bag, Firearm, Gas, Knife, Poison, Rope) :-
man(Kitchen), // a man is a kitchen?
\+Kitchen=Rope, // a kitchen is not a rope?
\+Kitchen=Knife, // a kitchen is not a knife?
\+Kitchen=Bag, // a kitchen is not a bag
\+Kitchen=Firearm. // a kitchen is not a firearm
Ok the variable names are ugly, better readable would be
clue1(InBathroom, InDiningroom, InKitchen, InLivingroom, InPantry, InStudy, WithBag, WithFirearm, WithGas, WithKnife, WithPoison, WithRope) :-
man(InKitchen), // (person) in the kitchen is a man - ok
\+Kitchen=Rope, // (person) in the kitchen is not
(person) with a rope - better than above
\+Kitchen=Knife, // ...
\+Kitchen=Bag, // ...
\+Kitchen=Firearm. // ...
But we misuse the equal relation for an explicit one. There is a clear indicator: Variables containing predicates in their names are probably implicit relations. "personInKitchen" is a (logical) predicate "in" connecting two substantives "person" and "kitchen".
As comparison a model with lists and function symbols (suspect/3 is the relational function that connects persons to weapons and rooms, Suspects is the list of suspects):
clue1(Suspects) :-
member(suspect(Person,Weapon,Room),Suspects),
male(Person), // The man (Person)
Room = kitchen, // in the Kitchen (Room)
Weapon \= rope, // was not found with the (Weapon) rope
Weapon \= knife, // (Weapon) knife
Weapon \= bag, // (Weapon) bag
Weapon \= firearm.// (Weapon) firearm
Summary
So if you use prolog for private purpose, I do not mind "misusing" Variables to come to a quick solution. But if your ruleset and your data grows it seems to me quite essential to model all relations explicitly.
I have a homework assignment where I must write a predicate seatingChart(X):- which will have 8 seats. The rules are:
Adjacent seating partners must be of the opposite gender.
Adjacent seating partners must share at least one of the same hobby.
I thought I wrote the code below to create the correct case.
person(jim,m).
person(tom,m).
person(joe,m).
person(bob,m).
person(fay,f).
person(beth,f).
person(sue,f).
person(cami,f).
% Database of hobbies
% hobbies(name,hobby). -> People can have multiple hobbies)
hobbies(jim, sup).
hobbies(jim, fish).
hobbies(jim, kayak).
hobbies(tom, hike).
hobbies(tom, fish).
hobbies(tom, ski).
hobbies(joe, gamer).
hobbies(joe, chess).
hobbies(joe, climb).
hobbies(bob, paint).
hobbies(bob, yoga).
hobbies(bob, run).
hobbies(fay, sup).
hobbies(fay, dance).
hobbies(fay, run).
hobbies(beth, climb).
hobbies(beth, cycle).
hobbies(beth, fish).
hobbies(sue, yoga).
hobbies(sue, skate).
hobbies(sue, ski).
hobbies(cami, run).
hobbies(cami, kayak).
hobbies(cami, gamer).
%% ANSWER %%
% return a pair of opposite gender people
gender(PersonX, PersonY):-
person(PersonX,GenderX),
person(PersonY,GenderY),
GenderX \= GenderY.
% return the pair of similar interests.
similarHobbies(PersonX, PersonY):-
hobbies(PersonX, HobbyX),
hobbies(PersonY, HobbyY),
HobbyX == HobbyY.
% Create the rules for our seating chart list
seatingRules([P1,P2,P3,P4,P5,P6,P7,P8|_]):-
% Have each adjacent person be of the opposite gender
gender(P1,P2),
gender(P3,P4),
gender(P5,P6),
gender(P7,P8),
gender(P8,P1),
% Have each adjacent person have at least one of the same hobby
similarHobbies(P1,P2),
similarHobbies(P3,P4),
similarHobbies(P5,P6),
similarHobbies(P7,P8).
% Generate a list of all the names from person(...)
people(P):-
findall(X, person(X,_), P).
% Generate a list of permutations of people
permPeople([P1,P2,P3,P4,P5,P6,P7,P8]):-
permutation([P1,P2,P3,P4,P5,P6,P7,P8],
[jim,tom,joe,bob,fay,beth,sue,cami]),
\+error([P1,P2,P3,P4,P5,P6,P7,P8]).
error([P1,P2,P3,P4,P5,P6,P7,P8]):-
\+seatingRules([P1,P2,P3,P4,P5,P6,P7,P8]).
seatingChart(X):-
permPeople(X).
When I run this using seatingChart(X). in SWI-Prolog I get the following answer first:
X = [jim, fay, tom, beth, joe, cami, bob, sue] ;
However, my subsequent permutations seem to be flat out wrong.. after hitting ; a few more times this says it's a valid answer:
X = [jim, beth, sue, tom, joe, cami, bob, fay] .
What am I doing wrong? Or what is causing my permutations to start not following the seating chart rules?
Shouldn't the seating rule predicate contain all pairs?
% Create the rules for our seating chart list
seatingRules([P1,P2,P3,P4,P5,P6,P7,P8|_]):-
% Have each adjacent person be of the opposite gender
gender(P1,P2),
gender(P2,P3),
gender(P3,P4),
gender(P4,P5),
gender(P5,P6),
gender(P6,P7),
gender(P7,P8),
gender(P8,P1),
% Have each adjacent person have at least one of the same hobby
similarHobbies(P1,P2),
similarHobbies(P2,P3),
similarHobbies(P3,P4),
similarHobbies(P4,P5),
similarHobbies(P5,P6),
similarHobbies(P6,P7),
similarHobbies(P7,P8),
similarHobbies(P8,P1).
The statement :
Four couples in all
Attended a costume ball.
2
The lady dressed as a cat
Arrived with her husband Matt.
3
Two couples were already there,
One man dressed like a bear.
4
First to arrive wasn't Vince,
But he got there before the Prince.
5
The witch (not Sue) is married to Chuck,
Who was dressed as Donald Duck.
6
Mary came in after Lou,
Both were there before Sue.
7
The Gipsy arrived before Ann,
Neither is wed to Batman.
8
If Snow White arrived after Tess,
Then how was each couple dressed?
My code is here , but it returns false :
sol(S):-
S=[[1,L1,M1,LD1,MD1],
[2,L2,M2,LD2,MD2],
[3,L3,M3,LD3,MD3],
[4,L4,M4,LD4,MD4]],
member([_,_,matt,cat,_],S),
member([ALR,_,_,_,bear],S),
(ALR =:= 1 ; ALR =:= 2),
not(member([1,_,vince,_,_],S)),
member([VN,_,vince,_,_],S),
member([PS,_,_,_,prince],S),
VN < PS ,
member([_,_,chuck,witch,donald],S),
not(member([_,sue,_,witch,_],S)),
member([MRY,mary,_,_,_],S),
member([LOU,_,lou,_,_],S),
member([SUE,sue,_,_,_],S),
MRY > LOU,
MRY < SUE,
member([GPS,_,_,gipsy,_],S),
member([ANN,ann,_,_,_],S),
GPS < ANN ,
not(member([_,_,_,gipsy,batman],S)),
not(member([_,ann,_,_,batman],S)),
member([SW,_,_,snowwhite,_],S),
member([TS,tess,_,_,_],S),
SW > TS ,
perm([sue,mary,ann,tess],[L1,L2,L3,L4]),
perm([matt,lou,vince,chuck],[M1,M2,M3,M4]),
perm([cat,witch,gipsy,snowwhite],[LD1,LD2,LD3,LD4]),
perm([donald,prince,batman,bear],[MD1,MD2,MD3,MD4]).
takeout(X,[X|R],R).
takeout(X,[F|R],[F|S]) :- takeout(X,R,S).
perm([],[]).
perm([X|Y],Z) :- perm(Y,W), takeout(X,Z,W).
Any solution ?
You should move all your not(...) goals to the very end of the predicate.
not(G) means, "G is impossible to satisfy right now". When tried too early, with many still non-instantiated variables in the lists, it is in fact very often possible to satisfy a goal, and the whole not(...) call will fail right away.
Alternatively, delay the checking of the inequality on a variable until it is instantiated, e.g. in SWI Prolog with freeze/2 (as seen e.g. in this answer).
In the book Jess in Action - Rule-Based Systems in Java (written more than 10 years back; I think Drools is the system to use today?), Ernest Friedman-Hill solves the constraint problem given below using Jess, an OPS5-style forward-chaining production system written in Java. I want to solve it using Prolog.
The question is: do I solve it correctly?
The problem
A foursome of golfers is standing at a tee, in a line from left to
right. Each golfer wears different colored pants; one is wearing red
pants. The golfer to Fed’s immediate right is wearing blue pants. Joe
is second in line. Bob is wearing plaid pants. Tom isn’t in position
one or four, and he isn’t wearing the hideous orange pants.
In what
order will the four golfers tee off, and what color are each golfer’s
pants?
This is an instance of a Zebra Puzzle. See also this presentation for a beautifully illustrated solution to a more complex one.
Using Jess, by Ernest Friedman-Hill
Using the Jess production system the code would be as follows. This is from the above-mentioned book, with variables renamed for clarity.
The working memory is filled with 32 links from golfers to their possible positions and pant-colors. The find-solution rule fires for the link set fulfilling the constraints.
This seems hard to think about because one does not test "possible worlds" for whether they fulfill the constraints but one selects a set of links that fulfill the constraints. Is not clear that this indeed what one is looking for.
;; Templates for working memory, basically the links golfer<->pantscolor,
;; and golfer<->position.
(deftemplate pants-color (slot of) (slot is))
(deftemplate position (slot of) (slot is))
;; Generate all possible 'pants-color' and 'position' facts
;; 4 names, each with 4 pants-color: 16 entries
;; 4 names, each with 4 positions: 16 entries
;; This gives the 32 facts describing the links
(defrule generate-possibilities
=>
(foreach ?name (create$ Fred Joe Bob Tom)
(foreach ?color (create$ red blue plaid orange)
(assert (pants-color (of ?name) (is ?color))))
(foreach ?position (create$ 1 2 3 4)
(assert (position (of ?name) (is ?position))))))
;; The “find solution” rule forward-chains and prints out a solution
(defrule find-solution
;; There is a golfer named Fred, whose position is ?p_fred and
;; pants color is ?c_fred
(position (of Fred) (is ?p_fred))
(pants-color (of Fred) (is ?c_fred))
;; The golfer to Fred's immediate right (who is not Fred) is wearing
;; blue pants.
(position (of ?n&~Fred) (is ?p&:(eq ?p (+ ?p_fred 1))))
(pants-color (of ?n&~Fred) (is blue&~?c_fred))
;; Joe is in position #2
(position (of Joe) (is ?p_joe&2&~?p_fred))
(pants-color (of Joe) (is ?c_joe&~?c_fred))
;; Bob is wearing the plaid pants (so his position is not “n” either
;; because “n” has blue pants)
(position (of Bob) (is ?p_bob&~?p_fred&~?n&~?p_joe))
(pants-color (of Bob&~?n) (is plaid&?c_bob&~?c_fred&~?c_joe))
;; Tom isn't in position 1 or 4 and isn't wearing orange (and not blue
;; either)
(position (of Tom&~?n) (is ?p_tom&~1&~4&~?p_fred&~?p_joe&~?p_bob))
(pants-color (of Tom) (is ?c_tom&~orange&~blue&~?c_fred&~?c_joe&~?c_bob))
=>
(printout t Fred " " ?p_fred " " ?c_fred crlf)
(printout t Joe " " ?p_joe " " ?c_joe crlf)
(printout t Bob " " ?p_bob " " ?c_bob crlf)
(printout t Tom " " ?p_tom " " ?c_tom crlf crlf))
My first solution in Prolog
Turns out this is inelegant & heavy-handed (see other answers)
Let's look for a datastructure to describe the solution, given as follows: Choose a list, at each position there is a "golfer" having a "Name" and a "Pants Color": [golfer(N0,C0),golfer(N1,C1),golfer(N2,C2),golfer(N3,C3)]. Each golfer also has the teeing position from 0 to 3 given by the actual position in the list; the position is not given explicitly as in golfer(Name,Color,Position).
solution(L) :-
% select possible pants colors which must be pairwise different; for
% fast fail, we check often
is_pants_color(C0),
is_pants_color(C1),are_pairwise_different([C0,C1]),
is_pants_color(C2),are_pairwise_different([C0,C1,C2]),
is_pants_color(C3),are_pairwise_different([C0,C1,C2,C3]),
% select possible golfer names which must be pairwise different; for
% fast fail, we check often
is_name(N0),
% we know that joe is second in line, so we can plonck that condition
% in here immediately
N1 = joe,
is_name(N1),are_pairwise_different([N0,N1]),
is_name(N2),are_pairwise_different([N0,N1,N2]),
is_name(N3),are_pairwise_different([N0,N1,N2,N3]),
% instantiate the solution in a unique order (we don't change the order
% as we permute exhuastively permute colors and names)
L = [golfer(N0,C0),golfer(N1,C1),golfer(N2,C2),golfer(N3,C3)],
% tom is not in position one or four; express this clearly using
% "searchWithPosition" instead of implicitly by unification with L
search(tom,L,golfer(_,_,TomPosition)),
TomPosition \== 0,
TomPosition \== 3,
% check additional constraints using L
rightOf(fred,L,golfer(_,blue)),
search(bob,L,golfer(_,plaid,_)),
\+search(tom,L,golfer(_,hideous_orange,_)).
% here we stipulate the colors
is_pants_color(red).
is_pants_color(blue).
is_pants_color(plaid).
is_pants_color(hideous_orange).
% here we stipulate the names
is_name(joe).
is_name(bob).
is_name(tom).
is_name(fred).
% helper predicate
are_pairwise_different(L) :- sort(L,LS), length(L,Len), length(LS,Len).
% Search a golfer by name in the solution list, iteratively.
% Also return the position 0..3 for fun and profit (allows to express the
% constraint on the position)
% We "know" that names are unique, so cut on the first clause.
search(Name,L,golfer(Name,C,Pos)) :-
searchWithPosition(Name,L,golfer(Name,C,Pos),0).
searchWithPosition(Name,[golfer(Name,C)|_],golfer(Name,C,Pos),Pos) :- !.
searchWithPosition(Name,[_|R],golfer(Name,C,PosOut),PosIn) :-
PosDown is PosIn+1, searchWithPosition(Name,R,golfer(Name,C,PosOut),PosDown).
% Search the golfer to the right of another golfer by name in the list,
% iteratively. We "know" that names are unique, so cut on the first clause
rightOf(Name,[golfer(Name,_),golfer(N,C)|_],golfer(N,C)) :- !.
rightOf(Name,[_|R],golfer(N,C)) :- rightOf(Name,R,golfer(N,C)).
Let's run this:
?:- solution(L).
L = [golfer(fred, hideous_orange),
golfer(joe, blue),
golfer(tom, red),
golfer(bob, plaid)]
Compact solution
golfers(S) :-
length(G, 4),
choices([
g(1, _, _),
g(2, joe, _), % Joe is second in line.
g(3, _, _),
g(4, _, _),
g(_, _, orange),
g(_, _, red), % one is wearing red pants
g(_, bob, plaid), % Bob is wearing plaid pants
g(P, fred, _), % The golfer to Fred’s immediate right
g(Q, _, blue), % ....is wearing blue pants
g(Pos, tom, Pants) % Tom isn’t in position one or four, and
% ... he isn’t wearing the orange pants
], G),
Q is P+1,
Pos \= 1, Pos \= 4, Pants \= orange, sort(G,S).
choices([],_).
choices([C|Cs],G) :- member(C,G), choices(Cs,G).
Note added by OP: Why this works
Create a list G of 4 uninitialized elements using length/2
For every element C in the first argument passed to choices/2, make sure C is a member of G.
The first 4 entries will be assigned in order (hopefully deterministically) and as they cannot unify, this will result in something like [g(1, _G722, _G723), g(2, joe, _G730), g(3, _G736, _G737), g(4, _G743, _G744)] after the 4th call to member/2.
After choices/2 returns, G has been unified to a structure that fulfills each constraint in the list of constraints passed to choices/2, in particular:
Positions 1,2,3,4 are listed
Names joe, bob, fred, tom are listed
Colors orange, plaid, red, blue listed
...and this means we don't have to even check for whether a color or name or position appears twice - it can only appear exactly once.
Additional constraints could not be passed to choices/2 (there is no way to say things like g(P, fred, _), g(P+1, _, blue), g(not-in{1,4}, tom, not-in{orange}) and pass this to choices/2). So these additional constraints are checked via the variables unified with G contents.
If these additional constraints fail, a backtracking over choices/2 and thus over member/2 will occur. There are 9 member/2 calls on-stack at that point, which will be exhaustively tried, although backtracking back past member assignment for g(4, _, _) is not useful.
Once an acceptable solution has been found, it is sorted and the program succeeds.
Compact solution, modified
Added by OP:
The above shows that a slight improvement is possible. This program does not find any additional (identical) solutions after the first one:
golfers(G) :-
G=[g(1,_,_),g(2,_,_),g(3,_,_),g(4,_,_)],
choices([
g(2, joe, _), % Joe is second in line.
g(_, _, orange),
g(_, _, red), % one is wearing red pants
g(_, bob, plaid), % Bob is wearing plaid pants
g(P, fred, _), % The golfer to Fred’s immediate right is
g(Q, _, blue), % ...wearing blue pants
g(Pos, tom, Pants) % Tom isn’t in position one or four, and
% ...he isn’t wearing the hideous orange pants
], G),
Q is P+1,
Pos \= 1, Pos \= 4, Pants \= orange.
choices([],_).
choices([C|Cs],G) :- member(C,G), choices(Cs,G).
Why this works
Define immediately the structure of the resulting G instead of creating a list of four as-yet-unknown elements using "length"
In this "proto-G" the list elements are sorted naturally by position; we will not be finding different solutions where the g(P,_,_) are permuted by position
We can thus get rid of the g(1,_,_), g(3,_,_), g(4,_,_) constraints
If one additionally wanted to make sure that names and colors are used exactly once (which is not necessary as this must be true by construction), one would capture the names and colors via choices/2 using g(1,N1,C1), g(2,N2,C2), g(3,N3,C3), g(4,N4,C4) and make sure the Ni and Ci are unique via a sort/2: sort([N1,N2,N3,N4],[bob,fred,joe,tom]), sort([C1,C2,C3,C4],[blue,orange,plaid,red])
Another solution
Prolog make easy to write 'languages'. Let's declare the problem, and craft a micro DSL to solve:
golfers_pants([G1,G2,G3,G4]) :-
maplist(choice([G1,G2,G3,G4]),[
% my note: we are going to compute on positions, so fill the 'column' with domain values
g(1, _, _),
% Joe is second in line.
g(2, joe, _),
g(3, _, _),
g(4, _, _),
% my note: someone is wearing 'hideous orange pants' not mentioned positively elsewhere
g(_, _, orange),
% one is wearing red pants
g(_, _, red),
% Bob is wearing plaid pants
g(_, bob, plaid),
% The golfer to Fred’s immediate right is wearing blue pants
g(P, fred, _), g(Q, _, blue), Q is P+1,
% Tom isn’t in position one or four, and he isn’t wearing the hideous orange pants
g(Pos, tom, Pants), Pos \= 1, Pos \= 4, Pants \= orange
]).
choice(G,C) :- C = g(_,_,_) -> member(C,G) ; call(C).
The Jess solution, rewritten in Prolog
This is for completion.
Rewriting the Jess solution in SWI Prolog (but not in SWISH, because we now make use of assert) shows that:
There is a lot of exhaustive enumerative going on "underneath the hood"
Forward chaining production systems may not the best tool for this kind of "constraint satisfaction over a finite search space" problem
The rule conditions might profit from some conceptual cleanup
So, let's translate this directly:
% Define the possible names, colors and positions
names([fred,joe,bob,tom]).
colors([red,blue,plaid,orange]).
positions([1,2,3,4]).
run :- names(Ns),
colors(Cs),
positions(Ps),
fill_working_memory(pantscolor,Ns,Cs),
fill_working_memory(position,Ns,Ps).
fireable(SortedResult) :-
position(fred,P_fred),
pantscolor(fred,C_fred),
position(N,P) , N \== fred,
P is P_fred+1,
pantscolor(N,blue) , N \== fred,
\+member(C_fred,[blue]),
position(joe,P_joe) , P_joe == 2,
\+member(P_joe,[P_fred]),
pantscolor(joe,C_joe) , \+member(C_joe,[C_fred]),
position(bob, P_bob) , \+member(P_bob,[P_fred,N,P_joe]),
pantscolor(bob, C_bob), N \== bob,
C_bob = plaid,
\+member(C_bob, [C_fred,C_joe]),
position(tom, P_tom) , N \== tom,
\+member(P_tom,[1,4,P_fred,P_joe,P_bob]),
pantscolor(tom, C_tom), \+member(C_tom,[orange,blue,C_fred,C_joe,C_bob]),
% build clean result
Result = [g(P_fred,fred,C_fred),
g(P_bob,bob,C_bob),
g(P_joe,joe,C_joe),
g(P_tom,tom,C_tom)],
sort(Result,SortedResult).
% -- Helper to assert initial facts into the working memory
fill_working_memory(PredSym,Ns,Vs) :-
product(Ns,Vs,Cartesian),
forall(member([N,V], Cartesian), factify(PredSym,N,V)).
factify(PredSym,N,V) :- Term=..([PredSym,N,V]), writeln(Term), assertz(Term).
% -- These should be in a library somewhere --
% Via https://gist.github.com/raskasa/4282471
% pairs(+N,+Bs,-Cs)
% returns in Cs the list of pairs [N,any_element_of_B]
pairs(_,[],[]) :- !.
pairs(N,[B|Bs],[[N,B]|Cs]) :- pairs(N,Bs,Cs).
% product(+As,+Bs,-Cs)
% returns in Cs the cartesian product of lists As and Bs
% product([x,y], [a,b,c], [[x, a], [x, b], [x, c], [y, a], [y, b], [y, c]])
% Would be interesting to make this a product(+As,+Bs,?Cs)
product([],_,[]) :- !.
product([A|As],Bs,Cs) :- pairs(A,Bs,Xs),
product(As,Bs,Ys),
append(Xs,Ys,Cs).
Let's run this:
?- run, fireable(X).
X = [g(1, fred, orange),
g(2, joe, blue),
g(3, tom, red),
g(4, bob, plaid)] .
For some reason, swipl becomes dog-slow after the 5th execution or so. Garbage collection kicking in?
We have a box that contains red & yellow balls.
A man comes daily and gets 2 balls from the box, if he couldn't get 2 balls the game finishes.
There is a heap of red balls next to the box.
If the 2 balls which the man has withdrawn from the box were similar, he puts red ball into the box,
while if they were different, he puts yellow ball in the box.
We suppose that the box is represented like this
initialCan([y, r, y, r, y, r, y, r, y, r]).
y represents yellow ball, r represents red ball.
The man withdraws the 2 balls from the beginning of the list,
then he puts back 1 ball also to the beginning of the list.
So what is the procedure in Prolog which gives the color of the last ball in the box whatever
was the box containing at the beginning?
You might abstract your problem as a search in the space of possible states.
search(FinalState, FinalState):-
is_final(FinalState).
search(CurrentState, FinalState):-
transition(CurrentState, NextState),
search(NextState, FinalState).
solution(FinalState):-
initial_state(State0),
search(State0, FinalState).
So you jump from state to state until you reach the final one which becomes your solution. You need to do some things:
design a representation for a state (for example, a state might be a list like [r,y,r,...])
write a predicate initial_state(S0) which is satisfied if S0 is the initial state of the game
write a predicate transition(S1, S2) which is true if you can get from S1 to S2
write a predicate is_final(S) which is true if S is a final state
It is even easier to design the state as just box(Yellow_count, Red_count) and not bother with any particular list (after all, the balls are all identical, like electrons). Here is my try. I'm probably writing someone's homework here, but this is actually interesting.
Also consider checking out "Why correctness must be a mathematical concern" by Edsger W. Dijkstra, wherein this problem is described.
% last_ball(box(Yellow_initial_count, Red_initial_count), Last_ball_color, Time_at_end)
% ---------- TRIVIAL CASES ---------
% if there is only 1 yellow ball, the color is 'yellow' and we needed zero steps to reach this state
last_ball(box(1,0), yellow, 0).
% if there is only 1 red ball, the color is 'red' and we needed zero steps to reach this state
last_ball(box(0,1), red, 0).
% ---------- CASES DEFINING INDUCTION OVER Yellow+Red BALLS -----------
% take two yellow: check that this is possible for the given box,
% then find out what the last color is from the reduced counts, then define the number of steps to be higher by 1
last_ball(box(YI, RI), LBC, TAE) :- YI>=2, YIp is (YI-2), RIp is (RI+1), last_ball(box(YIp,RIp),LBC,TAEp), TAE is (TAEp+1).
% take two red: check that this is possible for the given box,
% then find out what the last color is from the reduced counts, then define the number of steps to be higher by 1
last_ball(box(YI, RI), LBC, TAE) :- RI>=2, YIp is YI, RIp is (RI-2+1), last_ball(box(YIp,RIp),LBC,TAEp), TAE is (TAEp+1).
% take a red and a yellow: check that this is possible for the given box,
% then find out what the last color is from the reduced counts, then define the number of steps to be higher by 1
last_ball(box(YI, RI), LBC, TAE) :- RI>=1, YI>=1, YIp is (YI-1+1), RIp is (RI-1), last_ball(box(YIp,RIp),LBC,TAEp), TAE is (TAEp+1).
% Now ask for example:
% ?- last_ball(box(2,1), C, T).
% ===================================
% This problem is of course Edsger W. Dijkstra's "balls in the urn" problem, and
% there is a very easy way to deduce the color without exhautsive check of the move tree, as Prolog does in the above.
% See: https://www.cs.utexas.edu/users/EWD/transcriptions/EWD07xx/EWD720.html
last_ball_ewd(box(YI, _), red) :- 0 is (YI mod 2).
last_ball_ewd(box(YI, _), yellow) :- 1 is (YI mod 2).
% We can test this by trying to find a counterexample of the result of last_ball_ewsd for the other color via '\+'
othercolor(red,yellow).
othercolor(yellow,red).
verify(box(YI, RI)) :- last_ball_ewd(box(YI, RI), LBC), othercolor(LBC,LBCO), \+last_ball(box(YI, RI), LBCO, _).
% Now ask for example:
% ?- verify(box(2, 1))