From dc0c04d9d2c10f69995799b26c0ecc2cdeb3dc66 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 13 Jul 2007 00:52:54 +0000 Subject: [PATCH] encapsulate access to distribution, so that they are not stored in the constraint itself. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1916 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- CLPBN/Makefile.in | 1 + CLPBN/clpbn.yap | 50 +++++------ CLPBN/clpbn/aggregates.yap | 10 ++- CLPBN/clpbn/bnt.yap | 19 ++-- CLPBN/clpbn/discrete_utils.yap | 11 +-- CLPBN/clpbn/display.yap | 5 +- CLPBN/clpbn/dists.yap | 159 +++++++++++++++++++++++++++++++++ CLPBN/clpbn/evidence.yap | 2 - CLPBN/clpbn/gibbs.yap | 14 ++- CLPBN/clpbn/graphs.yap | 6 +- CLPBN/clpbn/graphviz.yap | 2 +- CLPBN/clpbn/hmm.yap | 3 +- CLPBN/clpbn/utils.yap | 12 +-- CLPBN/clpbn/vel.yap | 13 ++- CLPBN/clpbn/viterbi.yap | 17 ++-- CLPBN/clpbn/xbif.yap | 6 +- 16 files changed, 259 insertions(+), 71 deletions(-) create mode 100644 CLPBN/clpbn/dists.yap diff --git a/CLPBN/Makefile.in b/CLPBN/Makefile.in index 6fb6a08ed..7984459a0 100644 --- a/CLPBN/Makefile.in +++ b/CLPBN/Makefile.in @@ -34,6 +34,7 @@ CLPBN_PROGRAMS= \ $(CLPBN_SRCDIR)/bnt.yap \ $(CLPBN_SRCDIR)/discrete_utils.yap \ $(CLPBN_SRCDIR)/display.yap \ + $(CLPBN_SRCDIR)/dists.yap \ $(CLPBN_SRCDIR)/evidence.yap \ $(CLPBN_SRCDIR)/gibbs.yap \ $(CLPBN_SRCDIR)/graphs.yap \ diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 3999d95c4..ff9206ce6 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -22,7 +22,7 @@ :- dynamic user:term_expansion/2. -:- attribute key/1, dist/3, evidence/1, starter/0. +:- attribute key/1, dist/2, evidence/1, starter/0. :- use_module('clpbn/vel', [vel/3, @@ -41,6 +41,11 @@ clpbn2graph/1 ]). +:- use_module('clpbn/dists', [ + dist/3, + get_dist/4 + ]). + :- use_module('clpbn/evidence', [ store_evidence/1, incorporate_evidence/2 @@ -78,26 +83,10 @@ clpbn_flag(bnt_path,Before,After) :- assert(bnt:bnt_path(After)). {Var = Key with Dist} :- - put_atts(El,[key(Key),dist(Domain,Table,Parents)]), - extract_dist(Dist, Table, Parents, Domain), + put_atts(El,[key(Key),dist(DistInfo,Parents)]), + dist(Dist, DistInfo, Parents), add_evidence(Var,El). -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)) :- !, @@ -155,8 +144,9 @@ write_out(graphs, _, AVars, _) :- clpbn2graph(AVars). get_bnode(Var, Goal) :- - get_atts(Var, [key(Key),dist(A,B,C)]), - (C = [] -> X = tab(A,B) ; X = tab(A,B,C)), + get_atts(Var, [key(Key),dist(Dist,Parents)]), + get_dist(Dist,_,Domain,CPT), + (Parents = [] -> X = tab(Domain,CPT) ; X = tab(Domain,CPT,Parents)), dist_goal(X, Key, Goal0), include_evidence(Var, Goal0, Key, Goali), include_starter(Var, Goali, Key, Goal). @@ -204,16 +194,16 @@ process_var(V, _) :- throw(error(instantiation_error,clpbn(attribute_goal(V)))). % unify a CLPBN variable with something. % verify_attributes(Var, T, Goals) :- - get_atts(Var, [key(Key),dist(Domain,Table,Parents)]), !, + get_atts(Var, [key(Key),dist(Dist,Parents)]), !, /* oops, someone trying to bind a clpbn constrained variable */ Goals = [], - bind_clpbn(T, Var, Key, Domain, Table, Parents). + bind_clpbn(T, Var, Key, Dist, Parents). verify_attributes(_, _, []). -bind_clpbn(T, Var, Key, Domain, Table, Parents) :- var(T), - get_atts(T, [key(Key1),dist(Doman1,Table1,Parents1)]), !, - bind_clpbns(Key, Domain, Table, Parents, Key1, Doman1, Table1, Parents1), +bind_clpbn(T, Var, Key, Dist, Parents) :- var(T), + get_atts(T, [key(Key1),dist(Dist1,Parents1)]), !, + bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1), ( get_atts(T, [evidence(Ev1)]) -> bind_evidence_from_extra_var(Ev1,Var) @@ -241,10 +231,12 @@ fresh_attvar(Var, NVar) :- put_atts(NVar, LAtts). % I will now allow two CLPBN variables to be bound together. -%bind_clpbns(Key, Domain, Table, Parents, Key, Domain, Table, Parents). -bind_clpbns(Key, Domain, Table, Parents, Key1, Domain1, Table1, Parents1) :- +%bind_clpbns(Key, Dist, Parents, Key, Dist, Parents). +bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) :- Key == Key1, !, - ( Domain == Domain1, Table == Table1, Parents == Parents1 -> true ; throw(error(domain_error(bayesian_domain),bind_clpbns(var(Key, Domain, Table, Parents),var(Key1, Domain1, Table1, Parents1))))). + get_dist(Dist,Type,Domain,Table), + get_dist(Dist1,Type1,Domain1,Table1), + ( Dist == Dist1, Parents == Parents1 -> true ; throw(error(domain_error(bayesian_domain),bind_clpbns(var(Key, Type, Domain, Table, Parents),var(Key1, Type1, Domain1, Table1, Parents1))))). bind_clpbns(Key, _, _, _, Key1, _, _, _) :- Key\=Key1, !, fail. bind_clpbns(_, _, _, _, _, _, _, _) :- diff --git a/CLPBN/clpbn/aggregates.yap b/CLPBN/clpbn/aggregates.yap index f48a0b064..45546e919 100644 --- a/CLPBN/clpbn/aggregates.yap +++ b/CLPBN/clpbn/aggregates.yap @@ -10,6 +10,8 @@ :- use_module(library(lists), [last/2]). +:- use_module(dists, [get_dist_domain_size/2]). + cpt_average(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), @@ -162,7 +164,7 @@ generate_indices([_|Ls],[I|Inds],I,Av) :- combine_all([], [[]]). combine_all([V|LV], Cs) :- combine_all(LV, Cs0), - get_dist_size(V,Sz), + get_vdist_size(V,Sz), generate_indices(0, Sz, Vals), add_vals(Vals, Cs0, Cs). @@ -291,7 +293,7 @@ sm([V|_], V, _) :- !. sm([_|Vs], C, El) :- sm(Vs, C, El). -get_dist_size(V, Sz) :- - clpbn:get_atts(V, [dist(Vals,_,_)]), - length(Vals, Sz). +get_vdist_size(V, Sz) :- + clpbn:get_atts(V, [dist(Dist,_)]), + get_dist_domain_size(Dist, Sz), diff --git a/CLPBN/clpbn/bnt.yap b/CLPBN/clpbn/bnt.yap index f53f8ea42..d67a31ce5 100644 --- a/CLPBN/clpbn/bnt.yap +++ b/CLPBN/clpbn/bnt.yap @@ -5,6 +5,11 @@ :- use_module(library('clpbn/display'), [ clpbn_bind_vals/3]). +:- use_module(library('clpbn/dists'), [ + get_dist_domain_size/2, + get_dist_domain/2, + get_dist_params/2]). + :- use_module(library(matlab), [start_matlab/1, close_matlab/0, matlab_on/0, @@ -100,7 +105,7 @@ extract_graph(AllVars, Graph) :- get_edges([],[]). get_edges([V|AllVars],Edges) :- - clpbn:get_atts(V, [dist(_,_,Parents)]), + clpbn:get_atts(V, [dist(_,Parents)]), add_parent_child(Parents,V,Edges,Edges0), get_edges(AllVars,Edges0). @@ -127,7 +132,7 @@ build_dag(SortedVertices, Size) :- get_numbered_edges([], []). get_numbered_edges([V|SortedVertices], Edges) :- - clpbn:get_atts(V, [dist(_,_,Ps)]), + clpbn:get_atts(V, [dist(_,Ps)]), v2number(V,N), add_numbered_edges(Ps, N, Edges, Edges0), get_numbered_edges(SortedVertices, Edges0). @@ -166,13 +171,14 @@ mksizes(SortedVertices, Size) :- get_szs([],[]). get_szs([V|SortedVertices],[LD|Sizes]) :- - clpbn:get_atts(V, [dist(Dom,_,_)]), - length(Dom,LD), + clpbn:get_atts(V, [dist(Id,_)]), + get_dist_domain_size(Id,LD), get_szs(SortedVertices,Sizes). dump_cpts([], []). dump_cpts([V|SortedGraph], [I|Is]) :- - clpbn:get_atts(V, [dist(_,CPT,_)]), + clpbn:get_atts(V, [dist(Id,_)]), + get_dist_params(Id,CPT), mkcpt(bnet,I,CPT), dump_cpts(SortedGraph, Is). @@ -207,7 +213,8 @@ add_evidence(Graph, Size, Is) :- mk_evidence([], [], []). mk_evidence([V|L], [I|Is], [ar(1,I,Val)|LN]) :- - clpbn:get_atts(V, [evidence(Ev),dist(Domain,_,_)]), !, + clpbn:get_atts(V, [evidence(Ev),dist(Id,_)]), !, + get_dist_domain(Id, Domain), evidence_val(Ev,1,Domain,Val), mk_evidence(L, Is, LN). mk_evidence([_|L], [_|Is], LN) :- diff --git a/CLPBN/clpbn/discrete_utils.yap b/CLPBN/clpbn/discrete_utils.yap index 9557cf523..d3a3f2a19 100644 --- a/CLPBN/clpbn/discrete_utils.yap +++ b/CLPBN/clpbn/discrete_utils.yap @@ -3,6 +3,8 @@ reorder_CPT/5, get_dist_size/2]). +:- use_module(dists, [get_dist_domain_size/2, + get_dist_domain/2]). % % remove columns from a table % @@ -15,7 +17,8 @@ project_from_CPT(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs)) :- NewTable =.. [t|NTabl]. propagate_evidence(V, Evs) :- - clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !, + clpbn:get_atts(V, [evidence(Ev),dist(Id,_)]), !, + get_dist_domain(Id, Out), generate_szs_with_evidence(Out,Ev,Evs,Found), (var(Found) -> clpbn:get_atts(V, [key(K)]), @@ -135,10 +138,8 @@ convert_factor([F0|F0s], [F|Fs], I, OUT) :- get_sizes([], []). get_sizes([V|Deps], [Sz|Sizes]) :- - get_dist_size(V,Sz), + clpbn:get_atts(V, [dist(Id,_)]), + get_dist_domain_size(Id,Sz), get_sizes(Deps, Sizes). -get_dist_size(V,Sz) :- - clpbn:get_atts(V, [dist(Vals,_,_)]), - length(Vals,Sz). diff --git a/CLPBN/clpbn/display.yap b/CLPBN/clpbn/display.yap index b04e025bc..921c3e13d 100644 --- a/CLPBN/clpbn/display.yap +++ b/CLPBN/clpbn/display.yap @@ -6,6 +6,8 @@ member/2 ]). +:- use_module(dists, [get_dist_domain/2]). + :- attribute posterior/4. @@ -52,7 +54,8 @@ get_all_combs(Vs, Vals) :- get_all_doms([], []). get_all_doms([V|Vs], [D|Ds]) :- - clpbn:get_atts(V, [dist(D,_,_)]), + clpbn:get_atts(V, [dist(Id,_)]), + get_dist_domain(Id,D), get_all_doms(Vs, Ds). ms([], []). diff --git a/CLPBN/clpbn/dists.yap b/CLPBN/clpbn/dists.yap new file mode 100644 index 000000000..6ca5e7d7f --- /dev/null +++ b/CLPBN/clpbn/dists.yap @@ -0,0 +1,159 @@ +% +% distribution +% + +:- module(clpbn_dist,[ + dist/1, + dist/3, + get_dist/4, + get_dist_domain/2, + get_dist_params/2, + get_dist_domain_size/2, + get_dist_tparams/2, + dist_to_term/2 + ]). + +:- use_module(library(lists),[is_list/1]). + + +/* +:- mode dist(+, -). + +:- mode get_dist(+, -, -, -). + +:- mode get_dist_params(+, -). + +:- mode get_dist_domain_size(+, -). + +:- mode get_dist_domain(+, -). + +:- mode get_dist_nparams(+, -). + +:- mode dist(?). + +:- mode dist_to_term(+,-). +*/ + +/******************************************* + +store stuff in a DB of the form: + db(Id, CPT, Type, Domain, CPTSize, DSize) + +where Id is the id, + cptsize is the table size or -1, + DSize is the domain size, + Type is + tab for tabular + trans for HMMs + continuous + Domain is + a list of values + bool for [t,f] + aminoacids for [a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y] + dna for [a,c,g,t] + rna for [a,c,g,u] + reals + + +********************************************/ + + :- dynamic id/1, db/6. + +id(1). + +new_id(Id) :- + retract(id(Id)), + Id1 is Id+1, + assert(id(Id1)). + + +dist(V, Id, Parents) :- + var(V), !, + freeze(V, dist(V, Id, Parents)). +dist(p(Type, CPT, Parents), Id, FParents) :- + when( + (ground(Type), ground(CPT)) + , + distribution(Type, CPT, Id, Parents, FParents) + ). +dist(p(Type, CPT), Id, FParents) :- + when( + (ground(Type), ground(CPT)) + , + distribution(Type, CPT, Id, [], FParents) + ). + +distribution(bool, trans(CPT), Id, Parents, FParents) :- + is_list(CPT), !, + compress_hmm_table(CPT, Parents, Tab, FParents), + add_dist([t,f], trans, Tab, Id). +distribution(bool, CPT, Id, Parents, Parents) :- + is_list(CPT), !, + add_dist([t,f], tab, CPT, Id). +distribution(aminoacids, trans(CPT), Id, Parents, FParents) :- + is_list(CPT), !, + compress_hmm_table(CPT, Parents, Tab, FParents), + add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], trans, Tab, Id). +distribution(aminoacids, CPT, Id, Parents, Parents) :- + is_list(CPT), !, + add_dist([a,c,d,e,f,g,h,i,k,l,m,n,p,q,r,s,t,v,w,y], tab, CPT, Id). +distribution(dna, trans(CPT), Id, Parents, FParents) :- + is_list(CPT), !, + compress_hmm_table(CPT, Parents, Tab, FParents), + add_dist([a,c,g,t], trans, Tab, Id). +distribution(dna, CPT, Id, Parents, Parents) :- + is_list(CPT), !, + add_dist([a,c,g,t], tab, CPT, Id). +distribution(rna, trans(CPT), Id, Parents, FParents) :- + is_list(CPT), !, + compress_hmm_table(CPT, Parents, Tab, FParents), + add_dist([a,c,g,u], trans, Tab, Id). +distribution(rna, CPT, Id, Parents, Parents) :- + is_list(CPT), !, + add_dist([a,c,g,u], tab, CPT, Id). +distribution(Domain, trans(CPT), Id, Parents, FParents) :- + is_list(Domain), + is_list(CPT), !, + compress_hmm_table(CPT, Parents, Tab, FParents), + add_dist(Domain, trans, Tab, Id). +distribution(Domain, CPT, Id, Parents, Parents) :- + is_list(Domain), + is_list(CPT), !, + add_dist(Domain, tab, CPT, Id). + +add_dist(Domain, Type, CPT, Id) :- + db(Id, CPT, Type, Domain, _, _), !. +add_dist(Domain, Type, CPT, Id) :- + length(CPT, CPTSize), + length(Domain, DSize), + new_id(Id), + assert(db(Id, CPT, Type, Domain, CPTSize, DSize)). + +% +% Often, * is used to code empty in HMMs. +% +compress_hmm_table([], [], [], []). +compress_hmm_table([*|L],[_|Parents],NL,NParents) :- !, + compress_hmm_table(L,Parents,NL,NParents). +compress_hmm_table([Prob|L],[P|Parents],[Prob|NL],[P|NParents]) :- + compress_hmm_table(L,Parents,NL,NParents). + +dist(Id) :- + db(Id, _, _, _, _, _). + +get_dist(Id, Type, Domain, Tab) :- + db(Id, Tab, Type, Domain, _, _). + +get_dist_params(Id, Parms) :- + db(Id, Parms, _, _, _, _). + +get_dist_domain_size(Id, DSize) :- + db(Id, _, _, _, _, DSize). + +get_dist_domain(Id, Domain) :- + db(Id, _, _, Domain, _, _). + +get_dist_nparams(Id, NParms) :- + db(Id, _, _, _, NParms, _). + +dist_to_term(_Id,_Term). diff --git a/CLPBN/clpbn/evidence.yap b/CLPBN/clpbn/evidence.yap index 7bf19da82..ab0d0ce92 100644 --- a/CLPBN/clpbn/evidence.yap +++ b/CLPBN/clpbn/evidence.yap @@ -3,8 +3,6 @@ % % - - :- module(clpbn_evidence, [ store_evidence/1, incorporate_evidence/2 diff --git a/CLPBN/clpbn/gibbs.yap b/CLPBN/clpbn/gibbs.yap index a27451ded..7f50c8a3b 100644 --- a/CLPBN/clpbn/gibbs.yap +++ b/CLPBN/clpbn/gibbs.yap @@ -31,6 +31,10 @@ :- use_module(library('clpbn/utils'), [ check_for_hidden_vars/3]). +:- use_module(library('clpbn/dists'), [ + get_dist/4, + get_dist_domain_size/2]). + :- use_module(library('clpbn/topsort'), [ topsort/2]). @@ -76,7 +80,8 @@ gen_keys([V|Vs], I0, If, Keys0, Keys) :- graph_representation([],_,_,_,[]). graph_representation([V|Vs], Graph, I0, Keys, TGraph) :- clpbn:get_atts(V,[evidence(_)]), !, - clpbn:get_atts(V, [dist(Vals,Table,Parents)]), + clpbn:get_atts(V, [dist(Id,Parents)]), + get_dist(Id, _, Vals, Table), get_sizes(Parents, Szs), length(Vals,Sz), project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable), @@ -85,7 +90,8 @@ graph_representation([V|Vs], Graph, I0, Keys, TGraph) :- graph_representation(Vs, Graph, I0, Keys, TGraph). graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :- I is I0+1, - clpbn:get_atts(V, [dist(Vals,Table,Parents)]), + clpbn:get_atts(V, [dist(Id,Parents)]), + get_dist(Id, _, Vals, Table), get_sizes(Parents, Szs), length(Vals,Sz), project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable), @@ -106,8 +112,8 @@ write_pars([V|Parents]) :- get_sizes([], []). get_sizes([V|Parents], [Sz|Szs]) :- - clpbn:get_atts(V, [dist(Vals,_,_)]), - length(Vals,Sz), + clpbn:get_atts(V, [dist(Id,_)]), + get_dist_domain_size(Id, Sz), get_sizes(Parents, Szs). parent_indices([], _, []). diff --git a/CLPBN/clpbn/graphs.yap b/CLPBN/clpbn/graphs.yap index cddc920c2..e481161fb 100644 --- a/CLPBN/clpbn/graphs.yap +++ b/CLPBN/clpbn/graphs.yap @@ -8,6 +8,9 @@ :- use_module(library('clpbn/utils'), [ check_for_hidden_vars/3]). +:- use_module(library('clpbn/dists'), [ + get_dist/4]). + :- attribute node/0. clpbn2graph(Vs) :- @@ -24,7 +27,8 @@ clpbn2graph2([V|Vs]) :- % attribute_goal(V, node(K,Dom,CPT,TVs,Ev)) :- get_atts(V, [node]), - clpbn:get_atts(V, [key(K),dist(Dom,CPT,Vs)]), + clpbn:get_atts(V, [key(K),dist(Id,Vs)]), + get_dist(Id,_,Dom,CPT), translate_vars(Vs,TVs), ( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true). diff --git a/CLPBN/clpbn/graphviz.yap b/CLPBN/clpbn/graphviz.yap index b363957eb..c18d7c36b 100644 --- a/CLPBN/clpbn/graphviz.yap +++ b/CLPBN/clpbn/graphviz.yap @@ -18,7 +18,7 @@ output_var(Stream, V) :- format(Stream, ' [ shape=box, style=filled, fillcolor=red, fontsize=18.0 ]~n',[]), fail. output_var(Stream, V) :- - clpbn:get_atts(V,[key(Key),dist(_,_,Parents)]), + clpbn:get_atts(V,[key(Key),dist(_,Parents)]), Parents = [_|_], !, format(Stream, ' ',[]), output_parents(Stream, Parents), diff --git a/CLPBN/clpbn/hmm.yap b/CLPBN/clpbn/hmm.yap index c44e60110..d09d442e3 100644 --- a/CLPBN/clpbn/hmm.yap +++ b/CLPBN/clpbn/hmm.yap @@ -69,7 +69,8 @@ emission(Vals,CPT,Ev,V) :- 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(dna,[a,c,g,t]). +cvt_vals(rna,[a,c,g,u]). cvt_vals([A|B],[A|B]). % first, try standard representation diff --git a/CLPBN/clpbn/utils.yap b/CLPBN/clpbn/utils.yap index d0f942233..4531c9575 100644 --- a/CLPBN/clpbn/utils.yap +++ b/CLPBN/clpbn/utils.yap @@ -17,7 +17,7 @@ check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :- check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :- var(V), - clpbn:get_atts(V, [dist(_,_,[V1|LV])]), !, + clpbn:get_atts(V, [dist(_,[V1|LV])]), !, add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs). check_for_extra_variables(_,AllVs, AllVs, Vs, Vs). @@ -75,17 +75,17 @@ sort_vars_by_key_and_parents(AVars, 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), + clpbn:get_atts(V, [key(K),dist(Id,Parents)]), !, + add_parents(Parents,V,Id,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) :- +add_parents(Parents,_,_,KeyVars,KeyVars) :- all_vars(Parents), !. -add_parents(Parents,V,D,T,KeyVarsF,KeyVars0) :- +add_parents(Parents,V,Id,KeyVarsF,KeyVars0) :- transform_parents(Parents,NParents,KeyVarsF,KeyVars0), - clpbn:put_atts(V, [dist(D,T,NParents)]). + clpbn:put_atts(V, [dist(Id,NParents)]). all_vars([]). diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index 1a40b9d1b..040cb2716 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -25,6 +25,10 @@ :- use_module(library('clpbn/graphviz'), [clpbn2gviz/4]). +:- use_module(library('clpbn/dists'), [ + get_dist_domain_size/2, + get_dist/4]). + :- use_module(library('clpbn/utils'), [ clpbn_not_var_member/2, check_for_hidden_vars/3]). @@ -34,8 +38,7 @@ :- use_module(library('clpbn/discrete_utils'), [ project_from_CPT/3, - reorder_CPT/5, - get_dist_size/2]). + reorder_CPT/5]). :- use_module(library(lists), [ @@ -89,7 +92,8 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Parents,Size find_all_clpbn_vars(Vs, LV, ProcessedVars0, Tables). var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :- - clpbn:get_atts(V, [dist(Vals,OTable,Parents)]), + clpbn:get_atts(V, [dist(Id,Parents)]), + get_dist(Id,_,Vals,OTable), ( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true), reorder_CPT([V|Parents],OTable,Deps0,Table0,Sizes0), simplify_evidence(Deps0, Table0, Deps0, Sizes0, Table, Deps, Sizes). @@ -272,6 +276,7 @@ divide_by_sum([P|Ps0],Sum,[PN|Ps]) :- vel_get_dist_size(V,Sz) :- get_atts(V, [size(Sz)]), !. vel_get_dist_size(V,Sz) :- - get_dist_size(V,Sz), !, + clpbn:get_atts(V,dist(Id,_)), !, + get_dist_domain_size(Id,Sz), put_atts(V, [size(Sz)]). diff --git a/CLPBN/clpbn/viterbi.yap b/CLPBN/clpbn/viterbi.yap index 62d65f5da..94a27915f 100644 --- a/CLPBN/clpbn/viterbi.yap +++ b/CLPBN/clpbn/viterbi.yap @@ -8,8 +8,12 @@ :- use_module(library(clpbn), []). +:- use_module(library('clpbn/dists'), [ + get_dist_params/2]). + :- attribute prob/1, emission/1, backp/1, ancestors/1. + viterbi(Start,End,Trace,Ticks,Slices) :- attributes:all_attvars(Vars0), group_vars_by_key_and_parents(Vars0,Ticks,Slices), @@ -47,16 +51,16 @@ get_keys([_|AVars], Trees) :- % may be non-CLPBN vars. get_parents([], _). get_parents([V|AVars], Trees) :- - clpbn:get_atts(V, [dist(D,T,Parents)]), !, + clpbn:get_atts(V, [dist(Id,Parents)]), !, %clpbn:get_atts(V, [key(K)]), format('~w (~w): ~w~n',[V,K,Parents]), - add_parents(Parents,V,D,T,Trees), + add_parents(Parents,V,Id,Trees), get_parents(AVars, Trees). get_parents([_|AVars], Trees) :- % may be non-CLPBN vars. get_parents(AVars, Trees). -add_parents(Parents,V,D,T,Trees) :- +add_parents(Parents,V,Id,Trees) :- transform_parents(Parents,NParents,Copy,Trees), - ( var(Copy) -> true ; clpbn:put_atts(V, [dist(D,T,NParents)]) ). + ( var(Copy) -> true ; clpbn:put_atts(V, [dist(Id,NParents)]) ). transform_parents([],[],_,_). transform_parents([P|Parents0],[P|NParents],Copy,Trees) :- @@ -99,10 +103,11 @@ init_viterbi(V) :- viterbi_alg(L0, Lf) :- L0 == Lf, !. viterbi_alg([V|Vs], Rs) :- -%format('<< ~w~n',[V]), +% format('<< ~w~n',[V]), % get the current status get_atts(V,[prob(P0)]), !, - clpbn:get_atts(V,[dist(_,trans(Probs),States)]), + clpbn:get_atts(V,[dist(Id,States)]), + get_dist_params(Id,Probs), % adjust to consider emission probabilities adjust_for_emission(V, P0, Pf), propagate(Probs,States,Pf,V,Rs,NRs), diff --git a/CLPBN/clpbn/xbif.yap b/CLPBN/clpbn/xbif.yap index df0b61bcd..df010c6bf 100644 --- a/CLPBN/clpbn/xbif.yap +++ b/CLPBN/clpbn/xbif.yap @@ -4,6 +4,9 @@ :- module(xbif, [clpbn2xbif/3]). +:- use_module(library('clpbn/dists'), [ + get_dist_domain/2]). + clpbn2xbif(Stream, Name, Network) :- format(Stream, ' @@ -48,7 +51,8 @@ output_vars(Stream, [V|Vs]) :- output_vars(Stream, Vs). output_var(Stream, V) :- - clpbn:get_atts(V,[key(Key),dist(Domain,_,_)]), + clpbn:get_atts(V,[key(Key),dist(Id,_)]), + get_dist_domain(Id, Domain), format(Stream, ' ',[]), output_key(Stream,Key),