% File : ARC3.PL % Author : R.A.O'Keefe % Updated: 9 February 1984 % Purpose: Implement Mackworth's AC-3 algorithm. % Needs : Util:Assoc.Pl, Util:ListUt.Pl /* It is often stated that blind backtracking is highly inefficient, and it is thereby implied that Prolog must be highly inefficient. In his article "Consistency in Networks of Relations" (AIJ 8 (1977) 99-118) Mackworth presents a series of algorithms of increasing complexity to "remedy the thrashing behaviour that nearly always accompanies back- tracking", which applies to problems involving unary and binary constraints for a fixed number of variables with modest discrete domains. Of course it can readily be extended to problems with higher degree relations, which become unary or binary when enough of their arguments are filled in. His algorithms do not constitute a complete problem-solving method, but can be used to plan a backtracking or other solution so that it will be more efficient. He considers three forms of "consistency". I have just implemented the first two in this file. The reason is that this level of planning can be handled using just sets of values, path consistency requires data structures for relations. (I know how to manipulate such data structures, but I'd like to keep this simple.) For an explanation of why the algorithms work, read Mackworth's paper. We are given a set of Nodes a set of Arcs, represented as (From->To) pairs a fixed "node admissibility" relation admissible_node(Node, Value) a fixed "arc admissibility" relation admissible_arc(FromNode, ToNode, FromValue, ToValue) We compute a set of (Node=PossibleValues) associations which is node consistent and arc consistent, but may well not be path consistent. */ :- public arc_consistency_3/3. :- mode arc_consistency_3(+, +, -), make_nodes(+, -, -), make_graph(+, +, -, -), revise_each_arc(+, +, +, -), node_consistent_bindings(+, -), normalise_arcs(+, -), group_arcs_with_same_to_node(+, +, -), group_arcs_with_same_to_node(+, +, -, -), revise_arc(+, +, +, +, -), queue_arcs(+, +, +, -). arc_consistency_3(Nodes, Arcs, ArcConsistentBindings) :- make_nodes(Nodes, NodeSet, InitialBindings), make_graph(NodeSet, Arcs, ArcSet, Graph), revise_each_arc(ArcSet, Graph, InitialBindings, FinalBindings), assoc_to_list(FinalBindings, ArcConsistentBindings). /* make_nodes(NodeList, NodeSet, Bindings) is given a representation of the set of nodes as an unordered list possibly with duplicates and returns a representation as an ordered list without duplicates (make_graph will need this). It also returns an initial set of node-consistent bindings for the nodes. Now we will want to fetch and update random elements of this map, and the simplest thing to do is to use the existing ASSOC.PL utilities. The fact that setof fails if the set would be empty is *exactly* what we want here. */ make_nodes(NodeList, NodeSet, Bindings) :- sort(NodeList, NodeSet), node_consistent_bindings(NodeSet, NodeValList), list_to_assoc(NodeValList, Bindings). node_consistent_bindings([], []). node_consistent_bindings([Node|Nodes], [Node-Possible|Bindings]) :- setof(Value, admissible_node(Node, Value), Possible), !, node_consistent_bindings(Nodes, Bindings). /* We shall want to look up all the arcs leading TO a given node. We would like that to be fast. We would also like to eliminate self-loops (X->X). I think it is safe to assume that the arc list does not mention any nodes not in the node list, but we may have nodes that no arc leads to. So what we are going to build as a representation of the graph is a binary tree mapping nodes to the list of arcs leading to that node. In other contexts we would make that the list of node with arcs leading to the node, but here we want the arcs so we can push them back onto the stack. We also want a list of arcs. Just in case an arc appears more than once in the list, we use sort rather than keysort. The code for building the list into a tree is taken from ASSOC.PL, avoiding the extra keysort. */ make_graph(NodeSet, ArcList, ArcSet, GraphTree) :- normalise_arcs(ArcList, PairList), sort(PairList, ArcSet), group_arcs_with_same_to_node(NodeSet, ArcSet, FinalPairs), length(FinalPairs, N), list_to_assoc(N, FinalPairs, GraphTree, []). /* normalise_arcs maps a list of (From->To) pairs to a list of (To-From) pairs, omitting any (X->X) pairs it may find. */ normalise_arcs([], []) :- !. normalise_arcs([(X->X)|ArcList], PairList) :- !, normalise_arcs(ArcList, PairList). normalise_arcs([(From->To)|ArcList], [To-From|PairList]) :- normalise_arcs(ArcList, PairList). /* group_arcs_with_same_to_node(NodeSet, ArcSet, NodeToArcMap) takes a list of Nodes, and for each node puts a (Node-Arcs) pair in the NodeToArcMap, where Arcs is the subset of the ArcSet that has Node as the To-node. It exploits the fact that the NodeSet and ArcSet are both sorted, and the NodeToArcMap will also be sorted on the Node key, ready for building into a tree. */ group_arcs_with_same_to_node([], [], []). group_arcs_with_same_to_node([Node|Nodes], ArcSet, [Node-Arcs|NodeToArcMap]) :- group_arcs_with_same_to_node(ArcSet, Node, Arcs, RestArcSet), group_arcs_with_same_to_node(Nodes, RestArcSet, NodeToArcMap). group_arcs_with_same_to_node([Node-To|ArcSet], Node, [Node-To|Arcs], Rest) :- !, group_arcs_with_same_to_node(ArcSet, Node, Arcs, Rest). group_arcs_with_same_to_node(Rest, _, [], Rest). /* revise_each_binding implements the heart of Mackworth's AC-3: Q <- {(i,j) | (i,j) in arcs(G), i =/= j} while Q not empty do begin select and delete any arc (k,m) from Q; if REVISE((k,m)) then Q <- Q U {(i,k) | (i,k) in arcs(G),i/=k,i/=m} end; the Bindings variables play the role of his D-subscript-i, and the ArcSet variables play the role of Q. We exploit Prolog's success-failure: if revise_arc fails we just pop the arc from Q, if it succeeds it returns the new binding for node k. Note that arc (i,j) in Mackworth's notation corresponds to J-I in our notation. */ revise_each_arc([], _, Bindings, Bindings) :- !. revise_each_arc([M-K|Arcs], Graph, OldBindings, NewBindings) :- get_assoc(M, OldBindings, OldM), get_assoc(K, OldBindings, OldK), revise_arc(OldK, K, OldM, M, NewK), NewK \== OldK, !, % There was at least one deletion put_assoc(K, OldBindings, NewK, MidBindings), get_assoc(K, Graph, ArcsToK), queue_arcs(ArcsToK, M, Arcs, MidArcs), revise_each_arc(MidArcs, Graph, MidBindings, NewBindings). revise_each_arc([_|Arcs], Graph, OldBindings, NewBindings) :- revise_each_arc(Arcs, Graph, OldBindings, NewBindings). /* revise_arc(OldK, K, OldM, M, NewK) checks each value in OldK to see whether there is at least one value in OldM which admissible_arc will accept. If there is, it includes that value from OldK in NewK, otherwise it skips it. So NewK is the subset of bindings for K which is compatible with the current bindings for M. */ revise_arc([], _, _, _, []). revise_arc([Kval|OldK], K, OldM, M, [Kval|NewK]) :- member(Mval, OldM), admissible_arc(K, M, Kval, Mval), !, % at least one combination works revise_arc(OldK, K, OldM, M, NewK). revise_arc([_|OldK], K, OldM, M, NewK) :- revise_arc(OldK, K, OldM, M, NewK). % nothing worked /* queue_arcs(Arcs, Exclude, OldQueue, NewQueue) adds each (To-From) arc from Arcs whose From is not Exclude to OldQueue, forming at last a NewQueue. On reflection, it wasn't necessary to store complete arcs in the Graph after all, and I should go back and change it. However, storing complete arcs wins in a structure copying system. */ queue_arcs([], _, Queue, Queue). queue_arcs([_-Exclude|Arcs], Exclude, OldQueue, NewQueue) :- !, queue_arcs(Arcs, Exclude, OldQueue, NewQueue). queue_arcs([Arc|Arcs], Exclude, OldQueue, NewQueue) :- queue_arcs(Arcs, Exclude, [Arc|OldQueue], NewQueue).