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.

author
- Arnaud Nguembang Fadja and Fabrizio Riguzzi
    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*/
 dphil(++ListOfACs:list, ++Params1:list, ++StopCondition:list, ++Folder:list, ++AdamParams:list, ++Params2:list, -CLL:float, -Probabilities:list) is det
Performs gradient descent learning on HPLP. Takes as input a list of ACs each representing one example, Params is a list whose elements are [NR,ZERO,Seeded,Seed] where NR is the number of rule, ZERO is the value to use if the denominator of a particular fraction is zero, Seeded (yes to set a Seed or no otherwise). StopCond is a list whose elements are[MaxIter,EA,ER] where MaxIter is the maximum number of iterations EA and ER are the minimum absolute difference and relative between the log likelihood of examples in two different iterations Folder is a list whose elements are [Saved,StatisticsFolder] where if Saved is yes, the statistics are saved in StatisticsFolder and no otherwise AdamParams is a list whose elements are [Eta,Beta1,Beta2,Epsilon_adam_hat] containing the Adam parameters Params2 is a list whose elements are [Strategy,BatchSize,MAX_W] where Strategy is the strategy used in gradient descent (batch, minibatch or stochastic minibatch) and BatchSize the corresponding batch. weights are initialized in the range [-MAX_W,+MAX_W]

It returns the final log likelihood of examples CLL and the list of learned Parameters probabilities /

 emphil(++ListOfACs:list, ++Params1:list, ++StopCondition:list, ++Folder:list, -CLL:float, -Probabilities:list) is det
Performs EM learning on HPLP. Takes as input a list of ACs each representing one example, Params is a list whose elements are [NR,ZERO,Seeded,Seed] where NR is the number of rule, ZERO is the value to use if the denominator of a particular fraction is zero, Seeded (yes to set a Seed or no otherwise). StopCond is a list whose elements are[MaxIter,EA,ER] where MaxIter is the maximum number of iterations EA and ER are the minimum absolute difference and relative between the log likelihood of examples in two different iterations Folder is a list whose elements are [Saved,StatisticsFolder] where if Saved is yes, the statistics are saved in StatisticsFolder and no otherwise

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).
 or_list(++ListOfACs:list, ++Environment, --AC:int) is det
Returns in AC a pointer to a AC belonging to environment Environment representing the disjunction of all the ACs in ListOfACs /
  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).
 test_hplp(:P:probabilistic_program, +TestFolds:list_of_atoms, -LL:float, -AUCROC:float, -ROC:dict, -AUCPR:float, -PR:dict) is det
The predicate takes as input in P a probabilistic program, tests P on the folds indicated in TestFolds and returns the log likelihood of the test examples in LL, the area under the Receiver Operating Characteristic curve in AUCROC, a dict containing the points of the ROC curve in ROC, the area under the Precision Recall curve in AUCPR and a dict containing the points of the PR curve in PR /
  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).
 test_hplp_prob(:P:probabilistic_program, +TestFolds:list_of_atoms, -NPos:int, -NNeg:int, -LL:float, -Results:list) is det
The predicate takes as input in P a probabilistic program, tests P on the folds indicated in TestFolds and returns the number of positive examples in NPos, the number of negative examples in NNeg, the log likelihood in LL and in Results a list containing the probabilistic result for each query contained in TestFolds. /
  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).
 induce_hplp_par(:TrainFolds:list_of_atoms, -P:probabilistic_program) is det
The predicate learns the parameters of the program stored in the in/1 fact of the input file using the folds indicated in TrainFolds for training. It returns in P the input program with the updated parameters. /
  336induce_hplp_par(M:Folds,P):-
  337  induce_hplp_parameters(M:Folds,_DB,R),
  338  rules2termHPLPs(R,P),
  339  saveHPLP_learned(M,P).
 inference_hplp(:Query:atom, +Model:constant-Prob:number)
Performs inference and returns in Prob the probability of atom. /
  348inference_hplp(M:Query, Model, Prob):-
  349  inference_hplp(M:Query, Model,Prob, _Circuit).
 inference_hplp(:Query:atom, +Model:constant, -Prob:probabity, -Circuit:Term)
Performs inference and returns both the probability and the arithmetic circuit of atom in Prob and Circuit respectively. /
  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).
 resetProb
  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).
 learn_params_hplp(+DB:list_of_atoms, +M:atom, +R0:probabilistic_program, -R:probabilistic_program, -Score:float) is det
The predicate learns the parameters of the program R0 and returns the updated program in R and the score in Score. DB contains the list of interpretations ids and M the module where the data is stored. /
  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------------------
 induce
  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).
 getTree
  892getTree([],Trees,Trees):-!.
  893getTree([Pred|RestPred],TreesCurr,Treesresult):-
  894insert_tree(Pred,[],TreesCurr,TreesCurr1),
  895getTree(RestPred,TreesCurr1,Treesresult).
 insert_tree
  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).
 insert_tree_loop
  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).
 insert_Forest
  930insert_Forest(Pred1,t(Pred2,Forest),TreeResult):-
  931  append_No_empty(Forest,[t(Pred1,[])],Forest1),
  932  TreeResult=t(Pred2,Forest1).
 insert_tree_loop_Forest
  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.
 getVariableArgument(+Predicate:Term, -VarArguments:list)
Given a predicate Term, return in VarArguments the list of variable argument %of Term.
  970getVariableArgument(Predicate,VarArguments):-
  971  Predicate=..List,
  972  List=[_Functor|Arguments],
  973  remove_constants(Arguments,VarArguments).
 remove_constantss(+List1:list, -List2:list) is det
Removes constants form list List1. List2 returns only variables /
  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    ).
 writeList
 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).
 writeClause
 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 */
 rules2terms(:R:list_of_rules, -T:tern) is det
The predicate translates a list of rules from the internal representation format (rule/4 and def_rule/3) to the LPAD syntax. /
 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).
 list2or(+List:list, -Or:term) is det
list2or(-List:list, +Or:term) is det
The predicate succeeds when Or is a disjunction (using the ; operator) of the terms in List /
 1693list2or([],true):-!.
 1694
 1695list2or([X],X):-
 1696    X\=;(_,_),!.
 1697
 1698list2or([H|T],(H ; Ta)):-!,
 1699    list2or(T,Ta).
 list2and(+List:list, -And:term) is det
list2and(-List:list, +And:term) is det
The predicate succeeds when And is a conjunction (using the , operator) of the terms in List /
 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).
 sample_hplp(+N, List:list, -Sampled:list, -Rest:list) is det
Samples N elements from List and returns them in Sampled. The rest of List is returned in Rest If List contains less than N elements, Sampled is List and Rest is []. */
 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:H,HRef),
 2510  assert_all(T,M,TRef).
 2511
 2512assert_all([],[]).
 2513
 2514assert_all([H|T],[HRef|TRef]):-
 2515  assertz(phil:H,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*/
 set_hplp(:Parameter:atom, +Value:term) is det
The predicate sets the value of a parameter For a list of parameters see https://github.com/friguzzi/cplint/blob/master/doc/manual.pdf or http://ds.ing.unife.it/~friguzzi/software/cplint-swi/manual.html /
 2889set_hplp(M:Parameter,Value):-
 2890  retract(M:local_setting(Parameter,_)),
 2891  assert(M:local_setting(Parameter,Value)).
 setting_sc(:Parameter:atom, -Value:term) is det
The predicate returns the value of a parameter For a list of parameters see https://github.com/friguzzi/cplint/blob/master/doc/manual.pdf or http://ds.ing.unife.it/~friguzzi/software/cplint-swi/manual.html /
 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).
 builtin(+Goal:atom) is det
Succeeds if Goal is an atom whose predicate is defined in Prolog (either builtin or defined in a standard library). /
 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)).
 zero_clause(+Module:atom, +PredSpec:pred_spec, -ZeroClause:term) is det
Generates the zero clause for predicate PredSpec. Module is the module of the input file. /
 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
 3628system:term_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
 3645system:term_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
 3656system:term_expansion((:- begin_bg), []) :-
 3657  prolog_load_context(module, M),
 3658  input_mod_hplp(M),!,
 3659  assert(M:bg_on).
 3660
 3661system:term_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
 3667system:term_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
 3681system:term_expansion((:- begin_in), []) :-
 3682  prolog_load_context(module, M),
 3683  input_mod_hplp(M),!,
 3684  assert(M:in_on).
 3685
 3686system:term_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
 3692system:term_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
 3706system:term_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
 3714system:term_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
 3722system:term_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
 3729system:term_expansion(end(model(_I)), []) :-
 3730  prolog_load_context(module, M),
 3731  input_mod_hplp(M),!,
 3732  retractall(M:model(_)).
 3733
 3734system:term_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  )