This commit is contained in:
Vítor Santos Costa 2012-03-28 10:59:26 +01:00
parent d149d041a3
commit 0a9076bf4a
2 changed files with 129 additions and 29 deletions

View File

@ -55,6 +55,7 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
:- dynamic network_counting/1.
:- attribute order/1.
check_if_bdd_done(_Var).
@ -66,8 +67,8 @@ 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(AllVars1, AllVars, Leaves),
sort_vars(AllVars0, AllVars, Leaves),
%store_order(AllVars, 0),
rb_new(Vars0),
rb_new(Pars0),
init_tops(Leaves,Tops),
@ -77,6 +78,16 @@ 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),
@ -100,22 +111,110 @@ add_parents(V0.Parents, V, Graph0, GraphF) :-
get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> [].
get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ clpbn:get_atts(V, [dist(DistId, Parents)]) }, !,
%{ clpbn:get_atts(V, [key(K)]), writeln(V:K:DistId:Parents) },
%{writeln(v:DistId:Parents)},
[DIST],
{ check_p(DistId, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
check_v(V, DistId, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
get_parents(Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs)
%, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
},
{ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_vars_info(MoreVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
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) :- !,
length(Domain, DSize),
% reorder(Parents0, Parents),
Parents = Parents0,
run_though_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),
check_p(DistId, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
check_v(V, DistId, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
get_parents(Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs).
%, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
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)),
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),
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),
!,
OUT = 1.
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]
;
L0 = L1
),
( satisf(I00, I10+1, I20, IR, N0, N1, N2, R, Exp) ->
L1 = [P1|L2]
;
L1 = L2
),
( satisf(I00, I10, I20+1, IR, N0, N1, N2, R, Exp) ->
L2 = [P2]
;
L2 = []
),
to_disj(L0, OUT).
generate_3tree(OUT, [[P0,P1,P2]|Ps], 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) ->
I0 is I00+1, generate_3tree(O0, Ps, I0, I10, I20, IR, N0, N1, N2, R, Exp, ExpF)
->
L0 = [P0*O0|L1]
;
L0 = L1
),
( satisf(I00, I10+1, I20, IR0, N0, N1, N2, R, Exp) ->
I1 is I10+1, generate_3tree(O1, Ps, I00, I1, I20, IR, N0, N1, N2, R, Exp, ExpF)
->
L1 = [P1*O1|L2]
;
L1 = L2
),
( satisf(I00, I10, I20+1, IR0, N0, N1, N2, R, Exp) ->
I2 is I20+1, generate_3tree(O2, Ps, I00, I10, I2, IR, N0, N1, N2, R, Exp, ExpF)
->
L2 = [P2*O2]
;
L2 = []
),
to_disj(L0, OUT).
satisf(I0, I1, I2, IR, N0, N1, N2, R, Exp) :-
\+ \+ ( I0 = N0, I1=N1, I2=N2, IR=R, call(Exp) ).
not_satisf(I0, I1, I2, IR, N0, N1, N2, R, Exp) :-
\+ ( I0 = N0, I1=N1, I2=N2, IR=R, call(Exp) ).
to_disj([], 0).
to_disj([V], V).
to_disj([V,V1|Vs], V+Out) :-
to_disj([V1|Vs], Out).
%
% look for parameters in the rb-tree, or add a new.
% distid is the key
@ -299,7 +398,7 @@ get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs).
% hidden deterministic node, can be removed.
get_evidence(_V, _Tree, Ev, F0, [], _Leaves, _Finals) :-
get_evidence(V, _Tree, Ev, F0, [], _Leaves, _Finals) :-
clpbn:get_atts(V, [key(K)]),
functor(K, Name, 2),
( Name = 'AVG' ; Name = 'MAX' ; Name = 'MIN' ),
@ -327,7 +426,7 @@ one_list(1.Ev) :-
% insert a node with the disj of all alternatives, this is only done if node ends up to be in the output
%
insert_output([], _V, [], _Out, _Outs, []).
insert_output(V.Lvs, V0, [Top|_], Top, Outs, [Top = Outs]) :- V == V0, !.
insert_output(V._Leaves, V0, [Top|_], Top, Outs, [Top = Outs]) :- V == V0, !.
insert_output(_.Leaves, V, _.Finals, Top, Outs, SendOut) :-
insert_output(Leaves, V, Finals, Top, Outs, SendOut).
@ -390,13 +489,14 @@ simplify_not(1, 0) :- !.
simplify_not(SS, not(SS)).
run_bdd_solver([[V]], LPs, bdd(Term, Leaves, Nodes)) :-
run_bdd_solver([[V]], LPs, bdd(Term, _Leaves, Nodes)) :-
build_out_node(Nodes, Node),
findall(Prob, get_prob(Term, Node, V, Prob),TermProbs),
sumlist(TermProbs, Sum),
writeln(TermProbs:Sum),
normalise(TermProbs, Sum, LPs).
build_out_node([Top], []).
build_out_node([_Top], []).
build_out_node([T,T1|Tops], [Top = T*Top]) :-
build_out_node2(T1.Tops, Top).

View File

@ -412,7 +412,7 @@ registration(r52,c27,s16).
registration(r53,c26,s16).
registration(r54,c6,s17).
registration(r55,c27,s17).
registration(r56,c0,s17).
%registration(r56,c0,s17).
registration(r57,c51,s18).
registration(r58,c63,s18).
registration(r59,c41,s18).
@ -425,7 +425,7 @@ registration(r65,c22,s20).
registration(r66,c43,s20).
registration(r67,c17,s21).
registration(r68,c34,s21).
registration(r69,c0,s21).
%registration(r69,c0,s21).
registration(r70,c42,s22).
registration(r71,c7,s22).
registration(r72,c46,s22).
@ -515,7 +515,7 @@ registration(r155,c57,s46).
registration(r156,c25,s46).
registration(r157,c46,s46).
registration(r158,c15,s46).
registration(r159,c0,s47).
%registration(r159,c0,s47).
registration(r160,c33,s47).
registration(r161,c30,s47).
registration(r162,c55,s47).
@ -544,7 +544,7 @@ registration(r184,c50,s54).
registration(r185,c43,s54).
registration(r186,c55,s54).
registration(r187,c14,s55).
registration(r188,c0,s55).
%registration(r188,c0,s55).
registration(r189,c31,s55).
registration(r190,c47,s55).
registration(r191,c50,s56).
@ -600,7 +600,7 @@ registration(r240,c20,s71).
registration(r241,c18,s71).
registration(r242,c38,s71).
registration(r243,c37,s72).
registration(r244,c0,s72).
%registration(r244,c0,s72).
registration(r245,c62,s72).
registration(r246,c47,s73).
registration(r247,c53,s73).
@ -619,7 +619,7 @@ registration(r259,c2,s76).
registration(r260,c7,s77).
registration(r261,c3,s77).
registration(r262,c63,s77).
registration(r263,c0,s78).
%registration(r263,c0,s78).
registration(r264,c43,s78).
registration(r265,c57,s78).
registration(r266,c46,s79).
@ -648,7 +648,7 @@ registration(r288,c45,s86).
registration(r289,c17,s86).
registration(r290,c2,s86).
registration(r291,c48,s86).
registration(r292,c0,s86).
%registration(r292,c0,s86).
registration(r293,c40,s87).
registration(r294,c44,s87).
registration(r295,c41,s87).
@ -663,7 +663,7 @@ registration(r303,c50,s90).
registration(r304,c26,s90).
registration(r305,c58,s90).
registration(r306,c45,s90).
registration(r307,c0,s91).
%registration(r307,c0,s91).
registration(r308,c35,s91).
registration(r309,c4,s91).
registration(r310,c4,s92).
@ -677,7 +677,7 @@ registration(r317,c1,s94).
registration(r318,c18,s94).
registration(r319,c35,s94).
registration(r320,c3,s95).
registration(r321,c0,s95).
%registration(r321,c0,s95).
registration(r322,c38,s95).
registration(r323,c1,s96).
registration(r324,c30,s96).
@ -763,7 +763,7 @@ registration(r403,c49,s119).
registration(r404,c61,s119).
registration(r405,c38,s120).
registration(r406,c8,s120).
registration(r407,c0,s120).
%registration(r407,c0,s120).
registration(r408,c60,s121).
registration(r409,c45,s121).
registration(r410,c28,s121).
@ -782,7 +782,7 @@ registration(r422,c29,s125).
registration(r423,c54,s125).
registration(r424,c28,s126).
registration(r425,c22,s126).
registration(r426,c0,s126).
%registration(r426,c0,s126).
registration(r427,c61,s127).
registration(r428,c7,s127).
registration(r429,c28,s127).
@ -1124,7 +1124,7 @@ registration(r764,c10,s227).
registration(r765,c3,s228).
registration(r766,c47,s228).
registration(r767,c54,s228).
registration(r768,c0,s229).
%registration(r768,c0,s229).
registration(r769,c10,s229).
registration(r770,c37,s229).
registration(r771,c62,s230).