home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / ARC3.ZIP / ARC3.PL
Encoding:
Text File  |  1988-01-08  |  8.1 KB  |  200 lines
  1. %   File   : ARC3.PL
  2. %   Author : R.A.O'Keefe
  3. %   Updated: 9 February 1984
  4. %   Purpose: Implement Mackworth's AC-3 algorithm.
  5. %   Needs  : Util:Assoc.Pl, Util:ListUt.Pl
  6.  
  7. /*  It is often stated that blind backtracking is highly inefficient, and
  8.     it is thereby implied that Prolog must be highly inefficient.  In his
  9.     article "Consistency in Networks of Relations" (AIJ 8 (1977) 99-118)
  10.     Mackworth presents a series of algorithms of increasing complexity to
  11.     "remedy the thrashing behaviour that nearly always accompanies back-
  12.     tracking", which applies to problems involving unary and binary
  13.     constraints for a fixed number of variables with modest discrete
  14.     domains.  Of course it can readily be extended to problems with higher
  15.     degree relations, which become unary or binary when enough of their
  16.     arguments are filled in.  His algorithms do not constitute a complete
  17.     problem-solving method, but can be used to plan a backtracking or
  18.     other solution so that it will be more efficient.
  19.  
  20.     He considers three forms of "consistency".  I have just implemented
  21.     the first two in this file.  The reason is that this level of planning
  22.     can be handled using just sets of values, path consistency requires
  23.     data structures for relations.  (I know how to manipulate such data
  24.     structures, but I'd like to keep this simple.)
  25.  
  26.     For an explanation of why the algorithms work, read Mackworth's paper.
  27.  
  28.     We are given
  29.     a set of Nodes
  30.     a set of Arcs, represented as (From->To) pairs
  31.     a fixed "node admissibility" relation
  32.         admissible_node(Node, Value)
  33.     a fixed "arc admissibility" relation
  34.         admissible_arc(FromNode, ToNode, FromValue, ToValue)
  35.     We compute
  36.     a set of (Node=PossibleValues) associations
  37.     which is node consistent and arc consistent, but may well not
  38.     be path consistent.
  39. */
  40.  
  41. :- public
  42.     arc_consistency_3/3.
  43.  
  44. :- mode
  45.     arc_consistency_3(+, +, -),
  46.     make_nodes(+, -, -),
  47.     make_graph(+, +, -, -),
  48.     revise_each_arc(+, +, +, -),
  49.     node_consistent_bindings(+, -),
  50.     normalise_arcs(+, -),
  51.     group_arcs_with_same_to_node(+, +, -),
  52.     group_arcs_with_same_to_node(+, +, -, -),
  53.     revise_arc(+, +, +, +, -),
  54.     queue_arcs(+, +, +, -).
  55.  
  56.  
  57. arc_consistency_3(Nodes, Arcs, ArcConsistentBindings) :-
  58.     make_nodes(Nodes, NodeSet, InitialBindings),
  59.     make_graph(NodeSet, Arcs, ArcSet, Graph),
  60.     revise_each_arc(ArcSet, Graph, InitialBindings, FinalBindings),
  61.     assoc_to_list(FinalBindings, ArcConsistentBindings).
  62.  
  63.  
  64. /*  make_nodes(NodeList, NodeSet, Bindings)
  65.     is given a representation of the set of nodes as an unordered list
  66.     possibly with duplicates and returns a representation as an ordered
  67.     list without duplicates (make_graph will need this).  It also returns
  68.     an initial set of node-consistent bindings for the nodes.  Now we will
  69.     want to fetch and update random elements of this map, and the simplest
  70.     thing to do is to use the existing ASSOC.PL utilities.  The fact that
  71.     setof fails if the set would be empty is *exactly* what we want here.
  72. */
  73.  
  74. make_nodes(NodeList, NodeSet, Bindings) :-
  75.     sort(NodeList, NodeSet),
  76.     node_consistent_bindings(NodeSet, NodeValList),
  77.     list_to_assoc(NodeValList, Bindings).
  78.  
  79.  
  80. node_consistent_bindings([], []).
  81. node_consistent_bindings([Node|Nodes], [Node-Possible|Bindings]) :-
  82.     setof(Value, admissible_node(Node, Value), Possible), !,
  83.     node_consistent_bindings(Nodes, Bindings).
  84.  
  85.  
  86. /*  We shall want to look up all the arcs leading TO a given node.
  87.     We would like that to be fast.  We would also like to eliminate
  88.     self-loops (X->X).  I think it is safe to assume that the arc
  89.     list does not mention any nodes not in the node list, but we
  90.     may have nodes that no arc leads to.  So what we are going to
  91.     build as a representation of the graph is a binary tree mapping
  92.     nodes to the list of arcs leading to that node.  In other
  93.     contexts we would make that the list of node with arcs leading
  94.     to the node, but here we want the arcs so we can push them back
  95.     onto the stack.  We also want a list of arcs.  Just in case an
  96.     arc appears more than once in the list, we use sort rather than
  97.     keysort.  The code for building the list into a tree is taken
  98.     from ASSOC.PL, avoiding the extra keysort.
  99. */
  100.  
  101. make_graph(NodeSet, ArcList, ArcSet, GraphTree) :-
  102.     normalise_arcs(ArcList, PairList),
  103.     sort(PairList, ArcSet),
  104.     group_arcs_with_same_to_node(NodeSet, ArcSet, FinalPairs),
  105.     length(FinalPairs, N),
  106.     list_to_assoc(N, FinalPairs, GraphTree, []).
  107.  
  108.  
  109. /*  normalise_arcs maps a list of (From->To) pairs to a list of (To-From)
  110.     pairs, omitting any (X->X) pairs it may find.
  111. */
  112.  
  113. normalise_arcs([], []) :- !.
  114. normalise_arcs([(X->X)|ArcList], PairList) :- !,
  115.     normalise_arcs(ArcList, PairList).
  116. normalise_arcs([(From->To)|ArcList], [To-From|PairList]) :-
  117.     normalise_arcs(ArcList, PairList).
  118.  
  119.  
  120. /*  group_arcs_with_same_to_node(NodeSet, ArcSet, NodeToArcMap)
  121.     takes a list of Nodes, and for each node puts a (Node-Arcs) pair
  122.     in the NodeToArcMap, where Arcs is the subset of the ArcSet that
  123.     has Node as the To-node.  It exploits the fact that the NodeSet
  124.     and ArcSet are both sorted, and the NodeToArcMap will also be
  125.     sorted on the Node key, ready for building into a tree.
  126. */
  127.  
  128. group_arcs_with_same_to_node([], [], []).
  129. group_arcs_with_same_to_node([Node|Nodes], ArcSet, [Node-Arcs|NodeToArcMap]) :-
  130.     group_arcs_with_same_to_node(ArcSet, Node, Arcs, RestArcSet),
  131.     group_arcs_with_same_to_node(Nodes, RestArcSet, NodeToArcMap).
  132.  
  133. group_arcs_with_same_to_node([Node-To|ArcSet], Node, [Node-To|Arcs], Rest) :- !,
  134.     group_arcs_with_same_to_node(ArcSet, Node, Arcs, Rest).
  135. group_arcs_with_same_to_node(Rest, _, [], Rest).
  136.  
  137.  
  138. /*  revise_each_binding implements the heart of Mackworth's AC-3:
  139.     Q <- {(i,j) | (i,j) in arcs(G), i =/= j}
  140.     while Q not empty do begin
  141.         select and delete any arc (k,m) from Q;
  142.         if REVISE((k,m)) then Q <- Q U {(i,k) | (i,k) in arcs(G),i/=k,i/=m}
  143.     end;
  144.     the Bindings variables play the role of his D-subscript-i, and the ArcSet
  145.     variables play the role of Q.  We exploit Prolog's success-failure: if
  146.     revise_arc fails we just pop the arc from Q, if it succeeds it returns
  147.     the new binding for node k.  Note that arc (i,j) in Mackworth's notation
  148.     corresponds to J-I in our notation.
  149. */
  150. revise_each_arc([], _, Bindings, Bindings) :- !.
  151. revise_each_arc([M-K|Arcs], Graph, OldBindings, NewBindings) :-
  152.     get_assoc(M, OldBindings, OldM),
  153.     get_assoc(K, OldBindings, OldK),
  154.     revise_arc(OldK, K, OldM, M, NewK),
  155.     NewK \== OldK,
  156.     !,        %  There was at least one deletion
  157.     put_assoc(K, OldBindings, NewK, MidBindings),
  158.     get_assoc(K, Graph, ArcsToK),
  159.     queue_arcs(ArcsToK, M, Arcs, MidArcs),
  160.     revise_each_arc(MidArcs, Graph, MidBindings, NewBindings).
  161. revise_each_arc([_|Arcs], Graph, OldBindings, NewBindings) :-
  162.     revise_each_arc(Arcs, Graph, OldBindings, NewBindings).
  163.  
  164.  
  165. /*  revise_arc(OldK, K, OldM, M, NewK)
  166.     checks each value in OldK to see whether there is at least one value
  167.     in OldM which admissible_arc will accept.  If there is, it includes
  168.     that value from OldK in NewK, otherwise it skips it.  So NewK is the
  169.     subset of bindings for K which is compatible with the current bindings
  170.     for M.
  171. */
  172.  
  173. revise_arc([], _, _, _, []).
  174. revise_arc([Kval|OldK], K, OldM, M, [Kval|NewK]) :-
  175.     member(Mval, OldM),
  176.     admissible_arc(K, M, Kval, Mval),
  177.     !,    % at least one combination works
  178.     revise_arc(OldK, K, OldM, M, NewK).
  179. revise_arc([_|OldK], K, OldM, M, NewK) :-
  180.     revise_arc(OldK, K, OldM, M, NewK).    % nothing worked
  181.  
  182.  
  183. /*  queue_arcs(Arcs, Exclude, OldQueue, NewQueue)
  184.     adds each (To-From) arc from Arcs whose From is not Exclude to OldQueue,
  185.     forming at last a NewQueue.  On reflection, it wasn't necessary to store
  186.     complete arcs in the Graph after all, and I should go back and change it.
  187.     However, storing complete arcs wins in a structure copying system.
  188. */
  189.  
  190. queue_arcs([], _, Queue, Queue).
  191. queue_arcs([_-Exclude|Arcs], Exclude, OldQueue, NewQueue) :- !,
  192.     queue_arcs(Arcs, Exclude, OldQueue, NewQueue).
  193. queue_arcs([Arc|Arcs], Exclude, OldQueue, NewQueue) :-
  194.     queue_arcs(Arcs, Exclude, [Arc|OldQueue], NewQueue).
  195.  
  196.  
  197.  
  198.  
  199.  
  200.