9/* 10 HPLP: Hierarchical Probabilistic Logic Programs 11 Copyright (c) 2020, Arnaud Nguembang Fadja and Fabrizio Riguzzi 12 13*/ 14 15:- module(phil,[induce_hplp_par/2,induce_hplp/2,sample_hplp/4,inference_hplp/3,inference_hplp/4, 16 test_hplp/7,op(500,fx,#),op(500,fx,'-#'),set_hplp/2]). 17 18 19:-use_module(library(auc)). 20:-use_module(library(lists)). 21:-use_module(library(random)). 22:-use_module(library(system)). 23:-use_module(library(terms)). 24:-use_module(library(apply)). 25:- use_module(library(pio)). 26:- use_module(library(dialect)). 27:-set_prolog_flag(unknown,warning). 28 29:-load_foreign_library(foreign(phil)). 30%:-load_foreign_library(phil). 31 32 33:- dynamic getIndex/1. 34:- dynamic getRate/1. 35:- dynamic db/1. 36 37:- dynamic input_mod_hplp/1. 38 39:- thread_local input_mod_hplp/1. 40 41:- meta_predicate induce_hplp( , ). 42:- meta_predicate objective_hplp_func( , , , , , , , ). 43 44:- meta_predicate induce_hplp_rules( , ). 45:- meta_predicate induce_hplp_par( , ). 46:- meta_predicate induce_hplp_par_func( , , , , , , , , ). 47:- meta_predicate induce_hplp_par_func( , , , , ). 48:- meta_predicate induce_hplp_parameters( , , , ). 49:- meta_predicate test_hplp( , , , , , , ). 50 51:- meta_predicate inference_hplp( , , ). 52:- meta_predicate inference_hplp( , , , ). 53 54:- meta_predicate test_hplp_prob( , , , , , ). 55:- meta_predicate set_hplp( , ). 56:- meta_predicate setting_hplp( , ). 57 58 59 60% SLEAHP default settings 61default_setting_hplp(group,1). % use in the predicate derive_circuit_groupatoms (..) 62default_setting_hplp(megaex_bottom,1). % Necessary for the predicate test_hplp(..) 63default_setting_hplp(initial_clauses_per_megaex,1). 64default_setting_hplp(neg_literals,false). 65default_setting_hplp(neg_ex,cw). 66default_setting_hplp(epsilon_parsing, 1e-5). 67default_setting_hplp(depth_bound,false). %if true, it limits the derivation of the example to the value of 'depth' 68default_setting_hplp(depth,2). 69default_setting_hplp(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. 70default_setting_hplp(verbosity,1). 71default_setting_hplp(compiling,off). 72default_setting_hplp(d,1). 73 74default_setting_hplp(probability,1.0). % Initial value which indicates the probability to go to the next layer during HPLP generation 75default_setting_hplp(rate,0.95). % Rate to multiply to the current probability at each layer 76default_setting_hplp(min_probability,1e-5). % Threshold of the probability under which the clause is dropped 77default_setting_hplp(unifyRoot,yes). 78default_setting_hplp(use_all_mega_examples,yes). 79default_setting_hplp(saveHPLP,no). 80default_setting_hplp(saveFile,"hplp"). % File where to save the initial large HPLP generated 81default_setting_hplp(max_layer,-1). % Indicates the Max number of clause layer. -1 indicates the highest layer possible 82 83default_setting_hplp(saveArthmeticCircuit,no). % default value=no, values= no,testing,training,all 84% The name of the folder where to save the circuits 85default_setting_hplp(testingCircuitFile,"testing_circuits"). 86default_setting_hplp(trainingCircuitFile,"training_circuits"). 87 88% PHIL default settings 89default_setting_hplp(maxIter_phil,1000). % Max iteration 90default_setting_hplp(epsilon_deep,0.0001). % epsilon 91default_setting_hplp(epsilon_deep_fraction,0.00001). % delta 92default_setting_hplp(max_initial_weight,0.5). % initial weights of dphil in [-0.5 0.5] 93default_setting_hplp(adam_params,[0.001,0.9,0.999,1e-8]). % default Adam hyper-pameters 94default_setting_hplp(batch_strategy,minibatch(100)). % allowed values: batch, minibatch(size), stoch_minibatch(size) 95default_setting_hplp(algorithmType,dphil).% allowed values: dphil, emphil 96default_setting_hplp(saveStatistics,no). % indicates wheter to safe the statistics or no 97default_setting_hplp(statistics_folder,statistics). %if saveStatistics is different to "no", it indicates the folder where to safe the statistics during paramenter learning. 98default_setting_hplp(zero,0.000001). % Approximate value of 0 99default_setting_hplp(useInitParams,no). % if yes the initial parameters during the learning are the ones indicated in the progam. Otherwise, the parameters are initialy generated randomly 100default_setting_hplp(setSeed,no). 101default_setting_hplp(c_seed,c_seed). 102default_setting_hplp(logzero,log(0.000001)). 103default_setting_hplp(seed,seed(3032)). 104% regularization parameters 105default_setting_hplp(regularized,no). % yes for activating the regularization and no otherwise 106default_setting_hplp(regularizationType,1). % set the regulariztion type. 1,2 if algorithmType=dphil. Otherwise 1,2,3 107default_setting_hplp(gamma,10). % set the value of gamma according to the type (gamma=a if type=3) 108default_setting_hplp(gammaCount,0). % set the value of gammaCount according to the type (gammaCount=b if type=3) 109 110 111 112/* 113 dphil/8, emphil/6, forward/4 114*/
It returns the final log likelihood of examples CLL and the list of learned Parameters probabilities /
It returns the final log likelihood of examples CLL and the list of learned Parameters probabilities /
153%! 154 % forward(AC:+term,++Pobabilities:list,+:integer-Probability:+double) is det 155 % 156 % Evaluate the arithmetic circuit AC. 157 % Takes as input the list of learned probabilities and the number of rule NR, 158 % 159 % Returns in Probability the evaluated output of the AC 160 161 162orc(or(A),or(B),or(C)):- 163 (B=[and([zero])]-> 164 C=A 165 ; 166 (A=[and([zero])]-> 167 C=B 168 ; 169 ((A=[and([one])];B=[and([one])])-> 170 C=[one] 171 ; 172 append(A,B,C) 173 ) 174 ) 175 ). 176 177combine_or(A,B,or(C1)):- 178 argument_or(A,A1), 179 argument_or(B,B1), 180 append(A1,B1,C1). 181 182argument_or(or(A),A):-!. 183 184argument_or(A,[A]). 185 186onec(and([one])). 187 188zeroc(and([zero])). 189 190andc(and(A),and(B),and(C)):-!, 191 ((A=[zero];B=[zero])-> 192 %C=and(A,B) 193 fail 194 ; 195 (A=[one]-> 196 C=B 197 ; 198 (B=[one]-> 199 C=A 200 ; 201 append(A,B,C) 202 ) 203 ) 204 ). 205 206andc(and(A),or(B),and(C)):- 207 ((A=[zero];B=[and([zero])])-> 208 %C=and(A,B) 209 fail 210 ; 211 (A=[one]-> 212 C=or(B) 213 ; 214 (B=[one]-> 215 C=A 216 ; 217 append(A,[or(B)],C) 218 ) 219 ) 220 ). 221 222combine_and(A,B,and(C1)):- 223 argument_and(A,A1), 224 argument_and(B,B1), 225 append(A1,B1,C1). 226 227argument_and(and(A),A):-!. 228 229argument_and(A,[A]). 230 231 232ac_notc(A,B):- 233 (A=or([and([zero])])-> 234 B=one 235 ; 236 (A=or([one])-> 237 B=zero 238 ; 239 B=not(A) 240 ) 241 ). 242 243equalityc(V,N,V=N).
252or_list([H],H):-!. 253 254or_list([H|T],B):- 255 or_list1(T,H,B). 256 257 258or_list1([],B,B). 259 260or_list1([H|T],B0,B1):- 261 orc(B0,H,B2), 262 or_list1(T,B2,B1).
275test_hplp(M:P,TestFolds,LL,AUCROC,ROC,AUCPR,PR):- 276 test_hplp_prob(M:P,TestFolds,_NPos,_NNeg,LL,LG), 277 compute_areas_diagrams(LG,AUCROC,ROC,AUCPR,PR), 278 writeCurves(ROC,PR,"Curves.txt"). 279 280writeCurves(ROC,PR,FileName):- 281 open(FileName,write, Stream), 282 write(Stream, "ROC="), 283 write(Stream,ROC), 284 nl(Stream), 285 write(Stream, "PR="), 286 write(Stream,PR), 287 close(Stream).
301test_hplp_prob(M:P,TestFolds,NPos,NNeg,CLL,Results) :-
302 write2(M,'Testing\n'),
303 findall(Exs,(member(F,TestFolds),M:fold(F,Exs)),L),
304 append(L,TE),
305 process_clauses(P,M,[],_,[],PRules),
306 generate_clauses(PRules,M,RuleFacts,0,[],Th),
307 assert_all(Th,M,ThRef),
308 assert_all(RuleFacts,M,RFRef),
309 (M:bg(RBG0)->
310 process_clauses(RBG0,M,[],_,[],RBG),
311 generate_clauses(RBG,M,_RBGRF,0,[],ThBG),
312 generate_clauses_bg(RBG,ClBG),
313 assert_all(ClBG,M,ClBGRef),
314 assert_all(ThBG,ThBGRef)
315 ;
316 true
317 ),
318 test_no_area([TE],M,NPos,NNeg,CLL,Results),
319 writeList(Results,"Classification.txt"),
320 (M:bg(RBG0)->
321 retract_all(ThBGRef),
322 retract_all(ClBGRef)
323 ;
324 true
325 ),
326 retract_all(ThRef),
327 retract_all(RFRef).
336induce_hplp_par(M:Folds,P):-
337 induce_hplp_parameters(M:Folds,_DB,R),
338 rules2termHPLPs(R,P),
339 saveHPLP_learned(M,P).
348inference_hplp(M:Query, Model, Prob):-
349 inference_hplp(M:Query, Model,Prob, _Circuit).
359inference_hplp(M:Query,Model, Prob,Circuit):- 360 Fold=[Model], 361 findall(Exs,(member(F,Fold),M:fold(F,Exs)),L), 362 append(L,DB), 363 assert(M:database(DB)), 364 (M:bg(RBG0)-> 365 process_clauses(RBG0,M,[],_,[],RBG), 366 generate_clauses(RBG,M,_RBG1,0,[],ThBG), 367 generate_clauses_bg(RBG,ClBG), 368 assert_all(ClBG,M,ClBGRef), 369 assert_all(ThBG,ThBGRef) 370 ; 371 true 372 ), 373 M:in(R00), 374 process_clauses(R00,M,[],_,[],R0), 375 statistics(walltime,[_,_]), 376 generate_clauses(R0,M,R1,0,[],Th0), 377 assert_all(Th0,M,Th0Ref), 378 assert_all(R1,M,R1Ref),!, 379 retractall(M:v(_,_,_)), 380 Query=..[Func|Args], 381 append(Fold,Args,ArgsNew), 382 QueryNew=..[Func|ArgsNew], 383 findall(P,M:rule(_R,[_:P|_],_BL,_Lit),LR), 384 abolish_all_tables, 385 get_node(QueryNew,M,Circuit),!, 386 length(LR,NUMBER), 387 forward(Circuit,LR,NUMBER,Prob), 388 retract_all(Th0Ref), 389 retract_all(R1Ref), 390 retract_all(ClBGRef), 391 retract_all(ThBGRef). 392 393 394 395 396saveHPLP_learned(M,P):- 397 M:local_setting(saveHPLP,Save), 398 (Save=yes -> 399 M:local_setting(saveFile,SaveFile), 400 string_concat(SaveFile,"_Learned",Learned), 401 writeClause(P,Learned) 402 ; 403 true 404 ). 405 406rules2termHPLPs(R,T):- 407 maplist(rules2termHPLP,R,T). 408 409rules2termHPLP(rule(_N,[H:Par|_],BL,_Lit),(H:Par:-B)):- 410list2and(BL,B). 411 412induce_hplp_parameters(M:Folds,DB,R):- 413 M:local_setting(seed,Seed), 414 set_random(Seed), 415 findall(Exs,(member(F,Folds),M:fold(F,Exs)),L), 416 append(L,DB), 417 assert(M:database(DB)), 418 statistics(walltime,[_,_]), 419 (M:bg(RBG0)-> 420 process_clauses(RBG0,M,[],_,[],RBG), 421 generate_clauses(RBG,M,_RBG1,0,[],ThBG), 422 generate_clauses_bg(RBG,ClBG), 423 assert_all(ClBG,M,ClBGRef), 424 assert_all(ThBG,ThBGRef) 425 ; 426 true 427 ), 428 M:in(R00), 429 process_clauses(R00,M,[],_,[],R0), 430 statistics(walltime,[_,_]), 431 learn_params_hplp(DB,M,R0,R,Score2), 432 statistics(walltime,[_,CT]), 433 CTS is CT/1000, 434 format2(M,'Wall time=~f CLL=~f ~n',[CTS,Score2]), 435 write_rules2(M,R,user_output), 436 (M:bg(RBG0)-> 437 retract_all(ThBGRef), 438 retract_all(ClBGRef) 439 ; 440 true 441 ). 442 443 444 445% Other useful predicates 446remove_p([N,_],N).
453resetProb(_,[],[]). 454resetProb(Min_prob,[Prob|Rest],ProbFinal):- 455 (Prob<Min_prob -> 456 ProbNew is 0.0 457 ; 458 ProbNew is Prob 459 ), 460 ProbFinal=[ProbNew|ProbFinalRest], 461 resetProb(Min_prob, Rest, ProbFinalRest). 462 463 464 % Read probabilistic program from file 465 read_Program(Filename,Type,P):- 466 open(Filename, read, Stream), 467 read_file(Stream,[_|P1]), 468 removeArgument(P1,Type,P), 469 close(Stream). 470 471 read_file(Stream,[]) :- 472 at_end_of_stream(Stream). 473 474 read_file(Stream,[(Y)|L]) :- 475 \+ at_end_of_stream(Stream), 476 readWord(Stream,X), 477 %read(Stream,X), 478 %read_clause(Stream,X,[]), 479 atom_codes(X,X1), 480 atom_string(Sub,"::"), 481 atom_codes(Sub,CodSub), 482 substring(CodSub,X1), 483 %write_to_codes(X2,X1), 484 %term_to_atom(X2,X), 485 Y=X, 486 read_file(Stream,L). 487 488 read_file(_Stream,[]) :- 489 true. 490 491 removeArgument([],_,[]). 492 removeArgument([Clause|Rest],Type,[Pout|RestOut]):- 493 atomic_list_concat(Subatoms, '::', Clause), 494 Subatoms=[Prob1,Clause1], 495 term_string(Prob,Prob1), 496 term_string(Clause2,Clause1), 497 Clause2 =.. List, 498 List=[Val,Head,Body], 499 removeArg(Head,Type,Head1), 500 addProb(Head1,Prob,Head2), 501 removeBody(Body,Type,Body1), 502 List1=[Val,Head2,Body1], 503 Pout=..List1, 504 removeArgument(Rest,Type,RestOut). 505 % 506 %Pout=Head:-Body. 507 addProb(Head1,Prob,Head1:Prob). 508 removeArg(Pred,Type,PredNew):- 509 Pred =.. [Functor|Arg], 510 (Type=:=0 -> 511 Arg=[_|ArgNew] 512 ; 513 Arg=[_,_|ArgNew] 514 ), 515 PredNew =..[Functor|ArgNew]. 516 517 removeBody(Body,Type,(PredNew,RestR)):- 518 Body=(B1,Rest), 519 removeArg(B1,Type,PredNew), 520 removeBody(Rest,Type,RestR). 521 removeBody(Body,Type,PredNew):- 522 removeArg(Body,Type,PredNew),!. 523 524 readWord(InStream,W):- 525 get_code(InStream,Char), 526 checkCharAndReadRest(Char,Chars,InStream), 527 dropLast(Chars,Chars1), 528 atom_codes(W,Chars1). 529 530 dropLast(List,Result):- 531 reverse(List,[_|List1]), 532 reverse(List1,Result). 533 534 substring(X,S) :- 535 append(_,T,S) , 536 append(X,_,T) , 537 X \= []. 538 539 540 checkCharAndReadRest(10,[],_):- !. 541 542 %checkCharAndReadRest(32,[],_):- !. 543 544 checkCharAndReadRest(-1,[],_):- !. 545 546 checkCharAndReadRest(end_of_file,[],_):- !. 547 548 checkCharAndReadRest(Char,[Char|Chars],InStream):- 549 get_code(InStream,NextChar), 550 checkCharAndReadRest(NextChar,Chars,InStream). 551 552 553 554take(0, _, []) :- !. 555take(0, _, []) :- !. 556 take(N, [H|TA], [H|TB]) :- 557 N > 0, 558 N2 is N - 1, 559 take(N2, TA, TB). 560 561 562writefile(List,FileName):- 563 open(FileName,write, Stream), 564 writefile1(Stream,List), 565 close(Stream). 566 567writefile1(_Stream,[]):-!. 568writefile1(Stream,[Head|Tail]):- 569 writeln(Stream,Head), 570 writefile1(Stream,Tail). 571 572delete_AC(_, [], []):-!. 573delete_AC(ACs, [Term|Tail],Result):- 574 member(Term,ACs),!, 575 writeln(Term), 576 delete_AC(ACs, Tail, Result). 577 578delete_AC(ACs, [Head|Tail], [Head|Result]):- 579 delete_AC(ACs, Tail, Result). 580 581getInitialParameters([],[]):-!. 582getInitialParameters([rule(_Number,[_Head:Param,'':_],_Body,_)|Rest],[Param|RestParams]):- 583 getInitialParameters(Rest,RestParams).
595learn_params_hplp(DB,M,R0,R,CLL):- 596 generate_clauses(R0,M,R1,0,[],Th0), 597 assert_all(Th0,M,Th0Ref), 598 assert_all(R1,M,R1Ref),!, 599 length(R0,NR), 600 retractall(M:v(_,_,_)), 601 length(DB,NEx), 602 abolish_all_tables, 603 M:local_setting(group,G), 604 derive_circuit_groupatoms(DB,M,NEx,G,[],Nodes0,0,CLL0,_LE,[]),!, 605 maplist(remove_p,Nodes0,Nodes), 606 M:local_setting(algorithmType,Algorithm), 607 M:local_setting(maxIter_phil,MaxIter), 608 M:local_setting(epsilon_deep,EA), 609 M:local_setting(epsilon_deep_fraction,ER), 610 M:local_setting(saveArthmeticCircuit,SaveCircuits), 611 (SaveCircuits=all-> 612 M:local_setting(trainingCircuitFile,CircuitFile), 613 writefile(Nodes,CircuitFile) 614 ; 615 ( SaveCircuits=training -> 616 M:local_setting(trainingCircuitFile,CircuitFile), 617 writefile(Nodes,CircuitFile) 618 ; 619 true 620 ) 621 ), 622 StopCond=[MaxIter,EA,ER], 623 M:local_setting(statistics_folder,Statistics_folder), 624 M:local_setting(saveStatistics,Save), 625 Folder=[Save,Statistics_folder], 626 M:local_setting(zero,ZERO), 627 M:local_setting(setSeed,Seeded), 628 (Seeded=yes -> 629 M:local_setting(c_seed,Seed) 630 ; 631 Seed is 0 632 ), 633 M:local_setting(useInitParams,Init), 634 (Init=yes -> 635 getInitialParameters(R0,InitParameters), 636 Params=[NR,ZERO,Seeded,Seed,Init,InitParameters] 637 ; 638 Params=[NR,ZERO,Seeded,Seed,Init] 639 ), 640 641 format3(M,'Initial CLL on PHIL ~f */~n',[CLL0]), 642 retract_all(Th0Ref), 643 retract_all(R1Ref), 644 % Regularized parameters 645 M:local_setting(regularized,Regularized), 646 647 (Regularized=yes -> 648 M:local_setting(regularizationType,TypeReg), 649 (TypeReg=:=0 -> 650 RegParams=[no] 651 ; 652 M:local_setting(gamma,Gamma), 653 M:local_setting(gammaCount,GammaCount), 654 RegParams=[Regularized,TypeReg,Gamma,GammaCount] 655 ) 656 ; 657 RegParams=[Regularized] 658 ), 659 (Algorithm = emphil -> 660 emphil(Nodes,Params,RegParams,StopCond,Folder,CLL,ProbFinal) 661 ; 662 (Algorithm = dphil -> 663 M:local_setting(adam_params,Adam), 664 M:local_setting(max_initial_weight,MAX_W), 665 AdamReg=[Adam,RegParams], 666 dphil_C(M,Nodes,Params,StopCond,Folder,AdamReg,MAX_W,CLL,ProbFinal) 667 ; 668 format("The algorithm ~w does not exist. Do you mean dphil or emphil? ~n",[Algorithm]), 669 halt 670 ) 671 ), 672 format3(M,'~nFinal CLL ~f ~n',[CLL]), 673 (Regularized=yes -> 674 update_theory_par(R1,ProbFinal,R2), 675 M:local_setting(min_probability,Min_prob), 676 remove_clauses(R2,Min_prob,R21,Num), 677 %format("~d clauses removed",[Num]), 678 (Num=:=0 -> % if no rules was removed 679 R=R21 680 ; 681 R1=[Rule|_], % I have removed some rules so have to insure the program remains hierarchical 682 Rule1=(Rule,_), 683 getHead(Rule1,HeadFunctor), 684 removeHidden(R21,R,[HeadFunctor],_) 685 ) 686 ; 687 update_theory_par(R1,ProbFinal,R) 688 ). 689 690dphil_C(M,NodesNew,Params,StopCond,Folder,AdamReg,MAX_W,CLL,ProbFinal):- 691 M:local_setting(batch_strategy,minibatch(BatchSize)),!, 692 Params2=[minibatch,BatchSize,MAX_W], 693 dphil(NodesNew,Params,StopCond,Folder,AdamReg,Params2,CLL,ProbFinal). 694 695dphil_C(M,NodesNew,Params,StopCond,Folder,AdamReg,MAX_W,CLL,ProbFinal):- 696 M:local_setting(batch_strategy,stoch_minibatch(BatchSize)),!, 697 Params2=[stochastic,BatchSize,MAX_W], 698 dphil(NodesNew,Params,StopCond,Folder,AdamReg,Params2,CLL,ProbFinal). 699 700dphil_C(M,NodesNew,Params,StopCond,Folder,AdamReg,MAX_W,CLL,ProbFinal):- 701 M:local_setting(batch_strategy,batch),!, 702 BatchSize is 0, 703 Params2=[batch,BatchSize,MAX_W], 704 dphil(NodesNew,Params,StopCond,Folder,AdamReg,Params2,CLL,ProbFinal). 705 706%-----------------------------End parameter learning PHIL -------------------------------- 707 708 709 710 %----------------------Start HPLPs structure------------------
716induce_hplp(M:TrainFolds,P):- 717 induce_hplp_rules(M:TrainFolds,P0), 718 rules2termHPLPs(P0,P), 719 saveHPLP_learned(M,P). 720 721induce_hplp_rules(M:Folds,R):- 722 set_hplp(M:compiling,on), 723 M:local_setting(seed,Seed), 724 set_random(Seed), 725 findall(Exs,(member(F,Folds),M:fold(F,Exs)),L), 726 append(L,DB), 727 assert(M:database(DB)), 728 (M:bg(RBG0)-> 729 process_clauses(RBG0,M,[],_,[],RBG), 730 generate_clauses(RBG,M,_RBG1,0,[],ThBG), 731 generate_clauses_bg(RBG,ClBG), 732 assert_all(ThBG,M,ThBGRef), 733 assert_all(ClBG,M,ClBGRef) 734 ; 735 true 736 ), 737 length(DB,NMegaEx), 738 M:local_setting(megaex_bottom, NumMB), 739 (NMegaEx >= NumMB -> 740 true 741 ; 742 format2(M,"~nWARN: Number of required bottom clauses is greater than the number of training examples!~n. The number of required bottom clauses will be equal to the number of training examples", []), 743 set_hplp(M:megaex_bottom, NMegaEx) 744 ), 745 statistics(walltime,[_,_]), 746 M:local_setting(megaex_bottom,MB), 747 deduct(MB,M,DB,[],InitialTheory), 748 remove_duplicates(InitialTheory,R1), 749 genHPLP(M,R1,HPLP), 750 learn_params_hplp(DB,M,HPLP,R,CLL), 751 statistics(walltime,[_,WT]), 752 WTS is WT/1000, 753 %write2(M,'\n\n'), 754 format2(M,' HPLP Final score ~f~n',[CLL]), 755 format2(M,'Time=~f ~n',[WTS]), 756 set_hplp(M:compiling,off), 757 (M:bg(RBG0)-> 758 retract_all(ThBGRef), 759 retract_all(ClBGRef) 760 ; 761 true 762 ). 763 764writeParams(M,InitProb,Rate, MaxLayer,GenerateBottom):- 765 format2(M, "Hyper-parameters for generating the hierachical PLP \n \n", []), 766 (GenerateBottom=yes -> 767 format2(M, "Number of bottom clauses used: all \n", []) 768 ; 769 format2(M, "Number of bottom clauses used: one \n", []) 770 771 ), 772 format2(M, 'Initial Probability=~f ~n',[InitProb]), 773 format2(M, 'Rate=~f ~n',[Rate]), 774 Temp is -1, 775 (MaxLayer=:=Temp -> 776 format2(M, 'MaxLayer= no limit ~n',[]) 777 ; 778 format2(M, 'MaxLayer=~d ~n',[MaxLayer]) 779 ). 780 781genHPLP(M,Bottoms,HPLP):- 782 (Bottoms=[] -> 783 format("No Bottom has been generated~n",[]), 784 halt 785 ; 786 Bottoms=[Rule1|_Rest] 787 ), 788 M:local_setting(probability,InitProb), 789 M:local_setting(rate,Rate), 790 M:local_setting(max_layer,Max1), 791 M:local_setting(use_all_mega_examples,GenerateBottom), 792 M:local_setting(unifyRoot,UnifyRoot), 793 Temp is -1, 794 (Max1=:=Temp -> 795 MaxLayer is 2147000000, 796 writeParams(M,InitProb,Rate, Temp,GenerateBottom) 797 ; 798 MaxLayer is Max1, 799 writeParams(M,InitProb,Rate, MaxLayer,GenerateBottom) 800 ), 801 getHead(Rule1,HeadFunctor), 802 Prob is InitProb, 803 assert(getRate(Rate)), 804 (GenerateBottom=yes -> 805 BottomsNew=Bottoms 806 ; 807 Bottoms=[Head|_], 808 BottomsNew=[Head] 809 ), 810 (UnifyRoot=yes -> 811 maplist(unification(Rule1),BottomsNew) 812 ; 813 true 814 ), 815 getTrees(BottomsNew,Trees), 816 Trees1=[t(head,Trees)], 817 generateHPLPs(-1,HeadFunctor,MaxLayer,Prob,Trees1,HPLPs,Levels), 818 M:local_setting(saveHPLP,Save), 819 (Save=yes -> 820 M:local_setting(saveFile,SaveFile), 821 saveHPLPs(HPLPs,SaveFile,Levels) 822 ; 823 true 824 ), 825 HPLPs=[HPLP|_], 826 retractall(getRate(_Rate)). 827 828 829 830getHead((rule(_,[Head:_,_],_,_),_),HeadName):- 831 functor(Head,HeadName,_). 832 833selectHead(HeadName,[Rule|Rest],HeadRulesCur,RestCur,RulesHead):- 834 Rule=rule(_N,[Head:_|_],_,_), 835 functor(Head,HeadName,_), 836 append(HeadRulesCur,[Rule],HeadRulesCurNew), 837 selectHead(HeadName, Rest, HeadRulesCurNew, RestCur, RulesHead). 838 839selectHead(_,[Rule|Rest],HeadRulesCur,[Rule|Rest],HeadRulesCur):-!. 840 841 842remove_clauses(Rules,Prob,RulesOut,Num):- 843 remove_clauses_loop(Rules,Prob,0,Num,[],RulesOut). 844 845remove_clauses_loop([],_,Num,Num,Rules,Rules):-!. 846remove_clauses_loop([Rule|Rest],Prob,NumCur,Num,RulesCur,RulesOut):- 847 Rule=rule(_N,[_Head:Par|_],_,_), 848 (Par < Prob -> 849 NumCur1 is NumCur+1, 850 remove_clauses_loop(Rest, Prob, NumCur1,Num,RulesCur, RulesOut) 851 ; 852 append(RulesCur,[Rule],RulesCurNew), 853 remove_clauses_loop(Rest, Prob, NumCur,Num,RulesCurNew, RulesOut) 854 ). 855 856 857unification(Rule1,Rule2):- 858 Rule1=(rule(_,[Head1:_,_],_,_),_), 859 Rule2=(rule(_,[Head2:_,_],_,_),_), 860 Head1=Head2. 861 % unify_with_occurs_check(Head1,Head2). 862 863%------------------Create a tree from Bottom clauses------------------------ 864getTrees([],[]):-!. 865getTrees([(rule(_,[Head:_,_],_,Body),_)|RestBottom],[Tree|RestTrees]):- 866 functor(Head,_N, A), 867 (A=:=0 -> 868 getTree(Body,[],BodyTrees), 869 Tree=t(Head,BodyTrees) 870 ; 871 Bod=[Head|Body], 872 getTree(Bod,[],BodyTrees), 873 length(BodyTrees, LTree), 874 (LTree=:=0 -> 875 Tree=[] 876 ; 877 (LTree=:=1 -> 878 BodyTrees=[Tree] 879 ; 880 BodyTrees=[H1|B1], 881 Tree=t(H1,B1) 882 ) 883 ) 884 ), 885%getTree(Body,[],BodyTrees), 886getTrees(RestBottom, RestTrees).
892getTree([],Trees,Trees):-!. 893getTree([Pred|RestPred],TreesCurr,Treesresult):- 894insert_tree(Pred,[],TreesCurr,TreesCurr1), 895getTree(RestPred,TreesCurr1,Treesresult).
901insert_tree(Pred,[],[],[t(Pred,[])]):-!. 902insert_tree(Pred,PreviousTrees,[],TreesResult):-!, 903append_No_empty(PreviousTrees,[t(Pred,[])],TreesResult). 904 905insert_tree(Pred1,Previoustrees,[Tree|RestTreesCurr],TreesResult):- 906insert_tree_loop(Pred1,Tree,TreeResultLoop),!, % attento a questa cut 907append_No_empty(Previoustrees,[TreeResultLoop],TreesResult1), 908append_No_empty(TreesResult1,RestTreesCurr,TreesResult). 909 910insert_tree(Pred1,Previoustrees,[Tree|RestTreesCurr],TreesResult):- 911append_No_empty(Previoustrees,[Tree],PreviousTreesCurr), 912insert_tree(Pred1,PreviousTreesCurr,RestTreesCurr,TreesResult).
918insert_tree_loop(Pred1,t(Pred2,Forest),TreeResult):- 919 ischild(Pred1,Pred2),!, 920 insert_Forest(Pred1,t(Pred2,Forest),TreeResult). 921 922 insert_tree_loop(Pred1,t(Pred2,Forest),TreeResult):- 923 insert_tree_loop_Forest(Pred1,[],Forest,NewForest), 924 TreeResult=t(Pred2,NewForest).
930insert_Forest(Pred1,t(Pred2,Forest),TreeResult):-
931 append_No_empty(Forest,[t(Pred1,[])],Forest1),
932 TreeResult=t(Pred2,Forest1).
938insert_tree_loop_Forest(_Pred,_AccForest,[],_ForestResult):-fail. 939insert_tree_loop_Forest(Pred,PreviousForest,[ForestCurr|RestForest],ForestResult):- 940 append_No_empty(PreviousForest,[ForestCurr],PreviousForestCurr), 941 insert_tree_loop_Forest(Pred,PreviousForestCurr, RestForest, ForestResult). 942 943 944insert_tree_loop_Forest(Pred,PreviousForest,[ForestCurr|RestForest],ForestResult):- 945 insert_tree_loop(Pred,ForestCurr,NewForest),!, 946 append_No_empty(PreviousForest,[NewForest],ForestResult1), 947 append_No_empty(ForestResult1,RestForest,ForestResult). 948 949 950 951% Append a list Whitout considering the empty lits 952append_No_empty([],[],[]). 953append_No_empty(List,[],List):-!. 954append_No_empty([],List,List):-!. 955append_No_empty(List1,List2,List):-!, 956append(List1,List2,List). 957 958 959ischild(Pred1,Pred2):- 960 getVariableArgument(Pred1,VarPr1), 961 getVariableArgument(Pred2,VarPr2), 962 inter(VarPr1,VarPr2,Inter), 963 length(Inter,L), 964 L >0.
970getVariableArgument(Predicate,VarArguments):-
971 Predicate=..List,
972 List=[_Functor|Arguments],
973 remove_constants(Arguments,VarArguments).
981remove_constants(L0, L) :- 982 remove_constants(L0, [], L1), 983 reverse(L1, L). 984 985remove_constants([], L, L). 986 987remove_constants([H|T], L0, L) :- 988 nonvar(H), !, 989 remove_constants(T, L0, L). 990 991remove_constants([H|T], L0, L) :- 992 remove_constants(T, [H|L0], L). 993 994 995inter([], _, []). 996inter([H1|T1], L2, [H1|Res]) :- 997 memberVar(H1, L2), 998 inter(T1, L2, Res). 999inter([_|T1], L2, Res) :- 1000 inter(T1, L2, Res). 1001 1002 1003memberVar(X, [Y|T]) :- 1004 ( X==Y 1005 ; memberVar(X, T) 1006 ). 1007 1008%------------------End tree creation------------------------ 1009 1010 1011%---------------Generate HPLPs from trees----------- 1012 1013generateHPLPs(_,_,_,_,[],[],[]):-!. 1014generateHPLPs(InitLevel,HeadFunctor,MaxLayer,Prob,[Tree|RestTrees],[HPLP|RestHPLs],[Level|RestLevel]):- 1015 Tree=t(Head,Forest), 1016 assert(getIndex(1)), 1017 generateHPLPloop(MaxLayer,1,InitLevel,[h([Head,'',Prob],Forest)],[],HPLP1,0,Level), 1018 retractall(getIndex(_Index1)), 1019 removeHidden(HPLP1,HPLP11,[HeadFunctor],_), 1020 reduce([],HPLP11,0,[],HPLP), 1021 %HPLP=HPLP11, 1022 %reduceprogram(Head,HPLP1,HPLP), 1023 generateHPLPs(InitLevel,HeadFunctor,MaxLayer,Prob,RestTrees,RestHPLs,RestLevel). 1024 1025 1026/* 1027generateHPLPs(MaxLayer,Prob,Tree,HPLP,Level):- 1028Tree=t(Head,Forest), 1029generateHPLPloop(MaxLayer,1,0,[h([Head,'',Prob],Forest)],[],HPLP1,0,Level), 1030removeHidden(HPLP1,HPLP,[Head],_). 1031*/ 1032 1033 1034generateHPLPloop(MaxLayer,_,MaxLayer,_,HPLPs,HPLPs,_,MaxLayer):-!. 1035generateHPLPloop(_,_,Level,[],HPLPs,HPLPs,_,Level):-!. 1036generateHPLPloop(MaxLayer,Count,Level,[Head|Rest],HPLPs,HPLPsR,NumRule,LevelOut):- 1037Head=h([Hidden,PathIndex,Prob],Forest), 1038generateHPLPloopCurr(Hidden,PathIndex,Prob,1,Forest,Rest,RestNew,HPLPs,HPLPsNew,NumRule,NumRuleNew), 1039Count1 is Count-1, 1040(Count1=:=0 -> 1041 length(RestNew,CountNew), 1042 LevelNew is Level +1 1043 ; 1044 LevelNew is Level, 1045 CountNew is Count1 1046 ), 1047generateHPLPloop(MaxLayer,CountNew,LevelNew,RestNew,HPLPsNew,HPLPsR,NumRuleNew,LevelOut). 1048 1049 1050generateHPLPloopCurr(_,_,_,_,[],Forest,Forest,HPLPs,HPLPs,NumR,NumR):-!. 1051generateHPLPloopCurr(Hidden,PathIndex,Prob,Index,[t(Pred2,ForestChild)|RestForest],AccForest,ForestResult,HPLPs,HPLPsR,NumR,NumResult):- 1052 %write(Stream,Hidden), 1053 %write(Stream,":0.5:-"), 1054 %write(Stream,Pred2), 1055 (maybe(Prob) -> 1056 Head=[Hidden:0.5,'':0.5], 1057 (ForestChild=[] -> 1058 Temp=[], 1059 Body=[Pred2], 1060 IndexNew is Index 1061 ; 1062 (Hidden=head -> 1063 %IndexNew is Index, 1064 Temp=[h([Pred2,'',Prob],ForestChild)] 1065 ; 1066 %write(Stream,","), 1067 atom_concat(PathIndex,'_',PathIndex1), 1068 (( functor(Hidden, Name, _),atom_concat(hidden,_,Name)) -> 1069 atom_concat(PathIndex1,Index,PathIndexNew) 1070 ; 1071 getIndex(Index1), 1072 atom_concat(PathIndex1,Index1,PathIndexNew), 1073 retractall(getIndex(_Index1)), 1074 Index1New is Index1 +1, 1075 assert(getIndex(Index1New)) 1076 1077 ), 1078 %atom_concat(PathIndex1,Index,PathIndexNew), 1079 getHidden(Hidden,Pred2,PathIndexNew,HiddenNew), 1080 getRate(Rate), 1081 ProbNew is Prob*Rate, 1082 Temp=[h([HiddenNew,PathIndexNew,ProbNew],ForestChild)], 1083 Body=[Pred2,HiddenNew] 1084 %write(Stream,HiddenNew), 1085 %IndexNew is Index+1 1086 ), 1087 IndexNew is Index+1 1088 ), 1089 append(AccForest,Temp,AccForestNew), 1090 (Hidden=head -> 1091 R=[], 1092 NumRNew is NumR 1093 ; 1094 R=[rule(NumR,Head,Body,true)], 1095 NumRNew is NumR+1 1096 ), 1097 append(HPLPs,R,HPLPsNew), 1098 generateHPLPloopCurr(Hidden,PathIndex,Prob,IndexNew,RestForest,AccForestNew,ForestResult,HPLPsNew,HPLPsR,NumRNew,NumResult) 1099 ; 1100 generateHPLPloopCurr(Hidden,PathIndex,Prob,Index,RestForest,AccForest,ForestResult,HPLPs,HPLPsR,NumR,NumResult) 1101 ). 1102 1103getHidden(Hidden,Pred2,PathIndex,HiddenNew):- 1104getVariableArgument(Hidden,Var1), 1105getVariableArgument(Pred2,Var2), 1106unionVar(Var1,Var2,UnionVar), 1107atom_concat(hidden,PathIndex,HiddenNew1), 1108HiddenNew=..[HiddenNew1|UnionVar]. 1109 1110unionVar([],ListVar,ListVar):-!. 1111unionVar(ListVar,[],ListVar):-!. 1112 1113unionVar([Var1|R1],List2,Rest):- 1114 memberVar(Var1,List2),!, 1115 unionVar(R1, List2, Rest). 1116 1117unionVar([Var1|R1],List2,[Var1|Rest]):- 1118 unionVar(R1, List2, Rest). 1119 1120%--------------End HPLPS generation-------------------------- 1121 1122 1123% --------Reduce the initial HPLP---------- 1124reduce(_ACC,[],_Count,Rule,Rule):-!. 1125reduce(Acc,[Rule2|RestRule],Count,RuleCur,Rule):- 1126 (Rule2=rule(_Num,_Head,[_Body1,_Body2],_Val) -> 1127 %R=rule(Count,Head,[Body1,Body2],Val), 1128 copy_term(Rule2, Rule2_copy), 1129 append(RuleCur,[Rule2_copy],RuleCur1), 1130 %append(RuleCur,[R],RuleCur1), 1131 Count1 is Count+1, 1132 reduce(Acc,RestRule,Count1,RuleCur1,Rule) 1133 ; 1134 Rule2=rule(_,[Head1,_],[Pred2],_Val), 1135 Head1=Head:_Prob, 1136 functor(Pred2,Name,Arity), 1137 New=(Head,Name,Arity), 1138 (member(New,Acc)-> 1139 reduce(Acc,RestRule,Count,RuleCur,Rule) 1140 ; 1141 append(Acc,[New],AccNew), 1142 %R=rule(Count,[Head1,Head2],[Pred2],Val), 1143 copy_term(Rule2, Rule2_copy), 1144 append(RuleCur,[Rule2_copy],RuleCur1), 1145 Count1 is Count+1, 1146 reduce(AccNew,RestRule,Count1,RuleCur1,Rule) 1147 ) 1148 ). 1149 1150 1151match(rule(_,Head,[Pred1],_),rule(_,Head,[Pred2],_)):- 1152 functor(Pred1,Name,Arity), 1153 functor(Pred2,Name,Arity). 1154 1155 1156removeHidden([],[],Hidden,Hidden):-!. 1157removeHidden([Rule|Rest],HPLPOut,HiddenCur,HiddenR):- 1158 Rule=rule(N,Head,[Pred,Hidden],True), 1159 (exist1(Hidden,Rest) -> 1160 functor(Hidden,Name,_), 1161 append(HiddenCur,[Name],HiddenCurNew), 1162 removeHidden(Rest,HPLPOutLoop,HiddenCurNew,HiddenR),!, 1163 HPLPOut=[Rule|HPLPOutLoop] 1164 ; 1165 removeHidden(Rest,HPLPOutLoop,HiddenCur,HiddenR),!, 1166 HPLPOut=[rule(N,Head,[Pred],True)|HPLPOutLoop] 1167). 1168 1169removeHidden([Rule|Rest],HPLPOut,HiddenCur,HiddenR):- 1170Rule=rule(_,Head,[Pred],_), 1171Head=[Hidden:_,_], 1172functor(Hidden,Name,_), 1173(memberVar(Name,HiddenCur) -> 1174 HPLPOut=[Rule|HPLPOutLoop] 1175 ; 1176 (isHiddenPredicate(Pred) -> 1177 HPLPOut=[Rule|HPLPOutLoop] 1178 ; 1179 HPLPOut=HPLPOutLoop 1180 ) 1181 ), 1182removeHidden(Rest,HPLPOutLoop,HiddenCur,HiddenR). 1183 1184exist1(_,[]):-fail,!. 1185exist1(Hidden,[rule(_,Head,_,_)|_Rest]):- 1186Head=[Hidden:_,_],!. 1187 1188exist1(Hidden,[_|Rest]):- 1189exist1(Hidden,Rest). 1190 1191isHiddenPredicate(Hidden):- 1192 functor(Hidden,Name,_), 1193 atom_concat(hidden,_,Name). 1194% -------End Reduction the initial HPLP---------- 1195 1196%----------------------------Save HPLPs in a file------------------------------------ 1197 1198saveHPLPs(HPLPs,FileName,Levels):- 1199 open(FileName,write, Stream), 1200 %saveHPLPsLoop(Stream,1,HPLPs,Nodes_Heigths), 1201 length(Levels,NumHPLPs), 1202 numlist(1,NumHPLPs, Numbers), 1203 maplist(saveHPLP(Stream), Numbers,HPLPs,Levels), 1204 close(Stream). 1205 1206 saveHPLPsStream(HPLPs,Stream,Levels):- 1207 %saveHPLPsLoop(Stream,1,HPLPs,Nodes_Heigths), 1208 length(Levels,NumHPLPs), 1209 numlist(1,NumHPLPs, Numbers), 1210 maplist(saveHPLP(Stream), Numbers,HPLPs,Levels). 1211 1212 /* 1213 saveHPLPsLoop(_,_,[],[]). 1214 saveHPLPsLoop(Stream,Iter,[HPLP|RestHPLPs],[(Nodes,Height)|Rest]):- 1215 format(Stream,"HPLP Number ~d: Number of nodes=~d Height=~d ~n",[Iter,Nodes,Height]), 1216 copy_term(HPLP,HPLPCopy), 1217 numbervars((HPLPCopy,_HPLPVar),0,_V), 1218 saveHPLP(Stream,HPLPCopy), 1219 (RestHPLPs=[]-> 1220 true 1221 ; 1222 nl(Stream), 1223 nl(Stream) 1224 ), 1225 Iter1 is Iter+1, 1226 saveHPLPsLoop(Stream, Iter1, RestHPLPs,Rest). 1227 */ 1228 1229 saveHPLP(Stream,Number,HPLP,Level):- 1230 %Params=(Nodes,Height), 1231 format(Stream,"HPLP ~d: Height=~d ~n",[Number,Level]), 1232 copy_term(HPLP,HPLPCopy), 1233 numbervars((HPLPCopy,_HPLPVar),0,_V), 1234 %saveHPLPLoop(Stream,HPLPCopy), 1235 maplist(saveHPLPLoop(Stream),HPLPCopy), 1236 nl(Stream), 1237 nl(Stream). 1238 1239 saveHPLPLoop(Stream,rule(_,[Head,_],Body,_)):- 1240 write(Stream,Head), 1241 write(Stream,":-"), 1242 %flush_output(Stream), 1243 writeBody(Stream,Body). 1244 1245 /* 1246 saveHPLPLoop(_,[]). 1247 saveHPLPLoop(Stream,[rule(_,[Head,_],Body,true)|RestRule]):- 1248 write(Stream,Head), 1249 write(Stream,":-"), 1250 writeBody(Stream,Body), 1251 saveHPLPLoop(Stream,RestRule). 1252 */ 1253 1254 writeBody(_,[]):-!. 1255 writeBody(Stream,[Body1|RestBody]):- 1256 write(Stream,Body1), 1257 (RestBody=[] -> 1258 writeln(Stream,".") 1259 ; 1260 write(Stream,",") 1261 ), 1262 writeBody(Stream, RestBody). 1263 1264 %--------------End save HPLPs------------------------------------ 1265 1266 1267%-------------------Other useful predicates-------------------------- 1268 1269saveTrees(Bottoms,FileName):- 1270 open(FileName,write, Stream), 1271 saveTrees1(Stream,1,Bottoms), 1272 close(Stream). 1273 1274 saveTrees1(_,_,[]). 1275 saveTrees1(Stream,Iter,[Hplp|Rest]):- 1276 nnodes(Hplp,Number), 1277 height(Hplp,Height), 1278 format(Stream,"HPLP N°~d: Number of nodes=~d; Height=~d ~n",[Iter,Number,Height]), 1279 copy_term(Hplp,HplpCopy), 1280 numbervars((HplpCopy,_HplpVar),0,_V), 1281 writeTreeloop(Stream,0,HplpCopy), 1282 length(Rest,LR), 1283 (LR=:=0-> 1284 true 1285 ; 1286 nl(Stream), 1287 nl(Stream) 1288 ), 1289 Iter1 is Iter+1, 1290 saveTrees1(Stream,Iter1,Rest). 1291 1292 1293 writeTrees(Trees,FileName):- 1294 open(FileName,write, Stream), 1295 writeTrees1(Stream,Trees), 1296 close(Stream). 1297 1298 writeTrees1(_Stream, []). 1299 writeTrees1(Stream,[HeadTree|RestTree]):- 1300 writeTreeloop(Stream,0,HeadTree), 1301 nl(Stream), 1302 nl(Stream), 1303 writeTrees1(Stream, RestTree). 1304 1305 1306 writeTreeloop(Stream,Iter,t(Pred,Forest)):- 1307 tab(Stream,Iter), 1308 %write(Stream,"|"), 1309 writeln(Stream,Pred), 1310 IterCurr is 2+Iter, 1311 writeForest(Stream,IterCurr,Forest). 1312 1313 writeForest(_Stream,_Iter,[]). 1314 writeForest(Stream,Iter,[HeadForest|RestForest]):- 1315 writeTreeloop(Stream,Iter,HeadForest), 1316 writeForest(Stream,Iter,RestForest). 1317 1318 1319 1320% Some useful predicate on Trees 1321 1322 1323% Count the Number of Node in a tree 1324 1325 nnodes(t(_,F),N) :- nnodes(F,NF), N is NF+1. 1326 nnodes([],0). 1327 nnodes([T|Ts],N) :- nnodes(T,NT), nnodes(Ts,NTs), N is NT+NTs. 1328 1329 1330% True if its arguments is a tree 1331 1332 istree(t(_,F)):-isforest(F). 1333 isforest([]). 1334 isforest([T|Ts]) :- istree(T), isforest(Ts). 1335 1336 1337% add a child to and existing tree 1338 1339 1340 addChild(t(Pred,Forest),NewChild,t(Pred,NewForest)):- 1341 append_No_empty(Forest,NewChild,NewForest). 1342 1343% Return the height of a tree 1344 1345 height(Tree,H):- 1346 tree_depth(Tree,Max), 1347 H is Max-1. 1348 tree_depth(nil,0) . % the depth of an empty tree is 0. 1349 tree_depth(t(_,Forest),D) :- % the depth of a non-empty tree is computed thus: 1350 depth_max(Forest,0,Max), 1351 D is 1 + Max. % - the overall depth is 1 more than the maximum depth in the forest. 1352 1353 depth_max([],Max,Max). 1354 depth_max([Child|RestForest],MaxCurr,Max):- 1355 tree_depth(Child,MaxChild), 1356 (MaxChild > MaxCurr -> 1357 depth_max(RestForest,MaxChild,Max) 1358 ; 1359 depth_max(RestForest,MaxCurr,Max) 1360 ).
1364 % Write the list List (of terms) in the file FileName 1365 % 1366 1367 writeList(List,FileName):- 1368 open(FileName,write, Stream), 1369 writeList1(List,Stream), 1370 close(Stream). 1371 writeList1([],_). 1372 writeList1([HeadList|RestList],Stream):- 1373 writeln(Stream,HeadList), 1374 writeList1(RestList,Stream).
1378 % Write the list List (of terms) in the file FileName 1379 % 1380 1381 writeClause(List,FileName):- 1382 open(FileName,write, Stream), 1383 copy_term(List,ListCopy), 1384 numbervars((ListCopy,_ListVar),0,_V), 1385 writeln(Stream,"Learned Program"), 1386 writeClause1(ListCopy,Stream), 1387 close(Stream). 1388 1389 1390 writeClauseOutput(List):- 1391 copy_term(List,ListCopy), 1392 numbervars((ListCopy,_ListVar),0,_V), 1393 writeln(user_output,"Learned Program"), 1394 writeClause1(user_output,ListCopy). 1395 1396 writeClause1([],_). 1397 writeClause1([HeadList|RestList],Stream):- 1398 write(Stream,HeadList), 1399 writeln(Stream,"."), 1400 writeClause1(RestList,Stream). 1401 1402 1403 /*update_theory_par([],[],[]). 1404 1405update_theory_par([(Head:_:-Body)|T0],[Par|ParT],[(Head:Par:-Body)|T]):- 1406 update_theory_par(T0,ParT,T). 1407*/ 1408 1409update_theory_par([],[],[]). 1410 1411update_theory_par([rule(N,[H:_,'':_],B,L)|T0],[Par|ParT], 1412 [rule(N,[H:Par,'':P0],B,L)|T]):- 1413 P0 is 1-Par, 1414 update_theory_par(T0,ParT,T). 1415 1416 1417update_theory(R,initial,R):-!. 1418 1419update_theory([],_Par,[]). 1420 1421update_theory([def_rule(H,B,L)|T0],Par,[def_rule(H,B,L)|T]):-!, 1422 update_theory(T0,Par,T). 1423 1424update_theory([(H:-B)|T0],Par,[(H:-B)|T]):-!, 1425 update_theory(T0,Par,T). 1426 1427update_theory([rule(N,H,B,L)|T0],Par,[rule(N,H1,B,L)|T]):- 1428 member([N,P],Par),!, 1429 reverse(P,P1), 1430 update_head_par(H,P1,H1), 1431 update_theory(T0,Par,T). 1432 1433update_head_par([],[],[]). 1434 1435update_head_par([H:_P|T0],[HP|TP],[H:HP|T]):- 1436 update_head_par(T0,TP,T). 1437 1438%----------------------End HPLPs structure------------------ 1439 1440 1441 1442 1443 1444%---- derive the aritmetic circuits from the examples and the program-------- 1445derive_circuit_groupatoms_output_atoms([],_M,_O,_E,_G,Nodes,Nodes,CLL,CLL,LE,LE). 1446 1447derive_circuit_groupatoms_output_atoms([H|T],M,O,E,G,Nodes0,Nodes,CLL0,CLL,LE0,LE):- 1448 generate_goal(O,M,H,[],GL), 1449 1450 1451 CardEx is 1.0 1452 , 1453 get_node_list_groupatoms(GL,M,ACs,CardEx,G,CLL0,CLL1,LE0,LE1), 1454 append(Nodes0,ACs,Nodes1), 1455 derive_circuit_groupatoms_output_atoms(T,M,O,E,G,Nodes1,Nodes,CLL1,CLL,LE1,LE). 1456 1457 1458derive_circuit_groupatoms([],_M,_E,_G,Nodes,Nodes,CLL,CLL,LE,LE). 1459 1460derive_circuit_groupatoms([H|T],M,E,G,Nodes0,Nodes,CLL0,CLL,LE0,LE):- 1461 get_output_atoms(O,M), 1462 generate_goal(O,M,H,[],GL), 1463 CardEx is 1.0, 1464 %sample_hplp(1000,GL,GLTemp,_), 1465 get_node_list_groupatoms(GL,M,ACs,CardEx,G,CLL0,CLL1,LE0,LE1), 1466 append(Nodes0,ACs,Nodes1), 1467 derive_circuit_groupatoms(T,M,E,G,Nodes1,Nodes,CLL1,CLL,LE1,LE). 1468 1469get_node_list_groupatoms([],_M,[],_CE,_Gmax,CLL,CLL,LE,LE). 1470 1471get_node_list_groupatoms([H|T],M,[[AC1,CE]|ACT],CE,Gmax,CLL0,CLL,[H|LE0],LE):- 1472 get_node(H,M,AC1), %creates the AC for atom , 1473 CLL2 is CLL0, 1474 get_node_list_groupatoms(T,M,ACT,CE,Gmax,CLL2,CLL,LE0,LE). 1475 1476%---- End aritmetic circuits derivation-------- 1477 1478 1479 % -- Compute the areas under the ROC and PR curve 1480compute_prob([],[],[],Pos,Pos,Neg,Neg). 1481 1482compute_prob([\+ HE|TE],[HP|TP],[P- (\+ HE)|T],Pos0,Pos,Neg0,Neg):-!, 1483 P is 1-HP, 1484 Neg1 is Neg0+1, 1485 compute_prob(TE,TP,T,Pos0,Pos,Neg1,Neg). 1486 1487compute_prob([ HE|TE],[HP|TP],[HP- HE|T],Pos0,Pos,Neg0,Neg):- 1488 Pos1 is Pos0+1, 1489 compute_prob(TE,TP,T,Pos1,Pos,Neg0,Neg). 1490 1491 1492compute_aucpr(L,Pos,Neg,A):- 1493 L=[P_0-E|TL], 1494 (E= (\+ _ )-> 1495 FP=1, 1496 TP=0, 1497 FN=Pos, 1498 TN is Neg -1 1499 ; 1500 FP=0, 1501 TP=1, 1502 FN is Pos -1, 1503 TN=Neg 1504 ), 1505 compute_curve_points(TL,P_0,TP,FP,FN,TN,Points), 1506 Points=[R0-P0|_TPoints], 1507 (R0=:=0,P0=:=0-> 1508 Flag=true 1509 ; 1510 Flag=false 1511 ), 1512 area(Points,Flag,Pos,0,0,0,A). 1513 1514compute_curve_points([],_P0,TP,FP,_FN,_TN,[1.0-Prec]):-!, 1515 Prec is TP/(TP+FP). 1516 1517compute_curve_points([P- (\+ _)|T],P0,TP,FP,FN,TN,Pr):-!, 1518 (P<P0-> 1519 Prec is TP/(TP+FP), 1520 Rec is TP/(TP+FN), 1521 Pr=[Rec-Prec|Pr1], 1522 P1=P 1523 ; 1524 Pr=Pr1, 1525 P1=P0 1526 ), 1527 FP1 is FP+1, 1528 TN1 is TN-1, 1529 compute_curve_points(T,P1,TP,FP1,FN,TN1,Pr1). 1530 1531compute_curve_points([P- _|T],P0,TP,FP,FN,TN,Pr):-!, 1532 (P<P0-> 1533 Prec is TP/(TP+FP), 1534 Rec is TP/(TP+FN), 1535 Pr=[Rec-Prec|Pr1], 1536 P1=P 1537 ; 1538 Pr=Pr1, 1539 P1=P0 1540 ), 1541 TP1 is TP+1, 1542 FN1 is FN-1, 1543 compute_curve_points(T,P1,TP1,FP,FN1,TN,Pr1). 1544 1545area([],_Flag,_Pos,_TPA,_FPA,A,A). 1546 1547area([R0-P0|T],Flag,Pos,TPA,FPA,A0,A):- 1548 TPB is R0*Pos, 1549 (TPB=:=0-> 1550 A1=A0, 1551 FPB=0 1552 ; 1553 R_1 is TPA/Pos, 1554 (TPA=:=0-> 1555 (Flag=false-> 1556 P_1=P0 1557 ; 1558 P_1=0.0 1559 ) 1560 ; 1561 P_1 is TPA/(TPA+FPA) 1562 ), 1563 FPB is TPB*(1-P0)/P0, 1564 N is TPB-TPA+0.5, 1565 interpolate(1,N,Pos,R_1,P_1,TPA,FPA,TPB,FPB,A0,A1) 1566 ), 1567 area(T,Flag,Pos,TPB,FPB,A1,A). 1568 1569interpolate(I,N,_Pos,_R0,_P0,_TPA,_FPA,_TPB,_FPB,A,A):-I>N,!. 1570 1571interpolate(I,N,Pos,R0,P0,TPA,FPA,TPB,FPB,A0,A):- 1572 R is (TPA+I)/Pos, 1573 P is (TPA+I)/(TPA+I+FPA+(FPB-FPA)/(TPB-TPA)*I), 1574 A1 is A0+(R-R0)*(P+P0)/2, 1575 I1 is I+1, 1576 interpolate(I1,N,Pos,R,P,TPA,FPA,TPB,FPB,A1,A). 1577% End Areas computation 1578 1579 1580randomize([],[]):-!. 1581 1582randomize([rule(N,V,NH,HL,BL,LogF)|T],[rule(N,V,NH,HL1,BL,LogF)|T1]):- 1583 length(HL,L), 1584 Int is 1.0/L, 1585 randomize_head(Int,HL,0,HL1), 1586 randomize(T,T1). 1587 1588randomize_head(_Int,['':_],P,['':PNull1]):-!, 1589 PNull is 1.0-P, 1590 (PNull>=0.0-> 1591 PNull1 =PNull 1592 ; 1593 PNull1=0.0 1594 ). 1595 1596randomize_head(Int,[H:_|T],P,[H:PH1|NT]):- 1597 PMax is 1.0-P, 1598 random(0,PMax,PH1), 1599 P1 is P+PH1, 1600 randomize_head(Int,T,P1,NT). 1601 1602 1603 1604update_head([],[],_N,[]):-!. 1605 1606update_head([H:_P|T],[PU|TP],N,[H:P|T1]):- 1607 P is PU/N, 1608 update_head(T,TP,N,T1). 1609 1610/* utilities */
1618/* 1619rules2terms(R,T):- 1620 maplist(rule2term,R,T). 1621 1622rule2term(rule(_N,HL,BL,_Lit),(H:-B)):- 1623 list2or(HL,H), 1624 list2and(BL,B). 1625 1626rule2term(def_rule(H,BL,_Lit),((H:1.0):-B)):- 1627 list2and(BL,B). 1628*/ 1629 1630write_rules([],_S). 1631 1632write_rules([rule(_N,HL,BL,Lit)|T],S):-!, 1633 copy_term((HL,BL,Lit),(HL1,BL1,Lit1)), 1634 numbervars((HL1,BL1,Lit1),0,_M), 1635 write_disj_clause(S,(HL1:-BL1)), 1636 write_rules(T,S). 1637 1638write_rules([def_rule(H,BL,Lit)|T],S):- 1639 copy_term((H,BL,Lit),(H1,BL1,Lit1)), 1640 numbervars((H1,BL1,Lit1),0,_M), 1641 write_disj_clause(S,([H1:1.0]:-BL1)), 1642 write_rules(T,S). 1643 1644 1645new_par([],[],[]). 1646 1647new_par([HP|TP],[Head:_|TO],[Head:HP|TN]):- 1648 new_par(TP,TO,TN). 1649 1650 1651 1652write_disj_clause(S,(H:-[])):-!, 1653 write_head(S,H), 1654 format(S,".~n~n",[]). 1655 1656write_disj_clause(S,(H:-B)):- 1657 write_head(S,H), 1658 format(S,' :-',[]), 1659 nl(S), 1660 write_body(S,B). 1661 1662 1663write_head(S,[A:1.0|_Rest]):-!, 1664 format(S,"~q:1.0",[A]). 1665 1666write_head(S,[A:P,'':_P]):-!, 1667 format(S,"~q:~g",[A,P]). 1668 1669write_head(S,[A:P]):-!, 1670 format(S,"~q:~g",[A,P]). 1671 1672write_head(S,[A:P|Rest]):- 1673 format(S,"~q:~g ; ",[A,P]), 1674 write_head(S,Rest). 1675 1676write_body(S,[]):-!, 1677 format(S," true.~n~n",[]). 1678 1679write_body(S,[A]):-!, 1680 format(S," ~q.~n~n",[A]). 1681 1682write_body(S,[A|T]):- 1683 format(S," ~q,~n",[A]), 1684 write_body(S,T).
1693list2or([],true):-!. 1694 1695list2or([X],X):- 1696 X\=;(_,_),!. 1697 1698list2or([H|T],(H ; Ta)):-!, 1699 list2or(T,Ta).
1709list2and([],true):-!. 1710 1711list2and([X],X):- 1712 X\=(_,_),!. 1713 1714list2and([H|T],(H,Ta)):-!, 1715 list2and(T,Ta). 1716 1717 1718deduct(0,_Mod,_DB,Th,Th):-!. 1719 1720deduct(NM,Mod,DB,InTheory0,InTheory):- 1721 get_head_atoms(O,Mod), 1722 sample_hplp(1,DB,Sampled,DB1), 1723 (Sampled=[M]-> 1724 generate_head(O,M,Mod,[],HL), 1725 NM1 is NM-1, 1726 ( HL \== [] -> 1727 (generate_body(HL,Mod,InTheory1), 1728 append(InTheory0,InTheory1,InTheory2), 1729 deduct(NM1,Mod,DB1,InTheory2,InTheory) 1730 ) 1731 ; 1732 deduct(NM1,Mod,DB1,InTheory0,InTheory) 1733 ) 1734 ; 1735 InTheory=InTheory0 1736 ). 1737 1738 1739get_head_atoms(O,M):- 1740 findall(A,M:modeh(_,A),O0), 1741 findall((A,B,D),M:modeh(_,A,B,D),O1), 1742 append(O0,O1,O). 1743 1744generate_top_cl([],_M,[]):-!. 1745 1746generate_top_cl([A|T],M,[(rule(R,[A1:0.5,'':0.5],[],true),-1e20)|TR]):- 1747 A=..[F|ArgM], 1748 keep_const(ArgM,Arg), 1749 A1=..[F|Arg], 1750 get_next_rule_number(M,R), 1751 generate_top_cl(T,M,TR). 1752 1753 1754generate_head([],_M,_Mod,HL,HL):-!. 1755 1756generate_head([(A,G,D)|T],M,Mod,H0,H1):-!, 1757 generate_head_goal(G,M,Goals), 1758 findall((A,Goals,D),(member(Goal,Goals),call(Mod:Goal),ground(Goals)),L), 1759 Mod:local_setting(initial_clauses_per_megaex,IC), %IC: represents how many samples are extracted from the list L of example 1760 sample(IC,L,L1), 1761 append(H0,L1,H2), 1762 generate_head(T,M,Mod,H2,H1). 1763 1764generate_head([A|T],M,Mod,H0,H1):- 1765 functor(A,F,N), 1766 functor(F1,F,N), 1767 F1=..[F|Arg], 1768 Pred1=..[F,M|Arg], 1769 A=..[F|ArgM], 1770 keep_const(ArgM,Arg), 1771 findall((A,Pred1),call(Mod:Pred1),L), 1772 Mod:local_setting(initial_clauses_per_megaex,IC), 1773 sample(IC,L,L1), 1774 append(H0,L1,H2), 1775 generate_head(T,M,Mod,H2,H1). 1776 1777generate_head_goal([],_M,[]). 1778 1779generate_head_goal([H|T],M,[H1|T1]):- 1780 H=..[F|Arg], 1781 H1=..[F,M|Arg], 1782 generate_head_goal(T,M,T1). 1783 1784keep_const([],[]). 1785 1786keep_const([- _|T],[_|T1]):-!, 1787 keep_const(T,T1). 1788 1789keep_const([+ _|T],[_|T1]):-!, 1790 keep_const(T,T1). 1791 1792keep_const([-# _|T],[_|T1]):-!, 1793 keep_const(T,T1). 1794 1795keep_const([H|T],[H1|T1]):- 1796 H=..[F|Args], 1797 keep_const(Args,Args1), 1798 H1=..[F|Args1], 1799 keep_const(T,T1).
1810sample_hplp(0,List,[],List):-!. 1811 1812sample_hplp(N,List,List,[]):- 1813 length(List,L), 1814 L=<N,!. 1815 1816sample_hplp(N,List,[El|List1],Li):- 1817 length(List,L), 1818 random(0,L,Pos), 1819 nth0(Pos,List,El,Rest), 1820 N1 is N-1, 1821 sample_hplp(N1,Rest,List1,Li). 1822 1823sample(0,_List,[]):-!. 1824 1825sample(N,List,List):- 1826 length(List,L), 1827 L=<N,!. 1828 1829sample(N,List,[El|List1]):- 1830 length(List,L), 1831 random(0,L,Pos), 1832 nth0(Pos,List,El,Rest), 1833 N1 is N-1, 1834 sample(N1,Rest,List1). 1835 1836get_args([],[],[],A,A,AT,AT,_). 1837 1838get_args([HM|TM],[H|TH],[(H,HM)|TP],A0,A,AT0,AT,M):- 1839 HM=..[F|ArgsTypes], 1840 H=..[F,M|Args], 1841 append(A0,Args,A1), 1842 append(AT0,ArgsTypes,AT1), 1843 get_args(TM,TH,TP,A1,A,AT1,AT,M). 1844 1845/* Generation of the bottom clauses */ 1846 1847gen_head([],P,['':P]). 1848 1849gen_head([H|T],P,[H:P|TH]):- 1850 gen_head(T,P,TH). 1851 1852get_modeb([],_Mod,B,B). 1853 1854get_modeb([F/AA|T],Mod,B0,B):- 1855 findall((R,B),(Mod:modeb(R,B),functor(B,F,AA)),BL), 1856 (setting_sc(neg_literals,true)-> 1857 findall((R,(\+ B)),(Mod:modeb(R,B),functor(B,F,AA),all_plus(B)),BNL) 1858 ; 1859 BNL=[] 1860 ), 1861 append([B0,BL,BNL],B1), 1862 get_modeb(T,Mod,B1,B). 1863 1864all_plus(B):- 1865 B=..[_|Args], 1866 all_plus_args(Args). 1867 1868all_plus_args([]). 1869 1870all_plus_args([+ _ |T]):-!, 1871 all_plus_args(T). 1872 1873all_plus_args([H|T]):- 1874 H \= - _, 1875 H \= # _, 1876 H \= -# _, 1877 H=..[_|Args], 1878 all_plus_args(Args), 1879 all_plus_args(T). 1880 1881generate_body([],_Mod,[]):-!. 1882 1883generate_body([(A,H,Det)|T],Mod,[(rule(R,HP,[],BodyList),-1e20)|CL0]):-!, 1884 get_modeb(Det,Mod,[],BL), 1885 get_args(A,H,Pairs,[],Args,[],ArgsTypes,M), 1886 Mod:local_setting(d,D), 1887 cycle_modeb(ArgsTypes,Args,[],[],Mod,BL,a,[],BLout0,D,M), 1888 variabilize((Pairs:-BLout0),CLV), %+(Head):-Bodylist; -CLV:(Head):-Bodylist with variables _num in place of constants 1889 CLV=(Head1:-BodyList1), 1890 remove_int_atom_list(Head1,Head), 1891 remove_int_atom_list(BodyList1,BodyList2), 1892 remove_duplicates(BodyList2,BodyList), 1893 get_next_rule_number(Mod,R), 1894 length(Head,LH), 1895 Prob is 1/(LH+1), 1896 gen_head(Head,Prob,HP), 1897 copy_term((HP,BodyList),(HeadV,BodyListV)), 1898 numbervars((HeadV,BodyListV),0,_V), 1899 format2(Mod,"Bottom clause: example ~q~nClause~n",[H]), 1900 write_disj_clause2(Mod,user_output,(HeadV:-BodyListV)), 1901 generate_body(T,Mod,CL0). 1902 1903generate_body([(A,H)|T],Mod,[(rule(R,[Head:0.5,'':0.5],[],BodyList),-1e20)|CL0]):- 1904 functor(A,F,AA), 1905 findall(FB/AB,Mod:determination(F/AA,FB/AB),Det), 1906 get_modeb(Det,Mod,[],BL), 1907 A=..[F|ArgsTypes], 1908 H=..[F,M|Args], 1909 Mod:local_setting(d,D), 1910 cycle_modeb(ArgsTypes,Args,[],[],Mod,BL,a,[],BLout0,D,M), 1911 variabilize(([(H,A)]:-BLout0),CLV), %+(Head):-Bodylist; -CLV:(Head):-Bodylist with variables _num in place of constants 1912 CLV=([Head1]:-BodyList1), 1913 remove_int_atom(Head1,Head), 1914 remove_int_atom_list(BodyList1,BodyList2), 1915 remove_duplicates(BodyList2,BodyList), 1916 get_next_rule_number(Mod,R), 1917 copy_term((Head,BodyList),(HeadV,BodyListV)), 1918 numbervars((HeadV,BodyListV),0,_V), 1919 format2(Mod,"Bottom clause: example ~q~nClause~n~q:0.5 :-~n",[H,HeadV]), 1920 write_body2(Mod,user_output,BodyListV), 1921 generate_body(T,Mod,CL0). 1922 1923 1924 1925 1926 1927remove_int_atom_list([],[]). 1928 1929remove_int_atom_list([\+ A|T],[\+ A1|T1]):-!, 1930 A=..[F,_|Arg], 1931 A1=..[F|Arg], 1932 remove_int_atom_list(T,T1). 1933 1934remove_int_atom_list([A|T],[A1|T1]):- 1935 A=..[F,_|Arg], 1936 A1=..[F|Arg], 1937 remove_int_atom_list(T,T1). 1938 1939 1940 1941remove_int_atom(\+ A,\+ A1):-!, 1942 A=..[F,_|T], 1943 A1=..[F|T]. 1944 1945remove_int_atom(A,A1):- 1946 A=..[F,_|T], 1947 A1=..[F|T]. 1948 1949 1950 1951variabilize((H:-B),(H1:-B1)):- 1952 variabilize_list(H,H1,[],AS,M), 1953 variabilize_list(B,B1,AS,_AS,M). 1954 1955 1956variabilize_list([],[],A,A,_M). 1957 1958variabilize_list([(\+ H,Mode)|T],[\+ H1|T1],A0,A,M):- 1959 builtin(H),!, 1960 H=..[F|Args], 1961 Mode=..[F|ArgTypes], 1962 variabilize_args(Args,ArgTypes, Args1,A0,A1), 1963 H1=..[F,M|Args1], 1964 variabilize_list(T,T1,A1,A,M). 1965 1966variabilize_list([(\+ H,Mode)|T],[\+ H1|T1],A0,A,M):-!, 1967 H=..[F,_M|Args], 1968 Mode=..[F|ArgTypes], 1969 variabilize_args(Args,ArgTypes, Args1,A0,A1), 1970 H1=..[F,M|Args1], 1971 variabilize_list(T,T1,A1,A,M). 1972 1973variabilize_list([(H,Mode)|T],[H1|T1],A0,A,M):- 1974 builtin(H),!, 1975 H=..[F|Args], 1976 Mode=..[F|ArgTypes], 1977 variabilize_args(Args,ArgTypes, Args1,A0,A1), 1978 H1=..[F,M|Args1], 1979 variabilize_list(T,T1,A1,A,M). 1980 1981variabilize_list([(H,Mode)|T],[H1|T1],A0,A,M):- 1982 H=..[F,_M|Args], 1983 Mode=..[F|ArgTypes], 1984 variabilize_args(Args,ArgTypes, Args1,A0,A1), 1985 H1=..[F,M|Args1], 1986 variabilize_list(T,T1,A1,A,M). 1987 1988 1989variabilize_args([],[],[],A,A). 1990 1991variabilize_args([C|T],[C|TT],[C|TV],A0,A):-!, 1992 variabilize_args(T,TT,TV,A0,A). 1993 1994variabilize_args([C|T],[# _Ty|TT],[C|TV],A0,A):-!, 1995 variabilize_args(T,TT,TV,A0,A). 1996 1997variabilize_args([C|T],[-# _Ty|TT],[C|TV],A0,A):-!, 1998 variabilize_args(T,TT,TV,A0,A). 1999 2000variabilize_args([C|T],[Ty|TT],[V|TV],A0,A):- 2001 (Ty = +Ty1;Ty = -Ty1), 2002 member(C/Ty1/V,A0),!, 2003 variabilize_args(T,TT,TV,A0,A). 2004 2005variabilize_args([C|T],[Ty|TT],[V|TV],A0,A):- 2006 (Ty = +Ty1;Ty = -Ty1),!, 2007 variabilize_args(T,TT,TV,[C/Ty1/V|A0],A). 2008 2009variabilize_args([C|T],[Ty|TT],[V|TV],A0,A):- 2010 compound(C), 2011 C=..[F|Args], 2012 Ty=..[F|ArgsT], 2013 variabilize_args(Args,ArgsT,ArgsV,A0,A1), 2014 V=..[F|ArgsV], 2015 variabilize_args(T,TT,TV,A1,A). 2016 2017 2018cycle_modeb(ArgsTypes,Args,ArgsTypes,Args,_Mod,_BL,L,L,L,_,_M):-!. 2019 2020cycle_modeb(_ArgsTypes,_Args,_ArgsTypes1,_Args1,_Mod,_BL,_L,L,L,0,_M):-!. 2021 2022cycle_modeb(ArgsTypes,Args,_ArgsTypes0,_Args0,Mod,BL,_L0,L1,L,D,M):- 2023 find_atoms(BL,Mod,ArgsTypes,Args,ArgsTypes1,Args1,L1,L2,M), 2024 D1 is D-1, 2025 cycle_modeb(ArgsTypes1,Args1,ArgsTypes,Args,Mod,BL,L1,L2,L,D1,M). 2026 2027 2028find_atoms([],_Mod,ArgsTypes,Args,ArgsTypes,Args,L,L,_M). 2029 2030find_atoms([(R,\+ H)|T],Mod,ArgsTypes0,Args0,ArgsTypes,Args,L0,L1,M):-!, 2031 H=..[F|ArgsT], 2032 findall((A,H),instantiate_query_neg(ArgsT,ArgsTypes0,Args0,F,M,A),L), 2033 call_atoms(L,Mod,[],At), 2034 remove_duplicates(At,At1), 2035 ((R = '*' ) -> 2036 R1= +1e20 2037 ; 2038 R1=R 2039 ), 2040 sample(R1,At1,At2), 2041 append(L0,At2,L2), 2042 find_atoms(T,Mod,ArgsTypes0,Args0,ArgsTypes,Args,L2,L1,M). 2043 2044find_atoms([(R,H)|T],Mod,ArgsTypes0,Args0,ArgsTypes,Args,L0,L1,M):- 2045 H=..[F|ArgsT], 2046 findall((A,H),instantiate_query(ArgsT,ArgsTypes0,Args0,F,M,A),L), 2047 call_atoms(L,Mod,[],At), 2048 remove_duplicates(At,At1), 2049 ((R = '*' ) -> 2050 R1= +1e20 2051 ; 2052 R1=R 2053 ), 2054 sample(R1,At1,At2), 2055 extract_output_args(At2,ArgsT,ArgsTypes0,Args0,ArgsTypes1,Args1), 2056 append(L0,At2,L2), 2057 find_atoms(T,Mod,ArgsTypes1,Args1,ArgsTypes,Args,L2,L1,M). 2058 2059 2060call_atoms([],_Mod,A,A). 2061 2062call_atoms([(H,M)|T],Mod,A0,A):- 2063 findall((H,M),Mod:H,L), 2064 append(A0,L,A1), 2065 call_atoms(T,Mod,A1,A). 2066 2067 2068extract_output_args([],_ArgsT,ArgsTypes,Args,ArgsTypes,Args). 2069 2070extract_output_args([(H,_At)|T],ArgsT,ArgsTypes0,Args0,ArgsTypes,Args):- 2071 builtin(H),!, 2072 H=..[_F|ArgsH], 2073 add_const(ArgsH,ArgsT,ArgsTypes0,Args0,ArgsTypes1,Args1), 2074 extract_output_args(T,ArgsT,ArgsTypes1,Args1,ArgsTypes,Args). 2075 2076extract_output_args([(H,_At)|T],ArgsT,ArgsTypes0,Args0,ArgsTypes,Args):- 2077 H=..[_F,_M|ArgsH], 2078 add_const(ArgsH,ArgsT,ArgsTypes0,Args0,ArgsTypes1,Args1), 2079 extract_output_args(T,ArgsT,ArgsTypes1,Args1,ArgsTypes,Args). 2080 2081 2082add_const([],[],ArgsTypes,Args,ArgsTypes,Args). 2083 2084add_const([_A|T],[+_T|TT],ArgsTypes0,Args0,ArgsTypes,Args):-!, 2085 add_const(T,TT,ArgsTypes0,Args0,ArgsTypes,Args). 2086 2087add_const([A|T],[-Type|TT],ArgsTypes0,Args0,ArgsTypes,Args):-!, 2088 (already_present(ArgsTypes0,Args0,A,Type)-> 2089 ArgsTypes1=ArgsTypes0, 2090 Args1=Args0 2091 ; 2092 ArgsTypes1=[+Type|ArgsTypes0], 2093 Args1=[A|Args0] 2094 ), 2095 add_const(T,TT,ArgsTypes1,Args1,ArgsTypes,Args). 2096 2097add_const([A|T],[-# Type|TT],ArgsTypes0,Args0,ArgsTypes,Args):-!, 2098 (already_present(ArgsTypes0,Args0,A,Type)-> 2099 ArgsTypes1=ArgsTypes0, 2100 Args1=Args0 2101 ; 2102 ArgsTypes1=[+Type|ArgsTypes0], 2103 Args1=[A|Args0] 2104 ), 2105 add_const(T,TT,ArgsTypes1,Args1,ArgsTypes,Args). 2106 2107add_const([_A|T],[# _|TT],ArgsTypes0,Args0,ArgsTypes,Args):-!, 2108 add_const(T,TT,ArgsTypes0,Args0,ArgsTypes,Args). 2109 2110add_const([A|T],[A|TT],ArgsTypes0,Args0,ArgsTypes,Args):- 2111 atomic(A),!, 2112 add_const(T,TT,ArgsTypes0,Args0,ArgsTypes,Args). 2113 2114add_const([A|T],[AT|TT],ArgsTypes0,Args0,ArgsTypes,Args):- 2115 A=..[F|Ar], 2116 AT=..[F|ArT], 2117 add_const(Ar,ArT,ArgsTypes0,Args0,ArgsTypes1,Args1), 2118 add_const(T,TT,ArgsTypes1,Args1,ArgsTypes,Args). 2119 2120 2121already_present([+T|_TT],[C|_TC],C,T):-!. 2122 2123already_present([_|TT],[_|TC],C,T):- 2124 already_present(TT,TC,C,T). 2125 2126 2127instantiate_query_neg(ArgsT,ArgsTypes,Args,F,M,A):- 2128 instantiate_input(ArgsT,ArgsTypes,Args,ArgsB), 2129 A1=..[F|ArgsB], 2130 (builtin(A1)-> 2131 A= (\+ A1) 2132 ; 2133 A0=..[F,M|ArgsB], 2134 A = (\+ A0) 2135 ). 2136 2137instantiate_query(ArgsT,ArgsTypes,Args,F,M,A):- 2138 instantiate_input(ArgsT,ArgsTypes,Args,ArgsB), 2139 A1=..[F|ArgsB], 2140 (builtin(A1)-> 2141 A=A1 2142 ; 2143 A=..[F,M|ArgsB] 2144 ). 2145 2146 2147instantiate_input([],_AT,_A,[]). 2148 2149instantiate_input([-_Type|T],AT,A,[_V|TA]):-!, 2150 instantiate_input(T,AT,A,TA). 2151 2152instantiate_input([+Type|T],AT,A,[H|TA]):-!, 2153 find_val(AT,A,+Type,H), 2154 instantiate_input(T,AT,A,TA). 2155 2156instantiate_input([# Type|T],AT,A,[H|TA]):-!, 2157 find_val(AT,A,+Type,H), 2158 instantiate_input(T,AT,A,TA). 2159 2160instantiate_input([-# _Type|T],AT,A,[_V|TA]):-!, 2161 instantiate_input(T,AT,A,TA). 2162 2163instantiate_input([C|T],AT,A,[C1|TA]):- 2164 C=..[F|Args], 2165 instantiate_input(Args,AT,A,Args1), 2166 C1=..[F|Args1], 2167 instantiate_input(T,AT,A,TA). 2168 2169 2170find_val([T|_TT],[A|_TA],T,A). 2171 2172find_val([HT|_TT],[HA|_TA],T,A):- 2173 nonvar(HA), 2174 HT=..[F|ArgsT], 2175 HA=..[F|Args], 2176 find_val(ArgsT,Args,T,A). 2177 2178find_val([_T|TT],[_A|TA],T,A):- 2179 find_val(TT,TA,T,A). 2180 2181 2182get_output_atoms(O,M):- 2183 findall((A/Ar),M:output((A/Ar)),O). 2184 2185 2186generate_goal([],_M,_H,G,G):-!. 2187 2188generate_goal([P/A|T],M,H,G0,G1):- 2189 functor(Pred,P,A), 2190 Pred=..[P|Rest], 2191 Pred1=..[P,H|Rest], 2192 findall(Pred1,call(M:Pred1),L), 2193 findall(\+ Pred1,call(M:neg(Pred1)),LN), 2194 append(G0,L,G2), 2195 append(G2,LN,G3), 2196 generate_goal(T,M,H,G3,G1). 2197 2198remove_duplicates(L0,L):- 2199 remove_duplicates(L0,[],L1), 2200 reverse(L1,L). 2201 2202remove_duplicates([],L,L). 2203 2204remove_duplicates([H|T],L0,L):- 2205 member_eq(H,L0),!, 2206 remove_duplicates(T,L0,L). 2207 2208remove_duplicates([H|T],L0,L):- 2209 remove_duplicates(T,[H|L0],L). 2210 2211 2212 2213 2214 2215banned_clause(M,H,B):- 2216 numbervars((H,B),0,_N), 2217 M:banned(H2,B2), 2218 mysublist(H2,H), 2219 mysublist(B2,B). 2220 2221 2222mysublist([],_). 2223 2224mysublist([H|T],L):- 2225 member(H,L), 2226 mysublist(T,L). 2227 2228 2229 2230 2231remove_prob(['':_P],[]):-!. 2232 2233remove_prob([X:_|R],[X|R1]):- 2234 remove_prob(R,R1). 2235 2236 2237convert_to_input_vars([],[]):-!. 2238 2239convert_to_input_vars([+T|RT],[+T|RT1]):- 2240 !, 2241 convert_to_input_vars(RT,RT1). 2242 2243convert_to_input_vars([-T|RT],[+T|RT1]):- 2244 convert_to_input_vars(RT,RT1). 2245 2246 2247 2248remove_eq(X,[Y|R],R):- 2249 X == Y, 2250 !. 2251 2252remove_eq(X,[_|R],R1):- 2253 remove_eq(X,R,R1). 2254 2255 2256 2257 2258input_variables(\+ LitM,M,InputVars):- 2259 !, 2260 LitM=..[P|Args], 2261 length(Args,LA), 2262 length(Args1,LA), 2263 Lit1=..[P|Args1], 2264 M:modeb(_,Lit1), 2265 Lit1 =.. [P|Args1], 2266 convert_to_input_vars(Args1,Args2), 2267 Lit2 =.. [P|Args2], 2268 input_vars(LitM,Lit2,InputVars). 2269 2270input_variables(LitM,M,InputVars):- 2271 LitM=..[P|Args], 2272 length(Args,LA), 2273 length(Args1,LA), 2274 Lit1=..[P|Args1], 2275 M:modeb(_,Lit1), 2276 input_vars(LitM,Lit1,InputVars). 2277 2278input_variables(LitM,M,InputVars):- 2279 LitM=..[P|Args], 2280 length(Args,LA), 2281 length(Args1,LA), 2282 Lit1=..[P|Args1], 2283 M:modeh(_,Lit1), 2284 input_vars(LitM,Lit1,InputVars). 2285 2286input_vars(Lit,Lit1,InputVars):- 2287 Lit =.. [_|Vars], 2288 Lit1 =.. [_|Types], 2289 input_vars1(Vars,Types,InputVars). 2290 2291 2292input_vars1([],_,[]). 2293 2294input_vars1([V|RV],[+_T|RT],[V|RV1]):- 2295 !, 2296 input_vars1(RV,RT,RV1). 2297 2298input_vars1([_V|RV],[_|RT],RV1):- 2299 input_vars1(RV,RT,RV1). 2300 2301 2302exctract_type_vars([],_M,[]). 2303 2304exctract_type_vars([Lit|RestLit],M,TypeVars):- 2305 Lit =.. [Pred|Args], 2306 length(Args,L), 2307 length(Args1,L), 2308 Lit1 =.. [Pred|Args1], 2309 take_mode(M,Lit1), 2310 type_vars(Args,Args1,Types), 2311 exctract_type_vars(RestLit,M,TypeVars0), 2312 !, 2313 append(Types,TypeVars0,TypeVars). 2314 2315 2316take_mode(M,Lit):- 2317 M:modeh(_,Lit),!. 2318 2319take_mode(M,Lit):- 2320 M:modeb(_,Lit),!. 2321 2322take_mode(M,Lit):- 2323 M:mode(_,Lit),!. 2324 2325 2326type_vars([],[],[]). 2327 2328type_vars([V|RV],[+T|RT],[V=T|RTV]):- 2329 !, 2330 type_vars(RV,RT,RTV). 2331 2332type_vars([V|RV],[-T|RT],[V=T|RTV]):-atom(T),!, 2333 type_vars(RV,RT,RTV). 2334 2335type_vars([_V|RV],[_T|RT],RTV):- 2336 type_vars(RV,RT,RTV). 2337 2338 2339take_var_args([],_,[]). 2340 2341take_var_args([+T|RT],TypeVars,[V|RV]):- 2342 !, 2343 member(V=T,TypeVars), 2344 take_var_args(RT,TypeVars,RV). 2345 2346take_var_args([-T|RT],TypeVars,[_V|RV]):- 2347 atom(T), 2348 take_var_args(RT,TypeVars,RV). 2349 2350take_var_args([-T|RT],TypeVars,[V|RV]):- 2351 member(V=T,TypeVars), 2352 take_var_args(RT,TypeVars,RV). 2353 2354take_var_args([T|RT],TypeVars,[T|RV]):- 2355 T\= + _,(T\= - _; T= - A,number(A)), 2356 take_var_args(RT,TypeVars,RV). 2357 2358 2359 2360add_probs([],['':P],P):-!. 2361 2362add_probs([H|T],[H:P|T1],P):- 2363 add_probs(T,T1,P). 2364 2365 2366extract_fancy_vars(List,Vars):- 2367 term_variables(List,Vars0), 2368 fancy_vars(Vars0,1,Vars). 2369 2370 2371fancy_vars([],_,[]). 2372 2373fancy_vars([X|R],N,[NN2=X|R1]):- 2374 name(N,NN), 2375 append([86],NN,NN1), 2376 name(NN2,NN1), 2377 N1 is N + 1, 2378 fancy_vars(R,N1,R1). 2379 2380 2381delete_one([X|R],R,X). 2382 2383delete_one([X|R],[X|R1],D):- 2384 delete_one(R,R1,D). 2385 2386 2387 2388make_dynamic(M):- 2389 M:(dynamic int/1), 2390 findall(O,M:output(O),LO), 2391 findall(I,M:input(I),LI), 2392 %findall(I,M:input_cw(I),LIC), 2393 findall(D,M:determination(D,_DD),LDH), 2394 findall(DD,M:determination(_D,DD),LDD), 2395 findall(DH,(M:modeh(_,_,_,LD),member(DH,LD)),LDDH), 2396 %append([LO,LI,LIC,LDH,LDD,LDDH],L0), 2397 append([LO,LI,LDH,LDD,LDDH],L0), 2398 remove_duplicates(L0,L), 2399 maplist(to_dyn(M),L). 2400 2401to_dyn(M,P/A):- 2402 %atomic_concat(P, ' tabled',PT), 2403 A1 is A+1, 2404 M:(dynamic P/A1), 2405 A2 is A1+1, 2406 M:(dynamic P/A2), 2407 %M:(dynamic PT/A2), 2408 A3 is A2+1, 2409 M:(dynamic P/A3). 2410 % M:(dynamic PT/A3). 2411 2412 2413%Computation of the depth of the variables in the clause head/body 2414dv(H,B,M,DV1):- %DV1: returns a list of couples (Variable, Max depth) 2415 term_variables(H,V), 2416 head_depth(V,DV0), 2417 findall((MD-DV),var_depth(B,M,DV0,DV,0,MD),LDs), 2418 get_max(LDs,-1,-,DV1). 2419 2420 2421input_variables_b(\+ LitM,M,InputVars):-!, 2422 LitM=..[P|Args], 2423 length(Args,LA), 2424 length(Args1,LA), 2425 Lit1=..[P|Args1], 2426 M:modeb(_,Lit1), 2427 all_plus(Lit1), 2428 input_vars(LitM,Lit1,InputVars). 2429 2430input_variables_b(LitM,M,InputVars):- 2431 LitM=..[P|Args], 2432 length(Args,LA), 2433 length(Args1,LA), 2434 Lit1=..[P|Args1], 2435 M:modeb(_,Lit1), 2436 input_vars(LitM,Lit1,InputVars). 2437 2438 2439 2440%associates depth 0 to each variable in the clause head 2441head_depth([],[]). 2442head_depth([V|R],[[V,0]|R1]):- 2443 head_depth(R,R1). 2444 2445%associates a depth to each variable in the clause body 2446var_depth([],_M,PrevDs1,PrevDs1,MD,MD):-!. 2447 2448var_depth([L|R],M,PrevDs,PrevDs1,_MD,MD):- %L = a body literal, MD = maximum depth set by the user 2449 input_variables_b(L,M,InputVars), 2450 term_variables(L, BodyAtomVars), 2451 output_vars(BodyAtomVars,InputVars,OutputVars), 2452 depth_InputVars(InputVars,PrevDs,0,MaxD), %MaxD: maximum depth of the input variables in the body literal 2453 D is MaxD+1, 2454 compute_depth(OutputVars,D,PrevDs,PrevDs0), %Computes the depth for the output variables in the body literal 2455 var_depth(R,M,PrevDs0,PrevDs1,D,MD). 2456 2457get_max([],_,Ds,Ds). 2458 2459get_max([(MD-DsH)|T],MD0,_Ds0,Ds):- 2460 MD>MD0,!, 2461 get_max(T,MD,DsH,Ds). 2462 2463get_max([_H|T],MD,Ds0,Ds):- 2464 get_max(T,MD,Ds0,Ds). 2465 2466delete_eq([],_E,[]). 2467 2468delete_eq([H|T],E,T1):- 2469 H==E,!, 2470 delete_eq(T,E,T1). 2471 2472delete_eq([H|T],E,[H|T1]):- 2473 delete_eq(T,E,T1). 2474 2475output_vars(OutVars,[],OutVars):-!. 2476output_vars(BodyAtomVars,[I|InputVars],OutVars):- 2477 delete_eq(BodyAtomVars, I, Residue), 2478 output_vars(Residue,InputVars, OutVars). 2479 2480% returns D as the maximum depth of the variables in the list (first argument) 2481depth_InputVars([],_,D,D). 2482depth_InputVars([I|Input],PrevDs,D0,D):- 2483 member_l(PrevDs,I,MD), 2484 (MD>D0-> 2485 D1=MD 2486 ; 2487 D1=D0 2488 ), 2489 depth_InputVars(Input,PrevDs,D1,D). 2490 2491member_l([[L,D]|_P],I,D):- 2492 I==L,!. 2493member_l([_|P],I,D):- 2494 member_l(P,I,D). 2495 2496compute_depth([],_,PD,PD):-!. 2497compute_depth([O|Output],D,PD,RestO):- 2498 member_l(PD,O,_),!, 2499 compute_depth(Output,D,PD,RestO). 2500 2501compute_depth([O|Output],D,PD,[[O,D]|RestO]):- 2502 compute_depth(Output,D,PD,RestO). 2503 2504 2505 2506assert_all([],_M,[]). 2507 2508assert_all([H|T],M,[HRef|TRef]):- 2509 assertz(M:,HRef), 2510 assert_all(T,M,TRef). 2511 2512assert_all([],[]). 2513 2514assert_all([H|T],[HRef|TRef]):- 2515 assertz(phil:,HRef), 2516 assert_all(T,TRef). 2517 2518/* 2519retract_all([],_):-!. 2520 2521retract_all([H|T],M):- 2522 erase(M,H), 2523 retract_all(T,M). */ 2524 2525retract_all([]):-!. 2526 2527retract_all([H|T]):- 2528 erase(H), 2529 retract_all(T). 2530 2531 2532read_clauses_dir(S,[Cl|Out]):- 2533 read_term(S,Cl,[]), 2534 (Cl=end_of_file-> 2535 Out=[] 2536 ; 2537 read_clauses_dir(S,Out) 2538 ). 2539 2540process_clauses([],_M,C,C,R,R):-!. 2541 2542process_clauses([end_of_file],_M,C,C,R,R):-!. 2543 2544process_clauses([H|T],M,C0,C1,R0,R1):- 2545 (term_expansion_int(H,M,H1)-> 2546 true 2547 ; 2548 H1=(H,[]) 2549 ), 2550 (H1=([_|_],R)-> 2551 H1=(List,R), 2552 append(C0,List,C2), 2553 append(R0,R,R2) 2554 ; 2555 (H1=([],_R)-> 2556 C2=C0, 2557 R2=R0 2558 ; 2559 H1=(H2,R), 2560 append(C0,[H2],C2), 2561 append(R0,R,R2) 2562 ) 2563 ), 2564 process_clauses(T,M,C2,C1,R2,R1). 2565 2566 2567get_next_rule_number(M,R):- 2568 retract(M:rule_sc_n(R)), 2569 R1 is R+1, 2570 assert(M:rule_sc_n(R1)). 2571/* 2572get_node(\+ Goal,M,AC):- 2573 M:local_setting(depth_bound,true),!, 2574 M:local_setting(depth,DB), 2575 retractall(M:v(_,_,_)), 2576 add_ac_arg_db(Goal,B,DB,Goal1), 2577 (M:Goal1-> 2578 ac_notc(B,(_,AC)) 2579 ; 2580 zeroc((_,AC)) 2581 ). 2582 2583get_node(\+ Goal,M,AC):-!, 2584 retractall(M:v(_,_,_)), 2585 add_ac_arg(Goal,B,Goal1), 2586 (M:Goal1-> 2587 ac_notc(B,(_,AC)) 2588 ; 2589 zeroc((_,AC)) 2590 ). 2591 2592get_node(Goal,M,AC):- 2593 M:local_setting(depth_bound,true),!, 2594 M:local_setting(depth,DB), 2595 retractall(M:v(_,_,_)), 2596 add_ac_arg_db(Goal,B,DB,Goal1),%DB=depth bound 2597 (M:Goal1-> 2598 (_,AC)=B 2599 ; 2600 zeroc((_,AC)) 2601 ). 2602 2603get_node(Goal,M,AC):- %with DB=false 2604 retractall(M:v(_,_,_)), 2605 add_ac_arg(Goal,B,Goal1), 2606 (M:Goal1-> 2607 (_,AC)=B 2608 ; 2609 zeroc((_,AC)) 2610 ). 2611*/ 2612 2613get_node(\+ Goal,M,AC):- 2614 M:local_setting(depth_bound,true),!, 2615 M:local_setting(depth,DB), 2616 retractall(M:v(_,_,_)), 2617 abolish_all_tables, 2618 add_ac_arg_db(Goal,C,DB,Goal1), 2619 (M:Goal1-> 2620 B=C 2621 ; 2622 zeroc(B) 2623 ), 2624 ac_notc(B,AC). 2625 2626get_node(\+ Goal,M,AC):-!, 2627 retractall(M:v(_,_,_)), 2628 abolish_all_tables, 2629 add_ac_arg(Goal,C,Goal1), 2630 (M:Goal1-> 2631 B=C 2632 ; 2633 zeroc(B) 2634 ), 2635 ac_notc(B,AC). 2636 2637get_node(Goal,M,B):- 2638 M:local_setting(depth_bound,true),!, 2639 M:local_setting(depth,DB), 2640 retractall(M:v(_,_,_)), 2641 abolish_all_tables, 2642 add_ac_arg_db(Goal,AC,DB,Goal1),%DB=depth bound 2643 (M:Goal1-> 2644 B=AC 2645 ; 2646 zeroc(B) 2647 ). 2648 2649get_node(Goal,M,B):- %with DB=false 2650 retractall(M:v(_,_,_)), 2651 add_ac_arg(Goal,AC,Goal1), 2652 abolish_all_tables, 2653 (M:Goal1-> 2654 B=AC 2655 ; 2656 zeroc(B) 2657 ). 2658 2659 2660add_ac_arg(A,AC,A1):- 2661 A=..[P|Args], 2662 append(Args,[AC],Args1), 2663 A1=..[P|Args1]. 2664 2665 2666add_ac_arg_db(A,AC,DB,A1):- 2667 A=..[P|Args], 2668 append(Args,[DB,AC],Args1), 2669 A1=..[P|Args1]. 2670 2671 2672add_ac_arg(A,AC,Module,A1):- 2673 A=..[P|Args], 2674 append(Args,[AC],Args1), 2675 A1=..[P,Module|Args1]. 2676 2677 2678add_ac_arg_db(A,AC,DB,Module,A1):- 2679 A=..[P|Args], 2680 append(Args,[DB,AC],Args1), 2681 A1=..[P,Module|Args1]. 2682 2683add_mod_arg(A,Module,A1):- 2684 A=..[P|Args], 2685 A1=..[P,Module|Args]. 2686 2687 2688generate_rules_fact([],_VC,_R,_Probs,_N,[],_Module,_M). 2689 2690generate_rules_fact([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module,M):-!, 2691 add_ac_arg(Head,AC,Module,Head1), 2692 Clause=(Head1:-(phil:get_var_n(M,R,VC,Probs,V),phil:equalityc(V,N,AC))). 2693 2694generate_rules_fact([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module,M):- 2695 add_ac_arg(Head,AC,Module,Head1), 2696 Clause=(Head1:-(phil:get_var_n(M,R,VC,Probs,V),phil:equalityc(V,N,AC))), 2697 N1 is N+1, 2698 generate_rules_fact(T,VC,R,Probs,N1,Clauses,Module,M). 2699 2700 2701generate_rules_fact_db([],_VC,_R,_Probs,_N,[],_Module,_M). 2702 2703generate_rules_fact_db([Head:_P1,'':_P2],VC,R,Probs,N,[Clause],Module,M):-!, 2704 add_ac_arg_db(Head,AC,_DB,Module,Head1), 2705 Clause=(Head1:-(phil:get_var_n(M,R,VC,Probs,V),phil:equalityc(V,N,AC))). 2706 2707generate_rules_fact_db([Head:_P|T],VC,R,Probs,N,[Clause|Clauses],Module,M):- 2708 add_ac_arg_db(Head,AC,_DB,Module,Head1), 2709 Clause=(Head1:-(phil:get_var_n(M,R,VC,Probs,V),phil:equalityc(V,N,AC))), 2710 N1 is N+1, 2711 generate_rules_fact_db(T,VC,R,Probs,N1,Clauses,Module,M). 2712 2713 2714generate_clause(Head,Body,_VC,_R,_Probs,ACAnd,_N,Clause,Module,_M):- 2715 add_ac_arg(Head,or([ACAnd]),Module,Head1), 2716 Clause=(Head1:-Body). 2717 2718 2719generate_clause_db(Head,Body,_VC,_R,_Probs,DB,ACAnd,_N,Clause,Module,_M):- 2720 add_ac_arg_db(Head,or([ACAnd]),DBH,Module,Head1), 2721 Clause=(Head1:-(DBH>=1,DB is DBH-1,Body)). 2722 2723 2724generate_rules([],_Body,_VC,_R,_Probs,_ACAnd,_N,[],_Module,_M). 2725 2726generate_rules([Head:_P1,'':_P2],Body,VC,R,Probs,ACAnd,N,[Clause],Module,M):-!, 2727 generate_clause(Head,Body,VC,R,Probs,ACAnd,N,Clause,Module,M). 2728 2729generate_rules([Head:_P|T],Body,VC,R,Probs,ACAnd,N,[Clause|Clauses],Module,M):- 2730 generate_clause(Head,Body,VC,R,Probs,ACAnd,N,Clause,Module,M), 2731 N1 is N+1, 2732 generate_rules(T,Body,VC,R,Probs,ACAnd,N1,Clauses,Module,M). 2733 2734 2735generate_rules_db([],_Body,_VC,_R,_Probs,_DB,_ACAnd,_N,[],_Module,_M):-!. 2736 2737generate_rules_db([Head:_P1,'':_P2],Body,VC,R,Probs,DB,ACAnd,N,[Clause],Module,M):-!, 2738 generate_clause_db(Head,Body,VC,R,Probs,DB,ACAnd,N,Clause,Module,M). 2739 2740generate_rules_db([Head:_P|T],Body,VC,R,Probs,DB,ACAnd,N,[Clause|Clauses],Module,M):- 2741 generate_clause_db(Head,Body,VC,R,Probs,DB,ACAnd,N,Clause,Module,M),!,%agg.cut 2742 N1 is N+1, 2743 generate_rules_db(T,Body,VC,R,Probs,DB,ACAnd,N1,Clauses,Module,M). 2744 2745process_body_bg([],[],_Module). 2746 2747process_body_bg([\+ H|T],[\+ H|Rest],Module):- 2748 builtin(H),!, 2749 process_body_bg(T,Rest,Module). 2750 2751process_body_bg([\+ H|T],[\+ H1|Rest],Module):-!, 2752 add_mod_arg(H,Module,H1), 2753 process_body_bg(T,Rest,Module). 2754 2755process_body_bg([H|T],[H|Rest],Module):- 2756 builtin(H),!, 2757 process_body_bg(T,Rest,Module). 2758 2759process_body_bg([H|T],[H1|Rest],Module):-!, 2760 add_mod_arg(H,Module,H1), 2761 process_body_bg(T,Rest,Module). 2762 2763 2764 2765 2766process_body([],AC,AC,Vars,Vars,[],_Module,_M):-!. 2767 2768process_body([\+ H|T],AC,AC1,Vars,Vars1,[\+ H|Rest],Module,M):- 2769 builtin(H),!, 2770 process_body(T,AC,AC1,Vars,Vars1,Rest,Module,M). 2771 2772process_body([\+ H|T],AC,AC1,Vars,Vars1,[ 2773 neg(H1)|Rest],Module,M):- 2774 given_cw(M,H),!, 2775 add_mod_arg(H,Module,H1), 2776 process_body(T,AC,AC1,Vars,Vars1,Rest,Module,M). 2777 2778process_body([\+ H|T],AC,AC1,Vars,[ACH,ACN,AC2|Vars1], 2779[H1,phil:ac_notc(ACH,ACN), 2780 phil:andc(AC,ACN,AC2)|Rest],Module,M):-!, 2781 add_ac_arg(H,ACH,Module,H1), 2782 process_body(T,AC2,AC1,Vars,Vars1,Rest,Module,M). 2783 2784process_body([H|T],AC,AC1,Vars,Vars1,[H|Rest],Module,M):- 2785 builtin(H),!, 2786 process_body(T,AC,AC1,Vars,Vars1,Rest,Module,M). 2787 2788process_body([H|T],AC,AC1,Vars,Vars1, 2789[H1|Rest],Module,M):- 2790 given_cw(M,H),!, 2791 add_mod_arg(H,Module,H1), 2792 process_body(T,AC,AC1,Vars,Vars1,Rest,Module,M). 2793 2794process_body([H|T],AC,AC1,Vars,[ACH,AC2|Vars1], 2795[H1,phil:andc(AC,ACH,AC2)|Rest],Module,M):-!, %agg. cut 2796 add_ac_arg(H,ACH,Module,H1), 2797 process_body(T,AC2,AC1,Vars,Vars1,Rest,Module,M). 2798 2799process_body_db([],AC,AC,_DB,Vars,Vars,[],_Module,_M):-!. 2800 2801process_body_db([\+ H|T],AC,AC1,DB,Vars,Vars1,[\+ H|Rest],Module,M):- 2802 builtin(H),!, 2803 process_body_db(T,AC,AC1,DB,Vars,Vars1,Rest,Module,M). 2804 2805process_body_db([\+ H|T],AC,AC1,DB,Vars,Vars1,[ 2806 neg(H1)|Rest],Module,M):- 2807 given_cw(M,H),!, 2808 add_mod_arg(H,Module,H1), 2809 process_body_db(T,AC,AC1,DB,Vars,Vars1,Rest,Module,M). 2810 2811process_body_db([\+ H|T],AC,AC1,DB,Vars,[ACH,ACN,AC2|Vars1], 2812[H1,phil:ac_notc(ACH,ACN), 2813 phil:andc(AC,ACN,AC2)|Rest],Module,M):-!, 2814 add_ac_arg_db(H,ACH,DB,Module,H1), 2815 process_body_db(T,AC2,AC1,DB,Vars,Vars1,Rest,Module,M). 2816 2817process_body_db([H|T],AC,AC1,DB,Vars,Vars1,[H|Rest],Module,M):- 2818 builtin(H),!, 2819 process_body_db(T,AC,AC1,DB,Vars,Vars1,Rest,Module,M). 2820 2821process_body_db([H|T],AC,AC1,DB,Vars,Vars1, 2822[H1|Rest],Module,M):- 2823 given_cw(M,H),!, 2824 add_mod_arg(H,Module,H1), 2825 process_body_db(T,AC,AC1,DB,Vars,Vars1,Rest,Module,M). 2826 2827process_body_db([H|T],AC,AC1,DB,Vars,[ACH,AC2|Vars1], 2828[H1,phil:andc(AC,ACH,AC2)|Rest],Module,M):-!, %agg. cut 2829 add_ac_arg_db(H,ACH,DB,Module,H1), 2830 process_body_db(T,AC2,AC1,DB,Vars,Vars1,Rest,Module,M). 2831 2832 2833 2834process_body_cw([],AC,AC,Vars,Vars,[],_Module). 2835 2836process_body_cw([\+ H|T],AC,AC1,Vars,Vars1,[\+ H|Rest],Module):- 2837 builtin(H),!, 2838 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2839 2840process_body_cw([\+ H|T],AC,AC1,Vars,Vars1,[\+ H|Rest],Module):- 2841 db(H),!, 2842 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2843 2844process_body_cw([\+ H|T],AC,AC1,Vars,Vars1,[ 2845 \+(H1)|Rest],Module):- 2846 add_mod_arg(H,Module,H1), 2847 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2848 2849process_body_cw([H|T],AC,AC1,Vars,Vars1,[H|Rest],Module):- 2850 builtin(H),!, 2851 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2852 2853process_body_cw([H|T],AC,AC1,Vars,Vars1,[H|Rest],Module):- 2854 db(H),!, 2855 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2856 2857process_body_cw([H|T],AC,AC1,Vars,Vars1, 2858[H1|Rest],Module):- 2859 add_mod_arg(H,Module,H1), 2860 process_body_cw(T,AC,AC1,Vars,Vars1,Rest,Module). 2861 2862 2863given(M,H):- 2864 functor(H,P,Ar), 2865 (M:input(P/Ar)). 2866 2867 2868given_cw(M,H):- 2869 functor(H,P,Ar), 2870 (M:input(P/Ar)). 2871 %(M:input_cw(P/Ar)). 2872 2873/* 2874and_list([],B,B). 2875 2876and_list([H|T],B0,B1):- 2877 and(B0,H,B2), 2878 and_list(T,B2,B1). 2879*/
2889set_hplp(M:Parameter,Value):-
2890 retract(M:local_setting(Parameter,_)),
2891 assert(M:local_setting(Parameter,Value)).
2901setting_sc(M:P,V):- 2902 M:local_setting(P,V). 2903 2904 2905difference([],_,[]). 2906 2907difference([H|T],L2,L3):- 2908 member_eq(H,L2),!, 2909 difference(T,L2,L3). 2910 2911difference([H|T],L2,[H|L3]):- 2912 difference(T,L2,L3). 2913 2914 2915member_eq(E,[H|_T]):- 2916 E==H,!. 2917 2918member_eq(E,[_H|T]):- 2919 member_eq(E,T). 2920 2921 2922 2923 2924process_head(HeadList,M, GroundHeadList) :- 2925 ground_prob(HeadList), !, 2926 process_head_ground(HeadList,M, 0, GroundHeadList). 2927 2928process_head(HeadList,_M, HeadList). 2929 2930 2931 2932/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null]) 2933 * ---------------------------------------------------------------- 2934 */ 2935process_head_ground([Head:ProbHead],M, Prob, [Head:ProbHead1|Null]) :-!, 2936 ProbHead1 is ProbHead, 2937 ProbLast is 1 - Prob - ProbHead1, 2938 M:local_setting(epsilon_parsing, Eps), 2939 EpsNeg is - Eps, 2940 ProbLast > EpsNeg, 2941 (ProbLast > Eps -> 2942 Null = ['':ProbLast] 2943 ; 2944 Null = [] 2945 ). 2946 2947process_head_ground([Head:ProbHead|Tail], M, Prob, [Head:ProbHead1|Next]) :- 2948 ProbHead1 is ProbHead, 2949 ProbNext is Prob + ProbHead1, 2950 process_head_ground(Tail, M, ProbNext, Next). 2951 2952 2953ground_prob([]). 2954 2955ground_prob([_Head:ProbHead|Tail]) :- 2956 ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead. 2957 ground_prob(Tail). 2958 2959 2960get_probs([], []). 2961 2962get_probs([_H:P|T], [P1|T1]) :- 2963 P1 is P, 2964 get_probs(T, T1). 2965 2966 2967generate_clauses_cw([],_M,[],_N,C,C):-!. 2968 2969generate_clauses_cw([H|T],M,[H1|T1],N,C0,C):- 2970 gen_clause_cw(H,M,N,N1,H1,CL),!, %agg.cut 2971 append(C0,CL,C1), 2972 generate_clauses_cw(T,M,T1,N1,C1,C). 2973 2974to_tabled(M,H0,H):- 2975 (M:tabled(H0)-> 2976 H0=..[P|Args], 2977 %atomic_concat(P, ' tabled',PT), 2978 %H=..[PT|Args] 2979 H=..[P|Args] 2980 ; 2981 H=H0 2982 ). 2983 2984to_tabled_head_list(M,A0:P,A:P):- 2985 to_tabled(M,A0,A). 2986 2987gen_clause_cw((H :- Body),_M,N,N,(H :- Body),[(H1 :- Body)]):- 2988 !, 2989 H1=H. 2990 % phil:to_tabled(H,H1). 2991 2992gen_clause_cw(rule(_R,HeadList,BodyList,Lit),M,N,N1, 2993 rule(N,HeadList,BodyList,Lit),Clauses):-!, 2994% disjunctive clause with more than one head atom senza depth_bound 2995 process_body_cw(BodyList,AC,ACAnd,[],_Vars,BodyList1,Module), 2996 append([phil:onec(AC)],BodyList1,BodyList2), 2997 list2and(BodyList2,Body1), 2998 append(HeadList,BodyList,List), 2999 term_variables(List,VC), 3000 get_probs(HeadList,Probs), 3001 maplist(to_tabled_head_list,M,HeadList,HeadList1), 3002 (M:local_setting(single_var,true)-> 3003 generate_rules(HeadList1,Body1,[],N,Probs,ACAnd,0,Clauses,Module,M) 3004 ; 3005 generate_rules(HeadList1,Body1,VC,N,Probs,ACAnd,0,Clauses,Module,M) 3006 ), 3007 N1 is N+1. 3008 3009gen_clause_cw(def_rule(H,BodyList,Lit),_M,N,N,def_rule(H,BodyList,Lit),Clauses) :- !,%agg. cut 3010% disjunctive clause with a single head atom senza depth_bound con prob =1 3011 process_body_cw(BodyList,AC,ACAnd,[],_Vars,BodyList2,Module), 3012 append([phil:onec(AC)],BodyList2,BodyList3), 3013 list2and(BodyList3,Body1), 3014 add_ac_arg(H,ACAnd,Module,Head1), 3015 %phil:to_tabled(Head1,Head2), 3016 Head2=Head1, 3017 Clauses=[(Head2 :- Body1)]. 3018 3019 3020generate_clauses([],_M,[],_N,C,C):-!. 3021 3022generate_clauses([H|T],M,[H1|T1],N,C0,C):- 3023 gen_clause(H,M,N,N1,H1,CL),!, %agg.cut 3024 append(C0,CL,C1), 3025 generate_clauses(T,M,T1,N1,C1,C). 3026 3027 3028gen_clause((H :- Body),_M,N,N,(H :- Body),[(H1 :- Body)]):- 3029 !, 3030 H1=H. 3031 % phil:to_tabled(H,H1). 3032 3033 3034gen_clause(rule(_R,HeadList,BodyList,Lit),M,N,N1, 3035 rule(N,HeadList,BodyList,Lit),Clauses):- 3036 M:local_setting(depth_bound,true),!, 3037% disjunctive clause with more than one head atom e depth_bound 3038 process_body_db(BodyList,and([N]),ACAnd, DB,[],_Vars,BodyList1,Module,M), 3039 list2and(BodyList1,Body1), 3040 append(HeadList,BodyList,List), 3041 term_variables(List,VC), 3042 get_probs(HeadList,Probs), 3043 maplist(to_tabled_head_list(M),HeadList,HeadList1), 3044 (M:local_setting(single_var,true)-> 3045 generate_rules_db(HeadList1,Body1,[],N,Probs,DB,ACAnd,0,Clauses,Module,M) 3046 ; 3047 generate_rules_db(HeadList1,Body1,VC,N,Probs,DB,ACAnd,0,Clauses,Module,M) 3048 ), 3049 N1 is N+1. 3050 3051gen_clause(rule(_R,HeadList,BodyList,Lit),M,N,N1, 3052 rule(N,HeadList,BodyList,Lit),Clauses):-!, 3053% disjunctive clause with more than one head atom senza depth_bound 3054 process_body(BodyList,and([N]),ACAnd,[],_Vars,BodyList1,Module,M), 3055 list2and(BodyList1,Body1), 3056 append(HeadList,BodyList,List), 3057 term_variables(List,VC), 3058 get_probs(HeadList,Probs), 3059 maplist(to_tabled_head_list(M),HeadList,HeadList1), 3060 (M:local_setting(single_var,true)-> 3061 generate_rules(HeadList1,Body1,[],N,Probs,ACAnd,0,Clauses,Module,M) 3062 ; 3063 generate_rules(HeadList1,Body1,VC,N,Probs,ACAnd,0,Clauses,Module,M) 3064 ), 3065 N1 is N+1. 3066 3067gen_clause(def_rule(H,BodyList,Lit),M,N,N,def_rule(H,BodyList,Lit),Clauses) :- 3068% disjunctive clause with a single head atom e depth_bound 3069 M:local_setting(depth_bound,true),!, 3070 process_body_db(BodyList,AC,ACAnd,DB,[],_Vars,BodyList2,Module,M), 3071 append([phil:onec(AC)],BodyList2,BodyList3), 3072 list2and(BodyList3,Body1), 3073 add_ac_arg_db(H,ACAnd,DBH,Module,Head1), 3074 to_tabled(M,Head1,Head2), 3075 Clauses=[(Head2 :- (DBH>=1,DB is DBH-1,Body1))]. 3076 3077gen_clause(def_rule(H,BodyList,Lit),M,N,N,def_rule(H,BodyList,Lit),Clauses) :- !,%agg. cut 3078% disjunctive clause with a single head atom senza depth_bound con prob =1 3079 process_body(BodyList,AC,ACAnd,[],_Vars,BodyList2,Module,M), 3080 append([phil:onec(AC)],BodyList2,BodyList3), 3081 list2and(BodyList3,Body1), 3082 add_ac_arg(H,ACAnd,Module,Head1), 3083 to_tabled(M,Head1,Head2), 3084 Clauses=[(Head2 :- Body1)]. 3085 3086 3087generate_clauses_bg([],[]):-!. 3088 3089generate_clauses_bg([H|T],[CL|T1]):- 3090 gen_clause_bg(H,CL), %agg.cut 3091 generate_clauses_bg(T,T1). 3092 3093gen_clause_bg(def_rule(H,BodyList,_Lit),Clauses) :- 3094% disjunctive clause with a single head atom e depth_bound 3095 process_body_bg(BodyList,BodyList2,Module), 3096 list2and(BodyList2,Body1), 3097 add_mod_arg(H,Module,Head1), 3098 Clauses=(Head1 :- Body1).
3107builtin(G):- 3108 builtin_int(G),!. 3109 3110builtin_int(average(_L,_Av)). 3111builtin_int(G):- 3112 predicate_property(G,built_in). 3113builtin_int(G):- 3114 predicate_property(G,imported_from(lists)). 3115builtin_int(G):- 3116 predicate_property(G,imported_from(apply)). 3117builtin_int(G):- 3118 predicate_property(G,imported_from(nf_r)). 3119builtin_int(G):- 3120 predicate_property(G,imported_from(matrix)). 3121builtin_int(G):- 3122 predicate_property(G,imported_from(clpfd)). 3123 3124average(L,Av):- 3125 sum_list(L,Sum), 3126 length(L,N), 3127 Av is Sum/N. 3128 3129 3130term_expansion_int((Head :- Body),M, (Clauses,[rule(R,HeadList,BodyList,true)])) :- 3131% disjunctive clause with a single head atom e DB, con prob. diversa da 1 3132 M:local_setting(depth_bound,true), 3133 ((Head:-Body) \= ((system:term_expansion(_,_) ):- _ )), 3134 Head = (H:_), !, 3135 list2or(HeadListOr, Head), 3136 process_head(HeadListOr,M,HeadList), 3137 list2and(BodyList, Body), 3138 process_body_db(BodyList,AC,ACAnd,DB,[],_Vars,BodyList2,Module,M), 3139 append([phil:onec(AC)],BodyList2,BodyList3), 3140 list2and(BodyList3,Body2), 3141 append(HeadList,BodyList,List), 3142 term_variables(List,VC), 3143 get_next_rule_number(M,R), 3144 get_probs(HeadList,Probs),%***test single_var 3145 (M:local_setting(single_var,true)-> 3146 generate_clause_db(H,Body2,[],R,Probs,DB,ACAnd,0,Clauses,Module,M) 3147 ; 3148 generate_clause_db(H,Body2,VC,R,Probs,DB,ACAnd,0,Clauses,Module,M) 3149 ). 3150 3151term_expansion_int((Head :- Body),M, (Clauses,[rule(R,HeadList,BodyList,true)])) :- 3152% disjunctive clause with a single head atom e DB, con prob. diversa da 1 3153 M:local_setting(depth_bound,false), 3154 ((Head:-Body) \= ((system:term_expansion(_,_) ):- _ )), 3155 Head = (H:_), !, 3156 list2or(HeadListOr, Head), 3157 process_head(HeadListOr,M,HeadList), 3158 list2and(BodyList, Body), 3159 process_body(BodyList,AC,ACAnd,[],_Vars,BodyList2,Module,M), 3160 append([phil:onec(AC)],BodyList2,BodyList3), 3161 list2and(BodyList3,Body2), 3162 append(HeadList,BodyList,List), 3163 term_variables(List,VC), 3164 get_next_rule_number(M,R), 3165 get_probs(HeadList,Probs),%***test single_var 3166 (M:local_setting(single_var,true)-> 3167 generate_clause(H,Body2,[],R,Probs,ACAnd,0,Clauses,Module,M) 3168 ; 3169 generate_clause(H,Body2,VC,R,Probs,ACAnd,0,Clauses,Module,M) 3170 ). 3171 3172 3173term_expansion_int((Head :- Body),M,(Clauses,[def_rule(Head,BodyList,true)])) :- 3174 % definite clause senza DB 3175 %M:local_setting(compiling,on), 3176 ((Head:-Body) \= ((system:term_expansion(_,_)) :- _ )),!, 3177 list2and(BodyList, Body), 3178 process_body(BodyList,AC,AC1,[],_Vars,BodyList2,Module,M), 3179 append([phil:onec(AC)],BodyList2,BodyList3), 3180 list2and(BodyList3,Body2), 3181 add_bdd_arg(Head,AC1,Module,Head1), 3182 Clauses=(Head1 :- Body2). 3183 3184 3185 term_expansion_int(Head,M, ((Head1:-phil:onec(Env,One)),[def_rule(Head,[],true)])) :- 3186 M:local_setting(compiling,on), 3187 M:local_setting(depth_bound,true), 3188 %definite fact with db 3189 (Head \= ((system:term_expansion(_,_) ):- _ )), 3190 (Head\= end_of_file),!, 3191 add_bdd_arg_db(Head,Env,One,_DB,_Module,Head1). 3192 3193 term_expansion_int(Head,M, ((Head1:-phil:onec(Env,One)),[def_rule(Head,[],true)])) :- 3194 M:local_setting(compiling,on), 3195 %definite fact without db 3196 (Head \= ((system:term_expansion(_,_) ):- _ )), 3197 (Head\= end_of_file),!, 3198 add_bdd_arg(Head,Env,One,_Module,Head1). 3199 3200 3201 add_bdd_arg_db(A,Env,BDD,DB,A1):- 3202 A=..[P|Args], 3203 append(Args,[DB,Env,BDD],Args1), 3204 A1=..[P|Args1]. 3205 3206 3207 add_bdd_arg(A,Env,BDD,Module,A1):- 3208 A=..[P|Args], 3209 append(Args,[Env,BDD],Args1), 3210 A1=..[P,Module|Args1]. 3211 3212 3213 add_bdd_arg_db(A,Env,BDD,DB,Module,A1):- 3214 A=..[P|Args], 3215 append(Args,[DB,Env,BDD],Args1), 3216 A1=..[P,Module|Args1]. 3217 3218 3219 add_bdd_arg(A,BDD,A1):- 3220 A=..[P|Args], 3221 append(Args,[BDD],Args1), 3222 A1=..[P|Args1]. 3223 3224 3225 add_bdd_arg_db(A,BDD,DB,A1):- 3226 A=..[P|Args], 3227 append(Args,[DB,BDD],Args1), 3228 A1=..[P|Args1]. 3229 3230 3231 add_bdd_arg(A,BDD,Module,A1):- 3232 A=..[P|Args], 3233 append(Args,[BDD],Args1), 3234 A1=..[P,Module|Args1]. 3235 3236 3237/*-----------*/ 3238 3239 3240 3241:- multifile sandbox:safe_meta/2. 3242 3243sandbox:safe_meta(phil:induce_hplp_par(_,_) ,[]). 3244sandbox:safe_meta(phil:induce_hplp(_,_), []). 3245sandbox:safe_meta(phil:get_node(_,_), []). 3246sandbox:safe_meta(phil:test_prob_hplp(_,_,_,_,_,_), []). 3247sandbox:safe_meta(phil:test_hplp(_,_,_,_,_,_,_), []). 3248sandbox:safe_meta(phil:inference_hplp(_,_,_,_), []). 3249sandbox:safe_meta(phil:inference_hplp(_,_,_), []). 3250sandbox:safe_meta(phil:set_hplp(_,_), []). 3251sandbox:safe_meta(phil:setting_hplp(_,_), []). 3252 3253 3254 3255test_no_area(TestSet,M,NPos,NNeg,CLL,Results):- 3256 test_folds(TestSet,M,[],Results,0,NPos,0,NNeg,0,CLL). 3257 3258 3259test_folds([],_M,LG,LG,Pos,Pos,Neg,Neg,CLL,CLL). 3260 3261test_folds([HT|TT],M,LG0,LG,Pos0,Pos,Neg0,Neg,CLL0,CLL):- 3262 test_1fold(HT,M,LG1,Pos1,Neg1,CLL1), 3263 append(LG0,LG1,LG2), 3264 Pos2 is Pos0+Pos1, 3265 Neg2 is Neg0+Neg1, 3266 CLL2 is CLL0+CLL1, 3267 test_folds(TT,M,LG2,LG,Pos2,Pos,Neg2,Neg,CLL2,CLL). 3268 3269test_1fold(F,M,LGOrd,Pos,Neg,CLL1):- 3270 find_ex(F,M,LG,Pos,Neg), 3271 format("Test: Positive examples=~g, Negative examples=~g ~n",[Pos,Neg]), 3272 compute_CLL_atoms(LG,M,0,0,CLL1,LG1,[],Nodes), 3273 M:local_setting(saveArthmeticCircuit,SaveCircuits), 3274 (SaveCircuits=all-> 3275 M:local_setting(testingCircuitFile,CircuitFile), 3276 writefile(Nodes,CircuitFile) 3277 ; 3278 ( SaveCircuits=testing -> 3279 M:local_setting(testingCircuitFile,CircuitFile), 3280 writefile(Nodes,CircuitFile) 3281 ; 3282 true 3283 ) 3284 ), 3285 keysort(LG1,LGOrd). 3286 3287 3288find_ex(DB,M,LG,Pos,Neg):- 3289 findall(P/A,M:output(P/A),LP), 3290 M:local_setting(neg_ex,given),!, 3291 find_ex_pred(LP,M,DB,[],LG,0,Pos,0,Neg). 3292 3293find_ex(DB,M,LG,Pos,Neg):- 3294 findall(P/A,M:output(P/A),LP), 3295 M:local_setting(neg_ex,cw), 3296 find_ex_pred_cw(LP,M,DB,[],LG,0,Pos,0,Neg). 3297 3298 3299find_ex_pred([],_M,_DB,LG,LG,Pos,Pos,Neg,Neg). 3300 3301find_ex_pred([P/A|T],M,DB,LG0,LG,Pos0,Pos,Neg0,Neg):- 3302 functor(At,P,A), 3303 find_ex_db(DB,M,At,LG0,LG1,Pos0,Pos1,Neg0,Neg1), 3304 find_ex_pred(T,M,DB,LG1,LG,Pos1,Pos,Neg1,Neg). 3305 3306find_ex_db([],_M,_At,LG,LG,Pos,Pos,Neg,Neg). 3307 3308find_ex_db([H|T],M,At,LG0,LG,Pos0,Pos,Neg0,Neg):- 3309 At=..[P|L], 3310 At1=..[P,H|L], 3311 findall(At1,M:At1,LP), 3312 findall(\+ At1,M:neg(At1),LN), 3313 length(LP,NP), 3314 length(LN,NN), 3315 append([LG0,LP,LN],LG1), 3316 Pos1 is Pos0+NP, 3317 Neg1 is Neg0+NN, 3318 find_ex_db(T,M,At,LG1,LG,Pos1,Pos,Neg1,Neg). 3319 3320 3321find_ex_pred_cw([],_M,_DB,LG,LG,Pos,Pos,Neg,Neg). 3322 3323find_ex_pred_cw([P/A|T],M,DB,LG0,LG,Pos0,Pos,Neg0,Neg):- 3324 functor(At,P,A), 3325 findall(Types,get_types(At,M,Types),LT), 3326 append(LT,LLT), 3327 remove_duplicates(LLT,Types1), 3328 find_ex_db_cw(DB,M,At,Types1,LG0,LG1,Pos0,Pos1,Neg0,Neg1), 3329 find_ex_pred_cw(T,M,DB,LG1,LG,Pos1,Pos,Neg1,Neg). 3330 3331get_types(At,_M,[]):- 3332 At=..[_],!. 3333 3334get_types(At,M,Types):- 3335 M:modeh(_,At), 3336 At=..[_|Args], 3337 get_args(Args,Types). 3338 3339get_types(At,M,Types):- 3340 M:modeh(_,HT,_,_), 3341 member(At,HT), 3342 At=..[_|Args], 3343 get_args(Args,Types). 3344 3345 3346get_args([],[]). 3347 3348get_args([+H|T],[H|T1]):-!, 3349 get_args(T,T1). 3350 3351get_args([-H|T],[H|T1]):-!, 3352 get_args(T,T1). 3353 3354get_args([#H|T],[H|T1]):-!, 3355 get_args(T,T1). 3356 3357get_args([-#H|T],[H|T1]):-!, 3358 get_args(T,T1). 3359 3360get_args([H|T],[H|T1]):- 3361 get_args(T,T1). 3362 3363 3364 3365 3366get_constants([],_M,_Mod,[]). 3367 3368get_constants([Type|T],M,Mod,[(Type,Co)|C]):- 3369 find_pred_using_type(Type,Mod,LP), 3370 find_constants(LP,M,Mod,[],Co), 3371 get_constants(T,M,Mod,C). 3372 3373find_pred_using_type(T,M,L):- 3374 (setof((P,Ar,A),pred_type(T,M,P,Ar,A),L)-> 3375 true 3376 ; 3377 L=[] 3378 ). 3379 3380pred_type(T,M,P,Ar,A):- 3381 M:modeh(_,S), 3382 S=..[P|Args], 3383 length(Args,Ar), 3384 scan_args(Args,T,1,A). 3385 3386pred_type(T,M,P,Ar,A):- 3387 M:modeb(_,S), 3388 S=..[P|Args], 3389 length(Args,Ar), 3390 scan_args(Args,T,1,A). 3391 3392scan_args([+T|_],T,A,A):-!. 3393 3394scan_args([-T|_],T,A,A):-!. 3395 3396scan_args([#T|_],T,A,A):-!. 3397 3398scan_args([-#T|_],T,A,A):-!. 3399 3400scan_args([_|Tail],T,A0,A):- 3401 A1 is A0+1, 3402 scan_args(Tail,T,A1,A). 3403 3404find_constants([],_M,_Mod,C,C). 3405 3406find_constants([(P,Ar,A)|T],M,Mod,C0,C):- 3407 gen_goal(1,Ar,A,Args,ArgsNoV,V), 3408 G=..[P,M|Args], 3409 (setof(V,ArgsNoV^call_goal(Mod,G),LC)-> 3410 true 3411 ; 3412 LC=[] 3413 ), 3414 append(C0,LC,C1), 3415 remove_duplicates(C1,C2), 3416 find_constants(T,M,Mod,C2,C). 3417 3418call_goal(M,G):- 3419 M:G. 3420 3421gen_goal(Arg,Ar,_A,[],[],_):- 3422 Arg =:= Ar+1,!. 3423 3424gen_goal(A,Ar,A,[V|Args],ArgsNoV,V):-!, 3425 Arg1 is A+1, 3426 gen_goal(Arg1,Ar,A,Args,ArgsNoV,V). 3427 3428gen_goal(Arg,Ar,A,[ArgV|Args],[ArgV|ArgsNoV],V):- 3429 Arg1 is Arg+1, 3430 gen_goal(Arg1,Ar,A,Args,ArgsNoV,V). 3431 3432 3433 3434find_ex_db_cw([],_M,_At,_Ty,LG,LG,Pos,Pos,Neg,Neg). 3435 3436find_ex_db_cw([H|T],M,At,Types,LG0,LG,Pos0,Pos,Neg0,Neg):- 3437 get_constants(Types,H,M,C), 3438 At=..[P|L], 3439 get_types(At,M,TypesA),!, 3440 length(L,N), 3441 length(LN,N), 3442 At1=..[P,H|LN], 3443 findall(At1,M:At1,LP), 3444 (setof(\+ At1,neg_ex(LN,M,TypesA,At1,C),LNeg)->true;LNeg=[]), 3445 length(LP,NP), 3446 length(LNeg,NN), 3447 append([LG0,LP,LNeg],LG1), 3448 Pos1 is Pos0+NP, 3449 Neg1 is Neg0+NN, 3450 find_ex_db_cw(T,M,At,Types,LG1,LG,Pos1,Pos,Neg1,Neg). 3451 3452neg_ex([],M,[],At1,_C):- 3453 \+ M:At1. 3454 3455neg_ex([H|T],M,[HT|TT],At1,C):- 3456 member((HT,Co),C), 3457 member(H,Co), 3458 neg_ex(T,M,TT,At1,C). 3459 3460compute_CLL_atoms([],_M,_N,CLL,CLL,[],Nodes,Nodes):-!. 3461 3462compute_CLL_atoms([],_M,_N,CLL,CLL,[],Nodes,Nodes):-!. 3463 3464compute_CLL_atoms([\+ H|T],M,N,CLL0,CLL1,[PG- (\+ H)|T1],Nodes0,Nodes):-!, 3465 findall(P,M:rule(_R,[_:P|_],_BL,_Lit),LR), 3466 abolish_all_tables, 3467 get_node(H,M,Circuit),!, 3468 CircuitNew = not(Circuit), 3469 append(Nodes0,[CircuitNew],Nodes0_New), 3470 length(LR,NR), 3471 forward(Circuit,LR,NR,PG), 3472 PG1 is 1-PG, 3473 (PG1=:=0.0-> 3474 M:local_setting(logzero,LZ), 3475 CLL2 is CLL0+LZ 3476 ; 3477 CLL2 is CLL0+ log(PG1) 3478 ), 3479 N1 is N+1, 3480 compute_CLL_atoms(T,M,N1,CLL2,CLL1,T1,Nodes0_New,Nodes). 3481 3482compute_CLL_atoms([H|T],M,N,CLL0,CLL1,[PG-H|T1],Nodes0,Nodes):- 3483 findall(P,M:rule(_R,[_:P|_],_BL,_Lit),LR), 3484 abolish_all_tables, 3485 get_node(H,M,Circuit),!, 3486 append(Nodes0,[Circuit],Nodes0_New), 3487 length(LR,NR), 3488 forward(Circuit,LR,NR,PG), 3489 (PG=:=0.0-> 3490 M:local_setting(logzero,LZ), 3491 CLL2 is CLL0+LZ 3492 ; 3493 CLL2 is CLL0+ log(PG) 3494 ), 3495 N1 is N+1, 3496 compute_CLL_atoms(T,M,N1,CLL2,CLL1,T1,Nodes0_New,Nodes). 3497 3498 3499 3500write2(M,A):- 3501 M:local_setting(verbosity,Ver), 3502 (Ver>1-> 3503 write(A) 3504 ; 3505 true 3506 ). 3507 3508write3(M,A):- 3509 M:local_setting(verbosity,Ver), 3510 (Ver>2-> 3511 write(A) 3512 ; 3513 true 3514 ). 3515 3516nl2(M):- 3517 M:local_setting(verbosity,Ver), 3518 (Ver>1-> 3519 nl 3520 ; 3521 true 3522 ). 3523 3524nl3(M):- 3525 M:local_setting(verbosity,Ver), 3526 (Ver>2-> 3527 nl 3528 ; 3529 true 3530 ). 3531 3532format2(M,A,B):- 3533 M:local_setting(verbosity,Ver), 3534 (Ver>1-> 3535 format(A,B) 3536 ; 3537 true 3538 ). 3539 3540format3(M,A,B):- 3541 M:local_setting(verbosity,Ver), 3542 (Ver>2-> 3543 format(A,B) 3544 ; 3545 true 3546 ). 3547 3548write_rules2(M,A,B):- 3549 M:local_setting(verbosity,Ver), 3550 (Ver>1-> 3551 write_rules(A,B) 3552 ; 3553 true 3554 ). 3555 3556write_rules3(M,A,B):- 3557 M:local_setting(verbosity,Ver), 3558 (Ver>2-> 3559 write_rules(A,B) 3560 ; 3561 true 3562 ). 3563 3564 3565write_disj_clause2(M,A,B):- 3566 M:local_setting(verbosity,Ver), 3567 (Ver>1-> 3568 write_disj_clause(A,B) 3569 ; 3570 true 3571 ). 3572 3573write_disj_clause3(M,A,B):- 3574 M:local_setting(verbosity,Ver), 3575 (Ver>2-> 3576 write_disj_clause(A,B) 3577 ; 3578 true 3579 ). 3580 3581write_body2(M,A,B):- 3582 M:local_setting(verbosity,Ver), 3583 (Ver>1-> 3584 write_body(A,B) 3585 ; 3586 true 3587 ). 3588 3589write_body3(M,A,B):- 3590 M:local_setting(verbosity,Ver), 3591 (Ver>2-> 3592 write_body(A,B) 3593 ; 3594 true 3595 ). 3596 3597 3598tab(M,A/B,P):- 3599 length(Args0,B), 3600 (M:local_setting(depth_bound,true)-> 3601 append(Args0,[_,_,lattice(phil:orc/3)],Args) 3602 ; 3603 append(Args0,[_,lattice(phil:orc/3)],Args) 3604 ), 3605 P=..[A|Args], 3606 PT=..[A|Args0], 3607 assert(M:tabled(PT)).
3615zero_clause(M,A/B,(H:-maplist(nonvar,Args0),phil:zeroc(AC))):- 3616 B1 is B+1, 3617 length(Args0,B1), 3618 (M:local_setting(depth_bound,true)-> 3619 ExtraArgs=[_,or([AC])] 3620 ; 3621 ExtraArgs=[or([AC])] 3622 ), 3623 append(Args0,ExtraArgs,Args), 3624 H=..[A|Args]. 3625 3626 3627 3628systemterm_expansion((:- phil), []) :-!, 3629 prolog_load_context(module, M), 3630 retractall(M:local_setting(_,_)), 3631 findall(local_setting(P,V),default_setting_hplp(P,V),L), 3632 assert_all(L,M,_), 3633 assert(input_mod_hplp(M)), 3634 retractall(M:rule_sc_n(_)), 3635 assert(M:rule_sc_n(0)), 3636 M:dynamic((modeh/2,modeh/4,fixed_rule/3,banned/2,lookahead/2, 3637 lookahead_cons/2,lookahead_cons_var/2,'$prob'/2,output/1,input/1,input_cw/1, 3638 ref_clause/1,ref/1,model/1,neg/1,rule/5,determination/2, 3639 bg_on/0,bg/1,bgc/1,in_on/0,in/1,inc/1,int/1,v/3, 3640 query_rule/4,database/1, 3641 zero_clauses/1,tabled/1)), 3642 retractall(M:tabled(_)), 3643 style_check(-discontiguous). 3644 3645systemterm_expansion(end_of_file, C) :- 3646 prolog_load_context(module, M), 3647 input_mod_hplp(M),!, 3648 make_dynamic(M), 3649 findall(LZ,M:zero_clauses(LZ),L0), 3650 append(L0,L), 3651 retractall(M:zero_clauses(_)), 3652% retractall(M:tabled(_)), 3653 %retractall(input_mod_hplp(M)), 3654 append(L,[(:- style_check(+discontiguous)),end_of_file],C). 3655 3656systemterm_expansion((:- begin_bg), []) :- 3657 prolog_load_context(module, M), 3658 input_mod_hplp(M),!, 3659 assert(M:bg_on). 3660 3661systemterm_expansion(C, M:bgc(C)) :- 3662 prolog_load_context(module, M), 3663 C\= (:- end_bg), 3664 input_mod_hplp(M), 3665 M:bg_on,!. 3666 3667systemterm_expansion((:- end_bg), []) :- 3668 prolog_load_context(module, M), 3669 input_mod_hplp(M),!, 3670 retractall(M:bg_on), 3671 findall(C,M:bgc(C),L), 3672 retractall(M:bgc(_)), 3673 (M:bg(BG0)-> 3674 retract(M:bg(BG0)), 3675 append(BG0,L,BG), 3676 assert(M:bg(BG)) 3677 ; 3678 assert(M:bg(L)) 3679 ). 3680 3681systemterm_expansion((:- begin_in), []) :- 3682 prolog_load_context(module, M), 3683 input_mod_hplp(M),!, 3684 assert(M:in_on). 3685 3686systemterm_expansion(C, M:inc(C)) :- 3687 prolog_load_context(module, M), 3688 C\= (:- end_in), 3689 input_mod_hplp(M), 3690 M:in_on,!. 3691 3692systemterm_expansion((:- end_in), []) :- 3693 prolog_load_context(module, M), 3694 input_mod_hplp(M),!, 3695 retractall(M:in_on), 3696 findall(C,M:inc(C),L), 3697 retractall(M:inc(_)), 3698 (M:in(IN0)-> 3699 retract(M:in(IN0)), 3700 append(IN0,L,IN), 3701 assert(M:in(IN)) 3702 ; 3703 assert(M:in(L)) 3704 ). 3705 3706systemterm_expansion(output(P/A), [output(P/A)|TabDir]) :- 3707 prolog_load_context(module, M), 3708 input_mod_hplp(M),!, 3709 tab(M,P/A,P1), 3710 zero_clause(M,P/A,Z), 3711 system:term_expansion((:- table P1),TabDir), 3712 assert(M:zero_clauses([Z])). 3713 3714systemterm_expansion(input(P/A), [input(P/A)|TabDir]):- 3715 prolog_load_context(module, M), 3716 input_mod_hplp(M),!, 3717 tab(M,P/A,P1), 3718 zero_clause(M,P/A,Z), 3719 system:term_expansion((:- table P1),TabDir), 3720 assert(M:zero_clauses([Z])). 3721 3722systemterm_expansion(begin(model(I)), []) :- 3723 prolog_load_context(module, M), 3724 input_mod_hplp(M),!, 3725 retractall(M:model(_)), 3726 assert(M:model(I)), 3727 assert(M:int(I)). 3728 3729systemterm_expansion(end(model(_I)), []) :- 3730 prolog_load_context(module, M), 3731 input_mod_hplp(M),!, 3732 retractall(M:model(_)). 3733 3734systemterm_expansion(At, A) :- 3735 prolog_load_context(module, M), 3736 input_mod_hplp(M), 3737 M:model(Name), 3738 At \= (_ :- _), 3739 At \= end_of_file, 3740 (At=neg(Atom)-> 3741 Atom=..[Pred|Args], 3742 Atom1=..[Pred,Name|Args], 3743 A=neg(Atom1) 3744 ; 3745 (At=prob(Pr)-> 3746 A=prob(Name,Pr) 3747 ; 3748 At=..[Pred|Args], 3749 Atom1=..[Pred,Name|Args], 3750 A=Atom1 3751 ) 3752 )
hplp
This module provides algorithms for learning the structure and the parameters of Hierachical Probabilic Logic Programs (HPLP) from data. Structure learning is done by predicates invention and parameter learning by gradient descent (Backpropagation) or Expectation maximization.