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

PFL machinery

This commit is contained in:
Vítor Santos Costa 2012-09-23 13:25:15 +01:00
parent 309dfaa813
commit ac863833ff
4 changed files with 74 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/CLPBN/clpbn.yap
View File

@ -306,7 +306,7 @@ write_out(jt, GVars, AVars, DiffVars) :-
write_out(bdd, GVars, AVars, DiffVars) :-
bdd(GVars, AVars, DiffVars).
write_out(bp, _GVars, _AVars, _DiffVars) :-
writeln('interface not supported anymore').
writeln('interface not supported any longer').
%bp(GVars, AVars, DiffVars).
write_out(gibbs, GVars, AVars, DiffVars) :-
gibbs(GVars, AVars, DiffVars).
@ -324,7 +324,7 @@ call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
foldl(gvar_in_hash, GVars, Hash0, HashI),
foldl(key_to_var, Keys, AllVars, HashI, Hash1),
foldl(evidence_to_v, Evidence, _EVars, Hash1, Hash),
writeln(Keys:AllVars),
%writeln(Keys:AllVars),
maplist(factor_to_dist(Hash), Factors),
% evidence
retract(use_parfactors(on)),

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

@ -30,6 +30,9 @@
defined_in_factor/2,
skolem/2]).
:- use_module(library(clpbn/aggregates), [
avg_factors/5]).
:- use_module(library(clpbn/dists), [
dist/4]).
@ -101,35 +104,12 @@ collect(Keys, Factors) :-
findall(K, currently_defined(K), Keys),
findall(f(FType,FId,FKeys), f(FType,FId,FKeys), Factors).
ground_all_keys([], _).
ground_all_keys([V|GVars], AllKeys) :-
clpbn:get_atts(V,[key(Key)]),
\+ ground(Key), !,
member(Key, AllKeys),
ground_all_keys(GVars, AllKeys).
ground_all_keys([_V|GVars], AllKeys) :-
ground_all_keys(GVars, AllKeys).
keys([], []).
keys([Var|QueryVars], [Key|QueryKeys]) :-
clpbn:get_atts(Var,[key(Key)]),
keys(QueryVars, QueryKeys).
initialize_evidence([]).
initialize_evidence([V|EVars]) :-
clpbn:get_atts(V, [key(K)]),
ground(K),
queue_in(K),
initialize_evidence(EVars).
%
% gets key K, and collects factors that define it
queue_in(K) :-
queue(K), !.
queue_in(K) :-
writeln(+K),
%writeln(+K),
assert(queue(K)),
fail.
queue_in(_).
@ -139,8 +119,6 @@ propagate :-
do_propagate(K).
propagate.
do_propagate(agg(_)) :- !,
propagate.
do_propagate(K) :-
%writeln(-K),
\+ currently_defined(K),
@ -152,9 +130,7 @@ do_propagate(K) :-
true
;
throw(error(no_defining_factor(K)))
)
,
writeln(Ks),
),
member(K1, Ks),
\+ currently_defined(K1),
queue_in(K1),
@ -163,18 +139,19 @@ do_propagate(_K) :-
propagate.
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
( Ks = [K,agg(Els)]
%writeln(+Ks),
( Ks = [K,Els], var(Els)
->
NKs=[K|Els]
once(run(Constraints)),
avg_factors(K, Els, 0.0, NewKeys, NewId),
NKs = [K|NewKeys]
;
NKs = Ks
once(run(Constraints)),
NKs = Ks,
Id = NewId
),
run(Constraints), !,
\+ f(Type, Id, NKs),
assert(f(Type, Id, NKs)).
fetch_list((A,agg(B)), A, B).
\+ f(Type, NewId, NKs),
assert(f(Type, NewId, NKs)).
run([Goal|Goals]) :-
call(user:Goal),

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

@ -40,14 +40,17 @@
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
:- use_module(library(clpbn/numbers)).
:- use_module(library(charsio),
[term_to_atom/2]).
:- use_module(library(pfl),
[skolem/2,
get_pfl_parameters/2
[skolem/2
]).
:- use_module(library(maplist)).
:- use_module(library(lists)).
:- use_module(library(atts)).
@ -59,119 +62,36 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Outpu
call_horus_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidence, Solutions) :-
attributes:all_attvars(AVars),
keys(AVars, AllKeys),
b_hash_new(Hash0),
keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1),
call_horus_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
get_factors_type(Factors, Type),
evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds),
%writeln(evidence:Evidence:EvidenceIds),
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, Id3, Id4, Hash3, Hash4),
%b_hash:b_hash_to_list(Hash1,_L4), writeln(h1:_L4),
%writeln(factors:Factors), writeln(''),
%writeln(factorIds:FactorIds), writeln(''),
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
%writeln(evidence:Evidence), writeln(''),
%writeln(evidenceIds:EvidenceIds), writeln(''),
%writeln(factorIds:FactorIds), writeln(''),
cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network),
get_vars_information(AllKeys, StatesNames),
terms_to_atoms(AllKeys, KeysAtoms),
maplist(get_var_information, AllKeys, StatesNames),
maplist(term_to_atom, AllKeys, KeysAtoms),
%writeln(s1:KeysAtoms:KeysAtoms:StatesNames),
cpp_set_vars_information(KeysAtoms, StatesNames),
%writeln(network:(Type, FactorIds, EvidenceIds, Network)), writeln(''),
run_solver(ground(Network,Hash4,Id4), QueryKeys, Solutions),
cpp_free_ground_network(Network).
keys([], []).
keys([V|AVars], [K|AllKeys]) :-
clpbn:get_atts(V,[key(K)]), !,
keys(AVars, AllKeys).
keys([_V|AVars], AllKeys) :-
keys(AVars, AllKeys).
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, _, Id, _, QueryIds),
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
%writeln(queryKeys:QueryKeys), writeln(''),
%writeln(queryIds:QueryIds), 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) :- ! .
list_of_keys_to_ids([], H, H, I, I, []).
list_of_keys_to_ids([List|Extra], Hash0, Hash, I0, I, [IdList|More]) :-
List = [_|_], !,
list_of_keys_to_ids(List, Hash0, Hash1, I0, I1, IdList),
list_of_keys_to_ids(Extra, Hash1, Hash, I1, I, More).
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [Id|QueryIds]) :-
b_hash_lookup(Key, Id, Hash0), !,
list_of_keys_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
list_of_keys_to_ids([Key|QueryKeys], Hash0, Hash, I0, I, [I0|QueryIds]) :-
b_hash_insert(Hash0, Key, I0, Hash1),
I1 is I0+1,
list_of_keys_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
factors_to_ids([], H, H, I, I, []).
factors_to_ids([f(_, DistId, Keys)|Fs], Hash0, Hash, I0, I, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
list_of_keys_to_ids(Keys, Hash0, Hash1, I0, I1, Ids),
pfl:get_pfl_parameters(DistId, CPT),
get_ranges(Keys, Ranges),
factors_to_ids(Fs, Hash1, Hash, I1, I, NFs).
get_ranges([],[]).
get_ranges(K.Ks, Range.Rs) :- !,
skolem(K,Domain),
length(Domain,Range),
get_ranges(Ks, Rs).
evidence_to_ids([], H, H, I, I, []).
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [Id=Ev|QueryIds]) :-
b_hash_lookup(Key, Id, Hash0), !,
evidence_to_ids(QueryKeys, Hash0, Hash, I0, I, QueryIds).
evidence_to_ids([Key=Ev|QueryKeys], Hash0, Hash, I0, I, [I0=Ev|QueryIds]) :-
b_hash_insert(Hash0, Key, I0, Hash1),
I1 is I0+1,
evidence_to_ids(QueryKeys, Hash1, Hash, I1, I, QueryIds).
get_vars_information([], []).
get_vars_information(Key.QueryKeys, Domain.StatesNames) :-
pfl:skolem(Key, Domain),
get_vars_information(QueryKeys, StatesNames).
terms_to_atoms([], []).
terms_to_atoms(K.Ks, Atom.As) :-
term_to_atom(K,Atom),
terms_to_atoms(Ks,As).
get_var_information(Key, Domain) :-
skolem(Key, Domain).
finalize_horus_ground_solver(bp(Network, _)) :-

65
packages/CLPBN/pfl.yap
View File

@ -4,25 +4,20 @@
%
:- module(pfl, [
factor/6,
skolem/2,
defined_in_factor/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
add_ground_factor/4, %add a new bayesian variable (for now)
op(550,yfx,@),
op(550,yfx,::),
op(1150,fx,bayes),
op(1150,fx,markov)]).
:- use_module(library(lists),
[nth0/3,
append/3,
member/2]).
:- dynamic factor/6, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
op(550,yfx,@),
op(550,yfx,::),
op(1150,fx,bayes),
op(1150,fx,markov),
factor/6,
skolem/2,
defined_in_factor/2,
get_pfl_cpt/5, % given id and keys, return new keys and cpt
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
add_ground_factor/5 %add a new bayesian variable (for now)
]).
:- reexport(library(clpbn),
[clpbn_flag/2 as pfl_flag,
@ -31,6 +26,10 @@
:- reexport(library(clpbn/horus),
[set_solver/1]).
:- reexport(library(clpbn/aggregates),
[avg_factors/5]).
:- ( % if clp(bn) has done loading, we're top-level
predicate_property(set_pfl_flag(_,_), imported_from(clpbn))
->
@ -42,6 +41,14 @@
true
).
:- use_module(library(lists),
[nth0/3,
append/3,
member/2]).
:- dynamic factor/6, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(bayes,Id,FList,FV,Phi,Constraints)) :-
!,
term_variables(Formula, FreeVars),
@ -70,11 +77,12 @@ Id@N :-
fail.
_Id@_N.
add_ground_factor(bayes, Domain, Vars, CPT) :-
add_ground_factor(bayes, Domain, Vars, CPT, Id) :-
Vars = [K|_],
( skolem(K,_Domain) -> true ; assert(skolem(K, Domain)) ),
new_id(Id),
assert(factor(bayes, Id, Vars, [], CPT, true)).
asserta(skolem_in(K, Id)),
assert(factor(bayes, Id, Vars, [], CPT, [])).
defined_in_factor(Key, Factor) :-
skolem_in(Key, Id),
@ -104,6 +112,10 @@ new_id(Id) :-
process_args(V, _Id, _I0, _I ) --> { var(V) }, !,
{ throw(error(instantiation_error,pfl:process_args)) }.
process_args((Arg1,V), Id, I0, I ) --> { var(V) }, !,
{ I is I0+1 },
process_arg(Arg1, Id, I),
[V].
process_args((Arg1,Arg2), Id, I0, I ) --> !,
process_args(Arg1, Id, I0, I1),
process_args(Arg2, Id, I1, I).
@ -161,10 +173,17 @@ add_evidence(Sk,Var) :-
clpbn:put_atts(_V,[key(Sk),evidence(E)]).
%% get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :-
%% factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !,
%% Keys = [Key|Parents],
%% writeln(Key:Parents),
%% avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out).
get_pfl_cpt(Id, Keys, _, Keys, Out) :-
get_pfl_parameters(Id,Out).
get_pfl_parameters(Id,Out) :-
factor(_Type,Id,_FList,_FV,Phi,_Constraints),
%writeln(factor(_Type,Id,_FList,_FV,_Phi,_Constraints)),
( is_list(Phi) -> Out = Phi ; call(user:Phi, Out) ).
( Phi = [_|_] -> Phi = Out ; call(user:Phi, Out) ).
new_pfl_parameters(Id, NewPhi) :-