diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 5e498d659..49dd18df5 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -1,6 +1,6 @@ -:- module(clpbn, [{}/1). +:- module(clpbn, [{}/1]). :- use_module(library(atts)). :- use_module(library(lists)). @@ -27,7 +27,7 @@ check_if_bnt_done/1 ]). -:- use_module('clpn/vel', [vel/3, +:- use_module('clpbn/vel', [vel/3, check_if_vel_done/1 ]). @@ -41,7 +41,7 @@ use(vel). % key_entry(Key,Indx), % array_element(clpbn,Indx,El), % attributes:put_att(El,3,indx(Indx)), - put_atts(El,[key(Key),dist(E=>Domain)]), + put_atts(El,[key(Key),dist((E->Domain))]), extract_dist(Dist, E, Domain), add_evidence(Var,El). @@ -130,8 +130,8 @@ compile_second_constraint(Constraint, Vars, NVars, clpbn:put_atts(EVar,[dist(NC) check_constraint(Constraint, Vars, NVars, NC). check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !. -check_constraint((A=>D), _, _, (A=>D)) :- var(A), !. -check_constraint((([A|B].L)=>D), Vars, NVars, (([A|B].NL)=>D)) :- !, +check_constraint((A->D), _, _, (A->D)) :- var(A), !. +check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !, check_cpt_input_vars(L, Vars, NVars, NL). check_constraint(Dist, _, _, Dist). @@ -256,11 +256,11 @@ get_bnode(Var, Goal) :- include_evidence(Var, Goal0, Key, Goali), include_starter(Var, Goali, Key, Goal). -include_evidence(Var, Goal0, Key, ((Key<--Ev),Goal0)) :- +include_evidence(Var, Goal0, Key, ((Key:-Ev),Goal0)) :- get_atts(Var, [evidence(Ev)]), !. include_evidence(_, Goal0, _, Goal0). -include_starter(Var, Goal0, Key, ((<--Key),Goal0)) :- +include_starter(Var, Goal0, Key, ((:-Key),Goal0)) :- get_atts(Var, [starter]), !. include_starter(_, Goal0, _, Goal0). @@ -366,13 +366,4 @@ reset_clpbn. user:term_expansion((A :- {}), ( :- true )) :- !, % evidence prolog_load_context(module, M), add_to_evidence(M:A). -user:term_expansion((A :- B), (A :- (LCs,NB))) :- % expands heads - fetch_skolems(B, B0, Skolems, []), - Skolems \= [], - skolem_vars(Skolems, Vars), - copy_term(Vars+A, NVars+NA), - skolem_new_vars(Skolems, NVars, NSkolems), - compile_skolems(NSkolems, Vars, NVars, NA, LCs), - handle_body_goals(B0, B1), - fresh_vars(Vars, NVars, NB, B1). diff --git a/CLPBN/clpbn/bnt.yap b/CLPBN/clpbn/bnt.yap index a46b4b23d..0db6704f9 100644 --- a/CLPBN/clpbn/bnt.yap +++ b/CLPBN/clpbn/bnt.yap @@ -170,7 +170,7 @@ send_var_sizes([V|Vs], CommandStream) :- send_var_sizes(Vs, CommandStream). -dist_size((_=>Vs), _, L) :- !, +dist_size((_->Vs), _, L) :- !, length(Vs,L). dist_size((_._=Vs), I0, If) :- !, length(Vs,L), @@ -201,7 +201,7 @@ dump_cpds([V|Vs], CommandStream, Answer) :- % % this is a discrete distribution % -dump_dist((average.Ss)=>Vs, V, CommandStream, Answer) :- !, +dump_dist(((average.Ss)->Vs), V, CommandStream, Answer) :- !, vals_map(Vs, 1, Map), get_atts(V, [topord(I)]), my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round(mean([",['$VAR'(I),'$VAR'(I)]), @@ -209,7 +209,7 @@ dump_dist((average.Ss)=>Vs, V, CommandStream, Answer) :- !, length(Ss, Len), dump_indices(0,Len,CommandStream), send_command(CommandStream, Answer, "]))'));~n",[]). -dump_dist((sum.Ss)=>Vs, V, CommandStream, Answer) :- !, +dump_dist(((sum.Ss)->Vs), V, CommandStream, Answer) :- !, vals_map(Vs, 1, Map), get_atts(V, [topord(I)]), my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('sum([",['$VAR'(I),'$VAR'(I)]), @@ -217,7 +217,7 @@ dump_dist((sum.Ss)=>Vs, V, CommandStream, Answer) :- !, length(Ss, Len), dump_indices(0,Len,CommandStream), send_command(CommandStream, Answer, "])'));~n",[]). -dump_dist((normalised_average(N).Ss)=>Vs, V, CommandStream, Answer) :- !, +dump_dist(((normalised_average(N).Ss)->Vs), V, CommandStream, Answer) :- !, vals_map(Vs, 1, Map), get_atts(V, [topord(I)]), my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round((sum([",['$VAR'(I),'$VAR'(I)]), @@ -226,7 +226,7 @@ dump_dist((normalised_average(N).Ss)=>Vs, V, CommandStream, Answer) :- !, dump_indices(0,Len,CommandStream), N2 is N//2, send_command(CommandStream, Answer, "])+~d)/~d)'));~n",[N2,N]). -dump_dist(([H|T].Ss0)=>Vs, V, CommandStream, Answer) :- !, +dump_dist((([H|T].Ss0)->Vs), V, CommandStream, Answer) :- !, Ds = [H|T], vals_map(Vs, 1, Map), get_atts(V, [topord(I)]), @@ -238,7 +238,7 @@ dump_dist(([H|T].Ss0)=>Vs, V, CommandStream, Answer) :- !, keysort(KDs0,KDs), dump_elements(KDs, CommandStream), send_command(CommandStream, Answer, "]);~n",[]). -dump_dist(([H|T]=>Vs), V, CommandStream, Answer) :- +dump_dist(([H|T]->Vs), V, CommandStream, Answer) :- vals_map(Vs, 1, Map), get_atts(V, [topord(I)]), my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]), diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index 69f098e6d..3333fc610 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -52,7 +52,7 @@ check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :- check_for_hidden_vars(IVs, AllVs, NVs). check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :- - clpbn:get_atts(V, [dist(([_|_].[V1|LV])=>_)]), !, + clpbn:get_atts(V, [dist((([_|_].[V1|LV])->_))]), !, add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs). check_for_extra_variables(_,AllVs, AllVs, Vs, Vs). @@ -70,7 +70,7 @@ find_all_clpbn_vars([V|Vs], [var(V,I,Sz,Vals,_,_)|LV], [table(I,Table,Deps,Sizes find_all_clpbn_vars(Vs, LV, Tables). var_with_deps(V, Table, Deps, Sizes, Vals) :- - clpbn:get_atts(V, [dist(D=>Vals)]), + clpbn:get_atts(V, [dist((D->Vals))]), from_dist_get(D,Vals,OTable,VDeps), reorder_table([V|VDeps],Sizes,OTable,Deps,Table). @@ -182,7 +182,7 @@ get_sizes([V|Deps], [Sz|Sizes]) :- get_dist_els(V,Sz) :- get_atts(V, [size(Sz)]), !. get_dist_els(V,Sz) :- - clpbn:get_atts(V, [dist(_=>Vals)]), !, + clpbn:get_atts(V, [dist((_->Vals))]), !, length(Vals,Sz), put_atts(V, [size(Sz)]). @@ -299,7 +299,7 @@ multiply_tables([tab(Tab1,Deps1,Szs1), tab(Tab2,Deps2,Sz2)| Tables], Out) :- propagate_evidence(V, Evs) :- - clpbn:get_atts(V, [evidence(Ev),dist(_=>Out)]), !, + clpbn:get_atts(V, [evidence(Ev),dist((_->Out))]), !, generate_szs_with_evidence(Out,Ev,Evs). propagate_evidence(_, _). @@ -435,7 +435,7 @@ update_tables([_|Tabs],NTabs,Table,V,AVs0,NS) :- bind_vals([],_,_) :- !. % simple case, we want a distribution on a single variable. %bind_vals([V],Ps) :- !, -% clpbn:get_atts(V, [dist(_=>Vals)]), +% clpbn:get_atts(V, [dist((_->Vals))]), % put_atts(V, posterior([V], Vals, Ps)). % complex case, we want a joint distribution, do it on a leader. % should split on cliques ? @@ -450,7 +450,7 @@ get_all_combs(Vs, Vals) :- get_all_doms([], []). get_all_doms([V|Vs], [D|Ds]) :- - clpbn:get_atts(V, [dist(_=>D)]), + clpbn:get_atts(V, [dist((_->D))]), get_all_doms(Vs, Ds). ms([], []). diff --git a/pl/debug.yap b/pl/debug.yap index ce4cbdee5..b2b6841fd 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -83,11 +83,20 @@ ). '$do_suspy'(S, F, N, T, M) :- '$system_predicate'(T,M), + '$flags'(T,Mod,F,F), + F /\ 0x118dd080 =\= 0, ( S = spy -> '$do_error'(permission_error(access,private_procedure,T),spy(M:F/N)) ; '$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N)) ). +'$do_suspy'(S, F, N, T, M) :- + '$undefined'(T,M), !, + ( S = spy -> + '$print_message'(warning,no_match(spy(M:F/N))) + ; + '$print_message'(warning,no_match(nospy(M:F/N))) + ). '$do_suspy'(S,F,N,T,M) :- '$suspy2'(S,F,N,T,M). @@ -391,7 +400,9 @@ debugging :- % '$spycall'(G, M, _) :- - '$access_yap_flags'(10,0), !, + ( '$access_yap_flags'(10,0); + '$system_predicate'(G,M), \+ '$meta_predicate'(G,M) + ), !, '$execute_nonstop'(G, M). '$spycall'(G, M, InControl) :- '$flags'(G,M,F,F),