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

fix bdd with em

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-10-04 00:15:18 +01:00
parent 2d373a28a6
commit b24922fd38
1 changed files with 44 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
packages/CLPBN/clpbn/bdd.yap
View File

@ -151,7 +151,7 @@ order_vars([V|AllVars], I0) :-
init_tops([],[]). init_tops([],[]).
init_tops(_.Leaves,_.Tops) :- init_tops([_|Leaves],[_|Tops]) :-
init_tops(Leaves,Tops). init_tops(Leaves,Tops).
sort_keys(AllFs, AllVars, Leaves) :- sort_keys(AllFs, AllVars, Leaves) :-
@ -161,54 +161,54 @@ sort_keys(AllFs, AllVars, Leaves) :-
dgraph_top_sort(Graph, AllVars). dgraph_top_sort(Graph, AllVars).
add_node(f([K|Parents],_,_,_), Graph0, Graph) :- add_node(f([K|Parents],_,_,_), Graph0, Graph) :-
dgraph_add_vertex(Graph0, K, Graph1), dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph). foldl(add_edge(K), Parents, Graph1, Graph).
add_edge(K, K0, Graph0, Graph) :- add_edge(K, K0, Graph0, Graph) :-
dgraph_add_edge(Graph0, K0, K, Graph). dgraph_add_edge(Graph0, K0, K, Graph).
sort_vars(AllVars0, AllVars, Leaves) :- sort_vars(AllVars0, AllVars, Leaves) :-
dgraph_new(Graph0), dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph), build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves), dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars). dgraph_top_sort(Graph, AllVars).
build_graph([], Graph, Graph). build_graph([], Graph, Graph).
build_graph(V.AllVars0, Graph0, Graph) :- build_graph([V|AllVars0], Graph0, Graph) :-
clpbn:get_atts(V, [dist(_DistId, Parents)]), !, clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1), dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI), add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph). build_graph(AllVars0, GraphI, Graph).
build_graph(_V.AllVars0, Graph0, Graph) :- build_graph(_V.AllVars0, Graph0, Graph) :-
build_graph(AllVars0, Graph0, Graph). build_graph(AllVars0, Graph0, Graph).
add_parents([], _V, Graph, Graph). add_parents([], _V, Graph, Graph).
add_parents(V0.Parents, V, Graph0, GraphF) :- add_parents([V0|Parents], V, Graph0, GraphF) :-
dgraph_add_edge(Graph0, V0, V, GraphI), dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF). add_parents(Parents, V, GraphI, GraphF).
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> []. get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) --> get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !, { rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) }, { F = f([V|Parents], _, _, DistId) },
%{writeln(v:DistId:Parents)}, %{writeln(v:DistId:Parents)},
[DIST], [DIST],
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) }, { get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs). get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :- get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
reorder_keys(Parents0, OrderVs, Parents, Map), reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1), check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars), unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_), F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1), check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms), DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]] % get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2), foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0), cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true), % (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs). get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs).
%, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true) % (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true).
get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> []. get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> [].
get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) --> get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) -->
@ -790,7 +790,7 @@ parents_to_conj(Ps, Theta, Theta*Conj) :-
parents_to_conj2(Ps, Conj). parents_to_conj2(Ps, Conj).
parents_to_conj2([P],P) :- !. parents_to_conj2([P],P) :- !.
parents_to_conj2(P.Ps,P*Conj) :- parents_to_conj2([P|Ps],P*Conj) :-
parents_to_conj2(Ps,Conj). parents_to_conj2(Ps,Conj).
% %
@ -843,10 +843,10 @@ get_evidence(V, Tree, _Values, F0, F1, Leaves, Finals) :-
get_outs(F0, F1, SendOut, Outs). get_outs(F0, F1, SendOut, Outs).
zero_pos(_, _Pos, []). zero_pos(_, _Pos, []).
zero_pos(Pos, Pos, 1.Values) :- !, zero_pos(Pos, Pos, [1|Values]) :- !,
I is Pos+1, I is Pos+1,
zero_pos(I, Pos, Values). zero_pos(I, Pos, Values).
zero_pos(I0, Pos, 0.Values) :- zero_pos(I0, Pos, [0|Values]) :-
I is I0+1, I is I0+1,
zero_pos(I, Pos, Values). zero_pos(I, Pos, Values).
@ -866,13 +866,13 @@ insert_output(_.Leaves, V, _.Finals, Top, Outs, SendOut) :-
get_outs([V=F], [V=NF|End], End, V) :- !, get_outs([V=F], [V=NF|End], End, V) :- !,
% writeln(f0:F), % writeln(f0:F),
simplify_exp(F,NF). simplify_exp(F,NF).
get_outs((V=F).Outs, (V=NF).NOuts, End, (F0 + V)) :- get_outs([(V=F)|Outs], [(V=NF)|NOuts], End, (F0 + V)) :-
% writeln(f0:F), % writeln(f0:F),
simplify_exp(F,NF), simplify_exp(F,NF),
get_outs(Outs, NOuts, End, F0). get_outs(Outs, NOuts, End, F0).
eval_outs([]). eval_outs([]).
eval_outs((V=F).Outs) :- eval_outs([(V=F)|Outs]) :-
simplify_exp(F,NF), simplify_exp(F,NF),
V = NF, V = NF,
eval_outs(Outs). eval_outs(Outs).
@ -890,9 +890,10 @@ run_bdd_solver([Vs], LPs, bdd(Term, _Leaves, Nodes)) :-
sumlist(TermProbs, Sum), sumlist(TermProbs, Sum),
normalise(TermProbs, Sum, LPs). normalise(TermProbs, Sum, LPs).
% output node for BDDs
build_out_node([_Top], []). build_out_node([_Top], []).
build_out_node([T,T1|Tops], [Top = T*Top]) :- build_out_node([T,T1|Tops], [_Top = T*NTop]) :-
build_out_node2(T1.Tops, Top). build_out_node2([T1|Tops], NTop).
build_out_node2([Top], Top). build_out_node2([Top], Top).
build_out_node2([T,T1|Tops], T*Top) :- build_out_node2([T,T1|Tops], T*Top) :-
@ -937,7 +938,7 @@ bind_all([info(_V, _Tree, _Ev, _Values, Formula, ParmVars, Parms)|Term], End, Bi
bind_all(Term, End, BindsI, V0s, AllParms, AllTheta). bind_all(Term, End, BindsI, V0s, AllParms, AllTheta).
bind_formula([], L, L). bind_formula([], L, L).
bind_formula(B.Formula, B.BsF, Bs0) :- bind_formula([B|Formula], [B|BsF], Bs0) :-
bind_formula(Formula, BsF, Bs0). bind_formula(Formula, BsF, Bs0).
set_to_one_zeros([1|Values]) :- set_to_one_zeros([1|Values]) :-
@ -946,15 +947,15 @@ set_to_one_zeros([0|Values]) :-
set_to_one_zeros(Values). set_to_one_zeros(Values).
set_to_zeros([]). set_to_zeros([]).
set_to_zeros(0.Values) :- set_to_zeros([0|Values]) :-
set_to_zeros(Values). set_to_zeros(Values).
set_to_ones([]). set_to_ones([]).
set_to_ones(1.Values) :- set_to_ones([1|Values]) :-
set_to_ones(Values). set_to_ones(Values).
normalise([], _Sum, []). normalise([], _Sum, []).
normalise(P.TermProbs, Sum, NP.LPs) :- normalise([P|TermProbs], Sum, [NP|LPs]) :-
NP is P/Sum, NP is P/Sum,
normalise(TermProbs, Sum, LPs). normalise(TermProbs, Sum, LPs).