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

new version

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1212 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-12-16 06:07:07 +00:00
parent ae2a53d2e3
commit 7acacd1618
9 changed files with 518 additions and 344 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CLPBN/Makefile.in
View File

@ -29,7 +29,9 @@ CLPBN_PROGRAMS= \
$(srcdir)/clpbn/aggregates.yap \
$(srcdir)/clpbn/bnt.yap \
$(srcdir)/clpbn/evidence.yap \
$(srcdir)/clpbn/graphs.yap \
$(srcdir)/clpbn/graphviz.yap \
$(srcdir)/clpbn/utils.yap \
$(srcdir)/clpbn/vel.yap \
$(srcdir)/clpbn/xbif.yap

138
CLPBN/clpbn.yap
View File

@ -1,6 +1,9 @@
:- module(clpbn, [{}/1]).
:- module(clpbn, [{}/1,
clpbn_flag/2,
set_clpbn_flag/2,
clpbn_flag/3]).
:- use_module(library(atts)).
:- use_module(library(lists)).
@ -20,7 +23,7 @@
:- multifile
user:term_expansion/2.
:- attribute key/1, dist/1, evidence/1, done/1, starter/0.
:- attribute key/1, dist/3, evidence/1, done/1, starter/0.
:- use_module('clpbn/bnt', [dump_as_bnt/2,
@ -31,25 +34,45 @@
check_if_vel_done/1
]).
:- use_module('clpbn/evidence', [add_to_evidence/1,
execute_pre_evidence/0
:- use_module('clpbn/graphs', [
clpbn2graph/1
]).
use(vel).
:- use_module('clpbn/evidence', [
store_evidence/1,
incorporate_evidence/2
]).
:- dynamic solver/1,output/1.
solver(vel).
%output(xbif(user_error)).
output(gviz(user_error)).
%output(no).
clpbn_flag(Flag,Option) :-
clpbn_flag(Flag, Option, Option).
set_clpbn_flag(Flag,Option) :-
clpbn_flag(Flag, _, Option).
clpbn_flag(output,Before,After) :-
retract(output(Before)),
assert(output(After)).
clpbn_flag(solver,Before,After) :-
retract(solver(Before)),
assert(solver(After)).
{Var = Key with Dist} :-
% key_entry(Key,Indx),
% array_element(clpbn,Indx,El),
% attributes:put_att(El,3,indx(Indx)),
put_atts(El,[key(Key),dist((E->Domain))]),
extract_dist(Dist, E, Domain),
put_atts(El,[key(Key),dist(Domain,Table,Parents)]),
extract_dist(Dist, Table, Parents, Domain),
add_evidence(Var,El).
extract_dist(V, (Tab.Inps), Domain) :- var(V), !,
extract_dist(V, Tab.Inps, Domain) :- var(V), !,
V = p(Domain, Tab, Inps).
extract_dist(p(Domain, Tab, []), Tab, Domain) :- !.
extract_dist(p(Domain, Tab, Inps), (Tab.Inps), Domain).
extract_dist(p(Domain, Tab), Tab, Domain).
extract_dist(p(Domain, Tab, Inps), Tab, Inps, Domain).
extract_dist(p(Domain, Tab), Tab, [], Domain).
check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
check_constraint((A->D), _, _, (A->D)) :- var(A), !.
@ -67,58 +90,22 @@ replace_var([V|_], V0, [NV|_], NV) :- V == V0, !.
replace_var([_|Vars], V, [_|NVars], NV) :-
replace_var(Vars, V, NVars, NV).
generate_key_goal(Head, Name, Key, clpbn_aux:KeyGoal, KeyDesc, Id) :-
functor(Head, _, Ar),
atom_chars(Name, NaS),
number_codes(Ar, ArS),
append("/", ArS, S1),
append(NaS, S1, S2),
append("key_", S2, SNNa),
atom_chars(NNa, SNNa),
append(Key,[Id],LArgs),
KeyGoal =.. [NNa|LArgs],
KeyDesc =.. [Name|Key],
length(Key, N),
NAr is N+1,
abolish(clpbn_aux:(NNa/NAr)),
reset_clpbn,
dynamic_predicate(clpbn_aux:(NNa/NAr), logical),
assert((clpbn_aux:KeyGoal :- new_key(Id), asserta(clpbn_aux:(KeyGoal :- !)))).
new_key(Key) :-
get_value(clpbn_key, Key),
X is Key+1,
set_value(clpbn_key, X).
skolem_vars([], []).
skolem_vars([[V|_]|LV], [V|NLV]) :-
skolem_vars(LV, NLV).
skolem_new_vars([], [], []).
skolem_new_vars([[_|B]|Sks], [NV|Vs], [[NV|B]|NSks]) :-
skolem_new_vars(Sks, Vs, NSks).
fresh_vars([], [], B, B).
fresh_vars([V|LV], [NV|NLV], (clpbn:add_evidence(V,NV),B), B0) :-
fresh_vars(LV, NLV, B, B0).
add_evidence(V,NV) :-
nonvar(V), !,
clpbn:put_atts(NV,evidence(V)).
add_evidence(V,V).
%
%
% called by top-level
% or by call_residue/2
%
project_attributes(GVars, AVars) :-
AVars = [_|_], !,
execute_pre_evidence,
sort_vars_by_key(AVars,SortedAVars,DiffVars),
get_clpbn_vars(GVars,CLPBNGVars),
write_out(CLPBNGVars, SortedAVars,DiffVars).
solver(Solver),
incorporate_evidence(SortedAVars, AllVars),
write_out(Solver,CLPBNGVars, AllVars, DiffVars).
project_attributes(_, _).
get_clpbn_vars([],[]).
@ -157,23 +144,16 @@ in_keys(K1,[_|Ks]) :-
add_to_keys(K1, Ks, Ks) :- ground(K1), !.
add_to_keys(K1, Ks, [K1|Ks]).
write_out(GVars, AVars, DiffVars) :-
use(vel),
write_out(vel, GVars, AVars, DiffVars) :-
vel(GVars, AVars, DiffVars).
write_out(GVars, AVars, _) :-
use(bnt),
write_out(bnt, GVars, AVars, _) :-
dump_as_bnt(GVars, AVars).
% starter_vars(GVars).
starter_vars([]).
starter_vars([Var|Vs]) :-
get_atts(Var, [key(_)]),
put_atts(Var, [starter]),
starter_vars(Vs).
write_out(graphs, _, AVars, _) :-
clpbn2graph(AVars).
get_bnode(Var, Goal) :-
get_atts(Var, [key(Key),dist(X)]),
get_atts(Var, [key(Key),dist(A,B,C)]),
(C = [] -> X = tab(A,B) ; X = tab(A,B,C)),
dist_goal(X, Key, Goal0),
include_evidence(Var, Goal0, Key, Goali),
include_starter(Var, Goali, Key, Goal).
@ -186,8 +166,6 @@ include_starter(Var, Goal0, Key, ((:-Key),Goal0)) :-
get_atts(Var, [starter]), !.
include_starter(_, Goal0, _, Goal0).
dist_goal(norm(M,V), Key, (Key=norm(M,V))) :- !.
dist_goal(avg(L), Key, (Key=avg(L))) :- !.
dist_goal(Dist, Key, (Key=NDist)) :-
term_variables(Dist, DVars),
process_vars(DVars, DKeys),
@ -223,16 +201,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(Dist)]), !,
get_atts(Var, [key(Key),dist(Domain,Table,Parents)]), !,
/* oops, someone trying to bind a clpbn constrained variable */
Goals = [],
bind_clpbn(T, Var, Key, Dist).
bind_clpbn(T, Var, Key, Domain, Table, Parents).
verify_attributes(_, _, []).
bind_clpbn(T, Var, Key, Dist) :- var(T),
get_atts(T, [key(Key1),dist(Dist1)]), !,
bind_clpbns(Key, Dist, Key1, Dist1),
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),
(
get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var)
@ -259,9 +237,10 @@ fresh_attvar(Var, NVar) :-
get_atts(Var, LAtts),
put_atts(NVar, LAtts).
bind_clpbns(Key, Dist, Key, Dist1) :- !,
( Dist = Dist1 -> true ; throw(error(domain_error(bayesian_domain),bind_clpbns))).
bind_clpbns(_, _, _, _, _) :-
bind_clpbns(Key, Domain, Table, Parents, Key1, Domain1, Table1, Parents1) :-
Key == Key1, !,
( Domain == Domain1, Table == Table1, Parents == Parents1 -> true ; throw(error(domain_error(bayesian_domain),bind_clpbns))).
bind_clpbns(_, _, _, _, _, _, _, _) :-
format(user_error, "unification of two bayesian vars not supported~n").
bind_evidence_from_extra_var(Ev1,Var) :-
@ -269,8 +248,7 @@ bind_evidence_from_extra_var(Ev1,Var) :-
bind_evidence_from_extra_var(Ev1,Var) :-
put_atts(Var, [evidence(Ev1)]).
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M),
add_to_evidence(M:A).
store_evidence(M:A).

230
CLPBN/clpbn/aggregates.yap
View File

@ -1,5 +1,9 @@
:- module(clpbn_aggregates, [cpt_average/4]).
:- module(clpbn_aggregates, [
cpt_average/4,
cpt_max/4,
cpt_min/4
]).
:- use_module(library(clpbn), [{}/1]).
@ -10,18 +14,56 @@ cpt_average(Vars, Key, Els0, CPT) :-
length(Els, SDomain),
build_avg_table(Vars, Els, SDomain, Key, CPT).
build_avg_table(Vars, Els, SDomain, _, p(Els, average, Vars)) :-
cpt_max(Vars, Key, Els0, CPT) :-
check_domain(Els0, Els),
length(Els, SDomain),
build_max_table(Vars, Els, SDomain, Key, CPT).
cpt_min(Vars, Key, Els0, CPT) :-
check_domain(Els0, Els),
length(Els, SDomain),
build_min_table(Vars, Els, SDomain, Key, CPT).
build_avg_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, !.
build_avg_table(Vars, Els, _, Key, p(Els, normalised_average(L), [V1,V2])) :-
TabSize =< 16, !,
average_cpt(Vars, Domain, CPT).
build_avg_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :-
length(Vars,L),
LL1 is L//2,
LL2 is L-LL1,
list_split(LL1, Vars, L1, L2),
Els = [Min|Els1],
Domain = [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, _).
build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _),
normalised_average_cpt(L, [V1,V2], Domain, CPT).
build_max_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, !,
max_cpt(Vars, Domain, CPT).
build_max_table(Vars, Domain, Domain, Key, p(Domain, CPT, [V1,V2])) :-
length(Vars,L),
LL1 is L//2,
LL2 is L-LL1,
list_split(LL1, Vars, L1, L2),
build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 0, I1),
build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, I1, _),
max_cpt([V1,V2], Domain, CPT).
build_min_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16, !,
min_cpt(Vars, Domain, CPT).
build_min_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :-
length(Vars,L),
LL1 is L//2,
LL2 is L-LL1,
list_split(LL1, Vars, L1, L2),
build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 0, I1),
build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, I1, _),
min_cpt([V1,V2], Domain, CPT).
int_power([], _, TabSize, TabSize).
int_power([_|L], X, I0, TabSize) :-
@ -37,24 +79,28 @@ build_intermediate_table(N, Op, L, V, Key, I0, If) :-
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).
build_intermediate_table(LL2, Op, L2, V2, Key, I2, If),
generate_tmp_random(Op, N, [V1,V2], V, Key, I0).
% 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 = 'AVG'(I,Key) with p(Nbs,sum,[V1,V2]) }.
sum_cpt([V1,V2], Nbs, CPT),
% write(sum(Nbs, CPT, [V1,V2])),nl, % debugging
{ V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }.
generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
{ V = 'MAX'(I,Key) with p(Domain,CPT,[V1,V2]) }.
generate_tmp_random(min(Domain,CPT), _, [V1,V2], V, Key, I) :-
{ V = 'MIN'(I,Key) with p(Domain,CPT,[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,
@ -77,3 +123,165 @@ normalise_domain([_|D], I0, [I0|ND]) :-
I is I0+1,
normalise_domain(D, I, ND).
%
% generate actual table, instead of trusting the solver
%
average_cpt(Vs,Vals,CPT) :-
generate_indices(Vals,Inds,0,Av),
combine_all(Vs, Inds, Cs),
length(Vs, Max),
average_possible_cases(0, Av, Max, Cs, CPT).
sum_cpt(Vs, Vals, CPT) :-
length(Vals,Sz),
combine_all(Vs, Cs),
sum_possible_cases(0, Sz, Cs, CPT).
normalised_average_cpt(Max, Vs, Vals, CPT) :-
generate_indices(Vals,_,0,Sz),
combine_all(Vs, Cs),
average_possible_cases(0, Sz, Max, Cs, CPT).
generate_indices([],[],Av,Av).
generate_indices([_|Ls],[I|Inds],I,Av) :-
I1 is I+1,
generate_indices(Ls,Inds,I1,Av).
combine_all([], [[]]).
combine_all([V|LV], Cs) :-
combine_all(LV, Cs0),
get_dist_size(V,Sz),
generate_indices(0, Sz, Vals),
add_vals(Vals, Cs0, Cs).
combine_all([], _, [[]]).
combine_all([_|LV], Vals, Cs) :-
combine_all(LV, Vals, Cs0),
add_vals(Vals, Cs0, Cs).
generate_indices(Sz,Sz,[]) :- !.
generate_indices(I0,Sz,[I0|Vals]) :-
I is I0+1,
generate_indices(I,Sz,Vals).
add_vals([], _, []).
add_vals([V|Vs], Cs0, Csf) :-
add_vals(Vs, Cs0, Cs),
add_val_to_cases(Cs0, V, Cs, Csf).
add_val_to_cases([], _, Cs, Cs).
add_val_to_cases([C|Cs], V, Cs0, [[V|C]|Csf]) :-
add_val_to_cases(Cs, V, Cs0, Csf).
sum_all([],N,N).
sum_all([C|Cs],N0,N) :-
X is C+N0,
sum_all(Cs,X,N).
average_possible_cases(Av,Av,_,_,[]) :- !.
average_possible_cases(I,Av,Max,Cs,Lf) :-
average_cases2(Cs,I,Max,Lf,L0),
I1 is I+1,
average_possible_cases(I1,Av,Max,Cs,L0).
average_cases2([], _, _, L, L).
average_cases2([C|Cs], I, Av, [P|Lf], L0) :-
calculate_avg_prob(C, I, Av, P),
average_cases2(Cs, I, Av, Lf, L0).
calculate_avg_prob(C, I, Av, 1.0) :-
sum_all(C,0,N),
I =:= integer(round(N/Av)), !.
calculate_avg_prob(_, _, _, 0.0).
sum_possible_cases(Av,Av,_,[]) :- !.
sum_possible_cases(I,Av,Cs,Lf) :-
sum_cases2(Cs,I,Lf,L0),
I1 is I+1,
sum_possible_cases(I1,Av,Cs,L0).
sum_cases2([], _, L, L).
sum_cases2([C|Cs], I, [P|Lf], L0) :-
calculate_sum_prob(C, I, P),
sum_cases2(Cs, I, Lf, L0).
calculate_sum_prob(C, I, 1.0) :-
sum_all(C,0,N),
I =:= N, !.
calculate_sum_prob(_, _, 0.0).
%
% generate a CPT for max.
%
max_cpt(Vs, Domain, CPT) :-
combinations(Vs, Domain, Combinations),
cpt_from_domain(Domain, Combinations, Domain, max, CPT).
min_cpt(Vs, Domain, CPT) :-
combinations(Vs, Domain, Combinations),
cpt_from_domain(Domain, Combinations, Domain, min, CPT).
combinations(Vs, Domain, Combinations) :-
mult_domains(Vs, Domain, Domains),
cart(Domains, Combinations).
mult_domains([], _, []).
mult_domains([_|Vs], Domain, [Domain|Domains]) :-
mult_domains(Vs, Domain, Domains).
cart([], [[]]).
cart([L|R], Rf) :-
cart(R, R1),
add(L, R1, Rf).
add([], _, []).
add([A|R], R1, RsF) :-
add_head(R1, A, RsF, Rs0),
add(R, R1, Rs0).
add_head([], _, Rs, Rs).
add_head([H|L], A, [[A|H]|Rs], Rs0) :-
add_head(L, A, Rs, Rs0).
cpt_from_domain([], _, _, _, []).
cpt_from_domain([El|Domain], Combinations, Domain0, OP, CPT) :-
cpt_from_domain_el(Combinations, El, Domain0, OP, CPT, CPT0),
cpt_from_domain(Domain, Combinations, Domain0, OP, CPT0).
cpt_from_domain_el([], _, _, _, CPT, CPT).
cpt_from_domain_el([C|Combinations], El, Domain, OP, [P|CPT], CPT0) :-
cpt_for_el(C, OP, El, Domain, 0.0, P),
cpt_from_domain_el(Combinations, El, Domain, OP, CPT, CPT0).
cpt_for_el([], _, _, _, P, P).
cpt_for_el([El|Cs], MAX, El, Domain, _, P) :- !,
cpt_for_el(Cs, MAX, El, Domain, 1.0, P).
cpt_for_el([C|_], MAX, El, Domain, _, 0.0) :-
op_broken(MAX, C, El, Domain), !.
cpt_for_el([_|Cs], MAX, El, Domain, P0, P) :-
cpt_for_el(Cs, MAX, El, Domain, P0, P).
op_broken(max, C, El, Domain) :-
lg(Domain, C, El).
op_broken(min, C, El, Domain) :-
sm(Domain, C, El).
lg([El|_], _, El) :- !.
lg([C|_], C, _) :- !, fail.
lg([_|Vs], C, El) :-
lg(Vs, C, El).
sm([El|_], _, El) :- !, fail.
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).

73
CLPBN/clpbn/bnt.yap
View File

@ -65,8 +65,7 @@ all_vars_with_deps(I, LDeps, LNoDeps) :-
var_with_deps(Indx, Deps, Deps0, NoDeps, NoDeps0) :-
array_element(clpbn, Indx, V),
clpbn:get_atts(V, [dist(D)]), !,
term_variables(D, VDeps),
clpbn:get_atts(V, [dist(_,_,VDeps)]), !,
(VDeps = [] ->
NoDeps = [V|NoDeps0], Deps = Deps0 ;
sort(VDeps,SVDeps),
@ -160,28 +159,16 @@ mknet_all_discrete(Vs, Key, Observables, CommandStream, Answer) :-
send_command(CommandStream, Answer, "bnet = mk_bnet(dag, ns, 'discrete', discrete_nodes, 'observed', onodes);~n", []).
send_var_sizes([V], CommandStream) :- !,
clpbn:get_atts(V, [dist(D)]),
dist_size(D, 1, Sz),
clpbn:get_atts(V, [dist(_,Tab,_)]),
length(Tab, Sz),
my_format(CommandStream, "~w", [Sz]).
send_var_sizes([V|Vs], CommandStream) :-
clpbn:get_atts(V, [dist(D)]),
dist_size(D, 1, Sz),
clpbn:get_atts(V, [dist(_,Tab,_)]),
length(Tab, Sz),
my_format(CommandStream, "~w ", [Sz]),
send_var_sizes(Vs, CommandStream).
dist_size((_->Vs), _, L) :- !,
length(Vs,L).
dist_size((_._=Vs), I0, If) :- !,
length(Vs,L),
If is I0+(L-1).
dist_size((A;B), I0, If) :- !,
dist_size(A, I0, I1),
I2 is I1+1,
dist_size(B, I2, If).
dist_size(_, I, I).
dump_observables([], _, _) :- !.
dump_observables([Observable|Observables], start, CommandStream) :- !,
get_atts(Observable, [topord(I)]),
@ -194,14 +181,14 @@ dump_observables([Observable|Observables], mid, CommandStream) :-
dump_cpds([], _, _).
dump_cpds([V|Vs], CommandStream, Answer) :-
clpbn:get_atts(V, [dist(D)]),
clpbn:get_atts(V, [dist(Domain,_,_)]),
dump_cpds(Vs, CommandStream, Answer),
dump_dist(D, V, CommandStream, Answer).
dump_dist(Domain, V, CommandStream, Answer).
%
% this is a discrete distribution
%
dump_dist(((average.Ss)->Vs), V, CommandStream, Answer) :- !,
dump_dist(Vs, average, Ss, V, CommandStream, Answer) :- !,
vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round(mean([",['$VAR'(I),'$VAR'(I)]),
@ -209,7 +196,7 @@ dump_dist(((average.Ss)->Vs), V, CommandStream, Answer) :- !,
length(Ss, Len),
dump_indices(0,Len,CommandStream),
send_command(CommandStream, Answer, "]))'));~n",[]).
dump_dist(((sum.Ss)->Vs), V, CommandStream, Answer) :- !,
dump_dist(Vs, sum, Ss, V, CommandStream, Answer) :- !,
vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('sum([",['$VAR'(I),'$VAR'(I)]),
@ -217,7 +204,7 @@ dump_dist(((sum.Ss)->Vs), V, CommandStream, Answer) :- !,
length(Ss, Len),
dump_indices(0,Len,CommandStream),
send_command(CommandStream, Answer, "])'));~n",[]).
dump_dist(((normalised_average(N).Ss)->Vs), V, CommandStream, Answer) :- !,
dump_dist(Vs, normalised_average(N), Ss, V, CommandStream, Answer) :- !,
vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round((sum([",['$VAR'(I),'$VAR'(I)]),
@ -226,8 +213,7 @@ dump_dist(((normalised_average(N).Ss)->Vs), V, CommandStream, Answer) :- !,
dump_indices(0,Len,CommandStream),
N2 is N//2,
send_command(CommandStream, Answer, "])+~d)/~d)'));~n",[N2,N]).
dump_dist((([H|T].Ss0)->Vs), V, CommandStream, Answer) :- !,
Ds = [H|T],
dump_dist(Vs,Ds,Ss0, V, CommandStream, Answer) :- !,
vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]),
@ -238,20 +224,6 @@ dump_dist((([H|T].Ss0)->Vs), V, CommandStream, Answer) :- !,
keysort(KDs0,KDs),
dump_elements(KDs, CommandStream),
send_command(CommandStream, Answer, "]);~n",[]).
dump_dist(([H|T]->Vs), V, CommandStream, Answer) :-
vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]),
put_atts(V, [map(Map)]),
dump_problist([H|T], CommandStream),
send_command(CommandStream, Answer, "]);~n",[]).
dump_dist((D1;D2), V, CommandStream, Answer) :-
get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]),
find_map((D1;D2), 1, _, Map, []),
put_atts(V, [map(Map)]),
dump_dlist((D1;D2), start, CommandStream),
send_command(CommandStream, Answer, "]);~n",[]).
vals_map([], _, []).
vals_map([V|Vs], I, [[V|I]|Map]) :-
@ -354,7 +326,7 @@ follow_map([_|Map], K, V) :- !,
find_observables([], []).
find_observables([Var|GVars], [Var|Observables]) :-
clpbn:get_atts(Var, [dist(_)]), !,
clpbn:get_atts(Var, [dist(_,_,_)]), !,
find_observables(GVars, Observables).
find_observables([_|GVars], Observables) :-
find_observables(GVars, Observables).
@ -383,8 +355,7 @@ in_clique([V1|L], V) :-
in_clique(L,V).
child(V,V1) :-
clpbn:get_atts(V, [dist(T)]),
term_variables(T,LVs),
clpbn:get_atts(V, [dist(_,_,LVs)]),
varmember(LVs, V1).
varmember([H|_], V1) :- H == V1, !.
@ -522,24 +493,6 @@ bind_lobs([Obs|Lobs], (Key,Rest), FullKey, Out) :-
bind_lobs(Lobs, Rest, FullKey, Out).
/* cartesian product
cart([], [[]]).
cart([L|R], Rf) :-
cart(R, R1),
add(L, R1, Rf).
add([], _, []).
add([A|R], R1, RsF) :-
add_head(R1, A, RsF, Rs0),
add(R, R1, Rs0).
add_head([], _, Rs, Rs).
add_head([H|L], A, [[A|H]|Rs], Rs0) :-
add_head(L, A, Rs, Rs0).
*/
my_format(Stream, String, Args) :-
format(user_error, String, Args),
format(Stream, String, Args).

127
CLPBN/clpbn/evidence.yap
View File

@ -1,25 +1,122 @@
%
%
%
%
:- module(evidence, [add_to_evidence/1,
execute_pre_evidence/0
:- module(evidence, [
store_evidence/1,
incorporate_evidence/2
]).
% declare some new evidence.
:- use_module(library(clpbn), [
{}/1,
clpbn_flag/3,
set_clpbn_flag/2
]).
add_to_evidence(G2) :-
recordzifnot('$evidence',G2,_),
fail.
add_to_evidence(_).
:- use_module(library(rbtrees), [
new/1,
lookup/3,
insert/4
]).
% use it at query evaluation time.
:- meta_predicate store_evidence(:).
execute_pre_evidence :-
findall(G, recorded('$evidence', G, _), LGs),
execute_all(LGs).
:- dynamic node/4, reachable_from_evidence/2, evidence/2.
execute_all([]).
execute_all([M:G|Gs]) :-
call(M:G),
execute_all(Gs).
%
% new evidence storagea algorithm. The idea is that instead of
% redoing all the evidence every time we query the network, we shall
% keep a precompiled version around. The precompiled
%
% the format is as follows:
% evidence_store:parent(Key,ParentList,[EvidenceChildren])
%
%
store_evidence(G) :-
clpbn_flag(solver,Solver, graphs),
compute_evidence(G, Solver).
compute_evidence(G, PreviousSolver) :-
catch(call_residue(G, Vars), Ball, evidence_error(Ball,PreviousSolver)), !,
store_graph(Vars,KEv),
mark_from_evidence(Vars,KEv),
set_clpbn_flag(solver,PreviousSolver).
compute_evidence(_, PreviousSolver) :-
set_clpbn_flag(solver,PreviousSolver).
evidence_error(Ball,PreviousSolver) :-
set_clpbn_flag(solver,PreviousSolver),
throw(Ball).
store_graph([], _).
store_graph([_-node(K,Dom,CPT,TVs,Ev)|Vars], Kev) :-
\+ node(K,_,_,_), !,
assert(node(K,Dom,CPT,TVs)),
( nonvar(Ev) -> assert(evidence(K,Ev)), Kev = K ; true),
store_graph(Vars, Kev).
store_graph([_|Vars], Kev) :-
store_graph(Vars, Kev).
mark_from_evidence([], _).
mark_from_evidence([_-node(K,_,_,_,_)|Vars], Kev) :-
\+ reachable_from_evidence(K,Kev), !,
assert(reachable_from_evidence(K,Kev)),
mark_from_evidence(Vars, Kev).
mark_from_evidence([_|Vars], Kev) :-
mark_from_evidence(Vars, Kev).
incorporate_evidence(Vs,AllVs) :-
new(Cache0),
create_open_list(Vs, OL, FL, Cache0, CacheI),
do_variables(OL, FL, CacheI),
extract_vars(OL, AllVs).
create_open_list([], L, L, C, C).
create_open_list([V|Vs], [K-V|OL], FL, C0, CF) :-
clpbn:get_atts(V,[key(K)]),
add_evidence(K, V),
insert(C0, K, V, CI),
create_open_list(Vs, OL, FL, CI, CF).
do_variables([], [], _) :- !.
do_variables([K-V|Vs], Vf, C0) :-
check_for_evidence(K, V, Vf, Vff, C0, Ci),
do_variables(Vs, Vff, Ci).
create_new_variable(K, V, Vf0, Vff, C0, Cf) :-
node(K,Dom, CPT, TVs),
{ V = K with p(Dom, CPT, NTVs) },
add_evidence(K, V),
add_variables(TVs, NTVs, Vf0, Vff, C0, Cf).
add_variables([], [], Vf, Vf, C, C).
add_variables([K|TVs], [V|NTVs], Vf0, Vff, C0, Cf) :-
lookup(K, V, C0), !,
add_variables(TVs, NTVs, Vf0, Vff, C0, Cf).
add_variables([K|TVs], [V|NTVs], [K-V|Vf0], Vff, C0, Cf) :-
insert(C0, K, V, C1),
create_new_variable(K, V, Vf0, Vf1, C1, C2),
add_variables(TVs, NTVs, Vf1, Vff, C2, Cf).
extract_vars([], []).
extract_vars([_-V|Cache], [V|AllVs]) :-
extract_vars(Cache, AllVs).
add_evidence(K, V) :-
evidence(K, Ev), !,
listing(evidence),
clpbn:put_atts(V, [evidence(Ev)]).
add_evidence(_, _).
check_for_evidence(_, V, Vf, Vf, C, C) :-
clpbn:get_atts(V, [evidence(_)]), !.
check_for_evidence(K, _, Vf0, Vff, C0, Ci) :-
findall(Rt,reachable_from_evidence(K,Rt),Rts),
add_variables(Rts, _, Vf0, Vff, C0, Ci).

39
CLPBN/clpbn/graphs.yap Normal file
View File

@ -0,0 +1,39 @@
%
% Just output a graph with all the variables.
%
:- module(clpbn2graph, [clpbn2graph/1]).
:- use_module(library('clpbn/utils'), [
check_for_hidden_vars/3]).
:- attribute node/0.
clpbn2graph(Vs) :-
check_for_hidden_vars(Vs, Vs, NVs),
clpbn2graph2(NVs).
clpbn2graph2([]).
clpbn2graph2([V|Vs]) :-
put_atts(V,[node]),
clpbn2graph2(Vs).
%
% what is actually output
%
attribute_goal(V, node(K,Dom,CPT,TVs,Ev)) :-
get_atts(V, [node]),
clpbn:get_atts(V, [key(K),dist(Dom,CPT,Vs)]),
translate_vars(Vs,TVs),
( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true).
translate_vars([],[]).
translate_vars([V|Vs],[K|Ks]) :-
clpbn:get_atts(V, [key(K)]),
translate_vars(Vs,Ks).

35
CLPBN/clpbn/utils.yap Normal file
View File

@ -0,0 +1,35 @@
:- module(clpbn_utils, [
clpbn_not_var_member/2,
clpbn_var_member/2,
check_for_hidden_vars/3]).
%
% It may happen that variables from a previous query may still be around.
% and be used in the next evaluation, so we cannot trust the list of *new*
% variables.
%
check_for_hidden_vars([], _, []).
check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :-
check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs),
check_for_hidden_vars(IVs, AllVs, NVs).
check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :-
clpbn:get_atts(V, [dist(_,_,[V1|LV])]), !,
add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs).
check_for_extra_variables(_,AllVs, AllVs, Vs, Vs).
add_old_variables([], AllVs, AllVs, Vs, Vs).
add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs) :-
clpbn_not_var_member(AllVs0, V1), !,
add_old_variables(LV, [V1|AllVs0], AllVs, [V1|Vs], IVs).
add_old_variables([_|LV], AllVs0, AllVs, Vs, IVs) :-
add_old_variables(LV, AllVs0, AllVs, Vs, IVs).
clpbn_var_member([V1|_], V) :- V1 == V, !.
clpbn_var_member([_|Vs], V) :-
clpbn_var_member(Vs, V).
clpbn_not_var_member([], _).
clpbn_not_var_member([V1|Vs], V) :- V1 \== V,
clpbn_not_var_member(Vs, V).

182
CLPBN/clpbn/vel.yap
View File

@ -19,13 +19,16 @@
:- attribute size/1, posterior/4, all_diffs/1.
:- use_module(library(ordsets), [ord_union/3
]).
:- use_module(library(ordsets), [ord_union/3]).
:- use_module(library('clpbn/xbif'), [clpbn2xbif/3]).
:- use_module(library('clpbn/graphviz'), [clpbn2gviz/4]).
:- use_module(library('clpbn/utils'), [
clpbn_not_var_member/2,
check_for_hidden_vars/3]).
:- use_module(library(lists),
[
append/3,
@ -35,49 +38,23 @@
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),
(output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,vel,Vs) ; true),
(output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,vel,Vs,LVs) ; true),
(clpbn:output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,vel,Vs) ; true),
(clpbn:output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,vel,Vs,LVs) ; true),
process(LVi, LVs, tab(Dist,_,_)),
Dist =.. [_|Ps0],
normalise(Ps0,Ps),
bind_vals(LVs,Ps,AllDiffs).
%
% It may happen that variables from a previous query may still be around.
% and be used in the next evaluation, so we cannot trust the list of *new*
% variables.
%
check_for_hidden_vars([], _, []).
check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :-
check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs),
check_for_hidden_vars(IVs, AllVs, NVs).
check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :-
clpbn:get_atts(V, [dist((([_|_].[V1|LV])->_))]), !,
add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs).
check_for_extra_variables(_,AllVs, AllVs, Vs, Vs).
add_old_variables([], AllVs, AllVs, Vs, Vs).
add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs) :-
not_var_member(AllVs0, V1), !,
add_old_variables(LV, [V1|AllVs0], AllVs, [V1|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|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),
get_dist_size(V,Sz),
% variables with evidence should not be processed.
(var(Ev) ->
ProcessedVars = [Var|ProcessedVars0]
@ -87,124 +64,16 @@ find_all_clpbn_vars([V|Vs], [Var|LV], ProcessedVars, [table(I,Table,Deps,Sizes)|
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, [dist(Vals,OTable,VDeps)]),
( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true),
from_dist_get(D,Vals,OTable,VDeps),
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).
from_dist_get(sum.Vs0,Vals,Lf,Vs) :- !,
handle_sum(Vs0, Vals, Lf, Vs).
from_dist_get(normalised_average(Max).Vs0,Vals,Lf,Vs) :- !,
handle_normalised_average(Max,Vs0,Vals,Lf,Vs).
from_dist_get(([A|B].[C|D]),_,[A|B],[C|D]) :- !.
from_dist_get([A|B],_,[A|B],[]).
handle_average(Vs0,Vals,Lf,Vs) :-
sort(Vs0,Vs),
generate_indices(Vals,Inds,0,Av),
combine_all(Vs, Inds, Cs),
length(Vs, Max),
average_possible_cases(0,Av,Max,Cs,Lf).
handle_sum(Vs0, Vals, Lf, Vs) :-
sort(Vs0,Vs),
length(Vals,Sz),
combine_all(Vs, Cs),
sum_possible_cases(0,Sz,Cs,Lf).
handle_normalised_average(Max,Vs0,Vals,Lf,Vs) :-
sort(Vs0,Vs),
generate_indices(Vals,_,0,Sz),
combine_all(Vs, Cs),
average_possible_cases(0,Sz,Max,Cs,Lf).
generate_indices([],[],Av,Av).
generate_indices([_|Ls],[I|Inds],I,Av) :-
I1 is I+1,
generate_indices(Ls,Inds,I1,Av).
combine_all([], [[]]).
combine_all([V|LV], Cs) :-
combine_all(LV, Cs0),
get_dist_els(V,Sz),
generate_indices(0, Sz, Vals),
add_vals(Vals, Cs0, Cs).
combine_all([], _, [[]]).
combine_all([_|LV], Vals, Cs) :-
combine_all(LV, Vals, Cs0),
add_vals(Vals, Cs0, Cs).
generate_indices(Sz,Sz,[]) :- !.
generate_indices(I0,Sz,[I0|Vals]) :-
I is I0+1,
generate_indices(I,Sz,Vals).
add_vals([], _, []).
add_vals([V|Vs], Cs0, Csf) :-
add_vals(Vs, Cs0, Cs),
add_val_to_cases(Cs0, V, Cs, Csf).
add_val_to_cases([], _, Cs, Cs).
add_val_to_cases([C|Cs], V, Cs0, [[V|C]|Csf]) :-
add_val_to_cases(Cs, V, Cs0, Csf).
sum_all([],N,N).
sum_all([C|Cs],N0,N) :-
X is C+N0,
sum_all(Cs,X,N).
average_possible_cases(Av,Av,_,_,[]) :- !.
average_possible_cases(I,Av,Max,Cs,Lf) :-
average_cases2(Cs,I,Max,Lf,L0),
I1 is I+1,
average_possible_cases(I1,Av,Max,Cs,L0).
average_cases2([], _, _, L, L).
average_cases2([C|Cs], I, Av, [P|Lf], L0) :-
calculate_avg_prob(C, I, Av, P),
average_cases2(Cs, I, Av, Lf, L0).
calculate_avg_prob(C, I, Av, 1.0) :-
sum_all(C,0,N),
I =:= integer(round(N/Av)), !.
calculate_avg_prob(_, _, _, 0.0).
sum_possible_cases(Av,Av,_,[]) :- !.
sum_possible_cases(I,Av,Cs,Lf) :-
sum_cases2(Cs,I,Lf,L0),
I1 is I+1,
sum_possible_cases(I1,Av,Cs,L0).
sum_cases2([], _, L, L).
sum_cases2([C|Cs], I, [P|Lf], L0) :-
calculate_sum_prob(C, I, P),
sum_cases2(Cs, I, Lf, L0).
calculate_sum_prob(C, I, 1.0) :-
sum_all(C,0,N),
I =:= N, !.
calculate_sum_prob(_, _, 0.0).
get_sizes([], []).
get_sizes([V|Deps], [Sz|Sizes]) :-
get_dist_els(V,Sz),
get_dist_size(V,Sz),
get_sizes(Deps, Sizes).
get_dist_els(V,Sz) :-
get_atts(V, [size(Sz)]), !.
get_dist_els(V,Sz) :-
clpbn:get_atts(V, [dist((_->Vals))]), !,
length(Vals,Sz),
put_atts(V, [size(Sz)]).
reorder_table(Vs0, Sizes, T0, Vs, TF) :-
get_sizes(Vs0, Szs),
numb_vars(Vs0, Szs, _, VPs0, VLs0),
@ -280,7 +149,7 @@ compute_size([tab(_,Vs,_)|Tabs],Vs0,K) :-
multiply_sizes([],K,K).
multiply_sizes([V|Vs],K0,K) :-
get_dist_els(V, Sz),
get_dist_size(V, Sz),
KI is K0*Sz,
multiply_sizes(Vs,KI,K).
@ -299,7 +168,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,
not_var_member(Inputs, V), !,
clpbn_not_var_member(Inputs, V), !,
find_best(LV, V, K, VF, WorkTables,LV0, Inputs),
(V == VF ->
LVF = LV0, Deps = NWorktables
@ -318,7 +187,7 @@ multiply_tables([tab(Tab1,Deps1,Szs1), tab(Tab2,Deps2,Sz2)| 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))]),
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).
@ -326,7 +195,7 @@ 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))]), !,
clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !,
generate_szs_with_evidence(Out,Ev,Evs).
propagate_evidence(_, _).
@ -342,10 +211,6 @@ fetch_tables([var(_,_,_,_,_,Deps,_)|LV0], Tables) :-
append(Deps,Tables0,Tables),
fetch_tables(LV0, Tables0).
not_var_member([], _).
not_var_member([V1|Vs], V) :- V1 \== V,
not_var_member(Vs, V).
multiply_table(Tab1, Deps1, Szs1, Tab2, Deps2, Szs2, NTab, NDeps, NSzs) :-
deps_union(Deps1,Szs1,Fs10,Deps2,Szs2,Fs20,NDeps,NSzs),
factors(NSzs, Fs, Total),
@ -442,7 +307,7 @@ project_inner_loop(I,Sz,[_|Evs],NBase,F,Table,Ent0,Ent) :- !,
include([],_,_,[]).
include([var(V,P,VSz,D,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Ev,Tabs,Est)|NLV]) :-
not_var_member(Vs,V), !,
clpbn_not_var_member(Vs,V), !,
include(LV,tab(T,Vs,Sz),V1,NLV).
include([var(V,P,VSz,D,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Ev,NTabs,NEst)|NLV]) :-
update_tables(Tabs,NTabs,Table,NV,[],NEst),
@ -453,7 +318,7 @@ update_tables([],[Table],Table,_,AVs,NS) :-
ord_union(Vs,AVs,TVs),
length(TVs,NS).
update_tables([tab(Tab0,Vs,Sz)|Tabs],[tab(Tab0,Vs,Sz)|NTabs],Table,V,AVs0,NS) :-
not_var_member(Vs,V), !,
clpbn_not_var_member(Vs,V), !,
ord_union(Vs,AVs0,AVsI),
update_tables(Tabs,NTabs,Table,V,AVsI,NS).
update_tables([_|Tabs],NTabs,Table,V,AVs0,NS) :-
@ -462,7 +327,7 @@ update_tables([_|Tabs],NTabs,Table,V,AVs0,NS) :-
bind_vals([],_,_) :- !.
% simple case, we want a distribution on a single variable.
%bind_vals([V],Ps) :- !,
% clpbn:get_atts(V, [dist((_->Vals))]),
% clpbn:get_atts(V, [dist(Vals,_,_)]),
% put_atts(V, posterior([V], Vals, Ps)).
% complex case, we want a joint distribution, do it on a leader.
% should split on cliques ?
@ -477,7 +342,7 @@ 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(D,_,_)]),
get_all_doms(Vs, Ds).
ms([], []).
@ -499,6 +364,10 @@ divide_by_sum([P|Ps0],Sum,[PN|Ps]) :-
PN is P/Sum,
divide_by_sum(Ps0,Sum,Ps).
%
% what is actually output
%
attribute_goal(V, G) :-
get_atts(V, [posterior(Vs,Vals,Ps,AllDiffs)]),
massage_out(Vs, Vals, Ps, G, AllDiffs).
@ -520,3 +389,10 @@ add_alldiffs([],Eqs,Eqs).
add_alldiffs(AllDiffs,Eqs,(Eqs/alldiff(AllDiffs))).
get_dist_size(V,Sz) :-
get_atts(V, [size(Sz)]), !.
get_dist_size(V,Sz) :-
clpbn:get_atts(V, [dist(Vals,_,_)]), !,
length(Vals,Sz),
put_atts(V, [size(Sz)]).

34
CLPBN/clpbn/xbif.yap
View File

@ -1,3 +1,7 @@
%
% XMLBIF support for CLP(BN)
%
:- module(xbif, [clpbn2xbif/3]).
clpbn2xbif(Stream, Name, Network) :-
@ -44,8 +48,7 @@ output_vars(Stream, [V|Vs]) :-
output_vars(Stream, Vs).
output_var(Stream, V) :-
clpbn:get_atts(V,[key(Key),dist(DInfo)]),
extract_domain(DInfo,Domain),
clpbn:get_atts(V,[key(Key),dist(Domain,_,_)]),
format(Stream, '<VARIABLE TYPE="nature">
<NAME>',[]),
output_key(Stream,Key),
@ -53,10 +56,6 @@ output_var(Stream, V) :-
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]),
@ -69,35 +68,22 @@ output_dists(Stream, [V|Network]) :-
output_dist(Stream, V) :-
clpbn:get_atts(V,[key(Key),dist((Info))]),
clpbn:get_atts(V,[key(Key),dist(_,CPT,Parents)]),
format(Stream, '<DEFINITION>
<FOR>',[]),
output_key(Stream, Key),
format('</FOR>~n',[]),
output_parents(Stream,Info),
extract_cpt(Info,CPT),
output_parents(Stream,Parents),
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]) :-
output_parents(_,[]).
output_parents(Stream,[P1|Ps]) :-
clpbn:get_atts(P1,[key(Key)]),
format(Stream, '<GIVEN>',[]),
output_key(Stream,Key),
format('</GIVEN>~n',[]),
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_parents(Stream,Ps).
output_cpt(Stream,CPT) :-
format(Stream, ' <TABLE> ', []),