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

Several whitespace fixes

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

83
packages/CLPBN/clpbn.yap
View File

@ -5,10 +5,10 @@
set_clpbn_flag/2,
clpbn_flag/3,
clpbn_key/2,
clpbn_init_graph/1,
clpbn_init_graph/1,
clpbn_init_solver/4,
clpbn_run_solver/3,
clpbn_finalize_solver/1,
clpbn_finalize_solver/1,
pfl_init_solver/5,
pfl_run_solver/3,
probability/2,
@ -16,7 +16,7 @@
use_parfactors/1,
op(500, xfy, with)
]).
:- use_module(library(atts)).
:- use_module(library(bhash)).
@ -103,7 +103,7 @@
check_stored_evidence/2,
put_evidence/2
]).
:- use_module('clpbn/ground_factors',
[generate_network/5]).
@ -131,7 +131,7 @@
parameter_softening/1,
em_solver/1,
use_parfactors/1.
:- meta_predicate probability(:,-), conditional_probability(:,:,-).
@ -199,7 +199,7 @@ store_var(El) :-
get_mutable(Tail, Mutable),
update_mutable(El.Tail, Mutable).
store_var(El) :-
init_clpbn_vars(El).
init_clpbn_vars(El).
init_clpbn_vars(El) :-
create_mutable(El, Mutable),
@ -246,13 +246,14 @@ project_attributes(GVars0, _AVars0) :-
generate_network(GVars0, GKeys, Keys, Factors, Evidence),
b_setval(clpbn_query_variables, f(GVars0,Evidence)),
simplify_query(GVars0, GVars),
( GKeys = []
->
(
GKeys = []
->
GVars0 = [V|_],
clpbn_display:put_atts(V, [posterior([],[],[],[])])
;
call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence)
).
).
project_attributes(GVars, AVars) :-
suppress_attribute_display(false),
AVars = [_|_],
@ -266,11 +267,11 @@ project_attributes(GVars, AVars) :-
(output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,ve,AllVars) ; 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(_, _).
@ -334,7 +335,7 @@ write_out(jt, GVars, AVars, DiffVars) :-
jt(GVars, AVars, DiffVars).
write_out(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').
write_out(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),
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)]) ->
bind_evidence_from_extra_var(Ev1,Var)
;
get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T)
;
true
)
(
get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var)
;
get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T)
;
true
)
;
fail
fail
).
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bnt),
@ -487,7 +488,7 @@ bind_clpbn(T, Var, Key0, _, _, _, []) :-
(
Key = Key0 -> true
;
% let us not loose whatever we had.
% let us not loose whatever we had.
put_evidence(T,Var)
).
@ -497,7 +498,7 @@ fresh_attvar(Var, NVar) :-
% I will now allow two CLPBN variables to be bound together.
%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, !,
get_dist(Dist,_Type,_Domain,_Table),
get_dist(Dist1,_Type1,_Domain1,_Table1),
@ -526,14 +527,14 @@ bind_evidence_from_extra_var(Ev1,Var) :-
bind_evidence_from_extra_var(Ev1,Var) :-
put_atts(Var, [evidence(Ev1)]).
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M),
store_evidence(M:A).
clpbn_key(Var,Key) :-
get_atts(Var, [key(Key)]).
%
% 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) :-
init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(ve, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_ve_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_horus_ground_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_bdd_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(pcg, 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) :-
run_pcg_solver(LVs, LPs, State).
clpbn_finalize_solver(State) :-
solver(bp), !,
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).
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).
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).
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).
pfl_init_solver(_, _, _, _, _, Solver) :-
write('Error: solver `'),
write(Solver),
write('\' cannot be used for learning').
pfl_run_solver(LVs, LPs, State) :-
solver(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) :- !,
run_horus_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, cbp) :- !,
run_horus_ground_solver(LVs, LPs, State).

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

@ -1,4 +1,4 @@
%
%
% generate explicit CPTs
%
:- module(clpbn_aggregates,
@ -63,9 +63,9 @@ simplify_dist(_, _, _, _, Vs0, Vs0).
%
avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
% we keep ev as a list
skolem(Key, Domain),
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
% we keep ev as a list
skolem(Key, Domain),
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
% there are 4 cases:
% 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 incompatible with parents
query_evidence(Key, EvHash, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
b_hash_lookup(Key, Ev, EvHash), !,
normalise_CPT_on_lines(MAT0, MAT1, L1),
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
b_hash_lookup(Key, Ev, EvHash), !,
normalise_CPT_on_lines(MAT0, MAT1, L1),
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
query_evidence(_, _, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
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) :-
b_hash_lookup(Key, V, Ev), !,
EvF is Ev0+V.
b_hash_lookup(Key, V, Ev), !,
EvF is Ev0+V.
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),
matrix_to_list(CPT, Mat),
add_ground_factor(bayes, Domain, [Key,V1,V2], Mat, Id).
intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !.
intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !,
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(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT).
build_max_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16,
TabSize =< 16,
/* case gmp is not there !! */
TabSize > 0, !,
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(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
max_cpt([V1,V2], Domain, Softness, CPT).
build_min_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16,
TabSize =< 16,
/* case gmp is not there !! */
TabSize > 0, !,
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(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
min_cpt([V1,V2], Domain, Softness, CPT).
int_power([], _, TabSize, TabSize).
int_power([_|L], X, I0, TabSize) :-
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) :-
sumlist(L1, Tot),
nth0(Ev, L1, Val),
(Val == Tot ->
MAT1 = MAT,
NewParents = [],
Vs = NewVs
(
Val == Tot
->
MAT1 = MAT,
NewParents = [],
Vs = NewVs
;
Val == 0.0 ->
Val == 0.0 ->
throw(error(domain_error(incompatible_evidence),evidence(Ev)))
;
;
MAT0 = MAT,
NewParents = NewParents0,
IVs = NewVs
).
%
% generate actual table, instead of trusting the solver
@ -376,6 +378,6 @@ get_vdist_size(V, Sz) :-
clpbn:get_atts(V, [dist(Dist,_)]),
get_dist_domain_size(Dist, Sz).
get_vdist_size(V, Sz) :-
skolem(V, Dom),
skolem(V, Dom),
length(Dom, Sz).

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

@ -93,37 +93,37 @@ run_bdd_ground_solver(_QueryVars, Solutions, bdd(GKeys, Keys, Factors, Evidence)
check_if_bdd_done(_Var).
call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_bdd_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
run_solver(QueryKeys, Solutions, BDD).
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
run_solver(QueryKeys, Solutions, BDD).
init_bdd(FactorIds, EvidenceIds, Hash, Id, bdd(Term, Leaves, Tops, Hash, Id)) :-
sort_keys(FactorIds, AllVars, Leaves),
rb_new(OrderVs0),
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
rb_new(Vars0),
rb_new(Pars0),
rb_new(Ev0),
foldl(evtotree,EvidenceIds,Ev0,Ev),
rb_new(Fs0),
foldl(ftotree,FactorIds,Fs0,Fs),
init_tops(Leaves,Tops),
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
sort_keys(FactorIds, AllVars, Leaves),
rb_new(OrderVs0),
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
rb_new(Vars0),
rb_new(Pars0),
rb_new(Ev0),
foldl(evtotree,EvidenceIds,Ev0,Ev),
rb_new(Fs0),
foldl(ftotree,FactorIds,Fs0,Fs),
init_tops(Leaves,Tops),
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
order_key( Id, I0, I, OrderVs0, OrderVs) :-
I is I0+1,
rb_insert(OrderVs0, Id, I0, OrderVs).
I is I0+1,
rb_insert(OrderVs0, Id, I0, OrderVs).
evtotree(K=V,Ev0,Ev) :-
rb_insert(Ev0, K, V, Ev).
rb_insert(Ev0, K, V, Ev).
ftotree(F, Fs0, Fs) :-
F = f([K|_Parents],_,_,_),
rb_insert(Fs0, K, F, Fs).
F = f([K|_Parents],_,_,_),
rb_insert(Fs0, K, F, Fs).
bdd([[]],_,_) :- !.
bdd([QueryVars], AllVars, AllDiffs) :-
@ -155,59 +155,59 @@ init_tops([_|Leaves],[_|Tops]) :-
init_tops(Leaves,Tops).
sort_keys(AllFs, AllVars, Leaves) :-
dgraph_new(Graph0),
foldl(add_node, AllFs, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
dgraph_new(Graph0),
foldl(add_node, AllFs, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
add_node(f([K|Parents],_,_,_), Graph0, Graph) :-
dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph).
dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, 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) :-
dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
build_graph([], Graph, Graph).
build_graph([V|AllVars0], Graph0, Graph) :-
clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph).
clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph).
build_graph(_V.AllVars0, Graph0, Graph) :-
build_graph(AllVars0, Graph0, Graph).
build_graph(AllVars0, Graph0, Graph).
add_parents([], _V, Graph, Graph).
add_parents([V0|Parents], V, Graph0, GraphF) :-
dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF).
dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF).
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) },
{ rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) },
%{writeln(v:DistId:Parents)},
[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).
[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_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (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).
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)]) }, !,
%{writeln(v:DistId:Parents)},
[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], 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,
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
L0 = [P0|L1]
;
;
L0 = L1
),
( satisf(I00, I10+1, I20, IR, N0, N1, N2, R, Exp) ->
L1 = [P1|L2]
;
;
L1 = L2
),
( satisf(I00, I10, I20+1, IR, N0, N1, N2, R, Exp) ->
L2 = [P2]
;
;
L2 = []
),
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,
( 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)
->
->
L0 = [P0*O0|L1]
;
;
L0 = L1
),
( 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)
->
->
L1 = [P1*O1|L2]
;
;
L1 = L2
),
( 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)
->
->
L2 = [P2*O2]
;
;
L2 = []
),
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 ),
Im1 is max(0, Im-I0),
IM1 is IM-I0,
( IM1 < 0 -> O1 = 0, H2 = HI; /* we have exceed maximum */
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 -> O1 = 0, H2 = HI ; /* we have exceed maximum */
Im1 > Max -> O1 = 0, H2 = HI ; /* we cannot make to minimum */
Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI ; /* we cannot exceed maximum */
P is P0+1,
avg_tree(PVars, P, Max, Im1, IM1, Size, O1, HI, H2)
),
),
I is I0+1,
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([V|Vs], [Sum|Sums0]) :-
Sum =.. [sum|V],
vs_to_sums(Vs, Sums0).
Sum =.. [sum|V],
vs_to_sums(Vs, Sums0).
bin_sums([Sum], Sum) --> !.
bin_sums(LSums, Sum) -->
bin_sums(LSums, Sum) -->
{ halve(LSums, Sums1, Sums2) },
bin_sums(Sums1, Sum1),
bin_sums(Sums2, Sum2),
@ -458,14 +458,14 @@ head(Take, [H|L], [H|Sums1], Sum2) :-
head(Take1, L, Sums1, Sum2).
sum(Sum1, Sum2, Sum) -->
{ functor(Sum1, _, M1),
functor(Sum2, _, M2),
Max is M1+M2-2,
Max1 is Max+1,
Max0 is M2-1,
functor(Sum, sum, Max1),
Sum1 =.. [_|PVals] },
expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
{ functor(Sum1, _, M1),
functor(Sum2, _, M2),
Max is M1+M2-2,
Max1 is Max+1,
Max0 is M2-1,
functor(Sum, sum, Max1),
Sum1 =.. [_|PVals] },
expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
%
% 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),
sum_all(Parents, 0, I0, Max0, Sums, List),
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) :-
I is I0+1,
arg(I, Sums, 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,
@ -538,12 +538,12 @@ gen_arg(J, Sums, Max, S0) :-
gen_arg(0, Max, J, Sums, S0).
gen_arg(Max, Max, J, Sums, S0) :- !,
I is Max+1,
arg(I, Sums, A),
I is Max+1,
arg(I, Sums, A),
( Max = J -> S0 = A ; S0 = not(A)).
gen_arg(I0, Max, J, Sums, S) :-
I is I0+1,
arg(I, Sums, A),
I is I0+1,
arg(I, Sums, A),
( I0 = J -> S = A*S0 ; S = not(A)*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_key_parent(Fs, V, Values, Vs0, Vs) :-
INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs).
INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs).
check_key(V, _, INFO, Vs, 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 ).
get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :-
rb_lookup(V, Pos, Evs), !,
zero_pos(0, Pos, Ev),
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs).
rb_lookup(V, Pos, Evs), !,
zero_pos(0, Pos, Ev),
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs).
% hidden deterministic node, can be removed.
%% get_key_evidence(V, _, DistId, _Tree, Ev, F0, [], _Leaves, _Finals) :-
%% deterministic(V, DistId),
%% deterministic(V, DistId),
%% !,
%% one_list(Ev),
%% eval_outs(F0).
%% no evidence !!!
get_key_evidence(V, _, _, Tree, _Values, F0, F1, Leaves, Finals) :-
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs).
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs).
get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
clpbn:get_atts(V, [evidence(Pos)]), !,
@ -846,7 +846,7 @@ zero_pos(_, _Pos, []).
zero_pos(Pos, Pos, [1|Values]) :- !,
I is Pos+1,
zero_pos(I, Pos, Values).
zero_pos(I0, Pos, [0|Values]) :-
zero_pos(I0, Pos, [0|Values]) :-
I is I0+1,
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).
get_outs([V=F], [V=NF|End], End, V) :- !,
get_outs([V=F], [V=NF|End], End, V) :- !,
% writeln(f0:F),
simplify_exp(F,NF).
get_outs([(V=F)|Outs], [(V=NF)|NOuts], End, (F0 + V)) :-
@ -878,11 +878,11 @@ eval_outs([(V=F)|Outs]) :-
eval_outs(Outs).
run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :-
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
findall(LPs,
(member(Q, QIds),
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
LLPs).
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
findall(LPs,
(member(Q, QIds),
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
LLPs).
run_bdd_solver([Vs], LPs, bdd(Term, _Leaves, Nodes)) :-
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, [_|Vs]) :-
v_in(V, Vs).
v_in(V, Vs).
all_indicators(Values) -->
{ values_to_disj(Values, Disj) },
@ -1017,7 +1017,7 @@ parameters([(V0=Disj*_I0)|Formula], Tree) -->
parameters(Formula, Tree).
% 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) -->
{ conj2(Disj, [[V0]], LVs) },
to_disjs(LVs).

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

@ -154,7 +154,7 @@ extract_kvars([V|AllVars],[N-i(V,Parents)|KVars]) :-
extract_kvars(AllVars,KVars).
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_tied(More,N,Vs,[V],Ns,NPs,Es,Es0,SVars),
split_tied_vars(SVars,TVars,LNs).
@ -206,7 +206,7 @@ extract_graph(AllVars, Graph) :-
dgraph_add_vertices(Graph0, AllVars, Graph1),
get_edges(AllVars,Edges),
dgraph_add_edges(Graph1, Edges, Graph).
get_edges([],[]).
get_edges([V|AllVars],Edges) :-
clpbn:get_atts(V, [dist(_,Parents)]),
@ -224,13 +224,13 @@ number_graph([V|SortedGraph], [I|Is], I0, IF) :-
% clpbn:get_atts(V,[key(K)]),
% write(I:K),nl,
number_graph(SortedGraph, Is, I, IF).
init_bnet(propositional, SortedGraph, NumberedGraph, Size, []) :-
build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size),
bnet <-- mk_bnet(dag, node_sizes, \discrete, discrete_nodes),
dump_cpts(SortedGraph, NumberedGraph).
init_bnet(tied, SortedGraph, NumberedGraph, Size, Representatives) :-
build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size),
@ -382,7 +382,7 @@ add_evidence(Graph, Size, Is) :-
mk_evidence(Graph, Is, LN),
matlab_initialized_cells( 1, Size, LN, evidence),
[engine_ev, loglik] <-- enter_evidence(engine, evidence).
mk_evidence([], [], []).
mk_evidence([V|L], [I|Is], [ar(1,I,EvVal1)|LN]) :-
clpbn:get_atts(V, [evidence(EvVal)]), !,
@ -409,7 +409,7 @@ marginalize([Vs], SortedVars, NumberedVars,Ps) :-
length(SortedVars,L),
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]):-
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),
mk_evidence_query(L, T, LN).

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

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

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

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

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

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

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

@ -326,11 +326,11 @@ randomise_all_dists.
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),
dist_new_table(Dist, NewCPT).
@ -342,11 +342,11 @@ uniformise_all_dists.
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),
dist_new_table(Dist, NewCPT).

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

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

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

@ -249,11 +249,11 @@ compile_var(_,_,_,_,_,_,_,_).
multiply_all(I,Parents,CPTs,Sz,Graph) :-
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.
multiply_all(I,_,_,_,_) :-
@ -283,7 +283,7 @@ fetch_parents([], _, []).
fetch_parents([P|Parents], Graph, [Val|Vals]) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)),
fetch_parents(Parents, Graph, Vals).
multiply_more([],_,Probs0,LProbs) :-
normalise_possibly_deterministic_CPT(Probs0, Probs),
list_from_CPT(Probs, LProbs0),
@ -299,7 +299,7 @@ accumulate_up_list([P|LProbs], P0, [P1|L]) :-
P1 is P0+P,
accumulate_up_list(LProbs, P1, L).
store_mblanket(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).
update_estimate_for_var(V0,[X|T],[X1|NT]) :-
( V0 == 0 ->
(V0 == 0 ->
X1 is X+1,
NT = T
;
@ -499,7 +499,7 @@ do_probs([E|Es],Sum,[P|Ps]) :-
show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :-
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
clpbn:get_atts(V,[key(K)]),
format('~w ',[K]),
show_sorted(VarOrder, Graph).

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

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

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

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

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

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

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

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

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

@ -30,16 +30,16 @@ keys_to_numbers(AllKeys, Factors, Evidence, Hash0, Hash4, Id0, Id4, FactorIds, E
foldl2(key_to_id, SKeys, _, Hash3, Hash4, Id3, Id4).
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) :-
foldl2(key_to_id, List, IdList, Hash0, Hash, I0, I).
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) :-
b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1.
b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1.
factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :-
get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT),

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -13,7 +13,7 @@
[clpbn_init_graph/1,
clpbn_init_solver/4,
clpbn_run_solver/3,
clpbn_finalize_solver/1,
clpbn_finalize_solver/1,
pfl_init_solver/5,
pfl_run_solver/3,
conditional_probability/3,
@ -57,10 +57,10 @@
[matrix_add/3,
matrix_to_list/2
]).
:- use_module(library(lists),
[member/2]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_insert/4,
@ -85,9 +85,9 @@ em(_, _, _, Tables, Likelihood) :-
handle_em(error(repeated_parents)) :- !,
assert(em_found(_, -inf)),
fail.
fail.
handle_em(Error) :-
throw(Error).
throw(Error).
% 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
@ -128,32 +128,31 @@ setup_em_network(Items, state(AllDists, AllDistInstances, MargVars, SolverState)
clpbn_init_solver(MargVars, AllVars, _, SolverState).
run_examples(user:Exs, Keys, Factors, EList) :-
Exs = [_:_|_], !,
findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs),
VExs),
foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _).
Exs = [_:_|_], !,
findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs), VExs),
foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _).
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) :-
I is I0+1,
foldl(process_key(I0), EKs, Keys0, Keys),
foldl(process_factor(I0), EFs, Factors0, Factors),
foldl(process_ev(I0), EEs, EList0, EList).
I is I0+1,
foldl(process_key(I0), EKs, Keys0, Keys),
foldl(process_factor(I0), EFs, Factors0, Factors),
foldl(process_ev(I0), EEs, EList0, EList).
process_key(I0, K, Keys0, [I0:K|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).
process_ev(I0, K=V, Es0, [(I0:K)=V|Es0]).
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_ex(Items, Keys, Factors, EList) :-
% create the ground network
@ -172,17 +171,17 @@ em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :-
ltables(Tables, F0Tables),
%writeln(iteration:Its:Likelihood:Its:Likelihood0:F0Tables),
(
(
abs((Likelihood - Likelihood0)/Likelihood) < MaxError
;
Its == MaxIts
)
(
abs((Likelihood - Likelihood0)/Likelihood) < MaxError
;
Its == MaxIts
)
->
ltables(Tables, FTables),
LikelihoodF = Likelihood
ltables(Tables, FTables),
LikelihoodF = Likelihood
;
Its1 is Its+1,
em_loop(Its1, Likelihood, State, MaxError, MaxIts, LikelihoodF, FTables)
Its1 is Its+1,
em_loop(Its1, Likelihood, State, MaxError, MaxIts, LikelihoodF, FTables)
).
ltables([], []).
@ -192,7 +191,7 @@ ltables([Id-T|Tables], [Key-LTable|FTables]) :-
ltables(Tables, FTables).
generate_dists(Factors, EList, AllDists, AllInfo, MargVars) :-
generate_dists(Factors, EList, AllDists, AllInfo, MargVars) :-
b_hash_new(Ev0),
foldl(elist_to_hash, EList, Ev0, Ev),
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(Parents, LengParents),
(
LengParents+1 =:= LengSorted
->
true
LengParents+1 =:= LengSorted
->
true
;
throw(error(repeated_parents))
throw(error(repeated_parents))
),
generate_hidden_cases([V|Parents], CompactCases, Hiddens),
uncompact_cases(CompactCases, Cases),
@ -314,7 +313,7 @@ create_mdist_table(Vs, Ps, MDistTable0, MDistTable) :-
rb_insert(MDistTable0, Vs, Ps, MDistTable).
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),
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]),
@ -324,7 +323,7 @@ compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0,
compute_likelihood(Table0, NewTable, DeltaLik),
dist_new_table(Id, NewTable),
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([i(_,_,[Case],[])|Samples], Table, MDistTable) :- !,

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

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

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

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

33
packages/CLPBN/pfl.yap
View File

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