All geek questions in one place

Mrs. Rosencrantz's Jess (Zebra Puzzle) Prologue Request

In the Jess in Action - Rule-Based Systems book in Java (written over 10 years ago, I think Drools is the system to use today?), Ernest Friedman-Hill addresses the constraint problem below using Jess, a direct creation system OPS5 chain written in Java. I want to solve this using Prolog.

Question: Am I resolving it correctly?

Problem

Four golfers stand on a tee, in a line from left to right correctly. Each golfer wears different colored pants; one in red pants. Golfer for the FBI right away in blue pants. Joe is in second place. Bob wears pants. Tom is not in one or four position, and he is not wearing disgusting orange pants.

What will be the four golfer's order, and what color will each golfer have trousers?

This is an example of Zebra Puzzle . See also this presentation for a beautifully illustrated solution to a more complex one.

Using Jess, Ernest Friedman Hill

Using the Jess production system, the code will look like this. This is from the above book, with variables renamed for clarity.

The working memory is filled with 32 links from golfers to their possible positions and colored underpants. The find-solution rule is run for a set of links that obeys restrictions.

It seems hard to think about because no one is testing the “possible worlds” to see if they comply with the restrictions, but selects a set of links that satisfy the restrictions. It is not clear that this is really what to look 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 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

It turns out it's inelegant and hard (see other answers)

Look at the data structure to describe the solution, given the following: select a list, each position has a “golfer” with a “Name” and “Pants Color”: [golfer(N0,C0),golfer(N1,C1),golfer(N2,C2),golfer(N3,C3)] . Each golfer also has a teeing position from 0 to 3 given by the actual position in the list; the position is not indicated 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)).

Run this:

 ?:- solution(L). L = [golfer(fred, hideous_orange), golfer(joe, blue), golfer(tom, red), golfer(bob, plaid)]
+6
source share
2 answers

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 it works.

  • Create a list G of 4 uninitialized elements with length/2
  • For each C element 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 (I hope deterministically), and since they cannot be combined, this will lead to 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 returning choices/2 G was combined with a structure that fulfills each restriction in the list of restrictions passed to choices/2 , in particular:
      • Items 1,2,3,4 are listed
      • The names joe, bob, fred, tom are listed
      • Colors are orange, checkered, red, blue.
      • ... and that means we don’t even need to check if a color, name or position is displayed twice - it can only be displayed once.
    • Additional restrictions cannot be passed to choices/2 (things like g(P, fred, _), g(P+1, _, blue), g(not-in{1,4}, tom, not-in{orange}) and pass this to choices/2 ). Thus, these additional restrictions are verified using variables unified with the contents of G.
    • If these additional restrictions are not met, choices/2 will occur on choices/2 and thus on member/2 . At this point, there are 9 member/2 calls on the stack that will be exhaustively verified, although reverting back to the previous item destination for g(4, _, _) not useful.
    • Once an acceptable solution is found, it is sorted and the program successfully completed.

Compact solution, modified

Added OP:

The above shows that a slight improvement is possible. This program does not find additional (identical) solutions after the first:

 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 does it work

  • Determine immediately the structure of the resulting G instead of creating a list of four previously unknown elements using "length"
  • In this "proto-G" list items are sorted naturally by position; we will not find different solutions where g(P,_,_) rearranged by position
    • Thus, we can get rid of the restrictions g(1,_,_), g(3,_,_), g(4,_,_)
    • If you still need to make sure that names and colors are used exactly once (which is not necessary, since this must be true by design), you could capture names and colors with choices/2 with g(1,N1,C1), g(2,N2,C2), g(3,N3,C3), g(4,N4,C4) and make sure that Ni and Ci are unique through a sort/2 : sort([N1,N2,N3,N4],[bob,fred,joe,tom]), sort([C1,C2,C3,C4],[blue,orange,plaid,red])

Another solution

The prologue makes it easy to write "languages." Let me declare a problem and process 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).
+5
source

Jess's solution rewritten in Prolog

This is for completion.

Rewriting the Jess solution in the SWI Prolog (but not in SWISH, as we now use assert ), shows that:

  • There are many exhaustive listings that happen “under the hood”.
  • Direct chain production systems may not be the best tool for this kind of problem with limiting restrictions on the final search space
  • The conditions of the rule may profit from some conceptual cleaning.

So 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).

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 gets slower after the 5th run or so. Garbage collection?

0
source

Source: https://habr.com/ru/post/980154/

More articles:


All Articles