1 | | % (c) 2004-2019 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 | | permutation_sequence_wf/3, |
15 | | not_permutation_sequence/3, |
16 | | size_of_sequence/3, |
17 | | prepend_sequence/4, append_sequence/4, prefix_sequence_wf/4, |
18 | | suffix_sequence/4, concat_sequence/4, |
19 | | disjoint_union_wf/4, |
20 | | concatentation_of_sequences/3, |
21 | | tail_sequence/4, first_sequence/4, front_sequence/4, last_sequence/4, |
22 | | rev_sequence/3, |
23 | | |
24 | | |
25 | | % maplet/3, |
26 | | % relation/1, |
27 | | relation_over/3, relation_over_wf/4, |
28 | | not_relation_over/4, |
29 | | domain_wf/3, |
30 | | |
31 | | range_wf/3, |
32 | | identity_relation_over_wf/3, in_identity/3, not_in_identity/3, |
33 | | invert_relation_wf/3, |
34 | | tuple_of/3, |
35 | | rel_composition/3, rel_composition_wf/4, |
36 | | direct_product_wf/4, |
37 | | parallel_product_wf/4, in_parallel_product_wf/4, not_in_parallel_product_wf/4, |
38 | | rel_iterate_wf/5, |
39 | | event_b_identity_for_type/3, |
40 | | |
41 | | not_partial_function/4, |
42 | | partial_function/3, partial_function_wf/4, |
43 | | |
44 | | total_function/3, total_function_wf/4, |
45 | | |
46 | | % enumerate_total_bijection/3, |
47 | | total_bijection/3, total_bijection_wf/4, |
48 | | |
49 | | not_total_function/4, |
50 | | not_total_bijection/4, |
51 | | |
52 | | |
53 | | range_restriction_wf/4, range_subtraction_wf/4, |
54 | | in_range_restriction_wf/4, not_in_range_restriction_wf/4, |
55 | | in_range_subtraction_wf/4, not_in_range_subtraction_wf/4, |
56 | | domain_restriction_wf/4, domain_subtraction_wf/4, |
57 | | in_domain_restriction_wf/4, not_in_domain_restriction_wf/4, |
58 | | in_domain_subtraction_wf/4, not_in_domain_subtraction_wf/4, |
59 | | override_relation/4, |
60 | | image_wf/4, image_for_closure1_wf/4, |
61 | | |
62 | | in_domain_wf/3, not_in_domain_wf/3, |
63 | | apply_to/4, apply_to/5, |
64 | | override/5, |
65 | | |
66 | | %sum_over_range/2, mul_over_range/2, |
67 | | |
68 | | disjoint_union_generalized_wf/3, |
69 | | |
70 | | partial_surjection/3, not_partial_surjection_wf/4, |
71 | | total_relation_wf/4, |
72 | | not_total_relation_wf/4, |
73 | | |
74 | | surjection_relation_wf/4, total_surjection_relation_wf/4, |
75 | | not_surjection_relation_wf/4, not_total_surjection_relation_wf/4, |
76 | | |
77 | | total_surjection/3, total_surjection_wf/4, |
78 | | not_total_surjection_wf/4, |
79 | | |
80 | | partial_injection/3, partial_injection_wf/4, |
81 | | not_partial_injection/4, |
82 | | |
83 | | total_injection/3, total_injection_wf/4, |
84 | | not_total_injection/4, |
85 | | |
86 | | partial_bijection/3, partial_bijection_wf/4, |
87 | | not_partial_bijection/4, |
88 | | |
89 | | relational_trans_closure_wf/3, %relational_reflexive_closure/2, |
90 | | in_closure1_wf/3, not_in_closure1_wf/3 |
91 | | ]). |
92 | | |
93 | | |
94 | | %:- print(loading_bsets_clp),nl. |
95 | | %:- use_module(library(clpfd)). |
96 | | %portray_message(informational, _). |
97 | | :- use_module(library(terms)). |
98 | | :- use_module(self_check). |
99 | | |
100 | | :- use_module(debug). |
101 | | :- use_module(tools). |
102 | | |
103 | | :- use_module(module_information,[module_info/2]). |
104 | | :- module_info(group,kernel). |
105 | | :- module_info(description,'This module provides more advanced operations for the basic datatypes of ProB (mainly for relations, functions, sequences).'). |
106 | | |
107 | | :- use_module(tools_printing,[print_term_summary/1]). |
108 | | |
109 | | :- use_module(delay). |
110 | | |
111 | | %:- use_module(labeling). |
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 | | |
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), |
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 | | :- block is_sequence_domain(-,?). |
212 | | is_sequence_domain(Domain,WF) :- |
213 | | kernel_objects:finite_cardinality_as_int(Domain,int(Max),WF), |
214 | | %print(size(Max)),nl, |
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 | | kernel_objects:finite_cardinality_as_int(Domain,int(Max),WF), |
219 | | %print(size(Max)),nl, |
220 | | construct_interval_closure(1,Max,Interval), not_equal_object_wf(Domain,Interval,WF). |
221 | | |
222 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true)], |
223 | | [pred_true,pred_false],WF),WF)). |
224 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true),(int(2),pred_false),(int(3),pred_true)], |
225 | | [pred_true,pred_false],WF),WF)). |
226 | | :- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R)],[pred_true],_WF),X==1, R==pred_true)). |
227 | | :- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R),(int(Y),R)],[pred_true],_WF),X=2, |
228 | | (preferences:preference(use_clpfd_solver,true) -> Y==1 ; Y=1), R==pred_true)). |
229 | | |
230 | | is_sequence_wf(Seq,Range,WF) :- is_sequence_wf_ex(Seq,Range,WF,_). |
231 | | % is_sequence_wf_ex also returns expansion; if it was done |
232 | | :- block is_sequence_wf_ex(-,?,?,?). |
233 | | is_sequence_wf_ex(FF,Range,WF,FF) :- % print(is_sequence_wf_ex(FF,Range,WF,FF)),nl, |
234 | | nonvar(FF), FF = closure(_,_,_), |
235 | | custom_explicit_sets:is_definitely_maximal_set(Range), |
236 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
237 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
238 | | % print_term_summary(checking_sequence(FFDomain)),nl, %% |
239 | | is_sequence_domain(FFDomain,WF). |
240 | | is_sequence_wf_ex(Seq,Range,WF,Res) :- |
241 | | expand_and_convert_to_avl_set_warn(Seq,AER,is_sequence_wf_ex,'ARG : seq(?)'),!, |
242 | | is_avl_sequence(AER), |
243 | | is_avl_relation_over_range(AER,Range,WF), |
244 | | custom_explicit_sets:construct_avl_set(AER,Res). |
245 | | is_sequence_wf_ex(X,Type,WF,EX) :- %writeq(is_sequence(X,Type)),nl, |
246 | | % try_ensure_seq_numbering(X,1), |
247 | | expand_custom_set_to_list_wf(X,EX,_,is_sequence_wf_ex,WF), |
248 | | is_sequence2(EX,[],Type,0,_MinSize,WF). |
249 | | |
250 | | % will make this much faster x:seq(STRING) & card(x)=400 & 401:dom(x) (40 ms rather than > 2 secs) |
251 | | % but this does not work -eval_file /Users/leuschel/git_root/prob_examples/examples/Setlog/prob-ttf/plavis-TransData_SP_21_simplified.prob |
252 | | %:- block try_ensure_seq_numbering(-,?). |
253 | | %try_ensure_seq_numbering([H|T],NextNr) :- var(H),!, print(nr(NextNr)),nl, |
254 | | % H = (int(NextNr),_), N1 is NextNr+1, |
255 | | % try_ensure_seq_numbering(T,N1). |
256 | | %try_ensure_seq_numbering(_,_). |
257 | | |
258 | | :- block is_sequence2(-,?,?,?,?,?). |
259 | | is_sequence2([],IndexesSoFar,_Type,Size,MinSize,_WF) :- MinSize = Size, |
260 | | contiguous_set_of_indexes(IndexesSoFar,Size). |
261 | | /* not very good to do the checking at the end; can we move part of the checking earlier ? */ |
262 | | is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,Size,MinSize,WF) :- |
263 | | less_than_direct(0,Idx), %is_index_greater_zero(Idx), |
264 | | not_element_of_wf(int(Idx),IndexesSoFar,WF), |
265 | | check_element_of_wf(X,Type,WF), S1 is Size+1, |
266 | | clpfd_interface:clpfd_leq(Idx,MinSize,_Posted), |
267 | | (var(Tail) |
268 | | -> clpfd_interface:clpfd_domain(MinSize,Low,_Up), %print(is_seq_index(MinSize,Low,_Up,Tail,S1,IndexesSoFar)),nl, % TO DO: ensure that final size at least Low |
269 | | (number(Low),Low>S1 -> Tail = [_|_] % TO DO: proper reification; what if MinSize gets constrained later |
270 | | ; expand_seq_if_necessary(Idx,S1,Tail)) % the sequence must be longer; force it |
271 | | ; true |
272 | | ), %print(rec_call(Tail)),nl, |
273 | | is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,S1,MinSize,WF). |
274 | | |
275 | | :- block expand_seq_if_necessary(-,?,-). |
276 | | expand_seq_if_necessary(MinSize,S1,Tail) :- % TO DO: proper reification on MinSize above |
277 | | number(MinSize), MinSize>S1, (var(Tail) ; Tail==[]), |
278 | | %print(expand(MinSize,S1,Tail)),nl, |
279 | | !, |
280 | | Tail = [_|_]. |
281 | | expand_seq_if_necessary(_,_,_). |
282 | | |
283 | | :- block contiguous_set_of_indexes(-,?). |
284 | | contiguous_set_of_indexes([],_). |
285 | | contiguous_set_of_indexes([H|T],Size) :- contiguous_set_of_indexes1(T,H,Size). |
286 | | |
287 | | :- block contiguous_set_of_indexes1(-,?,?). |
288 | | contiguous_set_of_indexes1([],int(1),_). |
289 | | contiguous_set_of_indexes1([int(H2)|T],int(H1),Size) :- less_than_equal_direct(H1,Size), |
290 | | less_than_equal_direct(H2,Size), less_than_equal_indexes(T,[H1,H2],Size). |
291 | | /* |
292 | | Indexes = [H1,H2|T], |
293 | | when(ground(Indexes),(sort(Indexes,Sorted),contiguous_set_of_indexes2(Sorted))). |
294 | | contiguous_set_of_indexes2([]). |
295 | | contiguous_set_of_indexes2([int(1)|T]) :- contiguous_set_of_indexes3(T,1). |
296 | | contiguous_set_of_indexes3([],_). |
297 | | contiguous_set_of_indexes3([int(N)|T],N1) :- N is N1+1, contiguous_set_of_indexes3(T,N). |
298 | | */ |
299 | | |
300 | | less_than_equal_indexes([],All,_) :- clpfd_interface:clpfd_alldifferent(All). |
301 | | less_than_equal_indexes([int(H)|T],All,Size) :- less_than_equal_direct(H,Size),less_than_equal_indexes(T,[H|All],Size). |
302 | | |
303 | | :- 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)). |
304 | | :- 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)). |
305 | | :- 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)). |
306 | | :- 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)). |
307 | | :- 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)). |
308 | | :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(1),int(22))],[int(22)]))). |
309 | | :- 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)]))). |
310 | | :- 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)]))). |
311 | | :- 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)]))). |
312 | | :- assert_must_fail((not_is_sequence(R,global_set('Name')),R = [])). |
313 | | :- assert_must_fail((not_is_sequence(R,global_set('Name')), |
314 | | R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )). |
315 | | :- assert_must_fail((not_is_sequence(R,global_set('Name')), |
316 | | R = [(int(1),fd(2,'Name'))] )). |
317 | | :- assert_must_fail((not_is_sequence(R,global_set('Name')), |
318 | | R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
319 | | :- assert_must_fail((not_is_sequence(R,global_set('Name')), |
320 | | R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
321 | | :- assert_must_fail((not_is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))], |
322 | | global_set('Name')) )). |
323 | | :- assert_must_fail((not_is_sequence(R,[int(1),int(2)]), |
324 | | R = [(int(2),int(2)),(int(1),int(1))] )). |
325 | | :- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]), |
326 | | R = [(int(2),int(2)),(int(3),int(1))] )). |
327 | | :- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]), |
328 | | R = [(int(2),int(2)),(int(1),int(3))] )). |
329 | | |
330 | | |
331 | | not_is_sequence(X,Type) :- init_wait_flags(WF), |
332 | | not_is_sequence_wf(X,Type,WF), |
333 | | ground_wait_flags(WF). |
334 | | |
335 | | :- block not_is_sequence_wf(-,?,?). |
336 | | not_is_sequence_wf(FF,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
337 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
338 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
339 | | % print_term_summary(not_checking_sequence(FFDomain)),nl, % |
340 | | not_is_sequence_domain(FFDomain,WF). |
341 | | not_is_sequence_wf(Seq,Range,WF) :- |
342 | | expand_and_convert_to_avl_set_warn(Seq,AER,not_is_sequence_wf,'ARG /: seq(?)'), |
343 | | !, %print_term_summary(not_is_sequence_wf(Seq,Range,WF)), |
344 | | (is_avl_sequence(AER) -> is_not_avl_relation_over_range(AER,Range,WF) |
345 | | ; true). |
346 | | not_is_sequence_wf(X,Type,WF) :- expand_custom_set_to_list_wf(X,EX,_Done,not_is_sequence_wf,WF), |
347 | | not_is_sequence2(EX,[],Type,WF). |
348 | | |
349 | | :- block not_is_sequence2(-,?,?,?). |
350 | | not_is_sequence2([],IndexesSoFar,_,_WF) :- not_contiguous_set_of_indexes(IndexesSoFar). |
351 | | not_is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,WF) :- |
352 | | membership_test_wf(IndexesSoFar,int(Idx),MemRes,WF), |
353 | | not_is_sequence3(MemRes,Idx,X,Tail,IndexesSoFar,Type,WF). |
354 | | |
355 | | :- block not_is_sequence3(-,?,?,?,?,?,?). |
356 | | not_is_sequence3(pred_true,_Idx,_X,_Tail,_IndexesSoFar,_Type,_WF). |
357 | | not_is_sequence3(pred_false,Idx,_X,_Tail,_IndexesSoFar,_Type,_WF) :- nonvar(Idx),Idx<1,!. |
358 | | not_is_sequence3(pred_false,Idx,X,Tail,IndexesSoFar,Type,WF) :- |
359 | | membership_test_wf(Type,X,MemRes,WF), |
360 | | not_is_sequence4(MemRes,Idx,Tail,IndexesSoFar,Type,WF). |
361 | | |
362 | | :- block not_is_sequence4(-,?,?,?,?,?). |
363 | | not_is_sequence4(pred_false,_Idx,_Tail,_IndexesSoFar,_Type,_WF). |
364 | | not_is_sequence4(pred_true,Idx,Tail,IndexesSoFar,Type,WF) :- |
365 | | not_is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,WF). |
366 | | |
367 | | not_contiguous_set_of_indexes(Indexes) :- |
368 | | when(ground(Indexes),(sort(Indexes,Sorted),not_contiguous_set_of_indexes2(Sorted,1))). |
369 | | not_contiguous_set_of_indexes2([int(N)|T],N1) :- |
370 | | when(?=(N,N1), |
371 | | ((N \= N1) ; (N=N1, N2 is N1+1, not_contiguous_set_of_indexes2(T,N2)))). |
372 | | |
373 | | |
374 | | |
375 | | |
376 | | |
377 | | :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(22))],[int(22)]))). |
378 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(2))],[int(22)]))). |
379 | | :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),R = [])). |
380 | | :- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')), |
381 | | R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )). |
382 | | :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')), |
383 | | R = [(int(2),fd(1,'Name')),(int(4),fd(2,'Name'))] )). |
384 | | :- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')), |
385 | | R = [(int(1),fd(1,'Name')),(int(2),fd(1,'Name'))] )). |
386 | | :- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,[int(1),int(2)]), |
387 | | R = [(int(1),int(2)),(int(2),int(3))] )). |
388 | | |
389 | | % S /: seq1(T) |
390 | | not_is_non_empty_sequence_wf(S,T,_) :- not_is_non_empty_sequence(S,T). |
391 | | :- block not_is_non_empty_sequence(-,?). |
392 | | not_is_non_empty_sequence([],_) :- !. |
393 | | not_is_non_empty_sequence(X,Type) :- |
394 | | empty_sequence(X) ; not_is_sequence(X,Type). |
395 | | |
396 | | |
397 | | |
398 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)). |
399 | | :- 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)). |
400 | | :- 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)). |
401 | | :- 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)). |
402 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([],global_set('Name'),WF),WF)). |
403 | | :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF), |
404 | | kernel_waitflags:ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )). |
405 | | :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF), |
406 | | ground_det_wait_flag(WF), R = [(int(1),fd(2,'Name'))] )). |
407 | | :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF), |
408 | | ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
409 | | :- assert_must_fail((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF), |
410 | | ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
411 | | :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_sequence_wf([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))], |
412 | | global_set('Name'),WF),WF) ). |
413 | | :- assert_must_succeed((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF), |
414 | | ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )). |
415 | | :- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF), |
416 | | ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(3),int(1))] )). |
417 | | :- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF), |
418 | | ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )). |
419 | | |
420 | | |
421 | | |
422 | | :- block injective_sequence_wf(-,-,?). |
423 | | injective_sequence_wf(Seq,Type,WF) :- /* corresponds to iseq */ |
424 | | nonvar(Seq), |
425 | | %expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)'), |
426 | | Seq=avl_set(AER), |
427 | | !, |
428 | | is_avl_sequence(AER), |
429 | | is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ?? |
430 | | is_avl_relation_over_range(AER,Type,WF). |
431 | | injective_sequence_wf(Seq,Type,WF) :- |
432 | | cardinality_as_int_for_wf(Type,MaxCard), |
433 | | custom_explicit_sets:blocking_nr_iseq(MaxCard,ISeqSize), |
434 | | block_get_wait_flag(ISeqSize,injective_sequence_wf,WF,LWF), |
435 | | injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF). |
436 | | |
437 | | :- block injective_sequence_wf_aux(-,?,?,?,-). |
438 | | injective_sequence_wf_aux(Seq,Type,_,WF,_) :- /* corresponds to iseq */ |
439 | | nonvar(Seq), |
440 | | expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)'),!, |
441 | | %Seq=avl_set(AER), |
442 | | !, |
443 | | is_avl_sequence(AER), |
444 | | is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ?? |
445 | | is_avl_relation_over_range(AER,Type,WF). |
446 | | injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF) :- |
447 | | expand_custom_set_to_list_wf(Seq,ESeq,_,injective_sequence_wf,WF), |
448 | | is_sequence_wf(ESeq,Type,WF), |
449 | | injective_sequence2(ESeq,0,[],Type,WF,MaxCard,LWF). |
450 | | |
451 | | :- block injective_sequence2(-,?,?,?,?,?,-),injective_sequence2(-,?,?,?,?,-,?). |
452 | | injective_sequence2([],_,_,_Type,_WF,_MaxCard,_LWF). |
453 | | injective_sequence2([(int(Index),X)|Tail],CardSoFar,SoFar,Type,WF,MaxCard,LWF) :- |
454 | | (number(MaxCard) -> CardSoFar< MaxCard, %less_than_equal_direct(Index,MaxCard) % does not enumerate index |
455 | | 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 |
456 | | ; true), |
457 | | check_element_of_wf(X,Type,WF), |
458 | | not_element_of_wf(X,SoFar,WF), |
459 | | add_new_element_wf(X,SoFar,SoFar2,WF), |
460 | | C1 is CardSoFar+1, |
461 | | (C1 == MaxCard -> Tail=[] ; true), |
462 | | injective_sequence2(Tail,C1,SoFar2,Type,WF,MaxCard,LWF). |
463 | | |
464 | | |
465 | | :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)). |
466 | | :- 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)). |
467 | | :- 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)). |
468 | | :- 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)). |
469 | | :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),_WF),R = [])). |
470 | | :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF), |
471 | | ground_det_wait_flag(WF), |
472 | | R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )). |
473 | | :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF), |
474 | | ground_det_wait_flag(WF), |
475 | | R = [(int(1),fd(2,'Name'))] )). |
476 | | :- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF), |
477 | | ground_det_wait_flag(WF), |
478 | | R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
479 | | :- assert_must_fail((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF), |
480 | | ground_det_wait_flag(WF), |
481 | | R = [(int(2),int(2)),(int(1),int(1))] )). |
482 | | :- assert_must_succeed((bsets_clp:not_injective_sequence(R,global_set('Name'),WF), |
483 | | ground_det_wait_flag(WF), |
484 | | R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
485 | | :- assert_must_succeed((bsets_clp:not_injective_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))], |
486 | | global_set('Name'),WF), |
487 | | ground_det_wait_flag(WF) )). |
488 | | :- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF), |
489 | | ground_det_wait_flag(WF), |
490 | | R = [(int(2),int(2)),(int(3),int(1))] )). |
491 | | :- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF), |
492 | | ground_det_wait_flag(WF), |
493 | | R = [(int(2),int(2)),(int(1),int(3))] )). |
494 | | :- block not_injective_sequence(-,?,?), not_injective_sequence(?,-,?). |
495 | | not_injective_sequence(Seq,_,_) :- Seq==[],!,fail. |
496 | | not_injective_sequence(Seq,Type,WF) :- nonvar(Seq), |
497 | | expand_and_convert_to_avl_set_warn(Seq,AER,not_injective_sequence,'ARG /: iseq(?)'),!, |
498 | | %print_term_summary(not_inj_seq(Seq,Type,WF)), |
499 | | (\+ is_avl_sequence(AER) -> true |
500 | | ; is_injective_avl_relation(AER,ExactRange) -> not_subset_of_wf(ExactRange,Type,WF) |
501 | | ; true). |
502 | | not_injective_sequence(Seq,Type,WF) :- /* corresponds to Iseq */ |
503 | | %get_middle_wait_flag(not_injective_sequence,WF,LWF), |
504 | | kernel_tools:ground_value_check(Seq,SV), |
505 | | not_injective_sequence1(Seq,Type,WF,SV). |
506 | | :- block not_injective_sequence1(?,?,?,-). |
507 | | not_injective_sequence1(Seq,Type,WF,_) :- |
508 | | expand_custom_set_to_list_wf(Seq,ESeq,_,not_injective_sequence1,WF), |
509 | | (not_is_sequence_wf(ESeq,Type,WF) |
510 | | ; /* CHOICE POINT !! */ |
511 | | (is_sequence_wf(ESeq,Type,WF),not_injective_sequence2(ESeq,[],Type,WF))). |
512 | | :- block not_injective_sequence2(-,?,?,?). |
513 | | not_injective_sequence2([(int(_),X)|Tail],SoFar,Type,WF) :- |
514 | | membership_test_wf(SoFar,X,MemRes,WF), |
515 | | not_injective_sequence3(MemRes,X,Tail,SoFar,Type,WF). |
516 | | |
517 | | :- block not_injective_sequence3(-,?,?,?,?,?). |
518 | | not_injective_sequence3(pred_true,_X,_Tail,_SoFar,_Type,_WF). |
519 | | not_injective_sequence3(pred_false,X,Tail,SoFar,Type,WF) :- |
520 | | add_new_element_wf(X,SoFar,SoFar2,WF), |
521 | | not_injective_sequence2(Tail,SoFar2,Type,WF). |
522 | | |
523 | | :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)). |
524 | | :- 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)). |
525 | | :- 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)). |
526 | | :- 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)). |
527 | | :- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF), |
528 | | ground_det_wait_flag(WF), R = [])). |
529 | | :- assert_must_fail((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF), |
530 | | ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
531 | | :- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,[int(1),int(2)],WF), |
532 | | ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )). |
533 | | |
534 | | :- block not_non_empty_injective_sequence(-,?,?). |
535 | | not_non_empty_injective_sequence([],_Type,_WF) :- !. |
536 | | not_non_empty_injective_sequence(X,Type,WF) :- |
537 | | empty_sequence(X) ; not_injective_sequence(X,Type,WF). |
538 | | |
539 | | |
540 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)). |
541 | | :- 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)). |
542 | | :- 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)). |
543 | | :- 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)). |
544 | | :- assert_must_fail((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF), |
545 | | ground_det_wait_flag(WF),R = [])). |
546 | | :- assert_must_succeed((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF), |
547 | | ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
548 | | :- block injective_non_empty_sequence(-,-,?). /* corresponds to iseq1 */ |
549 | | injective_non_empty_sequence(A,Type,WF) :- nonvar(A),A=avl_set(AS), !, |
550 | | injective_sequence_wf(avl_set(AS),Type,WF),is_non_empty_explicit_set_wf(avl_set(AS),WF). |
551 | | injective_non_empty_sequence(Seq,Type,WF) :- % print_term_summary(iseq1(Seq,Type,WF)),nl, |
552 | | ((nonvar(Seq),Seq=closure(_,_,_)) -> try_expand_custom_set(Seq,ESeq) ; ESeq=Seq), |
553 | | injective_sequence_wf(ESeq,Type,WF),not_empty_sequence_wf(ESeq,WF). |
554 | | |
555 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)). |
556 | | :- 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)). |
557 | | :- 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 = [])). |
558 | | :- assert_must_succeed((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF), |
559 | | ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
560 | | :- block finite_non_empty_sequence(-,?,?). |
561 | | finite_non_empty_sequence(Seq,Type,WF) :- /* corresponds to Seq1 */ |
562 | | is_sequence_wf_ex(Seq,Type,WF,ESeq),(var(ESeq) -> not_empty_sequence_wf(Seq,WF) ; not_empty_sequence_wf(ESeq,WF)). |
563 | | |
564 | | |
565 | | |
566 | | |
567 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)). |
568 | | :- 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)). |
569 | | :- 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)). |
570 | | :- 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)). |
571 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF), |
572 | | ground_det_wait_flag(WF),R = [(int(1),int(1))] )). |
573 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF), |
574 | | ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(2))] )). |
575 | | :- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF), |
576 | | ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )). |
577 | | :- 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), |
578 | | R = [(int(1),pred_false /* bool_false */),(int(2),pred_true /* bool_true */)] )). |
579 | | :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF), |
580 | | ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )). |
581 | | :- 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 = [])). |
582 | | :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF), |
583 | | ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
584 | | :- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF), |
585 | | ground_det_wait_flag(WF), |
586 | | kernel_objects:equal_object(R,[(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))]) )). |
587 | | :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF), |
588 | | ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )). |
589 | | :- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF), |
590 | | ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
591 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(4),int(3),int(2),int(1)],WF), |
592 | | ground_det_wait_flag(WF), R=[(int(1),int(1)),(int(2),int(2)),(int(3),int(3)),(int(4),int(4))])). |
593 | | |
594 | | :- block permutation_sequence_wf(-,-,?). |
595 | | permutation_sequence_wf(SeqFF,Type,WF) :- nonvar(SeqFF), |
596 | | custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection)),!, |
597 | | equal_object_wf(FFRange,Type,permutation_sequence_wf_1,WF), |
598 | | is_sequence_domain(FFDomain,WF). |
599 | | permutation_sequence_wf(Seq,Type,WF) :- |
600 | | expand_and_convert_to_avl_set_warn(Seq,AER,permutation_sequence_wf,'ARG : perm(?)'),!, |
601 | | %% print_term_summary(checking_avl_perm_seq(AER,Type)),nl, %% |
602 | | is_avl_sequence(AER), |
603 | | %% print(is_sequence),nl, %% |
604 | | is_injective_avl_relation(AER,Range), |
605 | | %% print_term_summary(is_injective(Range)), %% |
606 | | kernel_objects:equal_object_wf(Range,Type,permutation_sequence_wf_2,WF). |
607 | | permutation_sequence_wf(Seq,Type,WF) :- |
608 | | try_expand_custom_set(Seq,ESeq), |
609 | | cardinality_as_int_wf(Type,int(Card),WF), |
610 | | when(nonvar(Card), (setup_sequence(Card,SkelSeq,1), %print(setup(SkelSeq,ESeq)),nl, |
611 | | CardGround=true, |
612 | | kernel_objects:equal_object_wf(SkelSeq,ESeq,permutation_sequence_wf_3,WF))), |
613 | | %injective_sequence_wf(ESeq,Type,WF,LWF), |
614 | | surjective_iseq_0(SkelSeq,ESeq,Type,WF,Card,CardGround). |
615 | | % quick_all_different_range(ESeq,[],Type,WF). |
616 | | |
617 | | :- block surjective_iseq_0(-,-,?,?,?,-). |
618 | | surjective_iseq_0(SkelSeq,_ESeq,Type,WF,_Card,Ground) :- % print(perm(SkelSeq,Type,_Card,Ground)),nl, |
619 | | nonvar(Ground), |
620 | | nonvar(SkelSeq), |
621 | | preference(use_clpfd_solver,true), % try and use an optimized version calling global_cardinality in CLPFD module |
622 | | get_global_cardinality_list(Type,YType,GCL,_), |
623 | | % this dramatically reduces runtime for NQueens40_perm; maybe we should do this only when necessary, i.e., when surjective_iseq blocks on PreviousRemoveDone |
624 | | % check why it slows down SortByPermutation_v2 |
625 | | !, |
626 | | global_cardinality_range(SkelSeq,[],YType,GCL,WF). |
627 | | surjective_iseq_0(_,ESeq,Type,WF,Card,_) :- |
628 | | %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); |
629 | | % but this slows down EulerWay.mch ; maybe because it sets up enumerators ? TO DO: investigate |
630 | | surjective_iseq(ESeq,Type,WF,Card). |
631 | | |
632 | | %:- use_module(clpfd_interface,[clpfd_alldifferent/1]). |
633 | | % collect range and then call CLPFD global_cardinality using GCL (Global Cardinality List Ki-Vi) |
634 | | :- block global_cardinality_range(-,?,?,?,?). |
635 | | global_cardinality_range([],Acc,_Type,GCL,WF) :- |
636 | | %print(global_cardinality(Acc,_Type,GCL)),nl, |
637 | | clpfd:global_cardinality(Acc,GCL,[consistency(value)]), |
638 | | add_fd_variables_for_labeling(Acc,WF). % this is needed for efficiency for NQueens40_perm !! |
639 | | global_cardinality_range([(_,Y)|T],Acc,Type,GCL,WF) :- |
640 | | get_simple_fd_value(Type,Y,FDYVAL), |
641 | | global_cardinality_range(T,[FDYVAL|Acc],Type,GCL,WF). |
642 | | |
643 | | |
644 | | :- use_module(b_global_sets,[all_elements_of_type/2,b_integer_set/1]). |
645 | | % try and convert a B set into a list suitable for calling clpfd:global_cardinality |
646 | | % get_global_cardinality_list(avl_set(A) % TO DO: extend to integer_lists |
647 | | get_global_cardinality_list(global_set(G),Type,GCL,list) :- !, |
648 | | all_elements_of_type(G,Values), |
649 | | (b_integer_set(G) -> Type=integer ; Type=global(G)), |
650 | | findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL). |
651 | | get_global_cardinality_list(avl_set(A),Type,GCL,list) :- !, |
652 | | A = node(TopValue,_True,_,_,_), |
653 | | get_simple_fd_value(Type,TopValue,_), % we have CLPFD values |
654 | | avl:avl_domain(A,Values), |
655 | | findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL). |
656 | | get_global_cardinality_list(Set,integer,GCL,interval(L1,U1)) :- nonvar(Set), |
657 | | is_interval_closure_or_integerset(Set,L1,U1), number(L1),number(U1), |
658 | | global_cardinality_list_interval(L1,U1,GCL). |
659 | | |
660 | | global_cardinality_list_interval(From,To,[]) :- From>To, !. |
661 | | global_cardinality_list_interval(From,To,[From-1|T]) :- |
662 | | F1 is From+1, global_cardinality_list_interval(F1,To,T). |
663 | | |
664 | | %try_get_simple_fd_value(Type,V,Val) :- nonvar(V),get_simple_fd_value(Type,V,Val). |
665 | | get_simple_fd_value(integer,int(X),X). |
666 | | get_simple_fd_value(global(T),fd(X,T),X). |
667 | | % try_get_simple_fd_value(pred_false,0). try_get_simple_fd_value(pred_true,1). ?? |
668 | | % TO DO: maybe also treat pairs ? but we need complete values; see module clpfd_lists ! |
669 | | |
670 | | setup_sequence(0,R,_) :- !, R=[]. |
671 | | setup_sequence(Card,[(int(Nr),_)|T], Nr ) :- Card>0, C1 is Card-1, |
672 | | N1 is Nr+1, |
673 | | setup_sequence(C1,T,N1). |
674 | | |
675 | | :- block surjective_iseq(?,?,?,-),surjective_iseq(?,-,?,?), surjective_iseq(-,?,?,?). |
676 | | surjective_iseq(avl_set(S),Type,WF,Done) :- expand_custom_set(avl_set(S),ES), |
677 | | surjective_iseq(ES,Type,WF,Done). |
678 | | surjective_iseq(closure(P,T,B),Type,WF,Done) :- expand_custom_set(closure(P,T,B),ES), |
679 | | surjective_iseq(ES,Type,WF,Done). |
680 | | % no case for global_set: cannot be a relation |
681 | | surjective_iseq([],T,WF,_) :- empty_set_wf(T,WF). |
682 | | surjective_iseq([(int(_Nr),El)|Tail],Type,WF,_PreviousRemoveDone) :- |
683 | | % print(surjective_iseq([(int(_Nr),El)|Tail],Type,WF)),nl, |
684 | | remove_element_wf(El,Type,NType,WF,Done), |
685 | | % when(nonvar(Done), (print(removed(_Nr,El)),nl)), |
686 | | surjective_iseq(Tail,NType,WF,Done). |
687 | | :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(1),int(22))],[int(22)],WF),WF)). |
688 | | :- 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)). |
689 | | :- 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)). |
690 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)). |
691 | | :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1)],WF), |
692 | | ground_det_wait_flag(WF),R = [(int(1),int(1))] )). |
693 | | :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF), |
694 | | ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )). |
695 | | :- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF), |
696 | | ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )). |
697 | | :- assert_must_fail((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF), |
698 | | ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))] )). |
699 | | :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1)],WF), |
700 | | ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )). |
701 | | :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),_WF),R = [])). |
702 | | :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF), |
703 | | ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )). |
704 | | :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF), |
705 | | ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )). |
706 | | :- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF), |
707 | | ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )). |
708 | | :- block not_permutation_sequence(-,?,?). |
709 | | not_permutation_sequence(SeqFF,Type,WF) :- nonvar(SeqFF), |
710 | | custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection)),!, |
711 | | equality_objects_wf(FFRange,Type,Result,WF), |
712 | | when(nonvar(Result),(Result=pred_false -> true ; not_is_sequence_domain(FFDomain,WF))). |
713 | | not_permutation_sequence(Seq,Type,WF) :- |
714 | | kernel_tools:ground_value_check(Seq,SV), |
715 | | not_permutation_sequence1(Seq,Type,SV,WF). |
716 | | :- block not_permutation_sequence1(?,-,?,?), not_permutation_sequence1(?,?,-,?). |
717 | | not_permutation_sequence1(avl_set(A),Type,_,WF) :- is_ground_set(Type), !, Seq=avl_set(A), |
718 | | if(not_injective_sequence(Seq,Type,WF), |
719 | | true, % no backtracking required; we could even use regular if with -> |
720 | | not_surj_avl(Seq,Type,WF) |
721 | | ). |
722 | | not_permutation_sequence1(avl_set(A),Type,_,WF) :- !, Seq=avl_set(A), |
723 | | (not_injective_sequence(Seq,Type,WF) |
724 | | ; injective_sequence_wf(Seq,Type,WF), |
725 | | not_surj_avl(Seq,Type,WF)). |
726 | | not_permutation_sequence1(Seq,Type,_,WF) :- |
727 | | expand_custom_set_to_list_wf(Seq,ESeq,Done,not_permutation_sequence1,WF), |
728 | | not_permutation_sequence2(ESeq,Type,WF,Done). |
729 | | |
730 | | not_surj_avl(Seq,Type,WF) :- range_wf(Seq,Range,WF), |
731 | | not_equal_object_wf(Range,Type,WF). % TO DO: one could even just check cardinality as Seq is inj |
732 | | %expand_custom_set_to_list_wf(Seq,ESeq,_,not_permutation_sequence1,WF), |
733 | | % not_surjective_seq(ESeq,Type,WF). |
734 | | % check if it is a ground set that cannot be instantiated |
735 | | is_ground_set(V) :- var(V),!,fail. |
736 | | is_ground_set(avl_set(_)). |
737 | | is_ground_set(global_set(_)). |
738 | | is_ground_set([]). |
739 | | |
740 | | % here we could have a choice point in WF0 |
741 | | :- block not_permutation_sequence2(?,?,?,-). |
742 | | not_permutation_sequence2(Seq,Type,WF,_) :- not_injective_sequence(Seq,Type,WF). |
743 | | not_permutation_sequence2(Seq,Type,WF,_) :- |
744 | | injective_sequence_wf(Seq,Type,WF), not_surjective_seq(Seq,Type,WF). |
745 | | |
746 | | :- block not_surjective_seq(-,?,?). |
747 | | not_surjective_seq([],T,WF) :- not_empty_set_wf(T,WF). |
748 | | not_surjective_seq([(int(_),El)|Tail],Type,WF) :- |
749 | | delete_element_wf(El,Type,NType,WF), |
750 | | not_surjective_seq(Tail,NType,WF). |
751 | | |
752 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(1),int(22))],int(1),_WF))). |
753 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(2),_WF))). |
754 | | :- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(3),_WF))). |
755 | | :- 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))). |
756 | | :- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF), |
757 | | X = [(int(1),int(2)),(int(2),int(1))], |
758 | | R = int(2))). |
759 | | :- assert_must_succeed((preferences:preference(use_clpfd_solver,false) -> true |
760 | | ; preferences:preference(use_smt_mode,false) -> true |
761 | | ; bsets_clp:size_of_sequence(X,R,_WF), R=int(RI), |
762 | | clpfd_interface:clpfd_geq2(RI,2,_), nonvar(X), X = [(I1,_),(I2,_)|T], |
763 | | I1==int(1), I2==int(2), T=[], RI==2 )). |
764 | | :- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),X = [(int(1),_),(int(2),_)],R = int(2))). |
765 | | :- assert_must_succeed((bsets_clp:size_of_sequence(X,_R,_WF),X =[(int(1),_),(int(2),_)] )). |
766 | | :- assert_must_succeed_any((bsets_clp:size_of_sequence(X,int(2),_WF),nonvar(X),X=[_|Y],nonvar(Y),Y=[_|Z],Z==[])). |
767 | | :- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))). |
768 | | :- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))). |
769 | | :- assert_must_succeed((bsets_clp:size_of_sequence([(int(1),int(4))],int(1),_WF))). |
770 | | :- assert_must_succeed((bsets_clp:size_of_sequence([],_,_WF))). |
771 | | :- assert_must_fail((bsets_clp:size_of_sequence(X,int(1),_WF), |
772 | | X = [(int(1),_),(int(2),_)|_])). |
773 | | :- block size_of_sequence(-,-,?). |
774 | | size_of_sequence(Seq,int(Res),WF) :- size_of_sequence1(Seq,Res,WF), |
775 | | set_up_sequence_skel(Seq,Res,WF). |
776 | | |
777 | | % setup sequence skeleton if we have some CLPFD bounds information about the size |
778 | | % currently still quite limited: only sets up if sequence is a variable; + does the setup only once |
779 | | :- use_module(clpfd_interface,[clpfd_domain/3]). |
780 | | set_up_sequence_skel(Seq,Res,WF) :- %print(size(Seq,Res)),nl, |
781 | | var(Seq), % to do: also deal with cases when Seq partially instantiated |
782 | | var(Res), |
783 | | preferences:preference(use_clpfd_solver,true), |
784 | | !, |
785 | | clpfd_interface:clpfd_geq2(Res,0,_), % assert that size must not be negative |
786 | | clpfd_interface:try_post_constraint(clpfd:'#<=>'( (Res#>0) , Trigger)), % generate reified trigger for when we can instantiate Seq |
787 | | set_up_sequence_skel_aux(Seq,Res,Trigger,WF). |
788 | | set_up_sequence_skel(_,_,_). % TO DO: check if Size interval shrinks |
789 | | :- block set_up_sequence_skel_aux(-,?,-,?). |
790 | | set_up_sequence_skel_aux(Seq,_Res,_Trigger,_WF) :- |
791 | | nonvar(Seq), |
792 | | !. % to do: also deal with cases when Seq partially instantiated |
793 | | set_up_sequence_skel_aux(Seq,Res,_Trigger,_WF) :- |
794 | | (number(Res) ; preferences:preference(use_smt_mode,true)), |
795 | | !, |
796 | | gen_seq_for_res(Res,Seq). |
797 | | set_up_sequence_skel_aux(Seq,Res,_Trigger,WF) :- |
798 | | get_large_finite_wait_flag(set_up_sequence_skel,WF,LWF), % delay, avoid costly unification with partially instantaited list skeleton; TO DO: in future we may use the kernel_cardinality attribute instead |
799 | | when((nonvar(LWF) ; nonvar(Seq) ; nonvar(Res)), (nonvar(Seq) -> true ; gen_seq_for_res(Res,Seq))). |
800 | | |
801 | | gen_seq_for_res(Res,Seq) :- |
802 | | clpfd_domain(Res,FDLow,FDUp), % FDLow could also be 0 |
803 | | gen_sequence_skeleton(1,FDLow,FDUp,S), |
804 | | Seq=S. |
805 | | gen_sequence_skeleton(N,M,FDUp,S) :- N>M,!,(FDUp==M -> S=[] ; true). |
806 | | gen_sequence_skeleton(N,Max,FDUp,[(int(N),_)|T]) :- |
807 | | N1 is N+1, |
808 | | gen_sequence_skeleton(N1,Max,FDUp,T). |
809 | | |
810 | | :- block size_of_sequence1(-,-,?). |
811 | | size_of_sequence1(Seq,ResInt,WF) :- |
812 | | nonvar(Seq),is_custom_explicit_set_nonvar(Seq), |
813 | | size_of_custom_explicit_set(Seq,Size,WF),!, |
814 | | equal_object_wf(Size,int(ResInt),size_of_sequence1,WF). |
815 | | /* TO DO: CHECK BELOW: would it not be better to use cardinality ?? */ |
816 | | /* |
817 | | size_of_sequence1(Seq,Size,WF) :- !,finite_cardinality_as_int(Seq,int(Size),WF), check_indexes(Seq,Size). |
818 | | |
819 | | construct_interval_closure(1,Size,Domain), |
820 | | total_function_wf(FF,Domain,Range,_WF) |
821 | | % we could also call total_function 1..Size --> _RangeType; would setup domain ? |
822 | | :- block check_indexes(-,?). |
823 | | check_indexes([],_) :- !. |
824 | | check_indexes([(int(X),_)|T],Size) :- !, |
825 | | less_than_equal_direct(X,Size), check_indexes(T,Size). |
826 | | check_indexes(_,_). |
827 | | */ |
828 | | size_of_sequence1(Seq,Size,_WF) :- Size==0,!, empty_sequence(Seq). |
829 | | size_of_sequence1(Seq,Size,WF) :- % print_term_summary(size1(Seq,Size)), |
830 | | expand_custom_set_to_list_wf(Seq,ESeq,_,size_of_sequence1,WF), % print_term_summary(size1(Seq,ESeq,Size)), |
831 | | (var(ESeq),nonvar(Size) -> size_of_var_seq(ESeqR,0,Size), |
832 | | ESeqR=ESeq % unify after to do propagation in one go, without triggering coroutines inbetween |
833 | | ; size_of_seq2(ESeq,0,Size), |
834 | | (var(Size),var(ESeq) -> less_than_equal_direct(0,Size) % propagate that Size is positive |
835 | | ; true) |
836 | | ). |
837 | | /* small danger of expanding closure while still var !*/ |
838 | | :- block size_of_seq2(-,?,-). |
839 | | size_of_seq2([],Size,Size). |
840 | | size_of_seq2([I|Tail],SizeSoFar,Res) :- |
841 | | S2 is SizeSoFar + 1, |
842 | | check_index(I,Res), % don't instantiate I yet; allow other kernel_predicates to freely instantiate it |
843 | | less_than_equal_direct(S2,Res), |
844 | | %(ground(Res) -> safe_less_than_equal(size_of_seq2,S2,Res) ; true), |
845 | | size_of_seq2(Tail,S2,Res). |
846 | | size_of_var_seq([],Size,Size). |
847 | | size_of_var_seq([(int(S2),_)|Tail],SizeSoFar,Res) :- |
848 | | S2 is SizeSoFar + 1,safe_less_than_equal(size_of_var_seq,S2,Res), |
849 | | (var(Tail) -> size_of_var_seq(Tail,S2,Res) ; size_of_seq2(Tail,S2,Res)). |
850 | | |
851 | | |
852 | | :- block check_index(-,?). |
853 | | check_index((I,_),Res) :- check_index1(I,Res). |
854 | | :- block check_index1(-,?). |
855 | | check_index1(int(Idx),Res) :- less_than_equal_direct(Idx,Res). |
856 | | |
857 | | :- 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)). |
858 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[],[(int(1),int(33))],WF),WF)). |
859 | | :- 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)). |
860 | | :- 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)). |
861 | | :- assert_must_succeed((bsets_clp:prepend_sequence(int(7),[],[(int(1),int(7))],_WF))). |
862 | | :- assert_must_succeed((bsets_clp:prepend_sequence(int(7),X,R,_WF), |
863 | | X = [(int(2),int(4)),(int(1),int(3))], |
864 | | kernel_objects:equal_object(R,[(int(1),int(7)),(int(2),int(3)),(int(3),int(4))]))). |
865 | | :- block prepend_sequence(?,-,-,?). |
866 | | prepend_sequence(El,Seq,Res,_WF) :- Seq==[],!, |
867 | | equal_object_optimized([(int(1),El)],Res,prepend_sequence). |
868 | | prepend_sequence(El,Seq,Res,WF) :- nonvar(Seq),is_custom_explicit_set(Seq,prepend_sequence), |
869 | | prepend_custom_explicit_set(Seq,El,ERes),!, %print(prepend(Seq,El)),nl, |
870 | | equal_object_wf(Res,ERes,prepend_sequence,WF). |
871 | | prepend_sequence(El,Seq,Res,WF) :- %print_message(prepend_sequence(El,Seq,Res)), |
872 | | equal_cons_wf(Res,(int(1),El),ShiftSeq,WF), |
873 | | shift_seq_indexes(Seq,1,ShiftSeq,WF). |
874 | | % print_message(prepend_result(El,Res)). |
875 | | |
876 | | :- block shift_seq_indexes(-,-,?,?),shift_seq_indexes(-,?,-,?). |
877 | | shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- |
878 | | Offset == 0,!, equal_sequence(Seq,ShiftedSeq,WF). |
879 | | shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- nonvar(Seq),!, |
880 | | expand_custom_set_to_list_wf(Seq,ESeq,_,shift_seq_indexes,WF), |
881 | | shift_seq_indexes2(ESeq,Offset,ShiftedSeq,WF,Done), |
882 | | (Done == done |
883 | | -> true |
884 | | ; % also propagate in the other way: TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR |
885 | | NegOffset is -Offset, |
886 | | expand_custom_set_to_list_wf(ShiftedSeq,ESeq1,_,shift_seq_indexes,WF), |
887 | | shift_seq_indexes2(ESeq1,NegOffset,ESeq,WF,_)). |
888 | | shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- NegOffset is -Offset, |
889 | | % compute in the other direction; TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR |
890 | | expand_custom_set_to_list_wf(ShiftedSeq,ESeq,_,shift_seq_indexes,WF), |
891 | | shift_seq_indexes2(ESeq,NegOffset,Seq,WF,Done), |
892 | | (Done == done |
893 | | -> true |
894 | | ; % also propagate in the original way: |
895 | | expand_custom_set_to_list_wf(Seq,ESeq1,_,shift_seq_indexes,WF), |
896 | | shift_seq_indexes2(ESeq1,Offset,ESeq,WF,_)). |
897 | | |
898 | | :- block shift_seq_indexes2(-,?,?,?,?). |
899 | | shift_seq_indexes2([],_,R,WF,Done) :- !, Done = done, empty_set_wf(R,WF). |
900 | | shift_seq_indexes2([Pair|Tail],Offset,Res,WF,Done) :- !, |
901 | | Pair = (int(N),El), |
902 | | equal_cons_wf(Res,(int(NewN),El),ShiftTail,WF), |
903 | | int_plus(int(N),int(Offset),int(NewN)), |
904 | | shift_seq_indexes2(Tail,Offset,ShiftTail,WF,Done). |
905 | | shift_seq_indexes2(Seq,Offset,Res,WF,Done) :- |
906 | | add_internal_error('Unexpected set argument: ',shift_seq_indexes2(Seq,Offset,Res,WF,Done)), fail. |
907 | | |
908 | | :- 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)). |
909 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([],int(33),[(int(1),int(33))],WF),WF)). |
910 | | :- 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)). |
911 | | :- 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)). |
912 | | :- assert_must_succeed((bsets_clp:append_sequence([],int(7),[(int(1),int(7))],_WF))). |
913 | | :- assert_must_succeed((bsets_clp:append_sequence(X,int(7),R,_WF), |
914 | | X = [(int(2),int(4)),(int(1),int(3))], |
915 | | kernel_objects:equal_object(R,[(int(1),int(3)),(int(2),int(4)),(int(3),int(7))]))). |
916 | | |
917 | | :- block append_sequence(-,?,-,?). |
918 | | append_sequence(Seq,El,Res,_WF) :- Seq==[],!, |
919 | | equal_object_optimized([(int(1),El)],Res,append_sequence). |
920 | | append_sequence(Seq,El,Res,WF) :- %print_term_summary(append_sequence(Seq,El,Res)), |
921 | | nonvar(Seq),is_custom_explicit_set_nonvar(Seq), |
922 | | append_custom_explicit_set(Seq,El,ERes,WF),!, |
923 | | equal_sequence(Res,ERes,WF). |
924 | | append_sequence(Seq,El,Res,WF) :- equal_cons_wf(Res,(int(NewSize),El),ResT,WF), |
925 | | append_sequence2(Seq,ResT,NewSize,WF). |
926 | | |
927 | | :- block append_sequence2(-,?,?,?). |
928 | | append_sequence2(Seq,ResT,NewSize,WF) :- |
929 | | try_expand_custom_set(Seq,ESeq), equal_sequence(ESeq,ResT,WF), |
930 | | size_of_sequence(ESeq,Size,WF), |
931 | | int_plus(Size,int(1),int(NewSize)). |
932 | | |
933 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:prefix_sequence([(int(1),int(22))],int(1),[(int(1),int(22))]))). |
934 | | :- 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))]))). |
935 | | :- 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))]))). |
936 | | :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),X),X = [(int(1),int(1))])). |
937 | | :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(0),[]),X = [(int(1),int(1))])). |
938 | | :- assert_must_abort_wf((bsets_clp:prefix_sequence_wf(X,int(-1),_R,WF),X = [(int(1),int(1))]),WF). |
939 | | :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(2),Y), |
940 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
941 | | kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(3))]) )). |
942 | | :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),Y), |
943 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
944 | | kernel_objects:equal_object(Y,[(int(1),int(1))]) )). |
945 | | :- assert_must_succeed((bsets_clp:prefix_sequence(X,int(3),Y), |
946 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
947 | | kernel_objects:equal_object(Y,X) )). |
948 | | |
949 | | prefix_sequence(Seq,N,R) :- init_wait_flags(WF), |
950 | | prefix_sequence_wf(Seq,N,R,WF), |
951 | | ground_wait_flags(WF). |
952 | | |
953 | | % Prefix of a sequence (s /|\ n) |
954 | | prefix_sequence_wf(Seq,int(Num),Res,WF) :- |
955 | | prefix_sequence1(Seq,Num,Res,WF), |
956 | | propagate_size(Res,Num,WF). |
957 | | |
958 | | :- block propagate_size(-,-,?). |
959 | | propagate_size(Res,Num,WF) :- %print(prop(Res,Num,WF)),nl, |
960 | | var(Res),!, %print(setup_sequence(Num)),nl, |
961 | | (Num<0 -> preferences:preference(disprover_mode,false) % don't do anything; we may want to generate WD error |
962 | | ; size_of_sequence(Res,int(Num),WF)). |
963 | | propagate_size(_,Num,_) :- number(Num), !. % no need to propagate |
964 | | propagate_size(_,_Num,_) :- \+ preferences:preference(find_abort_values,false), |
965 | | !. % do not propagate as we could prevent detection of WD errors below |
966 | | propagate_size([],Num,_WF) :- !, |
967 | | Num=0. % Note: this could prevent a wd-error being detected |
968 | | propagate_size(avl_set(A),Num,WF) :- var(Num), |
969 | | % with partially instantated sets we get slowdowns (SimpleCSGGrammar2_SlowCLPFD) |
970 | | % TO DO: treat list skeletons |
971 | | !, |
972 | | size_of_sequence(avl_set(A),int(Num),WF). % Note: this could prevent a wd-error being detected |
973 | | propagate_size(_,_,_). % should we also propagate the other way around ? |
974 | | |
975 | | :- block prefix_sequence1(-,?,?,?), prefix_sequence1(?,-,?,?). |
976 | | prefix_sequence1(_Seq,Num,Res,WF) :- Num==0,!, empty_set_wf(Res,WF). |
977 | | 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) |
978 | | add_wd_error('negative index in prefix_sequence (/|\\)! ', Num,WF). |
979 | | prefix_sequence1(Seq,Num,Res,WF) :- |
980 | | is_custom_explicit_set(Seq,prefix), |
981 | | prefix_of_custom_explicit_set(Seq,Num,ERes,WF),!, % TO DO: check Num <= size(Seq) |
982 | | equal_object_wf(Res,ERes,prefix_sequence1,WF). |
983 | | prefix_sequence1(Seq,Num,Res,WF) :- |
984 | | expand_custom_set_to_list_wf(Seq,ESeq,_,prefix_sequence1,WF), |
985 | | unify_same_index_elements(Res,ESeq,WF), |
986 | | unify_same_index_elements(Seq,Res,WF), |
987 | | prefix_seq(ESeq,Num,0,Res,WF). %,print(prefix_seq_exit(ESeq,Num,0,Res)),nl |
988 | | :- block prefix_seq(-,?,?,?,?). |
989 | | prefix_seq([],Max,Sze,Res,WF) :- |
990 | | (less_than_direct(Sze,Max) |
991 | | -> add_wd_error('index larger than size of sequence in prefix_sequence (/|\\)! ', (Max,Sze),WF) |
992 | | ; true), |
993 | | empty_set_wf(Res,WF). |
994 | | %(less_than(int(_Sze),int(_Max)) |
995 | | % -> (print_message('Index bigger than sequence size in prefix_sequence (/|\\) !'), |
996 | | % print_message(Max)) |
997 | | % /* in the AtelierB book this is allowed, in Wordsworth + AMN on web it is not ?? */ |
998 | | % ; true). |
999 | | prefix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :- |
1000 | | prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF). |
1001 | | :- block prefix_seq2(-,?,?,?,?,?,?). |
1002 | | prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :- % SizeSoFar is always ground |
1003 | | (less_than_equal_direct(N,Max), equal_cons_wf(Res,(int(N),El),PTail,WF) |
1004 | | ; |
1005 | | less_than_direct(Max,N), equal_object_wf(Res,PTail,prefix_seq2,WF) |
1006 | | ), |
1007 | | ( SizeSoFar<N -> NewSizeSoFar=N ; NewSizeSoFar = SizeSoFar ), |
1008 | | prefix_seq(Tail,Max,NewSizeSoFar,PTail,WF). |
1009 | | |
1010 | | :- 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))). |
1011 | | :- 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))). |
1012 | | :- 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))). |
1013 | | :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(0),X,_WF),X = [(int(1),int(1))])). |
1014 | | :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),[],_WF),X = [(int(1),int(1))])). |
1015 | | :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF), |
1016 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
1017 | | kernel_objects:equal_object(Y,[(int(1),int(4))]) )). |
1018 | | :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),Y,_WF), |
1019 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
1020 | | kernel_objects:equal_object(Y,[(int(1),int(3)),(int(2),int(4))]) )). |
1021 | | :- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF), |
1022 | | X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))], |
1023 | | kernel_objects:equal_object(Y,[(int(1),int(4))]) )). |
1024 | | :- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(-1),_R,WF),WF). |
1025 | | :- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(3),_R,WF),WF). |
1026 | | |
1027 | | % kernel_waitflags:assert_must_abort2_wf(bsets_clp:suffix_sequence([int(11),int(22)],int(-1),_R,WF),WF) |
1028 | | |
1029 | | % suffix of a sequence (s \|/ n); also called restrict at tail (Atelier B) or Drop |
1030 | | :- block suffix_sequence(-,?,?,?). |
1031 | | suffix_sequence(Seq,int(Num),Res,WF) :- % print(suffix_sequence(Seq)),nl, |
1032 | | suffix_sequence1(Seq,Num,Res,WF). |
1033 | | :- block suffix_sequence1(?,-,?,?). |
1034 | | suffix_sequence1(Seq,Num,Res,WF) :- Num==0, !, equal_object_wf(Res,Seq,suffix_sequence1_1,WF). |
1035 | | suffix_sequence1(_Seq,Num,_Res,WF) :- Num<0, !, add_wd_error('negative index in suffix_sequence (\\|/)! ', Num,WF). |
1036 | | suffix_sequence1(Seq,Num,Res,WF) :- is_custom_explicit_set(Seq,suffix), |
1037 | | suffix_of_custom_explicit_set(Seq,Num,ERes,WF),!, |
1038 | | equal_object_wf(Res,ERes,suffix_sequence1_2,WF). |
1039 | | suffix_sequence1(Seq,Num,Res,WF) :- |
1040 | | expand_custom_set_to_list_wf(Seq,ESeq,_,suffix_sequence,WF), suffix_seq(ESeq,Num,0,Res,WF). |
1041 | | :- block suffix_seq(-,?,?,?,?). |
1042 | | suffix_seq([],Max,Sze,Res,WF) :- |
1043 | | (less_than_direct(Sze,Max) |
1044 | | -> add_wd_error('index larger than size of sequence in suffix_sequence (\\|/)! ', '>'(Max,Sze),WF) |
1045 | | ; true), empty_set_wf(Res,WF). |
1046 | | suffix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :- |
1047 | | suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF). |
1048 | | :- block suffix_seq2(-,?,?,?,?,?,?). |
1049 | | suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :- |
1050 | | (less_than_equal_direct(N,Max), equal_object_wf(Res,PTail,suffix_seq2,WF) |
1051 | | ; |
1052 | | less_than_direct(Max,N),int_minus(int(N),int(Max),int(NN)), |
1053 | | equal_cons_wf(Res,(int(NN),El),PTail,WF) |
1054 | | ), |
1055 | | (N>SizeSoFar -> (NewSizeSoFar=N) |
1056 | | ; (NewSizeSoFar = SizeSoFar)), |
1057 | | suffix_seq(Tail,Max,NewSizeSoFar,PTail,WF). |
1058 | | |
1059 | | |
1060 | | |
1061 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([],[(int(1),int(33))],[(int(1),int(33))],WF),WF)). |
1062 | | :- 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 |
1063 | | :- 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)). |
1064 | | :- 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)). |
1065 | | :- assert_must_succeed((bsets_clp:concat_sequence([],X,Y,_WF), |
1066 | | X = [(int(1),int(1))], Y==X)). |
1067 | | :- assert_must_succeed((bsets_clp:concat_sequence(X,[],Y,_WF), X = [(int(1),int(1))], Y==X)). |
1068 | | :- assert_must_succeed((bsets_clp:concat_sequence([(int(1),int(1))],[],Y,_WF), Y==[(int(1),int(1))])). |
1069 | | :- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF), |
1070 | | X = [(int(1),int(1))], kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(1))]))). |
1071 | | :- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF), |
1072 | | X = [(int(2),int(88)),(int(1),int(77))], |
1073 | | kernel_objects:equal_object(Y,[(int(1),int(77)),(int(2),int(88)),(int(3),int(77)),(int(4),int(88))]))). |
1074 | | |
1075 | | :- block /* concat_sequence(-,-,?,?), */ |
1076 | | concat_sequence(?,-,-,?), concat_sequence(-,?,-,?). |
1077 | | concat_sequence(S1,S2,Res,WF) :- Res==[],!, empty_set_wf(S1,WF), empty_set_wf(S2,WF). |
1078 | | concat_sequence(S1,S2,Res,WF) :- |
1079 | | (var(S1),var(S2) -> get_wait_flag(2,concat,WF,LWF) % we have at least two solutions; TODO maybe use cardinality as wait_flag? |
1080 | | ; LWF=1), |
1081 | | concat_sequence2(LWF,S1,S2,Res,WF). |
1082 | | |
1083 | | :- block concat_sequence2(-,?,-,?,?), concat_sequence2(-,-,?,?,?). |
1084 | | concat_sequence2(_,S1,S2,Res,WF) :- S1==[],!,equal_sequence(S2,Res,WF). |
1085 | | concat_sequence2(_,S1,S2,Res,WF) :- S2==[],!,equal_sequence(S1,Res,WF). |
1086 | | concat_sequence2(LWF,S1,S2,Res,WF) :- |
1087 | | try_expand_and_convert_to_avl_with_check(S1,AS1,concat1), |
1088 | | try_expand_and_convert_to_avl_with_check(S2,AS2,concat2), |
1089 | | concat_sequence3(LWF,AS1,AS2,Res,WF). |
1090 | | |
1091 | | concat_sequence3(_,S1,S2,Res,WF) :- nonvar(S1),is_custom_explicit_set(S1,concat_sequence), |
1092 | | concat_custom_explicit_set(S1,S2,ERes,WF),!, |
1093 | | %print_term_summary(concat(S1,S2,ERes)),nl, |
1094 | | equal_sequence(Res,ERes,WF). |
1095 | | concat_sequence3(_LWF,S1,S2,Res,WF) :- |
1096 | | % print_term_summary(ordinary_concat_sequence(_LWF,S1,S2,Res)), |
1097 | | %try_expand_custom_set(S1,ES1), |
1098 | | size_of_sequence(S1,int(Size1),WF), |
1099 | | (number(Size1) -> true |
1100 | | ; size_of_sequence(S2,Size2,WF), |
1101 | | size_of_sequence(Res,SizeRes,WF), |
1102 | | int_minus(SizeRes,Size2,int(Size1)), |
1103 | | in_nat_range_wf(int(Size1),int(0),SizeRes,WF) |
1104 | | % is this required: ?? ,in_nat_range_wf(Size2,int(0),SizeRes,WF) |
1105 | | ), |
1106 | | %print(call_concat_sequence_aux(Size1,S1,S2,Res,WF)),nl, |
1107 | | concat_sequence_aux(Size1,S1,S2,Res,WF). |
1108 | | |
1109 | | |
1110 | | :- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T1],[(int(1),int(22))|T2],_WF), |
1111 | | A==int(22),T2=[],T1==[] )) . |
1112 | | :- 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), |
1113 | | A==string(c), T = [(int(2),B)|T2], B==string(a), T2=[(int(3),C)], C==string(b)) ). |
1114 | | % equal_object optimized for sequences; can infer that pairs with same index have same value |
1115 | | % TO DO: complete and make more efficient |
1116 | | %equal_sequence(X,Y,_WF) :- nonvar(X),nonvar(Y), |
1117 | | % is_custom_explicit_set(X,eval_sequence), is_custom_explicit_set(Y,eval_sequence),!, |
1118 | | % equal_explicit_sets(X,Y). |
1119 | | equal_sequence(X,Y,WF) :- nonvar(X),nonvar(Y), |
1120 | | get_seq_head(X,XI,XEl,XT), get_seq_head(Y,YI,YEl,YT), XI==YI,!, |
1121 | | % THIS CURRENTLY ONLY CHECKS FRONTMOST indexes |
1122 | | %print(eq_seq(XI,XEl,YI,YEl,XT,YT)),nl, |
1123 | | equal_object_wf(XEl,YEl,equal_sequence_1,WF), %print(done(XEl,YEl)),nl, |
1124 | | equal_sequence(XT,YT,WF). |
1125 | | equal_sequence(X,Y,WF) :- |
1126 | | %print(equal_sequence(X,Y)),nl, |
1127 | | /* (is_custom_explicit_set(Y) -> monitor_equal_sequence_againts_custom_set(X,Y,WF) |
1128 | | ; is_custom_explicit_set(X) -> monitor_equal_sequence_againts_custom_set(Y,X,WF) |
1129 | | ; true), does not seem to buy anything; equal_object already powerful enough */ |
1130 | | equal_object_wf(X,Y,equal_sequence_2,WF). |
1131 | | |
1132 | | % enforces the constraint that there is only one possible elemenent per index: |
1133 | | %:- block monitor_equal_sequence_againts_custom_set(-,?,?). |
1134 | | %monitor_equal_sequence_againts_custom_set([],_,_) :- !. |
1135 | | %monitor_equal_sequence_againts_custom_set([El|T],CS,WF) :- !, |
1136 | | % element_of_custom_set_wf(El,CS,WF), |
1137 | | % monitor_equal_sequence_againts_custom_set(T,CS,WF). |
1138 | | %monitor_equal_sequence_againts_custom_set(_,_,_). |
1139 | | |
1140 | | get_seq_head([(Idx,El)|Tail],Idx,El,Tail). |
1141 | | %get_seq_head(avl_set(AVL),Idx,El,Tail) :- does not seem to buy anything; equal_object already powerful enough |
1142 | | % custom_explicit_sets:avl_min_pair(AVL,Idx,El), |
1143 | | % custom_explicit_sets:direct_remove_element_from_avl(AVL,(Idx,El),Tail). % TO DO: only compute if indexes == |
1144 | | |
1145 | | |
1146 | | :- block concat_sequence_aux(-,?,?,?,?). |
1147 | | concat_sequence_aux(Size1,_S1,_S2,Res,WF) :- nonvar(Res),Res=avl_set(_), |
1148 | | size_of_custom_explicit_set(Res,int(RSize),WF), number(RSize), |
1149 | | Size1 > RSize,!, % S1 is longer than Res; no solution (prevent WD error below) |
1150 | | fail. |
1151 | | concat_sequence_aux(Size1,S1,S2,Res,WF) :- nonvar(Res),Res=avl_set(_), |
1152 | | % split Result into prefix and suffix |
1153 | | prefix_of_custom_explicit_set(Res,Size1,Prefix,WF), % we could call versions which do not check WD |
1154 | | suffix_of_custom_explicit_set(Res,Size1,Postfix,WF), |
1155 | | %print(split_avl_set(Size1,S1,S2,Res,Prefix,Postfix,WF)),nl, |
1156 | | !, |
1157 | | equal_sequence(S1,Prefix,WF), equal_sequence(S2,Postfix,WF). |
1158 | | concat_sequence_aux(Size1,S1,S2,Res,WF) :- |
1159 | | % print(concat_size1(S1,Size1)),nl, |
1160 | | shift_seq_indexes(S2,Size1,NewS2,WF), %% print(shifted(S2,Size1,NewS2)),nl, |
1161 | | % We can do something stronger than disjoint union: we know that the indexes are disjoint! |
1162 | | % Hence: if (int(X),Y) : Res & (int(X),Z) : S1 => Y=Z |
1163 | | % Hence: if (int(X),Y) : Res & (int(X),Z) : S2 => Y=Z |
1164 | | unify_same_index_elements(S1,Res,WF), |
1165 | | unify_same_index_elements(Res,S1,WF), |
1166 | | unify_same_index_elements(NewS2,Res,WF), |
1167 | | unify_same_index_elements(Res,NewS2,WF), |
1168 | | disjoint_union_wf(S1,NewS2,Res,WF). % , print(disj_res(S1,NewS2,Res)),nl. |
1169 | | |
1170 | | % Check if (int(X),Y) pairs in Seq2 have a matching (int(X),Z) in Seq1 and then unify(Y,Z) |
1171 | | :- block unify_same_index_elements(-,?,?). |
1172 | | unify_same_index_elements(avl_set(A),Seq,WF) :- !, % print(check_seq(Seq,A)),nl, |
1173 | | unify_same_index_elements_aux(Seq,A,WF). |
1174 | | unify_same_index_elements(_,_,_). % TO DO: maybe also support other partially instantiated lists |
1175 | | |
1176 | | :- block unify_same_index_elements_aux(-,?,?). |
1177 | | unify_same_index_elements_aux([],_,_) :- !. |
1178 | | unify_same_index_elements_aux([(int(Idx),El)|T],A,WF) :- !, |
1179 | | try_find_index_element(Idx,El,A,WF), |
1180 | | unify_same_index_elements_aux(T,A,WF). |
1181 | | unify_same_index_elements_aux(_,_,_). |
1182 | | |
1183 | | :- block try_find_index_element(-,?,?,?). |
1184 | | try_find_index_element(Idx,El,AVL,WF) :- |
1185 | | avl_fetch_pair(int(Idx),AVL,AvlEl), |
1186 | | % print(fetch(Idx,AvlEl)),nl, |
1187 | | !, |
1188 | | % We have found an entry with the same index: El and AvlEl must be identical: |
1189 | | equal_object_wf(El,AvlEl,try_find_index_element,WF). |
1190 | | try_find_index_element(_Idx,_El,_AVL,_WF). % :- print(not_found(_Idx,_AVL)),nl. |
1191 | | |
1192 | | % TO DO: add waitflags + use within partition_wf |
1193 | | % 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 |
1194 | | |
1195 | | :- 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)). |
1196 | | :- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([],[int(2),int(1)],[int(1),int(2)],WF),WF)). |
1197 | | :- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(1),int(2)],[],[int(2),int(1)],WF),WF)). |
1198 | | :- assert_must_succeed((bsets_clp:disjoint_union_wf([int(1)],[int(2)],Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]))). |
1199 | | :- assert_must_succeed((bsets_clp:disjoint_union_wf(A,B,[int(1)],_WF),B=[H],H==int(1),A==[])). |
1200 | | |
1201 | | disjoint_union_wf(Set1,Set2,Res,WF) :- |
1202 | | (var(Res) |
1203 | | -> disjoint_union_wf0(Set1,Set2,DRes,DRes,WF), equal_object_optimized(Res,DRes) % try and convert result to AVL |
1204 | | ; disjoint_union_wf0(Set1,Set2,Res,Res,WF)). |
1205 | | |
1206 | | % disjoint_union_wf0(Set1,Set2,UnionOfSet1Set2, SuperSet, WF) |
1207 | | :- block disjoint_union_wf0(-,-,-,?,?). |
1208 | | disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union_wf0_1,WF). |
1209 | | disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union_wf0_2,WF). |
1210 | | disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Res==[],!,empty_set_wf(Set1,WF), empty_set_wf(Set2,WF). |
1211 | | disjoint_union_wf0(Set1,Set2,Res,FullRes,WF) :- |
1212 | ? | ((nonvar(Set1);nonvar(Set2)) -> true ; get_cardinality_powset_wait_flag(Res,disjoint_union_wf0,WF,_Card,CWF)), |
1213 | | disjoint_union0(Set1,Set2,Res,FullRes,WF,CWF). |
1214 | | |
1215 | | :- block disjoint_union0(-,-,?,?,?,-), disjoint_union0(-,?,-,-,?,?), disjoint_union0(?,-,-,-,?,?). |
1216 | | disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union0_1,WF). |
1217 | | disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union0_2,WF). |
1218 | | disjoint_union0(S1,S2,Res,_F,WF,_CWF) :- % print(disjoint_union0(S1,S2,Res,_F)),nl, |
1219 | | ground_value(Res), |
1220 | | ( ground_value(S1) -> !, %print(diff(Res,S1,S2)),nl, |
1221 | | check_subset_of_wf(S1,Res,WF), % TO DO: check if we can merge the check_subset and difference set in one predicate |
1222 | | difference_set_wf(Res,S1,S2,WF) |
1223 | | ; ground_value(S2) -> !, %print(diff(Res,S2,S1)),nl, |
1224 | | check_subset_of_wf(S2,Res,WF), |
1225 | | difference_set_wf(Res,S2,S1,WF) |
1226 | | ; var(S1),var(S2) -> !, %print(disj_enum(Res,CWF)),nl, % CWF nonvar |
1227 | | % see test 1408; allows to generate subsets of Res and avoid enumeration warnings |
1228 | | check_subset_of_wf(S1,Res,WF), |
1229 | | %check_subset_of(S1,Res), % without waitflag: will generate ground version |
1230 | | difference_set_wf(Res,S1,S2,WF) |
1231 | | ). |
1232 | | disjoint_union0(Set1,Set2,Res,_,WF,_) :- nonvar(Set1), |
1233 | | is_custom_explicit_set_nonvar(Set1), |
1234 | | union_of_explicit_set(Set1,Set2,Union), !, |
1235 | | equal_object_wf(Union,Res,disjoint_union0_3,WF). |
1236 | | disjoint_union0(Set1,Set2,Res,Full,WF,_) :- expand_custom_set_to_list_wf(Set1,ESet1,_,disjoint_union0_1,WF), |
1237 | | expand_custom_set_to_list_wf(Set2,ESet2,_,disjoint_union0_2,WF), |
1238 | | %print(disjoint_union0(ESet1,ESet2,Res,WF)),nl, |
1239 | | disj_union1(ESet1,ESet2,Res,Full,WF). |
1240 | | |
1241 | | :- block disj_union1(-,-,?,?,?). |
1242 | | disj_union1(X,Y,Res,FullRes,WF) :- |
1243 | | var(X) -> disj_union2(Y,X,Res,FullRes,WF) ; disj_union2(X,Y,Res,FullRes,WF). |
1244 | | |
1245 | | disj_union2([],Y,Res,_,_WF) :- equal_object_optimized(Y,Res,disj_union2). |
1246 | | disj_union2([X|TX],Y,Res,FullRes,WF) :- |
1247 | | 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 |
1248 | | kernel_tools:ground_value_check(X,XV), |
1249 | | (nonvar(XV) -> equal_cons_wf(Res,X,TR,WF) |
1250 | | ; 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 = {} |
1251 | | when(nonvar(XV), equal_cons_wf(Res,X,TR,WF)) |
1252 | | ), % ensure that we instantiate Res if TR known; otherwise we may get pending co-routines, e.g. test 506, SyracuseGrammar |
1253 | | disj_union3(TX,Y,TR,FullRes,WF). |
1254 | | |
1255 | | :- block disj_union3(-,-,-,?,?). |
1256 | | disj_union3(X,Y,Res,_,WF) :- Res==[],!,empty_set_wf(X,WF),empty_set_wf(Y,WF). |
1257 | | disj_union3(X,Y,Res,FullRes,WF) :- disj_union1(X,Y,Res,FullRes,WF). |
1258 | | |
1259 | | |
1260 | | :- block disjoint_union_generalized_wf(-,?,?). |
1261 | | %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 |
1262 | | % equal_object(Set1,Res). |
1263 | | disjoint_union_generalized_wf(SetsOfSets,Res,WF) :- |
1264 | | expand_custom_set_to_list_wf(SetsOfSets,ESetsOfSets,_,disjoint_union_generalized_wf,WF), |
1265 | | disjoint_union_generalized2(ESetsOfSets,[],Res,WF). %, print(res(Res)),nl. |
1266 | | :- block disjoint_union_generalized2(-,?,?,?). |
1267 | | disjoint_union_generalized2([],S,Res,WF) :- equal_object_optimized_wf(S,Res,disjoint_union_generalized2,WF). |
1268 | | disjoint_union_generalized2([H|T],UnionSoFar,Res,WF) :- |
1269 | | disjoint_union_wf0(H,UnionSoFar,UnionSoFar2,Res,WF), |
1270 | | %% print_message(called_disjoint_union(H,UnionSoFar,UnionSoFar2)), %% |
1271 | | disjoint_union_generalized2(T,UnionSoFar2,Res,WF). |
1272 | | |
1273 | | % TO DO: if there are more than two sets: it may be interesting to set up constraint that |
1274 | | % each set is a subset of the full set; |
1275 | | % (would avoid enumeration warning in, e.g., x \/ y \/ z = 1..10 & x /\ y = {} & x /\ z = {} & y /\ z = {} & card(x)=card(y)+2 ) |
1276 | | |
1277 | | :- 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))])], |
1278 | | [(int(1),int(11)),(int(2),int(22)),(int(3),int(33))],_WF))). |
1279 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(33))])],[(int(1),int(33))],_WF))). |
1280 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(55))])],Res,WF), |
1281 | | kernel_waitflags:ground_wait_flags(WF), |
1282 | | kernel_objects:equal_object(Res,[(int(1),int(55))]) )). |
1283 | | :- 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), |
1284 | | kernel_waitflags:ground_wait_flags(WF), |
1285 | | kernel_objects:equal_object(Res,[(int(1),int(22)),(int(2),int(55))]) )). |
1286 | | :- block concatentation_of_sequences(-,?,?). |
1287 | | concatentation_of_sequences(SeqOfSeq,Res,WF) :- %print_message(conc(SeqOfSeq)), |
1288 | ? | try_expand_and_convert_to_avl_with_check(SeqOfSeq,ES,conc), |
1289 | ? | concs2(ES,Res,WF). |
1290 | | |
1291 | | concs2(SeqOfSeq,Res,WF) :- is_custom_explicit_set(SeqOfSeq,conc), |
1292 | | conc_custom_explicit_set(SeqOfSeq,CRes),!, |
1293 | | equal_object_wf(CRes,Res,concs2,WF). |
1294 | | concs2(SeqOfSeq,Res,WF) :- empty_set_wf(SeqOfSeq,WF),empty_set_wf(Res,WF). |
1295 | | concs2(SeqOfSeq,Res,WF) :- not_empty_set_wf(SeqOfSeq,WF), |
1296 | | front_sequence(SeqOfSeq,Front,WF), |
1297 | | concatentation_of_sequences(Front,FrontRes,WF), |
1298 | | last_sequence(SeqOfSeq,Last,WF), |
1299 | | concat_sequence(FrontRes,Last,Res,WF). |
1300 | | |
1301 | | :- assert_must_abort_wf(bsets_clp:tail_sequence([],_R,unknown,WF),WF). |
1302 | | :- assert_must_abort_wf(bsets_clp:tail_sequence([],[],unknown,WF),WF). |
1303 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( |
1304 | | bsets_clp:tail_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5))],unknown,_WF)) ). |
1305 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:tail_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))], |
1306 | | [(int(1),int(5)),(int(2),int(6))],unknown,_WF)) ). |
1307 | | :- assert_must_succeed((bsets_clp:tail_sequence(X,R,unknown,_), |
1308 | | X = [(int(1),int(6)),(int(2),int(5))], |
1309 | | kernel_objects:equal_object(R,[(int(1),int(5))]) )). |
1310 | | :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5))],unknown,_), |
1311 | | X = [(int(1),int(6)),(int(2),int(5))] )). |
1312 | | :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5)),(int(2),int(7))],unknown,_), |
1313 | | X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )). |
1314 | | :- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(2),int(7)),(int(1),int(5))],unknown,_), |
1315 | | X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )). |
1316 | | :- block tail_sequence(-,?,?,?). |
1317 | | tail_sequence(S1,Res,Span,WF) :- is_custom_explicit_set(S1,tail_sequence), |
1318 | | tail_sequence_custom_explicit_set(S1,TRes,Span,WF),!, |
1319 | | equal_object_wf(TRes,Res,tail_sequence,WF). |
1320 | | tail_sequence(S1,Res,Span,WF) :- expand_custom_set_to_list_wf(S1,ES1,_,tail_sequence,WF), |
1321 | | tail2(ES1,Res,Span,WF). |
1322 | | |
1323 | | tail2([],_,Span,WF) :- |
1324 | | add_wd_error_span('tail applied to empty sequence!',[],Span,WF). |
1325 | | tail2([H|T],Res,_Span,WF) :- domain_subtraction_wf([int(1)],[H|T],IntRes,WF), |
1326 | | shift_seq_indexes(IntRes,-1,Res,WF). |
1327 | | |
1328 | | |
1329 | | :- assert_must_abort_wf(bsets_clp:first_sequence([],_R,unknown,WF),WF). |
1330 | | :- assert_must_abort_wf(bsets_clp:first_sequence([],int(1),unknown,WF),WF). |
1331 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(2),int(5))],int(4),unknown,_WF)) ). |
1332 | | :- 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)) ). |
1333 | | :- assert_must_succeed((bsets_clp:first_sequence(X,R,unknown,_WF), |
1334 | | X = [(int(1),int(2)),(int(2),int(1))], |
1335 | | R = int(2))). |
1336 | | |
1337 | | :- block first_sequence(-,?,?,?). |
1338 | | %first_sequence(Seq,Res,Span,_) :- % print(first_seq(Seq,Res,Span)),nl,fail. |
1339 | | % is_custom_explicit_set(Seq,first_sequence), |
1340 | | % first_sequence_explicit_set(Seq,First), !, |
1341 | | % equal_object(First,Res). |
1342 | | first_sequence([],_,Span,WF) :- !,add_wd_error_span('first applied to empty sequence!',[],Span,WF). |
1343 | | first_sequence(Seq,Res,Span,WF) :- apply_to(Seq,int(1),Res,Span,WF). |
1344 | | |
1345 | | |
1346 | | |
1347 | | :- assert_must_abort_wf(bsets_clp:front_sequence([],_R,WF),WF). |
1348 | | :- assert_must_abort_wf(bsets_clp:front_sequence([],[],WF),WF). |
1349 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(4))],_WF)) ). |
1350 | | :- 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)) ). |
1351 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF), |
1352 | | X = [(int(1),int(2)),(int(2),int(55))],kernel_waitflags:ground_wait_flags(WF), |
1353 | | kernel_objects:equal_object(R,[(int(1),int(2))]))). |
1354 | | :- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF), |
1355 | | X = [(int(3),int(33))|R], kernel_waitflags:ground_wait_flags(WF), |
1356 | | print(R),nl, |
1357 | | kernel_objects:equal_object(R,[(int(1),int(2)),(int(2),int(55))]) )). |
1358 | | |
1359 | | front_sequence(Seq,Res,WF) :- front_sequence(Seq,Res,unknown,WF). |
1360 | | :- block front_sequence(-,?,?,?). |
1361 | | front_sequence(S1,Res,_Span,WF) :- |
1362 | | is_custom_explicit_set(S1,front_sequence), |
1363 | | front_sequence_custom_explicit_set(S1,FRes),!, |
1364 | | equal_object_wf(FRes,Res,front_sequence,WF). |
1365 | | front_sequence(Seq,Res,Span,WF) :- expand_custom_set_to_list_wf(Seq,ESeq,_,front_sequence,WF), |
1366 | | front2(ESeq,Res,Span,WF). |
1367 | | front2([],_,Span,WF) :- add_wd_error_span('front applied to empty sequence!',[],Span,WF). |
1368 | | front2([H|T],Res,_Span,WF) :- size_of_sequence([H|T],int(Size),WF), |
1369 | | (number(Size) -> true ; size_of_sequence(Res,SizeRes,WF), int_plus(SizeRes,int(1),int(Size))), |
1370 | | when(ground(Size), domain_subtraction_wf([int(Size)],[H|T],Res,WF)). |
1371 | | |
1372 | | |
1373 | | :- assert_must_abort_wf(bsets_clp:last_sequence([],_R,WF),WF). |
1374 | | :- assert_must_abort_wf(bsets_clp:last_sequence([],int(1),WF),WF). |
1375 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(2),int(5))],int(5),_WF)) ). |
1376 | | :- 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)) ). |
1377 | | :- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF), |
1378 | | X = [(int(1),int(2)),(int(2),int(55))],R = int(55))). |
1379 | | :- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF), X = [(int(1),int(55))], R = int(55))). |
1380 | | :- 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))])). |
1381 | | |
1382 | | last_sequence(Seq,Res,WF) :- last_sequence(Seq,Res,unknown,WF). |
1383 | | :- block last_sequence(-,?,?,?). |
1384 | | last_sequence(Seq,Res,_Span,WF) :- %print(last_sequence(Seq,Res,_)),nl, |
1385 | | is_custom_explicit_set(Seq,last_sequence), |
1386 | | last_sequence_explicit_set(Seq,Last), !, %print(last(Last)),nl, |
1387 | | equal_object_wf(Last,Res,last_sequence,WF). |
1388 | | last_sequence([],_,Span,WF) :- !,add_wd_error_span('last applied to empty sequence!',[],Span,WF). |
1389 | | last_sequence(Seq,Res,Span,WF) :- |
1390 | | size_of_sequence(Seq,int(Size),WF), |
1391 | | last_sequence_aux(Size,Seq,Res,Span,WF). |
1392 | | :- block last_sequence_aux(-,?,?,?,?). |
1393 | | last_sequence_aux(Size,Seq,Res,Span,WF) :- |
1394 | | apply_to(Seq,int(Size),Res,Span,WF). |
1395 | | /* |
1396 | | :- block last_seq(-, ?,?,?,?, ?,?). |
1397 | | last_seq([],LastIdx,LastVal,SizeSoFar,LastResult, Span,WF) :- |
1398 | | (LastIdx=SizeSoFar -> LastResult = LastVal ; |
1399 | | add_wd_error_span('last applied to invalid sequence (biggest index different from size): ',LastIdx/SizeSoFar,Span,WF), |
1400 | | LastResult=LastVal). |
1401 | | last_seq([(ICurIdx,CurVal)|T],LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :- |
1402 | | last_seq2(ICurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF). |
1403 | | :- block last_seq2(-,?,?, ?,?,?,?, ?,?). |
1404 | | last_seq2(int(CurIdx),CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :- |
1405 | | last_seq3(CurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF). |
1406 | | :- block last_seq3(-,?,?, ?,?,?,?, ?,?). |
1407 | | last_seq3(CurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :- |
1408 | | S1 is SizeSoFar+1, |
1409 | | (CurIdx>LastIdx -> last_seq(T,CurIdx,CurVal,S1,LastResult,Span,WF) |
1410 | | ; last_seq(T,LastIdx,LastVal,S1,LastResult,Span,WF)). |
1411 | | */ |
1412 | | |
1413 | | |
1414 | | :- 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 )). |
1415 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4))],[(int(1),int(4))],WF),WF )). |
1416 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([],[],WF),WF )). |
1417 | | :- 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 )). |
1418 | | :- assert_must_succeed((bsets_clp:rev_sequence([],[],_WF))). |
1419 | | :- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF), |
1420 | | X = [(int(1),int(2)),(int(2),int(1))], |
1421 | | kernel_objects:equal_object(R,[(int(2),int(2)),(int(1),int(1))]) )). |
1422 | | :- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF), |
1423 | | X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))], |
1424 | | kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )). |
1425 | | :- assert_must_succeed((bsets_clp:rev_sequence(R,X,_WF), |
1426 | | X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))], |
1427 | | kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )). |
1428 | | :- assert_must_succeed((bsets_clp:rev_sequence(X,_R,_WF), |
1429 | | X = [(int(2),int(1)),(int(1),int(23)),(int(3),int(55))] )). |
1430 | | :- assert_must_succeed((bsets_clp:rev_sequence(_R,X,_WF), |
1431 | | X = [(int(3),int(55)),(int(1),int(23)),(int(2),int(1))] )). |
1432 | | |
1433 | | /* reverse of sequence */ |
1434 | | :- block rev_sequence(-,-,?). |
1435 | | rev_sequence(S1,Res,WF) :- |
1436 | | (nonvar(S1) -> rev_sequence2(S1,Res,WF) |
1437 | | ; rev_sequence2(Res,S1,WF)). |
1438 | | |
1439 | | rev_sequence2(S1,Res,WF) :- reverse_custom_explicit_set(S1,RS1),!, |
1440 | | equal_object_wf(Res,RS1,WF). |
1441 | | rev_sequence2(S1,Res,WF) :- |
1442 | | expand_custom_set_to_list_wf(S1,ES1,_,rev_sequence2,WF), |
1443 | | % print(rev(ES1)),nl, |
1444 | | size_of_sequence(ES1,int(Size1),WF), |
1445 | | rev_sequence3(ES1,Size1,Res,WF). |
1446 | | |
1447 | | :- block rev_sequence3(?,-,?,?). |
1448 | | rev_sequence3(E,S,R,WF) :- rev_sequence4(E,S,R,WF). |
1449 | | |
1450 | | :- block rev_sequence4(-,?,?,?). |
1451 | | rev_sequence4([],_,Res,WF) :- empty_set_wf(Res,WF). |
1452 | | rev_sequence4([(int(N),El)|Tail],Size1,Res,WF) :- |
1453 | | equal_cons_wf(Res,(NewN,El),RTail,WF), |
1454 | | % compute NewN = Size - (N-1) |
1455 | | int_minus(int(N),int(1),N1), |
1456 | | int_minus(int(Size1),N1,NewN), |
1457 | | %print(rev(N,Size1,NewN)),nl, |
1458 | | (ground(NewN) -> true ; in_nat_range(NewN,int(0),int(Size1))), |
1459 | | rev_sequence4(Tail,Size1,RTail,WF). |
1460 | | |
1461 | | |
1462 | | /* --------- */ |
1463 | | /* RELATIONS */ |
1464 | | /* --------- */ |
1465 | | |
1466 | | %maplet(X,Y,(X,Y)). |
1467 | | |
1468 | | % relation([]). |
1469 | | % relation([(_X,_Y)|T]) :- relation(T). |
1470 | | |
1471 | | :- 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)). |
1472 | | :- assert_must_succeed(exhaustive_kernel_check( bsets_clp:relation_over([],[int(1),int(2)],[int(2)]) )). |
1473 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2))],[int(1),int(2)],[int(2)]) )). |
1474 | | :- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([([int(1)],[int(2)])],[[int(1)],[],[int(2)]],[[int(2)]]) )). |
1475 | | :- 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 */]) )). |
1476 | | :- 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')]) )). |
1477 | | :- 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')]) )). |
1478 | | :- 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')]) )). |
1479 | | :- 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')]) )). |
1480 | | :- 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)]) )). |
1481 | | :- 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)]) )). |
1482 | | :- 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)]) )). |
1483 | | :- assert_must_fail(( bsets_clp:relation_over([(int(1),int(1))],[int(1),int(2)],[int(2)]) )). |
1484 | | :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]), |
1485 | | X==[(int(1),int(3))] )). |
1486 | | :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]), |
1487 | | X==[(int(1),int(3)),(int(2),int(3))] )). |
1488 | | :- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(4),int(5)]), |
1489 | | X==[(int(2),int(4)),(int(2),int(5))] )). |
1490 | | |
1491 | | relation_over(R,Dom,Ran) :- init_wait_flags(WF), |
1492 | | relation_over_wf(R,Dom,Ran,WF), |
1493 | | ground_wait_flags(WF). |
1494 | | |
1495 | | :- block relation_over_wf(-,-,-,?). |
1496 | | relation_over_wf(R,Dom,Ran,WF) :- |
1497 | | kernel_equality:get_cardinality_relation_over_wait_flag(Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels), |
1498 | | relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels). |
1499 | | |
1500 | | :- block relation_over1(-,?,?,?,-,?,?). |
1501 | | relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :- |
1502 | | nonvar(FF), |
1503 | ? | custom_explicit_sets:is_definitely_maximal_set(Range), |
1504 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
1505 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_),!, |
1506 | | check_subset_of_wf(FFDomain,Domain,WF). |
1507 | | relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :- nonvar(FF), |
1508 | | % print_term_summary(relation_over1(FF,Domain,Range,WF)), % |
1509 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_),!, |
1510 | | check_subset_of_wf(FFDomain,Domain,WF), |
1511 | | check_subset_of_wf(FFRange,Range,WF). |
1512 | | relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :- var(R),!, |
1513 | | expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF), |
1514 | | relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none). |
1515 | | relation_over1(R,Domain,Range,WF,_WFR,_MaxCard,_) :- |
1516 | | expand_and_convert_to_avl_set_warn(R,AER,relation_over1,'ARG : ? <-> ?'),!, |
1517 | | is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl, |
1518 | | is_avl_relation_over_range(AER,Range,WF). |
1519 | | relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :- |
1520 | ? | expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF), |
1521 | ? | relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none). |
1522 | | |
1523 | | expand_and_convert_to_avl_set_warn(R,AS,Origin,Operator) :- |
1524 | | observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS), |
1525 | | add_message(Origin,'Enumeration warning occured while expanding argument ARG for predicate ',Operator,R)). |
1526 | | %expand_and_convert_to_avl_set(R,AS,_,Operator,Values) :- |
1527 | | % observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS), |
1528 | | % display_warning_message(Operator,Values)). |
1529 | | %display_warning_message(Operator,Values) :- |
1530 | | % format(user_error,'Enumeration Warning for Operator ~w~n',[Operator]), |
1531 | | % maplist(translate:print_bvalue,Values),nl. |
1532 | | |
1533 | | :- block relation_over2(-,?,?,?,?,-,?,?,?). |
1534 | | relation_over2([],_,_,_,_WF,_WFR,_MaxCard,_MaxNrOfRels,_LastPair). |
1535 | | relation_over2(REL,SoFar,Domain,Range,WF,WFR,MaxCard,MaxNrOfRels,LastPair) :- |
1536 | ? | (var(REL) -> NewLastPair=(X,Y) ; NewLastPair=none), %remember whether we freely chose X,Y |
1537 | ? | REL = [(X,Y)|T], |
1538 | | % print(rel_over2(X,Y,T,sofar(SoFar),WFR,MaxCard,LastPair)),nl, |
1539 | ? | (number(MaxCard) |
1540 | | -> MaxCard>0,C1 is MaxCard-1 ,(C1=0 -> T=[] ; true) |
1541 | | ; C1=MaxCard), |
1542 | | % TO DO: try to enumerate elements in order |
1543 | ? | ordered_pair(LastPair,X,Y,not_equal), |
1544 | ? | check_element_of_wf(X,Domain,WF), |
1545 | ? | check_element_of_wf(Y,Range,WF), |
1546 | ? | not_element_of_wf((X,Y),SoFar,WF), |
1547 | | %print_bt_message(done_enum_relation_over2(X,Y,T,sofar(SoFar),MaxCard)),nl, |
1548 | ? | update_waitflag(MaxNrOfRels,WFR,NewWFR,WF), |
1549 | ? | relation_over2(T,[(X,Y)|SoFar],Domain,Range,WF,NewWFR,C1,MaxNrOfRels,NewLastPair). |
1550 | | |
1551 | | % check that new pair is greater than previous pair, if that pair was freely chosen |
1552 | | ordered_pair(none,_,_,_). |
1553 | | ordered_pair((LastX,LastY),NewX,NewY,Eq) :- ordered_value(LastX,NewX,EqualX), |
1554 | | check_second_component(EqualX,LastY,NewY,Eq). |
1555 | | |
1556 | | :- block check_second_component(-,?,?,?). |
1557 | | check_second_component(equal,X,Y,EqRes) :- ordered_value(X,Y,EqRes). |
1558 | | check_second_component(not_equal,_X,_Y,not_equal). % no need to check 2nd component |
1559 | | |
1560 | | :- block ordered_value(-,?,?), ordered_value(?,-,?). |
1561 | | ordered_value(pred_true /* bool_true */,B,Eq) :- !, (B=pred_true /* bool_true */ -> Eq=equal ; Eq=not_equal). |
1562 | | ordered_value(pred_false /* bool_false */,B,Eq) :- !, B=pred_false /* bool_false */, Eq=equal. |
1563 | | ordered_value(int(X),int(Y),Eq) :- !, |
1564 | | kernel_objects:less_than_equal_direct(X,Y), equal_atomic_term(X,Y,Eq). |
1565 | | ordered_value(fd(NrX,T),fd(NrY,T),Eq) :- !, |
1566 | | kernel_objects:less_than_equal_direct(NrX,NrY), equal_atomic_term(NrX,NrY,Eq). |
1567 | | ordered_value((X1,X2),(Y1,Y2),Eq) :- !, ordered_pair((X1,X2),Y1,Y2,Eq). |
1568 | | ordered_value(string(X),string(Y),Eq) :- !, less_equal_atomic_term(X,Y,Eq). |
1569 | | ordered_value(rec(FX),rec(FY),Eq) :- !, |
1570 | | ordered_fields(FX,FY,Eq). |
1571 | | ordered_value([],Y,Eq) :- !, (Y==[] -> Eq=equal ; Eq=not_equal). |
1572 | | ordered_value(avl_set(A),Y,Eq) :- !, |
1573 | | (Y==[] -> fail |
1574 | | ; Y=avl_set(B) -> (A @< B -> Eq=not_equal ; A@>B -> fail ; Eq=equal) |
1575 | | ; print(assuming_strictly_ordered(avl_set(A),Y)),nl, |
1576 | | Eq=not_equal). % TO DO: treat sets better |
1577 | | ordered_value([H|T],Y,Eq) :- !, |
1578 | | (Y==[] -> fail ; (Y==[H|T] -> Eq=equal |
1579 | | ; print(assuming_strictly_ordered([H|T],Y)),nl, |
1580 | | Eq=not_equal)). |
1581 | | ordered_value(A,B,not_equal) :- print(assuming_strictly_ordered(A,B)),nl. |
1582 | | |
1583 | | :- block ordered_fields(-,?,?). |
1584 | | ordered_fields([],RHS,Eq) :- !,RHS=[], Eq=equal. |
1585 | | ordered_fields([field(Name,ValX)|TX],RHS,Eq) :- !,RHS=[field(Name,ValY)|TY], |
1586 | | ordered_value(ValX,ValY,Equal1), check_next_field(Equal1,TX,TY,Eq). |
1587 | | ordered_fields(FX,FY,Eq) :- add_internal_error('Unknown fields: ',ordered_fields(FX,FY,Eq)), Eq=not_equal. |
1588 | | |
1589 | | :- block check_next_field(-,?,?,?). |
1590 | | check_next_field(equal,TX,TY,EqRes) :- ordered_fields(TX,TY,EqRes). |
1591 | | check_next_field(not_equal,_X,_Y,not_equal). % no need to check next field |
1592 | | |
1593 | | :- block less_equal_atomic_term(-,?,?), less_equal_atomic_term(?,-,?). |
1594 | | less_equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; A @<B, Res=not_equal). |
1595 | | |
1596 | | :- block equal_atomic_term(-,?,?), equal_atomic_term(?,-,?). |
1597 | | equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; Res=not_equal). |
1598 | | |
1599 | | |
1600 | | :- 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) )). |
1601 | | :- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2))],[],[int(2)],_WF) )). |
1602 | | :- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([(int(1),pred_true)],[int(1)],[pred_true],_WF) )). |
1603 | | :- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([],[int(1)],[pred_true],_WF) )). |
1604 | | :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(3)],[int(1),int(2)],_) ). |
1605 | | :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(1)],[int(3)],_) ). |
1606 | | :- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(3)),(int(1),int(2))],[int(1)],[int(3)],_) ). |
1607 | | :- assert_must_fail( bsets_clp:not_relation_over([(int(1),int(3))],[int(1)],[int(3)],_) ). |
1608 | | :- assert_must_fail( bsets_clp:not_relation_over([],[int(1)],[int(3)],_) ). |
1609 | | :- assert_must_fail( bsets_clp:not_relation_over([],[],[],_) ). |
1610 | | :- block not_relation_over(-,?,?,?). |
1611 | | |
1612 | | not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
1613 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
1614 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_),!, |
1615 | | % print_term_summary(not_relation_over(FF,FFDomain,Range)), |
1616 | | not_subset_of_wf(FFDomain,Domain,WF). |
1617 | | not_relation_over(FF,Domain,Range,WF) :- nonvar(FF), % print_term_summary(not_relation_over(FF,Domain,Range,WF)), % |
1618 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_),!, |
1619 | | %print_term_summary(check_special_not_pf(FF,FFDomain,FFRange)),nl, |
1620 | | not_both_subset_of(FFDomain,FFRange,Domain,Range,WF). |
1621 | | /* could be slightly more efficient: but not clear if warrants additional complexity in code: |
1622 | | not_relation_over(FF,Domain,Range,WF) :- nonvar(FF), |
1623 | | check_element_can_be_decided(Domain), % ensures that check_element_of_wf will not block below |
1624 | | check_element_can_be_decided(Range), % ensures that check_element_of_wf will not block below |
1625 | | expand_and_convert_to_avl_set(FF,AER),!, |
1626 | | (is_avl_relation_over_domain(AER,Domain,WF) |
1627 | | -> \+ is_avl_relation_over_range(AER,Range,WF) |
1628 | | ; true). |
1629 | | check_element_can_be_decided(X) :- var(X),!,fail. |
1630 | | check_element_can_be_decided(avl_set(_)). |
1631 | | check_element_can_be_decided([]). |
1632 | | check_element_can_be_decided(closure(P,T,B)) :- |
1633 | | custom_explicit_sets:is_interval_closure_or_integerset(closure(P,T,B),Low,Up), |
1634 | | ground(Low), ground(Up). |
1635 | | */ |
1636 | | not_relation_over(R,Dom,Ran,WF) :- |
1637 | | expand_custom_set_to_list_wf(R,ER,_,not_relation_over,WF), |
1638 | | %% print(not_rel(ER,Dom,Ran)),nl, |
1639 | | not_relation_over2(ER,Dom,Ran,WF). |
1640 | | |
1641 | | |
1642 | | %not_relation_over2(R,_,_) :- when(nonvar(R), (R\=[], R\=[_|_])) . % TYPE ERROR ! |
1643 | | :- block not_relation_over2(-,?,?,?). |
1644 | | not_relation_over2([(X,Y)|T],Domain,Range,WF) :- %print(not_rel2(X,Y,T)),nl, |
1645 | | membership_test_wf(Domain,X,MemRes,WF), |
1646 | | not_relation_over3(MemRes,Y,T,Domain,Range,WF). |
1647 | | |
1648 | | :- block not_relation_over3(-,?,?,?,?,?). |
1649 | | not_relation_over3(pred_false,_Y,_T,_Domain,_Range,_WF). |
1650 | | not_relation_over3(pred_true,Y,T,Domain,Range,WF) :- |
1651 | | membership_test_wf(Range,Y,MemRes,WF), |
1652 | | not_relation_over4(MemRes,T,Domain,Range,WF). |
1653 | | |
1654 | | :- block not_relation_over4(-,?,?,?,?). |
1655 | | not_relation_over4(pred_false,_T,_Domain,_Range,_WF). |
1656 | | not_relation_over4(pred_true,T,Domain,Range,WF) :- |
1657 | | not_relation_over2(T,Domain,Range,WF). |
1658 | | |
1659 | | |
1660 | | |
1661 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([],[],WF),WF)). |
1662 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([(int(1),int(3))],[int(1)],WF),WF)). |
1663 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf( |
1664 | | [(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(1),int(2),int(0)],WF),WF)). |
1665 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf( |
1666 | | [(int(99),int(55)),(int(2),int(3)),(int(99),int(4))],[int(2),int(99)],WF),WF)). |
1667 | | :- assert_must_succeed((bsets_clp:domain_wf([],Res,_WF),Res=[])). |
1668 | | :- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2))],Res,_WF), |
1669 | | kernel_objects:equal_object(Res,[int(1)]))). |
1670 | | :- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF), |
1671 | | kernel_objects:equal_object(Res,[int(1)]))). |
1672 | | :- assert_must_succeed((bsets_clp:domain_wf([(int(2),int(2)),(int(1),int(2))],Res,_WF), |
1673 | | kernel_objects:equal_object(Res,[int(1),int(2)]))). |
1674 | | :- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(3),int(2)]), |
1675 | | kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))). |
1676 | | :- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]), |
1677 | | kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(1),int(2))]))). |
1678 | | :- assert_must_fail((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]), |
1679 | | kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))). |
1680 | | |
1681 | | :- block domain_wf(-,-,?). |
1682 | | domain_wf(Rel,Res,WF) :- Res == [],!, |
1683 | | % print(empty_domain_res(Rel,Res)),nl, |
1684 | | empty_set_wf(Rel,WF). |
1685 | | domain_wf(Rel,Res,WF) :- var(Rel),!, % hence Res must me nonvar |
1686 | | (is_custom_explicit_set(Res,domain_wf) |
1687 | | -> expand_custom_set_to_list_wf(Res,Res2,_,propagate_result_to_input2,WF) % avoid expanding twice |
1688 | | ; Res2 = Res), |
1689 | | propagate_result_to_input(Res2,Rel,domain,WF), |
1690 | | domain_wf1(Rel,Res2,WF). |
1691 | ? | domain_wf(Rel,Res,WF) :- domain_wf1(Rel,Res,WF). |
1692 | | |
1693 | | |
1694 | | propagate_result_to_input(Result,Rel,DomOrRange,WF) :- |
1695 | | propagate_empty_set(Result,Rel), % this will trigger before LWF ground |
1696 | | (preferences:preference(use_smt_mode,true) |
1697 | | -> propagate_result_to_input1(Result,Rel,1,DomOrRange) % hopefully full CHR implementation will avoid the need for this hack |
1698 | | % ; kernel_objects:is_marked_to_be_computed(Rel) -> true % get_last_wait_flag(propagate_result_to_input,WF,LWF) |
1699 | | ; %print(propagating_to_input(Rel)),nl, |
1700 | | get_wait_flag(2000,propagate_result_to_input,WF,LWF), % TO DO: determine right value for Priority ? |
1701 | | propagate_result_to_input1(Result,Rel,LWF,DomOrRange) % this slows down test 289 if not guarded, 1088 if guarded |
1702 | | ). |
1703 | | |
1704 | | :- block propagate_result_to_input1(-,?,?,?), propagate_result_to_input1(?,-,-,?). |
1705 | | % Note: if arg 2 (Rel) is known we will not propagate |
1706 | | propagate_result_to_input1([],Rel,_,_) :- !, empty_set(Rel). |
1707 | | propagate_result_to_input1(Result,Input,LWF,DomOrRange) :- |
1708 | | (kernel_objects:is_marked_to_be_computed(Input) -> true %print(not_prop(Input,DomOrRange)),nl,nl |
1709 | | ; %print(prop(Result,Input,LWF)),nl, |
1710 | | propagate_result_to_input2(Result,Input,LWF,DomOrRange)). |
1711 | | |
1712 | | %:- block propagate_result_to_input2(-,?). |
1713 | | :- block propagate_result_to_input2(-,?,?,?), propagate_result_to_input2(?,-,-,?). |
1714 | | % maybe do in CHR in future: x:dom(R) => #z.(x,z) : R |
1715 | | % TO DO: make stronger; also support avl_set ... |
1716 | | propagate_result_to_input2([],_Rel,_,_) :- !. % nothing can be said; we could have repeated entries for previous domain elements |
1717 | | propagate_result_to_input2([D|T],Rel,LWF,DomOrRange) :- %print(propagate_result_to_input2([D|T],Rel,LWF,DomOrRange)),nl, |
1718 | | !, |
1719 | | (Rel == [] -> fail % we would need more relation elements to generate the domain/range |
1720 | | ; nonvar(Rel) -> true % no propagation |
1721 | | ; (DomOrRange=domain -> Rel = [(D,_)|RT] ; Rel = [(_,D)|RT]), |
1722 | | propagate_result_to_input2(T,RT,LWF,DomOrRange) |
1723 | | ). |
1724 | | propagate_result_to_input2(CS,Rel,LWF,DomOrRange) :- var(Rel), is_custom_explicit_set(CS),!, |
1725 | | expand_custom_set_to_list(CS,Res,_,propagate_result_to_input2), |
1726 | | propagate_result_to_input2(Res,Rel,LWF,DomOrRange). |
1727 | | propagate_result_to_input2(_1,_2,_LWF,_DomOrRange). % :- print(unknown_prop(_1,_2,_LWF)),nl. |
1728 | | |
1729 | | :- block domain_wf1(-,?,?). |
1730 | ? | domain_wf1(Rel,Res,WF) :- is_custom_explicit_set(Rel,domain_wf), |
1731 | | % print_term_summary(try_dom_explicit(Rel,Res)), |
1732 | ? | domain_of_explicit_set(Rel,Dom), !, |
1733 | | % print_term_summary(dom_res(Rel,Dom)),%% |
1734 | ? | equal_object_wf(Dom,Res,domain_wf1,WF). |
1735 | | domain_wf1(Rel,Res,WF) :- %% print_term_summary(domain_normal(Rel,Res)), %% |
1736 | | expand_custom_set_to_list_wf(Rel,Relation,_,domain_wf,WF), |
1737 | | newdomain1(Relation,[],Res,WF), |
1738 | | quick_propagate_domain(Relation,Res,WF). |
1739 | | |
1740 | | :- block quick_propagate_domain(-,?,?). |
1741 | | quick_propagate_domain([],_,_WF). |
1742 | | quick_propagate_domain([(X,_)|T],FullRes,WF) :- |
1743 | | quick_propagation_element_information(FullRes,X,WF,FullRes1), % should we use a stronger check ? |
1744 | | quick_propagate_domain(T,FullRes1,WF). |
1745 | | |
1746 | | %:- block newdomain1(-,?,-,?). % why was this commented out ? |
1747 | | :- block newdomain1(-,?,?,?). |
1748 | | /* newdomain1(Rel,SoFar,Res,WF) :- var(Rel), !, % print(prop(Res)),nl, |
1749 | | domain_propagate_result(Res,Rel,SoFar,WF). */ |
1750 | | newdomain1(Dom,SoFar,Res,WF) :- newdomain2(Dom,SoFar,Res,WF). |
1751 | | |
1752 | | %:- block newdomain2(-,?,?,?). |
1753 | | newdomain2([],_SoFar,Res,WF) :- empty_set_wf(Res,WF). |
1754 | | newdomain2([(X,Y)|T],SoFar,Res,WF) :- |
1755 | | (Res==[] |
1756 | | -> MemRes=pred_true, check_element_of_wf(X,SoFar,WF) |
1757 | | ; membership_test_wf(SoFar,X,MemRes,WF), |
1758 | | 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 |
1759 | | ), |
1760 | | %(var(MemRes) -> print(delayed_newdomain2(X,Y,SoFar,T)),nl ; true), |
1761 | | newdomain3(MemRes,X,T,SoFar,Res,WF). |
1762 | | |
1763 | | :- block newdomain3(-,?,?,?,?,?). |
1764 | | newdomain3(pred_true,_,T,SoFar,Res,WF) :- newdomain1(T,SoFar,Res,WF). |
1765 | | newdomain3(pred_false,X,T,SoFar,Res,WF) :- |
1766 | | kernel_objects:mark_as_non_free(X), % X is linked to a particular Y -> it is not free |
1767 | | add_element_wf(X,SoFar,SoFar2,WF), |
1768 | | equal_cons_wf(Res,X,Res2,WF), %print(newdomain3_added(X,SoFar,SoFar2,Res,Res2)),nl, |
1769 | | newdomain1(T,SoFar2,Res2,WF). |
1770 | | |
1771 | | |
1772 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(2),int(7))],WF),WF)). |
1773 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(1),int(6)),(int(2),int(7))],WF),WF)). |
1774 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(22),[(int(1),int(6)),(int(22),int(7)),(int(33),int(7))],WF),WF)). |
1775 | | :- assert_must_succeed((bsets_clp:in_domain_wf(int(1),[(int(1),int(2))],_))). |
1776 | | :- assert_must_succeed((bsets_clp:in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))). |
1777 | | :- assert_must_fail((bsets_clp:in_domain_wf(int(3),[],_))). |
1778 | | :- assert_must_fail((bsets_clp:in_domain_wf(int(3),[(int(1),int(2))],_))). |
1779 | | /* a more efficient version than using element_of and computing domain */ |
1780 | | |
1781 | | % just like not_empty_set_wf but instantiates with (El,_) as first element |
1782 | | in_domain_wf(El,S,WF) :- var(S),!, |
1783 | | (preferences:preference(use_smt_mode,true) -> S=[(El,_)|_] |
1784 | | ; get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)). |
1785 | | in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF). |
1786 | | :- block in_domain_lwf(-,-,-,?). |
1787 | | % was :- block in_domain_lwf(-,?,-,?). but this prevents instantiating El in case Rel becomes known ! see e.g. private_examples/ClearSy/ComparePv10Pv11/DebugPv10/ |
1788 | | %:- block in_domain_lwf(-,-,?,?),in_domain_lwf(?,-,-,?). % this annotation fails test 1703 |
1789 | | in_domain_lwf(El,Rel,_,WF) :- |
1790 | ? | (var(Rel) -> Rel = [(El,_)|_] |
1791 | ? | ; not_empty_set_unless_closure_wf(Rel,WF), |
1792 | ? | in_domain_wf_lazy(El,Rel,WF)). |
1793 | | |
1794 | | 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 |
1795 | | not_empty_set_unless_closure_wf(Rel,WF) :- not_empty_set_wf(Rel,WF). |
1796 | | |
1797 | | % does not instantiate to [(El,_)|_] |
1798 | | :- block in_domain_wf_lazy(?,-,?). |
1799 | | %in_domain_wf_lazy(DomainElement,ES,WF) :- print(in_domain_wf_lazy(DomainElement,ES,WF)),nl,fail. |
1800 | | in_domain_wf_lazy(_DomainElement,[],_WF) :- !,fail. |
1801 | | in_domain_wf_lazy(DomainElement,avl_set(A),_WF) :- |
1802 | | kernel_tools:ground_value(DomainElement), !, %print(enter_in_dom_avl(DomainElement)),nl, |
1803 | | check_in_domain_of_avlset(DomainElement,A). |
1804 | | % TO DO: check for infinite closures |
1805 | | in_domain_wf_lazy(DomainElement,ES,WF) :- |
1806 | ? | is_custom_explicit_set(ES,in_domain_wf_lazy), %print(enter_in_dom(ES)),nl, |
1807 | ? | domain_of_explicit_set(ES,Dom),!, |
1808 | | % print(in_domain_of_explicit_set(DomainElement,Dom,ES)),nl, |
1809 | ? | check_element_of_wf(DomainElement,Dom,WF). |
1810 | | in_domain_wf_lazy(El,Rel,WF) :- %print(in_dom(El)),nl, |
1811 | | expand_custom_set_to_list_wf(Rel,Relation,Done,in_domain_wf_lazy,WF), |
1812 | | 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 |
1813 | | % print(in_domain2(El,Relation,WF,LWF,Done)),nl, |
1814 | | % if Done == true -> we can use maybe clpfd_inlist or clpfd:element or quick_propagate |
1815 | | quick_propagation_domain_element_list(Done,Relation,El,WF), |
1816 | | in_domain2(El,Relation,WF,LWF). |
1817 | | |
1818 | | % a custom implementation of quick_propagation_element_information for checking domain elements and lists only |
1819 | | :- use_module(clpfd_lists,[try_in_fd_value_list_check/4]). |
1820 | | :- block quick_propagation_domain_element_list(-,?,?,?). |
1821 | | quick_propagation_domain_element_list(_,_,_,_) :- preferences:preference(use_clpfd_solver,false),!. |
1822 | | quick_propagation_domain_element_list(_,_,El,_) :- ground(El),!. |
1823 | | quick_propagation_domain_element_list(_,RelList,El,WF) :- |
1824 | | try_in_fd_value_list_check(RelList,(El,_),couple_left(_),WF). % use couple_left to ignore range values |
1825 | | |
1826 | | |
1827 | | :- block in_domain2(?,-,?,?). |
1828 | | in_domain2(El,[(X,_Y)|T],WF,LWF) :- |
1829 | | (T==[] -> equal_object_wf(El,X,in_domain2,WF) |
1830 | | ; kernel_objects:equality_objects_lwf(El,X,EqRes,LWF), |
1831 | | in_domain3(EqRes,El,T,WF,LWF) |
1832 | | ). |
1833 | | |
1834 | | :- block in_domain3(-,?,?,?,?). |
1835 | | in_domain3(pred_true,_El,_T,_WF,_LWF). |
1836 | | in_domain3(pred_false,El,T,WF,LWF) :- |
1837 | | get_new_subsidiary_wait_flag(LWF,in_domain2(El,T),WF,NewLWF), |
1838 | | in_domain2(El,T,WF,NewLWF). |
1839 | | |
1840 | | |
1841 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[],WF),WF)). |
1842 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7))],WF),WF)). |
1843 | | :- 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)). |
1844 | | :- 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)). |
1845 | | :- assert_must_fail((bsets_clp:not_in_domain_wf(int(1),[(int(1),int(2))],_))). |
1846 | | :- assert_must_fail((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))). |
1847 | | :- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[],_))). |
1848 | | :- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2))],_))). |
1849 | | :- 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)). |
1850 | | /* a more efficient version than using not_element_of and computing domain */ |
1851 | | |
1852 | | |
1853 | | :- block not_in_domain_wf(?,-,?). |
1854 | | not_in_domain_wf(DomainElement,ES,WF) :- is_custom_explicit_set(ES,not_in_domain), |
1855 | | domain_of_explicit_set(ES,Dom),!, |
1856 | | %print_term_summary(not_in_domain2(DomainElement,Dom,ES)), |
1857 | | not_element_of_wf(DomainElement,Dom,WF). |
1858 | | not_in_domain_wf(El,Rel,WF) :- %%print(not_in_dom(El,Rel)),nl, |
1859 | | expand_custom_set_to_list_wf(Rel,Relation,_,not_in_domain,WF), |
1860 | | not_in_domain2(Relation,El,WF). |
1861 | | :- block not_in_domain2(-,?,?). |
1862 | | not_in_domain2([],_,_WF). |
1863 | | not_in_domain2([(X,_Y)|T],E,WF) :- not_equal_object_wf(E,X,WF), not_in_domain2(T,E,WF). |
1864 | | |
1865 | | |
1866 | | |
1867 | | |
1868 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([],[],WF),WF)). |
1869 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([(int(1),int(3))],[int(3)],WF),WF)). |
1870 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf( |
1871 | | [(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(3),int(55)],WF),WF)). |
1872 | | :- assert_must_succeed((bsets_clp:range_wf([],Res,_WF),Res=[])). |
1873 | | :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2))],Res,_WF), |
1874 | | kernel_objects:equal_object(Res,[int(2)]))). |
1875 | | :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(1)),(int(2),int(1))],Res,_WF), |
1876 | | kernel_objects:equal_object(Res,[int(1)]))). |
1877 | | :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF), |
1878 | | kernel_objects:equal_object(Res,[int(1),int(2)]))). |
1879 | | :- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],Res,_WF), |
1880 | | kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))). |
1881 | | :- assert_must_succeed((bsets_clp:range_wf(X,Res,_WF), |
1882 | | X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(3))], |
1883 | | kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))). |
1884 | | :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2), |
1885 | | X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(2))])). |
1886 | | :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2), |
1887 | | X = [(int(2),int(1)),(int(1),int(2)),(int(2),int(2))])). |
1888 | | :- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2), |
1889 | | X = [])). |
1890 | | :- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]), |
1891 | | ([int(0),int(1)],[int(0),int(1)]),([int(0),int(2)],[int(0),int(2)]), |
1892 | | ([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]), |
1893 | | ([int(1),int(2)],[int(1),int(2)]),([int(1),int(3)],[int(1),int(3)]), |
1894 | | ([int(1),int(4)],[int(1),int(4)]),([int(2)],[int(2)]),([int(2),int(3)],[int(2),int(3)]), |
1895 | | ([int(2),int(4)],[int(2),int(4)]),([int(3)],[int(3)]),([int(3),int(4)], |
1896 | | [int(3),int(4)]),([int(4)],[int(4)])],_Res,_WF))). |
1897 | | :- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]), |
1898 | | ([int(0),int(1)],[int(0),int(1)]), |
1899 | | ([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]), |
1900 | | ([int(1),int(2)],[int(1),int(2)])],_Res,_WF))). |
1901 | | |
1902 | | % TO DO: also use propagate_result_to_input |
1903 | | :- block range_wf(-,-,?). |
1904 | | range_wf(Rel,Res,WF) :- Res ==[],!, empty_set_wf(Rel,WF). |
1905 | | range_wf(Rel,Res,WF) :- Rel ==[],!, empty_set_wf(Res,WF). |
1906 | ? | range_wf(Rel,Res,WF) :- range_wf1(Rel,Res,WF), |
1907 | | propagate_result_to_input(Res,Rel,range,WF). |
1908 | | |
1909 | | :- block range_wf1(-,?,?). |
1910 | | range_wf1(Rel,Res,WF) :- % print_term_summary(range_wf1(Rel,Res)), |
1911 | ? | is_custom_explicit_set(Rel,range_wf1), |
1912 | ? | range_of_explicit_set(Rel,Range), !, |
1913 | | % print_term_summary(range_of_explicit_set(Rel,Range)), |
1914 | ? | equal_object_wf(Range,Res,range_wf1,WF). |
1915 | | range_wf1(Rel,Res,WF) :- % print_term_summary(range_normal(Rel,Res)), |
1916 | | % TO DO : propagate information that card of Res <= card of Rel; similar thing for domain |
1917 | | expand_custom_set_to_list_wf(Rel,Relation,_,range_wf1,WF), %print(exp(Relation)),nl, |
1918 | | % print(newrange2(Relation,[],Res)),nl, |
1919 | | newrange2(Relation,[],Res,WF), |
1920 | | quick_propagate_range(Relation,Res,WF). |
1921 | | |
1922 | | |
1923 | | :- block quick_propagate_range(-,?,?). |
1924 | | quick_propagate_range([],_,_WF). |
1925 | | quick_propagate_range([(_,Y)|T],FullRes,WF) :- |
1926 | | quick_propagation_element_information(FullRes,Y,WF,FullRes1), % should we use a stronger check ? |
1927 | | quick_propagate_range(T,FullRes1,WF). |
1928 | | |
1929 | | :- block newrange2(-,?,?,?). |
1930 | | newrange2([],_SoFar,Res,WF) :- %print(range2_base(Acc,Res)),nl, |
1931 | | empty_set_wf(Res,WF). % ,print(eq),nl. |
1932 | | newrange2([(X,Y)|T],SoFar,Res,WF) :- %print(range2(Y,T,SoFar,Res)),nl, |
1933 | | (Res==[] |
1934 | | -> MemRes=pred_true, check_element_of_wf(Y,SoFar,WF) |
1935 | | ; membership_test_wf(SoFar,Y,MemRes,WF), |
1936 | | 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 |
1937 | | (var(MemRes) -> prop_empty_pred_true(Res,MemRes) %,print(delay_range(Y,T)),nl |
1938 | | % TO DO: we could look further in T if we can decide membership for other elements in T ? |
1939 | | ; true) |
1940 | | ), |
1941 | | newrange3(MemRes,Y,T,SoFar,Res,WF). |
1942 | | |
1943 | | :- block prop_empty_pred_true(-,?). |
1944 | | prop_empty_pred_true([],R) :- !, R=pred_true. |
1945 | | prop_empty_pred_true(_,_). |
1946 | | |
1947 | | % 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 |
1948 | | % checking is stopped if EqFlag becomes nonvar |
1949 | | % tested by testcase 1061 |
1950 | | :- block card_greater_equal_check(-,?,-), card_greater_equal_check(?,-,-). |
1951 | | card_greater_equal_check(_,_,Flag) :- nonvar(Flag),!. % no longer required; even though we could prune failure !? done later in newrange2/newdomain2 ??!! |
1952 | | card_greater_equal_check([],Set2,Flag) :- !,empty_set(Set2), |
1953 | | Flag=pred_false. % Flag set indicates that both sets have same size |
1954 | | card_greater_equal_check(_,[],_) :- !. |
1955 | | card_greater_equal_check([_|T],[_|R],Flag) :- !, card_greater_equal_check(T,R,Flag). |
1956 | | % To do: deal with AVL args as Result + also use efficient_card_for_set for closures |
1957 | | %card_greater_equal_check([_|T],Set,Flag) :- efficient_card_for_set(B,CardB,CodeB),!, |
1958 | | % f: 1..7 -->> 1..n & n>=7 & n<10 still does not work well |
1959 | | % TO DO: can we merge code with check_card_greater_equal |
1960 | | card_greater_equal_check(_,_,_). |
1961 | | |
1962 | | |
1963 | | :- block newrange3(-,?,?,?,?,?). |
1964 | | newrange3(pred_true,_Y,T,SoFar,Res,WF) :- newrange2(T,SoFar,Res,WF). |
1965 | | newrange3(pred_false,Y,T,SoFar,Res,WF) :- |
1966 | | kernel_objects:mark_as_non_free(Y), % Y is linked to a particular X -> it is not free |
1967 | | add_element_wf(Y,SoFar,SoFar2,WF), |
1968 | | equal_cons_wf(Res,Y,Res2,WF), |
1969 | | % print_bt_message(added(Y,T,SoFar,sofar2(SoFar2),Res,res2(Res2))), |
1970 | | newrange2(T,SoFar2,Res2,WF). |
1971 | | |
1972 | | |
1973 | | :- assert_must_succeed((bsets_clp:identity_relation_over_wf([],Res,_WF),Res=[])). |
1974 | | :- assert_must_succeed((bsets_clp:identity_relation_over_wf([int(1),int(2)],Res,_WF), |
1975 | | Res=[(int(1),int(1)),(int(2),int(2))])). |
1976 | | :- 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)). |
1977 | | :- 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)). |
1978 | | :- assert_must_fail((bsets_clp:identity_relation_over_wf([int(1)|_],_,_WF),fail)). /* check: no loop */ |
1979 | | |
1980 | | :- block identity_relation_over_wf(-,?,?). |
1981 | | identity_relation_over_wf(Set1,IDRel,WF) :- |
1982 | | expand_custom_set_to_list_wf(Set1,ESet1,_,identity_relation_over_wf,WF), |
1983 | | identity_relation_over2(ESet1,IDRel,WF). |
1984 | | |
1985 | | :- block identity_relation_over2(-,?,?). |
1986 | | identity_relation_over2([],Res,WF) :- empty_set_wf(Res,WF). |
1987 | | identity_relation_over2([X|T1],Res,WF) :- equal_cons_wf(Res,(X,X),T2,WF), % equal_object([(X,X)|T2],Res), |
1988 | | identity_relation_over2(T1,T2,WF). |
1989 | | |
1990 | | |
1991 | | |
1992 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_identity((int(1),int(1)),[int(1),int(2)],WF),WF)). |
1993 | | :- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[int(1),int(2)],_WF))). |
1994 | | :- assert_must_fail((bsets_clp:in_identity((int(3),int(3)),[int(1),int(2)],_WF))). |
1995 | | :- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[],_WF))). |
1996 | | in_identity((X,Y),Domain,WF) :- %print(in_identity((X,Y),Domain)),nl, |
1997 | | equal_object_wf(X,Y,in_identity,WF), check_element_of_wf(X,Domain,WF). |
1998 | | |
1999 | | :- assert_must_fail((bsets_clp:not_in_identity((int(1),int(1)),[int(1),int(2)],_WF))). |
2000 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(1),int(2)),[int(1),int(2)],WF),WF)). |
2001 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(3),int(3)),[int(1),int(2)],WF),WF)). |
2002 | | :- assert_must_succeed((bsets_clp:not_in_identity((int(1),int(2)),[],_WF))). |
2003 | | not_in_identity((X,Y),Domain,WF) :- %print(not_in_identity((X,Y),Domain)),nl, |
2004 | | equality_objects_wf(X,Y,Eq,WF), |
2005 | | not_in_id2(Eq,X,Domain,WF). |
2006 | | |
2007 | | :- block not_in_id2(-,?,?,?). |
2008 | | not_in_id2(pred_true,X,Domain,WF) :- not_element_of_wf(X,Domain,WF). |
2009 | | not_in_id2(pred_false,_,_,_). |
2010 | | |
2011 | | |
2012 | | :- 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)). |
2013 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2))], [(int(2),int(1))],WF),WF)). |
2014 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([], [],WF),WF)). |
2015 | | :- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [])). |
2016 | | :- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [(int(2),int(2))])). |
2017 | | :- assert_must_succeed((bsets_clp:invert_relation_wf(X,[(int(1),int(2)),(int(7),int(6))],_WF), |
2018 | | X = [(int(2),int(1)),(int(6),int(7))])). |
2019 | | :- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],X,_WF), |
2020 | | X = [(int(2),int(1)),(int(6),int(7))])). |
2021 | | :- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))], |
2022 | | [(int(6),int(7)),(int(2),int(1))],_WF))). |
2023 | | :- assert_must_succeed((bsets_clp:invert_relation_wf(closure([a,b],[string,boolean],b(truth,pred,[])), |
2024 | | closure([b,a],[boolean,string],b(truth,pred,[])),_WF))). |
2025 | | |
2026 | | :- block invert_relation_wf(-,-,?). |
2027 | | invert_relation_wf(R,IR,WF) :- % print_message(invert_relation(R,IR)), |
2028 | | % (nonvar(R) -> invert_relation2(R,IR) ; invert_relation2(IR,R)). |
2029 | ? | invert_relation2(R,IR,WF). % , print_term_summary(invert_relation(R,IR)). |
2030 | | /* Optimization for some types of closures: Instead of expanding the closures, we just |
2031 | | swap the parameters. This does not work with closures wich have only one parameter |
2032 | | wich is a pair */ |
2033 | ? | invert_relation2(CS,R,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!, |
2034 | ? | invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_1,WF). |
2035 | | invert_relation2(R,CS,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!, |
2036 | | invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_2,WF). |
2037 | | %invert_relation2(closure([P1,P2],[T1,T2],Clo),closure([P2,P1],[T2,T1],Clo)) :- !. |
2038 | | invert_relation2(R,IR,WF) :- %try_expand_custom_set(R,ER), |
2039 | | % (nonvar(R) -> invert_relation3(R,IR) |
2040 | | % ; invert_relation3(IR,R),(ground(IR)-> true ; invert_relation3(R,IR))). |
2041 | | % print(inverting(R,IR,WF)),nl, |
2042 | | invert_relation3(R,IR,WF,1), invert_relation3(IR,R,WF,1). |
2043 | | % ,print(inverted(R,IR)),nl. % propagates both ways; but multiple solutions ?! |
2044 | | |
2045 | | :- block invert_relation3(-,?,?,?). |
2046 | | invert_relation3(closure(P,T,B),Res,WF,_) :- invert_explicit_set(closure(P,T,B),ICS), |
2047 | | equal_object_wf(Res,ICS,invert_relation3_1,WF). |
2048 | | invert_relation3(avl_set(S),Res,WF,_) :- invert_explicit_set(avl_set(S),ICS), |
2049 | | equal_object_wf(Res,ICS,invert_relation3_2,WF). |
2050 | | invert_relation3([],Res,WF,_) :- empty_set_wf(Res,WF). |
2051 | | invert_relation3([(X,Y)|T],Res,WF,Depth) :- %prints(invert([(X,Y)|T],Res,Depth)), |
2052 | | D1 is Depth+1, get_wait_flag(D1,invert_relation3,WF,LWF), |
2053 | | equal_cons_lwf(Res,(Y,X),IT,LWF,WF), |
2054 | | invert_relation3(T,IT,WF,D1). |
2055 | | |
2056 | | |
2057 | | |
2058 | | |
2059 | | tuple_of(X,Y,R) :- check_element_of((X,Y),R). |
2060 | | %tuple_of_wf(X,Y,R,WF) :- check_element_of_wf((X,Y),R,WF). |
2061 | | |
2062 | | :- 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))], |
2063 | | [(int(1),int(1)),(int(5),int(7)),(int(3),int(33))]))). |
2064 | | :- 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))],[]))). |
2065 | | :- 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))],[],[]))). |
2066 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([],[],[]))). |
2067 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))], |
2068 | | [(int(1),int(11))],X),X = [])). |
2069 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],[],X),X = [])). |
2070 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))], |
2071 | | [(int(2),int(11))],X), |
2072 | | kernel_objects:equal_object(X,[(int(1),int(11))]))). |
2073 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(2))],[(int(2),int(11))],X), |
2074 | | ground(X), bsets_clp:equal_object(X,[(int(1),int(11)),(int(7),int(11))]))). |
2075 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(5))], |
2076 | | [(int(2),int(11)),(int(2),int(4))],X), |
2077 | | kernel_objects:equal_object(X,[(int(1),int(11)),(int(1),int(4))]))). |
2078 | | :- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(1),int(5))], |
2079 | | [(int(2),int(11)),(int(5),int(11))],X), |
2080 | | kernel_objects:equal_object(X,[(int(1),int(11))]))). |
2081 | | |
2082 | | rel_composition(Rel1,Rel2,Comp) :- |
2083 | | init_wait_flags(WF), % TO DO: remove and add WF arg |
2084 | | rel_composition_wf(Rel1,Rel2,Comp,WF), |
2085 | | ground_wait_flags(WF). |
2086 | | |
2087 | | :- block rel_composition_wf(-,-,?,?). |
2088 | | rel_composition_wf(Rel1,Rel2,Comp,WF) :- % print(rel_compose(Rel1,Rel2,Comp)),nl, |
2089 | | (Rel1==[] ; Rel2==[]), |
2090 | | !, |
2091 | | empty_set_wf(Comp,WF). |
2092 | | rel_composition_wf(Rel1,Rel2,Comp,WF) :- rel_composition1(Rel1,Rel2,Comp,WF). |
2093 | | |
2094 | | :- block rel_composition1(-,?,?,?),rel_composition1(?,-,?,?). |
2095 | | rel_composition1(Rel1,Rel2,Comp,WF) :- % print(rel(Rel1,Rel2,Comp)),nl, trace, |
2096 | ? | (Rel1==[] ; Rel2==[]),!, empty_set_wf(Comp,WF). |
2097 | | rel_composition1(Rel1,Rel2,Comp,WF) :- keep_symbolic(Rel1), |
2098 | | (Rel2 = avl_set(_) -> SYMBOLIC=false ; SYMBOLIC=symbolic), |
2099 | | symbolic_composition(Rel1,Rel2,SYMBOLIC,Rel3), |
2100 | | !, |
2101 | | % format('SYMBOLIC COMPOSITION (~w): ',[SYMBOLIC]), translate:print_bvalue(Rel3),nl, |
2102 | | equal_object_wf(Comp,Rel3,rel_composition1_0,WF). |
2103 | ? | rel_composition1(Rel1,Rel2,Comp,WF) :- rel_composition_for_explicit_set(Rel1,Rel2,Res),!, |
2104 | | % print_term_summary(rel_composition_for_explicit_set(Rel1,Rel2,Res)), |
2105 | ? | equal_object_wf(Res,Comp,rel_composition1_1,WF). |
2106 | | rel_composition1(Rel1,Rel2,Comp,WF) :- Rel2=closure(_,_,_), % nl,print(rel(Rel1,Rel2,Comp)),nl, trace, |
2107 | | keep_symbolic(Rel2), |
2108 | | (dom_for_specific_closure(Rel2,Domain,function(_)) % TO DO: also deal with relations; in SYMBOLIC mode this may be counter productive; see function_composition ast cleanup rule |
2109 | | -> !, |
2110 | | expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1,WF), |
2111 | | rel_compose_with_inf_fun(Relation1,Domain,Rel2,Comp,WF) |
2112 | | ; symbolic_composition(Rel1,Rel2,false,Rel3), |
2113 | | !, |
2114 | | % print('SYMBOLIC COMPOSITION2: '),translate:print_bvalue(Rel3),nl, |
2115 | | expand_custom_set(Rel3,CRes), equal_object_optimized(CRes,Comp,rel_composition1_3) % do we need to expand ? |
2116 | | ). |
2117 | | rel_composition1(Rel1,Rel2,Comp,WF) :- |
2118 | | expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1_2,WF), |
2119 | | expand_custom_set_to_list_wf(Rel2,Relation2,_,rel_composition1_3,WF), |
2120 | | rel_compose2(Relation1,Relation2,Comp,WF). |
2121 | | |
2122 | | :- use_module(btypechecker, [unify_types_strict/2]). |
2123 | | symbolic_composition(Rel1,Rel2,SYMBOLIC,Rel3) :- |
2124 | | get_relation_types(Rel1,TX,TY), |
2125 | | get_relation_types(Rel2,TY2,TZ), |
2126 | | (unify_types_strict(TY,TY2) -> true |
2127 | | ; add_internal_error('Could not unify range and domain types: ',unify_types_strict(TY,TY2)),fail), |
2128 | | rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,Rel3). |
2129 | | % generate a closure for {xx,zz | #(yy).(xx|->yy : Rel1 & yy|->zz : Rel2)} |
2130 | | % TO DO: maybe detect special cases: Rel1 is a function/cartesian product, e.g., (((0 .. 76) * (0 .. 76)) * {FALSE}) ; {(FALSE|->0),(TRUE|->1)} |
2131 | | rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,closure(Args,Types,CBody)) :- |
2132 | | Args = [xx,zz], Types = [TX,TZ], |
2133 | | couple_member_pred(xx,TX,yy,TY,Rel1, Pred1), |
2134 | | couple_member_pred(yy,TY,zz,TZ,Rel2, Pred2), |
2135 | | conjunct_predicates([Pred1,Pred2],P12), |
2136 | | b_interpreter_components:create_unsimplified_exists([b(identifier(yy),TY,[])],P12,Body), |
2137 | | (SYMBOLIC==symbolic -> mark_bexpr_as_symbolic(Body,CBody) ; CBody=Body). |
2138 | | |
2139 | | % generate predicate for X|->Y : Rel |
2140 | | couple_member_pred(X,TX,Y,TY,Rel, Pred) :- |
2141 | | Pred = b(member(b(couple(b(identifier(X),TX,[]), |
2142 | | b(identifier(Y),TY,[])),couple(TX,TY),[]), |
2143 | | b(value(Rel),set(couple(TX,TY)),[])),pred,[]). |
2144 | | |
2145 | | |
2146 | | |
2147 | | :- block rel_compose2(-,?,?,?). |
2148 | | rel_compose2([],_,Out,WF) :- empty_set_wf(Out,WF). |
2149 | | rel_compose2([(X,Y)|T],Rel2,Out,WF) :- |
2150 | | rel_extract(Rel2,X,Y,OutXY,[],WF), |
2151 | | % rel_extract(Rel2,X,Y,Out,OutRem), |
2152 | | rel_compose2(T,Rel2,OutRem,WF), |
2153 | | union_wf(OutRem,OutXY,Out,WF). % used to call union wihout wf; makes test 1394 fail |
2154 | | |
2155 | | :- block rel_extract(-,?,?,?,?,?). |
2156 | | rel_extract([],_,_,Rem,Rem,_WF). % should we use equal_object here ????? |
2157 | | rel_extract([(Y1,Z)|T],X,Y,Res,Rem,WF) :- |
2158 | | rel_extract(T,X,Y,CT,Rem,WF), |
2159 | | equality_objects_wf(Y1,Y,EqRes,WF), |
2160 | | rel_extract2(EqRes,Z,X,CT,Res). |
2161 | | |
2162 | | :- block rel_extract2(-,?,?,?,?). |
2163 | | rel_extract2(pred_true, Z, X,CT,Res) :- add_element((X,Z),CT,Res). |
2164 | | rel_extract2(pred_false,_Z,_X,CT,Res) :- Res = CT. |
2165 | | |
2166 | | |
2167 | | |
2168 | | :- block rel_compose_with_inf_fun(-,?,?,?,?). |
2169 | | rel_compose_with_inf_fun([],_Dom,_Rel2,Comp,WF) :- empty_set_wf(Comp,WF). |
2170 | | rel_compose_with_inf_fun([(X,Y)|T],Dom,Fun,CompRes,WF) :- |
2171 | | membership_test_wf(Dom,Y,MemRes,WF), |
2172 | | rel_compose_with_inf_fun_aux(MemRes,X,Y,T,Dom,Fun,CompRes,WF). |
2173 | | |
2174 | | :- block rel_compose_with_inf_fun_aux(-,?,?,?, ?,?,?,?). |
2175 | | rel_compose_with_inf_fun_aux(pred_true,X,Y,T,Dom,Fun,CompRes,WF) :- |
2176 | | % print(rel_compose_with_inf_fun_aux(X,Y)),nl, |
2177 | | apply_to(Fun,Y,FY,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ? |
2178 | | add_element_wf((X,FY),CT,CompRes,WF), |
2179 | | rel_compose_with_inf_fun(T,Dom,Fun,CT,WF). |
2180 | | rel_compose_with_inf_fun_aux(pred_false,_X,_Y,T,Dom,Fun,Comp,WF) :- |
2181 | | % print(rel_compose_not_in_domain(_X,_Y)),nl, |
2182 | | rel_compose_with_inf_fun(T,Dom,Fun,Comp,WF). |
2183 | | |
2184 | | :- assert_must_abort_wf(bsets_clp:rel_iterate_wf([],int(-1),_R,set(couple(integer,integer)),WF),WF). |
2185 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([], int(2),[],set(couple(integer,integer)),_WF))). |
2186 | | :- 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))). |
2187 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(pred_true,pred_true)], int(0), |
2188 | | [(pred_true,pred_true),(pred_false,pred_false)],set(couple(boolean,boolean)),_WF))). |
2189 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(int(1),int(2)),(int(2),int(4)),(int(4),int(6))], int(2),[(int(1),int(4)),(int(2),int(6))],set(couple(integer,integer)),_WF))). |
2190 | | :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF), R=[], |
2191 | | bsets_clp:equal_object(X,R))). |
2192 | | :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF), |
2193 | | R=[(int(1),int(2)),(int(2),int(3))], |
2194 | | bsets_clp:equal_object(X,R))). |
2195 | | :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(2),X,set(couple(integer,integer)),_WF), |
2196 | | R=[(int(1),int(2)),(int(2),int(3))], |
2197 | | bsets_clp:equal_object(X,[(int(1),int(3))]))). |
2198 | | :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF), |
2199 | | R=[(int(1),int(2)),(int(2),int(3))], |
2200 | | bsets_clp:equal_object(X,[]))). |
2201 | | :- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF), |
2202 | | R=[(int(1),int(2)),(int(2),int(3)),(int(1),int(1))], |
2203 | | bsets_clp:equal_object(X,[(int(1),int(1)),(int(1),int(2)),(int(1),int(3))]))). |
2204 | | |
2205 | | rel_iterate_wf(Rel,int(Nr),Res,Type,WF) :- rel_iterate2(Nr,Rel,Res,Type,WF). |
2206 | | |
2207 | | :- block rel_iterate2(-,?,?,?,?). |
2208 | | rel_iterate2(X,Rel,Res,Type,WF) :- |
2209 | | ( X=1 -> equal_object_wf(Res,Rel,rel_iterate2,WF) |
2210 | | ; X>1 -> X1 is X-1, |
2211 | | rel_iterate2(X1,Rel,R1,Type,WF), |
2212 | | rel_composition(Rel,R1,Res) % TO DO: call WF version |
2213 | | ; X=0 -> rel_iterate0(Rel,Type,Res,WF) |
2214 | | ; otherwise -> add_wd_error('negative index in iterate',X,WF) |
2215 | | ). |
2216 | | |
2217 | | :- use_module(bsyntaxtree,[get_set_type/2]). |
2218 | | :- block rel_iterate0(?,-,?,?). |
2219 | | rel_iterate0(_Rel,EType,Res,WF) :- |
2220 | | get_set_type(EType,couple(Type,Type)), |
2221 | | event_b_identity_for_type(Type,Res,WF). |
2222 | | |
2223 | | :- use_module(typing_tools,[is_infinite_type/1]). |
2224 | | event_b_identity_for_type(Type,Res,WF) :- |
2225 | | create_texpr(identifier('_zzzz_unary'),Type,[],TIdentifier1), % was [generated] |
2226 | | create_texpr(identifier('_zzzz_binary'),Type,[],TIdentifier2), % was [generated] |
2227 | | (is_infinite_type(Type) -> Info = [prob_annotation('SYMBOLIC')] ; Info =[]), |
2228 | | create_texpr(equal(TIdentifier1,TIdentifier2),pred,Info,TPred), |
2229 | | construct_closure(['_zzzz_unary','_zzzz_binary'],[Type,Type],TPred,CRes), |
2230 | | % for small types we could do: all_objects_of_type(Type,All), identity_relation_over_wf(All,CRes,WF) |
2231 | | %, print(constructed_eventb_identity(Res)),nl |
2232 | | equal_object_wf(Res,CRes,WF). |
2233 | | |
2234 | | |
2235 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([],[(int(1),int(11))],[],_WF))). |
2236 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))], |
2237 | | [(int(1),int(11))],[(int(1),(int(2),int(11)))],_WF))). |
2238 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))], |
2239 | | [(int(2),int(11))],[],_WF))). |
2240 | | :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))], |
2241 | | [(int(2),int(11))],X,_WF), |
2242 | | X = [])). |
2243 | | :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))], |
2244 | | [(int(1),int(11))],X,_WF), |
2245 | | kernel_objects:equal_object(X,[(int(1),(int(2),int(11)))]))). |
2246 | | :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(1),int(6))], |
2247 | | [(int(1),int(11))],X,_WF), |
2248 | | kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(6),int(11)))]))). |
2249 | | :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))], |
2250 | | [(int(1),int(11)),(int(1),int(12))],X,_WF), |
2251 | | kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))]))). |
2252 | | :- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))], |
2253 | | [(int(1),int(11)),(int(1),int(12))], |
2254 | | [(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))],_WF))). |
2255 | | :- 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))), |
2256 | | avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))), |
2257 | | 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))) |
2258 | | ,_WF))). |
2259 | | |
2260 | | :- block direct_product_wf(-,?,?,?),direct_product_wf(?,-,?,?). |
2261 | | direct_product_wf(Rel1,Rel2,Prod,WF) :- |
2262 | | try_expand_and_convert_to_avl_with_check(Rel1,E1,direct_product), % to do: try_expand_and_convert_to_avl_unless_very_large(Rel1,E1), |
2263 | | try_expand_and_convert_to_avl_with_check(Rel2,E2,direct_product), |
2264 | | direct_product_wf1(E1,E2,Prod,WF). |
2265 | | |
2266 | | direct_product_wf1(Rel1,Rel2,Prod,WF) :- % print_term_summary(direct_product(Rel1,Rel2,Prod)), % |
2267 | | direct_product_explicit_set(Rel1,Rel2,Res),!, |
2268 | | % print_term_summary(direct_product_result(Res)), |
2269 | | equal_object_wf(Prod,Res,direct_product_wf1,WF). |
2270 | | direct_product_wf1(Rel1,Rel2,Prod,WF) :- %print_term_summary(direct_product_list(Rel1,Rel2,Prod)), |
2271 | | expand_custom_set_to_list_wf(Rel1,Relation1,_,direct_product_wf1_1,WF), |
2272 | | expand_custom_set_to_list_wf(Rel2,Relation2,_,direct_product_wf1_2,WF), |
2273 | | direct_product2(Relation1,Relation2,Prod,WF), |
2274 | | direct_product_backwards(Relation1,Relation2,Prod,WF). |
2275 | | |
2276 | | %direct_product2(R1,R2,Res) :- print_message(direct_product2(R1,R2,Res)),fail. |
2277 | | :- block direct_product2(-,?,?,?). |
2278 | | direct_product2([],_,Out,WF) :- equal_object_wf(Out,[],direct_product2,WF). |
2279 | | direct_product2([(X,Y)|T],Rel2,Out,WF) :- |
2280 | | direct_product_tuple(Rel2,X,Y,Out,OutRem,WF), |
2281 | | direct_product2(T,Rel2,OutRem,WF). |
2282 | | |
2283 | | :- block direct_product_tuple(-,?,?,?,?,?). |
2284 | | direct_product_tuple([],_,_,Res,Rem,WF) :- equal_object_optimized_wf(Res,Rem,direct_product_tuple,WF). |
2285 | | direct_product_tuple([(X2,Z)|T],X,Y,Res,Rem,WF) :- |
2286 | | direct_product_tuple(T,X,Y,CT,Rem,WF), |
2287 | | equality_objects_wf(X2,X,EqRes,WF), |
2288 | | direct_product_tuple3(EqRes,X,Y,Z,CT,Res,WF). |
2289 | | |
2290 | | :- block direct_product_tuple3(-,?,?,?,?,?,?). |
2291 | | direct_product_tuple3(pred_true,X,Y,Z,CT,Res,WF) :- |
2292 | | equal_cons_wf(Res,(X,(Y,Z)),CT,WF). /* no need for add_element as output uniquely determines X,Y,Z !?*/ |
2293 | | direct_product_tuple3(pred_false,_X,_Y,_Z,CT,Res,WF) :- equal_object_optimized_wf(Res,CT,direct_product_tuple3,WF). |
2294 | | |
2295 | | :- block direct_product_backwards(?,?,-,?). |
2296 | | % Propagate information backwards from result to arguments |
2297 | | direct_product_backwards(R1,R2,Prod,WF) :- |
2298 | | ((kernel_tools:ground_value(R1);kernel_tools:ground_value(R2)) -> true |
2299 | | ; expand_custom_set_to_list_wf(Prod,ProdList,_,direct_product_backwards,WF), |
2300 | | direct_product_propagate_back(ProdList,R1,R2,WF) |
2301 | | ). |
2302 | | |
2303 | | :- block direct_product_propagate_back(-,?,?,?). |
2304 | | direct_product_propagate_back([],_,_,_WF). |
2305 | | direct_product_propagate_back([(X,(Y,Z))|T],R1,R2,WF) :- %% print(prop_back(X,Y,Z,R1,R2)),nl, % |
2306 | | check_element_of_wf((X,Y),R1,WF), check_element_of_wf((X,Z),R2,WF), |
2307 | | direct_product_propagate_back(T,R1,R2,WF). |
2308 | | |
2309 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([],[(int(3),int(4))],[]))). |
2310 | | :- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([(int(1),int(2))], |
2311 | | [(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))). |
2312 | | :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], |
2313 | | [(int(3),int(4))],X), ground(X), |
2314 | | equal_object(X,[((int(1),int(3)),(int(2),int(4)))]))). |
2315 | | :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], |
2316 | | [(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))). |
2317 | | :- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], [],X),X == [])). |
2318 | | :- assert_must_succeed((bsets_clp:parallel_product([], [(int(3),int(4))],X),X == [])). |
2319 | | |
2320 | | parallel_product(Rel1,Rel2,Prod) :- parallel_product_wf(Rel1,Rel2,Prod,no_wf_available). |
2321 | | |
2322 | | :- block parallel_product_wf(-,?,?,?),parallel_product_wf(?,-,?,?). |
2323 | | % NOTE: we now have in_parallel_product; as such parallel products are kept symbolic |
2324 | | %parallel_product_wf(Rel1,Rel2,Prod,WF) :- (keep_symbolic(Rel1) -> true ; keep_symbolic(Rel2)), |
2325 | | % print_term_summary(parallel_product(Rel1,Rel2,Prod)),nl, |
2326 | | %% % TO DO: generate closure |
2327 | | % %{xy,mn|#(x,y,m,n).(xy=(x,y) & mn=(m,n) & (x,m):S & (y,n):R)} |
2328 | | % fail. |
2329 | | parallel_product_wf(Rel1,Rel2,Prod,WF) :- |
2330 | | expand_custom_set_to_list_wf(Rel1,Relation1,_,parallel_product_1,WF), |
2331 | | expand_custom_set_to_list_wf(Rel2,Relation2,_,parallel_product_2,WF), |
2332 | | parallel_product2(Relation1,Relation2,ProdRes,WF), |
2333 | | equal_object_optimized_wf(ProdRes,Prod,parallel_product,WF). |
2334 | | |
2335 | | :- use_module(kernel_equality,[conjoin_test/4]). |
2336 | | %(Rel1||Rel2) = {(x,y),(m,n)| (x,m):Rel1 & (y,n):Rel2} |
2337 | | |
2338 | | % TO DO: use this in b_interpreter_check: |
2339 | | in_parallel_product_test(((X,Y),(M,N)),Rel1,Rel2,Result,WF) :- |
2340 | | conjoin_test(MemRes1,MemRes2,Result,WF), |
2341 | | % print_term_summary(in_parallel_product_test(Rel1,Rel2,Result,MemRes1,MemRes2)),nl, |
2342 | | membership_test_wf(Rel1,(X,M),MemRes1,WF), |
2343 | | membership_test_wf(Rel2,(Y,N),MemRes2,WF). |
2344 | | |
2345 | | :- 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)). |
2346 | | |
2347 | | in_parallel_product_wf(El,Rel1,Rel2,WF) :- |
2348 | | in_parallel_product_test(El,Rel1,Rel2,pred_true,WF). |
2349 | | |
2350 | | |
2351 | | :- 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))). |
2352 | | |
2353 | | not_in_parallel_product_wf(El,Rel1,Rel2,WF) :- |
2354 | | in_parallel_product_test(El,Rel1,Rel2,pred_false,WF). |
2355 | | |
2356 | | |
2357 | | :- block parallel_product2(-,?,?,?). |
2358 | | parallel_product2([],_,Out,WF) :- empty_set_wf(Out,WF). |
2359 | | parallel_product2([(X,Y)|T],Rel2,Out,WF) :- |
2360 | | parallel_product_tuple(Rel2,X,Y,Out,Tail,WF), |
2361 | | parallel_product2(T,Rel2,Tail,WF). |
2362 | | |
2363 | | :- block parallel_product_tuple(-,?,?,?,?,?). |
2364 | | parallel_product_tuple([],_,_,Tail1,Tail2,WF) :- equal_object_wf(Tail1,Tail2,parallel_product_tuple,WF). |
2365 | | parallel_product_tuple([(X2,Y2)|T],X,Y,Rel2,Tail,WF) :- |
2366 | | equal_object_wf(Rel2,[((X,X2),(Y,Y2))|RT],parallel_product_tuple,WF), |
2367 | | parallel_product_tuple(T,X,Y,RT,Tail,WF). |
2368 | | |
2369 | | |
2370 | | % ------------------------------------------------- |
2371 | | |
2372 | | :- 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 |
2373 | | :- 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)). |
2374 | | :- 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)). |
2375 | | :- 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)). |
2376 | | :- 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)). |
2377 | | :- 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)). |
2378 | | :- assert_must_fail((bsets_clp:not_partial_function([],[int(1)],[int(7)],_WF))). |
2379 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[int(7)],_WF), |
2380 | | X = [(int(1),int(7))])). |
2381 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7)],_WF), |
2382 | | X = [(int(2),int(7)),(int(1),int(7))])). |
2383 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2384 | | [int(7),int(6)],_WF), |
2385 | | X = [([(int(1),int(2))],int(7)), |
2386 | | ([(int(2),int(3)),(int(1),int(3))],int(6))])). |
2387 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2388 | | [int(7),int(6)],_WF), |
2389 | | X = [([(int(2),int(3)),(int(1),int(3))],int(6))])). |
2390 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2391 | | [int(7),int(6)],_WF), |
2392 | | X = [([(int(1),int(2))],int(7)), |
2393 | | ([(int(2),int(3)),(int(1),int(3))],int(6))])). |
2394 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[[int(7),int(6)]],_WF), |
2395 | | X = [(int(1),[int(6),int(7)])])). |
2396 | | :- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2397 | | X = [(int(2),int(7)),(int(1),int(7))])). |
2398 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2399 | | X = [(int(2),int(7)),(int(2),int(6))])). |
2400 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2401 | | X = [(int(2),int(7)),(int(1),int(2))])). |
2402 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2403 | | X = [(int(2),int(7)),(int(3),int(6))])). |
2404 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2405 | | X = [(int(2),int(7)),(int(2),int(5))])). |
2406 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2407 | | X = [(int(1),int(7)),(int(2),int(6)),(int(2),int(7))])). |
2408 | | :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF), |
2409 | | X = [(int(1),int(7)),(int(5),int(75))])). |
2410 | | :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF), |
2411 | | X = [(int(1),int(7)),(int(0),int(7))])). |
2412 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF), |
2413 | | X = [(int(1),int(7)),(int(-1),int(7))])). |
2414 | | :- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF), |
2415 | | X = [(int(1),int(7)),(int(0),int(7))])). |
2416 | | :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('Name'),global_set('Code'),_WF), |
2417 | | X = [(fd(1,'Name'),fd(1,'Code'))])). |
2418 | | :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF), |
2419 | | X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])). |
2420 | | :- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF), |
2421 | | X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])). |
2422 | | :- assert_must_succeed((bsets_clp:not_partial_function([(fd(1,'Code'),int(1)),(fd(1,'Code'),int(2))], |
2423 | | global_set('Code'),global_set('NAT1'),_WF) )). |
2424 | | |
2425 | | :- block not_partial_function(-,?,?,?). |
2426 | | not_partial_function([],_Domain,_Range,_WF) :- !,fail. |
2427 | | not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
2428 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
2429 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
2430 | | %print_term_summary(not_partial_fun_dom(FF,FFDomain,Range)), |
2431 | | not_subset_of_wf(FFDomain,Domain,WF). |
2432 | | not_partial_function(FF,Domain,Range,WF) :- nonvar(FF), |
2433 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!, |
2434 | | %print_term_summary(check_special_not_pf(FF,FFDomain,FFRange)),nl, |
2435 | | not_both_subset_of(FFDomain,FFRange,Domain,Range,WF). |
2436 | | not_partial_function(R,Domain,Range,WF) :- |
2437 | | expand_and_convert_to_avl_set(R,AER),!, |
2438 | | % print_term_summary(check_is_not_avl_partial_function(avl_set(AER),Domain,Range)), |
2439 | | (is_avl_partial_function(AER) |
2440 | | -> % print(is_pf),nl, |
2441 | | is_not_avl_relation_over_domain_range(AER,Domain,Range,WF) |
2442 | | %, print(not_in_domain_range),nl |
2443 | | ; true %,print(not_pf),nl |
2444 | | ). |
2445 | | not_partial_function(R,Domain,Range,WF) :- |
2446 | | expand_custom_set_to_list_wf(R,ER,_,not_partial_function,WF), |
2447 | | not_pf(ER,[],Domain,Range,WF). |
2448 | | |
2449 | | :- block not_pf(-,?,?,?,?). |
2450 | | not_pf([],_,_,_,_) :- fail. |
2451 | | not_pf([(X,Y)|T],SoFar,Dom,Ran,WF) :- |
2452 | | membership_test_wf_with_force(SoFar,X,MemRes,WF), |
2453 | | not_pf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
2454 | | |
2455 | | :- block not_pf2(-,?,?,?,?,?,?,?). |
2456 | | not_pf2(pred_true,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* then not a function */ |
2457 | | not_pf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :- |
2458 | | membership_test_wf_with_force(Dom,X,MemRes,WF), |
2459 | | not_pf2a(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
2460 | | |
2461 | | :- block not_pf2a(-,?,?,?,?,?,?,?). |
2462 | | not_pf2a(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* function, but domain wrong */ |
2463 | | not_pf2a(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :- |
2464 | | remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,_LWF,Done), %% provide _LWF ?? |
2465 | | not_pf2b(Done,X,Y,T,SoFar,Dom2,Ran,WF). |
2466 | | |
2467 | | :- block not_pf2b(-, ?,?,?, ?,?,?, ?). |
2468 | | not_pf2b(_Done, X,Y,T, SoFar,Dom2,Ran, WF) :- %print_term_summary(not_pf2b(X,Y,T,SoFar,Dom2,Ran,WF)),nl, |
2469 | | add_element_wf(X,SoFar,SoFar2,WF), |
2470 | | (T==[] -> not_element_of_wf(Y,Ran,WF) |
2471 | | ; membership_test_wf_with_force(Ran,Y,MemRes,WF), |
2472 | | prop_empty_pred_false(T,MemRes), % if T=[] -> Y must not be in Ran |
2473 | | not_pf3(MemRes,T,SoFar2,Dom2,Ran,WF)). |
2474 | | |
2475 | | :- block prop_empty_pred_false(-,?). |
2476 | | prop_empty_pred_false([],R) :- !, R=pred_false. |
2477 | | prop_empty_pred_false(_,_). |
2478 | | |
2479 | | :- block not_pf3(-,?,?,?,?,?). |
2480 | | not_pf3(pred_false,_T,_SoFar,_Dom2,_Ran,_WF). /* illegal range */ |
2481 | | not_pf3(pred_true,T,SoFar,Dom2,Ran,WF) :- |
2482 | | not_pf(T,SoFar,Dom2,Ran,WF). |
2483 | | |
2484 | | :- 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)). |
2485 | | :- 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)). |
2486 | | :- 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)). |
2487 | | :- 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)). |
2488 | | :- assert_must_succeed((bsets_clp:partial_function([],[int(1)],[int(7)]))). |
2489 | | :- assert_must_succeed((bsets_clp:partial_function(X,[int(1)],[int(7)]), |
2490 | | X = [(int(1),int(7))])). |
2491 | | :- assert_must_succeed((bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]), |
2492 | | equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
2493 | | :- assert_must_succeed((findall(X,bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),L), |
2494 | | length(L,Len), Len >= 4, |
2495 | | (preferences:get_preference(convert_comprehension_sets_into_closures,true) -> true ; Len=4) )). |
2496 | | :- assert_must_succeed((bsets_clp:partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2497 | | [int(7),int(6)]), |
2498 | | equal_object(X,[([(int(1),int(2))],int(7)), |
2499 | | ([(int(2),int(3)),(int(1),int(3))],int(6))]))). |
2500 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2501 | | [int(7),int(6)],_WF), |
2502 | | X = [([(int(2),int(3)),(int(1),int(3))],int(6))])). |
2503 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2504 | | [int(7),int(6)],_WF), |
2505 | | X = [([(int(1),int(2))],int(7)), |
2506 | | ([(int(2),int(3)),(int(1),int(3))],int(6))])). |
2507 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,[int(1)],[[int(7),int(6)]],_WF), |
2508 | | X = [(int(1),[int(6),int(7)])])). |
2509 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF), |
2510 | | X = [(int(1),int(7)),(int(5),int(75))])). |
2511 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF), |
2512 | | X = [(int(1),int(7)),(int(0),int(7))])). |
2513 | | :- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF), |
2514 | | X = [(int(1),int(7)),(int(-1),int(7))])). |
2515 | | :- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF), |
2516 | | X = [(int(1),int(7)),(int(0),int(7))])). |
2517 | | :- assert_must_fail((bsets_clp:partial_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2518 | | X = [(int(2),int(7)),(int(2),int(6))])). |
2519 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('Name'),global_set('Code'),_WF), |
2520 | | X = [(fd(1,'Name'),fd(1,'Code'))])). |
2521 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF), |
2522 | | X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])). |
2523 | | :- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF), |
2524 | | X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])). |
2525 | | |
2526 | | partial_function(R,Domain,Range) :- init_wait_flags(WF), |
2527 | | partial_function_wf(R,Domain,Range,WF), |
2528 | | % print(grounding_pf_wait_flags(WF)),nl, |
2529 | | ground_wait_flags(WF). |
2530 | | |
2531 | | :- use_module(kernel_equality,[get_cardinality_powset_wait_flag/5]). |
2532 | | :- block partial_function_wf(-,-,?,?). |
2533 | | partial_function_wf(R,_Domain,_Range,_WF) :- R==[], !. |
2534 | | partial_function_wf(R,Domain,Range,WF) :- (Domain==[] ; Range==[]), !, empty_set_wf(R,WF). |
2535 | ? | partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
2536 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
2537 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
2538 | | % print_term_summary(partial_fun_dom(FF,FFDomain,Range)), |
2539 | | check_subset_of_wf(FFDomain,Domain,WF). |
2540 | | partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF), |
2541 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!, |
2542 | | % same as for total_function_wf check |
2543 | | %print(check_special(FF,FFDomain,FFRange)),nl, |
2544 | | check_subset_of_wf(FFDomain,Domain,WF), |
2545 | | check_subset_of_wf(FFRange,Range,WF). %, print(special_partial_fun(FF)),nl. |
2546 | | partial_function_wf(R,Domain,Range,WF) :- %print(pf(R)),nl, |
2547 | | expand_and_convert_to_avl_set_warn(R,AER,partial_function_wf,'ARG : ? +-> ?'),!, |
2548 | | % print_term_summary(check_is_avl_partial_function(avl_set(AER),Domain,Range)), |
2549 | | is_avl_partial_function(AER), |
2550 | | is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl, |
2551 | | is_avl_relation_over_range(AER,Range,WF). |
2552 | | partial_function_wf(R,Domain,Range,WF) :- %% print(pf(R,Domain,Range,WF)),nl, %% |
2553 | | %we used to call: |
2554 | | get_cardinality_powset_wait_flag(Domain,partial_function_wf,WF,Card,CWF), |
2555 | | % probably we should compute real cardinality of set of partial functions over Domain +-> Range ? |
2556 | | % the powset waitflag uses 2^Card as priority; is the number of partial functions when Range contains just a single element |
2557 | | % slows down test 1088: TO DO investigate |
2558 | | % get_cardinality_partial_function_wait_flag(Domain,Range,partial_function_wf,WF,Card,_,CWF), |
2559 | | %% Maybe we should only enumerate partial functions for domain variables ; e.g., not f <+ {x |-> y} : T +-> S |
2560 | | %% print_bt_message(pf_dom_card(Card)),nl, %%% |
2561 | | % probably we should use a special version when R is var |
2562 | | propagate_empty_set(Domain,R), |
2563 | | propagate_empty_set(Range,R), |
2564 | | (var(R) -> pf_var_r(R,var,Domain,Range,Card,WF,CWF) ; pf_var_r(R,nonvar,Domain,Range,Card,WF,CWF)). |
2565 | | |
2566 | | % if first argument is empty, second argument must also be empty |
2567 | | :- block propagate_empty_set(-,?). |
2568 | | propagate_empty_set([],A) :- !, |
2569 | | % (A==[] -> true ; print(prop_empty(A)),nl), %% |
2570 | | kernel_objects:empty_set(A). % TO DO: add WF |
2571 | | propagate_empty_set(_,_). |
2572 | | |
2573 | | :- block pf_var_r(-,?,?,?,?,?,-). |
2574 | | 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 |
2575 | | expand_and_convert_to_avl_set_warn(R,AER,pf_var_r,'ARG : ? +-> ?'),!, |
2576 | | % print_term_summary(check_is_avl_partial_function(avl_set(AER),Domain,Range)), |
2577 | | is_avl_partial_function(AER), |
2578 | | is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl, |
2579 | | is_avl_relation_over_range(AER,Range,WF). |
2580 | | pf_var_r(R,_,Domain,Range,Card,WF,CWF) :- |
2581 | | expand_custom_set_to_list_wf(R,ER,_,partial_function_wf,WF), |
2582 | | % print(expanded(R,ER,CWF)),nl, |
2583 | | %get_last_wait_flag(partial_fun(Domain),WF,LWF), |
2584 | | pf_w(ER,[],Domain,Range,Card,_Large,WF,CWF). |
2585 | | |
2586 | | pf_w(T,SoFar,Dom,Ran,Card,Large,WF,LWF) :- |
2587 | | (Card==0 -> T=[] |
2588 | | ; pf(T,SoFar,Dom,Ran,Card,Large,WF,LWF)). |
2589 | | |
2590 | | :- block pf(-,?,?,?,?,?,?,-). |
2591 | | pf(LIST,_,_,_,_,_WF,_,_LWF) :- LIST==[],!. % avoid leaving choicepoint |
2592 | | pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF) :- nonvar(AVL),AVL=avl_set(_A), |
2593 | | add_internal_error('AVL arg: ',pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF)),fail. |
2594 | | pf([],_,_,_,_,_WF,_,_LWF). |
2595 | | pf(LIST,SoFar,Dom,Ran,Card,Large,WF,LWF) :- |
2596 | | (var(LIST) -> ListWasVar = true ; ListWasVar = false), % is ListWasVar = true we are doing the enumeration driven by LWF being ground |
2597 | | LIST = [(X,Y)|T], |
2598 | | dec_card(Card,NC),/* Card ensures we do not build too big lists */ |
2599 | | Dom \== [], |
2600 | | remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done), |
2601 | | %% prints(rem_dom(X,Dom,Dom2,Card,Done)),nl, %% |
2602 | | check_element_of_wf(Y,Ran,WF), |
2603 | | pf1(Done, X,Y,T,SoFar,Dom2,Ran,NC,Large,WF,LWF). |
2604 | | |
2605 | | :- block dec_card(-,?). |
2606 | | dec_card(inf,NewC) :- !, NewC=inf. |
2607 | | dec_card(C,NewC) :- C>0, NewC is C-1. |
2608 | | |
2609 | | :- block pf1(-, ?,?,?,?,?,?,?,?,?,?). |
2610 | | pf1(_Done, X,_Y,T,SoFar,Dom2,Ran,Card,Large,WF,LWF) :- |
2611 | | not_element_of_wf(X,SoFar,WF), /* check that it is a function */ |
2612 | | %% check_element_of_wf(Y,Ran,WF), % this check is now done above in pf |
2613 | | % prints(check(Y,Ran)), %% |
2614 | | add_new_element_wf(X,SoFar,SoFar2,WF), %print(added(SoFar2)),nl, |
2615 | | pf_w(T,SoFar2,Dom2,Ran,Card,Large,WF,LWF). |
2616 | | |
2617 | | remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done) :- compute_large(Dom,Large), |
2618 | | ((ListWasVar==true,var(X),var(Y),Large==false, |
2619 | | preference(convert_comprehension_sets_into_closures,false), % not in symbolic mode |
2620 | | kernel_tools:ground_value(Dom)) |
2621 | | -> %% (X, Y are free and we drive the enumeration: we can influence which element is taken from Dom |
2622 | | % print_term_summary(removing_minimal_element(X,Y,Dom)), |
2623 | | remove_a_minimal_element(X,Dom,Dom2,WF,Done) %%%%%%%%%% added Jul 15 2008 |
2624 | | %,print_term_summary(done(X,Dom2,Done)) ) |
2625 | | ; remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,LWF,Done) |
2626 | | ). |
2627 | | compute_large(Dom,Large) :- % check if the domain is large; ensure that we compute this only once |
2628 | | (nonvar(Large) -> true |
2629 | | ; var(Dom) -> true |
2630 | | ; dont_expand_this_explicit_set(Dom) -> Large=large |
2631 | | ; Large=false). |
2632 | | |
2633 | | :- assert_must_succeed(( bsets_clp:remove_a_minimal_element(X,[int(1)],R,_WF,Done), |
2634 | | X==int(1), Done==true, R=[] )). |
2635 | | :- 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), |
2636 | | X==int(2), Done==true, R=[int(3)] )). |
2637 | | :- 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), |
2638 | | X==int(1), R=[int(2),int(3)], Done==true )). |
2639 | | :- 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), |
2640 | | X==int(3), R=[], Done==true )). |
2641 | | :- assert_must_succeed(( init_wait_flags(WF), CL=closure(['_zzzz_binary'],[integer],b(member( b(identifier('_zzzz_binary'),integer,[]), |
2642 | | b(interval(b(value(int(1)),integer,[]),b(value(int(10)),integer,[])),set(integer),[])),pred,[])), |
2643 | | bsets_clp:remove_a_minimal_element(X,CL,R,WF,Done), ground_wait_flags(WF), |
2644 | | X=int(9), Done==true, kernel_objects:equal_object(R,[int(10)]) )). |
2645 | | |
2646 | | /* usage: restrict number of possible choices if element to remove is free */ |
2647 | | /* select one element; and disallow all elements appearing before it in the list */ |
2648 | | remove_a_minimal_element(X,Set,Res,WF,Done) :- |
2649 | | expand_custom_set_to_list_wf(Set,ESet,EDone,remove_a_minimal_element,WF), |
2650 | | remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done). |
2651 | | |
2652 | | :- use_module(kernel_equality,[get_cardinality_wait_flag/4]). |
2653 | | :- block remove_a_minimal_element2(?,?,-,?,?,?). |
2654 | | remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done) :- var(ESet), |
2655 | | % should not happen as we wait for EDone |
2656 | | add_internal_error('Illegal call: ',remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done)), |
2657 | | fail. |
2658 | | remove_a_minimal_element2(X,ESet,_EDone,Res,WF,Done) :- |
2659 | | % print(removing_minimal_element2(X,ESet,Res,WF)),nl,% |
2660 | | ESet \= [], |
2661 | | (ESet = [El] |
2662 | | -> X=El, empty_set_wf(Res,WF), Done=true % only one choice |
2663 | | ; get_cardinality_wait_flag(ESet,remove_a_minimal_element2,WF,CWF), |
2664 | | remove_a_minimal_element3(X,ESet,Res,WF,Done,CWF) |
2665 | | ). |
2666 | | |
2667 | | :- block remove_a_minimal_element3(?,?,?,?,?,-). |
2668 | | remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- var(Res), !, |
2669 | | append(_,[X|TRes],ESet), % WHAT IF Res has been instantiated in the meantime ??? |
2670 | | equal_object_wf(Res,TRes,remove_a_minimal_element2_2,WF),Done=true. |
2671 | | remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- print(remove_min_nonvar_res(Res)),nl, |
2672 | | equal_cons_wf(ESet,X,Res,WF), Done=true. |
2673 | | |
2674 | | |
2675 | | |
2676 | | |
2677 | | |
2678 | | :- 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)). |
2679 | | :- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[int(7)]), |
2680 | | X = [(int(1),int(7))])). |
2681 | | :- assert_must_succeed((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]), |
2682 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
2683 | | :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3))]],[int(7),int(6)]), |
2684 | | kernel_objects:equal_object(X,[([(int(1),int(3))],int(7)),([(int(1),int(2))],int(7))]))). |
2685 | | :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2686 | | [int(7),int(6)]), |
2687 | | kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)), |
2688 | | ([(int(2),int(3)),(int(1),int(3))],int(6))]))). |
2689 | | :- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[[int(7),int(6)]]), |
2690 | | kernel_objects:equal_object(X,[(int(1),[int(6),int(7)])]))). |
2691 | | :- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2692 | | [[int(7),int(6)]]), |
2693 | | kernel_objects:equal_object(X,[([(int(1),int(2))],[int(6),int(7)]), |
2694 | | ([(int(2),int(3)),(int(1),int(3))],[int(6),int(7)])]))). |
2695 | | :- assert_must_succeed((bsets_clp:total_function(X,[ [(int(1),int(3)),(int(2),int(3))]], |
2696 | | [int(6)]), |
2697 | | kernel_objects:equal_object(X,[ ([(int(2),int(3)),(int(1),int(3))], int(6)) ]))). |
2698 | | :- assert_must_succeed((bsets_clp:total_function(X,global_set('Name'), |
2699 | | [[],[fd(1,'Code'),fd(2,'Code')],[fd(1,'Code')],[fd(2,'Code')]]), |
2700 | | kernel_objects:enumerate_basic_type(X,set(couple(global('Name'),set(global('Code'))))), |
2701 | | kernel_objects:equal_object(X,[(fd(3,'Name'),[fd(2,'Code')]),(fd(1,'Name'),[fd(2,'Code')]),(fd(2,'Name'),[])]))). |
2702 | | |
2703 | | %:- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF),bsets_clp:total_function_wf(TF,global_set('Code'), |
2704 | | % closure([zzzz],[set(set(couple(integer,boolean)))], |
2705 | | % member(identifier(zzzz), |
2706 | | % pow_subset(value(closure([zzzz],[set(couple(integer,boolean))], |
2707 | | % member('ListExpression'(['Identifier'(zzzz)]), |
2708 | | % 'Seq'(value([pred_true /* bool_true */,pred_false /* bool_false */])))))))),WF), |
2709 | | % % print(tf(TF)),nl, |
2710 | | % 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 */)]]), |
2711 | | % (fd(2,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]) ]), |
2712 | | % print(gr(WF)),nl, |
2713 | | % kernel_waitflags:ground_wait_flags(WF) )). |
2714 | | |
2715 | | :- assert_must_succeed((bsets_clp:total_function([],[],[int(7)]))). |
2716 | | |
2717 | | :- assert_must_fail((bsets_clp:total_function([],[int(1)],[int(7)]))). |
2718 | | :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]), |
2719 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))). |
2720 | | :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]), |
2721 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(5))]))). |
2722 | | :- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]), |
2723 | | kernel_objects:equal_object(X,[(int(2),int(7))]))). |
2724 | | :- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2725 | | [int(7),int(6)]), |
2726 | | kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)), |
2727 | | ([(int(1),int(3)),(int(1),int(3))],int(6))]))). |
2728 | | :- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]], |
2729 | | [int(7),int(6)]), |
2730 | | kernel_objects:equal_object(X,[([(int(1),int(3)),(int(1),int(3))],int(6))]))). |
2731 | | |
2732 | | total_function(R,Domain,Range) :- init_wait_flags(WF), |
2733 | | total_function_wf(R,Domain,Range,WF), |
2734 | | ground_wait_flags(WF). |
2735 | | |
2736 | | |
2737 | | :- assert_must_succeed((bsets_clp:total_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2738 | | nonvar(X),X=[(A,B),(C,D)],A==int(1),C==int(2),\+ ground(B),\+ ground(D), B=int(7),D=int(7) )). |
2739 | | |
2740 | | :- block total_function_wf(-,-,-,?). |
2741 | | total_function_wf(FF,Domain,_Range,WF) :- FF == [],!, |
2742 | | empty_set_wf(Domain,WF). |
2743 | | total_function_wf(FF,Domain,Range,WF) :- |
2744 | | Range == [],!, |
2745 | | empty_set_wf(FF,WF), empty_set_wf(Domain,WF). |
2746 | | total_function_wf(FF,Domain,Range,WF) :- |
2747 | | % TO DO: if FF or Domain nonvar but \= [] -> check if other variable becomes [] |
2748 | | total_function_wf1(FF,Domain,Range,WF). |
2749 | | |
2750 | | :- block total_function_wf1(?,-,?,?). |
2751 | | total_function_wf1(FF,Domain,_Range,WF) :- |
2752 | | FF==[],!, |
2753 | | empty_set_wf(Domain,WF). |
2754 | | total_function_wf1(FF,Domain,Range,WF) :- |
2755 | ? | nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
2756 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
2757 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
2758 | | % print_term_summary(total_fun_dom(FF,FFDomain,Range)), |
2759 | | equal_object_wf(FFDomain,Domain,total_function_wf1_1,WF). |
2760 | | total_function_wf1(FF,Domain,Range,WF) :- nonvar(FF), |
2761 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!, |
2762 | | equal_object_wf(FFDomain,Domain,total_function_wf1_2,WF), check_subset_of_wf(FFRange,Range,WF) |
2763 | | .%, print(special_total_fun(FF)),nl. |
2764 | | total_function_wf1(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !, |
2765 | | total_function_avl_set(AEF,Domain,Range,WF). |
2766 | | total_function_wf1(FF,Domain,Range,WF) :- |
2767 | | % want to replace FF by closure: needs to be a variable! |
2768 | | var(FF), |
2769 | | % if the total function can not be build up explicitely (i.e. infinite domain) |
2770 | | % TODO: can / should this be relaxed? |
2771 | | custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card), |
2772 | | Card == inf, |
2773 | | kernel_objects:infer_value_type(Domain,set(DomT)), |
2774 | | kernel_objects:infer_value_type(Range,set(RanT)), |
2775 | | !, |
2776 | | % IDEA : TF = %x.(x:Domain|DEFAULT) <+ SFF, where SFF is partial function and DEFAULT is some default value |
2777 | | % build up a partial function instead (fulfilling all constraints) |
2778 | | partial_function_wf(SFF,Domain,Range,WF), |
2779 | | % next, build up a total function mapping everything to a default value |
2780 | | % this function will be overriden by the partial function to fulfilling |
2781 | | % given constraints |
2782 | | % 1. identifiers for closure |
2783 | | create_texpr(identifier('__domid__'),DomT,[],TDomId), |
2784 | | create_texpr(identifier('__ranid__'),RanT,[],TRanId), |
2785 | | % 2. domain identifier might take all values of the domain |
2786 | | create_texpr(member(TDomId,b(value(Domain),set(DomT),[])),pred,[],DomMember), |
2787 | | % 3. pick a single value for the range identifier |
2788 | | check_element_of_wf(RangeElement,Range,WF), |
2789 | | %% external_functions:observe_value(RangeElement,"range"),external_functions:observe_value(SFF,"pf"), |
2790 | | create_texpr(equal(TRanId,b(value(RangeElement),RanT,[])),pred,[],RanMember), |
2791 | | % 4. conjunct and form closure (should be treated symbolically) |
2792 | | conjunct_predicates([RanMember,DomMember],Pred), |
2793 | | Default = closure(['__domid__','__ranid__'],[DomT,RanT],Pred), |
2794 | | % 5. override default values where needed |
2795 | | override_relation(Default,SFF,FF,WF). |
2796 | | total_function_wf1(R,Domain,Range,WF) :- % print(total_function(R,Domain,Range,WF)),nl, |
2797 | | try_expand_and_convert_to_avl_with_check(Domain,EDomain,total_function), % avoid multiple expansions, but useless when dom_for_lambda_closure case triggers below ! TO DO: fix |
2798 | | % print(EDomain),nl, |
2799 | | % TO DO: maybe avoid converting intervals which are not fully instantiated ? |
2800 | | % 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 |
2801 | | try_expand_and_convert_to_avl_unless_large(R,ER), |
2802 | | total_function_wf2(ER,EDomain,Range,WF). |
2803 | | |
2804 | | :- block total_function_wf2(?,-,?,?). |
2805 | | total_function_wf2(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !, |
2806 | | total_function_avl_set(AEF,Domain,Range,WF). |
2807 | | total_function_wf2(R,Domain,Range,WF) :- %print_term_summary(total_function_wf2(R,Domain,Range,WF)), |
2808 | | cardinality_as_int_wf(Domain,int(Card),WF), |
2809 | | total_function_wf3(R,Card,Domain,Range,WF). |
2810 | | |
2811 | | total_function_wf3(FF,Card,Domain,Range,WF) :- nonvar(FF), |
2812 | | (number(Card) -> Card > 10000 ; true), |
2813 | | custom_explicit_sets:dom_for_lambda_closure(FF,FFDomain), |
2814 | | % we have a lambda closure where we cannot determine the range, otherwise dom_range_for_specific_closure would have succeeded |
2815 | | % example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 --> NATURAL |
2816 | | FF = closure(P,T,Pred), |
2817 | | get_range_id_expression(P,T,TRangeID), |
2818 | | !, |
2819 | | equal_object_wf(FFDomain,Domain,total_function1_closure,WF), |
2820 | | % CHECK not(#P.(Pred & P /: Range)) |
2821 | | % print(try_symbolic_range_check(P)), translate:print_bexpr(TRangeID),nl, %trace, |
2822 | | ExpectedRange = b(value(Range),set(RanT),[]), get_texpr_type(TRangeID,RanT), |
2823 | | safe_create_texpr(not_member(TRangeID,ExpectedRange),pred,NotMemCheck), |
2824 | | conjunct_predicates([Pred,NotMemCheck],Pred2), |
2825 | | is_empty_closure_wf(P,T,Pred2,WF). |
2826 | | % custom_explicit_sets:ran_symbolic(closure(P,T,Pred),RanSymbolic), check_subset_of_wf(RanSymbolic,Range,WF). |
2827 | | total_function_wf3(R,Card,Domain,Range,WF) :- |
2828 | | %print('TF '),translate:print_bvalue(R),nl, |
2829 | | card_convert_int_to_peano(Card,PeanoCard), |
2830 | | % print(tf_card(R,Domain,Card)),nl, trace, |
2831 | | ((nonvar(R);ground(PeanoCard))-> true |
2832 | | ; get_last_wait_flag(total_fun(Domain),WF,WF1)), |
2833 | | when((nonvar(R);ground(PeanoCard); |
2834 | | (nonvar(PeanoCard),nonvar(WF1))), /* mal 12/5/04: changed , into ; 17/3/2008: added WF1 */ |
2835 | | /* reason for delaying nonvar(Card): Card grounded bit by bit by cardinality; avoid |
2836 | | triggering too early and missing tf_var */ |
2837 | | total_function1(R,PeanoCard,Domain,Range,WF |
2838 | | )). |
2839 | | |
2840 | | :- use_module(bsyntaxtree,[safe_create_texpr/3]). |
2841 | | :- use_module(library(lists),[last/2]). |
2842 | | % for a closure get the identifier or proj expression that represents range values |
2843 | | get_range_id_expression([PairID],[Type],Res) :- !, |
2844 | | Type = couple(_,TX), |
2845 | | TP = b(identifier(PairID),Type,[]), |
2846 | | safe_create_texpr(second_of_pair(TP),TX,Res). % prj2(PairID) , |
2847 | | %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 |
2848 | | % but currently lambda closure detection in dom_for_lambda_closure cannot handle such closures anyway |
2849 | | get_range_id_expression(P,T,b(identifier(ID),Type,[])) :- last(P,ID), last(T,Type). |
2850 | | |
2851 | | total_function_avl_set(AEF,Domain,Range,WF) :- |
2852 | | %print(total_function_avl(avl_set(AEF),Dom,Range)),nl, |
2853 | | (Domain = avl_set(Dom) -> is_avl_total_function_over_domain(AEF,Dom) |
2854 | | ; is_avl_partial_function(AEF), |
2855 | | domain_of_explicit_set(avl_set(AEF),AEF_Domain), |
2856 | | equal_object_wf(AEF_Domain,Domain,total_function_avl_set,WF) |
2857 | | ), |
2858 | | is_avl_relation_over_range(AEF,Range,WF). |
2859 | | %total_function1(FF,Card,Domain,Range,WF) :- nonvar(FF), |
2860 | | % custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)), |
2861 | | % print(dom_range_for_specific_closure(FF,FFDomain,Domain,FFRange,Range)),nl,fail. |
2862 | | |
2863 | | |
2864 | | total_function1(FF,_,Domain,Range,WF) :- |
2865 | | expand_and_convert_to_avl_set_warn(FF,AEF,total_function1,'ARG : ? --> ?'),!, |
2866 | | total_function_avl_set(AEF,Domain,Range,WF). |
2867 | | total_function1(R,Card,Domain,Range,WF) :- |
2868 | | try_expand_custom_set(R,ER), |
2869 | | total_function2(ER,Card,Domain,Range,WF). |
2870 | | |
2871 | | total_function2(ER,Card,Domain,Range,WF) :- |
2872 | | var(ER),ground(Card),!, % print(tf_var(Card)),nl, |
2873 | | tf_var(TotalFunction,[],Card,Domain,Range,WF), %print(TotalFunction),nl, |
2874 | | ER=TotalFunction. |
2875 | | total_function2(ER,Card,Domain,Range,WF) :- |
2876 | | (ground(Card) -> get_wait_flag(0,tot_fun,WF,LWF) % we seem to know the domain exactly now; see e.g. test 1316 |
2877 | | ; 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 ? |
2878 | | %print(tf(ER,Card,Domain,LWF)),nl, |
2879 | | tf(ER,[],Card,Domain,Range,WF,LWF). |
2880 | | |
2881 | | :- block tf(-,?,-,?,?,?,?),tf(-,?,?,?,?,?,-). |
2882 | | % tf(X,SoFar,C,Dom,Ran,WF,LWF) :- print_message(tf(X,SoFar,C,Dom,Ran,WF,LWF)),nl,fail. |
2883 | | tf([],_,0,Dom,_,WF,_) :- empty_set_wf(Dom,WF). |
2884 | | tf(FUN,SoFar,s(Card),Dom,Ran,WF,LWF) :- var(FUN),nonvar(Dom), % try setting up skeleton for total fun |
2885 | | remove_exact_first_element(X,Dom,Dom2),not_element_of_wf(X,SoFar,WF),var(FUN),!, |
2886 | | FUN = [(X,Y)|T], tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF). |
2887 | | tf([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF,LWF) :- |
2888 | | not_element_of_wf(X,SoFar,WF), %print(not_el(X)),nl, |
2889 | | remove_element_wf(X,Dom,Dom2,WF), %mal: 17/3/08 changed to _wf version |
2890 | | tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF). |
2891 | | tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF) :- |
2892 | | check_element_of_wf(Y,Ran,WF), % print_message(chk(Y,Ran)), |
2893 | | %when((nonvar(T);nonvar(Card)), /* mal 12/5/04: changed , into ; */ |
2894 | | add_new_element_wf(X,SoFar,SoFar2,WF), %%% try_expand_and_convert_to_avl |
2895 | | tf(T,SoFar2,Card,Dom2,Ran,WF,LWF). |
2896 | | |
2897 | | :- block tf_var(-,?,-,?,?,?). |
2898 | | tf_var(F,_,Card,Dom,_,WF) :- Card==0,!,F=[],empty_set_wf(Dom,WF). % avoid choice point |
2899 | | tf_var([],_,0,Dom,_,WF) :- empty_set_wf(Dom,WF). %, print_bt_message(finished_tf_var). |
2900 | | tf_var([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF) :- %print_bt_message(tf_var(X,Y,SoFar,Card)), |
2901 | | /* supposes that X + Y are unbound */ |
2902 | | /* TO DO: rewrite like enumerate <-------------------------- */ |
2903 | | ((var(X),var(Y)) -> true ; (print_message(warning,'Nonvar in tf_var: '), |
2904 | | print_message(warning,((X,Y))))), |
2905 | | remove_exact_first_element(X,Dom,Dom2), |
2906 | | not_element_of_wf(X,SoFar,WF), |
2907 | | % print_message(check_element_of_wf(Y,Ran,WF)), |
2908 | | check_element_of_wf(Y,Ran,WF), |
2909 | | % print_message(checked(Y,Ran)), |
2910 | | add_new_element_wf(X,SoFar,SoFar2,WF), |
2911 | | tf_var(T,SoFar2,Card,Dom2,Ran,WF). |
2912 | | |
2913 | | |
2914 | | |
2915 | | :- assert_must_succeed((bsets_clp:total_bijection(X,[int(1)],[int(7)]), |
2916 | | X = [(int(1),int(7))])). |
2917 | | :- assert_must_succeed((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]), |
2918 | | kernel_objects:equal_object(X,[(int(2),int(8)),(int(1),int(7))]))). |
2919 | | :- assert_must_fail((bsets_clp:total_bijection(X,[int(1)],[int(7),int(3)]), |
2920 | | X = [(int(1),int(7))])). |
2921 | | :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(3)]), |
2922 | | X = [(int(1),int(3)),(int(2),int(3))])). |
2923 | | :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]), |
2924 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
2925 | | :- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]), |
2926 | | X = [(int(1),int(7)),(int(1),int(8))])). |
2927 | | |
2928 | | |
2929 | | |
2930 | | total_bijection(R,Domain,Range) :- init_wait_flags(WF), |
2931 | | total_bijection_wf(R,Domain,Range,WF), |
2932 | | ground_wait_flags(WF). |
2933 | | |
2934 | | :- block total_bijection_wf(?,-,?,?). |
2935 | | total_bijection_wf(FF,Domain,Range,WF) :- nonvar(FF), |
2936 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!, |
2937 | | equal_object_wf(FFDomain,Domain,total_bijection_wf_1,WF), |
2938 | | equal_object_wf(FFRange,Range,total_bijection_wf_2,WF). |
2939 | | %(R,Domain,Range,WF) :- Domain==Range,!, print(eq_domain_range),nl, total_injection_wf(R,Domain,Range,WF). |
2940 | | total_bijection_wf(R,Domain,Range,WF) :- % print_term_summary(total_bijection_wf(R,Domain,Range)), |
2941 | | cardinality_peano_wf(Domain,Card,WF), % TO DO: deal with infinite and large card |
2942 | | %print(card_domain(Domain,Card)),nl, |
2943 | | cardinality_peano_wf(Range,Card,WF), % Domain and Range must have same cardinality |
2944 | | %print(card_range(Range,Card)),nl, |
2945 | | %when(ground(Range),(print(ground_range(Range,Card,Domain)),nl)), |
2946 | | %when(nonvar(Card), (print(nonvar_card(Card,Domain,Range)),nl)), |
2947 | | %when(ground(Card), (print(ground_card(Card,Domain,Range)),nl)), |
2948 | | total_injection_wf2(R,Domain,Range,WF). % TO DO: use cardinality_as_int_wf ? makes test 1194 fail |
2949 | | |
2950 | | %Note: we used to call custom code: total_bijection_wf2(R,Domain,Card,Range,WF). |
2951 | | % total_injection_wf2 gives a considerable performance boost, e.g., for test 1222 ClearSy/alloc_large.mch or NQueens with >->> |
2952 | | |
2953 | | :- 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)). |
2954 | | :- 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)). |
2955 | | :- 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)). |
2956 | | :- 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)). |
2957 | | :- assert_must_fail((bsets_clp:not_total_function(X,[int(1)],[int(7)],_WF), |
2958 | | X = [(int(1),int(7))])). |
2959 | | :- assert_must_fail((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2960 | | X = [(int(2),int(7)),(int(1),int(7))])). |
2961 | | :- assert_must_succeed((bsets_clp:not_total_function([],[int(1)],[int(7)],_WF))). |
2962 | | :- assert_must_succeed((bsets_clp:not_total_function([],[global_set('NAT1')],[global_set('Name')],_WF))). |
2963 | | :- assert_must_succeed((bsets_clp:not_total_function([(int(7),int(7))],[int(1)],[int(7)],_WF))). |
2964 | | :- assert_must_succeed((bsets_clp:not_total_function([(int(1),int(7)), (int(2),int(1))], |
2965 | | [int(1),int(2)],[int(7)],_WF))). |
2966 | | :- assert_must_succeed((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF), |
2967 | | X = [(int(2),int(7)),(int(2),int(6))])). |
2968 | | |
2969 | | :- block not_total_function(-,?,?,?), not_total_function(?,-,?,?). |
2970 | ? | not_total_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
2971 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
2972 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
2973 | | not_equal_object_wf(FFDomain,Domain,WF). |
2974 | | not_total_function(FF,Domain,Range,WF) :- nonvar(FF), |
2975 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!, |
2976 | | %print_term_summary(check_special_not_tf(FF,FFDomain,FFRange)),nl, |
2977 | | equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set |
2978 | | when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))). |
2979 | | % this clause is unsound: it prevents finite partial functions as solutions to not_total_function over an infinite domain |
2980 | | %not_total_function(FF,Domain,Range,WF) :- |
2981 | | % custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card), |
2982 | | % Card == inf, !, % cardinality is too large for avl expansion to be viable |
2983 | | % not_partial_function(FF,Domain,Range,WF). % so search for something that is not even a partial function |
2984 | | not_total_function(R,Domain,Range,WF) :- |
2985 | | % print_term_summary(not_total_function(R,Domain,Range,WF)), |
2986 | | try_expand_and_convert_to_avl_with_check(R,ER,not_total_function_range), |
2987 | | try_expand_and_convert_to_avl_with_check(Domain,EDomain,not_total_function_domain), /* avoid multiple expansions */ |
2988 | | % print_term_summary(exp_domain(EDomain)), |
2989 | | try_expand_and_convert_to_avl_unless_large(Range,ERange), |
2990 | | % print_term_summary(exp_range(ERange)), |
2991 | | not_total_function2(ER,EDomain,ERange,WF). |
2992 | | |
2993 | | % repeat block, in case Domain or R is a closure |
2994 | | :- block not_total_function2(-,?,?,?), not_total_function2(?,-,?,?). |
2995 | | not_total_function2(R,Domain,Range,WF) :- %print_term_summary(not_tot2(R,Domain,Range)), |
2996 | | expand_and_convert_to_avl_set_warn(R,AER,not_total_function2,'ARG /: ? --> ?'), |
2997 | | !, |
2998 | | not_total_function_avl(AER,Domain,Range,WF). |
2999 | | not_total_function2(R,EDomain,ERange,WF) :- |
3000 | | expand_custom_set_to_list_wf(R,ER,_,not_total_function2,WF), |
3001 | | %print_term_summary(not_tf(R,ER)),nl, |
3002 | | not_tf(ER,[],EDomain,ERange,WF). |
3003 | | |
3004 | | not_total_function_avl(_AER,Domain,_Range,_WF) :- is_infinite_explicit_set(Domain),!, |
3005 | | true. % a finite AVL set cannot be a total function over an infinite domain |
3006 | | not_total_function_avl(AER,Domain,Range,WF) :- |
3007 | | expand_and_convert_to_avl_set_warn(Domain,ADom,not_total_function2,'? /: ARG --> ?'), |
3008 | | !, |
3009 | | % print_term_summary(check_is_not_avl_total_function(avl_set(AER),Domain,Range)), |
3010 | | (is_avl_total_function_over_domain(AER,ADom) |
3011 | | -> % print(is_tf),nl, |
3012 | | is_not_avl_relation_over_range(AER,Range,WF) % TO DO: check only Range ! |
3013 | | ; true %,print(not_pf),nl |
3014 | | ). |
3015 | | not_total_function_avl(AER,EDomain,ERange,WF) :- |
3016 | | expand_custom_set_to_list_wf(avl_set(AER),ER,_,not_total_function_avl,WF), |
3017 | | not_tf(ER,[],EDomain,ERange,WF). |
3018 | | |
3019 | | |
3020 | | :- use_module(kernel_equality,[membership_test_wf_with_force/4]). |
3021 | | |
3022 | | :- block not_tf(-,?,?,?,?). |
3023 | | not_tf([],_,Domain,_,WF) :- not_empty_set_wf(Domain,WF). |
3024 | | not_tf([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf_with_force(SoFar,X,MemRes,WF), |
3025 | | not_tf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
3026 | | |
3027 | | :- block not_tf2(-,?,?,?, ?,?,?,?). %, not_tf2(?,?,?,?, -,?,?), not_tf2(?,?,?,?, ?,-,?). |
3028 | | not_tf2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).% :- check_element_of_lazy(X,SoFar,WF). |
3029 | | not_tf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :- |
3030 | | %not_element_of_wf(X,SoFar,WF), |
3031 | | membership_test_wf_with_force(Dom,X,MemRes,WF), |
3032 | | not_tf3(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
3033 | | |
3034 | | :- block not_tf3(-, ?,?,?,?, ?,?,?). |
3035 | | not_tf3(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). |
3036 | | not_tf3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :- |
3037 | | remove_element_wf(X,Dom,Dom2,WF), |
3038 | | membership_test_wf_with_force(Ran,Y,MemRes,WF), |
3039 | | not_tf4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF). |
3040 | | |
3041 | | :- block not_tf4(-, ?,?,?,?, ?,?,?). |
3042 | | not_tf4(pred_false,_X,_Y,_T,_SoFar,_Dom2,_Ran,_WF). |
3043 | | not_tf4(pred_true,X,_Y,T,SoFar,Dom2,Ran,WF) :- |
3044 | | %check_element_of_wf(Y,Ran,WF), %DO WE NEED THIS ???? |
3045 | | add_new_element_wf(X,SoFar,SoFar2,WF), |
3046 | | not_tf(T,SoFar2,Dom2,Ran,WF). |
3047 | | |
3048 | | |
3049 | | |
3050 | | :- 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)). |
3051 | | :- 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)). |
3052 | | :- 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)). |
3053 | | :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1)],[int(7)],_WF), |
3054 | | X = [(int(1),int(7))])). |
3055 | | :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF), |
3056 | | X = [(int(2),int(7)),(int(1),int(6))])). |
3057 | | :- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF), |
3058 | | X = [(int(1),int(7)),(int(2),int(6))])). |
3059 | | :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(3)],_WF), |
3060 | | X = [(int(1),int(3)),(int(2),int(3))])). |
3061 | | :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF), |
3062 | | X = [(int(2),int(7)),(int(1),int(7))])). |
3063 | | :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1)],[int(7),int(8)],_WF), |
3064 | | X = [(int(1),int(7))])). |
3065 | | :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7)],_WF), |
3066 | | X = [(int(2),int(7))])). |
3067 | | :- assert_must_succeed((bsets_clp:not_total_bijection([],[int(1)],[int(7)],_WF))). |
3068 | | :- assert_must_succeed((bsets_clp:not_total_bijection([(int(7),int(7))],[int(1)],[int(7)],_WF))). |
3069 | | :- assert_must_succeed((bsets_clp:not_total_bijection([(int(1),int(7)), (int(2),int(1))], |
3070 | | [int(1),int(2)],[int(7)],_WF))). |
3071 | | :- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF), |
3072 | | X = [(int(2),int(7)),(int(2),int(6))])). |
3073 | | |
3074 | | :- block not_total_bijection(-,?,?,?). |
3075 | | not_total_bijection(FF,Domain,Range,WF) :- |
3076 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!, |
3077 | | %% print(not_total_bijection_wf_closure(FFDomain,FFRange)),nl, %% |
3078 | | not_equal_object_wf((FFDomain,FFRange),(Domain,Range),WF). |
3079 | | not_total_bijection(R,Domain,Range,WF) :- |
3080 | | try_expand_custom_set(R,ER),not_tot_bij(ER,[],Domain,Range,WF). |
3081 | | |
3082 | | :- block not_tot_bij(-,?,?,?,?). |
3083 | | not_tot_bij([],_,Domain,Range,_WF) :- empty_not_tot_bij(Domain,Range). |
3084 | | not_tot_bij([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf(SoFar,X,MemRes,WF), |
3085 | | not_tot_bij2(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
3086 | | |
3087 | | :- use_module(kernel_equality,[empty_set_test/2]). |
3088 | | :- block empty_not_tot_bij(-,?). |
3089 | | empty_not_tot_bij(Domain,Range) :- |
3090 | | empty_set_test(Domain,EqRes), empty_not_tot_bij2(EqRes,Range). |
3091 | | :- block empty_not_tot_bij2(-,?). |
3092 | | empty_not_tot_bij2(pred_false,_). |
3093 | | empty_not_tot_bij2(pred_true,Range) :- not_empty_set(Range). |
3094 | | |
3095 | | :- block not_tot_bij2(-,?,?,?,?,?,?,?). |
3096 | | not_tot_bij2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF). |
3097 | | not_tot_bij2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :- |
3098 | | membership_test_wf(Dom,X,MemRes,WF), |
3099 | | not_tot_bij3(MemRes,X,Y,T,SoFar,Dom,Ran,WF). |
3100 | | |
3101 | | :- block not_tot_bij3(-,?,?,?,?,?,?,?). |
3102 | | not_tot_bij3(pred_false,_X,_,_T,_SoFar,_Dom,_Ran,_WF). % X not a member of domain |
3103 | | not_tot_bij3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :- |
3104 | | remove_element_wf(X,Dom,Dom2,WF), |
3105 | | membership_test_wf(Ran,Y,MemRes,WF), |
3106 | | not_tot_bij4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF). |
3107 | | |
3108 | | :- block not_tot_bij4(-,?,?,?,?,?,?,?). |
3109 | | not_tot_bij4(pred_false,_X,_,_T,_SoFar,_Dom2,_Ran,_WF). % Y not a member of range |
3110 | | not_tot_bij4(pred_true,X,Y,T,SoFar,Dom2,Ran,WF) :- |
3111 | | remove_element_wf(Y,Ran,Ran2,WF), |
3112 | | add_element_wf(X,SoFar,SoFar2,WF), |
3113 | | not_tot_bij(T,SoFar2,Dom2,Ran2,WF). |
3114 | | |
3115 | | |
3116 | | |
3117 | | :- 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)). |
3118 | | :- 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)). |
3119 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([],[int(2),int(3)],[],WF),WF)). |
3120 | | :- assert_must_succeed((bsets_clp:range_restriction_wf([],[int(1)],[],_WF))). |
3121 | | :- assert_must_succeed((bsets_clp:range_restriction_wf([],[],[],_WF))). |
3122 | | :- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(1)],[],_WF))). |
3123 | | :- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(2)],[(int(1),int(2))],_WF))). |
3124 | | :- assert_must_succeed((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF), |
3125 | | X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))], |
3126 | | kernel_objects:equal_object(X,R))). |
3127 | | :- assert_must_succeed((bsets_clp:range_restriction_wf(X,Y,R,_WF), |
3128 | | X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],Y=global_set('Name'), |
3129 | | kernel_objects:equal_object(X,R))). |
3130 | | :- assert_must_fail((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF), |
3131 | | X = [(int(1),fd(3,'Name')),(int(2),fd(1,'Name'))], |
3132 | | kernel_objects:equal_object(X,R))). |
3133 | | |
3134 | | :- block range_restriction_wf(-,?,?,?),range_restriction_wf(?,-,-,?). |
3135 | | |
3136 | | range_restriction_wf(R,S,Res,WF) :- /* R |> S */ |
3137 | ? | ok_to_try_restriction_explicit_set(S,R,Res), |
3138 | ? | range_restriction_explicit_set_wf(R,S,SR,WF),!, |
3139 | ? | equal_object_wf(SR,Res,range_restriction,WF). |
3140 | | range_restriction_wf(R,S,Res,WF) :- /* R |> S */ |
3141 | | expand_custom_set_to_list_wf(R,ER,_,range_restriction,WF), |
3142 | | relation_restriction_wf(ER,S,Res,pred_true,range,WF). |
3143 | | |
3144 | | % heuristic: should we try restriction_explicit_set or |
3145 | | % is relation_restriction with its stronger constraint propagation better |
3146 | | ok_to_try_restriction_explicit_set(S,R,Res) :- |
3147 | | nonvar(S), |
3148 | | (var(Res) -> true |
3149 | | ; S=avl_set(_), |
3150 | | nonvar(R), R=avl_set(_) % otherwise constraint propagation from normal relation_restriction better |
3151 | | ). |
3152 | | |
3153 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([],[int(2)],[],WF),WF)). |
3154 | | :- 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)). |
3155 | | :- 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)). |
3156 | | :- 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)). |
3157 | | |
3158 | | :- block range_subtraction_wf(-,?,?,?),range_subtraction_wf(?,-,-,?). |
3159 | | range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */ |
3160 | | S==[],!, |
3161 | | equal_object_wf(R,Res,range_subtraction1,WF). |
3162 | | range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */ |
3163 | | % print(range_subtraction(R,S,Res)),nl,debug:trace_in_debug_mode, |
3164 | ? | ok_to_try_restriction_explicit_set(S,R,Res), |
3165 | ? | range_subtraction_explicit_set_wf(R,S,SR,WF),!, |
3166 | ? | equal_object_wf(SR,Res,range_subtraction2,WF). |
3167 | | range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */ |
3168 | | expand_custom_set_to_list_wf(R,ER,_,range_subtraction,WF), |
3169 | | relation_restriction_wf(ER,S,Res,pred_false,range,WF). |
3170 | | |
3171 | | :- 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)). |
3172 | | :- 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)). |
3173 | | |
3174 | | :- block in_range_restriction_wf(-,-,-,?). |
3175 | | in_range_restriction_wf(Pair,Rel,Set,WF) :- |
3176 | | (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel) |
3177 | | ; preference(convert_comprehension_sets_into_closures,true)), |
3178 | | % print_term_summary(symbolic_treatment_in_range_restriction_wf(Pair,Set,Rel,WF)), |
3179 | | !, |
3180 | | Rel \== [], % avoid setting up check_element_of for X then |
3181 | | % x |-> y : Rel |>> Set <=> x|->y : Rel & y: Set |
3182 | | check_element_of_wf(Pair,Rel,WF), |
3183 | | Pair = (_,P2), |
3184 | | check_element_of_wf(P2,Set,WF). |
3185 | | in_range_restriction_wf(Pair,Rel,Set,WF) :- |
3186 | | range_restriction_wf(Rel,Set,Res,WF), |
3187 | | check_element_of_wf(Pair,Res,WF). |
3188 | | |
3189 | | :- 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)). |
3190 | | :- 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)). |
3191 | | |
3192 | | :- block not_in_range_restriction_wf(-,-,-,?). |
3193 | | not_in_range_restriction_wf(Pair,Rel,Set,WF) :- |
3194 | | range_restriction_wf(Rel,Set,Res,WF), |
3195 | | not_element_of_wf(Pair,Res,WF). |
3196 | | |
3197 | | :- 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)). |
3198 | | :- 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)). |
3199 | | |
3200 | | :- block in_range_subtraction_wf(-,-,-,?). |
3201 | | in_range_subtraction_wf(Pair,Rel,Set,WF) :- |
3202 | | (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel) |
3203 | | ; preference(convert_comprehension_sets_into_closures,true)), |
3204 | | % print_term_summary(symbolic_treatment_in_range_subtraction_wf(Pair,Set,Rel,WF)), |
3205 | | !, |
3206 | | Rel \== [], % avoid setting up check_element_of for X then |
3207 | | % x |-> y : Rel |>> Set <=> x|->y : Rel & y/: Set |
3208 | | check_element_of_wf(Pair,Rel,WF), |
3209 | | Pair = (_,P2), |
3210 | | not_element_of_wf(P2,Set,WF). |
3211 | | in_range_subtraction_wf(Pair,Rel,Set,WF) :- |
3212 | | range_subtraction_wf(Rel,Set,Res,WF), |
3213 | | check_element_of_wf(Pair,Res,WF). |
3214 | | |
3215 | | :- 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)). |
3216 | | :- 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)). |
3217 | | |
3218 | | :- block not_in_range_subtraction_wf(-,-,-,?). |
3219 | | not_in_range_subtraction_wf(Pair,Rel,Set,WF) :- |
3220 | | range_subtraction_wf(Rel,Set,Res,WF), |
3221 | | not_element_of_wf(Pair,Res,WF). |
3222 | | |
3223 | | |
3224 | | |
3225 | | :- 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)). |
3226 | | :- 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)). |
3227 | | |
3228 | | :- block in_domain_restriction_wf(-,-,-,?). |
3229 | | in_domain_restriction_wf(Pair,Set,Rel,WF) :- |
3230 | | (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel) |
3231 | | ; preference(convert_comprehension_sets_into_closures,true)), |
3232 | | % print_term_summary(symbolic_treatment_in_domain_restriction_wf(Pair,Set,Rel,WF)), |
3233 | | !, |
3234 | | Rel \== [], % avoid setting up check_element_of for X then |
3235 | | % x |-> y : Set <| Rel <=> x|->y : Rel & x: Set |
3236 | | check_element_of_wf(Pair,Rel,WF), |
3237 | | Pair = (P1,_), |
3238 | | check_element_of_wf(P1,Set,WF). |
3239 | | in_domain_restriction_wf(Pair,Set,Rel,WF) :- |
3240 | | domain_restriction_wf(Set,Rel,Res,WF), |
3241 | | check_element_of_wf(Pair,Res,WF). |
3242 | | |
3243 | | :- 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)). |
3244 | | :- 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)). |
3245 | | |
3246 | | :- block not_in_domain_restriction_wf(-,-,-,?). |
3247 | | not_in_domain_restriction_wf(Pair,Set,Rel,WF) :- |
3248 | | domain_restriction_wf(Set,Rel,Res,WF), |
3249 | | not_element_of_wf(Pair,Res,WF). |
3250 | | |
3251 | | :- 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)). |
3252 | | :- 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)). |
3253 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(3)],[],[],WF),WF)). |
3254 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],[],_WF))). |
3255 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],R,_WF), R==[])). |
3256 | | :- assert_must_fail((bsets_clp:domain_restriction_wf(_,[],R,_WF), R=[int(_)|_])). |
3257 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2)],[(int(1),int(2))],[],_WF))). |
3258 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([],[(int(1),int(2))],[],_WF))). |
3259 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2))],[(int(1),int(2))],_WF))). |
3260 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2)),(int(2),_)],_,_WF))). |
3261 | | :- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2),int(1)],X,R,_WF), |
3262 | | X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))], |
3263 | | kernel_objects:equal_object(X,R))). |
3264 | | |
3265 | | |
3266 | | :- block domain_restriction_wf(?,-,?,?),domain_restriction_wf(-,?,-,?). |
3267 | | domain_restriction_wf(S,R,Res,WF) :- /* S <| R */ |
3268 | | %print_term_summary(domain_restriction(S,R,Res)), |
3269 | | ok_to_try_restriction_explicit_set(S,R,Res), |
3270 | | domain_restriction_explicit_set_wf(S,R,SR,WF),!, |
3271 | | % print_term_summary(domain_restriction_explicit_set(S,R,SR)), %% |
3272 | | equal_object_wf(SR,Res,domain_restriction,WF). |
3273 | | domain_restriction_wf(S,R,Res,WF) :- /* S <| R */ |
3274 | | % print_term_summary(call_domain_restriction(S,R,Res)), translate:print_bvalue(S),nl, |
3275 | | expand_custom_set_to_list_wf(R,ER,_,domain_restriction,WF), |
3276 | | relation_restriction_wf(ER,S,Res,pred_true,domain,WF). |
3277 | | |
3278 | | % a predicate to compute domain/range restriction/subtraction |
3279 | | :- block relation_restriction_wf(?,-,- ,?,?,?), |
3280 | | relation_restriction_wf(-,?,? ,?,?,?). |
3281 | | relation_restriction_wf([],_S,Res,_AddWhen,_DomOrRange,WF) :- |
3282 | | %print_term_summary(domain_restriction_finished([],_S,Res)), |
3283 | | empty_set_wf(Res,WF). |
3284 | | relation_restriction_wf([(X,Y)|T],S,Res,AddWhen,DomOrRange,WF) :- |
3285 | ? | (DomOrRange=domain |
3286 | | -> membership_test_wf(S,X,MemRes,WF) % TO DO: pass WF ! |
3287 | | ; membership_test_wf(S,Y,MemRes,WF)), |
3288 | ? | (nonvar(MemRes) |
3289 | | %MemRes==AddWhen % MemRes already set; we will ensure that (X,Y) in Res below; this slows down Alstom Compilation Regle ! |
3290 | | % 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 ? |
3291 | | -> true %,(MemRes==AddWhen -> true ; print_term_summary(relation_restriction([(X,Y)|T],S,Res,AddWhen,DomOrRange)),nl) |
3292 | | ; (AddWhen=pred_true -> InResult=MemRes |
3293 | | ; negate(InResult,MemRes)), % from bool_pred |
3294 | | membership_test_wf(Res,(X,Y),InResult,WF) |
3295 | | % TO DO: same for explicit version; gets called e.g. if S = 1..n (1..n <| [1,2,3] = [1,2]) |
3296 | | % can now solve e.g. {x|x <| [1,2,3] = [1,2] & card(x)=2} = {{1,2}} |
3297 | | % or x <| s = [1,2,3] \/ {29|->29} & x <: 1..100 & s = %i.(i:1..50|i) |
3298 | | ), |
3299 | | % print(restrict(X,Y,MemRes)),nl, |
3300 | ? | relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF). |
3301 | | :- block relation_restriction_aux(-,?,?,?,?,?, ?,?,?). |
3302 | | relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF) :- |
3303 | ? | MemRes==AddWhen,!, % (X,Y) should be added to result %print(add(X,Y)),nl, |
3304 | | % TO DO: collect result until we delay ? and then do equal_object ? |
3305 | | %print(eq_cons1(Res)),nl,print((X,Y)),nl,print(RT),nl, |
3306 | ? | equal_cons(Res,(X,Y),RT), % was : equal_object([(X,Y)|RT],Res), |
3307 | | %equal_cons_wf(Res,(X,Y),RT,WF), % makes tests 982, 1302, 1303 fail; TO DO: investigate |
3308 | | %print(eq_cons2(Res)),nl,print((X,Y)),nl,print(RT),nl, |
3309 | | %when(nonvar(RT), % causes problem for test 982 |
3310 | ? | relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF). |
3311 | | relation_restriction_aux(_MemRes,_X,_,T,S,RT,AddWhen,DomOrRange,WF) :- |
3312 | | % the couple is filtered out %print(filter(_X)),nl, |
3313 | ? | relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF). |
3314 | | |
3315 | | |
3316 | | :- 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)). |
3317 | | :- 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)). |
3318 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1)],[],[],WF),WF)). |
3319 | | :- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([],[(int(11),int(21))],[(int(11),int(21))],WF),WF)). |
3320 | | :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2))],[],_WF))). |
3321 | | :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(3)],[(int(1),int(2))],[(int(1),int(2))],_WF))). |
3322 | | :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2)),(int(2),int(X))],R,_WF), |
3323 | | R=[(int(2),int(YY))], YY==X)). |
3324 | | :- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(5),int(3)],X,R,_WF), |
3325 | | X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))], |
3326 | | kernel_objects:equal_object(X,R))). |
3327 | | :- block domain_subtraction_wf(?,-,?,?),domain_subtraction_wf(-,?,-,?). |
3328 | | %domain_subtraction(S,R,Res) :- /* S <<| R */ |
3329 | | % is_custom_explicit_set(R), nonvar(S), |
3330 | | % fail. |
3331 | | domain_subtraction_wf(S,R,Res,WF) :- S==[],!, |
3332 | | equal_object_wf(R,Res,domain_subtraction1,WF). |
3333 | | domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */ |
3334 | | ok_to_try_restriction_explicit_set(S,R,Res), |
3335 | | domain_subtraction_explicit_set_wf(S,R,SR,WF),!, |
3336 | | equal_object_wf(SR,Res,domain_subtraction2,WF). |
3337 | | domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */ |
3338 | | %print_message(dom_sub(S,R,Res)), |
3339 | | expand_custom_set_to_list_wf(R,ER,_,domain_subtraction,WF), |
3340 | | try_expand_and_convert_to_avl_with_check(S,AS,domain_subtraction), |
3341 | | % print_term_summary(dom_sub2(ER,AS,Res)), |
3342 | | % (ground(ER) -> domain_subtraction_acc(ER,AS,[],Res) ; |
3343 | | relation_restriction_wf(ER,AS,Res,pred_false,domain,WF) |
3344 | | % ) |
3345 | | . |
3346 | | |
3347 | | |
3348 | | |
3349 | | :- 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)). |
3350 | | :- 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)). |
3351 | | |
3352 | | :- block in_domain_subtraction_wf(-,-,-,?). |
3353 | | |
3354 | | in_domain_subtraction_wf(Pair,Set,Rel,WF) :- |
3355 | | (treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel) |
3356 | | ; preference(convert_comprehension_sets_into_closures,true)), |
3357 | | % print_term_summary(symbolic_treatment_in_domain_subtraction_wf(Pair,Set,Rel,WF)), |
3358 | | !, |
3359 | | Rel \== [], % avoid setting up check_element_of for X then |
3360 | | % x |-> y : Set <<| Rel <=> x|->y : Rel & x/: Set |
3361 | | check_element_of_wf(Pair,Rel,WF), |
3362 | | Pair = (P1,_), |
3363 | | not_element_of_wf(P1,Set,WF). |
3364 | | in_domain_subtraction_wf(Pair,Set,Rel,WF) :- |
3365 | | domain_subtraction_wf(Set,Rel,Res,WF), |
3366 | | check_element_of_wf(Pair,Res,WF). |
3367 | | |
3368 | | |
3369 | | :- 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)). |
3370 | | :- 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)). |
3371 | | |
3372 | | :- block not_in_domain_subtraction_wf(-,-,-,?). |
3373 | | not_in_domain_subtraction_wf(Pair,Set,Rel,WF) :- |
3374 | | domain_subtraction_wf(Set,Rel,Res,WF), |
3375 | | not_element_of_wf(Pair,Res,WF). |
3376 | | |
3377 | | % similar to kernel_objects, but adds case for [_|_] |
3378 | | treat_arg_symbolically(X) :- var(X),!. |
3379 | | treat_arg_symbolically([H|T]) :- \+ ground(H) ; treat_arg_symbolically(T). |
3380 | | treat_arg_symbolically(global_set(_)). |
3381 | | treat_arg_symbolically(freetype(_)). |
3382 | | treat_arg_symbolically(closure(P,T,B)) :- \+ kernel_objects:small_interval(P,T,B). |
3383 | | |
3384 | | :- 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)). |
3385 | | :- 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)). |
3386 | | :- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(1),int(3))],X,_WF), |
3387 | | kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(3))]))). |
3388 | | :- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(3),int(6))],X,_WF), |
3389 | | kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(2)),(int(3),int(6))]))). |
3390 | | |
3391 | | :- block override_relation(-,-,?,?). |
3392 | | override_relation(R,S,Res,WF) :- R==[],!, equal_object_wf(S,Res,override_relation1,WF). |
3393 | | override_relation(R,S,Res,WF) :- S==[],!, equal_object_wf(R,Res,override_relation2,WF). |
3394 | | override_relation(R,S,Res,WF) :- Res==[],!, empty_set_wf(S,WF), empty_set_wf(R,WF). |
3395 | | override_relation(R,S,Res,WF) :- /* R <+ S */ |
3396 | | % print_term_summary(override_relation(R,S,Res,_WF)),nl, |
3397 | | override_custom_explicit_set_wf(R,S,ORes,WF),!, |
3398 | | % print_term_summary(override_custom_explicit_set_wf(R,S,ORes,WF)), |
3399 | | equal_object_wf(ORes,Res,override_relation3,WF). |
3400 | | override_relation(R,S,Res,WF) :- /* R <+ S */ |
3401 | | % print('override_relation: '), translate:print_bvalue(S),nl, |
3402 | | /* TO DO: first check if S is empty */ |
3403 | | % print(override__enter_domain(S,DS)),nl, |
3404 | | domain_wf(S,DS,WF), |
3405 | | % when(ground(DS), (print(override_domain(DS)),nl)), |
3406 | | % print_term_summary(override__exit__domain(S,DS)),nl, |
3407 | | % print_term_summary(override__enter_domain_subtraction(DS,R,DSR)), |
3408 | | domain_subtraction_wf(DS,R,DSR,WF), |
3409 | | % print(override__exit_domain_subtraction(DS,R,DSR)),nl, |
3410 | | % when(ground(DSR), (print(override_domain_subtraction(DSR)),nl)), |
3411 | | % print(calling_union(DSR,S,Res)),nl, |
3412 | | union_wf(DSR,S,Res,WF). % ,print(done_union(DSR,S,Res)),nl,trace. |
3413 | | % , print_term_summary(override__exit_union(DSR,S,Res)),nl. |
3414 | | % when(ground(Res), (print(override_UNION_RESULT(R,S,Res)),nl)). |
3415 | | |
3416 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([],int(1),int(3),[(int(1),int(3))],WF),WF)). |
3417 | | :- 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)). |
3418 | | :- 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)). |
3419 | | :- block override(-,?,?,?,?), override(?,-,?,?,?), |
3420 | | override(?,?,-,?,?). % also wait on Y; try to generate avl if possible; can only be used in substitution anyway |
3421 | | /* R <+ {X |-> Y} as used by substitution R(X) := Y */ |
3422 | | override(R,X,Y,Res,WF) :- % print_term_summary(override(R,X,Y,Res)), |
3423 | | override_pair_explicit_set(R,X,Y,ORes),!, |
3424 | | %% print_term_summary(override_pair_explicit_set(R,X,Y,ORes)), %% |
3425 | | equal_object_wf(ORes,Res,override1,WF). |
3426 | | override(R,X,Y,Res,WF) :- |
3427 | | if(try_expand_custom_set_to_list(R,ER,_,override), |
3428 | | ( %print_term_summary(override2(ER,X,Y)), |
3429 | | override2(ER,X,Y,[(X,Y)],ORes,WF), |
3430 | | equal_object_wf(ORes,Res,override2,WF)), |
3431 | | ( %print_term_summary(exception(R)), % Virtual Timeout exception occured |
3432 | | override_relation(R,[(X,Y)],Res,WF) |
3433 | | )). |
3434 | | |
3435 | | :- block override2(-,?,?,?,?,?). |
3436 | | override2([],_X,_Y,Remainder,Res,WF) :- equal_object_optimized_wf(Remainder,Res,override2,WF). %equal_object(Remainder,Res). |
3437 | | override2([(V,W)|T],X,Y,Remainder,Res,WF) :- |
3438 | | equality_objects_wf(V,X,EqRes,WF), |
3439 | | override2c(EqRes,V,W,T,X,Y,Remainder,Res,WF). |
3440 | | |
3441 | | :- block override2c(-, ?,?,?, ?,?,?,?,?). |
3442 | | override2c(pred_true,_V,_W,T,X,Y,_Remainder,Res,WF) :- |
3443 | | equal_cons_wf(Res,(X,Y),T2,WF), |
3444 | | override2(T,X,Y,[],T2,WF). /* set remainder to [], we have already added (X,Y) */ |
3445 | | override2c(pred_false,V,W,T,X,Y,Remainder,Res,WF) :- |
3446 | | equal_cons_wf(Res,(V,W),T2,WF), |
3447 | | override2(T,X,Y,Remainder,T2,WF). |
3448 | | |
3449 | | |
3450 | | |
3451 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],WF),WF)). |
3452 | | :- 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)). |
3453 | | :- 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)). |
3454 | | :- 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)). |
3455 | | :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],_WF)). |
3456 | | :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(2)],[],_WF)). |
3457 | | :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(3)],[],_WF)). |
3458 | | :- assert_must_succeed((bsets_clp:image_wf([(int(1),int(2)),(int(1),int(3))], |
3459 | | [int(X)],R,_WF), X=1, kernel_objects:equal_object(R,[int(2),int(3)]))). |
3460 | | :- assert_must_succeed((bsets_clp:image_wf([([int(1),int(2)],int(6)), |
3461 | | ([int(1),int(2),int(3)],int(7)), |
3462 | | ([int(2),int(1)],int(8))], |
3463 | | [[int(X),int(1)]],R,_WF), X=2, |
3464 | | kernel_objects:equal_object(R,[int(6),int(8)]))). |
3465 | | :- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)],_WF)). |
3466 | | :- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(1)],_WF)). |
3467 | | :- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[],_WF)). |
3468 | | |
3469 | | |
3470 | | :- block image_wf(-,?,?,?). |
3471 | | image_wf(Rel,_,Res,WF) :- Rel==[],!,empty_set_wf(Res,WF). |
3472 | | image_wf(Rel,S,Res,WF) :- image_for_id_closure(Rel,S,Img),!, % we don't require S to be known here |
3473 | | % print(image_for_id(Rel,S,Img)),nl, |
3474 | | equal_object_wf(Img,Res,image_wf_id_closure,WF). %, print_term_summary(image_for_id(Rel,S,Res)). |
3475 | | image_wf(Rel,S,Res,WF) :- %print_term_summary(image_wf(Rel,S,Res)), |
3476 | | image_wf0(Rel,S,Res,WF). |
3477 | | |
3478 | | :- block image_wf0(?,-,?,?). |
3479 | | image_wf0(Rel,S,Res,WF) :- /* Res = Rel[S] */ |
3480 | | % nl,print_term_summary(image_wf0(Rel,S,Res)),nl, |
3481 | | % print(image(Rel,S,Res,WF)),nl, |
3482 | ? | (S==[] -> empty_set_wf(Res,WF) |
3483 | ? | ; image1(Rel,S,Res,WF) ) . %,print(done_image(Rel,S,Res)),nl. %,watch(Rel,arg1_of_image,0). |
3484 | | |
3485 | | keep_symbolic(R) :- var(R),!,fail. |
3486 | | keep_symbolic(closure(_,_,_)) :- preferences:get_preference(convert_comprehension_sets_into_closures,true),!. |
3487 | | keep_symbolic(R) :- dont_expand_this_explicit_set(R). |
3488 | | |
3489 | | :- block image1(-,?,?,?). |
3490 | | image1(Rel,S,Res,WF) :- %print_term_summary(image1(Rel,S,Res)), |
3491 | ? | image_for_explicit_set(Rel,S,Img,WF),!, % print(image_explicit(Img)),nl, |
3492 | ? | equal_object_wf(Img,Res,image1_1,WF), |
3493 | | quick_propagate_subset_range(Res,Rel,WF). |
3494 | | %image1(Rel,S,Res,WF) :- expand_custom_set_to_list(S,ES),!, image_of_set(ES,Rel,Res,WF). |
3495 | | image1(Rel,Set,Res,WF) :- %print(rel(Rel,Set)),nl, |
3496 | | keep_symbolic(Rel), %print(don_expand_this),nl, |
3497 | | (preferences:get_preference(convert_comprehension_sets_into_closures,true), % in this case keep_symbolic is always true |
3498 | | 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 |
3499 | | -> debug_println(9,infinite_for_image1(Set)), |
3500 | | fail |
3501 | | ; true), |
3502 | | ( dom_for_specific_closure(Rel,Domain,function(_)) |
3503 | | % print(image_for_inf_fun(Rel,Set)),nl, |
3504 | | -> !, expand_custom_set_to_list_wf(Set,ESet,_,image1,WF), % TO DO: what if keep_symbolic(Set) |
3505 | | image_for_inf_fun(ESet,Domain,Rel,[],Res,WF) |
3506 | | ; get_relation_types(Rel,DomType,RangeType),!, |
3507 | | %% print_term_summary(image_for_large_relation(DomType,RangeType,Set,Rel)),translate:print_bvalue(Set),nl, |
3508 | | expand_custom_set_to_list_wf(Set,ESet,_,image1_2,WF), |
3509 | | kernel_tools:ground_value_check(Rel,GRel), |
3510 | | when(nonvar(GRel), image_for_large_relation(ESet,Rel,DomType,RangeType,[],Res,WF)) |
3511 | | /* ; get_relation_types(Rel,DomType,RangeType),!, |
3512 | | % Rel should not be expanded, compute closure by calculating {yy|#(xx).(xx:Set & xx|->yy:Rel)} |
3513 | | print_term_summary(image_for_large_relation(DomType,RangeType,Set,Rel)),nl, |
3514 | | image_closure(Set,Rel,DomType,RangeType,Closure ), |
3515 | | translate:print_bvalue(Closure),nl, |
3516 | | expand_custom_set(Closure,CRes), print(expanded),nl, |
3517 | | equal_object(CRes,Res,image1_2) */ |
3518 | | ). |
3519 | | image1(Rel,S,Res,WF) :- |
3520 | | %((custom_explicit_sets:quick_custom_explicit_set_approximate_size(Rel,S), S>1000) -> print(image_for_large_relation(S)),nl ; true), |
3521 | | expand_custom_set_to_list_wf(Rel,Relation,_,image1_2,WF), % bad if Rel is a big closure ! |
3522 | | % print(image2(Rel,Relation,S,Res)),nl, |
3523 | | % image_for_list_relation(Relation,S,Res). |
3524 | | propagate_singleton_image(Relation,S,Res,WF), |
3525 | | image_for_list_relation(Relation,S,[],Res,WF). %,print_term_summary(image2_res(Relation,S,Res)). |
3526 | | |
3527 | | % propagate that f[{x}] = {r1,...,rk} => x|->ri : f (or {x}*{r1,...,rk} <: f); see test 1532 |
3528 | | propagate_singleton_image(R,S,Res,_) :- |
3529 | ? | (var(S) ; var(Res) ; nonvar(R), is_custom_explicit_set(R,psi)), !. |
3530 | | propagate_singleton_image(Relation,S,avl_set(Res),WF) :- |
3531 | | custom_explicit_sets:singleton_set(S,El), % we have the image by a singleton set {El} |
3532 | | expand_custom_set_to_list_wf(avl_set(Res),LR,_,prop_singleton,WF), |
3533 | | !, |
3534 | | %print_term_summary(prop(LR,El,Relation)),nl, |
3535 | | l_check_element_of(LR, El, Relation, WF). % propagate x|->ri : f (will force membership) |
3536 | | propagate_singleton_image(_,_,_,_). |
3537 | | |
3538 | | l_check_element_of([],_,_,_). |
3539 | | l_check_element_of([H|T],El,Relation,WF) :- |
3540 | | check_element_of_wf((El,H),Relation,WF), |
3541 | | l_check_element_of(T,El,Relation,WF). |
3542 | | |
3543 | | % quick_propagate_in_range(Set, Relation,WF) : propagate that Set <: ran(Relation) |
3544 | | :- block quick_propagate_subset_range(-,?,?). |
3545 | | quick_propagate_subset_range(avl_set(_),_,_) :- !. |
3546 | | quick_propagate_subset_range([],_,_) :- !. |
3547 | | quick_propagate_subset_range([H|T],Relation,WF) :- is_custom_explicit_set(Relation,range_wf1), |
3548 | | range_of_explicit_set(Relation,Range), !, |
3549 | | quick_propagation_element_information(Range,H,WF,NewRange), |
3550 | | quick_propagate_subset_range2(T,NewRange,WF). |
3551 | | quick_propagate_subset_range(_,_,_). |
3552 | | |
3553 | | :- block quick_propagate_subset_range2(-,?,?). |
3554 | | quick_propagate_subset_range2([H|T],NewRange,WF) :- !, |
3555 | | quick_propagation_element_information(NewRange,H,WF,NewRange1), |
3556 | | quick_propagate_subset_range2(T,NewRange1,WF). |
3557 | | quick_propagate_subset_range2(_,_,_). |
3558 | | |
3559 | | :- use_module(btypechecker, [unify_types_strict/2]). |
3560 | | get_relation_types(Value,Domain,Range) :- |
3561 | | kernel_objects:infer_value_type(Value,VT), |
3562 | | unify_types_strict(VT,set(couple(Domain,Range))). % deal also with seq types |
3563 | | % VT=set(couple(Domain,Range)). |
3564 | | |
3565 | | :- block image_for_large_relation(-,?,?,?,?,?,?), image_for_large_relation(?,?,?,?,-,?,?). |
3566 | | image_for_large_relation([],_,_,_,Acc,Res,WF) :- equal_object_wf(Acc,Res,WF). |
3567 | | image_for_large_relation([XX|T],Rel,DomType,RangeType,Acc,Res,WF) :- |
3568 | | %print_term_summary(computing_image(XX,Acc)),nl, |
3569 | | Body = b(member(b(couple(b(value(XX),DomType,[]), |
3570 | | b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]), |
3571 | | b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]), |
3572 | | % TO DO: simplify above if we have Rel = closure(P,T,B); which we usually will |
3573 | | custom_explicit_sets:expand_normal_closure_direct([yy],[RangeType],Body,HRes,_Done,WF), % do not memoize this (many different values) |
3574 | | union_wf(Acc,HRes,NewAcc,WF), |
3575 | | (T == [] -> equal_object_wf(NewAcc,Res,WF) |
3576 | | ; image_for_large_relation(T,Rel,DomType,RangeType,NewAcc,Res,WF)). |
3577 | | |
3578 | | /* no longer used |
3579 | | % construct a closure for {yy|#(xx).(xx:Set & xx|->yy:Rel)} |
3580 | | image_closure(Set,Rel,DomType,RangeType,Closure ) :- custom_explicit_sets:singleton_set(Set,XX),!, |
3581 | | % do not set up existential quantifier if Set is singleton set |
3582 | | Closure = closure([yy],[RangeType],Body), |
3583 | | Body = b(member(b(couple(b(value(XX),DomType,[]), |
3584 | | b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]), |
3585 | | b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]). |
3586 | | image_closure(Set,Rel,DomType,RangeType,Closure ) :- |
3587 | | Closure = closure([yy],[RangeType],Body), |
3588 | | couple_member_pred(xx,DomType,yy,RangeType,Rel, Predxxyy), |
3589 | | Body = b(exists([b(identifier(xx),DomType,[])], |
3590 | | b(conjunct( |
3591 | | b(member(b(identifier(xx),DomType,[]),b(value(Set),set(DomType),[])),pred,[]), % TO DO : force evaluation ! |
3592 | | Predxxyy), |
3593 | | pred,[])),pred,[used_ids([yy])]). |
3594 | | */ |
3595 | | |
3596 | | % very similar to rel_compose_with_inf_fun, indeed f[S] = ran((id(S);f)) |
3597 | | :- block image_for_inf_fun(-,?,?,?,?,?). |
3598 | ? | image_for_inf_fun([],_Dom,_Rel2,Acc,Comp,WF) :- equal_object_wf(Acc,Comp,WF). |
3599 | | image_for_inf_fun([X|T],Dom,Fun,Acc,CompRes,WF) :- |
3600 | | membership_test_wf(Dom,X,MemRes,WF), |
3601 | | image_for_inf_fun_aux(MemRes,X,T,Dom,Fun,Acc,CompRes,WF). |
3602 | | |
3603 | | :- block image_for_inf_fun_aux(-,?,?, ?,?,?,?,?). |
3604 | | image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,Acc,CompRes,WF) :- |
3605 | | % print_term_summary(image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,CompRes,WF)), |
3606 | ? | apply_to(Fun,X,FX,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ? |
3607 | | %hashing:my_term_hash(FX,Hash), (Hash=353256514437402551 -> trace ; Hash=340015815059493514 -> trace ; true), |
3608 | ? | add_element_wf(FX,Acc,NewAcc,WF), % will block until Acc Known !! |
3609 | | % (Acc==NewAcc -> true ; translate:print_bvalue(NewAcc),nl), %, print(add(Hash,FX)),nl,nl), |
3610 | | % TO DO USE: equal_cons_wf(CompRes,FX,CT,WF) + accumulator !, |
3611 | ? | image_for_inf_fun(T,Dom,Fun,NewAcc,CompRes,WF). |
3612 | | image_for_inf_fun_aux(pred_false,_X,T,Dom,Fun,Acc,Comp,WF) :- |
3613 | | % print(image_for_inf_fun_aux_not_in_domain(_X)),nl, |
3614 | | image_for_inf_fun(T,Dom,Fun,Acc,Comp,WF). |
3615 | | |
3616 | | |
3617 | | /* |
3618 | | :- block image_of_set(-,?,?,?,?), image_of_set(?,?,-,?,?). |
3619 | | image_of_set([],Rel,ImageSoFar,Res,WF) :- equal_object(ImageSoFar,Res). |
3620 | | image_of_set([H|T],Rel,ImageSoFar,Res,WF) :- |
3621 | | image_of_element(Rel,H,ImageSoFar,SF2,WF), |
3622 | | image_of_set(T,Rel,SF2,Res,WF). |
3623 | | |
3624 | | image_of_element([],_,Acc,Res,WF) :- equal_object(Acc,Res). |
3625 | | image_of_element([(A,B)|T],H,Acc,Res,WF) :- equality.... |
3626 | | image_of_element(avl_set(),H,Acc,Res,WF) :- .... |
3627 | | image_of_element(closure(),.... |
3628 | | */ |
3629 | | |
3630 | | % Computing the image of a relation which is stored as a list: traverse the relation |
3631 | | :- block image_for_list_relation(-,?,?,?,?). |
3632 | | image_for_list_relation([],_,_,Res,WF) :- empty_set_wf(Res,WF). |
3633 | | image_for_list_relation([(X,Y)|T],S,ImageSoFar,Res,WF) :- % prints(image(X,Y,T,ImageSoFar)),trace, |
3634 | | %print_term_summary(image_for_list_relation(X,Y,T,S,ImageSoFar,Res,WF)),nl, |
3635 | | ((T==[], definitely_not_empty(Res)) |
3636 | | -> MemRes=pred_true, % we need at least one more element for Res |
3637 | | check_element_of_wf(X,S,WF) |
3638 | | ; (Res==[],ImageSoFar==[]) -> MemRes=pred_false, not_element_of_wf(X,S,WF) % Result empty: X cannot be in S |
3639 | | ; membership_test_wf(S,X,MemRes,WF) |
3640 | | ), |
3641 | | image4(MemRes,Y,T,S,ImageSoFar,Res,WF). |
3642 | | |
3643 | | definitely_not_empty(Set) :- nonvar(Set), Set \== [], \+ functor(Set,closure,3). % Set \= closure(_,_,_). |
3644 | | |
3645 | | :- block image4(-, ?,?,?, ?,?,?). |
3646 | | image4(pred_true, Y,T,S, ImageSoFar,Res,WF) :- |
3647 | | (Res==[] |
3648 | | -> MemRes=pred_true, check_element_of_wf(Y,ImageSoFar,WF) |
3649 | | ; membership_test_wf(ImageSoFar,Y,MemRes,WF) |
3650 | | ), |
3651 | | image5(MemRes,Y,T,S,ImageSoFar,Res,WF). |
3652 | | image4(pred_false, _Y,T,S, ImageSoFar,Res,WF) :- |
3653 | | image_for_list_relation(T,S,ImageSoFar,Res,WF). |
3654 | | |
3655 | | :- block image5(-, ?,?,? ,?,?,?). |
3656 | | image5(pred_true,_Y,T,S,ImageSoFar,Res,WF) :- /* we have already added Y to the image */ |
3657 | | image_for_list_relation(T,S,ImageSoFar,Res,WF). |
3658 | | image5(pred_false,Y,T,S,ImageSoFar,Res,WF) :- %print(add_to_image_sofar(Y,ImageSoFar)),nl, |
3659 | | add_element_wf(Y,ImageSoFar,ImageSoFar2,WF), %print(adding_y_to_image_result(Y,Res)),nl, |
3660 | | kernel_objects:mark_as_non_free(Y), % has been added to image, no longer freely choosable |
3661 | | equal_cons_wf(Res,Y,Res2,WF), %print(added(Y,Res)),nl, |
3662 | | image_for_list_relation(T,S,ImageSoFar2,Res2,WF). |
3663 | | |
3664 | | |
3665 | | |
3666 | | :- 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)). |
3667 | | :- 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)). |
3668 | | :- 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)). |
3669 | | % first experimental version for computing closure1(Rel)[S] |
3670 | | :- block image_for_closure1_wf(-,?,?,?),image_for_closure1_wf(?,-,?,?). |
3671 | ? | image_for_closure1_wf(Rel,S,Res,WF) :- (Rel==[] ; S==[]),!,empty_set_wf(Res,WF). |
3672 | ? | image_for_closure1_wf(Rel,Set,Res,WF) :- try_expand_and_convert_to_avl_unless_large(Set,ESet), |
3673 | ? | image_for_closure1_wf_aux(Rel,ESet,Res,WF). |
3674 | | |
3675 | | :- use_module(library(avl),[avl_height/2]). |
3676 | | image_for_closure1_wf_aux(Rel,S,Res,WF) :- % print_term_summary(image_for_closure1_wf_aux(Rel,S,Res,WF)),nl, |
3677 | | ((nonvar(S),S=avl_set(_)) |
3678 | | -> closure1_for_explicit_set_from(Rel,S,Closure1Rel),!, % if S is known: start from S (currently only deals with Rel=avl_set(_) |
3679 | | % print_term_summary(closure1_from(Rel,S,Closure1Rel,Res)),nl, |
3680 | | range_wf(Closure1Rel,Res,WF) |
3681 | | ; Rel=avl_set(AR), avl_height(AR,AR_Height), |
3682 | | ((set_smaller_than(S,4),AR_Height>4) |
3683 | | -> !, % TO DO: we could do the same for small S if Rel is large |
3684 | | % print_term_summary(clo1(Rel)),nl, |
3685 | | when(ground(S), (expand_and_convert_to_avl_set(S,ES) -> |
3686 | | closure1_for_explicit_set_from(Rel,avl_set(ES),Closure1Rel), |
3687 | | range_wf(Closure1Rel,Res,WF) |
3688 | | ; image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S)) |
3689 | | )) |
3690 | | ; % print_term_summary(clo1(Rel)),nl, |
3691 | | % Don't do this if avl_height too large; then it is probably better to compute the image for S only |
3692 | | AR_Height < 13, % how big should we make this magic constant; or should we time-out ? 2^14=16384 |
3693 | | closure1_for_explicit_set(Rel,Closure1Rel),!, % we can compute it effiently; don't use code below |
3694 | | %print_term_summary(clo1_res(Closure1Rel,S,Res)),nl, |
3695 | | image_wf(Closure1Rel,S,Res,WF) |
3696 | | ) |
3697 | | ). |
3698 | | image_for_closure1_wf_aux(Rel,S,Res,WF) :- |
3699 | | %when(nonvar(Res),(print(inst(Res,for(S))),nl,trace)), |
3700 | | % print_term_summary(image_for_closure1_iterate(Rel,S,[],Res,WF)),debug:nl_time, |
3701 | ? | propagate_result_in_range(Rel,S,Res,WF), |
3702 | ? | image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S)). % , print_term_summary(done(Res)),debug:nl_time. |
3703 | | |
3704 | | % no need to treat avl_sets; already covered as special case above |
3705 | | set_smaller_than([],_). |
3706 | | set_smaller_than([_|T],N) :- N>1, nonvar(T), N1 is N-1, set_smaller_than(T,N1). |
3707 | | |
3708 | | image_for_closure1_iterate(Rel,S,Acc,Res,WF,FIRST) :- |
3709 | | % print_term_summary(image_wf0(Rel,S,Acc,Res,WF)),debug:nl_time, |
3710 | ? | image_wf0(Rel,S,Res1,WF), |
3711 | | % print_term_summary(done_image_wf0(Res1)),debug:nl_time,nl, |
3712 | ? | ground_value_check(Res1,RV), |
3713 | ? | image_for_closure1_check_fix(RV,Rel,Acc,Res1,Res,WF,FIRST). |
3714 | | |
3715 | | :- block image_for_closure1_check_fix(-,?,?,?,?,?,?). |
3716 | | image_for_closure1_check_fix(_,Rel,Acc,Res1,Res,WF,FIRST) :- |
3717 | | %try_expand_and_convert_to_avl_unless_large(Res1,ERes1), |
3718 | ? | difference_set(Res1,Acc,New), |
3719 | ? | try_expand_and_convert_to_avl(New,ENew), % we compute difference_set below; we most definitely will need an explicit finite representation |
3720 | | % print_term_summary(new(ENew)),debug:nl_time, |
3721 | ? | (not_empty_set_wf(ENew,WF), |
3722 | ? | union(ENew,Acc,Acc1), % Note: we do not call union_wf - should we do this |
3723 | | % upon first iteration remove also S from New -> New2 and pass New2 to image_for_closure1_iterate |
3724 | | % TO DO: investigate whether this also makes sense for further iterations; always remove S |
3725 | ? | (FIRST=first_iteration(S) -> difference_set(ENew,S,New2) ; New2=ENew), |
3726 | ? | image_for_closure1_iterate(Rel,New2,Acc1,Res,WF,not_first) |
3727 | | ; |
3728 | ? | empty_set_wf(ENew,WF),equal_object_optimized_wf(Acc,Res,image_for_closure1_check_fix,WF)). |
3729 | | |
3730 | | % propagate information that if closure1(Rel)[.] = Res => Res <: range(Rel) |
3731 | | % x: 1..n --> 1..n & closure1(x)[{1}] = {} & n=100 |
3732 | | :- block propagate_result_in_range(?,?,-,?). |
3733 | | propagate_result_in_range(Rel,_S,_Res,_WF) :- %print(propagate_result_in_range(Rel,_S,_Res,_WF)),nl, |
3734 | | ground_value(Rel),!. % no propagation required |
3735 | | propagate_result_in_range(Rel,S,[],WF) :- !, |
3736 | | domain_wf(Rel,Domain,WF), %print(not_in_domain(S,Domain)),nl,trace, |
3737 | | not_subset_of_wf(S,Domain,WF). |
3738 | | propagate_result_in_range(Rel,_,Res,WF) :- |
3739 | | range_wf(Rel,Range,WF), |
3740 | | check_subset_of_wf(Res,Range,WF). |
3741 | | |
3742 | | % ----------------------------------- |
3743 | | |
3744 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(2),int(22))],int(2),int(22),WF),WF)). |
3745 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(1),int(22)),(int(3),int(33)),(int(4),int(44))],int(3),int(33),WF),WF)). |
3746 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(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)). |
3747 | | :- assert_must_succeed(bsets_clp:apply_to([(int(1),int(2))],int(1),int(2),_WF)). |
3748 | | :- assert_must_succeed((bsets_clp:apply_to(F,int(3),int(2),_WF),F=[(int(3),int(2)),(int(2),int(1))])). |
3749 | | :- assert_must_succeed((bsets_clp:apply_to(F,X,int(1),_WF),F=[(int(3),int(2)),(int(2),int(1))],X=int(2))). |
3750 | | :- assert_must_succeed((bsets_clp:apply_to(F,int(3),_,_WF),F=[(int(3),[int(2),int(3)]),(int(2),[])])). |
3751 | | |
3752 | | :- assert_must_fail(bsets_clp:apply_to([(int(1),int(2)),(int(1),int(3))],int(1),int(3),_WF)). |
3753 | | /* input not a function */ |
3754 | | apply_to(R,X,Y,WF) :- apply_to(R,X,Y,unknown,unknown,WF). |
3755 | | apply_to(R,X,Y,Span,WF) :- apply_to(R,X,Y,unknown,Span,WF). |
3756 | | |
3757 | | :- block apply_to(-,-,-,?,?,?). |
3758 | | apply_to(R,X,Y,_FunctionType,Span,WF) :- |
3759 | | (\+ preferences:preference(find_abort_values,false) ; preference(data_validation_mode,true)), |
3760 | | !, |
3761 | | apply_to_var_block_abort(R,X,Y,R,Span,WF). % we have to know R before we can do anything |
3762 | | apply_to(R,X,Y,FunctionType,Span,WF) :- |
3763 | ? | (var(R),var(X) -> force_in_domain_wf(X,R,WF) ; true), |
3764 | ? | apply_to1(R,X,Y,R,FunctionType,Span,WF). |
3765 | | |
3766 | | force_in_domain_wf(El,S,WF) :- |
3767 | | (preferences:preference(use_smt_mode,true) -> S=[(El,_)|_] |
3768 | | ; get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)). |
3769 | | |
3770 | | :- use_module(preferences,[preference/2]). |
3771 | | :- use_module(clpfd_tables,[can_translate_function_to_element_constraint/2,check_apply_with_element_constraint/5]). |
3772 | | :- block apply_to1(-,-,?,?,?,?,?). |
3773 | | apply_to1(R,X,Y,InitialRel,FunctionType,Span,WF) :- % prints(apply2(R,X,Y,InitialRel,WF)), |
3774 | ? | (var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF) |
3775 | ? | ; R\=[],can_translate_function_to_element_constraint(R,FunctionType) -> |
3776 | | check_apply_with_element_constraint(R,X,Y,FunctionType,WF) |
3777 | ? | ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF), |
3778 | | propagate_range_membership(R,Y) |
3779 | | ). |
3780 | | :- block apply_to2(-,-,?,?,?,?). |
3781 | | apply_to2(R,X,Y,InitialRel,Span,WF) :- % prints(apply2(R,X,Y,InitialRel,WF)), |
3782 | | (var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF) |
3783 | | ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF) |
3784 | | ). |
3785 | | |
3786 | | :- use_module(clpfd_lists,[get_finite_fdset_information/2,combine_fdset_information/3, |
3787 | | assert_fdset_information/2,get_fdset_information/2]). |
3788 | | % tested in test 1478; initially slows down NQueens |
3789 | | %:- block propagate_range_membership(-,?). % not necessary |
3790 | | propagate_range_membership([(_,RanEl)|T],X) :- nonvar(RanEl), |
3791 | | preferences:preference(use_clpfd_solver,true), |
3792 | | % preferences:preference(use_smt_mode,true), |
3793 | | preferences:preference(find_abort_values,false), |
3794 | | get_finite_fdset_information(RanEl,Info), % TO DO: try and detect if we can apply element/3 from clpfd |
3795 | | \+ ground(X), |
3796 | | get_fdset_information(X,InfoX), |
3797 | | %print(start(Info,X,InfoX)),nl, |
3798 | | Info \= InfoX, % avoids NQueens slowdown; TO DO: check if more precise than InfoX; otherwise no use in collecting info |
3799 | | !, |
3800 | | propagate_range_membership(T,Info,X). |
3801 | | propagate_range_membership(_,_). |
3802 | | :- block propagate_range_membership(-,?,?). |
3803 | | propagate_range_membership([],Info,El) :- !, |
3804 | | % 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 ?? |
3805 | | % print(mem_propagate(Info,El)),nl, |
3806 | | assert_fdset_information(Info,El). %, tools_printing:print_arg(El),nl. |
3807 | | propagate_range_membership([(_,RanEl)|T],Acc,X) :- |
3808 | | nonvar(RanEl), % otherwise we have no info: we may just as well stop |
3809 | | get_finite_fdset_information(RanEl,RInfo), |
3810 | | combine_fdset_information(Acc,RInfo,NewAcc), |
3811 | | NewAcc \= no_fdset_info, |
3812 | | !, |
3813 | | propagate_range_membership(T,NewAcc,X). |
3814 | | propagate_range_membership(_,_,_). |
3815 | | |
3816 | | |
3817 | | |
3818 | | apply_to_var(R,X,Y,InitialRel,Span,WF) :- |
3819 | | %get_wait_flag(1.0,apply_to_var,WF,WF1), % see tests 1393, 1562?? |
3820 | | get_wait_flag0(WF,WF1), |
3821 | | 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 ??) |
3822 | | (var(R) -> % print(instantiate(R,X,Y,InitialRel,WF1,WF)),nl, |
3823 | | R=[(X,Y)|Tail], |
3824 | | optional_functionality_check(Tail,X,WF) |
3825 | | ; apply_to_nonvar(R,X,Y,InitialRel,Span,WF))). |
3826 | | |
3827 | | |
3828 | | :- block apply_to_var_block_abort(-,?,?,?,?,?). |
3829 | | apply_to_var_block_abort(R,X,Y,InitialRel,Span,WF) :- |
3830 | | apply_to_nonvar(R,X,Y,InitialRel,Span,WF). |
3831 | | %apply_to_var_block_abort([(X,Y)|_],X,Y,_,_,_). |
3832 | | %apply_to_var_block_abort(R,X,_Y,InitialRel,Span,WF) :- |
3833 | | % not_in_domain_wf(X,R,WF), |
3834 | | % kernel_tools:ground_value_check(R,RV), |
3835 | | % when((ground(X),nonvar(RV)), |
3836 | | % add_wd_error_span('function applied outside of domain (#1): ', '@fun'(X,InitialRel),Span,WF)). |
3837 | | |
3838 | | optional_functionality_check(Tail,X,WF) :- |
3839 | | preferences:preference(disprover_mode,true),!, |
3840 | | not_in_domain_wf(X,Tail,WF). % we assert that R is a function ; when disproving we can assume well-definedness |
3841 | | % 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) |
3842 | | 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 |
3843 | | |
3844 | | |
3845 | | :- use_module(memoization,[is_memoization_closure/4,apply_to_memoize/8]). |
3846 | | :- load_files(library(system), [when(compile_time), imports([environ/2])]). |
3847 | | :- if(\+ environ(no_wd_checking,true)). |
3848 | | apply_to_nonvar([],X,_Y,InitialRel,Span,WF) :- |
3849 | | \+ preferences:preference(find_abort_values,false), |
3850 | | %%print(apply_to_empty(X,_Y,InitialRel)),nl, |
3851 | | when(ground(X),add_wd_error_span('function applied outside of domain (#2): ', '@fun'(X,InitialRel),Span,WF)). |
3852 | | :- endif. |
3853 | | apply_to_nonvar([(X2,Y2)|T],X,Y,InitialRel,Span,WF) :- %translate:print_bvalue(((X,Y),(X2,Y2))),nl, trace, |
3854 | | equality_objects_wf(X2,X,EqRes,WF), |
3855 | | % this check on Y2 below is important if both Y and Y2 are instantiated but X,X2 not yet |
3856 | | % example: aload_R07_cbc.mch (Savary) or cbc_sequence check for R08_ByteArray for aload_R07 event (test 1349) |
3857 | | % however: slows down test 583 ! |
3858 | | (var(EqRes) -> equality_objects_wf(Y2,Y,EqResY,WF), %print(apply(X,X2,EqRes,Y2,Y,EqResY)),nl, |
3859 | | prop_apply_eqxy(EqResY,EqRes) % propagate: if Y/=Y2 => X/=X2 |
3860 | | ; EqResY=not_called), |
3861 | | apply_to4(EqRes,EqResY,Y2,T,X,Y,InitialRel,Span,WF). |
3862 | | %apply_to_nonvar(closure(Parameters,PT,Cond),X,Y,WF) :- !, |
3863 | | % check_element_of_wf((X,Y),closure(Parameters,PT,Cond),WF). |
3864 | | apply_to_nonvar(avl_set(A),X,Y,_InitialRel,Span,WF) :- |
3865 | | %%debug:watch(10,custom_explicit_sets:apply_to_avl_set(A,X,Y,WF)). %% |
3866 | ? | apply_to_avl_set(A,X,Y,Span,WF). |
3867 | | apply_to_nonvar(closure(P,T,B),X,Y,_InitialRel,Span,WF) :- |
3868 | | %is_custom_explicit_set(Closure,apply), % should also work for avl_set,... |
3869 | ? | (is_memoization_closure(P,T,B,MemoID) |
3870 | | % Function application with memoization; currently enabled by add /*@desc memo */ pragma to abstract constant |
3871 | | -> apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF) |
3872 | ? | ; 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 ??) |
3873 | | -> % print_term_summary(apply_recursive_closure(X,P,T,B)), |
3874 | | %hit_profiler:add_profile_hit(rec_apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)), |
3875 | | ground_value_check(X,XV), block_apply_closure_to_nonvar_groundx(XV,X,Y,P,T,B,Span,WF) |
3876 | | %when(ground(X),apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF)) |
3877 | | ; %hit_profiler:add_profile_hit(apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)), |
3878 | ? | apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)). |
3879 | | |
3880 | | |
3881 | | :- block block_apply_closure_to_nonvar_groundx(-,?,?, ?,?,?, ?,?). |
3882 | | 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). |
3883 | | |
3884 | | apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :- |
3885 | | kernel_tools:ground_bexpr(B), |
3886 | | !, % then if the element of function succeeds there is no need to check WD |
3887 | | if(check_element_of_function_closure(X,Y,P,T,B,WF), |
3888 | | true, % No need to check for well-definedness; no pending choice points |
3889 | | 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 |
3890 | | ). |
3891 | | apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :- |
3892 | | apply_closure_to_nonvar(X,Y,P,T,B,Span,WF). |
3893 | | |
3894 | | % if we first check preferences:preference(find_abort_values,false) to avoid a choice |
3895 | | % point, we get a big slow-down on Alstom models; e.g., vesg_Mar12 |
3896 | | % WARNING: This choice point can be set up in WF0 ! |
3897 | | apply_closure_to_nonvar(X,Y,P,T,B,_,WF) :- |
3898 | ? | (preferences:preference(find_abort_values,true) -> true ; !), % slow down ???! |
3899 | ? | check_element_of_function_closure(X,Y,P,T,B,WF) . |
3900 | | apply_closure_to_nonvar(X,_,P,T,B,Span,WF) :- % removing this clause doubles runtime of COMPUTE_GRADIENT_CHANGE |
3901 | | %hit_profiler:add_profile_hit(clause2(X,P,T,B,Span,WF),2), |
3902 | | apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF). |
3903 | | |
3904 | | apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) :- |
3905 | | %%print(potential_wd_error(X,P)),nl,nl,%trace, |
3906 | | \+ preferences:preference(find_abort_values,false), |
3907 | | not_in_domain_wf(X,closure(P,T,B),WF), |
3908 | | when((ground(X),ground(closure(P,T,B))), |
3909 | | add_wd_error_span('function applied outside of domain (#3): ', '@fun'(X,closure(P,T,B)),Span,WF)). |
3910 | | |
3911 | | |
3912 | | % propagate equality_objects between range and domain elements for function application: |
3913 | | :- block prop_apply_eqxy(-,-). |
3914 | ? | prop_apply_eqxy(Eqy,Eqx) :- var(Eqy),!, (Eqx = pred_true -> Eqy = pred_true ; true). |
3915 | | prop_apply_eqxy(pred_false,pred_false). |
3916 | | prop_apply_eqxy(pred_true,_). |
3917 | | |
3918 | | :- block apply_to4(-,?,?, -,?,?,?,?,?). |
3919 | | apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :- %print(app4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),nl, |
3920 | ? | var(EqResX),!, % Tail bound |
3921 | ? | (Tail == [] |
3922 | ? | -> (preferences:preference(find_abort_values,false) |
3923 | ? | -> EqResX = pred_true, apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) |
3924 | | ; apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) |
3925 | | ) |
3926 | | ; 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,...) |
3927 | | ; Tail = closure(_,_,_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) |
3928 | | ; Tail \= [_|_] -> add_internal_error('Illegal Tail: ',apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),fail |
3929 | | ; 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 |
3930 | | apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3) |
3931 | | ). |
3932 | | apply_to4(pred_true,EqResY,Y2, Tail,X,Y,_InitialRel,_,WF) :- |
3933 | | (EqResY==not_called -> equal_object_wf(Y2,Y,apply_to4,WF) ; EqResY = pred_true), |
3934 | | optional_functionality_check(Tail,X,WF). |
3935 | | apply_to4(pred_false,_EqResY,_Y2,T,X,Y,InitialRel,Span,WF) :- apply_to2(T,X,Y,InitialRel,Span,WF). |
3936 | | % (nonvar(T) -> apply_to2(T,X,Y,InitialRel,WF) |
3937 | | % ; when((ground(X);nonvar(T)), apply_to2(T,X,Y,InitialRel,WF))). |
3938 | | |
3939 | | % we delay setting up equality_objects until X3 is at least partially known, see test 1715 Alstom_essai2_boucle1 |
3940 | | % TO DO: we could check if X3==X above |
3941 | | :- block apply_to4_call5(-,?,?, ?,?,?,?,?,?, -,?,?). |
3942 | | apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, _X3,_Y3,_T3) :- nonvar(EqResX),!, |
3943 | | apply_to4(EqResX,EqResY,Y2,Tail,X,Y,InitialRel,Span,WF). |
3944 | | apply_to4_call5(EqResX,EqResY,Y2, _Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3) :- % X3 must now be bound |
3945 | | equality_objects_wf(X3,X,EqRes3,WF), |
3946 | | %print(eq5(X3,X,EqRes3,Y3,T3)),nl, |
3947 | | apply_to5(EqResX,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, InitialRel,Span,WF). |
3948 | | |
3949 | | % version which wait suntil first argument known |
3950 | | :- block apply_to4_block(-,?,?, ?,?,?,?,?,?). |
3951 | | apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :- |
3952 | | apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF). |
3953 | | |
3954 | | |
3955 | | % apply_to5: implements a watched-literal style treatment of function application |
3956 | | % we watch whether X unifies with two elements of the function, if only one element left we can force equality |
3957 | | % TEST: |
3958 | | % 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 |
3959 | | :- block apply_to5(-,?,-, ?,?,?,?, ?,?, ?,?,?),apply_to5(-,?,?, ?,?,?,-, ?,?, ?,?,?). |
3960 | | apply_to5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :- %print(apply5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF)),nl, |
3961 | | var(EqRes),!, %trace, |
3962 | | % EqRes3 and T3 must be known; TO DO: improve predicate so that we have to wait on T3 only when EqRes3=pred_false |
3963 | | (EqRes3 = pred_false -> % we cannot match next element, move tail one forward |
3964 | | (T3 = [] -> EqRes=pred_true ; true), |
3965 | | apply_to4(EqRes,EqResY,Y2,T3,X,Y,InitialRel,Span,WF) |
3966 | | ; /* EqRes3 = pred_true */ |
3967 | | % we match the next entry in the list; discard Y2 and jump to (X3,Y3) and return as solution |
3968 | | equal_object_wf(Y3,Y,apply_to6,WF), optional_functionality_check(T3,X,WF), |
3969 | | % TO DO: we could also do equality_objects if necessary between Y and Y3, as in apply_to4 for Y and Y2 |
3970 | | opt_force_false(EqRes) |
3971 | | ). |
3972 | | apply_to5(pred_true,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, _InitialRel,_Span,WF) :- |
3973 | ? | (EqResY==not_called -> equal_object_wf(Y2,Y,apply_to5,WF) ; EqResY = pred_true), |
3974 | ? | opt_force_false(EqRes3), |
3975 | | optional_functionality_check([(X3,Y3)|T3],X,WF). |
3976 | | apply_to5(pred_false,_EqResY,EqRes3, _Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :- |
3977 | ? | (var(EqRes3) -> % it can be that EqRes3 is about to be triggered, frozen(EqRes3,Goals), print(frozen(EqRes3,Goals)),nl, trace, |
3978 | | equality_objects_wf(Y3,Y,EqResY3,WF), %print(apply(X,X2,EqRes,Y2,Y,EqResY)),nl, |
3979 | | prop_apply_eqxy(EqResY3,EqRes3) % propagate: if Y/=Y3 => X/=X3 |
3980 | | ; EqResY3=not_called), |
3981 | ? | apply_to4(EqRes3,EqResY3,Y3, T3,X,Y,InitialRel,Span,WF). |
3982 | | |
3983 | | opt_force_false(EqRes) :- |
3984 | ? | (preference(find_abort_values,false) -> EqRes=pred_false |
3985 | | ; true). % TO DO: if EqRes becomes pred_true: raise abort_error as the relation was not a function |
3986 | | |
3987 | | |
3988 | | |
3989 | | /********************************************/ |
3990 | | /* surjection_relation(R,Domain,Range) */ |
3991 | | /* R : Domain <->> Range */ |
3992 | | /********************************************/ |
3993 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(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)). |
3994 | | :- 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)). |
3995 | | |
3996 | | surjection_relation_wf(R,Domain,Range,WF) :- |
3997 | | is_surjective(R,Range,WF), |
3998 | | % TODO: is not optimal since ran(R)<:Range is already implied by is_surjective and |
3999 | | % checked a second time by relation_over_wf/4 |
4000 | | relation_over_wf(R,Domain,Range,WF). |
4001 | | |
4002 | | :- 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)). |
4003 | | |
4004 | | not_surjection_relation_wf(R,Domain,Range,WF) :- |
4005 | | expand_custom_set_to_list_wf(R,ER,Done,not_surjection_relation_wf,WF), |
4006 | | not_tot_surj_rel(ER,Done,[],Domain,Range,Range,WF). |
4007 | | |
4008 | | /*********************************************/ |
4009 | | /* total_surjection_relation(R,Domain,Range) */ |
4010 | | /* R : Domain <<->> Range */ |
4011 | | /*********************************************/ |
4012 | | :- 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)). |
4013 | | :- 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)). |
4014 | | |
4015 | | |
4016 | | :- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1)],[int(11),int(12)]),L), |
4017 | | 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 |
4018 | | length(SSL,1))). |
4019 | | %:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),L), length(L,7))). |
4020 | | % the new domain predicate also instantiates from result; meaning that duplicate solutions are now generated |
4021 | | :- 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))). |
4022 | | :- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11)]),L), |
4023 | | length(L,1))). |
4024 | | |
4025 | | total_surjection_relation(R,Domain,Range) :- init_wait_flags(WF), |
4026 | | total_surjection_relation_wf(R,Domain,Range,WF), ground_wait_flags(WF). |
4027 | | |
4028 | | total_surjection_relation_wf(R,Domain,Range,WF) :- |
4029 | | relation_over_wf(R,Domain,Range,WF), |
4030 | | check_relation_is_total(R,Domain,WF), % calls domain which now instantiates R if Domain known |
4031 | | check_relation_is_surjective(R,Range,WF). |
4032 | | |
4033 | | |
4034 | | :- 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)). |
4035 | | :- 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)). |
4036 | | :- 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)). |
4037 | | |
4038 | | not_total_surjection_relation_wf(R,Domain,Range,WF) :- |
4039 | | expand_custom_set_to_list_wf(R,ER,Done,not_total_surjection_relation_wf,WF), |
4040 | | not_tot_surj_rel(ER,Done,Domain,Domain,Range,Range,WF). |
4041 | | |
4042 | | |
4043 | | /********************************************/ |
4044 | | /* partial_surjection(R,DomType,RangeType) */ |
4045 | | /* R : DomType +->> RangeType */ |
4046 | | /********************************************/ |
4047 | | |
4048 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). |
4049 | | :- 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)). |
4050 | | :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4051 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4052 | | :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],global_set('Name')), |
4053 | | kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))). |
4054 | | :- assert_must_succeed((bsets_clp:partial_surjection_wf(X,[int(1),int(2),int(3)],global_set('Name'),_WF), |
4055 | | kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))). |
4056 | | :- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]), |
4057 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4058 | | :- assert_must_succeed_multiple((bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]), |
4059 | | % print(X),nl, |
4060 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))]))). /* mult. */ |
4061 | | :- assert_must_succeed((X=[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))], |
4062 | | bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]))). |
4063 | | :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4064 | | X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])). |
4065 | | :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4066 | | X = [(int(2),int(7)),(int(1),int(7))])). |
4067 | | :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]), |
4068 | | X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])). |
4069 | | :- assert_must_succeed_multiple((bsets_clp:partial_surjection(_X, |
4070 | | [int(1),int(2),int(3),int(4),int(5),int(6),int(7)],[int(2),int(3),int(4)]) )). |
4071 | | :- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4072 | | X = [(int(2),int(7)),(int(2),int(6))])). |
4073 | | |
4074 | | partial_surjection(R,Domain,Range) :- init_wait_flags(WF), |
4075 | | partial_surjection_wf(R,Domain,Range,WF), |
4076 | | ground_wait_flags(WF). |
4077 | | |
4078 | | :- block partial_surjection_wf(-,-,?,?). |
4079 | | partial_surjection_wf(R,Domain,Range,WF) :- |
4080 | | check_card_greater_equal(Domain,geq,Range,CardDom,CardRange), |
4081 | | (surjection_has_to_be_total_injection(CardDom,CardRange) |
4082 | | % LAW: card(setX) = card(setY) => ff: setX +->> setY <=> ff: setX >-> setY |
4083 | | -> total_function_wf(R,Domain,Range,WF), |
4084 | | injective(R,WF) |
4085 | | ; is_surjective(R,Range,WF), |
4086 | | partial_function_wf(R,Domain,Range,WF) |
4087 | | ). |
4088 | | |
4089 | | |
4090 | | % check_card_greater_equal(A,B) : quick check that card(A) >= card(B); also works with infinite cardinality |
4091 | | % TO DO: replace by a better constraint propagating predicate (also working for partially instantiated lists,...) |
4092 | | % compared with computing card and setting up < constraint: will only compute card if it can be done efficiently + deals with inf |
4093 | | % check_card_greater_equal(SetA,EQ,SetB) ; EQ=eq or geq |
4094 | | :- block check_card_greater_equal(-,?,?,?,?). |
4095 | | check_card_greater_equal([],_,R,0,0) :- !, empty_set(R). |
4096 | | check_card_greater_equal(A,EQ,B,CA,CB) :- check_card_greater_equal2(A,EQ,B,CA,CB). |
4097 | | |
4098 | | :- use_module(inf_arith,[block_inf_greater_equal/2]). |
4099 | | :- block check_card_greater_equal2(?,?,-,?,?). |
4100 | | check_card_greater_equal2(A,EQ,B,CardA,CardB) :- |
4101 | | efficient_card_for_set(A,CardA,CodeA), |
4102 | | efficient_card_for_set(B,CardB,CodeB),!, |
4103 | | %print(check_geq(A,B,CardA,CodeA,CardB,CodeB)),nl, |
4104 | | call(CodeA), call(CodeB), |
4105 | | %% print(check_geq_val(CardA,CardB)),nl, %% |
4106 | | (EQ=eq -> CardA=CardB ; block_inf_greater_equal(CardA,CardB)). |
4107 | | check_card_greater_equal2(_A,_,_B,'?','?'). |
4108 | | |
4109 | | |
4110 | | :- block is_surjective(-,-,?). |
4111 | | is_surjective(R,Range,WF) :- % print(is_surjective(R,Range,WF)),nl, % |
4112 | | (var(R) -> setup_surj_range(Range,R) |
4113 | | ; range_wf(R,Range,WF)). |
4114 | | |
4115 | | setup_surj_range(Range,R) :- |
4116 | | setup_range(Range,Res,DONE), %print(setup_range(Range,Res,DONE)),nl, |
4117 | | equal_when_done(Res,R,DONE). |
4118 | | :- block equal_when_done(?,?,-). |
4119 | | equal_when_done(Res,R,_DONE) :- equal_object(Res,R). |
4120 | | |
4121 | | |
4122 | | :- block setup_range(-,?,?). |
4123 | | setup_range(global_set(G),Res,DONE) :- |
4124 | | expand_custom_set(global_set(G),ES), setup_range(ES,Res,DONE). |
4125 | | setup_range(freetype(ID),Res,DONE) :- |
4126 | | expand_custom_set(freetype(ID),ES), setup_range(ES,Res,DONE). |
4127 | | setup_range(avl_set(S),Res,DONE) :- expand_custom_set(avl_set(S),ES), setup_range(ES,Res,DONE). |
4128 | | setup_range(closure(P,T,B),Res,DONE) :- |
4129 | | expand_custom_set(closure(P,T,B),ES), setup_range(ES,Res,DONE). |
4130 | | setup_range([],_,done). |
4131 | | setup_range([H|T],[(_,H)|ST],DONE) :- setup_range(T,ST,DONE). |
4132 | | |
4133 | | |
4134 | | |
4135 | | :- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))], |
4136 | | [int(1),int(2)],[int(7),int(6)],WF),WF)). |
4137 | | :- 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)], |
4138 | | [int(7),int(6),int(2)],WF),WF)). |
4139 | | :- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4140 | | X = [(int(2),int(7)),(int(1),int(6))])). |
4141 | | :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4142 | | X = [(int(2),int(7)),(int(2),int(6))])). |
4143 | | :- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]), |
4144 | | X = [(int(2),int(7)),(int(1),int(6))])). |
4145 | | :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4146 | | X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])). |
4147 | | :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4148 | | X = [(int(2),int(7)),(int(1),int(7))])). |
4149 | | :- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]), |
4150 | | X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])). |
4151 | | |
4152 | | /* /: Domain +->> Range */ |
4153 | | not_partial_surjection(R,Domain,Range) :- init_wait_flags(WF), |
4154 | | not_partial_surjection_wf(R,Domain,Range,WF), |
4155 | | ground_wait_flags(WF). |
4156 | | |
4157 | | :- block not_partial_surjection_wf(-,?,?,?), not_partial_surjection_wf(?,-,?,?), |
4158 | | not_partial_surjection_wf(?,?,-,?). |
4159 | | not_partial_surjection_wf(R,DomType,RangeType,WF) :- |
4160 | | % TO DO: create a new partial_function_test kernel_equality like function instead |
4161 | | % The fact that R is not a partial surjection is difficult to exploit !? |
4162 | | kernel_tools:ground_value_check(R,RV), |
4163 | | not_partial_surjection2(R,DomType,RangeType,WF,RV). |
4164 | | |
4165 | | :- block not_partial_surjection2(?,?,?,?,-). |
4166 | | not_partial_surjection2(R,DomType,RangeType,WF,_) :- |
4167 | | not_partial_function(R,DomType,RangeType,WF). |
4168 | | not_partial_surjection2(R,DomType,RType,WF,_) :- |
4169 | | partial_function_wf(R,DomType,RType,WF), |
4170 | | invert_relation_wf(R,IR,WF), |
4171 | | not_total_relation_wf(IR,RType,DomType,WF). |
4172 | | |
4173 | | :- 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)). |
4174 | | :- 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)). |
4175 | | |
4176 | | :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4177 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4178 | | :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4179 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
4180 | | :- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4181 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(7))]))). |
4182 | | :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4183 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))). |
4184 | | :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4185 | | kernel_objects:equal_object(X,[(int(2),int(7))]))). |
4186 | | :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4187 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(8))]))). |
4188 | | :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4189 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(3),int(6)),(int(1),int(7))]))). |
4190 | | :- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4191 | | kernel_objects:equal_object(X,[]))). |
4192 | | |
4193 | | |
4194 | | total_relation_wf(R,Domain,Range,WF) :- relation_over_wf(R,Domain,Range,WF), |
4195 | | check_relation_is_total(R,Domain,WF). |
4196 | | |
4197 | | % this predicates assume that the relation's range and domain have already been checked |
4198 | | check_relation_is_total(Relation,Domain,WF) :- domain_wf(Relation,Domain,WF). |
4199 | | check_relation_is_surjective(Relation,Range,WF) :- |
4200 | | range_wf(Relation,Range,WF). % we could also call is_surjective (which does setup_surj_range) ? |
4201 | | |
4202 | | :- 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)). |
4203 | | :- 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)). |
4204 | | :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4205 | | X = [(int(2),int(7)),(int(1),int(6))])). |
4206 | | :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4207 | | X = [(int(2),int(7)),(int(1),int(7))])). |
4208 | | :- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4209 | | X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])). |
4210 | | :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4211 | | X = [(int(2),int(7)),(int(2),int(6))])). |
4212 | | :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4213 | | X = [(int(2),int(7))])). |
4214 | | :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4215 | | X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(8))])). |
4216 | | :- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF), |
4217 | | X = [(int(2),int(7)),(int(3),int(6)),(int(1),int(7))])). |
4218 | | |
4219 | | :- block not_total_relation_wf(-,?,?,?). |
4220 | | not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range), |
4221 | | % we do not need the Range; this means we can match more closures (e.g., lambda) |
4222 | | custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!, |
4223 | | not_equal_object_wf(FFDomain,Domain,WF). |
4224 | | not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF), |
4225 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!, |
4226 | | equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set |
4227 | | when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))). |
4228 | | not_total_relation_wf(R,Domain,Range,WF) :- |
4229 | | expand_custom_set_to_list_wf(R,ER,Done,not_total_relation_wf,WF), %print(not_tot_rel(ER,Domain)),nl,trace, |
4230 | | not_tot_surj_rel(ER,Done,Domain,Domain,[],Range,WF). % empty DelRange means we don't do surjective test |
4231 | | |
4232 | | % can be used to check not total, not surj, not total surj relation |
4233 | | :- block not_tot_surj_rel(-,?,?,?,?,?,?). |
4234 | | not_tot_surj_rel([],_,DelDomain,_,DelRange,_,WF) :- |
4235 | | at_least_one_set_not_empty(DelDomain,DelRange,WF). |
4236 | | not_tot_surj_rel([_|_],Done,_DelDom,Dom,_DelRan,_Ran,_WF) :- nonvar(Done), |
4237 | | Done \= no_check_to_be_done, |
4238 | | nonvar(Dom),is_infinite_explicit_set(Dom), |
4239 | | !. % a finite expanded list can never be a total relation over an infinite domain |
4240 | | not_tot_surj_rel([(X,Y)|T],_Done,DelDom,Dom,DelRan,Ran,WF) :- |
4241 | | membership_test_wf(Dom,X,MemRes,WF), |
4242 | | not_tr2(MemRes,X,Y,T,DelDom,Dom,DelRan,Ran,WF). |
4243 | | |
4244 | | % check if one of the two sets is non-empty |
4245 | | at_least_one_set_not_empty(Set1,_,_) :- nonvar(Set1), |
4246 | | (Set1=avl_set(_) ; Set1=[_|_]), % we can avoid leaving choice point |
4247 | | !. |
4248 | | at_least_one_set_not_empty(Set1,_,WF) :- not_empty_set_wf(Set1,WF). |
4249 | | at_least_one_set_not_empty(Set1,Set2,WF) :- empty_set_wf(Set1,WF),not_empty_set_wf(Set2,WF). |
4250 | | |
4251 | | :- block not_tr2(-,?,?,?,?,?,?,?,?). |
4252 | | not_tr2(pred_false,_X,_Y,_T,_DelDom,_Dom,_DelRan,_Ran,_WF). |
4253 | | not_tr2(pred_true,X,Y,T,DelDom,Dom,DelRan,Ran,WF) :- |
4254 | | delete_element_wf(X,DelDom,DelDom2,WF), % set DelDom initially to [] to avoid totality check |
4255 | | membership_test_wf(Ran,Y,MemRes,WF), |
4256 | | not_tr3(MemRes,Y,T,DelDom2,Dom,DelRan,Ran,WF). |
4257 | | |
4258 | | :- block not_tr3(-,?,?,?,?,?,?,?). |
4259 | | not_tr3(pred_false,_Y,_T,_DelDom2,_Dom,_DelRan,_Ran,_WF). |
4260 | | not_tr3(pred_true,Y,T,DelDom2,Dom,DelRan,Ran,WF) :- |
4261 | | delete_element_wf(Y,DelRan,DelRan2,WF), % set DelRan initially to [] to avoid surjection check |
4262 | | not_tot_surj_rel(T,no_check_to_be_done,DelDom2,Dom,DelRan2,Ran,WF). |
4263 | | |
4264 | | /******************************************/ |
4265 | | /* total_surjection(R,DomType,RangeType) */ |
4266 | | /* R : DomType -->> RangeType */ |
4267 | | /******************************************/ |
4268 | | |
4269 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). |
4270 | | :- 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 |
4271 | | :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1)],[int(7)]), |
4272 | | kernel_objects:equal_object(X,[(int(1),int(7))]))). |
4273 | | :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4274 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4275 | | :- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7)]), |
4276 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
4277 | | :- assert_must_fail((bsets_clp:total_surjection([],[int(1)],[int(7)]))). |
4278 | | :- assert_must_fail((bsets_clp:total_surjection([(int(7),int(7))],[int(1)],[int(7)]))). |
4279 | | :- assert_must_fail((bsets_clp:total_surjection([(int(1),int(7)), (int(2),int(1))], |
4280 | | [int(1),int(2)],[int(7)]))). |
4281 | | :- assert_must_fail((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]), |
4282 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))). |
4283 | | |
4284 | | |
4285 | | total_surjection(R,Domain,Range) :- init_wait_flags(WF), |
4286 | | total_surjection_wf(R,Domain,Range,WF), |
4287 | | ground_wait_flags(WF). |
4288 | | |
4289 | | :- block total_surjection_wf(-,-,?,?). |
4290 | | total_surjection_wf(R,DomType,RangeType,WF) :- |
4291 | | check_card_greater_equal(DomType,geq,RangeType,CardDom,CardRange), |
4292 | | total_function_wf(R,DomType,RangeType,WF), |
4293 | | % setup_surj_range(RangeType,R). |
4294 | | %print(totsurj(R,DomType,RangeType,CardDom,CardRange)),nl, |
4295 | | (surjection_has_to_be_total_injection(CardDom,CardRange) |
4296 | | % LAW: card(setX) = card(setY) => ff: setX -->> setY <=> ff: setX >-> setY |
4297 | | -> 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 |
4298 | | ; check_relation_is_surjective(R,RangeType,WF)). |
4299 | | % invert_relation_wf(R,IR,WF), total_relation_wf(IR,RangeType,DomType,WF). |
4300 | | |
4301 | | surjection_has_to_be_total_injection(CardDom,CardRange) :- number(CardDom), CardDom=CardRange. |
4302 | | % 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) |
4303 | | |
4304 | | :- 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)). |
4305 | | :- 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)). |
4306 | | :- 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)). |
4307 | | :- 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)). |
4308 | | :- 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)). |
4309 | | :- 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)). |
4310 | | |
4311 | | :- block not_total_surjection_wf(-,?,?,?), not_total_surjection_wf(?,-,?,?), |
4312 | | not_total_surjection_wf(?,?,-,?). |
4313 | | not_total_surjection_wf(R,DomType,RangeType,WF) :- |
4314 | | %get_middle_wait_flag(not_total_surjection,WF,LWF), |
4315 | | % TO DO: create a new total_function_test kernel_equality like function instead; or write custom not_total_function code |
4316 | | % The fact that R is not a total surjection is difficult to exploit !? |
4317 | | ground_value_check(R,RV), |
4318 | | not_total_surjection2(R,DomType,RangeType,WF,RV). |
4319 | | :- block not_total_surjection2(?,?,?,?,-). |
4320 | | not_total_surjection2(R,DomType,RangeType,WF,_) :- |
4321 | | not_total_function(R,DomType,RangeType,WF). |
4322 | | not_total_surjection2(R,DomType,RangeType,WF,_) :- |
4323 | | total_function_wf(R,DomType,RangeType,WF), |
4324 | | not_partial_surjection_wf(R,DomType,RangeType,WF). |
4325 | | |
4326 | | /*******************************************/ |
4327 | | /* partial_injection(R,DomType,RangeType) */ |
4328 | | /* R : DomType >+> RangeType */ |
4329 | | /*******************************************/ |
4330 | | |
4331 | | :- 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)). |
4332 | | :- 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)). |
4333 | | :- 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)). |
4334 | | :- assert_must_succeed((bsets_clp:partial_injection(X,[int(1)],[int(7)]), |
4335 | | kernel_objects:equal_object(X,[(int(1),int(7))]))). |
4336 | | :- assert_must_succeed((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]), |
4337 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4338 | | :- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7)]), |
4339 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
4340 | | :- assert_must_succeed((bsets_clp:partial_injection([],[int(1)],[int(7)]))). |
4341 | | :- assert_must_fail((bsets_clp:partial_injection([(int(7),int(7))],[int(1)],[int(7)]))). |
4342 | | :- assert_must_fail((bsets_clp:partial_injection([(int(1),int(7)), (int(2),int(1))], |
4343 | | [int(1),int(2)],[int(7)]))). |
4344 | | :- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]), |
4345 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))). |
4346 | | |
4347 | | |
4348 | | partial_injection(R,Domain,Range) :- init_wait_flags(WF), |
4349 | | partial_injection_wf(R,Domain,Range,WF), |
4350 | | ground_wait_flags(WF). |
4351 | | |
4352 | | :- block partial_injection_wf(-,-,?,?). |
4353 | | partial_injection_wf(FF,Domain,Range,WF) :- nonvar(FF), |
4354 | | custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!, |
4355 | | check_subset_of_wf(FFDomain,Domain,WF), |
4356 | | check_subset_of_wf(FFRange,Range,WF). |
4357 | | partial_injection_wf(R,DomType,RangeType,WF) :- |
4358 | | try_expand_and_convert_to_avl_unless_large(R,ER), |
4359 | | partial_function_wf(ER,DomType,RangeType,WF), |
4360 | | injective(ER,WF). |
4361 | | % invert_relation_wf(R,IR,WF), |
4362 | | % print(pf(IR)),nl, |
4363 | | % partial_function_wf(IR,RangeType,DomType,WF). |
4364 | | |
4365 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],WF),WF)). |
4366 | | :- 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)). |
4367 | | |
4368 | | :- block injective(-,?). |
4369 | | injective(FF,_WF) :- %tools_printing:print_term_summary(injective(FF)),nl, |
4370 | | custom_explicit_sets:dom_range_for_specific_closure(FF,_FFDomain,_FFRange,function(bijection)),!. |
4371 | | injective(avl_set(AVL),_WF) :- !, |
4372 | | is_injective_avl_relation(AVL,_Range). % seems slightly faster than code below |
4373 | | injective(Rel,WF) :- expand_custom_set_to_list_wf(Rel,ERel,_,injective,WF), |
4374 | | injective(ERel,[],WF). |
4375 | | |
4376 | | %:- use_module(library(lists),[maplist/3]). |
4377 | | % for FD-sets we could setup all_different constraint |
4378 | | :- block injective(-,?,?). |
4379 | | injective([],_SoFar,_). % :- print(all(SoFar)),nl, |
4380 | | % (maplist(get_fd_val,SoFar,FDL) -> clpfd:all_distinct(FDL) ; true). %clpfd_interface:clpfd_alldifferent(FDL) ; true). |
4381 | | %get_fd_val(int(H),H). |
4382 | | injective([(_From,To)|T],SoFar,WF) :- %print(inj_check(_From,To,SoFar,T)),nl, |
4383 | | not_element_of_wf(To,SoFar,WF), /* check that it is injective */ |
4384 | | %print(not_el(To)),nl, |
4385 | | add_new_element_wf(To,SoFar,SoFar2,WF), %SoFar2=[To|SoFar], could also work and be faster ? |
4386 | | %print(added(To,SoFar2)),nl, |
4387 | | injective(T,SoFar2,WF). |
4388 | | % no case for global_set: it cannot be a relation; two cases below not required because of expand_custom_set_to_list |
4389 | | %injective(avl_set(S),SoFar,WF) :- expand_custom_set(avl_set(S),ES), injective(ES,SoFar,WF). |
4390 | | %injective(closure(P,T,B),SoFar,WF) :- expand_custom_set(closure(P,T,B),ES), injective(ES,SoFar,WF). |
4391 | | |
4392 | | |
4393 | | |
4394 | | /* /: Dom >+> R */ |
4395 | | |
4396 | | :- 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)). |
4397 | | :- 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)). |
4398 | | :- 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)). |
4399 | | :- 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)). |
4400 | | |
4401 | | :- block not_partial_injection(-,?,?,?), not_partial_injection(?,-,?,?), |
4402 | | not_partial_injection(?,?,-,?). |
4403 | | not_partial_injection(R,DomType,RangeType,WF) :- |
4404 | | %get_middle_wait_flag(not_partial_injection,WF,LWF), |
4405 | | % TO DO: create a new partial_function_test kernel_equality like function instead |
4406 | | %ground_value_check(R,RV), |
4407 | | kernel_tools:ground_value_check((R,DomType),RDV), |
4408 | | not_partial_injection2(R,DomType,RangeType,WF,RDV). |
4409 | | % TO DO: should we check dom_range_for_specific_closure ? |
4410 | | :- block not_partial_injection2(?,?,?,?,-). |
4411 | | not_partial_injection2(R,DomType,RType,WF,_) :- is_ground_set(R), |
4412 | | is_ground_set(DomType), is_ground_set(RType), |
4413 | | !, % avoid backtracking and checking for partial_function twice |
4414 | | (not_partial_function(R,DomType,RType,WF) |
4415 | | -> true |
4416 | | ; not_inection_wf(R,DomType,RType,WF) |
4417 | | ). |
4418 | | not_partial_injection2(R,DomType,RType,WF,_) :- |
4419 | | not_partial_function(R,DomType,RType,WF). % we could perform a cut if RType is also ground |
4420 | | not_partial_injection2(R,DomType,RType,WF,_) :- |
4421 | | partial_function_wf(R,DomType,RType,WF), |
4422 | | not_inection_wf(R,DomType,RType,WF). |
4423 | | |
4424 | | not_inection_wf(R,DomType,RType,WF) :- |
4425 | | invert_relation_wf(R,IR,WF), |
4426 | | not_partial_function(IR,RType,DomType,WF). |
4427 | | |
4428 | | /*****************************************/ |
4429 | | /* total_injection(R,DomType,RangeType) */ |
4430 | | /* R : DomType >-> RangeType */ |
4431 | | /*****************************************/ |
4432 | | |
4433 | | :- 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)). |
4434 | | :- 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)). |
4435 | | :- 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)). |
4436 | | :- 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)). |
4437 | | :- assert_must_succeed((bsets_clp:total_injection(X,[int(1)],[int(7)]), |
4438 | | kernel_objects:equal_object(X,[(int(1),int(7))]))). |
4439 | | :- assert_must_succeed((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]), |
4440 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))). |
4441 | | :- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7)]), |
4442 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))). |
4443 | | :- assert_must_fail((bsets_clp:total_injection([],[int(1)],[int(7)]))). |
4444 | | :- assert_must_fail((bsets_clp:total_injection([(int(7),int(7))],[int(1)],[int(7)]))). |
4445 | | :- assert_must_fail((bsets_clp:total_injection([(int(1),int(7)), (int(2),int(1))], |
4446 | | [int(1),int(2)],[int(7)]))). |
4447 | | :- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]), |
4448 | | kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))). |
4449 | | |
4450 | | |
4451 | | total_injection(R,Domain,Range) :- init_wait_flags(WF), |
4452 | | total_injection_wf(R,Domain,Range,WF), |
4453 | | ground_wait_flags(WF). |
4454 | | |
4455 | | :- block total_injection_wf(-,-,?,?). % with just ?,-,?,? we may wait too long to start injective check |
4456 | | % Note: no need to check: dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)), |
4457 | | total_injection_wf(R,DomType,RangeType,WF) :- % print_message(total_inj(R)), |
4458 | | check_card_greater_equal(RangeType,geq,DomType,_,_), % there must be more Range elements than domain elements; pigeonhole principle |
4459 | | total_injection_wf2(R,DomType,RangeType,WF). |
4460 | | total_injection_wf2(R,DomType,RangeType,WF) :- |
4461 | | try_expand_and_convert_to_avl_unless_large(R,ER), |
4462 | | total_function_wf(ER,DomType,RangeType,WF), % print_message(total_f(ER)), |
4463 | | injective(ER,WF). |
4464 | | |
4465 | | |
4466 | | :- block not_total_injection(-,?,?,?), not_total_injection(?,-,?,?), |
4467 | | not_total_injection(?,?,-,?). |
4468 | | not_total_injection(R,DomType,RangeType,WF) :- |
4469 | | %get_middle_wait_flag(not_total_injection,WF,LWF), |
4470 | | % TO DO: create a new total_function_test kernel_equality like function instead |
4471 | | kernel_tools:ground_value_check((R,DomType),RDV), |
4472 | | not_total_injection2(R,DomType,RangeType,WF,RDV). |
4473 | | |
4474 | | :- block not_total_injection2(?,?,?,?,-). |
4475 | | not_total_injection2(R,DomType,RangeType,WF,_) :- is_ground_set(R), |
4476 | | is_ground_set(DomType), is_ground_set(RangeType), |
4477 | | !, % avoid backtracking and checking for total_function twice |
4478 | | (not_total_function(R,DomType,RangeType,WF) |
4479 | | -> true |
4480 | | ; not_inection_wf(R,DomType,RangeType,WF) |
4481 | | ). |
4482 | | not_total_injection2(R,DomType,RangeType,WF,_) :- %print(not_tot_inj(R)),nl, |
4483 | | not_total_function(R,DomType,RangeType,WF) . %, print(not_tot_fun(R)),nl. |
4484 | | not_total_injection2(R,DomType,RangeType,WF,_) :- % print(try2(R)),nl, |
4485 | | total_function_wf(R,DomType,RangeType,WF), %print(tot_fun(R)),nl, |
4486 | | not_inection_wf(R,DomType,RangeType,WF). |
4487 | | |
4488 | | /***********************************/ |
4489 | | /* partial_bijection(R,DomType,RangeType) */ |
4490 | | /* R : DomType >+>> RangeType */ |
4491 | | /***********************************/ |
4492 | | |
4493 | | |
4494 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). |
4495 | | :- 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)). |
4496 | | :- assert_must_succeed((partial_bijection(X,[int(1),int(2)],[int(7),int(6)]), |
4497 | | kernel_objects:equal_object(X,[(int(1),int(6)),(int(2),int(7))]))). |
4498 | | :- assert_must_succeed((partial_bijection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]), |
4499 | | X = [(int(2),int(7)),(int(3),int(6))])). |
4500 | | :- assert_must_fail((partial_bijection(X,[int(1),int(2)],[int(7),int(6),int(5)]), |
4501 | | X = [(int(2),int(7)),(int(1),int(6))])). |
4502 | | |
4503 | | partial_bijection(R,Domain,Range) :- init_wait_flags(WF), |
4504 | | partial_bijection_wf(R,Domain,Range,WF), |
4505 | | ground_wait_flags(WF). |
4506 | | |
4507 | | partial_bijection_wf(R,DomType,RangeType,WF) :- |
4508 | | partial_injection_wf(R,DomType,RangeType,WF), |
4509 | | partial_surjection_wf(R,DomType,RangeType,WF). |
4510 | | |
4511 | | :- 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)). |
4512 | | :- 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)). |
4513 | | |
4514 | | :- 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)). |
4515 | | |
4516 | | :- 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)). |
4517 | | :- 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)). |
4518 | | |
4519 | | |
4520 | | :- block not_partial_bijection(-,?,?,?), not_partial_bijection(?,-,?,?), |
4521 | | not_partial_bijection(?,?,-,?). |
4522 | | not_partial_bijection(R,DomType,RangeType,WF) :- |
4523 | | %get_middle_wait_flag(not_partial_bijection,WF,LWF), |
4524 | | kernel_tools:ground_value_check((R,DomType,RangeType),LWF), |
4525 | | not_partial_bijection2(R,DomType,RangeType,WF,LWF). |
4526 | | :- block not_partial_bijection2(?,?,?,?,-). |
4527 | | not_partial_bijection2(R,DomType,RangeType,WF,_) :- |
4528 | | not_partial_injection(R,DomType,RangeType,WF). |
4529 | | not_partial_bijection2(R,DomType,RangeType,WF,_) :- |
4530 | | partial_injection_wf(R,DomType,RangeType,WF), |
4531 | | not_partial_surjection_wf(R,DomType,RangeType,WF). |
4532 | | |
4533 | | |
4534 | | |
4535 | | |
4536 | | |
4537 | | |
4538 | | /* The transitive (not reflexive) closure of a relation */ |
4539 | | |
4540 | | :- 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))]))). |
4541 | | :- 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))]))). |
4542 | | :- 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))]))). |
4543 | | :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4))],X), |
4544 | | kernel_objects:equal_object(X,[(int(1),int(4))]))). |
4545 | | :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2))],X), |
4546 | | kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)), |
4547 | | (int(1),int(2))]))). |
4548 | | :- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2)),(int(2),int(3))],X), |
4549 | | kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),(int(2),int(3)), |
4550 | | (int(4),int(3)),(int(1),int(2)),(int(1),int(3))]))). |
4551 | | |
4552 | | relational_trans_closure(Rel,Res) :- relational_trans_closure_wf(Rel,Res,no_wf_available). |
4553 | | |
4554 | | % transitive closure for relations (closure1) |
4555 | | :- block relational_trans_closure_wf(-,?,?). |
4556 | | relational_trans_closure_wf(Relation,Result,WF) :- % print_term_summary(closure1(Relation,Result)), |
4557 | ? | try_expand_and_convert_to_avl_with_check(Relation,ARelation,relational_trans_closure_wf), |
4558 | ? | relational_trans_closure2(ARelation,Result,WF). |
4559 | | :- block relational_trans_closure2(-,?,?). |
4560 | | relational_trans_closure2(ARelation,Result,WF) :- %print(closure1(ARelation)),nl, |
4561 | ? | (closure1_for_explicit_set(ARelation,Res) |
4562 | | -> % print_term_summary(closure1_explicit(ARelation,Res)), |
4563 | | kernel_objects:equal_object_wf(Res,Result,relational_trans_closure_wf,WF) |
4564 | ? | ; expand_custom_set_to_list_wf(ARelation,ERelation,_,relational_trans_closure2,WF), |
4565 | ? | is_full_relation(ERelation,WaitVar), |
4566 | ? | compute_trans_closure(ERelation,Result,WaitVar,WF) |
4567 | | ). |
4568 | | |
4569 | | :- block compute_trans_closure(?,?,-,?). |
4570 | | compute_trans_closure(Relation,Result,_,WF) :- % print(computing_trans_closure(Relation)),nl, |
4571 | ? | compute_trans_closure2(Relation,Result,WF). %,print(result(Result)),nl. |
4572 | | |
4573 | | compute_trans_closure2(Relation,Result,WF) :- %print_message(iter(Relation)), |
4574 | ? | one_closure_iteration(Relation,Relation,Relation,Result1,WF), |
4575 | ? | ( equal_object_wf(Result1,Relation,relational_trans_closure_wf,WF), % should we do equality_objects here? |
4576 | | equal_object_optimized_wf(Result,Result1,compute_trans_closure,WF) |
4577 | | ; % TO DO: use reification instead of is_full_relation check above ?? |
4578 | | not_equal_object(Result1,Relation), % not a fixpoint; continue |
4579 | | compute_trans_closure2(Result1,Result,WF) |
4580 | | ). |
4581 | | |
4582 | | one_closure_iteration([],_,Res,Res,_WF). |
4583 | | one_closure_iteration([(X,Y)|T],ExpandedPreviousRel,PreviousRel,OutRel,WF) :- |
4584 | | add_tuples(ExpandedPreviousRel,X,Y,PreviousRel,IntRel,WF), |
4585 | | one_closure_iteration(T,ExpandedPreviousRel,IntRel,OutRel,WF). |
4586 | | |
4587 | | |
4588 | | add_tuples([],_,_,OutRel,OutRel,_). |
4589 | | add_tuples([(X,Y)|T],OX,OY,InRel,OutRel,WF) :- |
4590 | | ( equal_object_wf(Y,OX,add_tuples,WF),add_element((X,OY),InRel,IntRel) ; |
4591 | | not_equal_object(Y,OX), IntRel = InRel), |
4592 | | add_tuples(T,OX,OY,IntRel,OutRel,WF). |
4593 | | |
4594 | | |
4595 | | :- assert_must_succeed((is_full_relation(X,R),var(R),X=[],R==true)). |
4596 | | :- 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)). |
4597 | | :- block is_full_relation(-,?). |
4598 | | is_full_relation([],R) :- !,R=true. |
4599 | | is_full_relation([H|T],W) :- !, is_full_relation_aux(H,T,W). |
4600 | | is_full_relation(X,R) :- |
4601 | | add_internal_error('Illegal Set for is_full_relation: ',is_full_relation(X,R)),fail. |
4602 | | |
4603 | | :- block is_full_relation_aux(-,?,?). |
4604 | | is_full_relation_aux((X,Y),T,W) :- !, is_full_relation_aux2(X,Y,T,W). |
4605 | | is_full_relation_aux(X,T,W) :- |
4606 | | add_internal_error('Illegal Set for is_full_relation: ',is_full_relation_aux(X,T,W)),fail. |
4607 | | :- block is_full_relation_aux2(-,?,?,?), is_full_relation_aux2(?,-,?,?). |
4608 | | is_full_relation_aux2(_X,_Y,T,W) :- is_full_relation(T,W). |
4609 | | |
4610 | | /* ------------------ */ |
4611 | | |
4612 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(2),int(3))],WF),WF)). |
4613 | | |
4614 | | in_closure1_wf(Pair,Relation,WF) :- %Pair = (_A,B), %print(in_closure1(Pair,Relation)),nl, |
4615 | | %in_domain_wf_lazy(A,Relation,WF), % done below |
4616 | | %check_element_of_wf((_,B),Relation,WF), % multiple solutions for _, see test 634, 637 |
4617 | ? | in_closure1_membership_test_wf(Pair,Relation,pred_true,WF). |
4618 | | |
4619 | | |
4620 | | :- 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)). |
4621 | | |
4622 | | not_in_closure1_wf(Pair,Relation,WF) :- |
4623 | | in_closure1_membership_test_wf(Pair,Relation,pred_false,WF). |
4624 | | |
4625 | | :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[],Res,_WF),Res==pred_false)). |
4626 | | :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(2))],Res,_WF),Res==pred_true)). |
4627 | | :- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3))],Res,_WF),Res==pred_false)). |
4628 | | :- 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)). |
4629 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],pred_true,WF),WF)). |
4630 | | :- 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)). |
4631 | | :- 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)). |
4632 | | :- 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)). |
4633 | | :- assert_must_succeed(exhaustive_kernel_check_wfdet(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)). |
4634 | | :- 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)). |
4635 | | |
4636 | | :- block force_in_domain(-,?,?,?). |
4637 | | force_in_domain(pred_false,_A,_Relation,_WF). |
4638 | | force_in_domain(pred_true,A,Relation,WF) :- % force A to be in domain, avoid enumeration warnings,... |
4639 | | % maybe only for non-ground A |
4640 | | in_domain_wf_lazy(A,Relation,WF). % slowdown Loop.mch (tests 634, 637) if we use in_domain_wf ? |
4641 | | |
4642 | | % (x,y) : closure1(Rel) |
4643 | | :- block in_closure1_membership_test_wf(?,-,?,?). |
4644 | | in_closure1_membership_test_wf((A,B),CSRelation,MemRes,WF) :- |
4645 | ? | is_custom_explicit_set(CSRelation,in_closure1), |
4646 | ? | !, |
4647 | ? | image_for_closure1_wf(CSRelation,[A],Image,WF), |
4648 | | force_in_domain(MemRes,A,CSRelation,WF), |
4649 | | membership_test_wf(Image,B,MemRes,WF). |
4650 | | in_closure1_membership_test_wf((X,Y),Relation,MemRes,WF) :- |
4651 | | expand_custom_set_to_list_wf(Relation,ERelation,_,in_closure1_membership_test_wf,WF), |
4652 | | Discarded = [], % pairs discarded in current iteration |
4653 | | force_in_domain(MemRes,X,Relation,WF), |
4654 | | in_closure1_membership_test_wf2(ERelation,X,Y,Discarded,MemRes,WF). |
4655 | | |
4656 | | :- block in_closure1_membership_test_wf2(-,?,?,?,?,?). |
4657 | | in_closure1_membership_test_wf2([],_X,_Y,_,MemRes,_WF) :- MemRes=pred_false. |
4658 | | in_closure1_membership_test_wf2([(V,W)|Rest],X,Y,Discarded,MemRes,WF) :- % TO DO: Rest==[] --> |
4659 | | equality_objects_wf(V,X,VXResult,WF), |
4660 | | in_closure1_membership_test_wf3(VXResult,V,W,Rest,X,Y,Discarded,MemRes,WF). |
4661 | | |
4662 | | :- block in_closure1_membership_test_wf3(-,?,?,?,?,?,?,?,?). |
4663 | | in_closure1_membership_test_wf3(pred_false,V,W,Rest,X,Y,Discarded,MemRes,WF) :- |
4664 | | in_closure1_membership_test_wf2(Rest,X,Y,[(V,W)|Discarded],MemRes,WF). |
4665 | | in_closure1_membership_test_wf3(pred_true,V,W,Rest,X,Y,Discarded,MemRes,WF) :- % V=X |
4666 | | propagate_false(MemRes,WYResult), |
4667 | | % TODO: Res=[],Discarded=[] -> MemRes=WYResult |
4668 | | equality_objects_wf(W,Y,WYResult,WF), % MemRes = pred_false => WYResult = pred_false |
4669 | | in_closure1_membership_test_wf4(WYResult,V,W,Rest,X,Y,Discarded,MemRes,WF). |
4670 | | |
4671 | | :- block in_closure1_membership_test_wf4(-,?,?,?,?,?,?,?,?). |
4672 | | in_closure1_membership_test_wf4(pred_false,_V,W,Rest,X,Y,Discarded,MemRes,WF) :- |
4673 | | append(Discarded,Rest,Restart), |
4674 | | in_closure1_membership_test_wf2(Restart,W,Y,[],MemRes1,WF), |
4675 | | propagate_false(MemRes,MemRes1), % MemRes = false -> MemRes1=false |
4676 | | when(nonvar(MemRes1), |
4677 | | (MemRes1=pred_true -> MemRes=pred_true |
4678 | | ; in_closure1_membership_test_wf2(Rest,X,Y,Discarded,MemRes,WF) % (V,W) not in Discarded: was not useful |
4679 | | )). |
4680 | | in_closure1_membership_test_wf4(pred_true,_V,_W,_Rest,_X,_Y,_Discarded,MemRes,_WF) :- % W=Y |
4681 | | MemRes = pred_true. |
4682 | | /* ------------------ */ |
4683 | | |
4684 | | :- block propagate_false(-,?). |
4685 | | propagate_false(pred_false,pred_false). |
4686 | | propagate_false(pred_true,_). |
4687 | | |