2:-module(pascal,[set_pascal/2,setting_pascal/2,
3 induce_pascal/2,op(500,fx,#),op(500,fx,'-#'),
4 induce_par_pascal/2,
5 6 test_pascal/7,
7 test_prob_pascal/6
11 12 45 ]). 46:-use_module(library(system)). 47:-use_module(library(lists)). 48:-use_module(library(lbfgs)). 49:-use_module(library(random)). 50:-use_module(library(auc)). 51:-use_module(ic_parser). 52
53:- thread_local pascal_input_mod/1,p/2. 54
55:- meta_predicate induce_pascal(:,-). 56:- meta_predicate induce_par_pascal(:,-). 57:- meta_predicate set_pascal(:,+). 58:- meta_predicate setting_pascal(:,-). 59:- meta_predicate test_pascal(:,+,-,-,-,-,-). 60:- meta_predicate test_prob_pascal(:,+,-,-,-,-). 61:- meta_predicate objective_func(:,-,-,-,-,-,-,-,-). 62:- meta_predicate induce_pascal_func(:,-,-,-,-,-,-,-,-). 63:- meta_predicate induce_pascal_func(:,-,-,-,-). 64:- meta_predicate induce_par_pascal_func(:,-,-,-,-,-,-,-,-). 65:- meta_predicate induce_par_pascal_func(:,-,-,-,-). 66
67
68:- multifile sandbox:safe_meta/2. 69
70sandbox:safe_meta(pascal:induce_par_pascal(_,_) ,[]).
71sandbox:safe_meta(pascal:induce_pascal(_,_), []).
72sandbox:safe_meta(pascal:test_prob_pascal(_,_,_,_,_,_), []).
73sandbox:safe_meta(pascal:test_pascal(_,_,_,_,_,_,_), []).
74sandbox:safe_meta(pascal:set_pascal(_,_), []).
75sandbox:safe_meta(pascal:setting_pascal(_,_), []).
76
78
79
80
82default_setting_pascal(examples,auto).
83
84default_setting_pascal(beamsize,10).
85default_setting_pascal(verbosity,3).
86default_setting_pascal(max_nodes,10). 87default_setting_pascal(optimal,no). 88default_setting_pascal(max_length,4).
90default_setting_pascal(max_lengths,[1,1,1,0]).
91
92default_setting_pascal(max_refinements, none).
93default_setting_pascal(num_samples,50). 94default_setting_pascal(max_initial_weight,0.1).
96default_setting_pascal(learning_algorithm,gradient_descent).
97default_setting_pascal(random_restarts_number,1).
99default_setting_pascal(learning_rate,fixed(0.01)).
100default_setting_pascal(gd_iter,1000).
101default_setting_pascal(epsilon,0.0001).
102default_setting_pascal(epsilon_fraction,0.00001).
103default_setting_pascal(regularizing_constant,5).
104default_setting_pascal(regularization,2).
106
107
108
109default_setting_pascal(lookahead, no). 110
111default_setting_pascal(max_rules,10).
112
113default_setting_pascal(logzero,log(0.01)).
114default_setting_pascal(zero,0.0001).
115default_setting_pascal(minus_infinity,-1.0e20).
117default_setting_pascal(bottom_clause,no).
118
119
120default_setting_pascal(fixed_parameters,no).
121
122default_setting_pascal(default_parameters,0).
134test_pascal(P,TestFolds,LL,AUCROC,ROC,AUCPR,PR):-
135 test_prob_pascal(P,TestFolds,_NPos,_NNeg,LL,LG),
136 compute_areas_diagrams(LG,AUCROC,ROC,AUCPR,PR).
147test_prob_pascal(M:P,TestFolds,NPos,NNeg,CLL,Results) :-
148 write2(M,'Testing\n'),
149 findall(Exs,(member(F,TestFolds),M:fold(F,Exs)),L),
150 append(L,TE),
151 test_no_area(TE,P,M,NPos,NNeg,CLL,Results).
152
153test_no_area(TestSet,P0,M,NPos,NNeg,CLL,Results):-
154 rule_to_int(P0,P),
155 test_ex(TestSet,P,M,Results,0,NPos,0,NNeg,0,CLL).
156
157
158test_ex([],_P,_M,[],Pos,Pos,Neg,Neg,CLL,CLL).
159
160test_ex([HT|TT],P,M,[Prob-Ex|TE],Pos0,Pos,Neg0,Neg,CLL0,CLL):-
161 convert_prob(P,Pr1),
162 163 length(P,N),
164 gen_initial_counts(N,MIP0), 165 test_theory_pos_prob([HT],M,Pr1,MIP0,MIP), 166 foldl(compute_prob,P,MIP,0,LL),
167 (is_pos(HT,M)->
168 Pos2 is Pos0+1,
169 Neg2 = Neg0,
170 Ex = HT,
171 Prob is exp(LL),
172 CLL2 is CLL0+LL
173 ;
174 Pos2 = Pos0,
175 Neg2 is Neg0+1,
176 Ex = (\+ HT),
177 Prob is exp(LL),
178 (Prob=:=1.0->
179 M:local_setting(logzero,LZ),
180 CLL2 is CLL0+LZ
181 ;
182 CLL2 is CLL0+log(1-Prob)
183 )
184 ),
185 test_ex(TT,P,M,TE,Pos2,Pos,Neg2,Neg,CLL2,CLL).
186
187is_pos(M,Mod):-
188 (Mod:local_setting(examples,keys(P))->
189 AtomP=..[P,M,pos],
190 Atom=..[P,M],
191 (current_predicate(Mod:P/1)->
192 (current_predicate(Mod:P/2)->
193 (Mod:AtomP;Mod:Atom)
194 ;
195 Mod:Atom
196 )
197 ;
198 Mod:AtomP
199 )
200 ;
201 AtomP=..[pos,M],
202 Mod:AtomP
203 ).
204
205
206compute_prob(rule(_,_,P),N,LL0,LL):-
207 LL is LL0+N*log(1-P).
216induce_pascal(M:Folds,P):-
217 induce_int(Folds,M,_DB,Program),
218 rule_to_ext(Program,P).
228induce_par_pascal(M:Folds,P):-
229 induce_par_int(Folds,M,_DB,Program),
230 rule_to_ext(Program,P).
231
232
233
234induce_par_int(Folds,M,DB,Program):-
235 M:in(Program00),
236 rule_to_int(Program00,Program0),
237 statistics(runtime,[_,_]),
238 (M:bg(BG)->
239 maplist(process,BG,BGP),
240 assert_all(BGP,M,BGRefs)
241 ;
242 BGRefs=[]
243 ),
244 findall(Exs,(member(F,Folds),M:fold(F,Exs)),Le),
245 append(Le,DB),
246 get_pos_neg(DB,M,Pos,Neg),
247 length(Pos,NP),
248 length(Neg,NN),
249 format2(M,"/* Inizio l'apprendimento dei pesi, N pos ~d N neg ~d */~n",[NP,NN]),
250 learn_param(Program0,M,Pos,Neg,Program,LL),
251 format2(M,"/* Log likelihood ~f~n*/~n",[LL]),
252 write_rules2(M,Program),
253 retract_all(BGRefs).
254
255rule_to_ext(P0,P):-
256 maplist(to_ext,P0,P).
257
258rule_to_int(P0,P):-
259 maplist(to_int,P0,P).
260
261to_ext(rule(_,((H,_):-(B,_BL)),P),rule((H1:-B),P)):-
262 maplist(remove_third_comp,H,H1).
263
264to_int(rule((H:-B),P),rule(r,((H1,[]):-(B,[])),P)):-
265 maplist(add_third_comp,H,H1).
266
267
268remove_third_comp((A,B,_),(A,B)).
269
270add_third_comp((A,B),(A,B,[])).
271
272induce_int(Folds,M,DB,Program):-
273 statistics(runtime,[_,_]),
276 findall(Exs,(member(F,Folds),M:fold(F,Exs)),Le),
277 append(Le,DB),
278 (M:bg(BG)->
279 maplist(process,BG,BGP),
280 assert_all(BGP,M,BGRefs)
281 ;
282 BGRefs=[]
283 ),
284 get_pos_neg(DB,M,Pos,Neg),
285 length(Pos,NP),
286 length(Neg,NN),
287 format2(M,"/* Learning start, N pos ~d N neg ~d */~n",[NP,NN]),
288 induce(Pos,Neg,M,Program,LL),
289 290 297 298 statistics(runtime,[_,T]),
299 T1 is T /1000,
300 findall(setting(A,B),M:local_setting(A,B),L),
301 302 length(Program,N1),
303 304 305 M:local_setting(optimal,Opt),
306 format2(M,"/* Learning time ~f seconds. */~N",[T1]),
307 format2(M,"/* Number of rules ~d */~n",[N1]),
308 format2(M,"/* ~p */~n~n",[L]),
309 310 format2(M,"/* Language bias ~n~p~n*/~n",[optimal(Opt)]),
311 format2(M,"/* Log likelihood ~f~n*/~n",[LL]),
312 write_rules2(M,Program),
313 retract_all(BGRefs).
315
316induce_pascal_func(M:Folds,XN,YN,XMin,XMax,YMin,YMax,Steps,POut):-
317 induce_int(Folds,M,DB,Prog),
318 rule_to_ext(Prog,POut),
319 get_hist(M,Hist),
320 obj_fun_hist_plot(DB,M,Prog,XN,YN,XMin,XMax,YMin,YMax,Steps,Hist).
321
322induce_pascal_func(M:Folds,XN,YN,Steps,Prog):-
323 induce_int(Folds,M,DB,ROut),
324 rule_to_ext(ROut,Prog),
325 get_hist(M,Hist),
326 get_min_max_hist(Hist,XN,YN,XMin,XMax,YMin,YMax),
327 obj_fun_hist_plot(DB,M,ROut,XN,YN,XMin,XMax,YMin,YMax,Steps,Hist).
328
329induce_par_pascal_func(M:Folds,XN,YN,XMin,XMax,YMin,YMax,Steps,POut):-
330 induce_par_int(Folds,M,DB,Prog),
331 rule_to_ext(Prog,POut),
332 get_hist(M,Hist),
333 obj_fun_hist_plot(DB,M,Prog,XN,YN,XMin,XMax,YMin,YMax,Steps,Hist).
334
335induce_par_pascal_func(M:Folds,XN,YN,Steps,Prog):-
336 induce_par_int(Folds,M,DB,ROut),
337 rule_to_ext(ROut,Prog),
338 get_hist(M,Hist),
339 get_min_max_hist(Hist,XN,YN,XMin,XMax,YMin,YMax),
340 obj_fun_hist_plot(DB,M,ROut,XN,YN,XMin,XMax,YMin,YMax,Steps,Hist).
349objective_func(M:Folds,P0,XN,YN,XMin,XMax,YMin,YMax,Steps):-
350 rule_to_int(P0,P),
351 findall(Exs,(member(F,Folds),M:fold(F,Exs)),L),
352 append(L,DB),
353 statistics(walltime,[_,_]),
354 obj_fun_plot(DB,M,P,XN,YN,XMin,XMax,YMin,YMax,Steps),
355 statistics(walltime,[_,CT]),
356 CTS is CT/1000,
358 format2(M,'Wall time ~f */~n',[CTS]),
359 true.
369obj_fun(DB,M,R0,XN,YN,XMin,XMax,YMin,YMax,Steps,X,Y,Z):- 370 compute_stats(DB,M,R0,NR,MIP,MI),
371 draw(NR,MIP,MI,M,XN,YN,XMin,XMax,YMin,YMax,Steps,X,Y,Z).
372
373compute_stats(DB,M,Program0,N,MIP,MI):-
374 get_pos_neg(DB,M,Pos,Neg),
375 convert_prob(Program0,Pr1),
376 377 length(Program0,N),
378 gen_initial_counts(N,MIP0), 379 test_theory_pos_prob(Pos,M,Pr1,MIP0,MIP), 380 test_theory_neg_prob(Neg,M,Pr1,N,MI). 381
382
383obj_fun_plot(DB,M,R0,XN,YN,XMin,XMax,YMin,YMax,Steps):-
384 obj_fun(DB,M,R0,XN,YN,XMin,XMax,YMin,YMax,Steps,X,Y,Z),
385 atomic_list_concat(['graph_obj_',XN,'_',YN,'.m'],File),
386 open(File,write,S),
387 write(S,'X = '),
388 write_mat(S,X),
389 write(S,'Y = '),
390 write_mat(S,Y),
391 write(S,'Z = '),
392 write_mat(S,Z),
393 write(S,"XP = 1 ./(1+exp(-X));
394 YP= 1./(1+exp(-Y));"),
395 write(S,"figure('Name','"),
396 write(S,objective_func_w(XN,YN,XMin,XMax,YMin,YMax,Steps)),
397 writeln(S,"','NumberTitle','off');"),
398 writeln(S,'surf(X,Y,Z)'),
399 write(S,"xlabel("),write(S,XN),writeln(S,");"),
400 write(S,"ylabel("),write(S,YN),writeln(S,");"),
401 writeln(S,"zlabel('-LogLik');"),
402 write(S,"figure('Name','"),
403 write(S,objective_func_p(XN,YN,XMin,XMax,YMin,YMax,Steps)),
404 writeln(S,"','NumberTitle','off');"),
405 writeln(S,'surf(XP,YP,Z)'),
406 write(S,"xlabel("),write(S,XN),writeln(S,");"),
407 write(S,"ylabel("),write(S,YN),writeln(S,");"),
408 writeln(S,"zlabel('-LogLik');"),
409 close(S).
410
411obj_fun_hist_plot(DB,M,R0,XN,YN,XMin,XMax,YMin,YMax,Steps,Hist):-
412 obj_fun(DB,M,R0,XN,YN,XMin,XMax,YMin,YMax,Steps,X,Y,Z),
413 get_hist(Hist,XN,YN,XH,YH,ZH),
414 atomic_list_concat(['graph_obj_traj_',XN,'_',YN,'.m'],File),
415 open(File,write,S),
416 write(S,'X = '),
417 write_mat(S,X),
418 write(S,'Y = '),
419 write_mat(S,Y),
420 write(S,'Z = '),
421 write_mat(S,Z),
422 write(S,'XH = ['),
423 maplist(write_col(S),XH),
424 writeln(S,'];'),
425 write(S,'YH = ['),
426 maplist(write_col(S),YH),
427 writeln(S,'];'),
428 write(S,'ZH = ['),
429 maplist(write_col(S),ZH),
430 writeln(S,'];'),
431 write(S,"XP = 1 ./(1+exp(-X));
432YP = 1 ./(1+exp(-Y));
433XHP = 1 ./(1+exp(-XH));
434YHP = 1 ./(1+exp(-YH));"),
435 write(S,"figure('Name','"),
436 write(S,objective_func_w(XN,YN,XMin,XMax,YMin,YMax,Steps)),
437 writeln(S,"','NumberTitle','off');"),
438 writeln(S,"plot3(XH,YH,ZH,'LineWidth',2)"),
439 write(S,"xlabel("),write(S,XN),writeln(S,");"),
440 write(S,"ylabel("),write(S,YN),writeln(S,");"),
441 writeln(S,"zlabel('-LogLik');
442hold on
443surf(X,Y,Z)
444hold off"),
445write(S,"figure('Name','"),
446write(S,objective_func_p(XN,YN,XMin,XMax,YMin,YMax,Steps)),
447writeln(S,"','NumberTitle','off');"),
448writeln(S,"plot3(XHP,YHP,ZH,'LineWidth',2)"),
449write(S,"xlabel("),write(S,XN),writeln(S,");"),
450write(S,"ylabel("),write(S,YN),writeln(S,");"),
451writeln(S,"zlabel('-LogLik');
452hold on
453surf(XP,YP,Z)
454hold off"),
455close(S).
456
457
458
459get_hist(M,Hist):-
460 findall(p(A,B),M:p(A,B),Hist).
461
462get_hist(Hist,XN,YN,XH,YH,ZH):-
463 maplist(get_w(XN),Hist,XH),
464 maplist(get_w(YN),Hist,YH),
465 maplist(get_z,Hist,ZH).
466
467get_min_max_hist(Hist,XN,YN,XMin,XMax,YMin,YMax):-
468 get_hist(Hist,XN,YN,XH,YH,_ZH),
469 min_list(XH,XMin),
470 max_list(XH,XMax),
471 min_list(YH,YMin),
472 max_list(YH,YMax).
473
474get_w(N,p(Ws,_),W):-
475 arg(N,Ws,W).
476
477get_z(p(_,Z),Z).
478
479write_mat(S,M):-
480 writeln(S,'['),
481 append(M0,[ML],M),!,
482 maplist(write_row(S),M0),
483 maplist(write_col(S),ML),
484 nl(S),
485 writeln(S,']'),
486 nl(S).
487
488write_row(S,R):-
489 maplist(write_col(S),R),
490 writeln(S,';').
491
492write_col(S,E):-
493 write(S,E),
494 write(S,' ').
495
496draw(NR,MIP,MI,M,XN,YN,XMin,XMax,YMin,YMax,Steps,X,Y,Z):-
497 XStep is (XMax-XMin)/Steps,
498 YStep is (YMax-YMin)/Steps,
499 cycle_X(NR,MIP,MI,M,XN,YN,XMin,XMax,YMin,YMax,XStep,YStep,X,Y,Z).
500
501initial_w(NR,M,W):-
502 M:local_setting(default_parameters,L),
503 is_list(L),!,
504 length(WA,NR),
505 maplist(init_w_par,L,WA),
506 W=..[w|WA].
507
508initial_w(NR,M,W):-
509 M:local_setting(default_parameters,V),
510 length(WA,NR),
511 maplist(init_w_par(V),WA),
512 W=..[w|WA].
513
514init_w_par(W,W).
515
516cycle_X(NR,MIP,MI,M,XN,YN,X,XMax,YMin,YMax,_,YStep,[XL],[YL],[ZL]):-
517 X>=XMax,!,
518 initial_w(NR,M,W),
519 setarg(XN,W,X),
520 cycle_Y(W,MIP,MI,M,YN,X,YMin,YMax,YStep,XL,YL,ZL).
521
522cycle_X(NR,MIP,MI,M,XN,YN,X,XMax,YMin,YMax,XStep,YStep,[XL|XT],[YL|YT],[ZL|ZT]):-
523 initial_w(NR,M,W),
524 setarg(XN,W,X),
525 cycle_Y(W,MIP,MI,M,YN,X,YMin,YMax,YStep,XL,YL,ZL),
526 X1 is X+XStep,
527 cycle_X(NR,MIP,MI,M,XN,YN,X1,XMax,YMin,YMax,XStep,YStep,XT,YT,ZT).
528
529cycle_Y(W,MIP,MI,M,YN,X,Y,YMax,_,[X],[Y],[Z]):-
530 Y>=YMax,!,
531 setarg(YN,W,Y),
532 evaluate_w(MIP,MI,W,M,_LN,Z).
533
534cycle_Y(W,MIP,MI,M,YN,X,Y,YMax,YStep,[X|XT],[Y|YT],[Z1|ZT]):-
535 setarg(YN,W,Y),
536 Y1 is Y+YStep,
537 evaluate_w(MIP,MI,W,M,_LN,Z),
538 Z1 is Z,
539 cycle_Y(W,MIP,MI,M,YN,X,Y1,YMax,YStep,XT,YT,ZT).
540
541
542evaluate_w(MIP,MI,W,M,LN,L):-
543 compute_likelihood_pos_w(MIP,W,1,0,LP),
544 compute_likelihood_neg_w(MI,W,LN), 545 compute_likelihood(LN,LP,M,L). 546
547compute_likelihood_neg_w([],_W,[]).
548
549compute_likelihood_neg_w([HMI|TMI],W,[HLN|TLN]):- 550 compute_likelihood_pos_w(HMI,W,1,0,HLN),
551 compute_likelihood_neg_w(TMI,W,TLN).
552
553compute_likelihood_pos_w([],_,_,LP,LP). 554
555compute_likelihood_pos_w([HMIP|TMIP],W,I,LP0,LP):- 556 arg(I,W,W0),
557 P is 1/(1+exp(-W0)), 558 LP1 is LP0-log(1-P)*HMIP,
559 I1 is I+1,
560 compute_likelihood_pos_w(TMIP,W,I1,LP1,LP).
561
562get_cl(([R],_),R).
563
564insert_max_rules([],_,[]):-!.
565
566insert_max_rules(_,0,[]):-!.
567
568insert_max_rules([H|T],N,[H|T1]):-
569 N1 is N - 1,
570 insert_max_rules(T,N1,T1).
571
575insert_starting_prob([], []):-!.
576
577insert_starting_prob([Rule|Pr0], [RuleProb|Pr1]):-
578 579 Rule = (r, Clause, _Stat),
580 RuleProb = rule(r, Clause, 1.0),
581 insert_starting_prob(Pr0,Pr1).
582
583generate_file_names(File,FileKB,FileBG,FileOut,FileL):-
584 atom_concat(File,'.kb',FileKB),
585 atom_concat(File,'.bg',FileBG),
586 atom_concat(File,'.l',FileL),
587 atom_concat(File,'.icl.out',FileOut).
588
589divide_pos_neg([],Pos,Pos,Neg,Neg):-!.
590
591divide_pos_neg([MH|MT],PosIn,PosOut,NegIn,NegOut):-
592 (pos(MH)->
593 PosOut=[MH|Pos],
594 NegOut=Neg
595 ;
596 PosOut=Pos,
597 NegOut=[MH|Neg]
598 ),
599 divide_pos_neg(MT,PosIn,Pos,NegIn,Neg).
600
602induce(Pos,Neg,M,Program,LL):-
603 prior_prob(Pos,Neg,M,NP,NN),
604 manage_modex(M), 605 606 M:local_setting(max_rules,MR),
607 M:local_setting(minus_infinity,MInf),
608 covering_loop1(Pos,Neg,M,NP,NN,MR,[],Program,MInf,LL).
609 610 611
612
613prior_prob(Pos,Neg,M,NP,NN):-
614 total_number(Pos,M,0,NP),
615 total_number(Neg,M,0,NN),
616 assert(M:npt(NP)),
617 assert(M:nnt(NN)).
618
619total_number([],_,N,N):-!.
620
621total_number([H|T],Mod,NIn,NOut):-
622 (Mod:mult(H,M)->
623 N1 is NIn+M
624 ;
625 N1 is NIn+1
626 ),
627 total_number(T,Mod,N1,NOut).
628
629manage_modex(M):-
630 get_modeb(M,BL0), 631 632 get_const_types(M,Const),
633 cycle_modex(BL0,M,'modeb',Const),
634 get_modeh(M,HL0),
635 636 cycle_modex(HL0,M,'modeh',Const).
637
638get_modeb(M,BL):-
639 findall((R,B),M:modeb(R,B),BL).
640
641get_modeh(M,BL):-
642 findall((R,B),M:modeh(R,B),BL).
643
646cycle_modex([],_,_,_).
647
648cycle_modex([(A,P)|T],M,Type,Const):-
649 P=..[F|Args],
650 count_values(Args,NL),
651 NL>0,!,
652 ModeR=..[Type,A,P],
653 retract(M:ModeR),!,
654 (M:local_setting(bottom_clause,no) ->
655 findall(Modex,create_new_modex_no_bc(Type,M,A,F,Args,Modex,Const),_)
656 ;
657 findall(Modex,create_new_modex(Type,M,A,F,Args,Modex,Const),_)
658 ),
659 cycle_modex(T,M,Type,Const).
660
661cycle_modex([(A,P)|T],M,Type,Const):-
662 ModeR=..[Type,A,P],
663 retract(M:ModeR),!,
664 assert(M:ModeR),
665 666 667 cycle_modex(T,M,Type,Const).
668
670count_values([],0).
671
672count_values([-#_|TP],N):-
673 !,
674 count_values(TP,N0),
675 N is N0+1.
676
677count_values([#_|TP],N):-
678 !,
679 count_values(TP,N0),
680 N is N0+1.
681
682count_values([_|TP],N):-
683 count_values(TP,N).
684
687create_new_modex(Type,M,A,F,Args,Modex,Const):-
688 length(Args,N),
689 length(Args1,N),
690 P0=..[F|Args1],
691 (builtin(P0)->
692 P=P0
693 ;
694 P=..[F,_|Args1]
695 ),
696 replace_values(Args1,Args,Args2,Const),
697 call(M:P),
698 NewP=..[F|Args2],
699 Modex=..[Type,A,NewP],
700 \+ call(M:Modex),
701 assert(M:Modex).
702
705create_new_modex_no_bc(Type,M,A,F,Args,Modex,Const):-
706 length(Args,N),
707 length(Args1,N),
708 P0=..[F|Args1],
709 (builtin(P0)->
710 P=P0
711 ;
712 P=..[F,_|Args1]
713 ),
714 replace_values_no_bc(Args1,Args,Args2,Const),
715 call(M:P),
716 NewP=..[F|Args2],
717 Modex=..[Type,A,NewP],
718 \+ call(M:Modex),
719 assert(M:Modex).
720
721
722replace_values([],[],[],_Const).
723
724replace_values([H|T1],[# Type|T],[H|T2],Const):-
725 !,
726 member((Type,Con),Const),
727 member(H,Con),
728 replace_values(T1,T,T2,Const).
729
730replace_values([H|T1],[-#_|T],[H|T2],Const):-!,
731 replace_values(T1,T,T2,Const).
732
733replace_values([H|T1],[+ Type|T],[+Type|T2],Const):-
734 !,
735 member((Type,Con),Const),
736 member(H,Con),
737 replace_values(T1,T,T2,Const).
738
739replace_values([_H|T1],[- Type|T],[-Type|T2],Const):-
740 !,
741 replace_values(T1,T,T2,Const).
742
743replace_values([H|T1],[H|T],[H|T2],Const):-
744 replace_values(T1,T,T2,Const).
745
746
747replace_values_no_bc([],[],[],_Const).
748
749replace_values_no_bc([H|T1],[# Type|T],[H|T2],Const):-
750 !,
751 member((Type,Con),Const),
752 member(H,Con),
753 replace_values_no_bc(T1,T,T2,Const).
754
755replace_values_no_bc([H|T1],[-# Type|T],[H|T2],Const):-
756 !,
757 member((Type,Con),Const),
758 member(H,Con),
759 replace_values_no_bc(T1,T,T2,Const).
760
761replace_values_no_bc([H|T1],[+ Type|T],[+Type|T2],Const):-
762 !,
763 member((Type,Con),Const),
764 member(H,Con),
765 replace_values_no_bc(T1,T,T2,Const).
766
767replace_values_no_bc([_H|T1],[- Type|T],[-Type|T2],Const):-
768 !,
769 replace_values_no_bc(T1,T,T2,Const).
770
771replace_values_no_bc([H|T1],[H|T],[H|T2],Const):-
772 replace_values_no_bc(T1,T,T2,Const).
773
774get_const_types(M,Const):-
775 findall(Types,get_types(M,Types),LT),
776 append(LT,T),
777 remove_duplicates(T,T1),
778 get_constants(T1,M,Const).
779
780
781get_types(M,Types):-
782 M:modeh(_,At),
783 At=..[_|Args],
784 get_args(Args,Types).
785
786get_types(M,Types):-
787 M:modeb(_,At),
788 At=..[_|Args],
789 get_args(Args,Types).
790
791
792get_args([],[]).
793
794get_args([+H|T],[H|T1]):-!,
795 get_args(T,T1).
796
797get_args([-H|T],[H|T1]):-!,
798 get_args(T,T1).
799
800get_args([#H|T],[H|T1]):-!,
801 get_args(T,T1).
802
803get_args([-#H|T],[H|T1]):-!,
804 get_args(T,T1).
805
806get_args([_|T],T1):-
807 get_args(T,T1).
808
809
810
811get_constants([],_Mod,[]).
812
813get_constants([Type|T],Mod,[(Type,Co)|C]):-
814 find_pred_using_type(Type,Mod,LP),
815 find_constants(LP,Mod,[],Co),
816 get_constants(T,Mod,C).
817
818find_pred_using_type(T,M,L):-
819 (setof((P,Ar,A),pred_type(T,M,P,Ar,A),L)->
820 true
821 ;
822 L=[]
823 ).
824
825pred_type(T,M,P,Ar,A):-
826 M:modeh(_,S),
827 S=..[P|Args],
828 length(Args,Ar),
829 scan_args(Args,T,1,A).
830
831pred_type(T,M,P,Ar,A):-
832 M:modeb(_,S),
833 S=..[P|Args],
834 length(Args,Ar),
835 scan_args(Args,T,1,A).
836
837scan_args([+T|_],T,A,A):-!.
838
839scan_args([-T|_],T,A,A):-!.
840
841scan_args([#T|_],T,A,A):-!.
842
843scan_args([-#T|_],T,A,A):-!.
844
845scan_args([_|Tail],T,A0,A):-
846 A1 is A0+1,
847 scan_args(Tail,T,A1,A).
848
849find_constants([],_Mod,C,C).
850
851find_constants([(P,Ar,_)|T],Mod,C0,C):-
852 functor(G,P,Ar),
853 builtin(G),!,
854 find_constants(T,Mod,C0,C).
855
856find_constants([(P,Ar,A)|T],Mod,C0,C):-
857 gen_goal(1,Ar,A,Args,ArgsNoV,V),
858 G0=..[P|Args],
859 (builtin(G0)->
860 G=G0
861 ;
862 G=..[P,_|Args]
863 ),
864 (setof(V,ArgsNoV^call_goal(Mod,G),LC)->
865 true
866 ;
867 LC=[]
868 ),
869 append(C0,LC,C1),
870 remove_duplicates(C1,C2),
871 find_constants(T,Mod,C2,C).
872
873call_goal(M,G):-
874 M:G.
875
876gen_goal(Arg,Ar,_A,[],[],_):-
877 Arg =:= Ar+1,!.
878
879gen_goal(A,Ar,A,[V|Args],ArgsNoV,V):-!,
880 Arg1 is A+1,
881 gen_goal(Arg1,Ar,A,Args,ArgsNoV,V).
882
883gen_goal(Arg,Ar,A,[ArgV|Args],[ArgV|ArgsNoV],V):-
884 Arg1 is Arg+1,
885 gen_goal(Arg1,Ar,A,Args,ArgsNoV,V).
886
887
888
889
890
893init_theory(0,[]).
894
895init_theory(N,[rule(bottom_pos,(([],[]):-([],[])),0.5),rule(bottom_neg,(([],[]):-([],[])),0.5)|Theory]):-
896 N1 is N - 1,
897 init_theory(N1, Theory).
898
899
900covering_loop(_Pos,[],[],Rules,Rules,_S):-!.
901
903covering_loop(Eplus,Eminus,EminusRem,NP,NN,NR,NR2,Rulesin,Rulesout,S):-
904 print_ex_rem(Eplus,Eminus),
905 908 initialize_agenda(Eplus,Eminus,NP,NN,Agenda,BestClause),
909 specialize(Agenda,Eplus,Eminus,NP,NN,0,BestClause,(Name,BestClauseOut,Heur,(NC,PC,Emc,Epnc))), 910 911 912 913 914 (BestClauseOut=null->
915 format("No more clauses.~n~n",[]),
916 print_ex_rem(Eplus,Eminus),
917 Rulesout=Rulesin,
918 NR2=NR,
919 EminusRem=Eminus
920 ;
921 set_output(S),
922 write_clause(BestClauseOut),
923 NR1 is NR+1,
924 925 926 numbervars(Name,0,_),
927 format("/* Rule n. ~d ",[NR1]),
928 write_term(Name,[numbervars(true)]),
929 format(" ~p ~p ~p ~n",[acc(Heur), negcov(NC), poscov(PC)]),
930 format("Neg traces ruled out:#~p */~n~n~n",[Emc]),
931 932 933 934 935 set_output(user_output),
936 print_new_clause(Name,BestClauseOut,Heur,NC,PC,Emc,Epnc),
937 flush_output(S),
938 remove_cov_examples(Emc,Eminus,EminusOut), 939 length(EminusOut,NN1), 940 Rulesout=[rule(Name,BestClauseOut,(heur(Heur),negcov(NC),poscov(PC),emc(Emc),epnc(Epnc)))|Rules1], 941 covering_loop(Eplus,EminusOut,EminusRem,NP,NN1,NR1,NR2,Rulesin,Rules1,S)
942 ).
943
944
945remove_cov_examples([],Eminus,Eminus):-!.
946
947remove_cov_examples([Ex|Rest],Eminus,EminusOut):-
948 delete(Eminus,Ex,Eminus1),
949 remove_cov_examples(Rest,Eminus1,EminusOut).
950
951
952
954
955
956covering_loop1(_Eplus,_Eminus,_M,_NP,_NN,0,Prog,Prog,LL,LL):-!.
957
959covering_loop1(Eplus,Eminus,M,NP,NN,MR,Prog0,Prog,LL0,LL):-
960 961 962 963 BestClause = (null,([], []:-[], []),(0,0,_,_,_)), 964 findBestICS([BestClause],M,Eplus,Eminus,NP,NN,Prog0,Prog0,Prog1,LL0,LL1,0),
965 write2(M,'New best theory: '),nl2(M),
966 write_rules2(M,Prog1),nl2(M),
967 write2(M,'Score '),write2(M,LL1),nl2(M),
968 969 MR1 is MR-1,
970 (LL1=:=LL0->
971 Prog=Prog0,
972 LL=LL0
973 ;
974 covering_loop1(Eplus,Eminus,M,NP,NN,MR1,Prog1,Prog,LL1,LL)
975 ).
976convert_rules_covering_loop1([],[]).
977
978convert_rules_covering_loop1([(Name,BestClauseOut,Heur,(NC,PC,Emc,Epnc))|T],[rule(Name,BestClauseOut,(heur(Heur),negcov(NC),poscov(PC),emc(Emc),epnc(Epnc)))|T1]):-
979 convert_rules_covering_loop1(T,T1).
980
981
982findBestICS(_Ag,M,_Ep,_Em,_NPT,_NNT,_,Prog,Prog,LL,LL,N):-
983 M:local_setting(max_nodes,NMax), 984 N>NMax,!.
985
986findBestICS(Agenda,M,Ep,Em,NPT,NNT,Prog00,Prog0,Prog,LL0,LL,N):-
987 988 format2(M,"Beam iteration ~d~n",[N]),
989 generate_new_agenda1(Ep,Em,M,NPT,NNT,Agenda,[],NewAgenda,Prog00,Prog0,Prog1,LL0,LL1), 990 991 992 993 994 N1 is N+1,!,
995 996 findBestICS(NewAgenda,M,Ep,Em,NPT,NNT,Prog00,Prog1,Prog,LL1,LL,N1).
997
999
1000generate_new_agenda1(_Ep,_Em,_M,_NPT,_NNT,[],NewAg,NewAg,_,Prog,Prog,LL,LL):-!.
1001
1002generate_new_agenda1(Ep,Em,M,NPT,NNT,[Rule0|Rest],NAgIn,NAgOut,Prog00,Prog0,Prog,LL0,LL):-
1003 1004 Rule0=(N,R0,P),
1005 Rule=rule(N,R0,P),
1006 format3(M,"Revision of one clause ",[]),nl3(M),
1007 write3(M,Rule),nl3(M),
1008 findall(RS, generalize_theory([Rule],M,RS),LRef), 1009 1010 1011 1012 evaluate_all_refinements(Ep,Em,M,NPT,NNT,LRef,NAgIn,NAg1,Prog00,Prog0,Prog1,LL0,LL1),!,
1013 format3(M,"Current best theory\n",[]),
1014 write_rules3(M,Prog1),nl3(M),
1015 write3(M,'LL '),write3(M,LL1),nl3(M),
1016
1017 1018 1019 generate_new_agenda1(Ep,Em,M,NPT,NNT,Rest,NAg1,NAgOut,Prog00,Prog1,Prog,LL1,LL).
1020
1021generalize_theory(Theory,M,Ref):-
1022 member(rule(N,R0,P0),Theory),
1023 (M:local_setting(bottom_clause,no) ->
1024 refine_no_bc(R0,M,R) 1025 ;
1026 refine(R0,M,R)
1027 ),
1028 M:local_setting(max_refinements, NR),
1029 ( NR=none ->
1030 delete(Theory,rule(N,R0,P0),T0),
1031 append(T0,[rule(r,R,0.5)],Ref)
1032 ;
1033 random_between(0, 100, RandValue),
1034 RandValue > 30,
1035 delete(Theory,rule(N,R0,P),T0),
1036 append(T0,[rule(N,R,P)],Ref)
1037 ).
1038
1041refine_no_bc(((H,HL):-(B,BL)),M,((H1,HL):-(B1,BL))):-
1042 length(B,BN),
1043 M:local_setting(max_lengths,[BodyLength,_,_,_]),
1044 BN<BodyLength,
1045 findall(BLB, M:modeb(_,BLB), BLS), 1046 specialize_rule_body(BLS,(H:-B),M,(H1:-B1)). 1047
1049refine_no_bc(((H,HL):-(B,BL)),M,((H1,HL):-(B1,BL))):-
1053 findall(HLH , M:modeh(_,HLH), HLS), 1054 refine_head_no_bc(HLS,(H:-B),M,(H1:-B1)). 1055
1056specialize_rule_body([Lit|_RLit],(H:-B),M,(H:-BL1)):- 1057 M:local_setting(lookahead,yes),
1058 check_recall(modeb,M,Lit,B),
1059 extract_lits_from_head(H,HL),
1060 append(HL,B,ALL),
1061 ( M:lookahead(Lit,LLit1)
1062 ;
1063 M:lookahead_cons(Lit,LLit1)
1064 ),
1065 specialize_rule_la(LLit1,M,HL,B,LLitOut),
1066 specialize_lit([Lit|LLitOut],M,ALL,SLitList),
1067 remove_copies(SLitList,ALL,SLitList1),
1068 append(B,SLitList1,BL1),
1069 linked_ic_nb(BL1,M,H).
1070
1071specialize_rule_body([Lit|_RLit],(H:-B),M,(H:-BL1)):- 1072 check_recall(modeb,M,Lit,B),
1073 extract_lits_from_head(H,HL),
1074 append(HL,B,ALL),
1075 specialize_lit([Lit],M,ALL,[SLit]),
1076 not_member(SLit,ALL),
1077 append(B,[SLit],BL1),
1078 linked_ic_nb(BL1,M,H).
1079
1080specialize_rule_body([_|RLit],Rule,M,SpecRul):-
1081 specialize_rule_body(RLit,Rule,M,SpecRul).
1082
1083not_member(X,List):-
1084 \+member(X,List),!.
1085
1086not_member(X,List):-
1087 X=..[P|Args],
1088 length(Args,N),
1089 length(Args1,N),
1090 C=..[P|Args1],
1091 member(C,List),
1092 not_eq_vars(Args,Args1).
1093
1094not_eq_vars([],[]):-!,fail.
1095
1096not_eq_vars([H|T],[H1|T1]):-
1097 ( (H==H1) ->
1098 (!,not_eq_vars(T,T1))
1099 ;
1100 !,true
1101 ).
1102
1103remove_copies([],_,[]):-!.
1104
1105remove_copies([H|T],ALL,T1):-
1106 member(H,ALL),!,
1107 remove_copies(T,ALL,T1).
1108
1109remove_copies([H|T],ALL,[H|T1]):-
1110 remove_copies(T,ALL,T1).
1111
1112specialize_rule_la([],_M,_LH1,BL1,BL1).
1113
1114specialize_rule_la([Lit1|T],M,LH1,BL1,BL3):-
1115 copy_term(Lit1,Lit2),
1116 M:modeb(_,Lit2),
1117 append(BL1,[Lit2],BL2),
1118 specialize_rule_la(T,M,LH1,BL2,BL3).
1119
1120specialize_lit([],_,_,[]):-!.
1121
1122specialize_lit(Lits,M,Rule,SpecLits):-
1123 extract_type_vars(Rule,M,TypeVars0),
1124 remove_duplicates(TypeVars0,TypeVars),
1125 specialize_lit_list(Lits,M,TypeVars,SpecLits).
1126
1127specialize_lit_list([],_,_,[]).
1128
1129specialize_lit_list([Lit|RLits],M,TypeVars,[SLit|RSLits]):- 1130 Lit =.. [Pred|Args],
1131 take_var_args(Args,TypeVars,Args1),
1132 SLit =.. [Pred|Args1],
1133 extract_type_vars([SLit],M,TypeVars0),
1134 append(TypeVars,TypeVars0,TypeVars1),
1135 remove_duplicates(TypeVars1,TypeVars2),
1136 specialize_lit_list(RLits,M,TypeVars2,RSLits).
1137
1138remove_duplicates([],[]).
1139
1140remove_duplicates([H|T],T1):-
1141 member_eq(H,T),!,
1142 remove_duplicates(T,T1).
1143
1144remove_duplicates([H|T],[H|T1]):-
1145 remove_duplicates(T,T1).
1146
1147refine_head_no_bc(Modehs,(H:-B),M,(HL1:-B)):-
1148 1149 1150 length(H,NDisjInH),
1151 extract_lits_from_head(H,HL),
1152 M:local_setting(max_lengths,[_,NDisj,NPlus,NMinus]),
1153 1154 (
1155 (
1156 NDisjInH<NDisj,
1157 ( 1158 (
1159 get_recall_modeh2(Modehs,M,Lits), 1160 length(Lits,NLits),
1161 get_number_of_samples(NLits,M,NPlus,NSamp),
1162 sample_possible_heads(NSamp,M,NLits,Lits,R),
1163 member(Disj,R),
1164 specialize_lit(Disj,M,B,SLits),
1165 append(H,[(+,SLits,[])],HL1),
1166 linked_ic_nb(B,M,HL1),
1167 check_absence(+,SLits,H)
1168 )
1169 ; 1170 (NMinus>0,
1171 member(Lit,Modehs),
1172 check_recall(modeh,M,Lit,HL),
1173 specialize_lit([Lit],M,B,SLit),
1174 append(H,[(-,SLit,[])],HL1),
1175 linked_ic_nb(B,M,HL1),
1176 check_absence(-,SLit,H)
1177 )
1178 )
1179
1180 )
1181 ; 1182 (
1183 H\=[],
1184 member((S,Lits,[]),H),
1185 append(Lits,B,ALL),
1186 refine_single_disj_no_bc(S,Lits,Modehs,M,SLits,HL,ALL),
1187 delete(H,(S,Lits,[]),H1),
1188 ( dif(SLits,[]) ->
1189 (append(H1,[(S,SLits,[])],HL1),
1190 check_absence(S,SLits,H1)
1191 )
1192 ;
1193 HL1=H1
1194 ),
1195 linked_ic_nb(B,M,HL1)
1196 )
1197 ).
1198
1199check_absence(S,L,H):-
1200 \+check_absence_int(S,L,H),!.
1201
1202check_absence_int(_S,L,H):-
1203 member((_,L1,[]),H),
1204 length(L,N),
1205 length(L1,N),
1206 check_lits(L,L1),!.
1207
1208check_lits([],_):-!.
1209
1210check_lits([H|T],L1):-
1211 H=..[P|Args],
1212 length(Args,N),
1213 length(Args1,N),
1214 C=..[P|Args1],
1215 member(C,L1),!,
1216 eq_vars(Args,Args1),
1217 check_lits(T,L1).
1218
1219eq_vars([],[]):-!.
1220
1221eq_vars([H|T],[H1|T1]):-
1222 H==H1,!,
1223 eq_vars(T,T1).
1224
([],[]).
1226
1227extract_lits_from_head([(_,H,_)|HL],HRes):-
1228 extract_lits_from_head(HL,HRes0),
1229 append(H,HRes0,HRes1),
1230 remove_duplicates(HRes1,HRes).
1231
1232check_recall(Mode,M,Lit,_Lits):-
1233 get_recall(Mode,M,Lit,*),!.
1234
1235check_recall(Mode,M,Lit,Lits):-
1236 Lit=.. [Pred|_Args],
1237 count_lit(Pred,Lits,N),
1238 get_recall(Mode,M,Lit,R),
1239 R > N.
1240
1241count_lit(_,[],0):-!.
1242
1243count_lit(P,[H|T],N):-
1244 H=..[P|_Args1],!,
1245 count_lit(P,T,N0),
1246 N is N0 + 1.
1247
1248count_lit(P,[_H|T],N):-
1249 count_lit(P,T,N).
1250
([],_,[]).
1252
1253extract_type_vars([Lit|RestLit],M,TypeVars):-
1254 Lit =.. [Pred|Args],
1255 length(Args,L),
1256 length(Args1,L),
1257 Lit1 =.. [Pred|Args1],
1258 take_mode(Lit1,M),
1259 type_vars(Args,Args1,Types),
1260 extract_type_vars(RestLit,M,TypeVars0),
1261 !,
1262 append(Types,TypeVars0,TypeVars).
1263
1264get_recall_modeh2([],_M,[]).
1265
1266get_recall_modeh2([H|T],Mo,Samples):-
1267 H=..[_Pred|Args],
1268 length(Args,N),
1269 count_pmc1(Args,N,_P,M,_C),
1270 Mo:modeh(R,H),!,
1271 get_recall_modeh2_int(M,Mo,R,H,T,Samples).
1272
1274get_recall_modeh2_int(0,M,_,H,T,[H|Samples]):-
1275 !,
1276 get_recall_modeh2(T,M,Samples).
1277
1279get_recall_modeh2_int(_,M,R,H,T,Samples):-
1280 duplicate_all_modeh1([H],M, R, ModehSampled),
1281 get_recall_modeh2(T,M,Samples0),
1282 append(ModehSampled,Samples0,Samples).
1283
1284count_pmc1([],N,0,0,N).
1285count_pmc1([+_|T],N,P,M,C):-!,
1286 count_pmc1(T,N,P0,M,C0),
1287 P is P0 + 1,
1288 C is C0 - 1.
1289count_pmc1([-_|T],N,P,M,C):-!,
1290 count_pmc1(T,N,P,M0,C0),
1291 M is M0 + 1,
1292 C is C0 - 1.
1293count_pmc1([_|T],N,P,M,C):-
1294 count_pmc1(T,N,P,M,C).
1295
1296duplicate_all_modeh1([],_,_,[]).
1297
1298duplicate_all_modeh1(L,M,*,Modehs):-!,
1299 M:local_setting(max_length, MaxL),
1300 random_between(0,MaxL,R),
1301 duplicate_all_modeh1(L,M,R,Modehs).
1302
1303duplicate_all_modeh1([H|T],M,R,Modehs):-
1304 duplicate_modeh1(H,R,Modehs0),
1305 duplicate_all_modeh1(T,M,R,Modehs1),
1306 append(Modehs0,Modehs1,Modehs).
1307
1309duplicate_modeh1(_,0,[]):- !.
1310
1312duplicate_modeh1(Modeh, R, [Modeh|Modehs]) :-
1313 R0 is R - 1,
1314 duplicate_modeh1(Modeh, R0, Modehs).
1315
1316
1317
1318get_recall(modeh,M,Lit,R):-
1319 M:modeh(R,Lit),!.
1320
1321get_recall(modeb,M,Lit,R):-
1322 M:modeb(R,Lit),!.
1323
1324take_mode(modeh,M,Lit):-
1325 1326 M:modeh(_,Lit),!. 1327
1328take_mode(modeb,M,Lit):-
1329 1330 1331 M:modeb(_,Lit),!.
1332
1333take_mode(Lit,M):-
1334 1335 M:modeh(_,Lit),!. 1336
1337take_mode(Lit,M):-
1338 1339 1340 M:modeb(_,Lit),!.
1341
1347
1348type_vars([],[],[]).
1349
1350type_vars([V|RV],[+T|RT],[V=T|RTV]):-
1351 !,
1352 type_vars(RV,RT,RTV).
1353
1354type_vars([V|RV],[-T|RT],[V=T|RTV]):-atom(T),!,
1355 type_vars(RV,RT,RTV).
1356
1357type_vars([_V|RV],[_T|RT],RTV):-
1358 type_vars(RV,RT,RTV).
1359
1360take_var_args([],_,[]).
1361
1362take_var_args([+T|RT],TypeVars,[V|RV]):-
1363 !,
1364 member(V=T,TypeVars),
1365 take_var_args(RT,TypeVars,RV).
1366
1367take_var_args([-T|RT],TypeVars,[_V|RV]):-
1368 atom(T),
1369 take_var_args(RT,TypeVars,RV).
1370
1371take_var_args([-T|RT],TypeVars,[V|RV]):-
1372 member(V=T,TypeVars),
1373 take_var_args(RT,TypeVars,RV).
1374
1375take_var_args([T|RT],TypeVars,[T|RV]):-
1376 T\= + _,(T\= - _; T= - A,number(A)),
1377 take_var_args(RT,TypeVars,RV).
1378
1379
1385
1386linked_ic_nb(B,M,_) :-
1387 linked_clause(B,M).
1388
1389linked_clause(X,M):-
1390 linked_clause(X,M,[]).
1391
1392linked_clause([],_,_).
1393
1394linked_clause([L|R],M,PrevLits):-
1395 term_variables(PrevLits,PrevVars),
1396 input_variables(L,M,InputVars),
1397 linked(InputVars,PrevVars),!,
1398 linked_clause(R,M,[L|PrevLits]).
1399
1400
1401linked([],_).
1402
1403linked([X|R],L) :-
1404 member_eq(X,L),
1405 !,
1406 linked(R,L).
1407
1408
1409input_variables(\+ LitM,M,InputVars):-
1410 !,
1411 LitM=..[P|Args],
1412 length(Args,LA),
1413 length(Args1,LA),
1414 Lit1=..[P|Args1],
1415 copy_term(LitM,Lit0),
1416 M:modeb(_,Lit1),
1417 Lit1 =.. [P|Args1],
1418 convert_to_input_vars(Args1,Args2),
1419 Lit2 =.. [P|Args2],
1420 input_vars(Lit0,Lit2,InputVars).
1421
1422input_variables(LitM,M,InputVars):-
1423 LitM=..[P|Args],
1424 length(Args,LA),
1425 length(Args1,LA),
1426 Lit1=..[P|Args1],
1427 M:modeb(_,Lit1),
1428 input_vars(LitM,Lit1,InputVars).
1429
1430input_head_variables(LitM,InputVars):-
1431 LitM=..[P|Args],
1432 length(Args,LA),
1433 length(Args1,LA),
1434 Lit1=..[P|Args1],
1435 modeh(_,Lit1),
1436 input_vars(LitM,Lit1,InputVars).
1437
1438input_vars(Lit,Lit1,InputVars):-
1439 Lit =.. [_|Vars],
1440 Lit1 =.. [_|Types],
1441 input_vars1(Vars,Types,InputVars).
1442
1443
1444input_vars1([],_,[]).
1445
1446input_vars1([V|RV],[+_T|RT],[V|RV1]):-
1447 !,
1448 input_vars1(RV,RT,RV1).
1449
1450input_vars1([_V|RV],[_|RT],RV1):-
1451 input_vars1(RV,RT,RV1).
1452
1453convert_to_input_vars([],[]):-!.
1454
1455convert_to_input_vars([+T|RT],[+T|RT1]):-
1456 !,
1457 convert_to_input_vars(RT,RT1).
1458
1459convert_to_input_vars([-T|RT],[+T|RT1]):-
1460 convert_to_input_vars(RT,RT1).
1461
1462
1464refine_single_disj_no_bc(+,D,_,_,D1,_,_):-
1465 member(E,D),
1466 delete(D,E,D1).
1467
1469refine_single_disj_no_bc(-,D,DL,M,D1,DL1,ALL):-
1470 M:local_setting(max_lengths,[_,_,_,NMinus]),
1471 length(D,LengthD),
1472 LengthD<NMinus,
1473 member(E,DL),
1474 check_recall(modeh,M,E,DL1),
1475 specialize_lit([E],M,ALL,[E1]),
1476 append(D,[E1],D1).
1477
1481
1485sample_possible_heads(N,M,NLits,L,R):-
1486 M:local_setting(max_lengths,[_,_,NPlus,_]),
1487 (NPlus > NLits -> Dim = NLits ; Dim = NPlus),
1488 sample_possible_heads1(N,Dim,L,R,[]).
1489
1490sample_possible_heads1(0,_,_,X,X):-!.
1491
1492sample_possible_heads1(R,Dim,L,T,X):-
1493 sample(Dim,L,N0),
1494 sort(N0,N),
1495 ( member(N,X) ->
1496 sample_possible_heads1(R,Dim,L,T,X)
1497 ;
1498 (!,R0 is R-1,
1499 sample_possible_heads1(R0,Dim,L,T,[N|X])
1500 )
1501 ).
1502
1503
1504sample(0,List,[],List):-!.
1505
1506sample(N,List,List,[]):-
1507 length(List,L),
1508 L=<N,!.
1509
1510sample(N,List,[El|List1],Li):-
1511 length(List,L),
1512 random(0,L,Pos),
1513 nth0(Pos,List,El,Rest),
1514 N1 is N-1,
1515 sample(N1,Rest,List1,Li).
1516
1517sample(0,_List,[]):-!.
1518
1519sample(N,List,List):-
1520 length(List,L),
1521 L=<N,!.
1522
1523sample(N,List,[El|List1]):-
1524 length(List,L),
1525 random(0,L,Pos),
1526 nth0(Pos,List,El,Rest),
1527 N1 is N-1,
1528 sample(N1,Rest,List1).
1529
1530
1531get_number_of_samples(NLits,M,NtoS,NSamp):-
1532 NLits > NtoS,!,
1533 M:local_setting(num_samples,NS),
1534 possible_combinations(NLits,NtoS,Res),
1535 (NS>Res ->
1536 NSamp = Res
1537 ;
1538 NSamp = NS
1539 ).
1540
1541get_number_of_samples(NLits,M,_NtoS,NSamp):-
1542 M:local_setting(num_samples,NS),
1543 possible_combinations(NLits,NLits,Res),
1544 (NS>Res ->
1545 NSamp = Res
1546 ;
1547 NSamp = NS
1548 ).
1549
1552possible_combinations(NLits,NtoS,Res):-
1553 comb(NLits,NtoS,R1),
1554 comb(NtoS,NtoS,R2),
1555 Res is R1/R2.
1556
1557comb(_,0,1):-!.
1558comb(A,B,R):-
1559 B0 is B - 1,
1560 A0 is A - 1,
1561 comb(A0,B0,R0),
1562 R is A*R0.
1563
1590
1591evaluate_all_refinements(_Ep,_Em,_M,_NPT,_NNT,[],Ag,NAg,_,Prog,Prog,LL,LL):-!.
1592
1593evaluate_all_refinements(Ep,Em,M,NPT,NNT,[[HRef]|TRef],AgIn,NAgOut,Prog00,Prog0,Prog,LL0,LL):-
1594 already_scored(M,[HRef|Prog00],Score),!,
1595 write3(M,'Already scored ref, score: '),write3(M,Score),write3(M,'\n'),
1596 write_rules3(M,[HRef|Prog00]),
1597 evaluate_all_refinements(Ep,Em,M,NPT,NNT,TRef,NAgIn,NAgOut,Prog00,Prog0,Prog,LL0,LL).
1598
1599evaluate_all_refinements(Ep,Em,M,NPT,NNT,[[HRef]|TRef],AgIn,NAgOut,Prog00,Prog0,Prog,LL0,LL):-
1600 HRef=rule(Name,HRef1,_Stat),
1601 write3(M,'New ref '),write3(M,'\n'),
1602 write_rules3(M,[HRef|Prog00]),
1603 learn_param([HRef|Prog00],M,Ep,Em,Prog1,NewL1),
1604 write3(M,'Score: '),write3(M,NewL1),write3(M,'\n'),
1605 write_rules3(M,Prog1),
1606 M:local_setting(beamsize,BS),
1607 print_ref(Name,M,HRef,NewL1,_,_,_,_),
1608 insert_in_order((Name,HRef1,NewL1,_),BS,NAgIn,NAg1),
1609 store_prog(M,Prog1,NewL1),
1610 ( NewL1>LL0->
1611 LL1=NewL1,
1612 Prog2=Prog1
1613 ;
1614 LL1=LL0,
1615 Prog2=Prog0
1616 ),
1617 evaluate_all_refinements(Ep,Em,M,NPT,NNT,TRef,NAg1,NAgOut,Prog00,Prog2,Prog,LL1,LL).
1618
1619
1620store_prog(M,Ref,Score):-
1621 assert(M:ref_th(Ref,Score)).
1622
1623elab_clause_ref(((H,_HL):-(B,_BL)),rule(H1,B1)):-
1624 copy_term((H,B),(H1,B1)).
1625
1626already_scored(M,Prog,Score):-
1627 M:ref_th(P,Score),
1628 length(P,NR),
1629 length(Prog,NR),
1630 already_scored_clause(Prog,P).
1631
1632already_scored_clause([],[]).
1633
1634already_scored_clause([R|RT],[rule(H1,B1)|RT0]):-
1635 elab_ref([R],[rule(H,B)]),
1636 permutation(B,B1),
1637 perm_head(H,H1),
1638 already_scored_clause(RT,RT0).
1639
1640perm_head([],_H1).
1641
1642perm_head([(Sign,Lit,_DL)|T],H1):-
1643 member((Sign,Lit1,_),H1),
1644 permutation(Lit,Lit1),
1645 perm_head(T,H1).
1646
1647elab_ref([],[]).
1648
1649elab_ref([rule(_NR,((H,_HL):-(B,_BL)),_Lits)|T],[rule(H1,B1)|T1]):-!,
1650 copy_term((H,B),(H1,B1)),
1651 numbervars((H1,B1),0,_N),
1652 elab_ref(T,T1).
1653
1654generate_query(((H,_HL):-(B,_BL)),QA,VI):-
1655 process_head(H,HA,VI),
1656 add_int_atom(B,B1,VI),
1657 append(B1,HA,Q),
1658 list2and(Q,QA).
1659
1660process_head([],[],_VI).
1661
1662process_head([(+,D,_DL)|T],[\+(DA)|T1],VI):-
1663 add_int_atom(D,D1,VI),
1664 list2and(D1,DA),
1665 process_head(T,T1,VI).
1666
1667process_head([(+=,D,_DL)|T],[\+(DA)|T1],VI):-
1668 add_int_atom(D,D1,VI),
1669 list2and(D1,DA),
1670 process_head(T,T1,VI).
1671
1672process_head([(-,D,_DL)|T],[\+(\+(DA))|T1],VI):-
1673 add_int_atom(D,D1,VI),
1674 list2and(D1,DA),
1675 process_head(T,T1,VI).
1676
1677process_head([(-=,D,_DL)|T],[\+(\+(DA))|T1],VI):-
1678 add_int_atom(D,D1,VI),
1679 list2and(D1,DA),
1680 process_head(T,T1,VI).
1681
1682add_int_atom([],[],_VI).
1683
1684add_int_atom([H|T],[H|T1],VI):-
1685 builtin(H),!,
1686 add_int_atom(T,T1,VI).
1687
1688add_int_atom([H|T],[H1|T1],VI):-
1689 H=..[F|Args],
1690 H1=..[F,VI|Args],
1691 add_int_atom(T,T1,VI).
1692
1693list2andHead([],false):-!.
1694
1695list2andHead(HeadList,Head):-
1696 list2and(HeadList,Head).
1697
1698list2andBody([],true):-!.
1699
1700list2andBody(BodyList,Body):-
1701 list2and(BodyList,Body).
1702
1703
1704
([],[]).
1706
1707extract_disj([(S,D)|T],[(S,D,[])|T1]):-
1708 extract_disj(T,T1).
1709
1710
1711
1712gen_cov_eminus([],[]):-!.
1713
1714gen_cov_eminus([H|T],[(H,[])|T1]):-
1715 gen_cov_eminus(T,T1).
1716
1717print_ex_rem(Eplus,Eminus):-
1718 setting(verbosity,V),
1719 V>0,
1720 length(Eplus,Lp),
1721 format("Positive examples remaining: ~d~N~p~N~N",[Lp,Eplus]),
1722 length(Eminus,Lm),
1723 format("Negative examples remaining: ~d~N~p~N~N",[Lm,Eminus]).
1724
1725insert_in_order(C,BeamSize,[],[C]):-
1726 BeamSize>0,!.
1727
1728insert_in_order(_NewClauseItem,0,Beam,Beam):-!.
1729
1730
1731insert_in_order((Name,HRef,Heuristic,NN),BeamSize,
1732 [(Name1,HRef1,Heuristic1,NN1)|RestBeamIn],
1733 BeamOut):-
1734 (Heuristic>Heuristic1),!,
1735 1736 NewBeam=[(Name,HRef,Heuristic,NN),(Name1,HRef1,Heuristic1,NN1)|RestBeamIn],
1737 length(NewBeam,L),
1738 (L>BeamSize->
1739 nth1(L,NewBeam,_Last,BeamOut)
1740
1741 ;
1742 BeamOut=NewBeam
1743 ).
1744
1745insert_in_order((Name,HRef,Heuristic,NN),BeamSize,
1746 [(Name1,HRef1,Heuristic1,NN1)|RestBeamIn],
1747 [(Name1,HRef1,Heuristic1,NN1)|RestBeamOut]):-
1748 BeamSize1 is BeamSize -1,
1749 1750 insert_in_order((Name,HRef,Heuristic,NN),BeamSize1,RestBeamIn,
1751 RestBeamOut).
1752
1753
1754
1755
1756
1757
1760test_clause_pos([],_Mo,_Q,_VI,N,N,Ec,Ec):-!.
1761
1762test_clause_pos([Module|Rest],Mo,Q,VI,NIn,NOut,EcIn,EcOut):-
1763 copy_term(r(Q,VI),r(Q1,VI1)),
1764 VI1=Module,
1765 (call(Mo:Q1)->
1766 N is NIn,
1767 Ec=EcIn
1768 ;
1769 (Mo:mult(Module,M)->
1770 N is NIn+M
1771 ;
1772 N is NIn + 1
1773 ),
1774 Ec =[Module|EcIn]
1775 ),
1776 test_clause_pos(Rest,Mo,Q,VI,N,NOut,Ec,EcOut).
1777
1778test_clause_neg([],_Mo,_Q,_VI,N,N,Ec,Ec):-!.
1779
1780test_clause_neg([Module|Rest],Mo,Q,VI,NIn,NOut,EcIn,EcOut):-
1781 copy_term(r(Q,VI),r(Q1,VI1)),
1782 VI1=Module,
1783 (call(Mo:Q1)->
1784 (Mo:mult(Module,M)->
1785 N is NIn+M
1786 ;
1787 N is NIn + 1
1788 ),
1789 Ec =[Module|EcIn]
1790 ;
1791 N is NIn,
1792 Ec=EcIn
1793 ),
1794 test_clause_neg(Rest,Mo,Q,VI,N,NOut,Ec,EcOut).
1795
1796distribute_not(L,\+ L):-
1797 L\=(_,_),!.
1798
1799distribute_not((L,RestL),(\+ L ,NewRestL)):-
1800 distribute_not(RestL,NewRestL).
1801
1802remove_red(_Pos,[],P,P).
1803
1804remove_red(Pos,[rule(Name,C,Stat)|T],PIn,POut):-
1805 reduce_clause(Pos,C,CRed),
1806 append(PIn,[rule(Name,CRed,Stat)],P1),
1807 remove_red(Pos,T,P1,POut).
1808
1809reduce_clause(Pos,((H,HL):-(B,BL)),((HR,HL):-(B,BL))):-
1810 reduce_head(B,Pos,H,[],HR).
1811
1812reduce_head(_B,_Pos,[],Head,Head).
1813
1814reduce_head(B,Pos,[H|T],HeadIn,HeadOut):-
1815 generate_query((([H],_):-(B,_)),Q,VI),
1816 test_clause_pos(Pos,Q,VI,0,NP,[],Epc),
1817 (NP=0->
1818 Head1=HeadIn,
1819 Pos1=Pos
1820 ;
1821 append(HeadIn,[H],Head1),
1822 deleteall(Pos,Epc,Pos1)
1823 ),
1824 reduce_head(B,Pos1,T,Head1,HeadOut).
1825
1826
1827deleteall(L,[],L).
1828
1829deleteall(L,[H|T],LOut):-
1830 delete(L,H,L1),
1831 deleteall(L1,T,LOut).
1832
1833get_pos_neg(DB,Mod,Pos,Neg):-
1834 (Mod:local_setting(examples,keys(P))->
1835 AtomP=..[P,M,pos],
1836 Atom=..[P,M],
1837 (current_predicate(Mod:P/1)->
1838 (current_predicate(Mod:P/2)->
1839 findall(M,(member(M,DB),(Mod:AtomP;Mod:Atom)),Pos0),
1840 findall(M,(member(M,DB),\+ Mod:AtomP,\+ Mod:Atom),Neg)
1841 ;
1842 findall(M,(member(M,DB),Mod:Atom),Pos0),
1843 findall(M,(member(M,DB),\+ Mod:Atom),Neg)
1844 )
1845 ;
1846 findall(M,(member(M,DB),Mod:AtomP),Pos0),
1847 findall(M,(member(M,DB),\+ Mod:AtomP),Neg)
1848 )
1849 ;
1850 AtomP=..[pos,M],
1851 findall(M,(member(M,DB),Mod:AtomP),Pos0),
1852 findall(M,(member(M,DB),\+ Mod:AtomP),Neg)
1853 ),
1854 remove_duplicates(Pos0,Pos).
1855
1856
1857load_models(File,HB,Pos,Neg):-
1858 (setting(examples,keys(P))->
1859 reconsult(File),
1860 AtomP=..[P,M,pos],
1861 AtomN=..[P,M,neg],
1862 findall(M,AtomP,Pos),
1863 findall(M,AtomN,Neg),
1864 HB=[]
1865 ;
1866 open(File,read,Stream),
1867 read_models(Stream,[],HB,ModulesList),
1868 close(Stream),
1869 divide_pos_neg(ModulesList,[],Pos,[],Neg)
1870 ). 1871
1872read_models(Stream,HB0,HB,[Name1|Names]):-
1873 read(Stream,begin(model(Name))),!,
1874 (number(Name)->
1875 name(Name,NameStr),
1876 append("i",NameStr,Name1Str),
1877 name(Name1,Name1Str)
1878 ;
1879 Name1=Name
1880 ),
1881 read_all_atoms(Stream,HB0,HB1,Name1),
1882 read_models(Stream,HB1,HB,Names).
1883
1884read_models(_S,HB,HB,[]).
1885
1886read_all_atoms(Stream,HB0,HB,Name):-
1887 read(Stream,Atom),
1888 Atom \=end(model(_Name)),!,
1889 Atom=..[Pred|Args],
1890 Atom1=..[Pred,Name|Args],
1891 assertz(Atom1),
1892 functor(Atom1,F,A),
1893 (member(F/A,HB0)->
1894 HB1=HB0
1895 ;
1896 HB1=[F/A|HB0]
1897 ),
1898 read_all_atoms(Stream,HB1,HB,Name).
1899
1900
1901read_all_atoms(_S,HB,HB,_N).
1902
1903
1910
1911
1912list2and([],true):-!.
1913
1914list2and([X],X):-!.
1915
1916list2and([H|T],(H,Ta)):-
1917 list2and(T,Ta).
1918
1919and2list(true,[]):-!.
1920
1921
1922and2list((H,Ta),[H|T]):-!,
1923 and2list(Ta,T).
1924
1925and2list(X,[X]).
1926
1927print_list([]):-!.
1928
1929print_list([rule(Name,C,Stat)|Rest]):-
1930 numbervars(C,0,_M),
1931 write_clause(C),
1932 format("/* ~p ~p */~n~n",[Name,Stat]),
1933 1934 print_list(Rest).
1935
1936print_list1([],[]):-!.
1937
1938print_list1([rule(Name,C,Stat)|Rest],[P|Par]):-
1939 numbervars(C,0,_M),
1940 format("~f :: ",[P]),
1941 write_clause(C),
1942 format("/* ~p ~p */~n~n",[Name,Stat]),
1943 print_list1(Rest,Par).
1944
1945print_list1([],_N,_Par):-!.
1946
1947print_list1([rule(Name,C0,Stat,_P)|Rest],N,Par):-
1948 copy_term(C0,C),
1949 numbervars(C,0,_M),
1950 member([N,[P,_]],Par),
1951 format("~f :: ",[P]),
1952 write_clause(C),
1953 format("/* ~p ~p */~n~n",[Name,Stat]),
1954 N1 is N+1,
1955 print_list1(Rest,N1,Par).
1956
1957print_list1([]):-!.
1958
1959print_list1([rule(_Name,C0,P)|Rest]):-
1960 copy_term(C0,C),
1961 numbervars(C,0,_M),
1962 format("~f :: ",[P]),
1963 write_clause(C),
1964 1965 print_list1(Rest).
1966
1967
1968
1970load_bg(FileBG):-
1971 (exists_file(FileBG)->
1972 open(FileBG,read,S),
1973 read_all_atoms_bg(S),
1974 close(S)
1975 ;
1976 true
1977 ).
1978
1979
1980process((H:-B),(H1:-B1)):-!,
1981 add_int_atom([H],[H1],VI),
1982 and2list(B,BL),
1983 add_int_atom(BL,BL1,VI),
1984 list2and(BL1,B1).
1985
1986process(H,H1):-!,
1987 add_int_atom([H],[H1],_VI).
1988
1989
1990learn_param([],M,_,_,[],MInf):-!,
1991 M:local_setting(minus_infinity,MInf).
1992
1993learn_param(Program0,M,Pos,Neg,Program,NewL1):-
1994 M:local_setting(learning_algorithm,lbfgs),!,
1995 format3(M,"Parameter learning by lbfgs~n",[]),
1996 convert_prob(Program0,Pr1),
1998 length(Program0,N),
1999 length(Pos,NPos),
2000 length(Neg,NNeg),
2001 NEx is NPos+NNeg,
2002 gen_initial_counts(N,MIP0), 2003 test_theory_pos_prob(Pos,M,Pr1,MIP0,MIP), 2004 test_theory_neg_prob(Neg,M,Pr1,N,MI), 2007 optimizer_initialize(N,pascal,evaluate,[M,MIP,MI,NEx],progress,[M]),
2008 M:local_setting(max_initial_weight,R),
2009 R0 is R*(-1),
2010 random(R0,R,R1), 2011 format3(M,"Starting parameters: ~f",[R1]),nl3(M),
2012 init_par(N,R1),
2013 evaluate_L(MIP,MI,M,L),
2014 IL is -L,
2015 format3(M,"~nInitial L ~f~n",[IL]),
2016 optimizer_run(_LL,Status),
2017 interpret_return_value(Status,Mess),
2018 format3(M,"Status ~p ~s~n",[Status,Mess]),
2019 update_theory(Program0,0,Program),
2020 evaluate_L(MIP,MI,M,NewL),
2021 NewL1 is -NewL,
2022 format3(M,"Final L ~f~n~n",[NewL1]),
2023 optimizer_finalize.
2024
2025learn_param(Program0,M,Pos,Neg,Program,NewL1):-
2026 M:local_setting(learning_algorithm,gradient_descent),!,
2027 format3(M,"Parameter learning by gradient descent~n",[]),
2028 M:local_setting(random_restarts_number,NR),
2029 2030 convert_prob(Program0,Pr1),
2031 2032 length(Program0,N),
2033 gen_initial_counts(N,MIP0), 2034 test_theory_pos_prob(Pos,M,Pr1,MIP0,MIP), 2035 test_theory_neg_prob(Neg,M,Pr1,N,MI), 2036 length(Pos,NPos),
2037 length(Neg,NNeg),
2038 NEx is NPos+NNeg,
2039 random_restarts(NR,N,M,MIP,MI,NEx,1e20,Score,initial,PH),
2040 (PH=initial ->
2041 Program=Program0
2042 ;
2043 PH=..[_|LW],
2044 update_theory_w(Program0,LW,Program)
2045 ),
2046 NewL1 is -Score.
2047
2048sigma_vec(W,SW):-
2049 W=..[F|ArgW],
2050 maplist(sigma,ArgW,ArgSW),
2051 SW=..[F|ArgSW].
2052
2053sigma(W,S):-S is 1/(1+e^(-W)).
2054
2055random_restarts(0,_NR,_MN,_MIP,_MI,_NEx,Score,Score,Par,Par):-!.
2056
2057random_restarts(N,NR,M,MIP,MI,NEx,Score0,Score,Par0,Par):-
2058 M:local_setting(random_restarts_number,NMax),
2059 Num is NMax-N+1,
2060 format3(M,"Restart number ~d~n~n",[Num]),
2061 initialize_weights(NR,M,W),
2062 M:local_setting(gd_iter,Iter),
2063 M:local_setting(minus_infinity,MInf),
2064 gradient_descent(0,Iter,M,W,MIP,MI,NEx,NR,-MInf),
2065 evaluate_w(MIP,MI,W,M,_LN,ScoreR),
2066 ScoreOut is -ScoreR,
2067 format3(M,"Random_restart: Score ~f~n",[ScoreOut]),
2068 N1 is N-1,
2069 (ScoreR<Score0->
2070 random_restarts(N1,NR,M,MIP,MI,NEx,ScoreR,Score,W,Par)
2071 ;
2072 random_restarts(N1,NR,M,MIP,MI,NEx,Score0,Score,Par0,Par)
2073 ).
2074
2075initialize_weights(NR,M,W):-
2076 M:local_setting(fixed_parameters,L0),
2077 (is_list(L0)->
2078 L=L0
2079 ;
2080 length(L,NR)
2081 ),
2082 length(WA,NR),
2083 W=..[w|WA],
2084 M:local_setting(max_initial_weight,MW),
2085 maplist(random_weight(MW),WA,L).
2086
2087
2088random_weight(MW,W,FW):-
2089 var(FW),!,
2090 Min is -MW,
2091 random(Min,MW,W).
2092
2093random_weight(_,FW,FW).
2094
2095gradient_descent(I,I,_,_,_MIP,_MI,_NEx,_NR,_LL0):-!.
2096
2097gradient_descent(Iter,MaxIter,M,W,MIP,MI,NEx,NR,LL0):-
2098 evaluate_w(MIP,MI,W,M,LN,LL),
2099 Diff is LL0-LL,
2100 Ratio is Diff/abs(LL0),
2101 M:local_setting(epsilon,EM),
2102 M:local_setting(epsilon_fraction,EMF),
2103 ((Diff<EM;Ratio<EMF)->
2104 write3(M,end(Diff,Ratio,LL,LL0)),nl3(M),
2105 true
2106 ;
2107 duplicate_term(W,WC),
2108 format3(M,"Gradient descent iteration ~d, LL ~f, old LL ~f~n",[Iter,LL,LL0]),
2109 length(GA,NR),
2110 G=..[g|GA],
2111 maplist(g_init,GA),
2112 M:local_setting(regularizing_constant,C),
2113 M:local_setting(regularization,R),
2114 compute_grad_w(MIP,W,G,1,MI,M,LN,NEx,R,C),
2115 format3(M,"Gradient:",[]),write3(M,G),nl3(M),
2116 format3(M,"Weights:",[]),write3(M,W),nl3(M),
2117 learning_rate(M,Iter,Eta),
2118 format3(M,"Learning rate ~f~n",[Eta]),
2119 nl3(M),
2120 update_weights(M,W,G,Eta),
2121 Iter1 is Iter+1,
2122 assertz(M:p(WC,LL)),
2123 gradient_descent(Iter1,MaxIter,M,W,MIP,MI,NEx,NR,LL)
2124 ).
2125
2126g_init(0.0).
2127
2128update_weights(M,W,G,Eta):-
2129 functor(W,_,NR),
2130 M:local_setting(fixed_parameters,FP0),
2131 (is_list(FP0)->
2132 FP=FP0
2133 ;
2134 length(FP,NR)
2135 ),
2136 numlist(1,NR,L),
2137 maplist(update_w(W,G,Eta),L,FP).
2138
2139update_w(W,G,Eta,NR,F):-
2140 var(F),!,
2141 arg(NR,G,G0),
2142 arg(NR,W,W0),
2143 New_W0 is W0-Eta*G0,
2144 setarg(NR,W,New_W0).
2145
2146update_w(_W,_G,_Eta,_NR,_F).
2147
2148learning_rate(M,_Iter,Eta):-
2149 M:local_setting(learning_rate,fixed(Eta)),!.
2150
2151learning_rate(M,Iter,Eta):-
2152 M:local_setting(learning_rate,decay(Eta_0,Eta_tau,Tau)),
2153 (Iter>Tau ->
2154 Eta = Eta_tau
2155 ;
2156 Alpha is Iter/Tau,
2157 Eta is (1.0-Alpha)*Eta_0+Alpha*Eta_tau
2158 ).
2159
2160evaluate(L,N,_Step,M,MIP,MI,NEx):-
2162 2163 2164 compute_likelihood_pos(MIP,0,0,LP),
2165 2166 2167 compute_likelihood_neg(MI,LN),
2168 2169 2170 compute_likelihood(LN,LP,M,L),
2171 2172 length(MIP,LMIP),
2173 compute_weights(0,LMIP,LW),
2174 write3(M,"Weights "),write3(M,LW),nl3(M),
2175 2176 2177 2178 M:local_setting(regularizing_constant,C),
2179 M:local_setting(regularization,R),
2180 compute_grad(MIP,0,MI,M,R,C,NEx,LN),
2181 store_hist(M,N,L).
2182
2183compute_weights(_I,0,[]):-!.
2184
2185compute_weights(I,LMIP,[P|Rest]):-
2186 optimizer_get_x(I,W0),
2187 P is 1/(1+exp(-W0)),
2188 I1 is I+1,
2189 LMIP1 is LMIP-1,
2190 compute_weights(I1,LMIP1,Rest).
2191
2192
2193progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0,M) :-
2194 format3(M,'~d. Iteration : f(X)=~4f |X|=~4f |g(X)|=~4f Step=~4f Ls=~4f~n',[Iteration,FX,X_Norm,G_Norm,Step,Ls]),
2195 true.
2196
2197store_hist(M,N,FX):-
2198 get_weights(0,N,WA),
2199 W=..[w|WA],
2200 assertz(M:p(W,FX)).
2201
2202get_weights(I,I,[]):-!.
2203
2204get_weights(I,N,[W0|Rest]):-
2205 optimizer_get_x(I,W0),
2206 I1 is I+1,
2207 get_weights(I1,N,Rest).
2208
2209convert_prob([],[]).
2210
2211convert_prob([rule(_,H,_P)|T],[(Q,VI)|T1]):-
2212 generate_query_prob(H,Q,VI),
2213 convert_prob(T,T1).
2214
2215generate_query_prob(((H,_HL):-(B,_BL)),QA,VI):-
2216 process_head(H,HA,VI),
2217 add_int_atom(B,B1,VI),
2218 append(B1,HA,Q),
2219 list2and(Q,QA).
2220
2221
2222
2223test_theory_pos_prob([],_,_Theory,MIP,MIP).
2224
2225test_theory_pos_prob([Module|Rest],M,Th,MIP0,MIP):-
2226 test_clause_prob(Th,M,Module,MIP0,MIP1),
2227 test_theory_pos_prob(Rest,M,Th,MIP1,MIP).
2228
2229test_clause_prob([],_Mo,_M,MIP,MIP).
2230
2231test_clause_prob([(Q,VI)|Rest],Mo,M,[MIPH0|MIPT0],[MIPH|MIPT]):-
2232 copy_term(r(Q,VI),r(Q1,VI1)),
2233 VI1=M,
2234 findall(Q1,Mo:Q1,L),
2235 length(L,MIP),
2236 MIPH is MIPH0+MIP,
2237 test_clause_prob(Rest,Mo,M,MIPT0,MIPT).
2238
2239test_theory_neg_prob([],_,_Theory,_N,[]).
2240
2241test_theory_neg_prob([Module|Rest],M,Th,N,[MI|LMI]):-
2242 gen_initial_counts(N,MI0),
2243 test_clause_prob(Th,M,Module,MI0,MI),
2244 test_theory_neg_prob(Rest,M,Th,N,LMI).
2245
2246
2247init_par(0,_):-!.
2248
2249init_par(I,R1):-
2250 I1 is I-1,
2251 optimizer_set_x(I1,R1),
2252 init_par(I1,R1).
2253
2254
2255compute_grad_w([],_W,_G,_N,_MI,_M,_LN,_NEx,_R,_C):-!.
2256
2257compute_grad_w([HMIP|TMIP],W,G,N0,MI,M,LN,NEx,R,C):-
2258 N00 is N0-1,
2259 compute_sum_neg(MI,LN,N00,M,0,S),
2260 arg(N0,W,W0),
2261 P is 1/(1+exp(-W0)),
2263 G0 is R*C*P^R*(1-P)+(HMIP-S)*P/NEx,
2264 setarg(N0,G,G0),
2265 2266 N1 is N0+1,
2267 compute_grad_w(TMIP,W,G,N1,MI,M,LN,NEx,R,C).
2268
2269evaluate_L(MIP,MI,M,L):-
2270 compute_likelihood_pos(MIP,0,0,LP),
2271 compute_likelihood_neg(MI,LN), 2272 compute_likelihood(LN,LP,M,L). 2273
2274compute_likelihood([],L,_M,L).
2275
2276compute_likelihood([HP|TP],L0,M,L):-
2277 2278 A is 1.0-exp(-HP),
2279 M:local_setting(logzero,Logzero),
2280 (A=<0.0->
2281 L1 is L0-Logzero
2282 ;
2283 L1 is L0-log(A)
2284 ),
2285 compute_likelihood(TP,L1,M,L).
2286
2287compute_likelihood_neg([],[]).
2288
2289compute_likelihood_neg([HMI|TMI],[HLN|TLN]):- 2290 compute_likelihood_pos(HMI,0,0,HLN),
2291 compute_likelihood_neg(TMI,TLN).
2292
2293compute_likelihood_pos([],_,LP,LP). 2294
2295compute_likelihood_pos([HMIP|TMIP],I,LP0,LP):- 2296 optimizer_get_x(I,W0),
2297 P is 1/(1+exp(-W0)), 2298 LP1 is LP0-log(1-P)*HMIP,
2299 I1 is I+1,
2300 compute_likelihood_pos(TMIP,I1,LP1,LP).
2301
2302compute_grad([],_N,_MI,_M,_R,_C,_NEx,_LN):-!.
2303
2304compute_grad([HMIP|TMIP],N0,MI,M,R,C,NEx,LN):-
2305 compute_sum_neg(MI,LN,N0,M,0,S),
2306 optimizer_get_x(N0,W0),
2307 P is 1/(1+exp(-W0)),
2308 G is (HMIP-S)*P/NEx+R*C*P^R*(1-P),
2309 optimizer_set_g(N0,G),
2310 N1 is N0+1,
2311 compute_grad(TMIP,N1,MI,M,R,C,NEx,LN).
2312
2313compute_sum_neg([],_LN,_I,_M,S,S).
2314
2315compute_sum_neg([HMI|TMI],[HLN|TLN],I,M,S0,S):-
2318 nth0(I,HMI,MIR),
2321 Den is 1.0-exp(-HLN),
2322 M:local_setting(zero,Zero),
2323 (Den=<0.0->
2324 Den1 is Zero
2325 ;
2326 Den1 = Den
2327 ),
2328 S1 is S0+MIR*exp(-HLN)/Den1,
2329 compute_sum_neg(TMI,TLN,I,M,S1,S).
2330
2331gen_initial_counts(0,[]):-!.
2332
2333gen_initial_counts(N0,[0|MIP0]):-
2334 N1 is N0-1,
2335 gen_initial_counts(N1,MIP0).
2336
2337update_theory([],_N,[]):-!.
2338
2339update_theory([rule(Name,C,_P)|Rest],N,[rule(Name,C,P)|Rest1]):-
2340 optimizer_get_x(N,W0),
2341 P is 1/(1+exp(-W0)),
2342 N1 is N+1,
2343 update_theory(Rest,N1,Rest1).
2344
2345
2346update_theory_w([],[],[]):-!.
2347
2348update_theory_w([rule(Name,C,_P)|Rest],[W0|WR],[rule(Name,C,P)|Rest1]):-
2349 P is 1/(1+exp(-W0)),
2350 update_theory_w(Rest,WR,Rest1).
2351
2352print_new_clause(Name,M,C,Heur,NC,PC,_Emc,_Epnc):-
2353 M:local_setting(verbosity,V),
2354 V>0,
2355 format(" ~N ~NGenerated clause:~n",[]),
2356 write_clause(C),
2357 nl,
2358 copy_term(Name,Name1),
2359 numbervars(Name1,0,_),
2360 format("Name: ~p~n",[Name1]),
2361 format("Score: ~p~n",[Heur]),
2362 format("Neg ex ruled out: #~p~n",[NC]),
2364 format("Covered pos ex: #~p~n",[PC]),
2370 (V>3->
2371 get0(_)
2372 ;
2373 true
2374 ).
2375
2376write_clause(((H,_HL):-(B,_BL))):-
2377 copy_term(c(H,B),c(H1,B1)),
2378 numbervars((H1,B1),0,_M),
2379 write('\t'),
2380 (B1=[]->
2381 write(true)
2382 ;
2383 write_list(B1)
2384 ),
2385 nl,
2386 write('--->'),
2387 nl,
2388 write_head(H1).
2389
2390write_head([]):-
2391 write('\t'),
2392 write('false.'),nl.
2393
2394write_head([(Sign,[A|T],_DL)]):-!,
2395 write('\t'),
2396 ((Sign = '-';Sign = '-=') ->
2397 write('not(')
2398 ;
2399 true
2400 ),
2401 write_term(A,[numbervars(true)]),
2402 (T=[]->
2403 ((Sign='-';Sign='-=')->
2404 write(')')
2405 ;
2406 true
2407 )
2408 ;
2409 write('\n\t/\\'),
2410 write_list(T),
2411 ((Sign='-';Sign='-=')->
2412 write(')')
2413 ;
2414 true
2415 )
2416 ),
2417 write('.'),
2418 nl.
2419
2420write_head([(Sign,[A|T],_DL)|HT]):-!,
2421 write('\t'),
2422 ((Sign = '-';Sign = '-=') ->
2423 write('not(')
2424 ;
2425 true
2426 ),
2427 2428 write_term(A,[numbervars(true)]),
2429 (T=[]->
2430 ((Sign='-';Sign='-=')->
2431 write(')')
2432 ;
2433 true
2434 )
2435 ;
2436 ((Sign='-';Sign='-=')->
2437 write(')\n\t/\\')
2438 ;
2439 write('\n\t/\\')
2440 ),
2441 write_list(T)
2442 ),
2443 nl,
2444 write('\\/'),nl,
2445 write_head(HT).
2446
2447
2448
2481
2482write_list([H]):-!,
2483 (H=h(E,Time)->
2484 write('H('),
2485 2486 2487 write_term(E,[numbervars(true)]),
2488 write(','),
2489 write(Time),
2490 write(')')
2491 ;
2492 2493 2494 write_term(H,[numbervars(true)])
2495 ).
2496
2497write_list([H|T]):-
2498 (H=h(E,Time)->
2499 write('H('),
2500 2501 2502 write_term(E,[numbervars(true)]),
2503 write(','),
2504 write(Time),
2505 write(')')
2506 ;
2507 2508 2509 write_term(H,[numbervars(true)])
2510 ),
2511 write('\n\t/\\'),
2512 write_list(T).
2513
2514
2515
2516write2(M,A):-
2517 M:local_setting(verbosity,Ver),
2518 (Ver>1->
2519 write(A)
2520 ;
2521 true
2522 ).
2523
2524write3(M,A):-
2525 M:local_setting(verbosity,Ver),
2526 (Ver>2->
2527 write(A)
2528 ;
2529 true
2530 ).
2531
2532nl2(M):-
2533 M:local_setting(verbosity,Ver),
2534 (Ver>1->
2535 nl
2536 ;
2537 true
2538 ).
2539
2540nl3(M):-
2541 M:local_setting(verbosity,Ver),
2542 (Ver>2->
2543 nl
2544 ;
2545 true
2546 ).
2547
2548format2(M,A,B):-
2549 M:local_setting(verbosity,Ver),
2550 (Ver>1->
2551 format(A,B)
2552 ;
2553 true
2554 ).
2555
2556format3(M,A,B):-
2557 M:local_setting(verbosity,Ver),
2558 (Ver>2->
2559 format(A,B)
2560 ;
2561 true
2562 ).
2563
2564write_rules2(M,A):-
2565 M:local_setting(verbosity,Ver),
2566 (Ver>1->
2567 print_list1(A)
2568 ;
2569 true
2570 ).
2571
2572write_rules3(M,A):-
2573 M:local_setting(verbosity,Ver),
2574 (Ver>2->
2575 print_list1(A)
2576 ;
2577 true
2578 ).
2579
2580print_ref(_Name,M,C,Heur,_NC,_PC,_Emc,_Epnc):-
2581 M:local_setting(verbosity,V),
2582 (V>1->
2583 format("Refinement:~n",[]),
2584 C = rule(r,C1,_),
2585 write_clause(C1),
2586 2587 2588 2589 2590 format("Score: ~p~n",[Heur]),
2593 (V>3->
2594 get0(_)
2595 ;
2596 true
2597 )
2598 ;
2599 true
2600 ).
2601
2623refine(((H,HL):-(B,BL)),M,((H1,HL1):-(B1,BL1))):-
2624 length(H,HN),
2625 length(B,BN),
2626 N is HN+BN,
2627 M:local_setting(max_length,ML),
2628 N=<ML,
2629 (M:local_setting(optimal,no)->
2630 ((refine_body_no(B,BL,B1,BL1),H1=H,HL1=HL)
2631 ;
2632 (refine_head_no(H,HL,M,H1,HL1),B1=B,BL1=BL)
2633 )
2634 ;
2635 refine(B,BL,B1,BL1,M,H,HL,H1,HL1)
2636 ).
2637
2639refine_body_no(B,BL,NewB,NewBL):-
2640 member(E,BL),
2641 delete(E,BL,NewBL),
2643 append(B,[E],NewB).
2644
2646refine(B,BL,B1,BL1,_M,H,HL,H,HL):-
2647 refine_body(B,BL,B1,BL1).
2648
2650refine(B,_BL,B,[],M,H,HL,H1,HL1):-
2651 refine_head(H,HL,M,H1,HL1).
2652
2654refine_body(B,[H|T],NewB,T):-
2655 append(B,[H],NewB).
2656
2658refine_body(B,[_H|T],NewB,BL):-
2659 refine_body(B,T,NewB,BL).
2660
2674
2675refine_head_no(H,HL,_M,NewH,NewHL):-
2676 member(HH,HL),
2677 delete(HH,HL,NewHL),
2678 (HH=(+,[HD|TD])->
2679 append(H,[(+,[HD|TD],TD)],NewH)
2680 ;
2681 (HH=(-,[HD|TD])->
2682 append(H,[(-,[HD],TD)],NewH)
2683 ;
2684 (HH=(+=,[HD|TD])->
2685 append(H,[(+=,[HD|TD],[])],NewH)
2686 ;
2687 HH=(-=,[HD|TD]),
2688 append(H,[(-=,[HD|TD],[])],NewH)
2689 )
2690 )
2691 ).
2692
2694refine_head_no(H,HL,M,NewH,HL):-
2695 refine_disj(H,M,NewH).
2696
2697
2698
2699refine_head(H,HL,_M,H1,HL1):-
2700 add_disj(H,HL,H1,HL1).
2701
2702refine_head(H,_HL,M,NewH,[]):-
2703 refine_disj(H,M,NewH).
2704
2713
2714add_disj(H,[HH|T],NewH,T):-
2715 (HH=(+,[HD|TD])->
2716 append(H,[(+,[HD|TD],TD)],NewH)
2717 ;
2718 (HH=(-,[HD|TD])->
2719 append(H,[(-,[HD],TD)],NewH)
2720 ;
2721 (HH=(+=,[HD|TD])->
2722 append(H,[(+=,[HD|TD],[])],NewH)
2723 ;
2724 HH=(-=,[HD|TD]),
2725 append(H,[(-=,[HD|TD],[])],NewH)
2726 )
2727 )
2728 ).
2729
2730
2731
2732add_disj(H,[_HH|T],NewH,HL):-
2733 add_disj(H,T,NewH,HL).
2734
2735
2738refine_disj([(Sign,D,DL)|T],M,[(Sign,D1,DL1)|T]):-
2739 (M:local_setting(optimal,no)->
2740 refine_single_disj_no(Sign,D,DL,D1,DL1)
2741 ;
2742 refine_single_disj(Sign,D,DL,D1,DL1)
2743 ).
2744
2746refine_disj([D|T],M,[D|T1]):-
2747 refine_disj(T,M,T1).
2748
2749
2751refine_single_disj_no(+,D,DL,D1,DL):-
2752 member(E,D),
2753 delete(D,E,D1).
2754
2756refine_single_disj_no(-,D,DL,D1,DL1):-
2757 member(E,DL),
2758 delete(E,DL,DL1),
2760 append(D,[E],D1).
2761
2764
2767
2768
2769refine_single_disj(+,D,[H|T],D1,T):-
2770 delete(D,H,D1).
2771
2772refine_single_disj(+,D,[_H|T],D1,DL1):-
2773 refine_single_disj(+,D,T,D1,DL1).
2774
2775refine_single_disj(-,D,[H|T],D1,T):-
2776 append(D,[H],D1).
2777
2778refine_single_disj(-,D,[_H|T],D1,DL1):-
2779 refine_single_disj(-,D,T,D1,DL1).
2780
2783
2786
2787
2788
2789number(+inf,Inf):-
2790 Inf is inf, !.
2791number(-inf,MInf):-
2792 MInf is -inf, !.
2793number(X,Y):-
2794 Y is X, !.
2795
2796
2797
2799aleph_member1(H,[H|_]):- !.
2800aleph_member1(H,[_|T]):-
2801 aleph_member1(H,T).
2802
2803aleph_member2(X,[Y|_]):- X == Y, !.
2804aleph_member2(X,[_|T]):-
2805 aleph_member2(X,T).
2806
2807aleph_member3(A,A-B):- A =< B.
2808aleph_member3(X,A-B):-
2809 A < B,
2810 A1 is A + 1,
2811 aleph_member3(X,A1-B).
2812
2813aleph_member(X,[X|_]).
2814aleph_member(X,[_|T]):-
2815 aleph_member(X,T).
2816
2818goals_to_list((true,Goals),T):-
2819 !,
2820 goals_to_list(Goals,T).
2821goals_to_list((Goal,Goals),[Goal|T]):-
2822 !,
2823 goals_to_list(Goals,T).
2824goals_to_list(true,[]):- !.
2825goals_to_list(Goal,[Goal]).
2826
2827list_to_goals([Goal],Goal):- !.
2828list_to_goals([Goal|Goals],(Goal,Goals1)):-
2829 list_to_goals(Goals,Goals1).
2830
2831
2832prune(_):-fail.
2833
2834in((Head:-true),Head):- !.
2835in((Head:-Body),L):-
2836 !,
2837 in((Head,Body),L).
2838in((L1,_),L1).
2839in((_,R),L):-
2840 !,
2841 in(R,L).
2842in(L,L).
2843
2844in((L1,L),L1,L).
2845in((L1,L),L2,(L1,Rest)):-
2846 !,
2847 in(L,L2,Rest).
2848in(L,L,true).
2849
2850member_eq(A,[H|_T]):-
2851 A==H,!.
2852
2853member_eq(A,[_H|T]):-
2854 member_eq(A,T).
2855
2856clear_kb([]).
2857
2858clear_kb([F/A|T]):-
2859 abolish(F,A),
2860 clear_kb(T).
2868builtin(G):-
2869 builtin_int(G),!.
2870
2871builtin_int(average(_L,_Av)).
2872builtin_int(G):-
2873 predicate_property(G,built_in).
2874builtin_int(G):-
2875 predicate_property(G,imported_from(lists)).
2876builtin_int(G):-
2877 predicate_property(G,imported_from(apply)).
2878builtin_int(G):-
2879 predicate_property(G,imported_from(nf_r)).
2880builtin_int(G):-
2881 predicate_property(G,imported_from(matrix)).
2882builtin_int(G):-
2883 predicate_property(G,imported_from(clpfd)).
2884
2885average(L,Av):-
2886 sum_list(L,Sum),
2887 length(L,N),
2888 Av is Sum/N.
2898set_pascal(M:Parameter,Value):-
2899 retract(M:local_setting(Parameter,_)),
2900 assert(M:local_setting(Parameter,Value)).
2909setting_pascal(M:P,V):-
2910 M:local_setting(P,V).
2911
2916
2917
2918assert_all([],_M,[]).
2919
2920assert_all([H|T],M,[HRef|TRef]):-
2921 assertz(M:H,HRef),
2922 assert_all(T,M,TRef).
2923
2924assert_all([],[]).
2925
2926assert_all([H|T],[HRef|TRef]):-
2927 assertz(slipcover:H,HRef),
2928 assert_all(T,TRef).
2929
2930
2931retract_all([],_):-!.
2932
2933retract_all([H|T],M):-
2934 erase(M,H),
2935 retract_all(T,M).
2936
2937retract_all([]):-!.
2938
2939retract_all([H|T]):-
2940 erase(H),
2941 retract_all(T).
2942
2943make_dynamic(M):-
2944 M:(dynamic int/1),
2945 findall(O,M:output(O),LO),
2946 findall(I,M:input(I),LI),
2947 findall(I,M:input_cw(I),LIC),
2948 findall(D,M:determination(D,_DD),LDH),
2949 findall(DD,M:determination(_D,DD),LDD),
2950 findall(DH,(M:modeh(_,_,_,LD),member(DH,LD)),LDDH),
2951 append([LO,LI,LIC,LDH,LDD,LDDH],L0),
2952 remove_duplicates(L0,L),
2953 maplist(to_dyn(M),L).
2954
2955to_dyn(M,P/A):-
2956 A1 is A+1,
2957 M:(dynamic P/A1),
2958 A2 is A1+2,
2959 M:(dynamic P/A2),
2960 A3 is A2+1,
2961 M:(dynamic P/A3).
2962
2963
2964
2965
2966pascal_expansion((:- begin_bg), []) :-
2967 prolog_load_context(module, M),
2968 pascal_input_mod(M),!,
2969 assert(M:bg_on).
2970
2971pascal_expansion(C, M:bgc(C)) :-
2972 prolog_load_context(module, M),
2973 C\= (:- end_bg),
2974 pascal_input_mod(M),
2975 M:bg_on,!.
2976
2977pascal_expansion((:- end_bg), []) :-
2978 prolog_load_context(module, M),
2979 pascal_input_mod(M),!,
2980 retractall(M:bg_on),
2981 findall(C,M:bgc(C),L),
2982 retractall(M:bgc(_)),
2983 (M:bg(BG0)->
2984 retract(M:bg(BG0)),
2985 append(BG0,L,BG),
2986 assert(M:bg(BG))
2987 ;
2988 assert(M:bg(L))
2989 ).
2990
2991pascal_expansion((:- begin_in), []) :-
2992 prolog_load_context(module, M),
2993 pascal_input_mod(M),!,
2994 assert(M:in_on).
2995
2996pascal_expansion(rule(C,P), M:inc(rule(C,P))) :-
2997 prolog_load_context(module, M),
2998 pascal_input_mod(M),
2999 M:in_on,!.
3000
3001pascal_expansion(ic(String), M:inc(rule((Head:-Body),P))) :-
3002 prolog_load_context(module, M),
3003 pascal_input_mod(M),
3004 M:in_on,!,
3005 parse_ics_string(String,ICs),
3006 add_var(ICs,[rule(((Head,_):-(Body,_)),0,P)]).
3007
3008pascal_expansion((:- end_in), []) :-
3009 prolog_load_context(module, M),
3010 pascal_input_mod(M),!,
3011 retractall(M:in_on),
3012 findall(C,M:inc(C),L),
3013 retractall(M:inc(_)),
3014 (M:in(IN0)->
3015 retract(M:in(IN0)),
3016 append(IN0,L,IN),
3017 assert(M:in(IN))
3018 ;
3019 assert(M:in(L))
3020 ).
3021
3022pascal_expansion(begin(model(I)), []) :-
3023 prolog_load_context(module, M),
3024 pascal_input_mod(M),!,
3025 retractall(M:model(_)),
3026 assert(M:model(I)),
3027 assert(M:int(I)).
3028
3029pascal_expansion(end(model(_I)), []) :-
3030 prolog_load_context(module, M),
3031 pascal_input_mod(M),!,
3032 retractall(M:model(_)).
3033
3034pascal_expansion(At, A) :-
3035 prolog_load_context(module, M),
3036 pascal_input_mod(M),
3037 M:model(Name),
3038 At \= (_ :- _),
3039 At \= end_of_file,
3040 (At=neg(Atom)->
3041 Atom=..[Pred|Args],
3042 Atom1=..[Pred,Name|Args],
3043 A=neg(Atom1)
3044 ;
3045 (At=prob(Pr)->
3046 A=prob(Name,Pr)
3047 ;
3048 At=..[Pred|Args],
3049 Atom1=..[Pred,Name|Args],
3050 A=Atom1
3051 )
3052 ).
3053
3054
3055
3056
3057:- thread_local pascal_file/1. 3058
3059user:term_expansion((:- pascal), []) :-!,
3060 prolog_load_context(source, Source),
3061 asserta(pascal_file(Source)),
3062 prolog_load_context(module, M),
3063 retractall(M:local_setting(_,_)),
3064 findall(local_setting(P,V),default_setting_pascal(P,V),L),
3065 assert_all(L,M,_),
3066 assert(pascal_input_mod(M)),
3067 retractall(M:rule_sc_n(_)),
3068 assert(M:rule_sc_n(0)),
3069 M:dynamic((modeh/2,mult/2,modeb/2,
3070 lookahead/2,
3071 lookahead_cons/2,lookahead_cons_var/2,
3072 bg_on/0,bg/1,bgc/1,in_on/0,in/1,inc/1,int/1,
3073 p/2,model/1,ref_th/2,fold/2)),
3074 style_check(-discontiguous).
3075
3076
3077user:term_expansion(end_of_file, C) :-
3078 pascal_file(Source),
3079 prolog_load_context(source, Source),
3080 retractall(pascal_file(Source)),
3081 prolog_load_context(module, M),
3082 pascal_input_mod(M),!,
3083 retractall(pascal_input_mod(M)),
3084 C=[(:- style_check(+discontiguous)),end_of_file].
3085
3086user:term_expansion(In, Out) :-
3087 \+ current_prolog_flag(xref, true),
3088 pascal_file(Source),
3089 prolog_load_context(source, Source),
3090 pascal_expansion(In, Out)