include two extensions for CLP(BN): dumping in XBif format (XML) and

aggregate averages.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1209 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

CLPBN/Makefile.in

@@ -26,9 +26,11 @@ srcdir=@srcdir@
 CLPBN_TOP= $(srcdir)/clpbn.yap
 
 CLPBN_PROGRAMS= \
-	$(srcdir)/clpbn/vel.yap \
+	$(srcdir)/clpbn/aggregates.yap \
 	$(srcdir)/clpbn/bnt.yap \
-	$(srcdir)/clpbn/evidence.yap
+	$(srcdir)/clpbn/evidence.yap \
+	$(srcdir)/clpbn/vel.yap \
+	$(srcdir)/clpbn/xbif.yap
 
 CLPBN_EXAMPLES=
 

CLPBN/clpbn.yap

@@ -270,35 +270,6 @@ bind_evidence_from_extra_var(Ev1,Var) :-
 	put_atts(Var, [evidence(Ev1)]).
 	
 
-:- yap_flag(toplevel_hook,clpbn:init_clpbn).
-
-hash_table_size(300000).
-
-init_clpbn :-
-	reset_clpbn,
-	fail.
-%init_clpbn :-
-%	hash_table_size(HashTableSize),
-%	array(clpbn,HashTableSize),
-%	catch(static_array(keys,HashTableSize,term),_,true).
-	
-
-random_tmp_number(I) :-
-	get_value(clpbn_random_tmp_number,I),
-	I1 is I+1,
-	set_value(clpbn_random_tmp_number,I1).
-
-reset_clpbn :-
-	current_predicate(_, clpbn_aux:P),
-	retract(clpbn_aux:(P :- !)),
-	fail.
-reset_clpbn :-
-	set_value(clpbn_key, 0), fail.
-reset_clpbn :-
-	set_value(clpbn_random_tmp_number, 0), fail.
-reset_clpbn.
-
-
 user:term_expansion((A :- {}), ( :- true )) :-	 !, % evidence
 	prolog_load_context(module, M),
 	add_to_evidence(M:A).

CLPBN/clpbn/aggregates.yap

@@ -0,0 +1,79 @@
+
+:- module(clpbn_aggregates, [cpt_average/4]).
+
+:- use_module(library(clpbn), [{}/1]).
+
+:- use_module(library(lists), [last/2]).
+
+cpt_average(Vars, Key, Els0, CPT) :-
+	check_domain(Els0, Els),
+	length(Els, SDomain),
+	build_avg_table(Vars, Els, SDomain, Key, CPT).
+
+build_avg_table(Vars, Els, SDomain, _, p(Els, average, Vars)) :-
+	int_power(Vars, SDomain, 1, TabSize),
+	TabSize =< 16, !.
+build_avg_table(Vars, Els, _, Key, p(Els, normalised_average(L), [V1,V2])) :-
+	length(Vars,L),
+	LL1 is L//2,
+	LL2 is L-LL1,
+	list_split(LL1, Vars, L1, L2),
+	Els = [Min|Els1],
+	last(Els1,Max),
+	build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key,  0, I1),
+	build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _).
+	
+int_power([], _, TabSize, TabSize).
+int_power([_|L], X, I0, TabSize) :-
+	I is I0*X,
+	int_power(L, X, I, TabSize).
+
+build_intermediate_table(1,_,[V],V, _, I, I) :- !.
+build_intermediate_table(2, Op, [V1,V2], V, Key, I0, If) :- !,
+	If is I0+1,
+	generate_tmp_random(Op, 2, [V1,V2], V, Key, I0).
+build_intermediate_table(N, Op, L, V, Key, I0, If) :-
+	LL1 is N//2,
+	LL2 is N-LL1,
+	list_split(LL1, L, L1, L2),
+	I1 is I0+1,
+	generate_tmp_random(Op, N, [V1,V2], V, Key, I0),
+	build_intermediate_table(LL1, Op, L1, V1, Key, I1, I2),
+	build_intermediate_table(LL2, Op, L2, V2, Key, I2, If).
+
+% averages are transformed into sums.
+generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :-
+	Lower is Min*N,
+	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]) }.
+
+generate_list(M, M, [M]) :- !.
+generate_list(I, M, [I|Nbs]) :-
+	I1 is I+1,
+	generate_list(I1, M, Nbs).
+
+
+list_split(0, L, [], L) :- !.
+list_split(I, [H|L], [H|L1], L2) :-
+	I1 is I-1,
+	list_split(I1, L, L1, L2).
+
+% allow quick description for a range.
+check_domain([I0|Is], [I0|Is]) :-
+	integer(I0),
+	check_integer_domain(Is,I0), !.
+check_domain(D, ND) :-
+	normalise_domain(D, 0, ND).
+
+check_integer_domain([],_).
+check_integer_domain([I1|Is],I0) :-
+	I0 < I1,
+	check_integer_domain(Is,I1).
+
+normalise_domain([], _, []).
+normalise_domain([_|D], I0, [I0|ND]) :-
+	I is I0+1,
+	normalise_domain(D, I, ND).
+	

CLPBN/clpbn/vel.yap

@@ -22,6 +22,8 @@
 :- use_module(library(ordsets), [ord_union/3
 		    ]).
 
+:- use_module(library('clpbn/xbif'), [cplbn2xbif/3]).
+
 :- use_module(library(lists),
 	      [
 	       append/3,
@@ -34,9 +36,10 @@ check_if_vel_done(Var) :-
 vel(LVs,Vs0,AllDiffs) :-
 	check_for_hidden_vars(Vs0, Vs0, Vs1),
 	sort(Vs1,Vs),
-	find_all_clpbn_vars(Vs, LV0, Tables0),
+	find_all_clpbn_vars(Vs, LV0, LVi, Tables0),
 	find_all_table_deps(Tables0, LV0),
-	process(LV0, LVs, tab(Dist,_,_)),
+	(xbif(XBifStream) -> clpbn2xbif(XBifStream,vel,Vs) ; true),
+	process(LVi, LVs, tab(Dist,_,_)),
 	Dist =.. [_|Ps0],
 	normalise(Ps0,Ps),
 	bind_vals(LVs,Ps,AllDiffs).
@@ -63,17 +66,25 @@ add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs) :-
 add_old_variables([_|LV], AllVs0, AllVs, Vs, IVs) :-
 	add_old_variables(LV, AllVs0, AllVs, Vs, IVs).
 
-find_all_clpbn_vars([], [], []) :- !.
+find_all_clpbn_vars([], [], [], []) :- !.
-find_all_clpbn_vars([V|Vs], [var(V,I,Sz,Vals,Ev,_,_)|LV], [table(I,Table,Deps,Sizes)|Tables]) :-
+find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Deps,Sizes)|Tables]) :-
 	var_with_deps(V, Table, Deps, Sizes, Ev, Vals), !,
+	Var = var(V,I,Sz,Vals,Ev,_,_),
 	get_dist_els(V,Sz),
-	find_all_clpbn_vars(Vs, LV, Tables).
+	% variables with evidence should not be processed.
+	(var(Ev) ->
+	    ProcessedVars = [Var|ProcessedVars0]
+	;
+	    ProcessedVars = ProcessedVars0
+	),
+	find_all_clpbn_vars(Vs, LV, ProcessedVars0, Tables).
 
 var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :-
 	clpbn:get_atts(V, [dist((D->Vals))]),
 	( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true),
 	from_dist_get(D,Vals,OTable,VDeps),
-	reorder_table([V|VDeps],Sizes,OTable,Deps,Table).
+	reorder_table([V|VDeps],Sizes0,OTable,Deps0,Table0),
+	simplify_evidence(Deps0, Table0, Deps0, Sizes0, Table, Deps, Sizes).
 
 from_dist_get(average.Vs0,Vals,Lf,Vs) :- !,
 	handle_average(Vs0,Vals,Lf,Vs).
@@ -225,14 +236,12 @@ convert_factor([F0|F0s], [F|Fs], I, OUT) :-
 	NI is I mod F0,
 	NEXT is F*X,
 	convert_factor(F0s, Fs, NI, OUT1),
-	OUT is OUT1+NEXT.	
+	OUT is OUT1+NEXT.
-
 
 find_all_table_deps(Tables0, LV) :-
 	find_dep_graph(Tables0, DepGraph0),
 	sort(DepGraph0, DepGraph),
 	add_table_deps_to_variables(LV, DepGraph).
-	
 
 find_dep_graph([], []).
 find_dep_graph([table(I,Tab,Deps,Sizes)|Tables], DepGraph) :-
@@ -282,7 +291,7 @@ process(LV0, _, Out) :-
 
 find_best([], V, _, V, _, [], _).
 find_best([var(V,I,Sz,Vals,Ev,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
-	( K < Threshold ; K = Threshold, nonvar(Ev)),
+	K < Threshold,
 	not_var_member(Inputs, V), !,
 	find_best(LV, V, K, VF, WorkTables,LV0, Inputs),
 	(V == VF ->
@@ -299,6 +308,16 @@ multiply_tables([tab(Tab1,Deps1,Szs1), tab(Tab2,Deps2,Sz2)| Tables], Out) :-
 	multiply_tables([tab(NTab,NDeps,NSz)| Tables], Out).
 
 
+simplify_evidence([], Table, Deps, Sizes, Table, Deps, Sizes).
+simplify_evidence([V|VDeps], Table0, Deps0, Sizes0, Table, Deps, Sizes) :-
+	clpbn:get_atts(V, [evidence(Ev)]),
+	clpbn:get_atts(V, [dist((_->Out))]),
+	generate_szs_with_evidence(Out,Ev,Evs),
+	project(V,tab(Table0,Deps0,Sizes0),tab(NewTable,Deps1,Sizes1),Evs),
+	simplify_evidence(VDeps, NewTable, Deps1, Sizes1, Table, Deps, Sizes).
+simplify_evidence([_|VDeps], Table0, Deps0, Sizes0, Table, Deps, Sizes) :-
+	simplify_evidence(VDeps, Table0, Deps0, Sizes0, Table, Deps, Sizes).
+
 propagate_evidence(V, Evs) :-
 	clpbn:get_atts(V, [evidence(Ev),dist((_->Out))]), !,
 	generate_szs_with_evidence(Out,Ev,Evs).

CLPBN/clpbn/xbif.yap

@@ -0,0 +1,96 @@
+:- module(xbif, [clpbn2xbif/3]).
+
+clpbn2xbif(Stream, Name, Network) :-
+	format(Stream, '<!-- DTD for the XMLBIF 0.3 format -->
+<!DOCTYPE BIF [
+	<!ELEMENT BIF ( NETWORK )*>
+	      <!ATTLIST BIF VERSION CDATA #REQUIRED>
+	<!ELEMENT NETWORK ( NAME, ( PROPERTY | VARIABLE | DEFINITION )* )>
+	<!ELEMENT NAME (#PCDATA)>
+	<!ELEMENT VARIABLE ( NAME, ( OUTCOME |  PROPERTY )* ) >
+	      <!ATTLIST VARIABLE TYPE (nature|decision|utility) "nature">
+	<!ELEMENT OUTCOME (#PCDATA)>
+	<!ELEMENT DEFINITION ( FOR | GIVEN | TABLE | PROPERTY )* >
+	<!ELEMENT FOR (#PCDATA)>
+	<!ELEMENT GIVEN (#PCDATA)>
+	<!ELEMENT TABLE (#PCDATA)>
+	<!ELEMENT PROPERTY (#PCDATA)>
+]>
+
+<BIF VERSION="0.3">
+<NETWORK>
+<NAME>~w</NAME>]>
+
+
+<!-- Variables -->',[Name]),
+	output_vars(Stream, Network),
+	output_dists(Stream, Network),
+	format(Stream, '</NETWORK>
+</BIF>
+',[]).
+
+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),dist(DInfo)]),
+	extract_domain(DInfo,Domain),
+	format(Stream, '<VARIABLE TYPE="nature">
+	<NAME>~w</NAME>~n',[Key]),
+	output_domain(Stream, Domain),
+	format(Stream, '</VARIABLE>~n~n',[]).
+
+extract_domain(tab(D,_),D).
+extract_domain(tab(D,_,_),D).
+extract_domain((_->D),D).
+
+output_domain(_, []).
+output_domain(Stream, [El|Domain]) :-
+	format(Stream, '	<OUTCOME>~q</OUTCOME>~n',[El]),
+	output_domain(Stream, Domain).
+
+output_dists(_, []).
+output_dists(Stream, [V|Network]) :-
+	output_dist(Stream, V),
+	output_dists(Stream, Network).
+
+
+output_dist(Stream, V) :-
+	clpbn:get_atts(V,[key(Key),dist((Info))]),
+	format(Stream, '<DEFINITION>
+	<FOR>~w</FOR>~n',[Key]),
+	output_parents(Stream,Info),
+	extract_cpt(Info,CPT),
+	output_cpt(Stream,CPT),
+	format(Stream, '</DEFINITION>~n~n',[]).
+
+output_parents(_,tab(_,_)).
+output_parents(Stream,tab(_,_,Ps)) :-
+	do_output_parents(Stream,Ps).
+output_parents(Stream,([_|_].Ps->_)) :- !,
+	do_output_parents(Stream,Ps).
+output_parents(_,(_->_)).
+
+do_output_parents(_,[]).
+do_output_parents(Stream,[P1|Ps]) :-
+	clpbn:get_atts(P1,[key(Key)]),
+	format(Stream, '<GIVEN>~w</GIVEN>~n',[Key]),
+	do_output_parents(Stream,Ps).
+
+extract_cpt(tab(_,CPT),CPT).
+extract_cpt(tab(_,CPT,_),CPT).	
+extract_cpt(([C1|Cs]._->_),[C1|Cs]) :- !.
+extract_cpt((CPT->_),CPT).
+
+output_cpt(Stream,CPT) :-
+	format(Stream, '	<TABLE> ', []),
+	output_els(Stream, CPT),
+	format(Stream, '</TABLE>~n', []).
+
+output_els(_, []).
+output_els(Stream, [El|Els]) :-
+	format(Stream,'~f ',[El]),
+	output_els(Stream, Els).
+