2:- module( constrained_clauses,
3 [ learn_constrained/0
4 ]). 5
7:- meta_predicate ccl_newp(+,+,:,:,:,:,:,:,:,:,:,:,:,:). 8
9
11:- use_module(home(kb),
12 [get_example/3,
13 get_clause/5,
14 get_evaluation/2,
15 delete_clause/1,
16 delete_example/1,
17 store_clauses/2,
18 store_clause/4,
19 store_ex/3,
20 delete_all/1,
21 known/6]). 22:- use_module(home(gencon),
23 [gilppi/12,gilppi/14]). 24:- use_module(home(argument_types),
25 [types_of/3,type_restriction/2]).
26:- use_module(home(clause_heads),
27 [heads/1]).
28:- use_module(home(show_utils),
29 [show_kb/0,write_list/1]).
30:- use_module(home(evaluation),
31 [eval_examples/0,complete_chk/0,correct_chk/0,
32 covered_pos_examples/1,clear_evaluation/0,
33 covered_neg_examples/1,fp_hyp/1,change_evaluated/1]). 34:- use_module(home(lgg),
35 [set_lgg/2]). 36:- use_module(home(div_utils),
37 [best/2,
38 remove_v/3,
39 mysetof/3,
40 make_unique/2,
41 body2list/2]). 42:- use_module(home(var_utils),
43 [only_vars/2,clause_terms/2]). 44:- use_module(home(tdref_it),
45 [refinement_add_body_literal/3]). 46:- use_module(home(newpred),
47 [specialize_with_newpred/7]). 48:- use_module(home(interpreter),
49 [prooftrees/3]). 50:- use_module_if_exists(library(basics),
51 [member/2]). 52:- use_module_if_exists(library(strings),
53 [gensym/2]). 54:- use_module_if_exists(library(sets),
55 [subset/2]). 56:- use_module_if_exists(library(subsumes),
57 [variant/2]). 60
61
77
78learn_constrained:-
79 gilppi(ccinitialize,ccstop_c,ccquality_c,ccupdate,ccselect,
80 ccadd,ccfilter,ccone_of,ccspec,ccgen,ccl_newp,ccoutput).
81
82
83ccinitialize([(HL:[S1,S2]:HL,active)]):-
84 heads(HL),
85 store_clauses(HL,hypo),
86 eval_examples,
87 findall((ID,H,B,CL,E),(get_clause(ID,H,B,CL,hypo),
88 get_evaluation(ID,E), delete_clause(ID)),S1),
89 findall((ID1,M1,T1),(retract(prooftrees(ID1,M1,T1))),S2).
90
91ccinitialize_newp([(PS:[S1,S2]:PS,active)]):-
92 heads(HL),
93 store_clauses(HL,hypo),
94 eval_examples,
95 findall((H0:-B0),get_clause(_,H0,B0,_,hypo),PS),
96 findall((ID,H,B,CL,E),(get_clause(ID,H,B,CL,hypo),
97 get_evaluation(ID,E), delete_clause(ID)),S1),
98 findall((ID1,M1,T1),(retract(prooftrees(ID1,M1,T1))),S2).
99
100ccstop_c([_]).
101
102
103ccquality_c(_:[SC,SP]:_):-
104 sclauses(SC),
105 sprooftrees(SP),
106 ( (complete_chk,correct_chk) ->
107 true
108 ; fail
109 ).
110
111ccupdate(L,L).
112
113sclauses([]).
114sclauses([(ID,H,B,CL,E)|R]):-
115 sclauses(R),
116 assertz(kb:known(ID,H,B,CL,hypo,E)).
117
118sprooftrees([]):- change_evaluated(yes).
119sprooftrees([(ID,M,T)|R]):-
120 sprooftrees(R),
121 assertz(interpreter:prooftrees(ID,M,T)).
122
123
124ccselect(Partial_Sols,PS,active,Partial_Sols1):-
125 select_active(Partial_Sols,PS,Partial_Sols1).
126ccselect(Partial_Sols,PS,passive,Partial_Sols):-
127 select_passive(Partial_Sols,PS).
128
129select_active([(PS,active)|R],PS,[(PS,passive)|R]).
130select_active([P|R],PS,[P|R1]):-
131 select_active(R,PS,R1).
132
133select_passive(Partial_Sols,PS):-
134 candidates(Partial_Sols,[],Partial_Sols1),
135 best(Partial_Sols1,_-PS).
136
137candidates([],PSS,PSS).
138candidates([(PS:[SC,SP]:Hist,_)|R],PSS,PSS2):-
139 candidates(R,PSS,PSS1),
140 sclauses(SC), sprooftrees(SP),
141 ( complete_chk ->
142 covered_neg_examples(N), length(N,NN),
143 ccins(NN-(PS:[SC,SP]:Hist), PSS1,PSS2)
144 ; PSS1 = PSS2
145 ),
146 clear_evaluation,
147 findall(ID,(get_clause(ID,_,_,_,hypo),delete_clause(ID)),_).
148
149ccins(N-PS,[N1-PS1|R],[N1-PS1|R1]):-
150 N > N1,!,
151 ccins(N-PS,R,R1).
152ccins(X,L,[X|L]).
153
154ccadd(Partial_Sols,PSL,Partial_Sols1):-
155 append(Partial_Sols,PSL,Partial_Sols1).
156
157ccfilter(Partial_Sols,Partial_Sols1):-
158 ccfilter(Partial_Sols,[],Partial_Sols1).
159
160ccfilter([],Partial_Sols,Partial_Sols).
161ccfilter([X|R],Partial_Sols,Partial_Sols2):-
162 ccfilter1(X,Partial_Sols,Partial_Sols1),
163 ccfilter(R,Partial_Sols1,Partial_Sols2).
164
165ccfilter1(X,[],[X]).
166ccfilter1((PS:DB:Hist,M),[(PS1:DB1:Hist1,M1)|R],[(PS1:DB1:Hist1,M1)|R1]):-
167 ( (M = M1,clause_variants(PS,PS1)) ->
168 R1 = R
169 ; ccfilter1((PS:DB:Hist,M),R,R1)
170 ).
171
172ccone_of(_,M):-
173 ( complete_chk ->
174 M = spec
175 ; M = gen
176 ).
177
178ccspec(_:_:Hist,PSL):-
179 ccspec1(Hist,PSL),
180 write_l(PSL),
181 findall(ID,get_clause(ID,_,_,_,hypo),IDL),
182 delete_all(IDL).
183
184ccspec1(Hist,PSL):-
185 covered_neg_examples(NIDs),
186 fp_hyp(OR),
187 best(OR,I:_),
188 get_clause(I,H,B,_,hypo),
189 get_evaluation(I,evaluation(_,_,Pos,_,_,_,_,_,_)),
190 Pos \== [],
191 clause_terms((H:-B),Terms),
192 types_of(Terms,(H:-B),TTerms),
193 refinement_add_body_literal((H:-B),TTerms,CL),
194 length(CL,CLl),nl,write('no refs: '),write(CLl),nl,nl,
195 check_refinements(CL,NIDs,I,Hist,(H:-B),PSL).
196
197check_refinements(CL,NIDs,I,Hist,C,PSL):-
198 delete_clause(I),
199 clear_evaluation,
200 check_refinements(CL,NIDs,I,Hist,PSL),
201 store_clause(C,_,hypo,I),!.
202
203check_refinements([],_,_,_,[]).
204check_refinements([C|R],NID,I,Hist,PSL2):-
205 ( (constrained(C), \+(clause_in(C,Hist,_))) ->
206 store_clause(C,_,hypo,I),
207 eval_examples,
208 get_evaluation(I,evaluation(_,_,Pos,_,_,_,_,_,_)),
209 covered_neg_examples(NID1),
210 ( (genuine_subset(NID1,NID), Pos \== []) ->
211 findall((H:-B),get_clause(ID,H,B,_,hypo),PS),
212 findall((ID,H,B,CL,E),(get_clause(ID,H,B,CL,hypo),
213 get_evaluation(ID,E)),S1),
214 findall((ID1,M1,T1),retract(prooftrees(ID1,M1,T1)),S2),
215 PSL2 = [(PS:[S1,S2]:[C|Hist],active)|PSL1]
216 ; PSL2 = PSL1,clear_evaluation
217 ),
218 delete_clause(I)
219 ; PSL2 = PSL1
220 ),
221 check_refinements(R,NID,I,Hist,PSL1).
222
223
224constrained((H:-B)):-
225 only_vars(H,HV),
226 only_vars(B,BV),
227 remove_v(HV,BV,[]).
228
229clause_in((H:-true),[(H1:-B1)|R],R2):-
230 !,
231 ( (variant(H,H1), B1 == true) ->
232 R2 = R
233 ; clause_in((H:-true),R,R1),
234 R2 = [(H1:-B1)|R1]
235 ).
236clause_in((H:-B),[(H1:-B1)|R],R2):-
237 body2list(B,BL),
238 body2list(B1,B1L),!,
239 ( (variant(H,H1),length(BL,N),length(B1L,N)) ->
240 H = H1,
241 ( c_in(BL,B1L) ->
242 R2 = R
243 ; clause_in((H:-B),R,R1), R2 = [(H1:-B1)|R1]
244 )
245 ; clause_in((H:-B),R,R1), R2 = [(H1:-B1)|R1]
246 ).
247
248c_in([],[]).
249c_in([L|R],B):-
250 remove_v([L],B,B1),!,
251 c_in(R,B1).
252
253clause_variants([],[]).
254clause_variants([C|R],CL):-
255 clause_in(C,CL,CL1),
256 clause_variants(R,CL1).
257
258genuine_subset(L1,L2):-
259 length(L1,L1n),
260 length(L2,L2n),
261 L1n < L2n,
262 subset(L1,L2).
263
264ccgen(_:_:Hist,[(PS:[S1,S2]:Hist,active)]):-
265 covered_pos_examples(Cov),
266 findall(ID1:E1,(member(ID1,Cov),get_example(ID1,E1,_)),Cov1),
267 get_clause(ID,H,B,_,hypo),
268 mysetof(IDE:H,get_example(IDE,H,+),PH),
269 remove_v(Cov1,PH,P1),
270 P1 \== [],
271 ccgen2(ID,H,B,PH,B1),
272 store_clause((H:-B1),_,hypo,_),
273 eval_examples,
274 findall((ID2,H2,B2,CL2,E2),(get_clause(ID2,H2,B2,CL2,hypo),
275 get_evaluation(ID2,E2)),S1),
276 findall((ID3,M3,T3),(retract(prooftrees(ID3,M3,T3))),S2),
277 findall((H4:-B4),(get_clause(ID4,H4,B4,_,hypo),
278 delete_clause(ID4)),PS),
279 write_l([(PS:[S1,S2]:Hist,active)]).
280
281ccgen2(ID,H,B,PH,B1):-
282 delete_clause(ID),
283 body2list(B,BL),
284 ccgen3(BL,ID,H,PH,BL1),
285 ( BL1 == [] ->
286 B1 = true
287 ; body2list(B1,BL1)
288 ),
289 store_clause((H:-B),_,hypo,ID).
290
291ccgen3([],_,_,_,[]).
292ccgen3([L:M|R],ID,H,PH,B):-
293 ccgen3(R,ID,H,PH,B1),
294 store_clause((H:-L),_,hypo,ID),
295 eval_examples,
296 get_evaluation(ID,evaluation(_,_,Pos,_,_,_,_,_,_)),
297 delete_clause(ID),
298 ( remove_v(Pos,PH,[])->
299 B = [L:M|B1]
300 ; B = B1
301 ).
302
303
304ccl_newp(_:_:Hist,[(PS:[S1,S2]:Hist,active)], Initialize, Stop_C, Quality_C, Update,
305 Select, Add, Filter, One_of, Spec, Gen, L_newp,Output):-
306 fp_hyp(OR),
307 best(OR,I:_),
308 get_clause(I,H,B,_,hypo),
309 get_evaluation(I,evaluation(_,_,Pos,_,Neg,_,_,_,_)),
310 specialize_with_newpred((H:-B),Pos,Neg,NC,NPos,NNeg,NType),
311 delete_clause(I),
312 delete_old_ex(Elist),
313 store_newp_ex(NPos,NNeg,IDL0),
314 make_unique(IDL0,IDL),
315 assertz(NType),
316 store_clause(NC,_,hypo,I),
317 ccinitialize_newp(PSL),
318 gilppi(PSL, [], Initialize, Stop_C, Quality_C, Update, Select,
319 Add, Filter, One_of, Spec, Gen, L_newp,Output),
320 delete_all(IDL),
321 store_old_ex(Elist),
322 findall(ID0,(get_clause(ID0,H0,B0,_,constrained_clause),
323 delete_clause(ID0),
324 store_clause((H0:-B0),_,hypo,ID0)),_),
325 eval_examples,
326 findall((ID3,H3,B3,CL3,E3),(get_clause(ID3,H3,B3,CL3,hypo),
327 get_evaluation(ID3,E3)),S1),
328 findall((ID1,M1,T1),(retract(prooftrees(ID1,M1,T1))),S2),
329 findall((H2:-B2),(get_clause(ID2,H2,B2,_,hypo),
330 delete_clause(ID2)),PS).
331
332delete_old_ex([ex(ID,F,M)|R]):-
333 get_example(ID,F,M),
334 delete_example(ID),
335 delete_old_ex(R).
336delete_old_ex([]).
337
338store_old_ex([]).
339store_old_ex([ex(ID,F,M)|R]):-
340 store_ex(F,M,ID),
341 store_old_ex(R).
342
343store_newp_ex([],[],[]).
344store_newp_ex([],[F|R],[ID|R1]):-
345 store_ex(F,'-',ID),
346 store_newp_ex([],R,R1).
347store_newp_ex([F|R],L,[ID|R1]):-
348 store_ex(F,'+',ID),
349 store_newp_ex(R,L,R1).
350
351ccoutput([CL:_:_]):-
352 findall(ID,get_clause(ID,_,_,_,hypo),IDL),
353 delete_all(IDL),
354 store_clauses(CL,constrained_clause),
355 nl,nl,write('gilppi completed..........'),nl,nl,
356 show_kb.
357
358
359write_l([(CL:_:_,_)|R]):- write_list(CL),nl,write_l(R).
360write_l([])