diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improvements on HMMs 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1390 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-09-09 17:22:59 +00:00
parent de3bd15889
commit f0aee4d164
2 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CLPBN/Makefile.in
View File

@ -33,6 +33,7 @@ CLPBN_PROGRAMS= \
$(srcdir)/clpbn/gibbs.yap \
$(srcdir)/clpbn/graphs.yap \
$(srcdir)/clpbn/graphviz.yap \
$(srcdir)/clpbn/hmm.yap \
$(srcdir)/clpbn/topsort.yap \
$(srcdir)/clpbn/utils.yap \
$(srcdir)/clpbn/vel.yap \

14
CLPBN/clpbn.yap
View File

@ -76,9 +76,20 @@ clpbn_flag(solver,Before,After) :-
extract_dist(V, Tab.Inps, Domain) :- var(V), !,
V = p(Domain, Tab, Inps).
extract_dist(p(Domain, trans(L), Parents), Tab, Inps, Domain) :- !,
compress_hmm_table(L, Parents, Tab, Inps).
extract_dist(p(Domain, Tab, Inps), Tab, Inps, Domain).
extract_dist(p(Domain, Tab), Tab, [], Domain).
compress_hmm_table(L, Parents, trans(Tab), Inps) :-
get_rid_of_nuls(L,Parents,Tab,Inps).
get_rid_of_nuls([], [], [], []).
get_rid_of_nuls([*|L],[_|Parents],NL,NParents) :- !,
get_rid_of_nuls(L,Parents,NL,NParents).
get_rid_of_nuls([Prob|L],[P|Parents],[Prob|NL],[P|NParents]) :-
get_rid_of_nuls(L,Parents,NL,NParents).
check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
check_constraint((A->D), _, _, (A->D)) :- var(A), !.
check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !,
@ -105,6 +116,7 @@ add_evidence(V,V).
% or by call_residue/2
%
project_attributes(GVars, AVars) :-
GVars = [_|_],
AVars = [_|_], !,
sort_vars_by_key(AVars,SortedAVars,DiffVars),
get_clpbn_vars(GVars,CLPBNGVars),