1:- module(tor_clpfd_labeling,[label/1,labeling/2,indomain/1]). 2
3:- use_module(library(clpfd),except([label/1,labeling/2,indomain/1])). 4
5:- use_module(library(tor)). 6
7indomain(Var) :- label([Var]).
8
9label(Vs) :- labeling([], Vs).
10
11labeling(Options, Vars) :-
12 must_be(list, Options),
13 must_be(list, Vars),
14 maplist(finite_domain, Vars),
15 label(Options, Options, default(leftmost), default(up), default(step), [], upto_ground, Vars).
16
17finite_domain(Var) :-
18 ( clpfd:fd_get(Var, Dom, _) ->
19 ( domain_infimum(Dom, n(_)), domain_supremum(Dom, n(_)) -> true
20 ; instantiation_error(Var)
21 )
22 ; integer(Var) -> true
23 ; must_be(integer, Var)
24 ).
25
26domain_infimum(from_to(I, _), I).
27domain_infimum(split(_, Left, _), I) :- domain_infimum(Left, I).
28
29domain_supremum(from_to(_, S), S).
30domain_supremum(split(_, _, Right), S) :- domain_supremum(Right, S).
31
32label([O|Os], Options, Selection, Order, Choice, Optim, Consistency, Vars) :-
33 ( var(O)-> instantiation_error(O)
34 ; override(selection, Selection, O, Options, S1) ->
35 label(Os, Options, S1, Order, Choice, Optim, Consistency, Vars)
36 ; override(order, Order, O, Options, O1) ->
37 label(Os, Options, Selection, O1, Choice, Optim, Consistency, Vars)
38 ; override(choice, Choice, O, Options, C1) ->
39 label(Os, Options, Selection, Order, C1, Optim, Consistency, Vars)
40 ; optimisation(O) ->
41 label(Os, Options, Selection, Order, Choice, [O|Optim], Consistency, Vars)
42 ; consistency(O, O1) ->
43 label(Os, Options, Selection, Order, Choice, Optim, O1, Vars)
44 ; domain_error(labeling_option, O)
45 ).
46label([], _, Selection, Order, Choice, Optim0, Consistency, Vars) :-
47 maplist(arg(1), [Selection,Order,Choice], [S,O,C]),
48 ( Optim0 == [] ->
49 label(Vars, S, O, C, Consistency)
50 ; reverse(Optim0, Optim),
51 exprs_singlevars(Optim, SVs),
52 optimise(Vars, [S,O,C], SVs)
53 ).
54
57
58exprs_singlevars([], []).
59exprs_singlevars([E|Es], [SV|SVs]) :-
60 E =.. [F,Expr],
61 Single #= Expr,
62 SV =.. [F,Single],
63 exprs_singlevars(Es, SVs).
64
65all_dead(fd_props(Bs,Gs,Os)) :-
66 all_dead_(Bs),
67 all_dead_(Gs),
68 all_dead_(Os).
69
70all_dead_([]).
71all_dead_([propagator(_, S)|Ps]) :- S == dead, all_dead_(Ps).
72
73label([], _, _, _, Consistency) :- !,
74 ( Consistency = upto_in(I0,I) -> I0 = I
75 ; true
76 ).
77label(Vars, Selection, Order, Choice, Consistency) :-
78 ( Vars = [V|Vs], nonvar(V) -> label(Vs, Selection, Order, Choice, Consistency)
79 ; select_var(Selection, Vars, Var, RVars),
80 ( var(Var) ->
81 ( Consistency = upto_in(I0,I), clpfd:fd_get(Var, _, Ps), all_dead(Ps) ->
82 clpfd:fd_size(Var, Size),
83 I1 is I0*Size,
84 label(RVars, Selection, Order, Choice, upto_in(I1,I))
85 ; Consistency = upto_in, clpfd:fd_get(Var, _, Ps), all_dead(Ps) ->
86 label(RVars, Selection, Order, Choice, Consistency)
87 ; choice_order_variable(Choice, Order, Var, RVars, Vars, Selection, Consistency)
88 )
89 ; label(RVars, Selection, Order, Choice, Consistency)
90 )
91 ).
92
93choice_order_variable(step, Order, Var, Vars, Vars0, Selection, Consistency) :-
94 clpfd:fd_get(Var, Dom, _),
95 clpfd:order_dom_next(Order, Dom, Next),
96 ( ( Var = Next,
97 label(Vars, Selection, Order, step, Consistency) )
98 tor
99 ( clpfd:neq_num(Var, Next),
100 clpfd:do_queue,
101 label(Vars0, Selection, Order, step, Consistency)
102 ) ).
103choice_order_variable(enum, Order, Var, Vars, _, Selection, Consistency) :-
104 clpfd:fd_get(Var, Dom0, _),
105 domain_direction_element(Dom0, Order, Var),
106 label(Vars, Selection, Order, enum, Consistency).
107choice_order_variable(bisect, Order, Var, _, Vars0, Selection, Consistency) :-
108 clpfd:fd_get(Var, Dom, _),
109 domain_infimum(Dom, n(I)),
110 domain_supremum(Dom, n(S)),
111 Mid0 is (I + S) // 2,
112 ( Mid0 =:= S -> Mid is Mid0 - 1 ; Mid = Mid0 ),
113 ( Order == up -> ( Var #=< Mid tor Var #> Mid )
114 ; Order == down -> ( Var #> Mid tor Var #=< Mid )
115 ; domain_error(bisect_up_or_down, Order)
116 ),
117 label(Vars0, Selection, Order, bisect, Consistency).
118
119override(What, Prev, Value, Options, Result) :-
120 call(What, Value),
121 override_(Prev, Value, Options, Result).
122
123override_(default(_), Value, _, user(Value)).
124override_(user(Prev), Value, Options, _) :-
125 ( Value == Prev ->
126 domain_error(nonrepeating_labeling_options, Options)
127 ; domain_error(consistent_labeling_options, Options)
128 ).
129
130selection(ff).
131selection(ffc).
132selection(min).
133selection(max).
134selection(leftmost).
135selection(random_variable(Seed)) :-
136 must_be(integer, Seed),
137 set_random(seed(Seed)).
138
139choice(step).
140choice(enum).
141choice(bisect).
142
143order(up).
144order(down).
147order(random_value(Seed)) :-
148 must_be(integer, Seed),
149 set_random(seed(Seed)).
150
151consistency(upto_in(I), upto_in(1, I)).
152consistency(upto_in, upto_in).
153consistency(upto_ground, upto_ground).
154
155optimisation(min(_)).
156optimisation(max(_)).
157
158select_var(leftmost, [Var|Vars], Var, Vars).
159select_var(min, [V|Vs], Var, RVars) :-
160 find_min(Vs, V, Var),
161 delete_eq([V|Vs], Var, RVars).
162select_var(max, [V|Vs], Var, RVars) :-
163 find_max(Vs, V, Var),
164 delete_eq([V|Vs], Var, RVars).
165select_var(ff, [V|Vs], Var, RVars) :-
166 clpfd:fd_size_(V, n(S)),
167 find_ff(Vs, V, S, Var),
168 delete_eq([V|Vs], Var, RVars).
169select_var(ffc, [V|Vs], Var, RVars) :-
170 find_ffc(Vs, V, Var),
171 delete_eq([V|Vs], Var, RVars).
172select_var(random_variable(_), Vars0, Var, Vars) :-
173 length(Vars0, L),
174 I is random(L),
175 nth0(I, Vars0, Var),
176 delete_eq(Vars0, Var, Vars).
177
178find_min([], Var, Var).
179find_min([V|Vs], CM, Min) :-
180 ( min_lt(V, CM) ->
181 find_min(Vs, V, Min)
182 ; find_min(Vs, CM, Min)
183 ).
184
185find_max([], Var, Var).
186find_max([V|Vs], CM, Max) :-
187 ( max_gt(V, CM) ->
188 find_max(Vs, V, Max)
189 ; find_max(Vs, CM, Max)
190 ).
191
192find_ff([], Var, _, Var).
193find_ff([V|Vs], CM, S0, FF) :-
194 ( nonvar(V) -> find_ff(Vs, CM, S0, FF)
195 ; ( clpfd:fd_size_(V, n(S1)), S1 < S0 ->
196 find_ff(Vs, V, S1, FF)
197 ; find_ff(Vs, CM, S0, FF)
198 )
199 ).
200
201find_ffc([], Var, Var).
202find_ffc([V|Vs], Prev, FFC) :-
203 ( ffc_lt(V, Prev) ->
204 find_ffc(Vs, V, FFC)
205 ; find_ffc(Vs, Prev, FFC)
206 ).
207
208
209ffc_lt(X, Y) :-
210 ( clpfd:fd_get(X, XD, XPs) ->
211 domain_num_elements(XD, n(NXD))
212 ; NXD = 1, XPs = []
213 ),
214 ( clpfd:fd_get(Y, YD, YPs) ->
215 domain_num_elements(YD, n(NYD))
216 ; NYD = 1, YPs = []
217 ),
218 ( NXD < NYD -> true
219 ; NXD =:= NYD,
220 props_number(XPs, NXPs),
221 props_number(YPs, NYPs),
222 NXPs > NYPs
223 ).
224
225min_lt(X,Y) :- bounds(X,LX,_), bounds(Y,LY,_), LX < LY.
226
227max_gt(X,Y) :- bounds(X,_,UX), bounds(Y,_,UY), UX > UY.
228
229bounds(X, L, U) :-
230 ( clpfd:fd_get(X, Dom, _) ->
231 domain_infimum(Dom, n(L)),
232 domain_supremum(Dom, n(U))
233 ; L = X, U = L
234 ).
235
236delete_eq([], _, []).
237delete_eq([X|Xs], Y, List) :-
238 ( nonvar(X) -> delete_eq(Xs, Y, List)
239 ; X == Y -> List = Xs
240 ; List = [X|Tail],
241 delete_eq(Xs, Y, Tail)
242 ).
243
244tor_between(From, To, B) :-
245 From =< To,
246 ( B = From
247 tor
248 ( From1 is From + 1,
249 tor_between(From1, To, B)
250 )).
251
252domain_direction_element(from_to(n(From), n(To)), Dir, E) :-
253 ( Dir == up ->
254 tor_between(From, To, E)
255 ; tor_between(From, To, E0),
256 E is To - (E0 - From)
257 ).
258domain_direction_element(split(_, D1, D2), Dir, E) :-
259 ( Dir == up ->
260 ( domain_direction_element(D1, Dir, E)
261