/************************************************ Belief Propagation in CLP(BN) **************************************************/ :- module(clpbn_bp, [bp/3, check_if_bp_done/1, set_solver_parameter/2, use_log_space/0, init_bp_solver/4, run_bp_solver/3, finalize_bp_solver/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(charsio)). :- load_foreign_files(['horus'], [], init_predicates). :- attribute id/1. :- dynamic network_counting/1. check_if_bp_done(_Var). network_counting(0). :- set_solver_parameter(run_mode, normal). %:- set_solver_parameter(run_mode, convert). %: -set_solver_parameter(run_mode, compress). :- set_solver_parameter(schedule, seq_fixed). %:- set_solver_parameter(schedule, seq_random). %:- set_solver_parameter(schedule, parallel). %:- set_solver_parameter(schedule, max_residual). :- set_solver_parameter(accuracy, 0.0001). :- set_solver_parameter(max_iter, 1000). :- set_solver_parameter(always_loopy_solver, false). % :- use_log_space. bp([[]],_,_) :- !. bp([QueryVars], AllVars, Output) :- init_bp_solver(_, AllVars, _, BayesNet), run_bp_solver([QueryVars], LPs, BayesNet), finalize_bp_solver(BayesNet), clpbn_bind_vals([QueryVars], LPs, Output). init_bp_solver(_, AllVars0, _, bp(BayesNet, DistIds, AllParFactors)) :- check_for_agg_vars(AllVars0, AllVars), %inc_network_counting, %writeln_clpbn_vars(AllVars), process_ids(AllVars, 0, DistIds0), % generate_parfactors(AllVars, AllParFactors), %writeln(AllParFactors), get_vars_info(AllVars, VarsInfo), sort(DistIds0, DistIds), %(network_counting(0) -> writeln(vars:VarsInfo) ; true), %(network_counting(0) -> writeln(distsids:DistIds) ; true), create_network(VarsInfo, BayesNet). %get_extra_vars_info(AllVars, ExtraVarsInfo), %(network_counting(0) -> writeln(extra:ExtraVarsInfo) ; true), %set_extra_vars_info(BayesNet, ExtraVarsInfo). writeln_clpbn_vars(Var.AVars) :- clpbn:get_atts(Var, [key(Key),dist(Dist,Parents)]), parents_to_keys(Parents, Keys), writeln(Var:Key:Dist:Keys), writeln_clpbn_vars(AVars). writeln_clpbn_vars([]). parents_to_keys([], []). parents_to_keys(Var.Parents, Key.Keys) :- clpbn:get_atts(Var, [key(Key)]), parents_to_keys(Parents, Keys). generate_parfactors(AllVars, ParFactors) :- generate_factors(AllVars, Factors), %writeln(Factors), % sort factors by distribution % sort(Factors, DistFactors), %writeln(DistFactors), group(DistFactors, ParFactors). %writeln(ParFactors). generate_factors(Var.AllVars, f(Dist,[Var|Parents]).AllFactors) :- clpbn:get_atts(Var, [dist(Dist,Parents)]), generate_factors(AllVars, AllFactors). generate_factors([], []). group([], []). group(f(Dist,Vs).DistFactors, phi(Dist,NConstraints,Domain).ParFactors) :- number(Dist), grab_similar_factors(Dist, Vs, f(Dist,Vs).DistFactors, RemainingDistFactors, Constraints), simplify_constraints(Constraints, NConstraints, Domain), !, group(RemainingDistFactors, ParFactors). group(f(Dist,Vs).DistFactors, phi(Dist,Constraints,[]).ParFactors) :- grab_similar_factors(Dist, Vs, f(Dist,Vs).DistFactors, RemainingDistFactors, Constraints), group(RemainingDistFactors, ParFactors). simplify_constraints([[1=El]|Constraints], [NEl], [in(1,NEl,Domain)]) :- functor(El,Name,1), !, functor(NEl,Name,1), constraints_to_domain(1,[[1=El]|Constraints],Domain0), sort(Domain0, Domain). simplify_constraints(Constraints, NewConstraints, Ds) :- Constraints = [Constraint|_], generate_domains(Constraint, Constraints, Ds), !, normalize_constraints(Ds, Constraints, NewConstraints). simplify_constraints(Constraints, Constraints, []). normalize_constraints(Ds, Constraints, [T|GeneralizedConstraints]) :- unique(Ds, I, T, RemDs), !, remove_i(Constraints, I, ConstraintsI), normalize_constraints(RemDs, ConstraintsI, GeneralizedConstraints). normalize_constraints(Ds, Constraints, [(S1,S2)|GeneralizedConstraints]) :- equal(Ds, I, J, RemDs, S1, S2), arg(1,S1,V), arg(1,S2,V), %writeln(start:Ds:I:J), remove_eqs(Constraints, I, J, ConstraintsI), !, normalize_constraints(RemDs, ConstraintsI, GeneralizedConstraints). normalize_constraints(_Ds, Constraints, []) :- Constraints = [[_]|_], !. normalize_constraints(_, Constraints, Constraints). unique([in(I,T,[_])|Ds], I, T, Ds). unique([D|Ds], I, T, D.NewDs) :- unique(Ds, I, T, NewDs). equal([in(I,S1,Vals)|Ds], I, J, Ds, S1, S2) :- equal2(Ds, Vals, J, S2), !. equal([D|Ds], I, J, D.NewDs, S1, S2) :- equal(Ds, I, J, NewDs, S1, S2). equal2([in(J,S2,Vals)|Ds], Vals, J, S2). equal2([D|Ds], Vals, J, S2) :- equal2(Ds, Vals, J, S2). remove_i([], _I, []). remove_i(C.Constraints, I, NewC.ConstraintsI) :- remove_ic(C,I,NewC), remove_i(Constraints, I, ConstraintsI). remove_ic([I=_|C], I, C) :- !. remove_ic(El.C, I, El.NewC) :- remove_ic(C, I, NewC). remove_eqs([], _I, _J, []). remove_eqs(C.Constraints, I, J, NewC.ConstraintsI) :- remove_eqs2(C, I, J, NewC), remove_eqs(Constraints, I, J, ConstraintsI). remove_eqs2([I=V|C], I, J, C) :- !, arg(1,V,A), check_match(C, J, A). remove_eqs2(El.C, I, J, El.NewC) :- remove_eqs2(C, I, J, NewC). check_match([J=V1|C], J, V) :- !, arg(1,V1,V). check_match(El.C, J, V) :- check_match(C, J, V). generate_domains([], _Constraints, []). generate_domains([I=El|Constraint], Constraints, in(I,NEl,Domain).Ds) :- functor(El,Name,1), !, functor(NEl,Name,1), constraints_to_domain(I,Constraints,Domain0), sort(Domain0, Domain), generate_domains(Constraint, Constraints, Ds). constraints_to_domain(_,[],[]). constraints_to_domain(I,[Constraint|Constraints],El.Domain) :- add_constraint_to_domain(I, Constraint, El), constraints_to_domain(I,Constraints,Domain). add_constraint_to_domain(I, [I=El|_], A) :- !, arg(1, El, A). add_constraint_to_domain(I, _.Constraint, El) :- add_constraint_to_domain(I, Constraint, El). grab_similar_factors(Dist, Vs, f(Dist,DVs).DistFactors, RemainingDistFactors, Constraint.Constraints) :- grab_similar_factor(DVs, 1, Constraint), !, grab_similar_factors(Dist, Vs, DistFactors, RemainingDistFactors, Constraints). grab_similar_factors(_Dist, _Vs, DistFactors, DistFactors, []). grab_similar_factor([], _Arg, []). grab_similar_factor(V.VDVs, Arg, (Arg=Key).Constraint) :- clpbn:get_atts(V,key(Key)), Arg1 is Arg+1, grab_similar_factor(VDVs, Arg1, Constraint). process_ids([], _, []). process_ids([V|Vs], VarId0, [DistId|DistIds]) :- clpbn:get_atts(V, [dist(DistId, _)]), !, put_atts(V, [id(VarId0)]), VarId is VarId0 + 1, process_ids(Vs, VarId, DistIds). process_ids([_|Vs], VarId, DistIds) :- process_ids(Vs, VarId, DistIds). get_vars_info([], []). get_vars_info([V|Vs], [var(VarId, DSize, Ev, ParentIds, DistId)|VarsInfo]) :- clpbn:get_atts(V, [dist(DistId, Parents)]), !, get_atts(V, [id(VarId)]), get_dist_domain_size(DistId, DSize), get_evidence(V, Ev), vars2ids(Parents, ParentIds), get_vars_info(Vs, VarsInfo). get_vars_info([_|Vs], VarsInfo) :- get_vars_info(Vs, VarsInfo). vars2ids([], []). vars2ids([V|QueryVars], [VarId|Ids]) :- get_atts(V, [id(VarId)]), vars2ids(QueryVars, Ids). get_evidence(V, Ev) :- clpbn:get_atts(V, [evidence(Ev)]), !. get_evidence(_V, -1). % no evidence !!! get_extra_vars_info([], []). get_extra_vars_info([V|Vs], [v(VarId, Label, Domain)|VarsInfo]) :- get_atts(V, [id(VarId)]), !, clpbn:get_atts(V, [key(Key),dist(DistId, _)]), term_to_atom(Key, Label), get_dist_domain(DistId, Domain0), numbers2atoms(Domain0, Domain), get_extra_vars_info(Vs, VarsInfo). get_extra_vars_info([_|Vs], VarsInfo) :- get_extra_vars_info(Vs, VarsInfo). numbers2atoms([], []). numbers2atoms([Atom|L0], [Atom|L]) :- atom(Atom), !, numbers2atoms(L0, L). numbers2atoms([Number|L0], [Atom|L]) :- number_atom(Number, Atom), numbers2atoms(L0, L). run_bp_solver(QVsL0, LPs, bp(BayesNet, DistIds, _)) :- get_dists_parameters(DistIds, DistsParams), set_parameters(BayesNet, DistsParams), process_query_list(QVsL0, QVsL), %(network_counting(0) -> writeln(qvs:QVsL) ; true), run_solver(BayesNet, QVsL, LPs). process_query_list([], []). process_query_list([[V]|QueryVars], [VarId|Ids]) :- !, get_atts(V, [id(VarId)]), process_query_list(QueryVars, Ids). process_query_list([Vs|QueryVars], [VarIds|Ids]) :- vars2ids(Vs, VarIds), process_query_list(QueryVars, Ids). get_dists_parameters([],[]). get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :- get_dist_params(Id, Params), get_dists_parameters(Ids, DistsInfo). finalize_bp_solver(bp(BayesNet, _, _)) :- free_bayesian_network(BayesNet). inc_network_counting :- retract(network_counting(Count0)), Count is Count0 + 1, assert(network_counting(Count)).