add more support for FOVE.
This commit is contained in:
Vítor Santos Costa
parent
7d4f83ca40
commit
a338b95d3f
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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(_).
|
||||
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
:- use_module(library(lists)).
|
||||
:- use_module(library(charsio)).
|
||||
|
||||
:- load_foreign_files(['horus'], [], init_predicates).
|
||||
:- use_module(horus).
|
||||
|
||||
:- attribute id/1.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]) :-
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
:- [pos:train].
|
||||
|
||||
:- ['../../examples/School/school_32'].
|
||||
:- ['../../examples/School/sch32'].
|
||||
|
||||
:- use_module(library(clpbn/learning/em)).
|
||||
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
Reference in New Issue