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
parent
5870526dd8
commit
cffa76355e
|
|
@ -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).
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue