More viterbi fixes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1368 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-08-19 03:38:08 +00:00
parent 5870526dd8
commit cffa76355e
3 changed files with 86 additions and 24 deletions

View File

@ -57,7 +57,7 @@ initialise(LVs, Graph, GVs, OutputVars, VarOrder) :-
graph_representation(LVs, Graph, 0, Keys, TGraph), graph_representation(LVs, Graph, 0, Keys, TGraph),
compile_graph(Graph), compile_graph(Graph),
topsort(TGraph, VarOrder), topsort(TGraph, VarOrder),
show_sorted(VarOrder, Graph), % show_sorted(VarOrder, Graph),
add_output_vars(GVs, Keys, OutputVars). add_output_vars(GVs, Keys, OutputVars).
init_keys(Keys0) :- init_keys(Keys0) :-
@ -468,6 +468,6 @@ do_probs([E|Es],Sum,[P|Ps]) :-
show_sorted([], _) :- nl. show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :- show_sorted([I|VarOrder], Graph) :-
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)), arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
% clpbn:get_atts(V,[key(K)]), clpbn:get_atts(V,[key(K)]),
% format('~w ',[K]), format('~w ',[K]),
show_sorted(VarOrder, Graph). show_sorted(VarOrder, Graph).

View File

@ -2,7 +2,8 @@
clpbn_not_var_member/2, clpbn_not_var_member/2,
clpbn_var_member/2, clpbn_var_member/2,
check_for_hidden_vars/3, 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. % 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, Ks) :- ground(K1), !.
add_to_keys(K1, Ks, [K1|Ks]). 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).

View File

@ -9,7 +9,7 @@
:- use_module(library('clpbn'), []). :- use_module(library('clpbn'), []).
:- use_module(library('clpbn/utils'), [ :- use_module(library('clpbn/utils'), [
sort_vars_by_key/3]). sort_vars_by_key_and_parents/3]).
:- use_module(library('ugraphs'), [ :- use_module(library('ugraphs'), [
vertices_edges_to_ugraph/3, vertices_edges_to_ugraph/3,
@ -20,7 +20,7 @@
viterbi(Start,End,Trace) :- viterbi(Start,End,Trace) :-
attributes:all_attvars(Vars0), attributes:all_attvars(Vars0),
sort_vars_by_key(Vars0,Vars,_), sort_vars_by_key_and_parents(Vars0,Vars,_),
add_emissions(Vars), add_emissions(Vars),
topsort_vars(Vars,SortedVars), topsort_vars(Vars,SortedVars),
init_viterbi(Start), init_viterbi(Start),
@ -34,14 +34,36 @@ add_emissions([Var|Vars]) :-
add_emissions(Vars). add_emissions(Vars).
add_emission(Var) :- add_emission(Var) :-
clpbn:get_atts(Var,[evidence(Ev),dist(Vals,emission(CPT),Parents)]), !, clpbn:get_atts(Var,[key(K),evidence(Ev),dist(Vals,emission(CPT),Parents)]), !,
nth(Nth, Vals, Ev), cvt_vals(Vals,LVals),
find_probs(CPT,Nth,Prob), once(nth(Nth, LVals, Ev)),
find_probs(CPT,K,Nth,Prob),
adde2pars(Parents,Prob). adde2pars(Parents,Prob).
add_emission(_). 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). 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,Nth,Norm).
%get_norm(Norms,_,Norms) :- number(Norms), !. %get_norm(Norms,_,Norms) :- number(Norms), !.
@ -74,25 +96,25 @@ fetch_times([V|Vs], [T-V|TVs]) :-
sort_times([], _, []). sort_times([], _, []).
sort_times([T-V|TVs], Graph0, SortedVars) :- sort_times([T-V|TVs], Graph0, SortedVars) :-
fetch_same_time(TVs, T, Vars, NTVs), 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), top_sort(Graph,SortedVars0,SortedVars),
sort_times(NTVs, Graph0, SortedVars0). 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, T, Vs, TVs0).
fetch_same_time(TVs, _, [], TVs) :- !. fetch_same_time(TVs, _, [], TVs) :- !.
fetch_parents([],Graph,Graph). fetch_parents([],[]).
fetch_parents([V|Vars],Graph0,GraphF) :- fetch_parents([V|Vars],EdgesF) :-
clpbn:get_atts(V,[dist(_,_,Parents)]), clpbn:get_atts(V,[dist(_,_,Parents)]),
exp_edges(Parents,V,Graph0,GraphI), exp_edges(Parents,V,EdgesF,Edges0),
fetch_parents(Vars,GraphI,GraphF). fetch_parents(Vars,Edges0).
exp_edges([],_,Graph,Graph). exp_edges([],_,Edges,Edges).
exp_edges([P|Parents],V,Graph0,GraphF) :- exp_edges([P|Parents],V,[V-P|Edges],Edges0) :-
add_edges(Graph0,[V-P],GraphI), exp_edges(Parents,V,Edges,Edges0).
exp_edges(Parents,V,GraphI,GraphF).
extract_vars([],[]). extract_vars([],[]).
extract_vars([_-V|KVars],[V|Vars]) :- extract_vars([_-V|KVars],[V|Vars]) :-
@ -105,6 +127,7 @@ viterbi_alg([]).
viterbi_alg([V|Vs]) :- viterbi_alg([V|Vs]) :-
% get the current status % get the current status
get_atts(V,[prob(P0)]), !, get_atts(V,[prob(P0)]), !,
% clpbn:get_atts(V,[key(K)]),format('doing(~w)~n',[K]),
clpbn:get_atts(V,[dist(_,trans(Probs),States)]), clpbn:get_atts(V,[dist(_,trans(Probs),States)]),
% adjust to consider emission probabilities % adjust to consider emission probabilities
adjust_for_emission(V, P0, Pf), adjust_for_emission(V, P0, Pf),
@ -120,7 +143,9 @@ adjust_for_emission(V, P0, Pf) :-
adjust_for_emission(_, P, P). adjust_for_emission(_, P, P).
propagate([],[],_,_). 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)]), !, get_atts(State,[prob(P0)]), !,
mprob(Pf,Prob,P), mprob(Pf,Prob,P),
(P > P0 -> (P > P0 ->
@ -128,10 +153,12 @@ propagate([log(Prob,_)|Probs],[State|States],Pf,V) :-
; ;
true true
), ),
% clpbn:get_atts(State,[key(K)]),format(' ~w: ~w -> ~w~n',[K,P0,P]),
propagate(Probs,States,Pf,V). propagate(Probs,States,Pf,V).
propagate([log(Prob,_)|Probs],[State|States],Pf,V) :- propagate([Prob|Probs],[State|States],Pf,V) :-
mprob(Pf,Prob,P), mprob(Pf,Prob,P),
put_atts(State,[prob(P),backp(V)]), put_atts(State,[prob(P),backp(V)]),
% clpbn:get_atts(State,[key(K)]),format(' ~w: ~w!!~n',[K,P]),
propagate(Probs,States,Pf,V). propagate(Probs,States,Pf,V).
backtrace(Start,Var,Trace,Trace) :- Start == Var, !. backtrace(Start,Var,Trace,Trace) :- Start == Var, !.
@ -142,8 +169,8 @@ backtrace(Start,Var,Trace0,Trace) :-
mprob(*,P,P) :- !. mprob(*,_,-inf) :- !.
mprob(P,*,P) :- !. mprob(_,*,-inf) :- !.
mprob(P1,P2,P) :- P is P1+P2. mprob(P1,P2,P) :- P is P1+P2.