This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/cplint/em/em.pl

887 lines
21 KiB
Perl
Raw Normal View History

2011-10-22 15:33:04 +01:00
/*
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).