From 3824534ee8230b889ee7b9de968137ec1b5f08f5 Mon Sep 17 00:00:00 2001 From: vsc Date: Sat, 11 Dec 2004 19:53:43 +0000 Subject: [PATCH] further updates to CLP(BN): fixes on variable elimination and graph display with graphviz. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1210 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- CLPBN/Makefile.in | 1 + CLPBN/clpbn/aggregates.yap | 2 +- CLPBN/clpbn/graphviz.yap | 79 ++++++++++++++++++++++++++++++++++++++ CLPBN/clpbn/vel.yap | 11 +++++- CLPBN/clpbn/xbif.yap | 45 +++++++++++++++++++--- 5 files changed, 129 insertions(+), 9 deletions(-) create mode 100644 CLPBN/clpbn/graphviz.yap diff --git a/CLPBN/Makefile.in b/CLPBN/Makefile.in index 77e00810a..407ce56e3 100644 --- a/CLPBN/Makefile.in +++ b/CLPBN/Makefile.in @@ -29,6 +29,7 @@ CLPBN_PROGRAMS= \ $(srcdir)/clpbn/aggregates.yap \ $(srcdir)/clpbn/bnt.yap \ $(srcdir)/clpbn/evidence.yap \ + $(srcdir)/clpbn/graphviz.yap \ $(srcdir)/clpbn/vel.yap \ $(srcdir)/clpbn/xbif.yap diff --git a/CLPBN/clpbn/aggregates.yap b/CLPBN/clpbn/aggregates.yap index 9aa9f658a..f732f144b 100644 --- a/CLPBN/clpbn/aggregates.yap +++ b/CLPBN/clpbn/aggregates.yap @@ -47,7 +47,7 @@ generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :- Upper is Max*N, generate_list(Lower, Upper, Nbs), %% write(sum(Nbs,[V1,V2])),nl, % debugging - { V = average_internal_node(I,Key) with p(Nbs,sum,[V1,V2]) }. + { V = 'AVG'(I,Key) with p(Nbs,sum,[V1,V2]) }. generate_list(M, M, [M]) :- !. generate_list(I, M, [I|Nbs]) :- diff --git a/CLPBN/clpbn/graphviz.yap b/CLPBN/clpbn/graphviz.yap new file mode 100644 index 000000000..e4694088a --- /dev/null +++ b/CLPBN/clpbn/graphviz.yap @@ -0,0 +1,79 @@ +:- module(gviz, [clpbn2gviz/4]). + +clpbn2gviz(Stream, Name, Network, Output) :- + format(Stream, 'digraph ~w { + graph [ rankdir="LR" ];~n',[Name]), + output_vars(Stream, Network), + info_ouput(Stream, Output), + format(Stream, '}~n',[]). + +output_vars(_, []). +output_vars(Stream, [V|Vs]) :- + output_var(Stream, V), + output_vars(Stream, Vs). + +output_var(Stream, V) :- + clpbn:get_atts(V,[key(Key),evidence(_)]), + output_key(Stream,Key), + format(Stream, ' [ shape=box, style=filled, fillcolor=red, fontsize=18.0 ]~n',[]), + fail. +output_var(Stream, V) :- + clpbn:get_atts(V,[key(Key),dist(DInfo)]), + extract_parents(DInfo,Parents), + Parents = [_|_], !, + format(Stream, ' ',[]), + output_parents(Stream, Parents), + format(' -> ',[]), + output_key(Stream,Key), + nl(Stream). +output_var(_, _). + +info_ouput(_, []). +info_ouput(Stream, [V|Output]) :- + clpbn:get_atts(V,[key(Key)]), + output_key(Stream,Key), + format(Stream, ' [ shape=box, style=filled, fillcolor=green, fontsize=18.0 ]~n',[]), + info_ouput(Stream, Output). + + +output_parents(Stream, [V]) :- !, + clpbn:get_atts(V,[key(Key)]), + output_key(Stream,Key). +output_parents(Stream, L) :- + format(Stream,'{ ',[]), + output_parents1(Stream,L), + format(Stream,'}',[]). + +output_parents1(_,[]). +output_parents1(Stream,[V|L]) :- + clpbn:get_atts(V,[key(Key)]), + output_key(Stream,Key), + put_code(Stream, 0' ), + output_parents1(Stream,L). + + +extract_parents(tab(_,_),[]). +extract_parents(tab(_,_,Parents),Parents). +extract_parents((sum.Parents->_),Parents) :- !. +extract_parents((normalised_average(_).Parents->_),Parents) :- !. +extract_parents(([_|_].Parents->_),Parents) :- !. +extract_parents((_->_),[]). + +output_key(Stream, Key) :- + output_key(Stream, 0, Key). + +output_key(Stream, _, Key) :- + primitive(Key), !, + write(Stream, Key). +output_key(Stream, I0, Key) :- + Key =.. [Name|Args], + write(Stream, Name), + I is I0+1, + output_key_args(Stream, I, Args). + +output_key_args(_, _, []). +output_key_args(Stream, I, [Arg|Args]) :- + format(Stream, '~*c', [I,0'_]), + output_key(Stream, I, Arg), + output_key_args(Stream, I, Args). + diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index 06c4d7128..64d48f435 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -22,7 +22,9 @@ :- use_module(library(ordsets), [ord_union/3 ]). -:- use_module(library('clpbn/xbif'), [cplbn2xbif/3]). +:- use_module(library('clpbn/xbif'), [clpbn2xbif/3]). + +:- use_module(library('clpbn/graphviz'), [clpbn2gviz/4]). :- use_module(library(lists), [ @@ -33,12 +35,17 @@ check_if_vel_done(Var) :- get_atts(Var, [size(_)]), !. +%output(xbif(user_error)). +output(gviz(user_error)). +%output(no). + vel(LVs,Vs0,AllDiffs) :- check_for_hidden_vars(Vs0, Vs0, Vs1), sort(Vs1,Vs), find_all_clpbn_vars(Vs, LV0, LVi, Tables0), find_all_table_deps(Tables0, LV0), - (xbif(XBifStream) -> clpbn2xbif(XBifStream,vel,Vs) ; true), + (output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,vel,Vs) ; true), + (output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,vel,Vs,LVs) ; true), process(LVi, LVs, tab(Dist,_,_)), Dist =.. [_|Ps0], normalise(Ps0,Ps), diff --git a/CLPBN/clpbn/xbif.yap b/CLPBN/clpbn/xbif.yap index 379ccd1d1..242f050cf 100644 --- a/CLPBN/clpbn/xbif.yap +++ b/CLPBN/clpbn/xbif.yap @@ -1,7 +1,17 @@ :- module(xbif, [clpbn2xbif/3]). clpbn2xbif(Stream, Name, Network) :- - format(Stream, ' + format(Stream, ' + + + + + + + @@ -19,8 +29,7 @@ clpbn2xbif(Stream, Name, Network) :- -~w]> - +~w ',[Name]), output_vars(Stream, Network), @@ -38,7 +47,9 @@ output_var(Stream, V) :- clpbn:get_atts(V,[key(Key),dist(DInfo)]), extract_domain(DInfo,Domain), format(Stream, ' - ~w~n',[Key]), + ',[]), + output_key(Stream,Key), + format('~n',[]), output_domain(Stream, Domain), format(Stream, '~n~n',[]). @@ -60,7 +71,9 @@ output_dists(Stream, [V|Network]) :- output_dist(Stream, V) :- clpbn:get_atts(V,[key(Key),dist((Info))]), format(Stream, ' - ~w~n',[Key]), + ',[]), + output_key(Stream, Key), + format('~n',[]), output_parents(Stream,Info), extract_cpt(Info,CPT), output_cpt(Stream,CPT), @@ -76,7 +89,9 @@ output_parents(_,(_->_)). do_output_parents(_,[]). do_output_parents(Stream,[P1|Ps]) :- clpbn:get_atts(P1,[key(Key)]), - format(Stream, '~w~n',[Key]), + format(Stream, '',[]), + output_key(Stream,Key), + format('~n',[]), do_output_parents(Stream,Ps). extract_cpt(tab(_,CPT),CPT). @@ -94,3 +109,21 @@ output_els(Stream, [El|Els]) :- format(Stream,'~f ',[El]), output_els(Stream, Els). +output_key(Stream, Key) :- + output_key(Stream, 0, Key). + +output_key(Stream, _, Key) :- + primitive(Key), !, + write(Stream, Key). +output_key(Stream, I0, Key) :- + Key =.. [Name|Args], + write(Stream, Name), + I is I0+1, + output_key_args(Stream, I, Args). + +output_key_args(_, _, []). +output_key_args(Stream, I, [Arg|Args]) :- + format(Stream, '~*c', [I,0'_]), + output_key(Stream, I, Arg), + output_key_args(Stream, I, Args). +