From 83c5c7e7afcdc0e785de2c60f270211e8aa6f5cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 26 Sep 2012 00:04:58 +0100 Subject: [PATCH] more PFL support. --- packages/CLPBN/clpbn.yap | 5 +- packages/CLPBN/clpbn/bdd.yap | 12 +- packages/CLPBN/clpbn/connected.yap | 163 +++++++++++-------- packages/CLPBN/clpbn/ve.yap | 116 +++++++++++-- packages/CLPBN/examples/School/README | 4 +- packages/CLPBN/examples/School/school_32.yap | 4 +- 6 files changed, 209 insertions(+), 95 deletions(-) diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 86dc40292..738141875 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -37,7 +37,8 @@ [ve/3, check_if_ve_done/1, init_ve_solver/4, - run_ve_solver/3 + run_ve_solver/3, + call_ve_ground_solver/6 ]). :- use_module('clpbn/horus_ground', @@ -321,6 +322,8 @@ call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !, call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). call_ground_solver(bdd, GVars, GoalKeys, Keys, Factors, Evidence) :- !, call_bdd_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). +call_ground_solver(ve, GVars, GoalKeys, Keys, Factors, Evidence) :- !, + call_ve_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :- % traditional solver b_hash_new(Hash0), diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap index b76db9a10..0eb56a938 100644 --- a/packages/CLPBN/clpbn/bdd.yap +++ b/packages/CLPBN/clpbn/bdd.yap @@ -185,17 +185,14 @@ get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) --> get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :- reorder_keys(Parents0, OrderVs, Parents, Map), check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1), -writeln(v), unbound_parms(Parms, ParmVars), F = f(_,[Size|_],_,_), check_key(V, Size, DIST, Vs, Vs1), DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms), % get a list of form [[P00,P01], [P10,P11], [P20,P21]] -writeln(ps:Parents), foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2), cross_product(Values, Ev, PVars, ParmVars, Formula0), % (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true), -writeln(ev:Evs), get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs). %, (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true) @@ -588,10 +585,10 @@ to_disj2([V,V1|Vs], V0, Out) :- % check_key_p(DistId, _, Map, Parms, ParmVars, Ps, Ps) :- rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !. -check_key_p(DistId, f(_, Sizes, Parms0, _DistId), Map, Parms, ParmVars, Ps, PsF) :- +check_key_p(DistId, f(_, Sizes, Parms0, DistId), Map, Parms, ParmVars, Ps, PsF) :- swap_parms(Parms0, Sizes, [0|Map], Parms1), length(Parms1, L0), - get_dist_domain_size(DistId, Size), + Sizes = [Size|_], L1 is L0 div Size, L is L0-L1, initial_maxes(L1, Multipliers), @@ -798,7 +795,7 @@ skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :- skim_for_theta(More, Ps, Left, New ). get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :- - rb_lookup(Evs, V, Pos), !, + rb_lookup(V, Pos, Evs), !, zero_pos(0, Pos, Ev), insert_output(Leaves, V, Finals, Tree, Outs, SendOut), get_outs(F0, F, SendOut, Outs). @@ -871,13 +868,12 @@ run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :- findall(LPs, (member(Q, QIds), run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))), - LLPs), writeln(LLPs). + LLPs). 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(LPs:TermProbs), normalise(TermProbs, Sum, LPs). build_out_node([_Top], []). diff --git a/packages/CLPBN/clpbn/connected.yap b/packages/CLPBN/clpbn/connected.yap index 967a4f5cc..5996d932a 100644 --- a/packages/CLPBN/clpbn/connected.yap +++ b/packages/CLPBN/clpbn/connected.yap @@ -1,8 +1,12 @@ :- module(clpbn_connected, [influences/3, - init_influences/3, - influences/4]). + factor_influences/4, + init_influences/3, + influences/4] + ). + +:- use_module(library(maplist)). :- use_module(library(dgraphs), [dgraph_new/1, @@ -18,15 +22,29 @@ rb_insert/4, rb_visit/2]). +factor_influences(Vs, QVars, Ev, LV) :- + init_factor_influences(Vs, G, RG), + influences(QVars, Ev, G, RG, LV). + +init_factor_influences(Vs, G, RG) :- + dgraph_new(G0), + foldl(factor_to_dgraph, Vs, G0, G), + dgraph_transpose(G, RG). + influences(Vs, QVars, LV) :- init_influences(Vs, G, RG), - influences(QVars, G, RG, LV). + influences(QVars, [], G, RG, LV). init_influences(Vs, G, RG) :- dgraph_new(G0), to_dgraph(Vs, G0, G), dgraph_transpose(G, RG). +factor_to_dgraph(f([V|Parents],_,_,_), G0, G) :- + dgraph_add_vertex(G0, V, G00), + build_edges(Parents, V, Edges), + dgraph_add_edges(G00, Edges, G). + to_dgraph([], G, G). to_dgraph([V|Vs], G0, G) :- clpbn:get_atts(V, [dist(_,Parents)]), !, @@ -41,103 +59,106 @@ build_edges([P|Parents], V, [P-V|Edges]) :- % search for the set of variables that influence V influences(Vs, G, RG, Vars) :- - rb_new(Visited0), - influences(Vs, G, RG, Visited0, Visited), - all_top(Visited, Vars). + influences(Vs, [], G, RG, Vars). -influences([], _, _, Visited, Visited). -influences([V|LV], G, RG, Vs, NVs) :- - rb_lookup(V, T.B, Vs), T == t, B == b, !, - influences(LV, G, RG, Vs, NVs). -influences([V|LV], G, RG, Vs0, Vs3) :- - rb_insert(Vs0, V, t.b, Vs1), - process_new_variable(V, G, RG, Vs1, Vs2), - influences(LV, G, RG, Vs2, Vs3). +% search for the set of variables that influence V +influences(Vs, Evs, G, RG, Vars) :- + rb_new(Visited0), + foldl(influence(Evs, G, RG), Vs, Visited0, Visited), + all_top(Visited, Evs, Vars). -process_new_variable(V, _G, _RG, _Vs0, _Vs1) :- +influence(_, _G, _RG, V, Vs, Vs) :- + rb_lookup(V, [T|B], Vs), T == t, B == b, !. +influence(Ev, G, RG, V, Vs0, Vs) :- + rb_insert(Vs0, V, [t|b], Vs1), + process_new_variable(V, Ev, G, RG, Vs1, Vs). + +process_new_variable(V, _Evs, _G, _RG, _Vs0, _Vs1) :- + var(V), clpbn:get_atts(V,[evidence(Ev)]), !, throw(error(bound_to_evidence(V/Ev))). -process_new_variable(V, G, RG, Vs0, Vs2) :- +process_new_variable(V, Evs, _G, _RG, _Vs0, _Vs1) :- + rb_lookup(V, Ev, Evs), !, + throw(error(bound_to_evidence(V/Ev))). +process_new_variable(V, Evs, G, RG, Vs0, Vs2) :- dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1), dgraph_neighbors(V, RG, Parents), - throw_all_above(Parents, G, RG, Vs1, Vs2). - -throw_all_below([], _, _, Vs, Vs). -throw_all_below(Child.Children, G, RG, Vs0, Vs2) :- -% clpbn:get_atts(Child,[key(K)]), rb_visit(Vs0, Pairs), writeln(down:Child:K:Pairs), - throw_below(Child, G, RG, Vs0, Vs1), - throw_all_below(Children, G, RG, Vs1, Vs2). + foldl(throw_above(Evs, G, RG), Parents, Vs1, Vs2). % visited -throw_below(Child, G, RG, Vs0, Vs1) :- - rb_lookup(Child, _.B, Vs0), !, +throw_below(Evs, G, RG, Child, Vs0, Vs1) :- + rb_lookup(Child, [_|B], Vs0), !, ( B == b -> Vs0 = Vs1 % been there before ; B = b, % mark it - handle_ball_from_above(Child, G, RG, Vs0, Vs1) + handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1) ). -throw_below(Child, G, RG, Vs0, Vs2) :- - rb_insert(Vs0, Child, _.b, Vs1), - handle_ball_from_above(Child, G, RG, Vs1, Vs2). +throw_below(Evs, G, RG, Child, Vs0, Vs2) :- + rb_insert(Vs0, Child, [_|b], Vs1), + handle_ball_from_above(Child, Evs, G, RG, Vs1, Vs2). % share this with parents, if we have evidence -handle_ball_from_above(V, G, RG, Vs0, Vs1) :- - clpbn:get_atts(V,[evidence(_)]), !, - dgraph_neighbors(V, RG, Parents), - throw_all_above(Parents, G, RG, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !, + dgraph_neighbors(V, RG, Parents), + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + nonvar(V), + rb_lookup(V,_,Evs), !, + dgraph_neighbors(V, RG, Parents), + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). % propagate to kids, if we do not -handle_ball_from_above(V, G, RG, Vs0, Vs1) :- - dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1). +handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, G, Children), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). -throw_all_above([], _, _, Vs, Vs). -throw_all_above(Parent.Parentren, G, RG, Vs0, Vs2) :- -% clpbn:get_atts(Parent,[key(K)]), rb_visit(Vs0, Pairs), writeln(up:Parent:K:Pairs), - throw_above(Parent, G, RG, Vs0, Vs1), - throw_all_above(Parentren, G, RG, Vs1, Vs2). - % visited -throw_above(Parent, G, RG, Vs0, Vs1) :- - rb_lookup(Parent, T._, Vs0), !, +throw_above(Evs, G, RG, Parent, Vs0, Vs1) :- + rb_lookup(Parent, [T|_], Vs0), !, ( T == t -> Vs1 = Vs0 % been there before ; T = t, % mark it - handle_ball_from_below(Parent, G, RG, Vs0, Vs1) + handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1) ). -throw_above(Parent, G, RG, Vs0, Vs2) :- - rb_insert(Vs0, Parent, t._, Vs1), - handle_ball_from_below(Parent, G, RG, Vs1, Vs2). +throw_above(Evs, G, RG, Parent, Vs0, Vs2) :- + rb_insert(Vs0, Parent, [t|_], Vs1), + handle_ball_from_below(Parent, Evs, G, RG, Vs1, Vs2). % share this with parents, if we have evidence -handle_ball_from_below(V, _, _, Vs, Vs) :- - clpbn:get_atts(V,[evidence(_)]), !. +handle_ball_from_below(V, _Evs, _, _, Vs, Vs) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !. +handle_ball_from_below(V, Evs, _, _, Vs, Vs) :- + nonvar(V), + rb_lookup(V, _, Evs), !. % propagate to kids, if we do not -handle_ball_from_below(V, G, RG, Vs0, Vs1) :- - dgraph_neighbors(V, RG, Parents), - propagate_ball_from_below(Parents, V, G, RG, Vs0, Vs1). +handle_ball_from_below(V, Evs, G, RG, Vs0, Vs1) :- + dgraph_neighbors(V, RG, Parents), + propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1). -propagate_ball_from_below([], V, G, RG, Vs0, Vs1) :- !, - dgraph_neighbors(V, G, Children), - throw_all_below(Children, G, RG, Vs0, Vs1). -propagate_ball_from_below(Parents, _V, G, RG, Vs0, Vs1) :- - throw_all_above(Parents, G, RG, Vs0, Vs1). +propagate_ball_from_below([], Evs, V, G, RG, Vs0, Vs1) :- !, + dgraph_neighbors(V, G, Children), + foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1). +propagate_ball_from_below(Parents, Evs, _V, G, RG, Vs0, Vs1) :- + foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1). -all_top(T, Vs) :- - rb_visit(T, Pairs), - get_tops(Pairs, Vs). +all_top(T, Evs, Vs) :- + rb_visit(T, Pairs), + foldl( get_top(Evs), Pairs, [], Vs). -get_tops([], []). -get_tops([V-(T._)|Pairs], V.Vs) :- - T == t, !, - get_tops(Pairs, Vs). -get_tops([V-_|Pairs], V.Vs) :- - clpbn:get_atts(V,[evidence(_)]), !, - get_tops(Pairs, Vs). -get_tops(_.Pairs, Vs) :- - get_tops(Pairs, Vs). +get_top(_EVs, V-[T|_], Vs, [V|Vs]) :- + T == t, !. +get_top(_EVs, V-_, Vs, [V|Vs]) :- + var(V), + clpbn:get_atts(V,[evidence(_)]), !. +get_top(EVs, V-_, Vs, [V|Vs]) :- + nonvar(V), + rb_lookup(V, _, EVs), !. +get_top(_, Vs, Vs). diff --git a/packages/CLPBN/clpbn/ve.yap b/packages/CLPBN/clpbn/ve.yap index faf8b49e6..f6ab08192 100644 --- a/packages/CLPBN/clpbn/ve.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -15,9 +15,10 @@ *********************************/ :- module(clpbn_ve, [ve/3, - check_if_ve_done/1, - init_ve_solver/4, - run_ve_solver/3]). + check_if_ve_done/1, + init_ve_solver/4, + run_ve_solver/3, + call_ve_ground_solver/6]). :- attribute size/1, all_diffs/1. @@ -46,11 +47,14 @@ :- use_module(library('clpbn/connected'), [ init_influences/3, - influences/4 + influences/4, + factor_influences/4 ]). :- use_module(library(clpbn/matrix_cpt_utils)). +:- use_module(library(clpbn/numbers)). + :- use_module(library(lists), [ member/2, @@ -77,16 +81,63 @@ check_if_ve_done(Var) :- get_atts(Var, [size(_)]), !. - % + +% +% new PFL like interface... +% +call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- + call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions), + clpbn_bind_vals([QueryVars], Solutions, Output). + +call_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- + keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), + init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE), + run_solver(QueryKeys, Solutions, VE). + +simulate_ve_ground_solver(_QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- + simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output). + +simulate_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :- + keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), + init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE), + simulate_solver(QueryKeys, Solutions, VE). + + +% % implementation of the well known variable elimination algorithm % ve([[]],_,_) :- !. ve(LLVs,Vs0,AllDiffs) :- - init_ve_solver(LLVs, Vs0, AllDiffs, State), - % variable elimination proper - run_ve_solver(LLVs, LLPs, State), - % bind Probs back to variables so that they can be output. - clpbn_bind_vals(LLVs,LLPs,AllDiffs). + init_ve_solver(LLVs, Vs0, AllDiffs, State), + % variable elimination proper + run_ve_solver(LLVs, LLPs, State), + % bind Probs back to variables so that they can be output. + clpbn_bind_vals(LLVs,LLPs,AllDiffs). + + +init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, BG, Ev)) :- + rb_new(Fs0), + foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF), + sort(FVs, SFVs), + rb_new(VInfo0), + add_vs(SFVs, Fs, VInfo0, VInfo), + BG = bigraph(VInfo, IF, Fs), + rb_new(Ev0), + foldl(evtotree,EvidenceIds,Ev0,Ev). + +evtotree(K=V,Ev0,Ev) :- + rb_insert(Ev0, K, V, Ev). + +factor_to_graph( f(Nodes, Sizes, Pars0, _), Factors0, Factors, Edges0, Edges, I0, I) :- + I is I0+1, + init_CPT(Pars0, Sizes, CPT0), + reorder_CPT(Nodes, CPT0, FIPs, CPT, _), + F = f(I0, FIPs, CPT), + rb_insert(Factors0, I0, F, Factors), + foldl(add_f_to_nodes(I0), Nodes, Edges0, Edges). + +add_f_to_nodes(I0, Node, Edges, [Node-I0|Edges]). + % % Qs is a list of lists with all query vars (marginals) @@ -156,7 +207,7 @@ parent_to_id(VMap, V, DS, I) :- factors_to_vs(Fs, VInfo) :- rb_visit(Fs, L), - foldl(fsvs, L, FVs, []), + fsvs(L, FVs, []), sort(FVs, SFVs), rb_new(VInfo0), add_vs(SFVs, Fs, VInfo0, VInfo). @@ -186,6 +237,46 @@ collect_factors([V-F|SFVs], Fs, V, [FInfo|FInfos], R):- collect_factors(SFVs, Fs, V, FInfos, R). collect_factors(SFVs, _Fs, _V, [], SFVs). +% solve each query independently +% use a findall to recover space without needing for GC +run_solver(LQVs, LLPs, ve(FIds, Hash, Id, BG, Ev)) :- + lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _), + findall(LPs, solve(LQIds, FIds, BG, Ev, LPs), LLPs). + +solve([QVs|_], FIds, Bigraph, Evs, LPs) :- + factor_influences(FIds, QVs, Evs, LVs), + do_solve(QVs, LVs, Bigraph, Evs, LPs). +solve([_|LQVs], FIds, Bigraph, Ev, LPs) :- + solve(LQVs, FIds, Bigraph, Ev, LPs). + +do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :- + % get only what is relevant to query, + project_to_query_related(IVs, OldVs, SVs, Fs1), + % and also prune using evidence + rb_visit(Ev, EvL), + foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), + % eliminate + eliminate(IQVs, digraph(EVs, IF, Fs2), Dist), +% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD), +%exps(LD,LDE),writeln(LDE), + % move from potentials back to probabilities + normalise_CPT(Dist,MPs), + list_from_CPT(MPs, Ps). + +simulate_solver(LQVs, Choices, ve(FIds, Hash, Id, BG, Evs)) :- + lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _), + factor_influences(FIds, QVs, Evs, LVs), + do_simulate(QVs, LVs, BG, Evs, Choices). + +do_simulate(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Choices) :- + % get only what is relevant to query, + project_to_query_related(IVs, OldVs, SVs, Fs1), + % and also prune using evidence + rb_visit(Ev, EvL), + foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs), + % eliminate + simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices). + % solve each query independently % use a findall to recover space without needing for GC run_ve_solver(_, LLPs, state(LQVs, LVs, _VMap, Bigraph, Ev)) :- @@ -277,6 +368,9 @@ check_v(NVs, V) :- clean_v_ev(V=E, FVs0, FVs, Vs0, Vs) :- rb_delete(Vs0, V, Fs, Vs1), foldl2(simplify_f_ev(V, E), Fs, FVs0, FVs, Vs1, Vs). +clean_v_ev(V-E, FVs0, FVs, Vs0, Vs) :- + rb_delete(Vs0, V, Fs, Vs1), + foldl2(simplify_f_ev(V, E), Fs, FVs0, FVs, Vs1, Vs). % % diff --git a/packages/CLPBN/examples/School/README b/packages/CLPBN/examples/School/README index 7b2a725e5..93265adf4 100644 --- a/packages/CLPBN/examples/School/README +++ b/packages/CLPBN/examples/School/README @@ -49,8 +49,8 @@ course_rating(c0,h), course_difficulty(c0,X). course_difficulty(c0,X). -student_ranking(s0,X). +rank(s0,X). -student_ranking(s0,X), student_intelligence(s0,h). +rank(s0,X), student_intelligence(s0,h). diff --git a/packages/CLPBN/examples/School/school_32.yap b/packages/CLPBN/examples/School/school_32.yap index 2a794bbda..3ba7f855a 100644 --- a/packages/CLPBN/examples/School/school_32.yap +++ b/packages/CLPBN/examples/School/school_32.yap @@ -21,8 +21,8 @@ total_students(256). %:- clpbn_horus:set_solver(fove). %:- clpbn_horus:set_solver(hve). :- clpbn_horus:set_solver(bp). -:- clpbn_horus:set_solver(bdd). -%:- clpbn_horus:set_solver(ve). +%:- clpbn_horus:set_solver(bdd). +:- clpbn_horus:set_solver(ve). %:- clpbn_horus:set_solver(cbp). :- ensure_loaded(school32_data).