more PFL support.

2012-09-26 00:04:58 +01:00
parent 83418f8f27
commit 83c5c7e7af
6 changed files with 209 additions and 95 deletions
--- 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).

 %
 %