More viterbi fixes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1368 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

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)]),
+	clpbn:get_atts(V,[key(K)]),
-%	format('~w ',[K]),
+	format('~w ',[K]),
 	show_sorted(VarOrder, Graph).

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).
+
+

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)]), !,
+	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).
 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([],[]).
-fetch_parents([V|Vars],Graph0,GraphF) :-
+fetch_parents([V|Vars],EdgesF) :-
 	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([_-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(*,_,-inf) :- !.
-mprob(P,*,P) :- !.
+mprob(_,*,-inf) :- !.
 mprob(P1,P2,P) :- P is P1+P2.