罗森格兰茨夫人的杰西查询（斑马拼图）在 Prolog 中表达

Posted 2023-05-08

【中文标题】罗森格兰茨夫人的杰西查询（斑马拼图）在 Prolog 中表达

【英文标题】：Mrs. Rosencrantz' Jess query (a Zebra Puzzle) expressed in Prolog

【发布时间】：2015-02-23 08:11:42

【问题描述】：

在书中Jess in Action - Rule-Based Systems in Java（写于 10 多年前；我认为 Drools 是今天使用的系统？），Ernest Friedman-Hill 使用 Jess 解决了下面给出的约束问题，an OPS5-style forward-chaining production system 用 Ja​​va 编写。我想用 Prolog 解决它。

问题是：我能正确解决吗？

问题

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

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

这是Zebra Puzzle 的一个实例。另请参阅 this presentation，了解针对更复杂问题的精美插图解决方案。

使用 Jess，作者 Ernest Friedman-Hill

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

【问题讨论】：

回复：“我想对风格发表一些评论，以及这是否是编写此类代码的正确方法”：这听起来更像是codereview.stackexchange.com 的问题。 . .

are_pairwise_different/1 可以更简单，仍然包括[] 和[_]。

请参阅 this 了解“无脑”Prolog 解决方案

@CapelliC 这行得通真是太疯狂了！真的有人这么想吗？

好吧，Prolog 做到了！元语言一直是 Prolog 的标志（请记住，Prolog 比 Java 更古老，更不用说 Jess）。我的“解决方案”实际上只是对 Prolog 所构建的嵌入式反向链接“引擎”的利用。声明性...

【参考方案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 已列出姓名 joe、bob、fred、tom 列出的颜色为橙色、格子、红色、蓝色 ...这意味着我们甚至不必检查颜色、名称或位置是否出现两次 - 它只能出现一次。 无法将其他约束传递给choices/2（没有办法说像g(P, fred, _), g(P+1, _, blue), g(not-in1,4, tom, not-inorange) 这样的东西并将其传递给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,_,_) 约束 如果还想确保名称和颜色只使用一次（这不是必需的，因为这必须通过构造实现），可以通过choices/2 使用g(1,N1,C1), g(2,N2,C2), g(3,N3,C3), g(4,N4,C4) 捕获名称和颜色，并确保Ni 和 Ci 通过 sort/2: 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).

【讨论】：

s(X)!你真的应该有这个功能：链接到推荐人:-)

@CapelliC 谢谢！我可以在本文中添加您之前的答案，以及更改建议 1) 立即固定位置 2) 还检查颜色和名称是否唯一，这实际上不是必需的，但不言而喻为什么不.. .

@DavidTonhofer：是的，您可以根据需要编辑我的答案。我发布了代码，因为仅链接的答案太不稳定而无法真正有用。确实，SWISH 是一种宝贵的资源，但它太容易丢失实际内容...

@CapelliC 我已在您的文本中添加了大量内容；希望你没问题：不确定我写的内容是否清楚。此外，micro DSL 解决方案似乎不适用于 SWISH。

@DavidTonhofer not anymore.

【参考方案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 次左右执行后变得非常缓慢。垃圾收集开始了吗？

【讨论】：

在第五次调用之后，您的数据库中断言的事实是五倍，由于搜索空间无意义地增加，导致指数下降。这是一个很好的例子，为什么你应该避免副作用：它们使你的程序很难理解和测试。我希望你也能从这个例子中看到这一课。

我明白了。但我不想产生副作用，只是模仿 Jess。我不喜欢副作用（我的单子在哪里？）

你的 monad 在 Prolog 中被称为 DCG。使用它们来隐式地遍历您可以使用半上下文符号选择性地访问的其他参数。

我还发现了 2002 年的 Some Prolog Macros for Rule-Based Programming: Why? How?。最有趣。