887 lines
21 KiB
Prolog
887 lines
21 KiB
Prolog
/*
|
|
|
|
CEM
|
|
|
|
Copyright (c) 2011, Fabrizio Riguzzi
|
|
|
|
*/
|
|
%:- set_prolog_flag(unknown,error).
|
|
%:- set_prolog_flag(profiling,on).
|
|
%:- set_prolog_flag(debug,on).
|
|
:- set_prolog_flag(discontiguous_warnings,on).
|
|
:- set_prolog_flag(single_var_warnings,on).
|
|
:- set_prolog_flag(unknown,fail).
|
|
%:-source.
|
|
%:-yap_flag(gc_trace,very_verbose).
|
|
:- use_module(inference,
|
|
[find_deriv_inf1/3]).
|
|
%:-consult(inference).
|
|
:-use_module(library(rbtrees)).
|
|
:-use_module(library(random)).
|
|
:-use_module(library(avl)).
|
|
:-use_module(library(lists)).
|
|
|
|
%:-use_module(library(lpadsld)).
|
|
:-load_foreign_files(['cplint'],[],init_my_predicates).
|
|
|
|
:-dynamic setting/2,rule/5.
|
|
|
|
|
|
setting(depth,3).
|
|
setting(single_var,false).
|
|
|
|
setting(sample_size,1000).
|
|
/* Total number of examples in case in which the models in the kb file contain
|
|
a prob(P). fact. In that case, one model corresponds to sample_size*P examples
|
|
*/
|
|
setting(equivalent_sample_size,100).
|
|
/* equivalent samaple size for computing the BD score of the network refinements
|
|
It is indicated with NPrime in the formulas on Heckerman, Geiger & Chickering
|
|
paper */
|
|
setting(epsilon_em,0.1).
|
|
setting(epsilon_em_fraction,0.01).
|
|
/* if the difference in log likelihood in two successive em iteration is smaller
|
|
than epsilon_em, then em stops */
|
|
setting(epsilon_sem,2).
|
|
setting(random_restarts_number,1).
|
|
/* number of random restarts of em */
|
|
setting(verbosity,1).
|
|
|
|
|
|
|
|
em(File):-
|
|
generate_file_names(File,FileKB,FileOut,FileL,FileLPAD),
|
|
reconsult(FileL),
|
|
load_models(FileKB,DB),
|
|
load_initial_model(FileLPAD,Model0),!,
|
|
set(verbosity,3),
|
|
statistics(cputime,[_,_]),
|
|
gen_ex(DB,[],DBE),
|
|
compute_parameters_EM(Model0,Model,SuffStats,CLL,DBE),
|
|
statistics(cputime,[_,CT]),
|
|
CTS is CT/1000,
|
|
format("Final CLL ~f~n",[CLL]),
|
|
format("Execution time ~f~n",[CTS]),
|
|
write_stats(user_output,SuffStats),
|
|
listing(setting/2),
|
|
format("Model:~n",[]),
|
|
write_model(Model,user_output),
|
|
open(FileOut,write,Stream),
|
|
format(Stream,"/* Final CLL ~f~n",[CLL]),
|
|
format(Stream,"Execution time ~f~n",[CTS]),
|
|
tell(Stream),
|
|
listing(setting/2),
|
|
write_stats(Stream,SuffStats),
|
|
format(Stream,"*/~n",[]),
|
|
write_model(Model,Stream),
|
|
told.
|
|
|
|
gen_ex([],DBE,DBE).
|
|
|
|
gen_ex([H|T],DB0,DB1):-
|
|
get_ouptut_atoms(O),
|
|
generate_goal(O,H,[],GL),
|
|
append(DB0,GL,DB2),
|
|
gen_ex(T,DB2,DB1).
|
|
|
|
|
|
cycle_head([],[],_NR,_S,_NH,_PG,_CSetList,_N):-!.
|
|
|
|
cycle_head([SSH0|T],[SSH1|T1],NR,S,NH,PG,CSetList,N):-
|
|
extract_relevant_C_sets(NR,S,NH,CSetList,CSL1),
|
|
(CSL1=[]->
|
|
SSH1 is SSH0
|
|
;
|
|
build_formula(CSL1,Formula,[],Var),
|
|
var2numbers(Var,0,NewVar),
|
|
compute_prob(NewVar,Formula,Prob,0),
|
|
SSH1 is SSH0 +Prob/PG*N
|
|
),
|
|
NH1 is NH+1,
|
|
cycle_head(T,T1,NR,S,NH1,PG,CSetList,N).
|
|
|
|
cycle_head_neg([],[],_NR,_S,_NH,_NA,_PG,_CSetList,_N):-!.
|
|
|
|
cycle_head_neg([SSH0|T],[SSH1|T1],NR,S,NH,NA,PG,CSetList,N):-
|
|
extract_relevant_C_sets_neg(NR,S,NH,NA,CSetList,CSL1),
|
|
(CSL1=[]->
|
|
SSH1 is SSH0%+0.001
|
|
;
|
|
build_formula(CSL1,Formula,[],Var),
|
|
var2numbers(Var,0,NewVar),
|
|
compute_prob(NewVar,Formula,Prob,0),
|
|
(Prob>1 ->write(cyc),write(Prob),write(NewVar),nl;true),
|
|
SSH1 is SSH0 +(1-Prob)/PG*N
|
|
),
|
|
NH1 is NH+1,
|
|
cycle_head_neg(T,T1,NR,S,NH1,NA,PG,CSetList,N).
|
|
|
|
extract_relevant_C_sets_neg(NR,S,NH,NA,CS,CS1):-
|
|
neg_choice(0,NA,NH,NR,S,C),
|
|
append(CS,C,CS1).
|
|
|
|
neg_choice(N,N,_NH,_NR,_S,[]):-!.
|
|
|
|
neg_choice(NH,NA,NH,NR,S,L):-!,
|
|
N1 is NH+1,
|
|
neg_choice(N1,NA,NH,NR,S,L).
|
|
|
|
neg_choice(N,NA,NH,NR,S,[[(N,NR,S)]|L]):-
|
|
N1 is N+1,
|
|
neg_choice(N1,NA,NH,NR,S,L).
|
|
|
|
extract_relevant_C_sets(_NR,_S,_NH,[],[]):-!.
|
|
|
|
extract_relevant_C_sets(NR,S,NH,[H|T],CS):-
|
|
member((NH1,NR,S),H),!,
|
|
extract_relevant_C_sets1(NR,S,NH,NH1,H,T,CS).
|
|
|
|
extract_relevant_C_sets(NR,S,NH,[H|T],[H1|CS]):-
|
|
append(H,[(NH,NR,S)],H1),
|
|
extract_relevant_C_sets(NR,S,NH,T,CS).
|
|
|
|
extract_relevant_C_sets1(NR,S,NH,NH1,_H,T,CS):-
|
|
NH1\=NH,!,
|
|
extract_relevant_C_sets(NR,S,NH,T,CS).
|
|
|
|
extract_relevant_C_sets1(NR,S,NH,_NH1,H,T,[H|CS]):-
|
|
extract_relevant_C_sets(NR,S,NH,T,CS).
|
|
|
|
|
|
|
|
/* EM start */
|
|
compute_parameters_EM([],[],SuffStats,-1e200,_DB):-!,
|
|
rb_new(SuffStats).
|
|
|
|
compute_parameters_EM(Model0,Model1,SuffStats1,CLL1,DB):-
|
|
setting(verbosity,Ver),
|
|
(Ver>0->
|
|
format("EM computation ~nInitial model:~n",[]),
|
|
write_model(Model0,user_output),
|
|
flush_output
|
|
;
|
|
true
|
|
),
|
|
(Ver>2->
|
|
format("Initial EM Iteration ~n",[]),
|
|
flush_output
|
|
;
|
|
true
|
|
),
|
|
randomize(Model0,ModelR),
|
|
em_iteration(ModelR,Model,SuffStats,CLL,DB),
|
|
(Ver>2->
|
|
format("CLL ~f~n",[CLL])
|
|
;
|
|
true
|
|
),
|
|
flush_output,
|
|
setting(random_restarts_number,N),
|
|
random_restarts(N,Model,SuffStats,CLL,Model1,SuffStats1,CLL1,DB),
|
|
(Ver>0->
|
|
format("Final CLL ~f~n",[CLL1]),
|
|
flush_output
|
|
;
|
|
true
|
|
).
|
|
|
|
random_restarts(1,Model,SS,CLL,Model,SS,CLL,_DB):-!.
|
|
|
|
random_restarts(N,Model0,SS0,CLL0,Model1,SS1,CLL1,DB):-
|
|
setting(verbosity,Ver),
|
|
(Ver>2->
|
|
setting(random_restarts_number,NMax),
|
|
Num is NMax-N+1,
|
|
format("Restart number ~d~n",[Num]),
|
|
flush_output
|
|
;
|
|
true
|
|
),
|
|
randomize(Model0,ModelR),
|
|
em_iteration(ModelR,ModelR1,SSR,CLLR,DB),
|
|
setting(verbosity,Ver),
|
|
(Ver>2->
|
|
format("CLL ~f~n",[CLLR])
|
|
;
|
|
true
|
|
),
|
|
N1 is N-1,
|
|
(CLLR>CLL0->
|
|
random_restarts(N1,ModelR1,SSR,CLLR,Model1,SS1,CLL1,DB)
|
|
;
|
|
random_restarts(N1,Model0,SS0,CLL0,Model1,SS1,CLL1,DB)
|
|
).
|
|
|
|
randomize([],[]):-!.
|
|
|
|
randomize([rule(N,V,NH,HL,BL,LogF)|T],[rule(N,V,NH,HL1,BL,LogF)|T1]):-
|
|
length(HL,L),
|
|
Int is 1.0/L,
|
|
randomize_head(Int,HL,0,HL1),
|
|
randomize(T,T1).
|
|
|
|
randomize_head(_Int,['':_],P,['':PNull1]):-!,
|
|
PNull is 1.0-P,
|
|
(PNull>=0.0->
|
|
PNull1 =PNull
|
|
;
|
|
PNull1=0.0
|
|
).
|
|
|
|
randomize_head(Int,[H:_|T],P,[H:PH1|NT]):-
|
|
PMax is 1.0-P,
|
|
random(0,PMax,PH1),
|
|
P1 is P+PH1,
|
|
randomize_head(Int,T,P1,NT).
|
|
|
|
|
|
|
|
em_iteration(Model0,ModelPar,SuffStats1,CLL1,DB):-
|
|
compute_CLL_stats(Model0,DB,CLL0,SuffStats0),
|
|
/* setting(verbosity,Ver),
|
|
(Ver>2->
|
|
format("EM Iteration numer ~d~nCLL ~f~n",[N,CLL0]),
|
|
write_stats(user_output,SuffStats0)
|
|
;
|
|
true
|
|
),*/
|
|
cycle_EM(Model0,SuffStats0,CLL0,ModelPar,SuffStats1,CLL1,DB,1).
|
|
|
|
cycle_EM(Model0,SuffStats0,CLL0,ModelPar,SuffStats,CLL,DB,N):-
|
|
m_step(Model0,SuffStats0,Model1),
|
|
compute_CLL_stats(Model1,DB,CLL1,SuffStats1),
|
|
setting(verbosity,Ver),
|
|
(Ver>2->
|
|
format("Iteration: ~d CLL ~f~n",[N,CLL1])
|
|
;
|
|
true
|
|
),
|
|
flush_output,
|
|
% write_stats(user_output,SuffStats1),
|
|
% statistics,
|
|
setting(epsilon_em,Epsilon_EM),
|
|
setting(epsilon_em_fraction,Epsilon_EM_Frac),
|
|
((CLL1-CLL0<Epsilon_EM;(CLL1-CLL0)< - CLL0*Epsilon_EM_Frac)->
|
|
ModelPar=Model1,
|
|
SuffStats=SuffStats1,
|
|
CLL=CLL1,!
|
|
;
|
|
N1 is N+1,!,
|
|
cycle_EM(Model1,SuffStats1,CLL1,ModelPar,SuffStats,CLL,DB,N1)
|
|
).
|
|
|
|
write_stats(S,SS):-
|
|
rb_visit(SS,Pairs),
|
|
format(S,"Suff stats~n",[]),
|
|
write_stats_list(S,Pairs).
|
|
|
|
write_stats_list(S,[]):-nl(S),nl(S),!.
|
|
|
|
write_stats_list(S,[R-d(D,N,I)|T]):-
|
|
format(S,"~d,~p,~f,~d~n",[R,D,N,I]),
|
|
write_stats_list(S,T).
|
|
|
|
m_step([],_SS,[]):-!.
|
|
|
|
m_step([rule(N,V,NH,HL,BL,LogF)|T],SS,[rule(N,V,NH,HL1,BL,LogF)|T1]):-
|
|
(rb_lookup(N,d(Distr,_NBT,_NI),SS)->
|
|
sum_list(Distr,NBT),
|
|
update_head(HL,Distr,NBT,HL1)
|
|
;
|
|
HL1=HL
|
|
),
|
|
m_step(T,SS,T1).
|
|
|
|
update_head([],[],_N,[]).
|
|
|
|
update_head([H:_P|T],[PU|TP],N,[H:P|T1]):-
|
|
P is PU/N,
|
|
update_head(T,TP,N,T1).
|
|
|
|
|
|
/* EM end */
|
|
|
|
|
|
/* Start of computation of log likelihood and sufficient stats */
|
|
compute_CLL_stats(Model,DB,CLL,SuffStats1):-
|
|
assert_model(Model),
|
|
compute_CLL_stats_examples(DB,CLL,SuffStats1),
|
|
retract_model.
|
|
|
|
assert_model([]):-!.
|
|
|
|
assert_model([rule(N,V,NH,HL,BL,_LogF)|T]):-
|
|
assert_rules(HL,0,HL,BL,NH,N,V),
|
|
assertz(rule_by_num(N,V,NH,HL,BL)),
|
|
assert_model(T).
|
|
|
|
retract_model:-
|
|
retractall(rule_by_num(_,_,_,_,_)),
|
|
retractall(rule(_,_,_,_,_,_,_,_)).
|
|
|
|
assert_rules([],_Pos,_HL,_BL,_Nh,_N,_V1):-!.
|
|
|
|
assert_rules(['':_P],_Pos,_HL,_BL,_Nh,_N,_V1):-!.
|
|
|
|
assert_rules([H:P|T],Pos,HL,BL,NH,N,V1):-
|
|
assertz(rule(H,P,Pos,N,V1,NH,HL,BL)),
|
|
Pos1 is Pos+1,
|
|
assert_rules(T,Pos1,HL,BL,NH,N,V1).
|
|
|
|
compute_CLL_stats_examples(DB,CLL,SuffStats1):-
|
|
rb_new(SuffStats0),
|
|
compute_CLL_stats_cplint(DB,0,CLL,SuffStats0,SuffStats1).
|
|
|
|
get_ouptut_atoms(O):-
|
|
findall((A/Ar),output((A/Ar)),O).
|
|
|
|
generate_goal([],_H,G,G):-!.
|
|
|
|
generate_goal([P/A|T],H,G0,G1):-
|
|
functor(Pred,P,A),
|
|
Pred=..[P|Rest],
|
|
Pred1=..[P,H|Rest],
|
|
findall(Pred1,call(Pred1),L),
|
|
findall(\+ Pred1,call(neg(Pred1)),LN),
|
|
append(G0,L,G2),
|
|
append(G2,LN,G3),
|
|
generate_goal(T,H,G3,G1).
|
|
|
|
compute_CLL_stats_cplint([],CLL,CLL,S,S):-!.
|
|
|
|
compute_CLL_stats_cplint([\+ H|T],CLL0,CLL1,Stats0,Stats1):-!,
|
|
setting(verbosity,V),
|
|
(V>3->
|
|
write(user_error,(\+ H)),nl(user_error),flush_output
|
|
;
|
|
true
|
|
),
|
|
s([H],CL,CSetList,PG),!,
|
|
(PG=:=1.0->
|
|
CLL2=CLL0,
|
|
Stats2=Stats0
|
|
;
|
|
(prob(H,P)->
|
|
setting(sample_size,NTot),
|
|
N is P*NTot
|
|
;
|
|
N=1
|
|
),
|
|
PG1 is 1-PG,
|
|
CLL2 is CLL0+log(PG1)*N,
|
|
collect_stats_cplint_neg(CL,PG1,CSetList,N,Stats0,Stats2)
|
|
),
|
|
compute_CLL_stats_cplint(T,CLL2,CLL1,Stats2,Stats1).
|
|
|
|
compute_CLL_stats_cplint([H|T],CLL0,CLL1,Stats0,Stats1):-
|
|
setting(verbosity,V),
|
|
(V>3->
|
|
write(user_error,H),nl(user_error),flush_output
|
|
;
|
|
true
|
|
),
|
|
s([H],CL,CSetList,PG),!,
|
|
(PG=0.0->
|
|
CLL2=CLL0,
|
|
Stats2=Stats0
|
|
;
|
|
(prob(H,P)->
|
|
setting(sample_size,NTot),
|
|
N is P*NTot
|
|
;
|
|
N=1
|
|
),
|
|
CLL2 is CLL0+log(PG)*N,
|
|
collect_stats_cplint(CL,PG,CSetList,N,Stats0,Stats2)
|
|
),
|
|
compute_CLL_stats_cplint(T,CLL2,CLL1,Stats2,Stats1).
|
|
|
|
|
|
|
|
s(GoalsList,GroundLpad,CSets,Prob):-
|
|
solve(GoalsList,GroundLpad,CSets,Prob).
|
|
|
|
solve(GoalsList,GroundLpad,LDup,Prob):-
|
|
setting(depth,D),
|
|
findall(Deriv,inference:find_deriv_inf1(GoalsList,D,Deriv),LDup),
|
|
(LDup=[]->
|
|
Prob=0.0,
|
|
GroundLpad=[]
|
|
;
|
|
append(LDup,L0),
|
|
remove_head(L0,L1),
|
|
remove_duplicates(L1,L2),
|
|
build_ground_lpad(L2,GroundLpad),
|
|
build_formula(LDup,Formula,[],Var),
|
|
var2numbers(Var,0,NewVar),
|
|
compute_prob(NewVar,Formula,Prob,0),
|
|
true
|
|
).
|
|
|
|
collect_stats_cplint([],_PG,_CSetList,_N,Stats,Stats):-!.
|
|
|
|
collect_stats_cplint([(R,S,Head,_Body)|T],PG,CSetList,N,Stats0,Stats1):-
|
|
(rb_lookup(R,d(Distr0,N1,NInst1),Stats0)->
|
|
cycle_head(Distr0,Distr,R,S,0,PG,CSetList,N),
|
|
N2 is N+N1,
|
|
rb_update(Stats0,R,d(Distr,N2,NInst1),Stats2)
|
|
;
|
|
length(Head,LH),
|
|
list0(0,LH,Distr0),
|
|
cycle_head(Distr0,Distr,R,S,0,PG,CSetList,N),
|
|
rb_insert(Stats0,R,d(Distr,N,1),Stats2)
|
|
),
|
|
collect_stats_cplint(T,PG,CSetList,N,Stats2,Stats1).
|
|
|
|
collect_stats_cplint_neg([],_PG,_CSetList,_N,Stats,Stats):-!.
|
|
|
|
collect_stats_cplint_neg([(R,S,Head,_Body)|T],PG,CSetList,N,Stats0,Stats1):-
|
|
length(Head,NA),
|
|
(rb_lookup(R,d(Distr0,N1,NInst1),Stats0)->
|
|
cycle_head_neg(Distr0,Distr,R,S,0,NA,PG,CSetList,N),
|
|
N2 is N+N1,
|
|
rb_update(Stats0,R,d(Distr,N2,NInst1),Stats2)
|
|
;
|
|
length(Head,LH),
|
|
list0(0,LH,Distr0),
|
|
cycle_head_neg(Distr0,Distr,R,S,0,NA,PG,CSetList,N),
|
|
rb_insert(Stats0,R,d(Distr,N,1),Stats2)
|
|
),
|
|
collect_stats_cplint_neg(T,PG,CSetList,N,Stats2,Stats1).
|
|
|
|
/* build_formula(LC,Formula,VarIn,VarOut) takes as input a set of C sets
|
|
LC and a list of Variables VarIn and returns the formula and a new list
|
|
of variables VarOut
|
|
Formula is of the form [Term1,...,Termn]
|
|
Termi is of the form [Factor1,...,Factorm]
|
|
Factorj is of the form (Var,Value) where Var is the index of
|
|
the multivalued variable Var and Value is the index of the value
|
|
*/
|
|
build_formula([],[],Var,Var,C,C).
|
|
|
|
build_formula([D|TD],[F|TF],VarIn,VarOut,C0,C1):-
|
|
length(D,NC),
|
|
C2 is C0+NC,
|
|
build_term(D,F,VarIn,Var1),
|
|
build_formula(TD,TF,Var1,VarOut,C2,C1).
|
|
|
|
build_formula([],[],Var,Var).
|
|
|
|
build_formula([D|TD],[F|TF],VarIn,VarOut):-
|
|
build_term(D,F,VarIn,Var1),
|
|
build_formula(TD,TF,Var1,VarOut).
|
|
|
|
build_term([],[],Var,Var).
|
|
|
|
build_term([(_,pruned,_)|TC],TF,VarIn,VarOut):-!,
|
|
build_term(TC,TF,VarIn,VarOut).
|
|
|
|
build_term([(N,R,S)|TC],[[NVar,N]|TF],VarIn,VarOut):-
|
|
(nth0_eq(0,NVar,VarIn,(R,S))->
|
|
Var1=VarIn
|
|
;
|
|
append(VarIn,[(R,S)],Var1),
|
|
length(VarIn,NVar)
|
|
),
|
|
build_term(TC,TF,Var1,VarOut).
|
|
|
|
/* nth0_eq(PosIn,PosOut,List,El) takes as input a List,
|
|
an element El and an initial position PosIn and returns in PosOut
|
|
the position in the List that contains an element exactly equal to El
|
|
*/
|
|
nth0_eq(N,N,[H|_T],El):-
|
|
H==El,!.
|
|
|
|
nth0_eq(NIn,NOut,[_H|T],El):-
|
|
N1 is NIn+1,
|
|
nth0_eq(N1,NOut,T,El).
|
|
|
|
/* var2numbers converts a list of couples (Rule,Substitution) into a list
|
|
of triples (N,NumberOfHeadsAtoms,ListOfProbabilities), where N is an integer
|
|
starting from 0 */
|
|
var2numbers([],_N,[]).
|
|
|
|
var2numbers([(R,S)|T],N,[[N,ValNumber,Probs]|TNV]):-
|
|
find_probs(R,S,Probs),
|
|
length(Probs,ValNumber),
|
|
N1 is N+1,
|
|
var2numbers(T,N1,TNV).
|
|
|
|
find_probs(R,S,Probs):-
|
|
rule_by_num(R,S,_N,Head,_Body),
|
|
get_probs(Head,Probs).
|
|
|
|
get_probs(uniform(_A:1/Num,_P,_Number),ListP):-
|
|
Prob is 1/Num,
|
|
list_el(Num,Prob,ListP).
|
|
|
|
get_probs([],[]).
|
|
|
|
get_probs([_H:P|T],[P1|T1]):-
|
|
P1 is P,
|
|
get_probs(T,T1).
|
|
|
|
list_el(0,_P,[]):-!.
|
|
|
|
list_el(N,P,[P|T]):-
|
|
N1 is N-1,
|
|
list_el(N1,P,T).
|
|
|
|
sum(_NS,[],[],[]):-!.
|
|
|
|
sum(NS,[H0|T0],[H1|T1],[H2|T2]):-
|
|
H2 is H0+H1*NS,
|
|
sum(NS,T0,T1,T2).
|
|
|
|
times(_NS,[],[]):-!.
|
|
|
|
times(NS,[H0|T0],[H1|T1]):-
|
|
H1 is H0*NS,
|
|
times(NS,T0,T1).
|
|
|
|
/* End of computation of log likelihood and sufficient stats */
|
|
|
|
/* Utility predicates */
|
|
generate_file_names(File,FileKB,FileOut,FileL,FileLPAD):-
|
|
generate_file_name(File,".kb",FileKB),
|
|
generate_file_name(File,".rules",FileOut),
|
|
generate_file_name(File,".cpl",FileLPAD),
|
|
generate_file_name(File,".l",FileL).
|
|
|
|
generate_file_name(File,Ext,FileExt):-
|
|
name(File,FileString),
|
|
append(FileString,Ext,FileStringExt),
|
|
name(FileExt,FileStringExt).
|
|
|
|
|
|
set(Parameter,Value):-
|
|
retract(setting(Parameter,_)),
|
|
assert(setting(Parameter,Value)).
|
|
|
|
load_initial_model(File,Model):-
|
|
open(File,read,S),
|
|
read_clauses(S,C),
|
|
close(S),
|
|
process_clauses(C,1,_N,[],Model).
|
|
|
|
process_clauses([(end_of_file,[])],N,N,Model,Model).
|
|
|
|
process_clauses([((H:-B),_V)|T],N,N2,Model0,Model1):-
|
|
H=(db(A)),!,
|
|
assert((A:-B)),
|
|
process_clauses(T,N,N2,Model0,Model1).
|
|
|
|
process_clauses([((H:-B),V)|T],N,N2,Model0,[rule(N,V1,NH,HL,BL,0)|Model1]):-
|
|
H=(_;_),!,
|
|
list2or(HL1,H),
|
|
process_head(HL1,HL,VI),
|
|
list2and(BL0,B),
|
|
add_int_atom(BL0,BL,VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
N1 is N+1,
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
% assertz(rule(N,V,NH,HL,BL)),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
process_clauses([((H:-B),V)|T],N,N2,Model0,[rule(N,V1,NH,HL,BL,0)|Model1]):-
|
|
H=(_:_),!,
|
|
list2or(HL1,H),
|
|
process_head(HL1,HL,VI),
|
|
list2and(BL0,B),
|
|
add_int_atom(BL0,BL,VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
N1 is N+1,
|
|
% assertz(rule(N,V1,NH,HL,BL)),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
process_clauses([((H:-B),V)|T],N,N2,Model0,[rule(N,V1,NH,HL,BL,0)|Model1]):-!,
|
|
process_head([H:1.0],HL,VI),
|
|
list2and(BL0,B),
|
|
add_int_atom(BL0,BL,VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
N1 is N+1,
|
|
% assertz(rule(N,V1,NH,HL,BL)),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
process_clauses([(H,V)|T],N,N2,Model0,[rule(N,V1,NH,HL,[],0)|Model1]):-
|
|
H=(_;_),!,
|
|
list2or(HL1,H),
|
|
process_head(HL1,HL,_VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
N1 is N+1,
|
|
% assertz(rule(N,V,NH,HL,[])),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
process_clauses([(H,V)|T],N,N2,Model0,[rule(N,V1,NH,HL,[],0)|Model1]):-
|
|
H=(_:_),!,
|
|
list2or(HL1,H),
|
|
process_head(HL1,HL,_VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
N1 is N+1,
|
|
% assertz(rule(N,V,NH,HL,[])),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
process_clauses([(H,V)|T],N,N2,Model0,[rule(N,V1,NH,HL,[],0)|Model1]):-
|
|
process_head([H:1.0],HL,_VI),
|
|
length(HL,LH),
|
|
listN(0,LH,NH),
|
|
(setting(single_var,true)->
|
|
V1=[]
|
|
;
|
|
V1=V
|
|
),
|
|
N1 is N+1,
|
|
% assertz(rule(N,V,NH,HL,[])),
|
|
process_clauses(T,N1,N2,Model0,Model1).
|
|
|
|
|
|
/* if the annotation in the head are not ground, the null atom is not added
|
|
and the eventual formulas are not evaluated */
|
|
|
|
process_head([H:P|T],NHL,VI):-!,
|
|
process_head_prob([H:P|T],0.0,NHL,VI).
|
|
|
|
process_head(HL,NHL,VI):-
|
|
process_head_random(HL,0.0,NHL,VI).
|
|
|
|
process_head_random([],P,['':PNull1],_VI):-
|
|
PNull is 1.0-P,
|
|
(PNull>=0.0->
|
|
PNull1 =PNull
|
|
;
|
|
PNull1=0.0
|
|
).
|
|
|
|
process_head_random([H|T],P,[H1:PH1|NT],VI):-
|
|
add_int_atom([H],[H1],VI),
|
|
PMax is 1.0-P,
|
|
random(0,PMax,PH1),
|
|
P1 is P+PH1,
|
|
process_head_random(T,P1,NT,VI).
|
|
|
|
|
|
process_head_prob([H:PH],P,[H1:PH1,'':PNull1],VI):-
|
|
add_int_atom([H],[H1],VI),
|
|
PH1 is PH,
|
|
PNull is 1.0-P-PH1,
|
|
(PNull>=0.0->
|
|
PNull1 =PNull
|
|
;
|
|
PNull1=0.0
|
|
).
|
|
|
|
process_head_prob([H:PH|T],P,[H1:PH1|NT],VI):-
|
|
add_int_atom([H],[H1],VI),
|
|
PH1 is PH,
|
|
P1 is P+PH1,
|
|
process_head_prob(T,P1,NT,VI).
|
|
|
|
|
|
add_int_atom([],[],_VI).
|
|
|
|
add_int_atom([\+ H|T],[\+ H|T1],VI):-
|
|
inference:builtin(H),!,
|
|
add_int_atom(T,T1,VI).
|
|
|
|
add_int_atom([\+ H|T],[\+ H1|T1],VI):-!,
|
|
H=..[F|Args],
|
|
H1=..[F,VI|Args],
|
|
add_int_atom(T,T1,VI).
|
|
|
|
add_int_atom([H|T],[H|T1],VI):-
|
|
inference:builtin(H),!,
|
|
add_int_atom(T,T1,VI).
|
|
|
|
add_int_atom([H|T],[H1|T1],VI):-
|
|
H=..[F|Args],
|
|
H1=..[F,VI|Args],
|
|
add_int_atom(T,T1,VI).
|
|
|
|
/* predicates for reading in the program clauses */
|
|
read_clauses(S,Clauses):-
|
|
read_clauses_ground_body(S,Clauses).
|
|
|
|
|
|
read_clauses_ground_body(S,[(Cl,V)|Out]):-
|
|
read_term(S,Cl,[variable_names(V)]),
|
|
(Cl=end_of_file->
|
|
Out=[]
|
|
;
|
|
read_clauses_ground_body(S,Out)
|
|
).
|
|
|
|
|
|
|
|
|
|
listN(N,N,[]):-!.
|
|
|
|
listN(NIn,N,[NIn|T]):-
|
|
N1 is NIn+1,
|
|
listN(N1,N,T).
|
|
|
|
list0(N,N,[]):-!.
|
|
|
|
list0(NIn,N,[0|T]):-
|
|
N1 is NIn+1,
|
|
list0(N1,N,T).
|
|
|
|
/* end of predicates for parsing an input file containing a program */
|
|
|
|
|
|
load_models(File,ModulesList):-
|
|
open(File,read,Stream),
|
|
read_models(Stream,ModulesList),
|
|
close(Stream).
|
|
|
|
read_models(Stream,[Name1|Names]):-
|
|
read(Stream,begin(model(Name))),!,
|
|
(number(Name)->
|
|
name(Name,NameStr),
|
|
append("i",NameStr,Name1Str),
|
|
name(Name1,Name1Str)
|
|
;
|
|
Name1=Name
|
|
),
|
|
read_all_atoms(Stream,Name1),
|
|
read_models(Stream,Names).
|
|
|
|
read_models(_S,[]).
|
|
|
|
read_all_atoms(Stream,Name):-
|
|
read(Stream,At),
|
|
At \=end(model(_Name)),!,
|
|
(At=neg(Atom)->
|
|
Atom=..[Pred|Args],
|
|
Atom1=..[Pred,Name|Args],
|
|
assertz(neg(Atom1))
|
|
;
|
|
At=..[Pred|Args],
|
|
Atom1=..[Pred,Name|Args],
|
|
assertz(Atom1)
|
|
),
|
|
read_all_atoms(Stream,Name).
|
|
|
|
read_all_atoms(_S,_N).
|
|
|
|
|
|
list2or([],true):-!.
|
|
|
|
list2or([X],X):-
|
|
X\=;(_,_),!.
|
|
|
|
list2or([H|T],(H ; Ta)):-!,
|
|
list2or(T,Ta).
|
|
|
|
list2and([],true):-!.
|
|
|
|
list2and([X],X):-
|
|
X\=(_,_),!.
|
|
|
|
list2and([H|T],(H,Ta)):-!,
|
|
list2and(T,Ta).
|
|
|
|
|
|
write_model([],_Stream):-!.
|
|
|
|
write_model([rule(_N,_V,_NH,HL,BL,_LogF)|Rest],Stream):-
|
|
copy_term((HL,BL),(HL1,BL1)),
|
|
numbervars((HL1,BL1),0,_M),
|
|
write_disj_clause(Stream,(HL1:-BL1)),
|
|
format(Stream,".~n~n",[]),
|
|
write_model(Rest,Stream).
|
|
|
|
|
|
write_disj_clause(S,(H:-[])):-!,
|
|
write_head(S,H).
|
|
|
|
write_disj_clause(S,(H:-B)):-
|
|
write_head(S,H),
|
|
write(S,' :-'),
|
|
nl(S),
|
|
write_body(S,B).
|
|
|
|
write_head(S,[A:1.0|_Rest]):-!,
|
|
remove_int_atom(A,A1),
|
|
format(S,"~p",[A1]).
|
|
|
|
write_head(S,[A:P,'':_P]):-!,
|
|
remove_int_atom(A,A1),
|
|
format(S,"~p:~f",[A1,P]).
|
|
|
|
write_head(S,[A:P|Rest]):-
|
|
remove_int_atom(A,A1),
|
|
format(S,"~p:~f ; ",[A1,P]),
|
|
write_head(S,Rest).
|
|
|
|
write_body(S,[\+ A]):-!,
|
|
remove_int_atom(A,A1),
|
|
format(S,"\t\\+ ~p",[A1]).
|
|
|
|
write_body(S,[A]):-!,
|
|
remove_int_atom(A,A1),
|
|
format(S,"\t~p",[A1]).
|
|
|
|
write_body(S,[\+ A|T]):-!,
|
|
remove_int_atom(A,A1),
|
|
format(S,"\t\\+ ~p,~n",[A1]),
|
|
write_body(S,T).
|
|
|
|
write_body(S,[A|T]):-
|
|
remove_int_atom(A,A1),
|
|
format(S,"\t~p,~n",[A1]),
|
|
write_body(S,T).
|
|
|
|
|
|
remove_int_atom(A,A1):-
|
|
A=..[F,_|T],
|
|
A1=..[F|T].
|
|
|
|
build_ground_lpad([],[]):-!.
|
|
|
|
build_ground_lpad([(R,S)|T],[(R,S,Head,Body)|T1]):-
|
|
user:rule_by_num(R,S,_,Head,Body),
|
|
build_ground_lpad(T,T1).
|
|
|
|
|
|
remove_head([],[]).
|
|
|
|
remove_head([(_N,R,S)|T],[(R,S)|T1]):-
|
|
remove_head(T,T1).
|
|
|
|
|
|
append_all([],L,L):-!.
|
|
|
|
append_all([LIntH|IntT],IntIn,IntOut):-
|
|
append(IntIn,LIntH,Int1),
|
|
append_all(IntT,Int1,IntOut).
|
|
|