1% MODULE newpred EXPORTS
    2:- module( newpred,
    3           [ specialize_with_newpred/5,
    4             specialize_with_newpred/7,
    5             specialize_with_newpred/2,
    6             is_newpred/1
    7           ]).    8
    9
   10% IMPORTS
   11:- use_module(home(kb),
   12                   [get_clause/5, get_evaluation/2,delete_clause/1,
   13                    store_clause/4,store_ex/3]).   14:- use_module(home(var_utils),
   15                   [only_vars/2]).   16:- use_module(home(div_utils),
   17                   [mysetof/3]).   18:- use_module(home(td_basic),
   19                   [append_body/3]).   20:- use_module(home(interpreter),
   21                   [prooftrees/3]).   22:- use_module(home(environment),
   23                   [ask_for_ex/1]).   24:- use_module(home(argument_types),
   25              [types_of/3,type_restriction/2]).   26:- use_module_if_exists(library(basics),
   27                      [member/2]).   28:- use_module_if_exists(library(sets),
   29                      [intersection/3]).   30:- use_module_if_exists(library(strings),
   31                      [gensym/2]).   32
   33% METAPREDICATES
   34% none
   35
   36
   37%***********************************************************************
   38%*	
   39%* module: newpred.pl
   40%*									
   41%* author: I.Stahl
   42%*									
   43%* changed:								
   44%*									
   45%*									
   46%* description: 
   47%* 
   48%* see also:								
   49%*									
   50%***********************************************************************
   51
   52
   53
   54%***********************************************************************
   55%*									
   56%* predicate: 	specialize_with_newpred/1
   57%*									
   58%* syntax:	specialize_with_newpred(+ID)
   59%*									
   60%* args:	ID .. Clause ID
   61%*									
   62%* description: 
   63%*									
   64%* see also:								
   65%*									
   66%***********************************************************************
   67
   68specialize_with_newpred(ID,(ID,L)):-
   69    mysetof((NC,Pos,Neg,TR),specialize_with_newpred(ID,NC,Pos,Neg,TR),L).
   70    
   71
   72%***********************************************************************
   73%*									
   74%* predicate: 	specialize_with_newpred/5
   75%*									
   76%* syntax:	specialize_with_newpred(+ID,-Newclause,-Pos,-Neg,-Typerestriction)
   77%*									
   78%* args:	ID .. Clause ID, Newclause.. specialized clause
   79%*              Pos.. positive examples for the new predicate
   80%*              Neg.. negative examples for the new predicate
   81%*              Typerestriction.. type restriction for the new predicate
   82%*									
   83%* description: 
   84%*									
   85%* see also:								
   86%*									
   87%***********************************************************************
   88
   89specialize_with_newpred(ID,NC,P,N,type_restriction(Newp2,TR)):-
   90   get_clause(ID,H,B,_,_),
   91   get_evaluation(ID,evaluation(_,_,Pos,_,Neg,_,_,_,_)),
   92   (   ( Pos = [] ; Neg = [] ) ->
   93       fail
   94   ;   only_vars((H,B),Vars),
   95       types_of(Vars,(H:-B),TVars),
   96       clause_instances(Pos,ID,H,B,Vars,PV),
   97       clause_instances(Neg,ID,H,B,Vars,NV),
   98       reduce_newpred_args(Vars,Vars,PV,NV,Vars1,P0,N0),
   99       gensym(newp,X),
  100       Newp =.. [X|Vars1],
  101       make_newp_ex(P0,X,P),
  102       make_newp_ex(N0,X,N),
  103       append_body((H:- B),Newp,NC),
  104       copy_term((Vars1,TVars,Newp),(Vars2,TVars2,Newp2)),
  105       make_type_restriction(Vars2,TVars2,TR)
  106   ).
  107
  108
  109
  110%***********************************************************************
  111%*									
  112%* predicate: 	specialize_with_newpred/7
  113%*									
  114%* syntax:	specialize_with_newpred(+Clause,+CPos,+CNeg,-Newclause,
  115%*                                      -Pos,-Neg,-Typerestriction)
  116%*									
  117%* args:	Clause.. clause to be specialised with new predicate
  118%*              CPos,CNeg.. pos./neg. examples covered by the clause
  119%*              Newclause.. specialized clause
  120%*              Pos.. positive examples for the new predicate
  121%*              Neg.. negative examples for the new predicate
  122%*              Typerestriction.. type restriction for the new predicate
  123%*									
  124%* description: 
  125%*									
  126%* see also:								
  127%*									
  128%***********************************************************************
  129
  130specialize_with_newpred((H:-B),Pos,Neg,NC,P,N,type_restriction(Newp2,TR)):-
  131   only_vars((H,B),Vars),
  132   types_of(Vars,(H:-B),TVars),
  133   clause_instances(Pos,ID,H,B,Vars,PV),
  134   clause_instances(Neg,ID,H,B,Vars,NV),
  135   reduce_newpred_args(Vars,Vars,PV,NV,Vars1,P0,N0),
  136   gensym(newp,X),
  137   Newp =.. [X|Vars1],
  138   make_newp_ex(P0,X,P),
  139   make_newp_ex(N0,X,N),
  140   append_body((H:- B),Newp,NC),
  141   copy_term((Vars1,TVars,Newp),(Vars2,TVars2,Newp2)),
  142   make_type_restriction(Vars2,TVars2,TR).
  143 
  144
  145
  146%***********************************************************************
  147%*									
  148%* predicate: 	clause_instances/5
  149%*									
  150%* syntax:	clause_instances(+Covered,+ID,+Head,+Body,+Vars,-Varinstances)
  151%*									
  152%* args:	Covered.. examples covered by clause ID
  153%*              ID .. clauseID
  154%*              Head,Body.. of clause ID, Vars.. variables of clause ID
  155%*              Varinstances.. instantiations of the clause variables according
  156%*               to Covered. If Vars = [V1,..,Vn] and |Covered| = m, then
  157%*               Varinstances = [[I11,..,I1n],..,[Im1,..,Imn]]
  158%*									
  159%* description: 
  160%*									
  161%* see also:								
  162%*									
  163%***********************************************************************
  164
  165clause_instances([],_,_,_,_,[]).
  166clause_instances([ID:Ex|R],IDC,H,B,Vars,[Vars1|R1]):-
  167   clause_instances(R,IDC,H,B,Vars,R1),
  168   copy_term((H,B,Vars),(Ex,B1,Vars1)),
  169   prooftrees(ID,success,Proofs),
  170   setof(PBody,member([IDC,Ex,PBody],Proofs),Bodies),
  171   body_instances(Bodies,B1).
  172
  173body_instances([],_).
  174body_instances([B|R],B1):-
  175   body_instances(R,B1),
  176   body_inst(B,B1).
  177
  178body_inst([],true):- !.
  179body_inst([[_,B,_]|R],(B,R1)):-
  180   !, (   \+(ground(B)) ->
  181          ask_for_ex(B)
  182      ;   true
  183      ),
  184   body_inst(R,R1).
  185body_inst([[_,B,_]],B):-
  186   (   \+(ground(B)) ->
  187       ask_for_ex(B)
  188   ;   true
  189   ).
  190
  191   
  192%***********************************************************************
  193%*									
  194%* predicate: 	reduce_newpred_args/7
  195%*									
  196%* syntax:	reduce_newpred_args(+Vars,+Vars,+PCovered,+Ncovered,
  197%*                                  -Vars,-PCovered,-NCovered)
  198%*									
  199%* args:	Vars.. argument variables of the new predicate, to be 
  200%*                     reduced
  201%*              PCovered,NCovered.. Instantiations of these argument
  202%*                variables according to the Pos/Neg examples covered
  203%*                by the clause
  204%*									
  205%* description: discrimination based reduction
  206%*									
  207%* see also: CHAMP/DBC							
  208%*									
  209%***********************************************************************
  210
  211reduce_newpred_args([],Vars,PVars,NVars,Vars,PVars,NVars).
  212reduce_newpred_args([X|R],Vars,P,N,Vars2,P2,N2):-
  213   remove_arg(X,Vars,Vars1,P,P1,N,N1),
  214   intersection(P1,N1,[]),
  215   reduce_newpred_args(R,Vars1,P1,N1,Vars2,P2,N2).
  216reduce_newpred_args([_|R],Vars,P,N,Vars2,P2,N2):-
  217   reduce_newpred_args(R,Vars,P,N,Vars2,P2,N2).
  218
  219remove_arg(X,Vars,Vars1,P,P1,N,N1):-
  220   rem_arg(X,Vars,Vars1,1,Pos),!,
  221   rem_ins(P,Pos,P1),
  222   rem_ins(N,Pos,N1).
  223
  224rem_arg(X,[Y|R],R,Pos,Pos):-
  225   X == Y,!.
  226rem_arg(X,[Y|R],[Y|R1],Pos,Pos1):-
  227   Pos0 is Pos + 1,
  228   rem_arg(X,R,R1,Pos0,Pos1).
  229
  230rem_ins([],_,[]).
  231rem_ins([V|R],Pos,[V1|R1]):-
  232   rem_i(V,1,Pos,V1),
  233   rem_ins(R,Pos,R1).
  234
  235rem_i([_|R],P,P,R):- !.
  236rem_i([X|R],P,P1,[X|R1]):-
  237   P0 is P + 1,
  238   rem_i(R,P0,P1,R1).
  239
  240   
  241%***********************************************************************
  242%*									
  243%* predicate: 	make_newp_ex/3
  244%*									
  245%* syntax:	make_newp_ex(Varinstances,Newp_name,Newp_examples)
  246%*									
  247%* args:	Varinstances.. instantiations of the argument variables
  248%*                             [[I11,..,I1n],..,[Im1,..,Imn]]
  249%*              Newp_examples  [New_name(I11,..,I1n),..,Newp_name(Im1,..,Imn)]
  250%*									
  251%* description: 
  252%*									
  253%* see also:								
  254%*									
  255%***********************************************************************
  256
  257make_newp_ex([],_,[]).
  258make_newp_ex([V|R],X,[N|R1]):-
  259   N =.. [X|V],
  260   make_newp_ex(R,X,R1).
  261
  262
  263   
  264%***********************************************************************
  265%*									
  266%* predicate: 	make_type_restriction/4
  267%*									
  268%* syntax:	make_type_restriction(+Newpvars,+Typed_clause_vars,
  269%*                                    -Type_restriction)
  270%*									
  271%* args:	
  272%*									
  273%* description: 
  274%*									
  275%* see also:								
  276%*									
  277%***********************************************************************
  278
  279make_type_restriction([],_,[]).
  280make_type_restriction([X|R],TVars,[T|R1]):-
  281   make_type_restriction(R,TVars,R1),
  282   mtr(X,TVars,TN),
  283   T =.. [TN,X].
  284
  285mtr(X,[Y:T|_],T):- X == Y,!.
  286mtr(X,[_|R],T):- mtr(X,R,T).
  287
  288   
  289%***********************************************************************
  290%*									
  291%* predicate: 	is_newpred/1
  292%*									
  293%* syntax:	is_newpred(+Pred_Name)
  294%*									
  295%* args:	
  296%*									
  297%* description: checks whether Pred_Name is of the form 'newpXX'
  298%*									
  299%* see also:								
  300%*									
  301%***********************************************************************
  302
  303is_newpred(Name):-
  304   name(Name,[N,E,W,P|_]),
  305   name(newp,[N,E,W,P])