1 % (c) 2004-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(bsets_clp,
6 [empty_sequence/1,
7 is_sequence/2, is_sequence_wf/3, not_is_sequence/2, not_is_sequence_wf/3,
8 not_is_non_empty_sequence_wf/3,
9 injective_sequence_wf/3,
10 not_injective_sequence/3,
11 not_non_empty_injective_sequence/3,
12 injective_non_empty_sequence/3,
13 finite_non_empty_sequence/3,
14 test_finite_non_empty_sequence/4,
15 permutation_sequence_wf/3,
16 not_permutation_sequence/3,
17 size_of_sequence/3,
18 prepend_sequence/4, append_sequence/4, prefix_sequence_wf/4,
19 suffix_sequence/4, concat_sequence/4,
20 disjoint_union_wf/4,
21 concatentation_of_sequences/3,
22 tail_sequence/4, first_sequence/4, front_sequence/4, last_sequence/4,
23 rev_sequence/3,
24
25
26 % maplet/3,
27 % relation/1,
28 relation_over/3, relation_over_wf/4,
29 not_relation_over/4,
30 domain_wf/3,
31
32 range_wf/3,
33 identity_relation_over_wf/3, in_identity/3, not_in_identity/3,
34 invert_relation_wf/3,
35 tuple_of/3,
36 in_composition_wf/4, not_in_composition_wf/4, rel_composition_wf/5,
37 direct_product_wf/4,
38 parallel_product_wf/4, in_parallel_product_wf/4, not_in_parallel_product_wf/4,
39 rel_iterate_wf/5,
40 event_b_identity_for_type/3,
41
42 not_partial_function/4,
43 partial_function/3, partial_function_wf/4, partial_function_test_wf/5,
44
45 total_function/3, total_function_wf/4, total_function_test_wf/5,
46
47 % enumerate_total_bijection/3,
48 total_bijection/3, total_bijection_wf/4,
49
50 not_total_function/4,
51 not_total_bijection/4,
52
53
54 range_restriction_wf/4, range_subtraction_wf/4,
55 in_range_restriction_wf/4, not_in_range_restriction_wf/4,
56 in_range_subtraction_wf/4, not_in_range_subtraction_wf/4,
57 domain_restriction_wf/4, domain_subtraction_wf/4,
58 in_domain_restriction_wf/4, not_in_domain_restriction_wf/4,
59 in_domain_subtraction_wf/4, not_in_domain_subtraction_wf/4,
60 override_relation/4,
61 in_override_relation_wf/4, not_in_override_relation_wf/4,
62 image_wf/4, image_for_closure1_wf/4,
63 special_operator_for_image/3, image_for_special_operator/5, apply_fun_for_special_operator/6,
64
65 in_domain_wf/3, not_in_domain_wf/3,
66 apply_to/4, apply_to/5, apply_to/6,
67 override/5,
68
69 %sum_over_range/2, mul_over_range/2,
70
71 disjoint_union_generalized_wf/3,
72
73 partial_surjection/3, not_partial_surjection_wf/4,
74 partial_surjection_test_wf/5,
75
76 total_relation_wf/4,
77 not_total_relation_wf/4,
78
79 surjection_relation_wf/4, total_surjection_relation_wf/4,
80 not_surjection_relation_wf/4, not_total_surjection_relation_wf/4,
81
82 total_surjection/3, total_surjection_wf/4,
83 not_total_surjection_wf/4,
84
85 partial_injection/3, partial_injection_wf/4,
86 not_partial_injection/4,
87
88 total_injection/3, total_injection_wf/4,
89 not_total_injection/4,
90
91 partial_bijection/3, partial_bijection_wf/4,
92 not_partial_bijection/4,
93
94 relational_trans_closure_wf/3, %relational_reflexive_closure/2,
95 in_closure1_wf/3, not_in_closure1_wf/3
96 ]).
97
98
99 :- use_module(library(terms)).
100 :- use_module(self_check).
101
102 :- use_module(debug).
103 :- use_module(tools).
104
105 :- use_module(module_information,[module_info/2]).
106 :- module_info(group,kernel).
107 :- module_info(description,'This module provides more advanced operations for the basic datatypes of ProB (mainly for relations, functions, sequences).').
108
109 :- use_module(tools_printing).
110
111 :- use_module(delay).
112
113 :- use_module(typechecker).
114 :- use_module(error_manager).
115
116 :- use_module(kernel_objects).
117 :- use_module(kernel_records).
118 :- use_module(kernel_tools).
119
120 :- use_module(kernel_waitflags).
121 :- use_module(kernel_equality,[equality_objects_wf/4]).
122
123 :- use_module(custom_explicit_sets).
124 :- use_module(avl_tools,[avl_fetch_pair/3]).
125 :- use_module(bool_pred,[negate/2]).
126 :- use_module(closures,[is_symbolic_closure/1]).
127 :- use_module(bsyntaxtree, [conjunct_predicates/2,
128 mark_bexpr_as_symbolic/2,
129 create_texpr/4,
130 safe_create_texpr/3,
131 get_texpr_type/2
132 ]).
133
134 /* --------- */
135 /* SEQUENCES */
136 /* ------- - */
137
138 :- assert_must_succeed((bsets_clp:empty_sequence([]))).
139 :- assert_must_fail((bsets_clp:empty_sequence([int(1)]))).
140 ?empty_sequence(X) :- empty_set(X). % TO DO: add WF
141
142 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_empty_sequence([(int(2),int(33)),(int(1),int(22))]))).
143 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_empty_sequence([(int(1),int(33))]))).
144 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_empty_sequence([]))).
145
146 not_empty_sequence(X) :- var(X),!,
147 X = [(int(1),_)|_].
148 not_empty_sequence(X) :- is_custom_explicit_set_nonvar(X),!,
149 is_non_empty_explicit_set(X).
150 not_empty_sequence([(int(_),_)|_]). % clousure, avl_set dealt with clause above
151
152 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_empty_sequence_wf([(int(1),int(33))],WF),WF)).
153 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_empty_sequence_wf([(int(1),pred_true),(int(2),pred_false)],WF),WF)).
154 not_empty_sequence_wf(X,_WF) :- nonvar(X),!, not_empty_sequence(X).
155 not_empty_sequence_wf(X,WF) :-
156 (preferences:preference(use_smt_mode,true) -> not_empty_sequence(X)
157 ; get_enumeration_starting_wait_flag(not_empty_sequence_wf,WF,LWF),
158 not_empty_sequence_lwf(X,LWF)).
159
160 :- block not_empty_sequence_lwf(-,-).
161 not_empty_sequence_lwf(S,_) :- nonvar(S),!,not_empty_sequence(S).
162 not_empty_sequence_lwf([(int(1),_)|_],_).
163
164 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:is_sequence([(int(1),int(22))],[int(22)]))).
165 :- assert_must_succeed(bsets_clp:is_sequence(closure(['_zzzz_unit_tests'],[couple(integer,integer)],b(member(b(identifier('_zzzz_unit_tests'),couple(integer,integer),[generated]),b(value([(int(1),int(22))]),set(couple(integer,integer)),[])),pred,[])),[int(22)])).
166
167 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:is_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
168 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)]))).
169 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(1),int(33)),(int(0),int(22))],[int(22),int(33),int(44)]))).
170 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(3),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
171 :- assert_must_succeed((is_sequence(R,global_set('Name')),R = [])).
172 :- assert_must_succeed((is_sequence(R,global_set('Name')),
173 R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
174 :- assert_must_succeed((is_sequence(R,global_set('Name')),
175 R = [(int(1),fd(2,'Name'))] )).
176 :- assert_must_succeed((is_sequence(R,global_set('Name')),
177 R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
178 :- assert_must_succeed((is_sequence(R,global_set('Name')),
179 R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
180 :- assert_must_succeed((is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
181 global_set('Name')) )).
182 :- assert_must_succeed((is_sequence(R,[int(1),int(2)]),
183 R = [(int(2),int(2)),(int(1),int(1))] )).
184 :- assert_must_fail((is_sequence(R,[int(1),int(2)]),
185 R = [(int(2),int(2)),(int(3),int(1))] )).
186 :- assert_must_fail((is_sequence(R,[int(1),int(2)]),
187 R = [(int(2),int(2)),(int(1),int(3))] )).
188 :- assert_must_fail((is_sequence(R,global_set('Name')),
189 R = [(int(0),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
190 :- assert_must_succeed((is_sequence(X,global_set('Name')),
191 (preferences:get_preference(randomise_enumeration_order,true) -> true
192 ; kernel_objects:enumerate_basic_type(X,seq(global('Name')))),
193 X = [(int(1),fd(1,'Name'))])). % can take a long time with RANDOMISE_ENUMERATION_ORDER
194
195 is_sequence(X,Type) :- init_wait_flags(WF,[is_sequence]),
196 is_sequence_wf(X,Type,WF),
197 ? ground_wait_flags(WF).
198
199 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([int(1),int(2),int(3)],WF),WF)).
200 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([int(1)],WF),WF)).
201 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([],WF),WF)).
202 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:is_sequence_domain([int(0)],WF),WF)).
203 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:is_sequence_domain([int(2),int(3)],WF),WF)).
204 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_is_sequence_domain([int(2),int(3)],WF),WF)).
205 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_is_sequence_domain([int(0)],WF),WF)).
206 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_is_sequence_domain([int(1)],WF),WF)).
207 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_is_sequence_domain([],WF),WF)).
208
209 % check if a set is the domain of a sequence, i.e., an interval 1..n with n>=0
210 :- use_module(custom_explicit_sets,[construct_interval_closure/3]).
211 :- use_module(kernel_cardinality_attr,[finite_cardinality_as_int_wf/3]).
212 :- block is_sequence_domain(-,?).
213 is_sequence_domain(Domain,WF) :-
214 finite_cardinality_as_int_wf(Domain,int(Max),WF),
215 construct_interval_closure(1,Max,Interval), equal_object_wf(Domain,Interval,is_sequence_domain,WF).
216 :- block not_is_sequence_domain(-,?).
217 not_is_sequence_domain(Domain,WF) :-
218 finite_cardinality_as_int_wf(Domain,int(Max),WF),
219 construct_interval_closure(1,Max,Interval), not_equal_object_wf(Domain,Interval,WF).
220
221 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true)],
222 [pred_true,pred_false],WF),WF)).
223 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true),(int(2),pred_false),(int(3),pred_true)],
224 [pred_true,pred_false],WF),WF)).
225 :- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R)],[pred_true],_WF),X==1, R==pred_true)).
226 :- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R),(int(Y),R)],[pred_true],_WF),X=2,
227 (preferences:preference(use_clpfd_solver,true) -> Y==1 ; Y=1), R==pred_true)).
228
229 is_sequence_wf(Seq,Range,WF) :- is_sequence_wf_ex(Seq,Range,WF,_).
230 % is_sequence_wf_ex also returns expansion; if it was done
231 :- block is_sequence_wf_ex(-,?,?,?).
232 is_sequence_wf_ex(FF,Range,WF,FF) :-
233 nonvar(FF), FF = closure(_,_,_),
234 custom_explicit_sets:is_definitely_maximal_set(Range),
235 % we do not need the Range; this means we can match more closures (e.g., lambda)
236 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
237 is_sequence_domain(FFDomain,WF).
238 is_sequence_wf_ex(Seq,Range,WF,Res) :-
239 expand_and_convert_to_avl_set_warn(Seq,AER,is_sequence_wf_ex,'ARG : seq(?)',WF),!,
240 is_avl_sequence(AER),
241 is_avl_relation_over_range(AER,Range,WF),
242 custom_explicit_sets:construct_avl_set(AER,Res).
243 is_sequence_wf_ex(X,Type,WF,EX) :-
244 % try_ensure_seq_numbering(X,1),
245 expand_custom_set_to_list_wf(X,EX,_,is_sequence_wf_ex,WF),
246 is_sequence2(EX,[],Type,0,_MinSize,WF).
247
248 % will make this much faster x:seq(STRING) & card(x)=400 & 401:dom(x) (40 ms rather than > 2 secs)
249 % but this does not work -eval_file /Users/leuschel/git_root/prob_examples/examples/Setlog/prob-ttf/plavis-TransData_SP_21_simplified.prob
250 %:- block try_ensure_seq_numbering(-,?).
251 %try_ensure_seq_numbering([H|T],NextNr) :- var(H),!, print(nr(NextNr)),nl,
252 % H = (int(NextNr),_), N1 is NextNr+1,
253 % try_ensure_seq_numbering(T,N1).
254 %try_ensure_seq_numbering(_,_).
255
256 :- block is_sequence2(-,?,?,?,?,?).
257 is_sequence2([],IndexesSoFar,_Type,Size,MinSize,_WF) :- MinSize = Size,
258 contiguous_set_of_indexes(IndexesSoFar,Size).
259 /* not very good to do the checking at the end; can we move part of the checking earlier ? */
260 is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,Size,MinSize,WF) :-
261 less_than_direct(0,Idx), %is_index_greater_zero(Idx),
262 not_element_of_wf(int(Idx),IndexesSoFar,WF),
263 check_element_of_wf(X,Type,WF), S1 is Size+1,
264 clpfd_interface:clpfd_leq(Idx,MinSize,_Posted),
265 (var(Tail)
266 -> clpfd_interface:clpfd_domain(MinSize,Low,_Up), % TO DO: ensure that final size at least Low
267 (number(Low),Low>S1 -> Tail = [_|_] % TO DO: proper reification; what if MinSize gets constrained later
268 ; expand_seq_if_necessary(Idx,S1,Tail)) % the sequence must be longer; force it
269 ; true
270 ),
271 is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,S1,MinSize,WF).
272
273 :- block expand_seq_if_necessary(-,?,-).
274 expand_seq_if_necessary(MinSize,S1,Tail) :- % TO DO: proper reification on MinSize above
275 number(MinSize), MinSize>S1, (var(Tail) ; Tail==[]),
276 !,
277 Tail = [_|_].
278 expand_seq_if_necessary(_,_,_).
279
280 :- block contiguous_set_of_indexes(-,?).
281 contiguous_set_of_indexes([],_).
282 contiguous_set_of_indexes([H|T],Size) :- contiguous_set_of_indexes1(T,H,Size).
283
284 :- block contiguous_set_of_indexes1(-,?,?).
285 contiguous_set_of_indexes1([],int(1),_).
286 contiguous_set_of_indexes1([int(H2)|T],int(H1),Size) :- less_than_equal_direct(H1,Size),
287 less_than_equal_direct(H2,Size), less_than_equal_indexes(T,[H1,H2],Size).
288
289
290 less_than_equal_indexes([],All,_) :- clpfd_interface:clpfd_alldifferent(All).
291 less_than_equal_indexes([int(H)|T],All,Size) :- less_than_equal_direct(H,Size),less_than_equal_indexes(T,[H|All],Size).
292
293 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(4),int(7))],[int(7),int(6)],WF),WF)).
294 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(3),int(8))],[int(7),int(6)],WF),WF)).
295 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(7),int(6)],WF),WF)).
296 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(2),int(6)),(int(3),int(7)),(int(4),int(7))],[int(7),int(6)],WF),WF)).
297 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(0),int(7)),(int(2),int(7))],[int(7),int(6)],WF),WF)).
298 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(1),int(22))],[int(22)]))).
299 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
300 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)]))).
301 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_sequence([(int(3),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
302 :- assert_must_fail((not_is_sequence(R,global_set('Name')),R = [])).
303 :- assert_must_fail((not_is_sequence(R,global_set('Name')),
304 R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
305 :- assert_must_fail((not_is_sequence(R,global_set('Name')),
306 R = [(int(1),fd(2,'Name'))] )).
307 :- assert_must_fail((not_is_sequence(R,global_set('Name')),
308 R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
309 :- assert_must_fail((not_is_sequence(R,global_set('Name')),
310 R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
311 :- assert_must_fail((not_is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
312 global_set('Name')) )).
313 :- assert_must_fail((not_is_sequence(R,[int(1),int(2)]),
314 R = [(int(2),int(2)),(int(1),int(1))] )).
315 :- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
316 R = [(int(2),int(2)),(int(3),int(1))] )).
317 :- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
318 R = [(int(2),int(2)),(int(1),int(3))] )).
319
320
321 not_is_sequence(X,Type) :- init_wait_flags(WF,[not_is_sequence]),
322 not_is_sequence_wf(X,Type,WF),
323 ground_wait_flags(WF).
324
325 :- block not_is_sequence_wf(-,?,?).
326 not_is_sequence_wf(FF,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
327 % we do not need the Range; this means we can match more closures (e.g., lambda)
328 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
329 not_is_sequence_domain(FFDomain,WF).
330 not_is_sequence_wf(Seq,Range,WF) :-
331 expand_and_convert_to_avl_set_warn(Seq,AER,not_is_sequence_wf,'ARG /: seq(?)',WF),
332 !,
333 (is_avl_sequence(AER) -> is_not_avl_relation_over_range(AER,Range,WF)
334 ; true).
335 not_is_sequence_wf(X,Type,WF) :- expand_custom_set_to_list_wf(X,EX,_Done,not_is_sequence_wf,WF),
336 not_is_sequence2(EX,[],Type,WF).
337
338 :- block not_is_sequence2(-,?,?,?).
339 ?not_is_sequence2([],IndexesSoFar,_,_WF) :- not_contiguous_set_of_indexes(IndexesSoFar).
340 not_is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,WF) :-
341 membership_test_wf(IndexesSoFar,int(Idx),MemRes,WF),
342 ? not_is_sequence3(MemRes,Idx,X,Tail,IndexesSoFar,Type,WF).
343
344 :- block not_is_sequence3(-,?,?,?,?,?,?).
345 not_is_sequence3(pred_true,_Idx,_X,_Tail,_IndexesSoFar,_Type,_WF).
346 not_is_sequence3(pred_false,Idx,_X,_Tail,_IndexesSoFar,_Type,_WF) :- nonvar(Idx),Idx<1,!.
347 not_is_sequence3(pred_false,Idx,X,Tail,IndexesSoFar,Type,WF) :-
348 membership_test_wf(Type,X,MemRes,WF),
349 ? not_is_sequence4(MemRes,Idx,Tail,IndexesSoFar,Type,WF).
350
351 :- block not_is_sequence4(-,?,?,?,?,?).
352 not_is_sequence4(pred_false,_Idx,_Tail,_IndexesSoFar,_Type,_WF).
353 not_is_sequence4(pred_true,Idx,Tail,IndexesSoFar,Type,WF) :-
354 ? not_is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,WF).
355
356 not_contiguous_set_of_indexes(Indexes) :-
357 ? when(ground(Indexes),(sort(Indexes,Sorted),not_contiguous_set_of_indexes2(Sorted,1))).
358 not_contiguous_set_of_indexes2([int(N)|T],N1) :-
359 ? when(?=(N,N1),
360 ((N \= N1) ; (N=N1, N2 is N1+1, not_contiguous_set_of_indexes2(T,N2)))).
361
362
363
364
365
366 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(22))],[int(22)]))).
367 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(2))],[int(22)]))).
368 :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),R = [])).
369 :- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
370 R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
371 :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
372 R = [(int(2),fd(1,'Name')),(int(4),fd(2,'Name'))] )).
373 :- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
374 R = [(int(1),fd(1,'Name')),(int(2),fd(1,'Name'))] )).
375 :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,[int(1),int(2)]),
376 R = [(int(1),int(2)),(int(2),int(3))] )).
377
378 % S /: seq1(T)
379 not_is_non_empty_sequence_wf(S,T,_) :- not_is_non_empty_sequence(S,T).
380 :- block not_is_non_empty_sequence(-,?).
381 not_is_non_empty_sequence([],_) :- !.
382 not_is_non_empty_sequence(X,Type) :-
383 empty_sequence(X) ; not_is_sequence(X,Type).
384
385
386
387 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
388 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
389 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
390 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(22)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
391 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([],global_set('Name'),WF),WF)).
392 :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
393 kernel_waitflags:ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
394 :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
395 ground_det_wait_flag(WF), R = [(int(1),fd(2,'Name'))] )).
396 :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
397 ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
398 :- assert_must_fail((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
399 ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
400 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_sequence_wf([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
401 global_set('Name'),WF),WF) ).
402 :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
403 ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
404 :- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
405 ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(3),int(1))] )).
406 :- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
407 ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
408
409
410
411 :- block injective_sequence_wf(-,-,?).
412 injective_sequence_wf(Seq,Type,WF) :- /* corresponds to iseq */
413 nonvar(Seq),
414 %expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)',WF),
415 Seq=avl_set(AER),
416 !,
417 is_avl_sequence(AER),
418 is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
419 is_avl_relation_over_range(AER,Type,WF).
420 injective_sequence_wf(Seq,Type,WF) :-
421 cardinality_as_int_for_wf(Type,MaxCard),
422 custom_explicit_sets:blocking_nr_iseq(MaxCard,ISeqSize),
423 block_get_wait_flag(ISeqSize,injective_sequence_wf,WF,LWF),
424 injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF).
425
426 :- block injective_sequence_wf_aux(-,?,?,?,-).
427 injective_sequence_wf_aux(Seq,Type,_,WF,_) :- /* corresponds to iseq */
428 nonvar(Seq),
429 expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)',WF),!,
430 %Seq=avl_set(AER),
431 !,
432 is_avl_sequence(AER),
433 is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
434 is_avl_relation_over_range(AER,Type,WF).
435 injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF) :-
436 expand_custom_set_to_list_wf(Seq,ESeq,_,injective_sequence_wf,WF),
437 is_sequence_wf(ESeq,Type,WF),
438 injective_sequence2(ESeq,0,[],Type,WF,MaxCard,LWF).
439
440 :- block injective_sequence2(-,?,?,?,?,?,-),injective_sequence2(-,?,?,?,?,-,?).
441 injective_sequence2([],_,_,_Type,_WF,_MaxCard,_LWF).
442 injective_sequence2([(int(Index),X)|Tail],CardSoFar,SoFar,Type,WF,MaxCard,LWF) :-
443 (number(MaxCard) -> CardSoFar< MaxCard, %less_than_equal_direct(Index,MaxCard) % does not enumerate index
444 in_nat_range_wf(int(Index),int(0),int(MaxCard),WF) % ensures the index gets enumerated, see test 1914, x:iseq(50001..50002) & y:1..100005 & SIGMA(yy).(yy:dom(x)|x(yy)) = y & y>50002
445 ; true),
446 check_element_of_wf(X,Type,WF),
447 not_element_of_wf(X,SoFar,WF),
448 add_new_element_wf(X,SoFar,SoFar2,WF),
449 C1 is CardSoFar+1,
450 (C1 == MaxCard -> Tail=[] ; true),
451 injective_sequence2(Tail,C1,SoFar2,Type,WF,MaxCard,LWF).
452
453
454 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
455 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
456 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_injective_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
457 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_injective_sequence([(int(2),int(22)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
458 :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),_WF),R = [])).
459 :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
460 ground_det_wait_flag(WF),
461 R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
462 :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
463 ground_det_wait_flag(WF),
464 R = [(int(1),fd(2,'Name'))] )).
465 :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
466 ground_det_wait_flag(WF),
467 R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
468 :- assert_must_fail((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
469 ground_det_wait_flag(WF),
470 R = [(int(2),int(2)),(int(1),int(1))] )).
471 :- assert_must_succeed((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
472 ground_det_wait_flag(WF),
473 R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
474 :- assert_must_succeed((bsets_clp:not_injective_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
475 global_set('Name'),WF),
476 ground_det_wait_flag(WF) )).
477 :- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
478 ground_det_wait_flag(WF),
479 R = [(int(2),int(2)),(int(3),int(1))] )).
480 :- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
481 ground_det_wait_flag(WF),
482 R = [(int(2),int(2)),(int(1),int(3))] )).
483 :- block not_injective_sequence(-,?,?), not_injective_sequence(?,-,?).
484 not_injective_sequence(Seq,_,_) :- Seq==[],!,fail.
485 not_injective_sequence(Seq,Type,WF) :- nonvar(Seq),
486 expand_and_convert_to_avl_set_warn(Seq,AER,not_injective_sequence,'ARG /: iseq(?)',WF),!,
487 (\+ is_avl_sequence(AER) -> true
488 ; is_injective_avl_relation(AER,ExactRange) -> not_subset_of_wf(ExactRange,Type,WF)
489 ; true).
490 not_injective_sequence(Seq,Type,WF) :- /* corresponds to Iseq */
491 %get_middle_wait_flag(not_injective_sequence,WF,LWF),
492 ground_value_check(Seq,SV),
493 not_injective_sequence1(Seq,Type,WF,SV).
494 :- block not_injective_sequence1(?,?,?,-).
495 not_injective_sequence1(Seq,Type,WF,_) :-
496 expand_custom_set_to_list_wf(Seq,ESeq,_,not_injective_sequence1,WF),
497 (not_is_sequence_wf(ESeq,Type,WF)
498 ; /* CHOICE POINT !! */
499 (is_sequence_wf(ESeq,Type,WF),not_injective_sequence2(ESeq,[],Type,WF))).
500 :- block not_injective_sequence2(-,?,?,?).
501 not_injective_sequence2([(int(_),X)|Tail],SoFar,Type,WF) :-
502 membership_test_wf(SoFar,X,MemRes,WF),
503 not_injective_sequence3(MemRes,X,Tail,SoFar,Type,WF).
504
505 :- block not_injective_sequence3(-,?,?,?,?,?).
506 not_injective_sequence3(pred_true,_X,_Tail,_SoFar,_Type,_WF).
507 not_injective_sequence3(pred_false,X,Tail,SoFar,Type,WF) :-
508 add_new_element_wf(X,SoFar,SoFar2,WF),
509 not_injective_sequence2(Tail,SoFar2,Type,WF).
510
511 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
512 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
513 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
514 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(33))],[int(44),int(33),int(22)],WF),WF)).
515 :- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
516 ground_det_wait_flag(WF), R = [])).
517 :- assert_must_fail((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
518 ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
519 :- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,[int(1),int(2)],WF),
520 ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
521
522 :- block not_non_empty_injective_sequence(-,?,?).
523 not_non_empty_injective_sequence([],_Type,_WF) :- !.
524 not_non_empty_injective_sequence(X,Type,WF) :-
525 empty_sequence(X) ; not_injective_sequence(X,Type,WF).
526
527
528 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
529 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
530 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_non_empty_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
531 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_non_empty_sequence([(int(2),int(44)),(int(1),int(44))],[int(22),int(33),int(44)],WF),WF)).
532 :- assert_must_fail((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
533 ground_det_wait_flag(WF),R = [])).
534 :- assert_must_succeed((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
535 ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
536 :- block injective_non_empty_sequence(-,-,?). /* corresponds to iseq1 */
537 injective_non_empty_sequence(A,Type,WF) :- nonvar(A),A=avl_set(AS), !,
538 injective_sequence_wf(avl_set(AS),Type,WF),is_non_empty_explicit_set_wf(avl_set(AS),WF).
539 injective_non_empty_sequence(Seq,Type,WF) :-
540 ((nonvar(Seq),Seq=closure(_,_,_)) -> try_expand_custom_set_wf(Seq,ESeq,injective_non_empty_sequence,WF) ; ESeq=Seq),
541 injective_sequence_wf(ESeq,Type,WF),not_empty_sequence_wf(ESeq,WF).
542
543 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
544 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(33)),(int(2),int(33))],[int(22),int(33)],WF),WF)).
545 :- assert_must_fail((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF),ground_det_wait_flag(WF),ground_det_wait_flag(WF),R = [])).
546 :- assert_must_succeed((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF),
547 ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
548 :- block finite_non_empty_sequence(-,?,?).
549 finite_non_empty_sequence(Seq,Type,WF) :- /* corresponds to Seq1 */
550 is_sequence_wf_ex(Seq,Type,WF,ESeq),
551 (var(ESeq) -> not_empty_sequence_wf(Seq,WF) ; not_empty_sequence_wf(ESeq,WF)).
552
553
554 :- block test_finite_non_empty_sequence(-,?,-,?).
555 test_finite_non_empty_sequence(Seq,_Type,Res,_WF) :-
556 Seq == [],!, Res=pred_false.
557 test_finite_non_empty_sequence(Seq,Type,Res,WF) :- var(Res),!,
558 ground_value_check(Seq,GrSeq),
559 test_finite_non_empty_sequence2(Res,Seq,Type,GrSeq,WF). % will trigger and enumerate Res below
560 % Note: we cannot rely on Res being enumerated; e.g., in case a WD error occurs
561 test_finite_non_empty_sequence(Seq,Type,Res,WF) :-
562 test_finite_non_empty_sequence2(Res,Seq,Type,_,WF).
563
564 % TODO: improve to incrementally check if something is a sequence
565 :- block test_finite_non_empty_sequence2(-,?,?,-,?).
566 test_finite_non_empty_sequence2(pred_true,Seq,Type,_,WF) :-
567 finite_non_empty_sequence(Seq,Type,WF).
568 test_finite_non_empty_sequence2(pred_false,Seq,Type,_,WF) :-
569 not_is_non_empty_sequence_wf(Seq,Type,WF).
570
571
572
573 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
574 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(2),int(33)),(int(1),int(22))],[int(22),int(33)],WF),WF)).
575 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:permutation_sequence_wf([(int(2),int(33)),(int(1),int(23))],[int(23),int(33),int(44)],WF),WF)).
576 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:permutation_sequence_wf([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)).
577 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
578 ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
579 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
580 ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(2))] )).
581 :- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
582 ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
583 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[pred_true /* bool_true */,pred_false /* bool_false */],WF), kernel_waitflags:ground_wait_flags(WF), nonvar(R),
584 R = [(int(1),pred_false /* bool_false */),(int(2),pred_true /* bool_true */)] )).
585 :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
586 ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
587 :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),ground_det_wait_flag(WF),R = [])).
588 :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
589 ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
590 :- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
591 ground_det_wait_flag(WF),
592 kernel_objects:equal_object(R,[(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))]) )).
593 :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
594 ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
595 :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
596 ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
597 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(4),int(3),int(2),int(1)],WF),
598 ground_det_wait_flag(WF), R=[(int(1),int(1)),(int(2),int(2)),(int(3),int(3)),(int(4),int(4))])).
599
600 :- block permutation_sequence_wf(-,-,?).
601 permutation_sequence_wf(SeqFF,Type,WF) :- nonvar(SeqFF),
602 custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection),WF),!,
603 equal_object_wf(FFRange,Type,permutation_sequence_wf_1,WF),
604 is_sequence_domain(FFDomain,WF).
605 permutation_sequence_wf(Seq,Type,WF) :-
606 expand_and_convert_to_avl_set_warn(Seq,AER,permutation_sequence_wf,'ARG : perm(?)',WF),!,
607 is_avl_sequence(AER),
608 is_injective_avl_relation(AER,Range),
609 kernel_objects:equal_object_wf(Range,Type,permutation_sequence_wf_2,WF).
610 permutation_sequence_wf(Seq,Type,WF) :-
611 try_expand_custom_set_wf(Seq,ESeq,permutation_sequence_wf,WF),
612 cardinality_as_int_wf(Type,int(Card),WF),
613 when(nonvar(Card), (setup_sequence_wf(Card,SkelSeq,perm,WF),
614 CardGround=true,
615 kernel_objects:equal_object_wf(SkelSeq,ESeq,permutation_sequence_wf_3,WF))),
616 %injective_sequence_wf(ESeq,Type,WF,LWF),
617 surjective_iseq_0(SkelSeq,ESeq,Type,WF,Card,CardGround).
618 % quick_all_different_range(ESeq,[],Type,WF). % see all_different_wf
619
620 :- block surjective_iseq_0(-,-,?,?,?,-).
621 surjective_iseq_0(SkelSeq,_ESeq,Type,WF,_Card,Ground) :-
622 nonvar(Ground),
623 nonvar(SkelSeq),
624 preference(use_clpfd_solver,true), % try and use an optimized version calling global_cardinality in CLPFD module
625 ? get_global_cardinality_list(Type,YType,GCL,_,WF),
626 % this dramatically reduces runtime for NQueens40_perm; maybe we should do this only when necessary, i.e., when surjective_iseq blocks on PreviousRemoveDone
627 % check why it slows down SortByPermutation_v2
628 !,
629 global_cardinality_range(SkelSeq,[],YType,GCL,WF).
630 surjective_iseq_0(_,ESeq,Type,WF,Card,_) :-
631 %quick_propagate_range(ESeq,Type,WF), % ensure that we propagate type information to all elements; p:perm(5..20) & p(10)=21 will fail straightaway (surjective_iseq will block);
632 % but this slows down EulerWay.mch ; maybe because it sets up enumerators ? TO DO: investigate
633 surjective_iseq(ESeq,Type,WF,Card).
634
635 %:- use_module(clpfd_interface,[clpfd_alldifferent/1]).
636 % collect range and then call CLPFD global_cardinality using GCL (Global Cardinality List Ki-Vi)
637 :- use_module(library(clpfd), [global_cardinality/3]).
638 :- block global_cardinality_range(-,?,?,?,?).
639 global_cardinality_range([],Acc,_Type,GCL,WF) :-
640 global_cardinality(Acc,GCL,[consistency(value)]),
641 add_fd_variables_for_labeling(Acc,WF). % this is needed for efficiency for NQueens40_perm !!
642 global_cardinality_range([(_,Y)|T],Acc,Type,GCL,WF) :-
643 get_simple_fd_value(Type,Y,FDYVAL),
644 global_cardinality_range(T,[FDYVAL|Acc],Type,GCL,WF).
645
646
647 :- use_module(library(avl), [avl_domain/2]).
648 :- use_module(b_global_sets,[all_elements_of_type_wf/3,b_integer_set/1]).
649 % try and convert a B set into a list suitable for calling clpfd:global_cardinality
650 % get_global_cardinality_list(avl_set(A) % TO DO: extend to integer_lists
651 get_global_cardinality_list(global_set(G),Type,GCL,list,WF) :- !,
652 all_elements_of_type_wf(G,Values,WF), % can only work for finite sets, not for STRING, NATURAL, REAL, ...
653 (b_integer_set(G) -> Type=integer ; Type=global(G)),
654 findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
655 get_global_cardinality_list(avl_set(A),Type,GCL,list,_WF) :- !,
656 A = node(TopValue,_True,_,_,_),
657 ? get_simple_fd_value(Type,TopValue,_), % we have CLPFD values
658 avl_domain(A,Values),
659 findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
660 get_global_cardinality_list(Set,integer,GCL,interval(L1,U1),_WF) :- nonvar(Set),
661 is_interval_closure_or_integerset(Set,L1,U1), number(L1),number(U1),
662 global_cardinality_list_interval(L1,U1,GCL).
663
664 global_cardinality_list_interval(From,To,[]) :- From>To, !.
665 global_cardinality_list_interval(From,To,[From-1|T]) :-
666 F1 is From+1, global_cardinality_list_interval(F1,To,T).
667
668 %try_get_simple_fd_value(Type,V,Val) :- nonvar(V),get_simple_fd_value(Type,V,Val).
669 get_simple_fd_value(integer,int(X),X).
670 get_simple_fd_value(global(T),fd(X,T),X).
671 % try_get_simple_fd_value(pred_false,0). try_get_simple_fd_value(pred_true,1). ??
672 % TO DO: maybe also treat pairs ? but we need complete values; see module clpfd_lists !
673
674 setup_sequence_wf(0,R,_,_) :- !, R=[].
675 setup_sequence_wf(Card,_,PP,WF) :- \+ number(Card), !,
676 add_error_wf(infinite_sequence,'Cannot generate infinite sequence for', PP,unkown,WF). % triggered in test 1979
677 setup_sequence_wf(Card,[(int(1),_)|T] ,_PP,_WF) :- Card>0, C1 is Card-1,
678 setup_sequence(C1,T,2).
679 setup_sequence(0,R,_) :- !, R=[].
680 setup_sequence(Card,[(int(Nr),_)|T], Nr ) :- Card>0, C1 is Card-1,
681 N1 is Nr+1,
682 setup_sequence(C1,T,N1).
683
684 :- block surjective_iseq(?,?,?,-),surjective_iseq(?,-,?,?), surjective_iseq(-,?,?,?).
685 surjective_iseq(avl_set(S),Type,WF,Done) :-
686 expand_custom_set_wf(avl_set(S),ES,surjective_iseq,WF),
687 surjective_iseq(ES,Type,WF,Done).
688 surjective_iseq(closure(P,T,B),Type,WF,Done) :-
689 expand_custom_set_wf(closure(P,T,B),ES,surjective_iseq,WF),
690 surjective_iseq(ES,Type,WF,Done).
691 % no case for global_set: cannot be a relation
692 surjective_iseq([],T,WF,_) :- empty_set_wf(T,WF).
693 surjective_iseq([(int(_Nr),El)|Tail],Type,WF,_PreviousRemoveDone) :-
694 remove_element_wf(El,Type,NType,WF,Done),
695 surjective_iseq(Tail,NType,WF,Done).
696 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(1),int(22))],[int(22)],WF),WF)).
697 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33)],WF),WF)).
698 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(33)),(int(1),int(23))],[int(23),int(33),int(44)],WF),WF)).
699 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)).
700 :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
701 ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
702 :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
703 ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
704 :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
705 ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
706 :- assert_must_fail((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
707 ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))] )).
708 :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
709 ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
710 :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),_WF),R = [])).
711 :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
712 ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
713 :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
714 ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
715 :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
716 ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
717 :- block not_permutation_sequence(-,?,?).
718 not_permutation_sequence(SeqFF,Type,WF) :- nonvar(SeqFF),
719 custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection),WF),!,
720 equality_objects_wf(FFRange,Type,Result,WF),
721 when(nonvar(Result),(Result=pred_false -> true ; not_is_sequence_domain(FFDomain,WF))).
722 not_permutation_sequence(Seq,Type,WF) :-
723 ground_value_check(Seq,SV),
724 ? not_permutation_sequence1(Seq,Type,SV,WF).
725 :- block not_permutation_sequence1(?,-,?,?), not_permutation_sequence1(?,?,-,?).
726 not_permutation_sequence1(avl_set(A),Type,_,WF) :- is_ground_set(Type), !, Seq=avl_set(A),
727 if(not_injective_sequence(Seq,Type,WF),
728 true, % no backtracking required; we could even use regular if with ->
729 not_surj_avl(Seq,Type,WF)
730 ).
731 not_permutation_sequence1(avl_set(A),Type,_,WF) :- !, Seq=avl_set(A),
732 (not_injective_sequence(Seq,Type,WF)
733 ; injective_sequence_wf(Seq,Type,WF),
734 not_surj_avl(Seq,Type,WF)).
735 not_permutation_sequence1(Seq,Type,_,WF) :-
736 expand_custom_set_to_list_wf(Seq,ESeq,Done,not_permutation_sequence1,WF),
737 ? not_permutation_sequence2(ESeq,Type,WF,Done).
738
739 not_surj_avl(Seq,Type,WF) :- range_wf(Seq,Range,WF),
740 not_equal_object_wf(Range,Type,WF). % TO DO: one could even just check cardinality as Seq is inj
741 %expand_custom_set_to_list_wf(Seq,ESeq,_,not_permutation_sequence1,WF),
742 % not_surjective_seq(ESeq,Type,WF).
743 % check if it is a ground set that cannot be instantiated
744 is_ground_set(V) :- var(V),!,fail.
745 is_ground_set(avl_set(_)).
746 is_ground_set(global_set(_)).
747 is_ground_set([]).
748
749 % here we could have a choice point in WF0
750 :- block not_permutation_sequence2(?,?,?,-).
751 not_permutation_sequence2(Seq,Type,WF,_) :- not_injective_sequence(Seq,Type,WF).
752 not_permutation_sequence2(Seq,Type,WF,_) :-
753 injective_sequence_wf(Seq,Type,WF), not_surjective_seq(Seq,Type,WF).
754
755 :- block not_surjective_seq(-,?,?).
756 not_surjective_seq([],T,WF) :- not_empty_set_wf(T,WF).
757 not_surjective_seq([(int(_),El)|Tail],Type,WF) :-
758 delete_element_wf(El,Type,NType,WF),
759 not_surjective_seq(Tail,NType,WF).
760
761 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(1),int(22))],int(1),_WF))).
762 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(2),_WF))).
763 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(3),_WF))).
764 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22)),(int(3),int(33))],int(3),_WF))).
765 :- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),
766 X = [(int(1),int(2)),(int(2),int(1))],
767 R = int(2))).
768 :- assert_must_succeed((preferences:preference(use_clpfd_solver,false) -> true
769 ; preferences:preference(use_smt_mode,false) -> true
770 ; bsets_clp:size_of_sequence(X,R,_WF), R=int(RI),
771 clpfd_interface:clpfd_geq2(RI,2,_), nonvar(X), X = [(I1,_),(I2,_)|T],
772 I1==int(1), I2==int(2), T=[], RI==2 )).
773 :- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),X = [(int(1),_),(int(2),_)],R = int(2))).
774 :- assert_must_succeed((bsets_clp:size_of_sequence(X,_R,_WF),X =[(int(1),_),(int(2),_)] )).
775 :- assert_must_succeed_any((bsets_clp:size_of_sequence(X,int(2),_WF),nonvar(X),X=[_|Y],nonvar(Y),Y=[_|Z],Z==[])).
776 :- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
777 :- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
778 :- assert_must_succeed((bsets_clp:size_of_sequence([(int(1),int(4))],int(1),_WF))).
779 :- assert_must_succeed((bsets_clp:size_of_sequence([],_,_WF))).
780 :- assert_must_fail((bsets_clp:size_of_sequence(X,int(1),_WF),
781 X = [(int(1),_),(int(2),_)|_])).
782 :- block size_of_sequence(-,-,?).
783 ?size_of_sequence(Seq,int(Res),WF) :- size_of_sequence1(Seq,Res,WF),
784 set_up_sequence_skel(Seq,Res,WF).
785
786 % setup sequence skeleton if we have some CLPFD bounds information about the size
787 % currently still quite limited: only sets up if sequence is a variable; + does the setup only once
788 :- use_module(library(clpfd), [(#<=>)/2]).
789 :- use_module(clpfd_interface,[clpfd_domain/3]).
790 set_up_sequence_skel(Seq,Res,WF) :-
791 var(Seq), % to do: also deal with cases when Seq partially instantiated
792 var(Res),
793 preferences:preference(use_clpfd_solver,true),
794 !,
795 clpfd_interface:clpfd_geq2(Res,0,_), % assert that size must not be negative
796 clpfd_interface:try_post_constraint((Res#>0) #<=> Trigger), % generate reified trigger for when we can instantiate Seq
797 set_up_sequence_skel_aux(Seq,Res,Trigger,WF).
798 set_up_sequence_skel(_,_,_). % TO DO: check if Size interval shrinks
799 :- block set_up_sequence_skel_aux(-,?,-,?).
800 set_up_sequence_skel_aux(Seq,_Res,_Trigger,_WF) :-
801 nonvar(Seq),
802 !. % to do: also deal with cases when Seq partially instantiated
803 set_up_sequence_skel_aux(Seq,Res,_Trigger,_WF) :-
804 (number(Res) ; preferences:preference(use_smt_mode,true)),
805 !,
806 gen_seq_for_res(Res,Seq).
807 set_up_sequence_skel_aux(Seq,Res,_Trigger,WF) :-
808 get_large_finite_wait_flag(set_up_sequence_skel,WF,LWF),
809 % delay, avoid costly unification with partially instantiated list skeleton;
810 % TO DO: in future we may use the kernel_cardinality attribute instead
811 when((nonvar(LWF) ; nonvar(Seq) ; nonvar(Res)),
812 (nonvar(Seq) -> true ; gen_seq_for_res(Res,Seq))).
813
814 gen_seq_for_res(Res,Seq) :-
815 clpfd_domain(Res,FDLow,FDUp), % FDLow could also be 0
816 (number(FDLow) % it is ok if FDUp is sup, see test 1109
817 -> gen_sequence_skeleton(1,FDLow,FDUp,S),
818 Seq=S
819 ; true).
820 gen_sequence_skeleton(N,M,FDUp,S) :- N>M,!,(FDUp==M -> S=[] ; true).
821 gen_sequence_skeleton(N,Max,FDUp,[(int(N),_)|T]) :-
822 N1 is N+1,
823 gen_sequence_skeleton(N1,Max,FDUp,T).
824
825 :- block size_of_sequence1(-,-,?).
826 size_of_sequence1(Seq,ResInt,WF) :-
827 nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
828 size_of_custom_explicit_set(Seq,Size,WF),!,
829 ? equal_object_wf(Size,int(ResInt),size_of_sequence1,WF).
830 /* TO DO: CHECK BELOW: would it not be better to use cardinality ?? */
831 /*
832 size_of_sequence1(Seq,Size,WF) :- !,kernel_cardinality_attr:finite_cardinality_as_int_wf(Seq,int(Size),WF), check_indexes(Seq,Size).
833
834 construct_interval_closure(1,Size,Domain),
835 total_function_wf(FF,Domain,Range,_WF)
836 % we could also call total_function 1..Size --> _RangeType; would setup domain ?
837 :- block check_indexes(-,?).
838 check_indexes([],_) :- !.
839 check_indexes([(int(X),_)|T],Size) :- !,
840 less_than_equal_direct(X,Size), check_indexes(T,Size).
841 check_indexes(_,_).
842 */
843 ?size_of_sequence1(Seq,Size,_WF) :- Size==0,!, empty_sequence(Seq).
844 size_of_sequence1(Seq,Size,WF) :-
845 expand_custom_set_to_list_wf(Seq,ESeq,_,size_of_sequence1,WF),
846 ? (var(ESeq),nonvar(Size) -> size_of_var_seq(ESeqR,0,Size),
847 ESeqR=ESeq % unify after to do propagation in one go, without triggering coroutines inbetween
848 ? ; size_of_seq2(ESeq,0,Size),
849 (var(Size),var(ESeq) -> less_than_equal_direct(0,Size) % propagate that Size is positive
850 ; true)
851 ).
852 /* small danger of expanding closure while still var !*/
853 :- block size_of_seq2(-,?,-).
854 size_of_seq2([],Size,Size).
855 size_of_seq2([I|Tail],SizeSoFar,Res) :-
856 S2 is SizeSoFar + 1,
857 ? check_index(I,Res), % don't instantiate I yet; allow other kernel_predicates to freely instantiate it
858 less_than_equal_direct(S2,Res),
859 %(ground(Res) -> safe_less_than_equal(size_of_seq2,S2,Res) ; true),
860 ? size_of_seq2(Tail,S2,Res).
861 size_of_var_seq([],Size,Size).
862 size_of_var_seq([(int(S2),_)|Tail],SizeSoFar,Res) :-
863 S2 is SizeSoFar + 1,safe_less_than_equal(size_of_var_seq,S2,Res),
864 ? (var(Tail) -> size_of_var_seq(Tail,S2,Res) ; size_of_seq2(Tail,S2,Res)).
865
866
867 :- block check_index(-,?).
868 ?check_index((I,_),Res) :- check_index1(I,Res).
869 :- block check_index1(-,?).
870 ?check_index1(int(Idx),Res) :- less_than_equal_direct(Idx,Res).
871
872 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(1),int(22))],[(int(2),int(22)),(int(1),int(33))],WF),WF)).
873 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[],[(int(1),int(33))],WF),WF)).
874 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(2),int(44)),(int(1),int(22))],[(int(1),int(33)),(int(3),int(44)),(int(2),int(22))],WF),WF)).
875 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(1),int(22))],[(int(1),int(22)),(int(2),int(33))],WF),WF)).
876 :- assert_must_succeed((bsets_clp:prepend_sequence(int(7),[],[(int(1),int(7))],_WF))).
877 :- assert_must_succeed((bsets_clp:prepend_sequence(int(7),X,R,_WF),
878 X = [(int(2),int(4)),(int(1),int(3))],
879 kernel_objects:equal_object(R,[(int(1),int(7)),(int(2),int(3)),(int(3),int(4))]))).
880 % code for insert_front operator: El -> Seq
881 :- block prepend_sequence(?,-,-,?).
882 prepend_sequence(El,Seq,Res,_WF) :- Seq==[],!,
883 equal_object_optimized([(int(1),El)],Res,prepend_sequence).
884 prepend_sequence(El,Seq,Res,WF) :- nonvar(Seq),is_custom_explicit_set(Seq,prepend_sequence),
885 prepend_custom_explicit_set(Seq,El,ERes),!,
886 equal_sequence(Res,ERes,WF).
887 prepend_sequence(El,Seq,Res,WF) :- nonvar(Res),is_custom_explicit_set(Res,prepend_sequence),
888 tail_sequence_custom_explicit_set(Res,First,Tail,unknown,WF),!,
889 equal_object_wf(El,First,prepend_sequence,WF),
890 equal_sequence(Seq,Tail,WF).
891 prepend_sequence(El,Seq,Res,WF) :-
892 equal_cons_wf(Res,(int(1),El),ShiftSeq,WF),
893 shift_seq_indexes(Seq,1,ShiftSeq,WF).
894
895 :- block shift_seq_indexes(-,-,?,?),shift_seq_indexes(-,?,-,?).
896 shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :-
897 Offset == 0,!, equal_sequence(Seq,ShiftedSeq,WF).
898 shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- nonvar(Seq),!,
899 expand_custom_set_to_list_wf(Seq,ESeq,_,shift_seq_indexes,WF),
900 shift_seq_indexes2(ESeq,Offset,ShiftedSeq,WF,Done),
901 (Done == done
902 -> true
903 ; % also propagate in the other way: TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
904 NegOffset is -Offset,
905 expand_custom_set_to_list_wf(ShiftedSeq,ESeq1,_,shift_seq_indexes,WF),
906 shift_seq_indexes2(ESeq1,NegOffset,ESeq,WF,_)).
907 shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- NegOffset is -Offset,
908 % compute in the other direction; TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
909 expand_custom_set_to_list_wf(ShiftedSeq,ESeq,_,shift_seq_indexes,WF),
910 shift_seq_indexes2(ESeq,NegOffset,Seq,WF,Done),
911 (Done == done
912 -> true
913 ; % also propagate in the original way:
914 expand_custom_set_to_list_wf(Seq,ESeq1,_,shift_seq_indexes,WF),
915 shift_seq_indexes2(ESeq1,Offset,ESeq,WF,_)).
916
917 :- block shift_seq_indexes2(-,?,?,?,?).
918 ?shift_seq_indexes2([],_,R,WF,Done) :- !, Done = done, empty_set_wf(R,WF).
919 shift_seq_indexes2([Pair|Tail],Offset,Res,WF,Done) :- !,
920 Pair = (int(N),El),
921 ? equal_cons_wf(Res,(int(NewN),El),ShiftTail,WF),
922 int_plus(int(N),int(Offset),int(NewN)),
923 shift_seq_indexes2(Tail,Offset,ShiftTail,WF,Done).
924 shift_seq_indexes2(Seq,Offset,Res,WF,Done) :-
925 add_internal_error('Unexpected set argument: ',shift_seq_indexes2(Seq,Offset,Res,WF,Done)), fail.
926
927 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([(int(1),int(22))],int(33),[(int(2),int(33)),(int(1),int(22))],WF),WF)).
928 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([],int(33),[(int(1),int(33))],WF),WF)).
929 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([(int(2),int(44)),(int(1),int(22))],int(33),[(int(1),int(22)),(int(3),int(33)),(int(2),int(44))],WF),WF)).
930 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:append_sequence([(int(1),int(22))],int(33),[(int(1),int(33)),(int(2),int(22))],WF),WF)).
931 :- assert_must_succeed((bsets_clp:append_sequence([],int(7),[(int(1),int(7))],_WF))).
932 :- assert_must_succeed((bsets_clp:append_sequence(X,int(7),R,_WF),
933 X = [(int(2),int(4)),(int(1),int(3))],
934 kernel_objects:equal_object(R,[(int(1),int(3)),(int(2),int(4)),(int(3),int(7))]))).
935
936 % code for the insert_tail operator Seq<-El
937 :- block append_sequence(-,?,-,?).
938 append_sequence(Seq,El,Res,_WF) :- Seq==[],!,
939 equal_object_optimized([(int(1),El)],Res,append_sequence).
940 append_sequence(Seq,El,Res,WF) :-
941 nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
942 append_custom_explicit_set(Seq,El,ERes,WF),!,
943 equal_sequence(Res,ERes,WF).
944 append_sequence(Seq,El,Res,WF) :-
945 nonvar(Res),is_custom_explicit_set_nonvar(Res),
946 % we know result: deconstruct into last El and front Seq
947 front_sequence_custom_explicit_set(Res,Last,Front), !,
948 equal_object_wf(El,Last,append_sequence,WF),
949 equal_sequence(Seq,Front,WF).
950 append_sequence(Seq,El,Res,WF) :-
951 (var(Seq) -> size_of_sequence(Res,INewSize,WF), INewSize=int(NewSize) ; true),
952 equal_cons_wf(Res,(int(NewSize),El),ResT,WF),
953 append_sequence2(Seq,ResT,NewSize,WF).
954
955 :- block append_sequence2(-,?,-,?).
956 append_sequence2(Seq,ResT,_NewSize,WF) :- var(Seq),!,
957 equal_sequence(Seq,ResT,WF).
958 append_sequence2(Seq,ResT,NewSize,WF) :-
959 try_expand_custom_set_wf(Seq,ESeq,append_sequence2,WF),
960 equal_sequence(ESeq,ResT,WF),
961 size_of_sequence(ESeq,Size,WF),
962 int_plus(Size,int(1),int(NewSize)).
963
964 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:prefix_sequence([(int(1),int(22))],int(1),[(int(1),int(22))]))).
965 :- assert_must_succeed(exhaustive_kernel_succeed_check(bsets_clp:prefix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(2),[(int(1),int(11)),(int(2),int(22))]))).
966 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:prefix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(3),[(int(1),int(11)),(int(2),int(22))]))).
967 :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),X),X = [(int(1),int(1))])).
968 :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(0),[]),X = [(int(1),int(1))])).
969 :- assert_must_abort_wf((bsets_clp:prefix_sequence_wf(X,int(-1),_R,WF),X = [(int(1),int(1))]),WF).
970 :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(2),Y),
971 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
972 kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(3))]) )).
973 :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),Y),
974 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
975 kernel_objects:equal_object(Y,[(int(1),int(1))]) )).
976 :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(3),Y),
977 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
978 kernel_objects:equal_object(Y,X) )).
979
980 prefix_sequence(Seq,N,R) :- init_wait_flags(WF,[prefix_sequence]),
981 ? prefix_sequence_wf(Seq,N,R,WF),
982 ? ground_wait_flags(WF).
983
984 % Prefix of a sequence (s /|\ n)
985 prefix_sequence_wf(Seq,int(Num),Res,WF) :-
986 ? prefix_sequence1(Seq,Num,Res,WF),
987 ? propagate_size(Res,Num,WF).
988
989 % the size of the result of (s /|\ n) is the number n
990 :- block propagate_size(-,-,?).
991 propagate_size(Res,Num,WF) :-
992 var(Res),!,
993 (Num<0 -> preferences:preference(disprover_mode,false) % don't do anything; we may want to generate WD error
994 ? ; Num < 4 -> size_of_sequence(Res,int(Num),WF)
995 ; Prio is 1+Num // 100,
996 get_wait_flag(Prio,propagate_size,WF,LWF), % avoid setting up very large skeletons too early
997 block_size_of_sequence(LWF,Res,int(Num),WF)
998 ).
999 propagate_size(_,Num,_) :- number(Num), !. % no need to propagate
1000 propagate_size(_,_Num,_) :- \+ preferences:preference(find_abort_values,false),
1001 !. % do not propagate as we could prevent detection of WD errors below
1002 propagate_size([],Num,_WF) :- !,
1003 Num=0. % Note: this could prevent a wd-error being detected
1004 propagate_size(avl_set(A),Num,WF) :- var(Num),
1005 % with partially instantated sets we get slowdowns (SimpleCSGGrammar2_SlowCLPFD)
1006 % TO DO: treat list skeletons
1007 !,
1008 ? size_of_sequence(avl_set(A),int(Num),WF). % Note: this could prevent a wd-error being detected
1009 propagate_size(_,_,_). % should we also propagate the other way around ?
1010
1011 :- block block_size_of_sequence(-,?,?,?).
1012 block_size_of_sequence(_,Seq,Size,WF) :- size_of_sequence(Seq,Size,WF).
1013
1014 :- block prefix_sequence1(-,?,?,?), prefix_sequence1(?,-,?,?).
1015 prefix_sequence1(_Seq,Num,Res,WF) :- Num==0,!, empty_set_wf(Res,WF).
1016 prefix_sequence1(_Seq,Num,_Res,WF) :- Num<0,!, % according to version 1.8.8 of Atelier-B manual Num must be in 0..size(_Seq)
1017 add_wd_error('negative index in prefix_sequence (/|\\)! ', Num,WF).
1018 prefix_sequence1(Seq,Num,Res,WF) :-
1019 is_custom_explicit_set(Seq,prefix),
1020 prefix_of_custom_explicit_set(Seq,Num,ERes,WF),!, % TO DO: check Num <= size(Seq)
1021 equal_object_wf(Res,ERes,prefix_sequence1,WF).
1022 prefix_sequence1(Seq,Num,Res,WF) :-
1023 expand_custom_set_to_list_wf(Seq,ESeq,_,prefix_sequence1,WF),
1024 unify_same_index_elements(Res,ESeq,WF),
1025 unify_same_index_elements(Seq,Res,WF),
1026 ? prefix_seq(ESeq,Num,0,Res,WF).
1027 :- block prefix_seq(-,?,?,?,?).
1028 prefix_seq([],Max,Sze,Res,WF) :-
1029 (less_than_direct(Sze,Max)
1030 -> add_wd_error('index larger than size of sequence in prefix_sequence (/|\\)! ', (Max,Sze),WF)
1031 ; true),
1032 empty_set_wf(Res,WF).
1033 %(less_than(int(_Sze),int(_Max))
1034 % -> (print_message('Index bigger than sequence size in prefix_sequence (/|\\) !'),
1035 % print_message(Max))
1036 % /* in the AtelierB book this is allowed, in Wordsworth + AMN on web it is not ?? */
1037 % ; true).
1038 prefix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1039 ? prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1040 :- block prefix_seq2(-,?,?,?,?,?,?).
1041 prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :- % SizeSoFar is always ground
1042 ? (less_than_equal_direct(N,Max), equal_cons_wf(Res,(int(N),El),PTail,WF)
1043 ;
1044 less_than_direct(Max,N), equal_object_wf(Res,PTail,prefix_seq2,WF)
1045 ),
1046 ( SizeSoFar<N -> NewSizeSoFar=N ; NewSizeSoFar = SizeSoFar ),
1047 ? prefix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1048
1049 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:suffix_sequence([(int(1),int(22))],int(0),[(int(1),int(22))],WF),ground_det_wait_flag(WF))).
1050 :- assert_must_succeed(exhaustive_kernel_succeed_check(bsets_clp:suffix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(1),[(int(1),int(22)),(int(2),int(33))],_WF))).
1051 :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:suffix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(2),[(int(1),int(22)),(int(2),int(33))],_WF))).
1052 :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(0),X,_WF),X = [(int(1),int(1))])).
1053 :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),[],_WF),X = [(int(1),int(1))])).
1054 :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1055 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1056 kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1057 :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),Y,_WF),
1058 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1059 kernel_objects:equal_object(Y,[(int(1),int(3)),(int(2),int(4))]) )).
1060 :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1061 X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1062 kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1063 :- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(-1),_R,WF),WF).
1064 :- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(3),_R,WF),WF).
1065
1066 % kernel_waitflags:assert_must_abort2_wf(bsets_clp:suffix_sequence([int(11),int(22)],int(-1),_R,WF),WF)
1067
1068 % suffix of a sequence (s \|/ n); also called restrict at tail (Atelier B) or Drop
1069 :- block suffix_sequence(-,?,?,?).
1070 suffix_sequence(Seq,int(Num),Res,WF) :-
1071 ? suffix_sequence1(Seq,Num,Res,WF).
1072 :- block suffix_sequence1(?,-,?,?).
1073 suffix_sequence1(Seq,Num,Res,WF) :- Num==0, !, equal_object_wf(Res,Seq,suffix_sequence1_1,WF).
1074 suffix_sequence1(_Seq,Num,_Res,WF) :- Num<0, !, add_wd_error('negative index in suffix_sequence (\\|/)! ', Num,WF).
1075 suffix_sequence1(Seq,Num,Res,WF) :- is_custom_explicit_set(Seq,suffix),
1076 suffix_of_custom_explicit_set(Seq,Num,ERes,WF),!,
1077 equal_object_wf(Res,ERes,suffix_sequence1_2,WF).
1078 suffix_sequence1(Seq,Num,Res,WF) :-
1079 ? expand_custom_set_to_list_wf(Seq,ESeq,_,suffix_sequence,WF), suffix_seq(ESeq,Num,0,Res,WF).
1080 :- block suffix_seq(-,?,?,?,?).
1081 suffix_seq([],Max,Sze,Res,WF) :-
1082 (less_than_direct(Sze,Max)
1083 -> add_wd_error('index larger than size of sequence in suffix_sequence (\\|/)! ', '>'(Max,Sze),WF)
1084 ; true), empty_set_wf(Res,WF).
1085 suffix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1086 ? suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1087 :- block suffix_seq2(-,?,?,?,?,?,?).
1088 suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :-
1089 (less_than_equal_direct(N,Max), equal_object_wf(Res,PTail,suffix_seq2,WF)
1090 ;
1091 less_than_direct(Max,N),int_minus(int(N),int(Max),int(NN)),
1092 equal_cons_wf(Res,(int(NN),El),PTail,WF)
1093 ),
1094 (N>SizeSoFar -> (NewSizeSoFar=N)
1095 ; (NewSizeSoFar = SizeSoFar)),
1096 ? suffix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1097
1098
1099
1100 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([],[(int(1),int(33))],[(int(1),int(33))],WF),WF)).
1101 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:concat_sequence([(int(1),int(22)),(int(2),int(33))],[(int(1),int(33)),(int(2),int(44))],[(int(2),int(33)),(int(3),int(33)),(int(1),int(22)),(int(4),int(44))],WF),WF)). % not wfdet because of pending label_el_nr from clpfd_lists
1102 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([(int(1),int(22))],[(int(1),int(33))],[(int(2),int(33)),(int(1),int(22))],WF),WF)).
1103 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:concat_sequence([(int(1),int(22))],[(int(1),int(33))],[(int(2),int(22)),(int(1),int(33))],WF),WF)).
1104 :- assert_must_succeed((bsets_clp:concat_sequence([],X,Y,_WF),
1105 X = [(int(1),int(1))], Y==X)).
1106 :- assert_must_succeed((bsets_clp:concat_sequence(X,[],Y,_WF), X = [(int(1),int(1))], Y==X)).
1107 :- assert_must_succeed((bsets_clp:concat_sequence([(int(1),int(1))],[],Y,_WF), Y==[(int(1),int(1))])).
1108 :- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1109 X = [(int(1),int(1))], kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(1))]))).
1110 :- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1111 X = [(int(2),int(88)),(int(1),int(77))],
1112 kernel_objects:equal_object(Y,[(int(1),int(77)),(int(2),int(88)),(int(3),int(77)),(int(4),int(88))]))).
1113
1114 :- block /* concat_sequence(-,-,?,?), */
1115 concat_sequence(?,-,-,?), concat_sequence(-,?,-,?).
1116 concat_sequence(S1,S2,Res,WF) :- Res==[],!, empty_set_wf(S1,WF), empty_set_wf(S2,WF).
1117 concat_sequence(S1,S2,Res,WF) :-
1118 (var(S1),var(S2) -> get_wait_flag(2,concat,WF,LWF) % we have at least two solutions; TODO maybe use cardinality as wait_flag?
1119 ; LWF=1),
1120 ? concat_sequence2(LWF,S1,S2,Res,WF).
1121
1122 :- block concat_sequence2(-,?,-,?,?), concat_sequence2(-,-,?,?,?).
1123 ?concat_sequence2(_,S1,S2,Res,WF) :- S1==[],!,equal_sequence(S2,Res,WF).
1124 concat_sequence2(_,S1,S2,Res,WF) :- S2==[],!,equal_sequence(S1,Res,WF).
1125 concat_sequence2(LWF,S1,S2,Res,WF) :-
1126 try_expand_and_convert_to_avl_with_check(S1,AS1,concat1),
1127 try_expand_and_convert_to_avl_with_check(S2,AS2,concat2),
1128 ? concat_sequence3(LWF,AS1,AS2,Res,WF).
1129
1130 concat_sequence3(_,S1,S2,Res,WF) :- nonvar(S1),is_custom_explicit_set(S1,concat_sequence),
1131 concat_custom_explicit_set(S1,S2,ERes,WF),!,
1132 equal_sequence(Res,ERes,WF).
1133 concat_sequence3(_LWF,S1,S2,Res,WF) :-
1134 %try_expand_custom_set_wf(S1,ES1,concat,WF),
1135 size_of_sequence(S1,int(Size1),WF),
1136 (number(Size1) -> true
1137 ; size_of_sequence(S2,Size2,WF),
1138 size_of_sequence(Res,SizeRes,WF),
1139 ? int_minus(SizeRes,Size2,int(Size1)),
1140 ? in_nat_range_wf(int(Size1),int(0),SizeRes,WF)
1141 % is this required: ?? ,in_nat_range_wf(Size2,int(0),SizeRes,WF)
1142 ),
1143 ? concat_sequence_aux(Size1,S1,S2,Res,WF).
1144
1145
1146 :- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T1],[(int(1),int(22))|T2],_WF),
1147 A==int(22),T2=[],T1==[] )) .
1148 :- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T],avl_set(node((int(2),string(a)),true,0,node((int(1),string(c)),true,0,empty,empty),node((int(3),string(b)),true,0,empty,empty))),_WF),
1149 check_eqeq(A,string(c)),
1150 kernel_objects:equal_object(T,[(int(2),B)|T2]), check_eqeq(B,string(a)),
1151 kernel_objects:equal_object(T2,[(int(3),C)]), check_eqeq(C,string(b))) ).
1152 % equal_object optimized for sequences; can infer that pairs with same index have same value
1153 % TO DO: complete and make more efficient
1154 %equal_sequence(X,Y,_WF) :- nonvar(X),nonvar(Y),
1155 % is_custom_explicit_set(X,eval_sequence), is_custom_explicit_set(Y,eval_sequence),!,
1156 % equal_explicit_sets(X,Y).
1157 equal_sequence(X,Y,WF) :- nonvar(X),nonvar(Y),
1158 get_seq_head(X,XI,XEl,XT), get_seq_head(Y,YI,YEl,YT), XI==YI,!,
1159 % THIS CURRENTLY ONLY CHECKS FRONTMOST indexes
1160 equal_object_wf(XEl,YEl,equal_sequence_1,WF),
1161 equal_sequence(XT,YT,WF).
1162 equal_sequence(X,Y,WF) :-
1163 /* (is_custom_explicit_set(Y) -> monitor_equal_sequence_againts_custom_set(X,Y,WF)
1164 ; is_custom_explicit_set(X) -> monitor_equal_sequence_againts_custom_set(Y,X,WF)
1165 ; true), does not seem to buy anything; equal_object already powerful enough */
1166 ? equal_object_wf(X,Y,equal_sequence_2,WF).
1167
1168 % enforces the constraint that there is only one possible elemenent per index:
1169 %:- block monitor_equal_sequence_againts_custom_set(-,?,?).
1170 %monitor_equal_sequence_againts_custom_set([],_,_) :- !.
1171 %monitor_equal_sequence_againts_custom_set([El|T],CS,WF) :- !,
1172 % element_of_custom_set_wf(El,CS,WF),
1173 % monitor_equal_sequence_againts_custom_set(T,CS,WF).
1174 %monitor_equal_sequence_againts_custom_set(_,_,_).
1175
1176 get_seq_head([(Idx,El)|Tail],Idx,El,Tail).
1177 %get_seq_head(avl_set(AVL),Idx,El,Tail) :- does not seem to buy anything; equal_object already powerful enough
1178 % custom_explicit_sets:avl_min_pair(AVL,Idx,El),
1179 % custom_explicit_sets:direct_remove_element_from_avl(AVL,(Idx,El),Tail). % TO DO: only compute if indexes ==
1180
1181
1182 :- block concat_sequence_aux(-,?,?,?,?).
1183 concat_sequence_aux(Size1,_S1,_S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1184 size_of_custom_explicit_set(Res,int(RSize),WF), number(RSize),
1185 Size1 > RSize,!, % S1 is longer than Res; no solution (prevent WD error below)
1186 fail.
1187 concat_sequence_aux(Size1,S1,S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1188 % split Result into prefix and suffix
1189 prefix_of_custom_explicit_set(Res,Size1,Prefix,WF), % we could call versions which do not check WD
1190 suffix_of_custom_explicit_set(Res,Size1,Postfix,WF),
1191 !,
1192 equal_sequence(S1,Prefix,WF), equal_sequence(S2,Postfix,WF).
1193 concat_sequence_aux(Size1,S1,S2,Res,WF) :-
1194 shift_seq_indexes(S2,Size1,NewS2,WF),
1195 % We can do something stronger than disjoint union: we know that the indexes are disjoint!
1196 % Hence: if (int(X),Y) : Res & (int(X),Z) : S1 => Y=Z
1197 % Hence: if (int(X),Y) : Res & (int(X),Z) : S2 => Y=Z
1198 unify_same_index_elements(S1,Res,WF),
1199 unify_same_index_elements(Res,S1,WF),
1200 unify_same_index_elements(NewS2,Res,WF),
1201 unify_same_index_elements(Res,NewS2,WF),
1202 ? disjoint_union_wf(S1,NewS2,Res,WF).
1203
1204 % Check if (int(X),Y) pairs in Seq2 have a matching (int(X),Z) in Seq1 and then unify(Y,Z)
1205 :- block unify_same_index_elements(-,?,?).
1206 unify_same_index_elements(avl_set(A),Seq,WF) :- !,
1207 unify_same_index_elements_aux(Seq,A,WF).
1208 unify_same_index_elements(_,_,_). % TO DO: maybe also support other partially instantiated lists
1209
1210 :- block unify_same_index_elements_aux(-,?,?).
1211 unify_same_index_elements_aux([],_,_) :- !.
1212 unify_same_index_elements_aux([(int(Idx),El)|T],A,WF) :- !,
1213 try_find_index_element(Idx,El,A,WF),
1214 unify_same_index_elements_aux(T,A,WF).
1215 unify_same_index_elements_aux(_,_,_).
1216
1217 :- block try_find_index_element(-,?,?,?).
1218 try_find_index_element(Idx,El,AVL,WF) :-
1219 ? avl_fetch_pair(int(Idx),AVL,AvlEl),
1220 !,
1221 % We have found an entry with the same index: El and AvlEl must be identical:
1222 equal_object_wf(El,AvlEl,try_find_index_element,WF).
1223 try_find_index_element(_Idx,_El,_AVL,_WF). % :- print(not_found(_Idx,_AVL)),nl.
1224
1225 % TO DO: add waitflags + use within partition_wf
1226 % computes union of two sets which are guaranteed to be disjoint: means that if two of three sets known the other one can be determined
1227
1228 :- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(3)],[int(2),int(1)],[int(1),int(3),int(2)],WF),WF)).
1229 :- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([],[int(2),int(1)],[int(1),int(2)],WF),WF)).
1230 :- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(1),int(2)],[],[int(2),int(1)],WF),WF)).
1231 :- assert_must_succeed((bsets_clp:disjoint_union_wf([int(1)],[int(2)],Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]))).
1232 :- assert_must_succeed((bsets_clp:disjoint_union_wf(A,B,[int(1)],_WF),B=[H],H==int(1),A==[])).
1233
1234 % a union where we know that Set1 and Set2 are disjoint
1235 % this means we can propagate elements of Set1/2 more easily to result
1236 disjoint_union_wf(Set1,Set2,Res,WF) :-
1237 (var(Res)
1238 -> disjoint_union_wf0(Set1,Set2,DRes,DRes,WF),
1239 equal_object_optimized(Res,DRes) % try and convert result to AVL
1240 ? ; disjoint_union_wf0(Set1,Set2,Res,Res,WF)).
1241
1242 % disjoint_union_wf0(Set1,Set2,UnionOfSet1Set2, SuperSet, WF)
1243 :- block disjoint_union_wf0(-,-,-,?,?).
1244 disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union_wf0_1,WF).
1245 disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union_wf0_2,WF).
1246 disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Res==[],!,empty_set_wf(Set1,WF), empty_set_wf(Set2,WF).
1247 disjoint_union_wf0(Set1,Set2,Res,FullRes,WF) :-
1248 ((nonvar(Set1);nonvar(Set2)) -> true ; get_cardinality_powset_wait_flag(Res,disjoint_union_wf0,WF,_Card,CWF)),
1249 ? disjoint_union0(Set1,Set2,Res,FullRes,WF,CWF).
1250
1251 :- block disjoint_union0(-,-,?,?,?,-), disjoint_union0(-,?,-,-,?,?), disjoint_union0(?,-,-,-,?,?).
1252 disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union0_1,WF).
1253 disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union0_2,WF).
1254 disjoint_union0(S1,S2,Res,_F,WF,_CWF) :-
1255 ground_value(Res),
1256 ( ground_value(S1) -> !,
1257 check_subset_of_wf(S1,Res,WF), % TO DO: check if we can merge the check_subset and difference set in one predicate
1258 difference_set_wf(Res,S1,S2,WF)
1259 ; ground_value(S2) -> !,
1260 check_subset_of_wf(S2,Res,WF),
1261 ? difference_set_wf(Res,S2,S1,WF)
1262 ; var(S1),var(S2) -> !, % CWF nonvar
1263 % see test 1408; allows to generate subsets of Res and avoid enumeration warnings
1264 check_subset_of_wf(S1,Res,WF),
1265 %check_subset_of(S1,Res), % without waitflag: will generate ground version
1266 difference_set_wf(Res,S1,S2,WF)
1267 ).
1268 disjoint_union0(Set1,Set2,Res,_,WF,_) :- nonvar(Set1),
1269 is_custom_explicit_set_nonvar(Set1),
1270 union_of_explicit_set(Set1,Set2,Union), !, % TODO: if it fails: copy/propagate values to result?
1271 ? equal_object_wf(Union,Res,disjoint_union0_3,WF).
1272 disjoint_union0(Set1,Set2,Res,Full,WF,_) :-
1273 expand_custom_set_to_list_no_dups_wf(Set1,ESet1,_,disjoint_union0_1,WF),
1274 expand_custom_set_to_list_no_dups_wf(Set2,ESet2,_,disjoint_union0_2,WF),
1275 ? disj_union1(ESet1,ESet2,Res,Full,WF).
1276
1277 :- block disj_union1(-,-,?,?,?).
1278 disj_union1(X,Y,Res,FullRes,WF) :-
1279 ? var(X) -> disj_union2(Y,X,Res,FullRes,WF) ; disj_union2(X,Y,Res,FullRes,WF).
1280
1281 disj_union2([],Y,Res,_,_WF) :- equal_object_optimized(Y,Res,disj_union2).
1282 disj_union2([X|TX],Y,Res,FullRes,WF) :-
1283 ? remove_element_wf(X,Res,TR,WF), % was: equal_cons_wf(Res,X,TR,WF) but error was that it could force X to be a certain value
1284 ground_value_check(X,XV),
1285 (nonvar(XV) -> equal_cons_wf(Res,X,TR,WF)
1286 ; check_element_of_wf(X,FullRes,WF), % ensure that we set up proper constraints for X; e.g., for x \/ y = 1..10 & x /\ y = {}
1287 when(nonvar(XV), equal_cons_wf(Res,X,TR,WF))
1288 ), % ensure that we instantiate Res if TR known; otherwise we may get pending co-routines, e.g. test 506, SyracuseGrammar
1289 disj_union3(TX,Y,TR,FullRes,WF).
1290
1291 :- block disj_union3(-,-,-,?,?).
1292 disj_union3(X,Y,Res,_,WF) :- Res==[],!,empty_set_wf(X,WF),empty_set_wf(Y,WF).
1293 disj_union3(X,Y,Res,FullRes,WF) :- disj_union1(X,Y,Res,FullRes,WF).
1294
1295
1296 :- block disjoint_union_generalized_wf(-,?,?).
1297 %disjoint_union_generalized_wf([Set1|T],Res,_WF) :- T==[],!, % just one set; probably not covered at the moment (ast_cleanup simplifies partition with single set
1298 % equal_object(Set1,Res).
1299 disjoint_union_generalized_wf(ListOfSets,Res,WF) :-
1300 %expand_custom_set_to_list_wf(SetsOfSets,ESetsOfSets,_,disjoint_union_generalized_wf,WF), % this is a list of sets
1301 disjoint_union_generalized2(ListOfSets,[],Res,WF).
1302 :- block disjoint_union_generalized2(-,?,?,?).
1303 disjoint_union_generalized2([],S,Res,WF) :- !, equal_object_optimized_wf(S,Res,disjoint_union_generalized2,WF).
1304 disjoint_union_generalized2([H|T],UnionSoFar,Res,WF) :- !,
1305 disjoint_union_wf0(H,UnionSoFar,UnionSoFar2,Res,WF),
1306 %% print_message(called_disjoint_union(H,UnionSoFar,UnionSoFar2)), %%
1307 disjoint_union_generalized2(T,UnionSoFar2,Res,WF).
1308 disjoint_union_generalized2(L,S,Res,WF) :-
1309 add_internal_error('Not a list: ',disjoint_union_generalized2(L,S,Res,WF)),fail.
1310 % TO DO: if there are more than two sets: it may be interesting to set up constraint that
1311 % each set is a subset of the full set;
1312 % (would avoid enumeration warning in, e.g., x \/ y \/ z = 1..10 & x /\ y = {} & x /\ z = {} & y /\ z = {} & card(x)=card(y)+2 )
1313
1314 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(3),[(int(1),int(22)),(int(2),int(33))]),(int(2),[(int(1),int(11))])],
1315 [(int(1),int(11)),(int(2),int(22)),(int(3),int(33))],_WF))).
1316 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(33))])],[(int(1),int(33))],_WF))).
1317 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(55))])],Res,WF),
1318 kernel_waitflags:ground_wait_flags(WF),
1319 kernel_objects:equal_object(Res,[(int(1),int(55))]) )).
1320 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[(int(1),int(22))]),(int(2),[(int(1),int(55))])],Res,WF),
1321 kernel_waitflags:ground_wait_flags(WF),
1322 kernel_objects:equal_object(Res,[(int(1),int(22)),(int(2),int(55))]) )).
1323 :- block concatentation_of_sequences(-,?,?).
1324 concatentation_of_sequences(SeqOfSeq,Res,WF) :-
1325 try_expand_and_convert_to_avl_with_check(SeqOfSeq,ES,conc),
1326 ? concs2(ES,Res,WF).
1327
1328 concs2(SeqOfSeq,Res,WF) :- is_custom_explicit_set(SeqOfSeq,conc),
1329 conc_custom_explicit_set(SeqOfSeq,CRes),!,
1330 equal_object_wf(CRes,Res,concs2,WF).
1331 concs2(SeqOfSeq,Res,WF) :- empty_set_wf(SeqOfSeq,WF),empty_set_wf(Res,WF).
1332 concs2(SeqOfSeq,Res,WF) :- not_empty_set_wf(SeqOfSeq,WF),
1333 front_sequence(SeqOfSeq,Front,WF),
1334 ? concatentation_of_sequences(Front,FrontRes,WF),
1335 ? last_sequence(SeqOfSeq,Last,WF),
1336 ? concat_sequence(FrontRes,Last,Res,WF).
1337
1338 :- assert_must_abort_wf(bsets_clp:tail_sequence([],_R,unknown,WF),WF).
1339 :- assert_must_abort_wf(bsets_clp:tail_sequence([],[],unknown,WF),WF).
1340 :- assert_must_succeed(exhaustive_kernel_succeed_check(
1341 bsets_clp:tail_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5))],unknown,_WF)) ).
1342 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:tail_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],
1343 [(int(1),int(5)),(int(2),int(6))],unknown,_WF)) ).
1344 :- assert_must_succeed((bsets_clp:tail_sequence(X,R,unknown,_),
1345 X = [(int(1),int(6)),(int(2),int(5))],
1346 kernel_objects:equal_object(R,[(int(1),int(5))]) )).
1347 :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5))],unknown,_),
1348 X = [(int(1),int(6)),(int(2),int(5))] )).
1349 :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5)),(int(2),int(7))],unknown,_),
1350 X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1351 :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(2),int(7)),(int(1),int(5))],unknown,_),
1352 X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1353 :- block tail_sequence(-,?,?,?).
1354 tail_sequence(S1,Res,Span,WF) :- is_custom_explicit_set(S1,tail_sequence),
1355 tail_sequence_custom_explicit_set(S1,_,TRes,Span,WF),!,
1356 equal_object_wf(TRes,Res,tail_sequence,WF).
1357 tail_sequence(S1,Res,Span,WF) :- expand_custom_set_to_list_wf(S1,ES1,_,tail_sequence,WF),
1358 tail2(ES1,Res,Span,WF).
1359
1360 tail2([],_,Span,WF) :-
1361 add_wd_error_span('tail applied to empty sequence!',[],Span,WF).
1362 tail2([H|T],Res,_Span,WF) :- domain_subtraction_wf([int(1)],[H|T],IntRes,WF),
1363 shift_seq_indexes(IntRes,-1,Res,WF).
1364
1365
1366 :- assert_must_abort_wf(bsets_clp:first_sequence([],_R,unknown,WF),WF).
1367 :- assert_must_abort_wf(bsets_clp:first_sequence([],int(1),unknown,WF),WF).
1368 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(2),int(5))],int(4),unknown,_WF)) ).
1369 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],int(4),unknown,_WF)) ).
1370 :- assert_must_succeed((bsets_clp:first_sequence(X,R,unknown,_WF),
1371 X = [(int(1),int(2)),(int(2),int(1))],
1372 R = int(2))).
1373
1374 :- block first_sequence(-,?,?,?).
1375 first_sequence([],_,Span,WF) :- !,add_wd_error_span('first applied to empty sequence!',[],Span,WF).
1376 first_sequence(Seq,Res,Span,WF) :- apply_to(Seq,int(1),Res,Span,WF).
1377
1378
1379
1380 :- assert_must_abort_wf(bsets_clp:front_sequence([],_R,WF),WF).
1381 :- assert_must_abort_wf(bsets_clp:front_sequence([],[],WF),WF).
1382 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(4))],_WF)) ).
1383 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],[(int(1),int(4)),(int(2),int(5))],_WF)) ).
1384 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1385 X = [(int(1),int(2)),(int(2),int(55))],kernel_waitflags:ground_wait_flags(WF),
1386 kernel_objects:equal_object(R,[(int(1),int(2))]))).
1387 :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1388 X = [(int(3),int(33))|R], kernel_waitflags:ground_wait_flags(WF),
1389 kernel_objects:equal_object(R,[(int(1),int(2)),(int(2),int(55))]) )).
1390
1391 ?front_sequence(Seq,Res,WF) :- front_sequence(Seq,Res,unknown,WF).
1392 :- block front_sequence(-,?,?,?).
1393 front_sequence(S1,Res,_Span,WF) :-
1394 is_custom_explicit_set(S1,front_sequence),
1395 front_sequence_custom_explicit_set(S1,_,FRes),!,
1396 equal_object_wf(FRes,Res,front_sequence,WF).
1397 front_sequence(Seq,Res,Span,WF) :- expand_custom_set_to_list_wf(Seq,ESeq,_,front_sequence,WF),
1398 ? front2(ESeq,Res,Span,WF).
1399 front2([],_,Span,WF) :- add_wd_error_span('front applied to empty sequence!',[],Span,WF).
1400 front2([H|T],Res,_Span,WF) :- size_of_sequence([H|T],int(Size),WF),
1401 ? (number(Size) -> true ; size_of_sequence(Res,SizeRes,WF), int_plus(SizeRes,int(1),int(Size))),
1402 ? when(ground(Size), domain_subtraction_wf([int(Size)],[H|T],Res,WF)).
1403
1404
1405 :- assert_must_abort_wf(bsets_clp:last_sequence([],_R,WF),WF).
1406 :- assert_must_abort_wf(bsets_clp:last_sequence([],int(1),WF),WF).
1407 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(2),int(5))],int(5),_WF)) ).
1408 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],int(6),_WF)) ).
1409 :- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF),
1410 X = [(int(1),int(2)),(int(2),int(55))],R = int(55))).
1411 :- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF), X = [(int(1),int(55))], R = int(55))).
1412 :- assert_must_succeed((bsets_clp:last_sequence([(int(1),[(int(1),int(22))]),(int(2),[(int(1),int(55))])],R,_WF), R == [(int(1),int(55))])).
1413
1414 ?last_sequence(Seq,Res,WF) :- last_sequence(Seq,Res,unknown,WF).
1415 :- block last_sequence(-,?,?,?).
1416 last_sequence(Seq,Res,_Span,WF) :-
1417 is_custom_explicit_set(Seq,last_sequence),
1418 last_sequence_explicit_set(Seq,Last), !,
1419 equal_object_wf(Last,Res,last_sequence,WF).
1420 last_sequence([],_,Span,WF) :- !,add_wd_error_span('last applied to empty sequence!',[],Span,WF).
1421 last_sequence(Seq,Res,Span,WF) :-
1422 size_of_sequence(Seq,int(Size),WF),
1423 ? last_sequence_aux(Size,Seq,Res,Span,WF).
1424 :- block last_sequence_aux(-,?,?,?,?).
1425 last_sequence_aux(Size,Seq,Res,Span,WF) :-
1426 ? apply_to(Seq,int(Size),Res,Span,WF).
1427
1428
1429 :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5)),(int(2),int(4))],WF),WF )).
1430 :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4))],[(int(1),int(4))],WF),WF )).
1431 :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([],[],WF),WF )).
1432 :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],[(int(1),int(6)),(int(3),int(4)),(int(2),int(5))],WF),WF )).
1433 :- assert_must_succeed((bsets_clp:rev_sequence([],[],_WF))).
1434 :- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1435 X = [(int(1),int(2)),(int(2),int(1))],
1436 kernel_objects:equal_object(R,[(int(2),int(2)),(int(1),int(1))]) )).
1437 :- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1438 X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1439 kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1440 :- assert_must_succeed((bsets_clp:rev_sequence(R,X,_WF),
1441 X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1442 kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1443 :- assert_must_succeed((bsets_clp:rev_sequence(X,_R,_WF),
1444 X = [(int(2),int(1)),(int(1),int(23)),(int(3),int(55))] )).
1445 :- assert_must_succeed((bsets_clp:rev_sequence(_R,X,_WF),
1446 X = [(int(3),int(55)),(int(1),int(23)),(int(2),int(1))] )).
1447
1448 /* reverse of sequence */
1449 :- block rev_sequence(-,-,?).
1450 rev_sequence(S1,Res,WF) :-
1451 ? (nonvar(S1) -> rev_sequence2(S1,Res,WF)
1452 ; rev_sequence2(Res,S1,WF)).
1453
1454 rev_sequence2(S1,Res,WF) :- reverse_custom_explicit_set(S1,RS1),!,
1455 equal_object_wf(Res,RS1,WF).
1456 rev_sequence2(S1,Res,WF) :-
1457 expand_custom_set_to_list_wf(S1,ES1,_,rev_sequence2,WF),
1458 size_of_sequence(ES1,int(Size1),WF),
1459 % TO DO: we could also try and get the size from the result Res
1460 ? rev_sequence3(ES1,Size1,Res,WF).
1461
1462 :- block rev_sequence3(?,-,-,?).
1463 rev_sequence3(E,_Size,Res,WF) :- nonvar(Res), reverse_custom_explicit_set(Res,RevRes),!,
1464 equal_object_wf(E,RevRes,WF).
1465 rev_sequence3(E,Size,Res,WF) :- var(Size), !,
1466 % try to obtain size from result as well
1467 ? size_of_sequence(Res,int(Size),WF), rev_sequence3b(E,Size,Res,WF).
1468 rev_sequence3(E,S,R,WF) :- rev_sequence4(E,S,R,WF).
1469
1470 :- block rev_sequence3b(?,-,?,?).
1471 rev_sequence3b(E,S,R,WF) :- rev_sequence4(E,S,R,WF).
1472
1473 :- block rev_sequence4(-,?,?,?).
1474 rev_sequence4([],_,Res,WF) :- empty_set_wf(Res,WF).
1475 rev_sequence4([(int(N),El)|Tail],Size1,Res,WF) :-
1476 equal_cons_wf(Res,(NewN,El),RTail,WF),
1477 % compute NewN = Size - (N-1)
1478 int_minus(int(N),int(1),N1),
1479 int_minus(int(Size1),N1,NewN),
1480 (ground(NewN) -> true ; in_nat_range(NewN,int(0),int(Size1))),
1481 rev_sequence4(Tail,Size1,RTail,WF).
1482
1483
1484 /* --------- */
1485 /* RELATIONS */
1486 /* --------- */
1487
1488 %maplet(X,Y,(X,Y)).
1489
1490 % relation([]).
1491 % relation([(_X,_Y)|T]) :- relation(T).
1492
1493 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:relation_over_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
1494 :- assert_must_succeed(exhaustive_kernel_check( bsets_clp:relation_over([],[int(1),int(2)],[int(2)]) )).
1495 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2))],[int(1),int(2)],[int(2)]) )).
1496 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([([int(1)],[int(2)])],[[int(1)],[],[int(2)]],[[int(2)]]) )).
1497 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(pred_true /* bool_true */,pred_false /* bool_false */)],[pred_false /* bool_false */,pred_true /* bool_true */],[pred_false /* bool_false */]) )).
1498 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((pred_true /* bool_true */,int(2)),fd(1,'Name'))],[(pred_false /* bool_false */,int(1)),(pred_true /* bool_true */,int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1499 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((rec([field(a,fd(1,'Name'))]),int(2)),fd(1,'Name'))],[(rec([field(a,fd(1,'Name'))]),int(1)),(rec([field(a,fd(1,'Name'))]),int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1500 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((rec([field(a,fd(2,'Name')),field(b,fd(1,'Name'))]),int(2)),fd(1,'Name'))],[(rec([field(a,fd(1,'Name')),field(b,fd(1,'Name'))]),int(1)),(rec([field(a,fd(1,'Name')),field(b,fd(2,'Name'))]),int(2)),(rec([field(a,fd(2,'Name')),field(b,fd(1,'Name'))]),int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1501 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((pred_true /* bool_true */,int(2)),string('STRING1'))],[(pred_false /* bool_false */,int(1)),(pred_true /* bool_true */,int(2))],[string('STRING2'),string('STRING1')]) )).
1502 :- assert_must_succeed(exhaustive_kernel_succeed_check( /* multiple solutions !!*/ bsets_clp:relation_over([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)]) )).
1503 :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2)),(int(1),int(3))],[int(1),int(2)],[int(3),int(2)]) )).
1504 :- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:relation_over([(int(1),int(2)),(int(2),int(1))],[int(1),int(2)],[int(2)]) )).
1505 :- assert_must_fail(( bsets_clp:relation_over([(int(1),int(1))],[int(1),int(2)],[int(2)]) )).
1506 :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1507 X==[(int(1),int(3))] )).
1508 :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1509 X==[(int(1),int(3)),(int(2),int(3))] )).
1510 :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(4),int(5)]),
1511 X==[(int(2),int(4)),(int(2),int(5))] )).
1512
1513 relation_over(R,Dom,Ran) :- init_wait_flags(WF,[relation_over]),
1514 ? relation_over_wf(R,Dom,Ran,WF),
1515 ? ground_wait_flags(WF).
1516
1517 :- block relation_over_wf(-,-,-,?).
1518 relation_over_wf(R,Dom,Ran,WF) :-
1519 kernel_equality:get_cardinality_relation_over_wait_flag(Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels),
1520 ? relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels).
1521
1522 :- block relation_over1(-,?,?,?,-,?,?).
1523 relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :-
1524 nonvar(FF),
1525 custom_explicit_sets:is_definitely_maximal_set(Range),
1526 % we do not need the Range; this means we can match more closures (e.g., lambda)
1527 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_,WF),!,
1528 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF).
1529 relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :- nonvar(FF),
1530 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_,WF),!,
1531 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
1532 check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
1533 relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :- var(R),!,
1534 expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1535 ? relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1536 relation_over1(R,Domain,Range,WF,_WFR,_MaxCard,_) :-
1537 expand_and_convert_to_avl_set_catch(R,AER,relation_over1,'ARG : ? <-> ?',ResultStatus,WF),!,
1538 (ResultStatus=avl_set
1539 ? -> is_avl_relation_over_domain(AER,Domain,WF),
1540 is_avl_relation_over_range(AER,Range,WF)
1541 ; (debug_mode(on) -> add_message_wf(relation_over,'SYMBOLIC <-> check: ',R,unknown,WF) ; true),
1542 symbolic_domain_subset_check(R,Domain,WF),
1543 symbolic_range_subset_check(R,Range,WF)
1544 ).
1545 relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :-
1546 expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1547 ? relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1548
1549 % check the domain of a symbolic closure value FF whose domain is FFDomain and expected domain is Domain:
1550 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF) :-
1551 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
1552 [b_operator(domain,[FF]),Domain],unknown),WF2),
1553 check_subset_of_wf(FFDomain,Domain,WF2).
1554 % ditto for range
1555 check_range_subset_for_closure_wf(FF,FFRange,Range,WF) :-
1556 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
1557 [b_operator(range,[FF]),Range],unknown),WF2),
1558 check_subset_of_wf(FFRange,Range,WF2).
1559
1560
1561 % try and expand set to AVL and catch enumeration warning exceptions and set OK result value
1562 % if it succeeds with OK = avl_set -> we have an avl_set
1563 % if it fails: it cannot be expanded at the moment
1564 % if it retuns keep_symbolic: expansion cannot be performed and can never be performed; keep set symbolic
1565 expand_and_convert_to_avl_set_catch(R,_AS,_Origin,_Operator,_ResultStatus,_WF) :- var(R),!,fail.
1566 expand_and_convert_to_avl_set_catch(R,_AS,_Origin,_Operator,ResultStatus,_WF) :-
1567 is_infinite_explicit_set(R),!, % we could also use is_infinite_or_symbolic_closure
1568 ResultStatus=keep_symbolic.
1569 expand_and_convert_to_avl_set_catch(R,AS,Origin,Operator,ResultStatus,WF) :-
1570 catch(
1571 (expand_and_convert_to_avl_set(R,AS,Origin,Operator),ResultStatus=avl_set),
1572 enumeration_warning(_,_,_,_,_),
1573 (add_message_wf(Origin,'Attempting symbolic treatment, enumeration warning occured while expanding ARG for ',
1574 Operator,b(value(R),any,[]),WF),
1575 ResultStatus=keep_symbolic)).
1576
1577 expand_and_convert_to_avl_set_warn(R,_AS,_Origin,_Operator,_WF) :- var(R),!,fail.
1578 expand_and_convert_to_avl_set_warn(R,AS,Origin,Operator,WF) :-
1579 % TO DO: check for not fully instantiated closures, like memoization closures where ID not yet known
1580 % it is used before a cut: we need to expand straightaway without choice points
1581 (is_symbolic_closure(R)
1582 -> add_message_wf(Origin,'Expanding symbolic set argument ARG for predicate ',Operator,b(value(R),any,[]),WF)
1583 ; true),
1584 % TODO: instead of observe_enumeration_warnings we could push onto the call-stack and pass WF
1585 observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS,Origin,Operator),
1586 add_message_wf(Origin,'Enumeration warning occured while expanding argument ARG for predicate ',
1587 Operator,b(value(R),any,[]),WF)).
1588 %expand_and_convert_to_avl_set(R,AS,_,Operator,Values) :-
1589 % observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS,,),
1590 % display_warning_message(Operator,Values)).
1591 %display_warning_message(Operator,Values) :-
1592 % format(user_error,'Enumeration Warning for Operator ~w~n',[Operator]),
1593 % maplist(translate:print_bvalue,Values),nl.
1594
1595 :- block relation_over2(-,?,?,?,?,-,?,?,?).
1596 relation_over2([],_,_,_,_WF,_WFR,_MaxCard,_MaxNrOfRels,_LastPair).
1597 relation_over2(REL,SoFar,Domain,Range,WF,WFR,MaxCard,MaxNrOfRels,LastPair) :-
1598 (var(REL) -> NewLastPair=(X,Y) ; NewLastPair=none), %remember whether we freely chose X,Y
1599 REL = [(X,Y)|T],
1600 (number(MaxCard)
1601 -> MaxCard>0,C1 is MaxCard-1 ,(C1=0 -> T=[] ; true)
1602 ; C1=MaxCard),
1603 % TO DO: try to enumerate elements in order
1604 ordered_pair(LastPair,X,Y,not_equal),
1605 ? check_element_of_wf(X,Domain,WF),
1606 ? check_element_of_wf(Y,Range,WF),
1607 ? not_element_of_wf((X,Y),SoFar,WF),
1608 update_waitflag(MaxNrOfRels,WFR,NewWFR,WF),
1609 ? relation_over2(T,[(X,Y)|SoFar],Domain,Range,WF,NewWFR,C1,MaxNrOfRels,NewLastPair).
1610
1611 % check that new pair is greater than previous pair, if that pair was freely chosen
1612 ordered_pair(none,_,_,_).
1613 ordered_pair((LastX,LastY),NewX,NewY,Eq) :- ordered_value(LastX,NewX,EqualX),
1614 check_second_component(EqualX,LastY,NewY,Eq).
1615
1616 :- block check_second_component(-,?,?,?).
1617 check_second_component(equal,X,Y,EqRes) :- ordered_value(X,Y,EqRes).
1618 check_second_component(not_equal,_X,_Y,not_equal). % no need to check 2nd component
1619
1620 :- block ordered_value(-,?,?), ordered_value(?,-,?).
1621 ordered_value(pred_true /* bool_true */,B,Eq) :- !, (B=pred_true /* bool_true */ -> Eq=equal ; Eq=not_equal).
1622 ordered_value(pred_false /* bool_false */,B,Eq) :- !, B=pred_false /* bool_false */, Eq=equal.
1623 ordered_value(int(X),int(Y),Eq) :- !,
1624 kernel_objects:less_than_equal_direct(X,Y), equal_atomic_term(X,Y,Eq).
1625 ordered_value(fd(NrX,T),fd(NrY,T),Eq) :- !,
1626 kernel_objects:less_than_equal_direct(NrX,NrY),
1627 equal_atomic_term(NrX,NrY,Eq).
1628 ordered_value((X1,X2),(Y1,Y2),Eq) :- !, ordered_pair((X1,X2),Y1,Y2,Eq).
1629 ordered_value(string(X),string(Y),Eq) :- !, less_equal_atomic_term(X,Y,Eq).
1630 ordered_value(rec(FX),rec(FY),Eq) :- !,
1631 ordered_fields(FX,FY,Eq).
1632 ordered_value([],Y,Eq) :- !, (Y==[] -> Eq=equal ; Eq=not_equal). % empty set is the smallest set
1633 ordered_value(avl_set(A),Y,Eq) :- !,
1634 (Y==[] -> fail
1635 ; Y=avl_set(B) -> (A @< B -> Eq=not_equal ; A@>B -> fail ; Eq=equal)
1636 ; print(assuming_strictly_ordered(avl_set(A),Y)),nl,
1637 Eq=not_equal). % TO DO: treat sets better
1638 ordered_value([H|T],Y,Eq) :- !, ordered_value_cons(Y,H,T,Eq).
1639 ordered_value(term(floating(F1)),term(floating(F2)),Eq) :- !,
1640 kernel_reals:real_less_than_equal_wf(term(floating(F1)),term(floating(F2)),no_wf_available),
1641 equal_atomic_term(F1,F2,Eq).
1642 ordered_value(A,B,not_equal) :- print(assuming_strictly_ordered(A,B)),nl.
1643
1644 ordered_value_cons([],_,_,_) :- !,fail.
1645 ordered_value_cons([H2|T2],H,T,Eq) :- !,ordered_pair((H,T),H2,T2,Eq). % Note: order different than for avl_sets!
1646 ordered_value_cons(Y,H,T,not_equal) :- write(assuming_strictly_ordered([H|T],Y)),nl.
1647
1648 :- block ordered_fields(-,?,?).
1649 ordered_fields([],RHS,Eq) :- !,RHS=[], Eq=equal.
1650 ordered_fields([field(Name,ValX)|TX],RHS,Eq) :- !,RHS=[field(Name,ValY)|TY],
1651 ? ordered_value(ValX,ValY,Equal1), check_next_field(Equal1,TX,TY,Eq).
1652 ordered_fields(FX,FY,Eq) :- add_internal_error('Unknown fields: ',ordered_fields(FX,FY,Eq)), Eq=not_equal.
1653
1654 :- block check_next_field(-,?,?,?).
1655 ?check_next_field(equal,TX,TY,EqRes) :- ordered_fields(TX,TY,EqRes).
1656 check_next_field(not_equal,_X,_Y,not_equal). % no need to check next field
1657
1658 :- block less_equal_atomic_term(-,?,?), less_equal_atomic_term(?,-,?).
1659 less_equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; A @<B, Res=not_equal).
1660
1661 :- block equal_atomic_term(-,?,?), equal_atomic_term(?,-,?).
1662 equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; Res=not_equal).
1663
1664
1665 :- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2)),(int(2),int(1))],[int(1),int(2)],[int(2)],_WF) )).
1666 :- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2))],[],[int(2)],_WF) )).
1667 :- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([(int(1),pred_true)],[int(1)],[pred_true],_WF) )).
1668 :- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([],[int(1)],[pred_true],_WF) )).
1669 :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(3)],[int(1),int(2)],_) ).
1670 :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(1)],[int(3)],_) ).
1671 :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(3)),(int(1),int(2))],[int(1)],[int(3)],_) ).
1672 :- assert_must_fail( bsets_clp:not_relation_over([(int(1),int(3))],[int(1)],[int(3)],_) ).
1673 :- assert_must_fail( bsets_clp:not_relation_over([],[int(1)],[int(3)],_) ).
1674 :- assert_must_fail( bsets_clp:not_relation_over([],[],[],_) ).
1675 :- block not_relation_over(-,?,?,?).
1676
1677 not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
1678 % we do not need the Range; this means we can match more closures (e.g., lambda)
1679 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_,WF),!,
1680 not_subset_of_wf(FFDomain,Domain,WF).
1681 not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),
1682 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_,WF),!,
1683 not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
1684 /* could be slightly more efficient: but not clear if warrants additional complexity in code:
1685 not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),
1686 check_element_can_be_decided(Domain), % ensures that check_element_of_wf will not block below
1687 check_element_can_be_decided(Range), % ensures that check_element_of_wf will not block below
1688 expand_and_convert_to_avl_set(FF,AER,no_relation_over,''),!,
1689 (is_avl_relation_over_domain(AER,Domain,WF)
1690 -> \+ is_avl_relation_over_range(AER,Range,WF)
1691 ; true).
1692 check_element_can_be_decided(X) :- var(X),!,fail.
1693 check_element_can_be_decided(avl_set(_)).
1694 check_element_can_be_decided([]).
1695 check_element_can_be_decided(closure(P,T,B)) :-
1696 custom_explicit_sets:is_interval_closure_or_integerset(closure(P,T,B),Low,Up),
1697 ground(Low), ground(Up).
1698 */
1699 not_relation_over(R,Dom,Ran,WF) :-
1700 expand_custom_set_to_list_wf(R,ER,_,not_relation_over,WF),
1701 %% print(not_rel(ER,Dom,Ran)),nl,
1702 not_relation_over2(ER,Dom,Ran,WF).
1703
1704
1705 %not_relation_over2(R,_,_) :- when(nonvar(R), (R\=[], R\=[_|_])) . % TYPE ERROR !
1706 :- block not_relation_over2(-,?,?,?).
1707 not_relation_over2([(X,Y)|T],Domain,Range,WF) :-
1708 membership_test_wf(Domain,X,MemRes,WF),
1709 not_relation_over3(MemRes,Y,T,Domain,Range,WF).
1710
1711 :- block not_relation_over3(-,?,?,?,?,?).
1712 not_relation_over3(pred_false,_Y,_T,_Domain,_Range,_WF).
1713 not_relation_over3(pred_true,Y,T,Domain,Range,WF) :-
1714 membership_test_wf(Range,Y,MemRes,WF),
1715 not_relation_over4(MemRes,T,Domain,Range,WF).
1716
1717 :- block not_relation_over4(-,?,?,?,?).
1718 not_relation_over4(pred_false,_T,_Domain,_Range,_WF).
1719 not_relation_over4(pred_true,T,Domain,Range,WF) :-
1720 not_relation_over2(T,Domain,Range,WF).
1721
1722
1723
1724 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([],[],WF),WF)).
1725 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([(int(1),int(3))],[int(1)],WF),WF)).
1726 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1727 [(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(1),int(2),int(0)],WF),WF)).
1728 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1729 [(int(99),int(55)),(int(2),int(3)),(int(99),int(4))],[int(2),int(99)],WF),WF)).
1730 :- assert_must_succeed((bsets_clp:domain_wf([],Res,_WF),Res=[])).
1731 :- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2))],Res,_WF),
1732 kernel_objects:equal_object(Res,[int(1)]))).
1733 :- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1734 kernel_objects:equal_object(Res,[int(1)]))).
1735 :- assert_must_succeed((bsets_clp:domain_wf([(int(2),int(2)),(int(1),int(2))],Res,_WF),
1736 kernel_objects:equal_object(Res,[int(1),int(2)]))).
1737 :- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(3),int(2)]),
1738 kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1739 :- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1740 kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(1),int(2))]))).
1741 :- assert_must_fail((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1742 kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1743
1744 :- block domain_wf(-,-,?).
1745 domain_wf(Rel,Res,WF) :- Res == [],!,
1746 empty_set_wf(Rel,WF).
1747 domain_wf(Rel,Res,WF) :- var(Rel),!, % hence Res must me nonvar
1748 (is_custom_explicit_set(Res,domain_wf)
1749 -> expand_custom_set_to_list_wf(Res,Res2,_,propagate_result_to_input2,WF) % avoid expanding twice
1750 ; Res2 = Res),
1751 propagate_result_to_input(Res2,Rel,domain,WF),
1752 domain_wf1(Rel,Res2,WF).
1753 ?domain_wf(Rel,Res,WF) :- domain_wf1(Rel,Res,WF).
1754
1755
1756 % propagate result of domain/range back to original relation
1757 propagate_result_to_input(Result,OriginalRel,DomOrRange,WF) :-
1758 propagate_empty_set_wf(Result,result,OriginalRel,WF), % this will trigger before LWF ground
1759 (preferences:preference(use_smt_mode,true)
1760 -> propagate_result_to_input1(Result,OriginalRel,1,DomOrRange)
1761 % hopefully full CHR implementation will avoid the need for this hack
1762 % ; kernel_objects:is_marked_to_be_computed(OriginalRel) -> true % get_last_wait_flag(propagate_result_to_input,WF,LWF)
1763 ;
1764 get_wait_flag(2000,propagate_result_to_input,WF,LWF), % TO DO: determine right value for Priority ?
1765 % higher number for data_validation mode seems slightly counterproductive (on private_source_not_available tests)
1766 propagate_result_to_input1(Result,OriginalRel,LWF,DomOrRange) % this slows down test 289 if not guarded, 1088 if guarded
1767 ).
1768
1769 :- block propagate_result_to_input1(-,?,?,?), propagate_result_to_input1(?,-,-,?).
1770 % Note: if arg 2 (Rel) is known we will not propagate
1771 propagate_result_to_input1([],Rel,_,_) :- !, empty_set(Rel).
1772 propagate_result_to_input1(Result,Input,LWF,DomOrRange) :-
1773 (kernel_objects:is_marked_to_be_computed(Input) -> true
1774 ; propagate_result_to_input2(Result,Input,LWF,DomOrRange)).
1775
1776 %:- block propagate_result_to_input2(-,?).
1777 :- block propagate_result_to_input2(-,?,?,?), propagate_result_to_input2(?,-,-,?).
1778 % maybe do in CHR in future: x:dom(R) => #z.(x,z) : R
1779 % TO DO: make stronger; also support avl_set ...
1780 propagate_result_to_input2([],_Rel,_,_) :- !. % nothing can be said; we could have repeated entries for previous domain elements
1781 propagate_result_to_input2([D|T],Rel,LWF,DomOrRange) :- %print(propagate_result_to_input2([D|T],Rel,LWF,DomOrRange)),nl,
1782 !,
1783 (Rel == [] -> fail % we would need more relation elements to generate the domain/range
1784 ; nonvar(Rel) -> true % no propagation
1785 ; (DomOrRange=domain -> Rel = [(D,_)|RT] ; Rel = [(_,D)|RT]),
1786 propagate_result_to_input2(T,RT,LWF,DomOrRange)
1787 ).
1788 propagate_result_to_input2(CS,Rel,LWF,DomOrRange) :- var(Rel), is_custom_explicit_set(CS),!,
1789 expand_custom_set_to_list(CS,Res,_,propagate_result_to_input2),
1790 propagate_result_to_input2(Res,Rel,LWF,DomOrRange).
1791 propagate_result_to_input2(_1,_2,_LWF,_DomOrRange).
1792
1793 :- block domain_wf1(-,?,?).
1794 domain_wf1(Rel,Res,WF) :- is_custom_explicit_set(Rel,domain_wf),
1795 domain_of_explicit_set_wf(Rel,Dom,WF), !,
1796 ? equal_object_wf(Dom,Res,domain_wf1,WF).
1797 domain_wf1(Rel,Res,WF) :-
1798 expand_custom_set_to_list_wf(Rel,Relation,_,domain_wf,WF),
1799 ? newdomain1(Relation,[],Res,WF),
1800 quick_propagate_domain(Relation,Res,WF).
1801
1802 :- block quick_propagate_domain(-,?,?).
1803 quick_propagate_domain([],_,_WF).
1804 quick_propagate_domain([(X,_)|T],FullRes,WF) :-
1805 quick_propagation_element_information(FullRes,X,WF,FullRes1), % should we use a stronger check ?
1806 quick_propagate_domain(T,FullRes1,WF).
1807
1808 %:- block newdomain1(-,?,-,?). % why was this commented out ?
1809 :- block newdomain1(-,?,?,?).
1810 /* newdomain1(Rel,SoFar,Res,WF) :- var(Rel), !,
1811 domain_propagate_result(Res,Rel,SoFar,WF). */
1812 ?newdomain1(Dom,SoFar,Res,WF) :- newdomain2(Dom,SoFar,Res,WF).
1813
1814 %:- block newdomain2(-,?,?,?).
1815 ?newdomain2([],_SoFar,Res,WF) :- empty_set_wf(Res,WF).
1816 newdomain2([(X,Y)|T],SoFar,Res,WF) :-
1817 (Res==[]
1818 -> MemRes=pred_true, % no new elements can appear, all Xs must already be in SoFar
1819 check_element_of_wf(X,SoFar,WF)
1820 ; membership_test_wf(SoFar,X,MemRes,WF),
1821 % now check that card of Relation is greater or equal to Result; if equal set MemRes to pred_false
1822 % if card(Result)=card(dom(Result)) => all elements in Result must be fresh domain elements
1823 card_greater_equal_check([(X,Y)|T],Res,MemRes)
1824 ),
1825 ? newdomain3(MemRes,X,T,SoFar,Res,WF).
1826
1827 :- block newdomain3(-,?,?,?,?,?).
1828 newdomain3(pred_true,_,T,SoFar,Res,WF) :- newdomain1(T,SoFar,Res,WF).
1829 newdomain3(pred_false,X,T,SoFar,Res,WF) :-
1830 kernel_objects:mark_as_non_free(X,domain), % X is linked to a particular Y -> it is not free
1831 add_element_wf(X,SoFar,SoFar2,WF),
1832 ? equal_cons_wf(Res,X,Res2,WF),
1833 ? newdomain1(T,SoFar2,Res2,WF).
1834
1835
1836 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(2),int(7))],WF),WF)).
1837 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_wf(int(2),[(int(1),int(6)),(int(2),int(7))],WF),WF)). % used to be wfdet; but dom_symbolic can create existential quantifier, not all co-routines/... evaluated in wfdet
1838 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_wf(int(22),[(int(1),int(6)),(int(22),int(7)),(int(33),int(7))],WF),WF)). % used to be wfdet (see above)
1839 :- assert_must_succeed((bsets_clp:in_domain_wf(int(1),[(int(1),int(2))],_))).
1840 :- assert_must_succeed((bsets_clp:in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1841 :- assert_must_fail((bsets_clp:in_domain_wf(int(3),[],_))).
1842 :- assert_must_fail((bsets_clp:in_domain_wf(int(3),[(int(1),int(2))],_))).
1843 /* a more efficient version than using element_of and computing domain */
1844
1845 % just like not_empty_set_wf but instantiates with (El,_) as first element
1846 in_domain_wf(El,S,WF) :- var(S),!, force_in_domain_wf(El,S,WF).
1847 in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF).
1848
1849 :- use_module(kernel_non_empty_attr,[mark_var_set_as_non_empty/1]).
1850 % next is also used in apply_to/6
1851 force_in_domain_wf(El,S,WF) :-
1852 (preferences:preference(use_smt_mode,true) -> get_wait_flag0(WF,WF0),
1853 when(ground(WF0),delayed_force_in_domain_wf(El,S,WF))
1854 ; % TO DO: non-empty flag
1855 mark_var_set_as_non_empty(S),
1856 get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)).
1857 % delay instantiating S somewhat: it can mess up many other optimisations
1858 % fixes trying to deconstruct infinite set enum warning for test 2022
1859 delayed_force_in_domain_wf(El,S,_WF) :- var(S),!, S=[(El,_)|_]. % TODO: mark _ as irrelevant
1860 delayed_force_in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF).
1861
1862 :- block in_domain_lwf(-,-,-,?).
1863 % was :- block in_domain_lwf(-,?,-,?). but this prevents instantiating El in case Rel becomes known ! see e.g. private_examples/ClearSy/ComparePv10Pv11/DebugPv10/ test 1952, 2270
1864 %:- block in_domain_lwf(-,-,?,?),in_domain_lwf(?,-,-,?). % this annotation fails test 1703
1865 in_domain_lwf(El,Rel,LWF,WF) :- % tools_printing:print_term_summary(in_domain_lwf(El,Rel,LWF)),
1866 (var(Rel) -> ground_value_check(El,GrVal),
1867 in_domain_lwf2(El,Rel,LWF,GrVal,WF) % we could also wait at least until WF0 is fully grounded?
1868 ; not_empty_set_unless_closure_wf(Rel,WF),
1869 in_domain_wf_lazy(El,Rel,WF)).
1870
1871 :- block in_domain_lwf2(?,-,-,-,?).
1872 in_domain_lwf2(El,Rel,_LWF,_Grval,WF) :- % tools_printing:print_term_summary(in_domain_lwf2(El,Rel,_LWF,_Grval)),
1873 (var(Rel) -> Rel = [(El,_)|_]
1874 % can create a choice point when unifying with large avl_set:, see rule_Rule_DB_PSR_0003_C
1875 % maybe we should delay even further
1876 ; not_empty_set_unless_closure_wf(Rel,WF),
1877 in_domain_wf_lazy(El,Rel,WF)).
1878
1879 not_empty_set_unless_closure_wf(closure(_,_,_),_) :- !. % do not check this; in_domain_wf or other call will find a solution anyway; no need to set up closure constraints twice
1880 not_empty_set_unless_closure_wf(Rel,WF) :- not_empty_set_wf(Rel,WF).
1881
1882 % does not instantiate to [(El,_)|_]
1883 :- block in_domain_wf_lazy(?,-,?).
1884 in_domain_wf_lazy(_DomainElement,[],_WF) :- !,fail.
1885 in_domain_wf_lazy(DomainElement,avl_set(A),_WF) :-
1886 ground_value(DomainElement), !,
1887 check_in_domain_of_avlset(DomainElement,A).
1888 % TO DO: check for infinite closures
1889 in_domain_wf_lazy(DomainElement,ES,WF) :-
1890 is_custom_explicit_set(ES,in_domain_wf_lazy),
1891 domain_of_explicit_set_wf(ES,Dom,WF),!,
1892 check_element_of_wf(DomainElement,Dom,WF).
1893 in_domain_wf_lazy(El,Rel,WF) :-
1894 expand_custom_set_to_list_wf(Rel,Relation,Done,in_domain_wf_lazy,WF),
1895 get_binary_choice_wait_flag(in_domain_wf_lazy(El),WF,LWF), % TO DO: get_pow2_binary_choice_priority(Len,Prio), get_binary_choice_wait_flag_exp_backoff
1896 % if Done == true -> we can use maybe clpfd_inlist or clpfd:element or quick_propagate
1897 quick_propagation_domain_element_list(Done,Relation,El,WF),
1898 in_domain2(El,Relation,WF,LWF).
1899
1900 % a custom implementation of quick_propagation_element_information for checking domain elements and lists only
1901 :- use_module(clpfd_lists,[try_in_fd_value_list_check/4]).
1902 :- block quick_propagation_domain_element_list(-,?,?,?).
1903 quick_propagation_domain_element_list(_,_,_,_) :- preferences:preference(use_clpfd_solver,false),!.
1904 quick_propagation_domain_element_list(_,_,El,_) :- ground(El),!.
1905 quick_propagation_domain_element_list(_,RelList,El,WF) :-
1906 try_in_fd_value_list_check(RelList,(El,_),couple_left(_),WF). % use couple_left to ignore range values
1907
1908
1909 :- block in_domain2(?,-,?,?).
1910 in_domain2(El,[(X,_Y)|T],WF,LWF) :-
1911 (T==[]
1912 -> equal_object_wf(El,X,in_domain2,WF)
1913 ; kernel_objects:equality_objects_lwf(El,X,EqRes,LWF,WF),
1914 in_domain3(EqRes,El,T,WF,LWF)
1915 ).
1916
1917 :- block in_domain3(-,?,?,?,?).
1918 in_domain3(pred_true,_El,_T,_WF,_LWF).
1919 in_domain3(pred_false,El,T,WF,LWF) :-
1920 get_new_subsidiary_wait_flag(LWF,in_domain2(El,T),WF,NewLWF), % not necessary if T only has single element
1921 in_domain2(El,T,WF,NewLWF).
1922
1923
1924 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[],WF),WF)).
1925 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7))],WF),WF)).
1926 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7)),(int(4),int(3))],WF),WF)).
1927 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_in_domain_wf(int(4),[(int(2),int(7)),(int(4),int(3))],WF),WF)).
1928 :- assert_must_fail((bsets_clp:not_in_domain_wf(int(1),[(int(1),int(2))],_))).
1929 :- assert_must_fail((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1930 :- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[],_))).
1931 :- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2))],_))).
1932 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(2),int(3))],WF),WF)).
1933 /* a more efficient version than using not_element_of and computing domain */
1934
1935
1936 :- block not_in_domain_wf(?,-,?).
1937 not_in_domain_wf(DomainElement,ES,WF) :- is_custom_explicit_set(ES,not_in_domain),
1938 domain_of_explicit_set_wf(ES,Dom,WF),!,
1939 not_element_of_wf(DomainElement,Dom,WF).
1940 not_in_domain_wf(El,Rel,WF) :-
1941 expand_custom_set_to_list_wf(Rel,Relation,_,not_in_domain,WF),
1942 not_in_domain2(Relation,El,WF).
1943 :- block not_in_domain2(-,?,?).
1944 not_in_domain2([],_,_WF).
1945 not_in_domain2([(X,_Y)|T],E,WF) :- not_equal_object_wf(E,X,WF), not_in_domain2(T,E,WF).
1946
1947
1948
1949
1950 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([],[],WF),WF)).
1951 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([(int(1),int(3))],[int(3)],WF),WF)).
1952 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf(
1953 [(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(3),int(55)],WF),WF)).
1954 :- assert_must_succeed((bsets_clp:range_wf([],Res,_WF),Res=[])).
1955 :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2))],Res,_WF),
1956 kernel_objects:equal_object(Res,[int(2)]))).
1957 :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(1)),(int(2),int(1))],Res,_WF),
1958 kernel_objects:equal_object(Res,[int(1)]))).
1959 :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1960 kernel_objects:equal_object(Res,[int(1),int(2)]))).
1961 :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],Res,_WF),
1962 kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1963 :- assert_must_succeed((bsets_clp:range_wf(X,Res,_WF),
1964 X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],
1965 kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1966 :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1967 X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(2))])).
1968 :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1969 X = [(int(2),int(1)),(int(1),int(2)),(int(2),int(2))])).
1970 :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1971 X = [])).
1972 :- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1973 ([int(0),int(1)],[int(0),int(1)]),([int(0),int(2)],[int(0),int(2)]),
1974 ([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1975 ([int(1),int(2)],[int(1),int(2)]),([int(1),int(3)],[int(1),int(3)]),
1976 ([int(1),int(4)],[int(1),int(4)]),([int(2)],[int(2)]),([int(2),int(3)],[int(2),int(3)]),
1977 ([int(2),int(4)],[int(2),int(4)]),([int(3)],[int(3)]),([int(3),int(4)],
1978 [int(3),int(4)]),([int(4)],[int(4)])],_Res,_WF))).
1979 :- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1980 ([int(0),int(1)],[int(0),int(1)]),
1981 ([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1982 ([int(1),int(2)],[int(1),int(2)])],_Res,_WF))).
1983
1984
1985 :- block range_wf(-,-,?).
1986 range_wf(Rel,Res,WF) :- Res ==[],!, empty_set_wf(Rel,WF).
1987 range_wf(Rel,Res,WF) :- Rel ==[],!, empty_set_wf(Res,WF).
1988 ?range_wf(Rel,Res,WF) :- range_wf1(Rel,Res,WF),
1989 propagate_result_to_input(Res,Rel,range,WF).
1990
1991 :- block range_wf1(-,?,?).
1992 range_wf1(Rel,Res,WF) :-
1993 is_custom_explicit_set(Rel,range_wf1),
1994 range_of_explicit_set_wf(Rel,Range,WF), !,
1995 equal_object_wf(Range,Res,range_wf1,WF).
1996 range_wf1(Rel,Res,WF) :-
1997 % TO DO : propagate information that card of Res <= card of Rel; similar thing for domain
1998 expand_custom_set_to_list_wf(Rel,Relation,_,range_wf1,WF),
1999 ? newrange2(Relation,[],Res,WF),
2000 quick_propagate_range(Relation,Res,WF).
2001
2002
2003 :- block quick_propagate_range(-,?,?).
2004 quick_propagate_range([],_,_WF).
2005 quick_propagate_range([(_,Y)|T],FullRes,WF) :-
2006 quick_propagation_element_information(FullRes,Y,WF,FullRes1), % should we use a stronger check ?
2007 quick_propagate_range(T,FullRes1,WF).
2008
2009 :- block newrange2(-,?,?,?).
2010 newrange2([],_SoFar,Res,WF) :-
2011 empty_set_wf(Res,WF).
2012 newrange2([(X,Y)|T],SoFar,Res,WF) :-
2013 (Res==[]
2014 -> MemRes=pred_true, check_element_of_wf(Y,SoFar,WF)
2015 ; membership_test_wf(SoFar,Y,MemRes,WF),
2016 card_greater_equal_check([(X,Y)|T],Res,MemRes), % check that card of Relation is greater or equal to Result; if equal set MemRes to pred_false
2017 (var(MemRes) -> prop_empty_pred_true(Res,MemRes) %,print(delay_range(Y,T)),nl
2018 % TO DO: we could look further in T if we can decide membership for other elements in T ?
2019 ; true)
2020 ),
2021 ? newrange3(MemRes,Y,T,SoFar,Res,WF).
2022
2023 :- block prop_empty_pred_true(-,?).
2024 prop_empty_pred_true([],R) :- !, R=pred_true.
2025 prop_empty_pred_true(_,_).
2026
2027 % card_greater_equal_check(Set1,Set2,EqFlag) : check that cardinality of Set1 is greater or equal to that of Set2; set EqFlag to pred_false if they are equal
2028 % checking is stopped if EqFlag becomes nonvar
2029 % tested by testcase 1061
2030 :- block card_greater_equal_check(-,?,-), card_greater_equal_check(?,-,-).
2031 card_greater_equal_check(_,_,Flag) :- nonvar(Flag),!. % no longer required; even though we could prune failure !? done later in newrange2/newdomain2 ??!!
2032 card_greater_equal_check([],Set2,Flag) :- !,empty_set(Set2),
2033 Flag=pred_false. % Flag set indicates that both sets have same size
2034 card_greater_equal_check(_,[],_) :- !.
2035 card_greater_equal_check([_|T],[_|R],Flag) :- !, card_greater_equal_check(T,R,Flag).
2036 % To do: deal with AVL args as Result + also use efficient_card_for_set for closures
2037 %card_greater_equal_check([_|T],Set,Flag) :- efficient_card_for_set(B,CardB,CodeB),!,
2038 % f: 1..7 -->> 1..n & n>=7 & n<10 still does not work well
2039 % TO DO: can we merge code with check_card_greater_equal
2040 card_greater_equal_check(_,_,_).
2041
2042
2043 :- block newrange3(-,?,?,?,?,?).
2044 newrange3(pred_true,_Y,T,SoFar,Res,WF) :- newrange2(T,SoFar,Res,WF).
2045 newrange3(pred_false,Y,T,SoFar,Res,WF) :-
2046 kernel_objects:mark_as_non_free(Y,range), % Y is linked to a particular X -> it is not free
2047 add_element_wf(Y,SoFar,SoFar2,WF),
2048 ? equal_cons_wf(Res,Y,Res2,WF),
2049 newrange2(T,SoFar2,Res2,WF).
2050
2051
2052 :- assert_must_succeed((bsets_clp:identity_relation_over_wf([],Res,_WF),Res=[])).
2053 :- assert_must_succeed((bsets_clp:identity_relation_over_wf([int(1),int(2)],Res,_WF),
2054 Res=[(int(1),int(1)),(int(2),int(2))])).
2055 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:identity_relation_over_wf([int(2),int(4)],[(int(4),int(4)),(int(2),int(2))],WF),WF)).
2056 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:identity_relation_over_wf([int(1),int(2),int(4)],[(int(4),int(4)),(int(2),int(2)),(int(1),int(1))],WF),WF)).
2057 :- assert_must_fail((bsets_clp:identity_relation_over_wf([int(1)|_],_,_WF),fail)). /* check: no loop */
2058
2059 :- block identity_relation_over_wf(-,?,?).
2060 identity_relation_over_wf(Set1,IDRel,WF) :-
2061 expand_custom_set_to_list_wf(Set1,ESet1,_,identity_relation_over_wf,WF),
2062 identity_relation_over2(ESet1,IDRel,WF).
2063
2064 :- block identity_relation_over2(-,?,?).
2065 identity_relation_over2([],Res,WF) :- empty_set_wf(Res,WF).
2066 identity_relation_over2([X|T1],Res,WF) :- equal_cons_wf(Res,(X,X),T2,WF), % equal_object([(X,X)|T2],Res),
2067 identity_relation_over2(T1,T2,WF).
2068
2069
2070
2071 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_identity((int(1),int(1)),[int(1),int(2)],WF),WF)).
2072 :- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[int(1),int(2)],_WF))).
2073 :- assert_must_fail((bsets_clp:in_identity((int(3),int(3)),[int(1),int(2)],_WF))).
2074 :- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[],_WF))).
2075 in_identity((X,Y),Domain,WF) :-
2076 equal_object_wf(X,Y,in_identity,WF), check_element_of_wf(X,Domain,WF).
2077
2078 :- assert_must_fail((bsets_clp:not_in_identity((int(1),int(1)),[int(1),int(2)],_WF))).
2079 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(1),int(2)),[int(1),int(2)],WF),WF)).
2080 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(3),int(3)),[int(1),int(2)],WF),WF)).
2081 :- assert_must_succeed((bsets_clp:not_in_identity((int(1),int(2)),[],_WF))).
2082 not_in_identity((X,Y),Domain,WF) :-
2083 equality_objects_wf(X,Y,Eq,WF),
2084 not_in_id2(Eq,X,Domain,WF).
2085
2086 :- block not_in_id2(-,?,?,?).
2087 not_in_id2(pred_true,X,Domain,WF) :- not_element_of_wf(X,Domain,WF).
2088 not_in_id2(pred_false,_,_,_).
2089
2090
2091 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], [(int(6),int(5)),(int(2),int(1)),(int(4),int(3))],WF),WF)).
2092 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2))], [(int(2),int(1))],WF),WF)).
2093 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([], [],WF),WF)).
2094 :- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [])).
2095 :- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [(int(2),int(2))])).
2096 :- assert_must_succeed((bsets_clp:invert_relation_wf(X,[(int(1),int(2)),(int(7),int(6))],_WF),
2097 X = [(int(2),int(1)),(int(6),int(7))])).
2098 :- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],X,_WF),
2099 X = [(int(2),int(1)),(int(6),int(7))])).
2100 :- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],
2101 [(int(6),int(7)),(int(2),int(1))],_WF))).
2102 :- assert_must_succeed((bsets_clp:invert_relation_wf(closure([a,b],[string,boolean],b(truth,pred,[])),
2103 closure([b,a],[boolean,string],b(truth,pred,[])),_WF))).
2104
2105 :- block invert_relation_wf(-,-,?).
2106 invert_relation_wf(R,IR,WF) :-
2107 % (nonvar(R) -> invert_relation2(R,IR) ; invert_relation2(IR,R)).
2108 invert_relation2(R,IR,WF). % , print_term_summary(invert_relation(R,IR)).
2109 /* Optimization for some types of closures: Instead of expanding the closures, we just
2110 swap the parameters. This does not work with closures wich have only one parameter
2111 wich is a pair */
2112 invert_relation2(CS,R,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2113 invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_1,WF).
2114 invert_relation2(R,CS,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2115 invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_2,WF).
2116 %invert_relation2(closure([P1,P2],[T1,T2],Clo),closure([P2,P1],[T2,T1],Clo)) :- !.
2117 invert_relation2(R,IR,WF) :- %try_expand_custom_set_wf(R,ER,invert,WF),
2118 % (nonvar(R) -> invert_relation3(R,IR)
2119 % ; invert_relation3(IR,R),(ground(IR)-> true ; invert_relation3(R,IR))).
2120 invert_relation3(R,IR,WF,1), invert_relation3(IR,R,WF,1).
2121
2122 :- block invert_relation3(-,?,?,?).
2123 invert_relation3(closure(P,T,B),Res,WF,_) :- invert_explicit_set(closure(P,T,B),ICS),
2124 equal_object_wf(Res,ICS,invert_relation3_1,WF).
2125 invert_relation3(avl_set(S),Res,WF,_) :- invert_explicit_set(avl_set(S),ICS),
2126 equal_object_wf(Res,ICS,invert_relation3_2,WF).
2127 invert_relation3([],Res,WF,_) :- empty_set_wf(Res,WF).
2128 invert_relation3([(X,Y)|T],Res,WF,Depth) :-
2129 D1 is Depth+1, get_wait_flag(D1,invert_relation3,WF,LWF),
2130 equal_cons_lwf(Res,(Y,X),IT,LWF,WF),
2131 invert_relation3(T,IT,WF,D1).
2132
2133
2134
2135
2136 tuple_of(X,Y,R) :- check_element_of((X,Y),R).
2137 %tuple_of_wf(X,Y,R,WF) :- check_element_of_wf((X,Y),R,WF).
2138
2139
2140 % RELATIONAL COMPOSITION (;)
2141
2142 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2143 [(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2144 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2145 [(int(11),int(12)),(int(11),int(33))],
2146 [(int(33),int(12)),(int(33),int(22))],WF),WF)).
2147 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(12)),
2148 [(int(11),int(12)),(int(11),int(33))],
2149 [(int(33),int(12)),(int(33),int(22))],WF),WF)).
2150 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2151 [(int(11),[int(33),int(32)])],
2152 [([int(32),int(33)],int(22))],WF),WF)).
2153 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:in_composition_wf((int(11),int(33)),
2154 [(int(11),int(12)),(int(11),int(33))],
2155 [(int(33),int(12)),(int(33),int(22))],WF),WF)).
2156 % check if (X,Y) element of (F ; G)
2157 in_composition_wf((X,Y),F,G,WF) :-
2158 check_element_of_wf((X,Z1),F,WF), % no need to enumerate Z (TODO: check)
2159 equal_object_wf(Z1,Z2,check_element_of_wf,WF),
2160 check_element_of_wf((Z2,Y),G,WF).
2161
2162 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_composition_wf((int(11),int(33)),
2163 [(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2164 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_composition_wf((int(33),int(22)),
2165 [(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2166
2167 % just evaluates arguments; TODO: improve or at least pass Type (for symbolic composition)
2168 not_in_composition_wf(Couple,F,G,WF) :-
2169 rel_composition_wf(F,G,Comp,_UnknownType,WF),
2170 not_element_of_wf(Couple,Comp,WF).
2171
2172 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], [(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],
2173 [(int(1),int(1)),(int(5),int(7)),(int(3),int(33))]))).
2174 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([], [(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],[]))).
2175 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],[],[]))).
2176 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([],[],[]))).
2177 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2178 [(int(1),int(11))],X),X = [])).
2179 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],[],X),X = [])).
2180 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2181 [(int(2),int(11))],X),
2182 kernel_objects:equal_object(X,[(int(1),int(11))]))).
2183 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(2))],[(int(2),int(11))],X),
2184 ground(X), bsets_clp:equal_object(X,[(int(1),int(11)),(int(7),int(11))]))).
2185 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(5))],
2186 [(int(2),int(11)),(int(2),int(4))],X),
2187 kernel_objects:equal_object(X,[(int(1),int(11)),(int(1),int(4))]))).
2188 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(1),int(5))],
2189 [(int(2),int(11)),(int(5),int(11))],X),
2190 kernel_objects:equal_object(X,[(int(1),int(11))]))).
2191 :- assert_must_succeed((bsets_clp:rel_composition([(int(1),[int(1)]),(int(1),[int(2),int(5)])],
2192 [([int(1),int(2)],int(13)),([int(5),int(2)],int(12))],X),
2193 kernel_objects:equal_object(X,[(int(1),int(12))]))).
2194
2195 rel_composition(Rel1,Rel2,Comp) :- % only used in unit_tests above
2196 init_wait_flags(WF,[rel_composition]),
2197 rel_composition_wf(Rel1,Rel2,Comp,_UnknownType,WF),
2198 ? ground_wait_flags(WF).
2199
2200 :- block rel_composition_wf(-,-,?,?,?).
2201 rel_composition_wf(Rel1,Rel2,Comp,_,WF) :-
2202 (Rel1==[] ; Rel2==[]),
2203 !,
2204 empty_set_wf(Comp,WF).
2205 rel_composition_wf(Rel1,Rel2,Comp,Type,WF) :- rel_composition1(Rel1,Rel2,Comp,Type,WF).
2206
2207 :- use_module(closures,[is_infinite_non_injective_closure/1]).
2208
2209 :- block rel_composition1(-,?,?,?,?),rel_composition1(?,-,?,?,?).
2210 rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2211 (Rel1==[] ; Rel2==[]),!, empty_set_wf(Comp,WF).
2212 rel_composition1(Rel1,Rel2,Comp,Type,WF) :- keep_symbolic(Rel1),
2213 (Rel2 = avl_set(_), \+ is_infinite_non_injective_closure(Rel1)
2214 -> SYMBOLIC=false
2215 ; SYMBOLIC=symbolic),
2216 symbolic_composition(Rel1,Rel2,SYMBOLIC,Type,Rel3),
2217 !,
2218 ? equal_object_wf(Comp,Rel3,rel_composition1_0,WF).
2219
2220 rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2221 rel_composition_for_explicit_set(Rel1,Rel2,Res),!, % treats finite Rel1 and avl_set for Rel2
2222 equal_object_wf(Res,Comp,rel_composition1_1,WF).
2223 rel_composition1(Rel1,Rel2,Comp,Type,WF) :- Rel2=closure(_,_,_),
2224 keep_symbolic(Rel2),
2225 % we know keep_symbolic(Rel1) is false
2226 (dom_for_specific_closure(Rel2,Domain,function(_),WF) % TO DO: also deal with relations; in SYMBOLIC mode this may be counter productive; see function_composition ast cleanup rule
2227 -> !,
2228 opt_push_wait_flag_call_stack_info(WF,b_operator_call(composition,[Rel1,Rel2],unknown),WF2),
2229 on_enumeration_warning(expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1,WF2),R=failed),
2230 (R==failed % expansion of Rel1 failed; use symbolic composition
2231 -> symbolic_composition(Rel1,Rel2,true,Type,Rel3),
2232 equal_object_optimized(Rel3,Comp,rel_composition1_4)
2233 ; rel_compose_with_inf_fun(Relation1,Domain,Rel2,Comp,WF2)
2234 % this is like map Rel2 over Rel1 in functional programmming
2235 )
2236 ; symbolic_composition(Rel1,Rel2,false,Type,Rel3),
2237 !,
2238 expand_custom_set_wf(Rel3,CRes,rel_composition,WF),% do we need to expand ?
2239 ? equal_object_optimized(CRes,Comp,rel_composition1_4)
2240 ).
2241 rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2242 opt_push_wait_flag_call_stack_info(WF,b_operator_call(composition,[Rel1,Rel2],unknown),WF2),
2243 expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1_2,WF2),
2244 expand_custom_set_to_list_wf(Rel2,Relation2,_,rel_composition1_3,WF2),
2245 ? rel_compose2(Relation1,Relation2,Comp,WF2).
2246
2247
2248 :- use_module(btypechecker, [l_unify_types_strict/2]).
2249 symbolic_composition(Rel1,Rel2,SYMBOLIC,Type,Rel3) :-
2250 get_set_type(Type,couple(TX,TZ)),
2251 mnf_get_relation_types(Rel1,TX1,TY1),
2252 mnf_get_relation_types(Rel2,TY2,TZ2),
2253 (l_unify_types_strict([TX1,TY1,TZ],[TX,TY2,TZ2]) -> true
2254 ; add_internal_error('Could not unify range/domain types: ',l_unify_types_strict([TX1,TY1,TZ],[TX,TY2,TZ2])),
2255 fail
2256 ),
2257 ground((TX1,TY1,TZ)), % avoid creating a closure with non-ground type list
2258 rel_comp_closure(Rel1,Rel2,TX1,TY1,TZ,SYMBOLIC,Rel3).
2259 % generate a closure for {xx,zz | #(yy).(xx|->yy : Rel1 & yy|->zz : Rel2)}
2260 % TO DO: maybe detect special cases: Rel1 is a function/cartesian product, e.g., (((0 .. 76) * (0 .. 76)) * {FALSE}) ; {(FALSE|->0),(TRUE|->1)}
2261 :- use_module(bsyntaxtree, [conjunct_predicates_with_pos_info/3,update_used_ids/3 ]).
2262 rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,closure(Args,Types,CBody)) :-
2263 Args = ['_rel_comp1','_rel_comp2'], Types = [TX,TZ],
2264 couple_member_pred('_rel_comp1',TX,'_zzzz_unary',TY,Rel1, Pred1),
2265 couple_member_pred('_zzzz_unary',TY,'_rel_comp2',TZ,Rel2, Pred2),
2266 UsedIds = ['_rel_comp1','_rel_comp2','_zzzz_unary'], % avoid having to call find_identifier_uses
2267 %conjunct_predicates([Pred1,Pred2],P12a), bsyntaxtree:check_computed_used_ids(P12a,UsedIds),
2268 %safe_create_texpr(conjunct(Pred1,Pred2),pred,[used_ids(UsedIds)],P12),
2269 conjunct_predicates_with_pos_info(Pred1,Pred2,P12a),
2270 update_used_ids(P12a,UsedIds,P12),
2271 %b_interpreter_components:create_unsimplified_exists([b(identifier('_zzzz_unary'),TY,[])],P12,Body),
2272 bsyntaxtree:create_exists_opt_liftable([b(identifier('_zzzz_unary'),TY,[])],P12,Body), % cf Thales_All/rule_zcpa2 test 2287
2273 (SYMBOLIC==symbolic
2274 -> mark_bexpr_as_symbolic(Body,CBody)
2275 ; CBody=Body).
2276
2277 % generate predicate for X|->Y : Rel
2278 couple_member_pred(X,TX,Y,TY,Rel, Pred) :-
2279 Pred = b(member(b(couple(b(identifier(X),TX,[]),
2280 b(identifier(Y),TY,[])),couple(TX,TY),[]),
2281 b(value(Rel),set(couple(TX,TY)),[])),pred,[]).
2282
2283
2284
2285 :- block rel_compose2(-,?,?,?).
2286 rel_compose2([],_,Out,WF) :- empty_set_wf(Out,WF).
2287 rel_compose2([(X,Y)|T],Rel2,Out,WF) :-
2288 ? rel_extract(Rel2,X,Y,OutXY,[],WF),
2289 % rel_extract(Rel2,X,Y,Out,OutRem),
2290 ? rel_compose2(T,Rel2,OutRem,WF),
2291 ? union_wf(OutRem,OutXY,Out,WF). % used to call union wihout wf; makes test 1394 fail
2292
2293 :- block rel_extract(-,?,?,?,?,?).
2294 rel_extract([],_,_,Rem,Rem,_WF). % should we use equal_object here ?????
2295 rel_extract([(Y1,Z)|T],X,Y,Res,Rem,WF) :-
2296 ? rel_extract(T,X,Y,CT,Rem,WF),
2297 ? equality_objects_wf(Y1,Y,EqRes,WF),
2298 rel_extract2(EqRes,Z,X,CT,Res).
2299
2300 :- block rel_extract2(-,?,?,?,?).
2301 rel_extract2(pred_true, Z, X,CT,Res) :- add_element((X,Z),CT,Res).
2302 rel_extract2(pred_false,_Z,_X,CT,Res) :- Res = CT.
2303
2304
2305 % relational composition of a finite relation with an infinite or symbolic function
2306 rel_compose_with_inf_fun(R,Dom,Fun,CompRes,WF) :- !,
2307 rel_compose_with_inf_fun_acc(R,Dom,Fun,[],CompRes,WF).
2308 :- block rel_compose_with_inf_fun_acc(-,?,?,?,?,?).
2309 rel_compose_with_inf_fun_acc([],_Dom,_Rel2,Acc,Comp,WF) :-
2310 equal_object_wf(Comp,Acc,rel_compose_with_inf_fun_acc,WF).
2311 rel_compose_with_inf_fun_acc([(X,Y)|T],Dom,Fun,Acc,CompRes,WF) :-
2312 membership_test_wf(Dom,Y,MemRes,WF), % check if Y is in the domain of the symbolic relation
2313 rel_compose_with_inf_fun_acc_aux(MemRes,X,Y,T,Dom,Fun,Acc,CompRes,WF).
2314
2315 :- block rel_compose_with_inf_fun_acc_aux(-,?,?,?, ?,?,?,?, ?).
2316 rel_compose_with_inf_fun_acc_aux(pred_true,X,Y,T,Dom,Fun,Acc,CompRes,WF) :-
2317 apply_to(Fun,Y,FY,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
2318 add_element_wf((X,FY),Acc,NewAcc,WF),
2319 rel_compose_with_inf_fun_acc(T,Dom,Fun,NewAcc,CompRes,WF).
2320 rel_compose_with_inf_fun_acc_aux(pred_false,_X,_Y,T,Dom,Fun,Acc,Comp,WF) :-
2321 rel_compose_with_inf_fun_acc(T,Dom,Fun,Acc,Comp,WF).
2322
2323 % TO DO: if we obtain a list such as [(int(1),X),...] in Acc rather than an avl_set,
2324 % we may still be able to sort and avoid quadratic comparisons if e.g.
2325 % first component is a data-type where equality can be decided by unification (integer, bool, global(GS), ...)
2326 % we could put the optimisation into add_element_wf ?
2327 % TO DO: special version for avl_set as relation?
2328
2329 /*
2330 Note: old version; has performance problem, 2021/02_Feb/CDS
2331 the add_element_wf calls below can only construct/instantiate result when empty_set_wf reached
2332 and a lot of pending co-routines pile up for long relation lists
2333
2334 :- block rel_compose_with_inf_fun(-,?,?,?,?).
2335 rel_compose_with_inf_fun([],_Dom,_Rel2,Comp,WF) :- empty_set_wf(Comp,WF).
2336 rel_compose_with_inf_fun([(X,Y)|T],Dom,Fun,CompRes,WF) :-
2337 membership_test_wf(Dom,Y,MemRes,WF), rel_compose_with_inf_fun_aux(MemRes,X,Y,T,Dom,Fun,CompRes,WF).
2338
2339 :- block rel_compose_with_inf_fun_aux(-,?,?,?, ?,?,?,?).
2340 rel_compose_with_inf_fun_aux(pred_true,X,Y,T,Dom,Fun,CompRes,WF) :-
2341 apply_to(Fun,Y,FY,WF),
2342 add_element_wf((X,FY),CT,CompRes,WF),
2343 rel_compose_with_inf_fun(T,Dom,Fun,CT,WF).
2344 rel_compose_with_inf_fun_aux(pred_false,_X,_Y,T,Dom,Fun,Comp,WF) :-
2345 rel_compose_with_inf_fun(T,Dom,Fun,Comp,WF).
2346 */
2347
2348 :- assert_must_abort_wf(bsets_clp:rel_iterate_wf([],int(-1),_R,set(couple(integer,integer)),WF),WF).
2349 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([], int(2),[],set(couple(integer,integer)),_WF))).
2350 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], int(1),[(int(1),int(2)),(int(3),int(4)),(int(5),int(6))],set(couple(integer,integer)),_WF))).
2351 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(pred_true,pred_true)], int(0),
2352 [(pred_true,pred_true),(pred_false,pred_false)],set(couple(boolean,boolean)),_WF))).
2353 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:rel_iterate_wf([(int(1),int(2)),
2354 (int(2),int(4)),(int(4),int(6))], int(2),[(int(1),int(4)),(int(2),int(6))],
2355 set(couple(integer,integer)),WF),WF)).
2356 :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF), R=[],
2357 bsets_clp:equal_object(X,R))).
2358 :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF),
2359 R=[(int(1),int(2)),(int(2),int(3))],
2360 bsets_clp:equal_object(X,R))).
2361 :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(2),X,set(couple(integer,integer)),_WF),
2362 R=[(int(1),int(2)),(int(2),int(3))],
2363 bsets_clp:equal_object(X,[(int(1),int(3))]))).
2364 :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2365 R=[(int(1),int(2)),(int(2),int(3))],
2366 bsets_clp:equal_object(X,[]))).
2367 :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2368 R=[(int(1),int(2)),(int(2),int(3)),(int(1),int(1))],
2369 bsets_clp:equal_object(X,[(int(1),int(1)),(int(1),int(2)),(int(1),int(3))]))).
2370
2371 rel_iterate_wf(Rel,int(Nr),Res,Type,WF) :-
2372 opt_push_wait_flag_call_stack_info(WF,b_operator_call(iterate,
2373 [Nr,Rel],unknown),WF2),
2374 rel_iterate1(Nr,Rel,Res,Type,WF2).
2375
2376 :- block rel_iterate1(-,?,?,?,?).
2377 rel_iterate1(X,Rel,Res,Type,WF) :-
2378 %value_variables(Rel,GrV),
2379 rel_iterate2(X,Rel,Res,Type,WF).
2380
2381 rel_iterate2(X,Rel,Res,Type,WF) :-
2382 ( X=1 -> equal_object_wf(Res,Rel,rel_iterate2,WF)
2383 ; X>1 -> X1 is X-1,
2384 rel_iterate2(X1,Rel,R1,Type,WF),
2385 rel_composition_wf(Rel,R1,Res,Type,WF)
2386 ; X=0 -> rel_iterate0(Rel,Type,Res,WF)
2387 ; add_wd_error('negative index in iterate',X,WF)
2388 ).
2389
2390 :- use_module(bsyntaxtree,[get_set_type/2]).
2391 :- block rel_iterate0(?,-,?,?).
2392 rel_iterate0(_Rel,EType,Res,WF) :-
2393 get_set_type(EType,couple(Type,Type)),
2394 event_b_identity_for_type(Type,Res,WF).
2395
2396 :- use_module(typing_tools,[is_infinite_type/1]).
2397 event_b_identity_for_type(Type,Res,WF) :-
2398 create_texpr(identifier('_zzzz_unary'),Type,[],TIdentifier1), % was [generated]
2399 create_texpr(identifier('_zzzz_binary'),Type,[],TIdentifier2), % was [generated]
2400 (is_infinite_type(Type) -> Info = [prob_annotation('SYMBOLIC')] ; Info =[]),
2401 create_texpr(equal(TIdentifier1,TIdentifier2),pred,Info,TPred),
2402 construct_closure(['_zzzz_unary','_zzzz_binary'],[Type,Type],TPred,CRes),
2403 % for small types we could do: all_objects_of_type(Type,All), identity_relation_over_wf(All,CRes,WF)
2404 %, print(constructed_eventb_identity(Res)),nl
2405 equal_object_wf(Res,CRes,WF).
2406
2407
2408 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([],[(int(1),int(11))],[],_WF))).
2409 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2410 [(int(1),int(11))],[(int(1),(int(2),int(11)))],_WF))).
2411 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2412 [(int(2),int(11))],[],_WF))).
2413 :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2414 [(int(2),int(11))],X,_WF),
2415 X = [])).
2416 :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2417 [(int(1),int(11))],X,_WF),
2418 kernel_objects:equal_object(X,[(int(1),(int(2),int(11)))]))).
2419 :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(1),int(6))],
2420 [(int(1),int(11))],X,_WF),
2421 kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(6),int(11)))]))).
2422 :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2423 [(int(1),int(11)),(int(1),int(12))],X,_WF),
2424 kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))]))).
2425 :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2426 [(int(1),int(11)),(int(1),int(12))],
2427 [(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))],_WF))).
2428 :- assert_must_succeed((bsets_clp:direct_product_wf(avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))),
2429 avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))),
2430 avl_set(node((fd(1,'Name'),fd(2,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name'),fd(3,'Name')),true,0,empty,empty)))
2431 ,_WF))).
2432
2433 :- block direct_product_wf(-,?,?,?),direct_product_wf(?,-,?,?).
2434 direct_product_wf(Rel1,Rel2,Prod,WF) :-
2435 try_expand_and_convert_to_avl_with_check(Rel1,E1,direct_product), % to do: try_expand_and_convert_to_avl_unless_large_wf(Rel1,E1,WF),
2436 try_expand_and_convert_to_avl_with_check(Rel2,E2,direct_product),
2437 ? direct_product_wf1(E1,E2,Prod,WF).
2438
2439 direct_product_wf1(Rel1,Rel2,Prod,WF) :-
2440 direct_product_explicit_set(Rel1,Rel2,Res),!,
2441 equal_object_wf(Prod,Res,direct_product_wf1,WF).
2442 direct_product_wf1(Rel1,Rel2,Prod,WF) :-
2443 expand_custom_set_to_list_wf(Rel1,Relation1,_,direct_product_wf1_1,WF),
2444 expand_custom_set_to_list_wf(Rel2,Relation2,_,direct_product_wf1_2,WF),
2445 ? direct_product2(Relation1,Relation2,Prod,WF),
2446 ? direct_product_backwards(Relation1,Relation2,Prod,WF).
2447
2448 :- block direct_product2(-,?,?,?).
2449 direct_product2([],_,Out,WF) :- equal_object_wf(Out,[],direct_product2,WF).
2450 direct_product2([(X,Y)|T],Rel2,Out,WF) :-
2451 ? direct_product_tuple(Rel2,X,Y,Out,OutRem,WF),
2452 direct_product2(T,Rel2,OutRem,WF).
2453
2454 :- block direct_product_tuple(-,?,?,?,?,?).
2455 direct_product_tuple([],_,_,Res,Rem,WF) :- equal_object_optimized_wf(Res,Rem,direct_product_tuple,WF).
2456 direct_product_tuple([(X2,Z)|T],X,Y,Res,Rem,WF) :-
2457 direct_product_tuple(T,X,Y,CT,Rem,WF),
2458 equality_objects_wf(X2,X,EqRes,WF),
2459 ? direct_product_tuple3(EqRes,X,Y,Z,CT,Res,WF).
2460
2461 :- block direct_product_tuple3(-,?,?,?,?,?,?).
2462 direct_product_tuple3(pred_true,X,Y,Z,CT,Res,WF) :-
2463 ? equal_cons_wf(Res,(X,(Y,Z)),CT,WF). /* no need for add_element as output uniquely determines X,Y,Z !?*/
2464 direct_product_tuple3(pred_false,_X,_Y,_Z,CT,Res,WF) :- equal_object_optimized_wf(Res,CT,direct_product_tuple3,WF).
2465
2466 :- block direct_product_backwards(?,?,-,?).
2467 % Propagate information backwards from result to arguments
2468 direct_product_backwards(R1,R2,Prod,WF) :-
2469 ((ground_value(R1) ; ground_value(R2)) -> true
2470 ; expand_custom_set_to_list_wf(Prod,ProdList,_,direct_product_backwards,WF),
2471 ? direct_product_propagate_back(ProdList,R1,R2,WF)
2472 ).
2473
2474 :- block direct_product_propagate_back(-,?,?,?).
2475 direct_product_propagate_back([],_,_,_WF).
2476 direct_product_propagate_back([(X,(Y,Z))|T],R1,R2,WF) :-
2477 ? check_element_of_wf((X,Y),R1,WF), check_element_of_wf((X,Z),R2,WF),
2478 direct_product_propagate_back(T,R1,R2,WF).
2479
2480 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([],[(int(3),int(4))],[]))).
2481 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([(int(1),int(2))],
2482 [(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2483 :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2484 [(int(3),int(4))],X), ground(X),
2485 equal_object(X,[((int(1),int(3)),(int(2),int(4)))]))).
2486 :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2487 [(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2488 :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], [],X),X == [])).
2489 :- assert_must_succeed((bsets_clp:parallel_product([], [(int(3),int(4))],X),X == [])).
2490
2491 ?parallel_product(Rel1,Rel2,Prod) :- parallel_product_wf(Rel1,Rel2,Prod,no_wf_available).
2492
2493 :- block parallel_product_wf(-,?,?,?),parallel_product_wf(?,-,?,?).
2494 % NOTE: we now have in_parallel_product; as such parallel products are kept symbolic
2495 %parallel_product_wf(Rel1,Rel2,Prod,WF) :- (keep_symbolic(Rel1) -> true ; keep_symbolic(Rel2)),
2496 % print_term_summary(parallel_product(Rel1,Rel2,Prod)),nl,
2497 %% % TO DO: generate closure
2498 % %{xy,mn|#(x,y,m,n).(xy=(x,y) & mn=(m,n) & (x,m):S & (y,n):R)}
2499 % fail.
2500 parallel_product_wf(Rel1,Rel2,Prod,WF) :-
2501 expand_custom_set_to_list_wf(Rel1,Relation1,_,parallel_product_1,WF),
2502 expand_custom_set_to_list_wf(Rel2,Relation2,_,parallel_product_2,WF),
2503 parallel_product2(Relation1,Relation2,ProdRes,WF),
2504 ? equal_object_optimized_wf(ProdRes,Prod,parallel_product,WF).
2505
2506 :- use_module(kernel_equality,[conjoin_test/4]).
2507 %(Rel1||Rel2) = {(x,y),(m,n)| (x,m):Rel1 & (y,n):Rel2}
2508
2509 % TO DO: use this in b_interpreter_check:
2510 in_parallel_product_test(((X,Y),(M,N)),Rel1,Rel2,Result,WF) :-
2511 ? conjoin_test(MemRes1,MemRes2,Result,WF),
2512 ? membership_test_wf(Rel1,(X,M),MemRes1,WF),
2513 membership_test_wf(Rel2,(Y,N),MemRes2,WF).
2514
2515 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_parallel_product_wf(((int(1),int(2)),(int(11),int(22))),[(int(1),int(11))],[(int(2),int(22))],WF),WF)).
2516
2517 in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2518 in_parallel_product_test(El,Rel1,Rel2,pred_true,WF).
2519
2520
2521 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_in_parallel_product_wf(((int(1),int(11)),(int(2),int(22))),[(int(1),int(11))],[(int(2),int(22))],_WF))).
2522
2523 not_in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2524 ? in_parallel_product_test(El,Rel1,Rel2,pred_false,WF).
2525
2526
2527 :- block parallel_product2(-,?,?,?).
2528 parallel_product2([],_,Out,WF) :- empty_set_wf(Out,WF).
2529 parallel_product2([(X,Y)|T],Rel2,Out,WF) :-
2530 parallel_product_tuple(Rel2,X,Y,Out,Tail,WF),
2531 parallel_product2(T,Rel2,Tail,WF).
2532
2533 :- block parallel_product_tuple(-,?,?,?,?,?).
2534 parallel_product_tuple([],_,_,Tail1,Tail2,WF) :- equal_object_wf(Tail1,Tail2,parallel_product_tuple,WF).
2535 parallel_product_tuple([(X2,Y2)|T],X,Y,Rel2,Tail,WF) :-
2536 equal_object_wf(Rel2,[((X,X2),(Y,Y2))|RT],parallel_product_tuple,WF),
2537 parallel_product_tuple(T,X,Y,RT,Tail,WF).
2538
2539
2540 % -------------------------------------------------
2541
2542 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1)],[int(7),int(6)],WF),WF)). %% with wf_det leads to residue custom_explicit_sets:b_not_test_closure_enum
2543 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
2544 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2545 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(1),int(7))],[int(1)],[int(7),int(6)],WF),WF)).
2546 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2547 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2548 :- assert_must_fail((bsets_clp:not_partial_function([],[int(1)],[int(7)],_WF))).
2549 :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[int(7)],_WF),
2550 X = [(int(1),int(7))])).
2551 :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7)],_WF),
2552 X = [(int(2),int(7)),(int(1),int(7))])).
2553 :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2554 [int(7),int(6)],_WF),
2555 X = [([(int(1),int(2))],int(7)),
2556 ([(int(2),int(3)),(int(1),int(3))],int(6))])).
2557 :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2558 [int(7),int(6)],_WF),
2559 X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2560 :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2561 [int(7),int(6)],_WF),
2562 X = [([(int(1),int(2))],int(7)),
2563 ([(int(2),int(3)),(int(1),int(3))],int(6))])).
2564 :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[[int(7),int(6)]],_WF),
2565 X = [(int(1),[int(6),int(7)])])).
2566 :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2567 X = [(int(2),int(7)),(int(1),int(7))])).
2568 :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2569 X = [(int(2),int(7)),(int(2),int(6))])).
2570 :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2571 X = [(int(2),int(7)),(int(1),int(2))])).
2572 :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2573 X = [(int(2),int(7)),(int(3),int(6))])).
2574 :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2575 X = [(int(2),int(7)),(int(2),int(5))])).
2576 :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2577 X = [(int(1),int(7)),(int(2),int(6)),(int(2),int(7))])).
2578 :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2579 X = [(int(1),int(7)),(int(5),int(75))])).
2580 :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2581 X = [(int(1),int(7)),(int(0),int(7))])).
2582 :- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2583 X = [(int(1),int(7)),(int(-1),int(7))])).
2584 :- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2585 X = [(int(1),int(7)),(int(0),int(7))])).
2586 :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('Name'),global_set('Code'),_WF),
2587 X = [(fd(1,'Name'),fd(1,'Code'))])).
2588 :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2589 X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2590 :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2591 X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2592 :- assert_must_succeed((bsets_clp:not_partial_function([(fd(1,'Code'),int(1)),(fd(1,'Code'),int(2))],
2593 global_set('Code'),global_set('NAT1'),_WF) )).
2594
2595 :- block not_partial_function(-,?,?,?).
2596 not_partial_function([],_Domain,_Range,_WF) :- !,fail.
2597 not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2598 % we do not need the Range; this means we can match more closures (e.g., lambda)
2599 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2600 not_subset_of_wf(FFDomain,Domain,WF).
2601 not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),
2602 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2603 not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
2604 not_partial_function(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2605 % example: f = %t.(t : NATURAL|t + 100) & f /: NATURAL +-> NATURAL
2606 is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2607 get_range_id_expression(P,T,TRangeID),!,
2608 subset_test(FFDomain,Domain,SubRes,WF),
2609 when(nonvar(SubRes),
2610 (SubRes=pred_false -> true % not a subset -> it is not a partial function over the domain
2611 ; check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF))).
2612 not_partial_function(R,Domain,Range,WF) :-
2613 expand_and_convert_to_avl_set_warn(R,AER,not_partial_function,'ARG /: ? +-> ?',WF),!,
2614 % TO DO: expand_and_convert_to_avl_set_catch and provide symbolic treatment similar to partial_function
2615 % e.g., to support f = NATURAL1 * {22,33} & not(f: NATURAL1 +-> NATURAL)
2616 is_not_avl_partial_function(AER,Domain,Range,WF).
2617 not_partial_function(R,Domain,Range,WF) :-
2618 expand_custom_set_to_list_wf(R,ER,_,not_partial_function,WF),
2619 not_pf(ER,[],Domain,Range,WF).
2620
2621 is_not_avl_partial_function(AER,Domain,Range,WF) :-
2622 (is_avl_partial_function(AER)
2623 -> is_not_avl_relation_over_domain_range(AER,Domain,Range,WF)
2624 ; true
2625 ).
2626
2627 :- block not_pf(-,?,?,?,?).
2628 not_pf([],_,_,_,_) :- fail.
2629 not_pf([(X,Y)|T],SoFar,Dom,Ran,WF) :-
2630 membership_test_wf_with_force(SoFar,X,MemRes,WF),
2631 not_pf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2632
2633 :- block not_pf2(-,?,?,?,?,?,?,?).
2634 not_pf2(pred_true,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* then not a function */
2635 not_pf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
2636 membership_test_wf_with_force(Dom,X,MemRes,WF), % creates a choice point in SMT mode
2637 not_pf2a(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2638
2639 :- block not_pf2a(-,?,?,?,?,?,?,?).
2640 not_pf2a(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* function, but domain wrong */
2641 not_pf2a(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
2642 remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,_LWF,Done), %% provide _LWF ??
2643 not_pf2b(Done,X,Y,T,SoFar,Dom2,Ran,WF).
2644
2645 :- block not_pf2b(-, ?,?,?, ?,?,?, ?).
2646 not_pf2b(_Done, X,Y,T, SoFar,Dom2,Ran, WF) :-
2647 add_element_wf(X,SoFar,SoFar2,WF),
2648 (T==[] -> not_element_of_wf(Y,Ran,WF)
2649 ; membership_test_wf_with_force(Ran,Y,MemRes,WF),
2650 prop_empty_pred_false(T,MemRes), % if T=[] -> Y must not be in Ran
2651 not_pf3(MemRes,T,SoFar2,Dom2,Ran,WF)).
2652
2653 :- block prop_empty_pred_false(-,?).
2654 prop_empty_pred_false([],R) :- !, R=pred_false.
2655 prop_empty_pred_false(_,_).
2656
2657 :- block not_pf3(-,?,?,?,?,?).
2658 not_pf3(pred_false,_T,_SoFar,_Dom2,_Ran,_WF). /* illegal range */
2659 not_pf3(pred_true,T,SoFar,Dom2,Ran,WF) :-
2660 not_pf(T,SoFar,Dom2,Ran,WF).
2661
2662 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2663 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(1),int(1)),(int(2),int(1))],global_set('NATURAL'),global_set('NATURAL'),WF),WF)).
2664 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2665 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_function_wf([(int(2),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2666 :- assert_must_succeed((bsets_clp:partial_function([],[int(1)],[int(7)]))).
2667 :- assert_must_succeed((bsets_clp:partial_function(X,[int(1)],[int(7)]),
2668 X = [(int(1),int(7))])).
2669 :- assert_must_succeed((bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),
2670 equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
2671 :- assert_must_succeed((findall(X,bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),L),
2672 length(L,Len), Len >= 4,
2673 (preferences:get_preference(convert_comprehension_sets_into_closures,true) -> true ; Len=4) )).
2674 :- assert_must_succeed((bsets_clp:partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2675 [int(7),int(6)]),
2676 equal_object(X,[([(int(1),int(2))],int(7)),
2677 ([(int(2),int(3)),(int(1),int(3))],int(6))]))).
2678 :- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2679 [int(7),int(6)],_WF),
2680 X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2681 :- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2682 [int(7),int(6)],_WF),
2683 X = [([(int(1),int(2))],int(7)),
2684 ([(int(2),int(3)),(int(1),int(3))],int(6))])).
2685 :- assert_must_succeed((bsets_clp:partial_function_wf(X,[int(1)],[[int(7),int(6)]],_WF),
2686 X = [(int(1),[int(6),int(7)])])).
2687 :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2688 X = [(int(1),int(7)),(int(5),int(75))])).
2689 :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2690 X = [(int(1),int(7)),(int(0),int(7))])).
2691 :- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2692 X = [(int(1),int(7)),(int(-1),int(7))])).
2693 :- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2694 X = [(int(1),int(7)),(int(0),int(7))])).
2695 :- assert_must_fail((bsets_clp:partial_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
2696 X = [(int(2),int(7)),(int(2),int(6))])).
2697 :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('Name'),global_set('Code'),_WF),
2698 X = [(fd(1,'Name'),fd(1,'Code'))])).
2699 :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2700 X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2701 :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2702 X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2703
2704 partial_function(R,Domain,Range) :- init_wait_flags(WF,[partial_function]),
2705 partial_function_wf(R,Domain,Range,WF),
2706 ? ground_wait_flags(WF).
2707
2708 :- use_module(kernel_equality,[get_cardinality_powset_wait_flag/5]).
2709 :- use_module(closures,[is_lambda_value_domain_closure/5]).
2710 :- block partial_function_wf(-,-,?,?).
2711 partial_function_wf(R,_Domain,_Range,_WF) :- R==[], !.
2712 partial_function_wf(R,Domain,Range,WF) :- (Domain==[] ; Range==[]), !, empty_set_wf(R,WF).
2713 partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),
2714 custom_explicit_sets:is_definitely_maximal_set(Range),
2715 % we do not need the Range; this means we can match more closures (e.g., lambda)
2716 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2717 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF).
2718 partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),
2719 % TODO: this will fail if is_definitely_maximal_set was true above !
2720 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2721 % same as for total_function_wf check
2722 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
2723 check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
2724 partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2725 % example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 +-> NATURAL
2726 is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2727 get_range_id_expression(P,T,TRangeID),
2728 !,
2729 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
2730 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2731 [b_operator(range,[FF]),Range],unknown),WF3),
2732 check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF3). % we could use symbolic_range_subset_check
2733 partial_function_wf(R,Domain,Range,WF) :-
2734 expand_and_convert_to_avl_set_catch(R,AER,partial_function_wf,'ARG : ? +-> ?',ResultStatus,WF),!,
2735 (ResultStatus=avl_set
2736 ? -> is_avl_partial_function_over(AER,Domain,Range,WF)
2737 ; % keep symbolic
2738 (debug_mode(off) -> true ; print('SYMBOLIC +-> check : '),translate:print_bvalue(R),nl),
2739 % can deal with, e.g., f = %x.(x:NATURAL|x+1) & g = f <+ {0|->0} & g : INTEGER +-> INTEGER
2740 symbolic_domain_subset_check(R,Domain,WF),
2741 symbolic_range_subset_check(R,Range,WF),
2742 symbolic_functionality_check(R,WF)
2743 ).
2744 partial_function_wf(R,Domain,Range,WF) :-
2745 get_cardinality_powset_wait_flag(Domain,partial_function_wf,WF,Card,CWF),
2746 % probably we should compute real cardinality of set of partial functions over Domain +-> Range ?
2747 % the powset waitflag uses 2^Card as priority; is the number of partial functions when Range contains just a single element
2748 % slows down test 1088: TO DO investigate
2749 % get_cardinality_partial_function_wait_flag(Domain,Range,partial_function_wf,WF,Card,_,CWF),
2750 %% Maybe we should only enumerate partial functions for domain variables ; e.g., not f <+ {x |-> y} : T +-> S
2751 %% print_bt_message(pf_dom_card(Card)),nl, %%%
2752 % probably we should use a special version when R is var
2753 propagate_empty_set_wf(Domain,dom_pf,R,WF),
2754 propagate_empty_set_wf(Range,ran_pf,R,WF),
2755 ? (var(R) -> pf_var_r(R,var,Domain,Range,Card,WF,CWF) ; pf_var_r(R,nonvar,Domain,Range,Card,WF,CWF)).
2756
2757 % symbolic dom(R) <: Domain check for closures
2758 symbolic_domain_subset_check(R,Domain,WF) :-
2759 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2760 [b_operator(domain,[R]),Domain],unknown),WF2),
2761 domain_subtraction_wf(Domain,R,Res,WF2), % works symbolically
2762 (debug_mode(off) -> true ; print('Domain Violations: '),translate:print_bvalue(Res),nl),
2763 empty_set_wf(Res,WF2). % empty_set does a symbolic treatment calling gen_typed_ids and b_not_test_exists:
2764 % symbolic ran(R) <: Range check for closures
2765 symbolic_range_subset_check(R,Range,WF) :-
2766 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2767 [b_operator(range,[R]),Range],unknown),WF2),
2768 range_subtraction_wf(R,Range,Res,WF2), % works symbolically
2769 (debug_mode(off) -> true ; print('Range Violations: '),translate:print_bvalue(Res),nl),
2770 empty_set_wf(Res,WF2). % works symbolically
2771 symbolic_functionality_check(Closure,WF) :-
2772 custom_explicit_sets:symbolic_functionality_check_closure(Closure,ViolationsClosure),!,
2773 (debug_mode(off) -> true ; print('FUNCTIONALITY Violations: '),translate:print_bvalue(ViolationsClosure),nl),
2774 empty_set_wf(ViolationsClosure,WF). % works symbolically
2775 symbolic_functionality_check(R,WF) :-
2776 add_error_wf(symbolic_functionality_check,'Could not check functionality of:',R,R,WF).
2777
2778 symbolic_injectivity_check(Closure,WF) :-
2779 custom_explicit_sets:symbolic_injectivity_check_closure(Closure,ViolationsClosure),!,
2780 (debug_mode(off) -> true ; print('INJECTIVITY Violations: '),translate:print_bvalue(ViolationsClosure),nl),
2781 empty_set_wf(ViolationsClosure,WF). % works symbolically
2782 symbolic_injectivity_check(R,WF) :-
2783 add_error_wf(symbolic_functionality_check,'Could not check injectivity of:',R,R,WF).
2784
2785
2786 is_avl_partial_function_over(AER,Domain,Range,WF) :-
2787 is_avl_partial_function(AER),
2788 ? is_avl_relation_over_domain(AER,Domain,WF),
2789 ? is_avl_relation_over_range(AER,Range,WF).
2790
2791 % symbolically check that the range of lambda closure is a subset of a given Range
2792 % TRangeID is obtained by calling get_range_id_expression(P,T,TRangeID)
2793 check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF) :-
2794 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2795 [b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2796 % CHECK not(#P.(Pred & TRangeID /: Range))
2797 get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2798 is_empty_closure_wf(P,T,Pred2,WF2). % do we need to rename _lambda_result_ using rename_lambda_result_id ?
2799 % now the negation thereof:
2800 check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF) :-
2801 opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_subset,
2802 [b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2803 % CHECK (#P.(Pred & TRangeID /: Range))
2804 get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2805 is_non_empty_closure_wf(P,T,Pred2,WF2).
2806 test_lambda_closure_range(P,T,Pred,TRangeID,Range,Res,WF) :-
2807 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset, % it is actually a reify check
2808 [b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2809 % reify not(#P.(Pred & TRangeID /: Range))
2810 get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2811 test_empty_closure_wf(P,T,Pred2,Res,WF2).
2812
2813 get_not_in_range_pred_aux(Pred,TRangeID,Range,NewPred) :- % construct (Pred & TRangeID /: Range)
2814 ExpectedRange = b(value(Range),set(RanT),[]),
2815 get_texpr_type(TRangeID,RanT),
2816 safe_create_texpr(not_member(TRangeID,ExpectedRange),pred,NotMemCheck),
2817 conjunct_predicates([Pred,NotMemCheck],NewPred).
2818
2819
2820 % if first argument is empty, second argument must also be empty
2821 :- block propagate_empty_set_wf(-,?,?,?).
2822 propagate_empty_set_wf([],_PP,A,WF) :- !, %print(prop_empty(_PP,A)),nl,
2823 kernel_objects:empty_set_wf(A,WF). % TO DO: add WF
2824 propagate_empty_set_wf(_,_,_,_).
2825
2826 :- block pf_var_r(-,?,?,?,?,?,-).
2827 pf_var_r(R,var,Domain,Range,_Card,WF,_CWF) :- % if R was var: see if it is now an AVL set; otherwise we have already checked it
2828 expand_and_convert_to_avl_set_warn(R,AER,pf_var_r,'ARG : ? +-> ?',WF),!,
2829 ? is_avl_partial_function_over(AER,Domain,Range,WF).
2830 pf_var_r(R,_,Domain,Range,Card,WF,CWF) :-
2831 expand_custom_set_to_list_wf(R,ER,_,partial_function_wf,WF),
2832 %get_last_wait_flag(partial_fun(Domain),WF,LWF),
2833 ? pf_w(ER,[],Domain,Range,Card,_Large,WF,CWF).
2834
2835 pf_w(T,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2836 (Card==0 -> T=[]
2837 ? ; pf(T,SoFar,Dom,Ran,Card,Large,WF,LWF)).
2838
2839 :- block pf(-,?,?,?,?,?,?,-).
2840 pf(LIST,_,_,_,_,_WF,_,_LWF) :- LIST==[],!. % avoid leaving choicepoint
2841 pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF) :- nonvar(AVL),AVL=avl_set(_A),
2842 add_internal_error('AVL arg: ',pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF)),fail.
2843 pf([],_,_,_,_,_WF,_,_LWF).
2844 pf(LIST,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2845 (var(LIST) -> ListWasVar = true ; ListWasVar = false), % is ListWasVar = true we are doing the enumeration driven by LWF being ground
2846 LIST = [(X,Y)|T],
2847 dec_card(Card,NC),/* Card ensures we do not build too big lists */
2848 Dom \== [],
2849 ? remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done),
2850 ? check_element_of_wf(Y,Ran,WF),
2851 ? pf1(Done, X,Y,T,SoFar,Dom2,Ran,NC,Large,WF,LWF).
2852
2853 :- block dec_card(-,?).
2854 dec_card(inf,NewC) :- !, NewC=inf.
2855 dec_card(inf_overflow,NewC) :- !, NewC=inf_overflow.
2856 dec_card(C,NewC) :- C>0, NewC is C-1.
2857
2858 :- block pf1(-, ?,?,?,?,?,?,?,?,?,?).
2859 pf1(_Done, X,_Y,T,SoFar,Dom2,Ran,Card,Large,WF,LWF) :-
2860 not_element_of_wf(X,SoFar,WF), /* check that it is a function */
2861 %% check_element_of_wf(Y,Ran,WF), % this check is now done above in pf
2862 add_new_element_wf(X,SoFar,SoFar2,WF),
2863 ? pf_w(T,SoFar2,Dom2,Ran,Card,Large,WF,LWF).
2864
2865 remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done) :- compute_large(Dom,Large),
2866 ((ListWasVar==true,var(X),var(Y),Large==false,
2867 preference(convert_comprehension_sets_into_closures,false), % not in symbolic mode
2868 ground_value(Dom))
2869 -> %% (X, Y are free and we drive the enumeration: we can influence which element is taken from Dom
2870 remove_a_minimal_element(X,Dom,Dom2,WF,Done) %%%%%%%%%% added Jul 15 2008
2871 ? ; remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,LWF,Done)
2872 ).
2873 compute_large(Dom,Large) :- % check if the domain is large; ensure that we compute this only once
2874 (nonvar(Large) -> true
2875 ; var(Dom) -> true
2876 ; dont_expand_this_explicit_set(Dom) -> Large=large
2877 ; Large=false).
2878
2879 :- assert_must_succeed(( bsets_clp:remove_a_minimal_element(X,[int(1)],R,_WF,Done),
2880 X==int(1), Done==true, R=[] )).
2881 :- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2882 X==int(2), Done==true, R=[int(3)] )).
2883 :- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2884 X==int(1), R=[int(2),int(3)], Done==true )).
2885 :- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2886 X==int(3), R=[], Done==true )).
2887 :- assert_must_succeed(( init_wait_flags(WF), CL=closure(['_zzzz_binary'],[integer],b(member( b(identifier('_zzzz_binary'),integer,[]),
2888 b(interval(b(value(int(1)),integer,[]),b(value(int(10)),integer,[])),set(integer),[])),pred,[])),
2889 bsets_clp:remove_a_minimal_element(X,CL,R,WF,Done), ground_wait_flags(WF),
2890 X=int(9), Done==true, kernel_objects:equal_object(R,[int(10)]) )).
2891
2892 /* usage: restrict number of possible choices if element to remove is free */
2893 /* select one element; and disallow all elements appearing before it in the list */
2894 remove_a_minimal_element(X,Set,Res,WF,Done) :-
2895 expand_custom_set_to_list_wf(Set,ESet,EDone,remove_a_minimal_element,WF),
2896 remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done).
2897
2898 :- use_module(kernel_equality,[get_cardinality_wait_flag/4]).
2899 :- block remove_a_minimal_element2(?,?,-,?,?,?).
2900 remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done) :- var(ESet),
2901 % should not happen as we wait for EDone
2902 add_internal_error('Illegal call: ',remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done)),
2903 fail.
2904 remove_a_minimal_element2(X,ESet,_EDone,Res,WF,Done) :-
2905 ESet \= [],
2906 (ESet = [El]
2907 -> X=El, empty_set_wf(Res,WF), Done=true % only one choice
2908 ; get_cardinality_wait_flag(ESet,remove_a_minimal_element2,WF,CWF),
2909 remove_a_minimal_element3(X,ESet,Res,WF,Done,CWF)
2910 ).
2911
2912 :- block remove_a_minimal_element3(?,?,?,?,?,-).
2913 remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- var(Res), !,
2914 append(_,[X|TRes],ESet), % WHAT IF Res has been instantiated in the meantime ???
2915 equal_object_wf(Res,TRes,remove_a_minimal_element2_2,WF),Done=true.
2916 remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- %print(remove_min_nonvar_res(Res)),nl,
2917 equal_cons_wf(ESet,X,Res,WF), Done=true.
2918
2919
2920 % reified version of partial function test partial_function_wf:
2921 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2922 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2923 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2924 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(2),int(8))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2925 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2926 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(1),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2927
2928 :- use_module(kernel_equality,[subset_test/4]).
2929 :- block partial_function_test_wf(-,?,?,-,?), partial_function_test_wf(?,-,-,-,?).
2930 partial_function_test_wf(FF,Domain,Range,Res,WF) :- Res==pred_true,!,
2931 ? partial_function_wf(FF,Domain,Range,WF).
2932 partial_function_test_wf(FF,Domain,Range,Res,WF) :- Res==pred_false,!,
2933 not_partial_function(FF,Domain,Range,WF). % TO DO: remove not_partial_function to use check_is_partial_function?
2934 partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF),
2935 custom_explicit_sets:is_definitely_maximal_set(Range),
2936 % we do not need the Range; this means we can match more closures (e.g., lambda)
2937 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2938 subset_test(FFDomain,Domain,Res,WF).
2939 partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF),
2940 % TODO: this will fail if is_definitely_maximal_set was true above !
2941 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2942 % same as for total_function_wf check
2943 subset_test(FFDomain,Domain,DomainOk,WF),
2944 (DomainOk==pred_false -> Res = pred_false
2945 ; conjoin_test(DomainOk,RangeOk,Res,WF),
2946 subset_test(FFRange,Range,RangeOk,WF)).
2947 partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2948 % example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 +-> NATURAL
2949 is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2950 get_range_id_expression(P,T,TRangeID),
2951 !,
2952 subset_test(FFDomain,Domain,DomainOk,WF),
2953 (DomainOk == pred_false -> Res=pred_false
2954 ; conjoin_test(DomainOk,RangeOk,Res,WF),
2955 test_lambda_closure_range(P,T,Pred,TRangeID,Range,RangeOk,WF)
2956 ).
2957 partial_function_test_wf(R,Domain,Range,Res,WF) :-
2958 expand_and_convert_to_avl_set_warn(R,AER,partial_function_test_wf,'ARG : ? +-> ?',WF),!,
2959 % TO DO: use expand_and_convert_to_avl_set_catch
2960 (is_avl_partial_function(AER)
2961 -> % TO DO: we could do something similar to this instead: is_not_avl_relation_over_domain_range
2962 domain_of_explicit_set_wf(avl_set(AER),FFDomain,WF),
2963 subset_test(FFDomain,Domain,DomainOk,WF),
2964 (DomainOk == pred_false -> Res=pred_false
2965 ; range_of_explicit_set_wf(avl_set(AER),FFRange,WF),
2966 conjoin_test(DomainOk,RangeOk,Res,WF),
2967 subset_test(FFRange,Range,RangeOk,WF)
2968 )
2969 ; Res=pred_false).
2970 partial_function_test_wf(R,Domain,Range,Res,WF) :-
2971 expand_custom_set_to_list_wf(R,ER,_,partial_function_test_wf,WF),
2972 check_is_partial_function_acc_wf(ER,[],Domain,Range,Res,WF).
2973
2974 :- block check_is_partial_function_acc_wf(-,?,?,?,?,?).
2975 check_is_partial_function_acc_wf([],_,_,_,Res,_WF) :- !, Res=pred_true.
2976 check_is_partial_function_acc_wf([(A,FA)|T],Acc,Dom,Ran,Res,WF) :- !,
2977 check_pair_in_domain_range(A,FA,Dom,Ran,MemResDomRan,WF),
2978 (MemResDomRan==pred_false
2979 -> Res = pred_false
2980 ; membership_test_wf(Acc,A,MemResNotFunc,WF),
2981 negate(MemResNotFunc,MemResFunctionality),
2982 conjoin_test(MemResDomRan,MemResFunctionality,PF_Head,WF),
2983 (PF_Head == pred_false -> Res = pred_false
2984 ; T==[] -> Res=PF_Head
2985 ; add_element_wf(A,Acc,NewAcc,WF),
2986 conjoin_test(PF_Head,PF_Tail,Res,WF),
2987 check_is_partial_function_acc_wf(T,NewAcc,Dom,Ran,PF_Tail,WF))
2988 ).
2989
2990 check_pair_in_domain_range(A,FA,Dom,Ran,MemResDomRan,WF) :-
2991 membership_test_wf(Dom, A,MemResDom,WF), % use membership_test_wf_with_force for SMT mode ??
2992 (MemResDom == pred_false -> MemResDomRan = pred_false
2993 ; membership_test_wf(Ran,FA,MemResRan,WF),
2994 conjoin_test(MemResDom,MemResRan,MemResDomRan,WF)).
2995
2996 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_function_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2997 :- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[int(7)]),
2998 X = [(int(1),int(7))])).
2999 :- assert_must_succeed((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3000 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
3001 :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3))]],[int(7),int(6)]),
3002 kernel_objects:equal_object(X,[([(int(1),int(3))],int(7)),([(int(1),int(2))],int(7))]))).
3003 :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3004 [int(7),int(6)]),
3005 kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
3006 ([(int(2),int(3)),(int(1),int(3))],int(6))]))).
3007 :- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[[int(7),int(6)]]),
3008 kernel_objects:equal_object(X,[(int(1),[int(6),int(7)])]))).
3009 :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3010 [[int(7),int(6)]]),
3011 kernel_objects:equal_object(X,[([(int(1),int(2))],[int(6),int(7)]),
3012 ([(int(2),int(3)),(int(1),int(3))],[int(6),int(7)])]))).
3013 :- assert_must_succeed((bsets_clp:total_function(X,[ [(int(1),int(3)),(int(2),int(3))]],
3014 [int(6)]),
3015 kernel_objects:equal_object(X,[ ([(int(2),int(3)),(int(1),int(3))], int(6)) ]))).
3016 :- assert_must_succeed((bsets_clp:total_function(X,global_set('Name'),
3017 [[],[fd(1,'Code'),fd(2,'Code')],[fd(1,'Code')],[fd(2,'Code')]]),
3018 kernel_objects:enumerate_basic_type(X,set(couple(global('Name'),set(global('Code'))))),
3019 kernel_objects:equal_object(X,[(fd(3,'Name'),[fd(2,'Code')]),(fd(1,'Name'),[fd(2,'Code')]),(fd(2,'Name'),[])]))).
3020
3021 %:- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF),bsets_clp:total_function_wf(TF,global_set('Code'),
3022 % closure([zzzz],[set(set(couple(integer,boolean)))],
3023 % member(identifier(zzzz),
3024 % pow_subset(value(closure([zzzz],[set(couple(integer,boolean))],
3025 % member('ListExpression'(['Identifier'(zzzz)]),
3026 % 'Seq'(value([pred_true /* bool_true */,pred_false /* bool_false */])))))))),WF),
3027 % kernel_objects:equal_object(TF,[ (fd(1,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]),
3028 % (fd(2,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]) ]),
3029 % kernel_waitflags:ground_wait_flags(WF) )).
3030
3031 :- assert_must_succeed((bsets_clp:total_function([],[],[int(7)]))).
3032
3033 :- assert_must_fail((bsets_clp:total_function([],[int(1)],[int(7)]))).
3034 :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3035 kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
3036 :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3037 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(5))]))).
3038 :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3039 kernel_objects:equal_object(X,[(int(2),int(7))]))).
3040 :- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3041 [int(7),int(6)]),
3042 kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
3043 ([(int(1),int(3)),(int(1),int(3))],int(6))]))).
3044 :- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3045 [int(7),int(6)]),
3046 kernel_objects:equal_object(X,[([(int(1),int(3)),(int(1),int(3))],int(6))]))).
3047
3048 total_function(R,Domain,Range) :- init_wait_flags(WF,[total_function]),
3049 total_function_wf(R,Domain,Range,WF),
3050 ? ground_wait_flags(WF).
3051
3052
3053 :- assert_must_succeed((bsets_clp:total_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
3054 nonvar(X),X=[(A,B),(C,D)],A==int(1),C==int(2),\+ ground(B),\+ ground(D), B=int(7),D=int(7) )).
3055
3056 :- block total_function_wf(-,-,-,?).
3057 total_function_wf(FF,Domain,_Range,WF) :- FF == [],!,
3058 empty_set_wf(Domain,WF).
3059 total_function_wf(FF,Domain,Range,WF) :-
3060 Range == [],!,
3061 empty_set_wf(FF,WF), empty_set_wf(Domain,WF).
3062 total_function_wf(FF,Domain,Range,WF) :-
3063 % TO DO: if FF or Domain nonvar but \= [] -> check if other variable becomes []
3064 ? total_function_wf1(FF,Domain,Range,WF).
3065
3066 :- block total_function_wf1(?,-,?,?).
3067 total_function_wf1(FF,Domain,_Range,WF) :-
3068 FF==[],!,
3069 empty_set_wf(Domain,WF).
3070 total_function_wf1(FF,Domain,Range,WF) :-
3071 custom_explicit_sets:is_definitely_maximal_set(Range),
3072 % we do not need the Range; this means we can match more closures (e.g., lambda)
3073 (nonvar(FF),
3074 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF)
3075 -> !,
3076 equal_object_wf(FFDomain,Domain,total_function_wf1_1,WF)
3077 ; var(FF),
3078 get_wait_flag1(WF,WF1), var(WF1),
3079 \+ (custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card), number(Card)),
3080 % we have a total_function over a possibly infinite domain,
3081 % better wait: maybe a recursive of other closure will be produced for FF
3082 !,
3083 when( (nonvar(FF) ; nonvar(WF1)), total_function_wf1(FF,Domain,Range,WF))
3084 ).
3085 total_function_wf1(FF,Domain,Range,WF) :- nonvar(FF),
3086 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
3087 equal_object_wf(FFDomain,Domain,total_function_wf1_2,WF),
3088 check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
3089 total_function_wf1(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
3090 total_function_avl_set(AEF,Domain,Range,WF).
3091 total_function_wf1(FF,Domain,Range,WF) :-
3092 % want to replace FF by closure: needs to be a variable!
3093 var(FF),
3094 % if the total function can not be build up explicitly (i.e. infinite domain)
3095 % TODO: can / should this be relaxed?
3096 custom_explicit_sets:is_infinite_explicit_set(Domain), % get_card_for_specific_custom_set or is_infinite_or_symbolic_closure
3097 % TO DO: delay if Domain infinite or closure and not yet known and range is type
3098 kernel_objects:infer_value_type(Domain,set(DomT)),
3099 kernel_objects:infer_value_type(Range,set(RanT)),
3100 !,
3101 % IDEA : TF = %x.(x:Domain|DEFAULT) <+ SFF, where SFF is partial function and DEFAULT is some default value
3102 % build up a partial function instead (fulfilling all constraints)
3103 % better? : %x.(x:Domain|IF x:dom(SFF) THEN SFF(x) ELSE DEFAULT)?
3104 partial_function_wf(SFF,Domain,Range,WF),
3105 % next, build up a total function mapping everything to a default value
3106 % this function will be overriden by the partial function to fulfilling
3107 % given constraints
3108 % 1. identifiers for closure
3109 create_texpr(identifier('__domid__'),DomT,[],TDomId),
3110 create_texpr(identifier('__ranid__'),RanT,[],TRanId),
3111 % 2. domain identifier might take all values of the domain
3112 create_texpr(member(TDomId,b(value(Domain),set(DomT),[])),pred,[],DomMember),
3113 % 3. pick a single value for the range identifier
3114 check_element_of_wf(RangeElement,Range,WF),
3115 %% external_functions:observe_value(RangeElement,"range"),external_functions:observe_value(SFF,"pf"),
3116 create_texpr(equal(TRanId,b(value(RangeElement),RanT,[])),pred,[],RanMember),
3117 % 4. conjunct and form closure (should be treated symbolically)
3118 conjunct_predicates([RanMember,DomMember],Pred),
3119 Default = closure(['__domid__','__ranid__'],[DomT,RanT],Pred),
3120 % 5. override default values where needed
3121 override_relation(Default,SFF,FF,WF),
3122 get_last_wait_flag(enum_symb_tf,WF,LastWF),
3123 when(nonvar(LastWF), % if we enum too early test 1619 fails; see also test 2022
3124 % as partial_function_wf does not fully enumerate the new variable SFF we may have to enumerate SFF; see test 2328
3125 (enumerate_basic_type_wf(RangeElement,RanT,WF),
3126 enumerate_basic_type_wf(SFF,set(couple(DomT,RanT)),WF)
3127 )).
3128 total_function_wf1(R,Domain,Range,WF) :-
3129 try_expand_and_convert_to_avl_with_check(Domain,EDomain,keep_intervals(1000),total_function), % avoid multiple expansions, but useless when dom_for_lambda_closure case triggers below ! TO DO: fix
3130 % TO DO: maybe avoid converting intervals which are not fully instantiated ?
3131 % TODO: done by clause above? % TO DO ?: if Range singleton set {R} and Domain infinite: return %x.(x:Domain|R); if Range not empty choose one element
3132 try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF),
3133 propagate_empty_set_wf(Range,tf_range,ER,WF), % if the range of a total function is empty then the function must be empty
3134 ? total_function_wf2(ER,EDomain,Range,WF).
3135
3136 :- block total_function_wf2(?,-,?,?).
3137 total_function_wf2(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
3138 total_function_avl_set(AEF,Domain,Range,WF).
3139 total_function_wf2(R,Domain,Range,WF) :-
3140 cardinality_as_int_wf(Domain,int(Card),WF),
3141 ? total_function_wf3(R,Card,Domain,Range,WF).
3142
3143 :- use_module(kernel_card_arithmetic,[is_inf_or_overflow_card/1]).
3144 total_function_wf3(FF,Card,Domain,Range,WF) :-
3145 nonvar(FF),
3146 (number(Card) -> (Card >= 1000 -> true ; is_symbolic_closure(FF)) ; true),
3147 % note: we can have symbolic closures with a finite domain: /*@symbolic */ %p.(p:BOOL|(%t.(t:NATURAL|t+100)))
3148 custom_explicit_sets:dom_for_lambda_closure(FF,FFDomain),
3149 % we have a lambda closure where we cannot determine the range,
3150 % otherwise dom_range_for_specific_closure would have succeeded
3151 % example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 --> NATURAL
3152 FF = closure(P,T,Pred),
3153 get_range_id_expression(P,T,TRangeID),
3154 !,
3155 equal_object_wf(FFDomain,Domain,total_function1_closure,WF),
3156 % CHECK not(#P.(Pred & P /: Range))
3157 check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF).
3158 total_function_wf3(R,Card,Domain,Range,WF) :- nonvar(Card),is_inf_or_overflow_card(Card),!,
3159 when(nonvar(R), total_function_symbolic(R,Domain,Range,WF)).
3160 total_function_wf3(R,Card,Domain,Range,WF) :-
3161 card_convert_int_to_peano(Card,PeanoCard),
3162 ((nonvar(R);ground(PeanoCard))
3163 -> true
3164 ; get_last_wait_flag(total_fun(Domain),WF,WF1)),
3165 ? when((nonvar(R);ground(PeanoCard);
3166 (nonvar(PeanoCard),nonvar(WF1))), /* mal 12/5/04: changed , into ; 17/3/2008: added WF1 */
3167 /* reason for delaying nonvar(Card): Card grounded bit by bit by cardinality; avoid
3168 triggering too early and missing tf_var */
3169 total_function1(R,Card,PeanoCard,Domain,Range,WF
3170 )).
3171
3172 :- use_module(library(lists),[last/2]).
3173 % for a closure get the identifier or proj expression that represents range values
3174 get_range_id_expression([PairID],[Type],Res) :- !,
3175 Type = couple(_,TX),
3176 TP = b(identifier(PairID),Type,[]),
3177 safe_create_texpr(second_of_pair(TP),TX,Res). % prj2(PairID) ,
3178 %TO DO: test this e.g. with f = /*@symbolic*/ {x|x:NATURAL1*INTEGER & prj2(INTEGER,INTEGER)(x)=prj1(INTEGER,INTEGER)(x)+1} & f: NATURAL1 --> NATURAL
3179 % but currently lambda closure detection in dom_for_lambda_closure cannot handle such closures anyway
3180 get_range_id_expression(P,T,b(identifier(ID),Type,[])) :- last(P,ID), last(T,Type).
3181
3182 total_function_avl_set(AEF,Domain,Range,WF) :-
3183 (Domain = avl_set(Dom) -> is_avl_total_function_over_domain(AEF,Dom)
3184 ; is_avl_partial_function(AEF),
3185 domain_of_explicit_set_wf(avl_set(AEF),AEF_Domain,WF),
3186 equal_object_wf(AEF_Domain,Domain,total_function_avl_set,WF)
3187 ),
3188 is_avl_relation_over_range(AEF,Range,WF).
3189
3190 total_function_symbolic(FF,Domain,Range,WF) :-
3191 (debug_mode(off) -> true ; print('SYMBOLIC --> check : '),translate:print_bvalue(FF),nl),
3192 % can deal with, e.g., f = %x.(x:NATURAL|x+1) & g = f <+ {0|->0} & g : INTEGER +-> INTEGER
3193 domain_wf(FF,Domain,WF),
3194 symbolic_range_subset_check(FF,Range,WF),
3195 symbolic_functionality_check(FF,WF).
3196
3197 total_function1(FF,Card,PeanoCard,Domain,Range,WF) :- nonvar(Card),is_inf_or_overflow_card(Card),
3198 nonvar(PeanoCard),is_inf_or_overflow_card(PeanoCard),!,
3199 total_function_symbolic(FF,Domain,Range,WF).
3200 total_function1(FF,_,_,Domain,Range,WF) :-
3201 expand_and_convert_to_avl_set_catch(FF,AEF,total_function1,'ARG : ? --> ?',ResultStatus,WF),!,
3202 (ResultStatus=avl_set -> total_function_avl_set(AEF,Domain,Range,WF)
3203 ; % keep symbolic
3204 % TO DO: ensure no pending co-routine infinite_peano in card_convert_int_to_peano
3205 total_function_symbolic(FF,Domain,Range,WF)
3206 ).
3207 total_function1(R,_,Card,Domain,Range,WF) :-
3208 try_expand_custom_set_wf(R,ER,total_function1,WF),
3209 ? total_function2(ER,Card,Domain,Range,WF).
3210
3211 total_function2(ER,Card,Domain,Range,WF) :-
3212 var(ER),ground(Card),!,
3213 tf_var(TotalFunction,[],Card,Domain,Range,WF),
3214 ER=TotalFunction.
3215 total_function2(ER,Card,Domain,Range,WF) :-
3216 (ground(Card)
3217 -> get_wait_flag(0,tot_fun,WF,LWF) % we seem to know the domain exactly now; see e.g. test 1316
3218 ; get_wait_flag(2,total_function2,WF,LWF)), % ensure we don't start binding function as soon as Card is bound; important for test 1393; should we use another priority ?
3219 ? tf(ER,[],Card,Domain,Range,WF,LWF).
3220
3221 :- block tf(-,?,-,?,?,?,?),tf(-,?,?,?,?,?,-).
3222 tf([],_,0,Dom,_,WF,_) :- empty_set_wf(Dom,WF).
3223 tf(FUN,SoFar,s(Card),Dom,Ran,WF,LWF) :- var(FUN),nonvar(Dom), % try setting up skeleton for total fun
3224 remove_exact_first_element(X,Dom,Dom2),not_element_of_wf(X,SoFar,WF),var(FUN),!,
3225 ? FUN = [(X,Y)|T], tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
3226 tf([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF,LWF) :-
3227 not_element_of_wf(X,SoFar,WF),
3228 remove_element_wf(X,Dom,Dom2,WF), %mal: 17/3/08 changed to _wf version
3229 ? tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
3230 tf(CS,SoFar,Card,Dom,Ran,WF,LWF) :- nonvar(CS), is_custom_explicit_set(CS),
3231 expand_custom_set_to_list_wf(CS,ER,_,tf,WF),
3232 tf(ER,SoFar,Card,Dom,Ran,WF,LWF).
3233 tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF) :-
3234 check_element_of_wf(Y,Ran,WF),
3235 %when((nonvar(T);nonvar(Card)), /* mal 12/5/04: changed , into ; */
3236 add_new_element_wf(X,SoFar,SoFar2,WF), %%% try_expand_and_convert_to_avl
3237 ? tf(T,SoFar2,Card,Dom2,Ran,WF,LWF).
3238
3239 :- block tf_var(-,?,-,?,?,?).
3240 tf_var(F,_,Card,Dom,_,WF) :- Card==0,!,F=[],empty_set_wf(Dom,WF). % avoid choice point
3241 tf_var([],_,0,Dom,_,WF) :- empty_set_wf(Dom,WF).
3242 tf_var([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF) :-
3243 /* supposes that X + Y are unbound */
3244 /* TO DO: rewrite like enumerate <-------------------------- */
3245 ((var(X),var(Y)) -> true ; (print_message(warning,'Nonvar in tf_var: '),
3246 print_message(warning,((X,Y))))),
3247 remove_exact_first_element(X,Dom,Dom2),
3248 not_element_of_wf(X,SoFar,WF),
3249 check_element_of_wf(Y,Ran,WF),
3250 add_new_element_wf(X,SoFar,SoFar2,WF),
3251 tf_var(T,SoFar2,Card,Dom2,Ran,WF).
3252
3253
3254
3255 :- assert_must_succeed((bsets_clp:total_bijection(X,[int(1)],[int(7)]),
3256 X = [(int(1),int(7))])).
3257 :- assert_must_succeed((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3258 kernel_objects:equal_object(X,[(int(2),int(8)),(int(1),int(7))]))).
3259 :- assert_must_fail((bsets_clp:total_bijection(X,[int(1)],[int(7),int(3)]),
3260 X = [(int(1),int(7))])).
3261 :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(3)]),
3262 X = [(int(1),int(3)),(int(2),int(3))])).
3263 :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3264 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
3265 :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3266 X = [(int(1),int(7)),(int(1),int(8))])).
3267
3268
3269
3270 total_bijection(R,Domain,Range) :- init_wait_flags(WF,[total_bijection]),
3271 total_bijection_wf(R,Domain,Range,WF),
3272 ? ground_wait_flags(WF).
3273
3274 :- block total_bijection_wf(?,-,?,?).
3275 total_bijection_wf(FF,Domain,Range,WF) :- nonvar(FF),
3276 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
3277 equal_object_wf(FFDomain,Domain,total_bijection_wf_1,WF),
3278 equal_object_wf(FFRange,Range,total_bijection_wf_2,WF).
3279 %(R,Domain,Range,WF) :- Domain==Range,!, print(eq_domain_range),nl, total_injection_wf(R,Domain,Range,WF).
3280 total_bijection_wf(R,Domain,Range,WF) :-
3281 same_cardinality_wf(Domain,Range,WF),
3282 total_injection_wf2(R,Domain,Range,WF). % TO DO: use cardinality_as_int_wf ? makes test 1194 fail
3283
3284 %Note: we used to call custom code: total_bijection_wf2(R,Domain,Card,Range,WF).
3285 % total_injection_wf2 gives a considerable performance boost, e.g., for test 1222 ClearSy/alloc_large.mch or NQueens with >->>
3286
3287 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
3288 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
3289 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
3290 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(1),int(7))],[int(1)],[int(7),int(6)],WF),WF)).
3291 :- assert_must_fail((bsets_clp:not_total_function(X,[int(1)],[int(7)],_WF),
3292 X = [(int(1),int(7))])).
3293 :- assert_must_fail((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
3294 X = [(int(2),int(7)),(int(1),int(7))])).
3295 :- assert_must_succeed((bsets_clp:not_total_function([],[int(1)],[int(7)],_WF))).
3296 :- assert_must_succeed((bsets_clp:not_total_function([],[global_set('NAT1')],[global_set('Name')],_WF))).
3297 :- assert_must_succeed((bsets_clp:not_total_function([(int(7),int(7))],[int(1)],[int(7)],_WF))).
3298 :- assert_must_succeed((bsets_clp:not_total_function([(int(1),int(7)), (int(2),int(1))],
3299 [int(1),int(2)],[int(7)],_WF))).
3300 :- assert_must_succeed((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
3301 X = [(int(2),int(7)),(int(2),int(6))])).
3302
3303 :- block not_total_function(-,?,?,?), not_total_function(?,-,?,?).
3304 not_total_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
3305 % we do not need the Range; this means we can match more closures (e.g., lambda)
3306 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
3307 not_equal_object_wf(FFDomain,Domain,WF).
3308 not_total_function(FF,Domain,Range,WF) :- nonvar(FF),
3309 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
3310 equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
3311 when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
3312 not_total_function(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
3313 % example: f = %t.(t : NATURAL|t + 100) & f /: NATURAL +-> NATURAL
3314 is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
3315 get_range_id_expression(P,T,TRangeID),!,
3316 equality_objects_wf(FFDomain,Domain,SubRes,WF), % compare: subset_test for not_partial_function
3317 when(nonvar(SubRes),
3318 (SubRes=pred_false -> true % not equal -> it is not a total function over the domain
3319 ; check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF))).
3320 not_total_function(R,Domain,Range,WF) :-
3321 try_expand_and_convert_to_avl_with_check(R,ER,not_total_function_range),
3322 try_expand_and_convert_to_avl_unless_large_wf(Range,ERange,WF),
3323 not_total_function2(ER,Domain,ERange,WF).
3324
3325 % repeat block, in case Domain or R is a closure
3326 :- block not_total_function2(-,?,?,?), not_total_function2(?,-,?,?).
3327 not_total_function2(R,Domain,Range,WF) :-
3328 expand_and_convert_to_avl_set_warn(R,AER,not_total_function2,'ARG /: ? --> ?',WF),
3329 !,
3330 not_total_function_avl(AER,Domain,Range,WF).
3331 not_total_function2(R,Domain,ERange,WF) :-
3332 expand_custom_set_to_list_wf(R,ER,_,not_total_function2,WF),
3333 try_expand_and_convert_to_avl_with_check(Domain,EDomain,keep_intervals(1000),not_total_function_domain),
3334 not_tf(ER,[],EDomain,ERange,WF).
3335
3336 not_total_function_avl(_AER,Domain,_Range,_WF) :- is_infinite_explicit_set(Domain),!,
3337 true. % a finite AVL set cannot be a total function over an infinite domain
3338 not_total_function_avl(AER,Domain,Range,WF) :-
3339 expand_and_convert_to_avl_set_warn(Domain,ADom,not_total_function2,'? /: ARG --> ?',WF),
3340 !,
3341 (is_avl_total_function_over_domain(AER,ADom)
3342 ->
3343 is_not_avl_relation_over_range(AER,Range,WF)
3344 ; true
3345 ).
3346 not_total_function_avl(AER,EDomain,ERange,WF) :-
3347 expand_custom_set_to_list_wf(avl_set(AER),ER,_,not_total_function_avl,WF),
3348 not_tf(ER,[],EDomain,ERange,WF).
3349
3350
3351 :- use_module(kernel_equality,[membership_test_wf_with_force/4]).
3352
3353 :- block not_tf(-,?,?,?,?).
3354 not_tf([],_,Domain,_,WF) :- not_empty_set_wf(Domain,WF).
3355 not_tf([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf_with_force(SoFar,X,MemRes,WF),
3356 not_tf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3357
3358 :- block not_tf2(-,?,?,?, ?,?,?,?). %, not_tf2(?,?,?,?, -,?,?), not_tf2(?,?,?,?, ?,-,?).
3359 not_tf2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).% :- check_element_of_lazy(X,SoFar,WF).
3360 not_tf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3361 %not_element_of_wf(X,SoFar,WF),
3362 membership_test_wf_with_force(Dom,X,MemRes,WF),
3363 not_tf3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3364
3365 :- block not_tf3(-, ?,?,?,?, ?,?,?).
3366 not_tf3(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF).
3367 not_tf3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3368 remove_element_wf(X,Dom,Dom2,WF),
3369 membership_test_wf_with_force(Ran,Y,MemRes,WF),
3370 not_tf4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3371
3372 :- block not_tf4(-, ?,?,?,?, ?,?,?).
3373 not_tf4(pred_false,_X,_Y,_T,_SoFar,_Dom2,_Ran,_WF).
3374 not_tf4(pred_true,X,_Y,T,SoFar,Dom2,Ran,WF) :-
3375 %check_element_of_wf(Y,Ran,WF), %DO WE NEED THIS ????
3376 add_new_element_wf(X,SoFar,SoFar2,WF),
3377 not_tf(T,SoFar2,Dom2,Ran,WF).
3378
3379
3380
3381 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
3382 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
3383 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
3384 :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1)],[int(7)],_WF),
3385 X = [(int(1),int(7))])).
3386 :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3387 X = [(int(2),int(7)),(int(1),int(6))])).
3388 :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3389 X = [(int(1),int(7)),(int(2),int(6))])).
3390 :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(3)],_WF),
3391 X = [(int(1),int(3)),(int(2),int(3))])).
3392 :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3393 X = [(int(2),int(7)),(int(1),int(7))])).
3394 :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1)],[int(7),int(8)],_WF),
3395 X = [(int(1),int(7))])).
3396 :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7)],_WF),
3397 X = [(int(2),int(7))])).
3398 :- assert_must_succeed((bsets_clp:not_total_bijection([],[int(1)],[int(7)],_WF))).
3399 :- assert_must_succeed((bsets_clp:not_total_bijection([(int(7),int(7))],[int(1)],[int(7)],_WF))).
3400 :- assert_must_succeed((bsets_clp:not_total_bijection([(int(1),int(7)), (int(2),int(1))],
3401 [int(1),int(2)],[int(7)],_WF))).
3402 :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3403 X = [(int(2),int(7)),(int(2),int(6))])).
3404
3405 :- block not_total_bijection(-,?,?,?), not_total_bijection(?,-,?,?).
3406 not_total_bijection(FF,Domain,Range,WF) :-
3407 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
3408 not_equal_object_wf((FFDomain,FFRange),(Domain,Range),WF).
3409 not_total_bijection(avl_set(_),Domain,_Range,_WF) :-
3410 is_infinite_explicit_set(Domain),!.
3411 % a finite set cannot be a total bijection over an infinite domain, see test 1641
3412 not_total_bijection(R,Domain,Range,WF) :-
3413 try_expand_custom_set_wf(R,ER,not_total_bijection,WF),
3414 not_tot_bij(ER,[],Domain,Range,WF).
3415
3416 :- block not_tot_bij(-,?,?,?,?).
3417 not_tot_bij([],_,Domain,Range,WF) :- empty_not_tot_bij(Domain,Range,WF).
3418 not_tot_bij([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf(SoFar,X,MemRes,WF),
3419 not_tot_bij2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3420
3421 :- use_module(kernel_equality,[empty_set_test_wf/3]).
3422 :- block empty_not_tot_bij(-,?,?).
3423 empty_not_tot_bij(Domain,Range,WF) :-
3424 empty_set_test_wf(Domain,EqRes,WF),
3425 empty_not_tot_bij2(EqRes,Range,WF).
3426 :- block empty_not_tot_bij2(-,?,?).
3427 empty_not_tot_bij2(pred_false,_,_).
3428 empty_not_tot_bij2(pred_true,Range,WF) :- not_empty_set_wf(Range,WF).
3429
3430 :- block not_tot_bij2(-,?,?,?,?,?,?,?).
3431 not_tot_bij2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).
3432 not_tot_bij2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3433 membership_test_wf(Dom,X,MemRes,WF),
3434 not_tot_bij3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3435
3436 :- block not_tot_bij3(-,?,?,?,?,?,?,?).
3437 not_tot_bij3(pred_false,_X,_,_T,_SoFar,_Dom,_Ran,_WF). % X not a member of domain
3438 not_tot_bij3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3439 remove_element_wf(X,Dom,Dom2,WF),
3440 membership_test_wf(Ran,Y,MemRes,WF),
3441 not_tot_bij4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3442
3443 :- block not_tot_bij4(-,?,?,?,?,?,?,?).
3444 not_tot_bij4(pred_false,_X,_,_T,_SoFar,_Dom2,_Ran,_WF). % Y not a member of range
3445 not_tot_bij4(pred_true,X,Y,T,SoFar,Dom2,Ran,WF) :-
3446 remove_element_wf(Y,Ran,Ran2,WF),
3447 add_element_wf(X,SoFar,SoFar2,WF),
3448 not_tot_bij(T,SoFar2,Dom2,Ran2,WF).
3449
3450
3451
3452 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([(int(1),int(2)),(int(2),int(3))],[int(3)],[(int(2),int(3))],WF),WF)).
3453 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([(int(1),int(2)),(int(2),int(3))],[int(2),int(3)],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3454 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([],[int(2),int(3)],[],WF),WF)).
3455 :- assert_must_succeed((bsets_clp:range_restriction_wf([],[int(1)],[],_WF))).
3456 :- assert_must_succeed((bsets_clp:range_restriction_wf([],[],[],_WF))).
3457 :- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(1)],[],_WF))).
3458 :- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(2)],[(int(1),int(2))],_WF))).
3459 :- assert_must_succeed((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3460 X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3461 kernel_objects:equal_object(X,R))).
3462 :- assert_must_succeed((bsets_clp:range_restriction_wf(X,Y,R,_WF),
3463 X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],Y=global_set('Name'),
3464 kernel_objects:equal_object(X,R))).
3465 :- assert_must_fail((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3466 X = [(int(1),fd(3,'Name')),(int(2),fd(1,'Name'))],
3467 kernel_objects:equal_object(X,R))).
3468
3469 :- block range_restriction_wf(-,?,?,?),range_restriction_wf(?,-,-,?).
3470
3471 range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3472 ok_to_try_restriction_explicit_set(S,R,Res),
3473 range_restriction_explicit_set_wf(R,S,SR,WF),!,
3474 equal_object_wf(SR,Res,range_restriction,WF).
3475 range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3476 expand_custom_set_to_list_wf(R,ER,_,range_restriction,WF),
3477 ? relation_restriction_wf(ER,S,Res,pred_true,range,WF).
3478
3479 % heuristic: should we try restriction_explicit_set or
3480 % is relation_restriction with its stronger constraint propagation better
3481 ok_to_try_restriction_explicit_set(S,R,Res) :-
3482 nonvar(S),
3483 (var(Res) -> true
3484 ; S=avl_set(_),
3485 nonvar(R), R=avl_set(_) % otherwise constraint propagation from normal relation_restriction better
3486 ).
3487
3488 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([],[int(2)],[],WF),WF)).
3489 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[int(2)],[(int(2),int(3))],WF),WF)).
3490 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3491 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[int(1)],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3492
3493 :- block range_subtraction_wf(-,?,?,?),range_subtraction_wf(?,-,-,?).
3494 range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3495 S==[],!,
3496 equal_object_wf(R,Res,range_subtraction1,WF).
3497 range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3498 ok_to_try_restriction_explicit_set(S,R,Res),
3499 range_subtraction_explicit_set_wf(R,S,SR,WF),!,
3500 equal_object_wf(SR,Res,range_subtraction2,WF).
3501 range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3502 expand_custom_set_to_list_wf(R,ER,_,range_subtraction,WF),
3503 ? relation_restriction_wf(ER,S,Res,pred_false,range,WF).
3504
3505 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_restriction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(3)],WF),WF)).
3506 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_restriction_wf((int(1),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(3)],WF),WF)).
3507
3508 :- block in_range_restriction_wf(-,-,-,?).
3509 in_range_restriction_wf(Pair,Rel,Set,WF) :-
3510 ? (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3511 ; preference(convert_comprehension_sets_into_closures,true)),
3512 !,
3513 Rel \== [], % avoid setting up check_element_of for X then
3514 % x |-> y : Rel |>> Set <=> x|->y : Rel & y: Set
3515 check_element_of_wf(Pair,Rel,WF),
3516 Pair = (_,P2),
3517 check_element_of_wf(P2,Set,WF).
3518 in_range_restriction_wf(Pair,Rel,Set,WF) :-
3519 range_restriction_wf(Rel,Set,Res,WF),
3520 check_element_of_wf(Pair,Res,WF).
3521
3522 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_restriction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(1),int(2)],WF),WF)).
3523 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_restriction_wf((int(11),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(2)],WF),WF)).
3524
3525 :- block not_in_range_restriction_wf(-,-,-,?).
3526 not_in_range_restriction_wf(Pair,Rel,Set,WF) :-
3527 range_restriction_wf(Rel,Set,Res,WF),
3528 not_element_of_wf(Pair,Res,WF).
3529
3530 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_subtraction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(1)],WF),WF)).
3531 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_subtraction_wf((int(1),int(3)),[(int(2),int(3)),(int(1),int(3))],[],WF),WF)).
3532
3533 :- block in_range_subtraction_wf(-,-,-,?).
3534 in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3535 ? (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3536 ; preference(convert_comprehension_sets_into_closures,true)),
3537 !,
3538 Rel \== [], % avoid setting up check_element_of for X then
3539 % x |-> y : Rel |>> Set <=> x|->y : Rel & y/: Set
3540 check_element_of_wf(Pair,Rel,WF),
3541 Pair = (_,P2),
3542 not_element_of_wf(P2,Set,WF).
3543 in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3544 range_subtraction_wf(Rel,Set,Res,WF),
3545 check_element_of_wf(Pair,Res,WF).
3546
3547 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_subtraction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(3),int(2)],WF),WF)).
3548 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_subtraction_wf((int(11),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(2)],WF),WF)).
3549
3550 :- block not_in_range_subtraction_wf(-,-,-,?).
3551 not_in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3552 range_subtraction_wf(Rel,Set,Res,WF),
3553 not_element_of_wf(Pair,Res,WF).
3554
3555
3556
3557 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_restriction_wf((int(2),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3558 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_restriction_wf((int(1),int(3)),[int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3559
3560 :- block in_domain_restriction_wf(-,-,-,?).
3561 in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3562 ? (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3563 ; preference(convert_comprehension_sets_into_closures,true)),
3564 !,
3565 Rel \== [], % avoid setting up check_element_of for X then
3566 % x |-> y : Set <| Rel <=> x|->y : Rel & x: Set
3567 check_element_of_wf(Pair,Rel,WF),
3568 Pair = (P1,_),
3569 check_element_of_wf(P1,Set,WF).
3570 in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3571 domain_restriction_wf(Set,Rel,Res,WF),
3572 check_element_of_wf(Pair,Res,WF).
3573
3574 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_restriction_wf((int(2),int(3)),[int(33),int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3575 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_restriction_wf((int(11),int(3)),[int(11),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3576
3577 :- block not_in_domain_restriction_wf(-,-,-,?).
3578 not_in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3579 domain_restriction_wf(Set,Rel,Res,WF),
3580 not_element_of_wf(Pair,Res,WF).
3581
3582 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(4)],[(int(1),int(4)),(int(2),int(3))],[(int(2),int(3))],WF),WF)).
3583 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(1),int(2)],[(int(1),int(2)),(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3584 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(3)],[],[],WF),WF)).
3585 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],[],_WF))).
3586 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],R,_WF), R==[])).
3587 :- assert_must_fail((bsets_clp:domain_restriction_wf(_,[],R,_WF), R=[int(_)|_])).
3588 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2)],[(int(1),int(2))],[],_WF))).
3589 :- assert_must_succeed((bsets_clp:domain_restriction_wf([],[(int(1),int(2))],[],_WF))).
3590 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3591 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2)),(int(2),_)],_,_WF))).
3592 :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2),int(1)],X,R,_WF),
3593 X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3594 kernel_objects:equal_object(X,R))).
3595
3596
3597 :- block domain_restriction_wf(?,-,?,?),domain_restriction_wf(-,?,-,?).
3598 domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3599 ok_to_try_restriction_explicit_set(S,R,Res),
3600 domain_restriction_explicit_set_wf(S,R,SR,WF),!,
3601 equal_object_wf(SR,Res,domain_restriction,WF).
3602 domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3603 expand_custom_set_to_list_wf(R,ER,_,domain_restriction,WF),
3604 ? relation_restriction_wf(ER,S,Res,pred_true,domain,WF).
3605
3606 % a predicate to compute domain/range restriction/subtraction
3607 :- block relation_restriction_wf(?,-,- ,?,?,?),
3608 relation_restriction_wf(-,?,? ,?,?,?).
3609 relation_restriction_wf([],_S,Res,_AddWhen,_DomOrRange,WF) :-
3610 ? empty_set_wf(Res,WF).
3611 relation_restriction_wf([(X,Y)|T],S,Res,AddWhen,DomOrRange,WF) :-
3612 (DomOrRange=domain
3613 -> membership_test_wf(S,X,MemRes,WF) % TO DO: pass WF !
3614 ; membership_test_wf(S,Y,MemRes,WF)),
3615 (nonvar(MemRes)
3616 %MemRes==AddWhen % MemRes already set; we will ensure that (X,Y) in Res below; this slows down Alstom Compilation Regle !
3617 % doing the membership_test on the result Res if MemRes\==AddWhen only makes sense if we cannot fully compute the restriction ?? i.e. if T is not a closed list ?
3618 -> true %,(MemRes==AddWhen -> true ; print_term_summary(relation_restriction([(X,Y)|T],S,Res,AddWhen,DomOrRange)),nl)
3619 ; (AddWhen=pred_true -> InResult=MemRes
3620 ; negate(InResult,MemRes)), % from bool_pred
3621 ? membership_test_wf(Res,(X,Y),InResult,WF)
3622 % TO DO: same for explicit version; gets called e.g. if S = 1..n (1..n <| [1,2,3] = [1,2])
3623 % can now solve e.g. {x|x <| [1,2,3] = [1,2] & card(x)=2} = {{1,2}}
3624 % or x <| s = [1,2,3] \/ {29|->29} & x <: 1..100 & s = %i.(i:1..50|i)
3625 ),
3626 ? relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF).
3627 :- block relation_restriction_aux(-,?,?,?,?,?, ?,?,?).
3628 relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF) :-
3629 MemRes==AddWhen,!, % (X,Y) should be added to result
3630 % TO DO: collect result until we delay ? and then do equal_object ?
3631 ? equal_cons(Res,(X,Y),RT), % was : equal_object([(X,Y)|RT],Res),
3632 %equal_cons_wf(Res,(X,Y),RT,WF), % makes tests 982, 1302, 1303 fail; TO DO: investigate
3633 %when(nonvar(RT), % causes problem for test 982
3634 ? relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3635 relation_restriction_aux(_MemRes,_X,_,T,S,RT,AddWhen,DomOrRange,WF) :-
3636 % the couple is filtered out
3637 ? relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3638
3639
3640 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1),int(3)],[(int(1),int(4)),(int(2),int(3))],[(int(2),int(3))],WF),WF)).
3641 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(3),int(4)],[(int(1),int(2)),(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3642 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1)],[],[],WF),WF)).
3643 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([],[(int(11),int(21))],[(int(11),int(21))],WF),WF)).
3644 :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2))],[],_WF))).
3645 :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(3)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3646 :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2)),(int(2),int(X))],R,_WF),
3647 R=[(int(2),int(YY))], YY==X)).
3648 :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(5),int(3)],X,R,_WF),
3649 X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3650 kernel_objects:equal_object(X,R))).
3651 :- block domain_subtraction_wf(?,-,?,?),domain_subtraction_wf(-,?,-,?).
3652 domain_subtraction_wf(S,R,Res,WF) :- S==[],!,
3653 equal_object_wf(R,Res,domain_subtraction1,WF).
3654 domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3655 ok_to_try_restriction_explicit_set(S,R,Res),
3656 domain_subtraction_explicit_set_wf(S,R,SR,WF),!,
3657 equal_object_wf(SR,Res,domain_subtraction2,WF).
3658 domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3659 expand_custom_set_to_list_wf(R,ER,_,domain_subtraction,WF),
3660 try_expand_and_convert_to_avl_with_check(S,AS,keep_intervals(500),domain_subtraction),
3661 % (ground(ER) -> domain_subtraction_acc(ER,AS,[],Res) ;
3662 ? relation_restriction_wf(ER,AS,Res,pred_false,domain,WF)
3663 % )
3664 .
3665
3666
3667
3668 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_subtraction_wf((int(2),int(3)),[int(33),int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3669 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_subtraction_wf((int(2),int(3)),[],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3670
3671 :- block in_domain_subtraction_wf(-,-,-,?).
3672
3673 in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3674 ? (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3675 ; preference(convert_comprehension_sets_into_closures,true)),
3676 !,
3677 Rel \== [], % avoid setting up check_element_of for X then
3678 % x |-> y : Set <<| Rel <=> x|->y : Rel & x/: Set
3679 check_element_of_wf(Pair,Rel,WF),
3680 Pair = (P1,_),
3681 not_element_of_wf(P1,Set,WF).
3682 in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3683 domain_subtraction_wf(Set,Rel,Res,WF),
3684 check_element_of_wf(Pair,Res,WF).
3685
3686
3687 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_subtraction_wf((int(2),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3688 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_subtraction_wf((int(11),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3689
3690 :- block not_in_domain_subtraction_wf(-,-,-,?).
3691 not_in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3692 domain_subtraction_wf(Set,Rel,Res,WF),
3693 not_element_of_wf(Pair,Res,WF).
3694
3695 % similar to kernel_objects, but adds case for [_|_]
3696 treat_arg_symbolically(X) :- var(X),!.
3697 treat_arg_symbolically([H|T]) :- \+ ground(H) ; treat_arg_symbolically(T).
3698 treat_arg_symbolically(global_set(_)).
3699 treat_arg_symbolically(freetype(_)).
3700 treat_arg_symbolically(closure(P,T,B)) :- \+ kernel_objects:small_interval(P,T,B).
3701
3702 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override_relation([(int(1),int(2))],[(int(1),int(3))],[(int(1),int(3))],WF),WF)).
3703 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override_relation([(int(1),int(2))],[(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3704 :- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(1),int(3))],X,_WF),
3705 kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(3))]))).
3706 :- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(3),int(6))],X,_WF),
3707 kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(2)),(int(3),int(6))]))).
3708
3709 :- block override_relation(-,-,?,?). % overwrite AST node
3710 override_relation(R,S,Res,WF) :- R==[],!, equal_object_wf(S,Res,override_relation1,WF).
3711 override_relation(R,S,Res,WF) :- S==[],!, equal_object_wf(R,Res,override_relation2,WF).
3712 override_relation(R,S,Res,WF) :- Res==[],!, empty_set_wf(S,WF), empty_set_wf(R,WF).
3713 override_relation(R,S,Res,WF) :- /* R <+ S */
3714 override_custom_explicit_set_wf(R,S,ORes,WF),!,
3715 equal_object_wf(ORes,Res,override_relation3,WF).
3716 override_relation(R,S,Res,WF) :- /* R <+ S */
3717 domain_wf(S,DS,WF),
3718 domain_subtraction_wf(DS,R,DSR,WF),
3719 union_wf(DSR,S,Res,WF). % in principle we could call disjoint_union_wf, but fails 1112, 1751
3720
3721 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(1),int(2)),[(int(1),int(2))],[(int(2),int(3))],WF),WF)).
3722 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(2),int(3)),[(int(1),int(2))],[(int(2),int(3))],WF),WF)).
3723 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(2),int(3)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3724 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:in_override_relation_wf((int(2),int(4)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3725
3726 :- block in_override_relation_wf(-,-,-,?).
3727 in_override_relation_wf(Pair,Rel1,S,WF) :- S==[],!, % Pair: Rel1 <+ S
3728 check_element_of_wf(Pair,Rel1,WF).
3729 in_override_relation_wf(Pair,Rel1,S,WF) :- Rel1==[],!,
3730 check_element_of_wf(Pair,S,WF).
3731 in_override_relation_wf((X,Y),Rel1,S,WF) :-
3732 ? (treat_arg_symbolically(S) ; treat_arg_symbolically(Rel1)
3733 ; preference(convert_comprehension_sets_into_closures,true)),
3734 !,
3735 domain_wf(S,DS,WF),
3736 membership_test_wf(DS,X,MemRes,WF),
3737 in_override_aux(MemRes,X,Y,Rel1,S,WF).
3738 in_override_relation_wf(Pair,Rel1,S,WF) :-
3739 override_relation(Rel1,S,Res,WF),
3740 check_element_of_wf(Pair,Res,WF).
3741
3742 :- block in_override_aux(-,?,?,?,?,?).
3743 in_override_aux(pred_true,X,Y,_R,S,WF) :-
3744 check_element_of_wf((X,Y),S,WF).
3745 in_override_aux(pred_false,X,Y,R,_S,WF) :-
3746 check_element_of_wf((X,Y),R,WF).
3747
3748 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_in_override_relation_wf((int(2),int(3)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3749 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_override_relation_wf((int(2),int(4)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3750
3751 :- block not_in_override_relation_wf(-,-,-,?).
3752 not_in_override_relation_wf(Pair,Rel1,S,WF) :- S==[],!, % Pair: Rel1 <+ S
3753 not_element_of_wf(Pair,Rel1,WF).
3754 not_in_override_relation_wf(Pair,Rel1,S,WF) :- Rel1==[],!,
3755 not_element_of_wf(Pair,S,WF).
3756 not_in_override_relation_wf((X,Y),Rel1,S,WF) :-
3757 ? (treat_arg_symbolically(S) ; treat_arg_symbolically(Rel1)
3758 ; preference(convert_comprehension_sets_into_closures,true)),
3759 !,
3760 domain_wf(S,DS,WF),
3761 membership_test_wf(DS,X,MemRes,WF),
3762 not_in_override_aux(MemRes,X,Y,Rel1,S,WF).
3763 not_in_override_relation_wf(Pair,Rel1,S,WF) :-
3764 override_relation(Rel1,S,Res,WF),
3765 not_element_of_wf(Pair,Res,WF).
3766
3767 :- block not_in_override_aux(-,?,?,?,?,?).
3768 not_in_override_aux(pred_true,X,Y,_R,S,WF) :-
3769 not_element_of_wf((X,Y),S,WF).
3770 not_in_override_aux(pred_false,X,Y,R,_S,WF) :-
3771 not_element_of_wf((X,Y),R,WF).
3772
3773 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([],int(1),int(3),[(int(1),int(3))],WF),WF)).
3774 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([(int(1),int(2)),(int(2),int(6))],int(1),int(3),[(int(1),int(3)),(int(2),int(6))],WF),WF)).
3775 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([(int(1),int(2)),(int(2),int(6))],int(2),int(3),[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3776
3777 % override for a single pair
3778 :- block override(-,?,?,?,?), override(?,-,?,?,?),
3779 override(?,?,-,?,?). % also wait on Y; try to generate avl if possible; can only be used in substitution anyway
3780 /* R <+ {X |-> Y} as used by substitution R(X) := Y */
3781 override(R,X,Y,Res,WF) :-
3782 override_pair_explicit_set(R,X,Y,ORes),!,
3783 equal_object_wf(ORes,Res,override1,WF).
3784 override(R,X,Y,Res,WF) :-
3785 if(try_expand_custom_set_to_list(R,ER,_,override),
3786 (
3787 override2(ER,X,Y,[(X,Y)],ORes,WF),
3788 ? equal_object_wf(ORes,Res,override2,WF)),
3789 ( %print_term_summary(exception(R)), % Virtual Timeout exception occured
3790 override_relation(R,[(X,Y)],Res,WF)
3791 )).
3792
3793 :- block override2(-,?,?,?,?,?).
3794 override2([],_X,_Y,Remainder,Res,WF) :- equal_object_optimized_wf(Remainder,Res,override2,WF). %equal_object(Remainder,Res).
3795 override2([(V,W)|T],X,Y,Remainder,Res,WF) :-
3796 equality_objects_wf(V,X,EqRes,WF),
3797 override2c(EqRes,V,W,T,X,Y,Remainder,Res,WF).
3798
3799 :- block override2c(-, ?,?,?, ?,?,?,?,?).
3800 override2c(pred_true,_V,_W,T,X,Y,_Remainder,Res,WF) :-
3801 equal_cons_wf(Res,(X,Y),T2,WF),
3802 override2(T,X,Y,[],T2,WF). /* set remainder to [], we have already added (X,Y) */
3803 override2c(pred_false,V,W,T,X,Y,Remainder,Res,WF) :-
3804 equal_cons_wf(Res,(V,W),T2,WF),
3805 override2(T,X,Y,Remainder,T2,WF).
3806
3807
3808
3809 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],WF),WF)).
3810 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(3),int(3))],[int(1),int(2)],[int(2)],WF),WF)).
3811 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(1),int(3)),(int(4),int(4))],[int(1),int(2)],[int(2),int(3)],WF),WF)).
3812 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(1),int(3)),(int(4),int(4))],[int(2)],[int(2),int(3)],WF),WF)).
3813 :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],_WF)).
3814 :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(2)],[],_WF)).
3815 :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(3)],[],_WF)).
3816 :- assert_must_succeed((bsets_clp:image_wf([(int(1),int(2)),(int(1),int(3))],
3817 [int(X)],R,_WF), X=1, kernel_objects:equal_object(R,[int(2),int(3)]))).
3818 :- assert_must_succeed((bsets_clp:image_wf([([int(1),int(2)],int(6)),
3819 ([int(1),int(2),int(3)],int(7)),
3820 ([int(2),int(1)],int(8))],
3821 [[int(X),int(1)]],R,_WF), X=2,
3822 kernel_objects:equal_object(R,[int(6),int(8)]))).
3823 :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)],_WF)).
3824 :- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(1)],_WF)).
3825 :- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[],_WF)).
3826
3827
3828 :- block image_wf(-,?,?,?).
3829 image_wf(Rel,_,Res,WF) :- Rel==[],!,empty_set_wf(Res,WF).
3830 image_wf(Rel,S,Res,WF) :-
3831 image_for_id_closure(Rel,S,Img),!, % we don't require S to be known here
3832 equal_object_wf(Img,Res,image_wf_id_closure,WF).
3833 image_wf(Rel,S,Res,WF) :-
3834 image_wf0(Rel,S,Res,WF).
3835
3836 :- block image_wf0(?,-,?,?).
3837 image_wf0(Rel,S,Res,WF) :- /* Res = Rel[S] */
3838 (S==[] -> empty_set_wf(Res,WF)
3839 ; opt_push_wait_flag_call_stack_info(WF,b_operator_call(image,[Rel,S],unknown),WF2),
3840 image1(Rel,S,Res,WF2) ).
3841
3842 keep_symbolic(R) :- var(R),!,fail.
3843 keep_symbolic(closure(_,_,_)) :- preferences:get_preference(convert_comprehension_sets_into_closures,true),!.
3844 keep_symbolic(R) :- dont_expand_this_explicit_set(R).
3845
3846 :- block image1(-,?,?,?).
3847 image1(Rel,S,Res,WF) :-
3848 image_for_explicit_set(Rel,S,Img,WF),!,
3849 equal_object_wf(Img,Res,image1_1,WF),
3850 quick_propagate_subset_range(Res,Rel,WF).
3851 %image1(Rel,S,Res,WF) :- expand_custom_set_to_list(S,ES),!, image_of_set(ES,Rel,Res,WF).
3852 image1(Rel,Set,Res,WF) :-
3853 keep_symbolic(Rel),
3854 (preferences:get_preference(convert_comprehension_sets_into_closures,true), % in this case keep_symbolic is always true
3855 nonvar(Set),is_infinite_explicit_set(Set) % in this case we have to expand Rel below; what if Rel also infinite ?? --> TO DO : symbolic treatment
3856 -> debug_println(9,infinite_for_image1(Set)),
3857 fail
3858 ; true),
3859 ( dom_for_specific_closure(Rel,Domain,function(_),WF)
3860 -> !,
3861 expand_custom_set_to_list_wf(Set,ESet,_,image1,WF), % TO DO: what if keep_symbolic(Set)
3862 image_for_inf_fun(ESet,Domain,Rel,[],Res,WF)
3863 ; get_relation_types(Rel,DomType,RangeType),!,
3864 image_symbolic(Set,Rel,DomType,RangeType,Res,WF)
3865 ).
3866 image1(Rel,S,Res,WF) :-
3867 on_enumeration_warning(expand_custom_set_to_list_wf(Rel,Relation,_,image1_2,WF), R=failed),
3868 % bad if Rel is a big closure ! image_for_list_relation(Relation,S,Res).
3869 (R==failed -> write(failed),nl,
3870 mnf_get_relation_types(Rel,DomType,RangeType),% must succeed, as Rel is a closure with types
3871 image_symbolic(S,Rel,DomType,RangeType,Res,WF) % does not treat special case image_for_inf_fun
3872 ; propagate_singleton_image(Relation,S,Res,WF),
3873 % TO DO: we could propagate cardinality constraints about Relation,S and Res
3874 % we could also try to infer all_different constraints in case card(S)=card(Res) and f is a function
3875 image_for_list_relation(Relation,S,[],Res,WF)
3876 ).
3877
3878 image_symbolic(Set,Rel,DomType,RangeType,Res,WF) :-
3879 expand_custom_set_to_list_wf(Set,ESet,_,image1_2,WF),
3880 (is_symbolic_closure(Rel)
3881 -> Symbolic=symbolic_try_expand, ground_value_check((Rel,ESet),GRel) % also wait for ESet to be ground so that we can catch enumeration warning exceptions, cf. test 2428 when theorem and foralls not expanded
3882 ; Symbolic=expand, ground_value_check(Rel,GRel)
3883 ),
3884 when(nonvar(GRel), image_for_large_relation(ESet,Rel,Symbolic,DomType,RangeType,[],Res,WF)).
3885 % Alternative: We could compute closure by calculating {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3886 % image_closure(Set,Rel,DomType,RangeType,Closure ),
3887
3888 % propagate that f[{x}] = {r1,...,rk} => x|->ri : f (or {x}*{r1,...,rk} <: f); see test 1532
3889 propagate_singleton_image(R,S,Res,_) :-
3890 (var(S) ; var(Res) ; nonvar(R), is_custom_explicit_set(R,psi)), !.
3891 propagate_singleton_image(Relation,S,avl_set(Res),WF) :-
3892 custom_explicit_sets:singleton_set(S,El), % we have the image by a singleton set {El}
3893 expand_custom_set_to_list_wf(avl_set(Res),LR,_,prop_singleton,WF),
3894 !,
3895 l_check_element_of(LR, El, Relation, WF). % propagate x|->ri : f (will force membership)
3896 propagate_singleton_image(_,_,_,_).
3897
3898 l_check_element_of([],_,_,_).
3899 l_check_element_of([H|T],El,Relation,WF) :-
3900 check_element_of_wf((El,H),Relation,WF),
3901 l_check_element_of(T,El,Relation,WF).
3902
3903 % quick_propagate_in_range(Set, Relation,WF) : propagate that Set <: ran(Relation)
3904 :- block quick_propagate_subset_range(-,?,?).
3905 quick_propagate_subset_range(avl_set(_),_,_) :- !.
3906 quick_propagate_subset_range([],_,_) :- !.
3907 quick_propagate_subset_range([H|T],Relation,WF) :- is_custom_explicit_set(Relation,range_wf1),
3908 range_of_explicit_set_wf(Relation,Range,WF), !,
3909 quick_propagation_element_information(Range,H,WF,NewRange),
3910 quick_propagate_subset_range2(T,NewRange,WF).
3911 quick_propagate_subset_range(_,_,_).
3912
3913 :- block quick_propagate_subset_range2(-,?,?).
3914 quick_propagate_subset_range2([H|T],NewRange,WF) :- !,
3915 quick_propagation_element_information(NewRange,H,WF,NewRange1),
3916 quick_propagate_subset_range2(T,NewRange1,WF).
3917 quick_propagate_subset_range2(_,_,_).
3918
3919 :- use_module(btypechecker, [unify_types_strict/2]).
3920 get_relation_types(Value,Domain,Range) :-
3921 kernel_objects:infer_value_type(Value,VT),
3922 unify_types_strict(VT,set(couple(Domain,Range))). % deal also with seq types
3923 % VT=set(couple(Domain,Range)).
3924 % a version that must not fail:
3925 mnf_get_relation_types(Value,Domain,Range) :-
3926 (get_relation_types(Value,Domain,Range) -> true
3927 ; add_internal_error('Failed: ',get_relation_types(Value,Domain,Range)),
3928 Domain=any, Range=any).
3929
3930 :- block image_for_large_relation(-,?,?,?,?,?,?,?), image_for_large_relation(?,?,?,?,?,-,?,?).
3931 ?image_for_large_relation([],_,_,_,_,Acc,Res,WF) :- equal_object_wf(Acc,Res,WF).
3932 image_for_large_relation([XX|T],Rel,Symbolic,DomType,RangeType,Acc,Res,WF) :-
3933 get_image_singleton_closure(XX,DomType,RangeType,Rel, Par,TPara,Body),
3934 expand_closure_direct_if_possible(Symbolic,Par,TPara,Body,ImagesForXX,WF),
3935 union_wf(Acc,ImagesForXX,NewAcc,WF),
3936 (T == [] -> equal_object_wf(NewAcc,Res,WF)
3937 ; image_for_large_relation(T,Rel,Symbolic,DomType,RangeType,NewAcc,Res,WF)).
3938
3939 get_image_singleton_closure(XX,DomType,RangeType,Rel, [yy], [RangeType], Body) :-
3940 Body = b(member(b(couple(b(value(XX),DomType,[]),
3941 b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3942 b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]).
3943 % TO DO: simplify above if we have Rel = closure(P,T,B); which we usually will
3944
3945 expand_closure_direct_if_possible(symbolic_try_expand,Par,Types,Body,Result,WF) :- !,
3946 catch_enumeration_warning_exceptions(
3947 custom_explicit_sets:expand_normal_closure_direct(Par,Types,Body,Result,_Done,WF),
3948 (mark_bexpr_as_symbolic(Body,SBody),
3949 Result = closure(Par,Types,SBody) % TODO: we could set definitely_symbolic for next iteration
3950 ),
3951 false,
3952 ignore(image_for_large_relation)).
3953 expand_closure_direct_if_possible(definitely_symbolic,Par,Types,Body,Result,_WF) :- !,
3954 mark_bexpr_as_symbolic(Body,SBody),
3955 Result = closure(Par,Types,SBody).
3956 expand_closure_direct_if_possible(_,Par,Types,Body,Result,WF) :-
3957 % do not memoize this (many different values):
3958 custom_explicit_sets:expand_normal_closure_direct(Par,Types,Body,Result,_Done,WF).
3959
3960
3961 /* no longer used
3962 % construct a closure for {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3963 image_closure(Set,Rel,DomType,RangeType,Closure ) :- custom_explicit_sets:singleton_set(Set,XX),!,
3964 % do not set up existential quantifier if Set is singleton set
3965 Closure = closure([yy],[RangeType],Body),
3966 Body = b(member(b(couple(b(value(XX),DomType,[]),
3967 b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3968 b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]).
3969 image_closure(Set,Rel,DomType,RangeType,Closure ) :-
3970 Closure = closure([yy],[RangeType],Body),
3971 couple_member_pred(xx,DomType,yy,RangeType,Rel, Predxxyy),
3972 Body = b(exists([b(identifier(xx),DomType,[])],
3973 b(conjunct(
3974 b(member(b(identifier(xx),DomType,[]),b(value(Set),set(DomType),[])),pred,[]), % TO DO : force evaluation !
3975 Predxxyy),
3976 pred,[])),pred,[used_ids([yy])]).
3977 */
3978
3979 % very similar to rel_compose_with_inf_fun, indeed f[S] = ran((id(S);f))
3980 :- block image_for_inf_fun(-,?,?,?,?,?).
3981 image_for_inf_fun([],_Dom,_Rel2,Acc,Comp,WF) :- equal_object_wf(Acc,Comp,WF).
3982 image_for_inf_fun([X|T],Dom,Fun,Acc,CompRes,WF) :-
3983 membership_test_wf(Dom,X,MemRes,WF),
3984 image_for_inf_fun_aux(MemRes,X,T,Dom,Fun,Acc,CompRes,WF).
3985
3986 :- block image_for_inf_fun_aux(-,?,?, ?,?,?,?,?).
3987 image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,Acc,CompRes,WF) :-
3988 apply_to(Fun,X,FX,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
3989 add_element_wf(FX,Acc,NewAcc,WF), % will block until Acc Known !!
3990 % TO DO USE: equal_cons_wf(CompRes,FX,CT,WF) + accumulator !,
3991 image_for_inf_fun(T,Dom,Fun,NewAcc,CompRes,WF).
3992 image_for_inf_fun_aux(pred_false,_X,T,Dom,Fun,Acc,Comp,WF) :-
3993 image_for_inf_fun(T,Dom,Fun,Acc,Comp,WF).
3994
3995
3996 /*
3997 :- block image_of_set(-,?,?,?,?), image_of_set(?,?,-,?,?).
3998 image_of_set([],Rel,ImageSoFar,Res,WF) :- equal_object(ImageSoFar,Res).
3999 image_of_set([H|T],Rel,ImageSoFar,Res,WF) :-
4000 image_of_element(Rel,H,ImageSoFar,SF2,WF),
4001 image_of_set(T,Rel,SF2,Res,WF).
4002
4003 image_of_element([],_,Acc,Res,WF) :- equal_object(Acc,Res).
4004 image_of_element([(A,B)|T],H,Acc,Res,WF) :- equality....
4005 image_of_element(avl_set(),H,Acc,Res,WF) :- ....
4006 image_of_element(closure(),....
4007 */
4008
4009 % Computing the image of a relation which is stored as a list: traverse the relation
4010 :- block image_for_list_relation(-,?,?,?,?).
4011 ?image_for_list_relation([],_,_,Res,WF) :- empty_set_wf(Res,WF).
4012 image_for_list_relation([(X,Y)|T],S,ImageSoFar,Res,WF) :-
4013 ((T==[], definitely_not_empty(Res))
4014 -> MemRes=pred_true, % we need at least one more element for Res
4015 check_element_of_wf(X,S,WF)
4016 ; (Res==[],ImageSoFar==[]) -> MemRes=pred_false, not_element_of_wf(X,S,WF) % Result empty: X cannot be in S
4017 ; membership_test_wf(S,X,MemRes,WF)
4018 ),
4019 ? image4(MemRes,Y,T,S,ImageSoFar,Res,WF).
4020
4021 definitely_not_empty(Set) :- nonvar(Set), Set \== [], \+ functor(Set,closure,3). % Set \= closure(_,_,_).
4022
4023 :- block image4(-, ?,?,?, ?,?,?).
4024 image4(pred_true, Y,T,S, ImageSoFar,Res,WF) :-
4025 (Res==[]
4026 -> MemRes=pred_true, check_element_of_wf(Y,ImageSoFar,WF)
4027 ; membership_test_wf(ImageSoFar,Y,MemRes,WF)
4028 ),
4029 ? image5(MemRes,Y,T,S,ImageSoFar,Res,WF).
4030 image4(pred_false, _Y,T,S, ImageSoFar,Res,WF) :-
4031 ? image_for_list_relation(T,S,ImageSoFar,Res,WF).
4032
4033 :- block image5(-, ?,?,? ,?,?,?).
4034 image5(pred_true,_Y,T,S,ImageSoFar,Res,WF) :- /* we have already added Y to the image */
4035 image_for_list_relation(T,S,ImageSoFar,Res,WF).
4036 image5(pred_false,Y,T,S,ImageSoFar,Res,WF) :-
4037 add_element_wf(Y,ImageSoFar,ImageSoFar2,WF),
4038 kernel_objects:mark_as_non_free(Y,image), % Y has been added to image, no longer freely choosable
4039 equal_cons_wf(Res,Y,Res2,WF),
4040 ? image_for_list_relation(T,S,ImageSoFar2,Res2,WF).
4041
4042
4043
4044 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[int(2)],[int(1),int(2)],WF),WF)).
4045 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[],[],WF),WF)).
4046 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[int(3)],[int(3)],WF),WF)).
4047 % version for computing closure1(Rel)[S]
4048 :- block image_for_closure1_wf(-,?,?,?),image_for_closure1_wf(?,-,?,?).
4049 image_for_closure1_wf(Rel,S,Res,WF) :- (Rel==[] ; S==[]),!,empty_set_wf(Res,WF).
4050 image_for_closure1_wf(Rel,Set,Res,WF) :-
4051 try_expand_and_convert_to_avl_unless_large_wf(Set,ESet,WF),
4052 ? image_for_closure1_wf_aux(Rel,ESet,Res,WF).
4053
4054 :- use_module(library(avl),[avl_height/2]).
4055 image_for_closure1_wf_aux(Rel,S,Res,WF) :-
4056 ((nonvar(S),S=avl_set(_))
4057 -> closure1_for_explicit_set_from(Rel,S,Closure1Rel),!,
4058 % if S is known: start from S (currently only deals with Rel=avl_set(_)
4059 range_wf(Closure1Rel,Res,WF)
4060 ; Rel=avl_set(AR), avl_height(AR,AR_Height),
4061 ((set_smaller_than(S,4),AR_Height>4)
4062 -> !, % TO DO: we could do the same for small S if Rel is large
4063 when(ground(S), (expand_and_convert_to_avl_set(S,ES,image_for_closure1_wf_aux,'closure1(ARG)[?]') ->
4064 closure1_for_explicit_set_from(Rel,avl_set(ES),Closure1Rel),
4065 range_wf(Closure1Rel,Res,WF)
4066 ; image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S))
4067 ))
4068 ; % Don't do this if avl_height too large; then it is probably better to compute the image for S only
4069 AR_Height < 13, % how big should we make this magic constant; or should we time-out ? 2^14=16384
4070 closure1_for_explicit_set(Rel,Closure1Rel),!, % we can compute it effiently; don't use code below
4071 image_wf(Closure1Rel,S,Res,WF)
4072 )
4073 ).
4074 image_for_closure1_wf_aux(Rel,S,Res,WF) :-
4075 ? propagate_result_in_range(Rel,S,Res,WF),
4076 ? image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S)).
4077
4078 % no need to treat avl_sets; already covered as special case above
4079 set_smaller_than([],_).
4080 set_smaller_than([_|T],N) :- N>1, nonvar(T), N1 is N-1, set_smaller_than(T,N1).
4081
4082 image_for_closure1_iterate(Rel,S,Acc,Res,WF,FIRST) :-
4083 image_wf0(Rel,S,Res1,WF),
4084 ground_value_check(Res1,RV),
4085 ? image_for_closure1_check_fix(RV,Rel,Acc,Res1,Res,WF,FIRST).
4086
4087 :- block image_for_closure1_check_fix(-,?,?,?,?,?,?).
4088 image_for_closure1_check_fix(_,Rel,Acc,Res1,Res,WF,FIRST) :-
4089 %try_expand_and_convert_to_avl_unless_large_wf(Res1,ERes1,WF),
4090 difference_set(Res1,Acc,New),
4091 try_expand_and_convert_to_avl(New,ENew), % we compute difference_set below; we most definitely will need an explicit finite representation
4092 (not_empty_set_wf(ENew,WF),
4093 union(ENew,Acc,Acc1), % Note: we do not call union_wf - should we do this
4094 % upon first iteration remove also S from New -> New2 and pass New2 to image_for_closure1_iterate
4095 % TO DO: investigate whether this also makes sense for further iterations; always remove S
4096 (FIRST=first_iteration(S) -> difference_set(ENew,S,New2) ; New2=ENew),
4097 ? image_for_closure1_iterate(Rel,New2,Acc1,Res,WF,not_first)
4098 ;
4099 ? empty_set_wf(ENew,WF),equal_object_optimized_wf(Acc,Res,image_for_closure1_check_fix,WF)).
4100
4101 % propagate information that if closure1(Rel)[.] = Res => Res <: range(Rel)
4102 % x: 1..n --> 1..n & closure1(x)[{1}] = {} & n=100
4103 :- block propagate_result_in_range(?,?,-,?).
4104 propagate_result_in_range(Rel,_S,_Res,_WF) :-
4105 ground_value(Rel),!. % no propagation required
4106 propagate_result_in_range(Rel,S,[],WF) :- !,
4107 domain_wf(Rel,Domain,WF),
4108 not_subset_of_wf(S,Domain,WF).
4109 propagate_result_in_range(Rel,_,Res,WF) :-
4110 range_wf(Rel,Range,WF),
4111 ? check_subset_of_wf(Res,Range,WF).
4112
4113 :- use_module(probsrc(avl_tools),[avl_height_less_than/2]).
4114
4115 % version for computing iterate(K,Rel)[S]
4116 % iteration
4117 :- block image_for_iterate_wf(?,-,?,?,?,?), image_for_iterate_wf(?,?,-,?,?,?).
4118 image_for_iterate_wf(_Rel,_K,S,Res,_,WF) :- S==[],!,empty_set_wf(Res,WF).
4119 image_for_iterate_wf(Rel,int(K),S,Res,Type,WF) :-
4120 image_for_iterate_k(K,Rel,S,Res,Type,WF).
4121
4122 :- block image_for_iterate_k(-,?,?,?,?,?).
4123 image_for_iterate_k(K,Rel,S,Res,Type,WF) :-
4124 nonvar(Rel),
4125 Rel=avl_set(AVL),
4126 (var(S) -> avl_height_less_than(AVL,11) ; avl_height_less_than(AVL,3)),
4127 !, % compute the iteration once; possibly better constraint propagation and performance if S enumerated
4128 % e.g. x:{1,10,20} & iterate({1|->10,20|->1,10|->20},2)(x) = 20
4129 rel_iterate_wf(Rel,int(K),RelIterated,Type,WF),
4130 image_wf(RelIterated,S,Res,WF).
4131 image_for_iterate_k(K,Rel,S,Res,_,WF) :-
4132 image_for_iterate_k_loop(K,Rel,S,Res,WF).
4133
4134 :- block image_for_iterate_k_loop(?,?,-,?,?).
4135 image_for_iterate_k_loop(0,_Rel,Acc,Result,WF) :- !,
4136 equal_object_optimized_wf(Acc,Result,image_for_iterate_k,WF).
4137 image_for_iterate_k_loop(K,Rel,Acc,Result,WF) :-
4138 image_wf0(Rel,Acc,Acc1,WF), % we could try and detect fix point if K> some limit or time for iteration is measurable
4139 if((K>10, K mod 10 =:= 0, % check for fixpoint every 10 iterations
4140 nonvar(Acc1), Acc1=avl_set(_), quick_custom_explicit_set_approximate_size(Acc1,Size1),
4141 quick_custom_explicit_set_approximate_size(Acc,Size0),
4142 Size0=Size1, % only check for equality if approximate sizes match
4143 equal_explicit_sets_wf(Acc,Acc1,WF)),
4144 K1=0, % fixpoint found, no need to continue iterating
4145 K1 is K-1),
4146 image_for_iterate_k_loop(K1,Rel,Acc1,Result,WF).
4147
4148 special_operator_for_image(b(Rel,Type,_),Kind,Args) :- special_image_aux(Rel,Type,Kind,Args).
4149 special_image_aux(closure(Rel),_,closure,[Rel]). % we have closure1(Rel)[Set] -> avoid computing full closure
4150 special_image_aux(iteration(Rel,K),Type,iteration(Type),[Rel,K]).
4151 % TODO: reflexive closure, id_closure (this will probably be more natural as special case for a value)
4152
4153 image_for_special_operator(closure,[Rel],S,Res,WF) :- image_for_closure1_wf(Rel,S,Res,WF).
4154 image_for_special_operator(iteration(Type),[Rel,K],S,Res,WF) :-
4155 image_for_iterate_wf(Rel,K,S,Res,Type,WF).
4156
4157 :- use_module(kernel_objects,[singleton_set_element/4]).
4158 apply_fun_for_special_operator(Kind,EArgs,FunArg,Res,WF,Span) :-
4159 InitialSet = [FunArg], % TODO: try convert to AVL, note: closure1 not really useful in fun. application context
4160 image_for_special_operator(Kind,EArgs,InitialSet,SetRes,WF),
4161 singleton_set_element(SetRes,Res,Span,WF).
4162
4163 % iterate(%x.(x:NATURAL|x+2),2000)(20) much faster this way, 15 ms vs 4 seconds
4164 % iterate(%x.(x:NATURAL|x+2),2000)[{20}]: ditto
4165
4166
4167 % -----------------------------------
4168
4169 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(2),int(22))],int(2),int(22),WF),WF)).
4170 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(int(1),int(22)),(int(3),int(33)),(int(4),int(44))],int(3),int(33),WF),WF)). % used to be wfdet (see in_domain_wf above)
4171 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(int(1),[int(22)]),(int(3),[int(32),int(33)]),(int(4),[int(44)])],int(3),[int(32),int(33)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4172 :- assert_must_succeed(bsets_clp:apply_to([(int(1),int(2))],int(1),int(2),_WF)).
4173 :- assert_must_succeed((bsets_clp:apply_to(F,int(3),int(2),_WF),F=[(int(3),int(2)),(int(2),int(1))])).
4174 :- assert_must_succeed((bsets_clp:apply_to(F,X,int(1),_WF),F=[(int(3),int(2)),(int(2),int(1))],X=int(2))).
4175 :- assert_must_succeed((bsets_clp:apply_to(F,int(3),_,_WF),F=[(int(3),[int(2),int(3)]),(int(2),[])])).
4176
4177 :- assert_must_fail(bsets_clp:apply_to([(int(1),int(2)),(int(1),int(3))],int(1),int(3),_WF)).
4178 /* input not a function */
4179 apply_to(R,X,Y,WF) :- apply_to(R,X,Y,unknown,unknown,WF).
4180 ?apply_to(R,X,Y,Span,WF) :- apply_to(R,X,Y,unknown,Span,WF).
4181
4182 % comment in to perform profiling at function call level; can lead to big slowdowns
4183 %:- load_files(library(system), [when(compile_time), imports([environ/2])]).
4184 %:- use_module(source_profiler,[opt_add_source_location_hits/2]).
4185 %apply_to(_R,_X,_Y,_FunctionType,Span,_WF) :- opt_add_source_location_hits(Span,1),fail.
4186
4187 :- block apply_to(-,-,-,?,?,?).
4188 apply_to(R,X,Y,_FunctionType,Span,WF) :-
4189 % we could check if WD condition discharged in Span
4190 (\+ preferences:preference(find_abort_values,false) ; preference(data_validation_mode,true)),
4191 !,
4192 apply_to_var_block_abort(R,X,Y,R,Span,WF). % we have to know R before we can do anything
4193 apply_to(R,X,Y,FunctionType,Span,WF) :-
4194 (var(R),var(X) -> force_in_domain_wf(X,R,WF) ; true),
4195 ? apply_to1(R,X,Y,R,FunctionType,Span,WF).
4196
4197
4198
4199 :- use_module(preferences,[preference/2]).
4200 :- use_module(clpfd_tables,[can_translate_function_to_element_constraint/2,check_apply_with_element_constraint/5]).
4201 :- block apply_to1(-,-,?,?,?,?,?).
4202 apply_to1(R,X,Y,InitialRel,FunctionType,Span,WF) :-
4203 (var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF)
4204 ; R\=[], can_translate_function_to_element_constraint(R,FunctionType) ->
4205 check_apply_with_element_constraint(R,X,Y,FunctionType,WF)
4206 ? ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF),
4207 propagate_range_membership(R,Y)
4208 ).
4209 :- block apply_to2(-,-,?,?,?,?).
4210 apply_to2(R,X,Y,InitialRel,Span,WF) :-
4211 (var(R)
4212 -> apply_to_var(R,X,Y,InitialRel,Span,WF)
4213 ? ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF)
4214 ).
4215
4216 :- use_module(clpfd_lists,[get_finite_fdset_information/2,combine_fdset_information/3,
4217 assert_fdset_information/2,get_fdset_information/2]).
4218 % tested in test 1478; initially slows down NQueens
4219 %:- block propagate_range_membership(-,?). % not necessary
4220 propagate_range_membership([(_,RanEl)|T],X) :- nonvar(RanEl),
4221 preferences:preference(use_clpfd_solver,true),
4222 preferences:preference(find_abort_values,false),
4223 get_finite_fdset_information(RanEl,Info), % TO DO: try and detect if we can apply element/3 from clpfd
4224 \+ ground(X),
4225 get_fdset_information(X,InfoX),
4226 Info \= InfoX, % avoids NQueens slowdown; TO DO: check if more precise than InfoX; otherwise no use in collecting info
4227 !,
4228 propagate_range_membership(T,Info,X).
4229 propagate_range_membership(_,_).
4230 :- block propagate_range_membership(-,?,?).
4231 propagate_range_membership([],Info,El) :- !,
4232 % note: the information for the first few elements might have become more precise; TO DO: wait until list known and then propagate ?+ keep on propagating ??
4233 assert_fdset_information(Info,El).
4234 propagate_range_membership([(_,RanEl)|T],Acc,X) :-
4235 nonvar(RanEl), % otherwise we have no info: we may just as well stop
4236 get_finite_fdset_information(RanEl,RInfo),
4237 combine_fdset_information(Acc,RInfo,NewAcc),
4238 NewAcc \= no_fdset_info,
4239 !,
4240 propagate_range_membership(T,NewAcc,X).
4241 propagate_range_membership(_,_,_).
4242
4243
4244 apply_to_var(R,X,Y,InitialRel,Span,WF) :-
4245 mark_var_set_as_non_empty(R),
4246 get_wait_flag(1.0,apply_to_var,WF,WF1), % see tests 1393, 1562??
4247 % was: get_wait_flag0(WF,WF1), but see test 1706 (in conjunction for improvement for test 2033)
4248 when(((nonvar(WF1),ground(X));nonvar(R)), % only instantiate R when X sufficiently instantiated (TO DO: maybe use some for of equality_objects with existing relation R set up so far ??)
4249 (var(R) ->
4250 R=[(X,Y)|Tail],
4251 optional_functionality_check(Tail,X,WF)
4252 ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF))).
4253
4254 :- block apply_to_var_block_abort(-,?,?,?,?,?).
4255 apply_to_var_block_abort(R,X,Y,InitialRel,Span,WF) :-
4256 apply_to_nonvar(R,X,Y,InitialRel,Span,WF).
4257
4258 optional_functionality_check(Tail,X,WF) :-
4259 preferences:preference(disprover_mode,true),!,
4260 not_in_domain_wf(X,Tail,WF). % we assert that R is a function ; when disproving we can assume well-definedness
4261 % Note: this can cut down the search space ; see e.g. test 1230 (but e.g. it will not find a problem with test 1169, RULE_r967_1)
4262 optional_functionality_check(_,_X,_WF). % TO DO: maybe lazily check if we have other elements with X as first arg if find_abort_values is true
4263
4264
4265 :- use_module(closures,[is_recursive_closure/3]).
4266 :- use_module(memoization,[is_memoization_closure/4,apply_to_memoize/8]).
4267 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
4268 :- if(\+ environ(no_wd_checking,true)).
4269 apply_to_nonvar([],X,_Y,InitialRel,Span,WF) :-
4270 \+ preferences:preference(find_abort_values,false),
4271 add_wd_error_span('function applied outside of domain (#2): ', '@fun'(X,InitialRel),Span,WF).
4272 :- endif.
4273 apply_to_nonvar([(X2,Y2)|T],X,Y,InitialRel,Span,WF) :-
4274 equality_objects_wf(X2,X,EqRes,WF),
4275 % this check on Y2 below is important if both Y and Y2 are instantiated but X,X2 not yet
4276 % example: aload_R07_cbc.mch (Savary) or cbc_sequence check for R08_ByteArray for aload_R07 event (test 1349)
4277 % however: slows down test 583 !
4278 (var(EqRes) -> equality_objects_wf(Y2,Y,EqResY,WF),
4279 prop_apply_eqxy(EqResY,EqRes) % propagate: if Y/=Y2 => X/=X2
4280 ; EqResY=not_called),
4281 ? apply_to4(EqRes,EqResY,Y2,T,X,Y,InitialRel,Span,WF).
4282 apply_to_nonvar(avl_set(A),X,Y,_InitialRel,Span,WF) :-
4283 apply_to_avl_set(A,X,Y,Span,WF).
4284 apply_to_nonvar(closure(P,T,B),X,Y,_InitialRel,Span,WF) :-
4285 %is_custom_explicit_set(Closure,apply), % should also work for avl_set,...
4286 (is_memoization_closure(P,T,B,MemoID)
4287 % Function application with memoization; currently enabled by add /*@desc memo */ pragma to abstract constant
4288 -> apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF)
4289 ; is_recursive_closure(P,T,B) % TO DO: maybe we should do the same for functions marked as memoize symbolic/uni-directional/computed ? (although we have new rule for check_element_of_function_closure which makes this redundant ??)
4290 -> % print_term_summary(apply_recursive_closure(X,P,T,B)),
4291 %hit_profiler:add_profile_hit(rec_apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
4292 ground_value_check(X,XV), block_apply_closure_to_nonvar_groundx(XV,X,Y,P,T,B,Span,WF)
4293 ; %hit_profiler:add_profile_hit(apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
4294 apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)).
4295
4296
4297 :- block block_apply_closure_to_nonvar_groundx(-,?,?, ?,?,?, ?,?).
4298 block_apply_closure_to_nonvar_groundx(_,X,Y, P,T,B, Span,WF) :- apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF).
4299
4300 apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
4301 kernel_tools:ground_bexpr(B),
4302 !, % then if the element of function succeeds there is no need to check WD
4303 if(check_element_of_function_closure(X,Y,P,T,B,WF),
4304 true, % No need to check for well-definedness; no pending choice points
4305 apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) % here we need to check; it could be that the result Y was instantiated
4306 ).
4307 apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
4308 apply_closure_to_nonvar(X,Y,P,T,B,Span,WF).
4309
4310 % if we first check preferences:preference(find_abort_values,false) to avoid a choice
4311 % point, we get a big slow-down on Alstom models; e.g., vesg_Mar12
4312 % WARNING: This choice point can be set up in WF0 !
4313 apply_closure_to_nonvar(X,Y,P,T,B,_,WF) :-
4314 (preferences:preference(find_abort_values,true) -> true ; !), % slow down ???!
4315 check_element_of_function_closure(X,Y,P,T,B,WF) .
4316 apply_closure_to_nonvar(X,_,P,T,B,Span,WF) :- % removing this clause doubles runtime of COMPUTE_GRADIENT_CHANGE
4317 apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF).
4318
4319 apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) :-
4320 \+ preferences:preference(find_abort_values,false),
4321 not_in_domain_wf(X,closure(P,T,B),WF),
4322 when((ground(X),ground(closure(P,T,B))),
4323 add_wd_error_span('function applied outside of domain (#3): ', '@fun'(X,closure(P,T,B)),Span,WF)).
4324
4325
4326 % propagate equality_objects between range and domain elements for function application:
4327 :- block prop_apply_eqxy(-,-).
4328 prop_apply_eqxy(Eqy,Eqx) :- var(Eqy),!, (Eqx = pred_true -> Eqy = pred_true ; true).
4329 prop_apply_eqxy(pred_false,pred_false).
4330 prop_apply_eqxy(pred_true,_).
4331
4332 :- block apply_to4(-,?,?, -,?,?,?,?,?).
4333 apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :-
4334 var(EqResX),!, % Tail bound
4335 (Tail == []
4336 -> (preferences:preference(find_abort_values,false)
4337 -> EqResX = pred_true,
4338 apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4339 ; apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4340 )
4341 ; Tail = avl_set(_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) % TO DO: improve ! (e.g., expand to list if small or check if X can be in domain,...)
4342 ; Tail = closure(_,_,_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4343 ; Tail \= [_|_] -> add_internal_error('Illegal Tail: ',apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),fail
4344 ; Tail = [(X3,Y3)|T3], % setup equality check with X3, purpose: detect, e.g., when no other element in tail can match we can force EqResX to pred_true
4345 ? apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3)
4346 ).
4347 apply_to4(pred_true,EqResY,Y2, Tail,X,Y,_InitialRel,_,WF) :-
4348 ? (EqResY==not_called -> equal_object_wf(Y2,Y,apply_to4,WF) ; EqResY = pred_true),
4349 optional_functionality_check(Tail,X,WF).
4350 ?apply_to4(pred_false,_EqResY,_Y2,T,X,Y,InitialRel,Span,WF) :- apply_to2(T,X,Y,InitialRel,Span,WF).
4351
4352 % we delay setting up equality_objects until X3 is at least partially known, see test 1715 Alstom_essai2_boucle1
4353 % TO DO: we could check if X3==X above
4354 :- block apply_to4_call5(-,?,?, ?,?,?,?,?,?, -,?,?).
4355 apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, _X3,_Y3,_T3) :- nonvar(EqResX),!,
4356 apply_to4(EqResX,EqResY,Y2,Tail,X,Y,InitialRel,Span,WF).
4357 apply_to4_call5(EqResX,EqResY,Y2, _Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3) :- % X3 must now be bound
4358 equality_objects_wf(X3,X,EqRes3,WF),
4359 ? apply_to5(EqResX,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, InitialRel,Span,WF).
4360
4361 % version which wait suntil first argument known
4362 :- block apply_to4_block(-,?,?, ?,?,?,?,?,?).
4363 apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :-
4364 apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF).
4365
4366
4367 % apply_to5: implements a watched-literal style treatment of function application
4368 % we watch whether X unifies with two elements of the function, if only one element left we can force equality
4369 % TEST:
4370 % f : 11..23 +-> 1..10 & f = {a|->2, b|->3, c|->4} & card({a,b,c})=3 & f(x)=r & a>b & b>c & x>b
4371 :- block apply_to5(-,?,-, ?,?,?,?, ?,?, ?,?,?),apply_to5(-,?,?, ?,?,?,-, ?,?, ?,?,?).
4372 apply_to5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :-
4373 var(EqRes),!,
4374 % EqRes3 and T3 must be known; TO DO: improve predicate so that we have to wait on T3 only when EqRes3=pred_false
4375 (EqRes3 = pred_false -> % we cannot match next element, move tail one forward
4376 (T3 = [] -> EqRes=pred_true ; true),
4377 apply_to4(EqRes,EqResY,Y2,T3,X,Y,InitialRel,Span,WF)
4378 ; /* EqRes3 = pred_true */
4379 % we match the next entry in the list; discard Y2 and jump to (X3,Y3) and return as solution
4380 ? equal_object_wf(Y3,Y,apply_to6,WF), optional_functionality_check(T3,X,WF),
4381 % TO DO: we could also do equality_objects if necessary between Y and Y3, as in apply_to4 for Y and Y2
4382 opt_force_false(EqRes)
4383 ).
4384 apply_to5(pred_true,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, _InitialRel,_Span,WF) :-
4385 (EqResY==not_called -> equal_object_wf(Y2,Y,apply_to5,WF) ; EqResY = pred_true),
4386 opt_force_false(EqRes3),
4387 optional_functionality_check([(X3,Y3)|T3],X,WF).
4388 apply_to5(pred_false,_EqResY,EqRes3, _Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :-
4389 (var(EqRes3) -> % it can be that EqRes3 is about to be triggered
4390 equality_objects_wf(Y3,Y,EqResY3,WF),
4391 prop_apply_eqxy(EqResY3,EqRes3) % propagate: if Y/=Y3 => X/=X3
4392 ; EqResY3=not_called),
4393 apply_to4(EqRes3,EqResY3,Y3, T3,X,Y,InitialRel,Span,WF).
4394
4395 opt_force_false(EqRes) :-
4396 (preference(find_abort_values,false) -> EqRes=pred_false
4397 ; true). % TO DO: if EqRes becomes pred_true: raise abort_error as the relation was not a function
4398
4399
4400
4401 /********************************************/
4402 /* surjection_relation(R,Domain,Range) */
4403 /* R : Domain <->> Range */
4404 /********************************************/
4405 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:surjection_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4406 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(6),int(7)],WF),WF)).
4407
4408 surjection_relation_wf(R,Domain,Range,WF) :-
4409 is_surjective(R,Range,WF),
4410 % TODO: is not optimal since ran(R)<:Range is already implied by is_surjective and
4411 % checked a second time by relation_over_wf/4
4412 ? relation_over_wf(R,Domain,Range,WF).
4413
4414 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(6),int(7)],WF),WF)).
4415
4416 not_surjection_relation_wf(R,Domain,Range,WF) :-
4417 expand_custom_set_to_list_wf(R,ER,Done,not_surjection_relation_wf,WF),
4418 not_tot_surj_rel(ER,Done,[],Domain,Range,Range,WF).
4419
4420 /*********************************************/
4421 /* total_surjection_relation(R,Domain,Range) */
4422 /* R : Domain <<->> Range */
4423 /*********************************************/
4424 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_surjection_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4425 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_surjection_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4426
4427
4428 :- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1)],[int(11),int(12)]),L),
4429 lists:maplist(sort,L,SL), sort(SL,SSL), % added May15th due to change in domain_wf (bsets_clp:propagate_result_to_input); TO DO: see if we can go back to just one solution
4430 length(SSL,1))).
4431 %:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),L), length(L,7))).
4432 % the new domain predicate also instantiates from result; meaning that duplicate solutions are now generated
4433 :- assert_must_succeed((findall(SR,(bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),sort(R,SR)),L), sort(L,SL),length(SL,7))).
4434 :- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11)]),L),
4435 length(L,1))).
4436
4437 total_surjection_relation(R,Domain,Range) :- init_wait_flags(WF,[total_surjection_relation]),
4438 ? total_surjection_relation_wf(R,Domain,Range,WF), ground_wait_flags(WF).
4439
4440 total_surjection_relation_wf(R,Domain,Range,WF) :-
4441 ? relation_over_wf(R,Domain,Range,WF),
4442 check_relation_is_total(R,Domain,WF), % calls domain which now instantiates R if Domain known
4443 check_relation_is_surjective(R,Range,WF).
4444
4445
4446 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4447 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4448 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4449
4450 not_total_surjection_relation_wf(R,Domain,Range,WF) :-
4451 expand_custom_set_to_list_wf(R,ER,Done,not_total_surjection_relation_wf,WF),
4452 ? not_tot_surj_rel(ER,Done,Domain,Domain,Range,Range,WF).
4453
4454
4455 /********************************************/
4456 /* partial_surjection(R,DomType,RangeType) */
4457 /* R : DomType +->> RangeType */
4458 /********************************************/
4459
4460 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4461 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6),int(2)],WF),WF)).
4462 :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4463 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4464 :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],global_set('Name')),
4465 kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4466 :- assert_must_succeed((bsets_clp:partial_surjection_wf(X,[int(1),int(2),int(3)],global_set('Name'),_WF),
4467 kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4468 :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4469 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4470 :- assert_must_succeed_multiple((bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4471 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))]))). /* mult. */
4472 :- assert_must_succeed((X=[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))],
4473 bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]))).
4474 :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4475 X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4476 :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4477 X = [(int(2),int(7)),(int(1),int(7))])).
4478 :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4479 X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4480 :- assert_must_succeed_multiple((bsets_clp:partial_surjection(_X,
4481 [int(1),int(2),int(3),int(4),int(5),int(6),int(7)],[int(2),int(3),int(4)]) )).
4482 :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4483 X = [(int(2),int(7)),(int(2),int(6))])).
4484
4485 partial_surjection(R,Domain,Range) :- init_wait_flags(WF,[partial_surjection]),
4486 partial_surjection_wf(R,Domain,Range,WF),
4487 ? ground_wait_flags(WF).
4488
4489 :- block partial_surjection_wf(-,-,?,?).
4490 partial_surjection_wf(R,Domain,Range,WF) :-
4491 check_card_greater_equal(Domain,geq,Range,CardDom,CardRange),
4492 (surjection_has_to_be_total_injection(CardDom,CardRange)
4493 % LAW: card(setX) = card(setY) => ff: setX +->> setY <=> ff: setX >-> setY
4494 ? -> total_function_wf(R,Domain,Range,WF),
4495 injective(R,WF)
4496 ; is_surjective(R,Range,WF),
4497 partial_function_wf(R,Domain,Range,WF)
4498 ).
4499
4500
4501 % check_card_greater_equal(A,B) : quick check that card(A) >= card(B); also works with infinite cardinality
4502 % TO DO: replace by a better constraint propagating predicate (also working for partially instantiated lists,...)
4503 % compared with computing card and setting up < constraint: will only compute card if it can be done efficiently + deals with inf
4504 % check_card_greater_equal(SetA,EQ,SetB) ; EQ=eq or geq
4505 :- block check_card_greater_equal(-,?,?,?,?).
4506 check_card_greater_equal([],_,R,0,0) :- !, empty_set(R).
4507 check_card_greater_equal(A,EQ,B,CA,CB) :- check_card_greater_equal2(A,EQ,B,CA,CB).
4508
4509 :- use_module(inf_arith,[block_inf_greater_equal/2]).
4510 :- block check_card_greater_equal2(?,?,-,?,?).
4511 check_card_greater_equal2(A,EQ,B,CardA,CardB) :-
4512 efficient_card_for_set(A,CardA,CodeA),
4513 efficient_card_for_set(B,CardB,CodeB),!,
4514 call(CodeA), call(CodeB),
4515 (EQ=eq -> CardA=CardB ; block_inf_greater_equal(CardA,CardB)).
4516 check_card_greater_equal2(_A,_,_B,'?','?').
4517
4518
4519 :- block is_surjective(-,-,?).
4520 is_surjective(R,Range,WF) :-
4521 (var(R) -> setup_surj_range(Range,R,WF)
4522 ; range_wf(R,Range,WF)).
4523
4524 setup_surj_range(Range,R,WF) :-
4525 setup_range(Range,Res,DONE,WF),
4526 equal_when_done(Res,R,DONE).
4527 :- block equal_when_done(?,?,-).
4528 ?equal_when_done(Res,R,_DONE) :- equal_object(Res,R).
4529
4530
4531 :- block setup_range(-,?,?,?).
4532 setup_range(global_set(G),Res,DONE,WF) :-
4533 expand_custom_set_wf(global_set(G),ES,setup_range,WF),
4534 setup_range(ES,Res,DONE,WF).
4535 setup_range(freetype(ID),Res,DONE,WF) :-
4536 expand_custom_set_wf(freetype(ID),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4537 setup_range(avl_set(S),Res,DONE,WF) :-
4538 expand_custom_set_wf(avl_set(S),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4539 setup_range(closure(P,T,B),Res,DONE,WF) :-
4540 expand_custom_set_wf(closure(P,T,B),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4541 setup_range([],_,done,_WF).
4542 setup_range([H|T],[(_,H)|ST],DONE,WF) :- setup_range(T,ST,DONE,WF).
4543
4544
4545
4546 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],
4547 [int(1),int(2)],[int(7),int(6)],WF),WF)).
4548 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],
4549 [int(7),int(6),int(2)],WF),WF)).
4550 :- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4551 X = [(int(2),int(7)),(int(1),int(6))])).
4552 :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4553 X = [(int(2),int(7)),(int(2),int(6))])).
4554 :- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4555 X = [(int(2),int(7)),(int(1),int(6))])).
4556 :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4557 X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4558 :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4559 X = [(int(2),int(7)),(int(1),int(7))])).
4560 :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4561 X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4562
4563
4564
4565 /* /: Domain +->> Range */
4566 not_partial_surjection(R,Domain,Range) :- init_wait_flags(WF,[not_partial_surjection]),
4567 not_partial_surjection_wf(R,Domain,Range,WF),
4568 ground_wait_flags(WF).
4569
4570 :- block not_partial_surjection_wf(-,?,?,?).
4571 not_partial_surjection_wf(R,DomType,RangeType,WF) :-
4572 partial_surjection_test_wf(R,DomType,RangeType,pred_false,WF).
4573
4574
4575 %not_surjective_relation_wf(R,DomType,RType,WF) :-
4576 % invert_relation_wf(R,IR,WF),
4577 % not_total_relation_wf(IR,RType,DomType,WF).
4578
4579
4580 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
4581 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6),int(2)],pred_false,WF),WF)).
4582
4583 partial_surjection_test_wf(R,DomType,RangeType,PredRes,WF) :-
4584 partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4585 (IsPF==pred_false -> PredRes=pred_false
4586 ; range_wf(R,RelRan,WF),
4587 ? conjoin_test(IsPF,IsSurjective,PredRes,WF),
4588 ? subset_test(RangeType,RelRan,IsSurjective,WF)
4589 ).
4590
4591
4592 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4593 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4594
4595 :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4596 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4597 :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4598 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4599 :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4600 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(7))]))).
4601 :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4602 kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4603 :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4604 kernel_objects:equal_object(X,[(int(2),int(7))]))).
4605 :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4606 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(8))]))).
4607 :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4608 kernel_objects:equal_object(X,[(int(2),int(7)),(int(3),int(6)),(int(1),int(7))]))).
4609 :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4610 kernel_objects:equal_object(X,[]))).
4611
4612 /****************************************/
4613 /* total_relation_wf(R,Domain,Range,WF) */
4614 /* R : Domain <<-> Range */
4615 /****************************************/
4616
4617 ?total_relation_wf(R,Domain,Range,WF) :- relation_over_wf(R,Domain,Range,WF),
4618 check_relation_is_total(R,Domain,WF).
4619
4620 % this predicates assume that the relation's range and domain have already been checked
4621 check_relation_is_total(Relation,Domain,WF) :- domain_wf(Relation,Domain,WF).
4622 check_relation_is_surjective(Relation,Range,WF) :-
4623 range_wf(Relation,Range,WF). % we could also call is_surjective (which does setup_surj_range) ?
4624
4625 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4626 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4627 :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4628 X = [(int(2),int(7)),(int(1),int(6))])).
4629 :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4630 X = [(int(2),int(7)),(int(1),int(7))])).
4631 :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4632 X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4633 :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4634 X = [(int(2),int(7)),(int(2),int(6))])).
4635 :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4636 X = [(int(2),int(7))])).
4637 :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4638 X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(8))])).
4639 :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4640 X = [(int(2),int(7)),(int(3),int(6)),(int(1),int(7))])).
4641
4642 :- block not_total_relation_wf(-,?,?,?).
4643 not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
4644 % we do not need the Range; this means we can match more closures (e.g., lambda)
4645 custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
4646 not_equal_object_wf(FFDomain,Domain,WF).
4647 not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),
4648 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
4649 equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
4650 when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
4651 not_total_relation_wf(R,Domain,Range,WF) :-
4652 expand_custom_set_to_list_wf(R,ER,Done,not_total_relation_wf,WF),
4653 ? not_tot_surj_rel(ER,Done,Domain,Domain,[],Range,WF). % empty DelRange means we don't do surjective test
4654
4655 % can be used to check not total, not surj, not total surj relation
4656 :- block not_tot_surj_rel(-,?,?,?,?,?,?).
4657 not_tot_surj_rel([],_,DelDomain,_,DelRange,_,WF) :-
4658 ? at_least_one_set_not_empty(DelDomain,DelRange,WF).
4659 not_tot_surj_rel([_|_],Done,DelDom,Dom,_DelRan,_Ran,_WF) :- nonvar(Done),
4660 Done \= no_check_to_be_done,
4661 nonvar(DelDom),DelDom \= [],
4662 nonvar(Dom),is_infinite_explicit_set(Dom),
4663 !. % a finite expanded list can never be a total relation over an infinite domain
4664 not_tot_surj_rel([(X,Y)|T],_Done,DelDom,Dom,DelRan,Ran,WF) :-
4665 membership_test_wf(Dom,X,MemRes,WF),
4666 ? not_tr2(MemRes,X,Y,T,DelDom,Dom,DelRan,Ran,WF).
4667
4668 % check if one of the two sets is non-empty
4669 at_least_one_set_not_empty(Set1,Set2,_) :- (Set=Set1 ; Set=Set2),
4670 nonvar(Set),
4671 (Set=avl_set(_) ; Set=[_|_]), % we can avoid leaving choice point
4672 !.
4673 at_least_one_set_not_empty(Set1,_,WF) :- not_empty_set_wf(Set1,WF).
4674 at_least_one_set_not_empty(Set1,Set2,WF) :- empty_set_wf(Set1,WF),not_empty_set_wf(Set2,WF).
4675
4676 :- block not_tr2(-,?,?,?,?,?,?,?,?).
4677 not_tr2(pred_false,_X,_Y,_T,_DelDom,_Dom,_DelRan,_Ran,_WF).
4678 not_tr2(pred_true,X,Y,T,DelDom,Dom,DelRan,Ran,WF) :-
4679 delete_element_wf(X,DelDom,DelDom2,WF), % set DelDom initially to [] to avoid totality check
4680 membership_test_wf(Ran,Y,MemRes,WF),
4681 ? not_tr3(MemRes,Y,T,DelDom2,Dom,DelRan,Ran,WF).
4682
4683 :- block not_tr3(-,?,?,?,?,?,?,?).
4684 not_tr3(pred_false,_Y,_T,_DelDom2,_Dom,_DelRan,_Ran,_WF).
4685 not_tr3(pred_true,Y,T,DelDom2,Dom,DelRan,Ran,WF) :-
4686 delete_element_wf(Y,DelRan,DelRan2,WF), % set DelRan initially to [] to avoid surjection check
4687 ? not_tot_surj_rel(T,no_check_to_be_done,DelDom2,Dom,DelRan2,Ran,WF).
4688
4689 /******************************************/
4690 /* total_surjection(R,DomType,RangeType) */
4691 /* R : DomType -->> RangeType */
4692 /******************************************/
4693
4694 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4695 :- assert_must_succeed(exhaustive_kernel_succeed_check((bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),kernel_waitflags:ground_det_wait_flag(WF)))). %% TO DO: get rid of multiple solutions
4696 :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1)],[int(7)]),
4697 kernel_objects:equal_object(X,[(int(1),int(7))]))).
4698 :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4699 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4700 :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7)]),
4701 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4702 :- assert_must_fail((bsets_clp:total_surjection([],[int(1)],[int(7)]))).
4703 :- assert_must_fail((bsets_clp:total_surjection([(int(7),int(7))],[int(1)],[int(7)]))).
4704 :- assert_must_fail((bsets_clp:total_surjection([(int(1),int(7)), (int(2),int(1))],
4705 [int(1),int(2)],[int(7)]))).
4706 :- assert_must_fail((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4707 kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4708
4709
4710 total_surjection(R,Domain,Range) :- init_wait_flags(WF),
4711 total_surjection_wf(R,Domain,Range,WF),
4712 ? ground_wait_flags(WF).
4713
4714 :- block total_surjection_wf(-,-,?,?).
4715 total_surjection_wf(R,DomType,RangeType,WF) :-
4716 check_card_greater_equal(DomType,geq,RangeType,CardDom,CardRange),
4717 ? total_function_wf(R,DomType,RangeType,WF),
4718 % setup_surj_range(RangeType,R,WF).
4719 (surjection_has_to_be_total_injection(CardDom,CardRange)
4720 % LAW: card(setX) = card(setY) => ff: setX -->> setY <=> ff: setX >-> setY
4721 -> injective(R,WF) % if domain and range have same cardinality: injection ensures surjectivity, and is more efficient to check/propagate; example when using queens 1..n -->> 1..n for NQueens
4722 ; check_relation_is_surjective(R,RangeType,WF)).
4723 % invert_relation_wf(R,IR,WF), total_relation_wf(IR,RangeType,DomType,WF).
4724
4725 surjection_has_to_be_total_injection(CardDom,CardRange) :- number(CardDom), CardDom=CardRange.
4726 % TO DO: determine the difference in size between Dom and Range and count how many times a range element can occur multiple times (would give better incremental checking)
4727
4728 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
4729 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4730 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4731 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4732 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(8))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
4733 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4734
4735 :- block not_total_surjection_wf(-,?,?,?), not_total_surjection_wf(?,-,-,?).
4736 not_total_surjection_wf(R,DomType,RangeType,WF) :-
4737 total_function_test_wf(R,DomType,RangeType,PredRes,WF),
4738 not_total_surjection2(PredRes,R,DomType,RangeType,WF).
4739 :- block not_total_surjection2(-,?,?,?,?).
4740 not_total_surjection2(pred_false,_R,_DomType,_RangeType,_WF).
4741 not_total_surjection2(pred_true,R,_DomType,RangeType,WF) :-
4742 range_wf(R,RelRange,WF),
4743 opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_subset,
4744 [RangeType,b_operator(range,[R])],unknown),WF2),
4745 not_subset_of_wf(RangeType,RelRange,WF2).
4746 %not_surjective_relation_wf(R,DomType,RangeType,WF).
4747
4748 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(8))],[int(1),int(2),int(3)],[int(7),int(6)],pred_false,WF),WF)).
4749 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(6))],[int(1),int(2),int(3)],[int(7),int(6)],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
4750 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
4751
4752 % reified total function check:
4753 total_function_test_wf(R,DomType,RangeType,PredRes,WF) :-
4754 partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4755 (IsPF==pred_false -> PredRes=pred_false
4756 ; domain_wf(R,RelDom,WF),
4757 ? conjoin_test(IsPF,IsTotal,PredRes,WF),
4758 opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
4759 [DomType,b_operator(domain,[R])],unknown),WF2),
4760 ? subset_test(DomType,RelDom,IsTotal,WF2)
4761 ).
4762
4763 /*******************************************/
4764 /* partial_injection(R,DomType,RangeType) */
4765 /* R : DomType >+> RangeType */
4766 /*******************************************/
4767
4768 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4769 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],[int(1),int(2),int(3),int(4)],[int(7),int(6),int(8),int(9)],WF),WF)).
4770 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4771 :- assert_must_succeed((bsets_clp:partial_injection(X,[int(1)],[int(7)]),
4772 kernel_objects:equal_object(X,[(int(1),int(7))]))).
4773 :- assert_must_succeed((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4774 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4775 :- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7)]),
4776 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4777 :- assert_must_succeed((bsets_clp:partial_injection([],[int(1)],[int(7)]))).
4778 :- assert_must_fail((bsets_clp:partial_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4779 :- assert_must_fail((bsets_clp:partial_injection([(int(1),int(7)), (int(2),int(1))],
4780 [int(1),int(2)],[int(7)]))).
4781 :- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4782 kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4783
4784
4785 partial_injection(R,Domain,Range) :- init_wait_flags(WF),
4786 partial_injection_wf(R,Domain,Range,WF),
4787 ? ground_wait_flags(WF).
4788
4789 :- block partial_injection_wf(-,-,?,?).
4790 partial_injection_wf(FF,Domain,Range,WF) :- nonvar(FF),
4791 custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
4792 check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
4793 check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
4794 partial_injection_wf(R,DomType,RangeType,WF) :-
4795 try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF), % should we use very_large?
4796 partial_function_wf(ER,DomType,RangeType,WF),
4797 injective(ER,WF).
4798 % invert_relation_wf(R,IR,WF),
4799 % partial_function_wf(IR,RangeType,DomType,WF).
4800
4801 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],WF),WF)).
4802 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(7))],WF),WF)).
4803
4804 :- block injective(-,?).
4805 injective(FF,WF) :-
4806 custom_explicit_sets:dom_range_for_specific_closure(FF,_FFDomain,_FFRange,function(bijection),WF),!.
4807 injective(avl_set(AVL),_WF) :- !,
4808 is_injective_avl_relation(AVL,_Range). % seems slightly faster than injective/3 code below
4809 injective(closure(P,T,B),WF) :- !,
4810 symbolic_injectivity_check(closure(P,T,B),WF).
4811 injective(Rel,WF) :- expand_custom_set_to_list_wf(Rel,ERel,_,injective,WF),
4812 injective(ERel,[],WF).
4813
4814 %:- use_module(library(lists),[maplist/3]).
4815 % for FD-sets we could setup all_different constraint
4816 :- block injective(-,?,?).
4817 injective([],_SoFar,_).
4818 % (maplist(get_fd_val,SoFar,FDL) -> clpfd:all_distinct(FDL) ; true). %clpfd_interface:clpfd_alldifferent(FDL) ; true).
4819 %get_fd_val(int(H),H).
4820 injective([(_From,To)|T],SoFar,WF) :-
4821 not_element_of_wf(To,SoFar,WF), /* check that it is injective */
4822 add_new_element_wf(To,SoFar,SoFar2,WF), %SoFar2=[To|SoFar], could also work and be faster ?
4823 injective(T,SoFar2,WF).
4824 % no case for global_set: it cannot be a relation; two cases below not required because of expand_custom_set_to_list
4825 %injective(avl_set(S),SoFar,WF) :- expand_custom_set_wf(avl_set(S),ES,inj,WF), injective(ES,SoFar,WF).
4826 %injective(closure(P,T,B),SoFar,WF) :- expand_custom_set_wf(closure(P,T,B),ES,inj,WF), injective(ES,SoFar,WF).
4827
4828
4829
4830 /* /: Dom >+> R */
4831
4832 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4833 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4834 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(2),int(8))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4835 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4836
4837 :- block not_partial_injection(-,?,?,?).
4838 not_partial_injection(R,DomType,RangeType,WF) :-
4839 partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4840 not_partial_injection2(IsPF,R,DomType,RangeType,WF).
4841
4842 :- block not_partial_injection2(-,?,?,?,?).
4843 not_partial_injection2(pred_false,_R,_DomType,_RType,_WF).
4844 not_partial_injection2(pred_true,R,DomType,RType,WF) :-
4845 not_injection_wf(R,DomType,RType,WF).
4846
4847 not_injection_wf(R,DomType,RType,WF) :-
4848 invert_relation_wf(R,IR,WF),
4849 not_partial_function(IR,RType,DomType,WF).
4850
4851 /*****************************************/
4852 /* total_injection(R,DomType,RangeType) */
4853 /* R : DomType >-> RangeType */
4854 /*****************************************/
4855
4856 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_injection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4857 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_injection_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4858 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_total_injection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4859 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_total_injection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4860 :- assert_must_succeed((bsets_clp:total_injection(X,[int(1)],[int(7)]),
4861 kernel_objects:equal_object(X,[(int(1),int(7))]))).
4862 :- assert_must_succeed((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4863 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4864 :- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7)]),
4865 kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4866 :- assert_must_fail((bsets_clp:total_injection([],[int(1)],[int(7)]))).
4867 :- assert_must_fail((bsets_clp:total_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4868 :- assert_must_fail((bsets_clp:total_injection([(int(1),int(7)), (int(2),int(1))],
4869 [int(1),int(2)],[int(7)]))).
4870 :- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4871 kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4872
4873
4874 total_injection(R,Domain,Range) :- init_wait_flags(WF),
4875 total_injection_wf(R,Domain,Range,WF),
4876 ? ground_wait_flags(WF).
4877
4878 :- block total_injection_wf(-,-,?,?). % with just ?,-,?,? we may wait too long to start injective check
4879 % Note: no need to check: dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),
4880 total_injection_wf(R,DomType,RangeType,WF) :-
4881 check_card_greater_equal(RangeType,geq,DomType,_,_), % there must be more Range elements than domain elements; pigeonhole principle
4882 ? total_injection_wf2(R,DomType,RangeType,WF).
4883 total_injection_wf2(R,DomType,RangeType,WF) :-
4884 try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF),
4885 ? total_function_wf(ER,DomType,RangeType,WF),
4886 injective(ER,WF).
4887
4888
4889 :- block not_total_injection(-,?,?,?), not_total_injection(?,-,-,?).
4890 not_total_injection(R,DomType,RangeType,WF) :-
4891 total_function_test_wf(R,DomType,RangeType,PredRes,WF),
4892 not_total_injection2(PredRes,R,DomType,RangeType,WF).
4893
4894 :- block not_total_injection2(-,?,?,?,?).
4895 not_total_injection2(pred_false,_R,_Dom,_Ran,_WF).
4896 not_total_injection2(pred_true,R,DomType,RangeType,WF) :-
4897 % TO DO: replace DomType and RangeType by full Type
4898 not_injection_wf(R,DomType,RangeType,WF).
4899
4900 /***********************************/
4901 /* partial_bijection(R,DomType,RangeType) */
4902 /* R : DomType >+>> RangeType */
4903 /***********************************/
4904
4905 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4906 :- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4907 :- assert_must_succeed((partial_bijection(X,[int(1),int(2)],[int(7),int(6)]),
4908 kernel_objects:equal_object(X,[(int(1),int(6)),(int(2),int(7))]))).
4909 :- assert_must_succeed((partial_bijection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4910 X = [(int(2),int(7)),(int(3),int(6))])).
4911 :- assert_must_fail((partial_bijection(X,[int(1),int(2)],[int(7),int(6),int(5)]),
4912 X = [(int(2),int(7)),(int(1),int(6))])).
4913
4914 partial_bijection(R,Domain,Range) :- init_wait_flags(WF),
4915 partial_bijection_wf(R,Domain,Range,WF),
4916 ? ground_wait_flags(WF).
4917
4918 partial_bijection_wf(R,DomType,RangeType,WF) :-
4919 partial_injection_wf(R,DomType,RangeType,WF),
4920 ? partial_surjection_wf(R,DomType,RangeType,WF).
4921
4922 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4923 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_bijection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4924
4925 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4926
4927 :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(3),int(6))],[int(1),int(2),int(3),int(4)],[int(7),int(6)],WF),WF)).
4928 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6),int(5)],WF),WF)).
4929
4930
4931 :- block not_partial_bijection(-,?,?,?), not_partial_bijection(?,-,-,?).
4932 not_partial_bijection(R,DomType,RangeType,WF) :-
4933 % >+>> = +->> + injective
4934 partial_surjection_test_wf(R,DomType,RangeType,PredRes,WF),
4935 not_partial_bijection2(PredRes,R,DomType,RangeType,WF).
4936
4937 :- block not_partial_bijection2(-,?,?,?,?).
4938 not_partial_bijection2(pred_false,_R,_DomType,_RangeType,_WF).
4939 not_partial_bijection2(pred_true,R,DomType,RangeType,WF) :-
4940 not_injection_wf(R,DomType,RangeType,WF).
4941
4942
4943
4944 /* The transitive (not reflexive) closure of a relation (closure1) */
4945
4946 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(1),int(2)),(int(2),int(6))],[(int(1),int(2)),(int(1),int(6)),(int(2),int(6))]))).
4947 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(1),int(2)),(int(2),int(6)),(int(1),int(3))],[(int(1),int(2)),(int(1),int(3)),(int(1),int(6)),(int(2),int(6))]))).
4948 :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(6),int(7)),(int(1),int(2)),(int(2),int(6)),(int(1),int(3))],[(int(1),int(2)),(int(1),int(3)),(int(1),int(6)),(int(2),int(6)),(int(1),int(7)),(int(2),int(7)),(int(6),int(7))]))).
4949 :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4))],X),
4950 kernel_objects:equal_object(X,[(int(1),int(4))]))).
4951 :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2))],X),
4952 kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),
4953 (int(1),int(2))]))).
4954 :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2)),(int(2),int(3))],X),
4955 kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),(int(2),int(3)),
4956 (int(4),int(3)),(int(1),int(2)),(int(1),int(3))]))).
4957 :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(A),int(2)),(int(2),int(6))],
4958 [(int(1),int(2)),(int(1),int(6)),(int(2),int(6))]),A=1)).
4959
4960 relational_trans_closure(Rel,Res) :- relational_trans_closure_wf(Rel,Res,no_wf_available).
4961
4962 % transitive closure for relations (closure1)
4963 :- block relational_trans_closure_wf(-,?,?).
4964 relational_trans_closure_wf(Relation,Result,WF) :-
4965 try_expand_and_convert_to_avl_with_check(Relation,ARelation,relational_trans_closure_wf),
4966 relational_trans_closure2(ARelation,Result,WF).
4967 :- block relational_trans_closure2(-,?,?).
4968 relational_trans_closure2(ARelation,Result,WF) :-
4969 (closure1_for_explicit_set(ARelation,Res)
4970 -> kernel_objects:equal_object_wf(Res,Result,relational_trans_closure_wf,WF)
4971 ; expand_custom_set_to_list_wf(ARelation,ERelation,_,relational_trans_closure2,WF),
4972 is_full_relation(ERelation,WaitVar), % still required??
4973 % we could do a check_subset_of_wf(ERelation,Resul,WF) if Result is nonvar and ERelation not ground
4974 compute_trans_closure(ERelation,Result,WaitVar,WF)
4975 ).
4976
4977 :- block compute_trans_closure(?,?,-,?).
4978 compute_trans_closure(Relation,Result,_,WF) :-
4979 ? compute_trans_closure2(Relation,1,Result,WF).
4980
4981 compute_trans_closure2(Relation,Cnt,Result,WF) :-
4982 one_closure_iteration(Relation,Relation,Relation,Result1,Added,Done,WF),
4983 ? compute_trans_closure3(Relation,Cnt,Result1,Added,Done,Result,WF).
4984
4985 :- block compute_trans_closure3(?,?,?,?,-,?,?).
4986 compute_trans_closure3(Relation,Cnt,Result1,Added,_Done,Result,WF) :-
4987 ( equal_object_wf(Result1,Relation,relational_trans_closure_wf,WF), % should we do equality_objects here?
4988 equal_object_optimized_wf(Result,Result1,compute_trans_closure,WF)
4989 ;
4990 Added==possibly_added,
4991 not_equal_object_wf(Result1,Relation,WF), % not a fixpoint; continue
4992 IterCnt is Cnt+1,
4993 ? compute_trans_closure2(Result1,IterCnt,Result,WF)
4994 ).
4995
4996 :- block one_closure_iteration(?,?,-,?,?,?,?).
4997 one_closure_iteration([],_,IterRes,OutRel,Added,Done,WF) :-
4998 equal_object_wf(IterRes,OutRel,one_closure_iteration,WF),
4999 (var(Added) -> Added=not_added ; true),
5000 Done=done.
5001 one_closure_iteration([(X,Y)|T],ExpandedPreviousRel,PreviousRel,OutRel,Added,Done,WF) :-
5002 add_tuples(ExpandedPreviousRel,X,Y,PreviousRel,IntRel,Added,DoneTuples,WF),
5003 ? one_closure_iteration_block(DoneTuples,T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF).
5004
5005 :- block one_closure_iteration_block(-,?,?,?,?,?,?,?).
5006 one_closure_iteration_block(_,T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF) :-
5007 ? one_closure_iteration(T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF).
5008
5009 add_tuples([],_,_,OutRel,OutRel,_Added,done,_).
5010 add_tuples([(X,Y)|T],OX,OY,InRel,OutRel,Added,Done,WF) :-
5011 % add tuple (X,OY) if we have Y=OX
5012 equality_objects_wf(Y,OX,EqRes,WF),
5013 ? add_tuples_aux(EqRes,X,T,OX,OY,InRel,OutRel,Added,Done,WF).
5014
5015 :- block add_tuples_aux(-,?,?,?,?,?,?,?,?,?).
5016 add_tuples_aux(pred_true,X,T,OX,OY,InRel,OutRel,possibly_added,Done,WF) :-
5017 add_element_wf((X,OY),InRel,IntRel,WF), % add transitive couple X -> OY
5018 ? add_tuples(T,OX,OY,IntRel,OutRel,_,Done,WF).
5019 add_tuples_aux(pred_false,_X,T,OX,OY,InRel,OutRel,Added,Done,WF) :- % no transitive couple needed
5020 ? add_tuples(T,OX,OY,InRel,OutRel,Added,Done,WF).
5021
5022
5023 :- assert_must_succeed((is_full_relation(X,R),var(R),X=[],R==true)).
5024 :- assert_must_succeed((is_full_relation(X,R),var(R),X=[(A,B)|T],var(R),A=int(1),var(R),B=A,var(R),T=[],R==true)).
5025 :- block is_full_relation(-,?).
5026 is_full_relation([],R) :- !,R=true.
5027 ?is_full_relation([H|T],W) :- !, is_full_relation_aux(H,T,W).
5028 is_full_relation(X,R) :-
5029 add_internal_error('Illegal Set for is_full_relation: ',is_full_relation(X,R)),fail.
5030
5031 :- block is_full_relation_aux(-,?,?).
5032 ?is_full_relation_aux((X,Y),T,W) :- !, is_full_relation_aux2(X,Y,T,W).
5033 is_full_relation_aux(X,T,W) :-
5034 add_internal_error('Illegal Set for is_full_relation: ',is_full_relation_aux(X,T,W)),fail.
5035 :- block is_full_relation_aux2(-,?,?,?), is_full_relation_aux2(?,-,?,?).
5036 ?is_full_relation_aux2(_X,_Y,T,W) :- is_full_relation(T,W).
5037
5038 /* ------------------ */
5039
5040 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(2),int(3))],WF),WF)). % used to be wfdet (see in_domain_wf above)
5041
5042 in_closure1_wf(Pair,Relation,WF) :- %Pair = (_A,B),
5043 %in_domain_wf_lazy(A,Relation,WF), % done below
5044 %check_element_of_wf((_,B),Relation,WF), % multiple solutions for _, see test 634, 637
5045 ? in_closure1_membership_test_wf(Pair,Relation,pred_true,WF).
5046
5047
5048 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],WF),WF)).
5049
5050 not_in_closure1_wf(Pair,Relation,WF) :-
5051 ? in_closure1_membership_test_wf(Pair,Relation,pred_false,WF).
5052
5053 :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[],Res,_WF),Res==pred_false)).
5054 :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(2))],Res,_WF),Res==pred_true)).
5055 :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3))],Res,_WF),Res==pred_false)).
5056 :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],Res,_WF),Res==pred_true)).
5057 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
5058 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(3)),[(int(11),int(3))],pred_true,WF),WF)).
5059 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(3)),[(int(11),int(33))],pred_false,WF),WF)).
5060 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(1),int(3)),[(int(11),int(3))],pred_false,WF),WF)).
5061 :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_membership_test_wf((int(11),int(22)),[(int(11),int(3)),(int(33),int(2)),(int(3),int(22)),(int(11),int(3))],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
5062 :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(11)),[(int(11),int(3))],pred_false,WF),WF)).
5063
5064 :- block force_in_domain(-,?,?,?).
5065 force_in_domain(pred_false,_A,_Relation,_WF).
5066 force_in_domain(pred_true,A,Relation,WF) :- % force A to be in domain, avoid enumeration warnings,...
5067 % maybe only for non-ground A
5068 in_domain_wf_lazy(A,Relation,WF). % slowdown Loop.mch (tests 634, 637) if we use in_domain_wf ?
5069
5070 % (x,y) : closure1(Rel)
5071 :- block in_closure1_membership_test_wf(?,-,?,?).
5072 in_closure1_membership_test_wf((A,B),CSRelation,MemRes,WF) :-
5073 is_custom_explicit_set(CSRelation,in_closure1),
5074 !,
5075 ? image_for_closure1_wf(CSRelation,[A],Image,WF),
5076 force_in_domain(MemRes,A,CSRelation,WF),
5077 membership_test_wf(Image,B,MemRes,WF).
5078 in_closure1_membership_test_wf((X,Y),Relation,MemRes,WF) :-
5079 expand_custom_set_to_list_wf(Relation,ERelation,_,in_closure1_membership_test_wf,WF),
5080 Discarded = [], % pairs discarded in current iteration
5081 force_in_domain(MemRes,X,Relation,WF),
5082 in_closure1_membership_test_wf2(ERelation,X,Y,Discarded,MemRes,WF).
5083
5084 :- block in_closure1_membership_test_wf2(-,?,?,?,?,?).
5085 in_closure1_membership_test_wf2([],_X,_Y,_,MemRes,_WF) :- MemRes=pred_false.
5086 in_closure1_membership_test_wf2([(V,W)|Rest],X,Y,Discarded,MemRes,WF) :- % TO DO: Rest==[] -->
5087 equality_objects_wf(V,X,VXResult,WF),
5088 in_closure1_membership_test_wf3(VXResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
5089
5090 :- block in_closure1_membership_test_wf3(-,?,?,?,?,?,?,?,?).
5091 in_closure1_membership_test_wf3(pred_false,V,W,Rest,X,Y,Discarded,MemRes,WF) :-
5092 in_closure1_membership_test_wf2(Rest,X,Y,[(V,W)|Discarded],MemRes,WF).
5093 in_closure1_membership_test_wf3(pred_true,V,W,Rest,X,Y,Discarded,MemRes,WF) :- % V=X
5094 propagate_false(MemRes,WYResult),
5095 % TODO: Res=[],Discarded=[] -> MemRes=WYResult
5096 equality_objects_wf(W,Y,WYResult,WF), % MemRes = pred_false => WYResult = pred_false
5097 in_closure1_membership_test_wf4(WYResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
5098
5099 :- block in_closure1_membership_test_wf4(-,?,?,?,?,?,?,?,?).
5100 in_closure1_membership_test_wf4(pred_false,_V,W,Rest,X,Y,Discarded,MemRes,WF) :-
5101 append(Discarded,Rest,Restart),
5102 in_closure1_membership_test_wf2(Restart,W,Y,[],MemRes1,WF),
5103 propagate_false(MemRes,MemRes1), % MemRes = pred_false -> MemRes1=pred_false
5104 when(nonvar(MemRes1),
5105 (MemRes1=pred_true -> MemRes=pred_true
5106 ; in_closure1_membership_test_wf2(Rest,X,Y,Discarded,MemRes,WF) % (V,W) not in Discarded: was not useful
5107 )).
5108 in_closure1_membership_test_wf4(pred_true,_V,_W,_Rest,_X,_Y,_Discarded,MemRes,_WF) :- % W=Y
5109 MemRes = pred_true.
5110 /* ------------------ */
5111
5112 :- block propagate_false(-,?).
5113 propagate_false(pred_false,pred_false).
5114 propagate_false(pred_true,_).
5115