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

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
This commit is contained in:
vsc 2007-07-13 00:52:54 +00:00
parent 82aad9ab75
commit dc0c04d9d2
16 changed files with 259 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CLPBN/Makefile.in
View File

@ -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 \

50
CLPBN/clpbn.yap
View File

@ -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(_, _, _, _, _, _, _, _) :-

10
CLPBN/clpbn/aggregates.yap
View File

@ -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),

19
CLPBN/clpbn/bnt.yap
View File

@ -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) :-

11
CLPBN/clpbn/discrete_utils.yap
View File

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

5
CLPBN/clpbn/display.yap
View File

@ -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([], []).

159
CLPBN/clpbn/dists.yap Normal file
View File

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

2
CLPBN/clpbn/evidence.yap
View File

@ -3,8 +3,6 @@
%
%
:- module(clpbn_evidence, [
store_evidence/1,
incorporate_evidence/2

14
CLPBN/clpbn/gibbs.yap
View File

@ -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([], _, []).

6
CLPBN/clpbn/graphs.yap
View File

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

2
CLPBN/clpbn/graphviz.yap
View File

@ -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),

3
CLPBN/clpbn/hmm.yap
View File

@ -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

12
CLPBN/clpbn/utils.yap
View File

@ -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([]).

13
CLPBN/clpbn/vel.yap
View File

@ -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)]).

17
CLPBN/clpbn/viterbi.yap
View File

@ -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),

6
CLPBN/clpbn/xbif.yap
View File

@ -4,6 +4,9 @@
:- module(xbif, [clpbn2xbif/3]).
:- use_module(library('clpbn/dists'), [
get_dist_domain/2]).
clpbn2xbif(Stream, Name, Network) :-
format(Stream, '<?xml version="1.0" encoding="US-ASCII"?>
@ -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, '<VARIABLE TYPE="nature">
<NAME>',[]),
output_key(Stream,Key),