From 77e1d9425bc3e9a455c24c57b01a889d39add7d0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 10 Sep 2013 00:53:54 +0100 Subject: [PATCH] improve clpfd emulation --- library/gecode/clp_examples/photo.yap | 8 ++-- library/gecode/clpfd.yap | 67 ++++++++++++++++++++------- 2 files changed, 55 insertions(+), 20 deletions(-) diff --git a/library/gecode/clp_examples/photo.yap b/library/gecode/clp_examples/photo.yap index dd97c5c68..a383fa799 100644 --- a/library/gecode/clp_examples/photo.yap +++ b/library/gecode/clp_examples/photo.yap @@ -20,7 +20,7 @@ :- use_module(library(maplist)). % 5 people want to have a photograph together, but they have preferences. -photo(Ex, Solution,Amount) :- +photo(Ex, People, Amount) :- db(Ex, People, Preferences), length(People, Len), Len0 is Len-1, @@ -29,10 +29,10 @@ photo(Ex, Solution,Amount) :- % Bools are the satisfied constraints maplist(preferences, Preferences, Bools), length(Preferences, PLen), - Sum in 0..PLen, - Bools #= Sum, + Amount in 0..PLen, + sum( Bools, #= , Amount ), % add all satisfied constraints - maximize(Sum), + maximize(Amount), labeling([], People). %reification, use with care diff --git a/library/gecode/clpfd.yap b/library/gecode/clpfd.yap index 8ee9a603c..6af287880 100644 --- a/library/gecode/clpfd.yap +++ b/library/gecode/clpfd.yap @@ -31,8 +31,9 @@ ins/2, all_different/1, all_distinct/1, - all_distinct/2, /* - sum/3, + all_distinct/2, + maximize/1, + sum/3, /* scalar_product/4, tuples_in/2, */ labeling/2 /*, @@ -127,19 +128,25 @@ process_constraints(B, B, _Env). ( A #>= B) :- get_home(Env), post( (A #> B), Env, _). -( A #<==> Bool) :- +sum( L, Op, V) :- + get_home( Env ), + post( sum(L, Op, V), Env, _). +( A #<==> VBool) :- get_home(Space-Map), Bool := boolvar(Space), + m( VBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_EQV', R), post(A, Space-Map, R). -( A #==> Bool) :- +( A #==> VBool) :- get_home(Space-Map), Bool := boolvar(Space), + m( VBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_IMP', R), post(A, Space-Map, R). -( A #<== Bool) :- +( A #<== VBool) :- get_home(Space-Map), Bool := boolvar(Space), + m( VBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_PMI', R), post(A, Space-Map, R). '#\\'(A) :- @@ -188,8 +195,18 @@ labeling(_Opts, Xs) :- get_home(Space-Map), maplist(ll(Map), Xs, NXs), Space += branch(NXs, 'INT_VAR_SIZE_MIN', 'INT_VAL_MIN'). +maximize(V) :- + get_home(Space-Map), + l(V, I, Map), + Space += maximize(I). - +post( (A #= B), Space-Map, Reify):- + integer(B), + linear(A, 1, [NA], [], [1], [], B, A0, Space-Map), !, + (var(Reify) -> + Space += rel(NA, 'IRT_EQ', A0); + Space += rel(NA, 'IRT_EQ', A0, Reify) + ). post( (A #= B), Space-Map, Reify):- linear(A, 1, As, Bs, CAs, CBs, 0, A0, Space-Map), linear(B, -1, Bs, [], CBs, [], A0, B0, Space-Map), @@ -208,8 +225,8 @@ post( (A #>B), Space-Map, Reify):- linear(A, 1, As, Bs, CAs, CBs, 0, A0, Space-Map), linear(B, -1, Bs, [], CBs, [], A0, B0, Space-Map), (var(Reify) -> - Space += linear(CAs, As, 'IRT_NQ', B0); - Space += linear(CAs, As, 'IRT_NQ', B0, Reify) + Space += linear(CAs, As, 'IRT_GE', B0); + Space += linear(CAs, As, 'IRT_GE', B0, Reify) ). post( (A #>=B), Space-Map, Reify):- linear(A, 1, As, Bs, CAs, CBs, 0, A0, Space-Map), @@ -232,6 +249,13 @@ post( (A #= + Space += linear(IL, GOP, IOut); + Space += linear(IL, GOP, IOut, Reify) + ). post( all_different( Xs ), Space-Map, Reify) :- maplist(ll(Map), Xs, NXs), (var(Reify) -> @@ -254,6 +278,12 @@ post( all_distinct( Cs , Xs ), Space-Map, Reify) :- throw(error(domain(not_reifiable),all_distinct( Cs , Xs ))) ). +gecode_arith_op( (#=) , 'IRT_EQ' ). +gecode_arith_op( (#\=) , 'IRT_NQ' ). +gecode_arith_op( (#>) , 'IRT_GE' ). +gecode_arith_op( (#>=) , 'IRT_GQ' ). +gecode_arith_op( (#<) , 'IRT_LE' ). +gecode_arith_op( (#=<) , 'IRT_LQ' ). linear(V, C, [A|As], As, [C|CAs], CAs, I, I, _-Map) :- var(V), !, @@ -280,9 +310,15 @@ linear(B*C1, C, As, Bs, CAs, CBs, I, IF, Env) :- integer(C1), !, NC is C*C1, linear(B, NC, As, Bs, CAs, CBs, I, IF, Env). -linear(AC, C, [V|Bs], Bs, [C|CBs], CBs, I, I, Env) :- +linear(AC, C, [A|Bs], Bs, [C|CBs], CBs, I, I, Env) :- arith(AC), - equality(AC, V, Env). + equality(AC, V, Env), + Env = _-Map, + l(V, A, Map). + +arith(abs(_)). +arith(_ + _). +arith(_ - _). equality(abs(V), NV, Env) :- ( var(V) -> VA = V ; equality(V, VA, Env) ), @@ -294,13 +330,13 @@ equality(V1+V2, NV, Env) :- equality(V1-V2, NV, Env) :- ( var(V1) -> V1A = V1 ; equality(V1, V1A, Env) ), ( var(V2) -> V2A = V2 ; equality(V2, V2A, Env) ), - new_minus(V1A, V2A, NV, ENV). + new_minus(V1A, V2A, NV, Env). new_abs( V, NV, Space-Map) :- l(V, X, Min0, Max0, Map), ( Min0 < 0 -> ( Max0 < 0 -> Min is -Max0, Max is -Min0 ; - Min = 0 , Max is max( -Min, Max ) ) + Min = 0 , Max is max( -Min0, Max0 ) ) ; Min = Min0, Max = Max0 ), @@ -315,7 +351,7 @@ new_minus( V1, V2, NV, Space-Map) :- Max is Max1-Min2, NX := intvar(Space, Min, Max), m(NV, NX, Min, Max, Map), - Space += linear([1,-1], [X1,X2], NX). + Space += linear([1,-1], [X1,X2], 'IRT_EQ', NX). new_plus( V1, V2, NV, Space-Map) :- l(V1, X1, Min1, Max1, Map), @@ -324,9 +360,8 @@ new_plus( V1, V2, NV, Space-Map) :- Max is Max1+Max2, NX := intvar(Space, Min, Max), m(NV, NX, Min, Max, Map), - Space += linear([1,1], [X1,X2], NX). + Space += linear([1,1], [X1,X2], 'IRT_EQ', NX). - user:term_expansion( ( H :- B), (H :- (clpfd:init_gecode(Space, Me), NB, clpfd:close_gecode(Space, Vs, Me)) ) ) :- process_constraints(B, NB, Env), @@ -379,6 +414,6 @@ l(NV, OV, _, _, Vs) :- fail. l(NV, OV, A, B, [v(V, OV, A, B)|_Vs]) :- V == NV, !. -l(NV, O, A, BV, [_|Vs]) :- +l(NV, OV, A, B, [_|Vs]) :- l(NV, OV, A, B, Vs).