diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Several whitespace fixes

Browse Source
This commit is contained in:
Tiago Gomes 2012-12-17 17:57:00 +00:00
parent 409a230826
commit 2f2f88e571
27 changed files with 667 additions and 666 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
packages/CLPBN/clpbn.yap
View File

@ -5,10 +5,10 @@
set_clpbn_flag/2, set_clpbn_flag/2,
clpbn_flag/3, clpbn_flag/3,
clpbn_key/2, clpbn_key/2,
clpbn_init_graph/1, clpbn_init_graph/1,
clpbn_init_solver/4, clpbn_init_solver/4,
clpbn_run_solver/3, clpbn_run_solver/3,
clpbn_finalize_solver/1, clpbn_finalize_solver/1,
pfl_init_solver/5, pfl_init_solver/5,
pfl_run_solver/3, pfl_run_solver/3,
probability/2, probability/2,
@ -16,7 +16,7 @@
use_parfactors/1, use_parfactors/1,
op(500, xfy, with) op(500, xfy, with)
]). ]).
:- use_module(library(atts)). :- use_module(library(atts)).
:- use_module(library(bhash)). :- use_module(library(bhash)).
@ -103,7 +103,7 @@
check_stored_evidence/2, check_stored_evidence/2,
put_evidence/2 put_evidence/2
]). ]).
:- use_module('clpbn/ground_factors', :- use_module('clpbn/ground_factors',
[generate_network/5]). [generate_network/5]).
@ -131,7 +131,7 @@
parameter_softening/1, parameter_softening/1,
em_solver/1, em_solver/1,
use_parfactors/1. use_parfactors/1.
:- meta_predicate probability(:,-), conditional_probability(:,:,-). :- meta_predicate probability(:,-), conditional_probability(:,:,-).
@ -199,7 +199,7 @@ store_var(El) :-
get_mutable(Tail, Mutable), get_mutable(Tail, Mutable),
update_mutable(El.Tail, Mutable). update_mutable(El.Tail, Mutable).
store_var(El) :- store_var(El) :-
init_clpbn_vars(El). init_clpbn_vars(El).
init_clpbn_vars(El) :- init_clpbn_vars(El) :-
create_mutable(El, Mutable), create_mutable(El, Mutable),
@ -246,13 +246,14 @@ project_attributes(GVars0, _AVars0) :-
generate_network(GVars0, GKeys, Keys, Factors, Evidence), generate_network(GVars0, GKeys, Keys, Factors, Evidence),
b_setval(clpbn_query_variables, f(GVars0,Evidence)), b_setval(clpbn_query_variables, f(GVars0,Evidence)),
simplify_query(GVars0, GVars), simplify_query(GVars0, GVars),
( GKeys = [] (
-> GKeys = []
->
GVars0 = [V|_], GVars0 = [V|_],
clpbn_display:put_atts(V, [posterior([],[],[],[])]) clpbn_display:put_atts(V, [posterior([],[],[],[])])
; ;
call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence) call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence)
). ).
project_attributes(GVars, AVars) :- project_attributes(GVars, AVars) :-
suppress_attribute_display(false), suppress_attribute_display(false),
AVars = [_|_], AVars = [_|_],
@ -266,11 +267,11 @@ project_attributes(GVars, AVars) :-
(output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,ve,AllVars) ; true), (output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,ve,AllVars) ; true),
(output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,sort,AllVars,GVars) ; true), (output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,sort,AllVars,GVars) ; true),
( (
Solver = graphs Solver = graphs
-> ->
write_out(Solver, [[]], AllVars, DiffVars) write_out(Solver, [[]], AllVars, DiffVars)
; ;
write_out(Solver, [CLPBNGVars], AllVars, DiffVars) write_out(Solver, [CLPBNGVars], AllVars, DiffVars)
). ).
project_attributes(_, _). project_attributes(_, _).
@ -334,7 +335,7 @@ write_out(jt, GVars, AVars, DiffVars) :-
jt(GVars, AVars, DiffVars). jt(GVars, AVars, DiffVars).
write_out(bdd, GVars, AVars, DiffVars) :- write_out(bdd, GVars, AVars, DiffVars) :-
bdd(GVars, AVars, DiffVars). bdd(GVars, AVars, DiffVars).
write_out(bp, _GVars, _AVars, _DiffVars) :- write_out(bp, _GVars, _AVars, _DiffVars) :-
writeln('interface not supported any longer'). writeln('interface not supported any longer').
write_out(gibbs, GVars, AVars, DiffVars) :- write_out(gibbs, GVars, AVars, DiffVars) :-
gibbs(GVars, AVars, DiffVars). gibbs(GVars, AVars, DiffVars).
@ -453,19 +454,19 @@ bind_clpbn(T, Var, _, _, _, do_not_bind_variable([put_evidence(T,Var)])) :-
bind_clpbn(T, Var, Key, Dist, Parents, []) :- var(T), bind_clpbn(T, Var, Key, Dist, Parents, []) :- var(T),
get_atts(T, [key(Key1),dist(Dist1,Parents1)]), get_atts(T, [key(Key1),dist(Dist1,Parents1)]),
( (
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1)
-> ->
( (
get_atts(T, [evidence(Ev1)]) -> get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var) bind_evidence_from_extra_var(Ev1,Var)
; ;
get_atts(Var, [evidence(Ev)]) -> get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T) bind_evidence_from_extra_var(Ev,T)
; ;
true true
) )
; ;
fail fail
). ).
bind_clpbn(_, Var, _, _, _, _, []) :- bind_clpbn(_, Var, _, _, _, _, []) :-
use(bnt), use(bnt),
@ -487,7 +488,7 @@ bind_clpbn(T, Var, Key0, _, _, _, []) :-
( (
Key = Key0 -> true Key = Key0 -> true
; ;
% let us not loose whatever we had. % let us not loose whatever we had.
put_evidence(T,Var) put_evidence(T,Var)
). ).
@ -497,7 +498,7 @@ fresh_attvar(Var, NVar) :-
% I will now allow two CLPBN variables to be bound together. % I will now allow two CLPBN variables to be bound together.
%bind_clpbns(Key, Dist, Parents, Key, Dist, Parents). %bind_clpbns(Key, Dist, Parents, Key, Dist, Parents).
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) :- bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) :-
Key == Key1, !, Key == Key1, !,
get_dist(Dist,_Type,_Domain,_Table), get_dist(Dist,_Type,_Domain,_Table),
get_dist(Dist1,_Type1,_Domain1,_Table1), get_dist(Dist1,_Type1,_Domain1,_Table1),
@ -526,14 +527,14 @@ bind_evidence_from_extra_var(Ev1,Var) :-
bind_evidence_from_extra_var(Ev1,Var) :- bind_evidence_from_extra_var(Ev1,Var) :-
put_atts(Var, [evidence(Ev1)]). put_atts(Var, [evidence(Ev1)]).
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M), prolog_load_context(module, M),
store_evidence(M:A). store_evidence(M:A).
clpbn_key(Var,Key) :- clpbn_key(Var,Key) :-
get_atts(Var, [key(Key)]). get_atts(Var, [key(Key)]).
% %
% only useful for probabilistic context free grammars % only useful for probabilistic context free grammars
% %
@ -556,19 +557,19 @@ clpbn_init_solver(LVs, Vs0, VarsWithUnboundKeys, State) :-
clpbn_init_solver(gibbs, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(gibbs, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(ve, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(ve, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_ve_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_ve_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_horus_ground_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_horus_ground_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_bdd_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_bdd_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State). init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State).
@ -598,7 +599,7 @@ clpbn_run_solver(bdd, LVs, LPs, State) :-
clpbn_run_solver(pcg, LVs, LPs, State) :- clpbn_run_solver(pcg, LVs, LPs, State) :-
run_pcg_solver(LVs, LPs, State). run_pcg_solver(LVs, LPs, State).
clpbn_finalize_solver(State) :- clpbn_finalize_solver(State) :-
solver(bp), !, solver(bp), !,
functor(State, _, Last), functor(State, _, Last),
@ -622,22 +623,22 @@ pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, bdd) :- !,
init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State). init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, hve) :- !, pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, hve) :- !,
clpbn_horus:set_horus_flag(ground_solver, ve), clpbn_horus:set_horus_flag(ground_solver, ve),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State). init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, bp) :- !, pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, bp) :- !,
clpbn_horus:set_horus_flag(ground_solver, bp), clpbn_horus:set_horus_flag(ground_solver, bp),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State). init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, cbp) :- !, pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, cbp) :- !,
clpbn_horus:set_horus_flag(ground_solver, cbp), clpbn_horus:set_horus_flag(ground_solver, cbp),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State). init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(_, _, _, _, _, Solver) :- pfl_init_solver(_, _, _, _, _, Solver) :-
write('Error: solver `'), write('Error: solver `'),
write(Solver), write(Solver),
write('\' cannot be used for learning'). write('\' cannot be used for learning').
pfl_run_solver(LVs, LPs, State) :- pfl_run_solver(LVs, LPs, State) :-
solver(Solver), solver(Solver),
pfl_run_solver(LVs, LPs, State, Solver). pfl_run_solver(LVs, LPs, State, Solver).
@ -653,7 +654,7 @@ pfl_run_solver(LVs, LPs, State, hve) :- !,
pfl_run_solver(LVs, LPs, State, bp) :- !, pfl_run_solver(LVs, LPs, State, bp) :- !,
run_horus_ground_solver(LVs, LPs, State). run_horus_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, cbp) :- !, pfl_run_solver(LVs, LPs, State, cbp) :- !,
run_horus_ground_solver(LVs, LPs, State). run_horus_ground_solver(LVs, LPs, State).

50
packages/CLPBN/clpbn/aggregates.yap
View File

@ -1,4 +1,4 @@
% %
% generate explicit CPTs % generate explicit CPTs
% %
:- module(clpbn_aggregates, :- module(clpbn_aggregates,
@ -63,9 +63,9 @@ simplify_dist(_, _, _, _, Vs0, Vs0).
% %
avg_factors(Key, Parents, _Smoothing, NewParents, Id) :- avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
% we keep ev as a list % we keep ev as a list
skolem(Key, Domain), skolem(Key, Domain),
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id). avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
% there are 4 cases: % there are 4 cases:
% no evidence on top node % no evidence on top node
@ -73,17 +73,17 @@ avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
% evidence on top node *entailed* by values of parents (so there is no real connection) % evidence on top node *entailed* by values of parents (so there is no real connection)
% evidence incompatible with parents % evidence incompatible with parents
query_evidence(Key, EvHash, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :- query_evidence(Key, EvHash, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
b_hash_lookup(Key, Ev, EvHash), !, b_hash_lookup(Key, Ev, EvHash), !,
normalise_CPT_on_lines(MAT0, MAT1, L1), normalise_CPT_on_lines(MAT0, MAT1, L1),
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs). check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
query_evidence(_, _, MAT, MAT, NewParents, NewParents, _, Vs, Vs). query_evidence(_, _, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
hash_ev(K=V, Es0, Es) :- hash_ev(K=V, Es0, Es) :-
b_hash_insert(Es0, K, V, Es). b_hash_insert(Es0, K, V, Es).
find_ev(Ev, Key, RemKeys, RemKeys, Ev0, EvF) :- find_ev(Ev, Key, RemKeys, RemKeys, Ev0, EvF) :-
b_hash_lookup(Key, V, Ev), !, b_hash_lookup(Key, V, Ev), !,
EvF is Ev0+V. EvF is Ev0+V.
find_ev(_Evs, Key, RemKeys, [Key|RemKeys], Ev, Ev). find_ev(_Evs, Key, RemKeys, [Key|RemKeys], Ev, Ev).
@ -118,7 +118,7 @@ avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, [V1,V2], Vs, [V1,V2|N
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT), average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT),
matrix_to_list(CPT, Mat), matrix_to_list(CPT, Mat),
add_ground_factor(bayes, Domain, [Key,V1,V2], Mat, Id). add_ground_factor(bayes, Domain, [Key,V1,V2], Mat, Id).
intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !. intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !.
intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !, intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !,
If is I0+1, If is I0+1,
@ -184,11 +184,11 @@ build_avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, CPT, [V1,V2], V
build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 1.0, 0, I1, Vs, Vs1), build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs), build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT). average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT).
build_max_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :- build_max_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain), length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize), int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, TabSize =< 16,
/* case gmp is not there !! */ /* case gmp is not there !! */
TabSize > 0, !, TabSize > 0, !,
max_cpt(Vars, Domain, Softness, CPT). max_cpt(Vars, Domain, Softness, CPT).
@ -200,11 +200,11 @@ build_max_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewV
build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1), build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs), build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
max_cpt([V1,V2], Domain, Softness, CPT). max_cpt([V1,V2], Domain, Softness, CPT).
build_min_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :- build_min_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain), length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize), int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, TabSize =< 16,
/* case gmp is not there !! */ /* case gmp is not there !! */
TabSize > 0, !, TabSize > 0, !,
min_cpt(Vars, Domain, Softness, CPT). min_cpt(Vars, Domain, Softness, CPT).
@ -216,7 +216,7 @@ build_min_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewV
build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1), build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs), build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
min_cpt([V1,V2], Domain, Softness, CPT). min_cpt([V1,V2], Domain, Softness, CPT).
int_power([], _, TabSize, TabSize). int_power([], _, TabSize, TabSize).
int_power([_|L], X, I0, TabSize) :- int_power([_|L], X, I0, TabSize) :-
I is I0*X, I is I0*X,
@ -273,19 +273,21 @@ include_qevidence(_, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :- check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
sumlist(L1, Tot), sumlist(L1, Tot),
nth0(Ev, L1, Val), nth0(Ev, L1, Val),
(Val == Tot -> (
MAT1 = MAT, Val == Tot
NewParents = [], ->
Vs = NewVs MAT1 = MAT,
NewParents = [],
Vs = NewVs
; ;
Val == 0.0 -> Val == 0.0 ->
throw(error(domain_error(incompatible_evidence),evidence(Ev))) throw(error(domain_error(incompatible_evidence),evidence(Ev)))
; ;
MAT0 = MAT, MAT0 = MAT,
NewParents = NewParents0, NewParents = NewParents0,
IVs = NewVs IVs = NewVs
). ).
% %
% generate actual table, instead of trusting the solver % generate actual table, instead of trusting the solver
@ -376,6 +378,6 @@ get_vdist_size(V, Sz) :-
clpbn:get_atts(V, [dist(Dist,_)]), clpbn:get_atts(V, [dist(Dist,_)]),
get_dist_domain_size(Dist, Sz). get_dist_domain_size(Dist, Sz).
get_vdist_size(V, Sz) :- get_vdist_size(V, Sz) :-
skolem(V, Dom), skolem(V, Dom),
length(Dom, Sz). length(Dom, Sz).

210
packages/CLPBN/clpbn/bdd.yap
View File

@ -93,37 +93,37 @@ run_bdd_ground_solver(_QueryVars, Solutions, bdd(GKeys, Keys, Factors, Evidence)
check_if_bdd_done(_Var). check_if_bdd_done(_Var).
call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions), call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output). clpbn_bind_vals([QueryVars], Solutions, Output).
call_bdd_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- call_bdd_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD), init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
run_solver(QueryKeys, Solutions, BDD). run_solver(QueryKeys, Solutions, BDD).
init_bdd(FactorIds, EvidenceIds, Hash, Id, bdd(Term, Leaves, Tops, Hash, Id)) :- init_bdd(FactorIds, EvidenceIds, Hash, Id, bdd(Term, Leaves, Tops, Hash, Id)) :-
sort_keys(FactorIds, AllVars, Leaves), sort_keys(FactorIds, AllVars, Leaves),
rb_new(OrderVs0), rb_new(OrderVs0),
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs), foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
rb_new(Vars0), rb_new(Vars0),
rb_new(Pars0), rb_new(Pars0),
rb_new(Ev0), rb_new(Ev0),
foldl(evtotree,EvidenceIds,Ev0,Ev), foldl(evtotree,EvidenceIds,Ev0,Ev),
rb_new(Fs0), rb_new(Fs0),
foldl(ftotree,FactorIds,Fs0,Fs), foldl(ftotree,FactorIds,Fs0,Fs),
init_tops(Leaves,Tops), init_tops(Leaves,Tops),
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []). get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
order_key( Id, I0, I, OrderVs0, OrderVs) :- order_key( Id, I0, I, OrderVs0, OrderVs) :-
I is I0+1, I is I0+1,
rb_insert(OrderVs0, Id, I0, OrderVs). rb_insert(OrderVs0, Id, I0, OrderVs).
evtotree(K=V,Ev0,Ev) :- evtotree(K=V,Ev0,Ev) :-
rb_insert(Ev0, K, V, Ev). rb_insert(Ev0, K, V, Ev).
ftotree(F, Fs0, Fs) :- ftotree(F, Fs0, Fs) :-
F = f([K|_Parents],_,_,_), F = f([K|_Parents],_,_,_),
rb_insert(Fs0, K, F, Fs). rb_insert(Fs0, K, F, Fs).
bdd([[]],_,_) :- !. bdd([[]],_,_) :- !.
bdd([QueryVars], AllVars, AllDiffs) :- bdd([QueryVars], AllVars, AllDiffs) :-
@ -155,59 +155,59 @@ init_tops([_|Leaves],[_|Tops]) :-
init_tops(Leaves,Tops). init_tops(Leaves,Tops).
sort_keys(AllFs, AllVars, Leaves) :- sort_keys(AllFs, AllVars, Leaves) :-
dgraph_new(Graph0), dgraph_new(Graph0),
foldl(add_node, AllFs, Graph0, Graph), foldl(add_node, AllFs, Graph0, Graph),
dgraph_leaves(Graph, Leaves), dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars). dgraph_top_sort(Graph, AllVars).
add_node(f([K|Parents],_,_,_), Graph0, Graph) :- add_node(f([K|Parents],_,_,_), Graph0, Graph) :-
dgraph_add_vertex(Graph0, K, Graph1), dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph). foldl(add_edge(K), Parents, Graph1, Graph).
add_edge(K, K0, Graph0, Graph) :- add_edge(K, K0, Graph0, Graph) :-
dgraph_add_edge(Graph0, K0, K, Graph). dgraph_add_edge(Graph0, K0, K, Graph).
sort_vars(AllVars0, AllVars, Leaves) :- sort_vars(AllVars0, AllVars, Leaves) :-
dgraph_new(Graph0), dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph), build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves), dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars). dgraph_top_sort(Graph, AllVars).
build_graph([], Graph, Graph). build_graph([], Graph, Graph).
build_graph([V|AllVars0], Graph0, Graph) :- build_graph([V|AllVars0], Graph0, Graph) :-
clpbn:get_atts(V, [dist(_DistId, Parents)]), !, clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1), dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI), add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph). build_graph(AllVars0, GraphI, Graph).
build_graph(_V.AllVars0, Graph0, Graph) :- build_graph(_V.AllVars0, Graph0, Graph) :-
build_graph(AllVars0, Graph0, Graph). build_graph(AllVars0, Graph0, Graph).
add_parents([], _V, Graph, Graph). add_parents([], _V, Graph, Graph).
add_parents([V0|Parents], V, Graph0, GraphF) :- add_parents([V0|Parents], V, Graph0, GraphF) :-
dgraph_add_edge(Graph0, V0, V, GraphI), dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF). add_parents(Parents, V, GraphI, GraphF).
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> []. get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) --> get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !, { rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) }, { F = f([V|Parents], _, _, DistId) },
%{writeln(v:DistId:Parents)}, %{writeln(v:DistId:Parents)},
[DIST], [DIST],
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) }, { get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs). get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :- get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
reorder_keys(Parents0, OrderVs, Parents, Map), reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1), check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars), unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_), F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1), check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms), DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]] % get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2), foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0), cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true), % (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs). get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs).
% (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true). % (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true).
get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> []. get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> [].
@ -215,7 +215,7 @@ get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ clpbn:get_atts(V, [dist(DistId, Parents)]) }, !, { clpbn:get_atts(V, [dist(DistId, Parents)]) }, !,
%{writeln(v:DistId:Parents)}, %{writeln(v:DistId:Parents)},
[DIST], [DIST],
{ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) }, { get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_vars_info(MoreVs, Vs2, VsF, Ps1, PsF, Lvs, Outs). get_vars_info(MoreVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :- get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
get_vars_info(MoreVs, Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs). get_vars_info(MoreVs, Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs).
@ -298,17 +298,17 @@ generate_3tree(OUT, [[P0,P1,P2]], I00, I10, I20, IR0, N0, N1, N2, R, Exp, _ExpF)
IR is IR0-1, IR is IR0-1,
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) -> ( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
L0 = [P0|L1] L0 = [P0|L1]
; ;
L0 = L1 L0 = L1
), ),
( satisf(I00, I10+1, I20, IR, N0, N1, N2, R, Exp) -> ( satisf(I00, I10+1, I20, IR, N0, N1, N2, R, Exp) ->
L1 = [P1|L2] L1 = [P1|L2]
; ;
L1 = L2 L1 = L2
), ),
( satisf(I00, I10, I20+1, IR, N0, N1, N2, R, Exp) -> ( satisf(I00, I10, I20+1, IR, N0, N1, N2, R, Exp) ->
L2 = [P2] L2 = [P2]
; ;
L2 = [] L2 = []
), ),
to_disj(L0, OUT). to_disj(L0, OUT).
@ -316,23 +316,23 @@ generate_3tree(OUT, [[P0,P1,P2]|Ps], I00, I10, I20, IR0, N0, N1, N2, R, Exp, Exp
IR is IR0-1, IR is IR0-1,
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) -> ( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
I0 is I00+1, generate_3tree(O0, Ps, I0, I10, I20, IR, N0, N1, N2, R, Exp, ExpF) I0 is I00+1, generate_3tree(O0, Ps, I0, I10, I20, IR, N0, N1, N2, R, Exp, ExpF)
-> ->
L0 = [P0*O0|L1] L0 = [P0*O0|L1]
; ;
L0 = L1 L0 = L1
), ),
( satisf(I00, I10+1, I20, IR0, N0, N1, N2, R, Exp) -> ( satisf(I00, I10+1, I20, IR0, N0, N1, N2, R, Exp) ->
I1 is I10+1, generate_3tree(O1, Ps, I00, I1, I20, IR, N0, N1, N2, R, Exp, ExpF) I1 is I10+1, generate_3tree(O1, Ps, I00, I1, I20, IR, N0, N1, N2, R, Exp, ExpF)
-> ->
L1 = [P1*O1|L2] L1 = [P1*O1|L2]
; ;
L1 = L2 L1 = L2
), ),
( satisf(I00, I10, I20+1, IR0, N0, N1, N2, R, Exp) -> ( satisf(I00, I10, I20+1, IR0, N0, N1, N2, R, Exp) ->
I2 is I20+1, generate_3tree(O2, Ps, I00, I10, I2, IR, N0, N1, N2, R, Exp, ExpF) I2 is I20+1, generate_3tree(O2, Ps, I00, I10, I2, IR, N0, N1, N2, R, Exp, ExpF)
-> ->
L2 = [P2*O2] L2 = [P2*O2]
; ;
L2 = [] L2 = []
), ),
to_disj(L0, OUT). to_disj(L0, OUT).
@ -384,12 +384,12 @@ avg_exp([Val|Vals], PVars, I0, P0, Max, Size, Im, IM, HI, HF, O) :-
(Vals = [] -> O=O1 ; O = Val*O1+not(Val)*O2 ), (Vals = [] -> O=O1 ; O = Val*O1+not(Val)*O2 ),
Im1 is max(0, Im-I0), Im1 is max(0, Im-I0),
IM1 is IM-I0, IM1 is IM-I0,
( IM1 < 0 -> O1 = 0, H2 = HI; /* we have exceed maximum */ ( IM1 < 0 -> O1 = 0, H2 = HI ; /* we have exceed maximum */
Im1 > Max -> O1 = 0, H2 = HI; /* we cannot make to minimum */ Im1 > Max -> O1 = 0, H2 = HI ; /* we cannot make to minimum */
Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI; /* we cannot exceed maximum */ Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI ; /* we cannot exceed maximum */
P is P0+1, P is P0+1,
avg_tree(PVars, P, Max, Im1, IM1, Size, O1, HI, H2) avg_tree(PVars, P, Max, Im1, IM1, Size, O1, HI, H2)
), ),
I is I0+1, I is I0+1,
avg_exp(Vals, PVars, I, P0, Max, Size, Im, IM, H2, HF, O2). avg_exp(Vals, PVars, I, P0, Max, Size, Im, IM, H2, HF, O2).
@ -437,11 +437,11 @@ bin_sums(Vs, Sums, F) :-
vs_to_sums([], []). vs_to_sums([], []).
vs_to_sums([V|Vs], [Sum|Sums0]) :- vs_to_sums([V|Vs], [Sum|Sums0]) :-
Sum =.. [sum|V], Sum =.. [sum|V],
vs_to_sums(Vs, Sums0). vs_to_sums(Vs, Sums0).
bin_sums([Sum], Sum) --> !. bin_sums([Sum], Sum) --> !.
bin_sums(LSums, Sum) --> bin_sums(LSums, Sum) -->
{ halve(LSums, Sums1, Sums2) }, { halve(LSums, Sums1, Sums2) },
bin_sums(Sums1, Sum1), bin_sums(Sums1, Sum1),
bin_sums(Sums2, Sum2), bin_sums(Sums2, Sum2),
@ -458,14 +458,14 @@ head(Take, [H|L], [H|Sums1], Sum2) :-
head(Take1, L, Sums1, Sum2). head(Take1, L, Sums1, Sum2).
sum(Sum1, Sum2, Sum) --> sum(Sum1, Sum2, Sum) -->
{ functor(Sum1, _, M1), { functor(Sum1, _, M1),
functor(Sum2, _, M2), functor(Sum2, _, M2),
Max is M1+M2-2, Max is M1+M2-2,
Max1 is Max+1, Max1 is Max+1,
Max0 is M2-1, Max0 is M2-1,
functor(Sum, sum, Max1), functor(Sum, sum, Max1),
Sum1 =.. [_|PVals] }, Sum1 =.. [_|PVals] },
expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum). expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
% %
% bottom up step by step % bottom up step by step
@ -509,12 +509,12 @@ expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, [O=SUM*1|F], F0)
arg(I, NewSums, O), arg(I, NewSums, O),
sum_all(Parents, 0, I0, Max0, Sums, List), sum_all(Parents, 0, I0, Max0, Sums, List),
to_disj(List, SUM), to_disj(List, SUM),
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0). expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, F, F0) :- expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, F, F0) :-
I is I0+1, I is I0+1,
arg(I, Sums, O), arg(I, Sums, O),
arg(I, NewSums, O), arg(I, NewSums, O),
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0). expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
% %
%inner loop: find all parents that contribute to A_ji, %inner loop: find all parents that contribute to A_ji,
@ -538,12 +538,12 @@ gen_arg(J, Sums, Max, S0) :-
gen_arg(0, Max, J, Sums, S0). gen_arg(0, Max, J, Sums, S0).
gen_arg(Max, Max, J, Sums, S0) :- !, gen_arg(Max, Max, J, Sums, S0) :- !,
I is Max+1, I is Max+1,
arg(I, Sums, A), arg(I, Sums, A),
( Max = J -> S0 = A ; S0 = not(A)). ( Max = J -> S0 = A ; S0 = not(A)).
gen_arg(I0, Max, J, Sums, S) :- gen_arg(I0, Max, J, Sums, S) :-
I is I0+1, I is I0+1,
arg(I, Sums, A), arg(I, Sums, A),
( I0 = J -> S = A*S0 ; S = not(A)*S0), ( I0 = J -> S = A*S0 ; S = not(A)*S0),
gen_arg(I, Max, J, Sums, S0). gen_arg(I, Max, J, Sums, S0).
@ -692,9 +692,9 @@ get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
get_parents(Parents, PVars, Vs1, Vs). get_parents(Parents, PVars, Vs1, Vs).
get_key_parent(Fs, V, Values, Vs0, Vs) :- get_key_parent(Fs, V, Values, Vs0, Vs) :-
INFO = info(V, _Parent, _Ev, Values, _, _, _), INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs), rb_lookup(V, f(_, [Size|_], _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs). check_key(V, Size, INFO, Vs0, Vs).
check_key(V, _, INFO, Vs, Vs) :- check_key(V, _, INFO, Vs, Vs) :-
rb_lookup(V, INFO, Vs), !. rb_lookup(V, INFO, Vs), !.
@ -809,20 +809,20 @@ skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :-
skim_for_theta(More, Ps, Left, New ). skim_for_theta(More, Ps, Left, New ).
get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :- get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :-
rb_lookup(V, Pos, Evs), !, rb_lookup(V, Pos, Evs), !,
zero_pos(0, Pos, Ev), zero_pos(0, Pos, Ev),
insert_output(Leaves, V, Finals, Tree, Outs, SendOut), insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs). get_outs(F0, F, SendOut, Outs).
% hidden deterministic node, can be removed. % hidden deterministic node, can be removed.
%% get_key_evidence(V, _, DistId, _Tree, Ev, F0, [], _Leaves, _Finals) :- %% get_key_evidence(V, _, DistId, _Tree, Ev, F0, [], _Leaves, _Finals) :-
%% deterministic(V, DistId), %% deterministic(V, DistId),
%% !, %% !,
%% one_list(Ev), %% one_list(Ev),
%% eval_outs(F0). %% eval_outs(F0).
%% no evidence !!! %% no evidence !!!
get_key_evidence(V, _, _, Tree, _Values, F0, F1, Leaves, Finals) :- get_key_evidence(V, _, _, Tree, _Values, F0, F1, Leaves, Finals) :-
insert_output(Leaves, V, Finals, Tree, Outs, SendOut), insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs). get_outs(F0, F1, SendOut, Outs).
get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :- get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
clpbn:get_atts(V, [evidence(Pos)]), !, clpbn:get_atts(V, [evidence(Pos)]), !,
@ -846,7 +846,7 @@ zero_pos(_, _Pos, []).
zero_pos(Pos, Pos, [1|Values]) :- !, zero_pos(Pos, Pos, [1|Values]) :- !,
I is Pos+1, I is Pos+1,
zero_pos(I, Pos, Values). zero_pos(I, Pos, Values).
zero_pos(I0, Pos, [0|Values]) :- zero_pos(I0, Pos, [0|Values]) :-
I is I0+1, I is I0+1,
zero_pos(I, Pos, Values). zero_pos(I, Pos, Values).
@ -863,7 +863,7 @@ insert_output(_.Leaves, V, _.Finals, Top, Outs, SendOut) :-
insert_output(Leaves, V, Finals, Top, Outs, SendOut). insert_output(Leaves, V, Finals, Top, Outs, SendOut).
get_outs([V=F], [V=NF|End], End, V) :- !, get_outs([V=F], [V=NF|End], End, V) :- !,
% writeln(f0:F), % writeln(f0:F),
simplify_exp(F,NF). simplify_exp(F,NF).
get_outs([(V=F)|Outs], [(V=NF)|NOuts], End, (F0 + V)) :- get_outs([(V=F)|Outs], [(V=NF)|NOuts], End, (F0 + V)) :-
@ -878,11 +878,11 @@ eval_outs([(V=F)|Outs]) :-
eval_outs(Outs). eval_outs(Outs).
run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :- run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :-
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _), lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
findall(LPs, findall(LPs,
(member(Q, QIds), (member(Q, QIds),
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))), run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
LLPs). LLPs).
run_bdd_solver([Vs], LPs, bdd(Term, _Leaves, Nodes)) :- run_bdd_solver([Vs], LPs, bdd(Term, _Leaves, Nodes)) :-
build_out_node(Nodes, Node), build_out_node(Nodes, Node),
@ -988,7 +988,7 @@ all_cnfs([info(_V, Tree, Ev, Values, Formula, ParmVars, Parms)|Term], BindsF, IV
v_in(V, [V0|_]) :- V == V0, !. v_in(V, [V0|_]) :- V == V0, !.
v_in(V, [_|Vs]) :- v_in(V, [_|Vs]) :-
v_in(V, Vs). v_in(V, Vs).
all_indicators(Values) --> all_indicators(Values) -->
{ values_to_disj(Values, Disj) }, { values_to_disj(Values, Disj) },
@ -1017,7 +1017,7 @@ parameters([(V0=Disj*_I0)|Formula], Tree) -->
parameters(Formula, Tree). parameters(Formula, Tree).
% transform V0<- A*B+C*(D+not(E)) % transform V0<- A*B+C*(D+not(E))
% [V0+not(A)+not(B),V0+not(C)+not(D),V0+not(C)+E] % [V0+not(A)+not(B),V0+not(C)+not(D),V0+not(C)+E]
conj(Disj, V0) --> conj(Disj, V0) -->
{ conj2(Disj, [[V0]], LVs) }, { conj2(Disj, [[V0]], LVs) },
to_disjs(LVs). to_disjs(LVs).

13
packages/CLPBN/clpbn/bnt.yap
View File

@ -154,7 +154,7 @@ extract_kvars([V|AllVars],[N-i(V,Parents)|KVars]) :-
extract_kvars(AllVars,KVars). extract_kvars(AllVars,KVars).
split_tied_vars([],[],[]). split_tied_vars([],[],[]).
split_tied_vars([N-i(V,Par)|More],[N-g(Vs,Ns,Es)|TVars],[N|LNs]) :- split_tied_vars([N-i(V,Par)|More],[N-g(Vs,Ns,Es)|TVars],[N|LNs]) :-
get_pars(Par,N,V,NPs,[],Es0,Es), get_pars(Par,N,V,NPs,[],Es0,Es),
get_tied(More,N,Vs,[V],Ns,NPs,Es,Es0,SVars), get_tied(More,N,Vs,[V],Ns,NPs,Es,Es0,SVars),
split_tied_vars(SVars,TVars,LNs). split_tied_vars(SVars,TVars,LNs).
@ -206,7 +206,7 @@ extract_graph(AllVars, Graph) :-
dgraph_add_vertices(Graph0, AllVars, Graph1), dgraph_add_vertices(Graph0, AllVars, Graph1),
get_edges(AllVars,Edges), get_edges(AllVars,Edges),
dgraph_add_edges(Graph1, Edges, Graph). dgraph_add_edges(Graph1, Edges, Graph).
get_edges([],[]). get_edges([],[]).
get_edges([V|AllVars],Edges) :- get_edges([V|AllVars],Edges) :-
clpbn:get_atts(V, [dist(_,Parents)]), clpbn:get_atts(V, [dist(_,Parents)]),
@ -224,13 +224,13 @@ number_graph([V|SortedGraph], [I|Is], I0, IF) :-
% clpbn:get_atts(V,[key(K)]), % clpbn:get_atts(V,[key(K)]),
% write(I:K),nl, % write(I:K),nl,
number_graph(SortedGraph, Is, I, IF). number_graph(SortedGraph, Is, I, IF).
init_bnet(propositional, SortedGraph, NumberedGraph, Size, []) :- init_bnet(propositional, SortedGraph, NumberedGraph, Size, []) :-
build_dag(SortedGraph, Size), build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size), init_discrete_nodes(SortedGraph, Size),
bnet <-- mk_bnet(dag, node_sizes, \discrete, discrete_nodes), bnet <-- mk_bnet(dag, node_sizes, \discrete, discrete_nodes),
dump_cpts(SortedGraph, NumberedGraph). dump_cpts(SortedGraph, NumberedGraph).
init_bnet(tied, SortedGraph, NumberedGraph, Size, Representatives) :- init_bnet(tied, SortedGraph, NumberedGraph, Size, Representatives) :-
build_dag(SortedGraph, Size), build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size), init_discrete_nodes(SortedGraph, Size),
@ -382,7 +382,7 @@ add_evidence(Graph, Size, Is) :-
mk_evidence(Graph, Is, LN), mk_evidence(Graph, Is, LN),
matlab_initialized_cells( 1, Size, LN, evidence), matlab_initialized_cells( 1, Size, LN, evidence),
[engine_ev, loglik] <-- enter_evidence(engine, evidence). [engine_ev, loglik] <-- enter_evidence(engine, evidence).
mk_evidence([], [], []). mk_evidence([], [], []).
mk_evidence([V|L], [I|Is], [ar(1,I,EvVal1)|LN]) :- mk_evidence([V|L], [I|Is], [ar(1,I,EvVal1)|LN]) :-
clpbn:get_atts(V, [evidence(EvVal)]), !, clpbn:get_atts(V, [evidence(EvVal)]), !,
@ -409,7 +409,7 @@ marginalize([Vs], SortedVars, NumberedVars,Ps) :-
length(SortedVars,L), length(SortedVars,L),
cycle_values(Den, Ev, Vs, L, Vals, Ps). cycle_values(Den, Ev, Vs, L, Vals, Ps).
cycle_values(_D, _Ev, _Vs, _Size, [], []). cycle_values(_D, _Ev, _Vs, _Size, [], []).
cycle_values(Den,Ev,Vs,Size,[H|T],[HP|TP]):- cycle_values(Den,Ev,Vs,Size,[H|T],[HP|TP]):-
mk_evidence_query(Vs, H, EvQuery), mk_evidence_query(Vs, H, EvQuery),
@ -428,4 +428,3 @@ mk_evidence_query([V|L], [H|T], [ar(1,Pos,El)|LN]) :-
nth(El,D,H), nth(El,D,H),
mk_evidence_query(L, T, LN). mk_evidence_query(L, T, LN).

84
packages/CLPBN/clpbn/connected.yap
View File

@ -61,13 +61,13 @@ build_edges([P|Parents], V, [P-V|Edges]) :-
% search for the set of variables that influence V % search for the set of variables that influence V
influences(Vs, G, RG, Vars) :- influences(Vs, G, RG, Vars) :-
influences(Vs, [], G, RG, Vars). influences(Vs, [], G, RG, Vars).
% search for the set of variables that influence V % search for the set of variables that influence V
influences(Vs, Evs, G, RG, Vars) :- influences(Vs, Evs, G, RG, Vars) :-
rb_new(Visited0), rb_new(Visited0),
foldl(influence(Evs, G, RG), Vs, Visited0, Visited), foldl(influence(Evs, G, RG), Vs, Visited0, Visited),
all_top(Visited, Evs, Vars). all_top(Visited, Evs, Vars).
influence(_, _G, _RG, V, Vs, Vs) :- influence(_, _G, _RG, V, Vs, Vs) :-
rb_lookup(V, [T|B], Vs), T == t, B == b, !. rb_lookup(V, [T|B], Vs), T == t, B == b, !.
@ -91,76 +91,78 @@ process_new_variable(V, Evs, G, RG, Vs0, Vs2) :-
% visited % visited
throw_below(Evs, G, RG, Child, Vs0, Vs1) :- throw_below(Evs, G, RG, Child, Vs0, Vs1) :-
rb_lookup(Child, [_|B], Vs0), !, rb_lookup(Child, [_|B], Vs0), !,
( (
B == b -> B == b
->
Vs0 = Vs1 % been there before Vs0 = Vs1 % been there before
; ;
B = b, % mark it B = b, % mark it
handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1) handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1)
). ).
throw_below(Evs, G, RG, Child, Vs0, Vs2) :- throw_below(Evs, G, RG, Child, Vs0, Vs2) :-
rb_insert(Vs0, Child, [_|b], Vs1), rb_insert(Vs0, Child, [_|b], Vs1),
handle_ball_from_above(Child, Evs, G, RG, Vs1, Vs2). handle_ball_from_above(Child, Evs, G, RG, Vs1, Vs2).
% share this with parents, if we have evidence % share this with parents, if we have evidence
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
var(V), var(V),
clpbn:get_atts(V,[evidence(_)]), !, clpbn:get_atts(V,[evidence(_)]), !,
dgraph_neighbors(V, RG, Parents), dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
nonvar(V), nonvar(V),
rb_lookup(V,_,Evs), !, rb_lookup(V,_,Evs), !,
dgraph_neighbors(V, RG, Parents), dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
% propagate to kids, if we do not % propagate to kids, if we do not
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
dgraph_neighbors(V, G, Children), dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
% visited % visited
throw_above(Evs, G, RG, Parent, Vs0, Vs1) :- throw_above(Evs, G, RG, Parent, Vs0, Vs1) :-
rb_lookup(Parent, [T|_], Vs0), !, rb_lookup(Parent, [T|_], Vs0), !,
( (
T == t -> T == t
->
Vs1 = Vs0 % been there before Vs1 = Vs0 % been there before
; ;
T = t, % mark it T = t, % mark it
handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1) handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1)
). ).
throw_above(Evs, G, RG, Parent, Vs0, Vs2) :- throw_above(Evs, G, RG, Parent, Vs0, Vs2) :-
rb_insert(Vs0, Parent, [t|_], Vs1), rb_insert(Vs0, Parent, [t|_], Vs1),
handle_ball_from_below(Parent, Evs, G, RG, Vs1, Vs2). handle_ball_from_below(Parent, Evs, G, RG, Vs1, Vs2).
% share this with parents, if we have evidence % share this with parents, if we have evidence
handle_ball_from_below(V, _Evs, _, _, Vs, Vs) :- handle_ball_from_below(V, _Evs, _, _, Vs, Vs) :-
var(V), var(V),
clpbn:get_atts(V,[evidence(_)]), !. clpbn:get_atts(V,[evidence(_)]), !.
handle_ball_from_below(V, Evs, _, _, Vs, Vs) :- handle_ball_from_below(V, Evs, _, _, Vs, Vs) :-
nonvar(V), nonvar(V),
rb_lookup(V, _, Evs), !. rb_lookup(V, _, Evs), !.
% propagate to kids, if we do not % propagate to kids, if we do not
handle_ball_from_below(V, Evs, G, RG, Vs0, Vs1) :- handle_ball_from_below(V, Evs, G, RG, Vs0, Vs1) :-
dgraph_neighbors(V, RG, Parents), dgraph_neighbors(V, RG, Parents),
propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1). propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1).
propagate_ball_from_below([], Evs, V, G, RG, Vs0, Vs1) :- !, propagate_ball_from_below([], Evs, V, G, RG, Vs0, Vs1) :- !,
dgraph_neighbors(V, G, Children), dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
propagate_ball_from_below(Parents, Evs, _V, G, RG, Vs0, Vs1) :- propagate_ball_from_below(Parents, Evs, _V, G, RG, Vs0, Vs1) :-
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
all_top(T, Evs, Vs) :- all_top(T, Evs, Vs) :-
rb_visit(T, Pairs), rb_visit(T, Pairs),
foldl( get_top(Evs), Pairs, [], Vs). foldl( get_top(Evs), Pairs, [], Vs).
get_top(_EVs, V-[T|_], Vs, [V|Vs]) :- get_top(_EVs, V-[T|_], Vs, [V|Vs]) :-
T == t, !. T == t, !.
get_top(_EVs, V-_, Vs, [V|Vs]) :- get_top(_EVs, V-_, Vs, [V|Vs]) :-
var(V), var(V),
clpbn:get_atts(V,[evidence(_)]), !. clpbn:get_atts(V,[evidence(_)]), !.
get_top(EVs, V-_, Vs, [V|Vs]) :- get_top(EVs, V-_, Vs, [V|Vs]) :-
nonvar(V), nonvar(V),
rb_lookup(V, _, EVs), !. rb_lookup(V, _, EVs), !.
get_top(_, _, Vs, Vs). get_top(_, _, Vs, Vs).

6
packages/CLPBN/clpbn/discrete_utils.yap
View File

@ -25,10 +25,10 @@ propagate_evidence(V, Evs) :-
get_dist_domain(Id, Out), get_dist_domain(Id, Out),
generate_szs_with_evidence(Out,Ev,0,Evs,Found), generate_szs_with_evidence(Out,Ev,0,Evs,Found),
(var(Found) -> (var(Found) ->
clpbn:get_atts(V, [key(K)]), clpbn:get_atts(V, [key(K)]),
throw(clpbn(evidence_does_not_match,K,Ev,[Out])) throw(clpbn(evidence_does_not_match,K,Ev,[Out]))
; ;
true true
). ).
propagate_evidence(_, _). propagate_evidence(_, _).

1
packages/CLPBN/clpbn/display.yap
View File

@ -1,3 +1,4 @@
:- module(clpbn_display, :- module(clpbn_display,
[clpbn_bind_vals/3]). [clpbn_bind_vals/3]).

12
packages/CLPBN/clpbn/dists.yap
View File

@ -326,11 +326,11 @@ randomise_all_dists.
randomise_dist(Dist) :- randomise_dist(Dist) :-
( (
use_parfactors(on) use_parfactors(on)
-> ->
pfl:get_pfl_factor_sizes(Dist, DSizes) pfl:get_pfl_factor_sizes(Dist, DSizes)
; ;
recorded(clpbn_dist_psizes, db(Dist,DSizes), _) recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
), ),
random_CPT(DSizes, NewCPT), random_CPT(DSizes, NewCPT),
dist_new_table(Dist, NewCPT). dist_new_table(Dist, NewCPT).
@ -342,11 +342,11 @@ uniformise_all_dists.
uniformise_dist(Dist) :- uniformise_dist(Dist) :-
( (
use_parfactors(on) use_parfactors(on)
-> ->
pfl:get_pfl_factor_sizes(Dist, DSizes) pfl:get_pfl_factor_sizes(Dist, DSizes)
; ;
recorded(clpbn_dist_psizes, db(Dist,DSizes), _) recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
), ),
uniform_CPT(DSizes, NewCPT), uniform_CPT(DSizes, NewCPT),
dist_new_table(Dist, NewCPT). dist_new_table(Dist, NewCPT).

3
packages/CLPBN/clpbn/evidence.yap
View File

@ -61,7 +61,7 @@ evidence_error(Ball,PreviousSolver) :-
store_graph([]). store_graph([]).
store_graph([V|Vars]) :- store_graph([V|Vars]) :-
clpbn:get_atts(V,[key(K),dist(Id,Vs)]), clpbn:get_atts(V,[key(K),dist(Id,Vs)]),
\+ node(K, Id, _), !, \+ node(K, Id, _), !,
translate_vars(Vs,TVs), translate_vars(Vs,TVs),
assert(node(K,Id,TVs)), assert(node(K,Id,TVs)),
@ -84,7 +84,6 @@ add_links([K0|TVs],K) :-
assert(edge(K,K0)), assert(edge(K,K0)),
add_links(TVs,K). add_links(TVs,K).
incorporate_evidence(Vs,AllVs) :- incorporate_evidence(Vs,AllVs) :-
rb_new(Cache0), rb_new(Cache0),
create_open_list(Vs, OL, FL, Cache0, CacheI), create_open_list(Vs, OL, FL, Cache0, CacheI),

14
packages/CLPBN/clpbn/gibbs.yap
View File

@ -249,11 +249,11 @@ compile_var(_,_,_,_,_,_,_,_).
multiply_all(I,Parents,CPTs,Sz,Graph) :- multiply_all(I,Parents,CPTs,Sz,Graph) :-
markov_blanket_instance(Parents,Graph,Values), markov_blanket_instance(Parents,Graph,Values),
( (
multiply_all(CPTs,Graph,Probs) multiply_all(CPTs,Graph,Probs)
-> ->
store_mblanket(I,Values,Probs) store_mblanket(I,Values,Probs)
; ;
throw(error(domain_error(bayesian_domain),gibbs_cpt(I,Parents,Values,Sz))) throw(error(domain_error(bayesian_domain),gibbs_cpt(I,Parents,Values,Sz)))
), ),
fail. fail.
multiply_all(I,_,_,_,_) :- multiply_all(I,_,_,_,_) :-
@ -283,7 +283,7 @@ fetch_parents([], _, []).
fetch_parents([P|Parents], Graph, [Val|Vals]) :- fetch_parents([P|Parents], Graph, [Val|Vals]) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)), arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)),
fetch_parents(Parents, Graph, Vals). fetch_parents(Parents, Graph, Vals).
multiply_more([],_,Probs0,LProbs) :- multiply_more([],_,Probs0,LProbs) :-
normalise_possibly_deterministic_CPT(Probs0, Probs), normalise_possibly_deterministic_CPT(Probs0, Probs),
list_from_CPT(Probs, LProbs0), list_from_CPT(Probs, LProbs0),
@ -299,7 +299,7 @@ accumulate_up_list([P|LProbs], P0, [P1|L]) :-
P1 is P0+P, P1 is P0+P,
accumulate_up_list(LProbs, P1, L). accumulate_up_list(LProbs, P1, L).
store_mblanket(I,Values,Probs) :- store_mblanket(I,Values,Probs) :-
recordz(mblanket,m(I,Values,Probs),_). recordz(mblanket,m(I,Values,Probs),_).
@ -458,7 +458,7 @@ get_estimate_pos([I|Is], Sample, [M|Mult], V0, V) :-
get_estimate_pos(Is, Sample, Mult, VI, V). get_estimate_pos(Is, Sample, Mult, VI, V).
update_estimate_for_var(V0,[X|T],[X1|NT]) :- update_estimate_for_var(V0,[X|T],[X1|NT]) :-
( V0 == 0 -> (V0 == 0 ->
X1 is X+1, X1 is X+1,
NT = T NT = T
; ;
@ -499,7 +499,7 @@ do_probs([E|Es],Sum,[P|Ps]) :-
show_sorted([], _) :- nl. show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :- show_sorted([I|VarOrder], Graph) :-
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)), arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
clpbn:get_atts(V,[key(K)]), clpbn:get_atts(V,[key(K)]),
format('~w ',[K]), format('~w ',[K]),
show_sorted(VarOrder, Graph). show_sorted(VarOrder, Graph).

48
packages/CLPBN/clpbn/ground_factors.yap
View File

@ -42,7 +42,7 @@ generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
b_hash_new(Evidence0), b_hash_new(Evidence0),
foldl(include_evidence,AVars, Evidence0, Evidence1), foldl(include_evidence,AVars, Evidence0, Evidence1),
static_evidence(Evidence1, Evidence), static_evidence(Evidence1, Evidence),
b_hash_to_list(Evidence, EList0), b_hash_to_list(Evidence, EList0),
maplist(pair_to_evidence,EList0, EList), maplist(pair_to_evidence,EList0, EList),
maplist(queue_evidence, EList), maplist(queue_evidence, EList),
foldl(run_through_query(Evidence), QueryVars, [], QueryKeys), foldl(run_through_query(Evidence), QueryVars, [], QueryKeys),
@ -62,11 +62,11 @@ pair_to_evidence(K-E, K=E).
include_evidence(V, Evidence0, Evidence) :- include_evidence(V, Evidence0, Evidence) :-
clpbn:get_atts(V,[key(K),evidence(E)]), !, clpbn:get_atts(V,[key(K),evidence(E)]), !,
( (
b_hash_lookup(K, E1, Evidence0) b_hash_lookup(K, E1, Evidence0)
-> ->
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0) (E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
; ;
b_hash_insert(Evidence0, K, E, Evidence) b_hash_insert(Evidence0, K, E, Evidence)
). ).
include_evidence(_, Evidence, Evidence). include_evidence(_, Evidence, Evidence).
@ -76,16 +76,16 @@ static_evidence(Evidence0, Evidence) :-
include_static_evidence(K=E, Evidence0, Evidence) :- include_static_evidence(K=E, Evidence0, Evidence) :-
( (
b_hash_lookup(K, E1, Evidence0) b_hash_lookup(K, E1, Evidence0)
-> ->
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0) (E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
; ;
b_hash_insert(Evidence0, K, E, Evidence) b_hash_insert(Evidence0, K, E, Evidence)
). ).
queue_evidence(K=_) :- queue_evidence(K=_) :-
queue_in(K). queue_in(K).
run_through_query(Evidence, V, QueryKeys, QueryKeys) :- run_through_query(Evidence, V, QueryKeys, QueryKeys) :-
clpbn:get_atts(V,[key(K)]), clpbn:get_atts(V,[key(K)]),
@ -118,40 +118,40 @@ do_propagate(K) :-
\+ currently_defined(K), \+ currently_defined(K),
( ground(K) -> assert(currently_defined(K)) ; true), ( ground(K) -> assert(currently_defined(K)) ; true),
( (
defined_in_factor(K, ParFactor), defined_in_factor(K, ParFactor),
add_factor(ParFactor, Ks) add_factor(ParFactor, Ks)
*-> *->
true true
; ;
throw(error(no_defining_factor(K))) throw(error(no_defining_factor(K)))
), ),
member(K1, Ks), member(K1, Ks),
\+ currently_defined(K1), \+ currently_defined(K1),
queue_in(K1), queue_in(K1),
fail. fail.
do_propagate(_K) :- do_propagate(_K) :-
propagate. propagate.
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :- add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
% writeln(+Ks), % writeln(+Ks),
( (
Ks = [K,Els], var(Els) Ks = [K,Els], var(Els)
-> ->
% aggregate factor % aggregate factor
once(run(Constraints)), once(run(Constraints)),
avg_factors(K, Els, 0.0, NewKeys, NewId), avg_factors(K, Els, 0.0, NewKeys, NewId),
NKs = [K|NewKeys] NKs = [K|NewKeys]
; ;
run(Constraints), run(Constraints),
NKs = Ks, NKs = Ks,
Id = NewId Id = NewId
), ),
( (
f(Type, NewId, NKs) f(Type, NewId, NKs)
-> ->
true true
; ;
assert(f(Type, NewId, NKs)) assert(f(Type, NewId, NKs))
). ).
run([Goal|Goals]) :- run([Goal|Goals]) :-

29
packages/CLPBN/clpbn/hmm.yap
View File

@ -47,22 +47,19 @@ hmm_state(N/A,Mod) :-
Key =.. [T|KArgs], Key =.. [T|KArgs],
Head =.. [N|LArgs], Head =.. [N|LArgs],
asserta_static( (Mod:Head :- asserta_static( (Mod:Head :-
( First > 2 -> (First > 2 ->
Last = Key, ! Last = Key, !
; ;
nb_getval(trie, Trie), trie_check_entry(Trie, Key, _) nb_getval(trie, Trie), trie_check_entry(Trie, Key, _) ->
-> % leave work for solver!
% leave work for solver! Last = Key, !
% ;
Last = Key, ! % first time we saw this entry
; nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
% first time we saw this entry fail
nb_getval(trie, Trie), trie_put_entry(Trie, Key, _), )
fail )).
)
)
).
build_args(4,[A,B,C,D],[A,B,C],A,D). build_args(4,[A,B,C,D],[A,B,C],A,D).
build_args(3, [A,B,C], [A,B],A,C). build_args(3, [A,B,C], [A,B],A,C).
build_args(2, [A,B], [A],A,B). build_args(2, [A,B], [A],A,B).

67
packages/CLPBN/clpbn/jt.yap
View File

@ -135,7 +135,7 @@ run_vars([V|LVs], Edges, [V|Vs], [CPTVars-dist([V|Parents],Id)|CPTs], Ev) :-
add_evidence_from_vars(V, [e(V,P)|Evs], Evs) :- add_evidence_from_vars(V, [e(V,P)|Evs], Evs) :-
clpbn:get_atts(V, [evidence(P)]), !. clpbn:get_atts(V, [evidence(P)]), !.
add_evidence_from_vars(_, Evs, Evs). add_evidence_from_vars(_, Evs, Evs).
find_nth0([Id|_], Id, P, P) :- !. find_nth0([Id|_], Id, P, P) :- !.
find_nth0([_|D], Id, P0, P) :- find_nth0([_|D], Id, P0, P) :-
P1 is P0+1, P1 is P0+1,
@ -175,7 +175,7 @@ add_parents([], _, Graph, Graph).
add_parents([P|Parents], V, Graph0, [P-V|GraphF]) :- add_parents([P|Parents], V, Graph0, [P-V|GraphF]) :-
add_parents(Parents, V, Graph0, GraphF). add_parents(Parents, V, Graph0, GraphF).
% From David Page's lectures % From David Page's lectures
test_graph(0, test_graph(0,
[1-3,2-3,2-4,5-4,5-7,10-7,10-9,11-9,3-6,4-6,7-8,9-8,6-12,8-12], [1-3,2-3,2-4,5-4,5-7,10-7,10-9,11-9,3-6,4-6,7-8,9-8,6-12,8-12],
@ -232,19 +232,19 @@ choose([V|Vertices], Graph, Score0, _, _, Best, _, Cliques0, Cliques, EdgesF) :-
ord_insert(Neighbors, V, PossibleClique), ord_insert(Neighbors, V, PossibleClique),
new_edges(Neighbors, Graph, NewEdges), new_edges(Neighbors, Graph, NewEdges),
( (
% simplicial edge % simplicial edge
NewEdges == [] NewEdges == []
-> ->
!, !,
Best = V, Best = V,
NewEdges = EdgesF, NewEdges = EdgesF,
length(PossibleClique,L), length(PossibleClique,L),
Cliques = [L-PossibleClique|Cliques0] Cliques = [L-PossibleClique|Cliques0]
; ;
% cliquelength(PossibleClique,1,CL), % cliquelength(PossibleClique,1,CL),
length(PossibleClique,CL), length(PossibleClique,CL),
CL < Score0, !, CL < Score0, !,
choose(Vertices,Graph,CL,NewEdges, V, Best, CL-PossibleClique, Cliques0,Cliques,EdgesF) choose(Vertices,Graph,CL,NewEdges, V, Best, CL-PossibleClique, Cliques0,Cliques,EdgesF)
). ).
choose([_|Vertices], Graph, Score0, Edges0, BestSoFar, Best, Clique, Cliques0, Cliques, EdgesF) :- choose([_|Vertices], Graph, Score0, Edges0, BestSoFar, Best, Clique, Cliques0, Cliques, EdgesF) :-
choose(Vertices,Graph,Score0,Edges0, BestSoFar, Best, Clique, Cliques0,Cliques,EdgesF). choose(Vertices,Graph,Score0,Edges0, BestSoFar, Best, Clique, Cliques0,Cliques,EdgesF).
@ -289,18 +289,17 @@ get_links([Sz-Clique|Cliques], SoFar, Vertices, Edges0, Edges) :-
get_links(Cliques, [Clique|SoFar], Vertices, EdgesI, Edges). get_links(Cliques, [Clique|SoFar], Vertices, EdgesI, Edges).
get_links([_|Cliques], SoFar, Vertices, Edges0, Edges) :- get_links([_|Cliques], SoFar, Vertices, Edges0, Edges) :-
get_links(Cliques, SoFar, Vertices, Edges0, Edges). get_links(Cliques, SoFar, Vertices, Edges0, Edges).
add_clique_edges([], _, _, Edges, Edges). add_clique_edges([], _, _, Edges, Edges).
add_clique_edges([Clique1|Cliques], Clique, Sz, Edges0, EdgesF) :- add_clique_edges([Clique1|Cliques], Clique, Sz, Edges0, EdgesF) :-
ord_intersection(Clique1, Clique, Int), ord_intersection(Clique1, Clique, Int),
Int \== Clique, Int \== Clique,
( (Int = [] ->
Int = [] -> add_clique_edges(Cliques, Clique, Sz, Edges0, EdgesF)
add_clique_edges(Cliques, Clique, Sz, Edges0, EdgesF)
; ;
% we connect % we connect
length(Int, LSz), length(Int, LSz),
add_clique_edges(Cliques, Clique, Sz, [Clique-(Clique1-LSz)|Edges0], EdgesF) add_clique_edges(Cliques, Clique, Sz, [Clique-(Clique1-LSz)|Edges0], EdgesF)
). ).
root(WTree, JTree) :- root(WTree, JTree) :-
@ -362,25 +361,25 @@ get_cpts([], _, [], []).
get_cpts([CPT|CPts], [], [], [CPT|CPts]) :- !. get_cpts([CPT|CPts], [], [], [CPT|CPts]) :- !.
get_cpts([[I|MCPT]-Info|CPTs], [J|Clique], MyCPTs, MoreCPTs) :- get_cpts([[I|MCPT]-Info|CPTs], [J|Clique], MyCPTs, MoreCPTs) :-
compare(C,I,J), compare(C,I,J),
( C == < -> (C == < ->
% our CPT cannot be a part of the clique. % our CPT cannot be a part of the clique.
MoreCPTs = [[I|MCPT]-Info|LeftoverCPTs], MoreCPTs = [[I|MCPT]-Info|LeftoverCPTs],
get_cpts(CPTs, [J|Clique], MyCPTs, LeftoverCPTs) get_cpts(CPTs, [J|Clique], MyCPTs, LeftoverCPTs)
; ;
C == = -> C == = ->
% our CPT cannot be a part of the clique. % our CPT cannot be a part of the clique.
get_cpt(MCPT, Clique, I, Info, MyCPTs, MyCPTs0, MoreCPTs, MoreCPTs0), get_cpt(MCPT, Clique, I, Info, MyCPTs, MyCPTs0, MoreCPTs, MoreCPTs0),
get_cpts(CPTs, [J|Clique], MyCPTs0, MoreCPTs0) get_cpts(CPTs, [J|Clique], MyCPTs0, MoreCPTs0)
; ;
% the first element in our CPT may not be in a clique % the first element in our CPT may not be in a clique
get_cpts([[I|MCPT]-Info|CPTs], Clique, MyCPTs, MoreCPTs) get_cpts([[I|MCPT]-Info|CPTs], Clique, MyCPTs, MoreCPTs)
). ).
get_cpt(MCPT, Clique, I, Info, [[I|MCPT]-Info|MyCPTs], MyCPTs, MoreCPTs, MoreCPTs) :- get_cpt(MCPT, Clique, I, Info, [[I|MCPT]-Info|MyCPTs], MyCPTs, MoreCPTs, MoreCPTs) :-
ord_subset(MCPT, Clique), !. ord_subset(MCPT, Clique), !.
get_cpt(MCPT, _, I, Info, MyCPTs, MyCPTs, [[I|MCPT]-Info|MoreCPTs], MoreCPTs). get_cpt(MCPT, _, I, Info, MyCPTs, MyCPTs, [[I|MCPT]-Info|MoreCPTs], MoreCPTs).
translate_edges([], [], []). translate_edges([], [], []).
translate_edges([E1-E2|Edges], [(E1-A)-(E2-B)|NEdges], [E1-A,E2-B|Vs]) :- translate_edges([E1-E2|Edges], [(E1-A)-(E2-B)|NEdges], [E1-A,E2-B|Vs]) :-
translate_edges(Edges, NEdges, Vs). translate_edges(Edges, NEdges, Vs).
@ -389,13 +388,13 @@ match_vs(_,[]).
match_vs([K-A|Cls],[K1-B|KVs]) :- match_vs([K-A|Cls],[K1-B|KVs]) :-
compare(C, K, K1), compare(C, K, K1),
(C == = -> (C == = ->
A = B, A = B,
match_vs([K-A|Cls], KVs) match_vs([K-A|Cls], KVs)
; ;
C = < -> C = < ->
match_vs(Cls,[K1-B|KVs]) match_vs(Cls,[K1-B|KVs])
; ;
match_vs([K-A|Cls],KVs) match_vs([K-A|Cls],KVs)
). ).
fill_with_cpts(tree(Clique-Dists,Leafs), tree(Clique-NewDists,NewLeafs)) :- fill_with_cpts(tree(Clique-Dists,Leafs), tree(Clique-NewDists,NewLeafs)) :-

51
packages/CLPBN/clpbn/matrix_cpt_utils.yap
View File

@ -1,3 +1,4 @@
:- module(clpbn_matrix_utils, :- module(clpbn_matrix_utils,
[init_CPT/3, [init_CPT/3,
project_from_CPT/3, project_from_CPT/3,
@ -95,21 +96,21 @@ reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
var(Vs), !, var(Vs), !,
order_vec(Vs0,Vs,Map), order_vec(Vs0,Vs,Map),
( (
Vs == Vs0 Vs == Vs0
-> ->
TF = T0 TF = T0
; ;
matrix_shuffle(T0,Map,TF) matrix_shuffle(T0,Map,TF)
), ),
matrix_dims(TF, Sizes). matrix_dims(TF, Sizes).
reorder_CPT(Vs0,T0,Vs,TF,Sizes) :- reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
mapping(Vs0,Vs,Map), mapping(Vs0,Vs,Map),
( (
Vs == Vs0 Vs == Vs0
-> ->
TF = T0 TF = T0
; ;
matrix_shuffle(T0,Map,TF) matrix_shuffle(T0,Map,TF)
), ),
matrix_dims(TF, Sizes). matrix_dims(TF, Sizes).
@ -126,7 +127,7 @@ add_indices([V|Vs0],I0,[V-I0|Is]) :-
get_els([], [], []). get_els([], [], []).
get_els([V-I|NIs], [V|Vs], [I|Map]) :- get_els([V-I|NIs], [V|Vs], [I|Map]) :-
get_els(NIs, Vs, Map). get_els(NIs, Vs, Map).
mapping(Vs0,Vs,Map) :- mapping(Vs0,Vs,Map) :-
add_indices(Vs0,0,I1s), add_indices(Vs0,0,I1s),
add_indices( Vs,I2s), add_indices( Vs,I2s),
@ -169,26 +170,26 @@ expand_tabs([], [], [V2|Deps2], [S2|Sz2], [S2|Map1], [0|Map2], [V2|NDeps]) :-
expand_tabs([V1|Deps1], [S1|Sz1], [V2|Deps2], [S2|Sz2], Map1, Map2, NDeps) :- expand_tabs([V1|Deps1], [S1|Sz1], [V2|Deps2], [S2|Sz2], Map1, Map2, NDeps) :-
compare(C,V1,V2), compare(C,V1,V2),
(C == = -> (C == = ->
NDeps = [V1|MDeps], NDeps = [V1|MDeps],
Map1 = [0|M1], Map1 = [0|M1],
Map2 = [0|M2], Map2 = [0|M2],
NDeps = [V1|MDeps], NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, Deps2, Sz2, M1, M2, MDeps) expand_tabs(Deps1, Sz1, Deps2, Sz2, M1, M2, MDeps)
; ;
C == < -> C == < ->
NDeps = [V1|MDeps], NDeps = [V1|MDeps],
Map1 = [0|M1], Map1 = [0|M1],
Map2 = [S1|M2], Map2 = [S1|M2],
NDeps = [V1|MDeps], NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, [V2|Deps2], [S2|Sz2], M1, M2, MDeps) expand_tabs(Deps1, Sz1, [V2|Deps2], [S2|Sz2], M1, M2, MDeps)
; ;
NDeps = [V2|MDeps], NDeps = [V2|MDeps],
Map1 = [S2|M1], Map1 = [S2|M1],
Map2 = [0|M2], Map2 = [0|M2],
NDeps = [V2|MDeps], NDeps = [V2|MDeps],
expand_tabs([V1|Deps1], [S1|Sz1], Deps2, Sz2, M1, M2, MDeps) expand_tabs([V1|Deps1], [S1|Sz1], Deps2, Sz2, M1, M2, MDeps)
). ).
normalise_CPT(MAT,NMAT) :- normalise_CPT(MAT,NMAT) :-
matrix_to_exps2(MAT), matrix_to_exps2(MAT),
matrix_sum(MAT, Sum), matrix_sum(MAT, Sum),

8
packages/CLPBN/clpbn/numbers.yap
View File

@ -30,16 +30,16 @@ keys_to_numbers(AllKeys, Factors, Evidence, Hash0, Hash4, Id0, Id4, FactorIds, E
foldl2(key_to_id, SKeys, _, Hash3, Hash4, Id3, Id4). foldl2(key_to_id, SKeys, _, Hash3, Hash4, Id3, Id4).
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash0, Hash, Id0, Id) :- lists_of_keys_to_ids(QueryKeys, QueryIds, Hash0, Hash, Id0, Id) :-
foldl2(list_of_keys_to_ids, QueryKeys, QueryIds, Hash0, Hash, Id0, Id). foldl2(list_of_keys_to_ids, QueryKeys, QueryIds, Hash0, Hash, Id0, Id).
list_of_keys_to_ids(List, IdList, Hash0, Hash, I0, I) :- list_of_keys_to_ids(List, IdList, Hash0, Hash, I0, I) :-
foldl2(key_to_id, List, IdList, Hash0, Hash, I0, I). foldl2(key_to_id, List, IdList, Hash0, Hash, I0, I).
key_to_id(Key, Id, Hash0, Hash0, I0, I0) :- key_to_id(Key, Id, Hash0, Hash0, I0, I0) :-
b_hash_lookup(Key, Id, Hash0), !. b_hash_lookup(Key, Id, Hash0), !.
key_to_id(Key, I0, Hash0, Hash, I0, I) :- key_to_id(Key, I0, Hash0, Hash, I0, I) :-
b_hash_insert(Hash0, Key, I0, Hash), b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1. I is I0+1.
factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :- factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :-
get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT), get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT),

30
packages/CLPBN/clpbn/pgrammar.yap
View File

@ -70,9 +70,9 @@ grammar_mle(S,_,P) :-
nb_getval(best,p(P,S)), P > 0.0. nb_getval(best,p(P,S)), P > 0.0.
user:term_expansion((P::H --> B), Goal) :- user:term_expansion((P::H --> B), Goal) :-
functor(H,A0,_), functor(H,A0,_),
% a-->b to a(p(K,P,C,[Cs])) --> b(Cs) % a-->b to a(p(K,P,C,[Cs])) --> b(Cs)
convert_to_internal(H, B, IH, IB, Id), convert_to_internal(H, B, IH, IB, Id),
expand_term((IH --> IB),(NH :- NB)), expand_term((IH --> IB),(NH :- NB)),
prolog_load_context(module, Mod), prolog_load_context(module, Mod),
functor(NH,N,A), functor(NH,N,A),
@ -98,8 +98,8 @@ add_to_predicate(M:EH1,M:EH,M:H0,NH,NB,Key,Choice,P,Id,(EH1:-NB)) :-
% now ensure_tabled works. % now ensure_tabled works.
ensure_tabled(M,H0,EH), ensure_tabled(M,H0,EH),
assert_static(M:(EH :- assert_static(M:(EH :-
clpbn_pgrammar:p_rule(M,EH,Key,Choice), clpbn_pgrammar:p_rule(M,EH,Key,Choice),
M:EH1)), M:EH1)),
Choice = 1, Choice = 1,
new_id(Key,P,Choice,Id), new_id(Key,P,Choice,Id),
assert_static(M:ptab(EH,Choice,P)), assert_static(M:ptab(EH,Choice,P)),
@ -139,18 +139,18 @@ convert_body_to_internal({A}, {A}) --> !.
convert_body_to_internal(B, IB) --> convert_body_to_internal(B, IB) -->
[V], [V],
{ {
B =.. [Na|Args], B =.. [Na|Args],
build_internal(Na,NaInternal), build_internal(Na,NaInternal),
IB =.. [NaInternal,V|Args] IB =.. [NaInternal,V|Args]
}. }.
new_id(Key,P,Choice,Id) :- new_id(Key,P,Choice,Id) :-
( (
predicate_property(id(_,_,_,_),number_of_clauses(Id)) predicate_property(id(_,_,_,_),number_of_clauses(Id))
-> ->
true true
; ;
Id = 0 Id = 0
), ),
assert(id(Id,Key,P,Choice)). assert(id(Id,Key,P,Choice)).
@ -210,11 +210,11 @@ path_choices(InternalS, Proof) :-
new_id(Id) :- new_id(Id) :-
(nb_getval(grammar_id,Id) -> (nb_getval(grammar_id,Id) ->
I1 is Id+1, I1 is Id+1,
nb_setval(grammar_id,I1) nb_setval(grammar_id,I1)
; ;
nb_setval(grammar_id,1), nb_setval(grammar_id,1),
Id = 0 Id = 0
). ).
find_dom(K, Vs, Ps) :- find_dom(K, Vs, Ps) :-

93
packages/CLPBN/clpbn/table.yap
View File

@ -108,30 +108,28 @@ clpbn_table(F/N,M) :-
L0 = [_|Args0], L0 = [_|Args0],
IGoal =.. [NF|Args0], IGoal =.. [NF|Args0],
asserta(clpbn_table(S, M, IGoal)), asserta(clpbn_table(S, M, IGoal)),
assert( assert((M:S :-
(M:S :- !,
!, % write(S: ' ' ),
% write(S: ' ' ), b_getval(clpbn_tables, Tab),
b_getval(clpbn_tables, Tab), % V2 is unbound.
% V2 is unbound. (b_hash_lookup(Key, V2, Tab) ->
( b_hash_lookup(Key, V2, Tab) -> % (attvar(V2) -> writeln(ok:A0:V2) ; writeln(error(V2:should_be_attvar(S)))),
% (attvar(V2) -> writeln(ok:A0:V2) ; writeln(error(V2:should_be_attvar(S)))), (var(A0) -> A0 = V2 ; put_evidence(A0, V2))
( var(A0) -> A0 = V2 ; put_evidence(A0, V2) ) ;
; % writeln(new),
% writeln(new), b_hash_insert(Tab, Key, V2, NewTab),
b_hash_insert(Tab, Key, V2, NewTab), b_setval(clpbn_tables,NewTab),
b_setval(clpbn_tables,NewTab), once(M:Goal), !,
once(M:Goal), !, % enter evidence after binding.
% enter evidence after binding. (var(A0) -> A0 = V2 ; put_evidence(A0, V2))
( var(A0) -> A0 = V2 ; put_evidence(A0, V2) ) ;
; clpbn:clpbn_flag(solver,none) ->
clpbn:clpbn_flag(solver,none) -> true
true ;
; throw(error(tabled_clpbn_predicate_should_never_fail,S))
throw(error(tabled_clpbn_predicate_should_never_fail,S)) )
) )).
)
).
take_tail([V], V, [], V1, [V1]) :- !. take_tail([V], V, [], V1, [V1]) :- !.
take_tail([A|L0], V, [A|L1], V1, [A|L2]) :- take_tail([A|L0], V, [A|L1], V1, [A|L2]) :-
@ -154,19 +152,17 @@ clpbn_tableallargs(F/N,M) :-
atom_concat(F, '___tabled', NF), atom_concat(F, '___tabled', NF),
NKey =.. [NF|Args], NKey =.. [NF|Args],
asserta(clpbn_table(Key, M, NKey)), asserta(clpbn_table(Key, M, NKey)),
assert( assert((M:Key :-
(M:Key :- !,
!, b_getval(clpbn_tables, Tab),
b_getval(clpbn_tables, Tab), (b_hash_lookup(Key, Out, Tab) ->
( b_hash_lookup(Key, Out, Tab) -> true
true ;
; b_hash_insert(Tab, Key, Out, NewTab),
b_hash_insert(Tab, Key, Out, NewTab), b_setval(clpbn_tables, NewTab),
b_setval(clpbn_tables, NewTab), once(M:NKey)
once(M:NKey) )
) )).
)
).
clpbn_table_nondet(M:X) :- !, clpbn_table_nondet(M:X) :- !,
clpbn_table_nondet(X,M). clpbn_table_nondet(X,M).
@ -185,18 +181,17 @@ clpbn_table_nondet(F/N,M) :-
atom_concat(F, '___tabled', NF), atom_concat(F, '___tabled', NF),
NKey =.. [NF|Args], NKey =.. [NF|Args],
asserta(clpbn_table(Key, M, NKey)), asserta(clpbn_table(Key, M, NKey)),
assert( assert((M:Key :-
(M:Key :- % writeln(in:Key), % writeln(in:Key),
b_getval(clpbn_tables, Tab), b_getval(clpbn_tables, Tab),
( b_hash_lookup(Key, Out, Tab) -> (b_hash_lookup(Key, Out, Tab) ->
fail fail
; ;
b_hash_insert(Tab, Key, Out, NewTab), b_hash_insert(Tab, Key, Out, NewTab),
b_setval(clpbn_tables, NewTab), b_setval(clpbn_tables, NewTab),
M:NKey M:NKey
) )
) )).
).
user:term_expansion((P :- Gs), NC) :- user:term_expansion((P :- Gs), NC) :-
clpbn_table(P, M, NP), clpbn_table(P, M, NP),

16
packages/CLPBN/clpbn/utils.yap
View File

@ -54,15 +54,13 @@ get_keys([_|AVars], KeysVars) :- % may be non-CLPBN vars.
merge_same_key([], [], _, []). merge_same_key([], [], _, []).
merge_same_key([K1-V1,K2-V2|Vs], SortedAVars, Ks, UnifiableVars) :- merge_same_key([K1-V1,K2-V2|Vs], SortedAVars, Ks, UnifiableVars) :-
K1 == K2, !, K1 == K2, !,
(clpbn:get_atts(V1, [evidence(E)]) (clpbn:get_atts(V1, [evidence(E)]) ->
-> clpbn:put_atts(V2, [evidence(E)])
clpbn:put_atts(V2, [evidence(E)])
; ;
clpbn:get_atts(V2, [evidence(E)]) clpbn:get_atts(V2, [evidence(E)]) ->
->
clpbn:put_atts(V1, [evidence(E)]) clpbn:put_atts(V1, [evidence(E)])
; ;
true true
), ),
% V1 = V2, % V1 = V2,
attributes:fast_unify_attributed(V1,V2), attributes:fast_unify_attributed(V1,V2),
@ -78,7 +76,7 @@ merge_same_key([K-V|Vs], [V|SortedAVars], Ks, UnifiableVars) :-
in_keys(K1,[K|_]) :- \+ \+ K1 = K, !. in_keys(K1,[K|_]) :- \+ \+ K1 = K, !.
in_keys(K1,[_|Ks]) :- in_keys(K1,[_|Ks]) :-
in_keys(K1,Ks). in_keys(K1,Ks).
add_to_keys(K1, Ks, Ks) :- ground(K1), !. add_to_keys(K1, Ks, Ks) :- ground(K1), !.
add_to_keys(K1, Ks, [K1|Ks]). add_to_keys(K1, Ks, [K1|Ks]).
@ -104,7 +102,7 @@ add_parents(Parents,V,Id,KeyVarsF,KeyVars0) :-
all_vars([]). all_vars([]).
all_vars([P|Parents]) :- all_vars([P|Parents]) :-
var(P), var(P),
all_vars(Parents). all_vars(Parents).

116
packages/CLPBN/clpbn/ve.yap
View File

@ -23,7 +23,7 @@
run_ve_ground_solver/3, run_ve_ground_solver/3,
call_ve_ground_solver/6 call_ve_ground_solver/6
]). ]).
:- use_module(library(atts)). :- use_module(library(atts)).
:- use_module(library(ordsets), :- use_module(library(ordsets),
@ -75,8 +75,8 @@
:- use_module(library('clpbn/aggregates'), :- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]). [check_for_agg_vars/2]).
:- attribute size/1, all_diffs/1. :- attribute size/1, all_diffs/1.
% %
% uses a bipartite graph where bigraph(Vs, NFs, Fs) % uses a bipartite graph where bigraph(Vs, NFs, Fs)
@ -93,23 +93,23 @@ check_if_ve_done(Var) :-
% new PFL like interface... % new PFL like interface...
% %
call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions), call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output). clpbn_bind_vals([QueryVars], Solutions, Output).
call_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- call_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE), init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
run_ve_ground_solver(QueryKeys, Solutions, VE). run_ve_ground_solver(QueryKeys, Solutions, VE).
simulate_ve_ground_solver(_QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- simulate_ve_ground_solver(_QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output). simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output).
simulate_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- simulate_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE), init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
simulate_solver(QueryKeys, Solutions, VE). simulate_solver(QueryKeys, Solutions, VE).
init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :- init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :-
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE). init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE).
% %
@ -117,11 +117,11 @@ init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :-
% %
ve([[]],_,_) :- !. ve([[]],_,_) :- !.
ve(LLVs,Vs0,AllDiffs) :- ve(LLVs,Vs0,AllDiffs) :-
init_ve_solver(LLVs, Vs0, AllDiffs, State), init_ve_solver(LLVs, Vs0, AllDiffs, State),
% variable elimination proper % variable elimination proper
run_ve_solver(LLVs, LLPs, State), run_ve_solver(LLVs, LLPs, State),
% bind Probs back to variables so that they can be output. % bind Probs back to variables so that they can be output.
clpbn_bind_vals(LLVs,LLPs,AllDiffs). clpbn_bind_vals(LLVs,LLPs,AllDiffs).
init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, Ev)) :- init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, Ev)) :-
@ -177,7 +177,7 @@ vars_to_bigraph(VMap, bigraph(VInfo, IF, Fs), Evs) :-
id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :- id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
% process evidence for variable % process evidence for variable
clpbn:get_atts(V, [evidence(E), dist(_,Ps)]), clpbn:get_atts(V, [evidence(E), dist(_,Ps)]),
checklist(noparent_of_interest(VMap), Ps), !, checklist(noparent_of_interest(VMap), Ps), !,
% I don't need to get a factor here % I don't need to get a factor here
Evs = [I=E|Evs0], Evs = [I=E|Evs0],
@ -186,12 +186,12 @@ id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :- id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
% process distribution/factors % process distribution/factors
( (
clpbn:get_atts(V, [evidence(E)]) clpbn:get_atts(V, [evidence(E)])
-> ->
Evs = [I=E|Evs0] Evs = [I=E|Evs0]
; ;
Evs = Evs0 Evs = Evs0
), ),
clpbn:get_atts(V, [dist(D, Ps)]), clpbn:get_atts(V, [dist(D, Ps)]),
get_dist_params(D, Pars0), get_dist_params(D, Pars0),
get_dist_domain_size(D, DS), get_dist_domain_size(D, DS),
@ -244,29 +244,29 @@ collect_factors(SFVs, _Fs, _V, [], SFVs).
% solve each query independently % solve each query independently
% use a findall to recover space without needing for GC % use a findall to recover space without needing for GC
run_ve_ground_solver(LQVs, LLPs, ve(FactorIds, Hash, Id, Ev)) :- run_ve_ground_solver(LQVs, LLPs, ve(FactorIds, Hash, Id, Ev)) :-
rb_new(Fs0), rb_new(Fs0),
foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF), foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF),
sort(FVs, SFVs), sort(FVs, SFVs),
rb_new(VInfo0), rb_new(VInfo0),
add_vs(SFVs, Fs, VInfo0, VInfo), add_vs(SFVs, Fs, VInfo0, VInfo),
BG = bigraph(VInfo, IF, Fs), BG = bigraph(VInfo, IF, Fs),
lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _), lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _),
findall(LPs, solve(LQIds, FactorIds, BG, Ev, LPs), LLPs). findall(LPs, solve(LQIds, FactorIds, BG, Ev, LPs), LLPs).
solve([QVs|_], FIds, Bigraph, Evs, LPs) :- solve([QVs|_], FIds, Bigraph, Evs, LPs) :-
factor_influences(FIds, QVs, Evs, LVs), factor_influences(FIds, QVs, Evs, LVs),
do_solve(QVs, LVs, Bigraph, Evs, LPs). do_solve(QVs, LVs, Bigraph, Evs, LPs).
solve([_|LQVs], FIds, Bigraph, Ev, LPs) :- solve([_|LQVs], FIds, Bigraph, Ev, LPs) :-
solve(LQVs, FIds, Bigraph, Ev, LPs). solve(LQVs, FIds, Bigraph, Ev, LPs).
do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :- do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :-
% get only what is relevant to query, % get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1), project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence % and also prune using evidence
rb_visit(Ev, EvL), rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate % eliminate
eliminate(IQVs, digraph(EVs, IF, Fs2), Dist), eliminate(IQVs, digraph(EVs, IF, Fs2), Dist),
% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD), % writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
%exps(LD,LDE),writeln(LDE), %exps(LD,LDE),writeln(LDE),
% move from potentials back to probabilities % move from potentials back to probabilities
@ -274,18 +274,18 @@ do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :-
list_from_CPT(MPs, Ps). list_from_CPT(MPs, Ps).
simulate_solver(LQVs, Choices, ve(FIds, Hash, Id, BG, Evs)) :- simulate_solver(LQVs, Choices, ve(FIds, Hash, Id, BG, Evs)) :-
lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _), lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _),
factor_influences(FIds, QVs, Evs, LVs), factor_influences(FIds, QVs, Evs, LVs),
do_simulate(QVs, LVs, BG, Evs, Choices). do_simulate(QVs, LVs, BG, Evs, Choices).
do_simulate(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Choices) :- do_simulate(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Choices) :-
% get only what is relevant to query, % get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1), project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence % and also prune using evidence
rb_visit(Ev, EvL), rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate % eliminate
simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices). simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices).
% solve each query independently % solve each query independently
% use a findall to recover space without needing for GC % use a findall to recover space without needing for GC
@ -355,19 +355,19 @@ check_factor(V, NVs, F, NFs0, NFs, RemFs, NewRemFs) :-
-> ->
rb_insert(NFs0, IF, F, NFs), rb_insert(NFs0, IF, F, NFs),
NewRemFs = [F|RemFs] NewRemFs = [F|RemFs]
; ;
NFs0 = NFs, NFs0 = NFs,
NewRemFs = RemFs NewRemFs = RemFs
). ).
check_factor(_V, _NVs, F, NFs, NFs, RemFs, NewRemFs) :- check_factor(_V, _NVs, F, NFs, NFs, RemFs, NewRemFs) :-
F = f(Id, _, _), F = f(Id, _, _),
( (
rb_lookup(Id, F, NFs) rb_lookup(Id, F, NFs)
-> ->
NewRemFs = [F|RemFs] NewRemFs = [F|RemFs]
; ;
NewRemFs = RemFs NewRemFs = RemFs
). ).
check_v(NVs, V) :- check_v(NVs, V) :-
rb_lookup(V, _, NVs). rb_lookup(V, _, NVs).
@ -430,15 +430,15 @@ best_var(QVs, I, _Node, Info, Info) :-
!. !.
% pick the variable with less factors % pick the variable with less factors
best_var(_Qs, I, Node, i(ValSoFar,_,_), i(NewVal,I,Node)) :- best_var(_Qs, I, Node, i(ValSoFar,_,_), i(NewVal,I,Node)) :-
foldl(szfac,Node,1,NewVal), foldl(szfac,Node,1,NewVal),
%length(Node, NewVal), %length(Node, NewVal),
NewVal < ValSoFar, NewVal < ValSoFar,
!. !.
best_var(_, _I, _Node, Info, Info). best_var(_, _I, _Node, Info, Info).
szfac(f(_,Vs,_), I0, I) :- szfac(f(_,Vs,_), I0, I) :-
length(Vs,L), length(Vs,L),
I is I0*L. I is I0*L.
% delete one factor, need to also touch all variables % delete one factor, need to also touch all variables
del_fac(f(I,FVs,_), Fs0, Fs, Vs0, Vs) :- del_fac(f(I,FVs,_), Fs0, Fs, Vs0, Vs) :-

60
packages/CLPBN/clpbn/viterbi.yap
View File

@ -77,21 +77,21 @@ fetch_edges([V|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
clpbn:get_atts(V,[key(Key)]), clpbn:get_atts(V,[key(Key)]),
abstract_key(Key, AKey, Slice), abstract_key(Key, AKey, Slice),
( (
Slice < 3 Slice < 3
-> ->
EdgesF = [Key0-AKey|EdgesI] EdgesF = [Key0-AKey|EdgesI]
; ;
EdgesF = EdgesI EdgesF = EdgesI
), ),
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys). fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
fetch_edges([Key|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :- fetch_edges([Key|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
abstract_key(Key, AKey, Slice), abstract_key(Key, AKey, Slice),
( (
Slice < 3 Slice < 3
-> ->
EdgesF = [Key0-AKey|EdgesI] EdgesF = [Key0-AKey|EdgesI]
; ;
EdgesF = EdgesI EdgesF = EdgesI
), ),
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys). fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
fetch_edges([], _, Edges, Edges, []). fetch_edges([], _, Edges, Edges, []).
@ -124,20 +124,20 @@ compile_keys([], _, []).
% add a random symbol to the end. % add a random symbol to the end.
compile_emission([],_) --> !, []. compile_emission([],_) --> !, [].
compile_emission(EmissionTerm,IKey) --> [emit(IKey,EmissionTerm)]. compile_emission(EmissionTerm,IKey) --> [emit(IKey,EmissionTerm)].
compile_propagation([],[],_,_) --> []. compile_propagation([],[],_,_) --> [].
compile_propagation([0-PKey|Ps], [Prob|Probs], IKey, KeyMap) --> compile_propagation([0-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_same(IKey,Parent,Prob)], [prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) }, { get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap). compile_propagation(Ps, Probs, IKey, KeyMap).
compile_propagation([2-PKey|Ps], [Prob|Probs], IKey, KeyMap) --> compile_propagation([2-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_same(IKey,Parent,Prob)], [prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) }, { get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap). compile_propagation(Ps, Probs, IKey, KeyMap).
compile_propagation([3-PKey|Ps], [Prob|Probs], IKey, KeyMap) --> compile_propagation([3-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_next(IKey,Parent,Prob)], [prop_next(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) }, { get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap). compile_propagation(Ps, Probs, IKey, KeyMap).
get_id(_:S, Map, SI) :- !, get_id(_:S, Map, SI) :- !,
get_id(S, Map, SI). get_id(S, Map, SI).
@ -150,9 +150,9 @@ get_id(S, Map, SI) :-
compile_trace(Trace, Emissions) :- compile_trace(Trace, Emissions) :-
user:hmm_domain(Domain), user:hmm_domain(Domain),
(atom(Domain) -> (atom(Domain) ->
hmm:cvt_vals(Domain, Vals) hmm:cvt_vals(Domain, Vals)
; ;
Vals = Domain Vals = Domain
), ),
compile_trace(Trace, Vals, Emissions). compile_trace(Trace, Vals, Emissions).
@ -194,22 +194,22 @@ run_inst(prop_same(I,P,Prob), _, SP, Current, _, Trace) :-
NP is PI+Prob, NP is PI+Prob,
matrix_get(Current, [P], P0), matrix_get(Current, [P], P0),
(NP > P0 -> (NP > P0 ->
matrix_set(Current, [P], NP), matrix_set(Current, [P], NP),
matrix_set(Trace, [SP,P], I) matrix_set(Trace, [SP,P], I)
; ;
true true
). ).
run_inst(prop_next(I,P,Prob), _, SP, Current, Next, Trace) :- run_inst(prop_next(I,P,Prob), _, SP, Current, Next, Trace) :-
matrix_get(Current, [I], PI), matrix_get(Current, [I], PI),
NP is PI+Prob, NP is PI+Prob,
matrix_get(Next, [P], P0), matrix_get(Next, [P], P0),
(NP > P0 -> (NP > P0 ->
matrix_set(Next, [P], NP), matrix_set(Next, [P], NP),
SP1 is SP+1, SP1 is SP+1,
IN is -I, IN is -I,
matrix_set(Trace, [SP1,P], IN) matrix_set(Trace, [SP1,P], IN)
; ;
true true
). ).
backtrace(Dump, EI, Map, L, Trace) :- backtrace(Dump, EI, Map, L, Trace) :-
@ -221,11 +221,11 @@ backtrace(Dump, EI, Map, L, Trace) :-
trace(0,0,_,_,Trace,Trace) :- !. trace(0,0,_,_,Trace,Trace) :- !.
trace(L1,Next,Dump,Map,Trace0,Trace) :- trace(L1,Next,Dump,Map,Trace0,Trace) :-
(Next < 0 -> (Next < 0 ->
NL is L1-1, NL is L1-1,
P is -Next P is -Next
; ;
NL = L1, NL = L1,
P = Next P = Next
), ),
once(member(P-AKey,Map)), once(member(P-AKey,Map)),
AKey=..[N|Args], AKey=..[N|Args],

2
packages/CLPBN/clpbn/vmap.yap
View File

@ -16,7 +16,7 @@
% contiguous Vs to contiguous integers % contiguous Vs to contiguous integers
% %
init_vmap(vmap(0,Empty)) :- init_vmap(vmap(0,Empty)) :-
rb_new(Empty). rb_new(Empty).
get_from_vmap(V, I, VMap0) :- get_from_vmap(V, I, VMap0) :-
VMap0 = vmap(_I,Map0), VMap0 = vmap(_I,Map0),

131
packages/CLPBN/learning/aleph_params.yap
View File

@ -10,39 +10,42 @@
% but some variables are of special type random. % but some variables are of special type random.
% %
:- module(clpbn_aleph, :- module(clpbn_aleph,
[init_clpbn_cost/0, [init_clpbn_cost/0,
random_type/2]). random_type/2
]).
:- dynamic rt/2, inited/1. :- dynamic rt/2, inited/1.
:- use_module(library('clpbn'), :- use_module(library('clpbn'),
[{}/1, [{}/1,
clpbn_flag/2, clpbn_flag/2,
clpbn_flag/3, clpbn_flag/3,
set_clpbn_flag/2]). set_clpbn_flag/2
]).
:- use_module(library('clpbn/learning/em')). :- use_module(library('clpbn/learning/em')).
:- use_module(library('clpbn/matrix_cpt_utils'), :- use_module(library('clpbn/matrix_cpt_utils'),
[uniform_CPT_as_list/2]). [uniform_CPT_as_list/2]).
:- use_module(library('clpbn/dists'), :- use_module(library('clpbn/dists'),
[reset_all_dists/0, [reset_all_dists/0,
get_dist_key/2, get_dist_key/2,
get_dist_params/2 get_dist_params/2
]). ]).
:- use_module(library('clpbn/table'), :- use_module(library('clpbn/table'),
[clpbn_tabled_abolish/1, [clpbn_tabled_abolish/1,
clpbn_tabled_asserta/1, clpbn_tabled_asserta/1,
clpbn_tabled_asserta/2, clpbn_tabled_asserta/2,
clpbn_tabled_assertz/1, clpbn_tabled_assertz/1,
clpbn_tabled_clause/2, clpbn_tabled_clause/2,
clpbn_tabled_clause_ref/3, clpbn_tabled_clause_ref/3,
clpbn_tabled_number_of_clauses/2, clpbn_tabled_number_of_clauses/2,
clpbn_is_tabled/1, clpbn_is_tabled/1,
clpbn_reset_tables/0, clpbn_reset_tables/0,
clpbn_tabled_dynamic/1]). clpbn_tabled_dynamic/1
]).
% %
% Tell Aleph not to use default solver during saturation % Tell Aleph not to use default solver during saturation
@ -94,11 +97,11 @@ enable_solver :-
add_new_clause(_,(H :- _),_,_) :- add_new_clause(_,(H :- _),_,_) :-
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
update_tabled_theory(H) update_tabled_theory(H)
; ;
update_theory(H) update_theory(H)
), ),
fail. fail.
% step 2: add clause % step 2: add clause
add_new_clause(_,(_ :- true),_,_) :- !. add_new_clause(_,(_ :- true),_,_) :- !.
@ -113,18 +116,18 @@ add_new_clause(_,(H :- B),_,_) :-
get_dist_key(Id, K), get_dist_key(Id, K),
get_dist_params(Id, CPTList), get_dist_params(Id, CPTList),
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
clpbn_tabled_asserta(user:(H :- IB)) clpbn_tabled_asserta(user:(H :- IB))
; ;
asserta(user:(H :- IB)) asserta(user:(H :- IB))
), ),
user:setting(verbosity,V), user:setting(verbosity,V),
( V >= 1 -> ( V >= 1 ->
user:p_message('CLP(BN) Theory'), user:p_message('CLP(BN) Theory'),
functor(H,N,Ar), listing(user:N/Ar) functor(H,N,Ar), listing(user:N/Ar)
; ;
true true
). ).
@ -165,22 +168,22 @@ user:cost((H :- B),Inf,Score) :-
rewrite_body(B, IB, Vs, Ds, ( !, { V = K with p(D, CPTList, Vs) })), rewrite_body(B, IB, Vs, Ds, ( !, { V = K with p(D, CPTList, Vs) })),
uniform_cpt([D|Ds], CPTList), uniform_cpt([D|Ds], CPTList),
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
clpbn_reset_tables, clpbn_reset_tables,
clpbn_tabled_asserta(user:(H :- IB), R) clpbn_tabled_asserta(user:(H :- IB), R)
; ;
asserta(user:(H :- IB), R) asserta(user:(H :- IB), R)
), ),
( (
cpt_score(Score0) cpt_score(Score0)
-> ->
erase(R), erase(R),
Score is -Score0 Score is -Score0
; ;
% illegal clause, just get out of here. % illegal clause, just get out of here.
erase(R), erase(R),
fail fail
). ).
user:cost(H,_Inf,Score) :- !, user:cost(H,_Inf,Score) :- !,
init_clpbn_cost(H, Score0), init_clpbn_cost(H, Score0),
@ -196,38 +199,38 @@ init_clpbn_cost(H, Score) :-
functor(H,N,A), functor(H,N,A),
% get rid of Aleph crap % get rid of Aleph crap
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
clpbn_tabled_abolish(user:N/A), clpbn_tabled_abolish(user:N/A),
clpbn_tabled_dynamic(user:N/A) clpbn_tabled_dynamic(user:N/A)
; ;
abolish(user:N/A), abolish(user:N/A),
% make it easy to add and remove clauses. % make it easy to add and remove clauses.
dynamic(user:N/A) dynamic(user:N/A)
), ),
domain(H, K, V, D), domain(H, K, V, D),
uniform_cpt([D], CPTList), uniform_cpt([D], CPTList),
% This will be the default cause, called when the other rules fail. % This will be the default cause, called when the other rules fail.
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
clpbn_tabled_assertz(user:(H :- !, { V = K with p(D, CPTList) })) clpbn_tabled_assertz(user:(H :- !, { V = K with p(D, CPTList) }))
; ;
assert(user:(H :- !, { V = K with p(D, CPTList) })) assert(user:(H :- !, { V = K with p(D, CPTList) }))
), ),
cpt_score(Score), cpt_score(Score),
assert(inited(Score)). assert(inited(Score)).
% receives H, and generates a key K, a random variable RV, and a domain D. % receives H, and generates a key K, a random variable RV, and a domain D.
domain(H, K, RV, D) :- domain(H, K, RV, D) :-
functor(H,Name,Arity), functor(H,Name,Arity),
functor(Pred,Name,Arity), functor(Pred,Name,Arity),
( (
recorded(aleph,modeh(_,Pred),_) recorded(aleph,modeh(_,Pred),_)
-> ->
true true
; ;
user:'$aleph_global'(modeh,modeh(_,Pred)) user:'$aleph_global'(modeh,modeh(_,Pred))
), ),
arg(Arity,Pred,+RType), arg(Arity,Pred,+RType),
rt(RType,D), !, rt(RType,D), !,
@ -240,11 +243,11 @@ domain(H, K, V, D) :-
key_from_head(H,K,V) :- key_from_head(H,K,V) :-
H =.. [Name|Args], H =.. [Name|Args],
( (
clpbn_is_tabled(user:H) clpbn_is_tabled(user:H)
-> ->
clpbn_tabled_number_of_clauses(user:H,NClauses) clpbn_tabled_number_of_clauses(user:H,NClauses)
; ;
predicate_property(user:H,number_of_clauses(NClauses)) predicate_property(user:H,number_of_clauses(NClauses))
), ),
atomic_concat(Name,NClauses,NName), atomic_concat(Name,NClauses,NName),
append(H0L,[V],Args), append(H0L,[V],Args),
@ -267,11 +270,11 @@ rewrite_goal(A,V,D,NA) :-
functor(A,Name,Arity), functor(A,Name,Arity),
functor(Pred,Name,Arity), functor(Pred,Name,Arity),
( (
recorded(aleph,modeb(_,Pred),_) recorded(aleph,modeb(_,Pred),_)
-> ->
true true
; ;
user:'$aleph_global'(modeb,modeb(_,Pred)) user:'$aleph_global'(modeb,modeb(_,Pred))
), ),
arg(Arity,Pred,-RType), arg(Arity,Pred,-RType),
rt(RType,D), !, rt(RType,D), !,
@ -288,7 +291,7 @@ replace_last_var([A|Args],V,[A|NArgs]) :-
% This is the key % This is the key
% %
cpt_score(Lik) :- cpt_score(Lik) :-
findall(user:Ex, user:example(_,pos,Ex), Exs), findall(user:Ex, user:example(_,pos,Ex), Exs),
clpbn_flag(solver, Solver), clpbn_flag(solver, Solver),
clpbn_flag(em_solver, EMSolver), clpbn_flag(em_solver, EMSolver),
set_clpbn_flag(solver, EMSolver), set_clpbn_flag(solver, EMSolver),

40
packages/CLPBN/learning/bnt_parms.yap
View File

@ -8,23 +8,23 @@
:- module(bnt_parameters, [learn_parameters/2]). :- module(bnt_parameters, [learn_parameters/2]).
:- use_module(library('clpbn'), [ :- use_module(library('clpbn'),
clpbn_flag/3]). [clpbn_flag/3]).
:- use_module(library('clpbn/bnt'), [ :- use_module(library('clpbn/bnt'),
create_bnt_graph/2]). [create_bnt_graph/2]).
:- use_module(library('clpbn/display'), [ :- use_module(library('clpbn/display'),
clpbn_bind_vals/3]). [clpbn_bind_vals/3]).
:- use_module(library('clpbn/dists'), [ :- use_module(library('clpbn/dists'),
get_dist_domain/2 [get_dist_domain/2]).
]).
:- use_module(library(matlab), [matlab_initialized_cells/4, :- use_module(library(matlab),
matlab_call/2, [matlab_initialized_cells/4,
matlab_get_variable/2 matlab_call/2,
]). matlab_get_variable/2
]).
:- dynamic bnt_em_max_iter/1. :- dynamic bnt_em_max_iter/1.
bnt_em_max_iter(10). bnt_em_max_iter(10).
@ -61,7 +61,7 @@ clpbn_vars(Vs,BVars) :-
get_clpbn_vars(Vs,CVs), get_clpbn_vars(Vs,CVs),
keysort(CVs,KVs), keysort(CVs,KVs),
merge_vars(KVs,BVars). merge_vars(KVs,BVars).
get_clpbn_vars([],[]). get_clpbn_vars([],[]).
get_clpbn_vars([V|GVars],[K-V|CLPBNGVars]) :- get_clpbn_vars([V|GVars],[K-V|CLPBNGVars]) :-
clpbn:get_atts(V, [key(K)]), !, clpbn:get_atts(V, [key(K)]), !,
@ -73,8 +73,8 @@ merge_vars([],[]).
merge_vars([K-V|KVs],[V|BVars]) :- merge_vars([K-V|KVs],[V|BVars]) :-
get_var_has_same_key(KVs,K,V,KVs0), get_var_has_same_key(KVs,K,V,KVs0),
merge_vars(KVs0,BVars). merge_vars(KVs0,BVars).
get_var_has_same_key([K-V|KVs],K,V,KVs0) :- !, get_var_has_same_key([K-V|KVs],K,V,KVs0) :- !,
get_var_has_same_key(KVs,K,V,KVs0). get_var_has_same_key(KVs,K,V,KVs0).
get_var_has_same_key(KVs,_,_,KVs). get_var_has_same_key(KVs,_,_,KVs).
@ -84,7 +84,7 @@ mk_sample(AllVars,NVars, LL) :-
length(LN,LL), length(LN,LL),
matlab_initialized_cells( NVars, 1, LN, sample). matlab_initialized_cells( NVars, 1, LN, sample).
add2sample([], []). add2sample([], []).
add2sample([V|Vs],[val(VId,1,Val)|Vals]) :- add2sample([V|Vs],[val(VId,1,Val)|Vals]) :-
clpbn:get_atts(V, [evidence(Ev),dist(Id,_)]), !, clpbn:get_atts(V, [evidence(Ev),dist(Id,_)]), !,
bnt:get_atts(V,[bnt_id(VId)]), bnt:get_atts(V,[bnt_id(VId)]),
@ -113,9 +113,9 @@ get_parameters([],[]).
get_parameters([Rep-v(_,_,_)|Reps],[CPT|CPTs]) :- get_parameters([Rep-v(_,_,_)|Reps],[CPT|CPTs]) :-
get_new_table(Rep,CPT), get_new_table(Rep,CPT),
get_parameters(Reps,CPTs). get_parameters(Reps,CPTs).
get_new_table(Rep,CPT) :- get_new_table(Rep,CPT) :-
s <-- struct(new_bnet.'CPD'({Rep})), s <-- struct(new_bnet.'CPD'({Rep})),
matlab_get_variable( s.'CPT', CPT). matlab_get_variable( s.'CPT', CPT).

65
packages/CLPBN/learning/em.yap
View File

@ -13,7 +13,7 @@
[clpbn_init_graph/1, [clpbn_init_graph/1,
clpbn_init_solver/4, clpbn_init_solver/4,
clpbn_run_solver/3, clpbn_run_solver/3,
clpbn_finalize_solver/1, clpbn_finalize_solver/1,
pfl_init_solver/5, pfl_init_solver/5,
pfl_run_solver/3, pfl_run_solver/3,
conditional_probability/3, conditional_probability/3,
@ -57,10 +57,10 @@
[matrix_add/3, [matrix_add/3,
matrix_to_list/2 matrix_to_list/2
]). ]).
:- use_module(library(lists), :- use_module(library(lists),
[member/2]). [member/2]).
:- use_module(library(rbtrees), :- use_module(library(rbtrees),
[rb_new/1, [rb_new/1,
rb_insert/4, rb_insert/4,
@ -85,9 +85,9 @@ em(_, _, _, Tables, Likelihood) :-
handle_em(error(repeated_parents)) :- !, handle_em(error(repeated_parents)) :- !,
assert(em_found(_, -inf)), assert(em_found(_, -inf)),
fail. fail.
handle_em(Error) :- handle_em(Error) :-
throw(Error). throw(Error).
% This gets you an initial configuration. If there is a lot of evidence % This gets you an initial configuration. If there is a lot of evidence
% tables may be filled in close to optimal, otherwise they may be % tables may be filled in close to optimal, otherwise they may be
@ -128,32 +128,31 @@ setup_em_network(Items, state(AllDists, AllDistInstances, MargVars, SolverState)
clpbn_init_solver(MargVars, AllVars, _, SolverState). clpbn_init_solver(MargVars, AllVars, _, SolverState).
run_examples(user:Exs, Keys, Factors, EList) :- run_examples(user:Exs, Keys, Factors, EList) :-
Exs = [_:_|_], !, Exs = [_:_|_], !,
findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs), findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs), VExs),
VExs), foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _).
foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _).
run_examples(Items, Keys, Factors, EList) :- run_examples(Items, Keys, Factors, EList) :-
run_ex(Items, Keys, Factors, EList). run_ex(Items, Keys, Factors, EList).
join_example( ex(EKs, EFs, EEs), Keys0, Keys, Factors0, Factors, EList0, EList, I0, I) :- join_example( ex(EKs, EFs, EEs), Keys0, Keys, Factors0, Factors, EList0, EList, I0, I) :-
I is I0+1, I is I0+1,
foldl(process_key(I0), EKs, Keys0, Keys), foldl(process_key(I0), EKs, Keys0, Keys),
foldl(process_factor(I0), EFs, Factors0, Factors), foldl(process_factor(I0), EFs, Factors0, Factors),
foldl(process_ev(I0), EEs, EList0, EList). foldl(process_ev(I0), EEs, EList0, EList).
process_key(I0, K, Keys0, [I0:K|Keys0]). process_key(I0, K, Keys0, [I0:K|Keys0]).
process_factor(I0, f(Type, Id, Keys), Keys0, [f(Type, Id, NKeys)|Keys0]) :- process_factor(I0, f(Type, Id, Keys), Keys0, [f(Type, Id, NKeys)|Keys0]) :-
maplist(update_key(I0), Keys, NKeys). maplist(update_key(I0), Keys, NKeys).
update_key(I0, K, I0:K). update_key(I0, K, I0:K).
process_ev(I0, K=V, Es0, [(I0:K)=V|Es0]). process_ev(I0, K=V, Es0, [(I0:K)=V|Es0]).
run_example([_:Items|_], Keys, Factors, EList) :- run_example([_:Items|_], Keys, Factors, EList) :-
run_ex(user:Items, Keys, Factors, EList). run_ex(user:Items, Keys, Factors, EList).
run_example([_|LItems], Keys, Factors, EList) :- run_example([_|LItems], Keys, Factors, EList) :-
run_example(LItems, Keys, Factors, EList). run_example(LItems, Keys, Factors, EList).
run_ex(Items, Keys, Factors, EList) :- run_ex(Items, Keys, Factors, EList) :-
% create the ground network % create the ground network
@ -172,17 +171,17 @@ em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :-
ltables(Tables, F0Tables), ltables(Tables, F0Tables),
%writeln(iteration:Its:Likelihood:Its:Likelihood0:F0Tables), %writeln(iteration:Its:Likelihood:Its:Likelihood0:F0Tables),
( (
( (
abs((Likelihood - Likelihood0)/Likelihood) < MaxError abs((Likelihood - Likelihood0)/Likelihood) < MaxError
; ;
Its == MaxIts Its == MaxIts
) )
-> ->
ltables(Tables, FTables), ltables(Tables, FTables),
LikelihoodF = Likelihood LikelihoodF = Likelihood
; ;
Its1 is Its+1, Its1 is Its+1,
em_loop(Its1, Likelihood, State, MaxError, MaxIts, LikelihoodF, FTables) em_loop(Its1, Likelihood, State, MaxError, MaxIts, LikelihoodF, FTables)
). ).
ltables([], []). ltables([], []).
@ -192,7 +191,7 @@ ltables([Id-T|Tables], [Key-LTable|FTables]) :-
ltables(Tables, FTables). ltables(Tables, FTables).
generate_dists(Factors, EList, AllDists, AllInfo, MargVars) :- generate_dists(Factors, EList, AllDists, AllInfo, MargVars) :-
b_hash_new(Ev0), b_hash_new(Ev0),
foldl(elist_to_hash, EList, Ev0, Ev), foldl(elist_to_hash, EList, Ev0, Ev),
maplist(process_factor(Ev), Factors, Dists0), maplist(process_factor(Ev), Factors, Dists0),
@ -240,11 +239,11 @@ all_dists([V|AllVars], AllVars0, [i(Id, [V|Parents], Cases, Hiddens)|Dists]) :-
length(Sorted, LengSorted), length(Sorted, LengSorted),
length(Parents, LengParents), length(Parents, LengParents),
( (
LengParents+1 =:= LengSorted LengParents+1 =:= LengSorted
-> ->
true true
; ;
throw(error(repeated_parents)) throw(error(repeated_parents))
), ),
generate_hidden_cases([V|Parents], CompactCases, Hiddens), generate_hidden_cases([V|Parents], CompactCases, Hiddens),
uncompact_cases(CompactCases, Cases), uncompact_cases(CompactCases, Cases),
@ -314,7 +313,7 @@ create_mdist_table(Vs, Ps, MDistTable0, MDistTable) :-
rb_insert(MDistTable0, Vs, Ps, MDistTable). rb_insert(MDistTable0, Vs, Ps, MDistTable).
compute_parameters([], [], _, Lik, Lik, _). compute_parameters([], [], _, Lik, Lik, _).
compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0, Lik, LPs:MargVars) :- compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0, Lik, LPs:MargVars) :-
empty_dist(Id, Table0), empty_dist(Id, Table0),
add_samples(Samples, Table0, MDistTable), add_samples(Samples, Table0, MDistTable),
%matrix_to_list(Table0,Mat), lists:sumlist(Mat, Sum), format(user_error, 'FINAL ~d ~w ~w~n', [Id,Sum,Mat]), %matrix_to_list(Table0,Mat), lists:sumlist(Mat, Sum), format(user_error, 'FINAL ~d ~w ~w~n', [Id,Sum,Mat]),
@ -324,7 +323,7 @@ compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0,
compute_likelihood(Table0, NewTable, DeltaLik), compute_likelihood(Table0, NewTable, DeltaLik),
dist_new_table(Id, NewTable), dist_new_table(Id, NewTable),
NewLik is Lik0+DeltaLik, NewLik is Lik0+DeltaLik,
compute_parameters(Dists, Tables, MDistTable, NewLik, Lik, LPs:MargVars). compute_parameters(Dists, Tables, MDistTable, NewLik, Lik, LPs:MargVars).
add_samples([], _, _). add_samples([], _, _).
add_samples([i(_,_,[Case],[])|Samples], Table, MDistTable) :- !, add_samples([i(_,_,[Case],[])|Samples], Table, MDistTable) :- !,

40
packages/CLPBN/learning/learn_utils.yap
View File

@ -2,29 +2,31 @@
% Utilities for learning % Utilities for learning
% %
:- module(clpbn_learn_utils, [run_all/1, :- module(clpbn_learn_utils,
clpbn_vars/2, [run_all/1,
normalise_counts/2, clpbn_vars/2,
compute_likelihood/3, normalise_counts/2,
soften_sample/2, compute_likelihood/3,
soften_sample/3]). soften_sample/2,
soften_sample/3
]).
:- use_module(library(clpbn), :- use_module(library(clpbn),
[clpbn_flag/2]). [clpbn_flag/2]).
:- use_module(library('clpbn/table'), :- use_module(library('clpbn/table'),
[clpbn_reset_tables/0]). [clpbn_reset_tables/0]).
:- use_module(library(matrix), :- use_module(library(matrix),
[matrix_agg_lines/3, [matrix_agg_lines/3,
matrix_op_to_lines/4, matrix_op_to_lines/4,
matrix_agg_cols/3, matrix_agg_cols/3,
matrix_op_to_cols/4, matrix_op_to_cols/4,
matrix_to_logs/2, matrix_to_logs/2,
matrix_op/4, matrix_op/4,
matrix_sum/2, matrix_sum/2,
matrix_to_list/2, matrix_to_list/2,
matrix_op_to_all/4]). matrix_op_to_all/4]).
:- meta_predicate run_all(:). :- meta_predicate run_all(:).
@ -47,7 +49,7 @@ clpbn_vars(Vs,BVars) :-
get_clpbn_vars(Vs,CVs), get_clpbn_vars(Vs,CVs),
keysort(CVs,KVs), keysort(CVs,KVs),
merge_vars(KVs,BVars). merge_vars(KVs,BVars).
get_clpbn_vars([],[]). get_clpbn_vars([],[]).
get_clpbn_vars([V|GVars],[K-V|CLPBNGVars]) :- get_clpbn_vars([V|GVars],[K-V|CLPBNGVars]) :-
clpbn:get_atts(V, [key(K)]), !, clpbn:get_atts(V, [key(K)]), !,
@ -59,7 +61,7 @@ merge_vars([],[]).
merge_vars([K-V|KVs],[V|BVars]) :- merge_vars([K-V|KVs],[V|BVars]) :-
get_var_has_same_key(KVs,K,V,KVs0), get_var_has_same_key(KVs,K,V,KVs0),
merge_vars(KVs0,BVars). merge_vars(KVs0,BVars).
get_var_has_same_key([K-V|KVs],K,V,KVs0) :- !, get_var_has_same_key([K-V|KVs],K,V,KVs0) :- !,
get_var_has_same_key(KVs,K,V,KVs0). get_var_has_same_key(KVs,K,V,KVs0).
get_var_has_same_key(KVs,_,_,KVs). get_var_has_same_key(KVs,_,_,KVs).

28
packages/CLPBN/learning/mle.yap
View File

@ -5,25 +5,29 @@
% This assumes we have a single big example. % This assumes we have a single big example.
% %
:- module(clpbn_mle, [learn_parameters/2, :- module(clpbn_mle,
learn_parameters/3, [learn_parameters/2,
parameters_from_evidence/3]). learn_parameters/3,
parameters_from_evidence/3
]).
:- use_module(library('clpbn')). :- use_module(library('clpbn')).
:- use_module(library('clpbn/learning/learn_utils'), :- use_module(library('clpbn/learning/learn_utils'),
[run_all/1, [run_all/1,
clpbn_vars/2, clpbn_vars/2,
normalise_counts/2, normalise_counts/2,
soften_table/2, soften_table/2,
normalise_counts/2]). normalise_counts/2
]).
:- use_module(library('clpbn/dists'), :- use_module(library('clpbn/dists'),
[empty_dist/2, [empty_dist/2,
dist_new_table/2]). dist_new_table/2
]).
:- use_module(library(matrix), :- use_module(library(matrix),
[matrix_inc/2]). [matrix_inc/2]).
learn_parameters(Items, Tables) :- learn_parameters(Items, Tables) :-

33
packages/CLPBN/pfl.yap
View File

@ -6,7 +6,7 @@
:- module(pfl, :- module(pfl,
[op(550,yfx,@), [op(550,yfx,@),
op(550,yfx,::), op(550,yfx,::),
op(1150,fx,bayes), op(1150,fx,bayes),
op(1150,fx,markov), op(1150,fx,markov),
factor/6, factor/6,
skolem/2, skolem/2,
@ -133,19 +133,19 @@ process_args(Arg1, Id, I0, I ) -->
process_arg(Sk::D, Id, _I) --> process_arg(Sk::D, Id, _I) -->
!, !,
{ {
new_skolem(Sk,D), new_skolem(Sk,D),
assert(skolem_in(Sk, Id)) assert(skolem_in(Sk, Id))
}, },
[Sk]. [Sk].
process_arg(Sk, Id, _I) --> process_arg(Sk, Id, _I) -->
!, !,
{ {
% if :: been used before for this skolem % if :: been used before for this skolem
% just keep on using it, % just keep on using it,
% otherwise, assume it is t,f % otherwise, assume it is t,f
( \+ \+ skolem(Sk,_D) -> true ; new_skolem(Sk,[t,f]) ), ( \+ \+ skolem(Sk,_D) -> true ; new_skolem(Sk,[t,f]) ),
assert(skolem_in(Sk, Id)) assert(skolem_in(Sk, Id))
}, },
[Sk]. [Sk].
new_skolem(Sk,D) :- new_skolem(Sk,D) :-
@ -165,11 +165,10 @@ interface_predicate(Sk) :-
assert(preprocess(ESk, Sk, Var)), assert(preprocess(ESk, Sk, Var)),
% transform from PFL to CLP(BN) call % transform from PFL to CLP(BN) call
assert_static((user:ESk :- assert_static((user:ESk :-
evidence(Sk,Ev) -> Ev = Var; evidence(Sk,Ev) -> Ev = Var;
var(Var) -> insert_atts(Var,Sk) ; var(Var) -> insert_atts(Var,Sk) ;
add_evidence(Sk,Var) add_evidence(Sk,Var)
) )).
).
insert_atts(Var,Sk) :- insert_atts(Var,Sk) :-
clpbn:put_atts(Var,[key(Sk)]). clpbn:put_atts(Var,[key(Sk)]).
@ -186,7 +185,7 @@ add_evidence(Sk,Var) :-
%% writeln(Key:Parents), %% writeln(Key:Parents),
%% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out). %% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out).
get_pfl_cpt(Id, Keys, _, Keys, Out) :- get_pfl_cpt(Id, Keys, _, Keys, Out) :-
get_pfl_parameters(Id,Out). get_pfl_parameters(Id,Out).
get_pfl_parameters(Id,Out) :- get_pfl_parameters(Id,Out) :-
factor(_Type,Id,_FList,_FV,Phi,_Constraints), factor(_Type,Id,_FList,_FV,Phi,_Constraints),
@ -208,7 +207,7 @@ get_sizes(Key.FList, Sz.DSizes) :-
skolem(Key, Domain), skolem(Key, Domain),
length(Domain, Sz), length(Domain, Sz),
get_sizes(FList, DSizes). get_sizes(FList, DSizes).
% only makes sense for bayesian networks % only makes sense for bayesian networks
get_first_pvariable(Id,Var) :- get_first_pvariable(Id,Var) :-
factor(_Type, Id,Var._FList,_FV,_Phi,_Constraints). factor(_Type, Id,Var._FList,_FV,_Phi,_Constraints).