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) 1995-2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Pierre Lim, ECRC. 20% 21% END LICENSE BLOCK 22 23:- module(r). 24 25:- export op(700,xfx,$=). 26:- export op(700,xfx,$<>). 27:- export op(700,xfx,$>=). 28:- export op(700,xfx,$<=). 29:- export op(700,xfx,$=<). % CHIP compatibility 30:- export op(700,xfx,$>). 31:- export op(700,xfx,$<). 32 33:- export portray(type(rational), tr_rat/2, []). 34 35:- local other_error_handler/3. 36:- dynamic other_error_handler/3. 37 38/* 39:- define_macro($$= /2, tr_r/2, [write]). 40:- define_macro($$<> /2, tr_r/2, [write]). 41:- define_macro($$>= /2, tr_r/2, [write]). 42:- define_macro($$<= /2, tr_r/2, [write]). 43:- define_macro($$=< /2, tr_r/2, [write]). % CHIP compatibility 44:- define_macro($$> /2, tr_r/2, [write]). 45:- define_macro($$< /2, tr_r/2, [write]). 46:- define_macro(rrmin /1, tr_r/2, [write]). 47:- define_macro(rrmax /1, tr_r/2, [write]). 48*/ 49 50 51:- export 52 $= /2, 53 $<> /2, 54 $>= /2, 55 $<= /2, 56 $=< /2, 57 $> /2, 58 $< /2, 59 (rmin) /1, 60 (rmax) /1, 61 tr_rat/2, 62 tr_r/2, 63 print_global_list/0, 64 print_global_list2/0, 65 get_constraint_store/1, 66 is_slack_variable/1, 67 variable_name/2. 68 69 70:- pragma(nodebug). 71:- pragma(expand). % debugging multiple solver screwup 72:- set_flag(prefer_rationals,on). % turn on rational number system 73:- set_flag(output_mode, "QVP"). 74 75:- import 76 collect/3, 77 setarg/3, 78 suspensions/1 79 from sepia_kernel. 80 81make_const(no_macro_expansion('ZERO'), 0). 82make_const(no_macro_expansion('ONE'), 1). 83make_const(no_macro_expansion('MONE'), -1). 84 85mono_to_dot(mono(X,Y),[X|Y]). 86 87:- local macro(no_macro_expansion('ZERO'), make_const/2, []). 88:- local macro(no_macro_expansion('ONE'), make_const/2, []). 89:- local macro(no_macro_expansion('MONE'), make_const/2, []). 90:- local macro(no_macro_expansion(mono/2), mono_to_dot/2, []). 91 92 93tr_r($$=(A, B), $=(A1, B1)) :- 94 object2user(A, A1), 95 object2user(B, B1). 96tr_r($$<>(A, B), $<>(A1, B1)) :- 97 object2user(A, A1), 98 object2user(B, B1). 99tr_r($$>=(A, B), $>=(A1, B1)) :- 100 object2user(A, A1), 101 object2user(B, B1). 102tr_r($$<=(A, B), $<=(A1, B1)) :- 103 object2user(A, A1), 104 object2user(B, B1). 105tr_r($$=<(A, B), $=<(A1, B1)) :- 106 object2user(A, A1), 107 object2user(B, B1). % CHIP compatibility 108tr_r($$>(A, B), $>(A1, B1)) :- 109 object2user(A, A1), 110 object2user(B, B1). 111tr_r($$<(A, B), $<(A1, B1)) :- 112 object2user(A, A1), 113 object2user(B, B1). 114tr_r(rrmin(A), rmin(A1)) :- 115 object2user(A, A1). 116tr_r(rrmax(A), rmax(A1)) :- 117 object2user(A, A1). 118 119 120tr_rat(Term, Out) :- 121 N is numerator(Term), D is denominator(Term), 122 (D =:= 'ONE' -> 123 Out = N 124 ; 125 Out = N/D 126 ). 127 128:- local struct(lin(dg, constr, rhs, pvar, dead, user)). 129 130:- meta_attribute(r, [ 131 unify: linear_constraint_handler/2 132 ]). 133 134% no longer supported in release 4.1 135%:- debug_macro(0'/, "@set_flag(output_mode, \"QVP\"),nl"). 136%:- debug_macro(0'\, "@set_flag(output_mode, \"QVPM\"),nl"). 137%:- debug_macro(0'=, "@print_global_list."). 138%:- debug_macro(0'|, "@print_global_list2."). % debugging rationals 139 140% This works only after release 5.X 141:- local reference(global_list, []). 142 143 144%---------------------------------------------------------- 145% user level predicates 146%---------------------------------------------------------- 147 148$$<>(X, Y) :- 149 %index_integrity_check("At $$<> integrity check 1"), 150 (linnorm(X-Y,Norm0) -> 151 mark_solver_variables(Norm0), 152 substitute(1,Norm0,[],Norm1), 153 simplify(Norm1,Norm,_), 154 disequality(Norm) 155 ; 156 delay([X,Y],$$<>(X, Y)) 157 ). 158 %index_integrity_check("At $$<> integrity check 2"). 159 160$$=<(X, Y) :- 161 $$<=(X, Y). 162 163$$<=(X, Y) :- 164 %index_integrity_check("At $$<= integrity check 1"), 165 (linnorm(P+X-Y,Norm0) -> % the order of X-Y+P is important! 166 mark_solver_variables(Norm0), 167 positive(P), 168 substitute(1,Norm0,[],Norm1), 169 simplify(Norm1,Norm,_), 170 ( constant_rhs(Norm, Val) -> 171 Val = 'ZERO' 172 ; all_pvars(Norm) -> 173 simplex(Norm) 174 ; 175 eliminate(Norm) 176 ) 177 ; 178 delay([X,Y], $$<=(X, Y)) 179 ). 180 %index_integrity_check("At $$<= integrity check 2"). 181 182$$>=(X, Y) :- 183 %index_integrity_check("At $$>= integrity check 1"), 184 (linnorm(P-X+Y,Norm0) -> % the order of X-Y+P is important! 185 mark_solver_variables(Norm0), 186 positive(P), 187 substitute(1,Norm0,[],Norm1), 188 simplify(Norm1,Norm,_), 189 ( constant_rhs(Norm, Val) -> 190 Val = 'ZERO' 191 ; all_pvars(Norm) -> 192 simplex(Norm) 193 ; 194 eliminate(Norm) 195 ) 196 ; 197 delay([X,Y],$$>=(X, Y)) 198 ). 199 %index_integrity_check("At $$>= integrity check 2"). 200 201$$>(X, Y) :- 202 $$<(Y, X). 203 204$$<(X, Y) :- 205 $$<>(X, Y), 206 $$<=(X, Y). 207 208$$=(X, Y) :- 209 %index_integrity_check("At $$= integrity check 1"), 210 (linnorm(X-Y,Norm0) -> 211 lin_eq(Norm0) 212 ; 213 delay([X,Y], $$=(X, Y)) 214 ). 215 %index_integrity_check("At $$= integrity check 2"). 216 217lin_eq(Norm0) :- 218 mark_solver_variables(Norm0), 219 substitute(1,Norm0,[],Norm1), 220 simplify(Norm1,Norm,_), 221 ( constant_rhs(Norm, Val) -> 222 Val = 'ZERO' 223 ; all_pvars(Norm) -> 224 simplex(Norm) 225 ; 226 eliminate(Norm) 227 ). 228 229%---------------------------------------------------------- 230% Debugging 231%---------------------------------------------------------- 232 233linerr(Msg) :- 234 printf(error, "%Vw\n%b", [Msg]), 235 abort. 236 237%---------------------------------------------------------- 238% Accessing metaterms 239%---------------------------------------------------------- 240 241is_pvar(_{lin with [pvar:Pvar]}) ?- 242 nonvar(Pvar). 243 244positive(X) :- 245 meta(X), !, 246 get_lin_attr(X,Attr), 247 Attr = lin with [pvar:true]. 248positive(X) :- 249 free(X), !, 250 add_attribute(X, lin with [pvar:true,constr:[]]). 251positive(X) :- 252 linerr("free var expected in"-positive(X)), 253% writeln("free var expected in"-positive(X)), 254 true. 255 256get_lin_attr(_{Lin}, Lin1) ?- 257 Lin = lin with [], % Lin = lin(_,_,_) 258 Lin1 = Lin. 259 260lin_rhs(_{lin with [rhs:Rhs]}, Rhs1) ?- 261 Rhs = Rhs1. 262 263lin_constr(_{lin with [constr:Constr]}, Constr1) ?- 264 Constr = Constr1. 265 266lin_all(_{Attr}, Attr1) ?- 267 Attr = Attr1. 268 269 270insert_constr(Vrho, Vlhs{Lin}) ?- 271 Lin = lin with [constr:OldLocal], 272 setarg(constr of lin, Lin, [Vrho|OldLocal]), 273 r_notify_constrained(Vlhs). 274 %writeln(insert_constr(Lin)). 275 276 277linear_term(_{lin with []}) ?- 278 true. 279% 280% 16.11.93 281delayed_term(X) :- 282 meta(X). 283 284mark_solver_variables([]). 285mark_solver_variables([mono(_, V)|T]) :- 286 ( number(V) -> 287 true 288 ; linear_term(V) -> 289 true 290 ; delayed_term(V) -> 291 lin_all(V,Attr), 292 Attr = lin with [constr:Constr], 293 Constr = [] 294 ; 295 add_attribute(V, lin with [constr:[]]) 296 ), 297 mark_solver_variables(T). 298 299new_variable(V) :- 300 get_lin_attr(V, lin with [rhs:Rhs, constr:[]]), 301 var(Rhs). 302 303parametric(V) :- 304 lin_rhs(V,Rhs), 305 var(Rhs). 306 307 308%---------------------------------------------------------- 309% General utilities 310%---------------------------------------------------------- 311 312delay(Vars, Goal) :- 313 suspend(Goal, 3, Vars->bound). 314 315all_new_variables([]). 316all_new_variables([mono(_C,V)|T]) :- 317 parametric(V), 318 all_new_variables(T). 319 320add_rhs(V, Rhs) :- 321% test_rhs(Rhs), 322 get_lin_attr(V, Attr), 323% Gauss-Jordan 324 Attr = lin with [rhs:Rhs, constr:Constr], 325 r_notify_constrained(V), 326 substitute_single_var(V, Rhs, Constr), 327% SUBS 328 put_in_global_list(V), 329 put_in_constr_lists(V, Rhs). 330 331delete_var_from_constr(_,[],[]). 332delete_var_from_constr(Var,[V|T],New) :- 333 ( Var == V -> 334 New = T 335 ; 336 New = [V|New0], 337 delete_var_from_constr(Var,T,New0) 338 ). 339 340remove_from_local(_,[]) :- !. 341remove_from_local(Var,[mono(_,V)|T]) :- 342 delete_from_constr_list(Var, V), 343 remove_from_local(Var,T). 344 345delete_from_constr_list(_Var, V) :- 346 nonvar(V), 347 !. 348delete_from_constr_list(Var, V) :- 349 get_lin_attr(V, Attr), 350 Attr = lin with [constr:Constr], 351 delete_var_from_constr(Var,Constr,New), 352 setarg(constr of lin, Attr, New). 353 354remove_from_global(V) :- 355 getval(global_list,G), 356 delete_var_from_constr(V,G,G1), 357 setval(global_list,G1). 358 359delete_rhs(V) :- 360 get_lin_attr(V, Attr), 361 Attr = lin with [rhs:Rhs], 362 get_constant(Rhs,_,Rest), 363 remove_from_local(V,Rest), 364 remove_from_global(V), 365 setarg(rhs of lin, Attr, _). 366 367delete_simplex_row(Pvar) :- 368 get_lin_attr(Pvar,_Attr), 369 delete_rhs(Pvar). 370 371all_pvars([]). 372all_pvars([mono(_,V)|T]) :- 373 (number(V) ; is_pvar(V)), 374 !, 375 all_pvars(T). 376 377constant_rhs([], 'ZERO'). 378constant_rhs([mono(C,V)], Val) :- 379 number(C), 380 number(V), 381 Val is C*V. 382 383zero(X) :- var(X), !, fail. 384zero(X) :- sgn(X, 0). 385 386%get_var_coeff([], _, _) :- 387% linerr("variable not found in rhs in get_var_coeff"). 388get_var_coeff([], _Var, 0) :- 389% writeln("variable not found in rhs in get_var_coeff"), 390 true. 391get_var_coeff([mono(C,V)|T], Var, Coeff) :- 392 (Var == V -> 393 Coeff = C 394 ; 395 get_var_coeff(T, Var, Coeff) 396 ). 397 398%---------------------------------------------------------- 399% Handler for Unification of linear variables 400% It does two things: 401% 1. A binding of a variable that is a left had side is treated 402% as a new equality and given to the solver. If this is not 403% wanted or needed, the dead flag should be set before doing 404% the binding. 405% 2. All right hand sides that involve the (no bound) variable 406% are simplified. 407% We assume that pvars are not bound in an uncontrolled way, 408% so we don't make special checks here. 409%---------------------------------------------------------- 410 411linear_constraint_handler(X, Y) :- 412 ( var(Y) -> 413 true 414 ; 415 linear_unify(X, Y) 416 ). 417 418linear_unify(Val, lin with [dg:DG, rhs:Rhs, constr:Constr, dead:Dead]) :- 419 number(Val), 420 !, 421 ( var(Dead), nonvar(Rhs) -> 422 (zero(Val) -> 423 lin_eq(Rhs) % treat as new equality 424 ; 425 lin_eq([mono('MONE',Val)|Rhs]) % treat as new equality 426 ) 427 ; 428 true 429 ), 430 simplify_rhs(Constr), 431 schedule_woken(DG). 432linear_unify(killed, _) :- !. 433linear_unify(Val, X) :- 434 linerr("Error in linear_unify "-linear_unify(Val, X)). 435 436simplify_rhs([]) :- !. 437simplify_rhs([Vlhs|T]) :- 438 ( var(Vlhs) -> 439 get_lin_attr(Vlhs, Attr), 440 arg(rhs of lin, Attr, Rhs0), 441 substitute(1,Rhs0,[],Rhs), 442 simplify(Rhs, RhsSimp, Zeros), 443 remove_from_local(Vlhs,Zeros), 444 update(Vlhs, Attr, RhsSimp), 445 (is_pvar(Vlhs) -> 446 check_rhs(RhsSimp,Form), 447 get_constant(RhsSimp,_Const,RhsRest), 448 (Form == ok -> 449 true 450 ;Form == violates_3 -> 451 fail % nonpositive constant 452 ;Form == violates_4 -> 453 (all_new_variables(RhsRest) -> 454 true % work already done 455 ; 456 delete_simplex_row(Vlhs) % redundant 457 ) 458 ;Form == violates_5a -> 459 bind_all_zero(RhsRest) 460 ;Form == violates_5b -> 461 (all_new_variables(RhsRest) -> 462 true % work already done 463 ; 464 delete_simplex_row(Vlhs) % redundant 465 ) 466 ) 467 ; 468 true 469 ) 470 ; 471 true 472 ), 473 simplify_rhs(T). 474 475update_rhs(V, NewRhs) :- 476 get_lin_attr(V, Attr), 477 update(V, Attr, NewRhs). 478 479update(V, lin with [dead:Dead], []) :- 480 !, 481 Dead = dead, 482 V = 'ZERO'. 483update(V, lin with [dead:Dead,pvar:Pvar], [mono(C1,V1)]) :- 484 number(C1), 485 number(V1), 486 !, 487 V2 is C1*V1, 488 (nonvar(Pvar) -> 489 V2 >= 0 490 ; 491 true 492 ), 493 Dead = dead, 494 V = V2. 495update(V, Attr, RhsSimp) :- 496% test_rhs(RhsSimp), 497 setarg(rhs of lin, Attr, RhsSimp), 498 r_notify_constrained(V), 499% Patch 4.6.93 500 (is_pvar(V) -> 501 lin_constr(V,Constr), 502 substitute_single_var(V,RhsSimp,Constr) 503 ; 504 true 505 ). 506 507divide_remove(_,_,[],[]) :- !. 508divide_remove(C,Var,[mono(C1,V)|T],R) :- 509 (Var == V -> 510 divide_remove(C,Var,T,R) 511 ; 512 C2 is C1/C, 513 R = [mono(C2,V)|T1], 514 divide_remove(C,Var,T,T1) 515 ). 516 517put_in_constr_lists(_, []). 518put_in_constr_lists(Vrho, [mono(_, V)|T]) :- 519 ( var(V) -> 520 insert_constr(Vrho, V) 521 ; 522 true 523 ), 524 put_in_constr_lists(Vrho, T). 525 526put_in_global_list(V) :- 527 getval(global_list, Old), 528 setval(global_list, [V|Old]). 529 530find_rho([mono(C,V)|T],R) :- 531 (var(V) -> 532 ( is_pvar(V) -> 533 find_rho(T,R) 534 ; 535 R = mono(C,V) 536 ) 537 ; 538 find_rho(T,R) 539 ). 540 541 542/* Working spec 543% substitute(+Coeff, +Rhs, +RhsSubst, -RhsSubst) 544:- mode substitute(+,+,+,-). 545substitute(_,[],R0,R) :- !, R0=R. 546substitute(Coeff,[mono(C,V)|T],R0,R) :- 547 C1 is Coeff*C, 548 ( lin_rhs(V, Rhs), nonvar(Rhs) -> 549 substitute(C1,Rhs,R0,R1) 550 ; 551 R1 = [mono(C1,V)|R0] 552 ), 553 substitute(Coeff,T,R1,R). 554*/ 555% substitute(+Coeff, +Rhs, +RhsSubst, -RhsSubst) 556:- mode substitute(+,+,+,-). 557substitute(_,[],R0,R) :- !, R0=R. 558substitute(Coeff,[mono(C,V)|T],R0,R) :- 559 C1 is Coeff*C, 560 substitute_aux(C1,V,R0,R1), 561 substitute(Coeff,T,R1,R). 562 563:- mode substitute_aux(+,?,+,-). 564substitute_aux(C,V,R0,R) :- 565 number(V), 566 !, 567 R = [mono(C,V)|R0]. 568substitute_aux(C,V,R0,R) :- 569 lin_rhs(V, Rhs), 570 substitute_aux1(C,V,Rhs,R0,R). 571 572:- mode substitute_aux1(+,+,?,+,-). 573substitute_aux1(C,V,Rhs,R0,R) :- 574 var(Rhs), 575 !, 576 R = [mono(C,V)|R0]. 577substitute_aux1(C,_,Rhs,R0,R) :- 578 substitute(C,Rhs,R0,R). 579 580:- mode simplify2(+,+,-,-,-). 581/* 582% Working spec 583simplify2(N1, N2, N, NewVars, Zeros) :- 584 sort(2, >=, N1, N1s), 585 sort(2, >=, N2, N2s), 586 merge_and_detect_new_vars(N1s, N2s, N3, NewVars), 587 collect(N3, N, Zeros). 588*/ 589% Optimized version 590simplify2(N1, N2, N, NewVars, Zeros) :- 591 merge_and_detect_new_vars(N1, N2, N3, NewVars), 592 collect(N3, N, Zeros). 593 594% merge_and_detect_new_vars(Old, New, Merged, NewVars) 595 596:- mode merge_and_detect_new_vars(+,+,-,-). 597merge_and_detect_new_vars([], New, New, New) :- !. 598merge_and_detect_new_vars(Old, [], Old, []) :- !. 599/* Working spec 600merge_and_detect_new_vars([Old|Olds], [New|News], Merged, NewVars) :- 601 New = mono(_,NewV), 602 Old = mono(_,OldV), 603 compare(R, NewV, OldV), 604 ( R = (<) -> 605 Merged = [Old|Merged1], 606 merge_and_detect_new_vars(Olds, [New|News], Merged1, NewVars) 607 ; R = (>) -> 608 Merged = [New|Merged1], 609 NewVars = [New|NewVars1], 610 merge_and_detect_new_vars([Old|Olds], News, Merged1, NewVars1) 611 ; 612 Merged = [Old,New|Merged1], 613 merge_and_detect_new_vars(Olds, News, Merged1, NewVars) 614 ). 615*/ 616merge_and_detect_new_vars([Old|Olds], [New|News], Merged, NewVars) :- 617 New = mono(_,NewV), 618 Old = mono(_,OldV), 619 compare(R, NewV, OldV), 620 index_merge_and_detect_new_vars(R,Old,Olds,New,News,Merged,_Merged1,NewVars,_NewVars1), 621 !. 622 623index_merge_and_detect_new_vars((<),Old,Olds,New,News,Merged,Merged1,NewVars,_NewVars1) :- 624 Merged = [Old|Merged1], 625 merge_and_detect_new_vars(Olds, [New|News], Merged1, NewVars). 626index_merge_and_detect_new_vars((>),Old,Olds,New,News,Merged,Merged1,NewVars,NewVars1) :- 627 Merged = [New|Merged1], 628 NewVars = [New|NewVars1], 629 merge_and_detect_new_vars([Old|Olds], News, Merged1, NewVars1). 630index_merge_and_detect_new_vars(_R,Old,Olds,New,News,Merged,Merged1,NewVars,_NewVars1) :- 631 Merged = [Old,New|Merged1], 632 merge_and_detect_new_vars(Olds, News, Merged1, NewVars). 633 634:- mode collect_vars(+,-,?). 635collect_vars([], Vs, Vs). 636collect_vars([mono(_,V)|T], [V|Vs1], Vs0) :- 637 collect_vars(T, Vs1, Vs0). 638 639 640 641simplify(N0,N,Zeros) :- 642 sort(2,>=,N0,N1), 643 collect(N1,N,Zeros). 644 645 646/* 647check_rhs(Rhs, _Form) :- 648% If the Rhs is a negative constant then fail 649 get_constant(Rhs,Con,Rest), 650 Con < 0, 651 Rest == [], 652 writeln("Neg constant rhs"), 653 !, 654 fail. 655*/ 656check_rhs(Rhs, Form) :- 657 get_constant(Rhs, Con, Rest), 658 ( Con < 0 -> 659 % required action: delete constraint and re-add 660 Form = violates_3 661 ; 662 count_coeff_signs(Rest, 0, Plus, 0, Minus), 663 ( Minus = 0 -> 664 % required action: delete constraint (redundant) 665 Form = violates_4 666 ; zero(Con) -> 667 ( Plus = 0 -> 668 % required action: bind all vars to zero 669 Form = violates_5a 670 ; Plus = 1 -> 671 % required action: delete constraint (redundant) 672 Form = violates_5b 673 ; 674 Form = ok 675 ) 676 ; 677 Form = ok 678 ) 679 ). 680 681:- mode count_coeff_signs(+,+,-,+,-). 682count_coeff_signs([], P, P, M, M). 683count_coeff_signs([mono(C,_)|T], P0, P, M0, M) :- 684 ( C < 'ZERO' -> 685 M1 is M0+1, 686 count_coeff_signs(T, P0, P, M1, M) 687 ; 688 P1 is P0+1, 689 count_coeff_signs(T, P1, P, M0, M) 690 ). 691 692 693%---------------------------------------------------------- 694% Gauss 695%---------------------------------------------------------- 696 697eliminate(N) :- 698 find_rho(N,mono(C,V)), 699 NegC is -C, 700 divide_remove(NegC,V,N,N1), 701 ( lin_rhs(V,Rhs), nonvar(Rhs) -> 702 linerr("lhs in eliminate") 703 ; 704 true 705 ), 706 eliminate1(V, N1). 707 708eliminate1(V, []) :- 709 !, 710 V = 'ZERO'. 711eliminate1(V, [mono(C1,V1)]) :- 712 number(C1), 713 number(V1), 714 !, 715 V is C1*V1. 716eliminate1(V, N1) :- 717 add_rhs(V, N1). 718 719 720%------------------------------------------ 721% Printing 722%------------------------------------------ 723 724lin_print_values(N, V, M) :- 725 tidy_output1(D), 726 other_error_handler(N, V, M), 727 print_global_list, 728 output_diseqs(D). 729 730print_global_list :- 731 getval(global_list, Store), 732 ( Store == [] -> 733 nl, 734 true 735 ; 736 Store == 0 -> 737 nl, 738 true % At loadtime there's no initialization 739 ; 740 ( nonground(Store) -> 741 writeln(toplevel_output, "\n\nLinear Store:\n "), 742 print_global_list(Store) 743 ; 744 true 745 ) 746 ). 747 748constant_test([mono(_C,V)]) :- 749 number(V). 750 751print_global_list([]). 752print_global_list([H|T]) :- 753 ( get_lin_attr(H, Attr) -> 754 Attr = lin with [rhs:Rhs], 755 (var(Rhs) -> 756 true 757 ; 758 substitute(1,Rhs,[],Rhs1), 759 simplify(Rhs1,Rhs2,_), 760 separate_pvars(Rhs2, NonP, P), 761 P = P1, 762 projection(H,P1,NP,Rel), 763 (Rel == none -> 764 true 765 ; 766 ((NonP == []; constant_test(NonP)) -> 767 append(NonP, NP, Rhs3), 768 Rel1 = Rel 769 ; 770 append(NonP, P1,Rhs3), 771 Rel1 = ($=) 772 ), 773 output(Rhs3, Term), 774 object2user([H, Term], [Hu, Termu]), 775 printf(toplevel_output, "%VQPw %VQPw %VQPw\n", [Hu,Rel1,Termu]) 776 ) 777 ) 778 ; 779 true 780 ), 781 print_global_list(T). 782 783print_global_list2 :- 784 getval(global_list, Store), 785 ( Store == [] -> 786 true 787 ; 788 writeln(toplevel_output, "\nUnsimplified Linear Store:\n"), 789 print_global_list2(Store) 790 ). 791 792print_global_list2([]). 793print_global_list2([H|T]) :- 794 ( get_lin_attr(H, Attr) -> 795 Attr = lin with [rhs:Rhs], 796 (var(Rhs) -> 797 true 798 ; 799 output(Rhs, Term), 800 printf(toplevel_output, "%VQPw\n", $$=(H, Term)) 801 ) 802 ; 803 true 804 ), 805 print_global_list2(T). 806 807% :- mode remove_pvars(+,+,-). 808% remove_pvars(H,B,B) :- !. 809remove_pvars(H,B,Bout) :- 810 not(is_pvar(H)), 811 select_pvar(B,Bout), 812 !. 813remove_pvars(_H,B,B). 814 815select_pvar([mono(_C,V)|Rest],PVar) :- 816 number(V), 817 !, 818 select_pvar(Rest,PVar). 819select_pvar([mono(_C,V)|_Rest],PVar) :- 820 is_pvar(V), 821 appears_on_rhs(V), 822 !, 823 PVar = V. 824select_pvar([mono(_C,_V)|Rest],PVar) :- 825 select_pvar(Rest,PVar). 826 827appears_on_rhs(V) :- 828 lin_constr(V,[C]), 829 lin_rhs(C,Rhs), 830 writeln(constr(C,Rhs)). 831 832:- mode separate_pvars(+,-,-). 833separate_pvars([], [], []). 834separate_pvars([mono(C,V)|T], NonP, P) :- 835 ( is_pvar(V) -> 836 P = [mono(C,V)|P1], 837 NonP = NonP1 838 ; 839 P = P1, 840 NonP = [mono(C,V)|NonP1] 841 ), 842 separate_pvars(T, NonP1, P1). 843 844 845output([], 0). 846output([X|Xs], Z) :- 847 output_aux(X, Prod), 848 output3(Xs, Prod, Z). 849 850output3([], Z, Z) :- !. 851output3([X|Xs], Z0, Z) :- 852 output_aux(X, Prod), 853 output3(Xs, Z0+Prod, Z). 854 855output_aux(mono(X,Y),Z) :- 856 number(Y), 857 !, 858 Z is X*Y. 859output_aux(mono(X,Y),X * Y). 860 861%------------------------------------------ 862% Simplex procedure 863%------------------------------------------ 864 865simplex([]) ?- !, 866 linerr("simplex([]) called"). 867% simplex(Constr) :- writeln(simplex(Constr)), fail. 868simplex(Constr) :- 869 %index_integrity_check("At simplex/1 integrity check:"), 870 get_constant(Constr,Con,Rest), 871 separate_signs(Rest, Plus, Minus), 872 ( zero(Con) -> 873 simplex0(Plus, Minus, Rest) 874 ; 875 simplex2(Con, Plus, Minus, Rest) 876 ). 877 878% simplex(Plus, Minus) === simplex2(0, Plus, Minus) 879 880simplex0([], Minus, _) :- !, bind_all_zero(Minus). 881simplex0(Plus, [], _) :- !, bind_all_zero(Plus). 882simplex0([Plus], _Minus, All) :- 883 !, 884 (all_new_variables(All) -> 885 simplex0_aux(Plus,All) 886 ; 887 true 888 ). 889simplex0(_Plus, [Minus], All) :- 890 !, 891 (all_new_variables(All) -> 892 simplex0_aux(Minus,All) 893 ; 894 true 895 ). 896simplex0(_Plus, _Minus, All) :- 897 simplex3('ZERO', [], All, All). 898 899simplex0_aux(mono(C,V),Norm) :- 900 C1 is -C, 901 divide_remove(C1,V,Norm,Norm1), 902 add_rhs(V,Norm1), 903 lin_constr(V,Constr), 904 substitute_single_var(V,Norm1,Constr). 905 906bind_all_zero([]) :- !. 907bind_all_zero([mono(_,'ZERO')|T]) :- 908 bind_all_zero(T). 909 910% simplex2(Cons, Plus, Minus) where Cons =\= 0 911 912% If equation is of the form -Con = -P then P is positive; succeed 913% When the constant is extracted it has not yet been moved to the other side 914% Multiplication by -1 on the coefficient moves the variable to the other side 915% Since only PVars remain; check that the constant is positive 916% Division scales the constant to a unit of the variable; 917% Then the variable is bound to the constant 918simplex2(Con, [], [mono(C,V)], _) :- !, V1 is Con/(-C), V1 > 0, V = V1. 919simplex2(Con, [mono(C,V)], [], _) :- !, V1 is Con/(-C), V1 > 0, V = V1. 920simplex2(Con, Plus, Minus, All) :- 921 ( Con < 'ZERO' -> 922 simplex3(Con, Minus, Plus, All) 923 ; 924 simplex3(Con, Plus, Minus, All) 925 ). 926 927% simplex3(A, B, C, D) :- writeln(simplex3(A,B,C,D)), fail. 928simplex3(_, _, [], _) :- !, fail. 929simplex3(Con, _Plus, Minus, All) :- 930 find_new_variable(Minus, Cnew, Vnew), 931 !, % step 4a 932 Cnew1 is -Cnew, 933 (zero(Con) -> 934 divide_remove(Cnew1, Vnew, All, All1) 935 ; 936 divide_remove(Cnew1, Vnew, [mono(Con, 'ONE')|All], All1) 937 ), 938 add_rhs(Vnew, All1), 939 lin_constr(Vnew, Constr), 940/***/ substitute_single_var(Vnew, All1, Constr). 941simplex3(Con, Plus, Minus, All) :- 942 find_new_variable(Plus, Cnew, Vnew), 943 !, % step 4b 944 Cnew1 is -Cnew, 945 (zero(Con) -> 946 divide_remove(Cnew1, Vnew, All, Pi) 947 ; 948 divide_remove(Cnew1, Vnew, [mono(Con, 'ONE')|All], Pi) 949 ), 950 Minus \== [], % no possible pivots: fail 951 pick_pivot(Minus, none, Pivot_or_Unbounded), 952 ( Pivot_or_Unbounded = pivot(_,_) -> % step 8 953 pivot(Pivot_or_Unbounded), 954 (zero(Con) -> 955 substitute(1,All,[],Norm1) 956 ; 957 substitute(1,[mono(Con, 'ONE')|All],[],Norm1) 958 ), 959 simplify(Norm1,Norm,_), 960 simplex(Norm) 961 ; % step 7b 962 Pivot_or_Unbounded = unbounded(C,V), 963 C1 is -C, 964 get_var_coeff(All, V, Coeff), %debugging 965 ( Coeff =:= C -> 966 true 967 ; 968 linerr("bogus coeff in simplex3"-(Coeff=\=C)) 969 ), 970 (zero(Con) -> 971 divide_remove(C1, V, All, Pi1) 972 ; 973 divide_remove(C1, V, [mono(Con, 'ONE')|All], Pi1) 974 ), 975 add_rhs(V, Pi1), 976 lin_constr(V, Constr), 977/***/ substitute_single_var(V, Pi1, Constr) 978 ). 979simplex3(Con, _Plus, [mono(C,V)|_T], All) :- % no new variable, step 3 980 C1 is -C, 981 (zero(Con) -> 982 divide_remove(C1, V, All, Pi) 983 ; 984 divide_remove(C1, V, [mono(Con, 'ONE')|All], Pi) 985 ), 986 lin_constr(V, Constr), 987 substitute_single_var(V, Pi, Constr, RemovedRhs), 988 readd_constr(RemovedRhs). 989 990readd_constr([]) :- !. 991readd_constr([Rhs0|T]) :- 992 substitute(1,Rhs0,[],Rhs), 993 simplify(Rhs,Rhs1,_), 994 simplex(Rhs1), 995 readd_constr(T). 996 997insert_var_mono([], Mono, [Mono]). 998insert_var_mono([FirstMono|Others], Mono, Out) :- 999 FirstMono = mono(_,Con), 1000 ( var(Con) -> 1001 Out = [Mono,FirstMono|Others] 1002 ; 1003 Out = [FirstMono,Mono|Others] 1004 ). 1005 1006substitute_single_var(Var, Rhs, Constr) :- 1007 substitute_single_var(Var, Rhs, Constr, _Removed). 1008% ( Removed == [] -> 1009% true 1010% ; 1011% true 1012% 1013% If there are no new variables then we have to allow a parametic 1014% variable to become non-parametric. This can lead to removal of constraints. 1015% 1016%linerr("constraint unexpectedly removed in substitute_single_var") 1017% ). 1018 1019 1020:- mode substitute_single_var(?,+,+,-). 1021substitute_single_var(Var, _, [], []) :- 1022% The constr list of Var must now be empty 1023 true, 1024 (var(Var) -> 1025 get_lin_attr(Var, Attr), 1026 Attr = lin with [constr:_Constr], 1027 setarg(constr of lin, Attr, []) 1028 ; 1029 true 1030 ). 1031substitute_single_var(Var, Pi0, [V|T], RemRhs) :- 1032 (nonvar(V) -> 1033 RemRhs = RemRhs1, 1034 true 1035 ; 1036 (lin_rhs(V, Vrhs) -> 1037/* 1038% ****** test code 1039 substitute(1,Vrhs0,[],Vrhs1), 1040 simplify(Vrhs1,Vrhs,_), 1041% ****** test code 1042*/ 1043 remove_mono(Var, Vrhs, VrhsRest, Coeff), 1044 multiply_all(Coeff, Pi0, Pi), 1045 simplify2(VrhsRest, Pi, NewRhs, NewVars, Zeros), 1046%% 1047 (NewRhs \= [], get_constant(NewRhs,NNNCon,_), NNNCon < 0 -> 1048 mywriteln(old(V,Vrhs)), 1049 mywriteln(new(V,NewRhs)) 1050 ; 1051 true 1052 ), 1053%% 1054 remove_from_local(V, Zeros), 1055% remove_from_local(Var, [V]), 1056 true 1057 ; % else lin_rhs(V, Vrhs) 1058 mywriteln("failed lin_rhs") 1059 ), 1060% Var is no longer in the rhs of of V 1061 ( is_pvar(V) -> 1062 insert_var_mono(NewRhs,mono('MONE',V), NewRhs00), 1063 check_rhs(NewRhs00, Form), 1064 ( Form = ok -> 1065 RemRhs = RemRhs1, 1066 sort(2, >=, NewRhs, NewRhs1), 1067 update_rhs(V, NewRhs1), 1068 delete_from_constr_list(V, Var), 1069 put_in_constr_lists(V, NewVars) 1070 ; Form = violates_3 -> 1071 % DEBUGGING 1072% writeln("nonpositive constant"-NewRhs), 1073 delete_simplex_row(V), 1074 insert_var_mono(NewRhs, mono('MONE',V), NewRhs1), 1075 RemRhs = [NewRhs1|RemRhs1] 1076 ; Form = violates_4 -> 1077 (all_new_variables(NewRhs) -> 1078 RemRhs = RemRhs1, 1079 sort(2, >=, NewRhs, NewRhs1), 1080 update_rhs(V, NewRhs1), 1081 delete_from_constr_list(V, Var), 1082 put_in_constr_lists(V, NewVars) 1083 ; 1084 %% DEBUGGING 1085% writeln("redundant "-NewRhs), 1086 RemRhs = RemRhs1, 1087 delete_simplex_row(V) 1088 ) 1089 ; Form = violates_5a -> 1090 RemRhs = RemRhs1, 1091 bind_all_zero(NewRhs), 1092 V = 'ZERO' 1093 ; Form = violates_5b -> 1094 (all_new_variables(NewRhs) -> 1095 RemRhs = RemRhs1, 1096 sort(2, >=, NewRhs, NewRhs1), 1097 update_rhs(V, NewRhs1), 1098 delete_from_constr_list(V, Var), 1099 put_in_constr_lists(V, NewVars) 1100 ; 1101 % DEBUGGING 1102% writeln("redundant "-NewRhs), 1103 RemRhs = RemRhs1, 1104 delete_simplex_row(V) 1105 ) 1106 ; 1107 linerr("Form does not have correct form") 1108 ) 1109 ; 1110 RemRhs = RemRhs1, 1111 update_rhs(V, NewRhs), 1112 delete_from_constr_list(V, Var), 1113 put_in_constr_lists(V, NewVars) 1114 ) 1115 ), 1116 substitute_single_var(Var, Pi0, T, RemRhs1). 1117 1118%remove_mono(_, [], _, _) :- 1119remove_mono(_, [], [], 0) :- 1120 !, 1121% linerr("occurrence not found in remove_mono"). 1122% Application developers want more informative error messages 1123% linerr("Index integrity violation"). 1124 true. 1125remove_mono(Var, [Mono|T], Out, Coeff) :- 1126 Mono = mono(C,V), 1127 ( V == Var -> 1128 Coeff = C, 1129 Out = T 1130 ; 1131 Out = [Mono|Out1], 1132 remove_mono(Var, T, Out1, Coeff) 1133 ). 1134 1135:- mode multiply_all(+,+,-). 1136multiply_all(_, [], []). 1137multiply_all(Coeff, [mono(C,V)|T], [mono(C1,V)|T1]) :- 1138 C1 is Coeff*C, 1139 multiply_all(Coeff, T, T1). 1140 1141 1142 1143:- mode pick_pivot(+,+,-). 1144pick_pivot([], V, V). 1145pick_pivot([mono(C,V)|T], Vin, Vout) :- 1146 ( only_pos_coeff(V) -> 1147 Vout = unbounded(C,V) 1148 ; Vin = none -> 1149 pick_pivot(T, pivot(C,V), Vout) 1150% Test is reversed here because we used the previously 1151% split list without the pre multiplication 1152% ; Vin = pivot(Cmax,_), C > Cmax -> 1153% pick_pivot(T, pivot(C,V), Vout) 1154 ; Vin = pivot(Cmax,_) -> 1155 (C =:= 0 -> 1156 pick_pivot(T, Vin, Vout) % no change 1157 ; 1158 (C < 0 -> 1159 (C > Cmax -> 1160 pick_pivot(T, pivot(C,V), Vout) 1161 ; 1162 pick_pivot(T, Vin, Vout) % no change 1163 ) 1164 ; 1165 (C < Cmax -> 1166 pick_pivot(T, pivot(C,V), Vout) 1167 ; 1168 pick_pivot(T, Vin, Vout) % no change 1169 ) 1170 ) 1171 ) 1172 ; Vin = pivot(Cmax,_), C =:= Cmax -> 1173 % need cycle breaking code here 1174 % writeln(error, "possible cycle detected in pick_pivot/3"), 1175 pick_pivot(T, Vin, Vout) 1176 ; 1177 pick_pivot(T, Vin, Vout) 1178 ). 1179 1180% this check could be done with a simple test if the constr-list were 1181% split into one with positive and one with negative occurrences of the 1182% variable (as done in chip). 1183 1184only_pos_coeff(V) :- 1185 lin_constr(V, Constr), 1186 only_pos_coeff(V, Constr). 1187 1188only_pos_coeff(_, []). 1189only_pos_coeff(Var, [V|T]) :- 1190 ( is_pvar(V) -> 1191 lin_rhs(V, Rhs), 1192 only_pos_in_rhs(Var, Rhs) 1193 ; 1194 true 1195 ), 1196 only_pos_coeff(Var, T). 1197 1198only_pos_in_rhs(_, []) :- 1199 !, 1200 fail. 1201% linerr("Var does not occur in it's local list in only_pos_in_rhs/2"). 1202only_pos_in_rhs(Var, [mono(C,V)|T]) :- 1203 ( Var == V -> 1204 C >= 'ZERO' 1205 ; 1206 only_pos_in_rhs(Var, T) 1207 ). 1208 1209 1210get_constant(Constr, Const, Rest) :- 1211 nonvar(Constr), 1212% 1213% If it doesn't have a RHS then it should fail 1214% 1215 Constr = [mono(C,V)|T], 1216 ( var(V) -> 1217 Const = 'ZERO', 1218 Rest = Constr 1219 ; 1220 Const is C*V, 1221 Rest = T 1222 ). 1223 1224:- mode separate_signs(+,-,-). 1225separate_signs([],[],[]) :- !. 1226separate_signs([Mono|T],Plus,Minus) :- 1227 Mono = mono(C,V), 1228 ( nonvar(V) -> % debugging 1229 linerr("unexpected constant in separate_signs") 1230 ; zero(C) -> 1231 linerr("unexpected zero coefficient in separate_signs") 1232 ; 1233 true 1234 ), 1235 ( C =< 'ZERO' -> 1236 Minus = [Mono|T1], 1237 separate_signs(T,Plus,T1) 1238 ; 1239 Plus = [Mono|T1], 1240 separate_signs(T,T1,Minus) 1241 ). 1242 1243 1244find_new_variable([mono(C,V)|T], Cnew, Vnew) :- 1245 (new_variable(V) -> 1246% (parametric(V) -> 1247 Vnew = V, 1248 Cnew = C 1249 ; 1250 find_new_variable(T, Cnew, Vnew) 1251 ). 1252 1253 1254%------------------------------------------ 1255% Pivoting 1256%------------------------------------------ 1257 1258pivot(pivot(_,Vpivot)) :- 1259 lin_constr(Vpivot, Constr), 1260 choose_leaving(Constr, Vpivot, leave(none,_,_), Leave), 1261 Leave = leave(_,Coeff,Vleave), 1262 lin_rhs(Vleave, RhsL), 1263 insert_var_mono(RhsL, mono('MONE',Vleave), RhsPiv00), 1264 sort(2, >=, RhsPiv00, RhsPiv0), 1265% not in sorted order anymore !!! 1266 Coeff1 is -Coeff, 1267 divide_remove(Coeff1, Vpivot, RhsPiv0, RhsPiv), 1268 delete_rhs(Vleave), 1269 add_rhs(Vpivot, RhsPiv), 1270 lin_constr(Vpivot, ConstrPiv), 1271 substitute_single_var(Vpivot, RhsPiv, ConstrPiv). 1272 1273 1274:- mode choose_leaving(+,?,+,-). 1275choose_leaving([], _Vpivot, Max, Max) :- 1276 Max = leave(MaxC,_,_), % debugging 1277 !, 1278 ( MaxC = 'ONE' -> 1279 linerr("no leave var found in choose_leaving") 1280 ; 1281 true 1282 ). 1283choose_leaving([V|T], Vpivot, Max0, Max) :- 1284% ( is_pvar(V) -> 1285 ( var(V) -> 1286 lin_rhs(V, Rhs), 1287 mywriteln(choose_leaving(V,Rhs)), 1288 get_constant(Rhs, Con, Rhs1), 1289 get_var_coeff(Rhs1, Vpivot, Coeff), 1290 ( Coeff < 'ZERO' -> 1291 Quot is Con/(-Coeff), 1292 FQuot is Quot * 1.0, 1293 mywriteln(quot = FQuot), 1294 Max0 = leave(MaxC,_,_), 1295 ( MaxC = none -> 1296 Max1 = leave(Quot,Coeff,V) 1297 ; Quot < MaxC -> 1298 Max1 = leave(Quot,Coeff,V) 1299 ; Quot > MaxC -> 1300 Max1 = Max0 1301 ; 1302 Max0 = leave(_,_,Max0V), 1303 lin_rhs(Max0V,Max0Rhs0), 1304 insert_var_mono(Max0Rhs0, 1305 mono('MONE',Max0V), Max0Rhs), 1306 sort(2, >=, Max0Rhs, Max0Rhs1), 1307 insert_var_mono(Rhs, 1308 mono('MONE',V), Rhs2), 1309 sort(2, >=, Rhs2, Rhs3), 1310 break_tie(V,Rhs3,Max0V,Max0Rhs1,Result,ResultRhs), 1311 get_var_coeff(ResultRhs,Vpivot,VCoeff), 1312 % DEBUGGING 1313 % writeln(break_coeff(VCoeff)), 1314 Max1 = leave(Quot,VCoeff,Result) 1315 ) 1316 ; 1317 Max1 = Max0 1318 ) 1319 ; 1320 Max1 = Max0 1321 ), 1322 choose_leaving(T, Vpivot, Max1, Max). 1323 1324% break_tie(V1,Rhs1,V2,Rhs2,Result,ResultRhs). 1325 1326%break_tie(_,[],_,[],_,_) :- 1327% linerr("could not break tie"). 1328break_tie(Var1,[],_Var2,[],Result,ResultRhs) :- 1329 Result = Var1, 1330 lin_rhs(Var1,ResultRhs). 1331break_tie(Var1,[mono(_C1,V1)|T1],Var2,[mono(_C2,V2)|T2],Result,ResultRhs) :- 1332 (V1 @> V2 -> 1333 Result = Var1, 1334 lin_rhs(Var1,ResultRhs) 1335 ; V1 @< V2 -> 1336 Result = Var2, 1337 lin_rhs(Var2,ResultRhs) 1338 ; % V1 == V2 1339 break_tie(Var1,T1,Var2,T2,Result,ResultRhs) 1340 ). 1341 1342%------------------------------------------ 1343% Optimization 1344%------------------------------------------ 1345 1346:- mode all_negative(+). 1347all_negative([]). 1348all_negative([mono(C,_V)|T]) :- 1349 C < 0, 1350 all_negative(T). 1351 1352rrmin(F) :- 1353 mywriteln(rrmin(F)), 1354 rrmax(-F). 1355 1356check_disequations([]):- !. 1357check_disequations([H|T]) :- 1358 get_suspension_data(H, qualified_goal, G), 1359 (G = r:disequality1(_D) -> 1360 fail 1361 ; 1362 true 1363 ), 1364 check_disequations(T). 1365 1366process_disequations([]) :- !. 1367process_disequations([mono(_C,V)|T]) :- 1368 (var(V) -> 1369 suspensions(Susps), 1370 check_disequations(Susps) 1371 ; 1372 true 1373 ), 1374 process_disequations(T). 1375 1376rrmax(F) :- 1377% TIMING incval(ncon), 1378 (linnorm(F,Norm) -> 1379 rrmax1(Norm,Max), 1380 (process_disequations(Norm) -> 1381 $$=(F, Max) 1382 ; 1383 (F = -(Form) -> 1384 delay(F,rrmin(Form)) 1385 ; 1386 delay(F,rrmax(F)) 1387 ) 1388 ) 1389 ; 1390 delay(F,rrmax(F)) 1391 ). 1392 1393rrmax1(F,Max) :- 1394 mywriteln(rrmax1(F,Max)), 1395 mytest, 1396 substitute(1,F,[],F1), 1397 simplify(F1,F2,_), 1398 get_constant(F2,Con,Rest), 1399 (all_negative(Rest) -> 1400 Max = Con 1401 ; 1402 separate_signs(Rest,Plus,_Minus), 1403 obj_pick_pivot(Plus,none,Pivot_or_unbounded), 1404 mywriteln('***pivot_rrmax1'(pivot_or_unbounded = Pivot_or_unbounded,rest =Rest, plus = Plus)), 1405 (Pivot_or_unbounded = unbounded(_,_) -> 1406 linerr("Objective function is not bounded") 1407 ; 1408 obj_pivot(Pivot_or_unbounded), 1409 rrmax1(F,Max) 1410 ) 1411 ). 1412 1413%------------------------------------------ 1414% disequality 1415%------------------------------------------ 1416 1417positive_pvars([]). 1418positive_pvars([mono(C,V)|T]) :- 1419 C > 'ZERO', 1420 is_pvar(V), 1421 positive_pvars(T). 1422 1423disequality([]) :- !, fail. 1424disequality([mono(C,V)]) :- 1425 number(C), 1426 number(V), 1427 !, 1428 C*V =\= 'ZERO'. 1429disequality(D) :- 1430 get_constant(D,Con,Rest), 1431 Con > 'ZERO', 1432 positive_pvars(Rest), 1433 !. 1434disequality(D) :- 1435 make_suspension(disequality1(D), 2, Susp), 1436 insert_suspension(D, Susp, dg of lin). 1437 1438 1439disequality1(D) :- 1440 simplify(D,D1,_), 1441 disequality(D1). 1442 1443%------------------------------------------ 1444% install the handlers 1445%------------------------------------------ 1446 1447% Fix for error handler bug 1448:- get_event_handler(155,F/N,M), 1449 functor(Call,F,N), 1450 Call =.. [_|Args], 1451 Head =.. [other_error_handler|Args], 1452 compile_term(Head :- M:Call). 1453:- set_event_handler(155, lin_print_values/3). 1454 1455 1456%----------------------------------------------------------------------------- 1457% Pretty up output 1458%----------------------------------------------------------------------------- 1459 1460tidy_output1(Out) :- 1461 suspensions(Dgs), 1462 remove_mygoals(Dgs,Out). 1463 1464remove_mygoals([],[]) :- !. 1465remove_mygoals([H|T],R) :- 1466 get_suspension_data(H, qualified_goal, G), 1467 (G = r:disequality1(D) -> 1468 kill_suspension(H), 1469 R = [D|D2] 1470 ; 1471 D2 = R 1472 ), 1473 remove_mygoals(T,D2). 1474 1475 1476projection(H,Term,TermOut,Rel) :- 1477 (is_pvar(H) -> 1478 Rel = none 1479 ; 1480 (Term == [] -> 1481 Rel = ($=) 1482 ; 1483 process_aux(H), 1484 Term = [mono(X,_Var)|TermOut1], 1485 (true -> 1486 TermOut1 = TermOut, 1487 (X =< 0 -> 1488 Rel = ($<=) 1489 ; 1490 Rel = ($>=) 1491 ) 1492 ; 1493 TermOut = Term, 1494 Rel = ($=) 1495 ) 1496 ) 1497 ). 1498 1499process_aux(H) :- 1500 get_lin_attr(H, Attr), 1501 Attr = lin with [rhs:Rhs], 1502 process_aux1(Rhs,H=Rhs). 1503 1504process_aux1([],_) :- !. 1505process_aux1([H|T],Eqn) :- 1506 H = mono(_C,V), 1507% writeln(mono(C,V)), 1508 (number(V) -> 1509 true 1510 ; 1511 get_lin_attr(V,Attr), 1512 Attr = lin with [constr:_Constr], 1513% process_aux_link(Constr,Eqn), 1514 true 1515 ), 1516 process_aux1(T,Eqn). 1517 1518process_aux_link([],_) :- !. 1519process_aux_link([H|T],Eqn) :- 1520 (positive(H) -> 1521 get_lin_attr(H,Attr), 1522 Attr = lin with [rhs:_Rhs] 1523/* 1524 (var(Rhs) -> 1525 true 1526 ; 1527 writeln((rhs=(H=Rhs),eqn=Eqn)) 1528 ) 1529*/ 1530 ; 1531 process_aux_link(T,Eqn) 1532 ). 1533 1534print_disequality(D) :- 1535 D = [mono(X,Y)|Rest], 1536 (number(Y) -> 1537 Rest = [mono(X1,Y1)|_] 1538 ; 1539 X = X1, 1540 Y = Y1 1541 ), 1542 X2 is -1 * X1, 1543 divide_remove(X2,Y1,D,R), 1544 output(R, Term), 1545 ( object_variable(Y1) -> 1546 object2user([Y1, Term], [Y1u, Termu]), 1547 printf(toplevel_output, "%VQPw $<> %VQPw\n", [Y1u,Termu]) 1548 ; 1549 true 1550 ). 1551 1552output_diseqs([]) :- !. 1553output_diseqs([H|T]) :- 1554 print_disequality(H), 1555 output_diseqs(T). 1556 1557%%%%%%%%% Isolate the handler variables from the user instanciations 1558 1559:- meta_attribute(cutoff, [unify:cutoff_handler/2]). 1560 1561:- import add_attribute/3 from sepia_kernel. 1562 1563%%%%%%%%% The two types of variables %%%%%%%%%%%%%%%%%%%%%%%%% 1564user_variable(_{cutoff:user(_Object)}) ?- true. 1565 1566object_variable(_{cutoff:object(_User)}) ?- true. 1567 1568 1569get_object_variable(_{cutoff:user(Vo)}, Vo1) ?- 1570 Vo = Vo1. 1571 1572get_user_variable(_{cutoff:object(V)}, V1) ?- 1573 V = V1. 1574 1575create_object_variable(V, Vo) :- 1576 add_attribute(V, user(Vo), cutoff), 1577 add_attribute(Vo, object(V), cutoff). 1578 1579 1580r_notify_constrained(_{cutoff:object(User)}) ?- 1581 !, 1582 notify_constrained(User). 1583r_notify_constrained(_). %%% Not a object variable 1584 1585%%%%%%%% Unification %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1586cutoff_handler(Term, user(ObjectV)) ?- 1587 !, 1588 user2object(Term, TermO), 1589 $$=(ObjectV, TermO). 1590cutoff_handler(Value, object(UserV)) ?- 1591 !, 1592 ( object2user(Value, ValueU) 1593 -> 1594 UserV = ValueU 1595 ; 1596 var(Value) -> 1597 add_attribute(Value, object(UserV), cutoff) 1598 ; 1599 printf(stderr, "Can't return a nonground object (%p) value to the user level\n", [Value]), 1600 abort 1601 ). 1602%cutoff_handler(_, _NotSet). 1603% If its not set we can't just ignore it. PVars may not be wrapped so 1604% make a test for it and then 1605cutoff_handler(Term, Obj) :- 1606 is_pvar(Obj), 1607 !, 1608 $$=(Term,Obj). 1609 1610cutoff_handler(_, _NotSet). 1611 1612 1613%%%%%%%% Translations from one level to the other %%%%%%%%%%%%% 1614 1615user2object(V, Vo) :- 1616 user_variable(V), 1617 !, 1618 get_object_variable(V, Vo). 1619user2object(V, Vo) :- 1620 var(V), !, % Other variables 1621 create_object_variable(V, Vo). 1622user2object(Term, Term1) :- 1623 Term =.. [Name | Args], 1624 l_user2object(Args, Args1), 1625 Term1 =.. [Name | Args1]. 1626 1627l_user2object([], []). 1628l_user2object([Arg | Args], [Arg1 | Args1]) :- 1629 user2object(Arg, Arg1), 1630 l_user2object(Args, Args1). 1631 1632 1633object2user(V, Vo) :- 1634 object_variable(V), 1635 !, 1636 get_user_variable(V, Vo). 1637object2user(V, Vo) :- 1638 var(V), !, 1639 Vo = V. 1640object2user(V, _Vo) :- 1641 var(V), !, % Other variables 1642 linerr("Can't return non object variables"). 1643object2user(R, N) :- 1644 rational(R), 1645 One is denominator(R), %%% Bug ECLiPSe 1646 One = 1, 1647 !, 1648 N is numerator(R). 1649object2user(Term, Term1) :- 1650 Term =.. [Name | Args], 1651 l_object2user(Args, Args1), 1652 Term1 =.. [Name | Args1]. 1653 1654l_object2user([], []). 1655l_object2user([Arg | Args], [Arg1 | Args1]) :- 1656 object2user(Arg, Arg1), 1657 l_object2user(Args, Args1). 1658 1659 1660%%%%%%%% Redefinition of the primitives %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1661 1662X $= Y :- 1663 user2object(X, Xp), 1664 user2object(Y, Yp), 1665 $$=(Xp, Yp). 1666 1667X $<> Y :- 1668 user2object(X, Xp), 1669 user2object(Y, Yp), 1670 $$<>(Xp, Yp). 1671 1672X $>= Y :- 1673 user2object(X, Xp), 1674 user2object(Y, Yp), 1675 $$>=(Xp, Yp). 1676 1677X $<= Y :- 1678 user2object(X, Xp), 1679 user2object(Y, Yp), 1680 $$<=(Xp, Yp). 1681 1682X $=< Y :- 1683 user2object(X, Xp), 1684 user2object(Y, Yp), 1685 $$=<(Xp, Yp). 1686 1687X $> Y :- 1688 user2object(X, Xp), 1689 user2object(Y, Yp), 1690 $$>(Xp, Yp). 1691 1692X $< Y :- 1693 user2object(X, Xp), 1694 user2object(Y, Yp), 1695 $$<(Xp, Yp). 1696 1697rmin(Y) :- 1698 user2object(Y, Yp), 1699 rrmin(Yp). 1700 1701rmax(Y) :- 1702 user2object(Y, Yp), 1703 rrmax(Yp). 1704 1705variable_name(X,Y) :- 1706 user2object(X,X1), 1707 variable_name_aux(X1,Y). 1708 1709variable_name_aux(_{lin with [user:User]}, User1) ?- 1710 User1 = User. 1711 1712is_slack_variable(X) :- 1713 is_pvar(X). 1714 1715get_constraint_store(StoreOut) :- 1716 getval(global_list, Store), 1717 ( Store == [] -> 1718 StoreOut = [], 1719 true 1720 ; 1721 Store == 0 -> 1722 StoreOut = [], 1723 true % At loadtime there's no initialization 1724 ; 1725 ( nonground(Store) -> 1726 get_constraint_store(Store,StoreOut) 1727 ; 1728 StoreOut = [], 1729 true 1730 ) 1731 ). 1732 1733get_constraint_store([],[]). 1734get_constraint_store([H|T],[H1|T1]) :- 1735 ( get_lin_attr(H, Attr) -> 1736 Attr = lin with [rhs:Rhs], 1737 (var(Rhs) -> 1738 true 1739 ; 1740 output(Rhs, Term), 1741 object2user([H, Term],[HO, TermO]), 1742 H1= $=(HO, TermO) 1743 ) 1744 ; 1745 true 1746 ), 1747 get_constraint_store(T,T1). 1748 1749 1750%%%%%%%%%%%%%%% Normalization %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1751 1752/* 1753t ::= constant | variable | 1754 t + t | 1755 t - t | 1756 -t | 1757 constant * t | 1758 t * constant | 1759 t \ c 1760 1761Output: List of mono(coeff,variable) pairs 1762*/ 1763 1764linnorm(V,List) :- 1765 var(V), 1766 !, 1767 List = [mono(1, V)]. 1768linnorm(C,List) :- 1769 number(C), 1770 !, 1771 List = [mono(C, 1)]. 1772linnorm(C0,List) :- 1773 constant(C0,C), 1774 !, 1775 List = [mono(C, 1)]. 1776linnorm(T1 + T2,List) :- 1777 !, 1778 linnorm(T1,FlatT1), 1779 linnorm(T2,FlatT2), 1780 append(FlatT1,FlatT2,List). 1781linnorm(T1 - T2,List) :- 1782 !, 1783 linnorm(T1,FlatT1), 1784 distribute(-1,T2,NT2), 1785 linnorm(NT2,FlatT2), 1786 append(FlatT1,FlatT2,List). 1787linnorm(-T,List) :- 1788 !, 1789 distribute(-1,T,TDist), 1790 linnorm(TDist,List). 1791linnorm(C0*T0,List) :- 1792 constant(C0,C), 1793 constant(T0,T), 1794 !, 1795 Con is C * T, 1796 List = [mono(Con, 1)]. 1797linnorm(C0*T,List) :- 1798 constant(C0,C), 1799 var(T), 1800 !, 1801 List = [mono(C, T)]. 1802linnorm(C0*T,List) :- 1803 constant(C0,C), 1804 !, 1805 distribute(C,T,TDist), 1806 linnorm(TDist,List). 1807linnorm(T*C0,List) :- 1808 constant(C0,C), 1809 !, 1810 linnorm(C*T,List). 1811linnorm(T/C0,List) :- 1812 constant(C0,C), 1813 !, 1814 C1 is 1 / C, 1815 linnorm(C1*T,List). 1816 1817 1818% Evaluates constant expressions, 1819% makes error for invalid expressions, 1820% fails for nonground expressions (used for delay) 1821constant(C,_) :- 1822 var(C), !, fail. 1823constant(C,C3) :- 1824 number(C), !, C3 = C. 1825constant(-C1,C3) :- !, 1826 constant(C1,C11), 1827 C3 is -C11. 1828constant(C1/C2,C3) :- !, 1829 constant(C1,C11), 1830 constant(C2,C21), 1831 C3 is C11/C21. 1832constant(C1*C2,C3) :- !, 1833 constant(C1,C11), 1834 constant(C2,C21), 1835 C3 is C11*C21. 1836constant(C1+C2,C3) :- !, 1837 constant(C1,C11), 1838 constant(C2,C21), 1839 C3 is C11+C21. 1840constant(C1-C2,C3) :- !, 1841 constant(C1,C11), 1842 constant(C2,C21), 1843 C3 is C11-C21. 1844constant(_,_) :- 1845 linerr("Non-arithmetic functor encountered in rational constraint."). 1846 1847 1848% 1849% Distribute constant C all over CTerm 1850% 1851 1852distribute(C,CTerm,T) :- 1853 var(CTerm), 1854 !, 1855 T = C * CTerm. 1856distribute(C,CTerm,T) :- 1857 number(CTerm), 1858 !, 1859 T is C * CTerm. 1860distribute(C,CTerm0,T) :- 1861 constant(CTerm0,CTerm), 1862 !, 1863 T is C * CTerm. 1864distribute(C,-CTerm,T) :- 1865 !, 1866 NegC is -C, 1867 distribute(NegC,CTerm,T). 1868distribute(C,T1 + T2,T) :- 1869 !, 1870 distribute(C,T1,NT1), 1871 distribute(C,T2,NT2), 1872 T = NT1 + NT2. 1873distribute(C,T1 - T2,T) :- 1874 !, 1875 distribute(C,T1,NT1), 1876 distribute(C,T2,NT2), 1877 T = NT1 - NT2. 1878distribute(C,T1 * T2,T) :- 1879 !, 1880 distribute(C,T1,NT1), 1881 T = NT1 * T2. 1882distribute(C,T1 / T2,T) :- 1883 !, 1884 distribute(C,T1,NT1), 1885 T = NT1 / T2. 1886/* 1887Removed for compiler optimization 1888distribute(_,_,_) :- 1889 writeln("Error in LINnorm / distribute"), 1890 abort. 1891*/ 1892 1893%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1894% 1895% This code is for internal integrity checking. 1896% DO NOT REMOVE. 1897% 1898%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 1899 1900check_integrity(_, [], _, _) :- 1901 !, 1902 linerr("Index integrity check violation"). 1903check_integrity(Var, [Mono|T], Out, Coeff) :- 1904 Mono = mono(C,V), 1905 ( V == Var -> 1906 Coeff = C, 1907 Out = T 1908 ; 1909 Out = [Mono|Out1], 1910 check_integrity(Var, T, Out1, Coeff) 1911 ). 1912 1913check_index_global_list :- 1914 getval(global_list, Store), 1915 ( Store == [] -> 1916 nl, 1917 true 1918 ; 1919 Store == 0 -> 1920 nl, 1921 true % At loadtime there's no initialization 1922 ; 1923 ( nonground(Store) -> 1924 writeln(toplevel_output, "\n\nBeginning index integrity check\n "), 1925 writeln(store(Store)), 1926 check_index_global_list1(Store) 1927 ; 1928 true 1929 ) 1930 ). 1931 1932check_index_global_list1([]) :- !. 1933check_index_global_list1([H|T]) :- 1934 lin_rhs(H,Rhs), 1935 check_index_global_list(Rhs), 1936 check_index_global_list1(T). 1937 1938check_index_global_list([]). 1939check_index_global_list([mono(_,H)|T]) :- 1940 ( get_lin_attr(H, Attr) -> 1941 Attr = lin with [rhs:Rhs], 1942 (var(Rhs) -> 1943 true 1944 ; 1945 lin_rhs(H, Rhs), 1946 write("Checking: "), 1947 write(H = Rhs), 1948 nl, 1949 check_integrity(H, Rhs, _VrhsRest, _Coeff) 1950 ) 1951 ; 1952 true 1953 ), 1954 check_index_global_list(T). 1955 1956index_integrity_check(Mesg) :- 1957 writeln(Mesg), 1958 not(not(check_index_global_list)). 1959 1960well_formed_rhs(X) :- 1961 (well_formed_rhs1(X) -> 1962 true 1963 ; 1964 writeln("bad rhs"-X), 1965 abort 1966 ). 1967 1968well_formed_rhs1(X) :- 1969 nonvar(X), 1970 X == [], 1971 !. 1972well_formed_rhs1(X) :- 1973 nonvar(X), 1974 X = [H|T], 1975 H = mono(C,_V), 1976 nonvar(C), 1977 well_formed_rhs1(T). 1978 1979test_rhs([_H|_T]) :- !. 1980test_rhs([H]) :- 1981 (nonvar(H), H = [A|B], var(A), var(B) -> 1982 writeln("Bogus rhs found") 1983 ; 1984 true 1985 ). 1986 1987obj_pick_pivot([], V, V). 1988obj_pick_pivot([mono(C,V)|T], Vin, Vout) :- 1989 ( only_pos_coeff(V) -> 1990 Vout = unbounded(C,V) 1991 ; Vin = none -> 1992 obj_pick_pivot(T, pivot(C,V), Vout) 1993% Test is reversed here because we used the previously 1994% split list without the pre multiplication 1995 ; Vin = pivot(Cmax,_), C > Cmax -> 1996 obj_pick_pivot(T, pivot(C,V), Vout) 1997 ; Vin = pivot(Cmax,_), C =:= Cmax -> 1998 % need cycle breaking code here 1999 % writeln(error, "possible cycle detected in pick_pivot/3"), 2000 obj_pick_pivot(T, Vin, Vout) 2001 ; 2002 obj_pick_pivot(T, Vin, Vout) 2003 ). 2004 2005mytest :- true. 2006 2007obj_pivot(pivot(_,Vpivot)) :- 2008 lin_constr(Vpivot, Constr), 2009 getval(global_list, Store), 2010 obj_choose_leaving(Constr, Vpivot, leave(none,_,_), Leave), 2011 mywriteln('*****chosen_leaving'(Leave)), 2012 Leave = leave(_,Coeff,Vleave), 2013 lin_rhs(Vleave, RhsL), 2014 insert_var_mono(RhsL, mono('MONE',Vleave), RhsPiv00), 2015 sort(2, >=, RhsPiv00, RhsPiv0), 2016% not in sorted order anymore !!! 2017 Coeff1 is -Coeff, 2018 divide_remove(Coeff1, Vpivot, RhsPiv0, RhsPiv), 2019 delete_rhs(Vleave), 2020 add_rhs(Vpivot, RhsPiv), 2021 mywriteln("&&&RHSPIV" = RhsPiv), 2022% lin_constr(Vpivot, ConstrPiv), 2023 substitute_single_var(Vpivot, RhsPiv, Store). 2024 2025:- mode obj_choose_leaving(+,?,+,-). 2026obj_choose_leaving([], _Vpivot, Max, Max) :- 2027 Max = leave(MaxC,_,_), % debugging 2028 !, 2029 ( MaxC = 'ONE' -> 2030 linerr("no leave var found in choose_leaving") 2031 ; 2032 true 2033 ). 2034obj_choose_leaving([V|T], Vpivot, Max0, Max) :- 2035 ( var(V) -> 2036 lin_rhs(V, Rhs), 2037 mywriteln(choose_leaving(V,Rhs)), 2038 get_constant(Rhs, Con, Rhs1), 2039 get_var_coeff(Rhs1, Vpivot, Coeff), 2040 ( Coeff < 'ZERO' -> 2041 Quot is Con/(-Coeff), 2042 FQuot is Quot * 1.0, 2043 mywriteln(quot = FQuot), 2044 Max0 = leave(MaxC,_,_), 2045 ( MaxC = none -> 2046 Max1 = leave(Quot,Coeff,V) 2047 ; Quot < MaxC -> 2048 Max1 = leave(Quot,Coeff,V) 2049 ; Quot > MaxC -> 2050 Max1 = Max0 2051 ; 2052 Max0 = leave(_,_,Max0V), 2053 lin_rhs(Max0V,Max0Rhs0), 2054 insert_var_mono(Max0Rhs0, 2055 mono('MONE',Max0V), Max0Rhs), 2056 sort(2, >=, Max0Rhs, Max0Rhs1), 2057 insert_var_mono(Rhs, 2058 mono('MONE',V), Rhs2), 2059 sort(2, >=, Rhs2, Rhs3), 2060 break_tie(V,Rhs3,Max0V,Max0Rhs1,Result,ResultRhs), 2061 get_var_coeff(ResultRhs,Vpivot,VCoeff), 2062 % DEBUGGING 2063 % writeln(break_coeff(VCoeff)), 2064 Max1 = leave(Quot,VCoeff,Result) 2065 ) 2066 ; 2067 Max1 = Max0 2068 ) 2069 ; 2070 Max1 = Max0 2071 ), 2072 obj_choose_leaving(T, Vpivot, Max1, Max). 2073 2074 2075mywriteln(_). 2076 2077 2078 2079:- comment(categories, ["Constraints"]). 2080:- comment(summary, "Linear constraints over rational numbers (unsupported)"). 2081:- comment(author, "Pierre Lim, ECRC"). 2082:- comment(date, "1993"). 2083 2084:- comment(/($=, 2), [ 2085 summary:"Holds iff the rational T1 is equal to the rational term T2. 2086 2087", 2088 template:"?T1 $= ?T2", 2089 desc:html(" The rational constraint solver checks to see if the equality can be 2090 added to the constraint store. A modified Gaussian algorithm is used to 2091 perform the test. 2092 2093<P> 2094"), 2095 args:["?X" : "A rational term.", "?Y" : "A rational term."], 2096 resat:" No.", 2097 fail_if:" Fails if adding the constraint T1 $= T2 to the constraint store produces\n an infeasible set of constraints.\n\n", 2098 eg:" 2099Success: 21002*X + Y $= 16, X + 2*Y $= 17, Y = 6. gives X=5. 2101 2102Fail: 21034 $= 8/5. 2104 2105 2106", 2107 see_also:[]]). 2108 2109:- comment(/($>, 2), [ 2110 summary:"Holds iff the the rational term T1 is strictly greater than the rational 2111term T2. 2112 2113", 2114 template:"?T1 $> ?T2", 2115 desc:html(" The rational constraint solver tests the conjunction of the strict 2116 inequality with the constraint store for feasibility. 2117 2118<P> 2119"), 2120 args:["?T1" : "A rational term.", "?T2" : "A rational term."], 2121 resat:" No.", 2122 fail_if:" None.\n\n", 2123 eg:" 2124Success: 21253/4 $> 1/2. 2126 2127Fail: 21282/3 $> 8. 2129 2130 2131", 2132 see_also:[]]). 2133 2134:- comment(/($>=, 2), [ 2135 summary:"Holds iff the the rational term T1 is greater than or equal to the rational 2136term T2. 2137 2138", 2139 template:"?T1 $>= ?T2", 2140 desc:html(" Determines whether the inequality together with the constraint store 2141 forms a feasible system. A modified Simplex algorithm is used to make 2142 the test. 2143 2144<P> 2145"), 2146 args:["?T1" : "A rational term.", "?T2" : "A rational term."], 2147 resat:" No.", 2148 fail_if:" None.\n\n", 2149 eg:" 2150Success: 2151X + Y $>= 3. 2152 2153Fail: 215412/7 $>= 13/5. 2155 2156 2157", 2158 see_also:[]]). 2159 2160:- comment(/($<>, 2), [ 2161 summary:"Holds iff the the rational term T1 is different from the rational term T2. 2162 2163", 2164 template:"?T1 $<> ?T2", 2165 desc:html(" The rational constraint solver checks if the rational term T1 is 2166 different from the rational term T2. 2167 2168<P> 2169"), 2170 args:["?T1" : "A rational term.", "?T2" : "A rational term."], 2171 resat:" No.", 2172 fail_if:" Fails if the rational term (T1 - T2) becomes ground, taking a value of\n zero.\n\n", 2173 eg:" 2174Success: 2175 15/7 $<> 23/4. 2176 2177Fail: 2178 4 $<> 8/2. 2179 2180 2181", 2182 see_also:[]]). 2183 2184:- comment(/($<, 2), [ 2185 summary:"Holds iff the the rational term T1 is strictly less than the rational term 2186T2. 2187 2188", 2189 template:"?T1 $< ?T2", 2190 desc:html(" The rational constraint solver tests the conjunction of the strict 2191 inequality with the constraint store for feasibility. 2192 2193<P> 2194"), 2195 args:["?T1" : "A rational term.", "?T2" : "A rational term."], 2196 resat:" No.", 2197 fail_if:" None.\n\n", 2198 eg:" 2199Success: 22005/17 $< 32/4. 2201 2202Fail: 22033/5 $< 2/5. 2204 2205 2206", 2207 see_also:[]]). 2208 2209:- comment(/($<=, 2), [ 2210 summary:"Holds iff the the rational term T1 is less than or equal to the rational 2211term T2. 2212 2213", 2214 template:"?T1 $<= ?T2", 2215 desc:html(" Determines whether the inequality together with the constraint store 2216 forms a feasible system. A modified Simplex algorithm is used to make 2217 the test. 2218 2219<P> 2220"), 2221 args:["?T1" : "A rational term.", "?T2" : "A rational term."], 2222 resat:" No.", 2223 fail_if:" None.\n\n", 2224 eg:" 2225Success: 222615/7 $=< 23/4. 2227 2228Fail: 22294/3 $=< 8/3. 2230 2231 2232", 2233 see_also:[]]). 2234 2235:- comment(/(rmax, 1), [ 2236 summary:"The objective function Func is maximized with respect to a set of 2237constraints in normal form. 2238 2239", 2240 template:"rmax(?Func)", 2241 desc:html(" This is one of two optimization predicates provided by the ECLiPSe 2242 compiler, the other being rmin/1. 2243 2244<P> 2245 rmax/1 amounts to finding a feasible solution where the objective 2246 function Func is maximal with respect to the constraints store. 2247 2248<P> 2249"), 2250 args:["?Func" : "A rational term."], 2251 resat:"", 2252 fail_if:" None\n\n", 2253 eg:" 2254Success: 2255X $=< 3, 2 * X $= Y, rmax(X + Y). 2256Succeeds if X = 3 and Y = 6. 2257 2258Fail: 2259X $=< 3, rmax(X+Y), X $= 2 * Y. 2260Here rmax/1 fails because insufficient information 2261is available to find a solution when it is called. 2262 2263 2264 2265", 2266 see_also:[/(rmin, 1)]]). 2267 2268:- comment(/(rmin, 1), [ 2269 summary:"The objective function Func is minimized with respect to a set of 2270constraints in normal form. 2271 2272", 2273 template:"rmin(?Func)", 2274 desc:html(" This is one of two optimization predicates provided by the ECLiPSe 2275 compiler, the other being rmax/1. 2276 2277<P> 2278 rmin/1 amounts to finding a feasible solution where the objective 2279 function Func is minimal with respect to the constraints store. 2280 2281<P> 2282"), 2283 args:["?Func" : "A rational term."], 2284 resat:"", 2285 fail_if:" None.\n\n", 2286 eg:" 2287Success: 2288X $>= 3, rmin(X). 2289The minimum value of X that satisfies the constraint is 3. 2290 2291 2292 2293", 2294 see_also:[/(rmax, 1)]]). 2295