diff --git a/CLPBN/clpbn/utils.yap b/CLPBN/clpbn/utils.yap index 4531c9575..67f7cfe15 100644 --- a/CLPBN/clpbn/utils.yap +++ b/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), !, diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index 36e313156..8f14ee3e8 100644 --- a/CLPBN/clpbn/vel.yap +++ b/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 diff --git a/CLPBN/learning/aleph_params.yap b/CLPBN/learning/aleph_params.yap index b2037c55f..d237f7814 100644 --- a/CLPBN/learning/aleph_params.yap +++ b/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). diff --git a/CLPBN/learning/em.yap b/CLPBN/learning/em.yap index 4a56ef02e..7dd762b2f 100644 --- a/CLPBN/learning/em.yap +++ b/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).