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

first steps in adapting horus ground solvers to pfl

Browse Source
This commit is contained in:
Tiago Gomes 2012-04-03 19:53:27 +01:00
parent 2bdec8f725
commit 6c3add2ebd
7 changed files with 140 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -10,7 +10,7 @@
check_if_bp_done/1,
init_bp_solver/4,
run_bp_solver/3,
call_bp_ground/5,
call_bp_ground/5,
finalize_bp_solver/1
]).
@ -31,30 +31,21 @@
[check_for_agg_vars/2]).
:- use_module(library(charsio),
[term_to_atom/2]).
:- use_module(library(pfl),
[skolem/2,
get_pfl_parameters/2
]).
:- use_module(library(clpbn/horus)).
:- use_module(library(lists)).
:- use_module(library(atts)).
:- attribute id/1.
%:- set_horus_flag(inf_alg, ve).
:- set_horus_flag(inf_alg, bn_bp).
%:- set_horus_flag(inf_alg, fg_bp).
%: -set_horus_flag(inf_alg, cbp).
:- set_horus_flag(schedule, seq_fixed).
%:- set_horus_flag(schedule, seq_random).
%:- set_horus_flag(schedule, parallel).
%:- set_horus_flag(schedule, max_residual).
:- set_horus_flag(accuracy, 0.0001).
:- use_module(library(charsio),
[term_to_atom/2]).
:- use_module(library(bhash)).
@ -63,48 +54,77 @@
set_bayes_net_params/2,
run_ground_solver/3,
set_extra_vars_info/2,
free_bayesian_network/1
free_ground_network/1
]).
:- attribute id/1.
call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
b_hash_new(Hash0),
keys_to_ids(AllKeys, 0, Hash0, Hash),
InvMap =.. [view|AllKeys],
list_of_keys_to_ids(QueryKeys, Hash, QueryVarsIds),
evidence_to_ids(Evidence, Hash, EvIds, EvIdNames),
factors_to_ids(Factors, Hash, FactorIds),
init_graphical_model(FactorIds, Network, InvMap, EvIdNames),
run_ground_solver(Network, QueryVarsIds, EvIds, Solutions),
free_graphical_model(Network).
b_hash_new(Hash0),
keys_to_ids(AllKeys, 0, Hash0, Hash),
%InvMap =.. [view|AllKeys],
list_of_keys_to_ids(QueryKeys, Hash, QueryIds),
evidence_to_ids(Evidence, Hash, EvIds),
factors_to_ids(Factors, Hash, FactorIds),
get_factors_type(Factors, Type),
writeln(type:Type), writeln(''),
writeln(allKeys:AllKeys), writeln(''),
%writeln(allKeysIds:Hash), writeln(''),
writeln(queryKeys:QueryKeys), writeln(''),
writeln(queryIds:QueryIds), writeln(''),
writeln(factors:Factors), writeln(''),
writeln(factorIds:FactorIds), writeln(''),
writeln(evidence:Evidence), writeln(''),
writeln(evIds:EvIds),
create_ground_network(Type, FactorIds, GroundNetwork).
%run_ground_solver(Network, QueryIds, EvIds, Solutions),
%free_graphical_model(Network).
get_factors_type([f(bayes, _, _)|_], bayes) :- ! .
get_factors_type([f(markov, _, _)|_], markov) :- ! .
keys_to_ids([], _, Hash, Hash).
keys_to_ids([Key|AllKeys], I0, Hash0, Hash) :-
b_hash_insert(Hash0, Key, I0, HashI),
I is I0+1,
keys_to_ids(AllKeys, I, HashI, Hash).
b_hash_insert(Hash0, Key, I0, HashI),
I is I0+1,
keys_to_ids(AllKeys, I, HashI, Hash).
list_of_keys_to_ids([], _, []).
list_of_keys_to_ids([Key|QueryKeys], Hash, [Id|QueryIds]) :-
b_hash_lookup(Key, Id, Hash),
list_of_keys_to_ids(QueryKeys, Hash, QueryIds).
b_hash_lookup(Key, Id, Hash),
list_of_keys_to_ids(QueryKeys, Hash, QueryIds).
evidence_to_ids([], _, []).
evidence_to_ids([Key=Ev|QueryKeys], Hash, [Id=Ev|QueryIds]) :-
b_hash_lookup(Key, Id, Hash),
evidence_to_ids(QueryKeys, Hash, QueryIds).
%evidence_to_ids([], _, [], []).
%evidence_to_ids([Key=V|QueryKeys], Hash, [Id=V|QueryIds], [Id=Name|QueryNames]) :-
% b_hash_lookup(Key, Id, Hash),
% pfl:skolem(Key,Dom),
% nth0(V, Dom, Name),
% evidence_to_ids(QueryKeys, Hash, QueryIds, QueryNames).
evidence_to_ids([], _, [], []).
evidence_to_ids([Key=V|QueryKeys], Hash, [Id=V|QueryIds], [Id=Name|QueryNames]) :-
b_hash_lookup(Key, Id, Hash),
pfl:skolem(Key,Dom),
nth0(V, Dom, Name),
evidence_to_ids(QueryKeys, Hash, QueryIds, QueryNames).
factors_to_ids([], _, []).
factors_to_ids([f(markov, Keys, CPT)|Fs], Hash, [markov(Ids, CPT)|NFs]) :-
list_of_keys_to_ids(Keys, Hash, Ids),
factors_to_ids(Fs, Hash, NFs).
factors_to_ids([f(bayes, Keys, CPT)|Fs], Hash, [bayes(Ids, CPT)|NFs]) :-
list_of_keys_to_ids(Keys, Hash, Ids),
factors_to_ids(Fs, Hash, NFs).
factors_to_ids([f(_, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
list_of_keys_to_ids(Keys, Hash, Ids),
DistId = 0,
get_ranges(Keys, Ranges),
factors_to_ids(Fs, Hash, NFs).
get_ranges([],[]).
get_ranges(K.Ks, Range.Rs) :- !,
skolem(K,Domain),
length(Domain,Range),
get_ranges(Ks, Rs).
bp([[]],_,_) :- !.
@ -117,9 +137,8 @@ bp([QueryVars], AllVars, Output) :-
init_bp_solver(_, AllVars0, _, bp(BayesNet, DistIds)) :-
%writeln('init_bp_solver'),
check_for_agg_vars(AllVars0, AllVars),
%check_for_agg_vars(AllVars0, AllVars),
%writeln('clpbn_vars:'), print_clpbn_vars(AllVars),
assign_ids(AllVars, 0),
get_vars_info(AllVars, VarsInfo, DistIds0),
sort(DistIds0, DistIds),
create_ground_network(VarsInfo, BayesNet),
@ -138,41 +157,7 @@ run_bp_solver(QueryVars, Solutions, bp(Network, DistIds)) :-
finalize_bp_solver(bp(Network, _)) :-
free_bayesian_network(Network).
assign_ids([], _).
assign_ids([V|Vs], Count) :-
put_atts(V, [id(Count)]),
Count1 is Count + 1,
assign_ids(Vs, Count1).
get_vars_info([], [], []).
get_vars_info(V.Vs,
var(VarId,DS,Ev,PIds,DistId).VarsInfo,
DistId.DistIds) :-
clpbn:get_atts(V, [dist(DistId, Parents)]), !,
get_atts(V, [id(VarId)]),
get_dist_domain_size(DistId, DS),
get_evidence(V, Ev),
vars_to_ids(Parents, PIds),
get_vars_info(Vs, VarsInfo, DistIds).
get_evidence(V, Ev) :-
clpbn:get_atts(V, [evidence(Ev)]), !.
get_evidence(_V, -1). % no evidence !!!
vars_to_ids([], []).
vars_to_ids([L|Vars], [LIds|Ids]) :-
is_list(L), !,
vars_to_ids(L, LIds),
vars_to_ids(Vars, Ids).
vars_to_ids([V|Vars], [VarId|Ids]) :-
get_atts(V, [id(VarId)]),
vars_to_ids(Vars, Ids).
free_ground_network(Network).
get_extra_vars_info([], []).
@ -201,17 +186,3 @@ numbers_to_atoms([Number|L0], [Atom|L]) :-
number_atom(Number, Atom),
numbers_to_atoms(L0, L).
print_clpbn_vars(Var.AllVars) :-
clpbn:get_atts(Var, [key(Key),dist(DistId,Parents)]),
parents_to_keys(Parents, ParentKeys),
writeln(Var:Key:ParentKeys:DistId),
print_clpbn_vars(AllVars).
print_clpbn_vars([]).
parents_to_keys([], []).
parents_to_keys(Var.Parents, Key.Keys) :-
clpbn:get_atts(Var, [key(Key)]),
parents_to_keys(Parents, Keys).

7
packages/CLPBN/clpbn/bp/Factor.cpp
View File

@ -78,12 +78,13 @@ Factor::Factor (
Factor::Factor (
const VarIds& vids,
const Ranges& ranges,
const Params& params)
const Params& params,
unsigned distId)
{
args_ = vids;
args_ = vids;
ranges_ = ranges;
params_ = params;
distId_ = Util::maxUnsigned();
distId_ = distId;
assert (params_.size() == Util::expectedSize (ranges_));
}

3
packages/CLPBN/clpbn/bp/Factor.h
View File

@ -267,7 +267,8 @@ class Factor : public TFactor<VarId>
Factor (const VarNodes&, const Params&,
unsigned = Util::maxUnsigned());
Factor (const VarIds&, const Ranges&, const Params&);
Factor (const VarIds&, const Ranges&, const Params&,
unsigned = Util::maxUnsigned());
void sumOutAllExcept (VarId);

56
packages/CLPBN/clpbn/bp/HorusYap.cpp
View File

@ -24,11 +24,28 @@ using namespace std;
typedef std::pair<ParfactorList*, ObservedFormulas*> LiftedNetwork;
Params readParams (YAP_Term);
Params readParameters (YAP_Term);
vector<unsigned> readUnsignedList (YAP_Term);
void readLiftedEvidence (YAP_Term, ObservedFormulas&);
Parfactor* readParfactor (YAP_Term);
vector<unsigned>
readUnsignedList (YAP_Term list)
{
vector<unsigned> vec;
while (list != YAP_TermNil()) {
vec.push_back ((unsigned) YAP_IntOfTerm (YAP_HeadOfTerm (list)));
list = YAP_TailOfTerm (list);
}
return vec;
}
int createLiftedNetwork (void)
{
Parfactors parfactors;
@ -117,7 +134,7 @@ Parfactor* readParfactor (YAP_Term pfTerm)
}
// read the parameters
const Params& params = readParams (YAP_ArgOfTerm (4, pfTerm));
const Params& params = readParameters (YAP_ArgOfTerm (4, pfTerm));
// read the constraint
Tuples tuples;
@ -202,7 +219,27 @@ createGroundNetwork (void)
// Statistics::writeStatisticsToFile ("../../compressing.stats");
// }
BayesNet* bn = new BayesNet();
YAP_Term varList = YAP_ARG1;
string factorsType ((char*) YAP_AtomName (YAP_AtomOfTerm (YAP_ARG1)));
cout << "factors type: '" << factorsType << "'" << endl;
YAP_Term factorList = YAP_ARG2;
while (factorList != YAP_TermNil()) {
YAP_Term factor = YAP_HeadOfTerm (factorList);
// read the var ids
VarIds varIds = readUnsignedList (YAP_ArgOfTerm (1, factor));
// read the ranges
Ranges ranges = readUnsignedList (YAP_ArgOfTerm (2, factor));
// read the parameters
Params params = readParameters (YAP_ArgOfTerm (3, factor));
// read dist id
unsigned distId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (4, factor));
factorList = YAP_TailOfTerm (factorList);
Factor f (varIds, ranges, params, distId);
f.print();
}
assert (false);
/*
vector<VarIds> parents;
while (varList != YAP_TermNil()) {
YAP_Term var = YAP_HeadOfTerm (varList);
@ -233,6 +270,7 @@ createGroundNetwork (void)
nodes[i]->setParents (ps);
}
bn->setIndexes();
*/
YAP_Int p = (YAP_Int) (bn);
return YAP_Unify (YAP_MkIntTerm (p), YAP_ARG2);
}
@ -240,7 +278,7 @@ createGroundNetwork (void)
Params
readParams (YAP_Term paramL)
readParameters (YAP_Term paramL)
{
Params params;
while (paramL!= YAP_TermNil()) {
@ -412,7 +450,7 @@ setParfactorsParams (void)
YAP_Term dist = YAP_HeadOfTerm (distList);
unsigned distId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (1, dist));
assert (Util::contains (paramsMap, distId) == false);
paramsMap[distId] = readParams (YAP_ArgOfTerm (2, dist));
paramsMap[distId] = readParameters (YAP_ArgOfTerm (2, dist));
distList = YAP_TailOfTerm (distList);
}
ParfactorList::iterator it = pfList->begin();
@ -436,7 +474,7 @@ setBayesNetParams (void)
YAP_Term dist = YAP_HeadOfTerm (distList);
unsigned distId = (unsigned) YAP_IntOfTerm (YAP_ArgOfTerm (1, dist));
assert (Util::contains (paramsMap, distId) == false);
paramsMap[distId] = readParams (YAP_ArgOfTerm (2, dist));
paramsMap[distId] = readParameters (YAP_ArgOfTerm (2, dist));
distList = YAP_TailOfTerm (distList);
}
const BnNodeSet& nodes = bn->getBayesNodes();
@ -559,7 +597,7 @@ setHorusFlag (void)
int
freeBayesNetwork (void)
freeGroundNetwork (void)
{
delete (BayesNet*) YAP_IntOfTerm (YAP_ARG1);
return TRUE;
@ -583,7 +621,7 @@ extern "C" void
init_predicates (void)
{
YAP_UserCPredicate ("create_lifted_network", createLiftedNetwork, 3);
YAP_UserCPredicate ("create_ground_network", createGroundNetwork, 2);
YAP_UserCPredicate ("create_ground_network", createGroundNetwork, 3);
YAP_UserCPredicate ("run_lifted_solver", runLiftedSolver, 3);
YAP_UserCPredicate ("run_ground_solver", runGroundSolver, 3);
YAP_UserCPredicate ("set_parfactors_params", setParfactorsParams, 2);
@ -591,6 +629,6 @@ init_predicates (void)
YAP_UserCPredicate ("set_extra_vars_info", setExtraVarsInfo, 2);
YAP_UserCPredicate ("set_horus_flag", setHorusFlag, 2);
YAP_UserCPredicate ("free_parfactors", freeParfactors, 1);
YAP_UserCPredicate ("free_bayesian_network", freeBayesNetwork, 1);
YAP_UserCPredicate ("free_ground_network", freeGroundNetwork, 1);
}

1
packages/CLPBN/clpbn/bp/Parfactor.cpp
View File

@ -570,6 +570,7 @@ Parfactor::print (bool printParams) const
cout << " = " << params_[i] << endl;
}
}
cout << endl;
}

22
packages/CLPBN/clpbn/bp/examples/smokers.yap
View File

@ -15,18 +15,20 @@ friendly(P1, P2) :-
person(john).
person(maggie).
person(harry).
person(bill).
person(matt).
person(diana).
person(bob).
person(dick).
person(burr).
person(ann).
%person(bill).
%person(matt).
%person(diana).
%person(bob).
%person(dick).
%person(burr).
%person(ann).
person @ 2.
% person @ 2.
markov smokes(P)::[t,f] , cancer(P)::[t,f] ; [0.1, 0.2, 0.3, 0.4] ; [person(P)].
markov friend(P1,P2)::[t,f], smokes(P1)::[t,f], smokes(P2)::[t,f] ; [0.5, 0.6, 0.7, 0.8] ; [friendly(P1, P2)].
markov friend(P1,P2)::[t,f], smokes(P1)::[t,f], smokes(P2)::[t,f] ; [0.5, 0.6, 0.7, 0.8, 0.5, 0.6, 0.7, 0.8] ; [friendly(P1, P2)].
?- smokes(person_0, t), smokes(person_1, t), friend(person_0, person_1, F).
% ?- smokes(person_0, t), smokes(person_1, t), friend(person_0, person_1, F).
?- smokes(john, t), smokes(maggie, f), friend(john, maggie, X).

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

@ -7,7 +7,7 @@
:- module(clpbn_horus,
[create_lifted_network/3,
create_ground_network/2,
create_ground_network/3,
set_parfactors_params/2,
set_bayes_net_params/2,
run_lifted_solver/3,
@ -15,15 +15,15 @@
set_extra_vars_info/2,
set_horus_flag/2,
free_parfactors/1,
free_bayesian_network/1
free_ground_network/1
]).
patch_things_up :-
assert_static(clpbn_horus:set_horus_flag(_,_)).
assert_static(clpbn_horus:set_horus_flag(_,_)).
warning :-
format(user_error,"Horus library not installed: cannot use bp, fove~n.",[]).
format(user_error,"Horus library not installed: cannot use bp, fove~n.",[]).
:- catch(load_foreign_files([horus], [], init_predicates), _, patch_things_up) -> true ; warning.