1/* 2 3 Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) 4 5 Author: Leslie De Koninck 6 E-mail: Leslie.DeKoninck@cs.kuleuven.be 7 WWW: http://www.swi-prolog.org 8 http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 9 Copyright (C): 2006, K.U. Leuven and 10 1992-1995, Austrian Research Institute for 11 Artificial Intelligence (OFAI), 12 Vienna, Austria 13 14 This software is based on CLP(Q,R) by Christian Holzbaur for SICStus 15 Prolog and distributed under the license details below with permission from 16 all mentioned authors. 17 18 This program is free software; you can redistribute it and/or 19 modify it under the terms of the GNU General Public License 20 as published by the Free Software Foundation; either version 2 21 of the License, or (at your option) any later version. 22 23 This program is distributed in the hope that it will be useful, 24 but WITHOUT ANY WARRANTY; without even the implied warranty of 25 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 26 GNU General Public License for more details. 27 28 You should have received a copy of the GNU Lesser General Public 29 License along with this library; if not, write to the Free Software 30 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 31 32 As a special exception, if you link this library with other files, 33 compiled with a Free Software compiler, to produce an executable, this 34 library does not by itself cause the resulting executable to be covered 35 by the GNU General Public License. This exception does not however 36 invalidate any other reasons why the executable file might be covered by 37 the GNU General Public License. 38*/ 39 40% 41% Answer constraint projection 42% 43 44%:- public project_attributes/2. % xref.pl 45 46:- module(project, 47 [ 48 drop_dep/1, 49 drop_dep_one/1, 50 make_target_indep/2, 51 project_attributes/2 52 ]). 53:- use_module(class, 54 [ 55 class_allvars/2 56 ]). 57:- use_module(geler, 58 [ 59 project_nonlin/3 60 ]). 61:- use_module(redund, 62 [ 63 redundancy_vars/1, 64 systems/3 65 ]). 66:- use_module(ordering, 67 [ 68 arrangement/2 69 ]). 70 71% 72% interface predicate 73% 74% May be destructive (either acts on a copy or in a failure loop) 75% 76project_attributes(TargetVars,Cvas) :- 77 sort(TargetVars,Tvs), % duplicates ? 78 sort(Cvas,Avs), % duplicates ? 79 get_clp(TargetVars,CLP), 80 ( nonvar(CLP) 81 -> mark_target(Tvs), 82 project_nonlin(Tvs,Avs,NlReachable), 83 ( Tvs == [] 84 -> drop_lin_atts(Avs) 85 ; redundancy_vars(Avs), % removes redundant bounds (redund.pl) 86 make_target_indep(Tvs,Pivots), % pivot partners are marked to be kept during elim. 87 mark_target(NlReachable), % after make_indep to express priority 88 drop_dep(Avs), 89 fm_elim(CLP,Avs,Tvs,Pivots), 90 impose_ordering(Avs) 91 ) 92 ; true 93 ). 94 95fm_elim(clpq,Avs,Tvs,Pivots) :- fourmotz_q:fm_elim(Avs,Tvs,Pivots). 96fm_elim(clpr,Avs,Tvs,Pivots) :- fourmotz_r:fm_elim(Avs,Tvs,Pivots). 97 98get_clp([],_). 99get_clp([H|T],CLP) :- 100 ( get_attr(H,itf,Att) 101 -> arg(1,Att,CLP) 102 ; true 103 ), 104 get_clp(T,CLP). 105 106% mark_target(Vars) 107% 108% Marks the variables in Vars as target variables. 109 110mark_target([]). 111mark_target([V|Vs]) :- 112 ( get_attr(V,itf,Att) 113 -> setarg(9,Att,target) 114 ; true 115 ), 116 mark_target(Vs). 117 118 119% mark_keep(Vars) 120% 121% Mark the variables in Vars to be kept during elimination. 122 123mark_keep([]). 124mark_keep([V|Vs]) :- 125 get_attr(V,itf,Att), 126 setarg(11,Att,keep), 127 mark_keep(Vs). 128 129% 130% Collect the pivots in reverse order 131% We have to protect the target variables pivot partners 132% from redundancy eliminations triggered by fm_elim, 133% in order to allow for reverse pivoting. 134% 135make_target_indep(Ts,Ps) :- make_target_indep(Ts,[],Ps). 136 137% make_target_indep(Targets,Pivots,PivotsTail) 138% 139% Tries to make as many targetvariables independent by pivoting them with a non-target 140% variable. The pivots are stored as T:NT where T is a target variable and NT a non-target 141% variable. The non-target variables are marked to be kept during redundancy eliminations. 142 143make_target_indep([],Ps,Ps). 144make_target_indep([T|Ts],Ps0,Pst) :- 145 ( get_attr(T,itf,AttT), 146 arg(1,AttT,CLP), 147 arg(2,AttT,type(Type)), 148 arg(4,AttT,lin([_,_|H])), 149 nontarget(H,Nt) 150 -> Ps1 = [T:Nt|Ps0], 151 get_attr(Nt,itf,AttN), 152 arg(2,AttN,type(IndAct)), 153 arg(5,AttN,order(Ord)), 154 arg(6,AttN,class(Class)), 155 setarg(11,AttN,keep), 156 pivot(CLP,T,Class,Ord,Type,IndAct) 157 ; Ps1 = Ps0 158 ), 159 make_target_indep(Ts,Ps1,Pst). 160 161% nontarget(Hom,Nt) 162% 163% Finds a nontarget variable in homogene part Hom. 164% Hom contains elements of the form l(V*K,OrdV). 165% A nontarget variable has no target attribute and no keep_indep attribute. 166 167nontarget([l(V*_,_)|Vs],Nt) :- 168 ( get_attr(V,itf,Att), 169 arg(9,Att,n), 170 arg(10,Att,n) 171 -> Nt = V 172 ; nontarget(Vs,Nt) 173 ). 174 175% drop_dep(Vars) 176% 177% Does drop_dep_one/1 on each variable in Vars. 178 179drop_dep(Vs) :- 180 var(Vs), 181 !. 182drop_dep([]). 183drop_dep([V|Vs]) :- 184 drop_dep_one(V), 185 drop_dep(Vs). 186 187% drop_dep_one(V) 188% 189% If V is an unbounded dependent variable that isn't a target variable, shouldn't be kept 190% and is not nonzero, drops all linear attributes of V. 191% The linear attributes are: type, strictness, linear equation (lin), class and order. 192 193drop_dep_one(V) :- 194 get_attr(V,itf,Att), 195 Att = t(CLP,type(t_none),_,lin(Lin),order(OrdV),_,_,n,n,_,n), 196 \+ indep(CLP,Lin,OrdV), 197 !, 198 setarg(2,Att,n), 199 setarg(3,Att,n), 200 setarg(4,Att,n), 201 setarg(5,Att,n), 202 setarg(6,Att,n). 203drop_dep_one(_). 204 205indep(clpq,Lin,OrdV) :- store_q:indep(Lin,OrdV). 206indep(clpr,Lin,OrdV) :- store_r:indep(Lin,OrdV). 207 208pivot(clpq,T,Class,Ord,Type,IndAct) :- bv_q:pivot(T,Class,Ord,Type,IndAct). 209pivot(clpr,T,Class,Ord,Type,IndAct) :- bv_r:pivot(T,Class,Ord,Type,IndAct). 210 211renormalize(clpq,Lin,New) :- store_q:renormalize(Lin,New). 212renormalize(clpr,Lin,New) :- store_r:renormalize(Lin,New). 213 214% drop_lin_atts(Vs) 215% 216% Removes the linear attributes of the variables in Vs. 217% The linear attributes are type, strictness, linear equation (lin), order and class. 218 219drop_lin_atts([]). 220drop_lin_atts([V|Vs]) :- 221 get_attr(V,itf,Att), 222 setarg(2,Att,n), 223 setarg(3,Att,n), 224 setarg(4,Att,n), 225 setarg(5,Att,n), 226 setarg(6,Att,n), 227 drop_lin_atts(Vs). 228 229impose_ordering(Cvas) :- 230 systems(Cvas,[],Sys), 231 impose_ordering_sys(Sys). 232 233impose_ordering_sys([]). 234impose_ordering_sys([S|Ss]) :- 235 arrangement(S,Arr), % ordering.pl 236 arrange(Arr,S), 237 impose_ordering_sys(Ss). 238 239arrange([],_). 240arrange(Arr,S) :- 241 Arr = [_|_], 242 class_allvars(S,All), 243 order(Arr,1,N), 244 order(All,N,_), 245 renorm_all(All), 246 arrange_pivot(All). 247 248order(Xs,N,M) :- 249 var(Xs), 250 !, 251 N = M. 252order([],N,N). 253order([X|Xs],N,M) :- 254 ( get_attr(X,itf,Att), 255 arg(5,Att,order(O)), 256 var(O) 257 -> O = N, 258 N1 is N+1, 259 order(Xs,N1,M) 260 ; order(Xs,N,M) 261 ). 262 263% renorm_all(Vars) 264% 265% Renormalizes all linear equations of the variables in difference list Vars to reflect 266% their new ordering. 267 268renorm_all(Xs) :- 269 var(Xs), 270 !. 271renorm_all([X|Xs]) :- 272 ( get_attr(X,itf,Att), 273 arg(1,Att,CLP), 274 arg(4,Att,lin(Lin)) 275 -> renormalize(CLP,Lin,New), 276 setarg(4,Att,lin(New)), 277 renorm_all(Xs) 278 ; renorm_all(Xs) 279 ). 280 281% arrange_pivot(Vars) 282% 283% If variable X of Vars has type t_none and has a higher order than the first element of 284% its linear equation, then it is pivoted with that element. 285 286arrange_pivot(Xs) :- 287 var(Xs), 288 !. 289arrange_pivot([X|Xs]) :- 290 ( get_attr(X,itf,AttX), 291 %arg(8,AttX,n), % not for nonzero 292 arg(1,AttX,CLP), 293 arg(2,AttX,type(t_none)), 294 arg(4,AttX,lin(Lin)), 295 arg(5,AttX,order(OrdX)), 296 Lin = [_,_,l(Y*_,_)|_], 297 get_attr(Y,itf,AttY), 298 arg(2,AttY,type(IndAct)), 299 arg(5,AttY,order(OrdY)), 300 arg(6,AttY,class(Class)), 301 compare(>,OrdY,OrdX) 302 -> pivot(CLP,X,Class,OrdY,t_none,IndAct), 303 arrange_pivot(Xs) 304 ; arrange_pivot(Xs) 305 ).