1:- module(detact,
    2          [determine_active_dec/2,
    3           determine_active_inc/2]).    4
    5:- use_module(library(clpcd/domain_ops)).    6:- use_module(library(clpcd/solve)).    7
    8% determine_active_dec(Lin)
    9%
   10% Activates inactive bounds on the variables of Lin if such bounds exist.
   11% If the type of a variable is t_none, this fails. This version is aimed
   12% to make the R component of Lin as small as possible in order not to violate
   13% an upperbound (see reconsider/2)
   14
   15determine_active_dec(CLP,[_,_|H]) :-
   16	determine_active(H,CLP,-1).
   17
   18% determine_active_inc(Lin)
   19%
   20% Activates inactive bounds on the variables of Lin if such bounds exist.
   21% If the type of a variable is t_none, this fails. This version is aimed
   22% to make the R component of Lin as large as possible in order not to violate
   23% a lowerbound (see reconsider/2)
   24
   25determine_active_inc(CLP,[_,_|H]) :-
   26	determine_active(H,CLP,1).
   27
   28% determine_active(Hom,S)
   29%
   30% For each variable in Hom, activates its bound if it is not yet activated.
   31% For the case of t_lu(_,_) the lower or upper bound is activated depending on
   32% K and S:
   33% If sign of K*S is negative, then lowerbound, otherwise upperbound.
   34
   35determine_active([],_,_).
   36determine_active([l(X*K,_)|Xs],CLP,S) :-
   37	get_attr(X,clpcd_itf,Att),
   38	arg(2,Att,type(Type)),
   39	determine_active(Type,CLP,X,K,S),
   40	determine_active(Xs,CLP,S).
   41
   42determine_active(t_L(_),_,_,_,_).
   43determine_active(t_Lu(_,_),_,_,_,_).
   44determine_active(t_U(_),_,_,_,_).
   45determine_active(t_lU(_,_),_,_,_,_).
   46determine_active(t_l(L),CLP,X,_,_) :- intro_at(CLP,X,L,t_L(L)).
   47determine_active(t_u(U),CLP,X,_,_) :- intro_at(CLP,X,U,t_U(U)).
   48determine_active(t_lu(L,U),CLP,X,K,S) :-
   49	eval_d(CLP, K*S, KS),
   50	(   compare_d(CLP, >, 0, KS)
   51	->  intro_at(CLP,X,L,t_Lu(L,U))
   52	;   compare_d(CLP, <, 0, KS)
   53	->  intro_at(CLP,X,U,t_lU(L,U))
   54	)