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)]
