From 2f2f88e57190831aca9960094b9e693420c067ba Mon Sep 17 00:00:00 2001 From: Tiago Gomes Date: Mon, 17 Dec 2012 17:57:00 +0000 Subject: [PATCH] Several whitespace fixes --- packages/CLPBN/clpbn.yap | 83 ++++----- packages/CLPBN/clpbn/aggregates.yap | 50 +++--- packages/CLPBN/clpbn/bdd.yap | 210 +++++++++++----------- packages/CLPBN/clpbn/bnt.yap | 13 +- packages/CLPBN/clpbn/connected.yap | 84 ++++----- packages/CLPBN/clpbn/discrete_utils.yap | 6 +- packages/CLPBN/clpbn/display.yap | 1 + packages/CLPBN/clpbn/dists.yap | 12 +- packages/CLPBN/clpbn/evidence.yap | 3 +- packages/CLPBN/clpbn/gibbs.yap | 14 +- packages/CLPBN/clpbn/ground_factors.yap | 48 ++--- packages/CLPBN/clpbn/hmm.yap | 29 ++- packages/CLPBN/clpbn/jt.yap | 67 ++++--- packages/CLPBN/clpbn/matrix_cpt_utils.yap | 51 +++--- packages/CLPBN/clpbn/numbers.yap | 8 +- packages/CLPBN/clpbn/pgrammar.yap | 30 ++-- packages/CLPBN/clpbn/table.yap | 93 +++++----- packages/CLPBN/clpbn/utils.yap | 16 +- packages/CLPBN/clpbn/ve.yap | 116 ++++++------ packages/CLPBN/clpbn/viterbi.yap | 60 +++---- packages/CLPBN/clpbn/vmap.yap | 2 +- packages/CLPBN/learning/aleph_params.yap | 131 +++++++------- packages/CLPBN/learning/bnt_parms.yap | 40 ++--- packages/CLPBN/learning/em.yap | 65 ++++--- packages/CLPBN/learning/learn_utils.yap | 40 +++-- packages/CLPBN/learning/mle.yap | 28 +-- packages/CLPBN/pfl.yap | 33 ++-- 27 files changed, 667 insertions(+), 666 deletions(-) diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index a77d13d32..3fa79d7c0 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -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). diff --git a/packages/CLPBN/clpbn/aggregates.yap b/packages/CLPBN/clpbn/aggregates.yap index 5fa7d0718..71e08795b 100644 --- a/packages/CLPBN/clpbn/aggregates.yap +++ b/packages/CLPBN/clpbn/aggregates.yap @@ -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). diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap index 3040a754f..a7bc3abd7 100644 --- a/packages/CLPBN/clpbn/bdd.yap +++ b/packages/CLPBN/clpbn/bdd.yap @@ -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). diff --git a/packages/CLPBN/clpbn/bnt.yap b/packages/CLPBN/clpbn/bnt.yap index 4f8dddf49..9fd0d8d65 100644 --- a/packages/CLPBN/clpbn/bnt.yap +++ b/packages/CLPBN/clpbn/bnt.yap @@ -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). - diff --git a/packages/CLPBN/clpbn/connected.yap b/packages/CLPBN/clpbn/connected.yap index 773511b8f..e71d90bee 100644 --- a/packages/CLPBN/clpbn/connected.yap +++ b/packages/CLPBN/clpbn/connected.yap @@ -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). diff --git a/packages/CLPBN/clpbn/discrete_utils.yap b/packages/CLPBN/clpbn/discrete_utils.yap index d6b718074..ebe8ab376 100644 --- a/packages/CLPBN/clpbn/discrete_utils.yap +++ b/packages/CLPBN/clpbn/discrete_utils.yap @@ -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(_, _). diff --git a/packages/CLPBN/clpbn/display.yap b/packages/CLPBN/clpbn/display.yap index 006f7c77e..5d6afb6ea 100644 --- a/packages/CLPBN/clpbn/display.yap +++ b/packages/CLPBN/clpbn/display.yap @@ -1,3 +1,4 @@ + :- module(clpbn_display, [clpbn_bind_vals/3]). diff --git a/packages/CLPBN/clpbn/dists.yap b/packages/CLPBN/clpbn/dists.yap index 81a604d3a..be4b63b20 100644 --- a/packages/CLPBN/clpbn/dists.yap +++ b/packages/CLPBN/clpbn/dists.yap @@ -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). diff --git a/packages/CLPBN/clpbn/evidence.yap b/packages/CLPBN/clpbn/evidence.yap index 450413e29..8fd4ee9bc 100644 --- a/packages/CLPBN/clpbn/evidence.yap +++ b/packages/CLPBN/clpbn/evidence.yap @@ -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), diff --git a/packages/CLPBN/clpbn/gibbs.yap b/packages/CLPBN/clpbn/gibbs.yap index a8cccee0d..3349f4d29 100644 --- a/packages/CLPBN/clpbn/gibbs.yap +++ b/packages/CLPBN/clpbn/gibbs.yap @@ -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). diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap index 0a364408c..50d7a113d 100644 --- a/packages/CLPBN/clpbn/ground_factors.yap +++ b/packages/CLPBN/clpbn/ground_factors.yap @@ -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]) :- diff --git a/packages/CLPBN/clpbn/hmm.yap b/packages/CLPBN/clpbn/hmm.yap index fc6c38388..623955160 100644 --- a/packages/CLPBN/clpbn/hmm.yap +++ b/packages/CLPBN/clpbn/hmm.yap @@ -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). diff --git a/packages/CLPBN/clpbn/jt.yap b/packages/CLPBN/clpbn/jt.yap index 4a3e70f7f..7eb3c191f 100644 --- a/packages/CLPBN/clpbn/jt.yap +++ b/packages/CLPBN/clpbn/jt.yap @@ -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)) :- diff --git a/packages/CLPBN/clpbn/matrix_cpt_utils.yap b/packages/CLPBN/clpbn/matrix_cpt_utils.yap index 3c68dab8e..c12d5b6e6 100644 --- a/packages/CLPBN/clpbn/matrix_cpt_utils.yap +++ b/packages/CLPBN/clpbn/matrix_cpt_utils.yap @@ -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), diff --git a/packages/CLPBN/clpbn/numbers.yap b/packages/CLPBN/clpbn/numbers.yap index 85aca9f77..88c65c915 100644 --- a/packages/CLPBN/clpbn/numbers.yap +++ b/packages/CLPBN/clpbn/numbers.yap @@ -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), diff --git a/packages/CLPBN/clpbn/pgrammar.yap b/packages/CLPBN/clpbn/pgrammar.yap index 0a54ba91a..f4739cb84 100644 --- a/packages/CLPBN/clpbn/pgrammar.yap +++ b/packages/CLPBN/clpbn/pgrammar.yap @@ -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) :- diff --git a/packages/CLPBN/clpbn/table.yap b/packages/CLPBN/clpbn/table.yap index 3ebfac6c6..748a2757d 100644 --- a/packages/CLPBN/clpbn/table.yap +++ b/packages/CLPBN/clpbn/table.yap @@ -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), diff --git a/packages/CLPBN/clpbn/utils.yap b/packages/CLPBN/clpbn/utils.yap index 7ebf4d332..5bce1c943 100644 --- a/packages/CLPBN/clpbn/utils.yap +++ b/packages/CLPBN/clpbn/utils.yap @@ -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). diff --git a/packages/CLPBN/clpbn/ve.yap b/packages/CLPBN/clpbn/ve.yap index a5b0f8dee..b2e8d9ea4 100644 --- a/packages/CLPBN/clpbn/ve.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -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) :- diff --git a/packages/CLPBN/clpbn/viterbi.yap b/packages/CLPBN/clpbn/viterbi.yap index b71befc68..0d496d63b 100644 --- a/packages/CLPBN/clpbn/viterbi.yap +++ b/packages/CLPBN/clpbn/viterbi.yap @@ -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], diff --git a/packages/CLPBN/clpbn/vmap.yap b/packages/CLPBN/clpbn/vmap.yap index db7605646..98e3df357 100644 --- a/packages/CLPBN/clpbn/vmap.yap +++ b/packages/CLPBN/clpbn/vmap.yap @@ -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), diff --git a/packages/CLPBN/learning/aleph_params.yap b/packages/CLPBN/learning/aleph_params.yap index 8162c8bf7..cb6070eb4 100644 --- a/packages/CLPBN/learning/aleph_params.yap +++ b/packages/CLPBN/learning/aleph_params.yap @@ -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), diff --git a/packages/CLPBN/learning/bnt_parms.yap b/packages/CLPBN/learning/bnt_parms.yap index d3e8d9734..55be9d0ce 100644 --- a/packages/CLPBN/learning/bnt_parms.yap +++ b/packages/CLPBN/learning/bnt_parms.yap @@ -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). - - + + diff --git a/packages/CLPBN/learning/em.yap b/packages/CLPBN/learning/em.yap index aa2119f47..0e28d3136 100644 --- a/packages/CLPBN/learning/em.yap +++ b/packages/CLPBN/learning/em.yap @@ -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) :- !, diff --git a/packages/CLPBN/learning/learn_utils.yap b/packages/CLPBN/learning/learn_utils.yap index fee6cf5df..463b9030a 100644 --- a/packages/CLPBN/learning/learn_utils.yap +++ b/packages/CLPBN/learning/learn_utils.yap @@ -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). diff --git a/packages/CLPBN/learning/mle.yap b/packages/CLPBN/learning/mle.yap index ce6cd0132..14080fe69 100644 --- a/packages/CLPBN/learning/mle.yap +++ b/packages/CLPBN/learning/mle.yap @@ -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) :- diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index 7e1194568..fe7fbc359 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -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).