1/*  Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals)
    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% Answer constraint projection
   40%
   41
   42%:- public project_attributes/2.		% xref.pl
   43
   44:- module(clpqr_project,
   45	[
   46	    drop_dep/1,
   47	    drop_dep_one/1,
   48	    make_target_indep/2,
   49	    project_attributes/2
   50	]).   51:- use_module(class,
   52	[
   53	    class_allvars/2
   54	]).   55:- use_module(geler,
   56	[
   57	    project_nonlin/3
   58	]).   59:- use_module(redund,
   60	[
   61	    redundancy_vars/1,
   62	    systems/3
   63	]).   64:- use_module(ordering,
   65	[
   66	    arrangement/2
   67	]).   68
   69%
   70% interface predicate
   71%
   72% May be destructive (either acts on a copy or in a failure loop)
   73%
   74project_attributes(TargetVars,Cvas) :-
   75	sort(TargetVars,Tvs),		% duplicates ?
   76	sort(Cvas,Avs),			% duplicates ?
   77	get_clp(TargetVars,CLP),
   78	(   nonvar(CLP)
   79	->  mark_target(Tvs),
   80	    project_nonlin(Tvs,Avs,NlReachable),
   81	    (   Tvs == []
   82	    ->  drop_lin_atts(Avs)
   83	    ;   redundancy_vars(Avs),		% removes redundant bounds (redund.pl)
   84		make_target_indep(Tvs,Pivots),	% pivot partners are marked to be kept during elim.
   85		mark_target(NlReachable),	% after make_indep to express priority
   86		drop_dep(Avs),
   87		fm_elim(CLP,Avs,Tvs,Pivots),
   88		impose_ordering(Avs)
   89	    )
   90	;   true
   91	).
   92
   93fm_elim(clpq,Avs,Tvs,Pivots) :- fourmotz_q:fm_elim(Avs,Tvs,Pivots).
   94fm_elim(clpr,Avs,Tvs,Pivots) :- fourmotz_r:fm_elim(Avs,Tvs,Pivots).
   95
   96get_clp([],_).
   97get_clp([H|T],CLP) :-
   98	(   get_attr(H,clpqr_itf,Att)
   99	->  arg(1,Att,CLP)
  100	;   true
  101	),
  102	get_clp(T,CLP).
  103
  104% mark_target(Vars)
  105%
  106% Marks the variables in Vars as target variables.
  107
  108mark_target([]).
  109mark_target([V|Vs]) :-
  110	(   get_attr(V,clpqr_itf,Att)
  111	->  setarg(9,Att,target)
  112	;   true
  113	),
  114	mark_target(Vs).
  115
  116% Collect the pivots in reverse order
  117% We have to protect the target variables pivot partners
  118% from redundancy eliminations triggered by fm_elim,
  119% in order to allow for reverse pivoting.
  120%
  121make_target_indep(Ts,Ps) :- make_target_indep(Ts,[],Ps).
  122
  123% make_target_indep(Targets,Pivots,PivotsTail)
  124%
  125% Tries to make as many targetvariables independent by pivoting them with a non-target
  126% variable. The pivots are stored as T:NT where T is a target variable and NT a non-target
  127% variable. The non-target variables are marked to be kept during redundancy eliminations.
  128
  129make_target_indep([],Ps,Ps).
  130make_target_indep([T|Ts],Ps0,Pst) :-
  131	(   get_attr(T,clpqr_itf,AttT),
  132	    arg(1,AttT,CLP),
  133	    arg(2,AttT,type(Type)),
  134	    arg(4,AttT,lin([_,_|H])),
  135	    nontarget(H,Nt)
  136	->  Ps1 = [T:Nt|Ps0],
  137	    get_attr(Nt,clpqr_itf,AttN),
  138	    arg(2,AttN,type(IndAct)),
  139	    arg(5,AttN,order(Ord)),
  140	    arg(6,AttN,class(Class)),
  141	    setarg(11,AttN,keep),
  142	    pivot(CLP,T,Class,Ord,Type,IndAct)
  143	;   Ps1 = Ps0
  144	),
  145	make_target_indep(Ts,Ps1,Pst).
  146
  147% nontarget(Hom,Nt)
  148%
  149% Finds a nontarget variable in homogene part Hom.
  150% Hom contains elements of the form l(V*K,OrdV).
  151% A nontarget variable has no target attribute and no keep_indep attribute.
  152
  153nontarget([l(V*_,_)|Vs],Nt) :-
  154	(   get_attr(V,clpqr_itf,Att),
  155	    arg(9,Att,n),
  156	    arg(10,Att,n)
  157	->  Nt = V
  158	;   nontarget(Vs,Nt)
  159	).
  160
  161% drop_dep(Vars)
  162%
  163% Does drop_dep_one/1 on each variable in Vars.
  164
  165drop_dep(Vs) :-
  166	var(Vs),
  167	!.
  168drop_dep([]).
  169drop_dep([V|Vs]) :-
  170	drop_dep_one(V),
  171	drop_dep(Vs).
  172
  173% drop_dep_one(V)
  174%
  175% If V is an unbounded dependent variable that isn't a target variable, shouldn't be kept
  176% and is not nonzero, drops all linear attributes of V.
  177% The linear attributes are: type, strictness, linear equation (lin), class and order.
  178
  179drop_dep_one(V) :-
  180	get_attr(V,clpqr_itf,Att),
  181	Att = t(CLP,type(t_none),_,lin(Lin),order(OrdV),_,_,n,n,_,n),
  182	\+ indep(CLP,Lin,OrdV),
  183	!,
  184	setarg(2,Att,n),
  185	setarg(3,Att,n),
  186	setarg(4,Att,n),
  187	setarg(5,Att,n),
  188	setarg(6,Att,n).
  189drop_dep_one(_).
  190
  191indep(clpq,Lin,OrdV) :- store_q:indep(Lin,OrdV).
  192indep(clpr,Lin,OrdV) :- store_r:indep(Lin,OrdV).
  193
  194pivot(clpq,T,Class,Ord,Type,IndAct) :- bv_q:pivot(T,Class,Ord,Type,IndAct).
  195pivot(clpr,T,Class,Ord,Type,IndAct) :- bv_r:pivot(T,Class,Ord,Type,IndAct).
  196
  197renormalize(clpq,Lin,New) :- store_q:renormalize(Lin,New).
  198renormalize(clpr,Lin,New) :- store_r:renormalize(Lin,New).
  199
  200% drop_lin_atts(Vs)
  201%
  202% Removes the linear attributes of the variables in Vs.
  203% The linear attributes are type, strictness, linear equation (lin), order and class.
  204
  205drop_lin_atts([]).
  206drop_lin_atts([V|Vs]) :-
  207	get_attr(V,clpqr_itf,Att),
  208	setarg(2,Att,n),
  209	setarg(3,Att,n),
  210	setarg(4,Att,n),
  211	setarg(5,Att,n),
  212	setarg(6,Att,n),
  213	drop_lin_atts(Vs).
  214
  215impose_ordering(Cvas) :-
  216	systems(Cvas,[],Sys),
  217	impose_ordering_sys(Sys).
  218
  219impose_ordering_sys([]).
  220impose_ordering_sys([S|Ss]) :-
  221	arrangement(S,Arr),	% ordering.pl
  222	arrange(Arr,S),
  223	impose_ordering_sys(Ss).
  224
  225arrange([],_).
  226arrange(Arr,S) :-
  227	Arr = [_|_],
  228	class_allvars(S,All),
  229	order(Arr,1,N),
  230	order(All,N,_),
  231	renorm_all(All),
  232	arrange_pivot(All).
  233
  234order(Xs,N,M) :-
  235	var(Xs),
  236	!,
  237	N = M.
  238order([],N,N).
  239order([X|Xs],N,M) :-
  240	(   get_attr(X,clpqr_itf,Att),
  241	    arg(5,Att,order(O)),
  242	    var(O)
  243	->  O = N,
  244	    N1 is N+1,
  245	    order(Xs,N1,M)
  246	;   order(Xs,N,M)
  247	).
  248
  249% renorm_all(Vars)
  250%
  251% Renormalizes all linear equations of the variables in difference list Vars to reflect
  252% their new ordering.
  253
  254renorm_all(Xs) :-
  255	var(Xs),
  256	!.
  257renorm_all([X|Xs]) :-
  258	(   get_attr(X,clpqr_itf,Att),
  259	    arg(1,Att,CLP),
  260	    arg(4,Att,lin(Lin))
  261	->  renormalize(CLP,Lin,New),
  262	    setarg(4,Att,lin(New)),
  263	    renorm_all(Xs)
  264	;   renorm_all(Xs)
  265	).
  266
  267% arrange_pivot(Vars)
  268%
  269% If variable X of Vars has type t_none and has a higher order than the first element of
  270% its linear equation, then it is pivoted with that element.
  271
  272arrange_pivot(Xs) :-
  273	var(Xs),
  274	!.
  275arrange_pivot([X|Xs]) :-
  276	(   get_attr(X,clpqr_itf,AttX),
  277	    %arg(8,AttX,n), % not for nonzero
  278	    arg(1,AttX,CLP),
  279	    arg(2,AttX,type(t_none)),
  280	    arg(4,AttX,lin(Lin)),
  281	    arg(5,AttX,order(OrdX)),
  282	    Lin = [_,_,l(Y*_,_)|_],
  283	    get_attr(Y,clpqr_itf,AttY),
  284	    arg(2,AttY,type(IndAct)),
  285	    arg(5,AttY,order(OrdY)),
  286	    arg(6,AttY,clpqr_class(Class)),
  287	    compare(>,OrdY,OrdX)
  288	->  pivot(CLP,X,Class,OrdY,t_none,IndAct),
  289	    arrange_pivot(Xs)
  290	;   arrange_pivot(Xs)
  291	)