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])