1% MODULE rul EXPORTS
    2:- module( rul,
    3           [ learn_rul/0
    4           ]).    5
    6
    7% IMPORTS
    8:- use_module(home(kb),
    9                   [ get_example/3,get_clause/5, get_evaluation/2,store_ex/3,
   10                     delete_clause/1,store_clauses/2,store_clauses/3,store_clause/4,
   11                     delete_all/1]).   12:- use_module(home(argument_types),
   13              [type_sub/2,type_equal/4,replace_t/4]). 
   14:- use_module(home(gencon),
   15              [gilppi/12]).                    
   16:- use_module(home(show_utils),
   17              [show_kb/0]).                     
   18:- use_module(home(evaluation),
   19              [eval_examples/0,covered_pos_examples/1]).   20:- use_module(home(lgg),
   21                   [set_lgg/2]).   22:- use_module(home(div_utils),
   23                   [different_predicates/2,
   24                    remove_v/3, 
   25                    mysetof/3]).   26:- use_module(home(var_utils),
   27                   [only_vars/2]).   28:- use_module(home(td_basic),
   29                   [append_body/3]).   30:- use_module(home(newpred),
   31                  [is_newpred/1]).   32:- use_module_if_exists(library(basics),
   33                      [member/2]).   34:- use_module_if_exists(library(strings),
   35                      [gensym/2]).   36
   37% METAPREDICATES
   38% none
   39
   40
   41%***********************************************************************
   42%*	
   43%* module: rul.pl
   44%*									
   45%* author: I.Stahl              date:7/93	
   46%*									
   47%* changed:								
   48%*									
   49%*									
   50%* description: instantiation of gilppi for RUL-programs
   51%*		
   52%* 
   53%* see also:								
   54%*									
   55%***********************************************************************
   56
   57learn_rul:-
   58   gilppi(initialize,stop_c, quality_c, update, select, add, filter,
   59          one_of, spec, gen, l_newp,output).
   60
   61
   62
   63
   64initialize([HL:active]):-
   65   mysetof(E,I^get_example(I,E,'+'),Elist),
   66   different_predicates(Elist,Elist1),
   67   initialize1(Elist1,HL).
   68
   69initialize1([],[]).
   70initialize1([[E|ER]|R],HL):-
   71   initialize1(R,HL0),
   72   functor(E,T,_),
   73   mysetof(A,M^(member(M,[E|ER]),arg(1,M,A)),Alist),
   74   different_predicates(Alist,Alist1),
   75   initialize2(Alist1,T,HL1),
   76   append(HL1,HL0,HL).
   77
   78initialize2([],_,[]).
   79initialize2([A|R],T,[(H:-true)|R1]):-
   80   set_lgg(A,A1),
   81   H =.. [T,A1],
   82   initialize2(R,T,R1).
   83
   84
   85stop_c([_]).
   86
   87quality_c([]).
   88quality_c([(H:-B)|R]):-
   89   only_vars(H,HV),
   90   only_vars(B,BV),
   91   remove_v(BV,HV,[]),
   92   quality_c(R).
   93
   94update(L,L).
   95
   96select(Partial_Sols,PS,active,Partial_Sols1):-
   97   select_active(Partial_Sols,PS,Partial_Sols1).
   98select(Partial_Sols,PS,passive,Partial_Sols):-
   99   select_passive(Partial_Sols,PS).
  100
  101select_active([PS:active|R],PS,[PS:passive|R]).
  102select_active([P|R],PS,[P|R1]):-
  103   select_active(R,PS,R1).
  104
  105select_passive([PS:_],PS):- !.
  106select_passive([PS:_|R],PS2):-
  107   select_passive(R,PS1),
  108   most_specific(PS,PS1,PS2).
  109
  110most_specific(PS,PS1,PS2):-
  111   (   more_specific(PS,PS1) ->
  112       PS2 = PS
  113   ;   PS2 = PS1
  114   ).
  115
  116more_specific(Spec,Gen):-
  117   copy_term((Spec,Gen),(Spec0,Gen0)),
  118   normalize(Spec0,Spec1),
  119   normalize(Gen0,Gen1),
  120   rename_types(Gen1,Spec1,Spec2,Tlist),
  121   store_clauses(Spec2,type,IDS),
  122   store_clauses(Gen1,type,IDG),
  123   append(IDS,IDG,IDA),
  124   (   more_spec(Tlist) ->
  125       delete_all(IDA)
  126   ;   delete_all(IDA),!,
  127       fail
  128   ).
  129
  130
  131more_spec([]).
  132more_spec([Spec:Gen|R]):-
  133   type_sub(Gen,Spec),
  134   more_spec(R).
  135
  136normalize([],[]).
  137normalize([(H:-B)|R],[(H:-B1)|R1]):-
  138   normalize(R,R1),
  139   only_vars(H,HV),
  140   only_vars(B,BV),
  141   remove_v(BV,HV,RV),
  142   normalize(RV,B,B1).
  143
  144normalize([V],true,all(V)):- !.
  145normalize([],B,B).
  146normalize([V|R],B,(all(V),B1)):-
  147   normalize(R,B,B1).
  148
  149rename_types(Gen,Spec,Spec1,Tlist):-
  150   mysetof(Pred,H^B^(member((H:-B),Gen),functor(H,Pred,1)),Plist),
  151   rename_t(Plist,Tlist),
  152   transform_t(Spec,Spec1,Tlist).
  153
  154rename_t([],[]).
  155rename_t([P|R],[P1:P|R1]):-
  156   rename_t(R,R1),
  157   gensym(P,P1).
  158
  159transform_t([],[],_).
  160transform_t([(H:-B)|R],[(H1:-B1)|R1],Tlist):-
  161   transform_t(R,R1,Tlist),
  162   transform_t1((H,B),Tlist,(H1,B1)).
  163
  164transform_t1((A,B),Tlist,(A1,B1)):-
  165   !,transform_t1(A,Tlist,A1),
  166   transform_t1(B,Tlist,B1).
  167transform_t1(true,_,true):- !.
  168transform_t1(A,Tlist,A1):-
  169   A =.. [Pred,Arg],
  170   (   member(Pred1:Pred,Tlist) ->
  171       A1 =.. [Pred1,Arg]
  172   ;   A1 = A
  173   ).
  174
  175
  176
  177
  178add(Partial_Sols,PSL,Partial_Sols1):-
  179   append(PSL,Partial_Sols,Partial_Sols1).
  180
  181filter([],[]).
  182filter([CL|R],[CL1|R2]):-
  183   filter(R,CL,R1,CL1),
  184   filter(R1,R2).
  185filter([],CL,[],CL).
  186filter([CL1:A|R],CL:B,R1,CL2):-
  187   (   more_specific(CL,CL1) ->
  188       (   (B == active ; A == passive) ->
  189           filter(R,CL:B,R1,CL2)
  190       ;   filter(R,CL1:A,R1,CL2)
  191       )
  192   ;   (   more_specific(CL1,CL) ->
  193           (   (A == active; B == passive) ->
  194               filter(R,CL1:A,R1,CL2)
  195           ;   filter(R,CL:B,R1,CL2)
  196           )
  197       ;   R1 = [CL1:A|R0],
  198           filter(R,CL:B,R0,CL2)
  199       )
  200    ).
  201
  202
  203
  204one_of(PS,M):-
  205   store_clauses(PS,hypo,IDL),
  206   eval_examples,
  207   mysetof(ID:P,get_example(ID,P,+),Pos),
  208   rem_other_covered(IDL,Pos,Pos1),
  209   delete_all(IDL),
  210   (   Pos1 = [] ->
  211       M = spec
  212   ;   M = gen
  213   ).
  214
  215
  216spec(PS,PSL):-
  217   store_clauses(PS,hypo,IDL),
  218   eval_examples,
  219   mysetof(P,ID0^H0^B0^CL0^L0^(get_clause(ID0,H0,B0,CL0,L0),functor(H0,P,1)),
  220           Predlist),
  221   spec(IDL,Predlist,PSL).
  222
  223spec([],_,[]):- 
  224   mysetof((H1:-B1),ID1^CL^(get_clause(ID1,H1,B1,CL,hypo),
  225                            delete_clause(ID1)),_).
  226spec([ID|R],Preds,PSL):-
  227   get_clause(ID,H,B,_,_),
  228   (   specable(H,B,RV) ->
  229       get_evaluation(ID,evaluation(_,_,Pos,_,_,_,_,_,_)),
  230       remove_other_covered(H,ID,Pos,Pos1),
  231       delete_clause(ID),
  232       spec_c(RV,H,B,Preds,ID,Pos1,PSL0),
  233       (   PSL0 \== [] ->
  234           PSL0 = PSL,
  235           mysetof((H1:-B1),ID1^CL^(get_clause(ID1,H1,B1,CL,hypo),
  236                                    delete_clause(ID1)),_)
  237       ;   store_clause((H:-B),_,hypo,ID),
  238           spec(R,Preds,PSL)
  239       )
  240   ;   spec(R,Preds,PSL)
  241   ).
  242
  243
  244specable(H,B,RV):-
  245   only_vars(H,HV),
  246   only_vars(B,BV),
  247   remove_v(BV,HV,RV),
  248   RV \== [],!.
  249
  250remove_other_covered(H,ID,Pos,Pos1):-
  251   functor(H,F,N),functor(H1,F,N),
  252   mysetof(ID0,H1^B1^CL1^get_clause(ID0,H1,B1,CL1,hypo),IDL0),
  253   remove_v([ID],IDL0,IDL),
  254   rem_other_covered(IDL,Pos,Pos1),!.
  255
  256rem_other_covered([],Pos,Pos).
  257rem_other_covered([ID|R],Pos,Pos2):-
  258   rem_other_covered(R,Pos,Pos1),
  259   get_evaluation(ID,evaluation(_,_,P,_,_,_,_,_,_)),
  260   remove_v(P,Pos1,Pos2).
  261
  262
  263spec_c([],_,_,_,_,_,[]).
  264spec_c([V|R],H,B,Predlist,ID,Pos,PSL):-
  265   spec_c(R,H,B,Predlist,ID,Pos,PSL0),
  266   spec_c1(Predlist,V,H,B,ID,Pos,PSL1),
  267   append(PSL0,PSL1,PSL).
  268
  269spec_c1([],_,_,_,_,_,[]).
  270spec_c1([Pred|R],V,H,B,ID,Pos,PSL):-
  271   copy_term((V,H,B),(V1,H1,B1)),
  272   Lit =.. [Pred,V1],
  273   append_body((H1:-B1),Lit,C),
  274   store_clause(C,_,hypo,ID),
  275   eval_examples,
  276   get_evaluation(ID,evaluation(_,_,Pos1,_,_,_,_,_,_)),
  277   delete_clause(ID),
  278   (   remove_v(Pos1,Pos,[]) ->
  279       mysetof((H2:-B2),ID2^CL^get_clause(ID2,H2,B2,CL,hypo),RestPS),
  280       PSL = [[C|RestPS]:active|PSL0]
  281   ;   PSL = PSL0
  282   ),
  283   spec_c1(R,V,H,B,ID,Pos,PSL0).
  284
  285
  286
  287gen(PS,[[(H:-true)|RestPS]:active]):-
  288   store_clauses(PS,hypo),
  289   eval_examples,
  290   covered_pos_examples(Cov),
  291   get_clause(ID,H,_,_,hypo),
  292   mysetof(IDE,H^(get_example(IDE,H,+)),PH),
  293   remove_v(Cov,PH,P1),
  294   P1 \== [],
  295   delete_clause(ID),
  296   mysetof((H2:-B2),ID2^CL2^(get_clause(ID2,H2,B2,CL2,hypo),
  297                             delete_clause(ID2)),RestPS).
  298   
  299
  300
  301
  302
  303
  304l_newp(PS,[Clist1:active],_,_,_,_,_,_,_,_,_,_,_,_):-
  305   store_clauses(PS,hypo),
  306   eval_examples,
  307   get_all_clauses(Clist),
  308   correct_with_newp(Clist,Clist1).
  309
  310get_all_clauses([(H:-B):Pos:RV|R]):-
  311   get_clause(ID,H,B,_,hypo),
  312   get_evaluation(ID,evaluation(_,_,Pos,_,_,_,_,_,_)),
  313   only_vars(H,HV), only_vars(B,BV),
  314   remove_v(BV,HV,RV),
  315   delete_clause(ID),
  316   get_all_clauses(R).
  317get_all_clauses([]).
  318
  319correct_with_newp([],[]).
  320correct_with_newp([(H:-B):_:[]|R],[(H:-B)|R1]):-
  321   !,correct_with_newp(R,R1).
  322correct_with_newp([(H:-B):Pos:RV|R],R2):-
  323   correct_with_newp(R,R1),
  324   c_with_newp(RV,B,B1,Newps),
  325   instances(Newps,Pos,H,Elist),
  326   initialize1(Elist,HL),
  327   append([(H:-B1)|R1],HL,R2).
  328
  329c_with_newp([],B,B,[]).
  330c_with_newp([V],true,New,[New]):-
  331   !,gensym(newp,Newp),
  332   New =.. [Newp,V].
  333c_with_newp([V|R],B,(New,B1),[New|R1]):-
  334   c_with_newp(R,B,B1,R1),
  335   gensym(newp,Newp),
  336   New =.. [Newp,V].
  337
  338instances([],_,_,[]).
  339instances([New|R],Pos,H,[NewE|R1]):-
  340   instances(R,Pos,H,R1),
  341   mysetof(New,I^J^H^(member(I:H,Pos),store_ex(New,+,J)),NewE).
  342
  343output([CL]):- 
  344   mysetof(PN,H^B^R^(member((H:-B),CL),H =.. [PN|R], is_newpred(PN)),Newpredlist),
  345   minimize_output(Newpredlist,CL,CL1),
  346   store_clauses(CL1,rul), show_kb.
  347
  348minimize_output([],CL,CL).
  349minimize_output([P|R],CL,CL2):-
  350   findall(P1,(member(P1,R), type_equal(P,P1,[P:P1],CL)),P1L),
  351   replace_t(CL,P1L,P,CL1),
  352   findall(I,(member(NP,P1L),get_example(I,NPP,_),NPP =.. [NP|_]),IDL),
  353   delete_all(IDL),
  354   remove_v(P1L,R,R1),
  355   minimize_output(R1,CL1,CL2)