3:- module(pitaind,[prob_ind/2, prob_bar/2, prob_ind/3, prob_bar/3,
4 set_pitaind/2,setting_pitaind/2,
5 onec/1,zeroc/1,andc/3,notc/2,andcnf/3,
6 orc_ind/3,orc_exc/3,
7 get_var_n/5,or_list_pitaind/3,
8 or_list_ind/2,or_list_exc/2,
9 equalityc/3,
10 parse_ind/2,
11 op(600,xfy,'::'),
12 op(1150,fx,action)
13 ]).
27:-meta_predicate s(,). 28:-meta_predicate prob_ind(,). 29:-meta_predicate prob_bar(,). 30:-meta_predicate prob_ind(,,). 31:-meta_predicate prob_bar(,,). 32:-meta_predicate get_p(,). 33:-meta_predicate get_cond_p(,,). 34:-meta_predicate get_node(,). 35:-meta_predicate get_cond_node(,,,). 36:-meta_predicate set_pitaind(,). 37:-meta_predicate setting_pitaind(,). 38:-meta_predicate set_sw(,). 39 40:-use_module(library(lists)). 41:-use_module(library(apply)). 42:-use_module(library(assoc)). 43 44:- style_check(-discontiguous). 45 46:- thread_local rule_n/1,goal_n/1,pitaind_input_mod/1,local_pitaind_setting/2. 47 48% remove/3. 49 50 51 52 53 54 55 56 57 58 59 60 61default_setting_pitaind(epsilon_parsing, 1e-5). 62/* on, off */ 63 64default_setting_pitaind(bagof,false). 65/* values: false, intermediate, all, extra */ 66 67default_setting_pitaind(compiling,off). 68 69:-set_prolog_flag(unknown,warning). 70 71default_setting_pitaind(depth_bound,false). %if true, it limits the derivation of the example to the value of 'depth' 72default_setting_pitaind(depth,5). 73default_setting_pitaind(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. 74default_setting_pitaind(or,ind). 75/* values: ind, exc 76how or is computed: by assuming independence or exclusion 77*/
87orc_ind(A,B,C):-
88 C is 1-(1-A)*(1-B).
95orc_exc(A,B,C):-
96 C is A+B.
103onec(1.0).
110zeroc(0.0).
118andc(A,B,C):-
119 ((A=0.0;B=0.0)->
120 %C=and(A,B)
121 fail
122 ;
123 (A=1.0->
124 C=B
125 ;
126 (B=1.0->
127 C=A
128 ;
129 C is A*B
130 )
131 )
132 ).
139andcnf(A,B,C):-
140 (A=1.0->
141 C=B
142 ;
143 (B=1.0->
144 C=A
145 ;
146 C is A*B
147 )
148 ).
156notc(A,B):-
157 (A=0.0->
158 B=1.0
159 ;
160 (A=1.0->
161 B=0.0
162 ;
163 B is 1.0-A
164 )
165 ).
172equalityc(Probs,N,P):-
173 nth0(N,Probs,P).181parse_ind(FileIn,FileOut):- 182 prolog_load_context(module, M), 183 assert(M:pitaind_on), 184 initialize_pitaind, 185 open(FileIn,read,SI), 186 read_clauses(SI,C), 187 close(SI), 188 process_clauses(C,[],C1), 189 findall(LZ,M:zero_clauses(LZ),L0), 190 retractall(M:zero_clauses(_)), 191 retractall(M:tabled(_)), 192 append(C1,L0,Cl0), 193 divide_tab_dyn_dir(Cl0,T,Dyn,Cl), 194 open(FileOut,write,SO), 195 writeln(SO,':- use_module(library(pitaind)).'), 196 writeln(SO,':- style_check(-discontiguous).'), 197 writeln(SO,':- pitaind.'), 198 write_clauses(Dyn,SO), 199 write_tab_dir(T,SO), 200 write_clauses(Cl,SO), 201 close(SO). 202 203divide_tab_dyn_dir([],[],[],[]). 204 205divide_tab_dyn_dir([(:- table A)|T],[(:- table A)|TT],Dyn,Cl):-!, 206 divide_tab_dyn_dir(T,TT,Dyn,Cl). 207 208divide_tab_dyn_dir([(:- dynamic A)|T],Tab,[(:- dynamic A)|Dyn],Cl):-!, 209 divide_tab_dyn_dir(T,Tab,Dyn,Cl). 210 211divide_tab_dyn_dir([H|T],TT,Dyn,[H|Cl]):- 212 divide_tab_dyn_dir(T,TT,Dyn,Cl). 213 214 215/* output predicates */ 216write_tab_dir([],S):- 217 nl(S). 218 219write_tab_dir([H|T],S):- 220 format(S,"~w.",[H]), 221 nl(S), 222 write_tab_dir(T,S). 223 224 225 226write_clauses([],_). 227 228write_clauses([H|T],S):- 229 copy_term(H,H1), 230 numbervars(H1,0,_), 231 format(S,"~q.",[H1]), 232 nl(S), 233 write_clauses(T,S). 234 235read_clauses(S,[Cl|Out]):- 236 read_term(S,Cl,[]), 237 (Cl=end_of_file-> 238 Out=[] 239 ; 240 read_clauses(S,Out) 241 ). 242/* clause processing */ 243process_clauses([end_of_file],C,C):-!. 244 245process_clauses([:- set_pitaind(S,V) |T],C0,[:- set_pitaind(S,V)|C1]):-!, 246 prolog_load_context(module, M), 247 set_pitaind(M:S,V), 248 process_clauses(T,C0,C1). 249 250process_clauses([:- _ |T],C0,C1):-!, 251 process_clauses(T,C0,C1). 252 253process_clauses([H|T],C0,C1):- 254 (pitaind_expansion(H,H1)-> 255 true 256 ; 257 H1=H 258 ), 259 (is_list(H1)-> 260 append(C0,H1,C2) 261 ; 262 append(C0,[H1],C2) 263 ), 264 process_clauses(T,C2,C1). 265initialize_pitaind:- 266 prolog_load_context(module, M), 267 retractall(M:local_pitaind_setting(_,_)), 268 findall(local_pitaind_setting(P,V),default_setting_pitaind(P,V),L), 269 assert_all(L,M,_), 270 assert(pitaind_input_mod(M)), 271 retractall(M:rule_n(_)), 272 retractall(M:goal_n(_)), 273 assert(M:rule_n(0)), 274 assert(M:goal_n(0)), 275 M:(dynamic v/3, av/3, query_rule/4, rule_by_num/4, dec/3, 276 zero_clauses/1, pita_on/0, tabled/1, '$cons'/2), 277 style_check(-discontiguous).
286s(M:Goal,P):- 287 M:local_pitaind_setting(depth_bound,true),!, 288 term_variables(Goal,VG), 289 get_next_goal_number(M,GN), 290 atomic_concat('$goal',GN,NewGoal), 291 Goal1=..[NewGoal|VG], 292 list2and(GoalL,Goal), 293 process_body_db(GoalL,BDD,BDDAnd,DB,[],_Vars,BodyList2,M), 294 append([onec(BDD)],BodyList2,BodyList3), 295 list2and(BodyList3,Body2), 296 add_bdd_arg_db(Goal1,BDDAnd,DB,M,Head1), 297 M:(asserta((Head1 :- Body2),Ref)), 298 findall((Goal,P),get_p(M:Goal1,P),L), 299 erase(Ref), 300 member((Goal,P),L). 301 302s(M:Goal,P):- 303 term_variables(Goal,VG), 304 get_next_goal_number(M,GN), 305 atomic_concat('$goal',GN,NewGoal), 306 Goal1=..[NewGoal|VG], 307 list2and(GoalL,Goal), 308 process_body(GoalL,BDD,BDDAnd,[],_Vars,BodyList2,M), 309 append([onec(BDD)],BodyList2,BodyList3), 310 list2and(BodyList3,Body2), 311 add_bdd_arg(Goal1,BDDAnd,M,Head1), 312 M:(asserta((Head1 :- Body2),Ref)), 313 findall((Goal,P),get_p(M:Goal1,P),L), 314 erase(Ref), 315 member((Goal,P),L).
329prob_ind(M:Goal,P):-
330 must_be(nonvar,Goal),
331 must_be(var,P),
332 s(M:Goal,P).
345prob_bar(M:Goal,Chart):-
346 must_be(nonvar,Goal),
347 must_be(var,Chart),
348 s(M:Goal,P),
349 PF is 1.0-P,
350 Chart = c3{data:_{x:elem, rows:[elem-prob,'T'-P,'F' -PF], type:bar},
351 axis:_{x:_{type:category}, rotated: true,
352 y:_{min:0.0,max:1.0,padding:_{bottom:0.0,top:0.0},
353 tick:_{values:[0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0]}}},
354 size:_{height: 100},
355 legend:_{show: false}}.366prob_ind(M:Goal,M:Evidence,P):- 367 must_be(nonvar,Goal), 368 must_be(nonvar,Evidence), 369 must_be(var,P), 370 get_next_goal_number(M,GN), 371 atomic_concat('$ev',GN,NewEv), 372 deal_with_ev(Evidence,M,NewEv,EvNoAct,UpdatedClausesRefs,ClausesToReAdd), 373 term_variables(Goal,VG), 374 atomic_concat('$goal',GN,NewGoal), 375 Goal1=..[NewGoal|VG], 376 list2and(GoalL,Goal), 377 process_body(GoalL,BDD,BDDAnd,[],_Vars,BodyList2,M), 378 append([onec(BDD)],BodyList2,BodyList3), 379 list2and(BodyList3,Body2), 380 add_bdd_arg(Goal1,BDDAnd,M,Head1), 381 M:(asserta((Head1 :- Body2),Ref)), 382 (EvNoAct=true-> 383 findall((Goal,P),get_p(M:Goal1,P),L) 384 ; 385 findall((Goal,P),get_cond_p(M:Goal1,M:EvNoAct,P),L) 386 ), 387 retractall(M:), 388 maplist(erase,UpdatedClausesRefs), 389 erase(Ref), 390 maplist(M:assertz,ClausesToReAdd), 391 member((Goal,P),L). 392 393deal_with_ev(Ev,M,NewEv,EvGoal,UC,CA):- 394 list2and(EvL,Ev), 395 partition(ac,EvL,ActL,EvNoActL), 396 deal_with_actions(ActL,M,UC0,CA), 397 (EvNoActL=[]-> 398 EvGoal=true, 399 UC=UC0 400 ; 401 process_body(EvNoActL,BDD,BDDAnd,[],_Vars,BodyList2,M), 402 append([onec(BDD)],BodyList2,BodyList3), 403 list2and(BodyList3,Body2), 404 add_bdd_arg(NewEv,BDDAnd,M,Head1), 405 M:(asserta((Head1 :- Body2),Ref)), 406 UC=[Ref|UC0], 407 EvGoal=NewEv 408 ). 409 410deal_with_actions(ActL,M,UC,CA):- 411 empty_assoc(AP0), 412 foldl(get_pred_const,ActL,AP0,AP), 413 assoc_to_list(AP,LP), 414 maplist(update_clauses(M),LP,UCL,CAL), 415 partition(nac,ActL,_NActL,PActL), 416 maplist(assert_actions(M),PActL,ActRefs), 417 append([ActRefs|UCL],UC), 418 append(CAL,CA). 419 420zero_clauses_actions(M,do(\+ A),Ref):- 421 A=..[P|Args], 422 append(Args,[BDD],Args1), 423 A1=..[P|Args1], 424 M:assertz((A1:-zeroc(BDD)),Ref). 425 426assert_actions(M,do(A),Ref):- 427 A=..[P|Args], 428 append(Args,[BDD],Args1), 429 A1=..[P|Args1], 430 M:assertz((A1:-onec(BDD)),Ref). 431 432update_clauses(M,P/0- _,[RefZ],[(H:-zeroc(BDD))|LCA]):-!, 433 functor(G1,P,2), 434 findall(Ref,M:clause(G1,_B,Ref),UC), 435 findall((G1:-B),M:clause(G1,B),LCA), 436 H=..[P,BDD], 437 maplist(erase,UC), 438 M:assertz((H:-zeroc(BDD)),RefZ). 439 440update_clauses(M,P/A-Constants,UC,CA):- 441 functor(G,P,A), 442 A1 is A+2, 443 functor(G1,P,A1), 444 G=..[_|Args], 445 findall((G1,B,Ref),M:clause(G1,B,Ref),LC), 446 maplist(get_const(Args),Constants,ConstraintsL), 447 list2and(ConstraintsL,Constraints), 448 maplist(add_cons(G1,Constraints,M),LC,UC,CA). 449 450add_cons(_G,_C,M,(H,zeroc(Zero),Ref),Ref1,(H:-zeroc(Zero))):-!, 451 erase(Ref), 452 M:assertz((H:-zeroc(Zero)),Ref1). 453 454add_cons(G,C,M,(H,B,Ref),Ref1,(H:-B)):- 455 copy_term((G,C),(G1,C1)), 456 G1=H, 457 erase(Ref), 458 M:assertz((H:-(C1,B)),Ref1). 459 460 461get_const(Args,Constants,Constraint):- 462 maplist(constr,Args,Constants,ConstraintL), 463 list2and(ConstraintL,Constraint). 464 465constr(V,C,dif(V,C)). 466 467get_pred_const(do(Do0),AP0,AP):- 468 (Do0= (\+ Do)-> 469 true 470 ; 471 Do=Do0 472 ), 473 functor(Do,F,A), 474 Do=..[_|Args], 475 (get_assoc(F/A,AP0,V)-> 476 put_assoc(F/A,AP0,[Args|V],AP) 477 ; 478 put_assoc(F/A,AP0,[Args],AP) 479 ). 480 481 482ac(do(_)). 483nac(do(\+ _)).
496prob_bar(M:Goal,M:Evidence,Chart):- 497 must_be(nonvar,Goal), 498 must_be(nonvar,Evidence), 499 must_be(var,Chart), 500 prob_ind(M:Goal,M:Evidence,P), 501 PF is 1.0-P, 502 Chart = c3{data:_{x:elem, rows:[elem-prob,'T'-P,'F' -PF], type:bar}, 503 axis:_{x:_{type:category}, rotated: true, 504 y:_{min:0.0,max:1.0,padding:_{bottom:0.0,top:0.0}, 505 tick:_{values:[0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0]}}}, 506 size:_{height: 100}, 507 legend:_{show: false}}. 508 509 510get_p(M:Goal,P):- 511 get_node(M:Goal,P). 512 513get_cond_p(M:Goal,M:Evidence,P):- 514 get_cond_node(M:Goal,M:Evidence,PGE,PE), 515 P is PGE/PE. 516 517 518get_node(M:Goal,B):- 519 M:local_pitaind_setting(depth_bound,true),!, 520 M:local_pitaind_setting(depth,DB), 521 retractall(M:v(_,_,_)), 522 abolish_all_tables, 523 add_bdd_arg_db(Goal,BDD,DB,M,Goal1),%DB=depth bound 524 (bagof(BDD,M:Goal1,L)*-> 525 or_list_pitaind(L,M,B) 526 ; 527 zeroc(B) 528 ). 529 530get_node(M:Goal,B):- %with DB=false 531 retractall(M:v(_,_,_)), 532 abolish_all_tables, 533 add_bdd_arg(Goal,BDD,M,Goal1), 534 (bagof(BDD,M:Goal1,L)*-> 535 or_list_pitaind(L,M,B) 536 ; 537 zeroc(B) 538 ). 539 540get_cond_node(M:Goal,M:Ev,BGE,BE):- 541 M:local_pitaind_setting(depth_bound,true),!, 542 M:local_pitaind_setting(depth,DB), 543 retractall(M:v(_,_,_)), 544 abolish_all_tables, 545 add_bdd_arg_db(Goal,BDD,DB,M,Goal1),%DB=depth bound 546 (bagof(BDD,M:Goal1,L)*-> 547 or_list_pitaind(L,M,BG) 548 ; 549 zeroc(BG) 550 ), 551 add_bdd_arg_db(Ev,BDDE,DB,M,Ev1),%DB=depth bound 552 (bagof(BDDE,M:Ev1,LE)*-> 553 or_list_pitaind(LE,M,BE) 554 ; 555 zeroc(BE) 556 ), 557 andcnf(BG,BE,BGE). 558 559 560 561get_cond_node(M:Goal,M:Ev,BGE,BE):- %with DB=false 562 retractall(M:v(_,_,_)), 563 abolish_all_tables, 564 add_bdd_arg(Goal,BDD,M,Goal1), 565 (bagof(BDD,M:Goal1,L)*-> 566 or_list_pitaind(L,M,BG) 567 ; 568 zeroc(BG) 569 ), 570 add_bdd_arg(Ev,BDDE,M,Ev1), 571 (bagof(BDDE,M:Ev1,LE)*-> 572 or_list_pitaind(LE,M,BE) 573 ; 574 zeroc(BE) 575 ), 576 andcnf(BG,BE,BGE). 577 578 579get_next_goal_number(PName,R):- 580 retract(PName:goal_n(R)), 581 R1 is R+1, 582 assert(PName:goal_n(R1)). 583 584 585get_next_rule_number(PName,R):- 586 retract(PName:rule_n(R)), 587 R1 is R+1, 588 assert(PName:rule_n(R1)). 589 590 591assert_all([],_M,[]). 592 593assert_all([H|T],M,[HRef|TRef]):- 594 assertz(M:,HRef), 595 assert_all(T,M,TRef). 596 597 598retract_all([]):-!. 599 600retract_all([H|T]):- 601 erase(H), 602 retract_all(T).
611get_var_n(_M,_R,_S,Probs0,Probs):- 612 (ground(Probs0)-> 613 maplist(is,Probs,Probs0) 614 ; 615 throw(error('Non ground probailities not instantiated by the body')) 616 ). 617 618 619 620combine(V,P,V:P). 621 622add_bdd_arg(M:A,BDD,M:A1):- 623 A=..[P|Args], 624 append(Args,[BDD],Args1), 625 A1=..[P|Args1]. 626 627 628add_bdd_arg_db(M:A,BDD,DB,M:A1):- 629 A=..[P|Args], 630 append(Args,[DB,BDD],Args1), 631 A1=..[P|Args1]. 632 633 634add_bdd_arg(A,BDD,_Module,A1):- 635 A=..[P|Args], 636 append(Args,[BDD],Args1), 637 A1=..[P|Args1]. 638 639 640add_bdd_arg_db(A,BDD,DB,_Module,A1):- 641 A=..[P|Args], 642 append(Args,[DB,BDD],Args1), 643 A1=..[P|Args1]. 644 645add_mod_arg(A,_Module,A1):- 646 A=..[P|Args], 647 A1=..[P|Args]. 648 649 650generate_rules_fact([],_VC,_R,_Probs,_N,[],_Module). 651 652generate_rules_fact([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!, 653 add_bdd_arg(Head,BDD,Module,Head1), 654 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))). 655 656generate_rules_fact([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):- 657 add_bdd_arg(Head,BDD,Module,Head1), 658 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))), 659 N1 is N+1, 660 generate_rules_fact(T,VC,R,Probs,N1,Clauses,Module). 661 662 663generate_rules_fact_vars([],__R,_Probs,_N,[],_Module). 664 665generate_rules_fact_vars([Head:_P1,'':_P2],R,Probs,N,[Clause],Module):-!, 666 term_variables([Head],VC), 667 add_bdd_arg(Head,BDD,Module,Head1), 668 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))). 669 670generate_rules_fact_vars([Head:_P|T],R,Probs,N,[Clause|Clauses],Module):- 671 term_variables([Head],VC), 672 add_bdd_arg(Head,BDD,Module,Head1), 673 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))), 674 N1 is N+1, 675 generate_rules_fact_vars(T,R,Probs,N1,Clauses,Module). 676 677 678generate_rules_fact_db([],__VC,_R,_Probs,_N,[],_Module). 679 680generate_rules_fact_db([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module):-!, 681 add_bdd_arg_db(Head,BDD,_DB,Module,Head1), 682 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))). 683 684generate_rules_fact_db([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module):- 685 add_bdd_arg_db(Head,BDD,_DB,Module,Head1), 686 Clause=(Head1:-(get_var_n(Module,R,VC,Probs,V),equalityc(V,N,BDD))), 687 N1 is N+1, 688 generate_rules_fact_db(T,VC,R,Probs,N1,Clauses,Module). 689 690 691generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module):- 692 add_bdd_arg(Head,BDD,Module,Head1), 693 Clause=(Head1:-(Body,get_var_n(Module,R,VC,Probs,V),equalityc(V,N,B),andc(BDDAnd,B,BDD))). 694 695 696generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module):- 697 add_bdd_arg_db(Head,BDD,DBH,Module,Head1), 698 Clause=(Head1:-(DBH>=1,DB is DBH-1,Body,get_var_n(Module,R,VC,Probs,V),equalityc(V,N,B),andc(BDDAnd,B,BDD))). 699 700 701generate_rules([],__Body,_VC,_R,_Probs,_BDDAnd,_N,[],_Module). 702 703generate_rules([Head:_P1,'':_P2],Body,VC,R,Probs,BDDAnd,N,[Clause],Module):-!, 704 generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module). 705 706generate_rules([Head:_P|T],Body,VC,R,Probs,BDDAnd,N,[Clause|Clauses],Module):- 707 generate_clause(Head,Body,VC,R,Probs,BDDAnd,N,Clause,Module), 708 N1 is N+1, 709 generate_rules(T,Body,VC,R,Probs,BDDAnd,N1,Clauses,Module). 710 711 712generate_rules_db([],__Body,_VC,_R,_Probs,_DB,_BDDAnd,_N,[],_Module):-!. 713 714generate_rules_db([Head:_P1,'':_P2],Body,VC,R,Probs,DB,BDDAnd,N,[Clause],Module):-!, 715 generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module). 716 717generate_rules_db([Head:_P|T],Body,VC,R,Probs,DB,BDDAnd,N,[Clause|Clauses],Module):- 718 generate_clause_db(Head,Body,VC,R,Probs,DB,BDDAnd,N,Clause,Module),!,%agg.cut 719 N1 is N+1, 720 generate_rules_db(T,Body,VC,R,Probs,DB,BDDAnd,N1,Clauses,Module). 721 722 723 724process_body([],BDD,BDD,Vars,Vars,[],_Module). 725 726process_body([\+ H|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 727 builtin(H),!, 728 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 729 730process_body([\+ db(H)|T],BDD,BDD1,Vars,Vars1,[\+ H|Rest],Module):- 731 !, 732 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 733 734process_body([\+ H|T],BDD,BDD1,Vars,[BDDH,BDDN,BDD2|Vars1], 735[H1,notc(BDDH,BDDN), 736 andc(BDD,BDDN,BDD2)|Rest],Module):-!, 737 add_bdd_arg(H,BDDH,Module,H1), 738 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 739 740process_body([H|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 741 builtin(H),!, 742 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 743 744process_body([db(H)|T],BDD,BDD1,Vars,Vars1,[H|Rest],Module):- 745 !, 746 process_body(T,BDD,BDD1,Vars,Vars1,Rest,Module). 747 748process_body([H|T],BDD,BDD1,Vars,[BDDH,BDD2|Vars1], 749[H1,andc(BDD,BDDH,BDD2)|Rest],Module):- 750 add_bdd_arg(H,BDDH,Module,H1), 751 process_body(T,BDD2,BDD1,Vars,Vars1,Rest,Module). 752 753 754 755process_body_db([],BDD,BDD,_DB,Vars,Vars,[],_Module):-!. 756 757process_body_db([\+ H|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 758 builtin(H),!, 759 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 760 761process_body_db([\+ db(H)|T],BDD,BDD1,DB,Vars,Vars1,[\+ H|Rest],Module):- 762 !, 763 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 764 765process_body_db([\+ H|T],BDD,BDD1,DB,Vars,[BDDH,BDDN,BDD2|Vars1], 766[H1,notc(BDDH,BDDN), 767 andc(BDD,BDDN,BDD2)|Rest],Module):-!, 768 add_bdd_arg_db(H,BDDH,DB,Module,H1), 769 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 770 771process_body_db([H|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 772 builtin(H),!, 773 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 774 775process_body_db([db(H)|T],BDD,BDD1,DB,Vars,Vars1,[H|Rest],Module):- 776 !, 777 process_body_db(T,BDD,BDD1,DB,Vars,Vars1,Rest,Module). 778 779process_body_db([H|T],BDD,BDD1,DB,Vars,[BDDH,BDD2|Vars1], 780[H1,andc(BDD,BDDH,BDD2)|Rest],Module):-!, %agg. cut 781 add_bdd_arg_db(H,BDDH,DB,Module,H1), 782 process_body_db(T,BDD2,BDD1,DB,Vars,Vars1,Rest,Module). 783 784 785process_head(HeadList, GroundHeadList) :- 786 ground_prob(HeadList), !, 787 process_head_ground(HeadList, 0, GroundHeadList). 788 789process_head(HeadList0, HeadList):- 790 get_probs(HeadList0,PL), 791 foldl(minus,PL,1,PNull), 792 append(HeadList0,['':PNull],HeadList). 793 794minus(A,B,B-A). 795 796prob_ann(_:P,P):-!. 797prob_ann(P::_,P). 798 799 800gen_head(H,P,V,V1,H1:P):-copy_term((H,V),(H1,V1)). 801gen_head_disc(H,V,V1:P,H1:P):-copy_term((H,V),(H1,V1)). 802 803 804/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null]) 805 * ---------------------------------------------------------------- 806 */ 807process_head_ground([H], Prob, [Head:ProbHead1|Null]) :- 808 (H=Head:ProbHead;H=ProbHead::Head),!, 809 ProbHead1 is ProbHead, 810 ProbLast is 1 - Prob - ProbHead1, 811 prolog_load_context(module, M),pitaind_input_mod(M), 812 M:local_pitaind_setting(epsilon_parsing, Eps), 813 EpsNeg is - Eps, 814 ProbLast > EpsNeg, 815 (ProbLast > Eps -> 816 Null = ['':ProbLast] 817 ; 818 Null = [] 819 ). 820 821process_head_ground([H|Tail], Prob, [Head:ProbHead1|Next]) :- 822 (H=Head:ProbHead;H=ProbHead::Head), 823 ProbHead1 is ProbHead, 824 ProbNext is Prob + ProbHead1, 825 process_head_ground(Tail, ProbNext, Next). 826 827 828ground_prob([]). 829 830ground_prob([_Head:ProbHead|Tail]) :-!, 831 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 832 ground_prob(Tail). 833 834ground_prob([ProbHead::_Head|Tail]) :- 835 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 836 ground_prob(Tail). 837 838 839get_probs(Head, PL):- 840 maplist(prob_ann,Head,PL). 841 842/*get_probs([], []). 843 844get_probs([_H:P|T], [P1|T1]) :- 845 P1 is P, 846 get_probs(T, T1). 847*/
856or_list_pitaind(L,M,O):- 857 M:local_pitaind_setting(or,ind),!, 858 or_list_ind(L,O). 859 860or_list_pitaind(L,_M,O):- 861 or_list_exc(L,O).
869or_list_ind([H],H):-!. 870 871or_list_ind([H|T],B):- 872 or_list1_ind(T,H,B). 873 874 875or_list1_ind([],B,B). 876 877or_list1_ind([H|T],B0,B1):- 878 orc_ind(B0,H,B2), 879 or_list1_ind(T,B2,B1).
887or_list_exc([H],H):-!. 888 889or_list_exc([H|T],B):- 890 or_list1_exc(T,H,B). 891 892 893or_list1_exc([],B,B). 894 895or_list1_exc([H|T],B0,B1):- 896 orc_exc(B0,H,B2), 897 or_list1_exc(T,B2,B1).
/
907set_pitaind(M:Parameter,Value):-
908 must_be(atom,Parameter),
909 must_be(nonvar,Value),
910 retract(M:local_pitaind_setting(Parameter,_)),
911 assert(M:local_pitaind_setting(Parameter,Value)).920setting_pitaind(M:P,V):- 921 must_be(atom,P), 922 M:local_pitaind_setting(P,V). 923 924 925 926delete_equal([],_,[]). 927 928delete_equal([H|T],E,T):- 929 H == E,!. 930 931delete_equal([H|T],E,[H|T1]):- 932 delete_equal(T,E,T1). 933 934set_sw(M:A,B):- 935 get_next_rule_number(M,R), 936 assert(M:sw(R,A,B)). 937 938act(M,A/B):- 939 B1 is B + 2, 940 M:(dynamic A/B1). 941 942 943zero_clause(M,A/B,(H:-maplist(nonvar,Args0),zeroc(BDD))):- 944 length(Args0,B), 945 (M:local_pitaind_setting(depth_bound,true)-> 946 ExtraArgs=[_,BDD] 947 ; 948 ExtraArgs=[BDD] 949 ), 950 append(Args0,ExtraArgs,Args), 951 H=..[A|Args]. 952 953 954to_table(M,Heads,ProcTabDir,Heads1):- 955 maplist(tab_dir(M),Heads,TabDirList,Heads1L), 956 append(TabDirList,TabDir), 957 %maplist(system:term_expansion,TabDir,ProcTabDirL), 958 %append(ProcTabDirL,ProcTabDir), 959 ProcTabDir=TabDir, 960 append(Heads1L,Heads1). 961 962tab_dir(_M,'':_,[],[]):-!. 963 964tab_dir(M,H:P,[],[H:P]):- 965 M:tabled(H),!. 966 967 968tab_dir(M,Head,[(:- table HT)],[H1:P]):- 969 (Head=H:P;Head=P::H),!, 970 functor(H,F,A0), 971 functor(PT,F,A0), 972 PT=..[F|Args0], 973 (M:local_pitaind_setting(or,ind)-> 974 (M:local_pitaind_setting(depth_bound,true)-> 975 ExtraArgs=[_,lattice(orc_ind/3)] 976 ; 977 ExtraArgs=[lattice(orc_ind/3)] 978 ) 979 ; 980 (M:local_pitaind_setting(depth_bound,true)-> 981 ExtraArgs=[_,lattice(orc_exc/3)] 982 ; 983 ExtraArgs=[lattice(orc_exc/3)] 984 ) 985 ), 986 append(Args0,ExtraArgs,Args), 987 HT=..[F|Args], 988 H=..[_|ArgsH], 989 H1=..[F|ArgsH], 990 assert(M:tabled(PT)), 991 zero_clause(M,F/A0,LZ), 992 assert(M:zero_clauses(LZ)). 993 994 995 996 997 998pitaind_expansion((:- action Conj), []) :-!, 999 prolog_load_context(module, M), 1000 list2and(L,Conj), 1001 maplist(act(M),L). 1002 1003pitaind_expansion((:- table(Conj)), [:- table(Conj1)]) :-!, 1004 prolog_load_context(module, M), 1005 pitaind_input_mod(M),!, 1006 list2and(L,Conj), 1007 maplist(tab,L,L1), 1008 list2and(L1,Conj1). 1009 1010pitaind_expansion((:- begin_plp), []) :- 1011 prolog_load_context(module, M), 1012 pitaind_input_mod(M),!, 1013 assert(M:pitaind_on). 1014 1015pitaind_expansion((:- end_plp), []) :- 1016 prolog_load_context(module, M), 1017 pitaind_input_mod(M),!, 1018 retractall(M:pitaind_on). 1019 1020pitaind_expansion((:- begin_lpad), []) :- 1021 prolog_load_context(module, M), 1022 pitaind_input_mod(M),!, 1023 assert(M:pitaind_on). 1024 1025pitaind_expansion((:- end_lpad), []) :- 1026 prolog_load_context(module, M), 1027 pitaind_input_mod(M),!, 1028 retractall(M:pitaind_on). 1029 1030pitaind_expansion(values(A,B), values(A,B)) :- 1031 prolog_load_context(module, M), 1032 pitaind_input_mod(M),M:pitaind_on,!. 1033 1034pitaind_expansion((Head :- Body), Clauses):- 1035 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1036 M:local_pitaind_setting(depth_bound,true), 1037% disjunctive clause with more than one head atom e depth_bound 1038 Head = (_;_), !, 1039 list2or(HeadListOr, Head), 1040 process_head(HeadListOr, HeadList), 1041 list2and(BodyList, Body), 1042 process_body_db(BodyList,BDD,BDDAnd, DB,[],_Vars,BodyList1,M), 1043 append([onec(BDD)],BodyList1,BodyList2), 1044 list2and(BodyList2,Body1), 1045 append(HeadList,BodyList,List), 1046 term_variables(List,VC), 1047 get_next_rule_number(M,R), 1048 get_probs(HeadList,Probs), 1049 to_table(M,HeadList,TabDir,HeadList1), 1050 (M:local_pitaind_setting(single_var,true)-> 1051 generate_rules_db(HeadList1,Body1,[],R,Probs,DB,BDDAnd,0,Clauses0,M) 1052 ; 1053 generate_rules_db(HeadList1,Body1,VC,R,Probs,DB,BDDAnd,0,Clauses0,M) 1054 ), 1055 append(TabDir,Clauses0,Clauses). 1056 1057pitaind_expansion((Head :- Body), Clauses):- 1058 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1059% disjunctive clause with more than one head atom senza depth_bound 1060 Head = (_;_), !, 1061 list2or(HeadListOr, Head), 1062 process_head(HeadListOr, HeadList), 1063 list2and(BodyList, Body), 1064 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList1,M), 1065 append([onec(BDD)],BodyList1,BodyList2), 1066 list2and(BodyList2,Body1), 1067 append(HeadList,BodyList,List), 1068 term_variables(List,VC), 1069 get_next_rule_number(M,R), 1070 get_probs(HeadList,Probs), 1071 to_table(M,HeadList,TabDir,_), 1072 (M:local_pitaind_setting(single_var,true)-> 1073 generate_rules(HeadList,Body1,[],R,Probs,BDDAnd,0,Clauses0,M) 1074 ; 1075 generate_rules(HeadList,Body1,VC,R,Probs,BDDAnd,0,Clauses0,M) 1076 ), 1077 append(TabDir,Clauses0,Clauses). 1078 1079pitaind_expansion((Head :- Body), []) :- 1080% disjunctive clause with a single head atom con prob. 0 senza depth_bound --> la regola non e' caricata nella teoria e non e' conteggiata in NR 1081 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1082 ((Head:-Body) \= ((pitaind_expansion(_,_) ):- _ )), 1083 (Head = (_:P);Head=(P::_)), 1084 ground(P), 1085 P=:=0.0, !. 1086 1087pitaind_expansion((Head :- Body), Clauses) :- 1088% disjunctive clause with a single head atom e depth_bound 1089 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1090 M:local_pitaind_setting(depth_bound,true), 1091 ((Head:-Body) \= ((pitaind_expansion(_,_) ):- _ )), 1092 list2or(HeadListOr, Head), 1093 process_head(HeadListOr, HeadList), 1094 HeadList=[H:_],!, 1095 list2and(BodyList, Body), 1096 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,M), 1097 append([onec(BDD)],BodyList2,BodyList3), 1098 list2and([DBH>=1,DB is DBH -1|BodyList3],Body1), 1099 to_table(M,HeadList,TabDir,_), 1100 add_bdd_arg_db(H,BDDAnd,DBH,M,Head1), 1101 append(TabDir,[(Head1 :- Body1)],Clauses). 1102 1103pitaind_expansion((Head :- Body), Clauses) :- 1104% disjunctive clause with a single head atom senza depth_bound con prob =1 1105 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1106 ((Head:-Body) \= ((pitaind_expansion(_,_) ):- _ )), 1107 list2or(HeadListOr, Head), 1108 process_head(HeadListOr, HeadList), 1109 HeadList=[H:_],!, 1110 list2and(BodyList, Body), 1111 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,M), 1112 append([onec(BDD)],BodyList2,BodyList3), 1113 list2and(BodyList3,Body1), 1114 to_table(M,HeadList,TabDir,_), 1115 add_bdd_arg(H,BDDAnd,M,Head1), 1116 append(TabDir,[(Head1 :- Body1)],Clauses). 1117 1118pitaind_expansion((Head :- Body), Clauses) :- 1119% disjunctive clause with a single head atom e DB, con prob. diversa da 1 1120 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1121 M:local_pitaind_setting(depth_bound,true), 1122 ((Head:-Body) \= ((pitaind_expansion(_,_) ):- _ )), 1123 (Head = (H:_);Head=(_::H)), !, 1124 list2or(HeadListOr, Head), 1125 process_head(HeadListOr, HeadList), 1126 list2and(BodyList, Body), 1127 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,M), 1128 append([onec(BDD)],BodyList2,BodyList3), 1129 list2and(BodyList3,Body2), 1130 append(HeadList,BodyList,List), 1131 term_variables(List,VC), 1132 get_next_rule_number(M,R), 1133 get_probs(HeadList,Probs),%***test single_var 1134 (M:local_pitaind_setting(single_var,true)-> 1135 generate_clause_db(H,Body2,[],R,Probs,DB,BDDAnd,0,Clauses0,M) 1136 ; 1137 generate_clause_db(H,Body2,VC,R,Probs,DB,BDDAnd,0,Clauses0,M) 1138 ), 1139 to_table(M,HeadList,TabDir,_), 1140 append(TabDir,[Clauses0],Clauses). 1141 1142 1143pitaind_expansion((Head :- Body), Clauses) :- 1144% disjunctive clause with a single head atom senza DB, con prob. diversa da 1 1145 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1146 ((Head:-Body) \= ((pitaind_expansion(_,_) ):- _ )), 1147 (Head = (H:_);Head = (_::H)), !, 1148 list2or(HeadListOr, Head), 1149 process_head(HeadListOr, HeadList), 1150 list2and(BodyList, Body), 1151 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,M), 1152 append([onec(BDD)],BodyList2,BodyList3), 1153 list2and(BodyList3,Body2), 1154 append(HeadList,BodyList,List), 1155 term_variables(List,VC), 1156 get_next_rule_number(M,R), 1157 get_probs(HeadList,Probs),%***test single_vars 1158 (M:local_pitaind_setting(single_var,true)-> 1159 generate_clause(H,Body2,[],R,Probs,BDDAnd,0,Clauses0,M) 1160 ; 1161 generate_clause(H,Body2,VC,R,Probs,BDDAnd,0,Clauses0,M) 1162 ), 1163 to_table(M,HeadList,TabDir,_), 1164 append(TabDir,[Clauses0],Clauses). 1165 1166/*pitaind_expansion((Head :- Body),Clauses) :- 1167% definite clause for db facts 1168 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1169 ((Head:-Body) \= ((pitaind_expansion(_,_)) :- _ )), 1170 Head=db(Head1),!, 1171 Clauses=(Head1 :- Body). 1172*/ 1173pitaind_expansion((Head :- Body),Clauses) :- 1174% definite clause with depth_bound 1175 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1176 M:local_pitaind_setting(depth_bound,true), 1177 ((Head:-Body) \= ((pitaind_expansion(_,_)) :- _ )),!, 1178 list2and(BodyList, Body), 1179 process_body_db(BodyList,BDD,BDDAnd,DB,[],_Vars,BodyList2,M), 1180 append([onec(BDD)],BodyList2,BodyList3), 1181 list2and([DBH>=1,DB is DBH-1|BodyList3],Body1), 1182 add_bdd_arg_db(Head,BDDAnd,DBH,M,Head1), 1183 to_table(M,[Head:_],TabDir,_), 1184 append(TabDir,[(Head1 :- Body1)],Clauses). 1185 1186pitaind_expansion((Head :- Body),Clauses) :- 1187% definite clause senza DB 1188 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1189 ((Head:-Body) \= ((pitaind_expansion(_,_)) :- _ )),!, 1190 list2and(BodyList, Body), 1191 process_body(BodyList,BDD,BDDAnd,[],_Vars,BodyList2,M), 1192 append([onec(BDD)],BodyList2,BodyList3), 1193 list2and(BodyList3,Body2), 1194 add_bdd_arg(Head,BDDAnd,M,Head1), 1195 to_table(M,[Head:_],TabDir,_), 1196 append(TabDir,[(Head1 :- Body2)],Clauses). 1197 1198pitaind_expansion(Head,Clauses) :- 1199 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1200 M:local_pitaind_setting(depth_bound,true), 1201% disjunctive FACT with more than one head atom e db 1202 Head=(_;_), !, 1203 list2or(HeadListOr, Head), 1204 process_head(HeadListOr, HeadList), 1205 term_variables(HeadList,VC), 1206 get_next_rule_number(M,R), 1207 get_probs(HeadList,Probs), 1208 (M:local_pitaind_setting(single_var,true)-> 1209 generate_rules_fact_db(HeadList,[],R,Probs,0,Clauses0,M) 1210 ; 1211 generate_rules_fact_db(HeadList,VC,R,Probs,0,Clauses0,M) 1212 ), 1213 to_table(M,HeadList,TabDir,_), 1214 append(TabDir,Clauses0,Clauses). 1215 1216 1217pitaind_expansion(Head,Clauses) :- 1218 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1219% disjunctive fact with more than one head atom senza db 1220 Head=(_;_), !, 1221 list2or(HeadListOr, Head), 1222 process_head(HeadListOr, HeadList), 1223 term_variables(HeadList,VC), 1224 get_next_rule_number(M,R), 1225 get_probs(HeadList,Probs), %**** test single_var 1226 (M:local_pitaind_setting(single_var,true)-> 1227 generate_rules_fact(HeadList,[],R,Probs,0,Clauses0,M) 1228 ; 1229 generate_rules_fact(HeadList,VC,R,Probs,0,Clauses0,M) 1230 ), 1231 to_table(M,HeadList,TabDir,_), 1232 append(TabDir,Clauses0,Clauses). 1233 1234pitaind_expansion(Head,Clauses) :- 1235 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1236% disjunctive fact with uniform distr 1237 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1238 Head = (_:P), 1239 nonvar(P), 1240 Head=(H:uniform(Var,D0)),!, 1241 length(D0,Len), 1242 Prob is 1.0/Len, 1243 maplist(gen_head(H,Prob,Var),D0,HeadList), 1244 get_next_rule_number(M,R), 1245 get_probs(HeadList,Probs), %**** test single_var 1246 (M:local_pitaind_setting(single_var,true)-> 1247 generate_rules_fact(HeadList,[],R,Probs,0,Clauses0,M) 1248 ; 1249 generate_rules_fact_vars(HeadList,R,Probs,0,Clauses0,M) 1250 ), 1251 to_table(M,HeadList,TabDir,_), 1252 append(TabDir,Clauses0,Clauses). 1253 1254 1255 1256pitaind_expansion(Head,Clauses) :- 1257 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1258% disjunctive fact with guassia distr 1259 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1260 Head = (_:P), 1261 nonvar(P), 1262 (Head=(H:discrete(Var,D));Head=(H:finite(Var,D))),!, 1263 maplist(gen_head_disc(H,Var),D,HeadList), 1264 get_next_rule_number(M,R), 1265 get_probs(HeadList,Probs), %**** test single_var 1266 (M:local_pitaind_setting(single_var,true)-> 1267 generate_rules_fact(HeadList,[],R,Probs,0,Clauses0,M) 1268 ; 1269 generate_rules_fact_vars(HeadList,R,Probs,0,Clauses0,M) 1270 ), 1271 to_table(M,HeadList,TabDir,_), 1272 append(TabDir,Clauses0,Clauses). 1273 1274pitaind_expansion(Head,[]) :- 1275 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1276% disjunctive fact with a single head atom con prob. 0 1277 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1278 (Head = (_:P); Head = (P::_)), 1279 ground(P), 1280 P=:=0.0, !. 1281 1282pitaind_expansion(Head,Clauses) :- 1283 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1284 M:local_pitaind_setting(depth_bound,true), 1285% disjunctive fact with a single head atom con prob.1 e db 1286 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1287 (Head = (H:P); Head = (P::H)), 1288 ground(P), 1289 P=:=1.0, !, 1290 list2and([onec(BDD)],Body1), 1291 add_bdd_arg_db(H,BDD,_DB,M,Head1), 1292 to_table(M,[Head:_],TabDir,_), 1293 append(TabDir,[(Head1 :- Body1)],Clauses). 1294 1295pitaind_expansion(Head,Clauses) :- 1296 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1297% disjunctive fact with a single head atom con prob. 1, senza db 1298 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1299 (Head = (H:P);Head =(P::H)), 1300 ground(P), 1301 P=:=1.0, !, 1302 list2and([onec(BDD)],Body1), 1303 add_bdd_arg(H,BDD,M,Head1), 1304 to_table(M,[Head:_],TabDir,_), 1305 append(TabDir,[(Head1 :- Body1)],Clauses). 1306 1307pitaind_expansion(Head,Clauses) :- 1308 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1309 M:local_pitaind_setting(depth_bound,true), 1310% disjunctive fact with a single head atom e prob. generiche, con db 1311 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1312 (Head=(H:_);Head=(_::H)), !, 1313 list2or(HeadListOr, Head), 1314 process_head(HeadListOr, HeadList), 1315 term_variables(HeadList,VC), 1316 get_next_rule_number(M,R), 1317 get_probs(HeadList,Probs), 1318 add_bdd_arg_db(H,BDD,_DB,M,Head1), 1319 (M:local_pitaind_setting(single_var,true)-> 1320 Clause0=(Head1:-(get_var_n(M,R,[],Probs,V),equalityc(V,0,BDD))) 1321 ; 1322 Clause0=(Head1:-(get_var_n(M,R,VC,Probs,V),equalityc(V,0,BDD))) 1323 ), 1324 to_table(M,HeadList,TabDir,_), 1325 append(TabDir,[Clause0],Clauses). 1326 1327pitaind_expansion(Head,Clauses) :- 1328 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1329% disjunctive fact with a single head atom e prob. generiche, senza db 1330 (Head \= ((pitaind_expansion(_,_)) :- _ )), 1331 (Head=(H:_);Head=(_::H)), !, 1332 list2or(HeadListOr, Head), 1333 process_head(HeadListOr, HeadList), 1334 term_variables(HeadList,VC), 1335 get_next_rule_number(M,R), 1336 get_probs(HeadList,Probs), 1337 add_bdd_arg(H,BDD,M,Head1),%***test single_var 1338 (M:local_pitaind_setting(single_var,true)-> 1339 Clause0=(Head1:-(get_var_n(M,R,[],Probs,V),equalityc(V,0,BDD))) 1340 ; 1341 Clause0=(Head1:-(get_var_n(M,R,VC,Probs,V),equalityc(V,0,BDD))) 1342 ), 1343 to_table(M,HeadList,TabDir,_), 1344 append(TabDir,[Clause0],Clauses). 1345 1346pitaind_expansion((:- set_pitaind(P,V)), []) :-!, 1347 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1348 set_pitaind(P,V). 1349 1350pitaind_expansion((:- set_sw(A,B)), []) :-!, 1351 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1352 set_sw(M:A,B). 1353 1354 1355pitaind_expansion(Head, Clauses) :- 1356 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1357 M:local_pitaind_setting(depth_bound,true), 1358% definite fact with db 1359 (Head \= ((pitaind_expansion(_,_) ):- _ )), 1360 (Head\= end_of_file),!, 1361 add_bdd_arg_db(Head,One,_DB,M,Head1), 1362 to_table(M,[Head:_],TabDir,_), 1363 append(TabDir,[(Head1:-onec(One))],Clauses). 1364 1365pitaind_expansion(Head, Clauses) :- 1366 prolog_load_context(module, M),pitaind_input_mod(M),M:pitaind_on, 1367% definite fact without db 1368 (Head \= ((pitaind_expansion(_,_) ):- _ )), 1369 (Head\= end_of_file), 1370 add_bdd_arg(Head,One,M,Head1), 1371 to_table(M,[Head:_],TabDir,_), 1372 append(TabDir,[(Head1:-onec(One))],Clauses).
1379begin_lpad_pred:-
1380 assert(pitaind_input_mod(user)),
1381 assert(user:pitaind_on).1388end_lpad_pred:- 1389 retractall(pitaind_input_mod(_)), 1390 retractall(user:pitaind_on). 1391 1392list2or([],true):-!. 1393 1394list2or([X],X):- 1395 X\=;(_,_),!. 1396 1397list2or([H|T],(H ; Ta)):-!, 1398 list2or(T,Ta). 1399 1400 1401list2and([],true):-!. 1402 1403list2and([X],X):- 1404 X\=(_,_),!. 1405 1406list2and([H|T],(H,Ta)):-!, 1407 list2and(T,Ta). 1408 1409 1410builtin(average(_L,_Av)). 1411builtin(prob(_,_)). 1412builtin(G):- 1413 predicate_property(G,built_in). 1414builtin(G):- 1415 predicate_property(G,imported_from(lists)). 1416 1417average(L,Av):- 1418 sum_list(L,Sum), 1419 length(L,N), 1420 Av is Sum/N. 1421 1422:- multifile sandbox:safe_primitive/1. 1423 1424 1425:- multifile sandbox:safe_meta/2. 1426 1427sandbox:safe_meta(pitaind:s(_,_), []). 1428sandbox:safe_meta(pitaind:prob_ind(_,_), []). 1429sandbox:safe_meta(pitaind:prob_bar(_,_), []). 1430sandbox:safe_meta(pitaind:prob_ind(_,_,_), []). 1431sandbox:safe_meta(pitaind:prob_bar(_,_,_), []). 1432sandbox:safe_meta(pitaind:bdd_dot_file(_,_,_), []). 1433sandbox:safe_meta(pitaind:bdd_dot_string(_,_,_), []). 1434sandbox:safe_meta(pitaind:set_pitaind(_,_),[]). 1435sandbox:safe_meta(pitaind:setting_pitaind(_,_),[]). 1436 1437 1438:- thread_local pitaind_file/1. 1439 1440userterm_expansion((:- pitaind), []) :-!, 1441 prolog_load_context(source, Source), 1442 asserta(pitaind_file(Source)), 1443 prolog_load_context(module, M), 1444 retractall(M:local_pitaind_setting(_,_)), 1445 findall(local_pitaind_setting(P,V),default_setting_pitaind(P,V),L), 1446 assert_all(L,M,_), 1447 assert(pitaind_input_mod(M)), 1448 retractall(M:rule_n(_)), 1449 retractall(M:goal_n(_)), 1450 assert(M:rule_n(0)), 1451 assert(M:goal_n(0)), 1452 M:(dynamic v/3, av/3, %M:rule_by_num/4, 1453 zero_clauses/1, pitaind_on/0, if_on/0, tabled/1), 1454 style_check(-discontiguous). 1455 1456userterm_expansion(end_of_file, end_of_file) :- 1457 pitaind_file(Source), 1458 prolog_load_context(source, Source), 1459 retractall(pitaind_file(Source)), 1460 prolog_load_context(module, M), 1461 pitaind_input_mod(M),!, 1462 retractall(pitaind_input_mod(M)), 1463 style_check(+discontiguous). 1464 1465userterm_expansion(In, Out) :- 1466 \+ current_prolog_flag(xref, true), 1467 pitaind_file(Source), 1468 prolog_load_context(source, Source), 1469 pitaind_expansion(In, Out)
pitaind
This module performs reasoning over Logic Programs with Annotated Disjunctions and CP-Logic programs. It reads probabilistic program andcomputes the probability of queries.