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

fix processing of pfl ground networks.

Browse Source
This commit is contained in:
Costa Vitor 2012-08-08 22:16:37 -05:00
parent 652073caa4
commit 4756948967
3 changed files with 114 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,12 +8,14 @@
:- module(clpbn_ground_factors, [
generate_networks/5,
generate_network/5]).
:- use_module(library(bhash), [
b_hash_new/1,
b_hash_lookup/3,
b_hash_insert/4]).
b_hash_insert/4,
b_hash_to_list/2]).
:- use_module(library(lists), [
delete/3,
@ -30,78 +32,106 @@
:- dynamic currently_defined/1, f/4.
generate_network(QueryVars0, QueryKeys, Keys, Factors, Evidence) :-
%
% as you add query vars the network grows
% until you reach the last variable.
%
generate_networks(QueryVars, QueryKeys, Keys, Factors, EList) :-
init_global_search,
attributes:all_attvars(AVars),
keys(QueryVars0, QueryKeys0),
check_for_evidence(AVars, EVars, QueryKeys0, QueryVars0, Evidence),
check_for_extra_bindings(QueryVars0, QueryVars, QueryKeys0, QueryKeys),
do_network(QueryVars, EVars, Keys, Factors).
b_hash_new(Evidence0),
include_evidence(AVars, Evidence0, Evidence),
b_hash_to_list(Evidence, EList0), list_to_evlist(EList0, EList),
run_through_evidence(EList),
run_through_queries(QueryVars, QueryKeys, Evidence),
collect(Keys, Factors).
do_network([], _, _, _) :- !.
do_network(QueryVars, EVars, Keys, Factors) :-
%
% clean global stateq
%
init_global_search :-
retractall(currently_defined(_)),
retractall(f(_,_,_,_)),
run_through_factors(QueryVars),
run_through_factors(EVars),
retractall(f(_,_,_,_)).
list_to_evlist([], []).
list_to_evlist([K-E|EList0], [K=E|EList]) :-
list_to_evlist(EList0, EList).
include_evidence([], Evidence0, Evidence) :-
findall(Sk=Var, pfl:evidence(Sk,Var), Evs),
include_static_evidence(Evs, Evidence0, Evidence).
include_evidence([V|AVars], Evidence0, Evidence) :-
clpbn:get_atts(V,[key(K),evidence(E)]), !,
(
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; EvidenceI = Evidence0)
;
b_hash_insert(Evidence0, K, E, EvidenceI)
),
include_evidence(AVars, EvidenceI, Evidence).
include_evidence([_|AVars], Evidence0, Evidence) :-
include_evidence(AVars, Evidence0, Evidence).
include_static_evidence([], Evidence, Evidence).
include_static_evidence([K=E|AVars], Evidence0, Evidence) :-
(
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; EvidenceI = Evidence0)
;
b_hash_insert(Evidence0, K, E, EvidenceI)
),
include_evidence(AVars, EvidenceI, Evidence).
run_through_queries([QVars|QueryVars], [GKs|GKeys], E) :-
run_through_query(QVars, GKs, E),
run_through_queries(QueryVars, GKeys, E).
run_through_queries([], [], _).
generate_network(QueryVars0, QueryKeys, Keys, Factors, EList) :-
init_global_search,
attributes:all_attvars(AVars),
b_hash_new(Evidence0),
include_evidence(AVars, Evidence0, Evidence),
b_hash_to_list(Evidence, EList0), list_to_evlist(EList0, EList),
run_through_evidence(EList),
run_through_query(QueryVars0, QueryKeys, Evidence),
collect(Keys,Factors),
writeln(gn:Keys:QueryKeys:Factors:EList).
run_through_query([], [], _).
run_through_query([V|QueryVars], QueryKeys, Evidence) :-
clpbn:get_atts(V,[key(K)]),
b_hash_lookup(K, _, Evidence), !,
run_through_query(QueryVars, QueryKeys, Evidence).
run_through_query([V|QueryVars], [K|QueryKeys], Evidence) :-
clpbn:get_atts(V,[key(K)]),
( find_factors(K), fail ; true ),
run_through_query(QueryVars, QueryKeys, Evidence).
collect(Keys, Factors) :-
findall(K, currently_defined(K), Keys),
ground_all_keys(QueryVars, Keys),
ground_all_keys(EVars, Keys),
findall(f(FType,FId,FKeys,FCPT), f(FType,FId,FKeys,FCPT), Factors).
run_through_factors([]).
run_through_factors([Var|_QueryVars]) :-
clpbn:get_atts(Var,[key(K)]),
run_through_evidence([]).
run_through_evidence([K=_|_]) :-
find_factors(K),
fail.
run_through_factors([_|QueryVars]) :-
run_through_factors(QueryVars).
run_through_evidence([_|Ev]) :-
run_through_evidence(Ev).
ground_all_keys([], _).
ground_all_keys([V|GVars], AllKeys) :-
clpbn:get_atts(V,[key(Key)]),
\+ ground(Key), !,
writeln(g:Key),
member(Key, AllKeys),
ground_all_keys(GVars, AllKeys).
ground_all_keys([_V|GVars], AllKeys) :-
ground_all_keys(GVars, AllKeys).
%
% look for attributed vars with evidence (should also search the DB)
% verifiy if the evidence overlaps with query
% bind query if so.
%
check_for_evidence(V.AVars, V.EVars, QueryKeys, QueryVars, (K=E).Evidence) :-
clpbn:get_atts(V,[key(K),evidence(E)]), !,
check_for_evidence_in_query(K, QueryKeys, QueryVars, E),
check_for_evidence(AVars, EVars, QueryKeys, QueryVars, Evidence).
% ignore no evidence vars
check_for_evidence(_V.AVars, EVars, QueryKeys, QueryVars, Evidence) :-
check_for_evidence(AVars, EVars, QueryKeys, QueryVars, Evidence).
check_for_evidence([], [], _, _, []).
%
% do we still have free query variables?
%
check_for_extra_bindings([], [], [], []).
check_for_extra_bindings([V|QueryVars0], QueryVars, [_|QueryKeys0], QueryKeys) :-
nonvar(V),!,
check_for_extra_bindings(QueryVars0, QueryVars, QueryKeys0, QueryKeys).
check_for_extra_bindings([V|QueryVars0], [V|QueryVars], [K|QueryKeys0], [K|QueryKeys]) :-
check_for_extra_bindings(QueryVars0, QueryVars, QueryKeys0, QueryKeys).
check_for_evidence_in_query(Key, [Key|QueryKeys], [V|QueryVars], E) :- !,
skolem(Key, Dom),
nth0(E, Dom, Val),
V = Val,
check_for_evidence_in_query(Key, QueryKeys, QueryVars, E).
check_for_evidence_in_query(Key, [_|QueryKeys], [_|QueryVars], E) :-
check_for_evidence_in_query(Key, QueryKeys, QueryVars, E).
check_for_evidence_in_query(_Key, [], [], _E).
keys([], []).
keys([Var|QueryVars], [Key|QueryKeys]) :-
clpbn:get_atts(Var,[key(Key)]),

41
packages/CLPBN/clpbn/horus_ground.yap
View File

@ -30,6 +30,10 @@
get_dist_params/2
]).
:- use_module(library('clpbn/ground_factors'),
[generate_networks/5
]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
@ -62,12 +66,13 @@ call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidenc
keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1),
get_factors_type(Factors, Type),
evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds),
factors_to_ids(Factors, Hash2, Hash, Id2, _, FactorIds),
%% writeln(queryKeys:QueryKeys), writeln(''),
factors_to_ids(Factors, Hash2, Hash3, Id2, Id3, FactorIds),
%writeln(queryKeys:QueryKeys), writeln(''),
%% writeln(type:Type), writeln(''),
%% writeln(allKeys:AllKeys), writeln(''),
sort(AllKeys,SKeys), %% writeln(allSortedKeys:SKeys), writeln(''),
keys_to_ids(SKeys, 0, _, Hash0, Hash),
keys_to_ids(SKeys, Id3, Id4, Hash3, Hash4),
b_hash:b_hash_to_list(Hash1,_L4), writeln(h1:_L4),
% writeln(factors:Factors), writeln(''),
% writeln(factorIds:FactorIds), writeln(''),
% writeln(evidence:Evidence), writeln(''),
@ -76,7 +81,8 @@ call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidenc
get_vars_information(AllKeys, StatesNames),
terms_to_atoms(AllKeys, KeysAtoms),
cpp_set_vars_information(KeysAtoms, StatesNames),
run_solver(ground(Network,Hash), QueryKeys, Solutions),
writeln(network:(Type, FactorIds, EvidenceIds, Network)), writeln(''),
run_solver(ground(Network,Hash4,Id4), QueryKeys, Solutions),
cpp_free_ground_network(Network).
@ -88,22 +94,30 @@ keys([_V|AVars], AllKeys) :-
keys(AVars, AllKeys).
run_solver(ground(Network,Hash), QueryKeys, Solutions) :-
run_solver(ground(Network,Hash,Id), QueryKeys, Solutions) :-
%get_dists_parameters(DistIds, DistsParams),
%cpp_set_factors_params(Network, DistsParams),
list_of_keys_to_ids(QueryKeys, Hash, _, _, _, QueryIds),
%writeln(queryKeys:QueryKeys), writeln(''),
%writeln(queryIds:QueryIds), writeln(''),
list_of_keys_to_ids(QueryKeys, Hash, _, Id, _, QueryIds),
writeln(queryKeys:QueryKeys), writeln(''),
writeln(queryIds:QueryIds), writeln(''),
cpp_run_ground_solver(Network, QueryIds, Solutions).
keys_to_ids([], Id, Id, Hash, Hash).
keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
b_hash_lookup(Key, _, Hash0), !,
keys_to_ids(AllKeys, I0, I, Hash0, Hash).
keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :-
b_hash_insert(Hash0, Key, I0, HashI),
I1 is I0+1,
keys_to_ids(AllKeys, I1, I, HashI, Hash).
get_factors_type([f(bayes, _, _, _)|_], bayes) :- ! .
get_factors_type([f(markov, _, _, _)|_], markov) :- ! .
@ -166,19 +180,10 @@ finalize_horus_ground_solver(bp(Network, _)) :-
%
%
init_horus_ground_solver(QueryVars, _AllVars, _, horus(GKeys, Keys, Factors, Evidence)) :-
generate_networks(QueryVars, GKeys, [], Keys, [], Factors, [], Evidence),
generate_networks(QueryVars, GKeys, Keys, Factors, Evidence),
writeln(qvs:QueryVars),
writeln(Keys), writeln(Factors), !.
%
% as you add query vars the network grows
% until you reach the last variable.
%
generate_networks([QVars|QueryVars], [GK|GKeys], _K0, K, _F0, F, _E0, E) :-
clpbn:generate_network(QVars, GK, KI, FI, EI),
generate_networks(QueryVars, GKeys, KI, K, FI, F, EI, E).
generate_networks([], [], K, K, F, F, E, E).
%
% just call horus solver.
%

4
packages/CLPBN/examples/learning/prof_params.pfl
View File

@ -33,8 +33,8 @@ 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,ve).
:- clpbn:set_clpbn_flag(em_solver,bp).
timed_main :-
statistics(runtime, _),