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