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
Show Stats 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(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).

12
CLPBN/clpbn/bnt.yap
View File

@ -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)]),

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_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([], []).

13
pl/debug.yap
View File

@ -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),