1/* 2 clp.pl 3 4 @author Francois Fages 5 @version 1.1.5 6 7 @email Francois.Fages@inria.fr 8 @license LGPL-2 9 10 Frontend to library(clpr) and library(clpfd) to allow shorthand functional notations in clpr and clpfd constraints on arrays and lists 11 12*/ 13 14:- module(clp, [ 15 % CLPFD CONSTRAINTS GENERALIZED TO HYBRID CLPFD CLPR CONSTRAINTS 16 sum/3, 17 scalar_product/4, 18 19 % NEW HYBRID CLPFD CLPR CONSTRAINTS 20 op_rel/5, 21 rel/3, 22 truth_value/2, 23 clpr_entailed/1, 24 25 % NEW CLPR CONSTRAINTS 26 float_sum/3, 27 float_product/3, 28 29 % NEW CLPFD CONSTRAINTS 30 int_sum/3, 31 int_product/3, 32 int_minimum/3, 33 int_minimum/2, 34 int_maximum/3, 35 int_maximum/2, 36 37 lex_leq/2, 38 lex_lt/2, 39 40 41 % CLPFD CONSTRAINTS GENERALIZED TO ARRAYS 42 in/2, 43 ins/2, 44 (#>)/2, 45 (#<)/2, 46 (#>=)/2, 47 (#=<)/2, 48 (#=)/2, 49 (#\=)/2, 50 (#\)/1, 51 (#<==>)/2, 52 (#==>)/2, 53 (#<==)/2, 54 (#\/)/2, 55 (#\)/2, 56 (#/\)/2, 57 58 all_different/1, 59 all_distinct/1, 60 tuples_in/2, 61 labeling/2, 62 label/1, 63 lex_chain/1, 64 serialized/2, 65 global_cardinality/2, 66 global_cardinality/3, 67 circuit/1, 68 cumulative/1, 69 cumulative/2, 70 disjoint2/1, 71 element/3, 72 automaton/3, 73 transpose/2, 74 chain/2, 75 76 %op(450, xfx, ..), % in clpfd: "should bind more tightly than \/ of priority 500" 77 op(501, xfx, ..), % but here less tightly than arithmetic expressions now allowed in domains where * has priority 500 78 op(502, yfx, \/), % consequently changed from 500 to 502 WITH ONE RISK FOR BITWISE OR expressions !!! 79 80 op(760, yfx, #<==>), 81 op(750, xfy, #==>), 82 op(750, yfx, #<==), 83 op(740, yfx, #\/), 84 op(730, yfx, #\), 85 op(720, yfx, #/\), 86 op(710, fy, #\), 87 op(700, xfx, #>), 88 op(700, xfx, #<), 89 op(700, xfx, #>=), 90 op(700, xfx, #=<), 91 op(700, xfx, #=), 92 op(700, xfx, #\=), 93 op(700, xfx, in), 94 op(700, xfx, ins), 95 96 97 % CLPR 98 99 float_sum/3, 100 float_product/3, 101 102 '{=}'/2, 103 '{>=}'/2, 104 '{>}'/2, 105 '{<}'/2, 106 '{=<}'/2, 107 '{=\\=}'/2, 108 109 {}/1, 110 entailed/1, 111 maximize/1, 112 minimize/1, 113 inf/2, 114 sup/2, 115 bb_inf/3, 116 bb_inf/5, 117 118 119 % ARRAYS 120 op(100, yf, []) % for array cell functional notation Array[Indices] 121 ]).
241 % PATCH TO CLPFD LIBRARY FOR SHORTHAND FUNCTIONAL NOTATIONS, CONSTRAINTS ON ARRAYS AND EXTRA CONSTRAINTS 242 243 244% Just for pldoc 245:- op(501, xfx, ..). 246:- op(502, yfx, \/). 247:- op(700, xfx, in). 248:- op(700, xfx, ins). 249 250:- reexport(library(arrays)). 251 252:- reexport(library(tracesearch)). 253 254:- nb_setval(labeling_variable_names_reversed, []). 255 256:- nb_setval(fdvar_unification_warnings, false). % to set to true to get a warning when two clpfd variables unify 257 258 259:- use_module(library(clpfd), 260 except([ 261 (#>)/2, 262 (#<)/2, 263 (#>=)/2, 264 (#=<)/2, 265 (#=)/2, 266 (#\=)/2, 267 (#\)/1, 268 (#<==>)/2, 269 (#==>)/2, 270 (#<==)/2, 271 (#\/)/2, 272 (#\)/2, 273 (#/\)/2, 274 in/2, 275 ins/2, 276 all_different/1, 277 all_distinct/1, 278 sum/3, 279 scalar_product/4, 280 tuples_in/2, 281 labeling/2, 282 label/1, 283 lex_chain/1, 284 serialized/2, 285 global_cardinality/2, 286 global_cardinality/3, 287 circuit/1, 288 cumulative/1, 289 cumulative/2, 290 disjoint2/1, 291 element/3, 292 automaton/3, 293 transpose/2, 294 chain/2, 295 op(450, xfx, ..), 296 op(500, xfx, \/) 297 ] 298 )). 299 300:- op(501, xfx, ..). 301:- op(502, yfx, \/). 302 303:- use_module(library(clpr), 304 except([ 305 {}/1, 306 entailed/1, 307 maximize/1, 308 minimize/1, 309 inf/2, 310 sup/2, 311 bb_inf/3, 312 %bb_inf/4, 313 bb_inf/5 314 ] 315 )). 316 317 318 % NEW CLPFD CONSTRAINTS ADDED
325int_sum(VarDomains, Expr, Sum):-
326 aggregate_for(VarDomains, Expr, +, 0, #=, Sum).
333int_product(VarDomains, Expr, Product):-
334 aggregate_for(VarDomains, Expr, *, 1, #=, Product).
341int_minimum(A, Min):-
342 expand(A, Ae),
343 (array(Ae) -> array_list(Ae, List) ; must_be(list, Ae), flatten(Ae, List)),
344 (List=[X0 | Tail]
345 ->
346 aggregate_for([X in Tail], X, min, X0, #=, Min)
347 ;
348 throw(error(minimum_of_empty_set(A)))).
355int_minimum(VarDomains, Expr, Min):-
356 list_of(VarDomains, Expr, List),
357 int_minimum(List, Min).
365int_maximum(VarDomains, Expr, Max):-
366 list_of(VarDomains, Expr, List),
367 int_maximum(List, Max).
374int_maximum(A, Max):-
375 expand(A, Ae),
376 (array(Ae) -> array_list(Ae, List) ; must_be(list, Ae), flatten(Ae, List)),
377 (List=[X0 | Tail]
378 ->
379 aggregate_for([X in Tail], X, max, X0, #=, Max)
380 ;
381 throw(error(maximum_of_empty_set(A)))).
388lex_leq(A, B):- 389 expand(A, Ae), 390 expand(B, Be), 391 (is_list(Ae) -> Alist=Ae ; array_list(Ae, Alist)), 392 (is_list(Be) -> Blist=Be ; array_list(Be, Blist)), 393 lex_leq_list(Alist, Blist). 394 395 396lex_leq_list([], _). 397lex_leq_list([X|L], [Y|M]) :- 398 X#=<Y, 399 freeze(X, freeze(Y, (X==Y -> lex_leq_list(L, M) ; true))).
406lex_lt(A, B):- 407 expand(A, Ae), 408 expand(B, Be), 409 (is_list(Ae) -> Alist=Ae ; array_list(Ae, Alist)), 410 (is_list(Be) -> Blist=Be ; array_list(Be, Blist)), 411 lex_lt_list(Alist, Blist). 412 413 414lex_lt_list([], [_ | _]). 415lex_lt_list([X|L], [Y|M]) :- 416 X#=<Y, 417 freeze(X, freeze(Y, (X==Y -> lex_lt_list(L, M) ; true))). 418 419 420 421 % CLPFD DOMAINS WITH EVALUABLE EXPRESSIONS AND SHORTHAND NOTATIONS 422 423% TODO generalize to hybrid clpr domain constraints ?
430Var in Domain :-
431 evaluate_domain(Domain, Dom),
432 expand(Var, V),
433 clpfd:(V in Dom).
440Vars ins Domain :- 441 expand(Vars,Varse), 442 (array(Varse) -> array_list(Varse, List) ; List=Varse), 443 evaluate_domain(Domain, Dom), 444 clpfd:(List ins Dom). 445 446 447evaluate_domain(Domain, Dom):- 448 expand(Domain, Doma), 449 eval_domain(Doma, Dom). 450 451 452eval_domain(Domain, Dom):- 453 must_be(nonvar, Domain), 454 Domain=Min..Max 455 -> 456 (Min = inf -> Mi = Min ; Mi is Min), 457 (Max = sup -> Ma = Max ; Ma is Max), 458 Dom = Mi..Ma 459 ; 460 Domain = (Domain1 \/ Domain2) 461 -> 462 eval_domain(Domain1, Dom1), 463 eval_domain(Domain2, Dom2), 464 Dom = (Dom1 \/ Dom2) 465 ; 466 is_list(Domain) 467 -> 468 list_to_union(Domain, Dom) 469 ; 470 array(Domain) 471 -> 472 array_list(Domain, List), 473 list_to_union(List, Dom) 474 ; 475 Dom is Domain. 476 477 478list_to_union([Domain], Dom):- 479 !, 480 eval_domain(Domain, Dom). 481 482list_to_union([Domain | Tail], Dom\/Union):- 483 eval_domain(Domain, Dom), 484 list_to_union(Tail, Union). 485 486 487 488 % REIFICATION OF CLPR CLPFD CONSTRAINTS
?- array(A, [3]), truth_value({A[1] < 3.14}, B). A = array(_A, _, _), freeze(B, clp:clpr_reify(_A<3.14, _A>=3.14, B)).
503truth_value(Constraint, Boolean):- 504 expand(Constraint, Ce), 505 expand(Boolean, Be), 506 (compound(Ce), Ce={C} 507 -> 508 clpr_reify(C, Be) 509 ; 510 clpfd:(Be #<==> Ce)). 511 512 513% TODO find strategy for periodic clpr entailment, e.g. as new option of labeling/2 ?
519clpr_entailed(Bool):- 520 (var(Bool) 521 -> 522 frozen(Bool, Goals), 523 clpr_reify_check(Goals) 524 ; 525 true). 526 527 528% clpr_reify(+Constraint, ?Boolean) 529% 530% Reification of clpr Constraint (without curly brackets) by clpfd 0-1 variable Boolean. 531% Freezes the posting of Constraint (resp. its negation) until the Boolean gets instantiated to 1 (resp. 0). 532% In the other direction, there is no frozen entailment check, see clpr_entailed/1. 533 534clpr_reify(Constraint, Boolean):- 535 clpr_not(Constraint, NotConstraint), 536 clpr_reify(Constraint, NotConstraint, Boolean). 537 538clpr_reify(Constraint, NotConstraint, Bool):- 539 (var(Bool) 540 -> 541 (entailed(Constraint) -> Bool=1 ; 542 entailed(NotConstraint) -> Bool=0 ; 543 freeze(Bool, clpr_reify(Constraint, NotConstraint, Bool))) 544 ; 545 (Bool=1 -> {Constraint} ; {NotConstraint})). 546 547 548 549clpr_reify_check(true) :- 550 !. 551 552clpr_reify_check((Goal, Goals)) :- 553 !, 554 (Goal = freeze(_, clp:clpr_reify(Constraint, NotConstraint, Bool)) % Bool same as freeze 555 -> 556 (entailed(Constraint) -> Bool=1 ; 557 entailed(NotConstraint) -> Bool=0; 558 clp_reify_check(Goals)) 559 ; 560 clpr_reify_check(Goals)). 561 562clpr_reify_check(Goal) :- 563 (Goal = freeze(_, clp:clpr_reify(Constraint, NotConstraint, Bool)) 564 -> 565 (entailed(Constraint) -> Bool=1 ; 566 entailed(NotConstraint) -> Bool=0; 567 true) 568 ; 569 true). 570 571 572% negation of clpr constraints 573 574clpr_not(A < B, A >= B). 575clpr_not(A > B, A =< B). 576clpr_not(A =< B, A > B). 577clpr_not(A >= B, A < B). 578clpr_not(A =\= B, A = B). 579clpr_not(A =:= B, A = B). 580clpr_not(A = B, A =\= B). 581clpr_not((C, D), (E; F)):- 582 clpr_not(C, E), 583 clpr_not(D, F). 584clpr_not((C; D), (E, F)):- 585 clpr_not(C, E), 586 clpr_not(D, F). 587 588 589 % SHORTHANDS FOR ALLOWING CONSTRAINTS IN EXPRESSIONS 590 % WHEN THE LAST ARGUMENT CAN BE INTERPRETED AS A RESULT 591 592 593 594:- multifile user:shorthand/3.
X[I] #= int_sum(J in 1..N, truth_value(X[J] #= I-1)).
607usershorthand(fd_dom(Var), Domain, clp:fd_dom(Var, Domain)) :- !. 608 609usershorthand(fd_inf(Var), Min, clp:fd_inf(Var, Min)) :- !. 610 611usershorthand(fd_sup(Var), Max, clp:fd_sup(Var, Max)) :- !. 612 613usershorthand(truth_value(Constraint), Boolean, clp:truth_value(Constraint, Boolean)) :- !. 614 615usershorthand(int_sum(VarDomains, Expr), Result, clp:int_sum(VarDomains, Expr, Result)) :- !. 616 617usershorthand(int_product(VarDomains, Expr), Product, clp:int_product(VarDomains, Expr, Product)) :- !. 618 619usershorthand(int_minimum(VarDomains, Expr), Min, clp:int_minimum(VarDomains, Expr, Min)) :- !. 620 621usershorthand(float_sum(VarDomains, Expr), Result, clp:float_sum(VarDomains, Expr, Result)) :- !. 622 623usershorthand(float_product(VarDomains, Expr), Product, clp:float_product(VarDomains, Expr, Product)) :- !. 624 625usershorthand(int_minimum(A), Min, clp:int_minimum(A, Min)) :- !. 626 627usershorthand(int_maximum(VarDomains, Expr), Max, clp:int_maximum(VarDomains, Expr, Max)) :- !. 628 629usershorthand(int_maximum(A), Max, clp:int_maximum(A, Max)) :- !. 630 631usershorthand(rel(Arg1, Rel), Arg2, clp:rel(Arg1, Rel, Arg2)) :- !. 632 633usershorthand(op_rel(Arg1, Op, Arg2, Rel), Arg3, clp:op_rel(Arg1, Op, Arg2, Rel, Arg3)) :- !. 634 635usershorthand(op_rel_list(AA, Op, AB, Rel), AC, clp:op_rel_list(AA, Op, AB, Rel, AC)) :- !. 636 637usershorthand(sum(A, Rel), B, clp:sum(A, Rel, B)) :- !. 638 639usershorthand(scalar_product(A, B, Rel), C, clp:scalar_product(A, B, Rel, C)) :- !. 640 641usershorthand(element(A, B), C, clp:element(A, B, C)) :- !. 642 643usershorthand(transpose(A), B, clp:transpose(A, B)) :- !. 644 645 646 647 % FRONTEND TO CLPFD ARITHMETIC CONSTRAINTS
653#\ X :- expand(X, Xe), clpfd:(#\ Xe).
659X #= Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #= Ye).
666X #\= Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #\= Ye).
673X #<==> Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #<==> Ye).
680X #> Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #> Ye).
686X #< Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #< Ye).
692X #>= Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #>= Ye).
698X #=< Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #=< Ye).
705X #==> Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #==> Ye).
711X #<== Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #<== Ye).
717X #\/ Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #\/ Ye).
723X #\ Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #\ Ye).
729X #/\ Y :- expand(X, Xe), expand(Y, Ye), clpfd:(Xe #/\ Ye). 730 731 732 733 % CLPFD GLOBAL CONSTRAINTS ON LISTS GENERALIZED TO ARRAYS 734 735 % FIRST HYBRID CONSTRAINTS GENERALIZED TO BOTH CLPFD CLPR CONSTRAINTS
743rel(Arg1, Rel, Arg2):-
744 op_rel(Arg1, +, 0, Rel, Arg2).
E.g. the Hadamart product of two integer matrices of same dimension can be defined by
op_rel(A, *, B, #=, C)
over integers,
op_rel(A, *, B, '{=}', C)
over real numbers.
756op_rel(Arg1, Op, Arg2, Rel, Arg3):- 757 expand(Arg1, Ae1), 758 expand(Arg2, Ae2), 759 expand(Arg3, Ae3), 760 expand(Operation, Op), 761 expand(Rel, Relation), 762 (array(Ae1) -> array_lists(Ae1, T1) ; var(Ae1), \+ fd_var(Ae1) -> true; T1=Ae1), 763 (array(Ae2) -> array_lists(Ae2, T2) ; var(Ae2), \+ fd_var(Ae2) -> true; T2=Ae2), 764 (array(Ae3) -> array_lists(Ae3, T3) ; var(Ae3), \+ fd_var(Ae3) -> true; T3=Ae3), 765 766 op_rel_list(T1, Operation, T2, Relation, T3), 767 768 ((array(Ae1) ; array(Ae2) ; array(Ae3)) 769 -> 770 (var(Ae1), \+ fd_var(Ae1) -> (is_list(T1) -> array_lists(Ae1, T1) ; Ae1=T1) ; true), 771 (var(Ae2), \+ fd_var(Ae2) -> (is_list(T2) -> array_lists(Ae2, T2) ; Ae2=T2) ; true), 772 (var(Ae3), \+ fd_var(Ae3) -> (is_list(T3) -> array_lists(Ae3, T3) ; Ae3=T3) ; true) 773 ; 774 (var(Ae1), \+ fd_var(Ae1) -> Ae1=T1 ; true), 775 (var(Ae2), \+ fd_var(Ae2) -> Ae2=T2 ; true), 776 (var(Ae3), \+ fd_var(Ae3) -> Ae3=T3 ; true) 777 ). 778 779 780 781op_rel_list(AA, Op, AB, Rel, AC):- 782 ((is_list(AA) ; is_list(AB) ; is_list(AC)) 783 -> 784 (\+ fd_var(AA), AA=[A | As] -> true ; A=AA, As=AA), 785 (\+ fd_var(AB), AB=[B | Bs] -> true ; B=AB, Bs=AB), 786 (\+ fd_var(AC), AC=[C | Cs] -> true ; C=AC, Cs=AC), 787 788 op_rel(A, Op, B, Rel, C), 789 790 ((tail(As) ; tail(Bs); tail(Cs)) 791 -> 792 op_rel_list(As, Op, Bs, Rel, Cs) 793 ; 794 (var(As), As\==A -> As=[] ; true), 795 (var(Bs), Bs\==B -> Bs=[] ; true), 796 (var(Cs), Cs\==C -> Cs=[] ; true) 797 ) 798 ; 799 Arg =.. [Op, AA, AB], 800 call(Rel, Arg, AC) 801 ). 802 803tail(T):- 804 is_list(T), 805 T \= [].
812sum(A, Rel, B) :- 813 expand(A, Ae), 814 expand(B, Be), 815 expand(Rel, Relation), 816 (array(Ae) -> array_list(Ae, L) ; L=Ae), 817 (array(Be) -> array_list(Be, M) ; M=Be), 818 ( 819 clpr_rel(Relation) 820 -> 821 clp:clpr_sum(L, Relation, M) 822 ; 823 clpfd:sum(L, Relation, M)). 824 825 826% clpr_sum(+L, +Rel, ?V) 827% 828% constrains the sum of values in list L to be in clpr relation Rel with V. 829 830clpr_sum(L, Rel, B) :- 831 clpr_sum_list(L, Sum), 832 Goal =.. [Rel, Sum, B], 833 call(Goal). 834 835 836clpr_sum_list([X | List], Sum):- 837 (List=[] 838 -> 839 Sum=X 840 ; 841 {Sum = X+S}, 842 clpr_sum_list(List, S) 843 ).
850scalar_product(A, B, Rel, C) :-
851 expand(A, Ae),
852 expand(B, Be),
853 expand(C, Ce),
854 expand(Rel, Relation),
855 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
856 (array(Be) -> array_list(Be, BL) ; BL=Be),
857 (array(Ce) -> array_list(Ce, CL) ; CL=Ce),
858 (clpr_rel(Relation)
859 ->
860 op_rel(AL, *, BL, '{=}', AB),
861 sum(AB, Relation, CL)
862 ;
863 clpfd:scalar_product(AL, BL, Relation, CL)).
870transpose(A, B) :- 871 expand(A, Ae), 872 expand(B, Be), 873 (array(Ae) -> array_lists(Ae, AL) ; AL=Ae), 874 (array(Be) -> array_lists(Be, BL) ; BL=Be), 875 clpfd:transpose(AL, BL). 876 877 878 879 880 % NON HYBRID CLPFD CONSTRAINTS JUST GENERALIZED TO ARRAYS AND LISTS
887all_different(A):-
888 expand(A, Ae),
889 (array(Ae) -> array_list(Ae, List) ; List=Ae),
890 clpfd:all_different(List).
897all_distinct(A):-
898 expand(A, Ae),
899 (array(Ae) -> array_list(Ae, List) ; List=Ae),
900 clpfd:all_distinct(List).
908lex_chain(A) :-
909 expand(A, Ae),
910 (array(Ae) -> array_lists(Ae, Lists) ; Lists=Ae),
911 clpfd:lex_chain(Lists).
918tuples_in(A, B) :-
919 expand(A, Ae),
920 expand(B, Be),
921 (array(Ae) -> array_lists(Ae, AL) ; AL=Ae),
922 (array(Be) -> array_lists(Be, BL) ; BL=Be),
923 clpfd:tuples_in(AL, BL).
929serialized(A, B) :-
930 expand(A, Ae),
931 expand(B, Be),
932 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
933 (array(Be) -> array_list(Be, BL) ; BL=Be),
934 clpfd:serialized(AL, BL).
940global_cardinality(A, B) :-
941 expand(A, Ae),
942 expand(B, Be),
943 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
944 clpfd:global_cardinality(AL, Be).
950global_cardinality(A, B, C) :-
951 expand(A, Ae),
952 expand(B, Be),
953 expand(C, Ce),
954 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
955 clpfd:global_cardinality(AL, Be, Ce).
961circuit(A) :-
962 expand(A, Ae),
963 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
964 clpfd:circuit(AL).
970cumulative(A) :-
971 expand(A, Ae),
972 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
973 clpfd:cumulative(AL).
979cumulative(A, B) :-
980 expand(A, Ae),
981 expand(B, Be),
982 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
983 clpfd:cumulative(AL, Be).
989disjoint2(A) :-
990 expand(A, Ae),
991 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
992 clpfd:disjoint2(AL).
998element(A, B, C) :-
999 expand(A, Ae),
1000 expand(B, Be),
1001 expand(C, Ce),
1002 (array(Be) -> array_list(Be, BL) ; BL=Be),
1003 clpfd:element(Ae, BL, Ce).
1009automaton(A, B, C) :-
1010 expand(A, Ae),
1011 expand(B, Be),
1012 expand(C, Ce),
1013 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
1014 (array(Be) -> array_list(Be, BL) ; BL=Be),
1015 (array(Ce) -> array_list(Ce, CL) ; CL=Ce),
1016 clpfd:automaton(AL, BL, CL).
1023chain(A, B) :- 1024 expand(A, Ae), 1025 expand(B, Be), 1026 (array(Ae) -> array_list(Ae, AL) ; AL=Ae), 1027 clpfd:chain(AL, Be). 1028 1029 1030 1031 % CLPFD ENUMERATION
1038label(A) :-
1039 expand(A, Ae),
1040 (array(Ae) -> array_list(Ae, AL) ; AL=Ae),
1041 clpfd:label(AL).
trace(VarNames)
to create the search tree of variable instantiations perfomed by labeling,
to visualize it with search_tree_text/0, search_tree_term/1, search_tree_latex/1, search_tree_tikz/1 of library(tracesearch)
.
VarNames can be a list of same length as Vars, or an atom like 'Q' in which case the variables will be named Q1,...,QN.
?- queens(4, Queens), search_tree_text. labeling([Q1,Q2,Q3,Q4]) Q1=1 Q2=3 Q2$\neq$3 Q1$\neq$1 Q1=2 [2,4,1,3] Queens = array(2, 4, 1, 3) ; labeling([Q1,Q2,Q3,Q4]) Q1=1 Q2=3 Q2$\neq$3 Q1$\neq$1 Q1=2 [2,4,1,3] Q1$\neq$2 Q1=3 [3,1,4,2] Queens = array(3, 1, 4, 2) ; false.
1075labeling(Options, A) :- 1076 expand(A, Ae), 1077 expand(Options, Oe), % just in case ! 1078 (array(Ae) -> array_list(Ae, Vars) ; Vars=Ae), 1079 option_trace(Oe, O, Vars), 1080 clpfd:labeling(O, Vars), 1081 add_node(Vars). % success node 1082 1083 1084option_trace(Options, Opt, Vars) :- 1085 (member(trace(Arg), Options) 1086 -> 1087 delete(Options, trace(_), Opt), 1088 length(Vars, N), 1089 (atom(Arg) 1090 -> 1091 findall(Name, (between(1, N, I), with_output_to(atom(Name), (write(Arg),write(I)))), VarNames) 1092 ; 1093 must_be(list, Arg), 1094 length(Arg, M), 1095 (M=N 1096 -> 1097 VarNames=Arg 1098 ; 1099 throw(error(labeling_trace_option(Arg, Vars))))), 1100 reverse(VarNames, Rev), 1101 b_setval(labeling_variable_names_reversed, Rev), 1102 start_tracing, 1103 add_node(labeling(VarNames)) 1104 ; 1105 (member(trace, Options) 1106 -> 1107 delete(Options, trace, Opt), 1108 b_setval(labeling_variable_names_reversed, []), 1109 start_tracing, 1110 add_node(labeling(Vars)) 1111 ; 1112 stop_tracing, 1113 Opt=Options)). 1114 1115 % FIRST PATCH TO CLPFD: LABEL/5 in order to interpret new trace(Goal) option 1116 1117 1118:- abolish(clpfd:choice_order_variable/7). 1119 1120clpfdchoice_order_variable(step, Order, Var, Vars, Vars0, Selection, Consistency) :- 1121 clpfd:fd_get(Var, Dom, _), 1122 clpfd:order_dom_next(Order, Dom, Next), 1123 1124 find_varname(Var, Vars, AtomVar), %FF 1125 ( add_node(AtomVar = Next), %FF 1126 Var = Next, 1127 clpfd:label(Vars, Selection, Order, step, Consistency) 1128 ; 1129 with_output_to(atom(Atom), (write(AtomVar),write('$\\neq$'),write(Next))), %FF 1130 add_node(Atom), %FF 1131 clpfd:neq_num(Var, Next), 1132 clpfd:do_queue, 1133 clpfd:label(Vars0, Selection, Order, step, Consistency) 1134 ). 1135 1136clpfdchoice_order_variable(enum, Order, Var, Vars, _Vars0, Selection, Consistency) :- 1137 clpfd:fd_get(Var, Dom0, _), 1138 find_varname(Var, Vars, AtomVar), %FF 1139 add_node(enum(AtomVar)), %FF 1140 clpfd:domain_direction_element(Dom0, Order, Var), 1141 add_node(AtomVar = Var), %FF 1142 clpfd:label(Vars, Selection, Order, enum, Consistency). 1143 1144clpfdchoice_order_variable(bisect, Order, Var, Vars, Vars0, Selection, Consistency) :- 1145 clpfd:fd_get(Var, Dom, _), 1146 clpfd:domain_infimum(Dom, n(I)), 1147 clpfd:domain_supremum(Dom, n(S)), 1148 Mid0 is (I + S) // 2, 1149 ( Mid0 =:= S -> Mid is Mid0 - 1 ; Mid = Mid0 ), 1150 find_varname(Var, Vars, AtomVar), %FF 1151 concat_atom([AtomVar, ' $\\le$ ', Mid], AtomLE), %FF 1152 concat_atom([AtomVar, ' $\\gt$ ', Mid], AtomGT), %FF 1153 ( Order == up -> ( (add_node(AtomLE), Var #=< Mid) ; (add_node(AtomGT), Var #> Mid) ) %FF 1154 ; Order == down -> ( (add_node(AtomGT), Var #> Mid) ; (add_node(AtomLE), Var #=< Mid) ) %FF 1155 ; clpfd:domain_error(bisect_up_or_down, Order) 1156 ), 1157 clpfd:label(Vars0, Selection, Order, bisect, Consistency). 1158 1159 1160 1161 1162% Hack used to find the name of the selected variable to label 1163% in order to minimize the patch to library(clpfd) hence the multiple calls to reverse 1164% TODO avoid reverse by adding one argument to clpfd:label 1165find_varname(Var, Vars, VarName):- 1166 b_getval(labeling_variable_names_reversed, RNames), % reversed original variable names 1167 (RNames=[] 1168 -> 1169 term_to_atom(Var, VarName) 1170 ; 1171 reverse(Vars, RVars), % reversed tail of non selected original variables 1172 find_varname(RVars, Var, RNames, VarName)). % search Var in RVars and return its VarName from RNames 1173 1174find_varname([V | RVars], Var, [N | RNames], VarName) :- 1175 (Var == V 1176 -> 1177 VarName=N 1178 ; 1179 find_varname(RVars, Var, RNames, VarName) 1180 ). 1181find_varname([], _Var, [VarName | _RNames], VarName). % if not found before 1182 1183 1184 1185 1186 1187 % SECOND PATCH TO CLPFD: UNIFICATION HOOK in order to prevent duplication of constraint propagators 1188 1189/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1190 Unification hook and constraint projection 1191- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 1192 1193 The reason for this patch is to eliminate the duplication of constraint propagators when unifying variables 1194 1195Example with library(clpfd): 1196 1197?- L=[A, B], L ins 1..2, A #=< B, bagof(W, member(W, L), L2). 1198L = L2, L2 = [A, B], 1199A in 1..2, 1200B#>=A, 1201B#>=A, 1202B#>=A, 1203B in 1..2. 1204 1205*/ 1206 1207:- abolish(clpfd:attr_unify_hook/2). 1208clpfdattr_unify_hook(clpfd_attr(_,_,_,Dom,Ps), Other) :- 1209%foo(clpfd_attr(_,_,_,Dom,Ps), Other) :- 1210 ( nonvar(Other) -> 1211 ( integer(Other) -> true 1212 ; type_error(integer, Other) 1213 ), 1214 clpfd:domain_contains(Dom, Other), 1215 clpfd:trigger_props(Ps), 1216 clpfd:do_queue 1217 ; 1218 % tracing unification of clpfd variables 1219 ((b_getval(fdvar_unification_warnings, true), 1220 Ps \== fd_props([],[],[]) , get_attr(Other, clpfd, Attr)) 1221 -> 1222 format("Warning: unifying fdvar ~w ~w\n with fdvar domain ~w ~w\n", [Other, Attr, Dom, Ps]) 1223 ; 1224 true), 1225 clpfd:fd_get(Other, OD, OPs), 1226 clpfd:domains_intersection(OD, Dom, Dom1), 1227 % append_propagators(Ps, OPs, Ps1), 1228 % duplicated constraint propagators after unification, should rather simplify propagators with X=Y 1229 union_propagators(Ps, OPs, Ps1), 1230 % for the moment just merge propagators without duplicates, 1231 % constraint simplification would need to know the first variable as in clpz.pl not just its attributes 1232 clpfd:fd_put(Other, Dom1, Ps1), 1233 clpfd:trigger_props(Ps1), 1234 clpfd:do_queue 1235 ). 1236 1237 1238union_propagators(fd_props(Gs0,Bs0,Os0), fd_props(Gs1,Bs1,Os1), fd_props(Gs,Bs,Os)) :- 1239 % sorting the propagators perturbs the queue and can cause severe performance problems 1240 % maplist(append, [Gs0,Bs0,Os0], [Gs1,Bs1,Os1], [Gs2,Bs2,Os2]), 1241 % maplist(sort(1, @<), [Gs2, Bs2, Os2], [Gs, Bs, Os]). 1242 union_props(Gs0, Gs1, Gs), 1243 union_props(Bs0, Bs1, Bs), 1244 union_props(Os0, Os1, Os). 1245 1246 1247union_props([], P, P). 1248union_props([P | Ps0], Ps1, Ps):- 1249 P=propagator(Constraint, Status), 1250 (contains_prop(Ps1, Constraint, Status) 1251 -> 1252 union_props(Ps0, Ps1, Ps) 1253 ; 1254 Ps=[P | Pss], 1255 union_props(Ps0, Ps1, Pss)). 1256 1257% membership check for constraint propagators 1258% 1259% TODO: better than propagator union, add constraint simplification and disentailment check on that event of variable unification 1260% e.g. disentailment of all_different all_distinct circuit disjoint2 automaton? chain 1261% e.g. simplification of sum scalar_product lex_chain serialized global_cardinality cumulative element automaton? transpose? chain 1262 1263contains_prop([P1 | Ps1], Constraint, Status):- 1264 arg(1, P1, Constr), 1265 arg(2, P1, Stat), 1266 % add disentailement check and constraint simplification here 1267 ( 1268 Constr==Constraint, Stat=Status % not sure about status unification 1269 -> 1270 true 1271 ; 1272 contains_prop(Ps1, Constraint, Status)). 1273 1274 1275 1276 % NEW CLPR CONSTRAINTS
1283float_sum(VarDomains, Expr, Sum):-
1284 aggregate_for(VarDomains, Expr, +, 0.0, '{=}', Sum).
1291float_product(VarDomains, Expr, Product):- 1292 aggregate_for(VarDomains, Expr, *, 1.0, '{=}', Product). 1293 1294 1295 1296 % PREDICATE NAMES FOR CLPR CONSTRAINTS 1297 1298clpr_rel(Rel):- 1299 member(Rel, ['{=}', '{>=}', '{>}', '{=<}', '{<}', '{=\\=}']), 1300 !.
1307'{=}'(A, B):-
1308 {A = B}.
1314'{>=}'(A, B):-
1315 {A >= B}.
1321'{=<}'(A, B):-
1322 {A =< B}.
1328'{>}'(A, B):-
1329 {A > B}.
1335'{<}'(A, B):-
1336 {A < B}.
1342'{=\\=}'(A, B):- 1343 {A =\= B}. 1344 1345 1346 1347 % FRONTEND TO CLPR CONSTRAINT ALLOWING SHORTHAND FUNCTIONAL NOTATION
1353{Constraint} :- expand(Constraint, C), clpr:{C}.
1360entailed(Constraint) :- expand(Constraint, C), clpr:entailed(C).
1367maximize(Expression) :- expand(Expression, E), clpr:maximize(E).
1374minimize(Expression) :- expand(Expression, E), clpr:minimize(E).
1381inf(Expression, Inf) :- expand(Expression, E), clpr:inf(E, Inf).
1388sup(Expression, Sup) :- expand(Expression, E), clpr:sup(E, Sup).
1395bb_inf(Ints, Expression, Inf, Vertex, Eps) :- expand(Expression, E), clpr:bb_inf(Ints, E, Inf, Vertex, Eps).
1402%bb_inf(Ints, Expression, Inf, Vertex) :- expand(Expression, E), clpr:bb_inf(Ints, E, Inf, Vertex).
1409bb_inf(Ints, Expression, Inf) :- expand(Expression, E), clpr:bb_inf(Ints, E, Inf). 1410 1411 1412% % dump(+Target, +Newvars, -CodedAnswer) 1413% % 1414% % call to library(clpr) dump/3 predicate. 1415 1416% dump(Target, Newvars, CodedAnswer) :- clpr:dump(Target, Newvars, CodedAnswer). 1417 1418% :- reexport(library(clpfd), 1419% except([ 1420% (#>)/2, 1421% (#<)/2, 1422% (#>=)/2, 1423% (#=<)/2, 1424% (#=)/2, 1425% (#\=)/2, 1426% (#\)/1, 1427% (#<==>)/2, 1428% (#==>)/2, 1429% (#<==)/2, 1430% (#\/)/2, 1431% (#\)/2, 1432% (#/\)/2, 1433% in/2, 1434% ins/2, 1435% all_different/1, 1436% all_distinct/1, 1437% sum/3, 1438% scalar_product/4, 1439% tuples_in/2, 1440% labeling/2, 1441% label/1, 1442% lex_chain/1, 1443% serialized/2, 1444% global_cardinality/2, 1445% global_cardinality/3, 1446% circuit/1, 1447% cumulative/1, 1448% cumulative/2, 1449% disjoint2/1, 1450% element/3, 1451% automaton/3, 1452% transpose/2, 1453% chain/2, 1454% op(450, xfx, ..), 1455% op(500, xfx, \/) 1456% ] 1457% )). 1458 1459% :- op(501, xfx, ..). 1460% :- op(502, yfx, \/). 1461 1462 1463% :- reexport(library(clpr), 1464% except([ 1465% {}/1, 1466% entailed/1, 1467% maximize/1, 1468% minimize/1, 1469% inf/2, 1470% sup/2, 1471% bb_inf/3, 1472% %bb_inf/4, 1473% bb_inf/5 1474% ] 1475% )).
Frontend to library(clpr) and library(clpfd) to allow shorthand functional notations in clpr and clpfd constraints on arrays and lists
This library
library(tracesearch)
.You can set
nb_setval(fdvar_unification_warning, true)
to get warnings when two fd variables are unified (default is false).TODO
: the constraint propagators should rather be simplified when 2 variable unify (as done in SMT solvers). This is a winning strategy on global constraints compared to mere domain consistency checking;e.g. simplification of sum scalar_product lex_chain serialized global_cardinality cumulative element automaton? transpose? chain?
e.g. in all_distinct/1 all_different/1 unify_attribute_hook should rather fail when propagators get duplicated variables
*/