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 format3(M,"Random_restart: Score ~f~n",[ScoreR]),
2067 N1 is N-1,
2068 (ScoreR<Score0->
2069 random_restarts(N1,NR,M,MIP,MI,NEx,ScoreR,Score,W,Par)
2070 ;
2071 random_restarts(N1,NR,M,MIP,MI,NEx,Score0,Score,Par0,Par)
2072 ).
2073
2074initialize_weights(NR,M,W):-
2075 M:local_setting(fixed_parameters,L0),
2076 (is_list(L0)->
2077 L=L0
2078 ;
2079 length(L,NR)
2080 ),
2081 length(WA,NR),
2082 W=..[w|WA],
2083 M:local_setting(max_initial_weight,MW),
2084 maplist(random_weight(MW),WA,L).
2085
2086
2087random_weight(MW,W,FW):-
2088 var(FW),!,
2089 Min is -MW,
2090 random(Min,MW,W).
2091
2092random_weight(_,FW,FW).
2093
2094gradient_descent(I,I,_,_,_MIP,_MI,_NEx,_NR,_LL0):-!.
2095
2096gradient_descent(Iter,MaxIter,M,W,MIP,MI,NEx,NR,LL0):-
2097 evaluate_w(MIP,MI,W,M,LN,LL),
2098 Diff is LL0-LL,
2099 Ratio is Diff/abs(LL0),
2100 M:local_setting(epsilon,EM),
2101 M:local_setting(epsilon_fraction,EMF),
2102 ((Diff<EM;Ratio<EMF)->
2103 write3(M,end(Diff,Ratio,LL,LL0)),nl3(M),
2104 true
2105 ;
2106 duplicate_term(W,WC),
2107 format3(M,"Gradient descent iteration ~d, LL ~f, old LL ~f~n",[Iter,LL,LL0]),
2108 length(GA,NR),
2109 G=..[g|GA],
2110 maplist(g_init,GA),
2111 M:local_setting(regularizing_constant,C),
2112 M:local_setting(regularization,R),
2113 compute_grad_w(MIP,W,G,1,MI,M,LN,NEx,R,C),
2114 format3(M,"Gradient:",[]),write3(M,G),nl3(M),
2115 format3(M,"Weights:",[]),write3(M,W),nl3(M),
2116 learning_rate(M,Iter,Eta),
2117 format3(M,"Learning rate ~f~n",[Eta]),
2118 nl3(M),
2119 update_weights(M,W,G,Eta),
2120 Iter1 is Iter+1,
2121 assertz(M:p(WC,LL)),
2122 gradient_descent(Iter1,MaxIter,M,W,MIP,MI,NEx,NR,LL)
2123 ).
2124
2125g_init(0.0).
2126
2127update_weights(M,W,G,Eta):-
2128 functor(W,_,NR),
2129 M:local_setting(fixed_parameters,FP0),
2130 (is_list(FP0)->
2131 FP=FP0
2132 ;
2133 length(FP,NR)
2134 ),
2135 numlist(1,NR,L),
2136 maplist(update_w(W,G,Eta),L,FP).
2137
2138update_w(W,G,Eta,NR,F):-
2139 var(F),!,
2140 arg(NR,G,G0),
2141 arg(NR,W,W0),
2142 New_W0 is W0-Eta*G0,
2143 setarg(NR,W,New_W0).
2144
2145update_w(_W,_G,_Eta,_NR,_F).
2146
2147learning_rate(M,_Iter,Eta):-
2148 M:local_setting(learning_rate,fixed(Eta)),!.
2149
2150learning_rate(M,Iter,Eta):-
2151 M:local_setting(learning_rate,decay(Eta_0,Eta_tau,Tau)),
2152 (Iter>Tau ->
2153 Eta = Eta_tau
2154 ;
2155 Alpha is Iter/Tau,
2156 Eta is (1.0-Alpha)*Eta_0+Alpha*Eta_tau
2157 ).
2158
2159evaluate(L,N,_Step,M,MIP,MI,NEx):-
2161 2162 2163 compute_likelihood_pos(MIP,0,0,LP),
2164 2165 2166 compute_likelihood_neg(MI,LN),
2167 2168 2169 compute_likelihood(LN,LP,M,L),
2170 2171 length(MIP,LMIP),
2172 compute_weights(0,LMIP,LW),
2173 write3(M,"Weights "),write3(M,LW),nl3(M),
2174 2175 2176 2177 M:local_setting(regularizing_constant,C),
2178 M:local_setting(regularization,R),
2179 compute_grad(MIP,0,MI,M,R,C,NEx,LN),
2180 store_hist(M,N,L).
2181
2182compute_weights(_I,0,[]):-!.
2183
2184compute_weights(I,LMIP,[P|Rest]):-
2185 optimizer_get_x(I,W0),
2186 P is 1/(1+exp(-W0)),
2187 I1 is I+1,
2188 LMIP1 is LMIP-1,
2189 compute_weights(I1,LMIP1,Rest).
2190
2191
2192progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0,M) :-
2193 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]),
2194 true.
2195
2196store_hist(M,N,FX):-
2197 get_weights(0,N,WA),
2198 W=..[w|WA],
2199 assertz(M:p(W,FX)).
2200
2201get_weights(I,I,[]):-!.
2202
2203get_weights(I,N,[W0|Rest]):-
2204 optimizer_get_x(I,W0),
2205 I1 is I+1,
2206 get_weights(I1,N,Rest).
2207
2208convert_prob([],[]).
2209
2210convert_prob([rule(_,H,_P)|T],[(Q,VI)|T1]):-
2211 generate_query_prob(H,Q,VI),
2212 convert_prob(T,T1).
2213
2214generate_query_prob(((H,_HL):-(B,_BL)),QA,VI):-
2215 process_head(H,HA,VI),
2216 add_int_atom(B,B1,VI),
2217 append(B1,HA,Q),
2218 list2and(Q,QA).
2219
2220
2221
2222test_theory_pos_prob([],_,_Theory,MIP,MIP).
2223
2224test_theory_pos_prob([Module|Rest],M,Th,MIP0,MIP):-
2225 test_clause_prob(Th,M,Module,MIP0,MIP1),
2226 test_theory_pos_prob(Rest,M,Th,MIP1,MIP).
2227
2228test_clause_prob([],_Mo,_M,MIP,MIP).
2229
2230test_clause_prob([(Q,VI)|Rest],Mo,M,[MIPH0|MIPT0],[MIPH|MIPT]):-
2231 copy_term(r(Q,VI),r(Q1,VI1)),
2232 VI1=M,
2233 findall(Q1,Mo:Q1,L),
2234 length(L,MIP),
2235 MIPH is MIPH0+MIP,
2236 test_clause_prob(Rest,Mo,M,MIPT0,MIPT).
2237
2238test_theory_neg_prob([],_,_Theory,_N,[]).
2239
2240test_theory_neg_prob([Module|Rest],M,Th,N,[MI|LMI]):-
2241 gen_initial_counts(N,MI0),
2242 test_clause_prob(Th,M,Module,MI0,MI),
2243 test_theory_neg_prob(Rest,M,Th,N,LMI).
2244
2245
2246init_par(0,_):-!.
2247
2248init_par(I,R1):-
2249 I1 is I-1,
2250 optimizer_set_x(I1,R1),
2251 init_par(I1,R1).
2252
2253
2254compute_grad_w([],_W,_G,_N,_MI,_M,_LN,_NEx,_R,_C):-!.
2255
2256compute_grad_w([HMIP|TMIP],W,G,N0,MI,M,LN,NEx,R,C):-
2257 N00 is N0-1,
2258 compute_sum_neg(MI,LN,N00,M,0,S),
2259 arg(N0,W,W0),
2260 P is 1/(1+exp(-W0)),
2262 G0 is R*C*P^R*(1-P)+(HMIP-S)*P/NEx,
2263 setarg(N0,G,G0),
2264 2265 N1 is N0+1,
2266 compute_grad_w(TMIP,W,G,N1,MI,M,LN,NEx,R,C).
2267
2268evaluate_L(MIP,MI,M,L):-
2269 compute_likelihood_pos(MIP,0,0,LP),
2270 compute_likelihood_neg(MI,LN), 2271 compute_likelihood(LN,LP,M,L). 2272
2273compute_likelihood([],L,_M,L).
2274
2275compute_likelihood([HP|TP],L0,M,L):-
2276 2277 A is 1.0-exp(-HP),
2278 M:local_setting(logzero,Logzero),
2279 (A=<0.0->
2280 L1 is L0-Logzero
2281 ;
2282 L1 is L0-log(A)
2283 ),
2284 compute_likelihood(TP,L1,M,L).
2285
2286compute_likelihood_neg([],[]).
2287
2288compute_likelihood_neg([HMI|TMI],[HLN|TLN]):- 2289 compute_likelihood_pos(HMI,0,0,HLN),
2290 compute_likelihood_neg(TMI,TLN).
2291
2292compute_likelihood_pos([],_,LP,LP). 2293
2294compute_likelihood_pos([HMIP|TMIP],I,LP0,LP):- 2295 optimizer_get_x(I,W0),
2296 P is 1/(1+exp(-W0)), 2297 LP1 is LP0-log(1-P)*HMIP,
2298 I1 is I+1,
2299 compute_likelihood_pos(TMIP,I1,LP1,LP).
2300
2301compute_grad([],_N,_MI,_M,_R,_C,_NEx,_LN):-!.
2302
2303compute_grad([HMIP|TMIP],N0,MI,M,R,C,NEx,LN):-
2304 compute_sum_neg(MI,LN,N0,M,0,S),
2305 optimizer_get_x(N0,W0),
2306 P is 1/(1+exp(-W0)),
2307 G is (HMIP-S)*P/NEx+R*C*P^R*(1-P),
2308 optimizer_set_g(N0,G),
2309 N1 is N0+1,
2310 compute_grad(TMIP,N1,MI,M,R,C,NEx,LN).
2311
2312compute_sum_neg([],_LN,_I,_M,S,S).
2313
2314compute_sum_neg([HMI|TMI],[HLN|TLN],I,M,S0,S):-
2317 nth0(I,HMI,MIR),
2320 Den is 1.0-exp(-HLN),
2321 M:local_setting(zero,Zero),
2322 (Den=<0.0->
2323 Den1 is Zero
2324 ;
2325 Den1 = Den
2326 ),
2327 S1 is S0+MIR*exp(-HLN)/Den1,
2328 compute_sum_neg(TMI,TLN,I,M,S1,S).
2329
2330gen_initial_counts(0,[]):-!.
2331
2332gen_initial_counts(N0,[0|MIP0]):-
2333 N1 is N0-1,
2334 gen_initial_counts(N1,MIP0).
2335
2336update_theory([],_N,[]):-!.
2337
2338update_theory([rule(Name,C,_P)|Rest],N,[rule(Name,C,P)|Rest1]):-
2339 optimizer_get_x(N,W0),
2340 P is 1/(1+exp(-W0)),
2341 N1 is N+1,
2342 update_theory(Rest,N1,Rest1).
2343
2344
2345update_theory_w([],[],[]):-!.
2346
2347update_theory_w([rule(Name,C,_P)|Rest],[W0|WR],[rule(Name,C,P)|Rest1]):-
2348 P is 1/(1+exp(-W0)),
2349 update_theory_w(Rest,WR,Rest1).
2350
2351print_new_clause(Name,M,C,Heur,NC,PC,_Emc,_Epnc):-
2352 M:local_setting(verbosity,V),
2353 V>0,
2354 format(" ~N ~NGenerated clause:~n",[]),
2355 write_clause(C),
2356 nl,
2357 copy_term(Name,Name1),
2358 numbervars(Name1,0,_),
2359 format("Name:~p~n",[Name1]),
2360 format("Heuristic:~p~n",[Heur]),
2361 format("Neg ex ruled out:#~p~n",[NC]),
2363 format("Covered pos ex:#~p~n",[PC]),
2369 (V>3->
2370 get0(_)
2371 ;
2372 true
2373 ).
2374
2375write_clause(((H,_HL):-(B,_BL))):-
2376 copy_term(c(H,B),c(H1,B1)),
2377 numbervars((H1,B1),0,_M),
2378 write('\t'),
2379 (B1=[]->
2380 write(true)
2381 ;
2382 write_list(B1)
2383 ),
2384 nl,
2385 write('--->'),
2386 nl,
2387 write_head(H1).
2388
2389write_head([]):-
2390 write('\t'),
2391 write('false.'),nl.
2392
2393write_head([(Sign,[A|T],_DL)]):-!,
2394 write('\t'),
2395 ((Sign = '-';Sign = '-=') ->
2396 write('not(')
2397 ;
2398 true
2399 ),
2400 write_term(A,[numbervars(true)]),
2401 (T=[]->
2402 ((Sign='-';Sign='-=')->
2403 write(')')
2404 ;
2405 true
2406 )
2407 ;
2408 write('\n\t/\\'),
2409 write_list(T),
2410 ((Sign='-';Sign='-=')->
2411 write(')')
2412 ;
2413 true
2414 )
2415 ),
2416 write('.'),
2417 nl.
2418
2419write_head([(Sign,[A|T],_DL)|HT]):-!,
2420 write('\t'),
2421 ((Sign = '-';Sign = '-=') ->
2422 write('not(')
2423 ;
2424 true
2425 ),
2426 2427 write_term(A,[numbervars(true)]),
2428 (T=[]->
2429 ((Sign='-';Sign='-=')->
2430 write(')')
2431 ;
2432 true
2433 )
2434 ;
2435 ((Sign='-';Sign='-=')->
2436 write(')\n\t/\\')
2437 ;
2438 write('\n\t/\\')
2439 ),
2440 write_list(T)
2441 ),
2442 nl,
2443 write('\\/'),nl,
2444 write_head(HT).
2445
2446
2447
2480
2481write_list([H]):-!,
2482 (H=h(E,Time)->
2483 write('H('),
2484 2485 2486 write_term(E,[numbervars(true)]),
2487 write(','),
2488 write(Time),
2489 write(')')
2490 ;
2491 2492 2493 write_term(H,[numbervars(true)])
2494 ).
2495
2496write_list([H|T]):-
2497 (H=h(E,Time)->
2498 write('H('),
2499 2500 2501 write_term(E,[numbervars(true)]),
2502 write(','),
2503 write(Time),
2504 write(')')
2505 ;
2506 2507 2508 write_term(H,[numbervars(true)])
2509 ),
2510 write('\n\t/\\'),
2511 write_list(T).
2512
2513
2514
2515write2(M,A):-
2516 M:local_setting(verbosity,Ver),
2517 (Ver>1->
2518 write(A)
2519 ;
2520 true
2521 ).
2522
2523write3(M,A):-
2524 M:local_setting(verbosity,Ver),
2525 (Ver>2->
2526 write(A)
2527 ;
2528 true
2529 ).
2530
2531nl2(M):-
2532 M:local_setting(verbosity,Ver),
2533 (Ver>1->
2534 nl
2535 ;
2536 true
2537 ).
2538
2539nl3(M):-
2540 M:local_setting(verbosity,Ver),
2541 (Ver>2->
2542 nl
2543 ;
2544 true
2545 ).
2546
2547format2(M,A,B):-
2548 M:local_setting(verbosity,Ver),
2549 (Ver>1->
2550 format(A,B)
2551 ;
2552 true
2553 ).
2554
2555format3(M,A,B):-
2556 M:local_setting(verbosity,Ver),
2557 (Ver>2->
2558 format(A,B)
2559 ;
2560 true
2561 ).
2562
2563write_rules2(M,A):-
2564 M:local_setting(verbosity,Ver),
2565 (Ver>1->
2566 print_list1(A)
2567 ;
2568 true
2569 ).
2570
2571write_rules3(M,A):-
2572 M:local_setting(verbosity,Ver),
2573 (Ver>2->
2574 print_list1(A)
2575 ;
2576 true
2577 ).
2578
2579print_ref(_Name,M,C,Heur,_NC,_PC,_Emc,_Epnc):-
2580 M:local_setting(verbosity,V),
2581 (V>1->
2582 format("Refinement:~n",[]),
2583 C = rule(r,C1,_),
2584 write_clause(C1),
2585 2586 2587 2588 2589 format("Heuristic:~p~n",[Heur]),
2592 (V>3->
2593 get0(_)
2594 ;
2595 true
2596 )
2597 ;
2598 true
2599 ).
2600
2622refine(((H,HL):-(B,BL)),M,((H1,HL1):-(B1,BL1))):-
2623 length(H,HN),
2624 length(B,BN),
2625 N is HN+BN,
2626 M:local_setting(max_length,ML),
2627 N=<ML,
2628 (M:local_setting(optimal,no)->
2629 ((refine_body_no(B,BL,B1,BL1),H1=H,HL1=HL)
2630 ;
2631 (refine_head_no(H,HL,M,H1,HL1),B1=B,BL1=BL)
2632 )
2633 ;
2634 refine(B,BL,B1,BL1,M,H,HL,H1,HL1)
2635 ).
2636
2638refine_body_no(B,BL,NewB,NewBL):-
2639 member(E,BL),
2640 delete(E,BL,NewBL),
2642 append(B,[E],NewB).
2643
2645refine(B,BL,B1,BL1,_M,H,HL,H,HL):-
2646 refine_body(B,BL,B1,BL1).
2647
2649refine(B,_BL,B,[],M,H,HL,H1,HL1):-
2650 refine_head(H,HL,M,H1,HL1).
2651
2653refine_body(B,[H|T],NewB,T):-
2654 append(B,[H],NewB).
2655
2657refine_body(B,[_H|T],NewB,BL):-
2658 refine_body(B,T,NewB,BL).
2659
2673
2674refine_head_no(H,HL,_M,NewH,NewHL):-
2675 member(HH,HL),
2676 delete(HH,HL,NewHL),
2677 (HH=(+,[HD|TD])->
2678 append(H,[(+,[HD|TD],TD)],NewH)
2679 ;
2680 (HH=(-,[HD|TD])->
2681 append(H,[(-,[HD],TD)],NewH)
2682 ;
2683 (HH=(+=,[HD|TD])->
2684 append(H,[(+=,[HD|TD],[])],NewH)
2685 ;
2686 HH=(-=,[HD|TD]),
2687 append(H,[(-=,[HD|TD],[])],NewH)
2688 )
2689 )
2690 ).
2691
2693refine_head_no(H,HL,M,NewH,HL):-
2694 refine_disj(H,M,NewH).
2695
2696
2697
2698refine_head(H,HL,_M,H1,HL1):-
2699 add_disj(H,HL,H1,HL1).
2700
2701refine_head(H,_HL,M,NewH,[]):-
2702 refine_disj(H,M,NewH).
2703
2712
2713add_disj(H,[HH|T],NewH,T):-
2714 (HH=(+,[HD|TD])->
2715 append(H,[(+,[HD|TD],TD)],NewH)
2716 ;
2717 (HH=(-,[HD|TD])->
2718 append(H,[(-,[HD],TD)],NewH)
2719 ;
2720 (HH=(+=,[HD|TD])->
2721 append(H,[(+=,[HD|TD],[])],NewH)
2722 ;
2723 HH=(-=,[HD|TD]),
2724 append(H,[(-=,[HD|TD],[])],NewH)
2725 )
2726 )
2727 ).
2728
2729
2730
2731add_disj(H,[_HH|T],NewH,HL):-
2732 add_disj(H,T,NewH,HL).
2733
2734
2737refine_disj([(Sign,D,DL)|T],M,[(Sign,D1,DL1)|T]):-
2738 (M:local_setting(optimal,no)->
2739 refine_single_disj_no(Sign,D,DL,D1,DL1)
2740 ;
2741 refine_single_disj(Sign,D,DL,D1,DL1)
2742 ).
2743
2745refine_disj([D|T],M,[D|T1]):-
2746 refine_disj(T,M,T1).
2747
2748
2750refine_single_disj_no(+,D,DL,D1,DL):-
2751 member(E,D),
2752 delete(D,E,D1).
2753
2755refine_single_disj_no(-,D,DL,D1,DL1):-
2756 member(E,DL),
2757 delete(E,DL,DL1),
2759 append(D,[E],D1).
2760
2763
2766
2767
2768refine_single_disj(+,D,[H|T],D1,T):-
2769 delete(D,H,D1).
2770
2771refine_single_disj(+,D,[_H|T],D1,DL1):-
2772 refine_single_disj(+,D,T,D1,DL1).
2773
2774refine_single_disj(-,D,[H|T],D1,T):-
2775 append(D,[H],D1).
2776
2777refine_single_disj(-,D,[_H|T],D1,DL1):-
2778 refine_single_disj(-,D,T,D1,DL1).
2779
2782
2785
2786
2787
2788number(+inf,Inf):-
2789 Inf is inf, !.
2790number(-inf,MInf):-
2791 MInf is -inf, !.
2792number(X,Y):-
2793 Y is X, !.
2794
2795
2796
2798aleph_member1(H,[H|_]):- !.
2799aleph_member1(H,[_|T]):-
2800 aleph_member1(H,T).
2801
2802aleph_member2(X,[Y|_]):- X == Y, !.
2803aleph_member2(X,[_|T]):-
2804 aleph_member2(X,T).
2805
2806aleph_member3(A,A-B):- A =< B.
2807aleph_member3(X,A-B):-
2808 A < B,
2809 A1 is A + 1,
2810 aleph_member3(X,A1-B).
2811
2812aleph_member(X,[X|_]).
2813aleph_member(X,[_|T]):-
2814 aleph_member(X,T).
2815
2817goals_to_list((true,Goals),T):-
2818 !,
2819 goals_to_list(Goals,T).
2820goals_to_list((Goal,Goals),[Goal|T]):-
2821 !,
2822 goals_to_list(Goals,T).
2823goals_to_list(true,[]):- !.
2824goals_to_list(Goal,[Goal]).
2825
2826list_to_goals([Goal],Goal):- !.
2827list_to_goals([Goal|Goals],(Goal,Goals1)):-
2828 list_to_goals(Goals,Goals1).
2829
2830
2831prune(_):-fail.
2832
2833in((Head:-true),Head):- !.
2834in((Head:-Body),L):-
2835 !,
2836 in((Head,Body),L).
2837in((L1,_),L1).
2838in((_,R),L):-
2839 !,
2840 in(R,L).
2841in(L,L).
2842
2843in((L1,L),L1,L).
2844in((L1,L),L2,(L1,Rest)):-
2845 !,
2846 in(L,L2,Rest).
2847in(L,L,true).
2848
2849member_eq(A,[H|_T]):-
2850 A==H,!.
2851
2852member_eq(A,[_H|T]):-
2853 member_eq(A,T).
2854
2855clear_kb([]).
2856
2857clear_kb([F/A|T]):-
2858 abolish(F,A),
2859 clear_kb(T).
2867builtin(G):-
2868 builtin_int(G),!.
2869
2870builtin_int(average(_L,_Av)).
2871builtin_int(G):-
2872 predicate_property(G,built_in).
2873builtin_int(G):-
2874 predicate_property(G,imported_from(lists)).
2875builtin_int(G):-
2876 predicate_property(G,imported_from(apply)).
2877builtin_int(G):-
2878 predicate_property(G,imported_from(nf_r)).
2879builtin_int(G):-
2880 predicate_property(G,imported_from(matrix)).
2881builtin_int(G):-
2882 predicate_property(G,imported_from(clpfd)).
2883
2884average(L,Av):-
2885 sum_list(L,Sum),
2886 length(L,N),
2887 Av is Sum/N.
2897set_pascal(M:Parameter,Value):-
2898 retract(M:local_setting(Parameter,_)),
2899 assert(M:local_setting(Parameter,Value)).
2908setting_pascal(M:P,V):-
2909 M:local_setting(P,V).
2910
2915
2916
2917assert_all([],_M,[]).
2918
2919assert_all([H|T],M,[HRef|TRef]):-
2920 assertz(M:H,HRef),
2921 assert_all(T,M,TRef).
2922
2923assert_all([],[]).
2924
2925assert_all([H|T],[HRef|TRef]):-
2926 assertz(slipcover:H,HRef),
2927 assert_all(T,TRef).
2928
2929
2930retract_all([],_):-!.
2931
2932retract_all([H|T],M):-
2933 erase(M,H),
2934 retract_all(T,M).
2935
2936retract_all([]):-!.
2937
2938retract_all([H|T]):-
2939 erase(H),
2940 retract_all(T).
2941
2942make_dynamic(M):-
2943 M:(dynamic int/1),
2944 findall(O,M:output(O),LO),
2945 findall(I,M:input(I),LI),
2946 findall(I,M:input_cw(I),LIC),
2947 findall(D,M:determination(D,_DD),LDH),
2948 findall(DD,M:determination(_D,DD),LDD),
2949 findall(DH,(M:modeh(_,_,_,LD),member(DH,LD)),LDDH),
2950 append([LO,LI,LIC,LDH,LDD,LDDH],L0),
2951 remove_duplicates(L0,L),
2952 maplist(to_dyn(M),L).
2953
2954to_dyn(M,P/A):-
2955 A1 is A+1,
2956 M:(dynamic P/A1),
2957 A2 is A1+2,
2958 M:(dynamic P/A2),
2959 A3 is A2+1,
2960 M:(dynamic P/A3).
2961
2962
2963
2964
2965pascal_expansion((:- begin_bg), []) :-
2966 prolog_load_context(module, M),
2967 pascal_input_mod(M),!,
2968 assert(M:bg_on).
2969
2970pascal_expansion(C, M:bgc(C)) :-
2971 prolog_load_context(module, M),
2972 C\= (:- end_bg),
2973 pascal_input_mod(M),
2974 M:bg_on,!.
2975
2976pascal_expansion((:- end_bg), []) :-
2977 prolog_load_context(module, M),
2978 pascal_input_mod(M),!,
2979 retractall(M:bg_on),
2980 findall(C,M:bgc(C),L),
2981 retractall(M:bgc(_)),
2982 (M:bg(BG0)->
2983 retract(M:bg(BG0)),
2984 append(BG0,L,BG),
2985 assert(M:bg(BG))
2986 ;
2987 assert(M:bg(L))
2988 ).
2989
2990pascal_expansion((:- begin_in), []) :-
2991 prolog_load_context(module, M),
2992 pascal_input_mod(M),!,
2993 assert(M:in_on).
2994
2995pascal_expansion(rule(C,P), M:inc(rule(C,P))) :-
2996 prolog_load_context(module, M),
2997 pascal_input_mod(M),
2998 M:in_on,!.
2999
3000pascal_expansion(ic(String), M:inc(rule((Head:-Body),P))) :-
3001 prolog_load_context(module, M),
3002 pascal_input_mod(M),
3003 M:in_on,!,
3004 parse_ics_string(String,ICs),
3005 add_var(ICs,[rule(((Head,_):-(Body,_)),0,P)]).
3006
3007pascal_expansion((:- end_in), []) :-
3008 prolog_load_context(module, M),
3009 pascal_input_mod(M),!,
3010 retractall(M:in_on),
3011 findall(C,M:inc(C),L),
3012 retractall(M:inc(_)),
3013 (M:in(IN0)->
3014 retract(M:in(IN0)),
3015 append(IN0,L,IN),
3016 assert(M:in(IN))
3017 ;
3018 assert(M:in(L))
3019 ).
3020
3021pascal_expansion(begin(model(I)), []) :-
3022 prolog_load_context(module, M),
3023 pascal_input_mod(M),!,
3024 retractall(M:model(_)),
3025 assert(M:model(I)),
3026 assert(M:int(I)).
3027
3028pascal_expansion(end(model(_I)), []) :-
3029 prolog_load_context(module, M),
3030 pascal_input_mod(M),!,
3031 retractall(M:model(_)).
3032
3033pascal_expansion(At, A) :-
3034 prolog_load_context(module, M),
3035 pascal_input_mod(M),
3036 M:model(Name),
3037 At \= (_ :- _),
3038 At \= end_of_file,
3039 (At=neg(Atom)->
3040 Atom=..[Pred|Args],
3041 Atom1=..[Pred,Name|Args],
3042 A=neg(Atom1)
3043 ;
3044 (At=prob(Pr)->
3045 A=prob(Name,Pr)
3046 ;
3047 At=..[Pred|Args],
3048 Atom1=..[Pred,Name|Args],
3049 A=Atom1
3050 )
3051 ).
3052
3053
3054
3055
3056:- thread_local pascal_file/1. 3057
3058user:term_expansion((:- pascal), []) :-!,
3059 prolog_load_context(source, Source),
3060 asserta(pascal_file(Source)),
3061 prolog_load_context(module, M),
3062 retractall(M:local_setting(_,_)),
3063 findall(local_setting(P,V),default_setting_pascal(P,V),L),
3064 assert_all(L,M,_),
3065 assert(pascal_input_mod(M)),
3066 retractall(M:rule_sc_n(_)),
3067 assert(M:rule_sc_n(0)),
3068 M:dynamic((modeh/2,mult/2,modeb/2,
3069 lookahead/2,
3070 lookahead_cons/2,lookahead_cons_var/2,
3071 bg_on/0,bg/1,bgc/1,in_on/0,in/1,inc/1,int/1,
3072 p/2,model/1,ref_th/2,fold/2)),
3073 style_check(-discontiguous).
3074
3075
3076user:term_expansion(end_of_file, C) :-
3077 pascal_file(Source),
3078 prolog_load_context(source, Source),
3079 retractall(pascal_file(Source)),
3080 prolog_load_context(module, M),
3081 pascal_input_mod(M),!,
3082 retractall(pascal_input_mod(M)),
3083 C=[(:- style_check(+discontiguous)),end_of_file].
3084
3085user:term_expansion(In, Out) :-
3086 \+ current_prolog_flag(xref, true),
3087 pascal_file(Source),
3088 prolog_load_context(source, Source),
3089 pascal_expansion(In, Out)