diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 738141875..1b053939b 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -6,6 +6,8 @@ clpbn_key/2, clpbn_init_solver/4, clpbn_run_solver/3, + pfl_init_solver/6, + pfl_run_solver/4, clpbn_finalize_solver/1, clpbn_init_solver/5, clpbn_run_solver/4, @@ -38,14 +40,16 @@ check_if_ve_done/1, init_ve_solver/4, run_ve_solver/3, + init_ve_ground_solver/5, + run_ve_ground_solver/3, call_ve_ground_solver/6 ]). :- use_module('clpbn/horus_ground', [call_horus_ground_solver/6, check_if_horus_ground_solver_done/1, - init_horus_ground_solver/4, - run_horus_ground_solver/3, + init_horus_ground_solver/5, + run_horus_ground_solver/4, finalize_horus_ground_solver/1 ]). @@ -67,6 +71,8 @@ [bdd/3, init_bdd_solver/4, run_bdd_solver/3, + init_bdd_ground_solver/5, + run_bdd_ground_solver/3, call_bdd_ground_solver/6 ]). @@ -532,6 +538,23 @@ clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :- clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :- init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State). +% +% This is a routine to start a solver, called by the learning procedures (ie, em). +% LVs is a list of lists of variables one is interested in eventually marginalising out +% Vs0 gives the original graph +% AllDiffs gives variables that are not fully constrainted, ie, we don't fully know +% the key. In this case, we assume different instances will be bound to different +% values at the end of the day. +% +pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, bdd) :- + init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE). +pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, ve) :- + init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE). +pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, bp) :- + init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE). +pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, hve) :- + init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE). + % % LVs is the list of lists of variables to marginalise @@ -561,6 +584,16 @@ clpbn_run_solver(bdd, LVs, LPs, State) :- clpbn_run_solver(pcg, LVs, LPs, State) :- run_pcg_solver(LVs, LPs, State). +pfl_run_solver(LVs, LPs, State, ve) :- + run_ve_ground_solver(LVs, LPs, State). +pfl_run_solver(LVs, LPs, State, bdd) :- + run_bdd_ground_solver(LVs, LPs, State). +pfl_run_solver(LVs, LPs, State, bp) :- + run_horus_ground_solver(LVs, LPs, State, bp). +pfl_run_solver(LVs, LPs, State, hve) :- + run_horus_ground_solver(LVs, LPs, State, hve). + + add_keys(Key1+V1,_Key2,Key1+V1). % diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap index 0eb56a938..717d61168 100644 --- a/packages/CLPBN/clpbn/bdd.yap +++ b/packages/CLPBN/clpbn/bdd.yap @@ -21,7 +21,9 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ... [bdd/3, set_solver_parameter/2, init_bdd_solver/4, + init_bdd_ground_solver/5, run_bdd_solver/3, + run_bdd_ground_solver/3, finalize_bdd_solver/1, check_if_bdd_done/1, call_bdd_ground_solver/6 @@ -76,6 +78,18 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ... %bdds(ddnnf). bdds(bdd). +% +% QVars: all query variables? +% +% +init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, bdd(QueryKeys, AllKeys, Factors, Evidence)). + +% +% just call horus solver. +% +run_bdd_ground_solver(_QueryVars, Solutions, bdd(GKeys, Keys, Factors, Evidence) ) :- !, + call_bdd_ground_solver_for_probabilities(GKeys, Keys, Factors, Evidence, Solutions). + check_if_bdd_done(_Var). call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :- diff --git a/packages/CLPBN/clpbn/connected.yap b/packages/CLPBN/clpbn/connected.yap index 5996d932a..450c61bd9 100644 --- a/packages/CLPBN/clpbn/connected.yap +++ b/packages/CLPBN/clpbn/connected.yap @@ -160,5 +160,5 @@ get_top(_EVs, V-_, Vs, [V|Vs]) :- get_top(EVs, V-_, Vs, [V|Vs]) :- nonvar(V), rb_lookup(V, _, EVs), !. -get_top(_, Vs, Vs). +get_top(_, _, Vs, Vs). diff --git a/packages/CLPBN/clpbn/horus.yap b/packages/CLPBN/clpbn/horus.yap index 7dd7b68aa..c557a4c66 100644 --- a/packages/CLPBN/clpbn/horus.yap +++ b/packages/CLPBN/clpbn/horus.yap @@ -35,15 +35,15 @@ warning :- -> true ; warning. -set_solver(ve) :- set_clpbn_flag(solver,ve). -set_solver(bdd) :- set_clpbn_flag(solver,bdd). -set_solver(jt) :- set_clpbn_flag(solver,jt). -set_solver(gibbs) :- set_clpbn_flag(solver,gibbs). -set_solver(fove) :- set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, fove). -set_solver(lbp) :- set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, lbp). -set_solver(hve) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, ve). -set_solver(bp) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, bp). -set_solver(cbp) :- set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, cbp). +set_solver(ve) :- !, set_clpbn_flag(solver,ve). +set_solver(bdd) :- !, set_clpbn_flag(solver,bdd). +set_solver(jt) :- !, set_clpbn_flag(solver,jt). +set_solver(gibbs) :- !, set_clpbn_flag(solver,gibbs). +set_solver(fove) :- !, set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, fove). +set_solver(lbp) :- !, set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, lbp). +set_solver(hve) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, ve). +set_solver(bp) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, bp). +set_solver(cbp) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, cbp). set_solver(S) :- throw(error('unknown solver ', S)). diff --git a/packages/CLPBN/clpbn/horus_ground.yap b/packages/CLPBN/clpbn/horus_ground.yap index 4af385790..3cb9e14cc 100644 --- a/packages/CLPBN/clpbn/horus_ground.yap +++ b/packages/CLPBN/clpbn/horus_ground.yap @@ -10,8 +10,8 @@ :- module(clpbn_horus_ground, [call_horus_ground_solver/6, check_if_horus_ground_solver_done/1, - init_horus_ground_solver/4, - run_horus_ground_solver/3, + init_horus_ground_solver/5, + run_horus_ground_solver/4, finalize_horus_ground_solver/1 ]). @@ -20,7 +20,8 @@ cpp_set_factors_params/2, cpp_run_ground_solver/3, cpp_set_vars_information/2, - cpp_free_ground_network/1 + cpp_free_ground_network/1, + set_solver/1 ]). :- use_module(library('clpbn/dists'), @@ -90,30 +91,28 @@ get_factors_type([f(bayes, _, _)|_], bayes) :- ! . get_factors_type([f(markov, _, _)|_], markov) :- ! . +get_var_information(_:Key, Domain) :- !, + skolem(Key, Domain). get_var_information(Key, Domain) :- skolem(Key, Domain). finalize_horus_ground_solver(bp(Network, _)) :- cpp_free_ground_network(Network). +finalize_horus_ground_solver(horus(_, _, _, _)). % % QVars: all query variables? % % -init_horus_ground_solver(QueryVars, _AllVars, Ground, horus(GKeys, Keys, Factors, Evidence)) :- - ( - var(GKeys) -> - Ground = ground(GKeys, Keys, Factors, Evidence) - ; - generate_network(QueryVars, GKeys, Keys, Factors, Evidence) - ). +init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, horus(QueryKeys, AllKeys, Factors, Evidence)). % % just call horus solver. % -run_horus_ground_solver(_QueryVars, Solutions, horus(GKeys, Keys, Factors, Evidence) ) :- !, - call_horus_ground_solver_for_probabilities(GKeys, Keys, Factors, Evidence, Solutions). +run_horus_ground_solver(_QueryVars, Solutions, horus(GKeys, Keys, Factors, Evidence) , Solver) :- + set_solver(Solver), + call_horus_ground_solver_for_probabilities(GKeys, Keys, Factors, Evidence, Solutions). %bp([[]],_,_) :- !. %bp([QueryVars], AllVars, Output) :- diff --git a/packages/CLPBN/clpbn/numbers.yap b/packages/CLPBN/clpbn/numbers.yap index 6122b89d3..f7805a397 100644 --- a/packages/CLPBN/clpbn/numbers.yap +++ b/packages/CLPBN/clpbn/numbers.yap @@ -46,6 +46,9 @@ factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I foldl2(key_to_id, NKeys, Ids, Hash0, Hash, I0, I), maplist(get_range, Keys, Ranges). +get_range(_Id:K, Range) :- !, + skolem(K,Domain), + length(Domain,Range). get_range(K, Range) :- skolem(K,Domain), length(Domain,Range). diff --git a/packages/CLPBN/clpbn/ve.yap b/packages/CLPBN/clpbn/ve.yap index f6ab08192..b19bf020c 100644 --- a/packages/CLPBN/clpbn/ve.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -18,6 +18,8 @@ check_if_ve_done/1, init_ve_solver/4, run_ve_solver/3, + init_ve_ground_solver/5, + run_ve_ground_solver/3, call_ve_ground_solver/6]). :- attribute size/1, all_diffs/1. @@ -90,18 +92,20 @@ call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) 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). + init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE), + run_ve_ground_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), + init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE), simulate_solver(QueryKeys, Solutions, VE). +init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :- + keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds), + init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE). + % % implementation of the well known variable elimination algorithm @@ -115,21 +119,16 @@ ve(LLVs,Vs0,AllDiffs) :- 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), +init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, Ev)) :- 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) :- +factor_to_graph( f(Nodes, Sizes, _Pars0, Id), Factors0, Factors, Edges0, Edges, I0, I) :- I is I0+1, + pfl:get_pfl_parameters(Id, Pars0), init_CPT(Pars0, Sizes, CPT0), reorder_CPT(Nodes, CPT0, FIPs, CPT, _), F = f(I0, FIPs, CPT), @@ -230,7 +229,7 @@ add_vs([V-F|SFVs], Fs, VInfo0, VInfo) :- rb_insert(VInfo0, V, [FInfo|Fs0], VInfoI), add_vs(R, Fs, VInfoI, VInfo). -collect_factors([], _Fs, _V, [], []). +collect_factors([], _Fs, _V, [], []) :- !. collect_factors([V-F|SFVs], Fs, V, [FInfo|FInfos], R):- !, rb_lookup(F, FInfo, Fs), @@ -239,9 +238,15 @@ 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)) :- +run_ve_ground_solver(LQVs, LLPs, ve(FactorIds, Hash, Id, 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), lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _), - findall(LPs, solve(LQIds, FIds, BG, Ev, LPs), LLPs). + findall(LPs, solve(LQIds, FactorIds, BG, Ev, LPs), LLPs). solve([QVs|_], FIds, Bigraph, Evs, LPs) :- factor_influences(FIds, QVs, Evs, LVs), @@ -366,11 +371,13 @@ check_v(NVs, V) :- % simplify a variable with evidence % clean_v_ev(V=E, FVs0, FVs, Vs0, Vs) :- - rb_delete(Vs0, V, Fs, Vs1), + 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), + rb_delete(Vs0, V, Fs, Vs1), !, foldl2(simplify_f_ev(V, E), Fs, FVs0, FVs, Vs1, Vs). +% The variable is not there +clean_v_ev(_, FVs, FVs, Vs, Vs). % % diff --git a/packages/CLPBN/examples/learning/prof_params.pfl b/packages/CLPBN/examples/learning/prof_params.pfl index 339ed8520..bd555ce3e 100644 --- a/packages/CLPBN/examples/learning/prof_params.pfl +++ b/packages/CLPBN/examples/learning/prof_params.pfl @@ -34,8 +34,10 @@ professor(p8). %:- clpbn:set_clpbn_flag(em_solver,gibbs). %:- clpbn:set_clpbn_flag(em_solver,jt). -%:- clpbn:set_clpbn_flag(em_solver,ve). -:- clpbn:set_clpbn_flag(em_solver,bp). +:- clpbn:set_clpbn_flag(em_solver,hve). +:- clpbn:set_clpbn_flag(em_solver,ve). +%:- clpbn:set_clpbn_flag(em_solver,bp). +%:- clpbn:set_clpbn_flag(em_solver,bdd). timed_main :- statistics(runtime, _), diff --git a/packages/CLPBN/examples/learning/sprinkler_params.yap b/packages/CLPBN/examples/learning/sprinkler_params.yap index f29ffad86..365ae2649 100644 --- a/packages/CLPBN/examples/learning/sprinkler_params.yap +++ b/packages/CLPBN/examples/learning/sprinkler_params.yap @@ -4,25 +4,25 @@ :- use_module(library(clpbn/learning/em)). -%% data(t,t,t,t). -data(t,f,_,t). -%% data(_,t,_,t). -%% data(t,t,f,f). -%% data(t,t,f,t). -%% data(t,_,_,t). -%% data(t,f,t,t). -%% data(t,t,f,t). -%% data(t,_,f,f). -%% data(t,t,f,f). -%% data(f,f,t,t). -%% data(t,t,_,f). -%% data(t,f,f,t). -%% data(t,f,t,t). +data(t,t,t,t). +data(_,t,_,t). +data(t,t,f,f). +data(t,t,f,t). +data(t,_,_,t). +data(t,f,t,t). +data(t,t,f,t). +data(t,_,f,f). +data(t,t,f,f). +data(f,f,t,t). +data(t,t,_,f). +data(t,f,f,t). +data(t,f,t,t). %:- clpbn:set_clpbn_flag(em_solver,gibbs). %:- clpbn:set_clpbn_flag(em_solver,jt). -%:- clpbn:set_clpbn_flag(em_solver,ve). -:- clpbn:set_clpbn_flag(em_solver,bp). +%:- clpbn:set_clpbn_flag(em_solver,hve). +%:- clpbn:set_clpbn_flag(em_solver,bp). +:- clpbn:set_clpbn_flag(em_solver,ve). timed_main :- statistics(runtime, _), @@ -34,7 +34,17 @@ main(Lik) :- findall(X,scan_data(X),L), em(L,0.01,10,_,Lik). -scan_data(example([wet_grass(W),sprinkler(S),rain(R),cloudy(C)])) :- - data(W, S, R, C). +scan_data(I:[wet_grass(W),sprinkler(S),rain(R),cloudy(C)]) :- + data(W, S, R, C), + new_id(I). + +:- dynamic id/1. + +new_id(I) :- + retract(id(I)), + I1 is I+1, + assert(id(I1)). + +id(0). diff --git a/packages/CLPBN/learning/em.yap b/packages/CLPBN/learning/em.yap index 05cf46c41..087f96057 100644 --- a/packages/CLPBN/learning/em.yap +++ b/packages/CLPBN/learning/em.yap @@ -8,10 +8,17 @@ [append/3, delete/3]). +:- reexport(library(clpbn), + [ + clpbn_flag/2, + clpbn_flag/3]). + :- use_module(library(clpbn), [clpbn_init_graph/1, clpbn_init_solver/5, clpbn_run_solver/4, + pfl_init_solver/6, + pfl_run_solver/4, clpbn_finalize_solver/1, conditional_probability/3, clpbn_flag/2]). @@ -43,6 +50,8 @@ :- use_module(library(lists), [member/2]). +:- use_module(library(maplist)). + :- use_module(library(matrix), [matrix_add/3, matrix_to_list/2]). @@ -89,27 +98,22 @@ init_em(Items, State) :- clpbn_flag(em_solver, Solver), % only used for PCGs clpbn_init_graph(Solver), - % create the ground network - call_run_all(Items), % randomise_all_dists, % set initial values for distributions uniformise_all_dists, - setup_em_network(Solver, State). + setup_em_network(Items, Solver, State). -setup_em_network(Solver, state( AllDists, AllDistInstances, MargVars, SolverState)) :- +setup_em_network(Items, Solver, state( AllDists, AllDistInstances, MargKeys, SolverState)) :- clpbn:use_parfactors(on), !, % get all variables to marginalise - attributes:all_attvars(AllVars0), - % and order them - 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), + run_examples(Items, Keys, Factors, EList), % get the EM CPT connections info from the factors - generate_dists(Factors, EList, AllDists, AllDistInstances, MargVars), + generate_dists(Factors, EList, AllDists, AllDistInstances, MargKeys), % setup solver, if necessary - clpbn_init_solver(Solver, MargVars, _AllVars, ground(MargVars, Keys, Factors, EList), SolverState). -setup_em_network(Solver, state( AllDists, AllDistInstances, MargVars, SolverVars)) :- + pfl_init_solver(MargKeys, Keys, Factors, EList, SolverState, Solver). +setup_em_network(Items, Solver, state( AllDists, AllDistInstances, MargVars, SolverVars)) :- + % create the ground network + call_run_all(Items), % get all variables to marginalise attributes:all_attvars(AllVars0), % and order them @@ -119,6 +123,45 @@ setup_em_network(Solver, state( AllDists, AllDistInstances, MargVars, SolverVars % setup solver by doing parameter independent work. clpbn_init_solver(Solver, MargVars, AllVars, _, SolverVars). +run_examples(user:Exs, Keys, Factors, EList) :- + Exs = [_:_|_], !, + trace, + findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs), + VExs), + foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _). +run_examples(Items, Keys, Factors, EList) :- + run_ex(Items, Keys, Factors, EList). + +join_example( ex(EKs, EFs, EEs), Keys0, Keys, Factors0, Factors, EList0, EList, I0, I) :- + I is I0+1, + foldl(process_key(I0), EKs, Keys0, Keys), + foldl(process_factor(I0), EFs, Factors0, Factors), + foldl(process_ev(I0), EEs, EList0, EList). + +process_key(I0, K, Keys0, [I0:K|Keys0]). + +process_factor(I0, f(Type, Id, Keys), Keys0, [f(Type, Id, NKeys)|Keys0]) :- + maplist(update_key(I0), Keys, NKeys). + +update_key(I0, K, I0:K). + +process_ev(I0, K=V, Es0, [(I0:K)=V|Es0]). + +run_example([_:Items|_], Keys, Factors, EList) :- + run_ex(user:Items, Keys, Factors, EList). +run_example([_|LItems], Keys, Factors, EList) :- + run_example(LItems, Keys, Factors, EList). + +run_ex(Items, Keys, Factors, EList) :- + % create the ground network + call_run_all(Items), + attributes:all_attvars(AllVars0), + % and order them + 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). + % loop for as long as you want. em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :- estimate(State, LPs), @@ -147,37 +190,31 @@ ltables([Id-T|Tables], [Key-LTable|FTables]) :- generate_dists(Factors, EList, AllDists, AllInfo, MargVars) :- - b_hash_new(Ev0), - elist_to_hash(EList, Ev0, Ev), - process_factors(Factors, Ev, Dists0), - sort(Dists0, Dists1), - group(Dists1, AllDists, AllInfo, MargVars0, []), - sort(MargVars0, MargVars). + b_hash_new(Ev0), + foldl(elist_to_hash, EList, Ev0, Ev), + maplist(process_factor(Ev), Factors, Dists0), + sort(Dists0, Dists1), + group(Dists1, AllDists, AllInfo, MargVars0, []), + sort(MargVars0, MargVars). -elist_to_hash([], Ev, Ev). -elist_to_hash([K=V|EList], Ev0, Ev) :- - b_hash_insert(Ev0, K, V, Evi), - elist_to_hash(EList, Evi, Ev). +elist_to_hash(K=V, Ev0, Ev) :- + b_hash_insert(Ev0, K, V, Ev). -process_factors([], _Ev, []). -process_factors([f(bayes,Id,Ks)|Factors], Ev, [i(Id, Ks, Cases, NonEvs)|AllDistInstances]) :- - fetch_evidence(Ks, Ev, CompactCases, NonEvs), - uncompact_cases(CompactCases, Cases), - process_factors(Factors, Ev, AllDistInstances). +process_factor(Ev, f(bayes,Id,Ks), i(Id, Ks, Cases, NonEvs)) :- + foldl( fetch_evidence(Ev), Ks, CompactCases, [], NonEvs), + uncompact_cases(CompactCases, Cases). -fetch_evidence([], _Ev, [], []). -fetch_evidence([K|Ks], Ev, [E|CompactCases], NonEvs) :- - b_hash_lookup(K, E, Ev), !, - fetch_evidence(Ks, Ev, CompactCases, NonEvs). -fetch_evidence([K|Ks], Ev, [Ns|CompactCases], [K|NonEvs]) :- +fetch_evidence(Ev, K, E, NonEvs, NonEvs) :- + b_hash_lookup(K, E, Ev), !. +fetch_evidence(_Ev, _Id:K, Ns, NonEvs, [K|NonEvs]) :- + pfl:skolem(K,D), !, + foldl(domain_to_number, D, Ns, 0, _). +fetch_evidence(_Ev, K, Ns, NonEvs, [K|NonEvs]) :- pfl:skolem(K,D), - domain_to_numbers(D,0,Ns), - fetch_evidence(Ks, Ev, CompactCases, NonEvs). + foldl(domain_to_number, D, Ns, 0, _). -domain_to_numbers([],_,[]). -domain_to_numbers([_|D],I0,[I0|Ns]) :- - I is I0+1, - domain_to_numbers(D,I,Ns). +domain_to_number(_, I0, I0, I) :- + I is I0+1. % collect the different dists we are going to learn next. @@ -213,24 +250,6 @@ all_dists([V|AllVars], AllVars0, [i(Id, [V|Parents], Cases, Hiddens)|Dists]) :- uncompact_cases(CompactCases, Cases), all_dists(AllVars, AllVars0, Dists). -find_variables([], _AllVars0, []). -find_variables([K|PKeys], AllVars0, [Parent|Parents]) :- - find_variable(K, AllVars0, Parent), - find_variables(PKeys, AllVars0, Parents). - -% -% in clp(bn) the whole network is constructed when you evaluate EM. In -% pfl, we want to delay execution until as late as possible. -% we just create a new variable and hope for the best. -% -% -find_variable(K, [], Parent) :- - clpbn:put_atts(Parent, [key(K)]). -find_variable(K, [Parent|_AllVars0], Parent) :- - clpbn:get_atts(Parent, [key(K0)]), K0 =@= K, !. -find_variable(K, [_|AllVars0], Parent) :- - find_variable(K, AllVars0, Parent). - generate_hidden_cases([], [], []). generate_hidden_cases([V|Parents], [P|Cases], Hiddens) :- clpbn:get_atts(V, [evidence(P)]), !, @@ -280,19 +299,21 @@ compact_mvars([X1,X2|MargVars], CMVars) :- X1 == X2, !, compact_mvars([X|MargVars], [X|CMVars]) :- !, compact_mvars(MargVars, CMVars). +estimate(state(_, _, Margs, SolverState), LPs) :- + clpbn:use_parfactors(on), !, + clpbn_flag(em_solver, Solver), + pfl_run_solver(Margs, LPs, SolverState, Solver). estimate(state(_, _, Margs, SolverState), LPs) :- clpbn_flag(em_solver, Solver), clpbn_run_solver(Solver, Margs, LPs, SolverState). maximise(state(_,DistInstances,MargVars,_), Tables, LPs, Likelihood) :- rb_new(MDistTable0), - create_mdist_table(MargVars, LPs, MDistTable0, MDistTable), + foldl(create_mdist_table, MargVars, LPs, MDistTable0, MDistTable), compute_parameters(DistInstances, Tables, MDistTable, 0.0, Likelihood, LPs:MargVars). -create_mdist_table([],[],MDistTable,MDistTable). -create_mdist_table([Vs|MargVars],[Ps|LPs],MDistTable0,MDistTable) :- - rb_insert(MDistTable0, Vs, Ps, MDistTableI), - create_mdist_table(MargVars, LPs, MDistTableI ,MDistTable). +create_mdist_table(Vs, Ps, MDistTable0, MDistTable) :- + rb_insert(MDistTable0, Vs, Ps, MDistTable). compute_parameters([], [], _, Lik, Lik, _). compute_parameters([Id-Samples|Dists], [Id-NewTable|Tables], MDistTable, Lik0, Lik, LPs:MargVars) :- diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index 044014b16..67c51ccf2 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -21,7 +21,9 @@ :- reexport(library(clpbn), [clpbn_flag/2 as pfl_flag, - set_clpbn_flag/2 as set_pfl_flag]). + set_clpbn_flag/2 as set_pfl_flag, + pfl_init_solver/6, + pfl_run_solver/4]). :- reexport(library(clpbn/horus), [set_solver/1]). @@ -84,6 +86,8 @@ add_ground_factor(bayes, Domain, Vars, CPT, Id) :- asserta(skolem_in(K, Id)), assert(factor(bayes, Id, Vars, [], CPT, [])). +skolem(_Id:Key,Dom) :- skolem(Key, Dom). + defined_in_factor(Key, Factor) :- skolem_in(Key, Id), factor(bayes, Id, [Key|FList], FV, Phi, Constraints), !,