1/*  Part of CLP(Q) (Constraint Logic Programming over Rationals)
    2
    3    Author:        Leslie De Koninck
    4    E-mail:        Leslie.DeKoninck@cs.kuleuven.be
    5    WWW:           http://www.swi-prolog.org
    6		   http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09
    7    Copyright (C): 2006, K.U. Leuven and
    8		   1992-1995, Austrian Research Institute for
    9		              Artificial Intelligence (OFAI),
   10			      Vienna, Austria
   11
   12    This software is based on CLP(Q,R) by Christian Holzbaur for SICStus
   13    Prolog and distributed under the license details below with permission from
   14    all mentioned authors.
   15
   16    This program is free software; you can redistribute it and/or
   17    modify it under the terms of the GNU General Public License
   18    as published by the Free Software Foundation; either version 2
   19    of the License, or (at your option) any later version.
   20
   21    This program is distributed in the hope that it will be useful,
   22    but WITHOUT ANY WARRANTY; without even the implied warranty of
   23    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   24    GNU General Public License for more details.
   25
   26    You should have received a copy of the GNU Lesser General Public
   27    License along with this library; if not, write to the Free Software
   28    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   29
   30    As a special exception, if you link this library with other files,
   31    compiled with a Free Software compiler, to produce an executable, this
   32    library does not by itself cause the resulting executable to be covered
   33    by the GNU General Public License. This exception does not however
   34    invalidate any other reasons why the executable file might be covered by
   35    the GNU General Public License.
   36*/
   37
   38
   39:- module(clpqr_ordering,
   40	  [ combine/3,
   41	    ordering/1,
   42	    arrangement/2
   43	  ]).   44:- use_module(class,
   45	[
   46	    class_get_prio/2,
   47	    class_put_prio/2
   48	]).   49:- use_module(itf,
   50	[
   51	    clp_type/2
   52	]).   53:- autoload(library(ugraphs),
   54	[
   55	    add_edges/3,
   56	    add_vertices/3,
   57	    top_sort/2,
   58	    ugraph_union/3
   59	]).   60:- autoload(library(lists),
   61	[
   62	    append/3
   63	]).   64
   65ordering(X) :-
   66	var(X),
   67	!,
   68	fail.
   69ordering(A>B) :-
   70	!,
   71	ordering(B<A).
   72ordering(A<B) :-
   73	join_class([A,B],Class),
   74	class_get_prio(Class,Ga),
   75	!,
   76	add_edges([],[A-B],Gb),
   77	combine(Ga,Gb,Gc),
   78	class_put_prio(Class,Gc).
   79ordering(Pb) :-
   80	Pb = [_|Xs],
   81	join_class(Pb,Class),
   82	class_get_prio(Class,Ga),
   83	!,
   84	(   Xs = [],
   85	    add_vertices([],Pb,Gb)
   86	;   Xs=[_|_],
   87	    gen_edges(Pb,Es,[]),
   88	    add_edges([],Es,Gb)
   89	),
   90	combine(Ga,Gb,Gc),
   91	class_put_prio(Class,Gc).
   92ordering(_).
   93
   94arrangement(Class,Arr) :-
   95	class_get_prio(Class,G),
   96	normalize(G,Gn),
   97	top_sort(Gn,Arr),
   98	!.
   99arrangement(_,_) :- throw(unsatisfiable_ordering).
  100
  101join_class([],_).
  102join_class([X|Xs],Class) :-
  103	(   var(X)
  104	->  clp_type(X,CLP),
  105	    (   CLP = clpr
  106	    ->  bv_r:var_intern(X,Class)
  107	    ;   bv_q:var_intern(X,Class)
  108	    )
  109	;   true
  110	),
  111	join_class(Xs,Class).
  112
  113% combine(Ga,Gb,Gc)
  114%
  115% Combines the vertices of Ga and Gb into Gc.
  116
  117combine(Ga,Gb,Gc) :-
  118	normalize(Ga,Gan),
  119	normalize(Gb,Gbn),
  120	ugraph_union(Gan,Gbn,Gc).
  121
  122%
  123% both Ga and Gb might have their internal ordering invalidated
  124% because of bindings and aliasings
  125%
  126
  127normalize([],[]) :- !.
  128normalize(G,Gsgn) :-
  129	G = [_|_],
  130	keysort(G,Gs),	% sort vertices on key
  131	group(Gs,Gsg),	% concatenate vertices with the same key
  132	normalize_vertices(Gsg,Gsgn).	% normalize
  133
  134normalize_vertices([],[]).
  135normalize_vertices([X-Xnb|Xs],Res) :-
  136	(   normalize_vertex(X,Xnb,Xnorm)
  137	->  Res = [Xnorm|Xsn],
  138	    normalize_vertices(Xs,Xsn)
  139	;   normalize_vertices(Xs,Res)
  140	).
  141
  142% normalize_vertex(X,Nbs,X-Nbss)
  143%
  144% Normalizes a vertex X-Nbs into X-Nbss by sorting Nbs, removing duplicates (also of X)
  145% and removing non-vars.
  146
  147normalize_vertex(X,Nbs,X-Nbsss) :-
  148	var(X),
  149	sort(Nbs,Nbss),
  150	strip_nonvar(Nbss,X,Nbsss).
  151
  152% strip_nonvar(Nbs,X,Res)
  153%
  154% Turns vertext X-Nbs into X-Res by removing occurrences of X from Nbs and removing
  155% non-vars. This to normalize after bindings have occurred. See also normalize_vertex/3.
  156
  157strip_nonvar([],_,[]).
  158strip_nonvar([X|Xs],Y,Res) :-
  159	(   X==Y % duplicate of Y
  160	->  strip_nonvar(Xs,Y,Res)
  161	;   var(X) % var: keep
  162	->  Res = [X|Stripped],
  163	    strip_nonvar(Xs,Y,Stripped)
  164	;   % nonvar: remove
  165	    nonvar(X),
  166	    Res = []	% because Vars<anything
  167	).
  168
  169gen_edges([]) --> [].
  170gen_edges([X|Xs]) -->
  171	gen_edges(Xs,X),
  172	gen_edges(Xs).
  173
  174gen_edges([],_) --> [].
  175gen_edges([Y|Ys],X) -->
  176	[X-Y],
  177	gen_edges(Ys,X).
  178
  179% group(Vert,Res)
  180%
  181% Concatenates vertices with the same key.
  182
  183group([],[]).
  184group([K-Kl|Ks],Res) :-
  185	group(Ks,K,Kl,Res).
  186
  187group([],K,Kl,[K-Kl]).
  188group([L-Ll|Ls],K,Kl,Res) :-
  189	(   K==L
  190	->  append(Kl,Ll,KLl),
  191	    group(Ls,K,KLl,Res)
  192	;   Res = [K-Kl|Tail],
  193	    group(Ls,L,Ll,Tail)
  194	).
  195
  196
  197		 /*******************************
  198		 *	       SANDBOX		*
  199		 *******************************/
  200:- multifile
  201	sandbox:safe_primitive/1.  202
  203sandbox:safe_primitive(clpqr_ordering:ordering(_))