Several whitespace fixes
This commit is contained in:
Tiago Gomes
parent
409a230826
commit
2f2f88e571
|
|
@ -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).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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,3 +1,4 @@
|
||||||
|
|
||||||
:- module(clpbn_display,
|
:- module(clpbn_display,
|
||||||
[clpbn_bind_vals/3]).
|
[clpbn_bind_vals/3]).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
|
|
@ -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]) :-
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
|
|
@ -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)) :-
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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) :-
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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) :-
|
||||||
|
|
|
||||||
|
|
@ -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],
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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),
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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) :- !,
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
|
|
@ -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) :-
|
||||||
|
|
|
||||||
|
|
@ -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).
|
||||||
|
|
|
||||||
Reference in New Issue