new ve

packages/CLPBN/Makefile.in

@@ -63,6 +63,7 @@ CLPBN_PROGRAMS= \
 	$(CLPBN_SRCDIR)/utils.yap \
 	$(CLPBN_SRCDIR)/ve.yap \
 	$(CLPBN_SRCDIR)/viterbi.yap \
+	$(CLPBN_SRCDIR)/vmap.yap \
 	$(CLPBN_SRCDIR)/xbif.yap
 
 CLPBN_LEARNING_PROGRAMS= \
@@ -94,7 +95,7 @@ CLPBN_HMMER_EXAMPLES= \
 	$(CLPBN_EXDIR)/HMMer/score.yap
 
 CLPBN_LEARNING_EXAMPLES= \
-	$(CLPBN_EXDIR)/learning/profz_params.pfl \
+	$(CLPBN_EXDIR)/learning/prof_params.pfl \
 	$(CLPBN_EXDIR)/learning/school_params.pfl \
 	$(CLPBN_EXDIR)/learning/sprinkler_params.yap \
 	$(CLPBN_EXDIR)/learning/train.yap

packages/CLPBN/clpbn.yap

@@ -19,6 +19,7 @@
 :- use_module(library(bhash)).
 :- use_module(library(lists)).
 :- use_module(library(terms)).
+:- use_module(library(maplist)).
 
 %
 % avoid the overhead of using goal_expansion/2.
@@ -320,58 +321,47 @@ call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
 call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
 	% traditional solver
 	b_hash_new(Hash0),
-	gvars_in_hash(GVars,Hash0, HashI), 
+	foldl(gvar_in_hash, GVars, Hash0, HashI), 
-	keys_to_vars(Keys, AllVars, HashI, Hash1),
+	foldl(key_to_var, Keys, AllVars, HashI, Hash1),
-	evidence_to_vars(Evidence, _EVars, Hash1, Hash),
+	foldl(evidence_to_v, Evidence, _EVars, Hash1, Hash),
-	factors_to_dists(Factors, Hash),
+	writeln(Keys:AllVars),
+	maplist(factor_to_dist(Hash), Factors),
 	% evidence
 	retract(use_parfactors(on)),
 	write_out(Solver, [GVars], AllVars, _),
 	assert(use_parfactors(on)).
 
 %
-% convert a PFL network (without constriants)
+% convert a PFL network (without constraints)
 % into CLP(BN) for evaluation
 %
-gvars_in_hash([V|GVars],Hash0, Hash) :-
+gvar_in_hash(V, Hash0, Hash) :-
 	get_atts(V, [key(K)]),
-	b_hash_insert(Hash0, K, V, HashI),
+	b_hash_insert(Hash0, K, V, Hash). 
-	gvars_in_hash(GVars,HashI, Hash).
-gvars_in_hash([],Hash, Hash). 
 
+key_to_var(K, V, Hash0, Hash0) :-
+	b_hash_lookup(K, V, Hash0), !.
+key_to_var(K, V,Hash0, Hash) :-
+	put_atts(V, [key(K)]),
+	b_hash_insert(Hash0, K, V, Hash).
 
-keys_to_vars([], [], Hash, Hash).
+evidence_to_v(K=E, V, Hash0, Hash0) :-
-keys_to_vars([K|Keys], [V|Vs], Hash0, Hash) :-
 	b_hash_lookup(K, V, Hash0), !,
-	keys_to_vars(Keys, Vs, Hash0, Hash).
+	clpbn:put_atts(V,[evidence(E)]).
-keys_to_vars([K|Keys], [V|Vs],Hash0, Hash) :-
+evidence_to_v(K=E, V, Hash0, Hash) :-
-	b_hash_insert(Hash0, K, V, HashI),
+	b_hash_insert(Hash0, K, V, Hash),
-	keys_to_vars(Keys, Vs, HashI, Hash).
+	clpbn:put_atts(V,[evidence(E)]).
 
-evidence_to_vars([], [], Hash, Hash).
+factor_to_dist(Hash, f(bayes, Id, Ks)) :-
-evidence_to_vars([K=E|Keys], [V|Vs], Hash0, Hash) :-
+	maplist(key_to_var(Hash), Ks, [V|Parents]),
-	b_hash_lookup(K, V, Hash0), !,
-	clpbn:put_atts(V,[evidence(E)]),
-	evidence_to_vars(Keys, Vs, Hash0, Hash).
-evidence_to_vars([K=E|Keys], [V|Vs],Hash0, Hash) :-
-	b_hash_insert(Hash0, K, V, HashI),
-	clpbn:put_atts(V,[evidence(E)]),
-	evidence_to_vars(Keys, Vs, HashI, Hash).
-
-factors_to_dists([], _Hash).
-factors_to_dists([f(bayes,_Id,Ks,CPT)|Factors], Hash) :-
-	keys_to_vars(Ks, Hash, [V|Parents]),
 	Ks =[Key|_],
 	pfl:skolem(Key, Domain),
+	pfl:get_pfl_parameters(Id, CPT),
 	dist(p(Domain,CPT,Parents), DistInfo, Key, Parents),
-	put_atts(V,[dist(DistInfo,Parents)]),
+	put_atts(V,[dist(DistInfo,Parents)]).
-	factors_to_dists(Factors, Hash).
-
-keys_to_vars([], _Hash, []).
-keys_to_vars([K|Ks], Hash, [V|Vs]) :-
-	b_hash_lookup(K,V,Hash),
-	keys_to_vars(Ks, Hash, Vs).
 
+key_to_var(Hash, K, V) :-
+	b_hash_lookup(K, V, Hash).
 
 get_bnode(Var, Goal) :-
 	get_atts(Var, [key(Key),dist(Dist,Parents)]),

packages/CLPBN/clpbn/aggregates.yap

@@ -38,7 +38,7 @@ check_for_agg_vars([V|Vs0], [V|Vs1]) :-
 	clpbn:get_atts(V, [key(K), dist(Id,Parents)]), !,
 	simplify_dist(Id, V, K, Parents, Vs0, Vs00),
 	check_for_agg_vars(Vs00, Vs1).
-check_for_agg_vars([_|Vs0], Vs1) :-
+check_for_agg_vars([V|Vs0], [V|Vs1]) :-
 	check_for_agg_vars(Vs0, Vs1).
 
 % transform aggregate distribution into tree

packages/CLPBN/clpbn/discrete_utils.yap

@@ -8,7 +8,7 @@
 %
 % remove columns from a table
 %
-project_from_CPT(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs)) :-
+project_from_CPT(V,f(Table,Deps,Szs),f(NewTable,NDeps,NSzs)) :-
 	propagate_evidence(V,Evs),
 	functor(Table,_,Max),
 	find_projection_factor(Deps, V, NDeps, Szs, NSzs, F, Sz),

packages/CLPBN/clpbn/ground_factors.yap

@@ -23,6 +23,8 @@
 	  nth0/3,
 	  member/2]).
 
+:- use_module(library(maplist)).
+
 :- use_module(library(pfl), [
           factor/6,
           defined_in_factor/2,
@@ -44,7 +46,7 @@ generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
 	include_evidence(AVars, Evidence0, Evidence),
 	b_hash_to_list(Evidence, EList0), list_to_evlist(EList0, EList),
 	run_through_evidence(EList),
-	run_through_queries(QueryVars, QueryKeys, Evidence),
+	run_through_query(Evidence, QueryVars, QueryKeys),
 	propagate,
 	collect(Keys, Factors).
 
@@ -88,20 +90,15 @@ include_static_evidence([K=E|AVars], Evidence0, Evidence) :-
 	include_evidence(AVars, EvidenceI, Evidence).
 
 
-run_through_queries([QVars|QueryVars], [GKs|GKeys], E) :-
+run_through_query(_, [], []).
-	run_through_query(QVars, GKs, E),
+run_through_query(Evidence, [V|QueryVars], QueryKeys) :-
-	run_through_queries(QueryVars, GKeys, E).
-run_through_queries([], [], _).
-
-run_through_query([], [], _).
-run_through_query([V|QueryVars], QueryKeys, Evidence) :-
 	clpbn:get_atts(V,[key(K)]),
 	b_hash_lookup(K, _, Evidence), !,
-	run_through_query(QueryVars, QueryKeys, Evidence).
+	run_through_query(Evidence, QueryVars, QueryKeys).
-run_through_query([V|QueryVars], [K|QueryKeys], Evidence) :-
+run_through_query(Evidence, [V|QueryVars], [K|QueryKeys]) :-
 	clpbn:get_atts(V,[key(K)]),
 	queue_in(K),
-	run_through_query(QueryVars, QueryKeys, Evidence).
+	run_through_query(Evidence, QueryVars, QueryKeys).
 
 collect(Keys, Factors) :-
 	findall(K, currently_defined(K), Keys),
@@ -142,8 +139,10 @@ initialize_evidence([V|EVars]) :-
 queue_in(K) :-
 	queue(K), !.
 queue_in(K) :-
-	%writeln(+K),
+	writeln(+K),
-	assert(queue(K)).
+	assert(queue(K)),
+	fail.
+queue_in(_).
 
 propagate :-
 	retract(queue(K)),!,
@@ -167,7 +166,7 @@ do_propagate(K) :-
 	\+ currently_defined(K1),
 	queue_in(K1),
 	fail.
-do_propagate(K) :-
+do_propagate(_K) :-
         propagate.
 
 add_factor(factor(Type, Id, Ks, _, Phi, Constraints), Ks) :-

packages/CLPBN/clpbn/matrix_cpt_utils.yap

@@ -1,10 +1,13 @@
 :- module(clpbn_matrix_utils,
-	  [init_CPT/2,
+	  [init_CPT/3,
 	   project_from_CPT/3,
+	   sum_out_from_CPT/5,
+	   project_from_CPT/6,
 	   reorder_CPT/5,
 	   get_CPT_sizes/2,
 	   normalise_CPT/2,
 	   multiply_CPTs/4,
+	   multiply_CPTs/6,
 	   divide_CPTs/3,
 	   expand_CPT/4,
 	   reset_CPT_that_disagrees/5,
@@ -51,6 +54,20 @@ init_CPT(List, Sizes, TAB) :-
 init_possibly_deterministic_CPT(List, Sizes, TAB) :-
 	matrix_new(floats, Sizes, List, TAB).
 
+%
+% select elements of matrix Table such that V=Pos
+%
+project_from_CPT(V, Pos, Table, Deps, NewTable, NDeps) :-
+	vnth(Deps, 0, V, N, NDeps),
+	matrix_select(Table, N, Pos, NewTable).
+
+%
+% sum-out varibale V from Table
+%
+sum_out_from_CPT(V, Table, Deps, NewTable, NDeps) :-
+	vnth(Deps, 0, V, N, NDeps),
+	matrix_sum_logs_out(Table, N, NewTable).
+
 project_from_CPT(V,tab(Table,Deps,_),tab(NewTable,NDeps,NSzs)) :-
 	evidence(V,Pos), !,
 	vnth(Deps, 0, V, N, NDeps),
@@ -133,6 +150,14 @@ multiply_CPTs(tab(Tab1, Deps1, Sz1), tab(Tab2, Deps2, Sz2), tab(OT, NDeps, NSz),
 	matrix_op(NTab1,NTab2,+,OT),
 	matrix_dims(OT,NSz).
 
+multiply_CPTs(Tab1, Deps1, Tab2, Deps2, OT, NDeps) :-
+	matrix_dims(Tab1, Sz1),
+	matrix_dims(Tab2, Sz2),
+	expand_tabs(Deps1, Sz1, Deps2, Sz2, Map1, Map2, NDeps),
+	matrix_expand_compact(Tab1, Map1, NTab1),
+	matrix_expand_compact(Tab2, Map2, NTab2),
+	matrix_op(NTab1,NTab2,+,OT).
+
 
 expand_tabs([], [], [], [], [], [], []).
 expand_tabs([V1|Deps1], [S1|Sz1], [], [], [0|Map1], [S1|Map2], [V1|NDeps]) :-

packages/CLPBN/clpbn/ve.yap

@@ -33,6 +33,8 @@
 	      [
 	       dist/4,
 	       get_dist_domain_size/2,
+	       get_dist_params/2,
+	       get_dist_domain_size/2,
 	       get_dist_matrix/5]).
 
 :- use_module(library('clpbn/utils'), [
@@ -47,243 +49,322 @@
 	       influences/4
 	      ]).
 
-:- use_module(library('clpbn/matrix_cpt_utils'),
+:- use_module(library(clpbn/matrix_cpt_utils)).
-	      [project_from_CPT/3,
-	       reorder_CPT/5,
-	       multiply_CPTs/4,
-	       normalise_CPT/2,
-	       sum_out_from_CPT/4,
-	       list_from_CPT/2]).
 
 :- use_module(library(lists),
 	      [
-	       append/3
+	       member/2,
+	       append/3,
+	       delete/3
 	      ]).
 
+:- use_module(library(maplist)).
+
+:- use_module(library(rbtrees)).
+
+:- use_module(library(clpbn/vmap)).
+
 :- use_module(library('clpbn/aggregates'),
 	      [check_for_agg_vars/2]).
 
+%
+% uses a bipartite graph where bigraph(Vs, NFs, Fs)
+% Vs=map variables to lists of factors
+% NFs=number of factors
+% Fs=map factor id -> f(Id, Vars, Table)
+%
 
 check_if_ve_done(Var) :-
 	get_atts(Var, [size(_)]), !.
 
-%
+	%
 % implementation of the well known variable elimination algorithm
 %
 ve([[]],_,_) :- !.
-ve([LVs],Vs0,AllDiffs) :-
+ve(LLVs,Vs0,AllDiffs) :-
-	init_ve_solver([LVs], Vs0, AllDiffs, State),
+	init_ve_solver(LLVs, Vs0, AllDiffs, State),
 	% variable elimination proper
-	run_ve_solver([LVs], [LPs], State),
+	run_ve_solver(LLVs, LLPs, State),
 	% bind Probs back to variables so that they can be output.
-	clpbn_bind_vals([LVs],[LPs],AllDiffs).
+	clpbn_bind_vals(LLVs,LLPs,AllDiffs).
 
-init_ve_solver(Qs, Vs0, _, LVis) :-
+%
+% Qs is a list of lists with all query vars (marginals)
+% IQs is the corresponding list of integers
+% LVis is a list of lists with all variables reachable from the query
+% ILVis is the corresponding list of integers
+% Vmap is the map V->I
+%
+init_ve_solver(Qs, Vs0, _, state(IQs, LVIs, VMap, Bigraph, Ev)) :-
 	check_for_agg_vars(Vs0, Vs1),
 	% LVi will have a  list of CLPBN variables
-	init_influences(Vs1, G, RG),
+	init_influences(Vs1, Graph, TGraph),
-	init_ve_solver_for_questions(Qs, G, RG, _, LVis).
+	maplist(init_ve_solver_for_question(Graph, TGraph), Qs, LVs),
+	init_vmap(VMap0),
+	lvars_to_numbers(LVs, LVIs, VMap0, VMap1),
+	lvars_to_numbers(Qs, IQs, VMap1, VMap),
+	vars_to_bigraph(VMap, Bigraph, Ev).
 
-init_ve_solver_for_questions([], _, _, [], []).
+init_ve_solver_for_question(G, RG, Vs, NVs) :-
-init_ve_solver_for_questions([Vs|MVs], G, RG, [NVs|MNVs0], [NVs|LVis]) :-
 	influences(Vs, G, RG, NVs0),
-	sort(NVs0, NVs),
+	sort(NVs0, NVs).
-%clpbn_gviz:clpbn2gviz(user_error, test, NVs, Vs),
-	init_ve_solver_for_questions(MVs, G, RG, MNVs0, LVis).
 
+%
+% construct a bipartite graph with vars and factors
+% the nodes of the var graph just contain pointer to the factors
+% the nodes of the factors contain  alist of variables and a matrix
+% also provide a matrix with evidence
+%
+vars_to_bigraph(VMap, bigraph(VInfo, IF, Fs), Evs) :-
+	rb_new(Fs0),
+	vmap_to_list(VMap, VIds),
+	foldl3(id_to_factor(VMap), VIds, 0, IF, Fs0, Fs, [], Evs),
+	factors_to_vs(Fs, VInfo).
+
+id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
+	% process evidence for variable
+	clpbn:get_atts(V, [evidence(E), dist(_,Ps)]), 
+	checklist(noparent_of_interest(VMap), Ps), !,
+	% I don't need to get a factor here
+	Evs = [I=E|Evs0],
+	IF = IF0,
+	Fs = Fs0.
+id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
+	%  process distribution/factors
+	(
+	    clpbn:get_atts(V, [evidence(E)])
+	 ->
+	    Evs = [I=E|Evs0]
+	;
+	    Evs = Evs0
+	),	    
+	clpbn:get_atts(V, [dist(D, Ps)]),
+	get_dist_params(D, Pars0),
+	get_dist_domain_size(D, DS),
+	maplist(parent_to_id(VMap), Ps, Sizes, IPs),
+	init_CPT(Pars0, [DS|Sizes], CPT0), 
+	reorder_CPT([I|IPs], CPT0, FIPs, CPT, _),
+	rb_insert(Fs0, IF0, f(IF0, FIPs, CPT), Fs),
+	IF is IF0+1.
+
+noparent_of_interest(VMap, P) :-
+	\+ get_from_vmap(P, _, VMap).
+
+parent_to_id(VMap, V, DS, I) :-
+	clpbn:get_atts(V, [dist(D, _Ps)]),
+	get_dist_domain_size(D, DS),
+	get_from_vmap(V, I, VMap).
+
+factors_to_vs(Fs, VInfo) :-
+	rb_visit(Fs, L),
+	foldl(fsvs, L, FVs, []),
+	sort(FVs, SFVs),
+	rb_new(VInfo0),
+	add_vs(SFVs, Fs, VInfo0, VInfo).
+
+fsvs(F-f(_, IVs, _)) -->
+	fvs(IVs, F).
+
+fvs([], _F) --> [].
+fvs([I|IVs], F) -->
+	[I-F],
+	fvs(IVs, F).
+
+%
+% construct variable nodes
+%
+add_vs([], _, VInfo, VInfo).
+add_vs([V-F|SFVs], Fs, VInfo0, VInfo) :-
+	rb_lookup(F, FInfo, Fs),
+	collect_factors(SFVs, Fs, V, Fs0, R),
+	rb_insert(VInfo0, V, [FInfo|Fs0], VInfoI),
+	add_vs(R, Fs, VInfoI, VInfo).
+
+collect_factors([], _Fs, _V, [], []).
+collect_factors([V-F|SFVs], Fs, V, [FInfo|FInfos], R):-
+	!,
+	rb_lookup(F, FInfo, Fs),
+	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_ve_solver(LVs, LPs, LNVs) :-
+run_ve_solver(_, LLPs, state(LQVs, LVs, _VMap,  Bigraph, Ev)) :-
-	findall(Ps, solve_ve(LVs, LNVs, Ps), LPs).
+	findall(LPs, solve_ve(LQVs, LVs, Bigraph, Ev, LPs), LLPs).
 
-solve_ve([LVs|_], [NVs0|_], Ps) :-
+%
-%	length(NVs0, L), (L > 10 -> clpbn_gviz:clpbn2gviz(user_error,sort,NVs0,LVs) ; true ),
+% IQVs are the current marginal,
-%	length(NVs0, L), writeln(+L),
+% IVs are all variables related to that
-	find_all_clpbn_vars(NVs0, NVs0, LV0, LVi, Tables0),
+% IFVs are the factors
-	sort(LV0, LV),
+% SVs are the variables
-	% construct the graph
+%
-	find_all_table_deps(Tables0, LV),
+solve_ve([IQVs|_], [IVs|_], bigraph(OldVs, IF, _Fs), Ev, Ps) :-
-	process(LVi, LVs, tab(Dist,_,_)),
+	% get only what is relevant to query,
+	project_to_query_related(IVs, OldVs, SVs, Fs1), 
+	% and also prune using evidence
+	foldl2(clean_v_ev, Ev, 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).
-solve_ve([_|MoreLVs], [_|MoreLVis], Ps) :-
+solve_ve([_|MoreLVs], [_|MoreLVis], Digraph, Ev, Ps) :-
-	solve_ve(MoreLVs, MoreLVis, Ps).
+	solve_ve(MoreLVs, MoreLVis, Digraph, Ev, Ps).
-
-exps([],[]).
-exps([L|LD],[O|LDE]) :-
-	O is exp(L),
-	exps(LD,LDE).
-
-keys([],[]).
-keys([V|NVs0],[K:E|Ks]) :-
-	clpbn:get_atts(V,[key(K),evidence(E)]), !,
-	keys(NVs0,Ks).
-keys([V|NVs0],[K|Ks]) :-
-	clpbn:get_atts(V,[key(K)]),
-	keys(NVs0,Ks).
 
 %
-% just get a list of variables plus associated tables
+% given our input queries, sort them and obtain the subgraphs of vars and facs.
 %
-find_all_clpbn_vars([], _, [], [], []) :- !.
+project_to_query_related(IVs0, OldVs, NVs, NFs) :-
-find_all_clpbn_vars([V|Vs], NVs0, [Var|LV], ProcessedVars, [table(I,Table,Parents,Sizes)|Tables]) :-
+	sort(IVs0, IVs),
-	var_with_deps(V, NVs0, Table, Parents, Sizes, Ev, Vals), !,
+	rb_new(Vs0),
-	% variables with evidence should not be processed.
+	foldl(cp_to_vs, IVs, Vs0, AuxVs), 
-	(var(Ev) ->
+	rb_new(NFs0),
-	    Var = var(V,I,Sz,Vals,Parents,Ev,_,_),
+	foldl(simplify_graph_node(OldVs, AuxVs), IVs, VFs, NFs0, NFs),
-	    ve_get_dist_size(V,Sz),
+	list_to_rbtree(VFs, NVs).
-	    ProcessedVars = [Var|ProcessedVars0]
-	;
-	    ProcessedVars = ProcessedVars0
-	),
-	find_all_clpbn_vars(Vs, NVs0, LV, ProcessedVars0, Tables).
 
-var_with_deps(V, NVs0, Table, Deps, Sizes, Ev, Vals) :-
+%
-	clpbn:get_atts(V, [dist(Id,Parents)]),
+% auxiliary tree for fast access to vars.
-	get_dist_matrix(Id,Parents,_,Vals,TAB0),
+%
+cp_to_vs(V, Vs0, Vs) :-
+	rb_insert(Vs0, V, _, Vs).
+
+%
+% construct a new, hopefully much smaller, graph
+%
+simplify_graph_node(OldVs, NVs, V, V-RemFs, NFs0, NFs) :-
+	rb_lookup(V, Fs, OldVs),
+	foldl2(check_factor(V, NVs), Fs, NFs0, NFs, [], RemFs).
+
+%
+% check if a factor belongs to the subgraph.
+%
+%
+% Two cases: first time factor comes up: all its vars must be in subgraph
+% second case: second time it comes up, it must be already in graph
+% 
+% args: +Factor F, +current V (int), +rbtree with all Vs, 
+%       -Factors in new Graph, +factors in current graph, -rbtree of factors
+%
+%
+check_factor(V, NVs, F, NFs0, NFs, RemFs, NewRemFs) :-
+	F = f(IF, [V|More], _), !,
 	( 
-	    clpbn:get_atts(V, [evidence(Ev)])
+	  checklist(check_v(NVs), More)
 	->
-	    true
+	  rb_insert(NFs0, IF, F, NFs),
-	;
+	  NewRemFs = [F|RemFs]
-	    true
+        ;
-	), !,
+	  NFs0 = NFs,
-	% set CPT in canonical form
+	  NewRemFs = RemFs
-	reorder_CPT([V|Parents],TAB0,Deps0,TAB1,Sizes1),
+        ).
-	% remove evidence.
+check_factor(_V, _NVs, F, NFs, NFs, RemFs, NewRemFs) :-
-	simplify_evidence(Deps0, NVs0, TAB1, Deps0, Sizes1, Table, Deps, Sizes).
+	F = f(Id, _, _),
+	( 
+	  rb_lookup(Id, F, NFs)
+	->
+	  NewRemFs = [F|RemFs]
+        ;
+	  NewRemFs = RemFs
+        ).
 
-find_all_table_deps(Tables0, LV) :-
+check_v(NVs, V) :-
-	find_dep_graph(Tables0, DepGraph0),
+	rb_lookup(V, _, NVs).
-	sort(DepGraph0, DepGraph),
-	add_table_deps_to_variables(LV, DepGraph).
 
-find_dep_graph([], []) :- !.
+%
-find_dep_graph([table(I,Tab,Deps,Sizes)|Tables], DepGraph) :-
+% simplify a variable with evidence
-	add_table_deps(Deps, I, Deps, Tab, Sizes, DepGraph0, DepGraph),
+%
-	find_dep_graph(Tables, DepGraph0).
+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).
 
-add_table_deps([], _, _, _, _, DepGraph, DepGraph).
+%
-add_table_deps([V|Deps], I, Deps0, Table, Sizes, DepGraph0, [V-tab(Table,Deps0,Sizes)|DepGraph]) :-
+%
-	add_table_deps(Deps, I, Deps0, Table, Sizes, DepGraph0, DepGraph).
+% tricky: clean a factor means also cleaning all back references.
+%
+simplify_f_ev(V, E, F, Fs0, Fs, Vs0, Vs) :-
+	F =  f(Id,  FVs,  CPT),
+	NF = f(Id, NFVs, NCPT),
+	project_from_CPT(V, E, CPT, FVs, NCPT, NFVs),
+	% update factor
+	rb_update(Fs0, Id, NF, Fs),
+	foldl(update_factors(F,NF), NFVs, Vs0, Vs).
 
-add_table_deps_to_variables([], []).
+% update all instances of F in var graph
-add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :-
+update_factors(F, NF, V, Vs0, Vs) :-
-	steal_deps_for_variable(DepGraph, V, NDepGraph, Deps),
+	rb_update(Vs0, V, Fs, NFs, Vs),
-	compute_size(Deps,[],K),
+	maplist(replace_factor(F,NF), Fs, NFs).
-%	( clpbn:get_atts(V,[key(Key)]) -> format('~w:~w~n',[Key,K]) ; true),
-	add_table_deps_to_variables(LV, NDepGraph).
-	
-steal_deps_for_variable([V-Info|DepGraph], V0, NDepGraph, [Info|Deps]) :-
-	V == V0, !,
-	steal_deps_for_variable(DepGraph, V0, NDepGraph, Deps).
-steal_deps_for_variable(DepGraph, _, DepGraph, []).
 
-compute_size([],Vs,K) :-
+replace_factor(F, NF, F, NF) :- !.
-	% use sizes now
+replace_factor(_F,_NF,OF, OF).
-%	length(Vs,K).
-	multiply_sizes(Vs,1,K).
-compute_size([tab(_,Vs,_)|Tabs],Vs0,K) :-
-	ord_union(Vs,Vs0,VsI),
-	compute_size(Tabs,VsI,K).
 
-multiply_sizes([],K,K).
+eliminate(QVs, digraph(Vs0, I, Fs0), Dist) :-
-multiply_sizes([V|Vs],K0,K) :-
+	find_best(Vs0, QVs, BestV, VFs), !,
-	ve_get_dist_size(V, Sz),
+	%writeln(best:BestV:QVs),
-	KI is K0*Sz,
+	% delete all factors that touched the variable
-	multiply_sizes(Vs,KI,K).
+	foldl2(del_fac, VFs, Fs0, Fs1, Vs0, Vs1),
+	% delete current variable
+	rb_delete(Vs1, BestV, Vs2),
+	I1 is I+1,
+	% construct new table
+	multiply_and_delete(VFs, BestV, NewFVs, NewCPT),
+	% insert new factor in graph
+	insert_fac(I, NewFVs, NewCPT, Fs1, Fs, Vs2, Vs),
+	eliminate(QVs, digraph(Vs, I1, Fs), Dist).
+eliminate(_QVs, digraph(_, _, Fs), Dist) :-
+	combine_factors(Fs, Dist).
 
-process(LV0, InputVs, Out) :-
+find_best(Vs, QVs, BestV, VFs) :-
-	find_best(LV0, V0, -1, V, WorkTables, LVI, InputVs),
+	rb_key_fold(best_var(QVs), Vs, i(+inf,-1,[]), i(_Cost,BestV,VFs)),
-	V \== V0, !,
+	BestV \= -1, !.
-%	clpbn:get_atts(V,[key(K)]), writeln(chosen:K),
+
-% format('1 ~w: ~w~n',[V,WorkTables]), write_tables(WorkTables),
+% do not eliminate marginalised variables
-	multiply_tables(WorkTables, tab(Tab0,Deps0,_)),
+best_var(QVs, I, _Node, Info, Info) :-
-	reorder_CPT(Deps0,Tab0,Deps,Tab,Sizes),
+	member(I, QVs),
-	Table = tab(Tab,Deps,Sizes),
+	!.
-% format('2 ~w: ~w~n',[V,Table]),
+% pick the variable with less factors
-	project_from_CPT(V,Table,NewTable),
+best_var(_Qs, I, Node, i(ValSoFar,_,_), i(NewVal,I,Node)) :-
-% format('3 ~w: ~w~n',[V,NewTable]), write_tables([NewTable]),
+	length(Node, NewVal),
-	include(LVI,NewTable,V,LV2),
+	NewVal < ValSoFar,
-	process(LV2, InputVs, Out).
+	!.
-process(LV0, _, Out) :-
+best_var(_, _I, _Node, Info, Info).
-	fetch_tables(LV0, WorkTables0),
+
-	sort(WorkTables0, WorkTables),
+% delete one factor, need to also touch all variables
-% format('4 ~w: ~w~n',[LV0,WorkTables]), write_tables(WorkTables),
+del_fac(f(I,FVs,_), Fs0, Fs, Vs0, Vs) :-
-	multiply_tables(WorkTables, Out).
+	rb_delete(Fs0, I, Fs),
+	foldl(delete_fac_from_v(I), FVs, Vs0, Vs).
+
+delete_fac_from_v(I, FV, Vs0, Vs) :-
+	rb_update(Vs0, FV, Fs, NFs, Vs),
+	exclude(factor_name(I), Fs, NFs).
+
+factor_name(I, f(I,_,_)).
+
+% insert one factor, need to touch all corresponding variables
+insert_fac(I, FVs, CPT, Fs0, Fs, Vs0, Vs) :-
+	F = f(I, FVs, CPT),
+	rb_insert(Fs0, I, F, Fs),
+	foldl(insert_fac_in_v(F), FVs, Vs0, Vs).
+
+insert_fac_in_v(F, FV, Vs0, Vs) :-
+	rb_update(Vs0, FV, Fs, [F|Fs], Vs).
+
+combine_factors(Fs, Dist) :-
+	rb_visit(Fs,Els),
+	maplist(extract_factor,Els,Factors),
+	multiply(Factors, _, Dist).
+
+extract_factor(_-Factor, Factor).
+
+multiply_and_delete([f(I,Vs0,T0)|Fs], V, Vs, T) :-
+	foldl(multiply_factor, Fs, f(I,Vs0,T0), f(_,Vs1,T1)),
+	sum_out_from_CPT(V, T1, Vs1, T, Vs).
+
+multiply([F0|Fs], Vs, T) :-
+	foldl(multiply_factor, Fs, F0, f(_,Vs,T)).
+
+multiply_factor(f(_,Vs1,T1), f(_,Vs0,T0), f(_,Vs,T)) :-
+	multiply_CPTs(T1, Vs1, T0, Vs0, T, Vs).
 
 
-write_tables([]).
-write_tables([tab(Mat,_,_)|WorkTables]) :-
-	matrix:matrix_to_list(Mat,L),
-	writeln(L),
-	write_tables(WorkTables).
-
-
-find_best([], V, _TF, V, _, [], _).
-%:-
-%	clpbn:get_atts(V,[key(K)]), writeln(chosen:K:_TF).
-% root_with_single_child
-%find_best([var(V,I,_,_,[],Ev,[Dep],K)|LV], _, _, V, [Dep], LVF, Inputs) :- !.	
-find_best([var(V,I,Sz,Vals,Parents,Ev,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
-	( K < Threshold ; Threshold < 0),
-	clpbn_not_var_member(Inputs, V), !,
-	find_best(LV, V, K, VF, WorkTables,LV0, Inputs),
-	(V == VF ->
-	    LVF = LV0, Deps = NWorktables
-	;
-	    LVF = [var(V,I,Sz,Vals,Parents,Ev,Deps,K)|LV0], WorkTables = NWorktables
-	).
-find_best([V|LV], V0, Threshold, VF, WorkTables, [V|LVF], Inputs) :-
-	find_best(LV, V0, Threshold, VF, WorkTables, LVF, Inputs).
-
-multiply_tables([Table], Table) :- !. %, Table = tab(T,D,S),matrix:matrix_to_list(T,L),writeln(D:S:L).
-multiply_tables([TAB1, TAB2| Tables], Out) :-
-%TAB1 = tab(T,_,_),matrix:matrix_to_list(T,L),writeln(doing:L),
-	multiply_CPTs(TAB1, TAB2, TAB, _),
-	multiply_tables([TAB| Tables], Out).
-
-
-simplify_evidence([], _, Table, Deps, Sizes, Table, Deps, Sizes).
-simplify_evidence([V|VDeps], NVs0, Table0, Deps0, Sizes0, Table, Deps, Sizes) :-
-	clpbn:get_atts(V, [evidence(_)]), !,
-	project_from_CPT(V,tab(Table0,Deps0,Sizes0),tab(NewTable,Deps1,Sizes1)),
-	simplify_evidence(VDeps, NVs0, NewTable, Deps1, Sizes1, Table, Deps, Sizes).
-simplify_evidence([V|VDeps], NVs0, Table0, Deps0, Sizes0, Table, Deps, Sizes) :-
-	ord_member(V, NVs0), !,
-	simplify_evidence(VDeps, NVs0, Table0, Deps0, Sizes0, Table, Deps, Sizes).
-simplify_evidence([V|VDeps], NVs0, Table0, Deps0, Sizes0, Table, Deps, Sizes) :-
-	project_from_CPT(V,tab(Table0,Deps0,Sizes0),tab(NewTable,Deps1,Sizes1)),
-	simplify_evidence(VDeps, NVs0, NewTable, Deps1, Sizes1, Table, Deps, Sizes).
-
-fetch_tables([], []).
-fetch_tables([var(_,_,_,_,_,_,Deps,_)|LV0], Tables) :-
-	append(Deps,Tables0,Tables),
-	fetch_tables(LV0, Tables0).
-
- 
-include([],_,_,[]).
-include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Parents,Ev,Tabs,Est)|NLV]) :-
-	clpbn_not_var_member(Vs,V), !,
-	include(LV,tab(T,Vs,Sz),V1,NLV).
-include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :-
-	update_tables(Tabs,NTabs,Table,NV),
-	compute_size(NTabs, [], NEst),
-	include(LV,Table,NV,NLV).
-
-update_tables([],[Table],Table,_).
-update_tables([tab(Tab0,Vs,Sz)|Tabs],[tab(Tab0,Vs,Sz)|NTabs],Table,V) :-
-	clpbn_not_var_member(Vs,V), !,
-	update_tables(Tabs,NTabs,Table,V).
-update_tables([_|Tabs],NTabs,Table,V) :-
-	update_tables(Tabs,NTabs,Table,V).
-
-ve_get_dist_size(V,Sz) :-
-	get_atts(V, [size(Sz)]), !.
-ve_get_dist_size(V,Sz) :-
-	clpbn:get_atts(V,dist(Id,_)), !,
-	get_dist_domain_size(Id,Sz),
-	put_atts(V, [size(Sz)]).
-

packages/CLPBN/clpbn/vmap.yap

@@ -0,0 +1,44 @@
+
+:- module(clpbn_vmap,
+	[
+         init_vmap/1, % init_vmap(-Vmap)
+         add_to_vmap/4, % add_to_vmap(+V,-I,+VMap0,VMapF)
+         get_from_vmap/3, % add_to_vmap(+V,-I,+VMap0)
+	 vars_to_numbers/4, % vars_to_numbers(+Vs,-Is,+VMap0,VMapF)
+	 lvars_to_numbers/4, % lvars_to_numbers(+LVs,-LIs,+VMap0,VMapF)
+	vmap_to_list/2
+     ]).
+
+:- use_module(library(rbtrees)).
+:- use_module(library(maplist)).
+
+%
+% vmap: map V->I 
+% contiguous Vs to contiguous integers
+%
+init_vmap(vmap(0,Empty)) :-
+    rb_new(Empty).
+
+get_from_vmap(V, I, VMap0) :-
+	VMap0 = vmap(_I,Map0),
+	rb_lookup(V, I, Map0).
+
+add_to_vmap(V, I, VMap0, VMap0) :-
+	VMap0 = vmap(_I,Map0),
+	rb_lookup(V, I, Map0), !.
+add_to_vmap(V, I0, vmap(I0,Map0), vmap(I, Map)) :-
+	I is I0+1,
+	rb_insert(Map0, V, I0, Map).
+
+vars_to_numbers(Vs, Is, VMap0, VMap) :-
+	foldl(add_to_vmap, Vs, Is, VMap0, VMap).
+
+lvars_to_numbers(LVs, LIs, VMap0, VMap) :-
+	foldl(vars_to_numbers, LVs, LIs, VMap0, VMap).
+
+vmap_to_list(vmap(_,Map), L) :-
+	rb_visit(Map, L).
+
+
+
+

packages/CLPBN/examples/School/parschema.yap

@@ -29,7 +29,7 @@ bayes grade(C,S)::[a,b,c,d], int(S), diff(C) ; grade_table ; [registration(_,C,S
 
 bayes satisfaction(C,S)::[h,m,l], abi(P), grade(C,S) ; sat_table ; [reg_satisfaction(C,S,P)].
 
-bayes rat(C) :: [h,m,l], avg(Sats) ; avg ; [course_rating(C, Sats)].
+bayes rat(C) :: [h,m,l], avg(Sats) ; avg ; [course_rat(C, Sats)].
 
 bayes rank(S) :: [a,b,c,d], avg(Grades) ; avg ; [student_ranking(S,Grades)].
 
@@ -42,7 +42,7 @@ reg_satisfaction(CKey, SKey, PKey) :-
 	registration(_Key, CKey, SKey),
 	course(CKey, PKey).
 
-course_rating(CKey, Sats) :-
+course_rat(CKey, Sats) :-
 	course(CKey,  _),
 	setof(satisfaction(CKey,SKey,PKey),
 	   reg_satisfaction(CKey, SKey, PKey),
@@ -72,6 +72,14 @@ student_intelligence(P,A) :- int(P, A).
 course_difficulty(P,A) :- diff(P, A).
 
 
+registration_course(R,C) :-
+	registration(R, C, _).
+
+registration_student(R,S) :-
+	registration(R, _, S).
+
+course_rating(C,X) :- rat(C,X).
+
 %
 % evidence
 %

packages/CLPBN/learning/em.yap

@@ -104,7 +104,7 @@ setup_em_network(Solver, state( AllDists, AllDistInstances, MargVars, SolverStat
 	sort_vars_by_key(AllVars0,AllVars,[]),
 	% no, we are in trouble because we don't know the network yet.
 	% get the ground network
-	generate_network([AllVars], _, Keys, Factors, EList),
+	generate_network(AllVars, _, Keys, Factors, EList),
 	% get the EM CPT connections info from the factors
 	generate_dists(Factors, EList, AllDists, AllDistInstances, MargVars),
 	% setup solver, if necessary