From 0a9076bf4ad370b7f1e908614e7c8dabcd6a93ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 28 Mar 2012 10:59:26 +0100 Subject: [PATCH] bdd --- packages/CLPBN/clpbn/bdd.yap | 134 +++++++++++++++--- .../CLPBN/examples/School/school32_data.yap | 24 ++-- 2 files changed, 129 insertions(+), 29 deletions(-) diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap index e9ccd83c1..ff0e3d110 100644 --- a/packages/CLPBN/clpbn/bdd.yap +++ b/packages/CLPBN/clpbn/bdd.yap @@ -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). diff --git a/packages/CLPBN/examples/School/school32_data.yap b/packages/CLPBN/examples/School/school32_data.yap index c6c104026..64c85522d 100644 --- a/packages/CLPBN/examples/School/school32_data.yap +++ b/packages/CLPBN/examples/School/school32_data.yap @@ -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).