diff --git a/GPL/clpqr/ChangeLog b/GPL/clpqr/ChangeLog deleted file mode 100644 index 46c87df34..000000000 --- a/GPL/clpqr/ChangeLog +++ /dev/null @@ -1,34 +0,0 @@ -Sep 10, 2006 - - * JW: Removed dependency on C/3. - -Mar 31, 2006 - - * JW: Removed SICStus ugraphs.pl and replaced by new SWI-Prolog library - -Oct 17, 2005 - - * LDK: Changed floor and ceiling operators to cope with - inaccurate floats. - -Feb 25, 2005 - - * TS: Fix for Bugzilla Bug 19 by Leslie De Koninck. - -Feb 21, 2005 - - * JW: Fixed various module imports and expanded SWI-Prolog - library(ordsets) to support all of the clp(R) library. - -Dec 16, 2004 - - * JW: Make loading parts silent - * TS: Fixed bug toplevel printing. Now only pass different - variables to dump/3. - -Dec 15, 2004 - - * JW: Added version to CVS, updated copyright notices, etc. - * TS: Added automatic printing of constraints on variables - in toplevel query. - diff --git a/GPL/clpqr/Makefile.in b/GPL/clpqr/Makefile.in deleted file mode 100644 index 0d58334e3..000000000 --- a/GPL/clpqr/Makefile.in +++ /dev/null @@ -1,106 +0,0 @@ -# -# default base directory for YAP installation -# (EROOT for architecture-dependent files) -# -prefix = @prefix@ -ROOTDIR = $(prefix) -EROOTDIR = @exec_prefix@ - -SHELL=@SHELL@ -PLBASE=@PLBASE@ -PLARCH=@PLARCH@ -PL=@PL@ -XPCEBASE=$(PLBASE)/xpce -PKGDOC=$(PLBASE)/doc/packages -PCEHOME=../../xpce -LIBDIR=$(PLBASE)/library -SHAREDIR=$(ROOTDIR)/share/Yap -CLPRDIR=$(SHAREDIR)/clpr -CLPQDIR=$(SHAREDIR)/clpq -CLPQRDIR=$(SHAREDIR)/clpqr -EXDIR=$(PKGDOC)/examples/clpr -DESTDIR= -srcdir=@srcdir@ -CLPQSOURCEDIR=$(srcdir)/clpq -CLPRSOURCEDIR=$(srcdir)/clpr -CLPQRSOURCEDIR=$(srcdir)/clpqr - - -INSTALL=@INSTALL@ -INSTALL_PROGRAM=@INSTALL_PROGRAM@ -INSTALL_DATA=@INSTALL_DATA@ - -CLPRPRIV= \ - $(CLPRSOURCEDIR)/bb_r.pl \ - $(CLPRSOURCEDIR)/bv_r.pl \ - $(CLPRSOURCEDIR)/fourmotz_r.pl \ - $(CLPRSOURCEDIR)/ineq_r.pl \ - $(CLPRSOURCEDIR)/itf_r.pl \ - $(CLPRSOURCEDIR)/nf_r.pl \ - $(CLPRSOURCEDIR)/store_r.pl - -CLPQPRIV= \ - $(CLPQSOURCEDIR)/bb_q.pl \ - $(CLPQSOURCEDIR)/bv_q.pl \ - $(CLPQSOURCEDIR)/fourmotz_q.pl \ - $(CLPQSOURCEDIR)/ineq_q.pl \ - $(CLPQSOURCEDIR)/itf_q.pl \ - $(CLPQSOURCEDIR)/nf_q.pl \ - $(CLPQSOURCEDIR)/store_q.pl - -CLPQRPRIV= \ - $(CLPQRSOURCEDIR)/class.pl \ - $(CLPQRSOURCEDIR)/dump.pl \ - $(CLPQRSOURCEDIR)/geler.pl \ - $(CLPQRSOURCEDIR)/itf.pl \ - $(CLPQRSOURCEDIR)/ordering.pl \ - $(CLPQRSOURCEDIR)/project.pl \ - $(CLPQRSOURCEDIR)/redund.pl - -LIBPL= \ - $(srcdir)/clpr.pl \ - $(srcdir)/clpq.pl -EXAMPLES= - -all:: - @echo "Nothing to be done for this package" - -install: $(LIBPL) $(CLPQRPRIV) $(CLPRPRIV) $(CLPQPRIV) - mkdir -p $(DESTDIR)$(CLPQRDIR) - mkdir -p $(DESTDIR)$(CLPRDIR) - mkdir -p $(DESTDIR)$(CLPQDIR) - $(INSTALL_DATA) $(LIBPL) $(DESTDIR)$(SHAREDIR) - $(INSTALL_DATA) $(CLPQRPRIV) $(DESTDIR)$(CLPQRDIR) - $(INSTALL_DATA) $(CLPRPRIV) $(DESTDIR)$(CLPRDIR) - $(INSTALL_DATA) $(CLPQPRIV) $(DESTDIR)$(CLPQDIR) - $(INSTALL_DATA) $(srcdir)/README $(DESTDIR)$(CLPQRDIR) - -rpm-install: install - -pdf-install: install-examples - -html-install: install-examples - -install-examples:: -# mkdir -p $(DESTDIR)$(EXDIR) -# (cd Examples && $(INSTALL_DATA) $(EXAMPLES) $(DESTDIR)$(EXDIR)) - -uninstall: - (cd $(CLPDIR) && rm -f $(LIBPL)) - rm -rf $(CLPQRDIR) - -check:: -# $(PL) -q -f clpr_test.pl -g test,halt -t 'halt(1)' - - -################################################################ -# Clean -################################################################ - -clean: - rm -f *~ *% config.log - -distclean: clean - rm -f config.h config.cache config.status Makefile - rm -rf autom4te.cache - diff --git a/GPL/clpqr/README b/GPL/clpqr/README deleted file mode 100644 index 6acf85f3c..000000000 --- a/GPL/clpqr/README +++ /dev/null @@ -1,19 +0,0 @@ - SWI-Prolog CLP(Q,R) - ------------------- - -Author: Leslie De Koninck, K.U.Leuven - -This software is based on the CLP(Q,R) implementation by Christian -Holzbauer and released with permission from all above mentioned authors -and Christian Holzbauer under the standard SWI-Prolog license schema: -GPL-2 + statement to allow linking with proprietary software. - -The sources of this package are maintained in packages/clpr in the -SWI-Prolog source distribution. The documentation source is in -man/lib/clpr.doc as part of the overall SWI-Prolog documentation. - -Full documentation on CLP(Q,R) can be found at - - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - - diff --git a/GPL/clpqr/clpq.pl b/GPL/clpqr/clpq.pl deleted file mode 100644 index ec9db5747..000000000 --- a/GPL/clpqr/clpq.pl +++ /dev/null @@ -1,135 +0,0 @@ -/* - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(clpq, - [ - {}/1, - maximize/1, - minimize/1, - inf/2, inf/4, sup/2, sup/4, - bb_inf/3, - bb_inf/4, - ordering/1, - entailed/1, - clp_type/2, - dump/3%, projecting_assert/1 - ]). - -:- expects_dialect(swi). - -% -% Don't report export of private predicates from clpq -% -:- multifile - user:portray_message/2. - -:- dynamic - user:portray_message/2. -% -user:portray_message(warning,import(_,_,clpq,private)). - -:- load_files( - [ - 'clpq/bb_q', - 'clpq/bv_q', - 'clpq/fourmotz_q', - 'clpq/ineq_q', - 'clpq/itf_q', - 'clpq/nf_q', - 'clpq/store_q', - 'clpqr/class', - 'clpqr/dump', - 'clpqr/geler', - 'clpqr/itf', - 'clpqr/ordering', - 'clpqr/project', - 'clpqr/redund', - library(ugraphs) - ], - [ - if(not_loaded), - silent(true) - ]). - - /******************************* - * TOPLEVEL PRINTING * - *******************************/ - -:- multifile - prolog:message/3. - -% prolog:message(query(YesNo)) --> !, -% ['~@'-[chr:print_all_stores]], -% '$messages':prolog_message(query(YesNo)). - -prolog:message(query(YesNo,Bindings)) --> !, - {dump_toplevel_bindings(Bindings,Constraints)}, - {dump_format(Constraints,Format)}, - Format, - '$messages':prolog_message(query(YesNo,Bindings)). - -dump_toplevel_bindings(Bindings,Constraints) :- - dump_vars_names(Bindings,[],Vars,Names), - dump(Vars,Names,Constraints). - -dump_vars_names([],_,[],[]). -dump_vars_names([Name=Term|Rest],Seen,Vars,Names) :- - ( var(Term), - ( get_attr(Term,itf,_) - ; get_attr(Term,geler,_) - ), - \+ memberchk_eq(Term,Seen) - -> Vars = [Term|RVars], - Names = [Name|RNames], - NSeen = [Term|Seen] - ; Vars = RVars, - Names = RNames, - Seen = NSeen - ), - dump_vars_names(Rest,NSeen,RVars,RNames). - -dump_format([],[]). -dump_format([X|Xs],['{~w}'-[X],nl|Rest]) :- - dump_format(Xs,Rest). - -memberchk_eq(X,[Y|Ys]) :- - ( X == Y - -> true - ; memberchk_eq(X,Ys) - ). diff --git a/GPL/clpqr/clpq/bb_q.pl b/GPL/clpqr/clpq/bb_q.pl deleted file mode 100644 index c3289afd0..000000000 --- a/GPL/clpqr/clpq/bb_q.pl +++ /dev/null @@ -1,240 +0,0 @@ -/* $Id: bb_q.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(bb_q, - [ - bb_inf/3, - bb_inf/4, - vertex_value/2 - ]). -:- use_module(bv_q, - [ - deref/2, - deref_var/2, - determine_active_dec/1, - inf/2, - iterate_dec/2, - sup/2, - var_with_def_assign/2 - ]). -:- use_module(nf_q, - [ - {}/1, - entailed/1, - nf/2, - nf_constant/2, - repair/2, - wait_linear/3 - ]). - -% bb_inf(Ints,Term,Inf) -% -% Finds the infimum of Term where the variables Ints are to be integers. -% The infimum is stored in Inf. - -bb_inf(Is,Term,Inf) :- - bb_inf(Is,Term,Inf,_). - -bb_inf(Is,Term,Inf,Vertex) :- - wait_linear(Term,Nf,bb_inf_internal(Is,Nf,Inf,Vertex)). - -% --------------------------------------------------------------------- - -% bb_inf_internal(Is,Lin,Inf,Vertex) -% -% Finds an infimum for linear expression in normal form , where -% all variables in are to be integers. - -bb_inf_internal(Is,Lin,_,_) :- - bb_intern(Is,IsNf), - nb_delete(prov_opt), - repair(Lin,LinR), % bb_narrow ... - deref(LinR,Lind), - var_with_def_assign(Dep,Lind), - determine_active_dec(Lind), - bb_loop(Dep,IsNf), - fail. -bb_inf_internal(_,_,Inf,Vertex) :- - catch(nb_getval(prov_opt,InfVal-Vertex),_,fail), - {Inf =:= InfVal}, - nb_delete(prov_opt). - -% bb_loop(Opt,Is) -% -% Minimizes the value of Opt where variables Is have to be integer values. - -bb_loop(Opt,Is) :- - bb_reoptimize(Opt,Inf), - bb_better_bound(Inf), - vertex_value(Is,Ivs), - ( bb_first_nonint(Is,Ivs,Viol,Floor,Ceiling) - -> bb_branch(Viol,Floor,Ceiling), - bb_loop(Opt,Is) - ; nb_setval(prov_opt,Inf-Ivs) % new provisional optimum - ). - -% bb_reoptimize(Obj,Inf) -% -% Minimizes the value of Obj and puts the result in Inf. -% This new minimization is necessary as making a bound integer may yield a -% different optimum. The added inequalities may also have led to binding. - -bb_reoptimize(Obj,Inf) :- - var(Obj), - iterate_dec(Obj,Inf). -bb_reoptimize(Obj,Inf) :- - nonvar(Obj), - Inf = Obj. - -% bb_better_bound(Inf) -% -% Checks if the new infimum Inf is better than the previous one (if such exists). - -bb_better_bound(Inf) :- - catch((nb_getval(prov_opt,Inc-_),Inf < Inc),_,true). - -% bb_branch(V,U,L) -% -% Stores that V =< U or V >= L, can be used for different strategies within -% bb_loop/3. - -bb_branch(V,U,_) :- {V =< U}. -bb_branch(V,_,L) :- {V >= L}. - -% vertex_value(Vars,Values) -% -% Returns in the current values of the variables in . - -vertex_value([],[]). -vertex_value([X|Xs],[V|Vs]) :- - rhs_value(X,V), - vertex_value(Xs,Vs). - -% rhs_value(X,Value) -% -% Returns in the current value of variable . - -rhs_value(Xn,Value) :- - ( nonvar(Xn) - -> Value = Xn - ; var(Xn) - -> deref_var(Xn,Xd), - Xd = [I,R|_], - Value is R+I - ). - -% bb_first_nonint(Ints,Rhss,Eps,Viol,Floor,Ceiling) -% -% Finds the first variable in Ints which doesn't have an active integer bound. -% Rhss contain the Rhs (R + I) values corresponding to the variables. -% The first variable that hasn't got an active integer bound, is returned in -% Viol. The floor and ceiling of its actual bound is returned in Floor and Ceiling. - -bb_first_nonint([I|Is],[Rhs|Rhss],Viol,F,C) :- - ( integer(Rhs) - -> bb_first_nonint(Is,Rhss,Viol,F,C) - ; Viol = I, - F is floor(Rhs), - C is ceiling(Rhs) - ). - -% bb_intern([X|Xs],[Xi|Xis]) -% -% Turns the elements of the first list into integers into the second -% list via bb_intern/3. - -bb_intern([],[]). -bb_intern([X|Xs],[Xi|Xis]) :- - nf(X,Xnf), - bb_intern(Xnf,Xi,X), - bb_intern(Xs,Xis). - - -% bb_intern(Nf,X,Term) -% -% Makes sure that Term which is normalized into Nf, is integer. -% X contains the possibly changed Term. If Term is a variable, -% then its bounds are hightened or lowered to the next integer. -% Otherwise, it is checked it Term is integer. - -bb_intern([],X,_) :- - !, - X = 0. -bb_intern([v(I,[])],X,_) :- - !, - integer(I), - X = I. -bb_intern([v(1,[V^1])],X,_) :- - !, - V = X, - bb_narrow_lower(X), - bb_narrow_upper(X). -bb_intern(_,_,Term) :- - throw(instantiation_error(bb_inf(Term,_),1)). - -% bb_narrow_lower(X) -% -% Narrows the lower bound so that it is an integer bound. -% We do this by finding the infimum of X and asserting that X -% is larger than the first integer larger or equal to the infimum -% (second integer if X is to be strict larger than the first integer). - -bb_narrow_lower(X) :- - ( inf(X,Inf) - -> Bound is ceiling(Inf), - ( entailed(X > Bound) - -> {X >= Bound+1} - ; {X >= Bound} - ) - ; true - ). - -% bb_narrow_upper(X) -% -% See bb_narrow_lower/1. This predicate handles the upper bound. - -bb_narrow_upper(X) :- - ( sup(X,Sup) - -> Bound is floor(Sup), - ( entailed(X < Bound) - -> {X =< Bound-1} - ; {X =< Bound} - ) - ; true - ). \ No newline at end of file diff --git a/GPL/clpqr/clpq/bv_q.pl b/GPL/clpqr/clpq/bv_q.pl deleted file mode 100644 index 83ef49235..000000000 --- a/GPL/clpqr/clpq/bv_q.pl +++ /dev/null @@ -1,1760 +0,0 @@ -/* - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(bv_q, - [ - allvars/2, - backsubst/3, - backsubst_delta/4, - basis_add/2, - dec_step/2, - deref/2, - deref_var/2, - detach_bounds/1, - detach_bounds_vlv/5, - determine_active_dec/1, - determine_active_inc/1, - dump_var/6, - dump_nz/5, - export_binding/1, - get_or_add_class/2, - inc_step/2, - intro_at/3, - iterate_dec/2, - lb/3, - pivot_a/4, - pivot/5, - rcbl_status/6, - reconsider/1, - same_class/2, - solve/1, - solve_ord_x/3, - ub/3, - unconstrained/4, - var_intern/2, - var_intern/3, - var_with_def_assign/2, - var_with_def_intern/4, - maximize/1, - minimize/1, - sup/2, - sup/4, - inf/2, - inf/4, - 'solve_<'/1, - 'solve_=<'/1, - 'solve_=\\='/1, - log_deref/4 - ]). -:- use_module(store_q, - [ - add_linear_11/3, - add_linear_f1/4, - add_linear_ff/5, - delete_factor/4, - indep/2, - isolate/3, - nf2sum/3, - nf_rhs_x/4, - nf_substitute/4, - normalize_scalar/2, - mult_hom/3, - mult_linear_factor/3 - ]). -:- use_module('../clpqr/class', - [ - class_allvars/2, - class_basis/2, - class_basis_add/3, - class_basis_drop/2, - class_basis_pivot/3, - class_new/5 - ]). -:- use_module(ineq_q, - [ - ineq/4 - ]). -:- use_module(nf_q, - [ - {}/1, - split/3, - wait_linear/3 - ]). -:- use_module(bb_q, - [ - vertex_value/2 - ]). -:- use_module(library(ordsets), - [ - ord_add_element/3 - ]). - -% For the rhs maint. the following events are important: -% -% -) introduction of an indep var at active bound B -% -) narrowing of active bound -% -) swap active bound -% -) pivot -% - -% a variables bound (L/U) can have the states: -% -% -) t_none no bounds -% -) t_l inactive lower bound -% -) t_u inactive upper bound -% -) t_L active lower bound -% -) t_U active upper bound -% -) t_lu inactive lower and upper bound -% -) t_Lu active lower bound and inactive upper bound -% -) t_lU inactive lower bound and active upper bound - -% ----------------------------------- deref ----------------------------------- -% - -% deref(Lin,Lind) -% -% Makes a linear equation of the form [v(I,[])|H] into a solvable linear -% equation. -% If the variables are new, they are initialized with the linear equation X=X. - -deref(Lin,Lind) :- - split(Lin,H,I), - normalize_scalar(I,Nonvar), - length(H,Len), - log_deref(Len,H,[],Restd), - add_linear_11(Nonvar,Restd,Lind). - -% log_deref(Len,[Vs|VsTail],VsTail,Res) -% -% Logarithmically converts a linear equation in normal form ([v(_,_)|_]) into a -% linear equation in solver form ([I,R,K*X|_]). Res contains the result, Len is -% the length of the part to convert and [Vs|VsTail] is a difference list -% containing the equation in normal form. - -log_deref(0,Vs,Vs,Lin) :- - !, - Lin = [0,0]. -log_deref(1,[v(K,[X^1])|Vs],Vs,Lin) :- - !, - deref_var(X,Lx), - mult_linear_factor(Lx,K,Lin). -log_deref(2,[v(Kx,[X^1]),v(Ky,[Y^1])|Vs],Vs,Lin) :- - !, - deref_var(X,Lx), - deref_var(Y,Ly), - add_linear_ff(Lx,Kx,Ly,Ky,Lin). -log_deref(N,V0,V2,Lin) :- - P is N >> 1, - Q is N - P, - log_deref(P,V0,V1,Lp), - log_deref(Q,V1,V2,Lq), - add_linear_11(Lp,Lq,Lin). - -% deref_var(X,Lin) -% -% Returns the equation of variable X. If X is a new variable, a new equation -% X = X is made. - -deref_var(X,Lin) :- - ( get_attr(X,itf,Att) - -> ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; arg(4,Att,lin(Lin)) - -> true - ; setarg(2,Att,type(t_none)), - setarg(3,Att,strictness(0)), - Lin = [0,0,l(X*1,Ord)], - setarg(4,Att,lin(Lin)), - setarg(5,Att,order(Ord)) - ) - ; Lin = [0,0,l(X*1,Ord)], - put_attr(X,itf,t(clpq,type(t_none),strictness(0), - lin(Lin),order(Ord),n,n,n,n,n,n)) - ). - -% TODO -% -% - -var_with_def_assign(Var,Lin) :- - Lin = [I,_|Hom], - ( Hom = [] - -> % X=k - Var = I - ; Hom = [l(V*K,_)|Cs] - -> ( Cs = [], - K =:= 1, - I =:= 0 - -> % X=Y - Var = V - ; % general case - var_with_def_intern(t_none,Var,Lin,0) - ) - ). - -% var_with_def_intern(Type,Var,Lin,Strictness) -% -% Makes Lin the linear equation of new variable Var, makes all variables of -% Lin, and Var of the same class and bounds Var by type(Type) and -% strictness(Strictness) - -var_with_def_intern(Type,Var,Lin,Strict) :- - put_attr(Var,itf,t(clpq,type(Type),strictness(Strict),lin(Lin), - order(_),n,n,n,n,n,n)), % check uses - Lin = [_,_|Hom], - get_or_add_class(Var,Class), - same_class(Hom,Class). - -% TODO -% -% - -var_intern(Type,Var,Strict) :- - put_attr(Var,itf,t(clpq,type(Type),strictness(Strict), - lin([0,0,l(Var*1,Ord)]),order(Ord),n,n,n,n,n,n)), - get_or_add_class(Var,_Class). - -% TODO -% -% - -var_intern(Var,Class) :- % for ordered/1 but otherwise free vars - get_attr(Var,itf,Att), - arg(2,Att,type(_)), - arg(4,Att,lin(_)), - !, - get_or_add_class(Var,Class). -var_intern(Var,Class) :- - put_attr(Var,itf,t(clpq,type(t_none),strictness(0), - lin([0,0,l(Var*1,Ord)]),order(Ord),n,n,n,n,n,n)), - get_or_add_class(Var,Class). - -% ----------------------------------------------------------------------------- - -% export_binding(Lst) -% -% Binds variables X to Y where Lst contains elements of the form [X-Y]. - -export_binding([]). -export_binding([X-Y|Gs]) :- - Y = X, - export_binding(Gs). - -% 'solve_='(Nf) -% -% Solves linear equation Nf = 0 where Nf is in normal form. - -'solve_='(Nf) :- - deref(Nf,Nfd), % dereferences and turns Nf into solvable form Nfd - solve(Nfd). - -% 'solve_=\\='(Nf) -% -% Solves linear inequality Nf =\= 0 where Nf is in normal form. - -'solve_=\\='(Nf) :- - deref(Nf,Lind), % dereferences and turns Nf into solvable form Lind - Lind = [Inhom,_|Hom], - ( Hom = [] - -> Inhom =\= 0 - ; % make new variable Nz = Lind - var_with_def_intern(t_none,Nz,Lind,0), - % make Nz nonzero - get_attr(Nz,itf,Att), - setarg(8,Att,nonzero) - ). - -% 'solve_<'(Nf) -% -% Solves linear inequality Nf < 0 where Nf is in normal form. - -'solve_<'(Nf) :- - split(Nf,H,I), - ineq(H,I,Nf,strict). - -% 'solve_=<'(Nf) -% -% Solves linear inequality Nf =< 0 where Nf is in normal form. - -'solve_=<'(Nf) :- - split(Nf,H,I), - ineq(H,I,Nf,nonstrict). - -maximize(Term) :- - minimize(-Term). - -% -% This is NOT coded as minimize(Expr) :- inf(Expr,Expr). -% -% because the new version of inf/2 only visits -% the vertex where the infimum is assumed and returns -% to the 'current' vertex via backtracking. -% The rationale behind this construction is to eliminate -% all garbage in the solver data structures produced by -% the pivots on the way to the extremal point caused by -% {inf,sup}/{2,4}. -% -% If we are after the infimum/supremum for minimizing/maximizing, -% this strategy may have adverse effects on performance because -% the simplex algorithm is forced to re-discover the -% extremal vertex through the equation {Inf =:= Expr}. -% -% Thus the extra code for {minimize,maximize}/1. -% -% In case someone comes up with an example where -% -% inf(Expr,Expr) -% -% outperforms the provided formulation for minimize - so be it. -% Both forms are available to the user. -% -minimize(Term) :- - wait_linear(Term,Nf,minimize_lin(Nf)). - -% minimize_lin(Lin) -% -% Minimizes the linear expression Lin. It does so by making a new -% variable Dep and minimizes its value. - -minimize_lin(Lin) :- - deref(Lin,Lind), - var_with_def_intern(t_none,Dep,Lind,0), - determine_active_dec(Lind), - iterate_dec(Dep,Inf), - { Dep =:= Inf }. - -sup(Expression,Sup) :- - sup(Expression,Sup,[],[]). - -sup(Expression,Sup,Vector,Vertex) :- - inf(-Expression,-Sup,Vector,Vertex). - -inf(Expression,Inf) :- - inf(Expression,Inf,[],[]). - -inf(Expression,Inf,Vector,Vertex) :- - % wait until Expression becomes linear, Nf contains linear Expression - % in normal form - wait_linear(Expression,Nf,inf_lin(Nf,Inf,Vector,Vertex)). - -inf_lin(Lin,_,Vector,_) :- - deref(Lin,Lind), - var_with_def_intern(t_none,Dep,Lind,0), % make new variable Dep = Lind - determine_active_dec(Lind), % minimizes Lind - iterate_dec(Dep,Inf), - vertex_value(Vector,Values), - nb_setval(inf,[Inf|Values]), - fail. -inf_lin(_,Infimum,_,Vertex) :- - catch(nb_getval(inf,L),_,fail), - nb_delete(inf), - assign([Infimum|Vertex],L). - -% assign(L1,L2) -% -% The elements of L1 are pairwise assigned to the elements of L2 -% by means of asserting {X =:= Y} where X is an element of L1 and Y -% is the corresponding element of L2. - -assign([],[]). -assign([X|Xs],[Y|Ys]) :- - {X =:= Y}, % more defensive/expressive than X=Y - assign(Xs,Ys). - -% --------------------------------- optimization ------------------------------ -% -% The _sn(S) =< 0 row might be temporarily infeasible. -% We use reconsider/1 to fix this. -% -% s(S) e [_,0] = d +xi ... -xj, Rhs > 0 so we want to decrease s(S) -% -% positive xi would have to be moved towards their lower bound, -% negative xj would have to be moved towards their upper bound, -% -% the row s(S) does not limit the lower bound of xi -% the row s(S) does not limit the upper bound of xj -% -% a) if some other row R is limiting xk, we pivot(R,xk), -% s(S) will decrease and get more feasible until (b) -% b) if there is no limiting row for some xi: we pivot(s(S),xi) -% xj: we pivot(s(S),xj) -% which cures the infeasibility in one step -% - - -% iterate_dec(OptVar,Opt) -% -% Decreases the bound on the variables of the linear equation of OptVar as much -% as possible and returns the resulting optimal bound in Opt. Fails if for some -% variable, a status of unlimited is found. - -iterate_dec(OptVar,Opt) :- - get_attr(OptVar,itf,Att), - arg(4,Att,lin([I,R|H])), - dec_step(H,Status), - ( Status = applied - -> iterate_dec(OptVar,Opt) - ; Status = optimum, - Opt is R + I - ). - -% iterate_inc(OptVar,Opt) -% -% Increases the bound on the variables of the linear equation of OptVar as much -% as possible and returns the resulting optimal bound in Opt. Fails if for some -% variable, a status of unlimited is found. - -iterate_inc(OptVar,Opt) :- - get_attr(OptVar,itf,Att), - arg(4,Att,lin([I,R|H])), - inc_step(H,Status), - ( Status = applied - -> iterate_inc(OptVar,Opt) - ; Status = optimum, - Opt is R + I - ). - -% -% Status = {optimum,unlimited(Indep,DepT),applied} -% If Status = optimum, the tables have not been changed at all. -% Searches left to right, does not try to find the 'best' pivot -% Therefore we might discover unboundedness only after a few pivots -% - - -dec_step_cont([],optimum,Cont,Cont). -dec_step_cont([l(V*K,OrdV)|Vs],Status,ContIn,ContOut) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( dec_step_2_cont(W,l(V*K,OrdV),Class,Status,ContIn,ContOut) - -> true - ; dec_step_cont(Vs,Status,ContIn,ContOut) - ). - -inc_step_cont([],optimum,Cont,Cont). -inc_step_cont([l(V*K,OrdV)|Vs],Status,ContIn,ContOut) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( inc_step_2_cont(W,l(V*K,OrdV),Class,Status,ContIn,ContOut) - -> true - ; inc_step_cont(Vs,Status,ContIn,ContOut) - ). - -dec_step_2_cont(t_U(U),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K > 0, - ( lb(Class,OrdV,Vub-Vb-_) - -> % found a lower bound - Status = applied, - pivot_a(Vub,V,Vb,t_u(U)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_u(U)), - ContIn = ContOut - ). -dec_step_2_cont(t_lU(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K > 0, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -dec_step_2_cont(t_L(L),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K < 0, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_l(L)), - ContIn = ContOut - ). -dec_step_2_cont(t_Lu(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K < 0, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -dec_step_2_cont(t_none,l(V*_,_),_,unlimited(V,t_none),Cont,Cont). - - - -inc_step_2_cont(t_U(U),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K < 0, - ( lb(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_u(U)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_u(U)), - ContIn = ContOut - ). -inc_step_2_cont(t_lU(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K < 0, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -inc_step_2_cont(t_L(L),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K > 0, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_l(L)), - ContIn = ContOut - ). -inc_step_2_cont(t_Lu(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K > 0, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -inc_step_2_cont(t_none,l(V*_,_),_,unlimited(V,t_none),Cont,Cont). - -replace_in_cont([],_,_,[]). -replace_in_cont([H1|T1],X,Y,[H2|T2]) :- - ( H1 == X - -> H2 = Y, - T1 = T2 - ; H2 = H1, - replace_in_cont(T1,X,Y,T2) - ). - -dec_step([],optimum). -dec_step([l(V*K,OrdV)|Vs],Status) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( dec_step_2(W,l(V*K,OrdV),Class,Status) - -> true - ; dec_step(Vs,Status) - ). - -dec_step_2(t_U(U),l(V*K,OrdV),Class,Status) :- - K > 0, - ( lb(Class,OrdV,Vub-Vb-_) - -> % found a lower bound - Status = applied, - pivot_a(Vub,V,Vb,t_u(U)) - ; Status = unlimited(V,t_u(U)) - ). -dec_step_2(t_lU(L,U),l(V*K,OrdV),Class,applied) :- - K > 0, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -dec_step_2(t_L(L),l(V*K,OrdV),Class,Status) :- - K < 0, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)) - ; Status = unlimited(V,t_l(L)) - ). -dec_step_2(t_Lu(L,U),l(V*K,OrdV),Class,applied) :- - K < 0, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -dec_step_2(t_none,l(V*_,_),_,unlimited(V,t_none)). - -inc_step([],optimum). % if status has not been set yet: no changes -inc_step([l(V*K,OrdV)|Vs],Status) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( inc_step_2(W,l(V*K,OrdV),Class,Status) - -> true - ; inc_step(Vs,Status) - ). - -inc_step_2(t_U(U),l(V*K,OrdV),Class,Status) :- - K < 0, - ( lb(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_u(U)) - ; Status = unlimited(V,t_u(U)) - ). -inc_step_2(t_lU(L,U),l(V*K,OrdV),Class,applied) :- - K < 0, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -inc_step_2(t_L(L),l(V*K,OrdV),Class,Status) :- - K > 0, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)) - ; Status = unlimited(V,t_l(L)) - ). -inc_step_2(t_Lu(L,U),l(V*K,OrdV),Class,applied) :- - K > 0, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -inc_step_2(t_none,l(V*_,_),_,unlimited(V,t_none)). - -% ------------------------- find the most constraining row -------------------- -% -% The code for the lower and the upper bound are dual versions of each other. -% The only difference is in the orientation of the comparisons. -% Indeps are ruled out by their types. -% If there is no bound, this fails. -% -% *** The actual lb and ub on an indep variable X are [lu]b + b(X), where b(X) -% is the value of the active bound. -% -% Nota bene: We must NOT consider infeasible rows as candidates to -% leave the basis! -% -% ub(Class,OrdX,Ub) -% -% See lb/3: this is similar - -ub(Class,OrdX,Ub) :- - class_basis(Class,Deps), - ub_first(Deps,OrdX,Ub). - -% ub_first(Deps,X,Dep-W-Ub) -% -% Finds the tightest upperbound for variable X from the linear equations of -% basis variables Deps, and puts the resulting bound in Ub. Dep is the basis -% variable that generates the bound, and W is bound of that variable that has -% to be activated to achieve this. - -ub_first([Dep|Deps],OrdX,Tightest) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - ub_inner(Type,OrdX,Lin,W,Ub), - Ub >= 0 - -> ub(Deps,OrdX,Dep-W-Ub,Tightest) - ; ub_first(Deps,OrdX,Tightest) - ). - -% ub(Deps,OrdX,TightestIn,TightestOut) -% -% See lb/4: this is similar - -ub([],_,T0,T0). -ub([Dep|Deps],OrdX,T0,T1) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - ub_inner(Type,OrdX,Lin,W,Ub), - T0 = _-Ubb, - Ub < Ubb, - Ub >= 0 - -> ub(Deps,OrdX,Dep-W-Ub,T1) % tighter bound, use new bound - ; ub(Deps,OrdX,T0,T1) % no tighter bound, keep current one - ). - -% ub_inner(Type,OrdX,Lin,W,Ub) -% -% See lb_inner/5: this is similar - -ub_inner(t_l(L),OrdX,Lin,t_L(L),Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - K < 0, - Ub is (L - Rhs) rdiv K. -ub_inner(t_u(U),OrdX,Lin,t_U(U),Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - K > 0, - Ub is (U - Rhs) rdiv K. -ub_inner(t_lu(L,U),OrdX,Lin,W,Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - ( K < 0 % use lowerbound - -> W = t_Lu(L,U), - Ub = (L - Rhs) rdiv K - ; K > 0 % use upperbound - -> W = t_lU(L,U), - Ub = (U - Rhs) rdiv K - ). - -% lb(Class,OrdX,Lb) -% -% Returns in Lb how much we can lower the upperbound of X without violating -% a bound of the basisvariables. -% Lb has the form Dep-W-Lb with Dep the variable whose bound is violated when -% lowering the bound for X more, W the actual bound that has to be activated -% and Lb the amount that the upperbound can be lowered. -% X has ordering OrdX and class Class. - -lb(Class,OrdX,Lb) :- - class_basis(Class,Deps), - lb_first(Deps,OrdX,Lb). - -% lb_first(Deps,OrdX,Tightest) -% -% Returns in Tightest how much we can lower the upperbound of X without -% violating a bound of Deps. -% Tightest has the form Dep-W-Lb with Dep the variable whose bound is violated -% when lowering the bound for X more, W the actual bound that has to be -% activated and Lb the amount that the upperbound can be lowered. X has -% ordering attribute OrdX. - -lb_first([Dep|Deps],OrdX,Tightest) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - lb_inner(Type,OrdX,Lin,W,Lb), - Lb =< 0 % Lb > 0 means a violated bound - -> lb(Deps,OrdX,Dep-W-Lb,Tightest) - ; lb_first(Deps,OrdX,Tightest) - ). - -% lb(Deps,OrdX,TightestIn,TightestOut) -% -% See lb_first/3: this one does the same thing, but is used for the steps after -% the first one and remembers the tightest bound so far. - -lb([],_,T0,T0). -lb([Dep|Deps],OrdX,T0,T1) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - lb_inner(Type,OrdX,Lin,W,Lb), - T0 = _-Lbb, - Lb > Lbb, % choose the least lowering, others might violate - % bounds - Lb =< 0 % violation of a bound (without lowering) - -> lb(Deps,OrdX,Dep-W-Lb,T1) - ; lb(Deps,OrdX,T0,T1) - ). - -% lb_inner(Type,X,Lin,W,Lb) -% -% Returns in Lb how much lower we can make X without violating a bound -% by using the linear equation Lin of basis variable B which has type -% Type and which has to activate a bound (type W) to do so. -% -% E.g. when B has a lowerbound L, then L should always be smaller than I + R. -% So a lowerbound of X (which has scalar K in Lin), could be at most -% (L-(I+R))/K lower than its upperbound (if K is positive). -% Also note that Lb should always be smaller than 0, otherwise the row is -% not feasible. -% X has ordering attribute OrdX. - -lb_inner(t_l(L),OrdX,Lin,t_L(L),Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), % if linear equation Lin contains the term - % X*K, Rhs is the right hand side of that - % equation - K > 0, - Lb is (L - Rhs) rdiv K. -lb_inner(t_u(U),OrdX,Lin,t_U(U),Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - K < 0, % K < 0 - Lb is (U - Rhs) rdiv K. -lb_inner(t_lu(L,U),OrdX,Lin,W,Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - ( K < 0 - -> W = t_lU(L,U), - Lb is (U - Rhs) rdiv K - ; K > 0 - -> W = t_Lu(L,U), - Lb is (L - Rhs) rdiv K - ). - -% ---------------------------------- equations -------------------------------- -% -% backsubstitution will not make the system infeasible, if the bounds on the -% indep vars are obeyed, but some implied values might pop up in rows where X -% occurs -% -) special case X=Y during bs -> get rid of dependend var(s), alias -% - -solve(Lin) :- - Lin = [I,_|H], - solve(H,Lin,I,Bindings,[]), - export_binding(Bindings). - -% solve(Hom,Lin,I,Bind,BindT) -% -% Solves a linear equation Lin = [I,_|H] = 0 and exports the generated bindings - -solve([],_,I,Bind0,Bind0) :- - !, - I =:= 0. -solve(H,Lin,_,Bind0,BindT) :- - sd(H,[],ClassesUniq,9-9-0,Category-Selected-_,NV,NVT), - get_attr(Selected,itf,Att), - arg(5,Att,order(Ord)), - isolate(Ord,Lin,Lin1), % Lin = 0 => Selected = Lin1 - ( Category = 1 % classless variable, no bounds - -> setarg(4,Att,lin(Lin1)), - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,Selected,Inhom,Bind0,BindT), - eq_classes(NV,NVT,ClassesUniq) - ; Category = 2 % class variable, no bounds - -> arg(6,Att,class(NewC)), - class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,Ord,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,Ord,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq) - ; Category = 3 % classless variable, all variables in Lin and - % Selected are bounded - -> arg(2,Att,type(Type)), - setarg(4,Att,lin(Lin1)), - deactivate_bound(Type,Selected), - eq_classes(NV,NVT,ClassesUniq), - basis_add(Selected,Basis), - undet_active(Lin1), % we can't tell which bound will likely be a - % problem at this point - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,Selected,Inhom,Bind0,Bind1), % only if - % Hom = [] - rcbl(Basis,Bind1,BindT) % reconsider entire basis - ; Category = 4 % class variable, all variables in Lin and Selected - % are bounded - -> arg(2,Att,type(Type)), - arg(6,Att,class(NewC)), - class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,Ord,Lin1,Bind0,Bind1) - ; Bind0 = Bind1, - bs(Deps,Ord,Lin1) - ), - deactivate_bound(Type,Selected), - basis_add(Selected,Basis), - % eq_classes( NV, NVT, ClassesUniq), - % 4 -> var(NV) - equate(ClassesUniq,_), - undet_active(Lin1), - rcbl(Basis,Bind1,BindT) - ). - -% -% Much like solve, but we solve for a particular variable of type t_none -% - -% solve_x(H,Lin,I,X,[Bind|BindT],BindT) -% -% - -solve_x(Lin,X) :- - Lin = [I,_|H], - solve_x(H,Lin,I,X,Bindings,[]), - export_binding(Bindings). - -solve_x([],_,I,_,Bind0,Bind0) :- - !, - I =:= 0. -solve_x(H,Lin,_,X,Bind0,BindT) :- - sd(H,[],ClassesUniq,9-9-0,_,NV,NVT), - get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - isolate(OrdX,Lin,Lin1), - ( arg(6,Att,class(NewC)) - -> class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,OrdX,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,OrdX,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq) - ; setarg(4,Att,lin(Lin1)), - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,X,Inhom,Bind0,BindT), - eq_classes(NV,NVT,ClassesUniq) - ). - -% solve_ord_x(Lin,OrdX,ClassX) -% -% Does the same thing as solve_x/2, but has the ordering of X and its class as -% input. This also means that X has a class which is not sure in solve_x/2. - -solve_ord_x(Lin,OrdX,ClassX) :- - Lin = [I,_|H], - solve_ord_x(H,Lin,I,OrdX,ClassX,Bindings,[]), - export_binding(Bindings). - -solve_ord_x([],_,I,_,_,Bind0,Bind0) :- - I =:= 0. -solve_ord_x([_|_],Lin,_,OrdX,ClassX,Bind0,BindT) :- - isolate(OrdX,Lin,Lin1), - Lin1 = [_,_|H1], - sd(H1,[],ClassesUniq1,9-9-0,_,NV,NVT), % do sd on Lin without X, then - % add class of X - ord_add_element(ClassesUniq1,ClassX,ClassesUniq), - class_allvars(ClassX,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,OrdX,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,OrdX,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq). - -% sd(H,[],ClassesUniq,9-9-0,Category-Selected-_,NV,NVT) - -% sd(Hom,ClassesIn,ClassesOut,PreferenceIn,PreferenceOut,[NV|NVTail],NVTail) -% -% ClassesOut is a sorted list of the different classes that are either in -% ClassesIn or that are the classes of the variables in Hom. Variables that do -% not belong to a class yet, are put in the difference list NV. - -sd([],Class0,Class0,Preference0,Preference0,NV0,NV0). -sd([l(X*K,_)|Xs],Class0,ClassN,Preference0,PreferenceN,NV0,NVt) :- - get_attr(X,itf,Att), - ( arg(6,Att,class(Xc)) % old: has class - -> NV0 = NV1, - ord_add_element(Class0,Xc,Class1), - ( arg(2,Att,type(t_none)) - -> preference(Preference0,2-X-K,Preference1) - % has class, no bounds => category 2 - ; preference(Preference0,4-X-K,Preference1) - % has class, is bounded => category 4 - ) - ; % new: has no class - Class1 = Class0, - NV0 = [X|NV1], % X has no class yet, add to list of new variables - ( arg(2,Att,type(t_none)) - -> preference(Preference0,1-X-K,Preference1) - % no class, no bounds => category 1 - ; preference(Preference0,3-X-K,Preference1) - % no class, is bounded => category 3 - ) - ), - sd(Xs,Class1,ClassN,Preference1,PreferenceN,NV1,NVt). - -% -% A is best sofar, B is current -% smallest prefered -preference(A,B,Pref) :- - A = Px-_-_, - B = Py-_-_, - ( Px < Py - -> Pref = A - ; Pref = B - ). - -% eq_classes(NV,NVTail,Cs) -% -% Attaches all classless variables NV to a new class and equates all other -% classes with this class. The equate operation only happens after attach_class -% because the unification of classes can bind the tail of the AllVars attribute -% to a nonvar and then the attach_class operation wouldn't work. - -eq_classes(NV,_,Cs) :- - var(NV), - !, - equate(Cs,_). -eq_classes(NV,NVT,Cs) :- - class_new(Su,clpq,NV,NVT,[]), % make a new class Su with NV as the variables - attach_class(NV,Su), % attach the variables NV to Su - equate(Cs,Su). - -equate([],_). -equate([X|Xs],X) :- equate(Xs,X). - -% -% assert: none of the Vars has a class attribute yet -% -attach_class(Xs,_) :- - var(Xs), % Tail - !. -attach_class([X|Xs],Class) :- - get_attr(X,itf,Att), - setarg(6,Att,class(Class)), - attach_class(Xs,Class). - -% unconstrained(Lin,Uc,Kuc,Rest) -% -% Finds an unconstrained variable Uc (type(t_none)) in Lin with scalar Kuc and -% removes it from Lin to return Rest. - -unconstrained(Lin,Uc,Kuc,Rest) :- - Lin = [_,_|H], - sd(H,[],_,9-9-0,Category-Uc-_,_,_), - Category =< 2, - get_attr(Uc,itf,Att), - arg(5,Att,order(OrdUc)), - delete_factor(OrdUc,Lin,Rest,Kuc). - -% -% point the vars in Lin into the same equivalence class -% maybe join some global data -% -same_class([],_). -same_class([l(X*_,_)|Xs],Class) :- - get_or_add_class(X,Class), - same_class(Xs,Class). - -% get_or_add_class(X,Class) -% -% Returns in Class the class of X if X has one, or a new class where X now -% belongs to if X didn't have one. - -get_or_add_class(X,Class) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - ( arg(6,Att,class(ClassX)) - -> ClassX = Class - ; setarg(6,Att,class(Class)), - class_new(Class,CLP,[X|Tail],Tail,[]) - ). - -% allvars(X,Allvars) -% -% Allvars is a list of all variables in the class to which X belongs. - -allvars(X,Allvars) :- - get_attr(X,itf,Att), - arg(6,Att,class(C)), - class_allvars(C,Allvars). - -% deactivate_bound(Type,Variable) -% -% The Type of the variable is changed to reflect the deactivation of its -% bounds. -% t_L(_) becomes t_l(_), t_lU(_,_) becomes t_lu(_,_) and so on. - -deactivate_bound(t_l(_),_). -deactivate_bound(t_u(_),_). -deactivate_bound(t_lu(_,_),_). -deactivate_bound(t_L(L),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(L))). -deactivate_bound(t_Lu(L,U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). -deactivate_bound(t_U(U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(U))). -deactivate_bound(t_lU(L,U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% intro_at(X,Value,Type) -% -% Variable X gets new type Type which reflects the activation of a bound with -% value Value. In the linear equations of all the variables belonging to the -% same class as X, X is substituted by [0,Value,X] to reflect the new active -% bound. - -intro_at(X,Value,Type) :- - get_attr(X,itf,Att), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - setarg(2,Att,type(Type)), - ( Value =:= 0 - -> true - ; backsubst_delta(Class,Ord,X,Value) - ). - -% undet_active(Lin) -% -% For each variable in the homogene part of Lin, a bound is activated -% if an inactive bound exists. (t_l(L) becomes t_L(L) and so on) - -undet_active([_,_|H]) :- - undet_active_h(H). - -% undet_active_h(Hom) -% -% For each variable in homogene part Hom, a bound is activated if an -% inactive bound exists (t_l(L) becomes t_L(L) and so on) - -undet_active_h([]). -undet_active_h([l(X*_,_)|Xs]) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - undet_active(Type,X), - undet_active_h(Xs). - -% undet_active(Type,Var) -% -% An inactive bound of Var is activated if such exists -% t_lu(L,U) is arbitrarily chosen to become t_Lu(L,U) - -undet_active(t_none,_). % type_activity -undet_active(t_L(_),_). -undet_active(t_Lu(_,_),_). -undet_active(t_U(_),_). -undet_active(t_lU(_,_),_). -undet_active(t_l(L),X) :- intro_at(X,L,t_L(L)). -undet_active(t_u(U),X) :- intro_at(X,U,t_U(U)). -undet_active(t_lu(L,U),X) :- intro_at(X,L,t_Lu(L,U)). - -% determine_active_dec(Lin) -% -% Activates inactive bounds on the variables of Lin if such bounds exist. -% If the type of a variable is t_none, this fails. This version is aimed -% to make the R component of Lin as small as possible in order not to violate -% an upperbound (see reconsider/1) - -determine_active_dec([_,_|H]) :- - determine_active(H,-1). - -% determine_active_inc(Lin) -% -% Activates inactive bounds on the variables of Lin if such bounds exist. -% If the type of a variable is t_none, this fails. This version is aimed -% to make the R component of Lin as large as possible in order not to violate -% a lowerbound (see reconsider/1) - -determine_active_inc([_,_|H]) :- - determine_active(H,1). - -% determine_active(Hom,S) -% -% For each variable in Hom, activates its bound if it is not yet activated. -% For the case of t_lu(_,_) the lower or upper bound is activated depending on -% K and S: -% If sign of K*S is negative, then lowerbound, otherwise upperbound. - -determine_active([],_). -determine_active([l(X*K,_)|Xs],S) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - determine_active(Type,X,K,S), - determine_active(Xs,S). - -determine_active(t_L(_),_,_,_). -determine_active(t_Lu(_,_),_,_,_). -determine_active(t_U(_),_,_,_). -determine_active(t_lU(_,_),_,_,_). -determine_active(t_l(L),X,_,_) :- intro_at(X,L,t_L(L)). -determine_active(t_u(U),X,_,_) :- intro_at(X,U,t_U(U)). -determine_active(t_lu(L,U),X,K,S) :- - KS is K*S, - ( KS < 0 - -> intro_at(X,L,t_Lu(L,U)) - ; KS > 0 - -> intro_at(X,U,t_lU(L,U)) - ). - -% -% Careful when an indep turns into t_none !!! -% - -detach_bounds(V) :- - get_attr(V,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - arg(5,Att,order(OrdV)), - arg(6,Att,class(Class)), - setarg(2,Att,type(t_none)), - setarg(3,Att,strictness(0)), - ( indep(Lin,OrdV) - -> ( ub(Class,OrdV,Vub-Vb-_) - -> % exchange against thightest - class_basis_drop(Class,Vub), - pivot(Vub,Class,OrdV,Vb,Type) - ; lb(Class,OrdV,Vlb-Vb-_) - -> class_basis_drop(Class,Vlb), - pivot(Vlb,Class,OrdV,Vb,Type) - ; true - ) - ; class_basis_drop(Class,V) - ). - -detach_bounds_vlv(OrdV,Lin,Class,Var,NewLin) :- - ( indep(Lin,OrdV) - -> Lin = [_,R|_], - ( ub(Class,OrdV,Vub-Vb-_) - -> % in verify_lin, class might contain two occurrences of Var, - % but it doesn't matter which one we delete - class_basis_drop(Class,Var), - pivot_vlv(Vub,Class,OrdV,Vb,R,NewLin) - ; lb(Class,OrdV,Vlb-Vb-_) - -> class_basis_drop(Class,Var), - pivot_vlv(Vlb,Class,OrdV,Vb,R,NewLin) - ; NewLin = Lin - ) - ; NewLin = Lin, - class_basis_drop(Class,Var) - ). - -% ----------------------------- manipulate the basis -------------------------- - -% basis_drop(X) -% -% Removes X from the basis of the class to which X belongs. - -basis_drop(X) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis_drop(Cv,X). - -% basis(X,Basis) -% -% Basis is the basis of the class to which X belongs. - -basis(X,Basis) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis(Cv,Basis). - -% basis_add(X,NewBasis) -% -% NewBasis is the result of adding X to the basis of the class to which X -% belongs. - -basis_add(X,NewBasis) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis_add(Cv,X,NewBasis). - -% basis_pivot(Leave,Enter) -% -% Removes Leave from the basis of the class to which it belongs, and adds -% Enter to that basis. - -basis_pivot(Leave,Enter) :- - get_attr(Leave,itf,Att), - arg(6,Att,class(Cv)), - class_basis_pivot(Cv,Enter,Leave). - -% ----------------------------------- pivot ----------------------------------- - -% pivot(Dep,Indep) -% -% The linear equation of variable Dep, is transformed into one of variable -% Indep, containing Dep. Then, all occurrences of Indep in linear equations are -% substituted by this new definition - -% -% Pivot ignoring rhs and active states -% - -pivot(Dep,Indep) :- - get_attr(Dep,itf,AttD), - arg(4,AttD,lin(H)), - arg(5,AttD,order(OrdDep)), - get_attr(Indep,itf,AttI), - arg(5,AttI,order(Ord)), - arg(5,AttI,class(Class)), - delete_factor(Ord,H,H0,Coeff), - K is -1 rdiv Coeff, - add_linear_ff(H0,K,[0,0,l(Dep* -1,OrdDep)],K,Lin), - backsubst(Class,Ord,Lin). - -% pivot_a(Dep,Indep,IndepT,DepT) -% -% Removes Dep from the basis, puts Indep in, and pivots the equation of -% Dep to become one of Indep. The type of Dep becomes DepT (which means -% it gets deactivated), the type of Indep becomes IndepT (which means it -% gets activated) - - -pivot_a(Dep,Indep,Vb,Wd) :- - basis_pivot(Dep,Indep), - get_attr(Indep,itf,Att), - arg(2,Att,type(Type)), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - pivot(Dep,Class,Ord,Vb,Type), - get_attr(Indep,itf,Att2), %changed? - setarg(2,Att2,type(Wd)). - -pivot_b(Vub,V,Vb,Wd) :- - ( Vub == V - -> get_attr(V,itf,Att), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - setarg(2,Att,type(Vb)), - pivot_b_delta(Vb,Delta), % nonzero(Delta) - backsubst_delta(Class,Ord,V,Delta) - ; pivot_a(Vub,V,Vb,Wd) - ). - -pivot_b_delta(t_Lu(L,U),Delta) :- Delta is L-U. -pivot_b_delta(t_lU(L,U),Delta) :- Delta is U-L. - -% select_active_bound(Type,Bound) -% -% Returns the bound that is active in Type (if such exists, 0 otherwise) - -select_active_bound(t_L(L),L). -select_active_bound(t_Lu(L,_),L). -select_active_bound(t_U(U),U). -select_active_bound(t_lU(_,U),U). -select_active_bound(t_none,0). -% -% for project.pl -% -select_active_bound(t_l(_),0). -select_active_bound(t_u(_),0). -select_active_bound(t_lu(_,_),0). - - -% pivot(Dep,Class,IndepOrd,DepAct,IndAct) -% -% See pivot/2. -% In addition, variable Indep with ordering IndepOrd has an active bound IndAct - -% -% -% Pivot taking care of rhs and active states -% -pivot(Dep,Class,IndepOrd,DepAct,IndAct) :- - get_attr(Dep,itf,Att), - arg(4,Att,lin(H)), - arg(5,Att,order(DepOrd)), - setarg(2,Att,type(DepAct)), - select_active_bound(DepAct,AbvD), % New current value for Dep - select_active_bound(IndAct,AbvI), % Old current value of Indep - delete_factor(IndepOrd,H,H0,Coeff), % Dep = ... + Coeff*Indep + ... - AbvDm is -AbvD, - AbvIm is -AbvI, - add_linear_f1([0,AbvIm],Coeff,H0,H1), - K is -1 rdiv Coeff, - add_linear_ff(H1,K,[0,AbvDm,l(Dep* -1,DepOrd)],K,H2), - % Indep = -1/Coeff*... + 1/Coeff*Dep - add_linear_11(H2,[0,AbvIm],Lin), - backsubst(Class,IndepOrd,Lin). - -% Rewrite Dep = ... + Coeff*Indep + ... -% into Indep = ... + -1/Coeff*Dep + ... -% -% For backsubstitution, old current value of Indep must be removed from RHS -% New current value of Dep must be added to RHS -% For solving: old current value of Indep should be out of RHS - -pivot_vlv(Dep,Class,IndepOrd,DepAct,AbvI,Lin) :- - get_attr(Dep,itf,Att), - arg(4,Att,lin(H)), - arg(5,Att,order(DepOrd)), - setarg(2,Att,type(DepAct)), - select_active_bound(DepAct,AbvD), % New current value for Dep - delete_factor(IndepOrd,H,H0,Coeff), % Dep = ... + Coeff*Indep + ... - AbvDm is -AbvD, - AbvIm is -AbvI, - add_linear_f1([0,AbvIm],Coeff,H0,H1), - K is -1 rdiv Coeff, - add_linear_ff(H1,K,[0,AbvDm,l(Dep* -1,DepOrd)],K,Lin), - % Indep = -1/Coeff*... + 1/Coeff*Dep - add_linear_11(Lin,[0,AbvIm],SubstLin), - backsubst(Class,IndepOrd,SubstLin). - -% backsubst_delta(Class,OrdX,X,Delta) -% -% X with ordering attribute OrdX, is substituted in all linear equations of -% variables in the class Class, by linear equation [0,Delta,l(X*1,OrdX)]. This -% reflects the activation of a bound. - -backsubst_delta(Class,OrdX,X,Delta) :- - backsubst(Class,OrdX,[0,Delta,l(X*1,OrdX)]). - -% backsubst(Class,OrdX,Lin) -% -% X with ordering OrdX is substituted in all linear equations of variables in -% the class Class, by linear equation Lin - -backsubst(Class,OrdX,Lin) :- - class_allvars(Class,Allvars), - bs(Allvars,OrdX,Lin). - -% bs(Vars,OrdV,Lin) -% -% In all linear equations of the variables Vars, variable V with ordering -% attribute OrdV is substituted by linear equation Lin. -% -% valid if nothing will go ground -% - -bs(Xs,_,_) :- - var(Xs), - !. -bs([X|Xs],OrdV,Lin) :- - ( get_attr(X,itf,Att), - arg(4,Att,lin(LinX)), - nf_substitute(OrdV,Lin,LinX,LinX1) % does not change attributes - -> setarg(4,Att,lin(LinX1)), - bs(Xs,OrdV,Lin) - ; bs(Xs,OrdV,Lin) - ). - -% -% rank increasing backsubstitution -% - -% bs_collect_bindings(Deps,SelectedOrd,Lin,Bind,BindT) -% -% Collects bindings (of the form [X-I] where X = I is the binding) by -% substituting Selected in all linear equations of the variables Deps (which -% are of the same class), by Lin. Selected has ordering attribute SelectedOrd. -% -% E.g. when V = 2X + 3Y + 4, X = 3V + 2Z and Y = 4X + 3 -% we can substitute V in the linear equation of X: X = 6X + 9Y + 2Z + 12 -% we can't substitute V in the linear equation of Y of course. - -bs_collect_bindings(Xs,_,_,Bind0,BindT) :- - var(Xs), - !, - Bind0 = BindT. -bs_collect_bindings([X|Xs],OrdV,Lin,Bind0,BindT) :- - ( get_attr(X,itf,Att), - arg(4,Att,lin(LinX)), - nf_substitute(OrdV,Lin,LinX,LinX1) % does not change attributes - -> setarg(4,Att,lin(LinX1)), - LinX1 = [Inhom,_|Hom], - bs_collect_binding(Hom,X,Inhom,Bind0,Bind1), - bs_collect_bindings(Xs,OrdV,Lin,Bind1,BindT) - ; bs_collect_bindings(Xs,OrdV,Lin,Bind0,BindT) - ). - -% bs_collect_binding(Hom,Selected,Inhom,Bind,BindT) -% -% Collects binding following from Selected = Hom + Inhom. -% If Hom = [], returns the binding Selected-Inhom (=0) -% -bs_collect_binding([],X,Inhom) --> [X-Inhom]. -bs_collect_binding([_|_],_,_) --> []. - -% -% reconsider the basis -% - -% rcbl(Basis,Bind,BindT) -% -% - -rcbl([],Bind0,Bind0). -rcbl([X|Continuation],Bind0,BindT) :- - ( rcb_cont(X,Status,Violated,Continuation,NewContinuation) % have a culprit - -> rcbl_status(Status,X,NewContinuation,Bind0,BindT,Violated) - ; rcbl(Continuation,Bind0,BindT) - ). - -rcb_cont(X,Status,Violated,ContIn,ContOut) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin([I,R|H])), - ( Type = t_l(L) % case 1: lowerbound: R + I should always be larger - % than the lowerbound - -> R + I =< L, - Violated = l(L), - inc_step_cont(H,Status,ContIn,ContOut) - ; Type = t_u(U) % case 2: upperbound: R + I should always be smaller - % than the upperbound - -> R + I >= U, - Violated = u(U), - dec_step_cont(H,Status,ContIn,ContOut) - ; Type = t_lu(L,U) % case 3: check both - -> At is R + I, - ( At =< L - -> Violated = l(L), - inc_step_cont(H,Status,ContIn,ContOut) - ; At >= U - -> Violated = u(U), - dec_step_cont(H,Status,ContIn,ContOut) - ) - ). % other types imply nonbasic variable or unbounded variable - - - -% -% reconsider one element of the basis -% later: lift the binds -% -reconsider(X) :- - rcb(X,Status,Violated), - !, - rcbl_status(Status,X,[],Binds,[],Violated), - export_binding(Binds). -reconsider(_). - -% -% Find a basis variable out of its bound or at its bound -% Try to move it into whithin its bound -% a) impossible -> fail -% b) optimum at the bound -> implied value -% c) else look at the remaining basis variables -% -% -% Idea: consider a variable V with linear equation Lin. -% When a bound on a variable X of Lin gets activated, its value, multiplied -% with the scalar of X, is added to the R component of Lin. -% When we consider the lowerbound of V, it must be smaller than R + I, since R -% contains at best the lowerbounds of the variables in Lin (but could contain -% upperbounds, which are of course larger). So checking this can show the -% violation of a bound of V. A similar case works for the upperbound. - -rcb(X,Status,Violated) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin([I,R|H])), - ( Type = t_l(L) % case 1: lowerbound: R + I should always be larger - % than the lowerbound - -> R + I =< L, - Violated = l(L), - inc_step(H,Status) - ; Type = t_u(U) % case 2: upperbound: R + I should always be smaller - % than the upperbound - -> R + I >= U, - Violated = u(U), - dec_step(H,Status) - ; Type = t_lu(L,U) % case 3: check both - -> At is R + I, - ( At =< L - -> Violated = l(L), - inc_step(H,Status) - ; At >= U - -> Violated = u(U), - dec_step(H,Status) - ) - ). % other types imply nonbasic variable or unbounded variable - -% rcbl_status(Status,X,Continuation,[Bind|BindT],BindT,Violated) -% -% - -rcbl_status(optimum,X,Cont,B0,Bt,Violated) :- rcbl_opt(Violated,X,Cont,B0,Bt). -rcbl_status(applied,X,Cont,B0,Bt,Violated) :- rcbl_app(Violated,X,Cont,B0,Bt). -rcbl_status(unlimited(Indep,DepT),X,Cont,B0,Bt,Violated) :- - rcbl_unl(Violated,X,Cont,B0,Bt,Indep,DepT). - -% -% Might reach optimum immediately without changing the basis, -% but in general we must assume that there were pivots. -% If the optimum meets the bound, we backsubstitute the implied -% value, solve will call us again to check for further implied -% values or unsatisfiability in the rank increased system. -% -rcbl_opt(l(L),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Strict)), - arg(4,Att,lin(Lin)), - Lin = [I,R|_], - Opt is R + I, - ( L < Opt - -> narrow_u(Type,X,Opt), % { X =< Opt } - rcbl(Continuation,B0,B1) - ; L =:= Opt, - Strict /\ 2 =:= 0, % meets lower - Mop is -Opt, - normalize_scalar(Mop,MopN), - add_linear_11(MopN,Lin,Lin1), - Lin1 = [Inhom,_|Hom], - ( Hom = [] - -> rcbl(Continuation,B0,B1) % would not callback - ; solve(Hom,Lin1,Inhom,B0,B1) - ) - ). -rcbl_opt(u(U),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Strict)), - arg(4,Att,lin(Lin)), - Lin = [I,R|_], - Opt is R + I, - ( U > Opt - -> narrow_l(Type,X,Opt), % { X >= Opt } - rcbl(Continuation,B0,B1) - ; U =:= Opt, - Strict /\ 1 =:= 0, % meets upper - Mop is -Opt, - normalize_scalar(Mop,MopN), - add_linear_11(MopN,Lin,Lin1), - Lin1 = [Inhom,_|Hom], - ( Hom = [] - -> rcbl(Continuation,B0,B1) % would not callback - ; solve(Hom,Lin1,Inhom,B0,B1) - ) - ). - -% -% Basis has already changed when this is called -% -rcbl_app(l(L),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(4,Att,lin([I,R|H])), - ( R + I > L % within bound now - -> rcbl(Continuation,B0,B1) - ; inc_step(H,Status), - rcbl_status(Status,X,Continuation,B0,B1,l(L)) - ). -rcbl_app(u(U),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(4,Att,lin([I,R|H])), - ( R + I < U % within bound now - -> rcbl(Continuation,B0,B1) - ; dec_step(H,Status), - rcbl_status(Status,X,Continuation,B0,B1,u(U)) - ). -% -% This is never called for a t_lu culprit -% -rcbl_unl(l(L),X,Continuation,B0,B1,Indep,DepT) :- - pivot_a(X,Indep,t_L(L),DepT), % changes the basis - rcbl(Continuation,B0,B1). -rcbl_unl(u(U),X,Continuation,B0,B1,Indep,DepT) :- - pivot_a(X,Indep,t_U(U),DepT), % changes the basis - rcbl(Continuation,B0,B1). - -% narrow_u(Type,X,U) -% -% Narrows down the upperbound of X (type Type) to U. -% Fails if Type is not t_u(_) or t_lu(_) - -narrow_u(t_u(_),X,U) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(U))). -narrow_u(t_lu(L,_),X,U) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% narrow_l(Type,X,L) -% -% Narrows down the lowerbound of X (type Type) to L. -% Fails if Type is not t_l(_) or t_lu(_) - -narrow_l( t_l(_), X, L) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(L))). - -narrow_l( t_lu(_,U), X, L) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% ----------------------------------- dump ------------------------------------ - -% dump_var(Type,Var,I,H,Dump,DumpTail) -% -% Returns in Dump a representation of the linear constraint on variable -% Var which has linear equation H + I and has type Type. - -dump_var(t_none,V,I,H) --> - !, - ( { - H = [l(W*K,_)], - V == W, - I =:= 0, - K =:= 1 - } - -> % indep var - [] - ; {nf2sum(H,I,Sum)}, - [V = Sum] - ). -dump_var(t_L(L),V,I,H) --> - !, - dump_var(t_l(L),V,I,H). -% case lowerbound: V >= L or V > L -% say V >= L, and V = K*V1 + ... + I, then K*V1 + ... + I >= L -% and K*V1 + ... >= L-I and V1 + .../K = (L-I)/K -dump_var(t_l(L),V,I,H) --> - !, - { - H = [l(_*K,_)|_], % avoid 1 >= 0 - get_attr(V,itf,Att), - arg(3,Att,strictness(Strict)), - Sm is Strict /\ 2, - Kr is 1 rdiv K, - Li is Kr*(L - I), - mult_hom(H,Kr,H1), - nf2sum(H1,0,Sum), - ( K > 0 % K > 0 - -> dump_strict(Sm,Sum >= Li,Sum > Li,Result) - ; dump_strict(Sm,Sum =< Li,Sum < Li,Result) - ) - }, - [Result]. -dump_var(t_U(U),V,I,H) --> - !, - dump_var(t_u(U),V,I,H). -dump_var(t_u(U),V,I,H) --> - !, - { - H = [l(_*K,_)|_], % avoid 0 =< 1 - get_attr(V,itf,Att), - arg(3,Att,strictness(Strict)), - Sm is Strict /\ 1, - Kr is 1 rdiv K, - Ui is Kr*(U-I), - mult_hom(H,Kr,H1), - nf2sum(H1,0.0,Sum), - ( K > 0 - -> dump_strict(Sm,Sum =< Ui,Sum < Ui,Result) - ; dump_strict(Sm,Sum >= Ui,Sum > Ui,Result) - ) - }, - [Result]. -dump_var(t_Lu(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_u(U),V,I,H). -dump_var(t_lU(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_u(U),V,I,H). -dump_var(t_lu(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_U(U),V,I,H). -dump_var(T,V,I,H) --> % should not happen - [V:T:I+H]. - -% dump_strict(FilteredStrictness,Nonstrict,Strict,Res) -% -% Unifies Res with either Nonstrict or Strict depending on FilteredStrictness. -% FilteredStrictness is the component of strictness related to the bound: 0 -% means nonstrict, 1 means strict upperbound, 2 means strict lowerbound, -% 3 is filtered out to either 1 or 2. - -dump_strict(0,Result,_,Result). -dump_strict(1,_,Result,Result). -dump_strict(2,_,Result,Result). - -% dump_nz(V,H,I,Dump,DumpTail) -% -% Returns in Dump a representation of the nonzero constraint of variable V -% which has linear -% equation H + I. - -dump_nz(_,H,I) --> - { - H = [l(_*K,_)|_], - Kr is 1 rdiv K, - I1 is -Kr*I, - mult_hom(H,Kr,H1), - nf2sum(H1,0,Sum) - }, - [Sum =\= I1]. diff --git a/GPL/clpqr/clpq/fourmotz_q.pl b/GPL/clpqr/clpq/fourmotz_q.pl deleted file mode 100644 index 9ca21887c..000000000 --- a/GPL/clpqr/clpq/fourmotz_q.pl +++ /dev/null @@ -1,503 +0,0 @@ -/* $Id: fourmotz_q.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(fourmotz_q, - [ - fm_elim/3 - ]). -:- use_module(bv_q, - [ - allvars/2, - basis_add/2, - detach_bounds/1, - pivot/5, - var_with_def_intern/4 - ]). -:- use_module('../clpqr/class', - [ - class_allvars/2 - ]). -:- use_module('../clpqr/project', - [ - drop_dep/1, - drop_dep_one/1, - make_target_indep/2 - ]). -:- use_module('../clpqr/redund', - [ - redundancy_vars/1 - ]). -:- use_module(store_q, - [ - add_linear_11/3, - add_linear_f1/4, - indep/2, - nf_coeff_of/3, - normalize_scalar/2 - ]). - - - -fm_elim(Vs,Target,Pivots) :- - prefilter(Vs,Vsf), - fm_elim_int(Vsf,Target,Pivots). - -% prefilter(Vars,Res) -% -% filters out target variables and variables that do not occur in bounded linear equations. -% Stores that the variables in Res are to be kept independent. - -prefilter([],[]). -prefilter([V|Vs],Res) :- - ( get_attr(V,itf,Att), - arg(9,Att,n), - occurs(V) - -> % V is a nontarget variable that occurs in a bounded linear equation - Res = [V|Tail], - setarg(10,Att,keep_indep), - prefilter(Vs,Tail) - ; prefilter(Vs,Res) - ). - -% -% the target variables are marked with an attribute, and we get a list -% of them as an argument too -% -fm_elim_int([],_,Pivots) :- % done - unkeep(Pivots). -fm_elim_int(Vs,Target,Pivots) :- - Vs = [_|_], - ( best(Vs,Best,Rest) - -> occurences(Best,Occ), - elim_min(Best,Occ,Target,Pivots,NewPivots) - ; % give up - NewPivots = Pivots, - Rest = [] - ), - fm_elim_int(Rest,Target,NewPivots). - -% best(Vs,Best,Rest) -% -% Finds the variable with the best result (lowest Delta) in fm_cp_filter -% and returns the other variables in Rest. - -best(Vs,Best,Rest) :- - findall(Delta-N,fm_cp_filter(Vs,Delta,N),Deltas), - keysort(Deltas,[_-N|_]), - select_nth(Vs,N,Best,Rest). - -% fm_cp_filter(Vs,Delta,N) -% -% For an indepenent variable V in Vs, which is the N'th element in Vs, -% find how many inequalities are generated when this variable is eliminated. -% Note that target variables and variables that only occur in unbounded equations -% should have been removed from Vs via prefilter/2 - -fm_cp_filter(Vs,Delta,N) :- - length(Vs,Len), % Len = number of variables in Vs - mem(Vs,X,Vst), % Selects a variable X in Vs, Vst is the list of elements after X in Vs - get_attr(X,itf,Att), - arg(4,Att,lin(Lin)), - arg(5,Att,order(OrdX)), - arg(9,Att,n), % no target variable - indep(Lin,OrdX), % X is an independent variable - occurences(X,Occ), - Occ = [_|_], - cp_card(Occ,0,Lnew), - length(Occ,Locc), - Delta is Lnew-Locc, - length(Vst,Vstl), - N is Len-Vstl. % X is the Nth element in Vs - -% mem(Xs,X,XsT) -% -% If X is a member of Xs, XsT is the list of elements after X in Xs. - -mem([X|Xs],X,Xs). -mem([_|Ys],X,Xs) :- mem(Ys,X,Xs). - -% select_nth(List,N,Nth,Others) -% -% Selects the N th element of List, stores it in Nth and returns the rest of the list in Others. - -select_nth(List,N,Nth,Others) :- - select_nth(List,1,N,Nth,Others). - -select_nth([X|Xs],N,N,X,Xs) :- !. -select_nth([Y|Ys],M,N,X,[Y|Xs]) :- - M1 is M+1, - select_nth(Ys,M1,N,X,Xs). - -% -% fm_detach + reverse_pivot introduce indep t_none, which -% invalidates the invariants -% -elim_min(V,Occ,Target,Pivots,NewPivots) :- - crossproduct(Occ,New,[]), - activate_crossproduct(New), - reverse_pivot(Pivots), - fm_detach(Occ), - allvars(V,All), - redundancy_vars(All), % only for New \== [] - make_target_indep(Target,NewPivots), - drop_dep(All). - -% -% restore NF by reverse pivoting -% -reverse_pivot([]). -reverse_pivot([I:D|Ps]) :- - get_attr(D,itf,AttD), - arg(2,AttD,type(Dt)), - setarg(11,AttD,n), % no longer - get_attr(I,itf,AttI), - arg(2,AttI,type(It)), - arg(5,AttI,order(OrdI)), - arg(6,AttI,class(ClI)), - pivot(D,ClI,OrdI,Dt,It), - reverse_pivot(Ps). - -% unkeep(Pivots) -% -% - -unkeep([]). -unkeep([_:D|Ps]) :- - get_attr(D,itf,Att), - setarg(11,Att,n), - drop_dep_one(D), - unkeep(Ps). - - -% -% All we drop are bounds -% -fm_detach( []). -fm_detach([V:_|Vs]) :- - detach_bounds(V), - fm_detach(Vs). - -% activate_crossproduct(Lst) -% -% For each inequality Lin =< 0 (or Lin < 0) in Lst, a new variable is created: -% Var = Lin and Var =< 0 (or Var < 0). Var is added to the basis. - -activate_crossproduct([]). -activate_crossproduct([lez(Strict,Lin)|News]) :- - var_with_def_intern(t_u(0),Var,Lin,Strict), - % Var belongs to same class as elements in Lin - basis_add(Var,_), - activate_crossproduct(News). - -% ------------------------------------------------------------------------------ - -% crossproduct(Lst,Res,ResTail) -% -% See crossproduct/4 -% This predicate each time puts the next element of Lst as First in crossproduct/4 -% and lets the rest be Next. - -crossproduct([]) --> []. -crossproduct([A|As]) --> - crossproduct(As,A), - crossproduct(As). - -% crossproduct(Next,First,Res,ResTail) -% -% Eliminates a variable in linear equations First + Next and stores the generated -% inequalities in Res. -% Let's say A:K1 = First and B:K2 = first equation in Next. -% A = ... + K1*V + ... -% B = ... + K2*V + ... -% Let K = -K2/K1 -% then K*A + B = ... + 0*V + ... -% from the bounds of A and B, via cross_lower/7 and cross_upper/7, new inequalities -% are generated. Then the same is done for B:K2 = next element in Next. - -crossproduct([],_) --> []. -crossproduct([B:Kb|Bs],A:Ka) --> - { - get_attr(A,itf,AttA), - arg(2,AttA,type(Ta)), - arg(3,AttA,strictness(Sa)), - arg(4,AttA,lin(LinA)), - get_attr(B,itf,AttB), - arg(2,AttB,type(Tb)), - arg(3,AttB,strictness(Sb)), - arg(4,AttB,lin(LinB)), - K is -Kb rdiv Ka, - add_linear_f1(LinA,K,LinB,Lin) % Lin doesn't contain the target variable anymore - }, - ( { K > 0 } % K > 0: signs were opposite - -> { Strict is Sa \/ Sb }, - cross_lower(Ta,Tb,K,Lin,Strict), - cross_upper(Ta,Tb,K,Lin,Strict) - ; % La =< A =< Ua -> -Ua =< -A =< -La - { - flip(Ta,Taf), - flip_strict(Sa,Saf), - Strict is Saf \/ Sb - }, - cross_lower(Taf,Tb,K,Lin,Strict), - cross_upper(Taf,Tb,K,Lin,Strict) - ), - crossproduct(Bs,A:Ka). - -% cross_lower(Ta,Tb,K,Lin,Strict,Res,ResTail) -% -% Generates a constraint following from the bounds of A and B. -% When A = LinA and B = LinB then Lin = K*LinA + LinB. Ta is the type -% of A and Tb is the type of B. Strict is the union of the strictness -% of A and B. If K is negative, then Ta should have been flipped (flip/2). -% The idea is that if La =< A =< Ua and Lb =< B =< Ub (=< can also be <) -% then if K is positive, K*La + Lb =< K*A + B =< K*Ua + Ub. -% if K is negative, K*Ua + Lb =< K*A + B =< K*La + Ub. -% This predicate handles the first inequality and adds it to Res in the form -% lez(Sl,Lhs) meaning K*La + Lb - (K*A + B) =< 0 or K*Ua + Lb - (K*A + B) =< 0 -% with Sl being the strictness and Lhs the lefthandside of the equation. -% See also cross_upper/7 - -cross_lower(Ta,Tb,K,Lin,Strict) --> - { - lower(Ta,La), - lower(Tb,Lb), - !, - L is K*La+Lb, - normalize_scalar(L,Ln), - add_linear_f1(Lin,-1,Ln,Lhs), - Sl is Strict >> 1 % normalize to upper bound - }, - [ lez(Sl,Lhs) ]. -cross_lower(_,_,_,_,_) --> []. - -% cross_upper(Ta,Tb,K,Lin,Strict,Res,ResTail) -% -% See cross_lower/7 -% This predicate handles the second inequality: -% -(K*Ua + Ub) + K*A + B =< 0 or -(K*La + Ub) + K*A + B =< 0 - -cross_upper(Ta,Tb,K,Lin,Strict) --> - { - upper(Ta,Ua), - upper(Tb,Ub), - !, - U is -(K*Ua+Ub), - normalize_scalar(U,Un), - add_linear_11(Un,Lin,Lhs), - Su is Strict /\ 1 % normalize to upper bound - }, - [ lez(Su,Lhs) ]. -cross_upper(_,_,_,_,_) --> []. - -% lower(Type,Lowerbound) -% -% Returns the lowerbound of type Type if it has one. -% E.g. if type = t_l(L) then Lowerbound is L, -% if type = t_lU(L,U) then Lowerbound is L, -% if type = t_u(U) then fails - -lower(t_l(L),L). -lower(t_lu(L,_),L). -lower(t_L(L),L). -lower(t_Lu(L,_),L). -lower(t_lU(L,_),L). - -% upper(Type,Upperbound) -% -% Returns the upperbound of type Type if it has one. -% See lower/2 - -upper(t_u(U),U). -upper(t_lu(_,U),U). -upper(t_U(U),U). -upper(t_Lu(_,U),U). -upper(t_lU(_,U),U). - -% flip(Type,FlippedType) -% -% Flips the lower and upperbound, so the old lowerbound becomes the new upperbound and -% vice versa. - -flip(t_l(X),t_u(X)). -flip(t_u(X),t_l(X)). -flip(t_lu(X,Y),t_lu(Y,X)). -flip(t_L(X),t_u(X)). -flip(t_U(X),t_l(X)). -flip(t_lU(X,Y),t_lu(Y,X)). -flip(t_Lu(X,Y),t_lu(Y,X)). - -% flip_strict(Strict,FlippedStrict) -% -% Does what flip/2 does, but for the strictness. - -flip_strict(0,0). -flip_strict(1,2). -flip_strict(2,1). -flip_strict(3,3). - -% cp_card(Lst,CountIn,CountOut) -% -% Counts the number of bounds that may generate an inequality in -% crossproduct/3 - -cp_card([],Ci,Ci). -cp_card([A|As],Ci,Co) :- - cp_card(As,A,Ci,Cii), - cp_card(As,Cii,Co). - -% cp_card(Next,First,CountIn,CountOut) -% -% Counts the number of bounds that may generate an inequality in -% crossproduct/4. - -cp_card([],_,Ci,Ci). -cp_card([B:Kb|Bs],A:Ka,Ci,Co) :- - get_attr(A,itf,AttA), - arg(2,AttA,type(Ta)), - get_attr(B,itf,AttB), - arg(2,AttB,type(Tb)), - ( sign(Ka) =\= sign(Kb) - -> cp_card_lower(Ta,Tb,Ci,Cii), - cp_card_upper(Ta,Tb,Cii,Ciii) - ; flip(Ta,Taf), - cp_card_lower(Taf,Tb,Ci,Cii), - cp_card_upper(Taf,Tb,Cii,Ciii) - ), - cp_card(Bs,A:Ka,Ciii,Co). - -% cp_card_lower(TypeA,TypeB,SIn,SOut) -% -% SOut = SIn + 1 if both TypeA and TypeB have a lowerbound. - -cp_card_lower(Ta,Tb,Si,So) :- - lower(Ta,_), - lower(Tb,_), - !, - So is Si+1. -cp_card_lower(_,_,Si,Si). - -% cp_card_upper(TypeA,TypeB,SIn,SOut) -% -% SOut = SIn + 1 if both TypeA and TypeB have an upperbound. - -cp_card_upper(Ta,Tb,Si,So) :- - upper(Ta,_), - upper(Tb,_), - !, - So is Si+1. -cp_card_upper(_,_,Si,Si). - -% ------------------------------------------------------------------------------ - -% occurences(V,Occ) -% -% Returns in Occ the occurrences of variable V in the linear equations of dependent variables -% with bound =\= t_none in the form of D:K where D is a dependent variable and K is the scalar -% of V in the linear equation of D. - -occurences(V,Occ) :- - get_attr(V,itf,Att), - arg(5,Att,order(OrdV)), - arg(6,Att,class(C)), - class_allvars(C,All), - occurences(All,OrdV,Occ). - -% occurences(De,OrdV,Occ) -% -% Returns in Occ the occurrences of variable V with order OrdV in the linear equations of -% dependent variables De with bound =\= t_none in the form of D:K where D is a dependent -% variable and K is the scalar of V in the linear equation of D. - -occurences(De,_,[]) :- - var(De), - !. -occurences([D|De],OrdV,Occ) :- - ( get_attr(D,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - occ_type_filter(Type), - nf_coeff_of(Lin,OrdV,K) - -> Occ = [D:K|Occt], - occurences(De,OrdV,Occt) - ; occurences(De,OrdV,Occ) - ). - -% occ_type_filter(Type) -% -% Succeeds when Type is any other type than t_none. Is used in occurences/3 and occurs/2 - -occ_type_filter(t_l(_)). -occ_type_filter(t_u(_)). -occ_type_filter(t_lu(_,_)). -occ_type_filter(t_L(_)). -occ_type_filter(t_U(_)). -occ_type_filter(t_lU(_,_)). -occ_type_filter(t_Lu(_,_)). - -% occurs(V) -% -% Checks whether variable V occurs in a linear equation of a dependent variable with a bound -% =\= t_none. - -occurs(V) :- - get_attr(V,itf,Att), - arg(5,Att,order(OrdV)), - arg(6,Att,class(C)), - class_allvars(C,All), - occurs(All,OrdV). - -% occurs(De,OrdV) -% -% Checks whether variable V with order OrdV occurs in a linear equation of any dependent variable -% in De with a bound =\= t_none. - -occurs(De,_) :- - var(De), - !, - fail. -occurs([D|De],OrdV) :- - ( get_attr(D,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - occ_type_filter(Type), - nf_coeff_of(Lin,OrdV,_) - -> true - ; occurs(De,OrdV) - ). \ No newline at end of file diff --git a/GPL/clpqr/clpq/ineq_q.pl b/GPL/clpqr/clpq/ineq_q.pl deleted file mode 100644 index 29badf8b9..000000000 --- a/GPL/clpqr/clpq/ineq_q.pl +++ /dev/null @@ -1,1275 +0,0 @@ -/* $Id: ineq_q.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(ineq_q, - [ - ineq/4, - ineq_one/4, - ineq_one_n_n_0/1, - ineq_one_n_p_0/1, - ineq_one_s_n_0/1, - ineq_one_s_p_0/1 - ]). -:- use_module(bv_q, - [ - backsubst/3, - backsubst_delta/4, - basis_add/2, - dec_step/2, - deref/2, - determine_active_dec/1, - determine_active_inc/1, - export_binding/1, - get_or_add_class/2, - inc_step/2, - lb/3, - pivot_a/4, - rcbl_status/6, - reconsider/1, - same_class/2, - solve/1, - ub/3, - unconstrained/4, - var_intern/3, - var_with_def_intern/4 - ]). -:- use_module(store_q, - [ - add_linear_11/3, - add_linear_ff/5, - normalize_scalar/2 - ]). - -% ineq(H,I,Nf,Strictness) -% -% Solves the inequality Nf < 0 or Nf =< 0 where Nf is in normal form -% and H and I are the homogene and inhomogene parts of Nf. - -ineq([],I,_,Strictness) :- ineq_ground(Strictness,I). -ineq([v(K,[X^1])|Tail],I,Lin,Strictness) :- - ineq_cases(Tail,I,Lin,Strictness,X,K). - -ineq_cases([],I,_,Strictness,X,K) :- % K*X + I < 0 or K*X + I =< 0 - ineq_one(Strictness,X,K,I). -ineq_cases([_|_],_,Lin,Strictness,_,_) :- - deref(Lin,Lind), % Id+Hd =< 0 - Lind = [Inhom,_|Hom], - ineq_more(Hom,Inhom,Lind,Strictness). - -% ineq_ground(Strictness,I) -% -% Checks whether a grounded inequality I < 0 or I =< 0 is satisfied. - -ineq_ground(strict,I) :- I < 0. -ineq_ground(nonstrict,I) :- I =< 0. - -% ineq_one(Strictness,X,K,I) -% -% Solves the inequality K*X + I < 0 or K*X + I =< 0 - -ineq_one(strict,X,K,I) :- - ( K > 0 - -> ( I =:= 0 - -> ineq_one_s_p_0(X) % K*X < 0, K > 0 => X < 0 - ; Inhom is I rdiv K, - ineq_one_s_p_i(X,Inhom) % K*X + I < 0, K > 0 => X + I/K < 0 - ) - ; ( I =:= 0 - -> ineq_one_s_n_0(X) % K*X < 0, K < 0 => -X < 0 - ; Inhom is -I rdiv K, - ineq_one_s_n_i(X,Inhom) % K*X + I < 0, K < 0 => -X - I/K < 0 - ) - ). -ineq_one(nonstrict,X,K,I) :- - ( K > 0 - -> ( I =:= 0 - -> ineq_one_n_p_0(X) % K*X =< 0, K > 0 => X =< 0 - ; Inhom is I rdiv K, - ineq_one_n_p_i(X,Inhom) % K*X + I =< 0, K > 0 => X + I/K =< 0 - ) - ; ( I =:= 0 - -> ineq_one_n_n_0(X) % K*X =< 0, K < 0 => -X =< 0 - ; Inhom is -I rdiv K, - ineq_one_n_n_i(X,Inhom) % K*X + I =< 0, K < 0 => -X - I/K =< 0 - ) - ). - -% --------------------------- strict ---------------------------- - -% ineq_one_s_p_0(X) -% -% Solves the inequality X < 0 - -ineq_one_s_p_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, % old variable, this is deref - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_p_0(OrdX,X,Ix) - ). -ineq_one_s_p_0(X) :- % new variable, nothing depends on it - var_intern(t_u(0),X,1). % put a strict inactive upperbound on the variable - -% ineq_one_s_n_0(X) -% -% Solves the inequality X > 0 - -ineq_one_s_n_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_n_0(OrdX,X,Ix) - ). -ineq_one_s_n_0(X) :- - var_intern(t_l(0),X,2). % puts a strict inactive lowerbound on the variable - -% ineq_one_s_p_i(X,I) -% -% Solves the inequality X < -I - -ineq_one_s_p_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_p_i(OrdX,I,X,Ix) - ). -ineq_one_s_p_i(X,I) :- - Bound is -I, - var_intern(t_u(Bound),X,1). % puts a strict inactive upperbound on the variable - -% ineq_one_s_n_i(X,I) -% -% Solves the inequality X > I - -ineq_one_s_n_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_n_i(OrdX,I,X,Ix) - ). -ineq_one_s_n_i(X,I) :- var_intern(t_l(I),X,2). % puts a strict inactive lowerbound on the variable - -% ineq_one_old_s_p_0(Hom,X,Inhom) -% -% Solves the inequality X < 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_p_0([],_,Ix) :- Ix < 0. % X = I: Ix < 0 -ineq_one_old_s_p_0([l(Y*Ky,_)|Tail],X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -Ix rdiv Ky, - update_indep(strict,Y,Ky,Bound) % X < 0, X = K*Y + I => Y < -I/K or Y > -I/K (depending on K) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udus(Type,X,Lin,0,Old) % update strict upperbound - ). - -% ineq_one_old_s_p_0(Hom,X,Inhom) -% -% Solves the inequality X > 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_n_0([],_,Ix) :- Ix > 0. % X = I: Ix > 0 -ineq_one_old_s_n_0([l(Y*Ky,_)|Tail], X, Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is Ix rdiv Coeff, - update_indep(strict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udls(Type,X,Lin,0,Old) % update strict lowerbound - ). - -% ineq_one_old_s_p_i(Hom,C,X,Inhom) -% -% Solves the inequality X + C < 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_p_i([],I,_,Ix) :- I + Ix < 0. % X = I -ineq_one_old_s_p_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -(Ix + I) rdiv Ky, - update_indep(strict,Y,Ky,Bound) - ; Tail = [_|_] - -> Bound is -I, - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udus(Type,X,Lin,Bound,Old) % update strict upperbound - ). - -% ineq_one_old_s_n_i(Hom,C,X,Inhom) -% -% Solves the inequality X - C > 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_n_i([],I,_,Ix) :- I - Ix < 0. % X = I -ineq_one_old_s_n_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is (Ix - I) rdiv Coeff, - update_indep(strict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udls(Type,X,Lin,I,Old) % update strict lowerbound - ). - -% -------------------------- nonstrict -------------------------- - -% ineq_one_n_p_0(X) -% -% Solves the inequality X =< 0 - -ineq_one_n_p_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, % old variable, this is deref - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_p_0(OrdX,X,Ix) - ). -ineq_one_n_p_0(X) :- % new variable, nothing depends on it - var_intern(t_u(0),X,0). % nonstrict upperbound - -% ineq_one_n_n_0(X) -% -% Solves the inequality X >= 0 - -ineq_one_n_n_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_n_0(OrdX,X,Ix) - ). -ineq_one_n_n_0(X) :- - var_intern(t_l(0),X,0). % nonstrict lowerbound - -% ineq_one_n_p_i(X,I) -% -% Solves the inequality X =< -I - -ineq_one_n_p_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_p_i(OrdX,I,X,Ix) - ). -ineq_one_n_p_i(X,I) :- - Bound is -I, - var_intern(t_u(Bound),X,0). % nonstrict upperbound - -% ineq_one_n_n_i(X,I) -% -% Solves the inequality X >= I - -ineq_one_n_n_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpq) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_n_i(OrdX,I,X,Ix) - ). -ineq_one_n_n_i(X,I) :- - var_intern(t_l(I),X,0). % nonstrict lowerbound - -% ineq_one_old_n_p_0(Hom,X,Inhom) -% -% Solves the inequality X =< 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_p_0([],_,Ix) :- Ix =< 0. % X =I -ineq_one_old_n_p_0([l(Y*Ky,_)|Tail],X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -Ix rdiv Ky, - update_indep(nonstrict,Y,Ky,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udu(Type,X,Lin,0,Old) % update nonstrict upperbound - ). - -% ineq_one_old_n_n_0(Hom,X,Inhom) -% -% Solves the inequality X >= 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_n_0([],_,Ix) :- Ix >= 0. % X = I -ineq_one_old_n_n_0([l(Y*Ky,_)|Tail], X, Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is Ix rdiv Coeff, - update_indep(nonstrict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udl(Type,X,Lin,0,Old) % update nonstrict lowerbound - ). - -% ineq_one_old_n_p_i(Hom,C,X,Inhom) -% -% Solves the inequality X + C =< 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_p_i([],I,_,Ix) :- I + Ix =< 0. % X = I -ineq_one_old_n_p_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -(Ix + I) rdiv Ky, - update_indep(nonstrict,Y,Ky,Bound) - ; Tail = [_|_] - -> Bound is -I, - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udu(Type,X,Lin,Bound,Old) % update nonstrict upperbound - ). - -% ineq_one_old_n_n_i(Hom,C,X,Inhom) -% -% Solves the inequality X - C >= 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_n_i([],I,_,Ix) :- I - Ix =< 0. % X = I -ineq_one_old_n_n_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] - -> Coeff is -Ky, - Bound is (Ix - I) rdiv Coeff, - update_indep(nonstrict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udl(Type,X,Lin,I,Old) - ). - -% --------------------------------------------------------------- - -% ineq_more(Hom,Inhom,Lin,Strictness) -% -% Solves the inequality Lin < 0 or Lin =< 0 with Lin = Hom + Inhom - -ineq_more([],I,_,Strictness) :- ineq_ground(Strictness,I). % I < 0 or I =< 0 -ineq_more([l(X*K,_)|Tail],Id,Lind,Strictness) :- - ( Tail = [] - -> % X*K < Id or X*K =< Id - % one var: update bound instead of slack introduction - get_or_add_class(X,_), % makes sure X belongs to a class - Bound is -Id rdiv K, - update_indep(Strictness,X,K,Bound) % new bound - ; Tail = [_|_] - -> ineq_more(Strictness,Lind) - ). - -% ineq_more(Strictness,Lin) -% -% Solves the inequality Lin < 0 or Lin =< 0 - -ineq_more(strict,Lind) :- - ( unconstrained(Lind,U,K,Rest) - -> % never fails, no implied value - % Lind < 0 => Rest < -K*U where U has no bounds - var_intern(t_l(0),S,2), % create slack variable S - get_attr(S,itf,AttS), - arg(5,AttS,order(OrdS)), - Ki is -1 rdiv K, - add_linear_ff(Rest,Ki,[0,0,l(S*1,OrdS)],Ki,LinU), % U = (-1/K)*Rest + (-1/K)*S - LinU = [_,_|Hu], - get_or_add_class(U,Class), - same_class(Hu,Class), % put all variables of new lin. eq. of U in the same class - get_attr(U,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(ClassU)), - backsubst(ClassU,OrdU,LinU) % substitute U by new lin. eq. everywhere in the class - ; var_with_def_intern(t_u(0),S,Lind,1), % Lind < 0 => Lind = S with S < 0 - basis_add(S,_), % adds S to the basis - determine_active_dec(Lind), % activate bounds - reconsider(S) % reconsider basis - ). -ineq_more(nonstrict,Lind) :- - ( unconstrained(Lind,U,K,Rest) - -> % never fails, no implied value - % Lind =< 0 => Rest =< -K*U where U has no bounds - var_intern(t_l(0),S,0), % create slack variable S - Ki is -1 rdiv K, - get_attr(S,itf,AttS), - arg(5,AttS,order(OrdS)), - add_linear_ff(Rest,Ki,[0,0,l(S*1,OrdS)],Ki,LinU), % U = (-1K)*Rest + (-1/K)*S - LinU = [_,_|Hu], - get_or_add_class(U,Class), - same_class(Hu,Class), % put all variables of new lin. eq of U in the same class - get_attr(U,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(ClassU)), - backsubst(ClassU,OrdU,LinU) % substitute U by new lin. eq. everywhere in the class - ; % all variables are constrained - var_with_def_intern(t_u(0),S,Lind,0), % Lind =< 0 => Lind = S with S =< 0 - basis_add(S,_), % adds S to the basis - determine_active_dec(Lind), - reconsider(S) - ). - - -% update_indep(Strictness,X,K,Bound) -% -% Updates the bound of independent variable X where X < Bound or X =< Bound -% or X > Bound or X >= Bound, depending on Strictness and K. - -update_indep(strict,X,K,Bound) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - ( K < 0 - -> uils(Type,X,Lin,Bound,Old) % update independent lowerbound strict - ; uius(Type,X,Lin,Bound,Old) % update independent upperbound strict - ). -update_indep(nonstrict,X,K,Bound) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - ( K < 0 - -> uil(Type,X,Lin,Bound,Old) % update independent lowerbound nonstrict - ; uiu(Type,X,Lin,Bound,Old) % update independent upperbound nonstrict - ). - - -% --------------------------------------------------------------------------------------- - -% -% Update a bound on a var xi -% -% a) independent variable -% -% a1) update inactive bound: done -% -% a2) update active bound: -% Determine [lu]b including most constraining row R -% If we are within: done -% else pivot(R,xi) and introduce bound via (b) -% -% a3) introduce a bound on an unconstrained var: -% All vars that depend on xi are unconstrained (invariant) -> -% the bound cannot invalidate any Lhs -% -% b) dependent variable -% -% repair upper or lower (maybe just swap with an unconstrained var from Rhs) -% - -% -% Sign = 1,0,-1 means inside,at,outside -% - -% Read following predicates as update (dependent/independent) (lowerbound/upperbound) (strict) - -% udl(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -udl(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_l(Bound))), - setarg(3,AttX,strictness(0)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> Ki is -1 rdiv Kuc, - add_linear_ff(Rest,Ki,[0,0,l(X* -1,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; basis_add(X,_), - determine_active_inc(Lin), - reconsider(X) - ). -udl(t_l(L),X,Lin,Bound,Sold) :- - ( Bound > L - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; true - ). - -udl(t_u(U),X,Lin,Bound,_Sold) :- - ( Bound < U - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - reconsider_lower(X,Lin,Bound) % makes sure that Lin still satisfies lowerbound Bound - ; Bound =:= U, - solve_bound(Lin,Bound) % new bound is equal to upperbound: solve - ). -udl(t_lu(L,U),X,Lin,Bound,Sold) :- - ( Bound > L - -> ( Bound < U - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; Bound =:= U, - Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). - -% udls(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. - -udls(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_l(Bound))), - setarg(3,AttX,strictness(2)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1 rdiv Kuc, - add_linear_ff(Rest,Ki,[0,0,l(X* -1,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_inc(Lin), - reconsider(X) - ). -udls(t_l(L),X,Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; % equal to lowerbound: check strictness - Strict is Sold \/ 2, - get_attr(X,itf,Att), - arg(3,Att,strictness(Strict)) - ). -udls(t_u(U),X,Lin,Bound,Sold) :- - Bound < U, % smaller than upperbound: set new bound - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound). -udls(t_lu(L,U),X,Lin,Bound,Sold) :- - ( Bound < L - -> true % smaller than lowerbound: keep - ; Bound > L - -> % larger than lowerbound: check upperbound and possibly use new and reconsider basis - Bound < U, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; % equal to lowerbound: put new strictness - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% udu(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -udu(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_u(Bound))), - setarg(3,AttX,strictness(0)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1 rdiv Kuc, - add_linear_ff(Rest,Ki,[0,0,l(X* -1,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_dec(Lin), % try to lower R - reconsider(X) - ). -udu(t_u(U),X,Lin,Bound,Sold) :- - ( Bound < U - -> Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; true - ). -udu(t_l(L),X,Lin,Bound,_Sold) :- - ( Bound > L - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - reconsider_upper(X,Lin,Bound) - ; Bound =:= L, - solve_bound(Lin,Bound) % equal to lowerbound: solve - ). -udu(t_lu(L,U),X,Lin,Bound,Sold) :- - ( Bound < U - -> ( Bound > L - -> Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; Bound =:= L, - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). - -% udus(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. - -udus(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_u(Bound))), - setarg(3,AttX,strictness(1)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1 rdiv Kuc, - add_linear_ff(Rest,Ki,[0,0,l(X* -1,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_dec(Lin), - reconsider(X) - ). -udus(t_u(U),X,Lin,Bound,Sold) :- - ( U < Bound - -> true % larger than upperbound: keep - ; Bound < U - -> % smaller than upperbound: update bound and reconsider basis - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; % equal to upperbound: set new strictness - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -udus(t_l(L),X,Lin,Bound,Sold) :- - L < Bound, % larger than lowerbound: update and reconsider basis - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound). -udus(t_lu(L,U),X,Lin,Bound,Sold) :- - ( U < Bound - -> true % larger than upperbound: keep - ; Bound < U - -> % smaller than upperbound: check lowerbound, possibly update and reconsider basis - L < Bound, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; % equal to upperbound: update strictness - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% uiu(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -uiu(t_none,X,_Lin,Bound,_) :- % X had no bounds - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(0)). -uiu(t_u(U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true % larger than upperbound: keep - ; Bound < U - -> % smaller than upperbound: update. - Strict is Sold /\ 2, % update strictness: strictness of lowerbound is kept, - % strictness of upperbound is set to non-strict - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)) - ; true % equal to upperbound and nonstrict: keep - ). -uiu(t_l(L),X,Lin,Bound,_Sold) :- - ( Bound > L - -> % Upperbound is larger than lowerbound: store new bound - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))) - ; Bound =:= L, - solve_bound(Lin,Bound) % Lowerbound was equal to new upperbound: solve - ). -uiu(t_L(L),X,Lin,Bound,_Sold) :- - ( Bound > L - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))) - ; Bound =:= L, - solve_bound(Lin,Bound) - ). -uiu(t_lu(L,U),X,Lin,Bound,Sold) :- - ( Bound < U - -> ( Bound > L - -> Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Bound =:= L, - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uiu(t_Lu(L,U),X,Lin,Bound,Sold) :- - ( Bound < U - -> ( L < Bound - -> Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; L =:= Bound, - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uiu(t_U(U),X,_Lin,Bound,Sold) :- - ( Bound < U - -> Strict is Sold /\ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound =< Lb + U - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_U(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_u(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_U(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; true - ). -uiu(t_lU(L,U),X,Lin,Bound,Sold) :- - ( Bound < U - -> ( L < Bound - -> Strict is Sold /\ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound =< Lb + U - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_lU(L,Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_lu(L,Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_lU(L,Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; L =:= Bound, - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). - -% uius(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. (see also uiu/5) - -uius(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(1)). -uius(t_u(U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true - ; Bound < U - -> Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_l(L),X,_Lin,Bound,Sold) :- - L < Bound, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)). -uius(t_L(L),X,_Lin,Bound,Sold) :- - L < Bound, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)). -uius(t_lu(L,U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true - ; Bound < U - -> L < Bound, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_Lu(L,U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true - ; Bound < U - -> L < Bound, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_U(U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true - ; Bound < U - -> Strict is Sold \/ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound =< Lb + U - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_U(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_u(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_U(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_lU(L,U),X,_Lin,Bound,Sold) :- - ( U < Bound - -> true - ; Bound < U - -> L < Bound, - Strict is Sold \/ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound =< Lb + U - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_lU(L,Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_lu(L,Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_lU(L,Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% uil(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. (see also uiu/5) - - -uil(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(0)). -uil(t_l(L),X,_Lin,Bound,Sold) :- - ( Bound > L - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)) - ; true - ). -uil(t_u(U),X,Lin,Bound,_Sold) :- - ( Bound < U - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))) - ; Bound =:= U, - solve_bound(Lin,Bound) - ). -uil(t_U(U),X,Lin,Bound,_Sold) :- - ( Bound < U - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))) - ; Bound =:= U, - solve_bound(Lin,Bound) - ). -uil(t_lu(L,U),X,Lin,Bound,Sold) :- - ( Bound > L - -> ( Bound < U - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Bound =:= U, - Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uil(t_lU(L,U),X,Lin,Bound,Sold) :- - ( Bound > L - -> ( Bound < U - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Bound =:= U, - Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uil(t_L(L),X,_Lin,Bound,Sold) :- - ( Bound > L - -> Strict is Sold /\ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound >= Ub + L - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_L(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_l(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_L(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; true - ). -uil(t_Lu(L,U),X,Lin,Bound,Sold) :- - ( Bound > L - -> ( Bound < U - -> Strict is Sold /\ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound >= Ub + L - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,t_Lu(Bound,U)), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_lu(Bound,U)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_Lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Bound =:= U, - Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). - -% uils(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. (see also uiu/5) - -uils(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(2)). -uils(t_l(L),X,_Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_u(U),X,_Lin,Bound,Sold) :- - Bound < U, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)). -uils(t_U(U),X,_Lin,Bound,Sold) :- - Bound < U, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)). -uils(t_lu(L,U),X,_Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Bound < U, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_lU(L,U),X,_Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Bound < U, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_L(L),X,_Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Strict is Sold \/ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound >= Ub + L - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_L(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_l(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_L(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_Lu(L,U),X,_Lin,Bound,Sold) :- - ( Bound < L - -> true - ; Bound > L - -> Bound < U, - Strict is Sold \/ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound >= Ub + L - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_Lu(Bound,U))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_lu(Bound,U)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_Lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% reconsider_upper(X,Lin,U) -% -% Checks if the upperbound of X which is U, satisfies the bounds -% of the variables in Lin: let R be the sum of all the bounds on -% the variables in Lin, and I be the inhomogene part of Lin, then -% upperbound U should be larger or equal to R + I (R may contain -% lowerbounds). -% See also rcb/3 in bv.pl - -reconsider_upper(X,[I,R|H],U) :- - R + I > U, % violation - !, - dec_step(H,Status), % we want to decrement R - rcbl_status(Status,X,[],Binds,[],u(U)), - export_binding(Binds). -reconsider_upper( _, _, _). - -% reconsider_lower(X,Lin,L) -% -% Checks if the lowerbound of X which is L, satisfies the bounds -% of the variables in Lin: let R be the sum of all the bounds on -% the variables in Lin, and I be the inhomogene part of Lin, then -% lowerbound L should be smaller or equal to R + I (R may contain -% upperbounds). -% See also rcb/3 in bv.pl - -reconsider_lower(X,[I,R|H],L) :- - R + I < L, % violation - !, - inc_step(H,Status), % we want to increment R - rcbl_status(Status,X,[],Binds,[],l(L)), - export_binding(Binds). -reconsider_lower(_,_,_). - -% -% lin is dereferenced -% - -% solve_bound(Lin,Bound) -% -% Solves the linear equation Lin - Bound = 0 -% Lin is the linear equation of X, a variable whose bounds have narrowed to value Bound - -solve_bound(Lin,Bound) :- - Bound =:= 0, - !, - solve(Lin). -solve_bound(Lin,Bound) :- - Nb is -Bound, - normalize_scalar(Nb,Nbs), - add_linear_11(Nbs,Lin,Eq), - solve(Eq). diff --git a/GPL/clpqr/clpq/itf_q.pl b/GPL/clpqr/clpq/itf_q.pl deleted file mode 100644 index f2e5a40fa..000000000 --- a/GPL/clpqr/clpq/itf_q.pl +++ /dev/null @@ -1,222 +0,0 @@ -/* - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(itf_q, - [ - do_checks/8 - ]). -:- use_module(bv_q, - [ - deref/2, - detach_bounds_vlv/5, - solve/1, - solve_ord_x/3 - ]). -:- use_module(nf_q, - [ - nf/2 - ]). -:- use_module(store_q, - [ - add_linear_11/3, - indep/2, - nf_coeff_of/3 - ]). -:- use_module('../clpqr/class', - [ - class_drop/2 - ]). - -do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- - numbers_only(Y), - verify_nonzero(No,Y), - verify_type(Ty,St,Y,Later,[]), - verify_lin(Or,Cl,Li,Y), - maplist(call,Later). - -numbers_only(Y) :- - ( var(Y) - ; rational(Y) - ; throw(type_error(_X = Y,2,'a rational number',Y)) - ), - !. - -% verify_nonzero(Nonzero,Y) -% -% if Nonzero = nonzero, then verify that Y is not zero -% (if possible, otherwise set Y to be nonzero) - -verify_nonzero(nonzero,Y) :- - ( var(Y) - -> ( get_attr(Y,itf,Att) - -> setarg(8,Att,nonzero) - ; put_attr(Y,itf,t(clpq,n,n,n,n,n,n,nonzero,n,n,n)) - ) - ; Y =\= 0 - ). -verify_nonzero(n,_). % X is not nonzero - -% verify_type(type(Type),strictness(Strict),Y,[OL|OLT],OLT) -% -% if possible verifies whether Y satisfies the type and strictness of X -% if not possible to verify, then returns the constraints that follow from -% the type and strictness - -verify_type(type(Type),strictness(Strict),Y) --> - verify_type2(Y,Type,Strict). -verify_type(n,n,_) --> []. - -verify_type2(Y,TypeX,StrictX) --> - {var(Y)}, - !, - verify_type_var(TypeX,Y,StrictX). -verify_type2(Y,TypeX,StrictX) --> - {verify_type_nonvar(TypeX,Y,StrictX)}. - -% verify_type_nonvar(Type,Nonvar,Strictness) -% -% verifies whether the type and strictness are satisfied with the Nonvar - -verify_type_nonvar(t_none,_,_). -verify_type_nonvar(t_l(L),Value,S) :- ilb(S,L,Value). -verify_type_nonvar(t_u(U),Value,S) :- iub(S,U,Value). -verify_type_nonvar(t_lu(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). -verify_type_nonvar(t_L(L),Value,S) :- ilb(S,L,Value). -verify_type_nonvar(t_U(U),Value,S) :- iub(S,U,Value). -verify_type_nonvar(t_Lu(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). -verify_type_nonvar(t_lU(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). - -% ilb(Strict,Lower,Value) & iub(Strict,Upper,Value) -% -% check whether Value is satisfiable with the given lower/upper bound and -% strictness. -% strictness is encoded as follows: -% 2 = strict lower bound -% 1 = strict upper bound -% 3 = strict lower and upper bound -% 0 = no strict bounds - -ilb(S,L,V) :- - S /\ 2 =:= 0, - !, - L =< V. % non-strict -ilb(_,L,V) :- L < V. % strict - -iub(S,U,V) :- - S /\ 1 =:= 0, - !, - V =< U. % non-strict -iub(_,U,V) :- V < U. % strict - -% -% Running some goals after X=Y simplifies the coding. It should be possible -% to run the goals here and taking care not to put_atts/2 on X ... -% - -% verify_type_var(Type,Var,Strictness,[OutList|OutListTail],OutListTail) -% -% returns the inequalities following from a type and strictness satisfaction -% test with Var - -verify_type_var(t_none,_,_) --> []. -verify_type_var(t_l(L),Y,S) --> llb(S,L,Y). -verify_type_var(t_u(U),Y,S) --> lub(S,U,Y). -verify_type_var(t_lu(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). -verify_type_var(t_L(L),Y,S) --> llb(S,L,Y). -verify_type_var(t_U(U),Y,S) --> lub(S,U,Y). -verify_type_var(t_Lu(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). -verify_type_var(t_lU(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). - -% llb(Strict,Lower,Value,[OL|OLT],OLT) and lub(Strict,Upper,Value,[OL|OLT],OLT) -% -% returns the inequalities following from the lower and upper bounds and the -% strictness see also lb and ub -llb(S,L,V) --> - {S /\ 2 =:= 0}, - !, - [clpq:{L =< V}]. -llb(_,L,V) --> [clpq:{L < V}]. - -lub(S,U,V) --> - {S /\ 1 =:= 0}, - !, - [clpq:{V =< U}]. -lub(_,U,V) --> [clpq:{V < U}]. - -% -% We used to drop X from the class/basis to avoid trouble with subsequent -% put_atts/2 on X. Now we could let these dead but harmless updates happen. -% In R however, exported bindings might conflict, e.g. 0 \== 0.0 -% -% If X is indep and we do _not_ solve for it, we are in deep shit -% because the ordering is violated. -% -verify_lin(order(OrdX),class(Class),lin(LinX),Y) :- - !, - ( indep(LinX,OrdX) - -> detach_bounds_vlv(OrdX,LinX,Class,Y,NewLinX), - % if there were bounds, they are requeued already - class_drop(Class,Y), - nf(-Y,NfY), - deref(NfY,LinY), - add_linear_11(NewLinX,LinY,Lind), - ( nf_coeff_of(Lind,OrdX,_) - -> % X is element of Lind - solve_ord_x(Lind,OrdX,Class) - ; solve(Lind) % X is gone, can safely solve Lind - ) - ; class_drop(Class,Y), - nf(-Y,NfY), - deref(NfY,LinY), - add_linear_11(LinX,LinY,Lind), - solve(Lind) - ). -verify_lin(_,_,_,_). \ No newline at end of file diff --git a/GPL/clpqr/clpq/nf_q.pl b/GPL/clpqr/clpq/nf_q.pl deleted file mode 100644 index a55e01f7f..000000000 --- a/GPL/clpqr/clpq/nf_q.pl +++ /dev/null @@ -1,1118 +0,0 @@ -/* $Id: nf_q.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(nf_q, - [ - {}/1, - nf/2, - entailed/1, - split/3, - repair/2, - nf_constant/2, - wait_linear/3, - nf2term/2 - ]). -:- use_module('../clpqr/geler', - [ - geler/3 - ]). -:- use_module(bv_q, - [ - log_deref/4, - solve/1, - 'solve_<'/1, - 'solve_=<'/1, - 'solve_=\\='/1 - ]). -:- use_module(ineq_q, - [ - ineq_one/4, - ineq_one_s_p_0/1, - ineq_one_s_n_0/1, - ineq_one_n_p_0/1, - ineq_one_n_n_0/1 - ]). -:- use_module(store_q, - [ - add_linear_11/3, - normalize_scalar/2 - ]). - -goal_expansion(geler(X,Y),geler(clpq,X,Y)). - -% ------------------------------------------------------------------------- - -% {Constraint} -% -% Adds the constraint Constraint to the constraint store. -% -% First rule is to prevent binding with other rules when a variable is input -% Constraints are converted to normal form and if necessary, submitted to the linear -% equality/inequality solver (bv + ineq) or to the non-linear store (geler) - -{Rel} :- - var(Rel), - !, - throw(instantiation_error({Rel},1)). -{R,Rs} :- - !, - {R},{Rs}. -{R;Rs} :- - !, - ({R};{Rs}). % for entailment checking -{L < R} :- - !, - nf(L-R,Nf), - submit_lt(Nf). -{L > R} :- - !, - nf(R-L,Nf), - submit_lt(Nf). -{L =< R} :- - !, - nf(L-R,Nf), - submit_le( Nf). -{<=(L,R)} :- - !, - nf(L-R,Nf), - submit_le(Nf). -{L >= R} :- - !, - nf(R-L,Nf), - submit_le(Nf). -{L =\= R} :- - !, - nf(L-R,Nf), - submit_ne(Nf). -{L =:= R} :- - !, - nf(L-R,Nf), - submit_eq(Nf). -{L = R} :- - !, - nf(L-R,Nf), - submit_eq(Nf). -{Rel} :- throw(type_error({Rel},1,'a constraint',Rel)). - -% entailed(C) -% -% s -> c = ~s v c = ~(s /\ ~c) -% where s is the store and c is the constraint for which -% we want to know whether it is entailed. -% C is negated and added to the store. If this fails, then c is entailed by s - -entailed(C) :- - negate(C,Cn), - \+ {Cn}. - -% negate(C,Res). -% -% Res is the negation of constraint C -% first rule is to prevent binding with other rules when a variable is input - -negate(Rel,_) :- - var(Rel), - !, - throw(instantiation_error(entailed(Rel),1)). -negate((A,B),(Na;Nb)) :- - !, - negate(A,Na), - negate(B,Nb). -negate((A;B),(Na,Nb)) :- - !, - negate(A,Na), - negate(B,Nb). -negate(A=B) :- !. -negate(A>B,A=B) :- !. -negate(A>=B,A A = 0 -% b4) nonlinear -> geler -% c) Nf=[A,B|Rest] -% c1) A=k -% c11) (B=c*X^+1 or B=c*X^-1), Rest=[] -> B=-k/c or B=-c/k -% c12) invertible(A,B) -% c13) linear(B|Rest) -% c14) geler -% c2) linear(Nf) -% c3) nonlinear -> geler - -submit_eq([]). % trivial success: case a -submit_eq([T|Ts]) :- - submit_eq(Ts,T). -submit_eq([],A) :- submit_eq_b(A). % case b -submit_eq([B|Bs],A) :- submit_eq_c(A,B,Bs). % case c - -% submit_eq_b(A) -% -% Handles case b of submit_eq/1 - -% case b1: A is a constant (non-zero) -submit_eq_b(v(_,[])) :- - !, - fail. -% case b2/b3: A is n*X^P => X = 0 -submit_eq_b(v(_,[X^P])) :- - var(X), - P > 0, - !, - X = 0. -% case b2: non-linear is invertible: NL(X) = 0 => X - inv(NL)(0) = 0 -submit_eq_b(v(_,[NL^1])) :- - nonvar(NL), - nl_invertible(NL,X,0,Inv), - !, - nf(-Inv,S), - nf_add(X,S,New), - submit_eq(New). -% case b4: A is non-linear and not invertible => submit equality to geler -submit_eq_b(Term) :- - term_variables(Term,Vs), - geler(Vs,nf_q:resubmit_eq([Term])). - -% submit_eq_c(A,B,Rest) -% -% Handles case c of submit_eq/1 - -% case c1: A is a constant -submit_eq_c(v(I,[]),B,Rest) :- - !, - submit_eq_c1(Rest,B,I). -% case c2: A,B and Rest are linear -submit_eq_c(A,B,Rest) :- % c2 - A = v(_,[X^1]), - var(X), - B = v(_,[Y^1]), - var(Y), - linear(Rest), - !, - Hom = [A,B|Rest], - % 'solve_='(Hom). - nf_length(Hom,0,Len), - log_deref(Len,Hom,[],HomD), - solve(HomD). -% case c3: A, B or Rest is non-linear => geler -submit_eq_c(A,B,Rest) :- - Norm = [A,B|Rest], - term_variables(Norm,Vs), - geler(Vs,nf_q:resubmit_eq(Norm)). - -% submit_eq_c1(Rest,B,K) -% -% Handles case c1 of submit_eq/1 - -% case c11: k+cX^1=0 or k+cX^-1=0 -submit_eq_c1([],v(K,[X^P]),I) :- - var(X), - ( P = 1, - !, - X is -I rdiv K - ; P = -1, - !, - X is -K rdiv I - ). -% case c12: non-linear, invertible: cNL(X)^1+k=0 => inv(NL)(-k/c) = 0 ; -% cNL(X)^-1+k=0 => inv(NL)(-c/k) = 0 -submit_eq_c1([],v(K,[NL^P]),I) :- - nonvar(NL), - ( P = 1, - Y is -I rdiv K - ; P = -1, - Y is -K rdiv I - ), - nl_invertible(NL,X,Y,Inv), - !, - nf(-Inv,S), - nf_add(X,S,New), - submit_eq(New). -% case c13: linear: X + Y + Z + c = 0 => -submit_eq_c1(Rest,B,I) :- - B = v(_,[Y^1]), - var(Y), - linear(Rest), - !, - % 'solve_='( [v(I,[]),B|Rest]). - Hom = [B|Rest], - nf_length(Hom,0,Len), - normalize_scalar(I,Nonvar), - log_deref(Len,Hom,[],HomD), - add_linear_11(Nonvar,HomD,LinD), - solve(LinD). -% case c14: other cases => geler -submit_eq_c1(Rest,B,I) :- - Norm = [v(I,[]),B|Rest], - term_variables(Norm,Vs), - geler(Vs,nf_q:resubmit_eq(Norm)). - -% ----------------------------------------------------------------------- - -% submit_lt(Nf) -% -% Submits the inequality Nf<0 to the constraint store, where Nf is in normal form. - -% 0 < 0 => fail -submit_lt([]) :- fail. -% A + B < 0 -submit_lt([A|As]) :- submit_lt(As,A). - -% submit_lt(As,A) -% -% Does what submit_lt/1 does where Nf = [A|As] - -% v(K,P) < 0 -submit_lt([],v(K,P)) :- submit_lt_b(P,K). -% A + B + Bs < 0 -submit_lt([B|Bs],A) :- submit_lt_c(Bs,A,B). - -% submit_lt_b(P,K) -% -% Does what submit_lt/2 does where A = [v(K,P)] and As = [] - -% c < 0 -submit_lt_b([],I) :- - !, - I < 0. -% cX^1 < 0 : if c < 0 then X > 0, else X < 0 -submit_lt_b([X^1],K) :- - var(X), - !, - ( K > 0 - -> ineq_one_s_p_0(X) % X is strictly negative - ; ineq_one_s_n_0(X) % X is strictly positive - ). -% non-linear => geler -submit_lt_b(P,K) :- - term_variables(P,Vs), - geler(Vs,nf_q:resubmit_lt([v(K,P)])). - -% submit_lt_c(Bs,A,B) -% -% Does what submit_lt/2 does where As = [B|Bs]. - -% c + kX < 0 => kX < c -submit_lt_c([],A,B) :- - A = v(I,[]), - B = v(K,[Y^1]), - var(Y), - !, - ineq_one(strict,Y,K,I). -% linear < 0 => solve, non-linear < 0 => geler -submit_lt_c(Rest,A,B) :- - Norm = [A,B|Rest], - ( linear(Norm) - -> 'solve_<'(Norm) - ; term_variables(Norm,Vs), - geler(Vs,nf_q:resubmit_lt(Norm)) - ). - -% submit_le(Nf) -% -% Submits the inequality Nf =< 0 to the constraint store, where Nf is in normal form. -% See also submit_lt/1 - -% 0 =< 0 => success -submit_le([]). -% A + B =< 0 -submit_le([A|As]) :- submit_le(As,A). - -% submit_le(As,A) -% -% See submit_lt/2. This handles less or equal. - -% v(K,P) =< 0 -submit_le([],v(K,P)) :- submit_le_b(P,K). -% A + B + Bs =< 0 -submit_le([B|Bs],A) :- submit_le_c(Bs,A,B). - -% submit_le_b(P,K) -% -% See submit_lt_b/2. This handles less or equal. - -% c =< 0 -submit_le_b([],I) :- - !, - I =< 0. -% cX^1 =< 0: if c < 0 then X >= 0, else X =< 0 -submit_le_b([X^1],K) :- - var(X), - !, - ( K > 0 - -> ineq_one_n_p_0(X) % X is non-strictly negative - ; ineq_one_n_n_0(X) % X is non-strictly positive - ). -% cX^P =< 0 => geler -submit_le_b(P,K) :- - term_variables(P,Vs), - geler(Vs,nf_q:resubmit_le([v(K,P)])). - -% submit_le_c(Bs,A,B) -% -% See submit_lt_c/3. This handles less or equal. - -% c + kX^1 =< 0 => kX =< 0 -submit_le_c([],A,B) :- - A = v(I,[]), - B = v(K,[Y^1]), - var(Y), - !, - ineq_one(nonstrict,Y,K,I). -% A, B & Rest are linear => solve, otherwise => geler -submit_le_c(Rest,A,B) :- - Norm = [A,B|Rest], - ( linear(Norm) - -> 'solve_=<'(Norm) - ; term_variables(Norm,Vs), - geler(Vs,nf_q:resubmit_le(Norm)) - ). - -% submit_ne(Nf) -% -% Submits the inequality Nf =\= 0 to the constraint store, where Nf is in normal form. -% if Nf is a constant => check constant = 0, else if Nf is linear => solve else => geler - -submit_ne(Norm1) :- - ( nf_constant(Norm1,K) - -> K =\= 0 - ; linear(Norm1) - -> 'solve_=\\='(Norm1) - ; term_variables(Norm1,Vs), - geler(Vs,nf_q:resubmit_ne(Norm1)) - ). - -% linear(A) -% -% succeeds when A is linear: all elements are of the form v(_,[]) or v(_,[X^1]) - -linear([]). -linear(v(_,Ps)) :- linear_ps(Ps). -linear([A|As]) :- - linear(A), - linear(As). - -% linear_ps(A) -% -% Succeeds when A = V^1 with V a variable. -% This reflects the linearity of v(_,A). - -linear_ps([]). -linear_ps([V^1]) :- var(V). % excludes sin(_), ... - -% -% Goal delays until Term gets linear. -% At this time, Var will be bound to the normalform of Term. -% -:- meta_predicate wait_linear( ?, ?, :). -% -wait_linear(Term,Var,Goal) :- - nf(Term,Nf), - ( linear(Nf) - -> Var = Nf, - call(Goal) - ; term_variables(Nf,Vars), - geler(Vars,nf_q:wait_linear_retry(Nf,Var,Goal)) - ). -% -% geler clients -% -resubmit_eq(N) :- - repair(N,Norm), - submit_eq(Norm). -resubmit_lt(N) :- - repair(N,Norm), - submit_lt(Norm). -resubmit_le(N) :- - repair(N,Norm), - submit_le(Norm). -resubmit_ne(N) :- - repair(N,Norm), - submit_ne(Norm). -wait_linear_retry(Nf0,Var,Goal) :- - repair(Nf0,Nf), - ( linear(Nf) - -> Var = Nf, - call(Goal) - ; term_variables(Nf,Vars), - geler(Vars,nf_q:wait_linear_retry(Nf,Var,Goal)) - ). -% ----------------------------------------------------------------------- - -% nl_invertible(F,X,Y,Res) -% -% Res is the evaluation of the inverse of nonlinear function F in variable X -% where X is Y - -nl_invertible(sin(X),X,Y,Res) :- Res is asin(Y). -nl_invertible(cos(X),X,Y,Res) :- Res is acos(Y). -nl_invertible(tan(X),X,Y,Res) :- Res is atan(Y). -nl_invertible(exp(B,C),X,A,Res) :- - ( nf_constant(B,Kb) - -> A > 0, - Kb > 0, - Kb =\= 1, - X = C, % note delayed unification - Res is rational(log(A)) rdiv rational(log(Kb)) - ; nf_constant(C,Kc), - A =\= 0, - Kc > 0, - X = B, % note delayed unification - Res is rational(A**(1 rdiv Kc)) - ). - -% ----------------------------------------------------------------------- - -% nf(Exp,Nf) -% -% Returns in Nf, the normal form of expression Exp -% -% v(A,[B^C,D^E|...]) means A*B^C*D^E*... where A is a scalar (number) -% v(A,[]) means scalar A - -% variable X => 1*X^1 -nf(X,Norm) :- - var(X), - !, - Norm = [v(1,[X^1])]. -nf(X,Norm) :- - number(X), - !, - nf_number(X,Norm). -nf(X,Norm) :- - rational(X), - !, - nf_number(X,Norm). -% -nf(-A,Norm) :- - !, - nf(A,An), - nf_mul_factor(v(-1,[]),An,Norm). -nf(+A,Norm) :- - !, - nf(A,Norm). -% -nf(A+B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_add(An,Bn,Norm). -nf(A-B,Norm) :- - !, - nf(A,An), - nf(-B,Bn), - nf_add(An,Bn,Norm). -% -nf(A*B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_mul(An,Bn,Norm). -nf(A/B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_div(Bn,An,Norm). -% non-linear function, one argument: Term = f(Arg) equals f'(Sa1) = Skel -nf(Term,Norm) :- - nonlin_1(Term,Arg,Skel,Sa1), - !, - nf(Arg,An), - nf_nonlin_1(Skel,An,Sa1,Norm). -% non-linear function, two arguments: Term = f(A1,A2) equals f'(Sa1,Sa2) = Skel -nf(Term,Norm) :- - nonlin_2(Term,A1,A2,Skel,Sa1,Sa2), - !, - nf(A1,A1n), - nf(A2,A2n), - nf_nonlin_2(Skel,A1n,A2n,Sa1,Sa2,Norm). -% -nf(Term,_) :- - throw(type_error(nf(Term,_),1,'a numeric expression',Term)). - -% nf_number(N,Res) -% -% If N is a number, N is normalized - -nf_number(N,Res) :- - Rat is rationalize(N), - ( Rat =:= 0 - -> Res = [] - ; Res = [v(Rat,[])] - ). - -nonlin_1(abs(X),X,abs(Y),Y). -nonlin_1(sin(X),X,sin(Y),Y). -nonlin_1(cos(X),X,cos(Y),Y). -nonlin_1(tan(X),X,tan(Y),Y). -nonlin_2(min(A,B),A,B,min(X,Y),X,Y). -nonlin_2(max(A,B),A,B,max(X,Y),X,Y). -nonlin_2(exp(A,B),A,B,exp(X,Y),X,Y). -nonlin_2(pow(A,B),A,B,exp(X,Y),X,Y). % pow->exp -nonlin_2(A^B,A,B,exp(X,Y),X,Y). - -nf_nonlin_1(Skel,An,S1,Norm) :- - ( nf_constant(An,S1) - -> nl_eval(Skel,Res), - nf_number(Res,Norm) - ; S1 = An, - Norm = [v(1,[Skel^1])]). -nf_nonlin_2(Skel,A1n,A2n,S1,S2,Norm) :- - ( nf_constant(A1n,S1), - nf_constant(A2n,S2) - -> nl_eval(Skel,Res), - nf_number(Res,Norm) - ; Skel=exp(_,_), - nf_constant(A2n,Exp), - integer(Exp) - -> nf_power(Exp,A1n,Norm) - ; S1 = A1n, - S2 = A2n, - Norm = [v(1,[Skel^1])] - ). - -% evaluates non-linear functions in one variable where the variable is bound -nl_eval(abs(X),R) :- R is abs(X). -nl_eval(sin(X),R) :- R is sin(X). -nl_eval(cos(X),R) :- R is cos(X). -nl_eval(tan(X),R) :- R is tan(X). -% evaluates non-linear functions in two variables where both variables are -% bound -nl_eval(min(X,Y),R) :- R is min(X,Y). -nl_eval(max(X,Y),R) :- R is max(X,Y). -nl_eval(exp(X,Y),R) :- R is X**Y. - -% -% check if a Nf consists of just a constant -% - -nf_constant([],Z) :- Z = 0. -nf_constant([v(K,[])],K). - -% split(NF,SNF,C) -% -% splits a normalform expression NF into two parts: -% - a constant term C (which might be 0) -% - the homogene part of the expression -% -% this method depends on the polynf ordering, i.e. [] < [X^1] ... - -split([],[],0). -split([First|T],H,I) :- - ( First = v(I,[]) - -> H = T - ; I = 0, - H = [First|T] - ). - -% nf_add(A,B,C): merges two normalized additions into a new normalized addition -% -% a normalized addition is one where the terms are ordered, e.g. X^1 < Y^1, X^1 < X^2 etc. -% terms in the same variable with the same exponent are added, -% e.g. when A contains v(5,[X^1]) and B contains v(4,[X^1]) then C contains v(9,[X^1]). - -nf_add([],Bs,Bs). -nf_add([A|As],Bs,Cs) :- nf_add(Bs,A,As,Cs). - -nf_add([],A,As,Cs) :- Cs = [A|As]. -nf_add([B|Bs],A,As,Cs) :- - A = v(Ka,Pa), - B = v(Kb,Pb), - compare(Rel,Pa,Pb), - nf_add_case(Rel,A,As,Cs,B,Bs,Ka,Kb,Pa). - -% nf_add_case(Rel,A,As,Cs,B,Bs,Ka,Kb,Pa) -% -% merges sorted lists [A|As] and [B|Bs] into new sorted list Cs -% A = v(Ka,Pa) and B = v(Kb,_) -% Rel is the ordering relation (<, > or =) between A and B. -% when Rel is =, Ka and Kb are added to form a new scalar for Pa -nf_add_case(<,A,As,Cs,B,Bs,_,_,_) :- - Cs = [A|Rest], - nf_add(As,B,Bs,Rest). -nf_add_case(>,A,As,Cs,B,Bs,_,_,_) :- - Cs = [B|Rest], - nf_add(Bs,A,As,Rest). -nf_add_case(=,_,As,Cs,_,Bs,Ka,Kb,Pa) :- - Kc is Ka + Kb, - ( Kc =:= 0.0 - -> nf_add(As,Bs,Cs) - ; Cs = [v(Kc,Pa)|Rest], - nf_add(As,Bs,Rest) - ). - -nf_mul(A,B,Res) :- - nf_length(A,0,LenA), - nf_length(B,0,LenB), - nf_mul_log(LenA,A,[],LenB,B,Res). - -nf_mul_log(0,As,As,_,_,[]) :- !. -nf_mul_log(1,[A|As],As,Lb,B,R) :- - !, - nf_mul_factor_log(Lb,B,[],A,R). -nf_mul_log(2,[A1,A2|As],As,Lb,B,R) :- - !, - nf_mul_factor_log(Lb,B,[],A1,A1b), - nf_mul_factor_log(Lb,B,[],A2,A2b), - nf_add(A1b,A2b,R). -nf_mul_log(N,A0,A2,Lb,B,R) :- - P is N>>1, - Q is N-P, - nf_mul_log(P,A0,A1,Lb,B,Rp), - nf_mul_log(Q,A1,A2,Lb,B,Rq), - nf_add(Rp,Rq,R). - - -% nf_add_2: does the same thing as nf_add, but only has 2 elements to combine. -nf_add_2(Af,Bf,Res) :- % unfold: nf_add([Af],[Bf],Res). - Af = v(Ka,Pa), - Bf = v(Kb,Pb), - compare(Rel,Pa,Pb), - nf_add_2_case(Rel,Af,Bf,Res,Ka,Kb,Pa). - -nf_add_2_case(<,Af,Bf,[Af,Bf],_,_,_). -nf_add_2_case(>,Af,Bf,[Bf,Af],_,_,_). -nf_add_2_case(=,_, _,Res,Ka,Kb,Pa) :- - Kc is Ka + Kb, - ( Kc =:= 0 - -> Res = [] - ; Res = [v(Kc,Pa)] - ). - -% nf_mul_k(A,B,C) -% -% C is the result of the multiplication of each element of A (of the form v(_,_)) with scalar B (which shouldn't be 0) -nf_mul_k([],_,[]). -nf_mul_k([v(I,P)|Vs],K,[v(Ki,P)|Vks]) :- - Ki is K*I, - nf_mul_k(Vs,K,Vks). - -% nf_mul_factor(A,Sum,Res) -% -% multiplies each element of the list Sum with factor A which is of the form v(_,_) -% and puts the result in the sorted list Res. -nf_mul_factor(v(K,[]),Sum,Res) :- - !, - nf_mul_k(Sum,K,Res). -nf_mul_factor(F,Sum,Res) :- - nf_length(Sum,0,Len), - nf_mul_factor_log(Len,Sum,[],F,Res). - -% nf_mul_factor_log(Len,[Sum|SumTail],SumTail,F,Res) -% -% multiplies each element of Sum with F and puts the result in the sorted list Res -% Len is the length of Sum -% Sum is split logarithmically each step - -nf_mul_factor_log(0,As,As,_,[]) :- !. -nf_mul_factor_log(1,[A|As],As,F,[R]) :- - !, - mult(A,F,R). -nf_mul_factor_log(2,[A,B|As],As,F,Res) :- - !, - mult(A,F,Af), - mult(B,F,Bf), - nf_add_2(Af,Bf,Res). -nf_mul_factor_log(N,A0,A2,F,R) :- - P is N>>1, % P is rounded(N/2) - Q is N-P, - nf_mul_factor_log(P,A0,A1,F,Rp), - nf_mul_factor_log(Q,A1,A2,F,Rq), - nf_add(Rp,Rq,R). - -% mult(A,B,C) -% -% multiplies A and B into C each of the form v(_,_) - -mult(v(Ka,La),v(Kb,Lb),v(Kc,Lc)) :- - Kc is Ka*Kb, - pmerge(La,Lb,Lc). - -% pmerge(A,B,C) -% -% multiplies A and B into sorted C, where each is of the form of the second argument of v(_,_) - -pmerge([],Bs,Bs). -pmerge([A|As],Bs,Cs) :- pmerge(Bs,A,As,Cs). - -pmerge([],A,As,Res) :- Res = [A|As]. -pmerge([B|Bs],A,As,Res) :- - A = Xa^Ka, - B = Xb^Kb, - compare(R,Xa,Xb), - pmerge_case(R,A,As,Res,B,Bs,Ka,Kb,Xa). - -% pmerge_case(Rel,A,As,Res,B,Bs,Ka,Kb,Xa) -% -% multiplies and sorts [A|As] with [B|Bs] into Res where each is of the form of -% the second argument of v(_,_) -% -% A is Xa^Ka and B is Xb^Kb, Rel is ordening relation between Xa and Xb - -pmerge_case(<,A,As,Res,B,Bs,_,_,_) :- - Res = [A|Tail], - pmerge(As,B,Bs,Tail). -pmerge_case(>,A,As,Res,B,Bs,_,_,_) :- - Res = [B|Tail], - pmerge(Bs,A,As,Tail). -pmerge_case(=,_,As,Res,_,Bs,Ka,Kb,Xa) :- - Kc is Ka + Kb, - ( Kc =:= 0 - -> pmerge(As,Bs,Res) - ; Res = [Xa^Kc|Tail], - pmerge(As,Bs,Tail) - ). - -% nf_div(Factor,In,Out) -% -% Out is the result of the division of each element in In (which is of the form v(_,_)) by Factor. - -% division by zero -nf_div([],_,_) :- - !, - zero_division. -% division by v(K,P) => multiplication by v(1/K,P^-1) -nf_div([v(K,P)],Sum,Res) :- - !, - Ki is 1 rdiv K, - mult_exp(P,-1,Pi), - nf_mul_factor(v(Ki,Pi),Sum,Res). -nf_div(D,A,[v(1,[(A/D)^1])]). - -% zero_division -% -% called when a division by zero is performed -zero_division :- fail. % raise_exception(_) ? - -% mult_exp(In,Factor,Out) -% -% Out is the result of the multiplication of the exponents of the elements in In -% (which are of the form X^Exp by Factor. -mult_exp([],_,[]). -mult_exp([X^P|Xs],K,[X^I|Tail]) :- - I is K*P, - mult_exp(Xs,K,Tail). -% -% raise to integer powers -% -% | ?- time({(1+X+Y+Z)^15=0}). (sicstus, try with SWI) -% Timing 00:00:02.610 2.610 iterative -% Timing 00:00:00.660 0.660 binomial -nf_power(N,Sum,Norm) :- - integer(N), - compare(Rel,N,0), - ( Rel = (<) - -> Pn is -N, - % nf_power_pos(Pn,Sum,Inorm), - binom(Sum,Pn,Inorm), - nf_div(Inorm,[v(1,[])],Norm) - ; Rel = (>) - -> % nf_power_pos(N,Sum,Norm) - binom(Sum,N,Norm) - ; Rel = (=) - -> % 0^0 is indeterminate but we say 1 - Norm = [v(1,[])] - ). -% -% N>0 -% -% iterative method: X^N = X*(X^N-1) -nf_power_pos(1,Sum,Norm) :- - !, - Sum = Norm. -nf_power_pos(N,Sum,Norm) :- - N1 is N-1, - nf_power_pos(N1,Sum,Pn1), - nf_mul(Sum,Pn1,Norm). -% -% N>0 -% -% binomial method -binom(Sum,1,Power) :- - !, - Power = Sum. -binom([],_,[]). -binom([A|Bs],N,Power) :- - ( Bs = [] - -> nf_power_factor(A,N,Ap), - Power = [Ap] - ; Bs = [_|_] - -> factor_powers(N,A,v(1,[]),Pas), - sum_powers(N,Bs,[v(1,[])],Pbs,[]), - combine_powers(Pas,Pbs,0,N,1,[],Power) - ). - -combine_powers([],[],_,_,_,Pi,Pi). -combine_powers([A|As],[B|Bs],L,R,C,Pi,Po) :- - nf_mul(A,B,Ab), - nf_mul_k(Ab,C,Abc), - nf_add(Abc,Pi,Pii), - L1 is L+1, - R1 is R-1, - C1 is C*R//L1, - combine_powers(As,Bs,L1,R1,C1,Pii,Po). - -nf_power_factor(v(K,P),N,v(Kn,Pn)) :- - Kn is K**N, - mult_exp(P,N,Pn). - -factor_powers(0,_,Prev,[[Prev]]) :- !. -factor_powers(N,F,Prev,[[Prev]|Ps]) :- - N1 is N-1, - mult(Prev,F,Next), - factor_powers(N1,F,Next,Ps). -sum_powers(0,_,Prev,[Prev|Lt],Lt) :- !. -sum_powers(N,S,Prev,L0,Lt) :- - N1 is N-1, - nf_mul(S,Prev,Next), - sum_powers(N1,S,Next,L0,[Prev|Lt]). - -% ------------------------------------------------------------------------------ -repair(Sum,Norm) :- - nf_length(Sum,0,Len), - repair_log(Len,Sum,[],Norm). -repair_log(0,As,As,[]) :- !. -repair_log(1,[v(Ka,Pa)|As],As,R) :- - !, - repair_term(Ka,Pa,R). -repair_log(2,[v(Ka,Pa),v(Kb,Pb)|As],As,R) :- - !, - repair_term(Ka,Pa,Ar), - repair_term(Kb,Pb,Br), - nf_add(Ar,Br,R). -repair_log(N,A0,A2,R) :- - P is N>>1, - Q is N-P, - repair_log(P,A0,A1,Rp), - repair_log(Q,A1,A2,Rq), - nf_add(Rp,Rq,R). - -repair_term(K,P,Norm) :- - length(P,Len), - repair_p_log(Len,P,[],Pr,[v(1,[])],Sum), - nf_mul_factor(v(K,Pr),Sum,Norm). - -repair_p_log(0,Ps,Ps,[],L0,L0) :- !. -repair_p_log(1,[X^P|Ps],Ps,R,L0,L1) :- - !, - repair_p(X,P,R,L0,L1). -repair_p_log(2,[X^Px,Y^Py|Ps],Ps,R,L0,L2) :- - !, - repair_p(X,Px,Rx,L0,L1), - repair_p(Y,Py,Ry,L1,L2), - pmerge(Rx,Ry,R). -repair_p_log(N,P0,P2,R,L0,L2) :- - P is N>>1, - Q is N-P, - repair_p_log(P,P0,P1,Rp,L0,L1), - repair_p_log(Q,P1,P2,Rq,L1,L2), - pmerge(Rp,Rq,R). - -repair_p(Term,P,[Term^P],L0,L0) :- var(Term). -repair_p(Term,P,[],L0,L1) :- - nonvar(Term), - repair_p_one(Term,TermN), - nf_power(P,TermN,TermNP), - nf_mul(TermNP,L0,L1). -% -% An undigested term a/b is distinguished from an -% digested one by the fact that its arguments are -% digested -> cuts after repair of args! -% -repair_p_one(Term,TermN) :- - nf_number(Term,TermN), % freq. shortcut for nf/2 case below - !. -repair_p_one(A1/A2,TermN) :- - repair(A1,A1n), - repair(A2,A2n), - !, - nf_div(A2n,A1n,TermN). -repair_p_one(Term,TermN) :- - nonlin_1(Term,Arg,Skel,Sa), - repair(Arg,An), - !, - nf_nonlin_1(Skel,An,Sa,TermN). -repair_p_one(Term,TermN) :- - nonlin_2(Term,A1,A2,Skel,Sa1,Sa2), - repair(A1,A1n), - repair(A2,A2n), - !, - nf_nonlin_2(Skel,A1n,A2n,Sa1,Sa2,TermN). -repair_p_one(Term,TermN) :- - nf(Term,TermN). - -nf_length([],Li,Li). -nf_length([_|R],Li,Lo) :- - Lii is Li+1, - nf_length(R,Lii,Lo). -% ------------------------------------------------------------------------------ -% nf2term(NF,Term) -% -% transforms a normal form into a readable term - -% empty normal form = 0 -nf2term([],0). -% term is first element (+ next elements) -nf2term([F|Fs],T) :- - f02t(F,T0), % first element - yfx(Fs,T0,T). % next elements - -yfx([],T0,T0). -yfx([F|Fs],T0,TN) :- - fn2t(F,Ft,Op), - T1 =.. [Op,T0,Ft], - yfx(Fs,T1,TN). - -% f02t(v(K,P),T) -% -% transforms the first element of the normal form (something of the form v(K,P)) -% into a readable term -f02t(v(K,P),T) :- - ( % just a constant - P = [] - -> T = K - ; K =:= 1 - -> p2term(P,T) - ; K =:= -1 - -> T = -Pt, - p2term(P,Pt) - ; T = K*Pt, - p2term(P,Pt) - ). - -% f02t(v(K,P),T,Op) -% -% transforms a next element of the normal form (something of the form v(K,P)) -% into a readable term -fn2t(v(K,P),Term,Op) :- - ( K =:= 1 - -> Term = Pt, - Op = + - ; K =:= -1 - -> Term = Pt, - Op = - - ; K < 0 - -> Kf is -K, - Term = Kf*Pt, - Op = - - ; Term = K*Pt, - Op = + - ), - p2term(P,Pt). - -% transforms the P part in v(_,P) into a readable term -p2term([X^P|Xs],Term) :- - ( Xs = [] - -> pe2term(X,Xt), - exp2term(P,Xt,Term) - ; Xs = [_|_] - -> Term = Xst*Xtp, - pe2term(X,Xt), - exp2term(P,Xt,Xtp), - p2term(Xs,Xst) - ). - -% -exp2term(1,X,X) :- !. -exp2term(-1,X,1/X) :- !. -exp2term(P,X,Term) :- - % Term = exp(X,Pn) - Term = X^P. - -pe2term(X,Term) :- - var(X), - Term = X. -pe2term(X,Term) :- - nonvar(X), - X =.. [F|Args], - pe2term_args(Args,Argst), - Term =.. [F|Argst]. - -pe2term_args([],[]). -pe2term_args([A|As],[T|Ts]) :- - nf2term(A,T), - pe2term_args(As,Ts). - -% transg(Goal,[OutList|OutListTail],OutListTail) -% -% puts the equalities and inequalities that are implied by the elements in Goal -% in the difference list OutList -% -% called by geler.pl for project.pl - -transg(resubmit_eq(Nf)) --> - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpq:{Term=Z}]. -transg(resubmit_lt(Nf)) --> - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpq:{Term - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpq:{Term= - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpq:{Term=\=Z}]. -transg(wait_linear_retry(Nf,Res,Goal)) --> - { - nf2term(Nf,Term) - }, - [clpq:{Term=Res},Goal]. \ No newline at end of file diff --git a/GPL/clpqr/clpq/store_q.pl b/GPL/clpqr/clpq/store_q.pl deleted file mode 100644 index a7c304b7e..000000000 --- a/GPL/clpqr/clpq/store_q.pl +++ /dev/null @@ -1,398 +0,0 @@ -/* $Id: store_q.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(store_q, - [ - add_linear_11/3, - add_linear_f1/4, - add_linear_ff/5, - normalize_scalar/2, - delete_factor/4, - mult_linear_factor/3, - nf_rhs_x/4, - indep/2, - isolate/3, - nf_substitute/4, - mult_hom/3, - nf2sum/3, - nf_coeff_of/3, - renormalize/2 - ]). - -% normalize_scalar(S,[N,Z]) -% -% Transforms a scalar S into a linear expression [S,0] - -normalize_scalar(S,[S,0]). - -% renormalize(List,Lin) -% -% Renormalizes the not normalized linear expression in List into -% a normalized one. It does so to take care of unifications. -% (e.g. when a variable X is bound to a constant, the constant is added to -% the constant part of the linear expression; when a variable X is bound to -% another variable Y, the scalars of both are added) - -renormalize([I,R|Hom],Lin) :- - length(Hom,Len), - renormalize_log(Len,Hom,[],Lin0), - add_linear_11([I,R],Lin0,Lin). - -% renormalize_log(Len,Hom,HomTail,Lin) -% -% Logarithmically renormalizes the homogene part of a not normalized -% linear expression. See also renormalize/2. - -renormalize_log(1,[Term|Xs],Xs,Lin) :- - !, - Term = l(X*_,_), - renormalize_log_one(X,Term,Lin). -renormalize_log(2,[A,B|Xs],Xs,Lin) :- - !, - A = l(X*_,_), - B = l(Y*_,_), - renormalize_log_one(X,A,LinA), - renormalize_log_one(Y,B,LinB), - add_linear_11(LinA,LinB,Lin). -renormalize_log(N,L0,L2,Lin) :- - P is N>>1, - Q is N-P, - renormalize_log(P,L0,L1,Lp), - renormalize_log(Q,L1,L2,Lq), - add_linear_11(Lp,Lq,Lin). - -% renormalize_log_one(X,Term,Res) -% -% Renormalizes a term in X: if X is a nonvar, the term becomes a scalar. - -renormalize_log_one(X,Term,Res) :- - var(X), - Term = l(X*K,_), - get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), % Order might have changed - Res = [0,0,l(X*K,OrdX)]. -renormalize_log_one(X,Term,Res) :- - nonvar(X), - Term = l(X*K,_), - Xk is X*K, - normalize_scalar(Xk,Res). - -% ----------------------------- sparse vector stuff ---------------------------- % - -% add_linear_ff(LinA,Ka,LinB,Kb,LinC) -% -% Linear expression LinC is the result of the addition of the 2 linear expressions -% LinA and LinB, each one multiplied by a scalar (Ka for LinA and Kb for LinB). - -add_linear_ff(LinA,Ka,LinB,Kb,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia*Ka+Ib*Kb, - Rc is Ra*Ka+Rb*Kb, - add_linear_ffh(Ha,Ka,Hb,Kb,Hc). - -% add_linear_ffh(Ha,Ka,Hb,Kb,Hc) -% -% Homogene part Hc is the result of the addition of the 2 homogene parts Ha and Hb, -% each one multiplied by a scalar (Ka for Ha and Kb for Hb) - -add_linear_ffh([],_,Ys,Kb,Zs) :- mult_hom(Ys,Kb,Zs). -add_linear_ffh([l(X*Kx,OrdX)|Xs],Ka,Ys,Kb,Zs) :- - add_linear_ffh(Ys,X,Kx,OrdX,Xs,Zs,Ka,Kb). - -% add_linear_ffh(Ys,X,Kx,OrdX,Xs,Zs,Ka,Kb) -% -% Homogene part Zs is the result of the addition of the 2 homogene parts Ys and -% [l(X*Kx,OrdX)|Xs], each one multiplied by a scalar (Ka for [l(X*Kx,OrdX)|Xs] and Kb for Ys) - -add_linear_ffh([],X,Kx,OrdX,Xs,Zs,Ka,_) :- mult_hom([l(X*Kx,OrdX)|Xs],Ka,Zs). -add_linear_ffh([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs,Ka,Kb) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx*Ka+Ky*Kb, - ( Kz =:= 0 - -> add_linear_ffh(Xs,Ka,Ys,Kb,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_ffh(Xs,Ka,Ys,Kb,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kz,OrdX)|Ztail], - Kz is Kx*Ka, - add_linear_ffh(Xs,Y,Ky,OrdY,Ys,Ztail,Kb,Ka) - ; Rel = (>) - -> Zs = [l(Y*Kz,OrdY)|Ztail], - Kz is Ky*Kb, - add_linear_ffh(Ys,X,Kx,OrdX,Xs,Ztail,Ka,Kb) - ). - -% add_linear_f1(LinA,Ka,LinB,LinC) -% -% special case of add_linear_ff with Kb = 1 - -add_linear_f1(LinA,Ka,LinB,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia*Ka+Ib, - Rc is Ra*Ka+Rb, - add_linear_f1h(Ha,Ka,Hb,Hc). - -% add_linear_f1h(Ha,Ka,Hb,Hc) -% -% special case of add_linear_ffh/5 with Kb = 1 - -add_linear_f1h([],_,Ys,Ys). -add_linear_f1h([l(X*Kx,OrdX)|Xs],Ka,Ys,Zs) :- - add_linear_f1h(Ys,X,Kx,OrdX,Xs,Zs,Ka). - -% add_linear_f1h(Ys,X,Kx,OrdX,Xs,Zs,Ka) -% -% special case of add_linear_ffh/8 with Kb = 1 - -add_linear_f1h([],X,Kx,OrdX,Xs,Zs,Ka) :- mult_hom([l(X*Kx,OrdX)|Xs],Ka,Zs). -add_linear_f1h([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs,Ka) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx*Ka+Ky, - ( Kz =:= 0 - -> add_linear_f1h(Xs,Ka,Ys,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_f1h(Xs,Ka,Ys,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kz,OrdX)|Ztail], - Kz is Kx*Ka, - add_linear_f1h(Xs,Ka,[l(Y*Ky,OrdY)|Ys],Ztail) - ; Rel = (>) - -> Zs = [l(Y*Ky,OrdY)|Ztail], - add_linear_f1h(Ys,X,Kx,OrdX,Xs,Ztail,Ka) - ). - -% add_linear_11(LinA,LinB,LinC) -% -% special case of add_linear_ff with Ka = 1 and Kb = 1 - -add_linear_11(LinA,LinB,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia+Ib, - Rc is Ra+Rb, - add_linear_11h(Ha,Hb,Hc). - -% add_linear_11h(Ha,Hb,Hc) -% -% special case of add_linear_ffh/5 with Ka = 1 and Kb = 1 - -add_linear_11h([],Ys,Ys). -add_linear_11h([l(X*Kx,OrdX)|Xs],Ys,Zs) :- - add_linear_11h(Ys,X,Kx,OrdX,Xs,Zs). - -% add_linear_11h(Ys,X,Kx,OrdX,Xs,Zs) -% -% special case of add_linear_ffh/8 with Ka = 1 and Kb = 1 - -add_linear_11h([],X,Kx,OrdX,Xs,[l(X*Kx,OrdX)|Xs]). -add_linear_11h([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx+Ky, - ( Kz =:= 0 - -> add_linear_11h(Xs,Ys,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_11h(Xs,Ys,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kx,OrdX)|Ztail], - add_linear_11h(Xs,Y,Ky,OrdY,Ys,Ztail) - ; Rel = (>) - -> Zs = [l(Y*Ky,OrdY)|Ztail], - add_linear_11h(Ys,X,Kx,OrdX,Xs,Ztail) - ). - -% mult_linear_factor(Lin,K,Res) -% -% Linear expression Res is the result of multiplication of linear -% expression Lin by scalar K - -mult_linear_factor(Lin,K,Mult) :- - K =:= 1, - !, - Mult = Lin. -mult_linear_factor(Lin,K,Res) :- - Lin = [I,R|Hom], - Res = [Ik,Rk|Mult], - Ik is I*K, - Rk is R*K, - mult_hom(Hom,K,Mult). - -% mult_hom(Hom,K,Res) -% -% Homogene part Res is the result of multiplication of homogene part -% Hom by scalar K - -mult_hom([],_,[]). -mult_hom([l(A*Fa,OrdA)|As],F,[l(A*Fan,OrdA)|Afs]) :- - Fan is F*Fa, - mult_hom(As,F,Afs). - -% nf_substitute(Ord,Def,Lin,Res) -% -% Linear expression Res is the result of substitution of Var in -% linear expression Lin, by its definition in the form of linear -% expression Def - -nf_substitute(OrdV,LinV,LinX,LinX1) :- - delete_factor(OrdV,LinX,LinW,K), - add_linear_f1(LinV,K,LinW,LinX1). - -% delete_factor(Ord,Lin,Res,Coeff) -% -% Linear expression Res is the result of the deletion of the term -% Var*Coeff where Var has ordering Ord from linear expression Lin - -delete_factor(OrdV,Lin,Res,Coeff) :- - Lin = [I,R|Hom], - Res = [I,R|Hdel], - delete_factor_hom(OrdV,Hom,Hdel,Coeff). - -% delete_factor_hom(Ord,Hom,Res,Coeff) -% -% Homogene part Res is the result of the deletion of the term -% Var*Coeff from homogene part Hom - -delete_factor_hom(VOrd,[Car|Cdr],RCdr,RKoeff) :- - Car = l(_*Koeff,Ord), - compare(Rel,VOrd,Ord), - ( Rel= (=) - -> RCdr = Cdr, - RKoeff=Koeff - ; Rel= (>) - -> RCdr = [Car|RCdr1], - delete_factor_hom(VOrd,Cdr,RCdr1,RKoeff) - ). - - -% nf_coeff_of(Lin,OrdX,Coeff) -% -% Linear expression Lin contains the term l(X*Coeff,OrdX) - -nf_coeff_of([_,_|Hom],VOrd,Coeff) :- - nf_coeff_hom(Hom,VOrd,Coeff). - -% nf_coeff_hom(Lin,OrdX,Coeff) -% -% Linear expression Lin contains the term l(X*Coeff,OrdX) where the -% order attribute of X = OrdX - -nf_coeff_hom([l(_*K,OVar)|Vs],OVid,Coeff) :- - compare(Rel,OVid,OVar), - ( Rel = (=) - -> Coeff = K - ; Rel = (>) - -> nf_coeff_hom(Vs,OVid,Coeff) - ). - -% nf_rhs_x(Lin,OrdX,Rhs,K) -% -% Rhs = R + I where Lin = [I,R|Hom] and l(X*K,OrdX) is a term of Hom - -nf_rhs_x(Lin,OrdX,Rhs,K) :- - Lin = [I,R|Tail], - nf_coeff_hom(Tail,OrdX,K), - Rhs is R+I. % late because X may not occur in H - -% isolate(OrdN,Lin,Lin1) -% -% Linear expression Lin1 is the result of the transformation of linear expression -% Lin = 0 which contains the term l(New*K,OrdN) into an equivalent expression Lin1 = New. - -isolate(OrdN,Lin,Lin1) :- - delete_factor(OrdN,Lin,Lin0,Coeff), - K is -1 rdiv Coeff, - mult_linear_factor(Lin0,K,Lin1). - -% indep(Lin,OrdX) -% -% succeeds if Lin = [0,_|[l(X*1,OrdX)]] - -indep(Lin,OrdX) :- - Lin = [I,_|[l(_*K,OrdY)]], - OrdX == OrdY, - K =:= 1, - I =:= 0. - -% nf2sum(Lin,Sofar,Term) -% -% Transforms a linear expression into a sum -% (e.g. the expression [5,_,[l(X*2,OrdX),l(Y*-1,OrdY)]] gets transformed into 5 + 2*X - Y) - -nf2sum([],I,I). -nf2sum([X|Xs],I,Sum) :- - ( I =:= 0 - -> X = l(Var*K,_), - ( K =:= 1 - -> hom2sum(Xs,Var,Sum) - ; K =:= -1 - -> hom2sum(Xs,-Var,Sum) - ; hom2sum(Xs,K*Var,Sum) - ) - ; hom2sum([X|Xs],I,Sum) - ). - -% hom2sum(Hom,Sofar,Term) -% -% Transforms a linear expression into a sum -% this predicate handles all but the first term -% (the first term does not need a concatenation symbol + or -) -% see also nf2sum/3 - -hom2sum([],Term,Term). -hom2sum([l(Var*K,_)|Cs],Sofar,Term) :- - ( K =:= 1 - -> Next = Sofar + Var - ; K =:= -1 - -> Next = Sofar - Var - ; K < 0 - -> Ka is -K, - Next = Sofar - Ka*Var - ; Next = Sofar + K*Var - ), - hom2sum(Cs,Next,Term). \ No newline at end of file diff --git a/GPL/clpqr/clpqr/class.pl b/GPL/clpqr/clpqr/class.pl deleted file mode 100644 index 727e13dde..000000000 --- a/GPL/clpqr/clpqr/class.pl +++ /dev/null @@ -1,155 +0,0 @@ -/* $Id: class.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(class, - [ - class_allvars/2, - class_new/5, - class_drop/2, - class_basis/2, - class_basis_add/3, - class_basis_drop/2, - class_basis_pivot/3, - class_get_clp/2, - class_get_prio/2, - class_put_prio/2, - ordering/1, - arrangement/2 - ]). - -:- use_module(ordering, - [ - combine/3, - ordering/1, - arrangement/2 - ]). -:- use_module(library(lists), - [ append/3 - ]). - -% called when two classes are unified: the allvars lists are appended to eachother, as well as the basis -% lists. -% -% note: La=[A,B,...,C|Lat], Lb=[D,E,...,F|Lbt], so new La = [A,B,...,C,D,E,...,F|Lbt] - -attr_unify_hook(class(CLP,La,Lat,ABasis,PrioA),Y) :- - !, - var(Y), - get_attr(Y,class,class(CLP,Lb,Lbt,BBasis,PrioB)), - Lat = Lb, - append(ABasis,BBasis,CBasis), - combine(PrioA,PrioB,PrioC), - put_attr(Y,class,class(CLP,La,Lbt,CBasis,PrioC)). -attr_unify_hook(_,_). - -class_new(Class,CLP,All,AllT,Basis) :- - put_attr(Su,class,class(CLP,All,AllT,Basis,[])), - Su = Class. - -class_get_prio(Class,Priority) :- - get_attr(Class,class,class(_,_,_,_,Priority)). - -class_get_clp(Class,CLP) :- - get_attr(Class,class,class(CLP,_,_,_,_)). - -class_put_prio(Class,Priority) :- - get_attr(Class,class,class(CLP,All,AllT,Basis,_)), - put_attr(Class,class,class(CLP,All,AllT,Basis,Priority)). - -class_drop(Class,X) :- - get_attr(Class,class,class(CLP,Allvars,Tail,Basis,Priority)), - delete_first(Allvars,X,NewAllvars), - delete_first(Basis,X,NewBasis), - put_attr(Class,class,class(CLP,NewAllvars,Tail,NewBasis,Priority)). - -class_allvars(Class,All) :- get_attr(Class,class,class(_,All,_,_,_)). - -% class_basis(Class,Basis) -% -% Returns the basis of class Class. - -class_basis(Class,Basis) :- get_attr(Class,class,class(_,_,_,Basis,_)). - -% class_basis_add(Class,X,NewBasis) -% -% adds X in front of the basis and returns the new basis - -class_basis_add(Class,X,NewBasis) :- - NewBasis = [X|Basis], - get_attr(Class,class,class(CLP,All,AllT,Basis,Priority)), - put_attr(Class,class,class(CLP,All,AllT,NewBasis,Priority)). - -% class_basis_drop(Class,X) -% -% removes the first occurence of X from the basis (if exists) - -class_basis_drop(Class,X) :- - get_attr(Class,class,class(CLP,All,AllT,Basis0,Priority)), - delete_first(Basis0,X,Basis), - Basis0 \== Basis, % anything deleted ? - !, - put_attr(Class,class,class(CLP,All,AllT,Basis,Priority)). -class_basis_drop(_,_). - -% class_basis_pivot(Class,Enter,Leave) -% -% removes first occurence of Leave from the basis and adds Enter in front of the basis - -class_basis_pivot(Class,Enter,Leave) :- - get_attr(Class,class,class(CLP,All,AllT,Basis0,Priority)), - delete_first(Basis0,Leave,Basis1), - put_attr(Class,class,class(CLP,All,AllT,[Enter|Basis1],Priority)). - -% delete_first(Old,Element,New) -% -% removes the first occurence of Element from Old and returns the result in New -% -% note: test via syntactic equality, not unifiability - -delete_first(L,_,Res) :- - var(L), - !, - Res = L. -delete_first([],_,[]). -delete_first([Y|Ys],X,Res) :- - ( X==Y - -> Res = Ys - ; Res = [Y|Tail], - delete_first(Ys,X,Tail) - ). diff --git a/GPL/clpqr/clpqr/dump.pl b/GPL/clpqr/clpqr/dump.pl deleted file mode 100644 index dd8aeb242..000000000 --- a/GPL/clpqr/clpqr/dump.pl +++ /dev/null @@ -1,303 +0,0 @@ -/* $Id: dump.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(dump, - [ - dump/3, - projecting_assert/1 - ]). -:- use_module(class, - [ - class_allvars/2 - ]). -:- use_module(geler, - [ - collect_nonlin/3 - ]). -:- use_module(library(assoc), - [ - empty_assoc/1, - get_assoc/3, - put_assoc/4, - assoc_to_list/2 - ]). -:- use_module(itf, - [ - dump_linear/3, - dump_nonzero/3 - ]). -:- use_module(project, - [ - project_attributes/2 - ]). -:- use_module(ordering, - [ - ordering/1 - ]). - -% dump(Target,NewVars,Constraints) -% -% Returns in , the constraints that currently hold on Target where -% all variables in are copied to new variables in and the -% constraints are given on these new variables. In short, you can safely -% manipulate and without changing the constraints on -% . - -dump([],[],[]) :- !. -dump(Target,NewVars,Constraints) :- - ( ( proper_varlist(Target) - -> true - ; % Target is not a list of variables - throw(instantiation_error(dump(Target,NewVars,Constraints),1)) - ), - ordering(Target), - related_linear_vars(Target,All), % All contains all variables of the classes of Target variables. - nonlin_crux(All,Nonlin), - project_attributes(Target,All), - related_linear_vars(Target,Again), % project drops/adds vars - all_attribute_goals(Again,Gs,Nonlin), - empty_assoc(D0), - mapping(Target,NewVars,D0,D1), % late (AVL suffers from put_atts) - copy(Gs,Copy,D1,_), % strip constraints - nb_setval(clpqr_dump,NewVars/Copy), - fail % undo projection - ; catch(nb_getval(clpqr_dump,NewVars/Constraints),_,fail), - nb_delete(clpqr_dump) - ). - -:- meta_predicate projecting_assert(:). - -projecting_assert(QClause) :- - strip_module(QClause, Module, Clause), % JW: SWI-Prolog not always qualifies the term! - copy_term(Clause,Copy,Constraints), - l2c(Constraints,Conj), % fails for [] - ( Sm = clpq - ; Sm = clpr - ), % proper module for {}/1 - !, - ( Copy = (H:-B) - -> % former rule - Module:assert((H:-Sm:{Conj},B)) - ; % former fact - Module:assert((Copy:-Sm:{Conj})) - ). -projecting_assert(Clause) :- % not our business - assert(Clause). - -copy_term(Term,Copy,Constraints) :- - ( term_variables(Term,Target), % get all variables in Term - related_linear_vars(Target,All), % get all variables of the classes of the variables in Term - nonlin_crux(All,Nonlin), % get a list of all the nonlinear goals of these variables - project_attributes(Target,All), - related_linear_vars(Target,Again), % project drops/adds vars - all_attribute_goals(Again,Gs,Nonlin), - empty_assoc(D0), - copy(Term/Gs,TmpCopy,D0,_), % strip constraints - nb_setval(clpqr_dump,TmpCopy), - fail - ; catch(nb_getval(clpqr_dump,Copy/Constraints),_,fail), - nb_delete(clpqr_copy_term) - ). - -% l2c(Lst,Conj) -% -% converts a list to a round list: [a,b,c] -> (a,b,c) and [a] becomes a - -l2c([X|Xs],Conj) :- - ( Xs = [] - -> Conj = X - ; Conj = (X,Xc), - l2c(Xs,Xc) - ). - -% proper_varlist(List) -% -% Returns whether Lst is a list of variables. -% First clause is to avoid unification of a variable with a list. - -proper_varlist(X) :- - var(X), - !, - fail. -proper_varlist([]). -proper_varlist([X|Xs]) :- - var(X), - proper_varlist(Xs). - -% related_linear_vars(Vs,All) -% -% Generates a list of all variables that are in the classes of the variables in -% Vs. - -related_linear_vars(Vs,All) :- - empty_assoc(S0), - related_linear_sys(Vs,S0,Sys), - related_linear_vars(Sys,All,[]). - -% related_linear_sys(Vars,Assoc,List) -% -% Generates in List, a list of all to classes to which variables in Vars -% belong. -% Assoc should be an empty association list and is used internally. -% List contains elements of the form C-C where C is a class and both C's are -% equal. - -related_linear_sys([],S0,L0) :- assoc_to_list(S0,L0). -related_linear_sys([V|Vs],S0,S2) :- - ( get_attr(V,itf,Att), - arg(6,Att,class(C)) - -> put_assoc(C,S0,C,S1) - ; S1 = S0 - ), - related_linear_sys(Vs,S1,S2). - -% related_linear_vars(Classes,[Vars|VarsTail],VarsTail) -% -% Generates a difference list of all variables in the classes in Classes. -% Classes contains elements of the form C-C where C is a class and both C's are -% equal. - -related_linear_vars([]) --> []. -related_linear_vars([S-_|Ss]) --> - { - class_allvars(S,Otl) - }, - cpvars(Otl), - related_linear_vars(Ss). - -% cpvars(Vars,Out,OutTail) -% -% Makes a new difference list of the difference list Vars. -% All nonvars are removed. - -cpvars(Xs) --> {var(Xs)}, !. -cpvars([X|Xs]) --> - ( { var(X) } - -> [X] - ; [] - ), - cpvars(Xs). - -% nonlin_crux(All,Gss) -% -% Collects all pending non-linear constraints of variables in All. -% This marks all nonlinear goals of the variables as run and cannot -% be reversed manually. - -nonlin_crux(All,Gss) :- - collect_nonlin(All,Gs,[]), % collect the nonlinear goals of variables All - % this marks the goals as run and cannot be reversed manually - nonlin_strip(Gs,Gss). - -% nonlin_strip(Gs,Solver,Res) -% -% Removes the goals from Gs that are not from solver Solver. - -nonlin_strip([],[]). -nonlin_strip([_:What|Gs],Res) :- - ( What = {G} - -> Res = [G|Gss] - ; Res = [What|Gss] - ), - nonlin_strip(Gs,Gss). - -all_attribute_goals([]) --> []. -all_attribute_goals([V|Vs]) --> - dump_linear(V), - dump_nonzero(V), - all_attribute_goals(Vs). - -% mapping(L1,L2,AssocIn,AssocOut) -% -% Makes an association mapping of lists L1 and L2: -% L1 = [L1H|L1T] and L2 = [L2H|L2T] then the association L1H-L2H is formed -% and the tails are mapped similarly. - -mapping([],[],D0,D0). -mapping([T|Ts],[N|Ns],D0,D2) :- - put_assoc(T,D0,N,D1), - mapping(Ts,Ns,D1,D2). - -% copy(Term,Copy,AssocIn,AssocOut) -% -% Makes a copy of Term by changing all variables in it to new ones and -% building an association between original variables and the new ones. -% E.g. when Term = test(A,B,C), Copy = test(D,E,F) and an association between -% A and D, B and E and C and F is formed in AssocOut. AssocIn is input -% association. - -copy(Term,Copy,D0,D1) :- - var(Term), - ( get_assoc(Term,D0,New) - -> Copy = New, - D1 = D0 - ; put_assoc(Term,D0,Copy,D1) - ). -copy(Term,Copy,D0,D1) :- - nonvar(Term), % Term is a functor - functor(Term,N,A), - functor(Copy,N,A), % Copy is new functor with the same name and arity as Term - copy(A,Term,Copy,D0,D1). - -% copy(Nb,Term,Copy,AssocIn,AssocOut) -% -% Makes a copy of the Nb arguments of Term by changing all variables in it to -% new ones and building an association between original variables and the new -% ones. -% See also copy/4 - -copy(0,_,_,D0,D0) :- !. -copy(1,T,C,D0,D1) :- !, - arg(1,T,At1), - arg(1,C,Ac1), - copy(At1,Ac1,D0,D1). -copy(2,T,C,D0,D2) :- !, - arg(1,T,At1), - arg(1,C,Ac1), - copy(At1,Ac1,D0,D1), - arg(2,T,At2), - arg(2,C,Ac2), - copy(At2,Ac2,D1,D2). -copy(N,T,C,D0,D2) :- - arg(N,T,At), - arg(N,C,Ac), - copy(At,Ac,D0,D1), - N1 is N-1, - copy(N1,T,C,D1,D2). \ No newline at end of file diff --git a/GPL/clpqr/clpqr/geler.pl b/GPL/clpqr/clpqr/geler.pl deleted file mode 100644 index 471597ba0..000000000 --- a/GPL/clpqr/clpqr/geler.pl +++ /dev/null @@ -1,192 +0,0 @@ -/* $Id: geler.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(geler, - [ - geler/3, - project_nonlin/3, - collect_nonlin/3 - ]). - -% l2conj(List,Conj) -% -% turns a List into a conjunction of the form (El,Conj) where Conj -% is of the same form recursively and El is an element of the list - -l2conj([X|Xs],Conj) :- - ( X = [], - Conj = X - ; Xs = [_|_], - Conj = (X,Xc), - l2conj(Xs,Xc) - ). - -% nonexhausted(Goals,OutList,OutListTail) -% -% removes the goals that have already run from Goals -% and puts the result in the difference list OutList - -nonexhausted(run(Mutex,G)) --> - ( { var(Mutex) } - -> [G] - ; [] - ). -nonexhausted((A,B)) --> - nonexhausted(A), - nonexhausted(B). - -attr_unify_hook(g(CLP,goals(Gx),_),Y) :- - !, - ( var(Y), - ( get_attr(Y,geler,g(A,B,C)) - -> ignore((CLP \== A,throw(error(permission_error( - 'apply CLP(Q) constraints on','CLP(R) variable',Y), - context(_))))), - ( % possibly mutual goals. these need to be run. - % other goals are run as well to remove redundant goals. - B = goals(Gy) - -> Later = [Gx,Gy], - ( C = n - -> del_attr(Y,geler) - ; put_attr(Y,geler,g(CLP,n,C)) - ) - ; % no goals in Y, so no mutual goals of X and Y, store - % goals of X in Y - % no need to run any goal. - Later = [], - put_attr(Y,geler,g(CLP,goals(Gx),C)) - ) - ; Later = [], - put_attr(Y,geler,g(CLP,goals(Gx),n)) - ) - ; nonvar(Y), - Later = [Gx] - ), - maplist(call,Later). -attr_unify_hook(_,_). % no goals in X - -% -% called from project.pl -% -project_nonlin(_,Cvas,Reachable) :- - collect_nonlin(Cvas,L,[]), - sort(L,Ls), - term_variables(Ls,Reachable). - %put_attr(_,all_nonlin(Ls)). - - -collect_nonlin([]) --> []. -collect_nonlin([X|Xs]) --> - ( { get_attr(X,geler,g(_,goals(Gx),_)) } - -> trans(Gx), - collect_nonlin(Xs) - ; collect_nonlin(Xs) - ). - -% trans(Goals,OutList,OutListTail) -% -% transforms the goals (of the form run(Mutex,Goal) -% that are in Goals (in the conjunction form, see also l2conj) -% that have not been run (Mutex = variable) into a readable output format -% and notes that they're done (Mutex = 'done'). Because of the Mutex -% variable, each goal is only added once (so not for each variable). - -trans((A,B)) --> - trans(A), - trans(B). -trans(run(Mutex,Gs)) --> - ( { var(Mutex) } - -> { Mutex = done }, - transg(Gs) - ; [] - ). - -transg((A,B)) --> - !, - transg(A), - transg(B). -transg(M:G) --> - !, - M:transg(G). -transg(G) --> [G]. - -% run(Mutex,G) -% -% Calls goal G if it has not yet run (Mutex is still variable) -% and stores that it has run (Mutex = done). This is done so -% that when X = Y and X and Y are in the same goal, that goal -% is called only once. - -run(Mutex,_) :- nonvar(Mutex). -run(Mutex,G) :- - var(Mutex), - Mutex = done, - call(G). - -% geler(Vars,Goal) -% -% called by nf.pl when an unsolvable non-linear expression is found -% Vars contain the variables of the expression, Goal contains the predicate of -% nf.pl to be called when the variables are bound. - -geler(CLP,Vars,Goal) :- - attach(Vars,CLP,run(_Mutex,Goal)). - % one goal gets the same mutex on every var, so it is run only once - -% attach(Vars,Goal) -% -% attaches a new goal to be awoken when the variables get bounded. -% when the old value of the attribute goals = OldGoal, then the new value = -% (Goal,OldGoal) - -attach([],_,_). -attach([V|Vs],CLP,Goal) :- - var(V), - ( get_attr(V,geler,g(A,B,C)) - -> ( CLP \== A - -> throw(error(permission_error('apply CLP(Q) constraints on', - 'CLP(R) variable',V),context(_))) - ; ( B = goals(Goals) - -> put_attr(V,geler,g(A,goals((Goal,Goals)),C)) - ; put_attr(V,geler,g(A,goals(Goal),C)) - ) - ) - ; put_attr(V,geler,g(CLP,goals(Goal),n)) - ), - attach(Vs,CLP,Goal). \ No newline at end of file diff --git a/GPL/clpqr/clpqr/itf.pl b/GPL/clpqr/clpqr/itf.pl deleted file mode 100644 index cd245a616..000000000 --- a/GPL/clpqr/clpqr/itf.pl +++ /dev/null @@ -1,123 +0,0 @@ -/* - - Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -% attribute = t(CLP,type(_),strictness(_),lin(_),order(_),class(_),forward(_), -% nonzero,target,keep_indep,keep) - -:- module(itf, - [ - dump_linear/3, - dump_nonzero/3, - clp_type/2 - ]). - -clp_type(Var,Type) :- - ( get_attr(Var,itf,Att) - -> arg(1,Att,Type) - ; get_attr(Var,geler,Att) - -> arg(1,Att,Type) - ). - -dump_linear(V) --> - { - get_attr(V,itf,Att), - arg(1,Att,CLP), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - !, - Lin = [I,_|H] - }, - ( { - Type=t_none - ; arg(9,Att,n) - } - -> [] - ; dump_v(CLP,t_none,V,I,H) - ), - ( { - Type=t_none, - arg(9,Att,n) % attribute should not have changed by dump_v... - } - -> % nonzero produces such - [] - ; dump_v(CLP,Type,V,I,H) - ). -dump_linear(_) --> []. - -dump_v(clpq,Type,V,I,H) --> bv_q:dump_var(Type,V,I,H). -dump_v(clpr,Type,V,I,H) --> bv_r:dump_var(Type,V,I,H). - -dump_nonzero(V) --> - { - get_attr(V,itf,Att), - arg(1,Att,CLP), - arg(4,Att,lin(Lin)), - arg(8,Att,nonzero), - !, - Lin = [I,_|H] - }, - dump_nz(CLP,V,H,I). -dump_nonzero(_) --> []. - -dump_nz(clpq,V,H,I) --> bv_q:dump_nz(V,H,I). -dump_nz(clpr,V,H,I) --> bv_r:dump_nz(V,H,I). - -attr_unify_hook(t(CLP,n,n,n,n,n,n,n,_,_,_),Y) :- - !, - ( get_attr(Y,itf,AttY), - \+ arg(1,AttY,CLP) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',Y),context(_))) - ; true - ). -attr_unify_hook(t(CLP,Ty,St,Li,Or,Cl,_,No,_,_,_),Y) :- - ( get_attr(Y,itf,AttY), - \+ arg(1,AttY,CLP) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',Y),context(_))) - ; true - ), - do_checks(CLP,Y,Ty,St,Li,Or,Cl,No,Later), - maplist(call,Later). - -do_checks(clpq,Y,Ty,St,Li,Or,Cl,No,Later) :- - itf_q:do_checks(Y,Ty,St,Li,Or,Cl,No,Later). -do_checks(clpr,Y,Ty,St,Li,Or,Cl,No,Later) :- - itf_r:do_checks(Y,Ty,St,Li,Or,Cl,No,Later). \ No newline at end of file diff --git a/GPL/clpqr/clpqr/ordering.pl b/GPL/clpqr/clpqr/ordering.pl deleted file mode 100644 index e140c1f70..000000000 --- a/GPL/clpqr/clpqr/ordering.pl +++ /dev/null @@ -1,198 +0,0 @@ -/* $Id: ordering.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(Q) (Constraint Logic Programming over Rationals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(ordering, - [ - combine/3, - ordering/1, - arrangement/2 - ]). -:- use_module(class, - [ - class_get_clp/2, - class_get_prio/2, - class_put_prio/2 - ]). -:- use_module(itf, - [ - clp_type/2 - ]). -:- use_module(library(ugraphs), - [ - add_edges/3, - add_vertices/3, - top_sort/2, - ugraph_union/3 - ]). -:- use_module(library(lists), - [ - append/3 - ]). - -ordering(X) :- - var(X), - !, - fail. -ordering(A>B) :- - !, - ordering(B clp_type(X,CLP), - ( CLP = clpr - -> bv_r:var_intern(X,Class) - ; bv_q:var_intern(X,Class) - ) - ; true - ), - join_class(Xs,Class). - -% combine(Ga,Gb,Gc) -% -% Combines the vertices of Ga and Gb into Gc. - -combine(Ga,Gb,Gc) :- - normalize(Ga,Gan), - normalize(Gb,Gbn), - ugraph_union(Gan,Gbn,Gc). - -% -% both Ga and Gb might have their internal ordering invalidated -% because of bindings and aliasings -% - -normalize([],[]) :- !. -normalize(G,Gsgn) :- - G = [_|_], - keysort(G,Gs), % sort vertices on key - group(Gs,Gsg), % concatenate vertices with the same key - normalize_vertices(Gsg,Gsgn). % normalize - -normalize_vertices([],[]). -normalize_vertices([X-Xnb|Xs],Res) :- - ( normalize_vertex(X,Xnb,Xnorm) - -> Res = [Xnorm|Xsn], - normalize_vertices(Xs,Xsn) - ; normalize_vertices(Xs,Res) - ). - -% normalize_vertex(X,Nbs,X-Nbss) -% -% Normalizes a vertex X-Nbs into X-Nbss by sorting Nbs, removing duplicates (also of X) -% and removing non-vars. - -normalize_vertex(X,Nbs,X-Nbsss) :- - var(X), - sort(Nbs,Nbss), - strip_nonvar(Nbss,X,Nbsss). - -% strip_nonvar(Nbs,X,Res) -% -% Turns vertext X-Nbs into X-Res by removing occurrences of X from Nbs and removing -% non-vars. This to normalize after bindings have occurred. See also normalize_vertex/3. - -strip_nonvar([],_,[]). -strip_nonvar([X|Xs],Y,Res) :- - ( X==Y % duplicate of Y - -> strip_nonvar(Xs,Y,Res) - ; var(X) % var: keep - -> Res = [X|Stripped], - strip_nonvar(Xs,Y,Stripped) - ; % nonvar: remove - nonvar(X), - Res = [] % because Vars []. -gen_edges([X|Xs]) --> - gen_edges(Xs,X), - gen_edges(Xs). - -gen_edges([],_) --> []. -gen_edges([Y|Ys],X) --> - [X-Y], - gen_edges(Ys,X). - -% group(Vert,Res) -% -% Concatenates vertices with the same key. - -group([],[]). -group([K-Kl|Ks],Res) :- - group(Ks,K,Kl,Res). - -group([],K,Kl,[K-Kl]). -group([L-Ll|Ls],K,Kl,Res) :- - ( K==L - -> append(Kl,Ll,KLl), - group(Ls,K,KLl,Res) - ; Res = [K-Kl|Tail], - group(Ls,L,Ll,Tail) - ). diff --git a/GPL/clpqr/clpqr/project.pl b/GPL/clpqr/clpqr/project.pl deleted file mode 100644 index 04a657745..000000000 --- a/GPL/clpqr/clpqr/project.pl +++ /dev/null @@ -1,305 +0,0 @@ -/* - - Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -% -% Answer constraint projection -% - -%:- public project_attributes/2. % xref.pl - -:- module(project, - [ - drop_dep/1, - drop_dep_one/1, - make_target_indep/2, - project_attributes/2 - ]). -:- use_module(class, - [ - class_allvars/2 - ]). -:- use_module(geler, - [ - project_nonlin/3 - ]). -:- use_module(redund, - [ - redundancy_vars/1, - systems/3 - ]). -:- use_module(ordering, - [ - arrangement/2 - ]). - -% -% interface predicate -% -% May be destructive (either acts on a copy or in a failure loop) -% -project_attributes(TargetVars,Cvas) :- - sort(TargetVars,Tvs), % duplicates ? - sort(Cvas,Avs), % duplicates ? - get_clp(TargetVars,CLP), - ( nonvar(CLP) - -> mark_target(Tvs), - project_nonlin(Tvs,Avs,NlReachable), - ( Tvs == [] - -> drop_lin_atts(Avs) - ; redundancy_vars(Avs), % removes redundant bounds (redund.pl) - make_target_indep(Tvs,Pivots), % pivot partners are marked to be kept during elim. - mark_target(NlReachable), % after make_indep to express priority - drop_dep(Avs), - fm_elim(CLP,Avs,Tvs,Pivots), - impose_ordering(Avs) - ) - ; true - ). - -fm_elim(clpq,Avs,Tvs,Pivots) :- fourmotz_q:fm_elim(Avs,Tvs,Pivots). -fm_elim(clpr,Avs,Tvs,Pivots) :- fourmotz_r:fm_elim(Avs,Tvs,Pivots). - -get_clp([],_). -get_clp([H|T],CLP) :- - ( get_attr(H,itf,Att) - -> arg(1,Att,CLP) - ; true - ), - get_clp(T,CLP). - -% mark_target(Vars) -% -% Marks the variables in Vars as target variables. - -mark_target([]). -mark_target([V|Vs]) :- - ( get_attr(V,itf,Att) - -> setarg(9,Att,target) - ; true - ), - mark_target(Vs). - - -% mark_keep(Vars) -% -% Mark the variables in Vars to be kept during elimination. - -mark_keep([]). -mark_keep([V|Vs]) :- - get_attr(V,itf,Att), - setarg(11,Att,keep), - mark_keep(Vs). - -% -% Collect the pivots in reverse order -% We have to protect the target variables pivot partners -% from redundancy eliminations triggered by fm_elim, -% in order to allow for reverse pivoting. -% -make_target_indep(Ts,Ps) :- make_target_indep(Ts,[],Ps). - -% make_target_indep(Targets,Pivots,PivotsTail) -% -% Tries to make as many targetvariables independent by pivoting them with a non-target -% variable. The pivots are stored as T:NT where T is a target variable and NT a non-target -% variable. The non-target variables are marked to be kept during redundancy eliminations. - -make_target_indep([],Ps,Ps). -make_target_indep([T|Ts],Ps0,Pst) :- - ( get_attr(T,itf,AttT), - arg(1,AttT,CLP), - arg(2,AttT,type(Type)), - arg(4,AttT,lin([_,_|H])), - nontarget(H,Nt) - -> Ps1 = [T:Nt|Ps0], - get_attr(Nt,itf,AttN), - arg(2,AttN,type(IndAct)), - arg(5,AttN,order(Ord)), - arg(6,AttN,class(Class)), - setarg(11,AttN,keep), - pivot(CLP,T,Class,Ord,Type,IndAct) - ; Ps1 = Ps0 - ), - make_target_indep(Ts,Ps1,Pst). - -% nontarget(Hom,Nt) -% -% Finds a nontarget variable in homogene part Hom. -% Hom contains elements of the form l(V*K,OrdV). -% A nontarget variable has no target attribute and no keep_indep attribute. - -nontarget([l(V*_,_)|Vs],Nt) :- - ( get_attr(V,itf,Att), - arg(9,Att,n), - arg(10,Att,n) - -> Nt = V - ; nontarget(Vs,Nt) - ). - -% drop_dep(Vars) -% -% Does drop_dep_one/1 on each variable in Vars. - -drop_dep(Vs) :- - var(Vs), - !. -drop_dep([]). -drop_dep([V|Vs]) :- - drop_dep_one(V), - drop_dep(Vs). - -% drop_dep_one(V) -% -% If V is an unbounded dependent variable that isn't a target variable, shouldn't be kept -% and is not nonzero, drops all linear attributes of V. -% The linear attributes are: type, strictness, linear equation (lin), class and order. - -drop_dep_one(V) :- - get_attr(V,itf,Att), - Att = t(CLP,type(t_none),_,lin(Lin),order(OrdV),_,_,n,n,_,n), - \+ indep(CLP,Lin,OrdV), - !, - setarg(2,Att,n), - setarg(3,Att,n), - setarg(4,Att,n), - setarg(5,Att,n), - setarg(6,Att,n). -drop_dep_one(_). - -indep(clpq,Lin,OrdV) :- store_q:indep(Lin,OrdV). -indep(clpr,Lin,OrdV) :- store_r:indep(Lin,OrdV). - -pivot(clpq,T,Class,Ord,Type,IndAct) :- bv_q:pivot(T,Class,Ord,Type,IndAct). -pivot(clpr,T,Class,Ord,Type,IndAct) :- bv_r:pivot(T,Class,Ord,Type,IndAct). - -renormalize(clpq,Lin,New) :- store_q:renormalize(Lin,New). -renormalize(clpr,Lin,New) :- store_r:renormalize(Lin,New). - -% drop_lin_atts(Vs) -% -% Removes the linear attributes of the variables in Vs. -% The linear attributes are type, strictness, linear equation (lin), order and class. - -drop_lin_atts([]). -drop_lin_atts([V|Vs]) :- - get_attr(V,itf,Att), - setarg(2,Att,n), - setarg(3,Att,n), - setarg(4,Att,n), - setarg(5,Att,n), - setarg(6,Att,n), - drop_lin_atts(Vs). - -impose_ordering(Cvas) :- - systems(Cvas,[],Sys), - impose_ordering_sys(Sys). - -impose_ordering_sys([]). -impose_ordering_sys([S|Ss]) :- - arrangement(S,Arr), % ordering.pl - arrange(Arr,S), - impose_ordering_sys(Ss). - -arrange([],_). -arrange(Arr,S) :- - Arr = [_|_], - class_allvars(S,All), - order(Arr,1,N), - order(All,N,_), - renorm_all(All), - arrange_pivot(All). - -order(Xs,N,M) :- - var(Xs), - !, - N = M. -order([],N,N). -order([X|Xs],N,M) :- - ( get_attr(X,itf,Att), - arg(5,Att,order(O)), - var(O) - -> O = N, - N1 is N+1, - order(Xs,N1,M) - ; order(Xs,N,M) - ). - -% renorm_all(Vars) -% -% Renormalizes all linear equations of the variables in difference list Vars to reflect -% their new ordering. - -renorm_all(Xs) :- - var(Xs), - !. -renorm_all([X|Xs]) :- - ( get_attr(X,itf,Att), - arg(1,Att,CLP), - arg(4,Att,lin(Lin)) - -> renormalize(CLP,Lin,New), - setarg(4,Att,lin(New)), - renorm_all(Xs) - ; renorm_all(Xs) - ). - -% arrange_pivot(Vars) -% -% If variable X of Vars has type t_none and has a higher order than the first element of -% its linear equation, then it is pivoted with that element. - -arrange_pivot(Xs) :- - var(Xs), - !. -arrange_pivot([X|Xs]) :- - ( get_attr(X,itf,AttX), - %arg(8,AttX,n), % not for nonzero - arg(1,AttX,CLP), - arg(2,AttX,type(t_none)), - arg(4,AttX,lin(Lin)), - arg(5,AttX,order(OrdX)), - Lin = [_,_,l(Y*_,_)|_], - get_attr(Y,itf,AttY), - arg(2,AttY,type(IndAct)), - arg(5,AttY,order(OrdY)), - arg(6,AttY,class(Class)), - compare(>,OrdY,OrdX) - -> pivot(CLP,X,Class,OrdY,t_none,IndAct), - arrange_pivot(Xs) - ; arrange_pivot(Xs) - ). \ No newline at end of file diff --git a/GPL/clpqr/clpqr/redund.pl b/GPL/clpqr/clpqr/redund.pl deleted file mode 100644 index e0021be3c..000000000 --- a/GPL/clpqr/clpqr/redund.pl +++ /dev/null @@ -1,297 +0,0 @@ -/* - - Part of CLP(Q,R) (Constraint Logic Programming over Rationals and Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(redund, - [ - redundancy_vars/1, - systems/3 - ]). -:- use_module(class, - [ - class_allvars/2 - ]). - -% -% redundancy removal (semantic definition) -% -% done: -% +) deal with active bounds -% +) indep t_[lu] -> t_none invalidates invariants (fixed) -% - -% systems(Vars,SystemsIn,SystemsOut) -% -% Returns in SystemsOut the different classes to which variables in Vars -% belong. Every class only appears once in SystemsOut. - -systems([],Si,Si). -systems([V|Vs],Si,So) :- - ( var(V), - get_attr(V,itf,Att), - arg(6,Att,class(C)), - not_memq(Si,C) - -> systems(Vs,[C|Si],So) - ; systems(Vs,Si,So) - ). - -% not_memq(Lst,El) -% -% Succeeds if El is not a member of Lst (does not use unification). - -not_memq([],_). -not_memq([Y|Ys],X) :- - X \== Y, - not_memq(Ys,X). - -% redundancy_systems(Classes) -% -% Does redundancy removal via redundancy_vs/1 on all variables in the classes Classes. - -redundancy_systems([]). -redundancy_systems([S|Sys]) :- - class_allvars(S,All), - redundancy_vs(All), - redundancy_systems(Sys). - -% redundancy_vars(Vs) -% -% Does the same thing as redundancy_vs/1 but has some extra timing facilities that -% may be used. - -redundancy_vars(Vs) :- - !, - redundancy_vs(Vs). -redundancy_vars(Vs) :- - statistics(runtime,[Start|_]), - redundancy_vs(Vs), - statistics(runtime,[End|_]), - Duration is End-Start, - format(user_error,"% Redundancy elimination took ~d msec~n",Duration). - - -% redundancy_vs(Vs) -% -% Removes redundant bounds from the variables in Vs via redundant/3 - -redundancy_vs(Vs) :- - var(Vs), - !. -redundancy_vs([]). -redundancy_vs([V|Vs]) :- - ( get_attr(V,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Strict)), - redundant(Type,V,Strict) - -> redundancy_vs(Vs) - ; redundancy_vs(Vs) - ). - -% redundant(Type,Var,Strict) -% -% Removes redundant bounds from variable Var with type Type and strictness Strict. -% A redundant bound is one that is satisfied anyway (so adding the inverse of the bound -% makes the system infeasible. This predicate can either fail or succeed but a success -% doesn't necessarily mean a redundant bound. - -redundant(t_l(L),X,Strict) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - detach_bounds(CLP,X), % drop temporarily - % if not redundant, backtracking will restore bound - negate_l(Strict,CLP,L,X), - red_t_l. % negate_l didn't fail, redundant bound -redundant(t_u(U),X,Strict) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - detach_bounds(CLP,X), - negate_u(Strict,CLP,U,X), - red_t_u. -redundant(t_lu(L,U),X,Strict) :- - strictness_parts(Strict,Sl,Su), - ( get_attr(X,itf,Att), - arg(1,Att,CLP), - setarg(2,Att,type(t_u(U))), - setarg(3,Att,strictness(Su)), - negate_l(Strict,CLP,L,X) - -> red_t_l, - ( redundant(t_u(U),X,Strict) - -> true - ; true - ) - ; get_attr(X,itf,Att), - arg(1,Att,CLP), - setarg(2,Att,type(t_l(L))), - setarg(3,Att,strictness(Sl)), - negate_u(Strict,CLP,U,X) - -> red_t_u - ; true - ). -redundant(t_L(L),X,Strict) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - Bound is -L, - intro_at(CLP,X,Bound,t_none), % drop temporarily - detach_bounds(CLP,X), - negate_l(Strict,CLP,L,X), - red_t_L. -redundant(t_U(U),X,Strict) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - Bound is -U, - intro_at(CLP,X,Bound,t_none), % drop temporarily - detach_bounds(CLP,X), - negate_u(Strict,CLP,U,X), - red_t_U. -redundant(t_Lu(L,U),X,Strict) :- - strictness_parts(Strict,Sl,Su), - ( Bound is -L, - get_attr(X,itf,Att), - arg(1,Att,CLP), - intro_at(CLP,X,Bound,t_u(U)), - get_attr(X,itf,Att2), % changed? - setarg(3,Att2,strictness(Su)), - negate_l(Strict,CLP,L,X) - -> red_t_l, - ( redundant(t_u(U),X,Strict) - -> true - ; true - ) - ; get_attr(X,itf,Att), - arg(1,Att,CLP), - setarg(2,Att,type(t_L(L))), - setarg(3,Att,strictness(Sl)), - negate_u(Strict,CLP,U,X) - -> red_t_u - ; true - ). -redundant(t_lU(L,U),X,Strict) :- - strictness_parts(Strict,Sl,Su), - ( get_attr(X,itf,Att), - arg(1,Att,CLP), - setarg(2,Att,type(t_U(U))), - setarg(3,Att,strictness(Su)), - negate_l(Strict,CLP,L,X) - -> red_t_l, - ( redundant(t_U(U),X,Strict) - -> true - ; true - ) - ; get_attr(X,itf,Att), - arg(1,Att,CLP), - Bound is -U, - intro_at(CLP,X,Bound,t_l(L)), - get_attr(X,itf,Att2), % changed? - setarg(3,Att2,strictness(Sl)), - negate_u(Strict,CLP,U,X) - -> red_t_u - ; true - ). - -% strictness_parts(Strict,Lower,Upper) -% -% Splits strictness Strict into two parts: one related to the lowerbound and -% one related to the upperbound. - -strictness_parts(Strict,Lower,Upper) :- - Lower is Strict /\ 2, - Upper is Strict /\ 1. - -% negate_l(Strict,Lowerbound,X) -% -% Fails if X does not necessarily satisfy the lowerbound and strictness -% In other words: if adding the inverse of the lowerbound (X < L or X =< L) -% does not result in a failure, this predicate fails. - -negate_l(0,CLP,L,X) :- - CLP:{L > X}, - !, - fail. -negate_l(1,CLP,L,X) :- - CLP:{L > X}, - !, - fail. -negate_l(2,CLP,L,X) :- - CLP:{L >= X}, - !, - fail. -negate_l(3,CLP,L,X) :- - CLP:{L >= X}, - !, - fail. -negate_l(_,_,_,_). - -% negate_u(Strict,Upperbound,X) -% -% Fails if X does not necessarily satisfy the upperbound and strictness -% In other words: if adding the inverse of the upperbound (X > U or X >= U) -% does not result in a failure, this predicate fails. - -negate_u(0,CLP,U,X) :- - CLP:{U < X}, - !, - fail. -negate_u(1,CLP,U,X) :- - CLP:{U =< X}, - !, - fail. -negate_u(2,CLP,U,X) :- - CLP:{U < X}, - !, - fail. -negate_u(3,CLP,U,X) :- - CLP:{U =< X}, - !, - fail. -negate_u(_,_,_,_). - -% CLP(Q,R) - -detach_bounds(clpq,X) :- bv_q:detach_bounds(X). -detach_bounds(clpr,X) :- bv_r:detach_bounds(X). - -intro_at(clpq,A,B,C) :- bv_q:intro_at(A,B,C). -intro_at(clpr,A,B,C) :- bv_r:intro_at(A,B,C). - -% Profiling: these predicates are called during redundant and can be used -% to count the number of redundant bounds. - -red_t_l. -red_t_u. -red_t_L. -red_t_U. \ No newline at end of file diff --git a/GPL/clpqr/clpr.pl b/GPL/clpqr/clpr.pl deleted file mode 100644 index 8c5b7328a..000000000 --- a/GPL/clpqr/clpr.pl +++ /dev/null @@ -1,136 +0,0 @@ -/* $Id: clpr.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(clpr, - [ - {}/1, - maximize/1, - minimize/1, - inf/2, inf/4, sup/2, sup/4, - bb_inf/3, - bb_inf/5, - ordering/1, - entailed/1, - clp_type/2, - dump/3%, projecting_assert/1 - ]). - -:- expects_dialect(swi). - -% -% Don't report export of private predicates from clpr -% -:- multifile - user:portray_message/2. - -:- dynamic - user:portray_message/2. -% -user:portray_message(warning,import(_,_,clpr,private)). - -:- load_files( - [ - 'clpr/bb_r', - 'clpr/bv_r', - 'clpr/fourmotz_r', - 'clpr/ineq_r', - 'clpr/itf_r', - 'clpr/nf_r', - 'clpr/store_r', - 'clpqr/class', - 'clpqr/dump', - 'clpqr/geler', - 'clpqr/itf', - 'clpqr/ordering', - 'clpqr/project', - 'clpqr/redund', - library(ugraphs) - ], - [ - if(not_loaded), - silent(true) - ]). - - /******************************* - * TOPLEVEL PRINTING * - *******************************/ - -:- multifile - prolog:message/3. - -% prolog:message(query(YesNo)) --> !, -% ['~@'-[chr:print_all_stores]], -% '$messages':prolog_message(query(YesNo)). - -prolog:message(query(YesNo,Bindings)) --> !, - {dump_toplevel_bindings(Bindings,Constraints)}, - {dump_format(Constraints,Format)}, - Format, - '$messages':prolog_message(query(YesNo,Bindings)). - -dump_toplevel_bindings(Bindings,Constraints) :- - dump_vars_names(Bindings,[],Vars,Names), - dump(Vars,Names,Constraints). - -dump_vars_names([],_,[],[]). -dump_vars_names([Name=Term|Rest],Seen,Vars,Names) :- - ( var(Term), - ( get_attr(Term,itf,_) - ; get_attr(Term,geler,_) - ), - \+ memberchk_eq(Term,Seen) - -> Vars = [Term|RVars], - Names = [Name|RNames], - NSeen = [Term|Seen] - ; Vars = RVars, - Names = RNames, - Seen = NSeen - ), - dump_vars_names(Rest,NSeen,RVars,RNames). - -dump_format([],[]). -dump_format([X|Xs],['{~w}'-[X],nl|Rest]) :- - dump_format(Xs,Rest). - -memberchk_eq(X,[Y|Ys]) :- - ( X == Y - -> true - ; memberchk_eq(X,Ys) - ). diff --git a/GPL/clpqr/clpr/bb_r.pl b/GPL/clpqr/clpr/bb_r.pl deleted file mode 100644 index 1ebb0c477..000000000 --- a/GPL/clpqr/clpr/bb_r.pl +++ /dev/null @@ -1,260 +0,0 @@ -/* $Id: bb_r.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CPL(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(bb_r, - [ - bb_inf/3, - bb_inf/5, - vertex_value/2 - ]). -:- use_module(bv_r, - [ - deref/2, - deref_var/2, - determine_active_dec/1, - inf/2, - iterate_dec/2, - sup/2, - var_with_def_assign/2 - ]). -:- use_module(nf_r, - [ - {}/1, - entailed/1, - nf/2, - nf_constant/2, - repair/2, - wait_linear/3 - ]). - -% bb_inf(Ints,Term,Inf) -% -% Finds the infimum of Term where the variables Ints are to be integers. -% The infimum is stored in Inf. - -bb_inf(Is,Term,Inf) :- - bb_inf(Is,Term,Inf,_,0.001). - -bb_inf(Is,Term,Inf,Vertex,Eps) :- - nf(Eps,ENf), - nf_constant(ENf,EpsN), - wait_linear(Term,Nf,bb_inf_internal(Is,Nf,EpsN,Inf,Vertex)). - -% --------------------------------------------------------------------- - -% bb_inf_internal(Is,Lin,Eps,Inf,Vertex) -% -% Finds an infimum Inf for linear expression in normal form Lin, where -% all variables in Is are to be integers. Eps denotes the margin in which -% we accept a number as an integer (to deal with rounding errors etc.). - -bb_inf_internal(Is,Lin,Eps,_,_) :- - bb_intern(Is,IsNf,Eps), - nb_delete(prov_opt), - repair(Lin,LinR), % bb_narrow ... - deref(LinR,Lind), - var_with_def_assign(Dep,Lind), - determine_active_dec(Lind), - bb_loop(Dep,IsNf,Eps), - fail. -bb_inf_internal(_,_,_,Inf,Vertex) :- - catch(nb_getval(prov_opt,InfVal-Vertex),_,fail), - {Inf =:= InfVal}, - nb_delete(prov_opt). - -% bb_loop(Opt,Is,Eps) -% -% Minimizes the value of Opt where variables Is have to be integer values. -% Eps denotes the rounding error that is acceptable. This predicate can be -% backtracked to try different strategies. - -bb_loop(Opt,Is,Eps) :- - bb_reoptimize(Opt,Inf), - bb_better_bound(Inf), - vertex_value(Is,Ivs), - ( bb_first_nonint(Is,Ivs,Eps,Viol,Floor,Ceiling) - -> bb_branch(Viol,Floor,Ceiling), - bb_loop(Opt,Is,Eps) - ; round_values(Ivs,RoundVertex), - nb_setval(prov_opt,Inf-RoundVertex) % new provisional optimum - ). - -% bb_reoptimize(Obj,Inf) -% -% Minimizes the value of Obj and puts the result in Inf. -% This new minimization is necessary as making a bound integer may yield a -% different optimum. The added inequalities may also have led to binding. - -bb_reoptimize(Obj,Inf) :- - var(Obj), - iterate_dec(Obj,Inf). -bb_reoptimize(Obj,Inf) :- - nonvar(Obj), - Inf = Obj. - -% bb_better_bound(Inf) -% -% Checks if the new infimum Inf is better than the previous one (if such exists). - -bb_better_bound(Inf) :- - catch((nb_getval(prov_opt,Inc-_),Inf - Inc < -1.0e-10),_,true). - -% bb_branch(V,U,L) -% -% Stores that V =< U or V >= L, can be used for different strategies within bb_loop/3. - -bb_branch(V,U,_) :- {V =< U}. -bb_branch(V,_,L) :- {V >= L}. - -% vertex_value(Vars,Values) -% -% Returns in the current values of the variables in . - -vertex_value([],[]). -vertex_value([X|Xs],[V|Vs]) :- - rhs_value(X,V), - vertex_value(Xs,Vs). - -% rhs_value(X,Value) -% -% Returns in the current value of variable . - -rhs_value(Xn,Value) :- - ( nonvar(Xn) - -> Value = Xn - ; var(Xn) - -> deref_var(Xn,Xd), - Xd = [I,R|_], - Value is R+I - ). - -% bb_first_nonint(Ints,Rhss,Eps,Viol,Floor,Ceiling) -% -% Finds the first variable in Ints which doesn't have an active integer bound. -% Rhss contain the Rhs (R + I) values corresponding to the variables. -% The first variable that hasn't got an active integer bound, is returned in -% Viol. The floor and ceiling of its actual bound is returned in Floor and Ceiling. - -bb_first_nonint([I|Is],[Rhs|Rhss],Eps,Viol,F,C) :- - ( Floor is floor(Rhs+1.0e-10), - Ceiling is ceiling(Rhs-1.0e-10), - Eps - min(Rhs-Floor,Ceiling-Rhs) < -1.0e-10 - -> Viol = I, - F = Floor, - C = Ceiling - ; bb_first_nonint(Is,Rhss,Eps,Viol,F,C) - ). - -% round_values([X|Xs],[Xr|Xrs]) -% -% Rounds of the values of the first list into the second list. - -round_values([],[]). -round_values([X|Xs],[Y|Ys]) :- - Y is round(X), - round_values(Xs,Ys). - -% bb_intern([X|Xs],[Xi|Xis],Eps) -% -% Turns the elements of the first list into integers into the second -% list via bb_intern/4. - -bb_intern([],[],_). -bb_intern([X|Xs],[Xi|Xis],Eps) :- - nf(X,Xnf), - bb_intern(Xnf,Xi,X,Eps), - bb_intern(Xs,Xis,Eps). - - -% bb_intern(Nf,X,Term,Eps) -% -% Makes sure that Term which is normalized into Nf, is integer. -% X contains the possibly changed Term. If Term is a variable, -% then its bounds are hightened or lowered to the next integer. -% Otherwise, it is checked it Term is integer. - -bb_intern([],X,_,_) :- - !, - X = 0.0. -bb_intern([v(I,[])],X,_,Eps) :- - !, - X = I, - min(I-floor(I+1e-010),ceiling(I-1e-010)-I) - Eps < 1e-010. -bb_intern([v(One,[V^1])],X,_,_) :- - Test is One - 1.0, - Test =< 1e-010, - Test >= -1e-010, - !, - V = X, - bb_narrow_lower(X), - bb_narrow_upper(X). -bb_intern(_,_,Term,_) :- - throw(instantiation_error(bb_inf(Term,_,_),1)). - -% bb_narrow_lower(X) -% -% Narrows the lower bound so that it is an integer bound. -% We do this by finding the infimum of X and asserting that X -% is larger than the first integer larger or equal to the infimum -% (second integer if X is to be strict larger than the first integer). - -bb_narrow_lower(X) :- - ( inf(X,Inf) - -> Bound is ceiling(Inf-1.0e-10), - ( entailed(X > Bound) - -> {X >= Bound+1} - ; {X >= Bound} - ) - ; true - ). - -% bb_narrow_upper(X) -% -% See bb_narrow_lower/1. This predicate handles the upper bound. - -bb_narrow_upper(X) :- - ( sup(X,Sup) - -> Bound is floor(Sup+1.0e-10), - ( entailed(X < Bound) - -> {X =< Bound-1} - ; {X =< Bound} - ) - ; true - ). diff --git a/GPL/clpqr/clpr/bv_r.pl b/GPL/clpqr/clpr/bv_r.pl deleted file mode 100644 index 5f597eb14..000000000 --- a/GPL/clpqr/clpr/bv_r.pl +++ /dev/null @@ -1,1786 +0,0 @@ -/* $Id: bv_r.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2006, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is based on CLP(Q,R) by Christian Holzbaur for SICStus - Prolog and distributed under the license details below with permission from - all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(bv_r, - [ - allvars/2, - backsubst/3, - backsubst_delta/4, - basis_add/2, - dec_step/2, - deref/2, - deref_var/2, - detach_bounds/1, - detach_bounds_vlv/5, - determine_active_dec/1, - determine_active_inc/1, - dump_var/6, - dump_nz/5, - export_binding/1, - export_binding/2, - get_or_add_class/2, - inc_step/2, - intro_at/3, - iterate_dec/2, - lb/3, - pivot_a/4, - pivot/5, - rcbl_status/6, - reconsider/1, - same_class/2, - solve/1, - solve_ord_x/3, - ub/3, - unconstrained/4, - var_intern/2, - var_intern/3, - var_with_def_assign/2, - var_with_def_intern/4, - maximize/1, - minimize/1, - sup/2, - sup/4, - inf/2, - inf/4, - 'solve_<'/1, - 'solve_=<'/1, - 'solve_=\\='/1, - log_deref/4 - ]). -:- use_module(store_r, - [ - add_linear_11/3, - add_linear_f1/4, - add_linear_ff/5, - delete_factor/4, - indep/2, - isolate/3, - nf2sum/3, - nf_rhs_x/4, - nf_substitute/4, - normalize_scalar/2, - mult_hom/3, - mult_linear_factor/3 - ]). -:- use_module('../clpqr/class', - [ - class_allvars/2, - class_basis/2, - class_basis_add/3, - class_basis_drop/2, - class_basis_pivot/3, - class_new/5 - ]). -:- use_module(ineq_r, - [ - ineq/4 - ]). -:- use_module(nf_r, - [ - {}/1, - split/3, - wait_linear/3 - ]). -:- use_module(bb_r, - [ - vertex_value/2 - ]). -:- use_module(library(ordsets), - [ - ord_add_element/3 - ]). - -% For the rhs maint. the following events are important: -% -% -) introduction of an indep var at active bound B -% -) narrowing of active bound -% -) swap active bound -% -) pivot -% - -% a variables bound (L/U) can have the states: -% -% -) t_none no bounds -% -) t_l inactive lower bound -% -) t_u inactive upper bound -% -) t_L active lower bound -% -) t_U active upper bound -% -) t_lu inactive lower and upper bound -% -) t_Lu active lower bound and inactive upper bound -% -) t_lU inactive lower bound and active upper bound - -% ----------------------------------- deref ----------------------------------- -% - -% deref(Lin,Lind) -% -% Makes a linear equation of the form [v(I,[])|H] into a solvable linear -% equation. -% If the variables are new, they are initialized with the linear equation X=X. - -deref(Lin,Lind) :- - split(Lin,H,I), - normalize_scalar(I,Nonvar), - length(H,Len), - log_deref(Len,H,[],Restd), - add_linear_11(Nonvar,Restd,Lind). - -% log_deref(Len,[Vs|VsTail],VsTail,Res) -% -% Logarithmically converts a linear equation in normal form ([v(_,_)|_]) into a -% linear equation in solver form ([I,R,K*X|_]). Res contains the result, Len is -% the length of the part to convert and [Vs|VsTail] is a difference list -% containing the equation in normal form. - -log_deref(0,Vs,Vs,Lin) :- - !, - Lin = [0.0,0.0]. -log_deref(1,[v(K,[X^1])|Vs],Vs,Lin) :- - !, - deref_var(X,Lx), - mult_linear_factor(Lx,K,Lin). -log_deref(2,[v(Kx,[X^1]),v(Ky,[Y^1])|Vs],Vs,Lin) :- - !, - deref_var(X,Lx), - deref_var(Y,Ly), - add_linear_ff(Lx,Kx,Ly,Ky,Lin). -log_deref(N,V0,V2,Lin) :- - P is N >> 1, - Q is N - P, - log_deref(P,V0,V1,Lp), - log_deref(Q,V1,V2,Lq), - add_linear_11(Lp,Lq,Lin). - -% deref_var(X,Lin) -% -% Returns the equation of variable X. If X is a new variable, a new equation -% X = X is made. - -deref_var(X,Lin) :- - ( get_attr(X,itf,Att) - -> ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; arg(4,Att,lin(Lin)) - -> true - ; setarg(2,Att,type(t_none)), - setarg(3,Att,strictness(0)), - Lin = [0.0,0.0,l(X*1.0,Ord)], - setarg(4,Att,lin(Lin)), - setarg(5,Att,order(Ord)) - ) - ; Lin = [0.0,0.0,l(X*1.0,Ord)], - put_attr(X,itf,t(clpr,type(t_none),strictness(0), - lin(Lin),order(Ord),n,n,n,n,n,n)) - ). - -% TODO -% -% - -var_with_def_assign(Var,Lin) :- - Lin = [I,_|Hom], - ( Hom = [] - -> % X=k - Var = I - ; Hom = [l(V*K,_)|Cs] - -> ( Cs = [], - TestK is K - 1.0, % K =:= 1 - TestK =< 1.0e-10, - TestK >= -1.0e-10, - I >= -1.0e-010, % I =:= 0 - I =< 1.0e-010 - -> % X=Y - Var = V - ; % general case - var_with_def_intern(t_none,Var,Lin,0) - ) - ). - -% var_with_def_intern(Type,Var,Lin,Strictness) -% -% Makes Lin the linear equation of new variable Var, makes all variables of -% Lin, and Var of the same class and bounds Var by type(Type) and -% strictness(Strictness) - -var_with_def_intern(Type,Var,Lin,Strict) :- - put_attr(Var,itf,t(clpr,type(Type),strictness(Strict),lin(Lin), - order(_),n,n,n,n,n,n)), % check uses - Lin = [_,_|Hom], - get_or_add_class(Var,Class), - same_class(Hom,Class). - -% TODO -% -% - -var_intern(Type,Var,Strict) :- - put_attr(Var,itf,t(clpr,type(Type),strictness(Strict), - lin([0.0,0.0,l(Var*1.0,Ord)]),order(Ord),n,n,n,n,n,n)), - get_or_add_class(Var,_Class). - -% TODO -% -% - -var_intern(Var,Class) :- % for ordered/1 but otherwise free vars - get_attr(Var,itf,Att), - arg(2,Att,type(_)), - arg(4,Att,lin(_)), - !, - get_or_add_class(Var,Class). -var_intern(Var,Class) :- - put_attr(Var,itf,t(clpr,type(t_none),strictness(0), - lin([0.0,0.0,l(Var*1.0,Ord)]),order(Ord),n,n,n,n,n,n)), - get_or_add_class(Var,Class). - -% ----------------------------------------------------------------------------- - -% export_binding(Lst) -% -% Binds variables X to Y where Lst contains elements of the form [X-Y]. - -export_binding([]). -export_binding([X-Y|Gs]) :- - export_binding(Y,X), - export_binding(Gs). - -% export_binding(Y,X) -% -% Binds variable X to Y. If Y is a nonvar and equals 0, then X is set to 0 -% (numerically more stable) - -export_binding(Y,X) :- - var(Y), - Y = X. -export_binding(Y,X) :- - nonvar(Y), - ( Y >= -1.0e-10, % Y =:= 0 - Y =< 1.0e-10 - -> X = 0.0 - ; Y = X - ). - -% 'solve_='(Nf) -% -% Solves linear equation Nf = 0 where Nf is in normal form. - -'solve_='(Nf) :- - deref(Nf,Nfd), % dereferences and turns Nf into solvable form Nfd - solve(Nfd). - -% 'solve_=\\='(Nf) -% -% Solves linear inequality Nf =\= 0 where Nf is in normal form. - -'solve_=\\='(Nf) :- - deref(Nf,Lind), % dereferences and turns Nf into solvable form Lind - Lind = [Inhom,_|Hom], - ( Hom = [] - -> % Lind = Inhom => check Inhom =\= 0 - \+ (Inhom >= -1.0e-10, Inhom =< 1.0e-10) % Inhom =\= 0 - ; % make new variable Nz = Lind - var_with_def_intern(t_none,Nz,Lind,0), - % make Nz nonzero - get_attr(Nz,itf,Att), - setarg(8,Att,nonzero) - ). - -% 'solve_<'(Nf) -% -% Solves linear inequality Nf < 0 where Nf is in normal form. - -'solve_<'(Nf) :- - split(Nf,H,I), - ineq(H,I,Nf,strict). - -% 'solve_=<'(Nf) -% -% Solves linear inequality Nf =< 0 where Nf is in normal form. - -'solve_=<'(Nf) :- - split(Nf,H,I), - ineq(H,I,Nf,nonstrict). - -maximize(Term) :- - minimize(-Term). - -% -% This is NOT coded as minimize(Expr) :- inf(Expr,Expr). -% -% because the new version of inf/2 only visits -% the vertex where the infimum is assumed and returns -% to the 'current' vertex via backtracking. -% The rationale behind this construction is to eliminate -% all garbage in the solver data structures produced by -% the pivots on the way to the extremal point caused by -% {inf,sup}/{2,4}. -% -% If we are after the infimum/supremum for minimizing/maximizing, -% this strategy may have adverse effects on performance because -% the simplex algorithm is forced to re-discover the -% extremal vertex through the equation {Inf =:= Expr}. -% -% Thus the extra code for {minimize,maximize}/1. -% -% In case someone comes up with an example where -% -% inf(Expr,Expr) -% -% outperforms the provided formulation for minimize - so be it. -% Both forms are available to the user. -% -minimize(Term) :- - wait_linear(Term,Nf,minimize_lin(Nf)). - -% minimize_lin(Lin) -% -% Minimizes the linear expression Lin. It does so by making a new -% variable Dep and minimizes its value. - -minimize_lin(Lin) :- - deref(Lin,Lind), - var_with_def_intern(t_none,Dep,Lind,0), - determine_active_dec(Lind), - iterate_dec(Dep,Inf), - { Dep =:= Inf }. - -sup(Expression,Sup) :- - sup(Expression,Sup,[],[]). - -sup(Expression,Sup,Vector,Vertex) :- - inf(-Expression,-Sup,Vector,Vertex). - -inf(Expression,Inf) :- - inf(Expression,Inf,[],[]). - -inf(Expression,Inf,Vector,Vertex) :- - % wait until Expression becomes linear, Nf contains linear Expression - % in normal form - wait_linear(Expression,Nf,inf_lin(Nf,Inf,Vector,Vertex)). - -inf_lin(Lin,_,Vector,_) :- - deref(Lin,Lind), - var_with_def_intern(t_none,Dep,Lind,0), % make new variable Dep = Lind - determine_active_dec(Lind), % minimizes Lind - iterate_dec(Dep,Inf), - vertex_value(Vector,Values), - nb_setval(inf,[Inf|Values]), - fail. -inf_lin(_,Infimum,_,Vertex) :- - catch(nb_getval(inf,L),_,fail), - nb_delete(inf), - assign([Infimum|Vertex],L). - -% assign(L1,L2) -% -% The elements of L1 are pairwise assigned to the elements of L2 -% by means of asserting {X =:= Y} where X is an element of L1 and Y -% is the corresponding element of L2. - -assign([],[]). -assign([X|Xs],[Y|Ys]) :- - {X =:= Y}, % more defensive/expressive than X=Y - assign(Xs,Ys). - -% --------------------------------- optimization ------------------------------ -% -% The _sn(S) =< 0 row might be temporarily infeasible. -% We use reconsider/1 to fix this. -% -% s(S) e [_,0] = d +xi ... -xj, Rhs > 0 so we want to decrease s(S) -% -% positive xi would have to be moved towards their lower bound, -% negative xj would have to be moved towards their upper bound, -% -% the row s(S) does not limit the lower bound of xi -% the row s(S) does not limit the upper bound of xj -% -% a) if some other row R is limiting xk, we pivot(R,xk), -% s(S) will decrease and get more feasible until (b) -% b) if there is no limiting row for some xi: we pivot(s(S),xi) -% xj: we pivot(s(S),xj) -% which cures the infeasibility in one step -% - - -% iterate_dec(OptVar,Opt) -% -% Decreases the bound on the variables of the linear equation of OptVar as much -% as possible and returns the resulting optimal bound in Opt. Fails if for some -% variable, a status of unlimited is found. - -iterate_dec(OptVar,Opt) :- - get_attr(OptVar,itf,Att), - arg(4,Att,lin([I,R|H])), - dec_step(H,Status), - ( Status = applied - -> iterate_dec(OptVar,Opt) - ; Status = optimum, - Opt is R + I - ). - -% iterate_inc(OptVar,Opt) -% -% Increases the bound on the variables of the linear equation of OptVar as much -% as possible and returns the resulting optimal bound in Opt. Fails if for some -% variable, a status of unlimited is found. - -iterate_inc(OptVar,Opt) :- - get_attr(OptVar,itf,Att), - arg(4,Att,lin([I,R|H])), - inc_step(H,Status), - ( Status = applied - -> iterate_inc(OptVar,Opt) - ; Status = optimum, - Opt is R + I - ). - -% -% Status = {optimum,unlimited(Indep,DepT),applied} -% If Status = optimum, the tables have not been changed at all. -% Searches left to right, does not try to find the 'best' pivot -% Therefore we might discover unboundedness only after a few pivots -% - -dec_step_cont([],optimum,Cont,Cont). -dec_step_cont([l(V*K,OrdV)|Vs],Status,ContIn,ContOut) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( dec_step_2_cont(W,l(V*K,OrdV),Class,Status,ContIn,ContOut) - -> true - ; dec_step_cont(Vs,Status,ContIn,ContOut) - ). - -inc_step_cont([],optimum,Cont,Cont). -inc_step_cont([l(V*K,OrdV)|Vs],Status,ContIn,ContOut) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( inc_step_2_cont(W,l(V*K,OrdV),Class,Status,ContIn,ContOut) - -> true - ; inc_step_cont(Vs,Status,ContIn,ContOut) - ). - -dec_step_2_cont(t_U(U),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K > 1.0e-10, - ( lb(Class,OrdV,Vub-Vb-_) - -> % found a lower bound - Status = applied, - pivot_a(Vub,V,Vb,t_u(U)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_u(U)), - ContIn = ContOut - ). -dec_step_2_cont(t_lU(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K > 1.0e-10, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -dec_step_2_cont(t_L(L),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K < -1.0e-10, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_l(L)), - ContIn = ContOut - ). -dec_step_2_cont(t_Lu(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K < -1.0e-10, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -dec_step_2_cont(t_none,l(V*_,_),_,unlimited(V,t_none),Cont,Cont). - - - -inc_step_2_cont(t_U(U),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K < -1.0e-10, - ( lb(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_u(U)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_u(U)), - ContIn = ContOut - ). -inc_step_2_cont(t_lU(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K < -1.0e-10, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -inc_step_2_cont(t_L(L),l(V*K,OrdV),Class,Status,ContIn,ContOut) :- - K > 1.0e-10, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)), - replace_in_cont(ContIn,Vub,V,ContOut) - ; Status = unlimited(V,t_l(L)), - ContIn = ContOut - ). -inc_step_2_cont(t_Lu(L,U),l(V*K,OrdV),Class,applied,ContIn,ContOut) :- - K > 1.0e-10, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)), - replace_in_cont(ContIn,Vub,V,ContOut). -inc_step_2_cont(t_none,l(V*_,_),_,unlimited(V,t_none),Cont,Cont). - -replace_in_cont([],_,_,[]). -replace_in_cont([H1|T1],X,Y,[H2|T2]) :- - ( H1 == X - -> H2 = Y, - T1 = T2 - ; H2 = H1, - replace_in_cont(T1,X,Y,T2) - ). - -dec_step([],optimum). -dec_step([l(V*K,OrdV)|Vs],Status) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( dec_step_2(W,l(V*K,OrdV),Class,Status) - -> true - ; dec_step(Vs,Status) - ). - -dec_step_2(t_U(U),l(V*K,OrdV),Class,Status) :- - K > 1.0e-10, - ( lb(Class,OrdV,Vub-Vb-_) - -> % found a lower bound - Status = applied, - pivot_a(Vub,V,Vb,t_u(U)) - ; Status = unlimited(V,t_u(U)) - ). -dec_step_2(t_lU(L,U),l(V*K,OrdV),Class,applied) :- - K > 1.0e-10, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -dec_step_2(t_L(L),l(V*K,OrdV),Class,Status) :- - K < -1.0e-10, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)) - ; Status = unlimited(V,t_l(L)) - ). -dec_step_2(t_Lu(L,U),l(V*K,OrdV),Class,applied) :- - K < -1.0e-10, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -dec_step_2(t_none,l(V*_,_),_,unlimited(V,t_none)). - -inc_step([],optimum). % if status has not been set yet: no changes -inc_step([l(V*K,OrdV)|Vs],Status) :- - get_attr(V,itf,Att), - arg(2,Att,type(W)), - arg(6,Att,class(Class)), - ( inc_step_2(W,l(V*K,OrdV),Class,Status) - -> true - ; inc_step(Vs,Status) - ). - -inc_step_2(t_U(U),l(V*K,OrdV),Class,Status) :- - K < -1.0e-10, - ( lb(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_u(U)) - ; Status = unlimited(V,t_u(U)) - ). -inc_step_2(t_lU(L,U),l(V*K,OrdV),Class,applied) :- - K < -1.0e-10, - Init is L - U, - class_basis(Class,Deps), - lb(Deps,OrdV,V-t_Lu(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -inc_step_2(t_L(L),l(V*K,OrdV),Class,Status) :- - K > 1.0e-10, - ( ub(Class,OrdV,Vub-Vb-_) - -> Status = applied, - pivot_a(Vub,V,Vb,t_l(L)) - ; Status = unlimited(V,t_l(L)) - ). -inc_step_2(t_Lu(L,U),l(V*K,OrdV),Class,applied) :- - K > 1.0e-10, - Init is U - L, - class_basis(Class,Deps), - ub(Deps,OrdV,V-t_lU(L,U)-Init,Vub-Vb-_), - pivot_b(Vub,V,Vb,t_lu(L,U)). -inc_step_2(t_none,l(V*_,_),_,unlimited(V,t_none)). - -% ------------------------- find the most constraining row -------------------- -% -% The code for the lower and the upper bound are dual versions of each other. -% The only difference is in the orientation of the comparisons. -% Indeps are ruled out by their types. -% If there is no bound, this fails. -% -% *** The actual lb and ub on an indep variable X are [lu]b + b(X), where b(X) -% is the value of the active bound. -% -% Nota bene: We must NOT consider infeasible rows as candidates to -% leave the basis! -% -% ub(Class,OrdX,Ub) -% -% See lb/3: this is similar - -ub(Class,OrdX,Ub) :- - class_basis(Class,Deps), - ub_first(Deps,OrdX,Ub). - -% ub_first(Deps,X,Dep-W-Ub) -% -% Finds the tightest upperbound for variable X from the linear equations of -% basis variables Deps, and puts the resulting bound in Ub. Dep is the basis -% variable that generates the bound, and W is bound of that variable that has -% to be activated to achieve this. - -ub_first([Dep|Deps],OrdX,Tightest) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - ub_inner(Type,OrdX,Lin,W,Ub), - Ub > -1.0e-10 % Ub >= 0 - -> ub(Deps,OrdX,Dep-W-Ub,Tightest) - ; ub_first(Deps,OrdX,Tightest) - ). - -% ub(Deps,OrdX,TightestIn,TightestOut) -% -% See lb/4: this is similar - -ub([],_,T0,T0). -ub([Dep|Deps],OrdX,T0,T1) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - ub_inner(Type,OrdX,Lin,W,Ub), - T0 = _-Ubb, - % Ub < Ubb: tighter upper bound is a smaller one - Ub - Ubb < -1.0e-10, - % Ub >= 0: upperbound should be larger than 0; rare failure - Ub > -1.0e-10 - -> ub(Deps,OrdX,Dep-W-Ub,T1) % tighter bound, use new bound - ; ub(Deps,OrdX,T0,T1) % no tighter bound, keep current one - ). - -% ub_inner(Type,OrdX,Lin,W,Ub) -% -% See lb_inner/5: this is similar - -ub_inner(t_l(L),OrdX,Lin,t_L(L),Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - % Rhs is right hand side of lin. eq. Lin containing term X*K - K < -1.0e-10, % K < 0 - Ub is (L-Rhs)/K. -ub_inner(t_u(U),OrdX,Lin,t_U(U),Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - K > 1.0e-10, % K > 0 - Ub is (U-Rhs)/K. -ub_inner(t_lu(L,U),OrdX,Lin,W,Ub) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - ( K < -1.0e-10 % K < 0, use lowerbound - -> W = t_Lu(L,U), - Ub = (L-Rhs)/K - ; K > 1.0e-10 % K > 0, use upperbound - -> W = t_lU(L,U), - Ub = (U-Rhs)/K - ). - -% lb(Class,OrdX,Lb) -% -% Returns in Lb how much we can lower the upperbound of X without violating -% a bound of the basisvariables. -% Lb has the form Dep-W-Lb with Dep the variable whose bound is violated when -% lowering the bound for X more, W the actual bound that has to be activated -% and Lb the amount that the upperbound can be lowered. -% X has ordering OrdX and class Class. - -lb(Class,OrdX,Lb) :- - class_basis(Class,Deps), - lb_first(Deps,OrdX,Lb). - -% lb_first(Deps,OrdX,Tightest) -% -% Returns in Tightest how much we can lower the upperbound of X without -% violating a bound of Deps. -% Tightest has the form Dep-W-Lb with Dep the variable whose bound is violated -% when lowering the bound for X more, W the actual bound that has to be -% activated and Lb the amount that the upperbound can be lowered. X has -% ordering attribute OrdX. - -lb_first([Dep|Deps],OrdX,Tightest) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - lb_inner(Type,OrdX,Lin,W,Lb), - Lb < 1.0e-10 % Lb =< 0: Lb > 0 means a violated bound - -> lb(Deps,OrdX,Dep-W-Lb,Tightest) - ; lb_first(Deps,OrdX,Tightest) - ). - -% lb(Deps,OrdX,TightestIn,TightestOut) -% -% See lb_first/3: this one does the same thing, but is used for the steps after -% the first one and remembers the tightest bound so far. - -lb([],_,T0,T0). -lb([Dep|Deps],OrdX,T0,T1) :- - ( get_attr(Dep,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - lb_inner(Type,OrdX,Lin,W,Lb), - T0 = _-Lbb, - Lb - Lbb > 1.0e-10, % Lb > Lbb: choose the least lowering, others - % might violate bounds - Lb < 1.0e-10 % Lb =< 0: violation of a bound (without lowering) - -> lb(Deps,OrdX,Dep-W-Lb,T1) - ; lb(Deps,OrdX,T0,T1) - ). - -% lb_inner(Type,X,Lin,W,Lb) -% -% Returns in Lb how much lower we can make X without violating a bound -% by using the linear equation Lin of basis variable B which has type -% Type and which has to activate a bound (type W) to do so. -% -% E.g. when B has a lowerbound L, then L should always be smaller than I + R. -% So a lowerbound of X (which has scalar K in Lin), could be at most -% (L-(I+R))/K lower than its upperbound (if K is positive). -% Also note that Lb should always be smaller than 0, otherwise the row is -% not feasible. -% X has ordering attribute OrdX. - -lb_inner(t_l(L),OrdX,Lin,t_L(L),Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), % if linear equation Lin contains the term - % X*K, Rhs is the right hand side of that - % equation - K > 1.0e-10, % K > 0 - Lb is (L-Rhs)/K. -lb_inner(t_u(U),OrdX,Lin,t_U(U),Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - K < -1.0e-10, % K < 0 - Lb is (U-Rhs)/K. -lb_inner(t_lu(L,U),OrdX,Lin,W,Lb) :- - nf_rhs_x(Lin,OrdX,Rhs,K), - ( K < -1.0e-10 - -> W = t_lU(L,U), - Lb is (U-Rhs)/K - ; K > 1.0e-10 - -> W = t_Lu(L,U), - Lb is (L-Rhs)/K - ). - -% ---------------------------------- equations -------------------------------- -% -% backsubstitution will not make the system infeasible, if the bounds on the -% indep vars are obeyed, but some implied values might pop up in rows where X -% occurs -% -) special case X=Y during bs -> get rid of dependend var(s), alias -% - -solve(Lin) :- - Lin = [I,_|H], - solve(H,Lin,I,Bindings,[]), - export_binding(Bindings). - -% solve(Hom,Lin,I,Bind,BindT) -% -% Solves a linear equation Lin = [I,_|H] = 0 and exports the generated bindings - -solve([],_,I,Bind0,Bind0) :- - !, - I >= -1.0e-10, % I =:= 0: redundant or trivially unsat - I =< 1.0e-10. -solve(H,Lin,_,Bind0,BindT) :- - sd(H,[],ClassesUniq,9-9-0,Category-Selected-_,NV,NVT), - get_attr(Selected,itf,Att), - arg(5,Att,order(Ord)), - isolate(Ord,Lin,Lin1), % Lin = 0 => Selected = Lin1 - ( Category = 1 % classless variable, no bounds - -> setarg(4,Att,lin(Lin1)), - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,Selected,Inhom,Bind0,BindT), - eq_classes(NV,NVT,ClassesUniq) - ; Category = 2 % class variable, no bounds - -> arg(6,Att,class(NewC)), - class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,Ord,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,Ord,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq) - ; Category = 3 % classless variable, all variables in Lin and - % Selected are bounded - -> arg(2,Att,type(Type)), - setarg(4,Att,lin(Lin1)), - deactivate_bound(Type,Selected), - eq_classes(NV,NVT,ClassesUniq), - basis_add(Selected,Basis), - undet_active(Lin1), % we can't tell which bound will likely be a - % problem at this point - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,Selected,Inhom,Bind0,Bind1), % only if - % Hom = [] - rcbl(Basis,Bind1,BindT) % reconsider entire basis - ; Category = 4 % class variable, all variables in Lin and Selected - % are bounded - -> arg(2,Att,type(Type)), - arg(6,Att,class(NewC)), - class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,Ord,Lin1,Bind0,Bind1) - ; Bind0 = Bind1, - bs(Deps,Ord,Lin1) - ), - deactivate_bound(Type,Selected), - basis_add(Selected,Basis), - % eq_classes( NV, NVT, ClassesUniq), - % 4 -> var(NV) - equate(ClassesUniq,_), - undet_active(Lin1), - rcbl(Basis,Bind1,BindT) - ). - -% -% Much like solve, but we solve for a particular variable of type t_none -% - -% solve_x(H,Lin,I,X,[Bind|BindT],BindT) -% -% - -solve_x(Lin,X) :- - Lin = [I,_|H], - solve_x(H,Lin,I,X,Bindings,[]), - export_binding(Bindings). - -solve_x([],_,I,_,Bind0,Bind0) :- - !, - I >= -1.0e-10, % I =:= 0: redundant or trivially unsat - I =< 1.0e-10. - -solve_x(H,Lin,_,X,Bind0,BindT) :- - sd(H,[],ClassesUniq,9-9-0,_,NV,NVT), - get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - isolate(OrdX,Lin,Lin1), - ( arg(6,Att,class(NewC)) - -> class_allvars(NewC,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,OrdX,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,OrdX,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq) - ; setarg(4,Att,lin(Lin1)), - Lin1 = [Inhom,_|Hom], - bs_collect_binding(Hom,X,Inhom,Bind0,BindT), - eq_classes(NV,NVT,ClassesUniq) - ). - -% solve_ord_x(Lin,OrdX,ClassX) -% -% Does the same thing as solve_x/2, but has the ordering of X and its class as -% input. This also means that X has a class which is not sure in solve_x/2. - -solve_ord_x(Lin,OrdX,ClassX) :- - Lin = [I,_|H], - solve_ord_x(H,Lin,I,OrdX,ClassX,Bindings,[]), - export_binding(Bindings). - -solve_ord_x([],_,I,_,_,Bind0,Bind0) :- - I >= -1.0e-10, % I =:= 0 - I =< 1.0e-10. -solve_ord_x([_|_],Lin,_,OrdX,ClassX,Bind0,BindT) :- - isolate(OrdX,Lin,Lin1), - Lin1 = [_,_|H1], - sd(H1,[],ClassesUniq1,9-9-0,_,NV,NVT), % do sd on Lin without X, then - % add class of X - ord_add_element(ClassesUniq1,ClassX,ClassesUniq), - class_allvars(ClassX,Deps), - ( ClassesUniq = [_] % rank increasing - -> bs_collect_bindings(Deps,OrdX,Lin1,Bind0,BindT) - ; Bind0 = BindT, - bs(Deps,OrdX,Lin1) - ), - eq_classes(NV,NVT,ClassesUniq). - -% sd(H,[],ClassesUniq,9-9-0,Category-Selected-_,NV,NVT) - -% sd(Hom,ClassesIn,ClassesOut,PreferenceIn,PreferenceOut,[NV|NVTail],NVTail) -% -% ClassesOut is a sorted list of the different classes that are either in -% ClassesIn or that are the classes of the variables in Hom. Variables that do -% not belong to a class yet, are put in the difference list NV. - -sd([],Class0,Class0,Preference0,Preference0,NV0,NV0). -sd([l(X*K,_)|Xs],Class0,ClassN,Preference0,PreferenceN,NV0,NVt) :- - get_attr(X,itf,Att), - ( arg(6,Att,class(Xc)) % old: has class - -> NV0 = NV1, - ord_add_element(Class0,Xc,Class1), - ( arg(2,Att,type(t_none)) - -> preference(Preference0,2-X-K,Preference1) - % has class, no bounds => category 2 - ; preference(Preference0,4-X-K,Preference1) - % has class, is bounded => category 4 - ) - ; % new: has no class - Class1 = Class0, - NV0 = [X|NV1], % X has no class yet, add to list of new variables - ( arg(2,Att,type(t_none)) - -> preference(Preference0,1-X-K,Preference1) - % no class, no bounds => category 1 - ; preference(Preference0,3-X-K,Preference1) - % no class, is bounded => category 3 - ) - ), - sd(Xs,Class1,ClassN,Preference1,PreferenceN,NV1,NVt). - -% -% A is best sofar, B is current -% smallest prefered -preference(A,B,Pref) :- - A = Px-_-_, - B = Py-_-_, - ( Px < Py - -> Pref = A - ; Pref = B - ). - -% eq_classes(NV,NVTail,Cs) -% -% Attaches all classless variables NV to a new class and equates all other -% classes with this class. The equate operation only happens after attach_class -% because the unification of classes can bind the tail of the AllVars attribute -% to a nonvar and then the attach_class operation wouldn't work. - -eq_classes(NV,_,Cs) :- - var(NV), - !, - equate(Cs,_). -eq_classes(NV,NVT,Cs) :- - class_new(Su,clpr,NV,NVT,[]), % make a new class Su with NV as the variables - attach_class(NV,Su), % attach the variables NV to Su - equate(Cs,Su). - -equate([],_). -equate([X|Xs],X) :- equate(Xs,X). - -% -% assert: none of the Vars has a class attribute yet -% -attach_class(Xs,_) :- - var(Xs), % Tail - !. -attach_class([X|Xs],Class) :- - get_attr(X,itf,Att), - setarg(6,Att,class(Class)), - attach_class(Xs,Class). - -% unconstrained(Lin,Uc,Kuc,Rest) -% -% Finds an unconstrained variable Uc (type(t_none)) in Lin with scalar Kuc and -% removes it from Lin to return Rest. - -unconstrained(Lin,Uc,Kuc,Rest) :- - Lin = [_,_|H], - sd(H,[],_,9-9-0,Category-Uc-_,_,_), - Category =< 2, - get_attr(Uc,itf,Att), - arg(5,Att,order(OrdUc)), - delete_factor(OrdUc,Lin,Rest,Kuc). - -% -% point the vars in Lin into the same equivalence class -% maybe join some global data -% -same_class([],_). -same_class([l(X*_,_)|Xs],Class) :- - get_or_add_class(X,Class), - same_class(Xs,Class). - -% get_or_add_class(X,Class) -% -% Returns in Class the class of X if X has one, or a new class where X now -% belongs to if X didn't have one. - -get_or_add_class(X,Class) :- - get_attr(X,itf,Att), - arg(1,Att,CLP), - ( arg(6,Att,class(ClassX)) - -> ClassX = Class - ; setarg(6,Att,class(Class)), - class_new(Class,CLP,[X|Tail],Tail,[]) - ). - -% allvars(X,Allvars) -% -% Allvars is a list of all variables in the class to which X belongs. - -allvars(X,Allvars) :- - get_attr(X,itf,Att), - arg(6,Att,class(C)), - class_allvars(C,Allvars). - -% deactivate_bound(Type,Variable) -% -% The Type of the variable is changed to reflect the deactivation of its -% bounds. -% t_L(_) becomes t_l(_), t_lU(_,_) becomes t_lu(_,_) and so on. - -deactivate_bound(t_l(_),_). -deactivate_bound(t_u(_),_). -deactivate_bound(t_lu(_,_),_). -deactivate_bound(t_L(L),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(L))). -deactivate_bound(t_Lu(L,U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). -deactivate_bound(t_U(U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(U))). -deactivate_bound(t_lU(L,U),X) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% intro_at(X,Value,Type) -% -% Variable X gets new type Type which reflects the activation of a bound with -% value Value. In the linear equations of all the variables belonging to the -% same class as X, X is substituted by [0,Value,X] to reflect the new active -% bound. - -intro_at(X,Value,Type) :- - get_attr(X,itf,Att), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - setarg(2,Att,type(Type)), - ( Value >= -1.0e-10, % Value =:= 0 - Value =< 1.0e-010 - -> true - ; backsubst_delta(Class,Ord,X,Value) - ). - -% undet_active(Lin) -% -% For each variable in the homogene part of Lin, a bound is activated -% if an inactive bound exists. (t_l(L) becomes t_L(L) and so on) - -undet_active([_,_|H]) :- - undet_active_h(H). - -% undet_active_h(Hom) -% -% For each variable in homogene part Hom, a bound is activated if an -% inactive bound exists (t_l(L) becomes t_L(L) and so on) - -undet_active_h([]). -undet_active_h([l(X*_,_)|Xs]) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - undet_active(Type,X), - undet_active_h(Xs). - -% undet_active(Type,Var) -% -% An inactive bound of Var is activated if such exists -% t_lu(L,U) is arbitrarily chosen to become t_Lu(L,U) - -undet_active(t_none,_). % type_activity -undet_active(t_L(_),_). -undet_active(t_Lu(_,_),_). -undet_active(t_U(_),_). -undet_active(t_lU(_,_),_). -undet_active(t_l(L),X) :- intro_at(X,L,t_L(L)). -undet_active(t_u(U),X) :- intro_at(X,U,t_U(U)). -undet_active(t_lu(L,U),X) :- intro_at(X,L,t_Lu(L,U)). - -% determine_active_dec(Lin) -% -% Activates inactive bounds on the variables of Lin if such bounds exist. -% If the type of a variable is t_none, this fails. This version is aimed -% to make the R component of Lin as small as possible in order not to violate -% an upperbound (see reconsider/1) - -determine_active_dec([_,_|H]) :- - determine_active(H,-1). - -% determine_active_inc(Lin) -% -% Activates inactive bounds on the variables of Lin if such bounds exist. -% If the type of a variable is t_none, this fails. This version is aimed -% to make the R component of Lin as large as possible in order not to violate -% a lowerbound (see reconsider/1) - -determine_active_inc([_,_|H]) :- - determine_active(H,1). - -% determine_active(Hom,S) -% -% For each variable in Hom, activates its bound if it is not yet activated. -% For the case of t_lu(_,_) the lower or upper bound is activated depending on -% K and S: -% If sign of K*S is negative, then lowerbound, otherwise upperbound. - -determine_active([],_). -determine_active([l(X*K,_)|Xs],S) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - determine_active(Type,X,K,S), - determine_active(Xs,S). - -determine_active(t_L(_),_,_,_). -determine_active(t_Lu(_,_),_,_,_). -determine_active(t_U(_),_,_,_). -determine_active(t_lU(_,_),_,_,_). -determine_active(t_l(L),X,_,_) :- intro_at(X,L,t_L(L)). -determine_active(t_u(U),X,_,_) :- intro_at(X,U,t_U(U)). -determine_active(t_lu(L,U),X,K,S) :- - TestKs is K*S, - ( TestKs < -1.0e-10 % K*S < 0 - -> intro_at(X,L,t_Lu(L,U)) - ; TestKs > 1.0e-10 - -> intro_at(X,U,t_lU(L,U)) - ). - -% -% Careful when an indep turns into t_none !!! -% - -detach_bounds(V) :- - get_attr(V,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - arg(5,Att,order(OrdV)), - arg(6,Att,class(Class)), - setarg(2,Att,type(t_none)), - setarg(3,Att,strictness(0)), - ( indep(Lin,OrdV) - -> ( ub(Class,OrdV,Vub-Vb-_) - -> % exchange against thightest - class_basis_drop(Class,Vub), - pivot(Vub,Class,OrdV,Vb,Type) - ; lb(Class,OrdV,Vlb-Vb-_) - -> class_basis_drop(Class,Vlb), - pivot(Vlb,Class,OrdV,Vb,Type) - ; true - ) - ; class_basis_drop(Class,V) - ). - -detach_bounds_vlv(OrdV,Lin,Class,Var,NewLin) :- - ( indep(Lin,OrdV) - -> Lin = [_,R|_], - ( ub(Class,OrdV,Vub-Vb-_) - -> % in verify_lin, class might contain two occurrences of Var, - % but it doesn't matter which one we delete - class_basis_drop(Class,Var), - pivot_vlv(Vub,Class,OrdV,Vb,R,NewLin) - ; lb(Class,OrdV,Vlb-Vb-_) - -> class_basis_drop(Class,Var), - pivot_vlv(Vlb,Class,OrdV,Vb,R,NewLin) - ; NewLin = Lin - ) - ; NewLin = Lin, - class_basis_drop(Class,Var) - ). - -% ----------------------------- manipulate the basis -------------------------- - -% basis_drop(X) -% -% Removes X from the basis of the class to which X belongs. - -basis_drop(X) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis_drop(Cv,X). - -% basis(X,Basis) -% -% Basis is the basis of the class to which X belongs. - -basis(X,Basis) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis(Cv,Basis). - -% basis_add(X,NewBasis) -% -% NewBasis is the result of adding X to the basis of the class to which X -% belongs. - -basis_add(X,NewBasis) :- - get_attr(X,itf,Att), - arg(6,Att,class(Cv)), - class_basis_add(Cv,X,NewBasis). - -% basis_pivot(Leave,Enter) -% -% Removes Leave from the basis of the class to which it belongs, and adds -% Enter to that basis. - -basis_pivot(Leave,Enter) :- - get_attr(Leave,itf,Att), - arg(6,Att,class(Cv)), - class_basis_pivot(Cv,Enter,Leave). - -% ----------------------------------- pivot ----------------------------------- - -% pivot(Dep,Indep) -% -% The linear equation of variable Dep, is transformed into one of variable -% Indep, containing Dep. Then, all occurrences of Indep in linear equations are -% substituted by this new definition - -% -% Pivot ignoring rhs and active states -% - -pivot(Dep,Indep) :- - get_attr(Dep,itf,AttD), - arg(4,AttD,lin(H)), - arg(5,AttD,order(OrdDep)), - get_attr(Indep,itf,AttI), - arg(5,AttI,order(Ord)), - arg(5,AttI,class(Class)), - delete_factor(Ord,H,H0,Coeff), - K is -1.0/Coeff, - add_linear_ff(H0,K,[0.0,0.0,l(Dep* -1.0,OrdDep)],K,Lin), - backsubst(Class,Ord,Lin). - -% pivot_a(Dep,Indep,IndepT,DepT) -% -% Removes Dep from the basis, puts Indep in, and pivots the equation of -% Dep to become one of Indep. The type of Dep becomes DepT (which means -% it gets deactivated), the type of Indep becomes IndepT (which means it -% gets activated) - - -pivot_a(Dep,Indep,Vb,Wd) :- - basis_pivot(Dep,Indep), - get_attr(Indep,itf,Att), - arg(2,Att,type(Type)), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - pivot(Dep,Class,Ord,Vb,Type), - get_attr(Indep,itf,Att2), %changed? - setarg(2,Att2,type(Wd)). - -pivot_b(Vub,V,Vb,Wd) :- - ( Vub == V - -> get_attr(V,itf,Att), - arg(5,Att,order(Ord)), - arg(6,Att,class(Class)), - setarg(2,Att,type(Vb)), - pivot_b_delta(Vb,Delta), % nonzero(Delta) - backsubst_delta(Class,Ord,V,Delta) - ; pivot_a(Vub,V,Vb,Wd) - ). - -pivot_b_delta(t_Lu(L,U),Delta) :- Delta is L-U. -pivot_b_delta(t_lU(L,U),Delta) :- Delta is U-L. - -% select_active_bound(Type,Bound) -% -% Returns the bound that is active in Type (if such exists, 0 otherwise) - -select_active_bound(t_L(L),L). -select_active_bound(t_Lu(L,_),L). -select_active_bound(t_U(U),U). -select_active_bound(t_lU(_,U),U). -select_active_bound(t_none,0.0). -% -% for project.pl -% -select_active_bound(t_l(_),0.0). -select_active_bound(t_u(_),0.0). -select_active_bound(t_lu(_,_),0.0). - - -% pivot(Dep,Class,IndepOrd,DepAct,IndAct) -% -% See pivot/2. -% In addition, variable Indep with ordering IndepOrd has an active bound IndAct - -% -% -% Pivot taking care of rhs and active states -% -pivot(Dep,Class,IndepOrd,DepAct,IndAct) :- - get_attr(Dep,itf,Att), - arg(4,Att,lin(H)), - arg(5,Att,order(DepOrd)), - setarg(2,Att,type(DepAct)), - select_active_bound(DepAct,AbvD), % New current value for Dep - select_active_bound(IndAct,AbvI), % New current value of Indep - delete_factor(IndepOrd,H,H0,Coeff), % Dep = ... + Coeff*Indep + ... - AbvDm is -AbvD, - AbvIm is -AbvI, - add_linear_f1([0.0,AbvIm],Coeff,H0,H1), - K is -1.0/Coeff, - add_linear_ff(H1,K,[0.0,AbvDm,l(Dep* -1.0,DepOrd)],K,H2), - % Indep = -1/Coeff*... + 1/Coeff*Dep - add_linear_11(H2,[0.0,AbvIm],Lin), - backsubst(Class,IndepOrd,Lin). - -pivot_vlv(Dep,Class,IndepOrd,DepAct,AbvI,Lin) :- - get_attr(Dep,itf,Att), - arg(4,Att,lin(H)), - arg(5,Att,order(DepOrd)), - setarg(2,Att,type(DepAct)), - select_active_bound(DepAct,AbvD), % New current value for Dep - delete_factor(IndepOrd,H,H0,Coeff), % Dep = ... + Coeff*Indep + ... - AbvDm is -AbvD, - AbvIm is -AbvI, - add_linear_f1([0.0,AbvIm],Coeff,H0,H1), - K is -1.0/Coeff, - add_linear_ff(H1,K,[0.0,AbvDm,l(Dep* -1.0,DepOrd)],K,Lin), - % Indep = -1/Coeff*... + 1/Coeff*Dep - add_linear_11(Lin,[0.0,AbvIm],SubstLin), - backsubst(Class,IndepOrd,SubstLin). - -% backsubst_delta(Class,OrdX,X,Delta) -% -% X with ordering attribute OrdX, is substituted in all linear equations of -% variables in the class Class, by linear equation [0,Delta,l(X*1,OrdX)]. This -% reflects the activation of a bound. - -backsubst_delta(Class,OrdX,X,Delta) :- - backsubst(Class,OrdX,[0.0,Delta,l(X*1.0,OrdX)]). - -% backsubst(Class,OrdX,Lin) -% -% X with ordering OrdX is substituted in all linear equations of variables in -% the class Class, by linear equation Lin - -backsubst(Class,OrdX,Lin) :- - class_allvars(Class,Allvars), - bs(Allvars,OrdX,Lin). - -% bs(Vars,OrdV,Lin) -% -% In all linear equations of the variables Vars, variable V with ordering -% attribute OrdV is substituted by linear equation Lin. -% -% valid if nothing will go ground -% - -bs(Xs,_,_) :- - var(Xs), - !. -bs([X|Xs],OrdV,Lin) :- - ( get_attr(X,itf,Att), - arg(4,Att,lin(LinX)), - nf_substitute(OrdV,Lin,LinX,LinX1) % does not change attributes - -> setarg(4,Att,lin(LinX1)), - bs(Xs,OrdV,Lin) - ; bs(Xs,OrdV,Lin) - ). - -% -% rank increasing backsubstitution -% - -% bs_collect_bindings(Deps,SelectedOrd,Lin,Bind,BindT) -% -% Collects bindings (of the form [X-I] where X = I is the binding) by -% substituting Selected in all linear equations of the variables Deps (which -% are of the same class), by Lin. Selected has ordering attribute SelectedOrd. -% -% E.g. when V = 2X + 3Y + 4, X = 3V + 2Z and Y = 4X + 3 -% we can substitute V in the linear equation of X: X = 6X + 9Y + 2Z + 12 -% we can't substitute V in the linear equation of Y of course. - -bs_collect_bindings(Xs,_,_,Bind0,BindT) :- - var(Xs), - !, - Bind0 = BindT. -bs_collect_bindings([X|Xs],OrdV,Lin,Bind0,BindT) :- - ( get_attr(X,itf,Att), - arg(4,Att,lin(LinX)), - nf_substitute(OrdV,Lin,LinX,LinX1) % does not change attributes - -> setarg(4,Att,lin(LinX1)), - LinX1 = [Inhom,_|Hom], - bs_collect_binding(Hom,X,Inhom,Bind0,Bind1), - bs_collect_bindings(Xs,OrdV,Lin,Bind1,BindT) - ; bs_collect_bindings(Xs,OrdV,Lin,Bind0,BindT) - ). - -% bs_collect_binding(Hom,Selected,Inhom,Bind,BindT) -% -% Collects binding following from Selected = Hom + Inhom. -% If Hom = [], returns the binding Selected-Inhom (=0) -% -bs_collect_binding([],X,Inhom) --> [X-Inhom]. -bs_collect_binding([_|_],_,_) --> []. - -% -% reconsider the basis -% - -% rcbl(Basis,Bind,BindT) -% -% - -rcbl([],Bind0,Bind0). -rcbl([X|Continuation],Bind0,BindT) :- - ( rcb_cont(X,Status,Violated,Continuation,NewContinuation) % have a culprit - -> rcbl_status(Status,X,NewContinuation,Bind0,BindT,Violated) - ; rcbl(Continuation,Bind0,BindT) - ). - -rcb_cont(X,Status,Violated,ContIn,ContOut) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin([I,R|H])), - ( Type = t_l(L) % case 1: lowerbound: R + I should always be larger - % than the lowerbound - -> R + I - L < 1.0e-10, - Violated = l(L), - inc_step_cont(H,Status,ContIn,ContOut) - ; Type = t_u(U) % case 2: upperbound: R + I should always be smaller - % than the upperbound - -> R + I - U > -1.0e-10, - Violated = u(U), - dec_step_cont(H,Status,ContIn,ContOut) - ; Type = t_lu(L,U) % case 3: check both - -> At is R + I, - ( At - L < 1.0e-10 - -> Violated = l(L), - inc_step_cont(H,Status,ContIn,ContOut) - ; At - U > -1.0e-10 - -> Violated = u(U), - dec_step_cont(H,Status,ContIn,ContOut) - ) - ). % other types imply nonbasic variable or unbounded variable - - - -% -% reconsider one element of the basis -% later: lift the binds -% -reconsider(X) :- - rcb(X,Status,Violated), - !, - rcbl_status(Status,X,[],Binds,[],Violated), - export_binding(Binds). -reconsider(_). - -% -% Find a basis variable out of its bound or at its bound -% Try to move it into whithin its bound -% a) impossible -> fail -% b) optimum at the bound -> implied value -% c) else look at the remaining basis variables -% -% -% Idea: consider a variable V with linear equation Lin. -% When a bound on a variable X of Lin gets activated, its value, multiplied -% with the scalar of X, is added to the R component of Lin. -% When we consider the lowerbound of V, it must be smaller than R + I, since R -% contains at best the lowerbounds of the variables in Lin (but could contain -% upperbounds, which are of course larger). So checking this can show the -% violation of a bound of V. A similar case works for the upperbound. - -rcb(X,Status,Violated) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin([I,R|H])), - ( Type = t_l(L) % case 1: lowerbound: R + I should always be larger - % than the lowerbound - -> R + I - L < 1.0e-10, % R + I =< L - Violated = l(L), - inc_step(H,Status) - ; Type = t_u(U) % case 2: upperbound: R + I should always be smaller - % than the upperbound - -> R + I - U > -1.0e-10, % R + I >= U - Violated = u(U), - dec_step(H,Status) - ; Type = t_lu(L,U) % case 3: check both - -> At is R + I, - ( At - L < 1.0e-10 % At =< L - -> Violated = l(L), - inc_step(H,Status) - ; At - U > -1.0e-10 % At >= U - -> Violated = u(U), - dec_step(H,Status) - ) - ). % other types imply nonbasic variable or unbounded variable - -% rcbl_status(Status,X,Continuation,[Bind|BindT],BindT,Violated) -% -% - -rcbl_status(optimum,X,Cont,B0,Bt,Violated) :- rcbl_opt(Violated,X,Cont,B0,Bt). -rcbl_status(applied,X,Cont,B0,Bt,Violated) :- rcbl_app(Violated,X,Cont,B0,Bt). -rcbl_status(unlimited(Indep,DepT),X,Cont,B0,Bt,Violated) :- - rcbl_unl(Violated,X,Cont,B0,Bt,Indep,DepT). - -% -% Might reach optimum immediately without changing the basis, -% but in general we must assume that there were pivots. -% If the optimum meets the bound, we backsubstitute the implied -% value, solve will call us again to check for further implied -% values or unsatisfiability in the rank increased system. -% -rcbl_opt(l(L),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Strict)), - arg(4,Att,lin(Lin)), - Lin = [I,R|_], - Opt is R + I, - TestLO is L - Opt, - ( TestLO < -1.0e-10 % L < Opt - -> narrow_u(Type,X,Opt), % { X =< Opt } - rcbl(Continuation,B0,B1) - ; TestLO =< 1.0e-10, % L = Opt - Strict /\ 2 =:= 0, % meets lower - Mop is -Opt, - normalize_scalar(Mop,MopN), - add_linear_11(MopN,Lin,Lin1), - Lin1 = [Inhom,_|Hom], - ( Hom = [] - -> rcbl(Continuation,B0,B1) % would not callback - ; solve(Hom,Lin1,Inhom,B0,B1) - ) - ). -rcbl_opt(u(U),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Strict)), - arg(4,Att,lin(Lin)), - Lin = [I,R|_], - Opt is R + I, - TestUO is U - Opt, - ( TestUO > 1.0e-10 % U > Opt - -> narrow_l(Type,X,Opt), % { X >= Opt } - rcbl(Continuation,B0,B1) - ; TestUO >= -1.0e-10, % U = Opt - Strict /\ 1 =:= 0, % meets upper - Mop is -Opt, - normalize_scalar(Mop,MopN), - add_linear_11(MopN,Lin,Lin1), - Lin1 = [Inhom,_|Hom], - ( Hom = [] - -> rcbl(Continuation,B0,B1) % would not callback - ; solve(Hom,Lin1,Inhom,B0,B1) - ) - ). - -% -% Basis has already changed when this is called -% -rcbl_app(l(L),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(4,Att,lin([I,R|H])), - ( R + I - L > 1.0e-10 % R+I > L: within bound now - -> rcbl(Continuation,B0,B1) - ; inc_step(H,Status), - rcbl_status(Status,X,Continuation,B0,B1,l(L)) - ). -rcbl_app(u(U),X,Continuation,B0,B1) :- - get_attr(X,itf,Att), - arg(4,Att,lin([I,R|H])), - ( R + I - U < -1.0e-10 % R+I < U: within bound now - -> rcbl(Continuation,B0,B1) - ; dec_step(H,Status), - rcbl_status(Status,X,Continuation,B0,B1,u(U)) - ). -% -% This is never called for a t_lu culprit -% -rcbl_unl(l(L),X,Continuation,B0,B1,Indep,DepT) :- - pivot_a(X,Indep,t_L(L),DepT), % changes the basis - rcbl(Continuation,B0,B1). -rcbl_unl(u(U),X,Continuation,B0,B1,Indep,DepT) :- - pivot_a(X,Indep,t_U(U),DepT), % changes the basis - rcbl(Continuation,B0,B1). - -% narrow_u(Type,X,U) -% -% Narrows down the upperbound of X (type Type) to U. -% Fails if Type is not t_u(_) or t_lu(_) - -narrow_u(t_u(_),X,U) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(U))). -narrow_u(t_lu(L,_),X,U) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% narrow_l(Type,X,L) -% -% Narrows down the lowerbound of X (type Type) to L. -% Fails if Type is not t_l(_) or t_lu(_) - -narrow_l( t_l(_), X, L) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(L))). - -narrow_l( t_lu(_,U), X, L) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,U))). - -% ----------------------------------- dump ------------------------------------ - -% dump_var(Type,Var,I,H,Dump,DumpTail) -% -% Returns in Dump a representation of the linear constraint on variable -% Var which has linear equation H + I and has type Type. - -dump_var(t_none,V,I,H) --> - !, - ( { - H = [l(W*K,_)], - V == W, - I >= -1.0e-10, % I=:=0 - I =< 1.0e-010, - TestK is K - 1.0, % K=:=1 - TestK >= -1.0e-10, - TestK =< 1.0e-10 - } - -> % indep var - [] - ; {nf2sum(H,I,Sum)}, - [V = Sum] - ). -dump_var(t_L(L),V,I,H) --> - !, - dump_var(t_l(L),V,I,H). -% case lowerbound: V >= L or V > L -% say V >= L, and V = K*V1 + ... + I, then K*V1 + ... + I >= L -% and K*V1 + ... >= L-I and V1 + .../K = (L-I)/K -dump_var(t_l(L),V,I,H) --> - !, - { - H = [l(_*K,_)|_], % avoid 1 >= 0 - get_attr(V,itf,Att), - arg(3,Att,strictness(Strict)), - Sm is Strict /\ 2, - Kr is 1.0/K, - Li is Kr*(L - I), - mult_hom(H,Kr,H1), - nf2sum(H1,0.0,Sum), - ( K > 1.0e-10 % K > 0 - -> dump_strict(Sm,Sum >= Li,Sum > Li,Result) - ; dump_strict(Sm,Sum =< Li,Sum < Li,Result) - ) - }, - [Result]. -dump_var(t_U(U),V,I,H) --> - !, - dump_var(t_u(U),V,I,H). -dump_var(t_u(U),V,I,H) --> - !, - { - H = [l(_*K,_)|_], % avoid 0 =< 1 - get_attr(V,itf,Att), - arg(3,Att,strictness(Strict)), - Sm is Strict /\ 1, - Kr is 1.0/K, - Ui is Kr*(U-I), - mult_hom(H,Kr,H1), - nf2sum(H1,0.0,Sum), - ( K > 1.0e-10 % K > 0 - -> dump_strict(Sm,Sum =< Ui,Sum < Ui,Result) - ; dump_strict(Sm,Sum >= Ui,Sum > Ui,Result) - ) - }, - [Result]. -dump_var(t_Lu(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_u(U),V,I,H). -dump_var(t_lU(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_u(U),V,I,H). -dump_var(t_lu(L,U),V,I,H) --> - !, - dump_var(t_l(L),V,I,H), - dump_var(t_U(U),V,I,H). -dump_var(T,V,I,H) --> % should not happen - [V:T:I+H]. - -% dump_strict(FilteredStrictness,Nonstrict,Strict,Res) -% -% Unifies Res with either Nonstrict or Strict depending on FilteredStrictness. -% FilteredStrictness is the component of strictness related to the bound: 0 -% means nonstrict, 1 means strict upperbound, 2 means strict lowerbound, -% 3 is filtered out to either 1 or 2. - -dump_strict(0,Result,_,Result). -dump_strict(1,_,Result,Result). -dump_strict(2,_,Result,Result). - -% dump_nz(V,H,I,Dump,DumpTail) -% -% Returns in Dump a representation of the nonzero constraint of variable V -% which has linear -% equation H + I. - -dump_nz(_,H,I) --> - { - H = [l(_*K,_)|_], - Kr is 1.0/K, - I1 is -Kr*I, - mult_hom(H,Kr,H1), - nf2sum(H1,0.0,Sum) - }, - [Sum =\= I1]. diff --git a/GPL/clpqr/clpr/fourmotz_r.pl b/GPL/clpqr/clpr/fourmotz_r.pl deleted file mode 100644 index 2140576e5..000000000 --- a/GPL/clpqr/clpr/fourmotz_r.pl +++ /dev/null @@ -1,504 +0,0 @@ -/* $Id: fourmotz_r.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(fourmotz_r, - [ - fm_elim/3 - ]). -:- use_module(bv_r, - [ - allvars/2, - basis_add/2, - detach_bounds/1, - pivot/5, - var_with_def_intern/4 - ]). -:- use_module('../clpqr/class', - [ - class_allvars/2 - ]). -:- use_module('../clpqr/project', - [ - drop_dep/1, - drop_dep_one/1, - make_target_indep/2 - ]). -:- use_module('../clpqr/redund', - [ - redundancy_vars/1 - ]). -:- use_module(store_r, - [ - add_linear_11/3, - add_linear_f1/4, - indep/2, - nf_coeff_of/3, - normalize_scalar/2 - ]). - - - -fm_elim(Vs,Target,Pivots) :- - prefilter(Vs,Vsf), - fm_elim_int(Vsf,Target,Pivots). - -% prefilter(Vars,Res) -% -% filters out target variables and variables that do not occur in bounded linear equations. -% Stores that the variables in Res are to be kept independent. - -prefilter([],[]). -prefilter([V|Vs],Res) :- - ( get_attr(V,itf,Att), - arg(9,Att,n), - occurs(V) % V is a nontarget variable that occurs in a bounded linear equation - -> Res = [V|Tail], - setarg(10,Att,keep_indep), - prefilter(Vs,Tail) - ; prefilter(Vs,Res) - ). - -% -% the target variables are marked with an attribute, and we get a list -% of them as an argument too -% -fm_elim_int([],_,Pivots) :- % done - unkeep(Pivots). -fm_elim_int(Vs,Target,Pivots) :- - Vs = [_|_], - ( best(Vs,Best,Rest) - -> occurences(Best,Occ), - elim_min(Best,Occ,Target,Pivots,NewPivots) - ; % give up - NewPivots = Pivots, - Rest = [] - ), - fm_elim_int(Rest,Target,NewPivots). - -% best(Vs,Best,Rest) -% -% Finds the variable with the best result (lowest Delta) in fm_cp_filter -% and returns the other variables in Rest. - -best(Vs,Best,Rest) :- - findall(Delta-N,fm_cp_filter(Vs,Delta,N),Deltas), - keysort(Deltas,[_-N|_]), - select_nth(Vs,N,Best,Rest). - -% fm_cp_filter(Vs,Delta,N) -% -% For an indepenent variable V in Vs, which is the N'th element in Vs, -% find how many inequalities are generated when this variable is eliminated. -% Note that target variables and variables that only occur in unbounded equations -% should have been removed from Vs via prefilter/2 - -fm_cp_filter(Vs,Delta,N) :- - length(Vs,Len), % Len = number of variables in Vs - mem(Vs,X,Vst), % Selects a variable X in Vs, Vst is the list of elements after X in Vs - get_attr(X,itf,Att), - arg(4,Att,lin(Lin)), - arg(5,Att,order(OrdX)), - arg(9,Att,n), % no target variable - indep(Lin,OrdX), % X is an independent variable - occurences(X,Occ), - Occ = [_|_], - cp_card(Occ,0,Lnew), - length(Occ,Locc), - Delta is Lnew-Locc, - length(Vst,Vstl), - N is Len-Vstl. % X is the Nth element in Vs - -% mem(Xs,X,XsT) -% -% If X is a member of Xs, XsT is the list of elements after X in Xs. - -mem([X|Xs],X,Xs). -mem([_|Ys],X,Xs) :- mem(Ys,X,Xs). - -% select_nth(List,N,Nth,Others) -% -% Selects the N th element of List, stores it in Nth and returns the rest of the list in Others. - -select_nth(List,N,Nth,Others) :- - select_nth(List,1,N,Nth,Others). - -select_nth([X|Xs],N,N,X,Xs) :- !. -select_nth([Y|Ys],M,N,X,[Y|Xs]) :- - M1 is M+1, - select_nth(Ys,M1,N,X,Xs). - -% -% fm_detach + reverse_pivot introduce indep t_none, which -% invalidates the invariants -% -elim_min(V,Occ,Target,Pivots,NewPivots) :- - crossproduct(Occ,New,[]), - activate_crossproduct(New), - reverse_pivot(Pivots), - fm_detach(Occ), - allvars(V,All), - redundancy_vars(All), % only for New \== [] - make_target_indep(Target,NewPivots), - drop_dep(All). - -% -% restore NF by reverse pivoting -% -reverse_pivot([]). -reverse_pivot([I:D|Ps]) :- - get_attr(D,itf,AttD), - arg(2,AttD,type(Dt)), - setarg(11,AttD,n), % no longer - get_attr(I,itf,AttI), - arg(2,AttI,type(It)), - arg(5,AttI,order(OrdI)), - arg(6,AttI,class(ClI)), - pivot(D,ClI,OrdI,Dt,It), - reverse_pivot(Ps). - -% unkeep(Pivots) -% -% - -unkeep([]). -unkeep([_:D|Ps]) :- - get_attr(D,itf,Att), - setarg(11,Att,n), - drop_dep_one(D), - unkeep(Ps). - - -% -% All we drop are bounds -% -fm_detach( []). -fm_detach([V:_|Vs]) :- - detach_bounds(V), - fm_detach(Vs). - -% activate_crossproduct(Lst) -% -% For each inequality Lin =< 0 (or Lin < 0) in Lst, a new variable is created: -% Var = Lin and Var =< 0 (or Var < 0). Var is added to the basis. - -activate_crossproduct([]). -activate_crossproduct([lez(Strict,Lin)|News]) :- - var_with_def_intern(t_u(0.0),Var,Lin,Strict), - % Var belongs to same class as elements in Lin - basis_add(Var,_), - activate_crossproduct(News). - -% ------------------------------------------------------------------------------ - -% crossproduct(Lst,Res,ResTail) -% -% See crossproduct/4 -% This predicate each time puts the next element of Lst as First in crossproduct/4 -% and lets the rest be Next. - -crossproduct([]) --> []. -crossproduct([A|As]) --> - crossproduct(As,A), - crossproduct(As). - -% crossproduct(Next,First,Res,ResTail) -% -% Eliminates a variable in linear equations First + Next and stores the generated -% inequalities in Res. -% Let's say A:K1 = First and B:K2 = first equation in Next. -% A = ... + K1*V + ... -% B = ... + K2*V + ... -% Let K = -K2/K1 -% then K*A + B = ... + 0*V + ... -% from the bounds of A and B, via cross_lower/7 and cross_upper/7, new inequalities -% are generated. Then the same is done for B:K2 = next element in Next. - -crossproduct([],_) --> []. -crossproduct([B:Kb|Bs],A:Ka) --> - { - get_attr(A,itf,AttA), - arg(2,AttA,type(Ta)), - arg(3,AttA,strictness(Sa)), - arg(4,AttA,lin(LinA)), - get_attr(B,itf,AttB), - arg(2,AttB,type(Tb)), - arg(3,AttB,strictness(Sb)), - arg(4,AttB,lin(LinB)), - K is -Kb/Ka, - add_linear_f1(LinA,K,LinB,Lin) % Lin doesn't contain the target variable anymore - }, - ( { K > 1.0e-10 } % K > 0: signs were opposite - -> { Strict is Sa \/ Sb }, - cross_lower(Ta,Tb,K,Lin,Strict), - cross_upper(Ta,Tb,K,Lin,Strict) - ; % La =< A =< Ua -> -Ua =< -A =< -La - { - flip(Ta,Taf), - flip_strict(Sa,Saf), - Strict is Saf \/ Sb - }, - cross_lower(Taf,Tb,K,Lin,Strict), - cross_upper(Taf,Tb,K,Lin,Strict) - ), - crossproduct(Bs,A:Ka). - -% cross_lower(Ta,Tb,K,Lin,Strict,Res,ResTail) -% -% Generates a constraint following from the bounds of A and B. -% When A = LinA and B = LinB then Lin = K*LinA + LinB. Ta is the type -% of A and Tb is the type of B. Strict is the union of the strictness -% of A and B. If K is negative, then Ta should have been flipped (flip/2). -% The idea is that if La =< A =< Ua and Lb =< B =< Ub (=< can also be <) -% then if K is positive, K*La + Lb =< K*A + B =< K*Ua + Ub. -% if K is negative, K*Ua + Lb =< K*A + B =< K*La + Ub. -% This predicate handles the first inequality and adds it to Res in the form -% lez(Sl,Lhs) meaning K*La + Lb - (K*A + B) =< 0 or K*Ua + Lb - (K*A + B) =< 0 -% with Sl being the strictness and Lhs the lefthandside of the equation. -% See also cross_upper/7 - -cross_lower(Ta,Tb,K,Lin,Strict) --> - { - lower(Ta,La), - lower(Tb,Lb), - !, - L is K*La+Lb, - normalize_scalar(L,Ln), - add_linear_f1(Lin,-1.0,Ln,Lhs), - Sl is Strict >> 1 % normalize to upper bound - }, - [ lez(Sl,Lhs) ]. -cross_lower(_,_,_,_,_) --> []. - -% cross_upper(Ta,Tb,K,Lin,Strict,Res,ResTail) -% -% See cross_lower/7 -% This predicate handles the second inequality: -% -(K*Ua + Ub) + K*A + B =< 0 or -(K*La + Ub) + K*A + B =< 0 - -cross_upper(Ta,Tb,K,Lin,Strict) --> - { - upper(Ta,Ua), - upper(Tb,Ub), - !, - U is -(K*Ua+Ub), - normalize_scalar(U,Un), - add_linear_11(Un,Lin,Lhs), - Su is Strict /\ 1 % normalize to upper bound - }, - [ lez(Su,Lhs) ]. -cross_upper(_,_,_,_,_) --> []. - -% lower(Type,Lowerbound) -% -% Returns the lowerbound of type Type if it has one. -% E.g. if type = t_l(L) then Lowerbound is L, -% if type = t_lU(L,U) then Lowerbound is L, -% if type = t_u(U) then fails - -lower(t_l(L),L). -lower(t_lu(L,_),L). -lower(t_L(L),L). -lower(t_Lu(L,_),L). -lower(t_lU(L,_),L). - -% upper(Type,Upperbound) -% -% Returns the upperbound of type Type if it has one. -% See lower/2 - -upper(t_u(U),U). -upper(t_lu(_,U),U). -upper(t_U(U),U). -upper(t_Lu(_,U),U). -upper(t_lU(_,U),U). - -% flip(Type,FlippedType) -% -% Flips the lower and upperbound, so the old lowerbound becomes the new upperbound and -% vice versa. - -flip(t_l(X),t_u(X)). -flip(t_u(X),t_l(X)). -flip(t_lu(X,Y),t_lu(Y,X)). -flip(t_L(X),t_u(X)). -flip(t_U(X),t_l(X)). -flip(t_lU(X,Y),t_lu(Y,X)). -flip(t_Lu(X,Y),t_lu(Y,X)). - -% flip_strict(Strict,FlippedStrict) -% -% Does what flip/2 does, but for the strictness. - -flip_strict(0,0). -flip_strict(1,2). -flip_strict(2,1). -flip_strict(3,3). - -% cp_card(Lst,CountIn,CountOut) -% -% Counts the number of bounds that may generate an inequality in -% crossproduct/3 - -cp_card([],Ci,Ci). -cp_card([A|As],Ci,Co) :- - cp_card(As,A,Ci,Cii), - cp_card(As,Cii,Co). - -% cp_card(Next,First,CountIn,CountOut) -% -% Counts the number of bounds that may generate an inequality in -% crossproduct/4. - -cp_card([],_,Ci,Ci). -cp_card([B:Kb|Bs],A:Ka,Ci,Co) :- - get_attr(A,itf,AttA), - arg(2,AttA,type(Ta)), - get_attr(B,itf,AttB), - arg(2,AttB,type(Tb)), - K is -Kb/Ka, - ( K > 1.0e-10 % K > 0: signs were opposite - -> cp_card_lower(Ta,Tb,Ci,Cii), - cp_card_upper(Ta,Tb,Cii,Ciii) - ; flip(Ta,Taf), - cp_card_lower(Taf,Tb,Ci,Cii), - cp_card_upper(Taf,Tb,Cii,Ciii) - ), - cp_card(Bs,A:Ka,Ciii,Co). - -% cp_card_lower(TypeA,TypeB,SIn,SOut) -% -% SOut = SIn + 1 if both TypeA and TypeB have a lowerbound. - -cp_card_lower(Ta,Tb,Si,So) :- - lower(Ta,_), - lower(Tb,_), - !, - So is Si+1. -cp_card_lower(_,_,Si,Si). - -% cp_card_upper(TypeA,TypeB,SIn,SOut) -% -% SOut = SIn + 1 if both TypeA and TypeB have an upperbound. - -cp_card_upper(Ta,Tb,Si,So) :- - upper(Ta,_), - upper(Tb,_), - !, - So is Si+1. -cp_card_upper(_,_,Si,Si). - -% ------------------------------------------------------------------------------ - -% occurences(V,Occ) -% -% Returns in Occ the occurrences of variable V in the linear equations of dependent variables -% with bound =\= t_none in the form of D:K where D is a dependent variable and K is the scalar -% of V in the linear equation of D. - -occurences(V,Occ) :- - get_attr(V,itf,Att), - arg(5,Att,order(OrdV)), - arg(6,Att,class(C)), - class_allvars(C,All), - occurences(All,OrdV,Occ). - -% occurences(De,OrdV,Occ) -% -% Returns in Occ the occurrences of variable V with order OrdV in the linear equations of -% dependent variables De with bound =\= t_none in the form of D:K where D is a dependent -% variable and K is the scalar of V in the linear equation of D. - -occurences(De,_,[]) :- - var(De), - !. -occurences([D|De],OrdV,Occ) :- - ( get_attr(D,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - occ_type_filter(Type), - nf_coeff_of(Lin,OrdV,K) - -> Occ = [D:K|Occt], - occurences(De,OrdV,Occt) - ; occurences(De,OrdV,Occ) - ). - -% occ_type_filter(Type) -% -% Succeeds when Type is any other type than t_none. Is used in occurences/3 and occurs/2 - -occ_type_filter(t_l(_)). -occ_type_filter(t_u(_)). -occ_type_filter(t_lu(_,_)). -occ_type_filter(t_L(_)). -occ_type_filter(t_U(_)). -occ_type_filter(t_lU(_,_)). -occ_type_filter(t_Lu(_,_)). - -% occurs(V) -% -% Checks whether variable V occurs in a linear equation of a dependent variable with a bound -% =\= t_none. - -occurs(V) :- - get_attr(V,itf,Att), - arg(5,Att,order(OrdV)), - arg(6,Att,class(C)), - class_allvars(C,All), - occurs(All,OrdV). - -% occurs(De,OrdV) -% -% Checks whether variable V with order OrdV occurs in a linear equation of any dependent variable -% in De with a bound =\= t_none. - -occurs(De,_) :- - var(De), - !, - fail. -occurs([D|De],OrdV) :- - ( get_attr(D,itf,Att), - arg(2,Att,type(Type)), - arg(4,Att,lin(Lin)), - occ_type_filter(Type), - nf_coeff_of(Lin,OrdV,_) - -> true - ; occurs(De,OrdV) - ). \ No newline at end of file diff --git a/GPL/clpqr/clpr/ineq_r.pl b/GPL/clpqr/clpr/ineq_r.pl deleted file mode 100644 index 0c45fe3d1..000000000 --- a/GPL/clpqr/clpr/ineq_r.pl +++ /dev/null @@ -1,1384 +0,0 @@ -/* - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(ineq_r, - [ - ineq/4, - ineq_one/4, - ineq_one_n_n_0/1, - ineq_one_n_p_0/1, - ineq_one_s_n_0/1, - ineq_one_s_p_0/1 - ]). -:- use_module(bv_r, - [ - backsubst/3, - backsubst_delta/4, - basis_add/2, - dec_step/2, - deref/2, - determine_active_dec/1, - determine_active_inc/1, - export_binding/1, - get_or_add_class/2, - inc_step/2, - lb/3, - pivot_a/4, - rcbl_status/6, - reconsider/1, - same_class/2, - solve/1, - ub/3, - unconstrained/4, - var_intern/3, - var_with_def_intern/4 - ]). -:- use_module(store_r, - [ - add_linear_11/3, - add_linear_ff/5, - normalize_scalar/2 - ]). - -% ineq(H,I,Nf,Strictness) -% -% Solves the inequality Nf < 0 or Nf =< 0 where Nf is in normal form -% and H and I are the homogene and inhomogene parts of Nf. - -ineq([],I,_,Strictness) :- ineq_ground(Strictness,I). -ineq([v(K,[X^1])|Tail],I,Lin,Strictness) :- - ineq_cases(Tail,I,Lin,Strictness,X,K). - -ineq_cases([],I,_,Strictness,X,K) :- % K*X + I < 0 or K*X + I =< 0 - ineq_one(Strictness,X,K,I). -ineq_cases([_|_],_,Lin,Strictness,_,_) :- - deref(Lin,Lind), % Id+Hd =< 0 - Lind = [Inhom,_|Hom], - ineq_more(Hom,Inhom,Lind,Strictness). - -% ineq_ground(Strictness,I) -% -% Checks whether a grounded inequality I < 0 or I =< 0 is satisfied. - -ineq_ground(strict,I) :- I < -1.0e-10. % I < 0 -ineq_ground(nonstrict,I) :- I < 1.0e-10. % I =< 0 - -% ineq_one(Strictness,X,K,I) -% -% Solves the inequality K*X + I < 0 or K*X + I =< 0 - -ineq_one(strict,X,K,I) :- - ( K > 1.0e-10 % K > 0.0 - -> ( I >= -1.0e-10, % I =:= 0.0 - I =< 1.0e-10 - -> ineq_one_s_p_0(X) % K*X < 0, K > 0 => X < 0 - ; Inhom is I/K, - ineq_one_s_p_i(X,Inhom) % K*X + I < 0, K > 0 => X + I/K < 0 - ) - ; ( I >= -1.0e-10, % I =:= 0.0 - I =< 1.0e-10 - -> ineq_one_s_n_0(X) % K*X < 0, K < 0 => -X < 0 - ; Inhom is -I/K, - ineq_one_s_n_i(X,Inhom) % K*X + I < 0, K < 0 => -X - I/K < 0 - ) - ). -ineq_one(nonstrict,X,K,I) :- - ( K > 1.0e-10 % K > 0.0 - -> ( I >= -1.0e-10, % I =:= 0 - I =< 1.0e-10 - -> ineq_one_n_p_0(X) % K*X =< 0, K > 0 => X =< 0 - ; Inhom is I/K, - ineq_one_n_p_i(X,Inhom) % K*X + I =< 0, K > 0 => X + I/K =< 0 - ) - ; ( I >= -1.0e-10, % I =:= 0 - I =< 1.0e-10 - -> ineq_one_n_n_0(X) % K*X =< 0, K < 0 => -X =< 0 - ; Inhom is -I/K, - ineq_one_n_n_i(X,Inhom) % K*X + I =< 0, K < 0 => -X - I/K =< 0 - ) - ). - -% --------------------------- strict ---------------------------- - -% ineq_one_s_p_0(X) -% -% Solves the inequality X < 0 - -ineq_one_s_p_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, % old variable, this is deref - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_p_0(OrdX,X,Ix) - ). -ineq_one_s_p_0(X) :- % new variable, nothing depends on it - var_intern(t_u(0.0),X,1). % put a strict inactive upperbound on the variable - -% ineq_one_s_n_0(X) -% -% Solves the inequality X > 0 - -ineq_one_s_n_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_n_0(OrdX,X,Ix) - ). -ineq_one_s_n_0(X) :- - var_intern(t_l(0.0),X,2). % puts a strict inactive lowerbound on the variable - -% ineq_one_s_p_i(X,I) -% -% Solves the inequality X < -I - -ineq_one_s_p_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_p_i(OrdX,I,X,Ix) - ). -ineq_one_s_p_i(X,I) :- - Bound is -I, - var_intern(t_u(Bound),X,1). % puts a strict inactive upperbound on the variable - -% ineq_one_s_n_i(X,I) -% -% Solves the inequality X > I - -ineq_one_s_n_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_s_n_i(OrdX,I,X,Ix) - ). -ineq_one_s_n_i(X,I) :- var_intern(t_l(I),X,2). % puts a strict inactive lowerbound on the variable - -% ineq_one_old_s_p_0(Hom,X,Inhom) -% -% Solves the inequality X < 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_p_0([],_,Ix) :- Ix < -1.0e-10. % X = I: Ix < 0 -ineq_one_old_s_p_0([l(Y*Ky,_)|Tail],X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -Ix/Ky, - update_indep(strict,Y,Ky,Bound) % X < 0, X = K*Y + I => Y < -I/K or Y > -I/K (depending on K) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udus(Type,X,Lin,0.0,Old) % update strict upperbound - ). - -% ineq_one_old_s_p_0(Hom,X,Inhom) -% -% Solves the inequality X > 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_n_0([],_,Ix) :- Ix > 1.0e-10. % X = I: Ix > 0 -ineq_one_old_s_n_0([l(Y*Ky,_)|Tail], X, Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is Ix/Coeff, - update_indep(strict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udls(Type,X,Lin,0.0,Old) % update strict lowerbound - ). - -% ineq_one_old_s_p_i(Hom,C,X,Inhom) -% -% Solves the inequality X + C < 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_p_i([],I,_,Ix) :- Ix + I < -1.0e-10. % X = I -ineq_one_old_s_p_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -(Ix + I)/Ky, - update_indep(strict,Y,Ky,Bound) - ; Tail = [_|_] - -> Bound is -I, - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udus(Type,X,Lin,Bound,Old) % update strict upperbound - ). - -% ineq_one_old_s_n_i(Hom,C,X,Inhom) -% -% Solves the inequality X - C > 0 where X has linear equation Hom + Inhom - -ineq_one_old_s_n_i([],I,_,Ix) :- -Ix + I < -1.0e-10. % X = I -ineq_one_old_s_n_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is (Ix - I)/Coeff, - update_indep(strict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udls(Type,X,Lin,I,Old) % update strict lowerbound - ). - -% -------------------------- nonstrict -------------------------- - -% ineq_one_n_p_0(X) -% -% Solves the inequality X =< 0 - -ineq_one_n_p_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, % old variable, this is deref - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_p_0(OrdX,X,Ix) - ). -ineq_one_n_p_0(X) :- % new variable, nothing depends on it - var_intern(t_u(0.0),X,0). % nonstrict upperbound - -% ineq_one_n_n_0(X) -% -% Solves the inequality X >= 0 - -ineq_one_n_n_0(X) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_n_0(OrdX,X,Ix) - ). -ineq_one_n_n_0(X) :- - var_intern(t_l(0.0),X,0). % nonstrict lowerbound - -% ineq_one_n_p_i(X,I) -% -% Solves the inequality X =< -I - -ineq_one_n_p_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_p_i(OrdX,I,X,Ix) - ). -ineq_one_n_p_i(X,I) :- - Bound is -I, - var_intern(t_u(Bound),X,0). % nonstrict upperbound - -% ineq_one_n_n_i(X,I) -% -% Solves the inequality X >= I - -ineq_one_n_n_i(X,I) :- - get_attr(X,itf,Att), - arg(4,Att,lin([Ix,_|OrdX])), - !, - ( \+ arg(1,Att,clpr) - -> throw(error(permission_error('mix CLP(Q) variables with', - 'CLP(R) variables:',X),context(_))) - ; ineq_one_old_n_n_i(OrdX,I,X,Ix) - ). -ineq_one_n_n_i(X,I) :- - var_intern(t_l(I),X,0). % nonstrict lowerbound - -% ineq_one_old_n_p_0(Hom,X,Inhom) -% -% Solves the inequality X =< 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_p_0([],_,Ix) :- Ix < 1.0e-10. % X =I -ineq_one_old_n_p_0([l(Y*Ky,_)|Tail],X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -Ix/Ky, - update_indep(nonstrict,Y,Ky,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udu(Type,X,Lin,0.0,Old) % update nonstrict upperbound - ). - -% ineq_one_old_n_n_0(Hom,X,Inhom) -% -% Solves the inequality X >= 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_n_0([],_,Ix) :- Ix > -1.0e-10. % X = I -ineq_one_old_n_n_0([l(Y*Ky,_)|Tail], X, Ix) :- - ( Tail = [] % X = K*Y + I - -> Coeff is -Ky, - Bound is Ix/Coeff, - update_indep(nonstrict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udl(Type,X,Lin,0.0,Old) % update nonstrict lowerbound - ). - -% ineq_one_old_n_p_i(Hom,C,X,Inhom) -% -% Solves the inequality X + C =< 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_p_i([],I,_,Ix) :- Ix + I < 1.0e-10. % X = I -ineq_one_old_n_p_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] % X = K*Y + I - -> Bound is -(Ix + I)/Ky, - update_indep(nonstrict,Y,Ky,Bound) - ; Tail = [_|_] - -> Bound is -I, - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udu(Type,X,Lin,Bound,Old) % update nonstrict upperbound - ). - -% ineq_one_old_n_n_i(Hom,C,X,Inhom) -% -% Solves the inequality X - C >= 0 where X has linear equation Hom + Inhom - -ineq_one_old_n_n_i([],I,_,Ix) :- -Ix + I < 1.0e-10. % X = I -ineq_one_old_n_n_i([l(Y*Ky,_)|Tail],I,X,Ix) :- - ( Tail = [] - -> Coeff is -Ky, - Bound is (Ix - I)/Coeff, - update_indep(nonstrict,Y,Coeff,Bound) - ; Tail = [_|_] - -> get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - udl(Type,X,Lin,I,Old) - ). - -% --------------------------------------------------------------- - -% ineq_more(Hom,Inhom,Lin,Strictness) -% -% Solves the inequality Lin < 0 or Lin =< 0 with Lin = Hom + Inhom - -ineq_more([],I,_,Strictness) :- ineq_ground(Strictness,I). % I < 0 or I =< 0 -ineq_more([l(X*K,_)|Tail],Id,Lind,Strictness) :- - ( Tail = [] - -> % X*K < Id or X*K =< Id - % one var: update bound instead of slack introduction - get_or_add_class(X,_), % makes sure X belongs to a class - Bound is -Id/K, - update_indep(Strictness,X,K,Bound) % new bound - ; Tail = [_|_] - -> ineq_more(Strictness,Lind) - ). - -% ineq_more(Strictness,Lin) -% -% Solves the inequality Lin < 0 or Lin =< 0 - -ineq_more(strict,Lind) :- - ( unconstrained(Lind,U,K,Rest) - -> % never fails, no implied value - % Lind < 0 => Rest < -K*U where U has no bounds - var_intern(t_l(0.0),S,2), % create slack variable S - get_attr(S,itf,AttS), - arg(5,AttS,order(OrdS)), - Ki is -1.0/K, - add_linear_ff(Rest,Ki,[0.0,0.0,l(S*1.0,OrdS)],Ki,LinU), % U = (-1/K)*Rest + (-1/K)*S - LinU = [_,_|Hu], - get_or_add_class(U,Class), - same_class(Hu,Class), % put all variables of new lin. eq. of U in the same class - get_attr(U,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(ClassU)), - backsubst(ClassU,OrdU,LinU) % substitute U by new lin. eq. everywhere in the class - ; var_with_def_intern(t_u(0.0),S,Lind,1), % Lind < 0 => Lind = S with S < 0 - basis_add(S,_), % adds S to the basis - determine_active_dec(Lind), % activate bounds - reconsider(S) % reconsider basis - ). -ineq_more(nonstrict,Lind) :- - ( unconstrained(Lind,U,K,Rest) - -> % never fails, no implied value - % Lind =< 0 => Rest =< -K*U where U has no bounds - var_intern(t_l(0.0),S,0), % create slack variable S - Ki is -1.0/K, - get_attr(S,itf,AttS), - arg(5,AttS,order(OrdS)), - add_linear_ff(Rest,Ki,[0.0,0.0,l(S*1.0,OrdS)],Ki,LinU), % U = (-1K)*Rest + (-1/K)*S - LinU = [_,_|Hu], - get_or_add_class(U,Class), - same_class(Hu,Class), % put all variables of new lin. eq of U in the same class - get_attr(U,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(ClassU)), - backsubst(ClassU,OrdU,LinU) % substitute U by new lin. eq. everywhere in the class - ; % all variables are constrained - var_with_def_intern(t_u(0.0),S,Lind,0), % Lind =< 0 => Lind = S with S =< 0 - basis_add(S,_), % adds S to the basis - determine_active_dec(Lind), - reconsider(S) - ). - - -% update_indep(Strictness,X,K,Bound) -% -% Updates the bound of independent variable X where X < Bound or X =< Bound -% or X > Bound or X >= Bound, depending on Strictness and K. - -update_indep(strict,X,K,Bound) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - ( K < -1.0e-10 - -> uils(Type,X,Lin,Bound,Old) % update independent lowerbound strict - ; uius(Type,X,Lin,Bound,Old) % update independent upperbound strict - ). -update_indep(nonstrict,X,K,Bound) :- - get_attr(X,itf,Att), - arg(2,Att,type(Type)), - arg(3,Att,strictness(Old)), - arg(4,Att,lin(Lin)), - ( K < -1.0e-10 - -> uil(Type,X,Lin,Bound,Old) % update independent lowerbound nonstrict - ; uiu(Type,X,Lin,Bound,Old) % update independent upperbound nonstrict - ). - - -% --------------------------------------------------------------------------------------- - -% -% Update a bound on a var xi -% -% a) independent variable -% -% a1) update inactive bound: done -% -% a2) update active bound: -% Determine [lu]b including most constraining row R -% If we are within: done -% else pivot(R,xi) and introduce bound via (b) -% -% a3) introduce a bound on an unconstrained var: -% All vars that depend on xi are unconstrained (invariant) -> -% the bound cannot invalidate any Lhs -% -% b) dependent variable -% -% repair upper or lower (maybe just swap with an unconstrained var from Rhs) -% - -% -% Sign = 1,0,-1 means inside,at,outside -% - -% Read following predicates as update (dependent/independent) (lowerbound/upperbound) (strict) - -% udl(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -udl(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_l(Bound))), - setarg(3,AttX,strictness(0)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => -1/K*Rest + 1/K*X = U where U has no bounds - Ki is -1.0/Kuc, - add_linear_ff(Rest,Ki,[0.0,0.0,l(X* -1.0,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables in Lin: make X part of basis and reconsider - basis_add(X,_), - determine_active_inc(Lin), - reconsider(X) - ). -udl(t_l(L),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true % new bound is smaller than old one: keep old - ; TestBL > 1.0e-10 - -> % new bound is larger than old one: use new and reconsider basis - Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) % makes sure that Lin still satisfies lowerbound Bound - ; true % new bound is equal to old one, new one is nonstrict: keep old - ). - -udl(t_u(U),X,Lin,Bound,_Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail % new bound is larger than upperbound: fail - ; TestUB > 1.0e-10 - -> % new bound is smaller than upperbound: add new and reconsider basis - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - reconsider_lower(X,Lin,Bound) % makes sure that Lin still satisfies lowerbound Bound - ; solve_bound(Lin,Bound) % new bound is equal to upperbound: solve - ). -udl(t_lu(L,U),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true % smaller than lowerbound: keep - ; TestBL > 1.0e-10 - -> % larger than lowerbound: check upperbound - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail % larger than upperbound: fail - ; TestUB > 1.0e-10 - -> % smaller than upperbound: use new and reconsider basis - Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; % equal to upperbound: if strictness matches => solve - Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true % equal to lowerbound and nonstrict: keep - ). - -% udls(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. - -udls(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_l(Bound))), - setarg(3,AttX,strictness(2)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1.0/Kuc, - add_linear_ff(Rest,Ki,[0.0,0.0,l(X* -1.0,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_inc(Lin), - reconsider(X) - ). -udls(t_l(L),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true % smaller than lowerbound: keep - ; TestBL > 1.0e-10 - -> % larger than lowerbound: use new and reconsider basis - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; % equal to lowerbound: check strictness - Strict is Sold \/ 2, - get_attr(X,itf,Att), - arg(3,Att,strictness(Strict)) - ). -udls(t_u(U),X,Lin,Bound,Sold) :- - U - Bound > 1.0e-10, % smaller than upperbound: set new bound - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound). -udls(t_lu(L,U),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true % smaller than lowerbound: keep - ; TestBL > 1.0e-10 - -> % larger than lowerbound: check upperbound and possibly use new and reconsider basis - U - Bound > 1.0e-10, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - reconsider_lower(X,Lin,Bound) - ; % equal to lowerbound: put new strictness - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% udu(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -udu(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_u(Bound))), - setarg(3,AttX,strictness(0)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1.0/Kuc, - add_linear_ff(Rest,Ki,[0.0,0.0,l(X* -1.0,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_dec(Lin), % try to lower R - reconsider(X) - ). -udu(t_u(U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than upperbound: update and reconsider basis - Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; true % equal to upperbound and nonstrict: keep - ). -udu(t_l(L),X,Lin,Bound,_Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> fail % smaller than lowerbound: fail - ; TestBL > 1.0e-10 - -> % larger than lowerbound: use new and reconsider basis - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - reconsider_upper(X,Lin,Bound) - ; solve_bound(Lin,Bound) % equal to lowerbound: solve - ). -udu(t_lu(L,U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than upperbound: check lowerbound - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> fail % smaller than lowerbound: fail - ; TestBL > 1.0e-10 - -> % larger than lowerbound: update and reconsider basis - Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; % equal to lowerbound: check strictness and possibly solve - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true % equal to upperbound and nonstrict: keep - ). - -% udus(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of dependent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. - -udus(t_none,X,Lin,Bound,_Sold) :- - get_attr(X,itf,AttX), - arg(5,AttX,order(Ord)), - setarg(2,AttX,type(t_u(Bound))), - setarg(3,AttX,strictness(1)), - ( unconstrained(Lin,Uc,Kuc,Rest) - -> % X = Lin => U = -1/K*Rest + 1/K*X with U an unconstrained variable - Ki is -1.0/Kuc, - add_linear_ff(Rest,Ki,[0.0,0.0,l(X* -1.0,Ord)],Ki,LinU), - get_attr(Uc,itf,AttU), - arg(5,AttU,order(OrdU)), - arg(6,AttU,class(Class)), - backsubst(Class,OrdU,LinU) - ; % no unconstrained variables: add X to basis and reconsider basis - basis_add(X,_), - determine_active_dec(Lin), - reconsider(X) - ). -udus(t_u(U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than upperbound: update bound and reconsider basis - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; % equal to upperbound: set new strictness - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -udus(t_l(L),X,Lin,Bound,Sold) :- - Bound - L > 1.0e-10, % larger than lowerbound: update and reconsider basis - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound). -udus(t_lu(L,U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than upperbound: check lowerbound, possibly update and reconsider basis - Bound - L > 1.0e-10, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)), - reconsider_upper(X,Lin,Bound) - ; % equal to upperbound: update strictness - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% uiu(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. - -uiu(t_none,X,_Lin,Bound,_) :- % X had no bounds - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(0)). -uiu(t_u(U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than upperbound: update. - Strict is Sold /\ 2, % update strictness: strictness of lowerbound is kept, - % strictness of upperbound is set to non-strict - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)) - ; true % equal to upperbound and nonstrict: keep - ). -uiu(t_l(L),X,Lin,Bound,_Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> fail % Lowerbound was smaller than new upperbound: fail - ; TestBL > 1.0e-10 - -> % Upperbound is larger than lowerbound: store new bound - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))) - ; solve_bound(Lin,Bound) % Lowerbound was equal to new upperbound: solve - ). -uiu(t_L(L),X,Lin,Bound,_Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> fail % Same as for t_l - ; TestBL > 1.0e-10 - -> % Same as for t_l (new bound becomes t_Lu) - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))) - ; solve_bound(Lin,Bound) % Same as for t_l - ). -uiu(t_lu(L,U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % Upperbound was smaller than new bound: keep - ; TestUB > 1.0e-10 - -> TestBL is Bound - L, % Upperbound was larger than new bound: check lowerbound - ( TestBL < -1.0e-10 - -> fail % Lowerbound was larger than new bound: fail - ; TestBL > 1.0e-10 - -> % Lowerbound was smaller than new bound: store new bound - Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; % Lowerbound was equal to new bound: solve - Sold /\ 2 =:= 0, % Only solve when strictness matches - solve_bound(Lin,Bound) - ) - ; true % Upperbound was equal to new bound and new bound non-strict: keep - ). -uiu(t_Lu(L,U),X,Lin,Bound,Sold) :- % See t_lu case - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> fail - ; TestBL > 1.0e-10 - -> Strict is Sold /\ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uiu(t_U(U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> % smaller than active upperbound: check how much active upperbound can be lowered. - % if enough, just lower bound, otherwise update the bound, make X dependent and reconsider basis - Strict is Sold /\ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound - (Lb + U) < 1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_U(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_u(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_U(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; true % equal to upperbound and non-strict: keep - ). -uiu(t_lU(L,U),X,Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true % larger than upperbound: keep - ; TestUB > 1.0e-10 - -> TestBL is Bound-L, - ( TestBL < -1.0e-10 - -> fail % smaller than lowerbound: fail - ; TestBL > 1.0e-10 - -> % larger than lowerbound: see t_U case for rest - Strict is Sold /\ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound - (Lb + U) < 1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_lU(L,Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_lu(L,Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_lU(L,Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; % equal to lowerbound: check strictness and solve - Sold /\ 2 =:= 0, - solve_bound(Lin,Bound) - ) - ; true % equal to upperbound and non-strict: keep - % smaller than upperbound: check lowerbound - ). - -% uius(Type,X,Lin,Bound,Strict) -% -% Updates upper bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. (see also uiu/5) - -uius(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(1)). -uius(t_u(U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_u(Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_l(L),X,_Lin,Bound,Sold) :- - Bound - L > 1.0e-10, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)). -uius(t_L(L),X,_Lin,Bound,Sold) :- - Bound - L > 1.0e-10, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)). -uius(t_lu(L,U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> Bound - L > 1.0e-10, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_Lu(L,U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> Bound - L > 1.0e-10, - Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_Lu(L,Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_U(U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> Strict is Sold \/ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound - (Lb + U) < 1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_U(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_u(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_U(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uius(t_lU(L,U),X,_Lin,Bound,Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> true - ; TestUB > 1.0e-10 - -> Bound - L > 1.0e-10, - Strict is Sold \/ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - lb(ClassX,OrdX,Vlb-Vb-Lb), - Bound - (Lb + U) < 1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_lU(L,Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vlb,X,Vb,t_lu(L,Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_lU(L,Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - U, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 1, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% uil(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new non-strict -% bound Bound. (see also uiu/5) - - -uil(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(0)). -uil(t_l(L),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)) - ; true - ). -uil(t_u(U),X,Lin,Bound,_Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail - ; TestUB > 1.0e-10 - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))) - ; solve_bound(Lin,Bound) - ). -uil(t_U(U),X,Lin,Bound,_Sold) :- - TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail - ; TestUB > 1.0e-10 - -> get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))) - ; solve_bound(Lin,Bound) - ). -uil(t_lu(L,U),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail - ; TestUB > 1.0e-10 - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uil(t_lU(L,U),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail - ; TestUB > 1.0e-10 - -> Strict is Sold /\ 1, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). -uil(t_L(L),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> Strict is Sold /\ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound - (Ub + L) > -1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_L(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_l(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_L(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; true - ). -uil(t_Lu(L,U),X,Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> TestUB is U - Bound, - ( TestUB < -1.0e-10 - -> fail - ; TestUB > 1.0e-10 - -> Strict is Sold /\ 1, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound - (Ub + L) > -1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,t_Lu(Bound,U)), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_lu(Bound,U)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_Lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Sold /\ 1 =:= 0, - solve_bound(Lin,Bound) - ) - ; true - ). - -% uils(Type,X,Lin,Bound,Strict) -% -% Updates lower bound of independent variable X with linear equation -% Lin that had type Type and strictness Strict, to the new strict -% bound Bound. (see also uiu/5) - -uils(t_none,X,_Lin,Bound,_Sold) :- - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(2)). -uils(t_l(L),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_l(Bound))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_u(U),X,_Lin,Bound,Sold) :- - U - Bound > 1.0e-10, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)). -uils(t_U(U),X,_Lin,Bound,Sold) :- - U - Bound > 1.0e-10, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)). -uils(t_lu(L,U),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> U - Bound > 1.0e-10, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lu(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_lU(L,U),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> U - Bound > 1.0e-10, - Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(2,Att,type(t_lU(Bound,U))), - setarg(3,Att,strictness(Strict)) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_L(L),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> Strict is Sold \/ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound - (Ub + L) > -1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_L(Bound))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_l(Bound)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_L(Bound))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). -uils(t_Lu(L,U),X,_Lin,Bound,Sold) :- - TestBL is Bound - L, - ( TestBL < -1.0e-10 - -> true - ; TestBL > 1.0e-10 - -> U - Bound > 1.0e-10, - Strict is Sold \/ 2, - ( get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - ub(ClassX,OrdX,Vub-Vb-Ub), - Bound - (Ub + L) > -1.0e-10 - -> get_attr(X,itf,Att2), % changed? - setarg(2,Att2,type(t_Lu(Bound,U))), - setarg(3,Att2,strictness(Strict)), - pivot_a(Vub,X,Vb,t_lu(Bound,U)), - reconsider(X) - ; get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), - arg(6,Att,class(ClassX)), - setarg(2,Att,type(t_Lu(Bound,U))), - setarg(3,Att,strictness(Strict)), - Delta is Bound - L, - backsubst_delta(ClassX,OrdX,X,Delta) - ) - ; Strict is Sold \/ 2, - get_attr(X,itf,Att), - setarg(3,Att,strictness(Strict)) - ). - -% reconsider_upper(X,Lin,U) -% -% Checks if the upperbound of X which is U, satisfies the bounds -% of the variables in Lin: let R be the sum of all the bounds on -% the variables in Lin, and I be the inhomogene part of Lin, then -% upperbound U should be larger or equal to R + I (R may contain -% lowerbounds). -% See also rcb/3 in bv.pl - -reconsider_upper(X,[I,R|H],U) :- - R + I - U > -1.0e-10, % violation - !, - dec_step(H,Status), % we want to decrement R - rcbl_status(Status,X,[],Binds,[],u(U)), - export_binding(Binds). -reconsider_upper( _, _, _). - -% reconsider_lower(X,Lin,L) -% -% Checks if the lowerbound of X which is L, satisfies the bounds -% of the variables in Lin: let R be the sum of all the bounds on -% the variables in Lin, and I be the inhomogene part of Lin, then -% lowerbound L should be smaller or equal to R + I (R may contain -% upperbounds). -% See also rcb/3 in bv.pl - -reconsider_lower(X,[I,R|H],L) :- - R + I - L < 1.0e-10, % violation - !, - inc_step(H,Status), % we want to increment R - rcbl_status(Status,X,[],Binds,[],l(L)), - export_binding(Binds). -reconsider_lower(_,_,_). - -% -% lin is dereferenced -% - -% solve_bound(Lin,Bound) -% -% Solves the linear equation Lin - Bound = 0 -% Lin is the linear equation of X, a variable whose bounds have narrowed to value Bound - -solve_bound(Lin,Bound) :- - Bound >= -1.0e-10, - Bound =< 1.0e-10, - !, - solve(Lin). -solve_bound(Lin,Bound) :- - Nb is -Bound, - normalize_scalar(Nb,Nbs), - add_linear_11(Nbs,Lin,Eq), - solve(Eq). \ No newline at end of file diff --git a/GPL/clpqr/clpr/itf_r.pl b/GPL/clpqr/clpr/itf_r.pl deleted file mode 100644 index 1fe2c24b2..000000000 --- a/GPL/clpqr/clpr/itf_r.pl +++ /dev/null @@ -1,227 +0,0 @@ -/* - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(itf_r, - [ - do_checks/8 - ]). -:- use_module(bv_r, - [ - deref/2, - detach_bounds_vlv/5, - solve/1, - solve_ord_x/3 - ]). -:- use_module(nf_r, - [ - nf/2 - ]). -:- use_module(store_r, - [ - add_linear_11/3, - indep/2, - nf_coeff_of/3 - ]). -:- use_module('../clpqr/class', - [ - class_drop/2 - ]). - -do_checks(Y,Ty,St,Li,Or,Cl,No,Later) :- - numbers_only(Y), - verify_nonzero(No,Y), - verify_type(Ty,St,Y,Later,[]), - verify_lin(Or,Cl,Li,Y), - maplist(call,Later). - -numbers_only(Y) :- - ( var(Y) - ; integer(Y) - ; float(Y) - ; throw(type_error(_X = Y,2,'a real number',Y)) - ), - !. - -% verify_nonzero(Nonzero,Y) -% -% if Nonzero = nonzero, then verify that Y is not zero -% (if possible, otherwise set Y to be nonzero) - -verify_nonzero(nonzero,Y) :- - ( var(Y) - -> ( get_attr(Y,itf,Att) - -> setarg(8,Att,nonzero) - ; put_attr(Y,itf,t(clpr,n,n,n,n,n,n,nonzero,n,n,n)) - ) - ; ( Y < -1.0e-10 - -> true - ; Y > 1.0e-10 - ) - ). -verify_nonzero(n,_). % X is not nonzero - -% verify_type(type(Type),strictness(Strict),Y,[OL|OLT],OLT) -% -% if possible verifies whether Y satisfies the type and strictness of X -% if not possible to verify, then returns the constraints that follow from -% the type and strictness - -verify_type(type(Type),strictness(Strict),Y) --> - verify_type2(Y,Type,Strict). -verify_type(n,n,_) --> []. - -verify_type2(Y,TypeX,StrictX) --> - {var(Y)}, - !, - verify_type_var(TypeX,Y,StrictX). -verify_type2(Y,TypeX,StrictX) --> - {verify_type_nonvar(TypeX,Y,StrictX)}. - -% verify_type_nonvar(Type,Nonvar,Strictness) -% -% verifies whether the type and strictness are satisfied with the Nonvar - -verify_type_nonvar(t_none,_,_). -verify_type_nonvar(t_l(L),Value,S) :- ilb(S,L,Value). -verify_type_nonvar(t_u(U),Value,S) :- iub(S,U,Value). -verify_type_nonvar(t_lu(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). -verify_type_nonvar(t_L(L),Value,S) :- ilb(S,L,Value). -verify_type_nonvar(t_U(U),Value,S) :- iub(S,U,Value). -verify_type_nonvar(t_Lu(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). -verify_type_nonvar(t_lU(L,U),Value,S) :- - ilb(S,L,Value), - iub(S,U,Value). - -% ilb(Strict,Lower,Value) & iub(Strict,Upper,Value) -% -% check whether Value is satisfiable with the given lower/upper bound and -% strictness. -% strictness is encoded as follows: -% 2 = strict lower bound -% 1 = strict upper bound -% 3 = strict lower and upper bound -% 0 = no strict bounds - -ilb(S,L,V) :- - S /\ 2 =:= 0, - !, - L - V < 1.0e-10. % non-strict -ilb(_,L,V) :- L - V < -1.0e-10. % strict - -iub(S,U,V) :- - S /\ 1 =:= 0, - !, - V - U < 1.0e-10. % non-strict -iub(_,U,V) :- V - U < -1.0e-10. % strict - -% -% Running some goals after X=Y simplifies the coding. It should be possible -% to run the goals here and taking care not to put_atts/2 on X ... -% - -% verify_type_var(Type,Var,Strictness,[OutList|OutListTail],OutListTail) -% -% returns the inequalities following from a type and strictness satisfaction -% test with Var - -verify_type_var(t_none,_,_) --> []. -verify_type_var(t_l(L),Y,S) --> llb(S,L,Y). -verify_type_var(t_u(U),Y,S) --> lub(S,U,Y). -verify_type_var(t_lu(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). -verify_type_var(t_L(L),Y,S) --> llb(S,L,Y). -verify_type_var(t_U(U),Y,S) --> lub(S,U,Y). -verify_type_var(t_Lu(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). -verify_type_var(t_lU(L,U),Y,S) --> - llb(S,L,Y), - lub(S,U,Y). - -% llb(Strict,Lower,Value,[OL|OLT],OLT) and lub(Strict,Upper,Value,[OL|OLT],OLT) -% -% returns the inequalities following from the lower and upper bounds and the -% strictness see also lb and ub -llb(S,L,V) --> - {S /\ 2 =:= 0}, - !, - [clpr:{L =< V}]. -llb(_,L,V) --> [clpr:{L < V}]. - -lub(S,U,V) --> - {S /\ 1 =:= 0}, - !, - [clpr:{V =< U}]. -lub(_,U,V) --> [clpr:{V < U}]. - -% -% We used to drop X from the class/basis to avoid trouble with subsequent -% put_atts/2 on X. Now we could let these dead but harmless updates happen. -% In R however, exported bindings might conflict, e.g. 0 \== 0.0 -% -% If X is indep and we do _not_ solve for it, we are in deep shit -% because the ordering is violated. -% -verify_lin(order(OrdX),class(Class),lin(LinX),Y) :- - !, - ( indep(LinX,OrdX) - -> detach_bounds_vlv(OrdX,LinX,Class,Y,NewLinX), - % if there were bounds, they are requeued already - class_drop(Class,Y), - nf(-Y,NfY), - deref(NfY,LinY), - add_linear_11(NewLinX,LinY,Lind), - ( nf_coeff_of(Lind,OrdX,_) - -> % X is element of Lind - solve_ord_x(Lind,OrdX,Class) - ; solve(Lind) % X is gone, can safely solve Lind - ) - ; class_drop(Class,Y), - nf(-Y,NfY), - deref(NfY,LinY), - add_linear_11(LinX,LinY,Lind), - solve(Lind) - ). -verify_lin(_,_,_,_). \ No newline at end of file diff --git a/GPL/clpqr/clpr/nf_r.pl b/GPL/clpqr/clpr/nf_r.pl deleted file mode 100644 index 7fb71d39a..000000000 --- a/GPL/clpqr/clpr/nf_r.pl +++ /dev/null @@ -1,1146 +0,0 @@ -/* - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - - -:- module(nf_r, - [ - {}/1, - nf/2, - entailed/1, - split/3, - repair/2, - nf_constant/2, - wait_linear/3, - nf2term/2 - ]). - -:- use_module('../clpqr/geler', - [ - geler/3 - ]). -:- use_module(bv_r, - [ - export_binding/2, - log_deref/4, - solve/1, - 'solve_<'/1, - 'solve_=<'/1, - 'solve_=\\='/1 - ]). -:- use_module(ineq_r, - [ - ineq_one/4, - ineq_one_s_p_0/1, - ineq_one_s_n_0/1, - ineq_one_n_p_0/1, - ineq_one_n_n_0/1 - ]). -:- use_module(store_r, - [ - add_linear_11/3, - normalize_scalar/2 - ]). - -goal_expansion(geler(X,Y),geler(clpr,X,Y)). - -% ------------------------------------------------------------------------- - -% {Constraint} -% -% Adds the constraint Constraint to the constraint store. -% -% First rule is to prevent binding with other rules when a variable is input -% Constraints are converted to normal form and if necessary, submitted to the linear -% equality/inequality solver (bv + ineq) or to the non-linear store (geler) - -{Rel} :- - var(Rel), - !, - throw(instantiation_error({Rel},1)). -{R,Rs} :- - !, - {R},{Rs}. -{R;Rs} :- - !, - ({R};{Rs}). % for entailment checking -{L < R} :- - !, - nf(L-R,Nf), - submit_lt(Nf). -{L > R} :- - !, - nf(R-L,Nf), - submit_lt(Nf). -{L =< R} :- - !, - nf(L-R,Nf), - submit_le( Nf). -{<=(L,R)} :- - !, - nf(L-R,Nf), - submit_le(Nf). -{L >= R} :- - !, - nf(R-L,Nf), - submit_le(Nf). -{L =\= R} :- - !, - nf(L-R,Nf), - submit_ne(Nf). -{L =:= R} :- - !, - nf(L-R,Nf), - submit_eq(Nf). -{L = R} :- - !, - nf(L-R,Nf), - submit_eq(Nf). -{Rel} :- throw(type_error({Rel},1,'a constraint',Rel)). - -% entailed(C) -% -% s -> c = ~s v c = ~(s /\ ~c) -% where s is the store and c is the constraint for which -% we want to know whether it is entailed. -% C is negated and added to the store. If this fails, then c is entailed by s - -entailed(C) :- - negate(C,Cn), - \+ {Cn}. - -% negate(C,Res). -% -% Res is the negation of constraint C -% first rule is to prevent binding with other rules when a variable is input - -negate(Rel,_) :- - var(Rel), - !, - throw(instantiation_error(entailed(Rel),1)). -negate((A,B),(Na;Nb)) :- - !, - negate(A,Na), - negate(B,Nb). -negate((A;B),(Na,Nb)) :- - !, - negate(A,Na), - negate(B,Nb). -negate(A=B) :- !. -negate(A>B,A=B) :- !. -negate(A>=B,A A = 0 -% b4) nonlinear -> geler -% c) Nf=[A,B|Rest] -% c1) A=k -% c11) (B=c*X^+1 or B=c*X^-1), Rest=[] -> B=-k/c or B=-c/k -% c12) invertible(A,B) -% c13) linear(B|Rest) -% c14) geler -% c2) linear(Nf) -% c3) nonlinear -> geler - -submit_eq([]). % trivial success: case a -submit_eq([T|Ts]) :- - submit_eq(Ts,T). -submit_eq([],A) :- submit_eq_b(A). % case b -submit_eq([B|Bs],A) :- submit_eq_c(A,B,Bs). % case c - -% submit_eq_b(A) -% -% Handles case b of submit_eq/1 - -% case b1: A is a constant (non-zero) -submit_eq_b(v(_,[])) :- - !, - fail. -% case b2/b3: A is n*X^P => X = 0 -submit_eq_b(v(_,[X^P])) :- - var(X), - P > 0, - !, - export_binding(X,0.0). -% case b2: non-linear is invertible: NL(X) = 0 => X - inv(NL)(0) = 0 -submit_eq_b(v(_,[NL^1])) :- - nonvar(NL), - nl_invertible(NL,X,0.0,Inv), - !, - nf(-Inv,S), - nf_add(X,S,New), - submit_eq(New). -% case b4: A is non-linear and not invertible => submit equality to geler -submit_eq_b(Term) :- - term_variables(Term,Vs), - geler(Vs,nf_r:resubmit_eq([Term])). - -% submit_eq_c(A,B,Rest) -% -% Handles case c of submit_eq/1 - -% case c1: A is a constant -submit_eq_c(v(I,[]),B,Rest) :- - !, - submit_eq_c1(Rest,B,I). -% case c2: A,B and Rest are linear -submit_eq_c(A,B,Rest) :- % c2 - A = v(_,[X^1]), - var(X), - B = v(_,[Y^1]), - var(Y), - linear(Rest), - !, - Hom = [A,B|Rest], - % 'solve_='(Hom). - nf_length(Hom,0,Len), - log_deref(Len,Hom,[],HomD), - solve(HomD). -% case c3: A, B or Rest is non-linear => geler -submit_eq_c(A,B,Rest) :- - Norm = [A,B|Rest], - term_variables(Norm,Vs), - geler(Vs,nf_r:resubmit_eq(Norm)). - -% submit_eq_c1(Rest,B,K) -% -% Handles case c1 of submit_eq/1 - -% case c11: k+cX^1=0 or k+cX^-1=0 -submit_eq_c1([],v(K,[X^P]),I) :- - var(X), - ( P =:= 1, - !, - Val is -I/K, - export_binding(X,Val) - ; P =:= -1, - !, - Val is -K/I, - export_binding(X,Val) - ). -% case c12: non-linear, invertible: cNL(X)^1+k=0 => inv(NL)(-k/c) = 0 ; -% cNL(X)^-1+k=0 => inv(NL)(-c/k) = 0 -submit_eq_c1([],v(K,[NL^P]),I) :- - nonvar(NL), - ( P =:= 1, - Y is -I/K - ; P =:= -1, - Y is -K/I - ), - nl_invertible(NL,X,Y,Inv), - !, - nf(-Inv,S), - nf_add(X,S,New), - submit_eq(New). -% case c13: linear: X + Y + Z + c = 0 => -submit_eq_c1(Rest,B,I) :- - B = v(_,[Y^1]), - var(Y), - linear(Rest), - !, - % 'solve_='( [v(I,[]),B|Rest]). - Hom = [B|Rest], - nf_length(Hom,0,Len), - normalize_scalar(I,Nonvar), - log_deref(Len,Hom,[],HomD), - add_linear_11(Nonvar,HomD,LinD), - solve(LinD). -% case c14: other cases => geler -submit_eq_c1(Rest,B,I) :- - Norm = [v(I,[]),B|Rest], - term_variables(Norm,Vs), - geler(Vs,nf_r:resubmit_eq(Norm)). - -% ----------------------------------------------------------------------- - -% submit_lt(Nf) -% -% Submits the inequality Nf<0 to the constraint store, where Nf is in normal form. - -% 0 < 0 => fail -submit_lt([]) :- fail. -% A + B < 0 -submit_lt([A|As]) :- submit_lt(As,A). - -% submit_lt(As,A) -% -% Does what submit_lt/1 does where Nf = [A|As] - -% v(K,P) < 0 -submit_lt([],v(K,P)) :- submit_lt_b(P,K). -% A + B + Bs < 0 -submit_lt([B|Bs],A) :- submit_lt_c(Bs,A,B). - -% submit_lt_b(P,K) -% -% Does what submit_lt/2 does where A = [v(K,P)] and As = [] - -% c < 0 -submit_lt_b([],I) :- - !, - I < -1.0e-10. -% cX^1 < 0 : if c < 0 then X > 0, else X < 0 -submit_lt_b([X^1],K) :- - var(X), - !, - ( K > 1.0e-10 - -> ineq_one_s_p_0(X) % X is strictly negative - ; ineq_one_s_n_0(X) % X is strictly positive - ). -% non-linear => geler -submit_lt_b(P,K) :- - term_variables(P,Vs), - geler(Vs,nf_r:resubmit_lt([v(K,P)])). - -% submit_lt_c(Bs,A,B) -% -% Does what submit_lt/2 does where As = [B|Bs]. - -% c + kX < 0 => kX < c -submit_lt_c([],A,B) :- - A = v(I,[]), - B = v(K,[Y^1]), - var(Y), - !, - ineq_one(strict,Y,K,I). -% linear < 0 => solve, non-linear < 0 => geler -submit_lt_c(Rest,A,B) :- - Norm = [A,B|Rest], - ( linear(Norm) - -> 'solve_<'(Norm) - ; term_variables(Norm,Vs), - geler(Vs,nf_r:resubmit_lt(Norm)) - ). - -% submit_le(Nf) -% -% Submits the inequality Nf =< 0 to the constraint store, where Nf is in normal form. -% See also submit_lt/1 - -% 0 =< 0 => success -submit_le([]). -% A + B =< 0 -submit_le([A|As]) :- submit_le(As,A). - -% submit_le(As,A) -% -% See submit_lt/2. This handles less or equal. - -% v(K,P) =< 0 -submit_le([],v(K,P)) :- submit_le_b(P,K). -% A + B + Bs =< 0 -submit_le([B|Bs],A) :- submit_le_c(Bs,A,B). - -% submit_le_b(P,K) -% -% See submit_lt_b/2. This handles less or equal. - -% c =< 0 -submit_le_b([],I) :- - !, - I < 1.0e-10. -% cX^1 =< 0: if c < 0 then X >= 0, else X =< 0 -submit_le_b([X^1],K) :- - var(X), - !, - ( K > 1.0e-10 - -> ineq_one_n_p_0(X) % X is non-strictly negative - ; ineq_one_n_n_0(X) % X is non-strictly positive - ). -% cX^P =< 0 => geler -submit_le_b(P,K) :- - term_variables(P,Vs), - geler(Vs,nf_r:resubmit_le([v(K,P)])). - -% submit_le_c(Bs,A,B) -% -% See submit_lt_c/3. This handles less or equal. - -% c + kX^1 =< 0 => kX =< 0 -submit_le_c([],A,B) :- - A = v(I,[]), - B = v(K,[Y^1]), - var(Y), - !, - ineq_one(nonstrict,Y,K,I). -% A, B & Rest are linear => solve, otherwise => geler -submit_le_c(Rest,A,B) :- - Norm = [A,B|Rest], - ( linear(Norm) - -> 'solve_=<'(Norm) - ; term_variables(Norm,Vs), - geler(Vs,nf_r:resubmit_le(Norm)) - ). - -% submit_ne(Nf) -% -% Submits the inequality Nf =\= 0 to the constraint store, where Nf is in normal form. -% if Nf is a constant => check constant = 0, else if Nf is linear => solve else => geler - -submit_ne(Norm1) :- - ( nf_constant(Norm1,K) - -> \+ (K >= -1.0e-10, K =< 1.0e-10) % K =\= 0 - ; linear(Norm1) - -> 'solve_=\\='(Norm1) - ; term_variables(Norm1,Vs), - geler(Vs,nf_r:resubmit_ne(Norm1)) - ). - -% linear(A) -% -% succeeds when A is linear: all elements are of the form v(_,[]) or v(_,[X^1]) - -linear([]). -linear(v(_,Ps)) :- linear_ps(Ps). -linear([A|As]) :- - linear(A), - linear(As). - -% linear_ps(A) -% -% Succeeds when A = V^1 with V a variable. -% This reflects the linearity of v(_,A). - -linear_ps([]). -linear_ps([V^1]) :- var(V). % excludes sin(_), ... - -% -% Goal delays until Term gets linear. -% At this time, Var will be bound to the normalform of Term. -% -:- meta_predicate wait_linear( ?, ?, :). -% -wait_linear(Term,Var,Goal) :- - nf(Term,Nf), - ( linear(Nf) - -> Var = Nf, - call(Goal) - ; term_variables(Nf,Vars), - geler(Vars,nf_r:wait_linear_retry(Nf,Var,Goal)) - ). -% -% geler clients -% -resubmit_eq(N) :- - repair(N,Norm), - submit_eq(Norm). -resubmit_lt(N) :- - repair(N,Norm), - submit_lt(Norm). -resubmit_le(N) :- - repair(N,Norm), - submit_le(Norm). -resubmit_ne(N) :- - repair(N,Norm), - submit_ne(Norm). -wait_linear_retry(Nf0,Var,Goal) :- - repair(Nf0,Nf), - ( linear(Nf) - -> Var = Nf, - call(Goal) - ; term_variables(Nf,Vars), - geler(Vars,nf_r:wait_linear_retry(Nf,Var,Goal)) - ). -% ----------------------------------------------------------------------- - -% nl_invertible(F,X,Y,Res) -% -% Res is the evaluation of the inverse of nonlinear function F in variable X -% where X is Y - -nl_invertible(sin(X),X,Y,Res) :- Res is asin(Y). -nl_invertible(cos(X),X,Y,Res) :- Res is acos(Y). -nl_invertible(tan(X),X,Y,Res) :- Res is atan(Y). -nl_invertible(exp(B,C),X,A,Res) :- - ( nf_constant(B,Kb) - -> A > 1.0e-10, - Kb > 1.0e-10, - TestKb is Kb - 1.0, % Kb =\= 1.0 - \+ (TestKb >= -1.0e-10, TestKb =< 1.0e-10), - X = C, % note delayed unification - Res is log(A)/log(Kb) - ; nf_constant(C,Kc), - \+ (A >= -1.0e-10, A =< 1.0e-10), % A =\= 0 - Kc > 1.0e-10, % Kc > 0 - X = B, % note delayed unification - Res is A**(1.0/Kc) - ). - -% ----------------------------------------------------------------------- - -% nf(Exp,Nf) -% -% Returns in Nf, the normal form of expression Exp -% -% v(A,[B^C,D^E|...]) means A*B^C*D^E*... where A is a scalar (number) -% v(A,[]) means scalar A - -% variable X => 1*X^1 -nf(X,Norm) :- - var(X), - !, - Norm = [v(1.0,[X^1])]. -nf(X,Norm) :- - number(X), - !, - nf_number(X,Norm). -% -nf(#(Const),Norm) :- - monash_constant(Const,Value), - !, - Norm = [v(Value,[])]. -% -nf(-A,Norm) :- - !, - nf(A,An), - nf_mul_factor(v(-1.0,[]),An,Norm). -nf(+A,Norm) :- - !, - nf(A,Norm). -% -nf(A+B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_add(An,Bn,Norm). -nf(A-B,Norm) :- - !, - nf(A,An), - nf(-B,Bn), - nf_add(An,Bn,Norm). -% -nf(A*B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_mul(An,Bn,Norm). -nf(A/B,Norm) :- - !, - nf(A,An), - nf(B,Bn), - nf_div(Bn,An,Norm). -% non-linear function, one argument: Term = f(Arg) equals f'(Sa1) = Skel -nf(Term,Norm) :- - nonlin_1(Term,Arg,Skel,Sa1), - !, - nf(Arg,An), - nf_nonlin_1(Skel,An,Sa1,Norm). -% non-linear function, two arguments: Term = f(A1,A2) equals f'(Sa1,Sa2) = Skel -nf(Term,Norm) :- - nonlin_2(Term,A1,A2,Skel,Sa1,Sa2), - !, - nf(A1,A1n), - nf(A2,A2n), - nf_nonlin_2(Skel,A1n,A2n,Sa1,Sa2,Norm). -% -nf(Term,_) :- - throw(type_error(nf(Term,_),1,'a numeric expression',Term)). - -% nf_number(N,Res) -% -% If N is a number, N is normalized - -nf_number(N,Res) :- - number(N), - ( (N >= -1.0e-10, N =< 1.0e-10) % N =:= 0 - -> Res = [] - ; Res = [v(N,[])] - ). - -nonlin_1(abs(X),X,abs(Y),Y). -nonlin_1(sin(X),X,sin(Y),Y). -nonlin_1(cos(X),X,cos(Y),Y). -nonlin_1(tan(X),X,tan(Y),Y). -nonlin_2(min(A,B),A,B,min(X,Y),X,Y). -nonlin_2(max(A,B),A,B,max(X,Y),X,Y). -nonlin_2(exp(A,B),A,B,exp(X,Y),X,Y). -nonlin_2(pow(A,B),A,B,exp(X,Y),X,Y). % pow->exp -nonlin_2(A^B,A,B,exp(X,Y),X,Y). - -nf_nonlin_1(Skel,An,S1,Norm) :- - ( nf_constant(An,S1) - -> nl_eval(Skel,Res), - nf_number(Res,Norm) - ; S1 = An, - Norm = [v(1.0,[Skel^1])]). -nf_nonlin_2(Skel,A1n,A2n,S1,S2,Norm) :- - ( nf_constant(A1n,S1), - nf_constant(A2n,S2) - -> nl_eval(Skel,Res), - nf_number(Res,Norm) - ; Skel=exp(_,_), - nf_constant(A2n,Exp), - integerp(Exp,I) - -> nf_power(I,A1n,Norm) - ; S1 = A1n, - S2 = A2n, - Norm = [v(1.0,[Skel^1])] - ). - -% evaluates non-linear functions in one variable where the variable is bound -nl_eval(abs(X),R) :- R is abs(X). -nl_eval(sin(X),R) :- R is sin(X). -nl_eval(cos(X),R) :- R is cos(X). -nl_eval(tan(X),R) :- R is tan(X). -% evaluates non-linear functions in two variables where both variables are -% bound -nl_eval(min(X,Y),R) :- R is min(X,Y). -nl_eval(max(X,Y),R) :- R is max(X,Y). -nl_eval(exp(X,Y),R) :- R is X**Y. - -monash_constant(X,_) :- - var(X), - !, - fail. -monash_constant(p,3.14259265). -monash_constant(pi,3.14259265). -monash_constant(e,2.71828182). -monash_constant(zero,1.0e-10). - -% -% check if a Nf consists of just a constant -% - -nf_constant([],0.0). -nf_constant([v(K,[])],K). - -% split(NF,SNF,C) -% -% splits a normalform expression NF into two parts: -% - a constant term C (which might be 0) -% - the homogene part of the expression -% -% this method depends on the polynf ordering, i.e. [] < [X^1] ... - -split([],[],0.0). -split([First|T],H,I) :- - ( First = v(I,[]) - -> H = T - ; I = 0.0, - H = [First|T] - ). - -% nf_add(A,B,C): merges two normalized additions into a new normalized addition -% -% a normalized addition is one where the terms are ordered, e.g. X^1 < Y^1, X^1 < X^2 etc. -% terms in the same variable with the same exponent are added, -% e.g. when A contains v(5,[X^1]) and B contains v(4,[X^1]) then C contains v(9,[X^1]). - -nf_add([],Bs,Bs). -nf_add([A|As],Bs,Cs) :- nf_add(Bs,A,As,Cs). - -nf_add([],A,As,Cs) :- Cs = [A|As]. -nf_add([B|Bs],A,As,Cs) :- - A = v(Ka,Pa), - B = v(Kb,Pb), - compare(Rel,Pa,Pb), - nf_add_case(Rel,A,As,Cs,B,Bs,Ka,Kb,Pa). - -% nf_add_case(Rel,A,As,Cs,B,Bs,Ka,Kb,Pa) -% -% merges sorted lists [A|As] and [B|Bs] into new sorted list Cs -% A = v(Ka,Pa) and B = v(Kb,_) -% Rel is the ordering relation (<, > or =) between A and B. -% when Rel is =, Ka and Kb are added to form a new scalar for Pa -nf_add_case(<,A,As,Cs,B,Bs,_,_,_) :- - Cs = [A|Rest], - nf_add(As,B,Bs,Rest). -nf_add_case(>,A,As,Cs,B,Bs,_,_,_) :- - Cs = [B|Rest], - nf_add(Bs,A,As,Rest). -nf_add_case(=,_,As,Cs,_,Bs,Ka,Kb,Pa) :- - Kc is Ka + Kb, - ( (Kc >= -1.0e-10, Kc =< 1.0e-10) % Kc =:= 0.0 - -> nf_add(As,Bs,Cs) - ; Cs = [v(Kc,Pa)|Rest], - nf_add(As,Bs,Rest) - ). - -nf_mul(A,B,Res) :- - nf_length(A,0,LenA), - nf_length(B,0,LenB), - nf_mul_log(LenA,A,[],LenB,B,Res). - -nf_mul_log(0,As,As,_,_,[]) :- !. -nf_mul_log(1,[A|As],As,Lb,B,R) :- - !, - nf_mul_factor_log(Lb,B,[],A,R). -nf_mul_log(2,[A1,A2|As],As,Lb,B,R) :- - !, - nf_mul_factor_log(Lb,B,[],A1,A1b), - nf_mul_factor_log(Lb,B,[],A2,A2b), - nf_add(A1b,A2b,R). -nf_mul_log(N,A0,A2,Lb,B,R) :- - P is N>>1, - Q is N-P, - nf_mul_log(P,A0,A1,Lb,B,Rp), - nf_mul_log(Q,A1,A2,Lb,B,Rq), - nf_add(Rp,Rq,R). - - -% nf_add_2: does the same thing as nf_add, but only has 2 elements to combine. -nf_add_2(Af,Bf,Res) :- % unfold: nf_add([Af],[Bf],Res). - Af = v(Ka,Pa), - Bf = v(Kb,Pb), - compare(Rel,Pa,Pb), - nf_add_2_case(Rel,Af,Bf,Res,Ka,Kb,Pa). - -nf_add_2_case(<,Af,Bf,[Af,Bf],_,_,_). -nf_add_2_case(>,Af,Bf,[Bf,Af],_,_,_). -nf_add_2_case(=,_, _,Res,Ka,Kb,Pa) :- - Kc is Ka + Kb, - ( (Kc >= -1.0e-10, Kc =< 1.0e-10) % Kc =:= 0 - -> Res = [] - ; Res = [v(Kc,Pa)] - ). - -% nf_mul_k(A,B,C) -% -% C is the result of the multiplication of each element of A (of the form v(_,_)) with scalar B (which shouldn't be 0) -nf_mul_k([],_,[]). -nf_mul_k([v(I,P)|Vs],K,[v(Ki,P)|Vks]) :- - Ki is K*I, - nf_mul_k(Vs,K,Vks). - -% nf_mul_factor(A,Sum,Res) -% -% multiplies each element of the list Sum with factor A which is of the form v(_,_) -% and puts the result in the sorted list Res. -nf_mul_factor(v(K,[]),Sum,Res) :- - !, - nf_mul_k(Sum,K,Res). -nf_mul_factor(F,Sum,Res) :- - nf_length(Sum,0,Len), - nf_mul_factor_log(Len,Sum,[],F,Res). - -% nf_mul_factor_log(Len,[Sum|SumTail],SumTail,F,Res) -% -% multiplies each element of Sum with F and puts the result in the sorted list Res -% Len is the length of Sum -% Sum is split logarithmically each step - -nf_mul_factor_log(0,As,As,_,[]) :- !. -nf_mul_factor_log(1,[A|As],As,F,[R]) :- - !, - mult(A,F,R). -nf_mul_factor_log(2,[A,B|As],As,F,Res) :- - !, - mult(A,F,Af), - mult(B,F,Bf), - nf_add_2(Af,Bf,Res). -nf_mul_factor_log(N,A0,A2,F,R) :- - P is N>>1, % P is rounded(N/2) - Q is N-P, - nf_mul_factor_log(P,A0,A1,F,Rp), - nf_mul_factor_log(Q,A1,A2,F,Rq), - nf_add(Rp,Rq,R). - -% mult(A,B,C) -% -% multiplies A and B into C each of the form v(_,_) - -mult(v(Ka,La),v(Kb,Lb),v(Kc,Lc)) :- - Kc is Ka*Kb, - pmerge(La,Lb,Lc). - -% pmerge(A,B,C) -% -% multiplies A and B into sorted C, where each is of the form of the second argument of v(_,_) - -pmerge([],Bs,Bs). -pmerge([A|As],Bs,Cs) :- pmerge(Bs,A,As,Cs). - -pmerge([],A,As,Res) :- Res = [A|As]. -pmerge([B|Bs],A,As,Res) :- - A = Xa^Ka, - B = Xb^Kb, - compare(R,Xa,Xb), - pmerge_case(R,A,As,Res,B,Bs,Ka,Kb,Xa). - -% pmerge_case(Rel,A,As,Res,B,Bs,Ka,Kb,Xa) -% -% multiplies and sorts [A|As] with [B|Bs] into Res where each is of the form of -% the second argument of v(_,_) -% -% A is Xa^Ka and B is Xb^Kb, Rel is ordening relation between Xa and Xb - -pmerge_case(<,A,As,Res,B,Bs,_,_,_) :- - Res = [A|Tail], - pmerge(As,B,Bs,Tail). -pmerge_case(>,A,As,Res,B,Bs,_,_,_) :- - Res = [B|Tail], - pmerge(Bs,A,As,Tail). -pmerge_case(=,_,As,Res,_,Bs,Ka,Kb,Xa) :- - Kc is Ka + Kb, - ( Kc =:= 0 - -> pmerge(As,Bs,Res) - ; Res = [Xa^Kc|Tail], - pmerge(As,Bs,Tail) - ). - -% nf_div(Factor,In,Out) -% -% Out is the result of the division of each element in In (which is of the form v(_,_)) by Factor. - -% division by zero -nf_div([],_,_) :- - !, - zero_division. -% division by v(K,P) => multiplication by v(1/K,P^-1) -nf_div([v(K,P)],Sum,Res) :- - !, - Ki is 1.0/K, - mult_exp(P,-1,Pi), - nf_mul_factor(v(Ki,Pi),Sum,Res). -nf_div(D,A,[v(1.0,[(A/D)^1])]). - -% zero_division -% -% called when a division by zero is performed -zero_division :- fail. % raise_exception(_) ? - -% mult_exp(In,Factor,Out) -% -% Out is the result of the multiplication of the exponents of the elements in In -% (which are of the form X^Exp by Factor. -mult_exp([],_,[]). -mult_exp([X^P|Xs],K,[X^I|Tail]) :- - I is K*P, - mult_exp(Xs,K,Tail). -% -% raise to integer powers -% -% | ?- time({(1+X+Y+Z)^15=0}). (sicstus, try with SWI) -% Timing 00:00:02.610 2.610 iterative -% Timing 00:00:00.660 0.660 binomial -nf_power(N,Sum,Norm) :- - integer(N), - compare(Rel,N,0), - ( Rel = (<) - -> Pn is -N, - % nf_power_pos(Pn,Sum,Inorm), - binom(Sum,Pn,Inorm), - nf_div(Inorm,[v(1.0,[])],Norm) - ; Rel = (>) - -> % nf_power_pos(N,Sum,Norm) - binom(Sum,N,Norm) - ; Rel = (=) - -> % 0^0 is indeterminate but we say 1 - Norm = [v(1.0,[])] - ). -% -% N>0 -% -% iterative method: X^N = X*(X^N-1) -nf_power_pos(1,Sum,Norm) :- - !, - Sum = Norm. -nf_power_pos(N,Sum,Norm) :- - N1 is N-1, - nf_power_pos(N1,Sum,Pn1), - nf_mul(Sum,Pn1,Norm). -% -% N>0 -% -% binomial method -binom(Sum,1,Power) :- - !, - Power = Sum. -binom([],_,[]). -binom([A|Bs],N,Power) :- - ( Bs = [] - -> nf_power_factor(A,N,Ap), - Power = [Ap] - ; Bs = [_|_] - -> factor_powers(N,A,v(1.0,[]),Pas), - sum_powers(N,Bs,[v(1.0,[])],Pbs,[]), - combine_powers(Pas,Pbs,0,N,1,[],Power) - ). - -combine_powers([],[],_,_,_,Pi,Pi). -combine_powers([A|As],[B|Bs],L,R,C,Pi,Po) :- - nf_mul(A,B,Ab), - nf_mul_k(Ab,C,Abc), - nf_add(Abc,Pi,Pii), - L1 is L+1, - R1 is R-1, - C1 is C*R//L1, - combine_powers(As,Bs,L1,R1,C1,Pii,Po). - -nf_power_factor(v(K,P),N,v(Kn,Pn)) :- - Kn is K**N, - mult_exp(P,N,Pn). - -factor_powers(0,_,Prev,[[Prev]]) :- !. -factor_powers(N,F,Prev,[[Prev]|Ps]) :- - N1 is N-1, - mult(Prev,F,Next), - factor_powers(N1,F,Next,Ps). -sum_powers(0,_,Prev,[Prev|Lt],Lt) :- !. -sum_powers(N,S,Prev,L0,Lt) :- - N1 is N-1, - nf_mul(S,Prev,Next), - sum_powers(N1,S,Next,L0,[Prev|Lt]). - -% ------------------------------------------------------------------------------ -repair(Sum,Norm) :- - nf_length(Sum,0,Len), - repair_log(Len,Sum,[],Norm). -repair_log(0,As,As,[]) :- !. -repair_log(1,[v(Ka,Pa)|As],As,R) :- - !, - repair_term(Ka,Pa,R). -repair_log(2,[v(Ka,Pa),v(Kb,Pb)|As],As,R) :- - !, - repair_term(Ka,Pa,Ar), - repair_term(Kb,Pb,Br), - nf_add(Ar,Br,R). -repair_log(N,A0,A2,R) :- - P is N>>1, - Q is N-P, - repair_log(P,A0,A1,Rp), - repair_log(Q,A1,A2,Rq), - nf_add(Rp,Rq,R). - -repair_term(K,P,Norm) :- - length(P,Len), - repair_p_log(Len,P,[],Pr,[v(1.0,[])],Sum), - nf_mul_factor(v(K,Pr),Sum,Norm). - -repair_p_log(0,Ps,Ps,[],L0,L0) :- !. -repair_p_log(1,[X^P|Ps],Ps,R,L0,L1) :- - !, - repair_p(X,P,R,L0,L1). -repair_p_log(2,[X^Px,Y^Py|Ps],Ps,R,L0,L2) :- - !, - repair_p(X,Px,Rx,L0,L1), - repair_p(Y,Py,Ry,L1,L2), - pmerge(Rx,Ry,R). -repair_p_log(N,P0,P2,R,L0,L2) :- - P is N>>1, - Q is N-P, - repair_p_log(P,P0,P1,Rp,L0,L1), - repair_p_log(Q,P1,P2,Rq,L1,L2), - pmerge(Rp,Rq,R). - -repair_p(Term,P,[Term^P],L0,L0) :- var(Term). -repair_p(Term,P,[],L0,L1) :- - nonvar(Term), - repair_p_one(Term,TermN), - nf_power(P,TermN,TermNP), - nf_mul(TermNP,L0,L1). -% -% An undigested term a/b is distinguished from an -% digested one by the fact that its arguments are -% digested -> cuts after repair of args! -% -repair_p_one(Term,TermN) :- - nf_number(Term,TermN), % freq. shortcut for nf/2 case below - !. -repair_p_one(A1/A2,TermN) :- - repair(A1,A1n), - repair(A2,A2n), - !, - nf_div(A2n,A1n,TermN). -repair_p_one(Term,TermN) :- - nonlin_1(Term,Arg,Skel,Sa), - repair(Arg,An), - !, - nf_nonlin_1(Skel,An,Sa,TermN). -repair_p_one(Term,TermN) :- - nonlin_2(Term,A1,A2,Skel,Sa1,Sa2), - repair(A1,A1n), - repair(A2,A2n), - !, - nf_nonlin_2(Skel,A1n,A2n,Sa1,Sa2,TermN). -repair_p_one(Term,TermN) :- - nf(Term,TermN). - -nf_length([],Li,Li). -nf_length([_|R],Li,Lo) :- - Lii is Li+1, - nf_length(R,Lii,Lo). -% ------------------------------------------------------------------------------ -% nf2term(NF,Term) -% -% transforms a normal form into a readable term - -% empty normal form = 0 -nf2term([],0.0). -% term is first element (+ next elements) -nf2term([F|Fs],T) :- - f02t(F,T0), % first element - yfx(Fs,T0,T). % next elements - -yfx([],T0,T0). -yfx([F|Fs],T0,TN) :- - fn2t(F,Ft,Op), - T1 =.. [Op,T0,Ft], - yfx(Fs,T1,TN). - -% f02t(v(K,P),T) -% -% transforms the first element of the normal form (something of the form v(K,P)) -% into a readable term -f02t(v(K,P),T) :- - ( % just a constant - P = [] - -> T = K - ; TestK is K - 1.0, % K =:= 1 - (TestK >= -1.0e-10, TestK =< 1.0e-10) - -> p2term(P,T) - ; TestK is K + 1.0, % K =:= -1 - (TestK >= -1.0e-10, TestK =< 1.0e-10) - -> T = -Pt, - p2term(P,Pt) - ; T = K*Pt, - p2term(P,Pt) - ). - -% f02t(v(K,P),T,Op) -% -% transforms a next element of the normal form (something of the form v(K,P)) -% into a readable term -fn2t(v(K,P),Term,Op) :- - ( TestK is K - 1.0, % K =:= 1 - (TestK >= -1.0e-10, TestK =< 1.0e-10) - -> Term = Pt, - Op = + - ; TestK is K + 1.0, % K =:= -1 - (TestK >= -1.0e-10, TestK =< 1.0e-10) - -> Term = Pt, - Op = - - ; K < -1.0e-10 % K < 0 - -> Kf is -K, - Term = Kf*Pt, - Op = - - ; % K > 0 - Term = K*Pt, - Op = + - ), - p2term(P,Pt). - -% transforms the P part in v(_,P) into a readable term -p2term([X^P|Xs],Term) :- - ( Xs = [] - -> pe2term(X,Xt), - exp2term(P,Xt,Term) - ; Xs = [_|_] - -> Term = Xst*Xtp, - pe2term(X,Xt), - exp2term(P,Xt,Xtp), - p2term(Xs,Xst) - ). - -% -exp2term(1,X,X) :- !. -exp2term(-1,X,1.0/X) :- !. -exp2term(P,X,Term) :- - % Term = exp(X,Pn) - Term = X^P. - -pe2term(X,Term) :- - var(X), - Term = X. -pe2term(X,Term) :- - nonvar(X), - X =.. [F|Args], - pe2term_args(Args,Argst), - Term =.. [F|Argst]. - -pe2term_args([],[]). -pe2term_args([A|As],[T|Ts]) :- - nf2term(A,T), - pe2term_args(As,Ts). - -% transg(Goal,[OutList|OutListTail],OutListTail) -% -% puts the equalities and inequalities that are implied by the elements in Goal -% in the difference list OutList -% -% called by geler.pl for project.pl - -transg(resubmit_eq(Nf)) --> - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpr:{Term=Z}]. -transg(resubmit_lt(Nf)) --> - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpr:{Term - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpr:{Term= - { - nf2term([],Z), - nf2term(Nf,Term) - }, - [clpr:{Term=\=Z}]. -transg(wait_linear_retry(Nf,Res,Goal)) --> - { - nf2term(Nf,Term) - }, - [clpr:{Term=Res},Goal]. - -integerp(X) :- - floor(X)=:=X. - -integerp(X,I) :- - floor(X)=:=X, - I is integer(X). \ No newline at end of file diff --git a/GPL/clpqr/clpr/store_r.pl b/GPL/clpqr/clpr/store_r.pl deleted file mode 100644 index 9976a4fbf..000000000 --- a/GPL/clpqr/clpr/store_r.pl +++ /dev/null @@ -1,427 +0,0 @@ -/* $Id: store_r.pl,v 1.1 2008-03-13 17:16:43 vsc Exp $ - - Part of CLP(R) (Constraint Logic Programming over Reals) - - Author: Leslie De Koninck - E-mail: Leslie.DeKoninck@cs.kuleuven.be - WWW: http://www.swi-prolog.org - http://www.ai.univie.ac.at/cgi-bin/tr-online?number+95-09 - Copyright (C): 2004, K.U. Leuven and - 1992-1995, Austrian Research Institute for - Artificial Intelligence (OFAI), - Vienna, Austria - - This software is part of Leslie De Koninck's master thesis, supervised - by Bart Demoen and daily advisor Tom Schrijvers. It is based on CLP(Q,R) - by Christian Holzbaur for SICStus Prolog and distributed under the - license details below with permission from all mentioned authors. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - As a special exception, if you link this library with other files, - compiled with a Free Software compiler, to produce an executable, this - library does not by itself cause the resulting executable to be covered - by the GNU General Public License. This exception does not however - invalidate any other reasons why the executable file might be covered by - the GNU General Public License. -*/ - -:- module(store_r, - [ - add_linear_11/3, - add_linear_f1/4, - add_linear_ff/5, - normalize_scalar/2, - delete_factor/4, - mult_linear_factor/3, - nf_rhs_x/4, - indep/2, - isolate/3, - nf_substitute/4, - mult_hom/3, - nf2sum/3, - nf_coeff_of/3, - renormalize/2 - ]). - -% normalize_scalar(S,[N,Z]) -% -% Transforms a scalar S into a linear expression [S,0] - -normalize_scalar(S,[S,0.0]). - -% renormalize(List,Lin) -% -% Renormalizes the not normalized linear expression in List into -% a normalized one. It does so to take care of unifications. -% (e.g. when a variable X is bound to a constant, the constant is added to -% the constant part of the linear expression; when a variable X is bound to -% another variable Y, the scalars of both are added) - -renormalize([I,R|Hom],Lin) :- - length(Hom,Len), - renormalize_log(Len,Hom,[],Lin0), - add_linear_11([I,R],Lin0,Lin). - -% renormalize_log(Len,Hom,HomTail,Lin) -% -% Logarithmically renormalizes the homogene part of a not normalized -% linear expression. See also renormalize/2. - -renormalize_log(1,[Term|Xs],Xs,Lin) :- - !, - Term = l(X*_,_), - renormalize_log_one(X,Term,Lin). -renormalize_log(2,[A,B|Xs],Xs,Lin) :- - !, - A = l(X*_,_), - B = l(Y*_,_), - renormalize_log_one(X,A,LinA), - renormalize_log_one(Y,B,LinB), - add_linear_11(LinA,LinB,Lin). -renormalize_log(N,L0,L2,Lin) :- - P is N>>1, - Q is N-P, - renormalize_log(P,L0,L1,Lp), - renormalize_log(Q,L1,L2,Lq), - add_linear_11(Lp,Lq,Lin). - -% renormalize_log_one(X,Term,Res) -% -% Renormalizes a term in X: if X is a nonvar, the term becomes a scalar. - -renormalize_log_one(X,Term,Res) :- - var(X), - Term = l(X*K,_), - get_attr(X,itf,Att), - arg(5,Att,order(OrdX)), % Order might have changed - Res = [0.0,0.0,l(X*K,OrdX)]. -renormalize_log_one(X,Term,Res) :- - nonvar(X), - Term = l(X*K,_), - Xk is X*K, - normalize_scalar(Xk,Res). - -% ----------------------------- sparse vector stuff ---------------------------- % - -% add_linear_ff(LinA,Ka,LinB,Kb,LinC) -% -% Linear expression LinC is the result of the addition of the 2 linear expressions -% LinA and LinB, each one multiplied by a scalar (Ka for LinA and Kb for LinB). - -add_linear_ff(LinA,Ka,LinB,Kb,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia*Ka+Ib*Kb, - Rc is Ra*Ka+Rb*Kb, - add_linear_ffh(Ha,Ka,Hb,Kb,Hc). - -% add_linear_ffh(Ha,Ka,Hb,Kb,Hc) -% -% Homogene part Hc is the result of the addition of the 2 homogene parts Ha and Hb, -% each one multiplied by a scalar (Ka for Ha and Kb for Hb) - -add_linear_ffh([],_,Ys,Kb,Zs) :- mult_hom(Ys,Kb,Zs). -add_linear_ffh([l(X*Kx,OrdX)|Xs],Ka,Ys,Kb,Zs) :- - add_linear_ffh(Ys,X,Kx,OrdX,Xs,Zs,Ka,Kb). - -% add_linear_ffh(Ys,X,Kx,OrdX,Xs,Zs,Ka,Kb) -% -% Homogene part Zs is the result of the addition of the 2 homogene parts Ys and -% [l(X*Kx,OrdX)|Xs], each one multiplied by a scalar (Ka for [l(X*Kx,OrdX)|Xs] and Kb for Ys) - -add_linear_ffh([],X,Kx,OrdX,Xs,Zs,Ka,_) :- mult_hom([l(X*Kx,OrdX)|Xs],Ka,Zs). -add_linear_ffh([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs,Ka,Kb) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx*Ka+Ky*Kb, - ( % Kz =:= 0 - Kz =< 1.0e-10, - Kz >= -1.0e-10 - -> add_linear_ffh(Xs,Ka,Ys,Kb,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_ffh(Xs,Ka,Ys,Kb,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kz,OrdX)|Ztail], - Kz is Kx*Ka, - add_linear_ffh(Xs,Y,Ky,OrdY,Ys,Ztail,Kb,Ka) - ; Rel = (>) - -> Zs = [l(Y*Kz,OrdY)|Ztail], - Kz is Ky*Kb, - add_linear_ffh(Ys,X,Kx,OrdX,Xs,Ztail,Ka,Kb) - ). - -% add_linear_f1(LinA,Ka,LinB,LinC) -% -% special case of add_linear_ff with Kb = 1 - -add_linear_f1(LinA,Ka,LinB,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia*Ka+Ib, - Rc is Ra*Ka+Rb, - add_linear_f1h(Ha,Ka,Hb,Hc). - -% add_linear_f1h(Ha,Ka,Hb,Hc) -% -% special case of add_linear_ffh/5 with Kb = 1 - -add_linear_f1h([],_,Ys,Ys). -add_linear_f1h([l(X*Kx,OrdX)|Xs],Ka,Ys,Zs) :- - add_linear_f1h(Ys,X,Kx,OrdX,Xs,Zs,Ka). - -% add_linear_f1h(Ys,X,Kx,OrdX,Xs,Zs,Ka) -% -% special case of add_linear_ffh/8 with Kb = 1 - -add_linear_f1h([],X,Kx,OrdX,Xs,Zs,Ka) :- mult_hom([l(X*Kx,OrdX)|Xs],Ka,Zs). -add_linear_f1h([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs,Ka) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx*Ka+Ky, - ( % Kz =:= 0.0 - Kz =< 1.0e-10, - Kz >= -1.0e-10 - -> add_linear_f1h(Xs,Ka,Ys,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_f1h(Xs,Ka,Ys,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kz,OrdX)|Ztail], - Kz is Kx*Ka, - add_linear_f1h(Xs,Ka,[l(Y*Ky,OrdY)|Ys],Ztail) - ; Rel = (>) - -> Zs = [l(Y*Ky,OrdY)|Ztail], - add_linear_f1h(Ys,X,Kx,OrdX,Xs,Ztail,Ka) - ). - -% add_linear_11(LinA,LinB,LinC) -% -% special case of add_linear_ff with Ka = 1 and Kb = 1 - -add_linear_11(LinA,LinB,LinC) :- - LinA = [Ia,Ra|Ha], - LinB = [Ib,Rb|Hb], - LinC = [Ic,Rc|Hc], - Ic is Ia+Ib, - Rc is Ra+Rb, - add_linear_11h(Ha,Hb,Hc). - -% add_linear_11h(Ha,Hb,Hc) -% -% special case of add_linear_ffh/5 with Ka = 1 and Kb = 1 - -add_linear_11h([],Ys,Ys). -add_linear_11h([l(X*Kx,OrdX)|Xs],Ys,Zs) :- - add_linear_11h(Ys,X,Kx,OrdX,Xs,Zs). - -% add_linear_11h(Ys,X,Kx,OrdX,Xs,Zs) -% -% special case of add_linear_ffh/8 with Ka = 1 and Kb = 1 - -add_linear_11h([],X,Kx,OrdX,Xs,[l(X*Kx,OrdX)|Xs]). -add_linear_11h([l(Y*Ky,OrdY)|Ys],X,Kx,OrdX,Xs,Zs) :- - compare(Rel,OrdX,OrdY), - ( Rel = (=) - -> Kz is Kx+Ky, - ( % Kz =:= 0.0 - Kz =< 1.0e-10, - Kz >= -1.0e-10 - -> add_linear_11h(Xs,Ys,Zs) - ; Zs = [l(X*Kz,OrdX)|Ztail], - add_linear_11h(Xs,Ys,Ztail) - ) - ; Rel = (<) - -> Zs = [l(X*Kx,OrdX)|Ztail], - add_linear_11h(Xs,Y,Ky,OrdY,Ys,Ztail) - ; Rel = (>) - -> Zs = [l(Y*Ky,OrdY)|Ztail], - add_linear_11h(Ys,X,Kx,OrdX,Xs,Ztail) - ). - -% mult_linear_factor(Lin,K,Res) -% -% Linear expression Res is the result of multiplication of linear -% expression Lin by scalar K - -mult_linear_factor(Lin,K,Mult) :- - TestK is K - 1.0, % K =:= 1 - TestK =< 1.0e-10, - TestK >= -1.0e-10, % avoid copy - !, - Mult = Lin. -mult_linear_factor(Lin,K,Res) :- - Lin = [I,R|Hom], - Res = [Ik,Rk|Mult], - Ik is I*K, - Rk is R*K, - mult_hom(Hom,K,Mult). - -% mult_hom(Hom,K,Res) -% -% Homogene part Res is the result of multiplication of homogene part -% Hom by scalar K - -mult_hom([],_,[]). -mult_hom([l(A*Fa,OrdA)|As],F,[l(A*Fan,OrdA)|Afs]) :- - Fan is F*Fa, - mult_hom(As,F,Afs). - -% nf_substitute(Ord,Def,Lin,Res) -% -% Linear expression Res is the result of substitution of Var in -% linear expression Lin, by its definition in the form of linear -% expression Def - -nf_substitute(OrdV,LinV,LinX,LinX1) :- - delete_factor(OrdV,LinX,LinW,K), - add_linear_f1(LinV,K,LinW,LinX1). - -% delete_factor(Ord,Lin,Res,Coeff) -% -% Linear expression Res is the result of the deletion of the term -% Var*Coeff where Var has ordering Ord from linear expression Lin - -delete_factor(OrdV,Lin,Res,Coeff) :- - Lin = [I,R|Hom], - Res = [I,R|Hdel], - delete_factor_hom(OrdV,Hom,Hdel,Coeff). - -% delete_factor_hom(Ord,Hom,Res,Coeff) -% -% Homogene part Res is the result of the deletion of the term -% Var*Coeff from homogene part Hom - -delete_factor_hom(VOrd,[Car|Cdr],RCdr,RKoeff) :- - Car = l(_*Koeff,Ord), - compare(Rel,VOrd,Ord), - ( Rel= (=) - -> RCdr = Cdr, - RKoeff=Koeff - ; Rel= (>) - -> RCdr = [Car|RCdr1], - delete_factor_hom(VOrd,Cdr,RCdr1,RKoeff) - ). - - -% nf_coeff_of(Lin,OrdX,Coeff) -% -% Linear expression Lin contains the term l(X*Coeff,OrdX) - -nf_coeff_of([_,_|Hom],VOrd,Coeff) :- - nf_coeff_hom(Hom,VOrd,Coeff). - -% nf_coeff_hom(Lin,OrdX,Coeff) -% -% Linear expression Lin contains the term l(X*Coeff,OrdX) where the -% order attribute of X = OrdX - -nf_coeff_hom([l(_*K,OVar)|Vs],OVid,Coeff) :- - compare(Rel,OVid,OVar), - ( Rel = (=) - -> Coeff = K - ; Rel = (>) - -> nf_coeff_hom(Vs,OVid,Coeff) - ). - -% nf_rhs_x(Lin,OrdX,Rhs,K) -% -% Rhs = R + I where Lin = [I,R|Hom] and l(X*K,OrdX) is a term of Hom - -nf_rhs_x(Lin,OrdX,Rhs,K) :- - Lin = [I,R|Tail], - nf_coeff_hom(Tail,OrdX,K), - Rhs is R+I. % late because X may not occur in H - -% isolate(OrdN,Lin,Lin1) -% -% Linear expression Lin1 is the result of the transformation of linear expression -% Lin = 0 which contains the term l(New*K,OrdN) into an equivalent expression Lin1 = New. - -isolate(OrdN,Lin,Lin1) :- - delete_factor(OrdN,Lin,Lin0,Coeff), - K is -1.0/Coeff, - mult_linear_factor(Lin0,K,Lin1). - -% indep(Lin,OrdX) -% -% succeeds if Lin = [0,_|[l(X*1,OrdX)]] - -indep(Lin,OrdX) :- - Lin = [I,_|[l(_*K,OrdY)]], - OrdX == OrdY, - % K =:= 1.0 - TestK is K - 1.0, - TestK =< 1.0e-10, - TestK >= -1.0e-10, - % I =:= 0 - I =< 1.0e-10, - I >= -1.0e-10. - -% nf2sum(Lin,Sofar,Term) -% -% Transforms a linear expression into a sum -% (e.g. the expression [5,_,[l(X*2,OrdX),l(Y*-1,OrdY)]] gets transformed into 5 + 2*X - Y) - -nf2sum([],I,I). -nf2sum([X|Xs],I,Sum) :- - ( % I =:= 0.0 - I =< 1.0e-10, - I >= -1.0e-10 - -> X = l(Var*K,_), - ( % K =:= 1.0 - TestK is K - 1.0, - TestK =< 1.0e-10, - TestK >= -1.0e-10 - -> hom2sum(Xs,Var,Sum) - ; % K =:= -1.0 - TestK is K + 1.0, - TestK =< 1.0e-10, - TestK >= -1.0e-10 - -> hom2sum(Xs,-Var,Sum) - ; hom2sum(Xs,K*Var,Sum) - ) - ; hom2sum([X|Xs],I,Sum) - ). - -% hom2sum(Hom,Sofar,Term) -% -% Transforms a linear expression into a sum -% this predicate handles all but the first term -% (the first term does not need a concatenation symbol + or -) -% see also nf2sum/3 - -hom2sum([],Term,Term). -hom2sum([l(Var*K,_)|Cs],Sofar,Term) :- - ( % K =:= 1.0 - TestK is K - 1.0, - TestK =< 1.0e-10, - TestK >= -1.0e-10 - -> Next = Sofar + Var - ; % K =:= -1.0 - TestK is K + 1.0, - TestK =< 1.0e-10, - TestK >= -1.0e-10 - -> Next = Sofar - Var - ; % K < 0.0 - K < -1.0e-10 - -> Ka is -K, - Next = Sofar - Ka*Var - ; Next = Sofar + K*Var - ), - hom2sum(Cs,Next,Term). diff --git a/packages/chr b/packages/chr new file mode 160000 index 000000000..cba31e063 --- /dev/null +++ b/packages/chr @@ -0,0 +1 @@ +Subproject commit cba31e06301d475e572a2f377061c7b5014b4254 diff --git a/packages/clpqr b/packages/clpqr new file mode 160000 index 000000000..3cda12359 --- /dev/null +++ b/packages/clpqr @@ -0,0 +1 @@ +Subproject commit 3cda12359a93d7d9e337cc564b7bfacf40fc8cb5 diff --git a/packages/jpl b/packages/jpl new file mode 160000 index 000000000..884300248 --- /dev/null +++ b/packages/jpl @@ -0,0 +1 @@ +Subproject commit 8843002483df3078583ca8495630a1b864a7999f