From f0aee4d1648aa815cba2f28fa0f45eba7d0884b9 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 9 Sep 2005 17:22:59 +0000 Subject: [PATCH] improvements on HMMs git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1390 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- CLPBN/Makefile.in | 1 + CLPBN/clpbn.yap | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/CLPBN/Makefile.in b/CLPBN/Makefile.in index 47cd70631..3e9bdb65a 100644 --- a/CLPBN/Makefile.in +++ b/CLPBN/Makefile.in @@ -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 \ diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 2a3459993..6845632f3 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -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),