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