1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8% 
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License. 
13% 
14% The Original Code is  The ECLiPSe Constraint Logic Programming System. 
15% The Initial Developer of the Original Code is  Cisco Systems, Inc. 
16% Portions created by the Initial Developer are
17% Copyright (C) 2006 Cisco Systems, Inc.  All Rights Reserved.
18% 
19% Contributor(s): 
20% 
21% END LICENSE BLOCK
22%-----------------------------------------------------------------------------
23:- module(dual_var).
24%-----------------------------------------------------------------------------
25
26:- export dual_var_print/2.
27
28:- meta_attribute(dual_var, [print:dual_var_print/2, unify:unify_dual/2]).
29:- export struct(dual_var(dual_val, coeff, eplex_idx, type,
30                          primal_rhs, primal_lhs_range, susps, solver, next)).
31
32:- export var_dual/7.
33:- export get_dual/3.
34:- export get_coeff/3.
35
36:- export always_set_dual/3.
37
38:- export set_dual/3.
39:- export get_idx/3.
40:- export get_rhs/3.
41:- export get_lhs_range/3.
42:- export set_lhs_range/3.
43:- export get_type/3.
44:- export satisfiable_primal_cstr/2.
45
46%-----------------------------------------------------------------------------
47
48
49% dual_var attribute handlers
50
51unify_dual(_, Attribute) :-
52    /* NOT A DUAL-VAR */
53    var(Attribute).
54unify_dual(Term, Attribute) :-
55    /* DUAL-VAR */
56    compound(Attribute),
57    unify_term_dual(Term, Attribute).
58
59unify_term_dual(Value, _) :-
60    /* DUAL-VAR and NONVAR - instantiated */
61    nonvar(Value),
62    true.
63unify_term_dual(Y{AttrY}, AttrX) :-
64    -?->
65    /* DUAL-VAR and VAR */
66    unify_dual_dual(Y, AttrY, AttrX).
67
68unify_dual_dual(Y, AttrY, AttrX) :-
69    /* DUAL-VAR and NON-DUAL-VAR - share attribute */
70    var(AttrY),
71    AttrX = AttrY,
72    add_attribute(Y, AttrY).
73unify_dual_dual(_, AttrY, AttrX) :-
74    /* DUAL-VAR and DUAL-VAR - add them */
75    % but what to do about eplex indexes?
76    % probably something like eplex chain of solver ids
77    nonvar(AttrY),
78    AttrY = dual_var with [dual_val:DualY],
79    AttrX = dual_var with [dual_val:DualX],
80    merge_suspension_lists(susps of dual_var, AttrX,
81			   susps of dual_var, AttrY),
82    (DualY = DualX ->
83         true
84    ;
85         NewDual is DualY + DualX,
86         setarg(dual_val of dual_var, AttrY, NewDual),
87         schedule_suspensions(susps of dual_var, AttrY),
88         wake
89    ).
90
91dual_var_print(_{Attr}, Printed) :-
92    -?->
93    nonvar(Attr),
94    printed_dv_attributes(Attr, Printed).
95
96printed_dv_attributes(Attr, Printed) :-
97    ( compound(Attr) ->
98        Attr = dual_var with [
99                              dual_val:Dual,
100                              solver:Handle,
101                              next:NextAttr
102                             ],
103        Printed = [Handle:[dual_val:Dual]|Rest],
104        printed_dv_attributes(NextAttr, Rest)
105    ;
106        % chain terminated by atom end
107        Printed = []
108    ).
109
110% ----------------------------------------------------------------------
111
112% creating a new dual_var variable
113
114var_dual(Var, Dual, Coeff, Idx, Type, Rhs, Handle) :-
115        get_dual_attr(Var, Handle, Attr),
116        Attr = dual_var with [
117                              dual_val:Dual,
118                              coeff:Coeff,
119                              eplex_idx:Idx,
120                              type:Type,
121                              primal_rhs:Rhs
122                             ].
123
124get_dual_attr(X{dual_var:Attr0}, Handle, Attr) ?-
125        ( var(Attr0) ->
126              new_dual_attr(X, Handle, Attr)
127        ;
128              Attr0 = dual_var with [solver:Handle0, next:Next],
129              % should not fail unless Attr0 incorrect
130              ( Handle0 == Handle ->
131                    Attr = Attr0
132              ;
133                    get_dual_attr1(Next, Attr0, Handle, Attr)
134              )
135        ).
136get_dual_attr(X, Handle, Attr) :-           % make a new dual_var variable
137        free(X),
138        new_dual_attr(X, Handle, Attr).
139
140get_dual_attr1(ThisAttr, Attr0, Handle, Attr) :-
141	atom(ThisAttr), !, % chain terminated by atom 'end'
142	new_dual_attrstruct(Handle, Attr),
143	setarg(next of dual_var, Attr0, Attr).
144get_dual_attr1(ThisAttr, _Attr0, Handle, Attr) :-
145        ThisAttr = dual_var with [solver:Handle0, next:Next],
146        ( Handle0 == Handle ->
147              Attr = ThisAttr
148        ;
149              get_dual_attr1(Next, ThisAttr, Handle, Attr)
150        ).
151
152new_dual_attr(X, Handle, Attr) :-         % make a new dual_var variable:
153        new_dual_attrstruct(Handle, Attr),
154        add_attribute(X, Attr, dual_var).
155
156:- mode new_dual_attrstruct(+,-).
157new_dual_attrstruct(Handle, Attr) :-
158        Attr = dual_var with [
159                              solver:Handle,
160                              next:end
161                             ],
162        init_suspension_list(susps of dual_var, Attr).
163
164% From a dual_var attr, searches for the attribute corresponding to
165% that for the first argument. Fails if none found. 
166get_dual_attr_for_handle(Handle, Attr0, Attr) :-
167        compound(Attr0), 
168	get_dual_attr_for_handle1(Handle, Attr0, Attr).
169
170get_dual_attr_for_handle1(Handle, Attr0, Attr) :-
171        % no need to test for var(Attr0) in chain
172        Attr0 = dual_var with [solver:Handle0, next:NextAttr],
173	(Handle0 == Handle ->
174	     Attr0 = Attr
175	;    
176	     get_dual_attr_for_handle1(Handle, NextAttr, Attr)
177	).
178
179% -------------------------------------------------------------------------
180
181satisfiable_primal_cstr(_{Attr0}, Handle) :-
182    -?->
183    get_dual_attr_for_handle(Handle, Attr0, Attr),
184    Attr = dual_var with [
185                          type:Type,
186                          primal_rhs:Rhs,
187                          primal_lhs_range:Min..Max
188                         ],
189    ground(Min..Max),
190    ( Type == (=<) -> Min =< Rhs
191    ; Type == (=:=) -> Min =< Rhs, Max >= Rhs
192    ; Type == (>=) -> Max >= Rhs ).
193
194% dual_var attribute setting and testing predicates
195
196get_idx(_{Attr0}, Idx, Handle) :-
197    -?->
198    get_dual_attr_for_handle(Handle, Attr0, Attr),
199    Attr = dual_var with eplex_idx:Idx.
200
201get_rhs(_{Attr0}, Rhs, Handle) :-
202    -?->
203    get_dual_attr_for_handle(Handle, Attr0, Attr),
204    Attr = dual_var with primal_rhs:Rhs.
205
206get_lhs_range(_{Attr0}, Range, Handle) :-
207    -?->
208    get_dual_attr_for_handle(Handle, Attr0, Attr),
209    Attr = dual_var with primal_lhs_range:Range.
210
211set_lhs_range(_{Attr0}, Lo..Hi, Handle) :-
212    -?->
213    get_dual_attr_for_handle(Handle, Attr0, Attr),
214    Attr = dual_var with primal_lhs_range:Lo0..Hi0,
215    Lo1 is max(Lo, Lo0),
216    Hi1 is min(Hi, Hi0),
217    setarg(primal_lhs_range of dual_var, Attr, Lo1..Hi1).
218
219get_type(_{Attr0}, Type, Handle) :-
220    -?->
221    get_dual_attr_for_handle(Handle, Attr0, Attr),
222    Attr = dual_var with type:Type.
223
224get_dual(_{Attr0}, Dual, Handle) :-
225    -?->
226    get_dual_attr_for_handle(Handle, Attr0, Attr),
227    Attr = dual_var{dual_val:Dual}.
228
229always_set_dual(_{Attr0}, Dual, Handle) :-
230    -?->
231    get_dual_attr_for_handle(Handle, Attr0, Attr),
232    Attr = dual_var with dual_val:Old,
233    ( Old =:= Dual ->
234        true
235    ;
236        setarg(dual_val of dual_var, Attr, Dual)
237    ),
238    schedule_suspensions(susps of dual_var, Attr),
239    wake.
240
241set_dual(_{Attr0}, Dual, Handle) :-
242    -?->
243    get_dual_attr_for_handle(Handle, Attr0, Attr),
244    Attr = dual_var with dual_val:Old,
245    ( Old =:= Dual ->
246        true
247    ;
248        setarg(dual_val of dual_var, Attr, Dual),
249        schedule_suspensions(susps of dual_var, Attr),
250        wake
251    ).
252
253get_coeff(_{Attr0}, Coeff, Handle) :-
254    -?->
255    get_dual_attr_for_handle(Handle, Attr0, Attr),
256    Attr = dual_var{coeff:Coeff}.
257