From d86f30a2eb8506b4f071c77b2560b22a5e10fb87 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 13 Feb 2008 11:57:46 +0000 Subject: [PATCH] CLP(BN) fixes git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2096 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- CLPBN/clpbn/bnt.yap | 4 +-- CLPBN/clpbn/discrete_utils.yap | 2 +- CLPBN/clpbn/dists.yap | 16 ++++++------ CLPBN/clpbn/gibbs.yap | 45 +++++++++++++++++++++++++++++--- CLPBN/clpbn/graphs.yap | 2 +- CLPBN/clpbn/jt.yap | 6 ++--- CLPBN/clpbn/matrix_cpt_utils.yap | 2 +- CLPBN/clpbn/vel.yap | 2 +- 8 files changed, 58 insertions(+), 21 deletions(-) diff --git a/CLPBN/clpbn/bnt.yap b/CLPBN/clpbn/bnt.yap index fc0b19d0e..f35441904 100644 --- a/CLPBN/clpbn/bnt.yap +++ b/CLPBN/clpbn/bnt.yap @@ -374,8 +374,8 @@ add_evidence(Graph, Size, Is) :- [engine, loglik] <-- enter_evidence(engine, evidence). mk_evidence([], [], []). -mk_evidence([V|L], [I|Is], [ar(1,I,Val)|LN]) :- - clpbn:get_atts(V, [evidence(EvVal),dist(Id,_)]), !, +mk_evidence([V|L], [I|Is], [ar(1,I,EvVal)|LN]) :- + clpbn:get_atts(V, [evidence(EvVal)]), !, mk_evidence(L, Is, LN). mk_evidence([_|L], [_|Is], LN) :- mk_evidence(L, Is, LN). diff --git a/CLPBN/clpbn/discrete_utils.yap b/CLPBN/clpbn/discrete_utils.yap index 8ef31803c..35d15e0e5 100644 --- a/CLPBN/clpbn/discrete_utils.yap +++ b/CLPBN/clpbn/discrete_utils.yap @@ -34,7 +34,7 @@ generate_szs_with_evidence([_|Out],Ev,Ev,[ok|Evs],found) :- !, generate_szs_with_evidence(Out,Ev,I,Evs,found). generate_szs_with_evidence([_|Out],Ev,I0,[not_ok|Evs],Found) :- I is I0+1, - generate_szs_with_evidence(Out,Ev,I0,Evs,Found). + generate_szs_with_evidence(Out,Ev,I,Evs,Found). find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :- V == V1, !, diff --git a/CLPBN/clpbn/dists.yap b/CLPBN/clpbn/dists.yap index 0a7fb8b37..9cb0e6053 100644 --- a/CLPBN/clpbn/dists.yap +++ b/CLPBN/clpbn/dists.yap @@ -180,20 +180,20 @@ get_dist_nparams(Id, NParms) :- get_evidence_position(El, Id, Pos) :- recorded(clpbn_dist_db, db(Id, _, _, Domain, _, _), _), - nth0(Pos, El, Domain), !. + nth0(Pos, Domain, El), !. get_evidence_position(El, Id, Pos) :- - recorded(clpbn_dist_db, db(Id, _, _, Domain, _, _), _), !, - throw(error(domain_error(evidence,Id),add_evidence(Ev,Domain))). + recorded(clpbn_dist_db, db(Id, _, _, _, _, _), _), !, + throw(error(domain_error(evidence,Id),get_evidence_position(El, Id, Pos))). get_evidence_position(El, Id, Pos) :- - throw(error(domain_error(no_distribution,Id),add_evidence(Ev,Domain))). + throw(error(domain_error(no_distribution,Id),get_evidence_position(El, Id, Pos))). get_evidence_from_position(El, Id, Pos) :- recorded(clpbn_dist_db, db(Id, _, _, Domain, _, _), _), - nth0(Pos, El, Domain), !. + nth0(Pos, Domain, El), !. get_evidence_from_position(El, Id, Pos) :- - recorded(clpbn_dist_db, db(Id, _, _, Domain, _, _), _), !, - throw(error(domain_error(evidence,Id),add_evidence(Ev,Domain))). + recorded(clpbn_dist_db, db(Id, _, _, _, _, _), _), !, + throw(error(domain_error(evidence,Id),get_evidence_from_position(El, Id, Pos))). get_evidence_from_position(El, Id, Pos) :- - throw(error(domain_error(no_distribution,Id),add_evidence(Ev,Domain))). + throw(error(domain_error(no_distribution,Id),get_evidence_from_position(El, Id, Pos))). dist_to_term(_Id,_Term). diff --git a/CLPBN/clpbn/gibbs.yap b/CLPBN/clpbn/gibbs.yap index 7f50c8a3b..22018a280 100644 --- a/CLPBN/clpbn/gibbs.yap +++ b/CLPBN/clpbn/gibbs.yap @@ -19,7 +19,8 @@ [member/2, append/3, delete/3, - max_list/2]). + max_list/2, + sum_list/2]). :- use_module(library(ordsets), [ord_subtract/3]). @@ -38,12 +39,16 @@ :- use_module(library('clpbn/topsort'), [ topsort/2]). +:- use_module(library('clpbn/display'), [ + clpbn_bind_vals/3]). + :- dynamic gibbs_params/3. :- dynamic implicit/1. gibbs([],_,_) :- !. -gibbs(LVs,Vs0,_) :- +gibbs(LVs,Vs0,AllDiffs) :- + LVs = [_], !, clean_up, check_for_hidden_vars(Vs0, Vs0, Vs1), sort(Vs1,Vs), @@ -52,8 +57,12 @@ gibbs(LVs,Vs0,_) :- initialise(Vs, Graph, LVs, OutputVars, VarOrder), % write(Graph),nl, process(VarOrder, Graph, OutputVars, Estimates), - write(Estimates),nl, + sum_up(Estimates, [LPs]), +% write(Estimates),nl, + clpbn_bind_vals(LVs,LPs,AllDiffs), clean_up. +gibbs(LVs,_,_) :- + throw(error(domain_error(solver,LVs),solver(gibbs))). initialise(LVs, Graph, GVs, OutputVars, VarOrder) :- init_keys(Keys0), @@ -386,7 +395,7 @@ gen_e0(Sz,[0|E0L]) :- process_chains(0,_,F,F,_,_,Est,Est) :- !. process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :- process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti), -(ToDo mod 100 =:= 0 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true), +% (ToDo mod 100 =:= 0 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true), ToDo1 is ToDo-1, process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf). @@ -496,3 +505,31 @@ show_sorted([I|VarOrder], Graph) :- clpbn:get_atts(V,[key(K)]), format('~w ',[K]), show_sorted(VarOrder, Graph). + +sum_up([[]|_], []). +sum_up([[[Id|Counts]|More]|Chains], [Dist|Dists]) :- + add_up(Counts,Chains, Id, Add,RChains), + normalise(Add, Dist), + sum_up([More|RChains], Dists). + +add_up(Counts,[],_,Counts,[]). +add_up(Counts,[[[Id|Cs]|MoreVars]|Chains],Id, Add, [MoreVars|RChains]) :- + sum_lists(Counts, Cs, NCounts), + add_up(NCounts, Chains, Id, Add, RChains). + +sum_lists([],[],[]). +sum_lists([Count|Counts], [C|Cs], [NC|NCounts]) :- + NC is Count+C, + sum_lists(Counts, Cs, NCounts). + +normalise(Add, Dist) :- + sum_list(Add, Sum), + divide_list(Add, Sum, Dist). + +divide_list([], _, []). +divide_list([C|Add], Sum, [P|Dist]) :- + P is C/Sum, + divide_list(Add, Sum, Dist). + + + diff --git a/CLPBN/clpbn/graphs.yap b/CLPBN/clpbn/graphs.yap index e853f9be5..e481161fb 100644 --- a/CLPBN/clpbn/graphs.yap +++ b/CLPBN/clpbn/graphs.yap @@ -30,7 +30,7 @@ attribute_goal(V, node(K,Dom,CPT,TVs,Ev)) :- clpbn:get_atts(V, [key(K),dist(Id,Vs)]), get_dist(Id,_,Dom,CPT), translate_vars(Vs,TVs), - ( clpbn:get_atts(V, [evidence(_)]) -> true ; true). + ( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true). translate_vars([],[]). translate_vars([V|Vs],[K|Ks]) :- diff --git a/CLPBN/clpbn/jt.yap b/CLPBN/clpbn/jt.yap index 6b1bd89fb..a3de32781 100644 --- a/CLPBN/clpbn/jt.yap +++ b/CLPBN/clpbn/jt.yap @@ -93,14 +93,14 @@ get_graph(LVs, BayesNet, CPTs, Evidence) :- run_vars([], [], [], [], []). run_vars([V|LVs], Edges, [V|Vs], [CPTVars-dist([V|Parents],Id)|CPTs], Ev) :- clpbn:get_atts(V, [dist(Id,Parents)]), - add_evidence(V, Id, Ev, Ev0), + add_evidence_from_vars(V, Ev, Ev0), sort([V|Parents],CPTVars), add_edges(Parents, V, Edges, Edges0), run_vars(LVs, Edges0, Vs, CPTs, Ev0). -add_evidence(V, Id, [e(V,P)|Evs], Evs) :- +add_evidence_from_vars(V, [e(V,P)|Evs], Evs) :- clpbn:get_atts(V, [evidence(P)]), !. -add_evidence(_, _, Evs, Evs). +add_evidence_from_vars(_, Evs, Evs). find_nth0([Id|_], Id, P, P) :- !. find_nth0([_|D], Id, P0, P) :- diff --git a/CLPBN/clpbn/matrix_cpt_utils.yap b/CLPBN/clpbn/matrix_cpt_utils.yap index 9d1f72471..2bc5a3599 100644 --- a/CLPBN/clpbn/matrix_cpt_utils.yap +++ b/CLPBN/clpbn/matrix_cpt_utils.yap @@ -49,7 +49,7 @@ project_from_CPT(V,tab(Table,Deps,_),tab(NewTable,NDeps,NSzs)) :- matrix_dims(NewTable, NSzs). evidence(V, Pos) :- - clpbn:get_atts(V, [evidence(Pos),dist(Id,_)]). + clpbn:get_atts(V, [evidence(Pos)]). vnth([V1|Deps], N, V, N, Deps) :- V == V1, !. diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index cd069c4df..e8182c79d 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -81,7 +81,7 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Size var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :- clpbn:get_atts(V, [dist(Id,Parents)]), get_dist_matrix(Id,Parents,_,Vals,TAB0), - ( clpbn:get_atts(V, [evidence(_)]) -> true ; true), + ( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true), reorder_CPT([V|Parents],TAB0,Deps0,TAB1,Sizes1), simplify_evidence(Deps0, TAB1, Deps0, Sizes1, Table, Deps, Sizes).