6

Jess in Action - Rule-Based Systems in Java(写于 10 多年前;我认为 Drools 是今天使用的系统?)一书中,Ernest Friedman-Hill 使用 Jess(一种 OPS5 风格)解决了下面给出的约束问题用Java编写的前向链生产系统。我想用 Prolog 解决它。

问题是:我能正确解决它吗?

问题

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

四个高尔夫球手将按什么顺序开球,每个高尔夫球手的裤子是什么颜色的?

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

使用 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”,具有“Name”和“Pants Color” [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)]
4

2 回答 2

5

紧凑型解决方案

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添加的注释:为什么这样有效

  • 使用创建 4 个未初始化元素的列表 Glength/2
  • 对于传递给 的第一个参数中的每个元素 C choices/2,确保 C 是 G 的成员。
    • 前 4 个条目将按顺序分配(希望是确定性的),并且由于它们无法统一,这将导致在[g(1, _G722, _G723), g(2, joe, _G730), g(3, _G736, _G737), g(4, _G743, _G744)]第 4 次调用member/2.
    • 返回后choices/2, G 已统一为一个结构,该结构满足传递给 的约束列表中的每个约束choices/2,特别是:
      • 列出位置 1,2,3,4
      • 列出了 joe、bob、fred、tom 的名字
      • 颜色橙色,格子,红色,蓝色上市
      • ...这意味着我们甚至不必检查颜色、名称或位置是否出现两次——它只能出现一次。
    • 无法将其他约束传递给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,_,_)约束
    • 如果还想确保名称和颜色只使用一次(这不是必需的,因为这必须通过构造实现),可以通过choices/2using捕获名称和颜色,g(1,N1,C1), g(2,N2,C2), g(3,N3,C3), g(4,N4,C4)并通过 a 确保 Ni 和 Ci 是唯一的sort/2sort([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).
于 2014-12-26T07:21:33.493 回答
0

用 Prolog 重写的 Jess 解决方案

这是为了完成。

在 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 次左右执行后变得缓慢。垃圾收集开始了?

于 2014-12-31T15:07:01.583 回答