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