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

more bug fixes for CLP(BN)

Browse Source 
Allow debugging of system procedures if written in Prolog.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1174 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2004-11-16 16:38:09 +00:00
parent 6edf6f1dd3
commit 11ba3273da
4 changed files with 31 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
CLPBN/clpbn.yap
View File

@@ -1,6 +1,6 @@
:- module(clpbn, [{}/1). :- module(clpbn, [{}/1]).
:- use_module(library(atts)). :- use_module(library(atts)).
:- use_module(library(lists)). :- use_module(library(lists)).
@@ -27,7 +27,7 @@
check_if_bnt_done/1 check_if_bnt_done/1
]). ]).
:- use_module('clpn/vel', [vel/3, :- use_module('clpbn/vel', [vel/3,
check_if_vel_done/1 check_if_vel_done/1
]). ]).
@@ -41,7 +41,7 @@ use(vel).
% key_entry(Key,Indx), % key_entry(Key,Indx),
% array_element(clpbn,Indx,El), % array_element(clpbn,Indx,El),
% attributes:put_att(El,3,indx(Indx)), % 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), extract_dist(Dist, E, Domain),
add_evidence(Var,El). 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, Vars, NVars, NC).
check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !. check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
check_constraint((A=>D), _, _, (A=>D)) :- var(A), !. check_constraint((A->D), _, _, (A->D)) :- var(A), !.
check_constraint((([A|B].L)=>D), Vars, NVars, (([A|B].NL)=>D)) :- !, check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !,
check_cpt_input_vars(L, Vars, NVars, NL). check_cpt_input_vars(L, Vars, NVars, NL).
check_constraint(Dist, _, _, Dist). check_constraint(Dist, _, _, Dist).
@@ -256,11 +256,11 @@ get_bnode(Var, Goal) :-
include_evidence(Var, Goal0, Key, Goali), include_evidence(Var, Goal0, Key, Goali),
include_starter(Var, Goali, Key, Goal). 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)]), !. get_atts(Var, [evidence(Ev)]), !.
include_evidence(_, Goal0, _, Goal0). include_evidence(_, Goal0, _, Goal0).
include_starter(Var, Goal0, Key, ((<--Key),Goal0)) :- include_starter(Var, Goal0, Key, ((:-Key),Goal0)) :-
get_atts(Var, [starter]), !. get_atts(Var, [starter]), !.
include_starter(_, Goal0, _, Goal0). include_starter(_, Goal0, _, Goal0).
@@ -366,13 +366,4 @@ reset_clpbn.
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M), prolog_load_context(module, M),
add_to_evidence(M:A). 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).

12
CLPBN/clpbn/bnt.yap
View File

@@ -170,7 +170,7 @@ send_var_sizes([V|Vs], CommandStream) :-
send_var_sizes(Vs, CommandStream). send_var_sizes(Vs, CommandStream).
dist_size((_=>Vs), _, L) :- !, dist_size((_->Vs), _, L) :- !,
length(Vs,L). length(Vs,L).
dist_size((_._=Vs), I0, If) :- !, dist_size((_._=Vs), I0, If) :- !,
length(Vs,L), length(Vs,L),
@@ -201,7 +201,7 @@ dump_cpds([V|Vs], CommandStream, Answer) :-
% %
% this is a discrete distribution % 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), vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]), get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round(mean([",['$VAR'(I),'$VAR'(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), length(Ss, Len),
dump_indices(0,Len,CommandStream), dump_indices(0,Len,CommandStream),
send_command(CommandStream, Answer, "]))'));~n",[]). 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), vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]), get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('sum([",['$VAR'(I),'$VAR'(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), length(Ss, Len),
dump_indices(0,Len,CommandStream), dump_indices(0,Len,CommandStream),
send_command(CommandStream, Answer, "])'));~n",[]). 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), vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]), get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round((sum([",['$VAR'(I),'$VAR'(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), dump_indices(0,Len,CommandStream),
N2 is N//2, N2 is N//2,
send_command(CommandStream, Answer, "])+~d)/~d)'));~n",[N2,N]). 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], Ds = [H|T],
vals_map(Vs, 1, Map), vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]), get_atts(V, [topord(I)]),
@@ -238,7 +238,7 @@ dump_dist(([H|T].Ss0)=>Vs, V, CommandStream, Answer) :- !,
keysort(KDs0,KDs), keysort(KDs0,KDs),
dump_elements(KDs, CommandStream), dump_elements(KDs, CommandStream),
send_command(CommandStream, Answer, "]);~n",[]). 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), vals_map(Vs, 1, Map),
get_atts(V, [topord(I)]), get_atts(V, [topord(I)]),
my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]), my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]),

12
CLPBN/clpbn/vel.yap
View File

@@ -52,7 +52,7 @@ check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :-
check_for_hidden_vars(IVs, AllVs, NVs). check_for_hidden_vars(IVs, AllVs, NVs).
check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :- 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). add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs).
check_for_extra_variables(_,AllVs, AllVs, Vs, Vs). 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). find_all_clpbn_vars(Vs, LV, Tables).
var_with_deps(V, Table, Deps, Sizes, Vals) :- 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), from_dist_get(D,Vals,OTable,VDeps),
reorder_table([V|VDeps],Sizes,OTable,Deps,Table). reorder_table([V|VDeps],Sizes,OTable,Deps,Table).
@@ -182,7 +182,7 @@ get_sizes([V|Deps], [Sz|Sizes]) :-
get_dist_els(V,Sz) :- get_dist_els(V,Sz) :-
get_atts(V, [size(Sz)]), !. get_atts(V, [size(Sz)]), !.
get_dist_els(V,Sz) :- get_dist_els(V,Sz) :-
clpbn:get_atts(V, [dist(_=>Vals)]), !, clpbn:get_atts(V, [dist((_->Vals))]), !,
length(Vals,Sz), length(Vals,Sz),
put_atts(V, [size(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) :- 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). generate_szs_with_evidence(Out,Ev,Evs).
propagate_evidence(_, _). propagate_evidence(_, _).
@@ -435,7 +435,7 @@ update_tables([_|Tabs],NTabs,Table,V,AVs0,NS) :-
bind_vals([],_,_) :- !. bind_vals([],_,_) :- !.
% simple case, we want a distribution on a single variable. % simple case, we want a distribution on a single variable.
%bind_vals([V],Ps) :- !, %bind_vals([V],Ps) :- !,
% clpbn:get_atts(V, [dist(_=>Vals)]), % clpbn:get_atts(V, [dist((_->Vals))]),
% put_atts(V, posterior([V], Vals, Ps)). % put_atts(V, posterior([V], Vals, Ps)).
% complex case, we want a joint distribution, do it on a leader. % complex case, we want a joint distribution, do it on a leader.
% should split on cliques ? % should split on cliques ?
@@ -450,7 +450,7 @@ get_all_combs(Vs, Vals) :-
get_all_doms([], []). get_all_doms([], []).
get_all_doms([V|Vs], [D|Ds]) :- get_all_doms([V|Vs], [D|Ds]) :-
clpbn:get_atts(V, [dist(_=>D)]), clpbn:get_atts(V, [dist((_->D))]),
get_all_doms(Vs, Ds). get_all_doms(Vs, Ds).
ms([], []). ms([], []).

13
pl/debug.yap
View File

@@ -83,11 +83,20 @@
). ).
'$do_suspy'(S, F, N, T, M) :- '$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M), '$system_predicate'(T,M),
'$flags'(T,Mod,F,F),
F /\ 0x118dd080 =\= 0,
( S = spy -> ( S = spy ->
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N)) '$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_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) :- '$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M). '$suspy2'(S,F,N,T,M).
@@ -391,7 +400,9 @@ debugging :-
% %
'$spycall'(G, M, _) :- '$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). '$execute_nonstop'(G, M).
'$spycall'(G, M, InControl) :- '$spycall'(G, M, InControl) :-
'$flags'(G,M,F,F), '$flags'(G,M,F,F),