diff --git a/library/examples/matrix.yap b/library/examples/matrix.yap index c4073e657..6f6ed5d3f 100644 --- a/library/examples/matrix.yap +++ b/library/examples/matrix.yap @@ -32,7 +32,7 @@ t5 :- numbers(1, 100, L), X <== matrix(L, [dim=[10,10]]), writeln('diagonal:'), - foreach([I in 0..9, J in I..I], Y^(Y <== X[I,J], writeln(Y) ) ). + for([I in 0..9, J in I..I], Y^(Y <== X[I,J], writeln(Y) ) ). t6 :- Len = 10, LenSq is Len*Len, @@ -42,7 +42,7 @@ t6 :- Y <== matrix(L, [dim=[Len,Len]]), Z <== matrix(L, [dim=[Len,Len]]), writeln('product:'), - foreach([I in 0..Len1, J in 0..Len1], step(X,Y,Z,I,J) ), + for([I in 0..Len1, J in 0..Len1], step(X,Y,Z,I,J) ), O <== list(Z), writeln(O). @@ -73,7 +73,17 @@ t7(Len) :- Y <== matrix(L, [dim=[Len,Len]]), Z <== matrix(L, [dim=[Len,Len]]), writeln('product:'), - foreach([I in 0..Len1, J in 0..Len1], step(X,Y,Z,I,J) , 0, O), + for([I in 0..Len1, J in 0..Len1], step(X,Y,Z,I,J) , 0, O), writeln(O). +t8 :- + Len is 2*3*4*5, + L <== 1..Len, + X <== matrix(L, [dim=[5,4,3,2]]), + writeln('list:'), + OL <== list( X ), + LL <== lists( X ), + writeln(OL), + writeln(LL). + diff --git a/library/gecode/clp_examples/sudoku.yap b/library/gecode/clp_examples/sudoku.yap new file mode 100644 index 000000000..b22c2542a --- /dev/null +++ b/library/gecode/clp_examples/sudoku.yap @@ -0,0 +1,79 @@ + + +:- style_check(all). + +:- use_module(library(gecode/clpfd)). +:- use_module(library(maplist)). + + +sudoku( Ex ) :- + problem(Ex, Els), + output(Els). + +% +% gecode constraints +% +problem(Ex, Els) :- ex(Ex, Exs), + length(Els, 81), + Els ins 1..9, + M <== matrix( Els, [dim=[9,9]] ), + % select rows + for( I in 0..8 , all_different(M[I,*]) ), + % select cols + for( J in 0..8, all_different(M[*,J]) ), + % select squares + for( [I,J] ins 0..2 , + all_different(M[I*3+(0..2),J*3+(0..2)]) ), + ex(Ex, Exs), + maplist( bound, Els, Exs), + labeling( [], Els ). + + +% The gecode interface doesn't support wake-ups on binding constained variables, this is the closest. +% +bound(El, X) :- + ( nonvar(X) -> El #= X ; true ). + +% +% output using matrix library +% +output(Els) :- + M <== matrix( Els, [dim=[9,9]] ), + for( I in 0..2 , output(M, I) ), + output_line. + +output(M, I) :- + output_line, + for( J in 0..2 , output_row(M, J+I*3) ). + +output_row( M, Row ) :- + L <== M[Row,_], + format('| ~d ~d ~d | ~d ~d ~d | ~d ~d ~d |~n', L). + +output_line :- + format(' ~|~`-t~24+~n', []). + +ex( 1, [ + _,6,_,1,_,4,_,5,_, + _,_,8,3,_,5,6,_,_, + 2,_,_,_,_,_,_,_,1, + 8,_,_,4,_,7,_,_,6, + _,_,6,_,_,_,3,_,_, + 7,_,_,9,_,1,_,_,4, + 5,_,_,_,_,_,_,_,2, + _,_,7,2,_,6,9,_,_, + _,4,_,5,_,8,_,7,_ + ] ). + + +ex(2, [ + _,_,1,_,8,_,6,_,4, + _,3,7,6,_,_,_,_,_, + 5,_,_,_,_,_,_,_,_, + _,_,_,_,_,5,_,_,_, + _,_,6,_,1,_,8,_,_, + _,_,_,4,_,_,_,_,_, + _,_,_,_,_,_,_,_,3, + _,_,_,_,_,7,5,2,_, + 8,_,2,_,9,_,7,_,_ + ] ). diff --git a/library/gecode/clp_examples/test.yap b/library/gecode/clp_examples/test.yap index 313401511..4e263eba5 100644 --- a/library/gecode/clp_examples/test.yap +++ b/library/gecode/clp_examples/test.yap @@ -1,20 +1,48 @@ +:- style_check( all ). + :- use_module(library(gecode/clpfd)). :- use_module(library(maplist)). +t0 :- + test0(X), + writeln(X). + test0(X) :- X in 1..10, X #= 2. + +t1 :- + test1(X), + writeln(X), + fail. +t1. + test1(X) :- X in 1..10, Y in 3..7, Z in 1..4, X / Y #= Z, labeling([], [X]). + +t2 :- + test2(X), + writeln(X), + fail. +t2. + test2(X) :- X in 1..10, X / 4 #= 2, labeling([], [X]). + +t3 :- + test3(X), + writeln(X), + fail. +t3. + + test3(A) :- A = [X,Y,Z], A ins 1..4, @@ -22,6 +50,13 @@ test3(A) :- lex_chain(A), all_different(A), labeling([], [X,Y,Z]). + +t4 :- + test4(X), + writeln(X), + fail. +t4. + test4(A) :- A = [X,Y,Z], A ins 1..4, @@ -31,12 +66,26 @@ test4(A) :- min(A, 1), all_different(A), labeling([], [X,Y,Z]). + +t5 :- + test5(X), + writeln(X), + fail. +t5. + test5(A) :- A = [X,Y,Z], A ins 0..1, in_relation( A, [[0,0,0],[0,1,0],[1,0,0]] ), X #> 0, labeling([], A). + +t6 :- + test6(X), + writeln(X), + fail. +t6. + test6(A+B) :- A = [X,Y,Z], B = [X1,Y1,Z1], @@ -50,12 +99,27 @@ test6(A+B) :- Y1 #\= Z1, labeling([], A), labeling([], B). + +t7 :- + test7(X), + writeln(X), + fail. +t7. + test7(A) :- A = [X,Y,Z], A ins 0..1, in_dfa( A, 0, [t(0,0,0),t(0,1,1),t(1,0,0),t(-1,0,0)], [0]), X #> 0, labeling([], A). + +t8 :- + test8(X), + writeln(X), + fail. +t8. + + test8(A+B) :- A = [X,Y,Z,W], B = [X1,Y1,Z1,W1], diff --git a/library/gecode/clpfd.yap b/library/gecode/clpfd.yap index 999ab9273..c028cd5f5 100644 --- a/library/gecode/clpfd.yap +++ b/library/gecode/clpfd.yap @@ -1,4 +1,5 @@ :- module(clpfd, [ + op(100, yf, []), op(760, yfx, #<==>), op(750, xfy, #==>), op(750, yfx, #<==), @@ -68,6 +69,7 @@ :- use_module(library(gecode)). :- use_module(library(maplist)). +:- reexport(library(matrix), [(<==)/2, for/2, for/4]). constraint( (_ #> _) ). constraint( (_ #< _) ). @@ -128,111 +130,156 @@ process_constraints(B, B, _Env). ( A #= B) :- get_home(Env), - post( rel(A, (#=), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#=), NB), Env, _). ( A #\= B) :- get_home(Env), - post( rel(A, (#\=), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#\=), NB), Env, _). ( A #< B) :- get_home(Env), - post( rel(A, (#<), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#<), NB), Env, _). ( A #> B) :- get_home(Env), - post( rel(A, (#>), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#>), NB), Env, _). ( A #=< B) :- get_home(Env), - post( rel(A, (#=<), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#=<), NB), Env, _). ( A #>= B) :- get_home(Env), - post( rel(A, (#>=), B), Env, _). + check(A, NA), + check(B, NB), + post( rel(NA, (#>=), NB), Env, _). sum( L, Op, V) :- get_home( Env ), - post( rel(sum(L), Op, V), Env, _). + check(L, NL), + check(V, NV), + post( rel(sum(NL), Op, NV), Env, _). ( A #<==> VBool) :- get_home(Space-Map), + check(A, NA), + check(VBool, NVBool), Bool := boolvar(Space), - m( VBool, Bool, 0, 1, Map), + m( NVBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_EQV', R), - post(A, Space-Map, R). + post(NA, Space-Map, R). ( A #==> VBool) :- get_home(Space-Map), + check(A, NA), + check(VBool, NVBool), Bool := boolvar(Space), - m( VBool, Bool, 0, 1, Map), + m( NVBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_IMP', R), - post(A, Space-Map, R). + post(NA, Space-Map, R). ( A #<== VBool) :- get_home(Space-Map), + check(A, NA), + check(VBool, NVBool), Bool := boolvar(Space), - m( VBool, Bool, 0, 1, Map), + m( NVBool, Bool, 0, 1, Map), Space += reify(Bool, 'RM_PMI', R), - post(A, Space-Map, R). + post(NA, Space-Map, R). '#\\'(A) :- get_home(Space-Map), + check(A, NA), B := boolvar(Space), Space += reify(B, 'RM_EQV', R), Space += rel(B, 'BOT_EQV', 0), - post(A, Space-Map, R). + post(NA, Space-Map, R). ( A1 #\/ A2 ) :- get_home(Space-Map), + check(A1, NA1), + check(A2, NA2), B1 := boolvar(Space), B2 := boolvar(Space), Space += reify(B1, 'RM_EQV', R1), Space += reify(B2, 'RM_EQV', R2), - post(A1, Space-Map, R1), - post(A2, Space-Map, R2), + post(NA1, Space-Map, R1), + post(NA2, Space-Map, R2), Space += rel(B1, B2, 'BOT_OR', 1). ( A1 #/\ A2 ) :- get_home(Space-Map), + check(A1, NA1), + check(A2, NA2), B1 := boolvar(Space), B2 := boolvar(Space), Space += reify(B1, 'RM_EQV', R1), Space += reify(B2, 'RM_EQV', R2), - post(A1, Space-Map, R1), - post(A2, Space-Map, R2), + post(NA1, Space-Map, R1), + post(NA2, Space-Map, R2), Space += rel(B1, B2, 'BOT_AND', 1). ( X in A..B) :- get_home(Space-Map), - m(X, NX, A, B, Map), - NX := intvar(Space, A, B). + check(A, NA), + check(B, NB), + m(X, NX, NA, NB, Map), + NX := intvar(Space, NA, NB). ( Xs ins A..B) :- get_home(Space-Map), - maplist(lm(A, B, Map), Xs, NXs), + check(A, NA), + check(B, NB), + maplist(lm(NA, NB, Map), Xs, NXs), length(Xs, N), - NXs := intvars(Space, N, A, B). + NXs := intvars(Space, N, NA, NB). all_different( Xs ) :- get_home(Env), - post( all_different( Xs ), Env, _ ). + check(Xs, NXs), + post( all_different( NXs ), Env, _ ). all_distinct( Xs ) :- get_home(Env), - post( all_distinct( Xs ), Env, _ ). + check(Xs, NXs), + post( all_distinct( NXs ), Env, _ ). all_distinct( Cs, Xs ) :- get_home(Env), - post( all_distinct( Cs, Xs ), Env, _ ). + check(Xs, NXs), + post( all_distinct( Cs, NXs ), Env, _ ). scalar_product( Cs, Vs, Rels, X ) :- get_home(Env), - post( scalar_product( Cs, Vs, Rels, X ), Env, _ ). + check(Vs, NVs), + post( scalar_product( Cs, NVs, Rels, X ), Env, _ ). lex_chain( Cs ) :- get_home(Env), - post( rel( Cs, '#=<' ), Env, _ ). + check(Cs, NCs), + post( rel( NCs, '#=<' ), Env, _ ). minimum( V, Xs ) :- get_home(Env), - post( rel( min(Xs), (#=), V ), Env, _ ). + check(Xs, NXs), + check(V, NV), + post( rel( min(NXs), (#=), NV ), Env, _ ). min( Xs, V ) :- get_home(Env), - post( rel( min(Xs), (#=), V ), Env, _ ). + check(Xs, NXs), + check(V, NV), + post( rel( min(NXs), (#=), NV ), Env, _ ). maximum( V, Xs ) :- get_home(Env), - post( rel( max(Xs), (#=), V ), Env, _ ). + check(Xs, NXs), + check(V, NV), + post( rel( max(NXs), (#=), NV ), Env, _ ). max( Xs, V ) :- get_home(Env), - post( rel( max(Xs), (#=), V ), Env, _ ). + check(Xs, NXs), + check(V, NV), + post( rel( max(NXs), (#=), NV ), Env, _ ). in_relation( Xs, Rel ) :- get_home(Env), - post(in_tupleset(Xs, Rel), Env, _ ). + check(Xs, NXs), + post(in_tupleset(NXs, Rel), Env, _ ). in_dfa( Xs, Rel ) :- get_home(Env), - post(in_dfa(Xs, Rel), Env, _ ). + check(Xs, NXs), + post(in_dfa(NXs, Rel), Env, _ ). in_dfa( Xs, S0, Ts, Fs ) :- get_home(Env), + check(NXs, NXs), post(in_dfa(Xs, S0, Ts, Fs), Env, _ ). labeling(_Opts, Xs) :- @@ -251,6 +298,14 @@ extensional_constraint( Tuples, TupleSet) :- dfa( S0, Transitions, Finals, DFA) :- DFA := dfa( S0, Transitions, Finals ). + +check(V, NV) :- + ( var(V) -> V = NV ; + number(V) -> V = NV ; + is_list(V) -> maplist(check, V, NV) ; + V = '[]'(Indx, Mat) -> NV <== '[]'(Indx, Mat) ; + arith(V, _) -> V =.. [C|L], maplist(check, L, NL), NV =.. [C|NL] ). + post( ( A #= B), Env, Reify) :- post( rel( A, (#=), B), Env, Reify). post( ( A #\= B), Env, Reify) :- @@ -272,6 +327,12 @@ post( rel( A, Op, B), Space-Map, Reify):- gecode_arith_op( Op, GOP ), (var(Reify) -> Space += rel(IA, GOP, IB) ; Space += rel(IA, GOP, IB, Reify) ). + +post( rel( A, Op), Space-Map, Reify):- + ( var( A ) -> l(A, IA, Map) ; checklist( var, A ) -> maplist(ll(Map), A, IA ) ), + gecode_arith_op( Op, GOP ), + (var(Reify) -> Space += rel(IA, GOP) ; + Space += rel(IA, GOP, Reify) ). % 2 #\= B post( rel( A, Op, B), Space-Map, Reify):- var(B), integer(A), !, @@ -291,15 +352,16 @@ post( rel( sum(L), Op, Out), Space-Map, Reify):- Space += linear(IL, GOP, IOut, Reify) ). % [A,B,C,D] #< 3 -post( rel( A, Op ), Space-Map, Reify):- +post( rel( A, Op, B ), Space-Map, Reify):- checklist( var, A ), !, + ( var(B) -> l(B, IB, Map) ; integer(B) -> IB = B ), !, maplist(ll(Map), A, IL ), gecode_arith_op( Op, GOP ), (var(Reify) -> Space += rel(IL, GOP) ; Space += rel(IL, GOP, IB) ). post( rel( A, Op, B), Space-Map, Reify):- var( A ), !, - ( var(B) -> l(B, IB, Map) ; integer(B) -> IB = B ), !, + ( var(B) -> l(B, IB, Map) ; integer(B) -> IB = B ), l(A, IA, Map), gecode_arith_op( Op, GOP ), (var(Reify) -> Space += rel(IA, GOP, IB) ; @@ -407,7 +469,7 @@ post(in_tupleset(Xs, TS), Space-Map, Reify) :- (var(Reify) -> Space += extensional(IXs, TS) ; - throw(error(domain(not_reifiable),in_relation(Xs, Tuples))) + throw(error(domain(not_reifiable),in_relation(Xs, TS))) ). post(in_dfa(Xs, S0, Trs, Fs), Space-Map, Reify) :- TS := dfa( S0, Trs, Fs ), @@ -415,14 +477,14 @@ post(in_dfa(Xs, S0, Trs, Fs), Space-Map, Reify) :- (var(Reify) -> Space += extensional(IXs, TS) ; - throw(error(domain(not_reifiable),in_dfa(Xs, Tuples))) + throw(error(domain(not_reifiable),in_dfa(Xs, S0, Trs, Fs))) ). post(in_dfa(Xs, TS), Space-Map, Reify) :- maplist(ll(Map), Xs, IXs), (var(Reify) -> Space += extensional(IXs, TS) ; - throw(error(domain(not_reifiable),in_dfa(Xs, Tuples))) + throw(error(domain(not_reifiable),in_dfa(Xs, TS))) ). gecode_arith_op( (#=) , 'IRT_EQ' ). @@ -578,7 +640,7 @@ out_c(Name, A1, A2, B, (#=), Space-Map, Reify) :- var(Reify), !, new_arith( Name, A1, A2, B, Space-Map). % min(X,Y) #= Cin[..] <=> -out_c(Name, A1, A2, B, Space-Map, Reify) :- +out_c(Name, A1, A2, B, Op, Space-Map, Reify) :- l(B, IB0, Map), !, new_arith( Name, A1, A2, NB, Space-Map), l(NB, IB, Map), @@ -603,7 +665,7 @@ new_arith( abs, V, NV, Space-Map) :- new_arith( min, V, NV, Space-Map) :- V = [V1|RV], - l(V1, X1, Min0, Max0, Map), + l(V1, _X1, Min0, Max0, Map), foldl2( min_l(Map), RV, Max0, Max, Min0, Min), NX := intvar(Space, Min, Max), m(NV, NX, Min, Max, Map), @@ -612,7 +674,7 @@ new_arith( min, V, NV, Space-Map) :- new_arith( max, V, NV, Space-Map) :- V = [V1|RV], - l(V1, X, Min0, Max0, Map), + l(V1, _X1, Min0, Max0, Map), foldl2( max_l(Map), RV, Max0, Max, Min0, Min), NX := intvar(Space, Min, Max), m(NV, NX, Min, Max, Map), @@ -628,7 +690,7 @@ new_arith( minus, V1, V2, NV, Space-Map) :- m(NV, NX, Min, Max, Map), Space += linear([1,-1], [X1,X2], 'IRT_EQ', NX). -new_arith( plua, V1, V2, NV, Space-Map) :- +new_arith( plus, V1, V2, NV, Space-Map) :- l(V1, X1, Min1, Max1, Map), l(V2, X2, Min2, Max2, Map), Min is Min1+Min2, @@ -675,7 +737,7 @@ new_arith( (div), V1, V2, NV, Space-Map) :- new_arith( (mod), V1, V2, NV, Space-Map) :- l(V1, X1, _Min1, Max1, Map), - l(V2, X2, Min2, Max2, Map), + l(V2, X2, _Min2, Max2, Map), Min is 0, Max is min(abs(Max1), Max2-1), NX := intvar(Space, Min, Max), @@ -756,7 +818,7 @@ m(NV, OV, NA, NB, [_|Vs]) :- lm(A, B, Map, X, Y) :- m(X, Y, A, B, Map). -l(NV, OV, Vs) :- +l(_NV, _OV, Vs) :- var(Vs), !, fail. l(NV, OV, [v(V, OV, _A, _B)|_Vs]) :- @@ -767,7 +829,7 @@ l(NV, OV, [_|Vs]) :- ll(Map, X, Y) :- l(X, Y, Map). -l(NV, OV, _, _, Vs) :- +l(_NV, _OV, _, _, Vs) :- var(Vs), !, fail. l(NV, OV, A, B, [v(V, OV, A, B)|_Vs]) :- diff --git a/library/gecode/gecode4_yap_hand_written.yap b/library/gecode/gecode4_yap_hand_written.yap index c4f194976..31b2df80b 100644 --- a/library/gecode/gecode4_yap_hand_written.yap +++ b/library/gecode/gecode4_yap_hand_written.yap @@ -38,11 +38,6 @@ is_IntVar_('IntVar'(I,K),N) :- integer(K), nb_getval(gecode_space_use_keep_index,B), (B=true -> N=K ; N=I). -is_IntVarBranch_('IntVarBranch'(I,K),N) :- - integer(I), - integer(K), - nb_getval(gecode_space_use_keep_index,B), - (B=true -> N=K ; N=I). is_FloatVar_('FloatVar'(I,K),N) :- integer(I), integer(K), @@ -63,10 +58,8 @@ is_IntVar(X,I) :- nonvar(X), is_IntVar_(X,I). is_BoolVar(X,I) :- nonvar(X), is_BoolVar_(X,I). is_FloatVar(X,I) :- nonvar(X), is_FloatVar_(X,I). is_SetVar(X,I) :- nonvar(X), is_SetVar_(X,I). -is_IntVarBranch(X,I) :- nonvar(X), is_IntVarBranch_(X,I). is_IntVar(X) :- is_IntVar(X,_). -is_IntVarBranch(X) :- is_IntVarBranch(X,_). is_BoolVar(X) :- is_BoolVar(X,_). is_FloatVar(X) :- is_FloatVar(X,_). is_SetVar(X) :- is_SetVar(X,_). @@ -367,42 +360,42 @@ is_Reify(X) :- is_Reify(X,_). %% AUTOGENERATE ALL VARIANTS LATER! -new_intvars([], Space, Lo, Hi). +new_intvars([], _Space, _Lo, _Hi). new_intvars([IVar|IVars], Space, Lo, Hi) :- new_intvar(IVar, Space, Lo, Hi), new_intvars(IVars, Space, Lo, Hi). -new_intvars([], Space, IntSet). +new_intvars([], _Space, _IntSet). new_intvars([IVar|IVars], Space, IntSet) :- new_intvar(IVar, Space, IntSet), new_intvars(IVars, Space, IntSet). -new_boolvars([], Space). +new_boolvars([], _Space). new_boolvars([BVar|BVars], Space) :- new_boolvar(BVar, Space), new_boolvars(BVars, Space). -new_setvars([], Space, X1, X2, X3, X4, X5, X6). +new_setvars([], _Space, _X1, _X2, _X3, _X4, _X5, _X6). new_setvars([SVar|SVars], Space, X1, X2, X3, X4, X5, X6) :- new_setvar(SVar, Space, X1, X2, X3, X4, X5, X6), new_setvars(SVars, Space, X1, X2, X3, X4, X5, X6). -new_setvars([], Space, X1, X2, X3, X4, X5). +new_setvars([], _Space, _X1, _X2, _X3, _X4, _X5). new_setvars([SVar|SVars], Space, X1, X2, X3, X4, X5) :- new_setvar(SVar, Space, X1, X2, X3, X4, X5), new_setvars(SVars, Space, X1, X2, X3, X4, X5). -new_setvars([], Space, X1, X2, X3, X4). +new_setvars([], _Space, _X1, _X2, _X3, _X4). new_setvars([SVar|SVars], Space, X1, X2, X3, X4) :- new_setvar(SVar, Space, X1, X2, X3, X4), new_setvars(SVars, Space, X1, X2, X3, X4). -new_setvars([], Space, X1, X2, X3). +new_setvars([], _Space, _X1, _X2, _X3). new_setvars([SVar|SVars], Space, X1, X2, X3) :- new_setvar(SVar, Space, X1, X2, X3), new_setvars(SVars, Space, X1, X2, X3). -new_setvars([], Space, X1, X2). +new_setvars([], _Space, _X1, _X2). new_setvars([SVar|SVars], Space, X1, X2) :- new_setvar(SVar, Space, X1, X2), new_setvars(SVars, Space, X1, X2). @@ -426,7 +419,7 @@ new_intvar(IVar, Space, IntSet) :- !, IVar='IntVar'(Idx,-1). new_floatvar(FVar, Space, Lo, Hi) :- !, - assert_var(IVar), + assert_var(FVar), assert_is_Space_or_Clause(Space,Space_), assert_float(Lo), assert_float(Hi), @@ -463,7 +456,7 @@ new_setvar(SVar, Space, GlbMin, GlbMax, LubMin, LubMax, CardMin, CardMax) :- assert_integer(LubMax), assert_integer(CardMin), assert_integer(CardMax), - gecode_new_setvar(Idx, Space_, GlbMin, GlbMax, LubMib, LubMax, CardMin, CardMax), + gecode_new_setvar(Idx, Space_, GlbMin, GlbMax, LubMin, LubMax, CardMin, CardMax), SVar='SetVar'(Idx,-1). %% 5 arguments @@ -606,10 +599,10 @@ gecode_search_options_from_alist(L,R) :- gecode_search_options_init(R), gecode_search_options_process_alist(L,R). -gecode_search_options_process_alist([],R). -gecode_search_options_process_alist([H|T],R) :- !, - gecode_search_options_process1(H,R), - gecode_search_options_process_alist(T,R). +gecode_search_options_process_alist([], _R). +gecode_search_options_process_alist([H|T], R) :- !, + gecode_search_options_process1(H, R), + gecode_search_options_process_alist(T, R). gecode_search_options_process1(restart,R) :- !, gecode_search_option_set(restart,1,R). @@ -629,15 +622,15 @@ gecode_search_options_process1(a_d=N,R) :- !, gecode_search_options_process1(cutoff=C,R) :- !, (is_RestartMode(C,C_) -> V=C_ ; throw(bad_search_option_value(cutoff=C))), - gecode_search_option_set(cutoff,C_,R). + gecode_search_option_set(cutoff,V,R). gecode_search_options_process1(nogoods_limit=N,R) :- !, (integer(N), N >= 0 -> V=N ; throw(bad_search_option_value(nogoods_limit=N))), - gecode_search_option_set(nogoods_limit,N,R). + gecode_search_option_set(nogoods_limit,V,R). gecode_search_options_process1(clone=N,R) :- !, ((N == 0 ; N == 1)-> V=N ; throw(bad_search_option_value(clone=N))), - gecode_search_option_set(clone,N,R). + gecode_search_option_set(clone,V,R). gecode_search_options_process1(O,_) :- throw(gecode_error(unrecognized_search_option(O))). @@ -655,7 +648,7 @@ search(Space, Solution, Alist) :- %% INSPECTING VARIABLES -get_for_vars([],Space,[],F). +get_for_vars([],_Space,[],_F). get_for_vars([V|Vs],Space,[V2|V2s],F) :- call_with_args(F,V,Space,V2), get_for_vars(Vs,Space,V2s,F). @@ -920,7 +913,7 @@ keep_(Space, Var) :- ; throw(gecode_error(variable_already_kept(Var)))) ; keep_list_(Space,Var)))). -keep_list_(Space, []) :- !. +keep_list_(_Space, []) :- !. keep_list_(Space, [H|T]) :- !, keep_(Space,H), keep_list_(Space,T). keep_list_(_, X) :- diff --git a/library/matrix.yap b/library/matrix.yap index 0a489670f..bbc10232e 100644 --- a/library/matrix.yap +++ b/library/matrix.yap @@ -51,6 +51,7 @@ typedef enum { matrix_size/2, matrix_type/2, matrix_to_list/2, + matrix_to_lists/2, matrix_get/3, matrix_set/3, matrix_set_all/2, @@ -91,14 +92,14 @@ typedef enum { matrix_column/3, matrix_get/2, matrix_set/2, - foreach/2, - foreach/4, + for/2, + for/4, op(100, fy, '[]') ]). :- load_foreign_files([matrix], [], init_matrix). -:- meta_predicate foreach(+,0), foreach(+,2, +, -). +:- meta_predicate for(+,0), for(+,2, +, -). :- use_module(library(maplist)). :- use_module(library(lists)). @@ -113,25 +114,22 @@ rhs(A, A) :- atom(A), !. rhs(RHS, RHS) :- number(RHS), !. rhs(RHS, RHS) :- opaque(RHS), !. rhs(RHS, RHS) :- RHS = m(_, _, _, _), !. -rhs(matrix(List, Opts), RHS) :- - rhs( List, A1), - new_matrix(A1, Opts, RHS). -rhs(matrix(List), RHS) :- +rhs(matrix(List), RHS) :- !, rhs( List, A1), new_matrix(A1, [], RHS). -rhs(matrix(List, Opt1), RHS) :- +rhs(matrix(List, Opt1), RHS) :- !, rhs( List, A1), new_matrix(A1, Opt1, RHS). -rhs(matrix(List, Opt1, Opt2), RHS) :- +rhs(matrix(List, Opt1, Opt2), RHS) :- !, rhs( List, A1), new_matrix(A1, [Opt1, Opt2], RHS). -rhs(matrix(List, Opt1, Opt2, Opt3), RHS) :- +rhs(matrix(List, Opt1, Opt2, Opt3), RHS) :- !, rhs( List, A1), new_matrix(A1, [Opt1, Opt2, Opt3], RHS). -rhs(matrix(List, Opt1, Opt2, Opt3, Opt4), RHS) :- +rhs(matrix(List, Opt1, Opt2, Opt3, Opt4), RHS) :- !, rhs( List, A1), new_matrix(A1, [Opt1, Opt2, Opt3, Opt4], RHS). -rhs(matrix(List, Opt1, Opt2, Opt3, Opt4, Opt5), RHS) :- +rhs(matrix(List, Opt1, Opt2, Opt3, Opt4, Opt5), RHS) :- !, rhs( List, A1), new_matrix(A1, [Opt1, Opt2, Opt3, Opt4, Opt5], RHS). rhs(dim(RHS), Dims) :- !, @@ -140,9 +138,6 @@ rhs(dim(RHS), Dims) :- !, rhs(dims(RHS), Dims) :- !, rhs(RHS, X1), matrix_dims( X1, Dims ). -rhs(dims(RHS), Dims) :- !, - rhs(RHS, X1), - matrix_dims( X1, Dims ). rhs(nrow(RHS), NRow) :- !, rhs(RHS, X1), matrix_dims( X1, [NRow,_] ). @@ -164,6 +159,9 @@ rhs(min(RHS), Size) :- !, rhs(list(RHS), List) :- !, rhs(RHS, X1), matrix_to_list( X1, List ). +rhs(lists(RHS), List) :- !, + rhs(RHS, X1), + matrix_to_lists( X1, List ). rhs(A=B, NA=NB) :- !, rhs(A, NA), rhs(B, NB). @@ -189,6 +187,10 @@ rhs(':'(I, J), [I1|Is]) :- !, rhs(I, I1), rhs(J, J1), once( foldl(inc, Is, I1, J1) ). +rhs(S, NS) :- + S =.. [N|As], + maplist(rhs, As, Bs), + NS =.. [N|Bs]. set_lhs(V, R) :- var(V), !, V = R. set_lhs(V, R) :- number(V), !, V = R. @@ -227,15 +229,15 @@ index(I-J, _M, O ) :- index(I*J, _M, O ) :- index(I, M, I1), index(J, M, J1), - O is I*J. + O is I1*J1. index(I div J, _M, O ) :- index(I, M, I1), index(J, M, J1), - O is I div J. + O is I1 div J1. index(I rem J, _M, O ) :- index(I, M, I1), index(J, M, J1), - O is I rem J. + O is I1 rem J1. index(I, M, NI ) :- maplist(indx(M), I, NI). @@ -316,6 +318,17 @@ matrix_to_list( Mat, ToList) :- ( opaque(Mat) -> matrixn_to_list( Mat, ToList ) ; Mat = m( _, _, _, M), M=.. [_|ToList] ). +matrix_to_lists( Mat, ToList) :- + matrix_dims( Mat, [D|Dims] ), + D1 is D-1, + for( I in 0..D1, matrix_slicer( Dims, Mat, [I|L]-L), ToList, [] ). + +matrix_slicer( [_], M, Pos-[_], [O|L0], L0) :- !, + O <== '[]'(Pos,M). +matrix_slicer( [D|Dims], M, Pos-[I|L], [O|L0], L0) :- + D1 is D-1, + for( I in 0..D1 , L^matrix_slicer( Dims, M, Pos-L), O, [] ). + matrix_get( Mat, Pos, El) :- ( opaque(Mat) -> matrixn_get( Mat, Pos, El ) ; m_get(Mat, Pos, El) ). @@ -368,7 +381,7 @@ matrix_max(M, Max) :- matrix_maxarg(M, Max) :- ( opaque(M) -> matrixn_maxarg( M, Max ) ; - M = m(Dims, _, Size, _) -> fail ). + M = m(_, _, _, _) -> fail ). matrix_min(M, Min) :- ( opaque(M) -> matrixn_min( M, Min ) ; @@ -376,7 +389,7 @@ matrix_min(M, Min) :- matrix_minarg(M, Min) :- ( opaque(M) -> matrixn_minarg( M, Min ) ; - M = m(Dims, _, Size, _) -> fail ). + M = m(_Dims, _, _Size, _) -> fail ). matrix_agg_lines(M1,+,NM) :- do_matrix_agg_lines(M1,0,NM). @@ -487,7 +500,7 @@ guess_type( _List, terms ). process_new_opt(dim=Dim, Type, Type, _, Dim) :- !. process_new_opt(type=Type, _, Type, Dim, Dim) :- !. -process_new_opt(Opt, _, Type, Dim, Dim) :- +process_new_opt(Opt, _, _Type, Dim, Dim) :- throw(error(domain_error(opt=Opt), new_matrix)). el_list(_, V, _Els, _NEls, _I0, _I1) :- @@ -502,17 +515,17 @@ el_list([N], El, Els, NEls, I0, I1) :- append(El, NEls, Els), I1 is I0+1. -foreach( Domain, M:(Locals^Goal)) :- !, +for( Domain, M:(Locals^Goal)) :- !, global_variables( Domain, Locals, Goal, GlobalVars ), iterate( Domain, [], GlobalVars, M:Goal, [], [] ). -foreach( Domain, Goal ) :- +for( Domain, Goal ) :- global_variables( Domain, [], Goal, GlobalVars ), iterate( Domain, [], GlobalVars, Goal, [], [] ). -foreach( Domain, M:(Locals^Goal), Inp, Out) :- !, +for( Domain, M:(Locals^Goal), Inp, Out) :- !, global_variables( Domain, Locals, Goal, GlobalVars ), iterate( Domain, [], GlobalVars, M:Goal, [], [], Inp, Out). -foreach( Domain, Goal, Inp, Out ) :- +for( Domain, Goal, Inp, Out ) :- global_variables( Domain, [], Goal, GlobalVars ), iterate( Domain, [], GlobalVars, Goal, [], [], Inp, Out ). @@ -528,21 +541,22 @@ delv( V, [V1|Vs], [V1|NVs]) :- iterate( [], [], GlobalVars, Goal, Vs, Bs ) :- copy_term(t(Vs, Goal, GlobalVars), t(Bs, G, GlobalVars) ), - once( G ). + strip_module(G, M, NG), + once( M:NG ). iterate( [], [H|Cont], GlobalVars, Goal, Vs, Bs ) :- iterate(H, Cont, GlobalVars, Goal, Vs, Bs ). iterate( [H|L], Cont, GlobalVars, Goal, Vs, Bs ) :- !, append(L, Cont, LCont), iterate(H, LCont, GlobalVars, Goal, Vs, Bs ). -iterate( [] ins _A .. _B, Cont, GlobalVars, Goal ) :- !, +iterate( [] ins _A .. _B, Cont, GlobalVars, Goal, Vs, Bs ) :- !, iterate(Cont, [], GlobalVars, Goal, Vs, Bs ). iterate( [V|Ps] ins A..B, Cont, GlobalVars, Goal, Vs, Bs ) :- eval(A, Vs, Bs, NA), eval(B, Vs, Bs, NB), ( NA > NB -> true ; A1 is NA+1, - iterate( Cont, [], GlobalVars, Goal, [V|Vs], [NA|Bs] ), - iterate( Ps ins A1..NB, GlobalVars, Goal, [V|Vs], [NA|Bs] ) + iterate( Ps ins NA..NB, Cont, GlobalVars, Goal, [V|Vs], [NA|Bs] ), + iterate( [V|Ps] ins A1..NB, Cont, GlobalVars, Goal, Vs, Bs ) ). iterate( V in A..B, Cont, GlobalVars, Goal, Vs, Bs) :- var(V), @@ -556,21 +570,23 @@ iterate( V in A..B, Cont, GlobalVars, Goal, Vs, Bs) :- iterate( [], [], GlobalVars, Goal, Vs, Bs, Inp, Out ) :- copy_term(t(Vs, Goal, GlobalVars), t(Bs, G, GlobalVars) ), - once( call(G, Inp, Out) ). + strip_module(G, M, NG), + MG <== NG, + once( call(M:MG, Inp, Out) ). iterate( [], [H|Cont], GlobalVars, Goal, Vs, Bs, Inp, Out ) :- iterate(H, Cont, GlobalVars, Goal, Vs, Bs, Inp, Out ). iterate( [H|L], Cont, GlobalVars, Goal, Vs, Bs, Inp, Out ) :- !, append(L, Cont, LCont), iterate(H, LCont, GlobalVars, Goal, Vs, Bs, Inp, Out ). -iterate( [] ins _A .. _B, Cont, GlobalVars, Goal, Inp, Out ) :- !, +iterate( [] ins _A .. _B, Cont, GlobalVars, Goal, Vs, Bs, Inp, Out ) :- !, iterate(Cont, [], GlobalVars, Goal, Vs, Bs, Inp, Out ). iterate( [V|Ps] ins A..B, Cont, GlobalVars, Goal, Vs, Bs, Inp, Out ) :- eval(A, Vs, Bs, NA), eval(B, Vs, Bs, NB), ( NA > NB -> Inp = Out ; A1 is NA+1, - iterate( Cont, [], GlobalVars, Goal, [V|Vs], [NA|Bs], Inp, Mid ), - iterate( Ps ins A1..NB, GlobalVars, Goal, [V|Vs], [NA|Bs], Mid, Out ) + iterate( Ps ins A..B, Cont, GlobalVars, Goal, [V|Vs], [NA|Bs], Inp, Mid ), + iterate( [V|Ps] ins A1..NB, Cont, GlobalVars, Goal, Vs, Bs, Mid, Out ) ). iterate( V in A..B, Cont, GlobalVars, Goal, Vs, Bs, Inp, Out) :- var(V),