diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

more EM stuff

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-09-29 11:50:00 +01:00
parent 78a08e1b87
commit 793907f710
11 changed files with 218 additions and 125 deletions

37
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).
%

14
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) :-

2
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).

18
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)).

23
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) :-

3
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).

43
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).
%
%

6
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, _),

46
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).

145
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) :-

6
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), !,