1% MODULE foil  EXPORTS
    2
    3:- module(foil,
    4        [ learn_foil/0,
    5          infogain/3 ]).    6
    7
    8% IMPORTS
    9
   10:- use_module(home(kb),
   11                  [store_clause/4, get_evaluation/2, delete_clause/1,
   12                   get_example/3,delete_example/1,get_clause/5,known/6,store_ex/3]).   13
   14:- use_module(home(evaluation),
   15                  [eval_examples/0, encoding_length_examples/1,
   16                   encoding_length_clause/2]).   17
   18:- use_module(home(tdref_it),
   19                  [refinement_add_body_literal/2]).   20
   21:- use_module(home(div_utils),
   22                  [body2list/2,log2/2,log2nueberk/3,mysetof/3]).   23
   24:- use_module(home(gencon),
   25                  [gilppi/12]).   26
   27:- use_module(home(show_utils),
   28                  [show_kb/0]).   29
   30
   31
   32% METAPREDICATES
   33% none
   34
   35%************************************************************************
   36%* 
   37%* module: foil.pl
   38%*
   39%* author:      Irene Stahl      date:  1. 7. 1993
   40%*            
   41%* changed:   
   42%*             
   43%* description: simple implementation of infogain heuristic
   44%*              foil as instantiation of the generic algorithm (25. 11. 93)
   45%*              
   46%* see also:    
   47%*                            
   48%************************************************************************
   49
   50learn_foil:-
   51   gilppi(initialize,stop_c, quality_c, update, select, add, filter,
   52          one_of, spec, gen, l_newp,output).
   53
   54
   55:- dynamic(el_ex/1).   56:- dynamic(total_ex/1).   57initialize([([MGT]:0,active)]):-
   58   mysetof((P,N),ID^L^(get_example(ID,F,L),functor(F,P,N)),[(P1,N1)]),
   59   functor(MGT,P1,N1),
   60   encoding_length_examples(X),
   61   assert(el_ex(X)),
   62   mysetof(ID1,F1^L1^(get_example(ID1,F1,L1)),IDL),
   63   length(IDL,TE),
   64   assert(total_ex(TE)).
   65
   66
   67select([(C:G,active)|R],C,active,[(C:G,passive)|R]).
   68select([X|R],C,active,[X|R1]):-
   69   select(R,C,active,R1).
   70
   71
   72quality_c([C]):-
   73   store_clause(C,_,usr,ID),
   74   eval_examples,
   75   get_clause(ID,H,B,CL,_),
   76   get_evaluation(ID,E),
   77   (   arg(5,E,[]) ->
   78       arg(3,E,Pos),
   79       remove_covered_ex(Pos)
   80   ;   delete_clause(ID),
   81       assert(known(ID,H,B,CL,hypo,E)),!,fail
   82   ).
   83
   84remove_covered_ex([]).
   85remove_covered_ex([ID:Fact|R]):-
   86   delete_example(ID),
   87   assert(saved_ex(ID,Fact)),
   88   remove_covered_ex(R).
   89
   90update(_,[([MGT]:0,active)]):-
   91   mysetof((P,N),ID^(get_example(ID,F,'+'),functor(F,P,N)),[(P1,N1)]),
   92   functor(MGT,P1,N1),!.
   93update(_,[]).
   94
   95one_of(_,spec).
   96
   97spec([C],PSL):-
   98   refinement_add_body_literal(C,CL),
   99   infogain(CL,PSL).
  100   
  101add(PS,[],PS).
  102add(PS,[X|R],PS1):-
  103   insert_by_gain(X,PS,PS0),
  104   add(PS0,R,PS1).
  105
  106insert_by_gain(C:G,[(C1:G1,L)|R],[(C1:G1,L)|R1]):-
  107   G < G1,!,
  108   insert_by_gain(C:G,R,R1).
  109insert_by_gain(C:G,L,[([C]:G,active)|L]).
  110
  111
  112filter(L,L).
  113
  114stop_c(_):-
  115   \+(get_example(_,_,+)),!.
  116stop_c(CL):-
  117   stop_c1(CL,N),
  118   el_ex(X),
  119   N > X.
  120
  121stop_c1([],0).
  122stop_c1([[(H:-B)]|R],M):-
  123   stop_c1(R,M0),
  124   body2list(B,BL),
  125   encoding_length_clause([H:p|BL],M1),
  126   M is M0 + M1.
  127
  128output(_):-
  129   retract(saved_ex(ID,Fact)),
  130   store_ex(Fact,+,ID),
  131   output(_).
  132output(_):-
  133   retractall(total_ex(_)),
  134   retractall(el_ex(_)),
  135   show_kb.
  136   
  137
  138
  139   
  140   
  141
  142%************************************************************************
  143%*
  144%* predicate: info_gain/3
  145%*
  146%* syntax: infogain(+Clause,+Clause_refs,-CL)
  147%*
  148%* args: Clause.. Prolog clause that is refined
  149%*       Clause_refs .. list of prolog clauses, refinements of Clause
  150%*       CL.. list of clauses with their gain: CL = [C1:Gain1,..,Cn:Gainn]
  151%* 
  152%* description: Clause is an overgeneral clause, CL is the
  153%*              list of refinements of this overgeneral clause,
  154%*              CL = [C1,...,Cn]. infogain returns a list 
  155%*              CL = [C1:Gain_C1,..], where
  156%*              Gain is the information gain of Ci in comparison
  157%*              with the overgeneral clause
  158%*
  159%*************************************************************************
  160
  161
  162infogain(Clause,Ref_list,CL):-
  163   store_clause(Clause,_,gain,ID),
  164   eval_examples,
  165   get_evaluation(ID,evaluation(_,Tip,_,Tim,_,_,_,_,_)),
  166   delete_clause(ID),
  167   OTi is Tip / (Tip + Tim),
  168   log2(OTi,LNOTi),
  169   ITi is -LNOTi,
  170   infogain1(Ref_list,CL,ITi).
  171
  172infogain1([],[],_).
  173infogain1([C|R],R2,ITi):-
  174   infogain1(R,R1,ITi),
  175   store_clause(C,_,gain,ID),
  176   eval_examples,
  177   get_evaluation(ID,evaluation(_,Ti1p,_,Ti1m,_,_,_,_,_)),
  178   delete_clause(ID),
  179   (   Ti1p = 0 ->
  180       copy_term(C,C1),numbervars(C1,0,_),
  181       write('refuted: '),write(C1),
  182       nl,nl,
  183       R2 = R1
  184   ;   OTi1 is Ti1p/(Ti1p + Ti1m),
  185       log2(OTi1,LNOTi1),
  186       ITi1 is -LNOTi1,
  187       IG is Ti1p * ( ITi - ITi1),
  188       copy_term(C,C1),numbervars(C1,0,_),
  189       write('refined clause: '),write(C1),write('   '),write(IG),
  190       nl,nl,
  191       R2 = [C:IG|R1]
  192   ).
  193
  194infogain(Ref_list,CL):-
  195   get_clause(ID,_,_,_,hypo),
  196   get_evaluation(ID,evaluation(_,Tip,_,Tim,_,_,_,_,_)),
  197   delete_clause(ID),
  198   OTi is Tip / (Tip + Tim),
  199   log2(OTi,LNOTi),
  200   ITi is -LNOTi,
  201   infogain2(Ref_list,CL,ITi).
  202
  203
  204infogain2([],[],_).
  205infogain2([C|R],R2,ITi):-
  206   infogain2(R,R1,ITi),
  207   store_clause(C,_,gain,ID),
  208   eval_examples,
  209   get_evaluation(ID,evaluation(_,Ti1p,_,Ti1m,_,_,_,_,_)),
  210   encoding_length(Ti1p,X),
  211   (   C = (H:-B) ->
  212       body2list(B,BL),
  213       encoding_length_clause([H:p|BL],XE)
  214   ;   encoding_length_clause([C:p],XE)
  215   ),
  216   delete_clause(ID),
  217   (   (Ti1p = 0; XE > X) ->
  218       copy_term(C,C1),numbervars(C1,0,_),
  219       write('refuted: '),write(C1),
  220       nl,nl,
  221       R2 = R1
  222   ;   OTi1 is Ti1p/(Ti1p + Ti1m),
  223       log2(OTi1,LNOTi1),
  224       ITi1 is -LNOTi1,
  225       IG is Ti1p * ( ITi - ITi1),
  226       copy_term(C,C1),numbervars(C1,0,_),
  227       write('refined clause: '),write(C1),write('   '),write(IG),
  228       nl,nl,
  229       R2 = [C:IG|R1]
  230   ).
  231
  232encoding_length(PN,X):-
  233   total_ex(U),
  234   log2(U,LU),
  235   U1 is float(U),
  236   PN1 is float(PN),
  237   log2nueberk(U1,PN1,Y),
  238   X is LU + Y