罗森克兰茨夫人在Prolog中表达的Jess查询(斑马拼图)

Question

在《Jess in Action——Java中基于规则的系统》（10多年前写的;我认为Drools是今天要使用的系统？），Ernest Friedman-Hill使用Jess解决了下面给出的约束问题，Jess是一个用Java编写的OPS5风格的前向链生产系统。我想用Prolog解决它。

问题是：我是否正确解决它？

问题所在

四人组高尔夫球手站在发球台上，从左到一排 右。每个高尔夫球手都穿不同颜色的裤子;一个穿着红色 裤子。美联储右边的高尔夫球手穿着蓝色裤子。乔 排在第二位。鲍勃穿着格子裤。汤姆不在位置上 一四个，他没有穿那条丑陋的橙色裤子。

在什么 顺序是四位高尔夫球手开球，每个高尔夫球手的颜色是什么 裤子？

这是斑马拼图的一个实例。另请参阅此演示文稿，了解更复杂的解决方案的精美插图解决方案。

使用杰斯，欧内斯特·弗里德曼-希尔

使用 Jess 生产系统，代码如下。这是来自上述书籍，为清楚起见，变量已重命名。

工作记忆中充满了从高尔夫球手到他们可能的位置和裤子颜色的 32 个链接。find-solution规则为满足约束的链接集触发。

这似乎很难思考，因为人们不会测试"可能的世界"是否满足约束，而是选择一组满足约束的链接。不清楚这是否确实是一个人正在寻找的。

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

我在Prolog中的第一个解决方案

事实证明，这是不优雅和严厉的（见其他答案）

让我们寻找一个数据结构来描述解决方案，如下所示：选择一个列表，在每个位置都有一个具有"名称"和"裤子颜色"的"高尔夫球手"：[golfer(N0,C0),golfer(N1,C1),golfer(N2,C2),golfer(N3,C3)] .每个高尔夫球手的发球位置也由列表中的实际位置给出从 0 到 3;该职位没有像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)).

让我们运行这个：

?:- solution(L).
L = [golfer(fred, hideous_orange), 
     golfer(joe, blue), 
     golfer(tom, red), 
     golfer(bob, plaid)]

Answer 1

紧凑型解决方案

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

OP添加的说明：为什么有效

• 使用 length/2 创建包含 4 个未初始化元素的列表 G
• 对于传递给choices/2的第一个参数中的每个元素 C，确保 C 是 G 的成员。
  • 前 4 个条目将按顺序分配（希望是确定性的），并且由于它们无法统一，这将导致在第 4 次调用 member/2 之后出现类似 [g(1, _G722, _G723), g(2, joe, _G730), g(3, _G736, _G737), g(4, _G743, _G744)] 的内容。
  • 在choices/2返回之后，G 被统一为一个结构，该结构满足传递给 choices/2 的约束列表中的每个约束，特别是：
    • 列出位置 1，2，3，4
    • 列出乔、鲍勃、弗雷德、汤姆的名字
    • 颜色橙色，格子，红色，蓝色列出
    • 。这意味着我们甚至不必检查颜色、名称或位置是否出现两次 - 它只能只出现一次。
  • 其他约束无法传递给choices/2（没有办法说g(P, fred, _), g(P+1, _, blue), g(not-in{1,4}, tom, not-in{orange})之类的话并将其传递给choices/2）。因此，这些附加约束是通过与 G 内容统一的变量来检查的。
  • 如果这些附加约束失败，将发生choices/2回溯，从而超过member/2。此时堆栈上有 9 个member/2调用，这将被详尽地尝试，尽管回溯过去的成员分配g(4, _, _)没有用。
  • 一旦找到可接受的解决方案，就会对其进行排序，程序就会成功。

紧凑型解决方案，经过修改

由OP添加：

以上表明，略有改善是可能的。该程序在第一个解决方案之后找不到任何其他（相同的）解决方案：

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

为什么有效

• 立即定义生成的 G 的结构，而不是使用"长度"创建四个未知元素的列表
• 在这个"proto-G"中，列表元素是按位置自然排序的;我们不会找到不同的解决方案，其中g(P,_,_)按位置排列。
  • 因此，我们可以摆脱g(1,_,_), g(3,_,_), g(4,_,_)约束
  • 如果还想确保名称和颜色只使用一次（这不是必需的，因为构造必须如此），则可以使用g(1,N1,C1), g(2,N2,C2), g(3,N3,C3), g(4,N4,C4)通过choices/2捕获名称和颜色，并通过sort/2确保Ni和Ci是唯一的：sort([N1,N2,N3,N4],[bob,fred,joe,tom]), sort([C1,C2,C3,C4],[blue,orange,plaid,red])

另一种解决方案

Prolog使编写"语言"变得容易。让我们声明问题，并制作一个微型DSL来解决：

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

Answer 2

Jess解决方案，在Prolog中重写

这是为了完成。

在SWI Prolog中重写Jess解决方案（但不是在SWISH中，因为我们现在使用assert）表明：

• 有很多详尽的枚举在"引擎盖下"进行
• 正向链接生产系统可能不是解决这种"有限搜索空间上的约束满足"问题的最佳工具
• 规则条件可能会从一些概念清理中受益

所以，让我们直接翻译一下：

% 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, fireable(X).
X = [g(1, fred, orange),
     g(2, joe, blue),
     g(3, tom, red),
     g(4, bob, plaid)] .

出于某种原因，swipl在第 5 次执行左右后变得狗慢。垃圾收集开始了？