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

add more support for FOVE.

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-03-22 19:10:15 +00:00
parent 7d4f83ca40
commit a338b95d3f
14 changed files with 533 additions and 1243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/CLPBN/Makefile.in
View File

@ -16,6 +16,11 @@ YAPLIBDIR=@libdir@/Yap
#
SHAREDIR=$(ROOTDIR)/share/Yap
#
# where YAP should store documentation
#
DOCDIR=$(ROOTDIR)/share/doc/Yap
EXDIR=$(DOCDIR)/examples/CLPBN
#
#
# You shouldn't need to change what follows.
#
@ -35,6 +40,7 @@ CLPBN_EXDIR = $(srcdir)/examples
CLPBN_PROGRAMS= \
$(CLPBN_SRCDIR)/aggregates.yap \
$(CLPBN_SRCDIR)/bdd.yap \
$(CLPBN_SRCDIR)/bnt.yap \
$(CLPBN_SRCDIR)/bp.yap \
$(CLPBN_SRCDIR)/connected.yap \
@ -48,6 +54,7 @@ CLPBN_PROGRAMS= \
$(CLPBN_SRCDIR)/graphviz.yap \
$(CLPBN_SRCDIR)/ground_factors.yap \
$(CLPBN_SRCDIR)/hmm.yap \
$(CLPBN_SRCDIR)/horus.yap \
$(CLPBN_SRCDIR)/jt.yap \
$(CLPBN_SRCDIR)/matrix_cpt_utils.yap \
$(CLPBN_SRCDIR)/pgrammar.yap \
@ -72,6 +79,8 @@ CLPBN_SCHOOL_EXAMPLES= \
$(CLPBN_EXDIR)/School/parschema.yap \
$(CLPBN_EXDIR)/School/school_128.yap \
$(CLPBN_EXDIR)/School/school_32.yap \
$(CLPBN_EXDIR)/School/sch32.yap \
$(CLPBN_EXDIR)/School/school32_data.yap \
$(CLPBN_EXDIR)/School/school_64.yap \
$(CLPBN_EXDIR)/School/tables.yap
@ -92,12 +101,13 @@ CLPBN_EXAMPLES= \
install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/learning
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/examples/School
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/examples/HMMer
mkdir -p $(DESTDIR)$(EXDIR)
mkdir -p $(DESTDIR)$(EXDIR)/School
mkdir -p $(DESTDIR)$(EXDIR)/HMMer
for h in $(CLPBN_TOP); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
for h in $(CLPBN_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn; done
for h in $(CLPBN_LEARNING_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/learning; done
for h in $(CLPBN_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/examples; done
for h in $(CLPBN_SCHOOL_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/examples/School; done
for h in $(CLPBN_HMMER_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/examples/HMMer; done
for h in $(CLPBN_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR); done
for h in $(CLPBN_SCHOOL_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/School; done
for h in $(CLPBN_HMMER_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/HMMer; done

37
packages/CLPBN/clpbn.yap
View File

@ -5,6 +5,7 @@
set_clpbn_flag/2,
clpbn_flag/3,
clpbn_key/2,
clpbn_language/1,
clpbn_init_solver/4,
clpbn_run_solver/3,
clpbn_finalize_solver/1,
@ -61,6 +62,12 @@
run_jt_solver/3
]).
:- use_module('clpbn/bdd',
[bdd/3,
init_bdd_solver/4,
run_bdd_solver/3
]).
:- use_module('clpbn/bnt',
[do_bnt/3,
check_if_bnt_done/1
@ -140,6 +147,9 @@ clpbn_flag(output,Before,After) :-
clpbn_flag(solver,Before,After) :-
retract(solver(Before)),
assert(solver(After)).
clpbn_flag(language,Before,After) :-
retract(clpbn_language(Before)),
assert(clpbn_language(After)).
clpbn_flag(em_solver,Before,After) :-
retract(em_solver(Before)),
assert(em_solver(After)).
@ -244,7 +254,8 @@ project_attributes(GVars, AVars0) :-
project_attributes(_, _).
generate_vars(GVars, _, NewAVars) :-
use_parfactors(on), !,
use_parfactors(on),
clpbn_flag(solver, Solver), Solver \= fove, !,
generate_bn(GVars, NewAVars).
generate_vars(_GVars, AVars, AVars).
@ -289,6 +300,8 @@ write_out(ve, GVars, AVars, DiffVars) :-
ve(GVars, AVars, DiffVars).
write_out(jt, GVars, AVars, DiffVars) :-
jt(GVars, AVars, DiffVars).
write_out(bdd, GVars, AVars, DiffVars) :-
bdd(GVars, AVars, DiffVars).
write_out(bp, GVars, AVars, DiffVars) :-
bp(GVars, AVars, DiffVars).
write_out(gibbs, GVars, AVars, DiffVars) :-
@ -382,6 +395,9 @@ bind_clpbn(_, Var, _, _, _, _, []) :-
bind_clpbn(_, Var, _, _, _, _, []) :-
use(jt),
check_if_ve_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bdd),
check_if_bdd_done(Var), !.
bind_clpbn(T, Var, Key0, _, _, _, []) :-
get_atts(Var, [key(Key)]), !,
(
@ -452,6 +468,8 @@ clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_bp_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_bdd_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State).
@ -478,6 +496,9 @@ clpbn_run_solver(bp, LVs, LPs, State) :-
clpbn_run_solver(jt, LVs, LPs, State) :-
run_jt_solver(LVs, LPs, State).
clpbn_run_solver(bdd, LVs, LPs, State) :-
run_bdd_solver(LVs, LPs, State).
clpbn_run_solver(pcg, LVs, LPs, State) :-
run_pcg_solver(LVs, LPs, State).
@ -538,4 +559,18 @@ match_probability([p(V0=C)=Prob|_], C, V, Prob) :-
match_probability([_|Probs], C, V, Prob) :-
match_probability(Probs, C, V, Prob).
:- dynamic clpbn_language/1.
pfl_not_clpbn :-
clpbn_language(clpbn), !,
throw(error(pfl('should be called before clpbn'))).
pfl_not_clpbn :-
assert(clpbn_language(pfl)).
clpbn_not_pfl :-
clpbn_language(pfl), !.
clpbn_not_pfl :-
assert(clpbn_language(clpbn)).
:- clpbn_not_pfl.

352
packages/CLPBN/clpbn/bdd.yap Normal file
View File

@ -0,0 +1,352 @@
/************************************************
BDDs in CLP(BN)
A variable is represented by the N possible cases it can take
V = v(Va, Vb, Vc)
The generic formula is
V <- X, Y
Va <- P*X1*Y1 + Q*X2*Y2 + ...
**************************************************/
:- module(clpbn_bdd,
[bdd/3,
set_solver_parameter/2,
init_bdd_solver/4,
run_bdd_solver/3,
finalize_bdd_solver/1,
check_if_bdd_done/1
]).
:- use_module(library('clpbn/dists'),
[dist/4,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_params/2
]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
:- use_module(library(atts)).
:- use_module(library(lists)).
:- use_module(library(dgraphs)).
:- use_module(library(bdd)).
:- use_module(library(rbtrees)).
:- attribute id/1.
:- dynamic network_counting/1.
check_if_bdd_done(_Var).
bdd([[]],_,_) :- !.
bdd([QueryVars], AllVars, AllDiffs) :-
init_bdd_solver(_, AllVars, _, BayesNet),
run_bdd_solver([QueryVars], LPs, BayesNet),
finalize_bdd_solver(BayesNet),
clpbn_bind_vals([QueryVars], [LPs], AllDiffs).
init_bdd_solver(_, AllVars0, _, bdd(Term, Leaves)) :-
check_for_agg_vars(AllVars0, AllVars1),
sort_vars(AllVars1, AllVars, Leaves),
rb_new(Vars0),
rb_new(Pars0),
get_vars_info(AllVars, Vars0, _Vars, Pars0, _Pars, Term, []).
sort_vars(AllVars0, AllVars, Leaves) :-
dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, RAllVars),
reverse(RAllVars, AllVars).
build_graph([], Graph, Graph).
build_graph(V.AllVars0, Graph0, Graph) :-
clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph).
build_graph(_V.AllVars0, Graph0, Graph) :-
build_graph(AllVars0, Graph0, Graph).
add_parents([], _V, Graph, Graph).
add_parents(V0.Parents, V, Graph0, GraphF) :-
dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF).
get_vars_info([], Vs, Vs, Ps, Ps) --> [].
get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF) -->
{ clpbn:get_atts(V, [dist(DistId, Parents)]) }, !,
[DIST],
{ check_p(DistId, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
check_v(V, DistId, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
get_parents(Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
get_evidence(V, Tree, Ev, Formula0, Formula)
% (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
},
get_vars_info(MoreVs, Vs2, VsF, Ps1, PsF).
get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo) :-
get_vars_info(MoreVs, Vs0, VsF, Ps0, PsF, VarsInfo).
%
% look for parameters in the rb-tree, or add a new.
% distid is the key
%
check_p(DistId, Parms, ParmVars, Ps, Ps) :-
rb_lookup(DistId, theta(Parms, ParmVars), Ps), !.
check_p(DistId, Parms, ParmVars, Ps, PsF) :-
get_dist_params(DistId, Parms0),
length(Parms0, L0),
get_dist_domain_size(DistId, Size),
L1 is L0 div Size,
L is L0-L1,
initial_maxes(L1, Multipliers),
copy(L, Multipliers, NextMults, NextMults, Parms0, Parms, ParmVars),
rb_insert(Ps, DistId, theta(DistId, Parms, ParmVars), PsF).
%
% we are using switches by two
%
initial_maxes(0, []) :- !.
initial_maxes(Size, [1.0|Multipliers]) :- !,
Size1 is Size-1,
initial_maxes(Size1, Multipliers).
copy(0, [], [], _, _Parms0, [], []) :- !.
copy(N, [], [], Ms, Parms0, Parms, ParmVars) :-!,
copy(N, Ms, NewMs, NewMs, Parms0, Parms, ParmVars).
copy(N, D.Ds, ND.NDs, New, El.Parms0, NEl.Parms, _.ParmVars) :-
N1 is N-1,
NEl is El/D,
ND is D-El,
copy(N1, Ds, NDs, New, Parms0, Parms, ParmVars).
unbound_parms([], []).
unbound_parms(_.Parms, _.ParmVars) :-
unbound_parms(Parms, ParmVars).
check_v(V, _, INFO, Vs, Vs) :-
rb_lookup(V, INFO, Vs), !.
check_v(V, DistId, INFO, Vs0, Vs) :-
get_dist_domain_size(DistId, Size),
length(Values, Size),
length(Ev, Size),
INFO = info(V, _Tree, Ev, Values, _Formula, _, _),
rb_insert(Vs0, V, INFO, Vs).
get_parents([], [], Vs, Vs).
get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
clpbn:get_atts(V, [dist(DistId, _)]),
check_v(V, DistId, INFO, Vs0, Vs1),
INFO = info(V, _Parent, _Ev, Values, _, _, _),
get_parents(Parents, PVars, Vs1, Vs).
%
% construct the formula, this is the key...
%
cross_product(Values, Ev, PVars, ParmVars, Formulas) :-
arrangements(PVars, Arranges),
apply_parents_first(Values, Ev, ParmCombos, ParmCombos, Arranges, Formulas, ParmVars).
%
% if we have the parent variables with two values, we get
% [[XP,YP],[XP,YN],[XN,YP],[XN,YN]]
%
arrangements([], [[]]).
arrangements([L1|Ls],O) :-
arrangements(Ls, LN),
expand(L1, LN, O, []).
expand([], _LN) --> [].
expand([H|L1], LN) -->
concatenate_all(H, LN),
expand(L1, LN).
concatenate_all(_H, []) --> [].
concatenate_all(H, L.LN) -->
[[H|L]],
concatenate_all(H, LN).
%
% core of algorithm
%
% Values -> Output Vars for BDD
% Es -> Evidence variables
% Previous -> top of difference list with parameters used so far
% P0 -> end of difference list with parameters used so far
% Pvars -> Parents
% Eqs -> Output Equations
% Pars -> Output Theta Parameters
%
apply_parents_first([Value], [E], Previous, [], PVars, [Value=Disj*E], Parameters) :- !,
apply_last_parent(PVars, Previous, Disj),
flatten(Previous, Parameters).
apply_parents_first([Value|Values], [E|Ev], Previous, P0, PVars, (Value=Disj*E).Formulas, Parameters) :-
P0 = [TheseParents|End],
apply_first_parent(PVars, Disj, TheseParents),
apply_parents_second(Values, Ev, Previous, End, PVars, Formulas, Parameters).
apply_parents_second([Value], [E], Previous, [], PVars, [Value=Disj*E], Parameters) :- !,
apply_last_parent(PVars, Previous, Disj),
flatten(Previous, Parameters).
apply_parents_second([Value|Values], [E|Ev], Previous, P0, PVars, (Value=Disj*E).Formulas, Parameters) :-
apply_middle_parent(PVars, Previous, Disj, TheseParents),
% this must be done after applying middle parents because of the var
% test.
P0 = [TheseParents|End],
apply_parents_second(Values, Ev, Previous, End, PVars, Formulas, Parameters).
apply_first_parent([Parents], Conj, [Theta]) :- !,
parents_to_conj(Parents,Theta,Conj).
apply_first_parent(Parents.PVars, Disj+Conj, Theta.TheseParents) :-
parents_to_conj(Parents,Theta,Conj),
apply_first_parent(PVars, Disj, TheseParents).
apply_last_parent([Parents], Other, Conj) :- !,
parents_to_conj(Parents,(Theta),Conj),
skim_for_theta(Other, Theta, _, _).
apply_last_parent(Parents.PVars, Other, Conj+Disj) :-
parents_to_conj(Parents,(Theta),Conj),
skim_for_theta(Other, Theta, Remaining, _),
apply_last_parent(PVars, Remaining, Disj).
apply_middle_parent([Parents], Other, Conj, [ThetaPar]) :- !,
parents_to_conj(Parents,(Theta),Conj),
skim_for_theta(Other, Theta, _, ThetaPar).
apply_middle_parent(Parents.PVars, Other, Conj+Disj, ThetaPar.TheseParents) :-
parents_to_conj(Parents,(Theta),Conj),
skim_for_theta(Other, Theta, Remaining, ThetaPar),
apply_middle_parent(PVars, Remaining, Disj, TheseParents).
parents_to_conj([],Theta,Theta).
parents_to_conj(P.Parents,Theta,Conj*P) :-
parents_to_conj(Parents,Theta,Conj).
%
% first case we haven't reached the end of the list so we need
% to create a new parameter variable
%
skim_for_theta([[P|Other]|V], New*not(P), [Other|_], New) :- var(V), !.
%
% last theta, it is just negation of the other ones
%
skim_for_theta([[P|Other]], not(P), [Other], _) :- !.
%
% recursive case, build-up
%
skim_for_theta([[P|Other]|More], Ps*not(P), [Other|Left], New ) :-
skim_for_theta(More, Ps, Left, New ).
get_evidence(V, Tree, Values, F0, F) :-
clpbn:get_atts(V, [evidence(Pos)]), !,
zero_pos(0, Pos, Tree, Values, F0, F).
%% no evidence !!!
get_evidence(_V, Tree, _Values, F0, (Tree=Outs).F0) :-
get_outs(F0, Outs).
zero_pos(_, _Pos, _Tree, [], [], []) :- !.
zero_pos(Pos, Pos, Tree, 1.Values, [Tree=Vs|F], [Tree=Vs]) :-
I is Pos+1,
zero_pos(I, Pos, Tree, Values, F, []).
zero_pos(I0, Pos, Tree, 0.Values, _.F, NF) :-
I is I0+1,
zero_pos(I, Pos, Tree, Values, F, NF).
get_outs([V=_F], V) :- !.
get_outs((V=_F).Outs, (V + F0)) :-
get_outs(Outs, F0).
run_bdd_solver([[V]], LPs, bdd(Term, Leaves)) :-
build_out_node(Term, Leaves, Node),
findall(Prob, get_prob(Term, Node, V, Prob),TermProbs),
sumlist(TermProbs, Sum),
normalise(TermProbs, Sum, LPs).
build_out_node(Term, [Leaf], Top) :- !,
find_exp(Leaf, Term, Top).
build_out_node(Term, [Leaf|Leaves], Tops*Top) :-
find_exp(Leaf, Term, Top),
build_out_node(Term, Leaves, Tops).
find_exp(Leaf, info(V, Top, _Ev, _Values, _Formula, _ParmVars, _Parms)._, Top) :-
V == Leaf, !.
find_exp(Leaf, _.Term, Top) :-
find_exp(Leaf, Term, Top).
get_prob(Term, Top, V, SP) :-
bind_all(Term, V, AllParms, AllParmValues),
term_variables(AllParms, NVs),
build_bdd(Top, NVs, AllParms, AllParmValues, Bdd),
bdd_to_probability_sum_product(Bdd, SP),
bdd_close(Bdd).
build_bdd(X, NVs, VTheta, Theta, Bdd) :-
bdd_new(X, NVs, Bdd),
bdd_tree(Bdd, bdd(_F,Tree,_Vs)), length(Tree, Len),
VTheta = Theta,
writeln(length=Len).
bind_all([], _V, [], []).
bind_all(info(V, _Tree, Ev, _Values, Formula, ParmVars, Parms).Term, V0, ParmVars.AllParms, Parms.AllTheta) :-
V0 == V, !,
set_to_one_zeros(Ev),
bind_formula(Formula),
bind_all(Term, V0, AllParms, AllTheta).
bind_all(info(_V, _Tree, Ev, _Values, Formula, ParmVars, Parms).Term, V0, ParmVars.AllParms, Parms.AllTheta) :-
set_to_ones(Ev),!,
bind_formula(Formula),
bind_all(Term, V0, AllParms, AllTheta).
% evidence: no need to add any stuff.
bind_all(info(_V, _Tree, _Ev, _Values, Formula, ParmVars, Parms).Term, V0, ParmVars.AllParms, Parms.AllTheta) :-
bind_formula(Formula),
bind_all(Term, V0, AllParms, AllTheta).
bind_formula([]).
bind_formula((A=A).Formula) :-
bind_formula(Formula).
set_to_one_zeros([1|Values]) :-
set_to_zeros(Values).
set_to_one_zeros([0|Values]) :-
set_to_one_zeros(Values).
set_to_zeros([]).
set_to_zeros(0.Values) :-
set_to_zeros(Values).
set_to_ones([]).
set_to_ones(1.Values) :-
set_to_ones(Values).
normalise([], _Sum, []).
normalise(P.TermProbs, Sum, NP.LPs) :-
NP is P/Sum,
normalise(TermProbs, Sum, LPs).
finalize_bdd_solver(_).

2
packages/CLPBN/clpbn/bp.yap
View File

@ -35,7 +35,7 @@
:- use_module(library(lists)).
:- use_module(library(charsio)).
:- load_foreign_files(['horus'], [], init_predicates).
:- use_module(horus).
:- attribute id/1.

2
packages/CLPBN/clpbn/discrete_utils.yap
View File

@ -3,7 +3,7 @@
reorder_CPT/5,
get_dist_size/2]).
:- use_module(dists, [get_dist_domain_size/2,
:- use_module(library(clpbn/dists), [get_dist_domain_size/2,
get_dist_domain/2]).
%
% remove columns from a table

8
packages/CLPBN/clpbn/display.yap
View File

@ -6,7 +6,7 @@
member/2
]).
:- use_module(dists, [get_dist_domain/2]).
:- use_module(library(clpbn/dists), [get_dist_domain/2]).
:- attribute posterior/4.
@ -60,9 +60,13 @@ get_all_combs(Vs, Vals) :-
get_all_doms([], []).
get_all_doms([V|Vs], [D|Ds]) :-
clpbn:get_atts(V, [dist(Id,_)]),
clpbn:get_atts(V, [dist(Id,_)]), !,
get_dist_domain(Id,D),
get_all_doms(Vs, Ds).
get_all_doms([V|Vs], [D|Ds]) :-
clpbn:get_atts(V, [key(K)]),
pfl:skolem(K,D),
get_all_doms(Vs, Ds).
ms([], []).
ms([H|L], [El|Els]) :-

33
packages/CLPBN/clpbn/dists.yap
View File

@ -1,4 +1,4 @@
%
s%
% routines to manipulate distributions
%
@ -224,6 +224,10 @@ get_dsizes([P|Parents], [Sz|Sizes], Sizes0) :-
get_dist_params(Id, Parms) :-
recorded(clpbn_dist_db, db(Id, _, Parms, _, _, _, _), _).
get_dist_domain_size(DistId, DSize) :-
clpbn:clpbn_language(pfl), !,
pfl:get_pfl_parameters(DistId, Dist),
length(Dist, DSize).
get_dist_domain_size(avg(D,_), DSize) :- !,
length(D, DSize).
get_dist_domain_size(ip(D,_,_), DSize) :- !,
@ -234,6 +238,9 @@ get_dist_domain_size(Id, DSize) :-
get_dist_domain(Id, Domain) :-
recorded(clpbn_dist_db, db(Id, _, _, _, Domain, _, _), _).
get_dist_key(Id, Key) :-
clpbn:clpbn_language(pfl), !,
pfl:get_first_pvariable(Id, Key).
get_dist_key(Id, Key) :-
recorded(clpbn_dist_db, db(Id, Key, _, _, _, _, _), _).
@ -264,12 +271,20 @@ get_evidence_from_position(El, Id, Pos) :-
dist_to_term(_Id,_Term).
empty_dist(Dist, TAB) :-
clpbn:clpbn_language(pfl), !,
pfl:get_pfl_factor_sizes(Dist, DSizes),
matrix_new(floats, DSizes, TAB).
empty_dist(Dist, TAB) :-
recorded(clpbn_dist_psizes,db(Dist, DSizes),_), !,
matrix_new(floats, DSizes, TAB).
empty_dist(Dist, TAB) :-
throw(error(domain_error(no_distribution,Dist),empty_dist(Dist,TAB))).
dist_new_table(DistId, NewMat) :-
clpbn:clpbn_language(pfl), !,
matrix_to_list(NewMat, List),
pfl:set_pfl_parameters(DistId, List).
dist_new_table(Id, NewMat) :-
matrix_to_list(NewMat, List),
recorded(clpbn_dist_db, db(Id, Key, _, A, B, C, D), R),
@ -297,7 +312,13 @@ randomise_all_dists :-
randomise_all_dists.
randomise_dist(Dist) :-
recorded(clpbn_dist_psizes, db(Dist,DSizes), _),
(
clpbn:clpbn_language(pfl)
->
pfl:get_pfl_factor_sizes(Dist, DSizes)
;
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
),
random_CPT(DSizes, NewCPT),
dist_new_table(Dist, NewCPT).
@ -307,7 +328,13 @@ uniformise_all_dists :-
uniformise_all_dists.
uniformise_dist(Dist) :-
recorded(clpbn_dist_psizes, db(Dist,DSizes), _),
(
clpbn:clpbn_language(pfl)
->
pfl:get_pfl_factor_sizes(Dist, DSizes)
;
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
),
uniform_CPT(DSizes, NewCPT),
dist_new_table(Dist, NewCPT).

2
packages/CLPBN/clpbn/ground_factors.yap
View File

@ -62,7 +62,7 @@ run_through_factors(V.Vars, H0, HF) -->
% aggregates are special.
construct_clpbn_node(K, V, HI) -->
% and get the corresponding factor
{ factor(Id, [K|Ks], _, avg, Constraints) }, !,
{ factor(_Id, [K|Ks], _, avg, Constraints) }, !,
{
skolem(K, Domain),
dist(avg(Domain, Parents), DistId, K, Parents),

16
packages/CLPBN/clpbn/horus.yap Normal file
View File

@ -0,0 +1,16 @@
:- module(clpbn_horus,
[
create_lifted_network/3,
create_ground_network/2,
set_parfactor_graph_params/2,
set_bayes_net_params/2,
run_lifted_solver/3,
run_other_solvers/3,
set_extra_vars_info/2,
set_horus_flag/2,
free_bayesian_network/1,
free_parfactor_graph/1
]).
:- load_foreign_files(['horus'], [], init_predicates).

6
packages/CLPBN/clpbn/matrix_cpt_utils.yap
View File

@ -20,10 +20,14 @@
uniform_CPT_as_list/2,
normalise_CPT_on_lines/3]).
:- use_module(dists,
:- writeln(h0).
:- use_module(library(dists),
[get_dist_domain_size/2,
get_dist_domain/2]).
:- writeln(h1).
:- use_module(library(matrix),
[matrix_new/4,
matrix_new_set/4,

9
packages/CLPBN/examples/School/README
View File

@ -5,9 +5,14 @@ There are four main files:
school_128.yap: a school with 128 professors, 256 courses and 4096 students.
school_64.yap: medium size school
school_32.yap: small school
school_32.yap: small school (pfl)
sch32.yap: small school (clp(bn))
parschema.yap: the CLP(BN) schema
schema.yap: the PFL schema
schema.yap: the schema
tables: CPTs

1219
packages/CLPBN/examples/School/school_32.yap
View File

File diff suppressed because it is too large Load Diff

2
packages/CLPBN/learning/example/school_params.yap
View File

@ -4,7 +4,7 @@
:- [pos:train].
:- ['../../examples/School/school_32'].
:- ['../../examples/School/sch32'].
:- use_module(library(clpbn/learning/em)).

68
packages/CLPBN/pfl.yap
View File

@ -3,26 +3,42 @@
%
%
:- module(clpbn_parfactors, [
:- module(pfl, [
factor/5,
skolem/2,
get_pfl_parameters/2, % given id return par factor parameter
new_pfl_parameters/2, % given id set new parameters
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
get_factor_pvariable/2, % given id get any pvar
op(550,yfx,::),
op(1150,fx,bayes),
op(1150,fx,markov),
op(1150,fx,parfactor)]).
:- use_module(library(lists),
[nth0/3,
append/3]).
append/3,
member/2]).
:- dynamic factor/5, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
:- reexport(library(clpbn),
[clpbn_flag/3,
set_clpbn_flag/2]).
[clpbn_flag/2,
clpbn_flag/2 as pfl_flag,
set_clpbn_flag/2,
set_clpbn_flag/2 as set_pfl_flag]).
:- set_clpbn_flag(use_factors,on).
:- set_pfl_flag(use_factors,on).
user:term_expansion( bayes((Formula ; Phi ; Constraints)), clpbn_parfactors:factor(Id,FList,FV,Phi,Constraints)) :-
:- pfl_not_clpbn.
user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :-
!,
term_variables(Formula, FreeVars),
FV =.. [fv|FreeVars],
new_id(Id),
process_args(Formula, Id, 0, _, FList, []).
user:term_expansion( markov((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :-
!,
term_variables(Formula, FreeVars),
FV =.. [fv|FreeVars],
@ -32,7 +48,7 @@ user:term_expansion( Goal, [] ) :-
preprocess(Goal, Sk,Var), !,
(ground(Goal) -> true ; throw(error('non ground evidence',Goal))),
% prolog_load_context(module, M),
assert(evidence(Sk,Var)).
assert(pfl:evidence(Sk,Var)).
id(0).
@ -78,7 +94,10 @@ interface_predicate(Sk) :-
ESk =.. ESKAs,
assert(preprocess(ESk, Sk, Var)),
assert_static((user:ESk :-
var(Var) -> insert_atts(Var,Sk) ; add_evidence(Sk,Var) )
evidence(Sk,Ev) -> Ev = Var;
var(Var) -> insert_atts(Var,Sk) ;
add_evidence(Sk,Var)
)
).
insert_atts(Var,Sk) :-
@ -90,3 +109,36 @@ add_evidence(Sk,Var) :-
clpbn:put_atts(_V,[key(Sk),evidence(E)]).
get_pfl_parameters(Id,Out) :-
factor(Id,_FList,_FV,Phi,_Constraints),
writeln(factor(Id,_FList,_FV,_Phi,_Constraints)),
( is_list(Phi) -> Out = Phi ; call(user:Phi, Out) ).
new_pfl_parameters(Id, NewPhi) :-
retract(factor(Id,FList,FV,_Phi,Constraints)),
assert(factor(Id,FList,FV,NewPhi,Constraints)),
fail.
new_pfl_parameters(_Id, _NewPhi).
get_pfl_factor_sizes(Id, DSizes) :-
factor(Id, FList, _FV, _Phi, _Constraints),
get_sizes(FList, DSizes).
get_sizes([], []).
get_sizes(Key.FList, Sz.DSizes) :-
skolem(Key, Domain),
length(Domain, Sz),
get_sizes(FList, DSizes).
% only makes sense for bayesian networks
get_first_pvariable(Id,Var) :-
factor(Id,Var._FList,_FV,_Phi,_Constraints).
% only makes sense for bayesian networks
get_factor_pvariable(Id,Var) :-
factor(Id,FList,_FV,_Phi,_Constraints),
member(Var, FList).