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

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

Browse Source 
aggregate averages.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1209 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-12-08 22:32:34 +00:00
parent 2f2ba300c1
commit 49455985b3
5 changed files with 208 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
CLPBN/Makefile.in
View File

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

29
CLPBN/clpbn.yap
View File

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

79
CLPBN/clpbn/aggregates.yap Normal file
View File

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

39
CLPBN/clpbn/vel.yap
View File

@ -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([V|Vs], [var(V,I,Sz,Vals,Ev,_,_)|LV], [table(I,Table,Deps,Sizes)|Tables]) :-
find_all_clpbn_vars([], [], [], []) :- !.
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).

96
CLPBN/clpbn/xbif.yap Normal file
View File

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