rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1973 from triska/clpz

Browse Source 
CLP(ℤ) improvements, notably related to queue handling
This commit is contained in:
Mark Thom
2023-08-22 15:04:33 -06:00
committed by GitHub
parent 61f975ea18 98086de77e
commit 81712f4c82
1 changed files with 109 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files

191
src/lib/clpz.pl
View File

@@ -119,7 +119,7 @@
:- use_module(library(iso_ext)).
:- use_module(library(dcgs)).
:- use_module(library(terms)).
:- use_module(library(error), [domain_error/3, type_error/3]).
:- use_module(library(error), [domain_error/3, type_error/3, can_be/2]).
:- use_module(library(si)).
:- use_module(library(freeze)).
:- use_module(library(arithmetic)).
@@ -838,12 +838,12 @@ Using suitable labeling strategies, we can easily find solutions with
```
?- n_queens(80, Qs), labeling([ff], Qs).
Qs = [1,3,5,44,42,4,50,7,68,57,76,61,6,39,30,40,8,54,36,41,...]
Qs = [1,3,5,44,42,4,50,7,68,57,76,61,6,39,30,40,8,54,36,41|...]
; ... .
?- time((n_queens(90, Qs), labeling([ff], Qs))).
% CPU time: 31.351s
Qs = [1,3,5,50,42,4,49,7,59,48,46,63,6,55,47,64,8,70,58,67,...]
% CPU time: 2.382s
Qs = [1,3,5,50,42,4,49,7,59,48,46,63,6,55,47,64,8,70,58,67|...]
; ... .
```
@@ -1745,11 +1745,7 @@ clpz_in(V, D) :-
drep_to_domain(D, Dom),
domain(V, Dom).
fd_variable(V) :-
( var(V) -> true
; integer(V) -> true
; type_error(integer, V)
).
fd_variable(V) :- can_be(integer, V).
%% ins(+Vars, +Domain)
%
@@ -2219,14 +2215,14 @@ all_different(Ls) :-
fd_must_be_list(Ls, all_different(Ls)-1),
maplist(fd_variable, Ls),
Orig = original_goal(_, all_different(Ls)),
all_different(Ls, [], Orig),
do_queue.
new_queue(Q0),
phrase((all_different(Ls, [], Orig),do_queue), [Q0], _).
all_different([], _, _).
all_different([X|Right], Left, Orig) :-
( var(X) ->
make_propagator(pdifferent(Left,Right,X,Orig), Prop),
init_propagator(X, Prop),
all_different([], _, _) --> [].
all_different([X|Right], Left, Orig) -->
( { var(X) } ->
{ make_propagator(pdifferent(Left,Right,X,Orig), Prop) },
init_propagator_([X], Prop),
trigger_prop(Prop)
; exclude_fire(Left, Right, X)
),
@@ -2250,7 +2246,8 @@ all_distinct(Ls) :-
maplist(fd_variable, Ls),
make_propagator(pdistinct(Ls), Prop),
new_queue(Q0),
phrase((distinct_attach(Ls, Prop, []),trigger_prop(Prop),do_queue), [Q0], _).
phrase((distinct_attach(Ls, Prop, []),trigger_prop(Prop),do_queue), [Q0], _),
variables_same_queue(Ls).
%% nvalue(?N, +Vars).
%
@@ -2639,22 +2636,28 @@ parse_goals([G|Gs]) --> parse_goal(G), parse_goals(Gs).
parse_goal(g(Goal)) --> [Goal].
parse_goal(p(Prop)) -->
[make_propagator(Prop, P)],
{ term_variables(Prop, Vs) },
parse_init(Vs, P),
[trigger_once(P)].
[make_propagator(Prop, P),
new_queue(Q0),
phrase(init_propagator_(Vs, P), [Q0], [Q]),
variables_same_queue(Vs),
trigger_once_(P, Q)].
parse_init([], _) --> [].
parse_init([V|Vs], P) --> [init_propagator(V, P)], parse_init(Vs, P).
%?- set_prolog_flag(answer_write_options, [portray(true)]),
% clpz:parse_clpz_clauses(Clauses), maplist(portray_clause, Clauses).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- use_module(library(lists)),
use_module(library(format)),
clpz:parse_clpz_clauses(Clauses),
maplist(portray_clause, Clauses).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
trigger_once(Prop) :-
new_queue(Q),
trigger_once_(Prop, Q).
trigger_once_(Prop, Q) :-
phrase((trigger_prop(Prop),do_queue), [Q], _).
neq(A, B) :- propagator_init_trigger(pneq(A, B)).
@@ -2666,19 +2669,41 @@ propagator_init_trigger(P) -->
propagator_init_trigger(Vs, P) -->
[p(Prop)],
{ make_propagator(P, Prop),
maplist(prop_init(Prop), Vs),
new_queue(Q0),
phrase(init_propagator_(Vs, Prop), [Q0], [Q]),
variables_same_queue(Vs),
trigger_once(Prop) }.
trigger_once_(Prop, Q) }.
variables_same_queue(Vs0) :-
include(var, Vs0, Vs),
new_queue(Q),
maplist(variable_queue, Vs, Qs),
phrase((collect_goal(Qs),
collect_fast(Qs),
collect_slow(Qs)), [Q], [Q]),
maplist(clear_queue, Qs),
maplist(=(Q), Qs).
( Vs == [] -> true
; maplist(variable_queue, Vs, Qs0),
sort(Qs0, [Q|Qs]),
Q =.. [_|Args],
append_queues_(Qs, Args, [append,append,append,ignore]),
maplist(clear_queue, Qs),
maplist(=(Q), Qs)
).
append_queues_([], _, _).
append_queues_([Q|Qs], Args0, Is) :-
Q =.. [_|Args],
maplist(append_queue, Is, Args0, Args),
append_queues_(Qs, Args, Is).
append_queue(ignore, _, _).
append_queue(append, Q0, Q) :-
( get_atts(Q0, queue(Ls0,Ls)) ->
( get_atts(Q, queue(Ms0,Ms)) ->
Ls = Ms0,
put_atts(Q0, queue(Ls0,Ms))
; true
)
; ( get_atts(Q, queue(Ms0,Ms)) ->
put_atts(Q0, queue(Ms0,Ms))
; true
)
).
clear_queue(queue(Goals,Fast,Slow,Aux)) :-
put_atts(Goals, -queue(_,_)),
@@ -2686,22 +2711,6 @@ clear_queue(queue(Goals,Fast,Slow,Aux)) :-
put_atts(Slow, -queue(_,_)),
put_atts(Aux, -disabled).
collect_goal(Qs) --> collect_arg(Qs, 1).
collect_fast(Qs) --> collect_arg(Qs, 2).
collect_slow(Qs) --> collect_arg(Qs, 3).
collect_arg([], _) --> [].
collect_arg([Q|Qs], Which) -->
collect_all_(Q, Which),
collect_arg(Qs, Which).
collect_all_(Q, Which) -->
( { queue_get_arg_(Q, Which, Element) } ->
insert_queue(Element, Which),
collect_all_(Q, Which)
; []
).
variable_queue(Var, Q) :-
get_attr(Var, clpz, Attr),
Attr = clpz_attr(_Left,_Right,_Spread,_Dom,_Ps,Q).
@@ -2813,7 +2822,7 @@ matches([
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
m(var(X) #\= integer(Y)) => [g(neq_num(X, Y))],
m(var(X) #\= var(Y)) => [g(neq(X,Y))],
m(var(X) #\= var(Y)) => [p(pneq(X,Y))],
m(var(X) #\= var(Y) + var(Z)) => [p(x_neq_y_plus_z(X, Y, Z))],
m(var(X) #\= var(Y) - var(Z)) => [p(x_neq_y_plus_z(Y, X, Z))],
m(var(X) #\= var(Y)*var(Z)) => [p(ptimes(Y,Z,P)), g(neq(X,P))],
@@ -2898,10 +2907,12 @@ match_goal(r(X,Y), F) --> { G =.. [F,X,Y] }, [G].
match_goal(d(X,Y), _) --> [parse_clpz(X, Y)].
match_goal(g(Goal), _) --> [Goal].
match_goal(p(Prop), _) -->
[make_propagator(Prop, P)],
{ term_variables(Prop, Vs) },
parse_init(Vs, P),
[trigger_once(P)].
[make_propagator(Prop, P),
new_queue(Q0),
phrase(init_propagator_(Vs, P), [Q0], [Q]),
variables_same_queue(Vs),
trigger_once_(P, Q)].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -3753,8 +3764,10 @@ kill_reified_tuples([B|Bs], Ps, All) -->
relation_tuple_b_prop(Relation, Tuple, B, p(Prop)) :-
put_attr(R, clpz_relation, Relation),
make_propagator(reified_tuple_in(Tuple, R, B), Prop),
tuple_freeze_(Tuple, Prop),
init_propagator(B, Prop).
new_queue(Q0),
phrase((tuple_freeze_(Tuple, Prop),
init_propagator_([B], Prop),
do_queue), [Q0], _).
tuples_in_conjunction(Tuples, Relation, Conj) :-
@@ -3960,7 +3973,7 @@ insert_queue(Element, Which) -->
Tail0 = [Element|Tail]
; Head = [Element|Tail]
),
put_atts(Arg, +queue(Head,Tail)) }.
put_atts(Arg, queue(Head,Tail)) }.
domain_spread(Dom, Spread) :-
@@ -4192,9 +4205,9 @@ ignore(Goal) :- ( Goal -> true ; true ).
print_queue -->
state(queue(Goal,Fast,Slow,_)),
{ ignore(get_atts(Goal, +queue(GHs,_))),
ignore(get_atts(Fast, +queue(FHs,_))),
ignore(get_atts(Slow, +queue(SHs,_))),
{ ignore(get_atts(Goal, queue(GHs,_))),
ignore(get_atts(Fast, queue(FHs,_))),
ignore(get_atts(Slow, queue(SHs,_))),
format("Current queue:~n goal: ~q~n fast: ~q~n slow: ~q~n~n", [GHs,FHs,SHs]) }.
@@ -4209,18 +4222,27 @@ queue_get_arg(Which, Element) -->
queue_get_arg_(Queue, Which, Element) :-
arg(Which, Queue, Arg),
get_atts(Arg, +queue([Element|Elements],Tail)),
get_atts(Arg, queue([Element|Elements],Tail)),
( var(Elements) ->
put_atts(Arg, -queue(_,_))
; put_atts(Arg, +queue(Elements,Tail))
; put_atts(Arg, queue(Elements,Tail))
).
queue_enabled --> state(queue(_,_,_,Aux)), { \+ get_atts(Aux, disabled) }.
disable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, +disabled) }.
disable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, disabled) }.
enable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, -disabled) }.
portray_propagator(propagator(P,_), F) :- functor(P, F, _).
init_propagator_([], _) --> [].
init_propagator_([V|Vs], Prop) -->
( { fd_get(V, Dom, Ps0) } ->
{ insert_propagator(Prop, Ps0, Ps) },
fd_put(V, Dom, Ps)
; []
),
init_propagator_(Vs, Prop).
init_propagator(Var, Prop) :-
( fd_get(Var, Dom, Ps0) ->
insert_propagator(Prop, Ps0, Ps),
@@ -4343,17 +4365,22 @@ tuples_in(Tuples, Relation) :-
must_be(list(list), Tuples),
maplist(maplist(fd_variable), Tuples),
must_be(list(list(integer)), Relation),
maplist(relation_tuple(Relation), Tuples).
new_queue(Q0),
phrase(tuples_relation(Tuples, Relation), [Q0], [Q]),
append(Tuples, Vs),
variables_same_queue(Vs),
phrase(do_queue, [Q], _).
relation_tuple(Relation, Tuple) :-
relation_unifiable(Relation, Tuple, Us, _, _),
( ground(Tuple) -> memberchk(Tuple, Relation)
; new_queue(Q),
phrase((tuple_domain(Tuple, Us),do_queue), [Q], _),
tuples_relation([], _) --> [].
tuples_relation([Tuple|Tuples], Relation) -->
{ relation_unifiable(Relation, Tuple, Us, _, _) },
( ground(Tuple) -> { memberchk(Tuple, Relation) }
; tuple_domain(Tuple, Us),
( Tuple = [_,_|_] -> tuple_freeze(Tuple, Us)
; true
; []
)
).
),
tuples_relation(Tuples, Relation).
list_first_rest([L|Ls], L, Ls).
@@ -4371,19 +4398,19 @@ tuple_domain([T|Ts], Relation0) -->
),
tuple_domain(Ts, Relation1).
tuple_freeze(Tuple, Relation) :-
( ground(Tuple) -> memberchk(Tuple, Relation)
; put_attr(R, clpz_relation, Relation),
make_propagator(rel_tuple(R, Tuple), Prop),
tuple_freeze(Tuple, Relation) -->
( ground(Tuple) -> { memberchk(Tuple, Relation) }
; { put_attr(R, clpz_relation, Relation),
make_propagator(rel_tuple(R, Tuple), Prop) },
tuple_freeze_(Tuple, Prop)
).
tuple_freeze_([], _).
tuple_freeze_([T|Ts], Prop) :-
tuple_freeze_([], _) --> [].
tuple_freeze_([T|Ts], Prop) -->
( var(T) ->
init_propagator(T, Prop),
init_propagator_([T], Prop),
trigger_prop(Prop)
; true
; []
),
tuple_freeze_(Ts, Prop).
@@ -5993,9 +6020,9 @@ max_factor(L1, U1, L2, U2, Max) :-
distinct_attach([], _, _) --> [].
distinct_attach([X|Xs], Prop, Right) -->
( var(X) ->
{ init_propagator(X, Prop),
make_propagator(pexclude(Xs,Right,X), P1),
init_propagator(X, P1) },
init_propagator_([X], Prop),
{ make_propagator(pexclude(Xs,Right,X), P1) },
init_propagator_([X], P1),
trigger_prop(P1)
; exclude_fire(Xs, Right, X)
),