more PFL support.

This commit is contained in:
Vítor Santos Costa 2012-09-26 00:04:58 +01:00
parent 83418f8f27
commit 83c5c7e7af
6 changed files with 209 additions and 95 deletions

View File

@ -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),

View File

@ -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], []).

View File

@ -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).
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).
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
% 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).

View File

@ -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).
%
%

View File

@ -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).

View File

@ -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).