From ac863833fffa9033d21610d4c3b965fe3d43ba74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 23 Sep 2012 13:25:15 +0100 Subject: [PATCH] PFL machinery --- packages/CLPBN/clpbn.yap | 4 +- packages/CLPBN/clpbn/ground_factors.yap | 53 ++++-------- packages/CLPBN/clpbn/horus_ground.yap | 110 ++++-------------------- packages/CLPBN/pfl.yap | 65 +++++++++----- 4 files changed, 74 insertions(+), 158 deletions(-) diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 89a897da6..a56395551 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -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)), diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap index 546660a85..584068019 100644 --- a/packages/CLPBN/clpbn/ground_factors.yap +++ b/packages/CLPBN/clpbn/ground_factors.yap @@ -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), diff --git a/packages/CLPBN/clpbn/horus_ground.yap b/packages/CLPBN/clpbn/horus_ground.yap index b62b7abd4..4af385790 100644 --- a/packages/CLPBN/clpbn/horus_ground.yap +++ b/packages/CLPBN/clpbn/horus_ground.yap @@ -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, _)) :- diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index a659a7868..044014b16 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -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) :-