1/*
2
3EMBLEM and SLIPCASE
4
5Copyright (c) 2011, Fabrizio Riguzzi and Elena Bellodi
6
7*/
8:-use_module(library(lists)).
9:-load_foreign_files(['bddem'],[],init_my_predicates).
10
11:-dynamic p/2,rule_n/1,setting/2.
12
13
14rule_n(0).
15
16setting(epsilon_parsing, 1e-10).
17setting(tabling, off).
18/* on, off */
19
20setting(bagof,false).
21/* values: false, intermediate, all, extra */
22
23setting(compiling,off).
24
25:-yap_flag(unknown,fail).
26
27setting(depth_bound,false).  %if true, it limits the derivation of the example to the value of 'depth'
28setting(depth,2).
29setting(single_var,false). %false:1 variable for every grounding of a rule; true: 1 variable for rule (even if a rule has more groundings),simpler.
30
31:- yap_flag(single_var_warnings, on).
32
33
34load(FileIn,C1,R):-
35  open(FileIn,read,SI),
36  read_clauses_dir(SI,C),
37  close(SI),
38  process_clauses(C,[],C1,[],R).
39
40
41add_inter_cl(CL):-
42  %findall(A,(input(A);output(A)),L),
43  findall(A,(input(A)),L),
44  gen_cl(L,CL).
45
46
47gen_cl([],[]).
48
49gen_cl([H/A|T],[C|T1]):-
50  functor(F,H,A),
51  add_mod_arg(F,Module,F1),
52  add_bdd_arg(F,BDD,Module,F2),
53  C=(F2:-(F1,one(BDD))),
54  gen_cl(T,T1).
55
56
57assert_all([]).
58
59assert_all([H|T]):-
60  assert(H),
61  assert_all(T).
62
63
64retract_all([]):-!.
65
66retract_all([H|T]):-
67  retract(H),
68  retract_all(T).
69
70
71read_clauses_dir(S,[Cl|Out]):-
72  read_term(S,Cl,[]),
73  (Cl=end_of_file->
74    Out=[]
75  ;
76    read_clauses_dir(S,Out)
77  ).
78
79
80process_clauses([],C,C,R,R):-!.
81
82process_clauses([end_of_file],C,C,R,R):-!.
83
84process_clauses([H|T],C0,C1,R0,R1):-
85  (term_expansion(H,H1)->
86    true
87  ;
88    H1=(H,[])
89  ),
90  (H1=([_|_],R)->
91    H1=(List,R),
92    append(C0,List,C2),
93    append(R0,R,R2)
94  ;
95    (H1=([],_R)->
96      C2=C0,
97      R2=R0
98    ;
99      H1=(H2,R),
100      append(C0,[H2],C2),
101      append(R0,R,R2)
102    )
103  ),
104  process_clauses(T,C2,C1,R2,R1).
105
106
107get_next_rule_number(R):-
108  retract(rule_n(R)),
109  R1 is R+1,
110  assert(rule_n(R1)).
111
112
113get_node(\+ Goal,BDD):-
114  setting(depth_bound,true),!,
115  setting(depth,DB),
116  retractall(v(_,_,_)),
117  add_bdd_arg_db(Goal,BDD,DB,Goal1),
118  (bagof(BDD,Goal1,L)->
119    or_list(L,B)
120  ;
121    zero(B)
122  ),
123  bdd_not(B,BDD).
124
125get_node(\+ Goal,BDD):-!,
126  retractall(v(_,_,_)),
127  add_bdd_arg(Goal,BDD,Goal1),
128  (bagof(BDD,Goal1,L)->
129    or_list(L,B)
130  ;
131    zero(B)
132  ),
133  bdd_not(B,BDD).
134
135get_node(Goal,B):-
136  setting(depth_bound,true),!,
137  setting(depth,DB),
138  retractall(v(_,_,_)),
139  add_bdd_arg_db(Goal,BDD,DB,Goal1),%DB=depth bound
140  (bagof(BDD,Goal1,L)->
141    or_list(L,B)
142  ;
143    zero(B)
144  ).
145
146get_node(Goal,B):- %with DB=false
147  retractall(v(_,_,_)),
148  add_bdd_arg(Goal,BDD,Goal1),
149  (bagof(BDD,Goal1,L)->
150    or_list(L,B)
151  ;
152    zero(B)
153  ).
154
155
156s(Goal,P,CPUTime1,0,WallTime1,0):-
157  statistics(cputime,[_,_]),
158  statistics(walltime,[_,_]),
159    init,
160    retractall(v(_,_,_)),
161    abolish_all_tables,
162    add_bdd_arg(Goal,BDD,Goal1),
163    (bagof(BDD,Goal1,L)->
164      or_list(L,B),
165      ret_prob(B,P)
166    ;
167      P=0.0
168    ),
169    end,
170  statistics(cputime,[_,CT1]),
171  CPUTime1 is CT1/1000,
172  statistics(walltime,[_,WT1]),
173  WallTime1 is WT1/1000.
174
175
176get_var_n(R,S,Probs,V):-
177  (v(R,S,V)->
178    true
179  ;
180    length(Probs,L),
181    add_var(L,Probs,R,V),
182    assert(v(R,S,V))
183  ).
184
185
186generate_rules_fact([],_VC,_R,_Probs,_N,[],_Module).
187
188generate_rules_fact([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!,
189  add_bdd_arg(Head,BDD,Module,Head1),
190  Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))).
191
192generate_rules_fact([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):-
193  add_bdd_arg(Head,BDD,Module,Head1),
194  Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))),
195  N1 is N+1,
196  generate_rules_fact(T,VC,R,Probs,N1,Clauses,Module).
197
198
199generate_rules_fact_db([],_VC,_R,_Probs,_N,[],_Module).
200
201generate_rules_fact_db([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!,
202  add_bdd_arg_db(Head,BDD,_DB,Module,Head1),
203  Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))).
204
205generate_rules_fact_db([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):-
206  add_bdd_arg_db(Head,BDD,_DB,Module,Head1),
207  Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,N,BDD))),
208  N1 is N+1,
209  generate_rules_fact_db(T,VC,R,Probs,N1,Clauses,Module).
210
211
212generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module):-
213  add_bdd_arg(Head,BDD,Module,Head1),
214  Clause=(Head1:-(Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))).
215
216
217generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module):-
218  add_bdd_arg_db(Head,BDD,DBH,Module,Head1),
219  Clause=(Head1:-(DBH>=1,DB is DBH-1,Body,get_var_n(R,VC,Probs,V),equality(V,N,B),and(BDDAnd,B,BDD))).
220
221
222generate_rules([],_Body,_VC,_R,_Probs,_BDDAnd,_N,[],_Module).
223
224generate_rules([Head:_P1,'':_P2],Body,VC,R,Probs,BDDAnd,N,[Clause],Module):-!,
225  generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module).
226
227generate_rules([Head:_P|T],Body,VC,R,Probs,BDDAnd,N,[Clause|Clauses],Module):-
228  generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module),
229  N1 is N+1,
230  generate_rules(T,Body,VC,R,Probs,BDDAnd,N1,Clauses,Module).
231
232
233generate_rules_db([],_Body,_VC,_R,_Probs,_DB,_BDDAnd,_N,[],_Module):-!.
234
235generate_rules_db([Head:_P1,'':_P2],Body,VC,R,Probs,DB,BDDAnd,N,[Clause],Module):-!,
236  generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module).
237
238generate_rules_db([Head:_P|T],Body,VC,R,Probs,DB,BDDAnd,N,[Clause|Clauses],Module):-
239  generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module),!,%agg.cut
240  N1 is N+1,
241  generate_rules_db(T,Body,VC,R,Probs,DB,BDDAnd,N1,Clauses,Module).
242
243
244process_body_database([],[],_Module).
245
246process_body_database([H|T],[H1|T1],Module):-
247  add_mod_arg(H,H1,Module),
248  process_body_database(T,T1,Module).
249
250
251process_body_db([],BDD,BDD,_DB,Vars,Vars,[],_Module):-!.
252
253process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
254  builtin(H),!,
255  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
256
257process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
258  db(H),!,
259  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
260
261process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[
262(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
263  and(BDD,BDDN,BDD2)
264  |Rest],Module):-
265  given(H),!,
266  add_mod_arg(H,Module,H1),
267  add_bdd_arg_db(H,BDDH,DB,Module,H2),
268  process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
269
270process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[
271  neg(H1)|Rest],Module):-
272  given_cw(H),!,
273  add_mod_arg(H,Module,H1),
274  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
275
276process_body_db([\+ H|T],BDD,BDD1,DB,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1],
277[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
278  and(BDD,BDDN,BDD2)|Rest],Module):-!,
279  add_bdd_arg_db(H,BDDH,DB,Module,H1),
280  process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
281
282process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
283  builtin(H),!,
284  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
285
286process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
287  db(H),!,
288  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
289
290process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,
291[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
292  given(H),!,
293  add_mod_arg(H,Module,H1),
294  add_bdd_arg_db(H,BDDH,DB,Module,H2),
295  process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
296
297process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,
298[H1|Rest],Module):-
299  given_cw(H),!,
300  add_mod_arg(H,Module,H1),
301  process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
302
303process_body_db([H|T],BDD,BDD1,DB,Vars,[BDDH,BDD2|Vars1],
304[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!, %agg. cut
305  add_bdd_arg_db(H,BDDH,DB,Module,H1),
306  process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
307
308
309process_body_def_db([],BDD,BDD,_DB,Vars,Vars,[],_Module).
310
311process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
312  builtin(H),!,
313  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
314
315process_body_def_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):-
316  db(H),!,
317  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
318
319process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1,
320[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
321  and(BDD,BDDN,BDD2)|Rest],
322Module):-
323  given(H),!,
324  add_mod_arg(H,Module,H1),
325  add_bdd_arg_db(H,BDDH,DB,Module,H2),
326  process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
327
328process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,Vars1,
329[neg(H1)|Rest],
330Module):-
331  given_cw(H),!,
332  add_mod_arg(H,Module,H1),
333  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
334
335process_body_def_db([\+H|T],BDD,BDD1,DB,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1],
336  [(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
337  and(BDD,BDDN,BDD2)|Rest],Module):-!,
338  add_bdd_arg_db(H,BDDH,DB,Module,H1),
339  process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
340
341process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
342  builtin(H),!,
343  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
344
345process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):-
346  db(H),!,
347  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
348
349process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
350  given(H),!,
351  add_mod_arg(H,Module,H1),
352  add_bdd_arg_db(H,BDDH,DB,Module,H2),
353  process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
354
355process_body_def_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H1|Rest],Module):-
356  given_cw(H),!,
357  add_mod_arg(H,Module,H1),
358  process_body_def_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module).
359
360process_body_def_db([H|T],BDD,BDD1,DB,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!,
361  add_bdd_arg_db(H,BDDH,DB,Module,H1),
362  process_body_def_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module).
363
364
365
366
367process_body_def([],BDD,BDD,Vars,Vars,[],_Module).
368
369process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
370  builtin(H),!,
371  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
372
373process_body_def([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
374  db(H),!,
375  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
376
377process_body_def([\+H|T],BDD,BDD1,Vars,Vars1,
378[(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
379  and(BDD,BDDN,BDD2)|Rest],
380  Module):-
381  given(H),!,
382  add_mod_arg(H,Module,H1),
383  add_bdd_arg(H,BDDH,Module,H2),
384  process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
385
386process_body_def([\+H|T],BDD,BDD1,Vars,Vars1,
387[neg(H1)|Rest],
388Module):-
389  given_cw(H),!,
390  add_mod_arg(H,Module,H1),
391  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
392
393process_body_def([\+H|T],BDD,BDD1,Vars,[BDD,BDDH,L,BDDL,BDDN|Vars1],
394  [(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
395  and(BDD,BDDN,BDD2)|Rest],Module):-!,
396  add_bdd_arg(H,BDDH,Module,H1),
397  process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
398
399process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
400  builtin(H),!,
401  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
402
403process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
404  db(H),!,
405  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
406
407process_body_def([H|T],BDD,BDD1,Vars,Vars1,[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
408  given(H),!,
409  add_mod_arg(H,Module,H1),
410  add_bdd_arg(H,BDDH,Module,H2),
411  process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
412
413process_body_def([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):-
414  given_cw(H),!,
415  add_mod_arg(H,Module,H1),
416  process_body_def(T,BDD,BDD1,Vars,Vars1,Rest,Module).
417
418process_body_def([H|T],BDD,BDD1,Vars,[BDD,BDDH|Vars1],[H1,and(BDD,BDDH,BDD2)|Rest],Module):-!,
419  add_bdd_arg(H,BDDH,Module,H1),
420  process_body_def(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
421
422
423process_body([],BDD,BDD,Vars,Vars,[],_Module).
424
425process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
426  builtin(H),!,
427  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
428
429process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):-
430  db(H),!,
431  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
432
433process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[
434(((neg(H1);\+ H1),one(BDDN));(bagof(BDDH,H2,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN))),
435  and(BDD,BDDN,BDD2)
436  |Rest],Module):-
437  given(H),!,
438  add_mod_arg(H,Module,H1),
439  add_bdd_arg(H,BDDH,Module,H2),
440  process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
441
442process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[
443  neg(H1)|Rest],Module):-
444  given_cw(H),!,
445  add_mod_arg(H,Module,H1),
446  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
447
448process_body([\+ H|T],BDD,BDD1,Vars,[BDDH,BDDN,L,BDDL,BDD2|Vars1],
449[(bagof(BDDH,H1,L)->or_list(L,BDDL),bdd_not(BDDL,BDDN);one(BDDN)),
450  and(BDD,BDDN,BDD2)|Rest],Module):-!,
451  add_bdd_arg(H,BDDH,Module,H1),
452  process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
453
454process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
455  builtin(H),!,
456  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
457
458process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):-
459  db(H),!,
460  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
461
462process_body([H|T],BDD,BDD1,Vars,Vars1,
463[((H1,one(BDDH));H2),and(BDD,BDDH,BDD2)|Rest],Module):-
464  given(H),!,
465  add_mod_arg(H,Module,H1),
466  add_bdd_arg(H,BDDH,Module,H2),
467  process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
468
469process_body([H|T],BDD,BDD1,Vars,Vars1,
470[H1|Rest],Module):-
471  given_cw(H),!,
472  add_mod_arg(H,Module,H1),
473  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
474
475process_body([H|T],BDD,BDD1,Vars,Vars1,[H1|Rest],Module):-
476  add_mod_arg(H,Module,H1),
477  db(H1),!,
478  process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module).
479
480process_body([H|T],BDD,BDD1,Vars,[BDDH,BDD2|Vars1],
481[H1,and(BDD,BDDH,BDD2)|Rest],Module):-
482  add_bdd_arg(H,BDDH,Module,H1),
483  process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module).
484
485
486given(H):-
487  functor(H,P,Ar),
488  (input(P/Ar)).
489
490
491given_cw(H):-
492  functor(H,P,Ar),
493  (input_cw(P/Ar)).
494
495
496and_list([],B,B).
497
498and_list([H|T],B0,B1):-
499  and(B0,H,B2),
500  and_list(T,B2,B1).
501
502
503or_list([H],H):-!.
504
505or_list([H|T],B):-
506  or_list1(T,H,B).
507
508
509or_list1([],B,B).
510
511or_list1([H|T],B0,B1):-
512  or(B0,H,B2),
513  or_list1(T,B2,B1).
514
515
516/* set(Par,Value) can be used to set the value of a parameter */
517set(Parameter,Value):-
518  retract(setting(Parameter,_)),
519  assert(setting(Parameter,Value)).
520
521
522
523extract_vars(Variable, Var0, Var1) :-
524  var(Variable), !,
525  (member_eq(Variable, Var0) ->
526    Var1 = Var0
527  ;
528    append(Var0, [Variable], Var1)
529  ).
530
531extract_vars(Term, Var0, Var1) :-
532  Term=..[_F|Args],
533  extract_vars_list(Args, Var0, Var1).
534
535
536
537extract_vars_list([], Var, Var).
538
539extract_vars_list([Term|Tail], Var0, Var1) :-
540  extract_vars(Term, Var0, Var),
541  extract_vars_list(Tail, Var, Var1).
542
543
544difference([],_,[]).
545
546difference([H|T],L2,L3):-
547  member_eq(H,L2),!,
548  difference(T,L2,L3).
549
550difference([H|T],L2,[H|L3]):-
551  difference(T,L2,L3).
552
553
554member_eq(E,[H|_T]):-
555  E==H,!.
556
557member_eq(E,[_H|T]):-
558  member_eq(E,T).
559
560
561add_bdd_arg(A,BDD,A1):-
562  A=..[P|Args],
563  append(Args,[BDD],Args1),
564  A1=..[P|Args1],
565  (setting(tabling,on)->
566    table_pred(A)
567  ;
568    true
569  ).
570
571
572add_bdd_arg_db(A,BDD,DB,A1):-
573  A=..[P|Args],
574  append(Args,[DB,BDD],Args1),
575  A1=..[P|Args1],
576  (setting(tabling,on)->
577    table_pred(A)
578  ;
579    true
580  ).
581
582
583add_bdd_arg(A,BDD,Module,A1):-
584  A=..[P|Args],
585  append(Args,[BDD],Args1),
586  A1=..[P,Module|Args1],
587  (setting(tabling,on)->
588    table_pred(A)
589  ;
590    true
591  ).
592
593
594add_bdd_arg_db(A,BDD,DB,Module,A1):-
595  A=..[P|Args],
596  append(Args,[DB,BDD],Args1),
597  A1=..[P,Module|Args1],
598  (setting(tabling,on)->
599    table_pred(A)
600  ;
601    true
602  ).
603
604
605add_mod_arg(A,Module,A1):-
606  A=..[P|Args],
607  A1=..[P,Module|Args].
608
609
610table_pred(A):-
611  functor(A,P,Arity),
612  Arity1 is Arity +1,
613  (is_tabled((P/Arity1))->
614    true
615  ;
616    call(table(P/Arity1))
617  ).
618
619
620process_head(HeadList, GroundHeadList) :-
621  ground_prob(HeadList), !,
622  process_head_ground(HeadList, 0, GroundHeadList).
623
624process_head(HeadList, HeadList).
625
626
627
628/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null])
629 * ----------------------------------------------------------------
630 */
631process_head_ground([Head:ProbHead], Prob, [Head:ProbHead1|Null]) :-!,
632  ProbHead1 is ProbHead,
633  ProbLast is 1 - Prob - ProbHead1,
634  setting(epsilon_parsing, Eps),
635  EpsNeg is - Eps,
636  ProbLast > EpsNeg,
637  (ProbLast > Eps ->
638    Null = ['':ProbLast]
639  ;
640    Null = []
641  ).
642
643process_head_ground([Head:ProbHead|Tail], Prob, [Head:ProbHead1|Next]) :-
644  ProbHead1 is ProbHead,
645  ProbNext is Prob + ProbHead1,
646  process_head_ground(Tail, ProbNext, Next).
647
648
649ground_prob([]).
650
651ground_prob([_Head:ProbHead|Tail]) :-
652  ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead.
653  ground_prob(Tail).
654
655
656get_probs([], []).
657
658get_probs([_H:P|T], [P1|T1]) :-
659  P1 is P,
660  get_probs(T, T1).
661
662
663generate_clauses([],[],_N,C,C):-!.
664
665generate_clauses([H|T],[H1|T1],N,C0,C):-
666  gen_clause(H,N,N1,H1,CL),!,  %agg.cut
667  append(C0,CL,C1),
668  generate_clauses(T,T1,N1,C1,C).
669
670
671gen_clause((H :- Body),N,N,(H :- Body),[(H :- Body)]):-!.
672
673gen_clause(rule(_R,HeadList,BodyList),N,N1,
674  rule(N,HeadList,BodyList),Clauses):-
675  setting(depth_bound,true),!,
676% disjunctive clause with more than one head atom e depth_bound
677  process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module),
678  append([one(BDD)],BodyList1,BodyList2),
679  list2and(BodyList2,Body1),
680  extract_vars((HeadList,BodyList),[],VC),
681  get_probs(HeadList,Probs),
682  (setting(single_var,true)->
683    generate_rules_db(HeadList,Body1,[],N,Probs,DB,BDDAnd,0,Clauses,Module)
684  ;
685    generate_rules_db(HeadList,Body1,VC,N,Probs,DB,BDDAnd,0,Clauses,Module)
686   ),
687  N1 is N+1.
688
689gen_clause(rule(_R,HeadList,BodyList),N,N1,
690  rule(N,HeadList,BodyList),Clauses):-!,
691% disjunctive clause with more than one head atom senza depth_bound
692  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module),
693  append([one(BDD)],BodyList1,BodyList2),
694  list2and(BodyList2,Body1),
695  extract_vars((HeadList,BodyList),[],VC),
696  get_probs(HeadList,Probs),
697  (setting(single_var,true)->
698    generate_rules(HeadList,Body1,[],N,Probs,BDDAnd,0,Clauses,Module)
699  ;
700    generate_rules(HeadList,Body1,VC,N,Probs,BDDAnd,0,Clauses,Module)
701  ),
702  N1 is N+1.
703
704gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :-
705% disjunctive clause with a single head atom e depth_bound
706  setting(depth_bound,true),!,
707  process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
708  append([one(BDD)],BodyList2,BodyList3),
709  list2and(BodyList3,Body1),
710  add_bdd_arg_db(H,BDDAnd,DB,Module,Head1),
711  Clauses=[(Head1 :- Body1)].
712
713gen_clause(def_rule(H,BodyList),N,N,def_rule(H,BodyList),Clauses) :- !,%agg. cut
714% disjunctive clause with a single head atom senza depth_bound con prob =1
715  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
716  append([one(BDD)],BodyList2,BodyList3),
717  list2and(BodyList3,Body1),
718  add_bdd_arg(H,BDDAnd,Module,Head1),
719  Clauses=[(Head1 :- Body1)].
720
721
722user:term_expansion((Head :- Body), ((H :- Body),[])):-
723  Head=db(H),!.
724
725user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):-
726  setting(compiling,on),
727  setting(depth_bound,true),
728% disjunctive clause with more than one head atom e depth_bound
729  Head = (_;_), !,
730  list2or(HeadListOr, Head),
731  process_head(HeadListOr, HeadList),
732  list2and(BodyList, Body),
733  process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,Module),
734  append([one(BDD)],BodyList1,BodyList2),
735  list2and(BodyList2,Body1),
736  extract_vars((Head:-Body),[],VC),
737  get_next_rule_number(R),
738  get_probs(HeadList,Probs),
739  (setting(single_var,true)->
740    generate_rules_db(HeadList,Body1,[],R,Probs,DB,BDDAnd,0,Clauses,Module)
741  ;
742    generate_rules_db(HeadList,Body1,VC,R,Probs,DB,BDDAnd,0,Clauses,Module)
743   ).
744
745user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])):-
746  setting(compiling,on),
747% disjunctive clause with more than one head atom senza depth_bound
748  Head = (_;_), !,
749  list2or(HeadListOr, Head),
750  process_head(HeadListOr, HeadList),
751  list2and(BodyList, Body),
752  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,Module),
753  append([one(BDD)],BodyList1,BodyList2),
754  list2and(BodyList2,Body1),
755  extract_vars((Head:-Body),[],VC),
756  get_next_rule_number(R),
757  get_probs(HeadList,Probs),
758  (setting(single_var,true)->
759    generate_rules(HeadList,Body1,[],R,Probs,BDDAnd,0,Clauses,Module)
760  ;
761    generate_rules(HeadList,Body1,VC,R,Probs,BDDAnd,0,Clauses,Module)
762  ).
763
764user:term_expansion((Head :- Body), ([],[])) :-
765% disjunctive clause with a single head atom con prob. 0 senza depth_bound --> la regola non è caricata nella teoria e non è conteggiata in NR
766  setting(compiling,on),
767  ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
768  Head = (_H:P),P=:=0.0, !.
769
770user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :-
771% disjunctive clause with a single head atom e depth_bound
772  setting(compiling,on),
773  setting(depth_bound,true),
774  ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
775  list2or(HeadListOr, Head),
776  process_head(HeadListOr, HeadList),
777  HeadList=[H:_],!,
778  list2and(BodyList, Body),
779  process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
780  append([one(BDD)],BodyList2,BodyList3),
781  list2and(BodyList3,Body1),
782  add_bdd_arg_db(H,BDDAnd,DB,Module,Head1),
783  Clauses=(Head1 :- Body1).
784
785user:term_expansion((Head :- Body), (Clauses,[def_rule(H,BodyList)])) :-
786% disjunctive clause with a single head atom senza depth_bound con prob =1
787  setting(compiling,on),
788   ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
789  list2or(HeadListOr, Head),
790  process_head(HeadListOr, HeadList),
791  HeadList=[H:_],!,
792  list2and(BodyList, Body),
793  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
794  append([one(BDD)],BodyList2,BodyList3),
795  list2and(BodyList3,Body1),
796  add_bdd_arg(H,BDDAnd,Module,Head1),
797  Clauses=(Head1 :- Body1).
798
799user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :-
800% disjunctive clause with a single head atom e DB, con prob. diversa da 1
801  setting(compiling,on),
802  setting(depth_bound,true),
803  ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
804  Head = (H:_), !,
805  list2or(HeadListOr, Head),
806  process_head(HeadListOr, HeadList),
807  list2and(BodyList, Body),
808  process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
809  append([one(BDD)],BodyList2,BodyList3),
810  list2and(BodyList3,Body2),
811  extract_vars((Head:-Body),[],VC),
812  get_next_rule_number(R),
813  get_probs(HeadList,Probs),%***test single_var
814  (setting(single_var,true)->
815    generate_clause_db(H,Body2,[],R,Probs,DB,BDDAnd,0,Clauses,Module)
816  ;
817    generate_clause_db(H,Body2,VC,R,Probs,DB,BDDAnd,0,Clauses,Module)
818  ).
819
820user:term_expansion((Head :- Body), (Clauses,[rule(R,HeadList,BodyList)])) :-
821% disjunctive clause with a single head atom senza DB, con prob. diversa da 1
822  setting(compiling,on),
823  ((Head:-Body) \= ((user:term_expansion(_,_) ):- _ )),
824  Head = (H:_), !,
825  list2or(HeadListOr, Head),
826  process_head(HeadListOr, HeadList),
827  list2and(BodyList, Body),
828  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
829  append([one(BDD)],BodyList2,BodyList3),
830  list2and(BodyList3,Body2),
831  extract_vars((Head:-Body),[],VC),
832  get_next_rule_number(R),
833  get_probs(HeadList,Probs),%***test single_vars
834  (setting(single_var,true)->
835    generate_clause(H,Body2,[],R,Probs,BDDAnd,0,Clauses,Module)
836  ;
837    generate_clause(H,Body2,VC,R,Probs,BDDAnd,0,Clauses,Module)
838  ).
839
840user:term_expansion((Head :- Body),(Clauses,[])) :-
841% definite clause for db facts
842  setting(compiling,on),
843  ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),
844  Head=db(Head1),!,
845  Clauses=(Head1 :- Body).
846
847user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :-
848% definite clause with depth_bound
849  setting(compiling,on),
850  setting(depth_bound,true),
851   ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!,
852  list2and(BodyList, Body),
853  process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,Module),
854  append([one(BDD)],BodyList2,BodyList3),
855  list2and(BodyList3,Body1),
856  add_bdd_arg_db(Head,BDDAnd,DB,Module,Head1),
857  Clauses=(Head1 :- Body1).
858
859user:term_expansion((Head :- Body),(Clauses,[def_rule(Head,BodyList)])) :-
860% definite clause senza DB
861  setting(compiling,on),
862  ((Head:-Body) \= ((user:term_expansion(_,_)) :- _ )),!,
863  list2and(BodyList, Body),
864  process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,Module),
865  append([one(BDD)],BodyList2,BodyList3),
866  list2and(BodyList3,Body2),
867  add_bdd_arg(Head,BDDAnd,Module,Head1),
868  Clauses=(Head1 :- Body2).
869
870user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :-
871  setting(compiling,on),
872  setting(depth_bound,true),
873% disjunctive FACT with more than one head atom e db
874  Head=(_;_), !,
875  list2or(HeadListOr, Head),
876  process_head(HeadListOr, HeadList),
877  extract_vars((Head),[],VC),
878  get_next_rule_number(R),
879  get_probs(HeadList,Probs),
880  (setting(single_var,true)->
881    generate_rules_fact_db(HeadList,[],R,Probs,0,Clauses,_Module)
882  ;
883    generate_rules_fact_db(HeadList,VC,R,Probs,0,Clauses,_Module)
884  ).
885
886user:term_expansion(Head,(Clauses,[rule(R,HeadList,[])])) :-
887  setting(compiling,on),
888% disjunctive fact with more than one head atom senza db
889  Head=(_;_), !,
890  list2or(HeadListOr, Head),
891  process_head(HeadListOr, HeadList),
892  extract_vars((Head),[],VC),
893  get_next_rule_number(R),
894  get_probs(HeadList,Probs), %**** test single_var
895  (setting(single_var,true)->
896    generate_rules_fact(HeadList,[],R,Probs,0,Clauses,_Module)
897  ;
898    generate_rules_fact(HeadList,VC,R,Probs,0,Clauses,_Module)
899  ).
900
901user:term_expansion(Head,([],[])) :-
902  setting(compiling,on),
903% disjunctive fact with a single head atom con prob. 0
904  (Head \= ((user:term_expansion(_,_)) :- _ )),
905  Head = (_H:P),P=:=0.0, !.
906
907user:term_expansion(Head,(Clause,[def_rule(H,[])])) :-
908  setting(compiling,on),
909  setting(depth_bound,true),
910% disjunctive fact with a single head atom con prob.1 e db
911  (Head \= ((user:term_expansion(_,_)) :- _ )),
912  Head = (H:P),P=:=1.0, !,
913  list2and([one(BDD)],Body1),
914  add_bdd_arg_db(H,BDD,_DB,_Module,Head1),
915  Clause=(Head1 :- Body1).
916
917user:term_expansion(Head,(Clause,[def_rule(H,[])])) :-
918  setting(compiling,on),
919% disjunctive fact with a single head atom con prob. 1, senza db
920  (Head \= ((user:term_expansion(_,_)) :- _ )),
921  Head = (H:P),P=:=1.0, !,
922  list2and([one(BDD)],Body1),
923  add_bdd_arg(H,BDD,_Module,Head1),
924  Clause=(Head1 :- Body1).
925
926user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :-
927  setting(compiling,on),
928  setting(depth_bound,true),
929% disjunctive fact with a single head atom e prob. generiche, con db
930  (Head \= ((user:term_expansion(_,_)) :- _ )),
931  Head=(H:_), !,
932  list2or(HeadListOr, Head),
933  process_head(HeadListOr, HeadList),
934  extract_vars((Head),[],VC),
935  get_next_rule_number(R),
936  get_probs(HeadList,Probs),
937  add_bdd_arg_db(H,BDD,_DB,_Module,Head1),
938  (setting(single_var,true)->
939    Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD)))
940  ;
941    Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD)))
942  ).
943
944user:term_expansion(Head,(Clause,[rule(R,HeadList,[])])) :-
945  setting(compiling,on),
946% disjunctive fact with a single head atom e prob. generiche, senza db
947  (Head \= ((user:term_expansion(_,_)) :- _ )),
948  Head=(H:_), !,
949  list2or(HeadListOr, Head),
950  process_head(HeadListOr, HeadList),
951  extract_vars((Head),[],VC),
952  get_next_rule_number(R),
953  get_probs(HeadList,Probs),
954  add_bdd_arg(H,BDD,_Module,Head1),%***test single_var
955  (setting(single_var,true)->
956    Clause=(Head1:-(get_var_n(R,[],Probs,V),equality(V,0,BDD)))
957  ;
958    Clause=(Head1:-(get_var_n(R,VC,Probs,V),equality(V,0,BDD)))
959  ).
960
961user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :-
962  setting(compiling,on),
963  setting(depth_bound,true),
964% definite fact with db
965  (Head \= ((user:term_expansion(_,_) ):- _ )),
966  (Head\= end_of_file),!,
967  add_bdd_arg_db(Head,One,_DB,_Module,Head1).
968
969user:term_expansion(Head, ((Head1:-one(One)),[def_rule(Head,[])])) :-
970  setting(compiling,on),
971% definite fact without db
972  (Head \= ((user:term_expansion(_,_) ):- _ )),
973  (Head\= end_of_file),!,
974  add_bdd_arg(Head,One,_Module,Head1).
975
976
977builtin(_A is _B).
978builtin(_A > _B).
979builtin(_A < _B).
980builtin(_A >= _B).
981builtin(_A =< _B).
982builtin(_A =:= _B).
983builtin(_A =\= _B).
984builtin(true).
985builtin(false).
986builtin(_A = _B).
987builtin(_A==_B).
988builtin(_A\=_B).
989builtin(_A\==_B).
990builtin('!').
991builtin(length(_L,_N)).
992builtin(member(_El,_L)).
993builtin(average(_L,_Av)).
994builtin(max_list(_L,_Max)).
995builtin(min_list(_L,_Max)).
996builtin(nth0(_,_,_)).
997builtin(nth(_,_,_)).
998builtin(name(_,_)).
999builtin(float(_)).
1000builtin(integer(_)).
1001builtin(var(_)).
1002builtin(_ @> _).
1003builtin(memberchk(_,_)).
1004
1005
1006average(L,Av):-
1007        sum_list(L,Sum),
1008        length(L,N),
1009        Av is Sum/N.
1010
1011