diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index bb4c875be..3743ed178 100644 --- a/packages/CLPBN/Makefile.in +++ b/packages/CLPBN/Makefile.in @@ -100,7 +100,7 @@ CLPBN_LEARNING_EXAMPLES= \ CLPBN_EXAMPLES= \ $(CLPBN_EXDIR)/burglary-alarm.fg \ - $(CLPBN_EXDIR)/burglary-alarm.yap \ + $(CLPBN_EXDIR)/burglary-alarm.pfl \ $(CLPBN_EXDIR)/burglary-alarm.uai \ $(CLPBN_EXDIR)/cg.yap \ $(CLPBN_EXDIR)/city.yap \ diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 72758785d..4a343d729 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -16,6 +16,7 @@ op( 500, xfy, with)]). :- use_module(library(atts)). +:- use_module(library(bhash)). :- use_module(library(lists)). :- use_module(library(terms)). @@ -232,7 +233,7 @@ project_attributes(GVars, _AVars0) :- use_parfactors(on), clpbn_flag(solver, Solver), Solver \= fove, !, generate_network(GVars, GKeys, Keys, Factors, Evidence), - call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence, _Avars0). + call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence). project_attributes(GVars, AVars) :- suppress_attribute_display(false), AVars = [_|_], @@ -314,8 +315,62 @@ write_out(fove, GVars, AVars, DiffVars) :- call_horus_lifted_solver(GVars, AVars, DiffVars). % call a solver with keys, not actual variables -call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence, Answ) :- - call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, Answ). +call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !, + call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ). +call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :- + % traditional solver + b_hash_new(Hash0), + gvars_in_hash(GVars,Hash0, HashI), + keys_to_vars(Keys, AllVars, HashI, Hash1), + evidence_to_vars(Evidence, _EVars, Hash1, Hash), + factors_to_dists(Factors, Hash), + % evidence + retract(use_parfactors(on)), + write_out(Solver, [GVars], AllVars, _), + assert(use_parfactors(on)). + +% +% convert a PFL network (without constriants) +% into CLP(BN) for evaluation +% +gvars_in_hash([V|GVars],Hash0, Hash) :- + get_atts(V, [key(K)]), + b_hash_insert(Hash0, K, V, HashI), + gvars_in_hash(GVars,HashI, Hash). +gvars_in_hash([],Hash, Hash). + + +keys_to_vars([], [], Hash, Hash). +keys_to_vars([K|Keys], [V|Vs], Hash0, Hash) :- + b_hash_lookup(K, V, Hash0), !, + keys_to_vars(Keys, Vs, Hash0, Hash). +keys_to_vars([K|Keys], [V|Vs],Hash0, Hash) :- + b_hash_insert(Hash0, K, V, HashI), + keys_to_vars(Keys, Vs, HashI, Hash). + +evidence_to_vars([], [], Hash, Hash). +evidence_to_vars([K=E|Keys], [V|Vs], Hash0, Hash) :- + b_hash_lookup(K, V, Hash0), !, + clpbn:put_atts(V,[evidence(E)]), + evidence_to_vars(Keys, Vs, Hash0, Hash). +evidence_to_vars([K=E|Keys], [V|Vs],Hash0, Hash) :- + b_hash_insert(Hash0, K, V, HashI), + clpbn:put_atts(V,[evidence(E)]), + evidence_to_vars(Keys, Vs, HashI, Hash). + +factors_to_dists([], _Hash). +factors_to_dists([f(bayes,_Id,Ks,CPT)|Factors], Hash) :- + keys_to_vars(Ks, Hash, [V|Parents]), + Ks =[Key|_], + pfl:skolem(Key, Domain), + dist(p(Domain,CPT,Parents), DistInfo, Key, Parents), + put_atts(V,[dist(DistInfo,Parents)]), + factors_to_dists(Factors, Hash). + +keys_to_vars([], _Hash, []). +keys_to_vars([K|Ks], Hash, [V|Vs]) :- + b_hash_lookup(K,V,Hash), + keys_to_vars(Ks, Hash, Vs). get_bnode(Var, Goal) :- diff --git a/packages/CLPBN/clpbn/horus_ground.yap b/packages/CLPBN/clpbn/horus_ground.yap index 9a2475d7e..3c500ae62 100644 --- a/packages/CLPBN/clpbn/horus_ground.yap +++ b/packages/CLPBN/clpbn/horus_ground.yap @@ -58,20 +58,21 @@ call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Outpu call_horus_ground_solver_for_probabilities(QueryKeys, _AllKeys, Factors, Evidence, Solutions) :- attributes:all_attvars(AVars), keys(AVars, AllKeys), +writeln(AllKeys), b_hash_new(Hash0), - keys_to_ids(AllKeys, 0, Hash0, Hash), + keys_to_ids(AllKeys, 0, Id1, Hash0, Hash1), get_factors_type(Factors, Type), - evidence_to_ids(Evidence, Hash, EvidenceIds), - factors_to_ids(Factors, Hash, FactorIds), + evidence_to_ids(Evidence, Hash1, Hash2, Id1, Id2, EvidenceIds), + factors_to_ids(Factors, Hash2, Hash, Id2, _, 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), - writeln(factors:Factors), writeln(''), - writeln(factorIds:FactorIds), writeln(''), - writeln(evidence:Evidence), writeln(''), - writeln(evidenceIds:EvidenceIds), writeln(''), + keys_to_ids(SKeys, 0, _, Hash0, Hash), +% writeln(factors:Factors), writeln(''), +% writeln(factorIds:FactorIds), writeln(''), +% writeln(evidence:Evidence), writeln(''), +% writeln(evidenceIds:EvidenceIds), writeln(''), cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network), get_vars_information(AllKeys, StatesNames), terms_to_atoms(AllKeys, KeysAtoms), @@ -91,51 +92,59 @@ keys([_V|AVars], AllKeys) :- run_solver(ground(Network,Hash), QueryKeys, Solutions) :- %get_dists_parameters(DistIds, DistsParams), %cpp_set_factors_params(Network, DistsParams), - list_of_keys_to_ids(QueryKeys, Hash, QueryIds), + list_of_keys_to_ids(QueryKeys, Hash, _, _, _, QueryIds), %writeln(queryKeys:QueryKeys), writeln(''), %writeln(queryIds:QueryIds), writeln(''), cpp_run_ground_solver(Network, [QueryIds], Solutions). -keys_to_ids([], _, Hash, Hash). -keys_to_ids([Key|AllKeys], I0, Hash0, Hash) :- +keys_to_ids([], Id, Id, Hash, Hash). +keys_to_ids([Key|AllKeys], I0, I, Hash0, Hash) :- b_hash_insert(Hash0, Key, I0, HashI), - I is I0+1, - keys_to_ids(AllKeys, I, HashI, Hash). + 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([], _, []). -list_of_keys_to_ids([List|Extra], Hash, [IdList|More]) :- +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, Hash, IdList), - list_of_keys_to_ids(Extra, Hash, More). -list_of_keys_to_ids([Key|QueryKeys], Hash, [Id|QueryIds]) :- - b_hash_lookup(Key, Id, Hash), - list_of_keys_to_ids(QueryKeys, Hash, QueryIds). + 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([], _, []). -factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :- - list_of_keys_to_ids(Keys, Hash, Ids), - get_ranges(Keys, Ranges), - factors_to_ids(Fs, Hash, NFs). +factors_to_ids([], H, H, I, I, []). +factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash0, Hash, I0, I, [f(Ids, Ranges, CPT, DistId)|NFs]) :- + list_of_keys_to_ids(Keys, Hash0, Hash1, I0, I1, Ids), + 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). + skolem(K,Domain), + length(Domain,Range), + get_ranges(Ks, Rs). -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([], 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, [I=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([], []). diff --git a/packages/CLPBN/clpbn/ve.yap b/packages/CLPBN/clpbn/ve.yap index 15a47e0e1..419227b79 100644 --- a/packages/CLPBN/clpbn/ve.yap +++ b/packages/CLPBN/clpbn/ve.yap @@ -102,9 +102,8 @@ solve_ve([LVs|_], [NVs0|_], Ps) :- sort(LV0, LV), % construct the graph find_all_table_deps(Tables0, LV), -%writeln((Li: LVs: LV)), process(LVi, LVs, tab(Dist,_,_)), -%writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD), +% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD), %exps(LD,LDE),writeln(LDE), % move from potentials back to probabilities normalise_CPT(Dist,MPs), diff --git a/packages/CLPBN/examples/burglary-alarm.yap b/packages/CLPBN/examples/burglary-alarm.pfl similarity index 100% rename from packages/CLPBN/examples/burglary-alarm.yap rename to packages/CLPBN/examples/burglary-alarm.pfl diff --git a/pl/boot.yap b/pl/boot.yap index 5999123b1..c2756b2dc 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -518,14 +518,17 @@ true :- true. % *-> at this point would require compiler support, which does not exist. % '$delayed_goals'(G, V, NV, LGs, NCP) :- - if( - (yap_hacks:current_choice_point(NCP1), + ( + CP is '$last_choice_pt', + yap_hacks:current_choice_point(NCP1), '$attributes':delayed_goals(G, V, NV, LGs), - yap_hacks:current_choice_point(NCP2)) - , - (NCP is NCP2-NCP1) - , - (copy_term_nat(V, NV), LGs = [], NCP = 0) + yap_hacks:current_choice_point(NCP2), + '$clean_ifcp'(CP), + NCP is NCP2-NCP1 + ; + copy_term_nat(V, NV), + LGs = [], + NCP = 0 ). '$out_neg_answer' :-