diff --git a/CLPBN/clpbn/gibbs.yap b/CLPBN/clpbn/gibbs.yap index d4ae61d04..159b336de 100644 --- a/CLPBN/clpbn/gibbs.yap +++ b/CLPBN/clpbn/gibbs.yap @@ -57,7 +57,7 @@ initialise(LVs, Graph, GVs, OutputVars, VarOrder) :- graph_representation(LVs, Graph, 0, Keys, TGraph), compile_graph(Graph), topsort(TGraph, VarOrder), - show_sorted(VarOrder, Graph), +% show_sorted(VarOrder, Graph), add_output_vars(GVs, Keys, OutputVars). init_keys(Keys0) :- @@ -468,6 +468,6 @@ do_probs([E|Es],Sum,[P|Ps]) :- show_sorted([], _) :- nl. show_sorted([I|VarOrder], Graph) :- arg(I,Graph,var(V,I,_,_,_,_,_,_,_)), -% clpbn:get_atts(V,[key(K)]), -% format('~w ',[K]), + clpbn:get_atts(V,[key(K)]), + format('~w ',[K]), show_sorted(VarOrder, Graph). diff --git a/CLPBN/clpbn/utils.yap b/CLPBN/clpbn/utils.yap index a35e01187..d0f942233 100644 --- a/CLPBN/clpbn/utils.yap +++ b/CLPBN/clpbn/utils.yap @@ -2,7 +2,8 @@ clpbn_not_var_member/2, clpbn_var_member/2, check_for_hidden_vars/3, - sort_vars_by_key/3]). + sort_vars_by_key/3, + sort_vars_by_key_and_parents/3]). % % It may happen that variables from a previous query may still be around. @@ -67,3 +68,37 @@ in_keys(K1,[_|Ks]) :- add_to_keys(K1, Ks, Ks) :- ground(K1), !. add_to_keys(K1, Ks, [K1|Ks]). +sort_vars_by_key_and_parents(AVars, SortedAVars, UnifiableVars) :- + get_keys_and_parents(AVars, KeysVars), + keysort(KeysVars, KVars), + merge_same_key(KVars, SortedAVars, [], UnifiableVars). + +get_keys_and_parents([], []). +get_keys_and_parents([V|AVars], [K-V|KeysVarsF]) :- + clpbn:get_atts(V, [key(K),dist(D,T,Parents)]), !, + add_parents(Parents,V,D,T,KeysVarsF,KeysVars0), + get_keys_and_parents(AVars, KeysVars0). +get_keys_and_parents([_|AVars], KeysVars) :- % may be non-CLPBN vars. + get_keys_and_parents(AVars, KeysVars). + +add_parents(Parents,_,_,_,KeyVars,KeyVars) :- + all_vars(Parents), !. +add_parents(Parents,V,D,T,KeyVarsF,KeyVars0) :- + transform_parents(Parents,NParents,KeyVarsF,KeyVars0), + clpbn:put_atts(V, [dist(D,T,NParents)]). + + +all_vars([]). +all_vars([P|Parents]) :- + var(P), + all_vars(Parents). + + +transform_parents([],[],KeyVars,KeyVars). +transform_parents([P|Parents0],[P|NParents],KeyVarsF,KeyVars0) :- + var(P), !, + transform_parents(Parents0,NParents,KeyVarsF,KeyVars0). +transform_parents([P|Parents0],[V|NParents],[P-V|KeyVarsF],KeyVars0) :- + transform_parents(Parents0,NParents,KeyVarsF,KeyVars0). + + diff --git a/CLPBN/clpbn/viterbi.yap b/CLPBN/clpbn/viterbi.yap index dc838a419..d8b45c304 100644 --- a/CLPBN/clpbn/viterbi.yap +++ b/CLPBN/clpbn/viterbi.yap @@ -9,7 +9,7 @@ :- use_module(library('clpbn'), []). :- use_module(library('clpbn/utils'), [ - sort_vars_by_key/3]). + sort_vars_by_key_and_parents/3]). :- use_module(library('ugraphs'), [ vertices_edges_to_ugraph/3, @@ -20,7 +20,7 @@ viterbi(Start,End,Trace) :- attributes:all_attvars(Vars0), - sort_vars_by_key(Vars0,Vars,_), + sort_vars_by_key_and_parents(Vars0,Vars,_), add_emissions(Vars), topsort_vars(Vars,SortedVars), init_viterbi(Start), @@ -34,14 +34,36 @@ add_emissions([Var|Vars]) :- add_emissions(Vars). add_emission(Var) :- - clpbn:get_atts(Var,[evidence(Ev),dist(Vals,emission(CPT),Parents)]), !, - nth(Nth, Vals, Ev), - find_probs(CPT,Nth,Prob), + clpbn:get_atts(Var,[key(K),evidence(Ev),dist(Vals,emission(CPT),Parents)]), !, + cvt_vals(Vals,LVals), + once(nth(Nth, LVals, Ev)), + find_probs(CPT,K,Nth,Prob), adde2pars(Parents,Prob). add_emission(_). -find_probs(log(Logs,_Norms),Nth,Log) :- +% +% well known domains +% +cvt_vals(aminoacids,[a, c, d, e, f, g, h, i, k, l, m, n, p, q, r, s, t, v, w, y]). +cvt_vals(bool,[t,f]). +cvt_vals(bases,[a,c,g,t]). +cvt_vals([A|B],[A|B]). + + +% first, try standard representation +find_probs(Logs,_,Nth,Log) :- + compound(Logs), + arg(Nth,Logs,Log), !. +% key independent, compacted +find_probs(A,_,Nth,Log) :- atom(A), !, + user:compacted_cpt(A,Logs), arg(Nth,Logs,Log). +% key dependent, compacted +find_probs(I,K,Nth,Log) :- integer(I), !, + functor(K,A,_), + user:compacted_cpt(A,I,Logs), + arg(Nth,Logs,Log). +% now, try hacked representation % get_norm(Norms,Nth,Norm). %get_norm(Norms,_,Norms) :- number(Norms), !. @@ -74,25 +96,25 @@ fetch_times([V|Vs], [T-V|TVs]) :- sort_times([], _, []). sort_times([T-V|TVs], Graph0, SortedVars) :- fetch_same_time(TVs, T, Vars, NTVs), - fetch_parents([V|Vars],Graph0,Graph), + fetch_parents([V|Vars],Edges), + add_edges(Graph0, Edges, Graph), top_sort(Graph,SortedVars0,SortedVars), sort_times(NTVs, Graph0, SortedVars0). -fetch_same_time([T-V|TVs], T, [V|Vs], TVs0) :- +fetch_same_time([T-V|TVs], T, [V|Vs], TVs0) :- !, fetch_same_time(TVs, T, Vs, TVs0). fetch_same_time(TVs, _, [], TVs) :- !. -fetch_parents([],Graph,Graph). -fetch_parents([V|Vars],Graph0,GraphF) :- +fetch_parents([],[]). +fetch_parents([V|Vars],EdgesF) :- clpbn:get_atts(V,[dist(_,_,Parents)]), - exp_edges(Parents,V,Graph0,GraphI), - fetch_parents(Vars,GraphI,GraphF). + exp_edges(Parents,V,EdgesF,Edges0), + fetch_parents(Vars,Edges0). -exp_edges([],_,Graph,Graph). -exp_edges([P|Parents],V,Graph0,GraphF) :- - add_edges(Graph0,[V-P],GraphI), - exp_edges(Parents,V,GraphI,GraphF). +exp_edges([],_,Edges,Edges). +exp_edges([P|Parents],V,[V-P|Edges],Edges0) :- + exp_edges(Parents,V,Edges,Edges0). extract_vars([],[]). extract_vars([_-V|KVars],[V|Vars]) :- @@ -105,6 +127,7 @@ viterbi_alg([]). viterbi_alg([V|Vs]) :- % get the current status get_atts(V,[prob(P0)]), !, +% clpbn:get_atts(V,[key(K)]),format('doing(~w)~n',[K]), clpbn:get_atts(V,[dist(_,trans(Probs),States)]), % adjust to consider emission probabilities adjust_for_emission(V, P0, Pf), @@ -120,7 +143,9 @@ adjust_for_emission(V, P0, Pf) :- adjust_for_emission(_, P, P). propagate([],[],_,_). -propagate([log(Prob,_)|Probs],[State|States],Pf,V) :- +propagate([-inf|Probs],[_|States],Pf,V) :- !, + propagate(Probs,States,Pf,V). +propagate([Prob|Probs],[State|States],Pf,V) :- get_atts(State,[prob(P0)]), !, mprob(Pf,Prob,P), (P > P0 -> @@ -128,10 +153,12 @@ propagate([log(Prob,_)|Probs],[State|States],Pf,V) :- ; true ), +% clpbn:get_atts(State,[key(K)]),format(' ~w: ~w -> ~w~n',[K,P0,P]), propagate(Probs,States,Pf,V). -propagate([log(Prob,_)|Probs],[State|States],Pf,V) :- +propagate([Prob|Probs],[State|States],Pf,V) :- mprob(Pf,Prob,P), put_atts(State,[prob(P),backp(V)]), +% clpbn:get_atts(State,[key(K)]),format(' ~w: ~w!!~n',[K,P]), propagate(Probs,States,Pf,V). backtrace(Start,Var,Trace,Trace) :- Start == Var, !. @@ -142,8 +169,8 @@ backtrace(Start,Var,Trace0,Trace) :- -mprob(*,P,P) :- !. -mprob(P,*,P) :- !. +mprob(*,_,-inf) :- !. +mprob(_,*,-inf) :- !. mprob(P1,P2,P) :- P is P1+P2.