Improve Gibbs learning in CLP(BN).

CLPBN/clpbn/utils.yap

@@ -39,7 +39,7 @@ clpbn_not_var_member([V1|Vs], V) :- V1 \== V,
 
 sort_vars_by_key(AVars, SortedAVars, UnifiableVars) :-
 	get_keys(AVars, KeysVars),
-	keysort(KeysVars, KVars),
+	msort(KeysVars, KVars),
 	merge_same_key(KVars, SortedAVars, [], UnifiableVars).
 
 get_keys([], []).
@@ -51,7 +51,19 @@ get_keys([_|AVars], KeysVars) :-  % may be non-CLPBN vars.
 
 merge_same_key([], [], _, []).
 merge_same_key([K1-V1,K2-V2|Vs], SortedAVars, Ks, UnifiableVars) :-
-	K1 == K2, !, V1 = V2,
+	K1 == K2, !,
+	(clpbn:get_atts(V1, [evidence(E)])
+        ->
+	    clpbn:put_atts(V2, [evidence(E)])
+	;
+	    clpbn:get_atts(V2, [evidence(E)])
+	->
+	    clpbn:put_atts(V1, [evidence(E)])
+	;
+	     true
+	),
+%	V1 = V2,
+	attributes:fast_unify_attributed(V1,V2),
 	merge_same_key([K1-V1|Vs], SortedAVars, Ks, UnifiableVars).
 merge_same_key([K1-V1,K2-V2|Vs], [V1|SortedAVars], Ks, [K1|UnifiableVars]) :-
 	(in_keys(K1, Ks) ; \+ \+ K1 == K2), !, 

CLPBN/clpbn/vel.yap

@@ -14,7 +14,7 @@
   
 *********************************/
 
-:- module(vel, [vel/3,
+:- module(clpbn_vel, [vel/3,
 		check_if_vel_done/1,
 		init_vel_solver/4,
 		run_vel_solver/3]).
@@ -92,8 +92,12 @@ init_vel_solver_for_questions([Vs|MVs], G, RG, [NVs|MNVs0], [NVs|LVis]) :-
 %clpbn_gviz:clpbn2gviz(user_error, test, NVs, Vs),
 	init_vel_solver_for_questions(MVs, G, RG, MNVs0, LVis).
 
-run_vel_solver([], [], []).
-run_vel_solver([LVs|MoreLVs], [Ps|MorePs], [NVs0|MoreLVis]) :-
+% use a findall to recover space without needing for GC
+run_vel_solver(LVs, LPs, LNVs) :-
+	findall(Ps, solve_vel(LVs, LNVs, Ps), LPs).
+
+solve_vel([LVs|_], [NVs0|_], Ps) :-
+	length(NVs0, L), (L > 64 -> clpbn_gviz:clpbn2gviz(user_error,sort,NVs0,LVs) ; true ),
 	find_all_clpbn_vars(NVs0, NVs0, LV0, LVi, Tables0),
 	sort(LV0, LV),
 	% construct the graph
@@ -101,9 +105,19 @@ run_vel_solver([LVs|MoreLVs], [Ps|MorePs], [NVs0|MoreLVis]) :-
 	process(LVi, LVs, tab(Dist,_,_)),
 	% move from potentials back to probabilities
 	normalise_CPT(Dist,MPs),
-	list_from_CPT(MPs, Ps),
-length(Ps,_Len), 
-	run_vel_solver(MoreLVs, MorePs, MoreLVis).
+	list_from_CPT(MPs, Ps).
+solve_vel([_|MoreLVs], [_|MoreLVis], Ps) :-
+	solve_vel(MoreLVs, MoreLVis, Ps).
+
+
+
+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

CLPBN/learning/aleph_params.yap

@@ -197,7 +197,7 @@ cpt_score(Lik) :-
 	clpbn_flag(em_solver, EMSolver),
 	set_clpbn_flag(solver, EMSolver),
 	reset_all_dists,
-	em(Exs, 0.1, 10, _Tables, Lik),
+	em(Exs, 0.01, 10, _Tables, Lik),
 	set_clpbn_flag(solver, Solver).
 
 complete_clpbn_cost(_AlephClause).

CLPBN/learning/em.yap

@@ -50,7 +50,7 @@
 :- meta_predicate em(:,+,+,-,-), init_em(:,-).
 
 em(Items, MaxError, MaxIts, Tables, Likelihood) :-
-	init_em(Items, State),
+	catch(init_em(Items, State),Error,handle_em(Error)),
 	em_loop(0, 0.0, State, MaxError, MaxIts, Likelihood, Tables),
 	assert(em_found(Tables, Likelihood)),
 	fail.
@@ -58,6 +58,13 @@ em(Items, MaxError, MaxIts, Tables, Likelihood) :-
 em(_, _, _, Tables, Likelihood) :-
 	retract(em_found(Tables, Likelihood)).
 
+
+handle_em(error(repeated_parents)) :-
+	assert(em_found(_, -inf)),
+	fail.
+	
+	
+
 % This gets you an initial configuration. If there is a lot of evidence
 % tables may be filled in close to optimal, otherwise they may be
 % close to uniform.
@@ -72,9 +79,9 @@ init_em(Items, state( AllDists, AllDistInstances, MargVars, SolverVars)) :-
 %	randomise_all_dists,
 	uniformise_all_dists,
 	attributes:all_attvars(AllVars0),
-	sort_vars_by_key(AllVars0,AllVars1,[]),
+	sort_vars_by_key(AllVars0,AllVars,[]),
 	% remove variables that do not have to do with this query.
-	check_for_hidden_vars(AllVars1, AllVars1, AllVars),
+%	check_for_hidden_vars(AllVars1, AllVars1, AllVars),
 	different_dists(AllVars, AllDists, AllDistInstances, MargVars),
 	clpbn_flag(em_solver, Solver),
 	clpbn_init_solver(Solver, MargVars, AllVars, _, SolverVars).
@@ -116,6 +123,16 @@ different_dists(AllVars, AllDists, AllInfo, MargVars) :-
 all_dists([], []).
 all_dists([V|AllVars], [i(Id, [V|Parents], Cases, Hiddens)|Dists]) :-
 	clpbn:get_atts(V, [dist(Id,Parents)]),
+	sort([V|Parents], Sorted),
+	length(Sorted, LengSorted),
+        length(Parents, LengParents),
+	(
+	    LengParents+1 =:= LengSorted
+	-> 
+	    true
+	;
+	    throw(error(repeated_parents))
+	),	
 	generate_hidden_cases([V|Parents], CompactCases, Hiddens),
 	uncompact_cases(CompactCases, Cases),
 	all_dists(AllVars, Dists).