2:-module(lemur,[set_lm/2,setting_lm/2,
    3  induce_lm/2]).

lemur

This module performs learning over Logic Programs with Annotated Disjunctions and CP-Logic programs using the LEMUR algorithm of

Nicola Di Mauro, Elena Bellodi, and Fabrizio Riguzzi. Bandit-based Monte-Carlo structure learning of probabilistic logic programs. Machine Learning, 100(1):127-156, July 2015

See https://friguzzi.github.io/cplint/ for details.

Reexports slipcover

author
- Nicola di Mauro, Fabrizio Riguzzi, Elena Bellodi
license
- Artistic License 2.0
   24:-reexport(library(slipcover)).   25
   26:-use_module(library(lists)).   27:-use_module(library(random)).   28:-use_module(library(system)).   29:-use_module(library(terms)).   30
   31
   32:- set_prolog_flag(discontiguous_warnings,on).   33:- set_prolog_flag(single_var_warnings,on).   34:- set_prolog_flag(unknown,warning).   35
   36:- dynamic db/1.   37:- dynamic lm_input_mod/1.   38
   39
   40:- meta_predicate induce_lm(:,-).   41:- meta_predicate induce_rules(:,-).   42:- meta_predicate set_lm(:,+).   43:- meta_predicate setting_lm(:,-).   44/*
   45	declarations start
   46define the depth of a variable appearing in a clause A B ^ : : : ^ Br as follows.
   47
   48Variables appearing in the head of a clause have depth zero.
   49Otherwise, let Bi be the first literal containing the variable V, and let d be the maximal depth of the input variables of Bi
   50then the depth of V is d + 1. The depth of a clause is the maximal depth of any variable in the clause.
   51
   52In questo modo possiamo lasciare il numero massimo di variabili a 4 (e cosi' impara la regola con taughtby) e riduciamo la profondita' massima delle variabili a 2 (in questo modo dovremmo imparare la regola con i due publication nel body e anche quella con taughtby).
   53Bisogna modificare revise.pl per controllare che gli atomi che si aggiungono nel body non abbiano variabili oltre la profondita' massima.
   54*/
   55
   56
   57default_setting_lm(epsilon_em,0.0001).
   58default_setting_lm(epsilon_em_fraction,0.00001).
   59default_setting_lm(eps,0.0001).
   60default_setting_lm(eps_f,0.00001).
   61
   62/* if the difference in log likelihood in two successive em iteration is smaller
   63than epsilon_em, then EM stops */
   64default_setting_lm(epsilon_sem,2).
   65
   66/* number of random restarts of em */
   67default_setting_lm(random_restarts_REFnumber,1).
   68default_setting_lm(random_restarts_number,1).
   69default_setting_lm(iterREF,-1).
   70default_setting_lm(iter,-1).
   71default_setting_lm(examples,atoms).
   72default_setting_lm(group,1).
   73default_setting_lm(d,1).
   74default_setting_lm(verbosity,1).
   75default_setting_lm(logzero,log(0.000001)).
   76default_setting_lm(max_iter,10).
   77default_setting_lm(max_iter_structure,10000).
   78default_setting_lm(maxdepth_var,2).
   79default_setting_lm(beamsize,100).
   80default_setting_lm(background_clauses,50).
   81default_setting_lm(neg_ex,cw).
   82
   83
   84default_setting_lm(seed,seed(3032)).
   85default_setting_lm(c_seed,21344).
   86default_setting_lm(score,ll).
   87/* allowed values: ll aucpr */
   88
   89default_setting_lm(mcts_beamsize,3).
   90default_setting_lm(mcts_visits,1e20).
   91default_setting_lm(max_var,4).
   92default_setting_lm(mcts_max_depth,8).
   93default_setting_lm(mcts_c,0.7).
   94default_setting_lm(mcts_iter,20).
   95default_setting_lm(mcts_maxrestarts,20).
   96default_setting_lm(mcts_covering,true).
   97default_setting_lm(max_rules,1).
   98default_setting_lm(epsilon_parsing, 1e-5).
   99default_setting_lm(bagof,false).
  100default_setting_lm(compiling,off).
  101default_setting_lm(depth_bound,false).  %if true, it limits the derivation of the example to the value of 'depth'
  102default_setting_lm(depth,2).
  103default_setting_lm(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.
  104default_setting_lm(tabling,auto).
  105/* values:
  106  auto
  107  explicit
  108*/
  109default_setting_lm(alpha,0.0).
  110% Sets the type of parameter initialization for EM on Environment:
  111% if alpha is 0.0, it uses a truncated Dirichlet process
  112% if alpha is a float > 0.0, it uses a symmetric Dirichlet distribution
  113% with that value as parameter
  114:- thread_local database/1, lm_input_mod/1.
 induce_lm(:TrainFolds:list_of_atoms, -P:probabilistic_program) is det
The predicate performs structure learning using the folds indicated in TrainFolds for training. It returns in P the learned probabilistic program. /
  123induce_lm(M:TrainFolds,P):-
  124  must_be(list,TrainFolds),
  125  must_be(var,P),
  126  induce_rules(M:TrainFolds,P0),
  127  rules2terms(P0,P).
  128
  129
  130
  131induce_rules(M:Folds,R):-
  132  set_lm(M:compiling,on),
  133  M:local_setting(seed,Seed),
  134  set_random(Seed),
  135  M:local_setting(c_seed,CSeed),
  136  rand_seed(CSeed),
  137  findall(Exs,(member(F,Folds),M:fold(F,Exs)),L),
  138  append(L,DB),
  139  assert(M:database(DB)),
  140
  141  statistics(walltime,[_,_]),
  142  format2(M,"\nMonte Carlo Tree Search for LPAD Structure Learning\n",[]),
  143
  144  (M:bg(RBG0)->
  145    process_clauses(RBG0,M,[],_,[],RBG),
  146    generate_clauses(RBG,M,_RBG1,0,[],ThBG),
  147    generate_clauses_bg(RBG,ClBG),
  148    assert_all(ThBG,M,ThBGRef),
  149    assert_all(ClBG,M,ClBGRef)
  150  ;
  151    true
  152  ),
  153  findall(BL , M:modeb(_,BL), BLS0),
  154  sort(BLS0,BSL),
  155  assert(M:mcts_modeb(BSL)),
  156
  157  assert(M:mcts_restart(1)),
  158  learn_struct_mcts(DB,M,[],R2,Score2),
  159  retract(M:mcts_restart(_)),
  160  learn_params(DB,M,R2,R,Score),
  161
  162  format2(M,"~nRefinement score  ~f - score after EMBLEM ~f~n",[Score2,Score]),
  163  statistics(walltime,[_,WT]),
  164  WTS is WT/1000,
  165  write2(M,'\n\n'),
  166  format2(M,'Wall time ~f */~n',[WTS]),
  167  write_rules2(M,R,user_output),
  168  set_lm(M:compiling,off),
  169  (M:bg(RBG0)->
  170    retract_all(ThBGRef),
  171    retract_all(ClBGRef)
  172  ;
  173    true
  174  ).
  175
  176
  177learn_struct_mcts(DB,M,R1,R,CLL1):-
  178  learn_params(DB,M, R1, R3, CLL),
  179  write2(M,'updated Theory'),nl2(M),
  180  write_rules2(M,R3,user_output),
  181
  182  assert(M:mcts_best_score(CLL)),
  183  assert(M:mcts_best_theory(R3)),
  184  assert(M:mcts_theories(0)),
  185
  186  assert(M:mcts_best_theories_iteration([])),
  187
  188  mcts(R3,M,CLL,DB),
  189  retract(M:mcts_best_theories_iteration(BestsIter)),
  190  format2(M,"\nBests found at : ~w",[BestsIter]),
  191
  192  retract(M:mcts_theories(_)),
  193  retract(M:mcts_best_score(CLLNew)),
  194  retract(M:mcts_best_theory(RNew)),
  195
  196  (M:local_setting(mcts_covering,true) ->
  197
  198    M:local_setting(mcts_maxrestarts,MctsRestarts),
  199    M:mcts_restart(CurrentRestart),
  200
  201    Improvement is CLLNew - CLL,
  202    ( (CLLNew > CLL, Improvement > 0.1, CurrentRestart =< MctsRestarts) ->
  203
  204      format2(M,"\n---------------- Improvement ~w",[Improvement]),
  205      retractall(M:node(_, _, _, _, _, _, _)),
  206      retract(M:local_setting(max_rules,ParRules)),
  207      ParRules1 is ParRules + 1,
  208      assert(M:local_setting(max_rules,ParRules1)),
  209      retract(M:mcts_restart(Restart)),
  210      Restart1 is Restart + 1,
  211      assert(M:mcts_restart(Restart1)),
  212      learn_struct_mcts(DB,M,RNew,R,CLL1)
  213    ;
  214      CLL1 = CLLNew,
  215      R = RNew
  216    )
  217  ;
  218    CLL1 = CLLNew,
  219    R = RNew
  220  ).
  221
  222
  223
  224mcts(InitialTheory,M,InitialScore,DB):-
  225  % node(ID, CHILDRENS, PARENT, CLL, Theory, VISITED, BACKSCORE)
  226  assert(M:node(1, [], 0, InitialScore , InitialTheory, 0 , 0)),
  227  assert(M:lastid(1)),
  228  M:local_setting(mcts_iter,I),
  229  assert(M:mcts_iteration(0)),
  230  cycle_mcts(I,M,DB),
  231  retract(M:mcts_iteration(_)),
  232  retract(M:lastid(Nodes)),
  233  %print_graph,
  234  format2(M,"\nTree size: ~w nodes.",[Nodes]).
  235
  236
  237backup_amaf(1,M,_Reward,_):-
  238  !,
  239  (retract(M:node(1, Childs, Parent , PSLL, MLN, Visited, Backscore)) ->
  240    true
  241  ;
  242    format(user_error,"\nNo node with ID ~w in backup",[NodeID]),
  243    throw(no_node_id(NodeID))
  244  ),
  245  Visited1 is Visited + 1,
  246  assert(M:node(1, Childs, Parent , PSLL, MLN, Visited1, Backscore)).
  247
  248backup_amaf(NodeID,M,Reward,ParentsTranspose):-
  249  (retract(M:node(NodeID, Childs, Parent , PSLL, MLN, Visited, Backscore)) ->
  250    true
  251  ;
  252    format(user_error,"\nNo node with ID ~w in backup",[NodeID]),
  253    throw(no_node_id(NodeID))
  254  ),
  255  (member(NodeID,ParentsTranspose) ->
  256    Backscore1 is Backscore,
  257    Visited1 is Visited
  258    %format("~w- ",[NodeID])
  259  ;
  260    (PSLL =:= 1  ->
  261      Backscore1 is Backscore + Reward
  262    ;
  263      SigmoidValue is 1 / (1 - PSLL),
  264      ( Reward > SigmoidValue ->
  265        Backscore1 is Backscore + Reward
  266      ;
  267        Backscore1 is Backscore + SigmoidValue
  268        %Backscore1 is Backscore + Reward
  269      )
  270    ),
  271
  272    Visited1 is Visited + 1
  273    %format("~w+ ",[NodeID])
  274  ),
  275  assert(M:node(NodeID, Childs, Parent , PSLL, MLN, Visited1, Backscore1)).
  276
  277
  278check_amaf(NodeID,M,Theory,SigmoidValue,ParentsTranspose):-
  279  M:lastid(Nodes),
  280  format2(M,"\nChecking amaf: node ~w, parents ~w: ",[NodeID,ParentsTranspose]),
  281  check_amaf(Nodes,M,NodeID,Theory,SigmoidValue,ParentsTranspose).
  282
  283check_amaf(1,M,_NodeID,_,_SigmoidValue,_ParentsTranspose):-
  284  retract(M:node(1, Childs, Parent , PSLL, MLN, Visited, Backscore)),
  285  Visited1 is Visited + 1,
  286  assert(M:node(1, Childs, Parent , PSLL, MLN, Visited1, Backscore)),
  287  !.
  288
  289check_amaf(Node,M,NodeID,Theory,SigmoidValue,ParentsTranspose):-
  290  Node \== NodeID,
  291  !,
  292  M:node(Node, _Childs, _Parent , _CLL, TheoryN, _Visited, _Backscore),
  293  ( subsume_theory(TheoryN,Theory) ->
  294    %format("\n\t ~w ~w: ",[TheoryN,Theory]),
  295    backup_amaf(Node,M,SigmoidValue,ParentsTranspose)
  296  ;
  297    true
  298  ),
  299  Node1 is Node - 1,
  300  check_amaf(Node1,M,NodeID,Theory,SigmoidValue,ParentsTranspose).
  301
  302check_amaf(Node,M,NodeID,Theory,SigmoidValue,ParentsTranspose):-
  303  Node1 is Node - 1,
  304  check_amaf(Node1,M,NodeID,Theory,SigmoidValue,ParentsTranspose).
  305
  306
  307subsume_theory(Theory,TheoryN):-
  308  copy_term(Theory,Theory1),
  309  skolemize(TheoryN,TheoryN1),
  310  subsume_theory1(Theory1,TheoryN1),
  311  !.
  312
  313skolemize(Theory,Theory1):-
  314  copy_term(Theory,Theory1),
  315  term_variables(Theory1,Vars),
  316  skolemize1(Vars,1).
  317
  318
  319skolemize1([],_).
  320
  321skolemize1([Var|R],K):-
  322  atomic_list_concat([s,K],Skolem),
  323  Var = Skolem,
  324  K1 is K + 1,
  325  skolemize1(R,K1).
  326
  327subsume_theory1([],_).
  328
  329subsume_theory1([Rule|R],TheoryN):-
  330  subsume_theory2(Rule,TheoryN,NewTheoryN),
  331  subsume_theory1(R,NewTheoryN).
  332
  333
  334subsume_theory2(Rule,[Rule1|R],R):-
  335  Rule = rule(_,[H: _, _: _],Body,_,_),
  336  Rule1 = rule(_,[H1: _, _: _],Body1,_,_),
  337  H = H1,
  338  subsume_body(Body,Body1),
  339  !.
  340
  341subsume_theory2(Rule,[Rule1|R],[Rule1|R1]):-
  342  subsume_theory2(Rule,R,R1).
  343
  344
  345subsume_body(Body,Body1):-
  346  length(Body,L),
  347  length(Body1,L1),
  348  L =< L1,
  349  subsume_body1(Body,Body1).
  350
  351
  352subsume_body1([],_).
  353
  354subsume_body1([L|R],Body):-
  355  nth1(_,Body,L,Rest),
  356  subsume_body1(R,Rest).
  357
  358
  359same_theory(Theory0,TheoryN):-
  360  copy_term(Theory0,Theory),
  361  length(Theory,L),
  362  length(TheoryN,L),
  363  same_theory1(Theory,TheoryN),
  364  !.
  365
  366
  367same_theory1([],[]).
  368
  369same_theory1([Rule|R],TheoryN):-
  370  same_theory2(Rule,TheoryN,NewTheoryN),
  371  same_theory1(R,NewTheoryN).
  372
  373
  374same_theory2(Rule,[Rule1|R],R):-
  375  Rule = rule(_,[H: _, _: _],Body,_,_),
  376  Rule1 = rule(_,[H1: _, _: _],Body1,_,_),
  377  H = H1,
  378  same_body(Body,Body1),
  379  !.
  380
  381same_theory2(Rule,[Rule1|R],[Rule1|R1]):-
  382  same_theory2(Rule,R,R1).
  383
  384
  385same_body(Body,Body1):-
  386  length(Body,L),
  387  length(Body1,L),
  388  same_body1(Body,Body1).
  389
  390
  391same_body1([],[]).
  392
  393same_body1([L|R],Body):-
  394  nth1(_,Body,L,Rest),
  395  same_body1(R,Rest).
  396
  397
  398cycle_mcts(0,_M,_):-
  399  !.
  400
  401cycle_mcts(K,M,DB):-
  402  M:local_setting(mcts_iter,MaxI),
  403  Iteration is MaxI - K + 1,
  404  retract(M:mcts_iteration(_)),
  405  assert(M:mcts_iteration(Iteration)),
  406  format2(M,"\nIteration ~w",[Iteration]),
  407  tree_policy(1,M,NodeID,DB,1,_Depth),
  408  ( M:node(NodeID, _Childs, _Parent , _CLL, Theory, _Visited, _Backscore) ->
  409  % do update with the sigmoid of the Score
  410  % SigmoidValue is ((1 / (1 + exp(-PSLL)))/0.5),
  411  % format("\n~w: ~w ~w Sigmoid ~w",[K,MLN,PSLL,SigmoidValue]),
  412    M:local_setting(mcts_max_depth, MaxDepth),
  413    random(1,MaxDepth,MaxDepth1),
  414    default_policy(Theory,M,-1e20,Reward,_,BestDefaultTheory,DB,1,MaxDepth1),
  415  % do update with the sigmoid of the Score
  416  % SigmoidValue is ((1 / (1 + exp(-Reward)))/0.5),
  417
  418    (Reward=:=1->
  419      SigmoidValue=1e20
  420    ;
  421      SigmoidValue is 1 / (1 -  Reward)
  422    ),
  423    ( Reward =\= -1e20 ->
  424
  425  % (Reward > CLL ->
  426  % SigmoidValue = 1
  427  % ;
  428  % SigmoidValue = 0
  429  % ),
  430
  431      % format("\n~w: ~w \nReward ~w Sigmoid ~w",[K,Theory,Reward,SigmoidValue]),
  432      format2(M,"\n[Backup reward ~w]",[SigmoidValue]),
  433      backup(NodeID,M,SigmoidValue,Parents),
  434      %	check_transposition(NodeID,Theory,SigmoidValue,Parents),
  435      check_amaf(NodeID,M,BestDefaultTheory,SigmoidValue,Parents)
  436    ;
  437      format2(M,"\n--> no default policy expansion",[])
  438    ),
  439    K1 is K - 1,
  440    %read(_),
  441    cycle_mcts(K1,M,DB)
  442  ;
  443    format2(M,"\n--> tree policy end",[])
  444  ).
  445
  446
  447prune([],_Childs1).
  448
  449prune([ID|R],Childs1):-
  450  member(ID,Childs1),
  451  !,
  452  prune(R,Childs1).
  453
  454prune([ID|R],Childs1):-
  455  prune_sub_tree(ID),
  456  prune(R,Childs1).
  457
  458
  459prune_sub_tree(ID):-
  460  retract(node(ID, Childs, _Parent , _CLL, _Theory, _VISITED, _BACKSCORE)),
  461  prune_sub_tree1(Childs).
  462
  463
  464prune_sub_tree1([]).
  465
  466prune_sub_tree1([ID|R]):-
  467  retract(node(ID, Childs, _Parent , _CLL, _Theory, _VISITED, _BACKSCORE)),
  468  prune_sub_tree1(Childs),
  469  prune_sub_tree1(R).
  470
  471
  472tree_policy(ID,M,NodeID,DB,Od,Nd):-
  473  %check_pruning(ID),
  474
  475  (retract(M:node(ID, Childs, Parent , CLL, Theory, VISITED, BACKSCORE)) ->
  476    true
  477  ;
  478    throw(no_node_id(ID))
  479  ),
  480  %format("\n Tree policy ~w ~w ~w",[Theory,VISITED, BACKSCORE]),
  481  format2(M,"\n[Tree Policy ~w, ~w, ~w] ",[ID,VISITED,BACKSCORE]), flush_output,
  482  %( VISITED = 0, ID \= 1 ->
  483  ( CLL = 1, ID \= 1 ->
  484    score_theory(Theory,M,DB,CLL1,BestTheory,NewTheory),
  485    M:mcts_best_score(BestScore),
  486
  487    ( M:local_setting(mcts_covering,true) ->
  488      length(NewTheory,NewTheoryL),	%lemurc
  489      length(Theory,TheoryL),
  490      ( NewTheoryL = TheoryL ->
  491        LengthCondition = true
  492      ;
  493        LengthCondition = false
  494      )
  495    ;
  496      LengthCondition = true
  497    ),
  498
  499
  500    ( ( CLL1 > BestScore, LengthCondition = true) ->
  501        format2(M,"\n[New best score: ~w ~w]",[CLL1, BestTheory]),flush_output,
  502
  503
  504      retract(M:mcts_best_score(_)),
  505      retract(M:mcts_best_theory(_)),
  506      assert(M:mcts_best_score(CLL1)),
  507      assert(M:mcts_best_theory(NewTheory)),
  508
  509      retract(M:mcts_best_theories_iteration(BestsIter)),
  510      M:mcts_iteration(Iteration),
  511      append(BestsIter,[Iteration],BestsIter1),
  512      assert(M:mcts_best_theories_iteration(BestsIter1)),
  513
  514      retract(M:mcts_theories(Mlns)),
  515      Mlns1 is Mlns + 1,
  516      assert(M:mcts_theories(Mlns1))
  517    ;
  518      true
  519    )
  520 ;
  521    CLL1 = CLL,
  522    NewTheory = Theory
  523  ),
  524
  525  Visited1 is VISITED + 1,
  526
  527  % (CLL = 1 ->
  528  % Visited2 = Visited1,
  529  %	(Visited2 == 2 -> Backscore1 = BACKSCORE ; Backscore1 = 0) % in this case the node has been visited by transposition
  530  %	;
  531  %	Visited2 = Visited1,
  532  %	Backscore1 = BACKSCORE
  533  %	),
  534
  535  Visited2 = Visited1,
  536  Backscore1 = BACKSCORE,
  537
  538
  539  (Childs == [] ->
  540    Nd = Od,
  541    expand(ID,M, Theory, CLL1, DB, NodeID, Childs1),
  542    assert(M:node(ID, Childs1, Parent , CLL1, NewTheory, Visited2, Backscore1))
  543  ;
  544    Od1 is Od + 1,
  545    minmaxvalue(Childs,M,MinV,MaxV),
  546    %mean_value_level(Childs,M,Mvl),
  547    once(uct(Childs, M,VISITED, MinV, MaxV, BestChild)),
  548    %once(uct(Childs, VISITED, BestChild)),
  549    tree_policy(BestChild,M,NodeID,DB,Od1, Nd),
  550    assert(M:node(ID, Childs, Parent , CLL1, NewTheory, Visited2, Backscore1))
  551  ).
  552
  553
  554default_policy(_Theory, _M,Reward, Reward, BestDefaultTheory,BestDefaultTheory,_DB, Depth, MaxDepth):-
  555  Depth > MaxDepth,
  556  !.
  557
  558default_policy(Theory,M,PrevR,Reward,PrevBestDefaultTheory,BestDefaultTheory,DB,Depth,MaxDepth):-
  559  %format("\nDefault policy",[]),flush_output,
  560  format2(M,"\n[Default Policy ~w]",[Depth]),
  561  theory_revisions_r(Theory,M,Revisions),
  562  ( Revisions \== [] ->
  563    length(Revisions,L),
  564    random(0,L,K),
  565    nth0(K, Revisions,Spec),
  566    Depth1 is Depth + 1,
  567    score_theory(Spec,M,DB,Score,BestTheory,NewTheory),
  568    ( M:local_setting(mcts_covering,true) ->
  569      length(NewTheory,NewTheoryL),	%lemurc
  570      length(Spec,TheoryL),
  571      ( NewTheoryL = TheoryL ->
  572        LengthCondition = true
  573      ;
  574        LengthCondition = false
  575      )
  576    ;
  577      LengthCondition = true
  578    ),
  579
  580
  581    (( Score > PrevR, LengthCondition = true) ->
  582       Reward1 = Score,
  583       BestDefaultTheory1 = NewTheory
  584  ;
  585       Reward1 = PrevR,
  586       BestDefaultTheory1 = PrevBestDefaultTheory
  587    ),
  588
  589    format2(M," cll-reward ~w",[Reward1]),
  590
  591    M:mcts_best_score(BestScore),
  592
  593
  594    ((Score > BestScore, LengthCondition = true) ->
  595      format2(M,"\n[New best score: ~w ~w]",[Score, BestTheory]),flush_output,
  596
  597
  598      retract(M:mcts_best_score(_)),
  599      retract(M:mcts_best_theory(_)),
  600      assert(M:mcts_best_score(Score)),
  601      assert(M:mcts_best_theory(NewTheory)),
  602
  603      retract(M:mcts_best_theories_iteration(BestsIter)),
  604      M:mcts_iteration(Iteration),
  605      append(BestsIter,[Iteration],BestsIter1),
  606      assert(M:mcts_best_theories_iteration(BestsIter1)),
  607
  608
  609      retract(M:mcts_theories(Mlns)),
  610      Mlns1 is Mlns + 1,
  611      assert(M:mcts_theories(Mlns1))
  612    ;
  613      true
  614    ),
  615
  616    default_policy(Spec,M, Reward1,Reward, BestDefaultTheory1,BestDefaultTheory,DB, Depth1,MaxDepth)
  617
  618  ;
  619    Reward = PrevR,
  620    BestDefaultTheory = PrevBestDefaultTheory
  621  ).
  622
  623
  624minmaxvalue(Childs,M,MinV,MaxV):-
  625  Childs = [F|R],
  626  M:node(F, _, _ , _, _, Visits, Reward),
  627  ( Visits=:=0->
  628    V is sign(Reward)*1e20
  629  ;
  630    V is Reward / Visits
  631  ),
  632  minmaxvalue(R,M,V,V,MinV,MaxV).
  633
  634minmaxvalue([],_M,Min,Max,Min,Max).
  635
  636minmaxvalue([C|R],M,PrevMin,PrevMax,MinV,MaxV):-
  637  M:node(C, _, _ , _, _, Visits, Reward),
  638  ( Visits=:=0->
  639    V is sign(Reward)*1e20
  640  ;
  641    V is Reward / Visits
  642  ),
  643  ( V > PrevMax ->
  644    Max1 is V
  645  ;
  646    Max1 is PrevMax
  647  ),
  648  ( V < PrevMin ->
  649    Min1 is V
  650  ;
  651    Min1 is PrevMin
  652  ),
  653  minmaxvalue(R,M,Min1,Max1,MinV,MaxV).
  654
  655
  656mean_value_level(Cs,Mod,M):-
  657  mean_value_level1(Cs,Mod,Me),
  658  length(Me,L),
  659  sum_list(Me,S),
  660  ( L=:=0->
  661    M is sign(S)*1e20
  662  ;
  663    M is S / L
  664  ).
  665
  666
  667mean_value_level1([],_Mod,[]).
  668
  669mean_value_level1([C|R],Mod,M1):-
  670  Mod:node(C, _, _ , 1, _, _Visits, _Reward),
  671  !,
  672  mean_value_level1(R,Mod,M1).
  673
  674mean_value_level1([C|R],Mod,[M|Rm]):-
  675  Mod:node(C, _, _ , _, _, Visits, Reward),
  676  !,
  677  mean_value_level1(R,Mod,Rm),
  678  ( Visits=:=0->
  679    M is sign(Reward)*1e20
  680  ;
  681    M is (Reward / Visits)
  682  ).
  683
  684
  685uct(Childs, M,ParentVisits, Min, Max, BestChild):-
  686  Childs = [FirstChild|RestChilds],
  687  M:node(FirstChild, _, _ , _Score, _Theory, Visits, Reward),
  688  ( Visits == 0 ->
  689    BestChild = FirstChild
  690  ;
  691    M:local_setting(mcts_c,C),
  692%    ( Score == 1 ->
  693%      R is Mvl
  694%    ;
  695%      R is Reward
  696%    ),
  697    ( Max-Min=:=0->
  698      UCT is sign(Reward/Visits-Min)*1e20
  699    ;
  700      R is Reward,
  701      %AA is ((R / Visits) - Min ) / (Max-Min),
  702      %BB is 2 * C * sqrt(2 * log(ParentVisits) / Visits),
  703      UCT is ((R / Visits) - Min ) / (Max-Min) + 2 * C * sqrt(2 * log(ParentVisits) / Visits)
  704    ),
  705%%%    format("\nID ~w UCT ~w ~w/~w=~w ~w",[FirstChild,UCT,R,Visits,AA,BB]),
  706%%%    format("\n\t ~w ~w",[Score,Theory]),
  707%%%    format("~w ",[UCT]),
  708    uct(RestChilds,M, UCT, ParentVisits, FirstChild, Min,Max, BestChild)
  709  ).
  710
  711
  712uct([],_M, _CurrentBestUCT, _ParentVisits, BestChild, _, _,BestChild).
  713
  714uct([Child|RestChilds], M,CurrentBestUCT, ParentVisits, CurrentBestChild, Min, Max,BestChild) :-
  715  M:node(Child, _, _ , _Score, _Theory, Visits, Reward),
  716  ( Visits == 0 ->
  717    BestChild = Child
  718  ;
  719    M:local_setting(mcts_c,C),
  720%   ( Score == 1 ->
  721%     R is Mvl
  722%   ;
  723%     R is Reward
  724%   ),
  725    ( Max-Min=:=0->
  726      UCT is sign(Reward/Visits-Min)*1e20
  727    ;
  728      R is Reward,
  729      %AA is ((R / Visits) - Min ) / (Max-Min),
  730      %BB is 2 * C * sqrt(2 * log(ParentVisits) / Visits),
  731      UCT is ((R / Visits) - Min ) / (Max-Min) + 2 * C * sqrt(2 * log(ParentVisits) / Visits)
  732    ),
  733%%%   format("\nID ~w UCT ~w ~w/~w=~w ~w",[Child,UCT,R,Visits,AA,BB]),
  734%%%   format("\n\t ~w ~w",[Score,Theory]),
  735%%%   format("~w ",[UCT]),flush_output,
  736    ( UCT > CurrentBestUCT ->
  737      uct(RestChilds,M, UCT, ParentVisits, Child, Min, Max, BestChild)
  738    ;
  739      uct(RestChilds,M, CurrentBestUCT, ParentVisits, CurrentBestChild, Min, Max, BestChild)
  740    )
  741  ).
  742
  743
  744expand(ID, M,Theory, ParentCLL, DB, NodeID, Childs):-
  745  %format("  expanding...",[]),flush_output,
  746  theory_revisions(Theory,M,Revisions),
  747  !,
  748  assert_childs(Revisions,M,ID,ParentCLL,Childs),
  749  ( Childs \= [] ->
  750    Childs = [NodeID|_],
  751    retract(M:node(NodeID, Childs1, Parent , _, Theory1, Visited, Backscore)),
  752    format2(M,"\n[Expand ~w]",[NodeID]),
  753    Visited1 is Visited + 1,
  754    score_theory(Theory1,M,DB,CLL,BestTheory,NewTheory),
  755    format2(M," CLL: ~w]",[CLL]),
  756    %format("\nTree policy: ~w ~w]",[Score, Theory1]),
  757    M:mcts_best_score(BestScore),
  758
  759    %Ratio is BestScore / CLL,
  760    %( Ratio > 1.001 ->
  761
  762    ( M:local_setting(mcts_covering,true) ->
  763      length(NewTheory,NewTheoryL), %lemurc
  764      length(Theory1,Theory1L),
  765      ( NewTheoryL = Theory1L ->
  766        LengthCondition = true
  767      ;
  768        LengthCondition = false
  769      )
  770    ;
  771      LengthCondition = true
  772    ),
  773
  774
  775    ( ( CLL > BestScore, LengthCondition = true) ->
  776        format2(M,"\n[New best score: ~w ~w]",[CLL, BestTheory]),flush_output,
  777        retract(M:mcts_best_score(_)),
  778        retract(M:mcts_best_theory(_)),
  779        assert(M:mcts_best_score(CLL)),
  780        assert(M:mcts_best_theory(NewTheory)),
  781
  782        retract(M:mcts_best_theories_iteration(BestsIter)),
  783        M:mcts_iteration(Iteration),
  784        append(BestsIter,[Iteration],BestsIter1),
  785        assert(M:mcts_best_theories_iteration(BestsIter1)),
  786
  787
  788        retract(M:mcts_theories(Mlns)),
  789        Mlns1 is Mlns + 1,
  790        assert(M:mcts_theories(Mlns1))
  791    ;
  792      true
  793  ),
  794    assert(M:node(NodeID, Childs1, Parent , CLL, NewTheory, Visited1, Backscore))
  795  ;
  796    NodeID = -1
  797  ).
  798
  799
  800assert_childs([],_M,_,_,[]).
  801
  802assert_childs([Spec|Rest],M,P,PCLL,[ID1|Childs]):-
  803  %node(ID, CHILDRENS, PARENT, PSLL, MLN, VISITED, BACKSCORE)
  804  retract(M:lastid(ID)),
  805  %format(" ~w",[ID]),flush_output,
  806  ID1 is ID + 1,
  807  assert(M:lastid(ID1)),
  808  %SigmoidValue is ((1 / (1 + exp(-PCLL)))/0.5),
  809  (PCLL=:=1->
  810    SigmoidValue=1e20
  811  ;
  812    SigmoidValue is 1 / (1 -  PCLL)
  813  ),
  814  assert(M:node(ID1, [], P, 1 , Spec, 1 , SigmoidValue)),
  815  %assert(node(ID1, [], P, 1 , Spec, 0 , 0)),
  816  assert_childs(Rest,M,P,PCLL,Childs).
  817
  818
  819theory_length([],X,X).
  820
  821theory_length([T|R],K,K1):-
  822  theory_length(R,K,K0),
  823  T = rule(_,_,B,_,_),
  824  length(B,L),
  825  ( L > K0 ->
  826    K1 = L
  827  ;
  828    K1 = K0
  829  ).
  830
  831score_theory(Theory0,M,DB,Score,Theory,R3):-
  832  ( M:mcts_theories(0) ->
  833    Theory = Theory0
  834  ;
  835    theory_length(Theory0,0,Le),
  836    ( Le > 1 ->
  837%     mcts_best_theory(TheoryBest),
  838%     append(TheoryBest,Theory0,Theory)
  839      Theory = Theory0
  840    ;
  841      Theory = Theory0
  842    )
  843  ),
  844  learn_params(DB, M, Theory, R3, CLL),
  845  write3(M,'Updated refinement'),write3(M,'\n'),
  846  write_rules3(M,R3,user_output),
  847  Score = CLL,
  848  !.
  849
  850
  851backup(1,_M,_Reward,[]):-
  852  !.
  853
  854backup(NodeID,M,Reward,[Parent|R]):-
  855  ( retract(M:node(NodeID, Childs, Parent , PSLL, MLN, Visited, Backscore)) ->
  856    true
  857  ;
  858    format2(M,"\nNo node with ID ~w in backup",[NodeID]),
  859    throw(no_node_id(NodeID))
  860  ),
  861  ( PSLL=:=1->
  862    SigmoidValue=1e20
  863  ;
  864    SigmoidValue is 1 / (1 -  PSLL)
  865  ),
  866  ( Reward > SigmoidValue ->
  867    Backscore1 is Backscore + Reward,
  868    Reward1 is Reward
  869  ;
  870    Backscore1 is Backscore + SigmoidValue,
  871    Reward1 is SigmoidValue
  872    %Backscore1 is Backscore + Reward,
  873    %Reward1 is Reward
  874    ),
  875    %format("\n backup ~w ~w",[NodeID,MLN]),
  876    assert(M:node(NodeID, Childs, Parent , PSLL, MLN, Visited, Backscore1)),
  877    backup(Parent,M,Reward1,R).
  878
  879
  880theory_revisions_op(Theory,M,TheoryRevs):-
  881  setof(RevOp, Theory^revise_theory(Theory,M,RevOp), TheoryRevs),!.
  882
  883theory_revisions_op(_Theory,_M,[]).
  884
  885
  886theory_revisions_r(Theory,M,TheoryRevs):-
  887  theory_revisions_op(Theory,M,TheoryRevs1),
  888  %filter_add_rule(TheoryRevs11,TheoryRevs1),
  889
  890  ( TheoryRevs1 == [] ->
  891    TheoryRevs = []
  892  ;
  893    length(TheoryRevs1,L),
  894    random(0,L,K),
  895    nth0(K, TheoryRevs1,Revision),
  896    apply_operators([Revision],Theory,TheoryRevs)
  897  ).
  898
  899
  900theory_revisions(Theory,M,TheoryRevs):-
  901  theory_revisions_op(Theory,M,TheoryRevs1),
  902  apply_operators(TheoryRevs1,Theory,TheoryRevs).
  903
  904
  905apply_operators([],_Theory,[]).
  906
  907apply_operators([add(Rule)|RestOps],Theory,[NewTheory|RestTheory]) :-!,
  908  append(Theory, [Rule], NewTheory),
  909  %nl,write(NewTheory),
  910  apply_operators(RestOps,Theory,RestTheory).
  911
  912apply_operators([add_body(Rule1,Rule2,_A)|RestOps],Theory,[NewTheory|RestTheory]) :-!,
  913  delete_matching(Theory,Rule1,Theory1),
  914  append(Theory1, [Rule2], NewTheory),
  915  %nl,write(NewTheory),
  916  apply_operators(RestOps,Theory,RestTheory).
  917
  918revise_theory(Theory,M,Ref):-
  919  specialize_theory(Theory,M,Ref).
  920
  921revise_theory(Theory,M,Ref):-
  922  generalize_theory(Theory,M,Ref).
  923
  924
  925generalize_theory(Theory,M,Ref):-
  926  length(Theory,LT),
  927  M:local_setting(max_rules,MR),
  928  LT<MR,
  929  add_rule(M,Ref).
  930
  931
  932add_rule(M,add(SpecRule)):-
  933  findall(HL , M:modeh(_,HL), HLS),
  934  length(HLS,L),
  935  L1 is L+1,
  936  P is 1/L1,
  937  generate_head(HLS,P,Head),
  938  get_next_rule_number(M,ID),
  939  Rule0 = rule(ID,Head,[],true,_),
  940  specialize_rule(Rule0,M,SpecRule,_Lit).
  941
  942generate_head([H|_T],_P,[H1:0.5,'':0.5]):-
  943  H=..[Pred|Args],
  944  length(Args,LA),
  945  length(Args1,LA),
  946  H1=..[Pred|Args1].
  947
  948generate_head([_H|T],P,Head):-
  949  generate_head(T,P,Head).
  950
  951
  952specialize_theory(Theory,M,Ref):-
  953  Theory \== [],
  954  choose_rule(Theory,M,Rule),
  955  specialize_rule(Rule,M,SpecRule,Lit),
  956  Ref = add_body(Rule,SpecRule,Lit),
  957  SpecRule = rule(_,_,_B,_,_).
  958
  959
  960specialize_rule(Rule,M,SpecRule,Lit):-
  961  M:mcts_modeb(BSL),
  962  specialize_rule_bl(BSL,M,Rule,SpecRule,Lit).
  963
  964
  965
  966
  967
  968specialize_rule_bl([Lit|_RLit],M,Rule,SpecRul,SLit):-
  969  Rule = rule(ID,LH,BL,true,Tun),
  970  remove_prob(LH,LH1),
  971  append(LH1,BL,ALL),
  972  specialize_rule_lit(Lit,M,ALL,SLit),
  973  append(BL,[SLit],BL1),
  974  (M:lookahead(SLit,LLit1);M:lookahead_cons(SLit,LLit1)),
  975  specialize_rule_la(LLit1,M,LH1,BL1,BL2),
  976  append(LH1,BL2,ALL2),
  977  extract_fancy_vars(ALL2,Vars1),
  978  length(Vars1,NV),
  979  M:local_setting(max_var,MV),
  980  NV=<MV,
  981  \+ banned_clause(M,LH1,BL2),
  982  SpecRul = rule(ID,LH,BL2,true,Tun).
  983
  984specialize_rule_bl([Lit|_RLit],M,Rule,SpecRul,SLit):-
  985  Rule = rule(ID,LH,BL,true,Tun),
  986  remove_prob(LH,LH1),
  987  append(LH1,BL,ALL),
  988  specialize_rule_lit(Lit,M,ALL,SLit),
  989
  990  \+ M:lookahead_cons(SLit,_),
  991
  992  append(BL,[SLit],BL1),
  993  append(LH1,BL1,ALL1),
  994  extract_fancy_vars(ALL1,Vars1),
  995  length(Vars1,NV),
  996  M:local_setting(max_var,MV),
  997  NV=<MV,
  998  M:local_setting(maxdepth_var,_MD),
  999  \+ banned_clause(M,LH1,BL1),
 1000  SpecRul = rule(ID,LH,BL1,true,Tun).
 1001
 1002
 1003specialize_rule_bl([_|RLit],M,Rule,SpecRul,Lit):-
 1004  specialize_rule_bl(RLit,M,Rule,SpecRul,Lit).
 1005
 1006
 1007specialize_rule_la([],_M,_LH1,BL1,BL1).
 1008
 1009specialize_rule_la([Lit1|T],M,LH1,BL1,BL3):-
 1010  copy_term(Lit1,Lit2),
 1011  M:modeb(_,Lit2),
 1012  append(LH1,BL1,ALL1),
 1013  specialize_rule_lit(Lit2,M,ALL1,SLit1),
 1014  append(BL1,[SLit1],BL2),
 1015  specialize_rule_la(T,M,LH1,BL2,BL3).
 1016
 1017
 1018
 1019remove_prob(['':_P],[]):-!.
 1020
 1021remove_prob([X:_|R],[X|R1]):-
 1022  remove_prob(R,R1).
 1023
 1024
 1025specialize_rule_lit(Lit,M,Lits,SpecLit):-
 1026  Lit =.. [Pred|Args],
 1027  extract_type_vars(Lits,M,TypeVars0),
 1028  remove_duplicates(TypeVars0,TypeVars),
 1029  take_var_args(Args,TypeVars,Args1),
 1030  SpecLit =.. [Pred|Args1],
 1031  \+ member_eq(SpecLit,Lits).
 1032
 1033choose_rule(Theory,M,Rule):-
 1034  ( M:local_setting(mcts_covering,true)	->
 1035    M:mcts_restart(Restart),
 1036    nth1(K,Theory,Rule),
 1037    K >= Restart
 1038  ;
 1039    member(Rule,Theory)
 1040  ).
 1041
 1042
 1043
 1044delete_matching([],_El,[]).
 1045
 1046delete_matching([El|T],El,T1):-!,
 1047  delete_matching(T,El,T1).
 1048
 1049delete_matching([H|T],El,[H|T1]):-
 1050  delete_matching(T,El,T1).
 set_lm(:Parameter:atom, +Value:term) is det
The predicate sets the value of a parameter For a list of parameters see https://friguzzi.github.io/cplint/ /
 1060set_lm(M:Parameter,Value):-
 1061  must_be(atom,Parameter),
 1062  must_be(nonvar,Value),
 1063  retract(M:local_setting(Parameter,_)),
 1064  assert(M:local_setting(Parameter,Value)).
 setting_lm(:Parameter:atom, -Value:term) is det
The predicate returns the value of a parameter For a list of parameters see https://friguzzi.github.io/cplint/ /
 1073setting_lm(M:P,V):-
 1074  must_be(atom,P),
 1075  M:local_setting(P,V).
 1076
 1077
 1078
 1079
 1080
 1081
 1082
 1083
 1084lemur_expansion((:- begin_bg), []) :-
 1085  prolog_load_context(module, M),
 1086  lm_input_mod(M),!,
 1087  assert(M:bg_on).
 1088
 1089lemur_expansion(C, M:bgc(C)) :-
 1090  prolog_load_context(module, M),
 1091  C\= (:- end_bg),
 1092  lm_input_mod(M),
 1093  M:bg_on,!.
 1094
 1095lemur_expansion((:- end_bg), []) :-
 1096  prolog_load_context(module, M),
 1097  lm_input_mod(M),!,
 1098  retractall(M:bg_on),
 1099  findall(C,M:bgc(C),L),
 1100  retractall(M:bgc(_)),
 1101  (M:bg(BG0)->
 1102    retract(M:bg(BG0)),
 1103    append(BG0,L,BG),
 1104    assert(M:bg(BG))
 1105  ;
 1106    assert(M:bg(L))
 1107  ).
 1108
 1109lemur_expansion((:- begin_in), []) :-
 1110  prolog_load_context(module, M),
 1111  lm_input_mod(M),!,
 1112  assert(M:in_on).
 1113
 1114lemur_expansion(C, M:inc(C)) :-
 1115  prolog_load_context(module, M),
 1116  C\= (:- end_in),
 1117  lm_input_mod(M),
 1118  M:in_on,!.
 1119
 1120lemur_expansion((:- end_in), []) :-
 1121  prolog_load_context(module, M),
 1122  lm_input_mod(M),!,
 1123  retractall(M:in_on),
 1124  findall(C,M:inc(C),L),
 1125  retractall(M:inc(_)),
 1126  (M:in(IN0)->
 1127    retract(M:in(IN0)),
 1128    append(IN0,L,IN),
 1129    assert(M:in(IN))
 1130  ;
 1131    assert(M:in(L))
 1132  ).
 1133
 1134lemur_expansion(output(P/A), [output(P/A)|TabDir]) :-
 1135  prolog_load_context(module, M),
 1136  lm_input_mod(M),
 1137  M:local_setting(tabling,auto),!,
 1138  tab(M,P/A,P1),
 1139  zero_clause(M,P/A,Z),
 1140  term_expansion((:- table P1),TabDir),
 1141  assert(M:zero_clauses([Z])).
 1142
 1143lemur_expansion(input(P/A), [input(P/A)|TabDir]) :-
 1144  prolog_load_context(module, M),
 1145  lm_input_mod(M),
 1146  M:local_setting(tabling,auto),!,
 1147  tab(M,P/A,P1),
 1148  zero_clause(M,P/A,Z),
 1149  term_expansion((:- table P1),TabDir),
 1150  assert(M:zero_clauses([Z])).
 1151
 1152lemur_expansion(begin(model(I)), []) :-
 1153  prolog_load_context(module, M),
 1154  lm_input_mod(M),!,
 1155  retractall(M:model(_)),
 1156  assert(M:model(I)),
 1157  assert(M:int(I)).
 1158
 1159lemur_expansion(end(model(_I)), []) :-
 1160  prolog_load_context(module, M),
 1161  lm_input_mod(M),!,
 1162  retractall(M:model(_)).
 1163
 1164lemur_expansion(At, A) :-
 1165  prolog_load_context(module, M),
 1166  lm_input_mod(M),
 1167  M:model(Name),
 1168  At \= (_ :- _),
 1169  At \= end_of_file,
 1170  (At=neg(Atom)->
 1171    Atom=..[Pred|Args],
 1172    Atom1=..[Pred,Name|Args],
 1173    A=neg(Atom1)
 1174  ;
 1175    (At=prob(Pr)->
 1176      A='$prob'(Name,Pr)
 1177    ;
 1178      At=..[Pred|Args],
 1179      Atom1=..[Pred,Name|Args],
 1180      A=Atom1
 1181    )
 1182	).
 1183
 1184
 1185:- multifile sandbox:safe_meta/2. 1186
 1187sandbox:safe_meta(lemur:induce_lm(_,_),[]).
 1188sandbox:safe_meta(lemur:set_lm(_,_), []).
 1189sandbox:safe_meta(lemur:setting_lm(_,_), []).
 1190
 1191:- thread_local lemur_file/1. 1192
 1193
 1194user:term_expansion((:- lemur), []) :-!,
 1195  prolog_load_context(source, Source),
 1196  asserta(lemur_file(Source)),  
 1197  prolog_load_context(module, M),
 1198  retractall(M:local_setting(_,_)),
 1199  findall(local_setting(P,V),default_setting_lm(P,V),L),
 1200  assert_all(L,M,_),
 1201  assert(lm_input_mod(M)),
 1202  retractall(M:rule_sc_n(_)),
 1203  assert(M:rule_sc_n(0)),
 1204  retractall(M:rule_ng_sc_n(_)),
 1205  assert(M:rule_ng_sc_n(0)),
 1206    M:dynamic((modeh/2,modeh/4,fixed_rule/3,banned/2,lookahead/2,
 1207    lookahead_cons/2,lookahead_cons_var/2,'$prob'/2,output/1,input/1,input_cw/1,
 1208    ref_clause/1,ref/1,model/1,neg/1,rule/5,determination/2,
 1209    bg_on/0,bg/1,bgc/1,in_on/0,in/1,inc/1,int/1,
 1210    query_rule/4,
 1211    zero_clauses/1,tabled/1,
 1212    fold/2)),
 1213  retractall(M:tabled(_)),
 1214  style_check(-discontiguous).
 1215
 1216user:term_expansion(end_of_file, end_of_file) :-
 1217  lemur_file(Source),
 1218  prolog_load_context(source, Source),
 1219  retractall(lemur_file(Source)),
 1220  prolog_load_context(module, M),
 1221  lm_input_mod(M),!,
 1222  make_dynamic(M),
 1223  retractall(lm_input_mod(M)),
 1224  style_check(+discontiguous).
 1225
 1226user:term_expansion(In, Out) :-
 1227  \+ current_prolog_flag(xref, true),
 1228  lemur_file(Source),
 1229  prolog_load_context(source, Source),
 1230  lemur_expansion(In, Out)