improve bdd support.
This commit is contained in:
Vítor Santos Costa
parent
3d216cf9db
commit
e130c26c6d
@ -41,6 +41,7 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
|
||||
:- use_module(library('clpbn/aggregates'),
|
||||
[check_for_agg_vars/2]).
|
||||
|
||||
|
||||
:- use_module(library(atts)).
|
||||
|
||||
:- use_module(library(hacks)).
|
||||
@ -67,27 +68,25 @@ bdd([QueryVars], AllVars, AllDiffs) :-
|
||||
clpbn_bind_vals([QueryVars], [LPs], AllDiffs).
|
||||
|
||||
init_bdd_solver(_, AllVars0, _, bdd(Term, Leaves, Tops)) :-
|
||||
% check_for_agg_vars(AllVars0, AllVars1),
|
||||
sort_vars(AllVars0, AllVars, Leaves),
|
||||
%store_order(AllVars, 0),
|
||||
order_vars(AllVars, 0),
|
||||
rb_new(Vars0),
|
||||
rb_new(Pars0),
|
||||
init_tops(Leaves,Tops),
|
||||
get_vars_info(AllVars, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
|
||||
|
||||
order_vars([], _).
|
||||
order_vars([V|AllVars], I0) :-
|
||||
put_atts(V, [order(I0)]),
|
||||
I is I0+1,
|
||||
order_vars(AllVars, I).
|
||||
|
||||
|
||||
init_tops([],[]).
|
||||
init_tops(_.Leaves,_.Tops) :-
|
||||
init_tops(Leaves,Tops).
|
||||
|
||||
%
|
||||
% keep an attribute for sorting variables
|
||||
%
|
||||
store_order([], _).
|
||||
store_order(V.AllVars, I0) :-
|
||||
put_atts(V,[order(I0)]),
|
||||
I is I0+1,
|
||||
store_order(AllVars, I).
|
||||
|
||||
|
||||
sort_vars(AllVars0, AllVars, Leaves) :-
|
||||
dgraph_new(Graph0),
|
||||
build_graph(AllVars0, Graph0, Graph),
|
||||
@ -122,10 +121,10 @@ get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
|
||||
% let's have some fun with avg
|
||||
%
|
||||
get_var_info(V, avg(Domain), Parents0, Vs, Vs2, Ps, Ps, Lvs, Outs, DIST) :- !,
|
||||
reorder_vars(Parents0, Parents),
|
||||
length(Domain, DSize),
|
||||
% reorder(Parents0, Parents),
|
||||
Parents = Parents0,
|
||||
run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
|
||||
% run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
|
||||
bup_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
|
||||
% standard random variable
|
||||
get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
|
||||
% clpbn:get_atts(V, [key(K)]), writeln(V:K:DistId:Parents),
|
||||
@ -140,27 +139,45 @@ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
|
||||
get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs).
|
||||
%, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
|
||||
|
||||
reorder_vars(Vs, OVs) :-
|
||||
add_pos(Vs, PVs),
|
||||
keysort(PVs, SVs),
|
||||
remove_key(SVs, OVs1),
|
||||
reverse(OVs1, OVs).
|
||||
|
||||
add_pos([], []).
|
||||
add_pos([V|Vs], [K-V|PVs]) :-
|
||||
get_atts(V,[order(K)]),
|
||||
add_pos(Vs, PVs).
|
||||
|
||||
remove_key([], []).
|
||||
remove_key([_-V|SVs], [V|OVs]) :-
|
||||
remove_key(SVs, OVs).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% use top-down to generate average
|
||||
%
|
||||
run_though_avg(V, 3, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
|
||||
check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
|
||||
DIST = info(V, Tree, Ev, [V0,V1,V2], Formula, [], []),
|
||||
get_parents(Parents, PVars, Vs1, Vs2),
|
||||
length(Parents, N),
|
||||
generate_3tree(F00, PVars, 0, 0, 0, N, N0, N1, N2, R, (N1+2*N2 =< N/2), (N1+2*(N2+R) > N/2)),
|
||||
generate_3tree(F00, PVars, 0, 0, 0, N, N0, N1, N2, R, (N1+2*N2 =< N/2), (N1+2*(N2+R) =< N/2)),
|
||||
simplify_exp(F00, F0),
|
||||
writeln(1:PVars=F0),
|
||||
% generate_3tree(F1, PVars, 0, 0, 0, N, N0, N1, N2, R, ((N1+2*(N2+R) > N/2, N1+2*N2 < (3*N)/2))),
|
||||
generate_3tree(F20, PVars, 0, 0, 0, N, N0, N1, N2, R, (N1+2*(N2+R) >= (3*N)/2), N1+2*N2 < (3*N)/2),
|
||||
generate_3tree(F20, PVars, 0, 0, 0, N, N0, N1, N2, R, (N1+2*(N2+R) >= (3*N)/2), N1+2*N2 >= (3*N)/2),
|
||||
simplify_exp(F20, F2),
|
||||
writeln(3:PVars=F2),
|
||||
Formula0 = [V0=F0*Ev0,V2=F2*Ev2,V1=not(F0+F2)*Ev1],
|
||||
Ev = [Ev0,Ev1,Ev2],
|
||||
get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs).
|
||||
|
||||
generate_3tree(OUT, _, I00, I10, I20, IR0, N0, N1, N2, R, _Exp, ExpF) :-
|
||||
not_satisf(I00, I10, I20, IR0, N0, N1, N2, R, ExpF),
|
||||
IR is IR0-1,
|
||||
satisf(I00, I10, I20, IR, N0, N1, N2, R, ExpF),
|
||||
!,
|
||||
OUT = 1.
|
||||
generate_3tree(OUT, [[P0,P1,P2]], I00, I10, I20, IR0, N0, N1, N2, R, Exp, ExpF) :-
|
||||
generate_3tree(OUT, [[P0,P1,P2]], I00, I10, I20, IR0, N0, N1, N2, R, Exp, _ExpF) :-
|
||||
IR is IR0-1,
|
||||
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
|
||||
L0 = [P0|L1]
|
||||
@ -210,10 +227,87 @@ satisf(I0, I1, I2, IR, N0, N1, N2, R, Exp) :-
|
||||
not_satisf(I0, I1, I2, IR, N0, N1, N2, R, Exp) :-
|
||||
\+ ( I0 = N0, I1=N1, I2=N2, IR=R, call(Exp) ).
|
||||
|
||||
%%%%%%%%%%%%%%%%%%%%%%%%%
|
||||
%
|
||||
% use bottom-up dynamic programming to generate average
|
||||
%
|
||||
bup_avg(V, Size, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
|
||||
check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
|
||||
DIST = info(V, Tree, Ev, OVs, Formula, [], []),
|
||||
get_parents(Parents, PVars, Vs1, Vs2),
|
||||
generate_sums(PVars, Size, Max, Sums, F0),
|
||||
% length(Parents, N),
|
||||
% Max is (Size-1)*N, % This should be true
|
||||
% easier to do recursion on lists
|
||||
Sums =.. [_|LSums],
|
||||
generate_avg(0, Size, 0, Max, LSums, OVs, Ev, F1, []),
|
||||
reverse(F0, RF0),
|
||||
get_evidence(V, Tree, Ev, F1, F2, Lvs, Outs),
|
||||
append(RF0, F2, Formula).
|
||||
|
||||
generate_sums([PVals], Size, Max, Sum, []) :- !,
|
||||
Max is Size-1,
|
||||
Sum =.. [sum|PVals].
|
||||
generate_sums([PVals|Parents], Size, Max, NewSums, F) :-
|
||||
generate_sums(Parents, Size, Max0, Sums, F0),
|
||||
Max is Max0+(Size-1),
|
||||
Max1 is Max+1,
|
||||
functor(NewSums, sum, Max1),
|
||||
expand_sums(PVals, 0, Max0, Max1, Size, Sums, NewSums, F, F0).
|
||||
|
||||
%
|
||||
% outer loop: generate array of sums at level j= Sum[j0...jMax]
|
||||
%
|
||||
expand_sums(_Parents, Max, _, Max, _Size, _Sums, _NewSums, F0, F0) :- !.
|
||||
expand_sums(Parents, I0, Max0, Max, Size, Sums, NewSums, F, F0) :-
|
||||
I is I0+1,
|
||||
arg(I, NewSums, O),
|
||||
sum_all(Parents, 0, I0, Max0, Sums, List),
|
||||
to_disj(List, SUM),
|
||||
expand_sums(Parents, I, Max0, Max, Size, Sums, NewSums, F, [O=SUM|F0]).
|
||||
|
||||
%
|
||||
%inner loop: find all parents that contribute to A_ji,
|
||||
% that is generate Pk*Sum_(j-1)l and k+l st k+l = i
|
||||
%
|
||||
sum_all([], _, _, _, _, []).
|
||||
sum_all([V|Vs], Pos, I, Max0, Sums, [V*S0|List]) :-
|
||||
J is I-Pos,
|
||||
J >= 0,
|
||||
J =< Max0, !,
|
||||
J1 is J+1,
|
||||
arg(J1, Sums, S0),
|
||||
Pos1 is Pos+1,
|
||||
sum_all(Vs, Pos1, I, Max0, Sums, List).
|
||||
sum_all([_V|Vs], Pos, I, Max0, Sums, List) :-
|
||||
Pos1 is Pos+1,
|
||||
sum_all(Vs, Pos1, I, Max0, Sums, List).
|
||||
|
||||
|
||||
generate_avg(Size, Size, _J, _Max, [], [], [], F, F).
|
||||
generate_avg(I0, Size, J0, Max, LSums, [O|OVs], [Ev|Evs], [O=Disj*Ev|F], F0) :-
|
||||
I is I0+1,
|
||||
Border is (I*Max)/Size,
|
||||
fetch_for_avg(J0, Border, J, LSums, MySums, RSums),
|
||||
to_disj(MySums, Disj),
|
||||
generate_avg(I, Size, J, Max, RSums, OVs, Evs, F, F0).
|
||||
|
||||
fetch_for_avg(J, Border, J, RSums, [], RSums) :-
|
||||
J > Border, !.
|
||||
fetch_for_avg(J0, Border, J, [S|LSums], [S|MySums], RSums) :-
|
||||
J1 is J0+1,
|
||||
fetch_for_avg(J1, Border, J, LSums, MySums, RSums).
|
||||
|
||||
|
||||
to_disj([], 0).
|
||||
to_disj([V], V).
|
||||
to_disj([V,V1|Vs], V+Out) :-
|
||||
to_disj([V1|Vs], Out).
|
||||
to_disj([V,V1|Vs], Out) :-
|
||||
to_disj2([V1|Vs], V, Out).
|
||||
|
||||
to_disj2([V], V0, V0+V).
|
||||
to_disj2([V,V1|Vs], V0, Out) :-
|
||||
to_disj2([V1|Vs], V0+V, Out).
|
||||
|
||||
|
||||
%
|
||||
% look for parameters in the rb-tree, or add a new.
|
||||
@ -345,7 +439,7 @@ apply_parents_second([Value|Values], [E|Ev], Previous, P0, PVars, (Value=Disj*E)
|
||||
|
||||
apply_first_parent([Parents], Conj, [Theta]) :- !,
|
||||
parents_to_conj(Parents,Theta,Conj).
|
||||
apply_first_parent(Parents.PVars, Disj+Conj, Theta.TheseParents) :-
|
||||
apply_first_parent(Parents.PVars, Conj+Disj, Theta.TheseParents) :-
|
||||
parents_to_conj(Parents,Theta,Conj),
|
||||
apply_first_parent(PVars, Disj, TheseParents).
|
||||
|
||||
@ -370,18 +464,18 @@ apply_last_parent(Parents.PVars, Other, Conj+Disj) :-
|
||||
% simplify stuff, removing process that is cancelled by 0s
|
||||
%
|
||||
parents_to_conj([], Theta, Theta) :- !.
|
||||
parents_to_conj(Ps, Theta, Conj*Theta) :-
|
||||
parents_to_conj(Ps, Theta, Theta*Conj) :-
|
||||
parents_to_conj2(Ps, Conj).
|
||||
|
||||
parents_to_conj2([P],P) :- !.
|
||||
parents_to_conj2(P.Ps,Conj*P) :-
|
||||
parents_to_conj2(P.Ps,P*Conj) :-
|
||||
parents_to_conj2(Ps,Conj).
|
||||
|
||||
%
|
||||
% first case we haven't reached the end of the list so we need
|
||||
% to create a new parameter variable
|
||||
%
|
||||
skim_for_theta([[P|Other]|V], New*not(P), [Other|_], New) :- var(V), !.
|
||||
skim_for_theta([[P|Other]|V], not(P)*New, [Other|_], New) :- var(V), !.
|
||||
%
|
||||
% last theta, it is just negation of the other ones
|
||||
%
|
||||
@ -389,7 +483,7 @@ skim_for_theta([[P|Other]], not(P), [Other], _) :- !.
|
||||
%
|
||||
% recursive case, build-up
|
||||
%
|
||||
skim_for_theta([[P|Other]|More], Ps*not(P), [Other|Left], New ) :-
|
||||
skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :-
|
||||
skim_for_theta(More, Ps, Left, New ).
|
||||
|
||||
get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
|
||||
@ -432,8 +526,10 @@ insert_output(_.Leaves, V, _.Finals, Top, Outs, SendOut) :-
|
||||
|
||||
|
||||
get_outs([V=F], [V=NF|End], End, V) :- !,
|
||||
% writeln(f0:F),
|
||||
simplify_exp(F,NF).
|
||||
get_outs((V=F).Outs, (V=NF).NOuts, End, (F0 + V)) :-
|
||||
% writeln(f0:F),
|
||||
simplify_exp(F,NF),
|
||||
get_outs(Outs, NOuts, End, F0).
|
||||
|
||||
@ -441,7 +537,7 @@ eval_outs([]).
|
||||
eval_outs((V=F).Outs) :-
|
||||
simplify_exp(F,NF),
|
||||
V = NF,
|
||||
get_outs(Outs).
|
||||
eval_outs(Outs).
|
||||
|
||||
%simplify_exp(V,V) :- !.
|
||||
simplify_exp(V,V) :- var(V), !.
|
||||
@ -515,7 +611,10 @@ get_prob(Term, Node, V, SP) :-
|
||||
|
||||
build_bdd(Bindings, NVs, VTheta, Theta, Bdd) :-
|
||||
bdd_from_list(Bindings, NVs, Bdd),
|
||||
bdd_tree(Bdd, bdd(_F,Tree,_Vs)), length(Tree, Len),
|
||||
bdd_size(Bdd, Len),
|
||||
% number_codes(Len,Codes),
|
||||
% atom_codes(Name,Codes),
|
||||
% bdd_print(Bdd, Name),
|
||||
writeln(length=Len),
|
||||
VTheta = Theta.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user