write_depth/3

overflow handlings and garbage collection Several ipdates to CLPBN dif/2 could be broken in the presence of attributed variables. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1474 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2005-12-05 17:16:12 +00:00
parent 868f236185
commit 5c2e06ad50
23 changed files with 494 additions and 308 deletions
--- a/CLPBN/clpbn.yap
+++ b/CLPBN/clpbn.yap
@@ -116,11 +116,11 @@ add_evidence(V,V).
 % or by call_residue/2
 %
 project_attributes(GVars, AVars) :-
-	GVars = [_|_],
-	AVars = [_|_], !,
+	AVars = [_|_],
+	solver(Solver),
+	( GVars = [_|_] ; Solver = graphs), !,
 	sort_vars_by_key(AVars,SortedAVars,DiffVars),
 	get_clpbn_vars(GVars,CLPBNGVars),
-	solver(Solver),
 	incorporate_evidence(SortedAVars, AllVars),
 	write_out(Solver,CLPBNGVars, AllVars, DiffVars).
 project_attributes(_, _).
--- a/CLPBN/clpbn/aggregates.yap
+++ b/CLPBN/clpbn/aggregates.yap
@@ -1,6 +1,7 @@

 :- module(clpbn_aggregates, [
 	cpt_average/4,
+	cpt_average/5,
 	cpt_max/4,
 	cpt_min/4
 	]).
@@ -12,59 +13,64 @@
 cpt_average(Vars, Key, Els0, CPT) :-
 	check_domain(Els0, Els),
 	length(Els, SDomain),
-	build_avg_table(Vars, Els, SDomain, Key, CPT).
+	build_avg_table(Vars, Els, SDomain, Els0, Key, 1.0, CPT).
+
+cpt_average(Vars, Key, Els0, Softness, CPT) :-
+	check_domain(Els0, Els),
+	length(Els, SDomain),
+	build_avg_table(Vars, Els, SDomain, Els0, Key, Softness, CPT).

 cpt_max(Vars, Key, Els0, CPT) :-
 	check_domain(Els0, Els),
 	length(Els, SDomain),
-	build_max_table(Vars, Els, SDomain, Key, CPT).
+	build_max_table(Vars, Els, SDomain, Els0, Key, CPT).

 cpt_min(Vars, Key, Els0, CPT) :-
 	check_domain(Els0, Els),
 	length(Els, SDomain),
-	build_min_table(Vars, Els, SDomain, Key, CPT).
+	build_min_table(Vars, Els, SDomain, Els0, Key, CPT).

-build_avg_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
+build_avg_table(Vars, Domain, SDomain, ODomain, _, 1.0, p(ODomain, CPT, Vars)) :-
 	int_power(Vars, SDomain, 1, TabSize),
 	TabSize =< 16, 
 	/* case gmp is not there !! */
 	TabSize > 0, !,
 	average_cpt(Vars, Domain, CPT).
-build_avg_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :-
+build_avg_table(Vars, Domain, _, ODomain, Key, Softness, p(ODomain, CPT, [V1,V2])) :-
 	length(Vars,L),
 	LL1 is L//2,
 	LL2 is L-LL1,
 	list_split(LL1, Vars, L1, L2),
 	Domain = [Min|Els1],
 	last(Els1,Max),
-	build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key,  0, I1),
-	build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _),
-	normalised_average_cpt(L, [V1,V2], Domain, CPT).
+	build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key,  Softness, 0, I1),
+	build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, Softness, I1, _),
+	normalised_average_cpt(L, [V1,V2], Domain, Softness, CPT).
 	
-build_max_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
+build_max_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :-
 	int_power(Vars, SDomain, 1, TabSize),
 	TabSize =< 16, !,
 	max_cpt(Vars, Domain, CPT).
-build_max_table(Vars, Domain, Domain, Key, p(Domain, CPT, [V1,V2])) :-
+build_max_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :-
 	length(Vars,L),
 	LL1 is L//2,
 	LL2 is L-LL1,
 	list_split(LL1, Vars, L1, L2),
-	build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key,  0, I1),
-	build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, I1, _),
+	build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0,  0, I1),
+	build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _),
 	max_cpt([V1,V2], Domain, CPT).
 	
-build_min_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :-
+build_min_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :-
 	int_power(Vars, SDomain, 1, TabSize),
 	TabSize =< 16, !,
 	min_cpt(Vars, Domain, CPT).
-build_min_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :-
+build_min_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :-
 	length(Vars,L),
 	LL1 is L//2,
 	LL2 is L-LL1,
 	list_split(LL1, Vars, L1, L2),
-	build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key,  0, I1),
-	build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, I1, _),
+	build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0,  0, I1),
+	build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _),
 	min_cpt([V1,V2], Domain, CPT).
 	
 int_power([], _, TabSize, TabSize).
@@ -72,25 +78,25 @@ int_power([_|L], X, I0, TabSize) :-
 	I is I0*X,
 	int_power(L, X, I, TabSize).

-build_intermediate_table(1,_,[V],V, _, I, I) :- !.
-build_intermediate_table(2, Op, [V1,V2], V, Key, I0, If) :- !,
+build_intermediate_table(1,_,[V],V, _, _, I, I) :- !.
+build_intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If) :- !,
 	If is I0+1,
-	generate_tmp_random(Op, 2, [V1,V2], V, Key, I0).
-build_intermediate_table(N, Op, L, V, Key, I0, If) :-
+	generate_tmp_random(Op, 2, [V1,V2], V, Key, Softness, I0).
+build_intermediate_table(N, Op, L, V, Key, Softness, I0, If) :-
 	LL1 is N//2,
 	LL2 is N-LL1,
 	list_split(LL1, L, L1, L2),
 	I1 is I0+1,
-	build_intermediate_table(LL1, Op, L1, V1, Key, I1, I2),
-	build_intermediate_table(LL2, Op, L2, V2, Key, I2, If),
-	generate_tmp_random(Op, N, [V1,V2], V, Key, I0).
+	build_intermediate_table(LL1, Op, L1, V1, Key, Softness, I1, I2),
+	build_intermediate_table(LL2, Op, L2, V2, Key, Softness, I2, If),
+	generate_tmp_random(Op, N, [V1,V2], V, Key, Softness, I0).

 % averages are transformed into sums.
-generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :-
+generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :-
 	Lower is Min*N,
 	Upper is Max*N,
 	generate_list(Lower, Upper, Nbs),
-	sum_cpt([V1,V2], Nbs, CPT),
+	sum_cpt([V1,V2], Nbs, Softness, CPT),
 %	write(sum(Nbs, CPT, [V1,V2])),nl, % debugging
 	{ V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }.
 generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
@@ -134,17 +140,17 @@ average_cpt(Vs,Vals,CPT) :-
 	generate_indices(Vals,Inds,0,Av),
 	combine_all(Vs, Inds, Cs),
 	length(Vs, Max),
-	average_possible_cases(0, Av, Max, Cs, CPT).
+	average_possible_cases(0, Av, Max, Cs, 1.0, CPT).

-sum_cpt(Vs, Vals, CPT) :-
+sum_cpt(Vs, Vals, Softness, CPT) :-
 	length(Vals,Sz),
 	combine_all(Vs, Cs),
-	sum_possible_cases(0, Sz, Cs, CPT).
+	sum_possible_cases(0, Sz, Cs, Softness, CPT).

-normalised_average_cpt(Max, Vs, Vals, CPT) :-
+normalised_average_cpt(Max, Vs, Vals, Softness, CPT) :-
 	generate_indices(Vals,_,0,Sz),
 	combine_all(Vs, Cs),
-	average_possible_cases(0, Sz, Max, Cs, CPT).
+	average_possible_cases(0, Sz, Max, Cs, Softness, CPT).


 generate_indices([],[],Av,Av).
@@ -185,37 +191,39 @@ sum_all([C|Cs],N0,N) :-
 	X is C+N0,
 	sum_all(Cs,X,N).

-average_possible_cases(Av,Av,_,_,[]) :- !.
-average_possible_cases(I,Av,Max,Cs,Lf) :-
-	average_cases2(Cs,I,Max,Lf,L0),
+average_possible_cases(Av,Av,_,_,_,[]) :- !.
+average_possible_cases(I,Av,Max,Cs,Softness,Lf) :-
+	average_cases2(Cs,I,Av,Softness,Lf,L0),
 	I1 is I+1,
-	average_possible_cases(I1,Av,Max,Cs,L0).
+	average_possible_cases(I1,Av,Max,Cs,Softness,L0).

-average_cases2([], _, _, L, L).
-average_cases2([C|Cs], I, Av, [P|Lf], L0) :-
-	calculate_avg_prob(C, I, Av, P),
-	average_cases2(Cs, I, Av, Lf, L0).
+average_cases2([], _, _, _, L, L).
+average_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :-
+	calculate_avg_prob(C, I, Av, Softness, P),
+	average_cases2(Cs, I, Av, Softness, Lf, L0).

-calculate_avg_prob(C, I, Av, 1.0) :-
+calculate_avg_prob(C, I, Av, Softness, Softness) :-
 	sum_all(C,0,N),
 	I =:= integer(round(N/Av)), !.
-calculate_avg_prob(_, _, _, 0.0).
+calculate_avg_prob(_, _, Av, Softness, Comp) :-
+	Comp is (1.0-Softness)/(Av-1).

-sum_possible_cases(Av,Av,_,[]) :- !.
-sum_possible_cases(I,Av,Cs,Lf) :-
-	sum_cases2(Cs,I,Lf,L0),
+sum_possible_cases(Av,Av,_, _, []) :- !.
+sum_possible_cases(I,Av,Cs,Softness, Lf) :-
+	sum_cases2(Cs,I, Av, Softness, Lf,L0),
 	I1 is I+1,
-	sum_possible_cases(I1,Av,Cs,L0).
+	sum_possible_cases(I1,Av,Cs,Softness, L0).

-sum_cases2([], _, L, L).
-sum_cases2([C|Cs], I, [P|Lf], L0) :-
-	calculate_sum_prob(C, I, P),
-	sum_cases2(Cs, I, Lf, L0).
+sum_cases2([], _, _, _, L, L).
+sum_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :-
+	calculate_sum_prob(C, I, Av, Softness, P),
+	sum_cases2(Cs, I, Av, Softness, Lf, L0).

-calculate_sum_prob(C, I, 1.0) :-
+calculate_sum_prob(C, I, _, Softness, Softness) :-
 	sum_all(C,0,N),
 	I =:= N, !.
-calculate_sum_prob(_, _, 0.0).
+calculate_sum_prob(_, _, Av, Softness, Comp) :-
+	Comp is (1.0-Softness)/(Av-1).

 %
 % generate a CPT for max.
--- a/CLPBN/clpbn/discrete_utils.yap
+++ b/CLPBN/clpbn/discrete_utils.yap
@@ -16,14 +16,20 @@ project_from_CPT(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs)) :-

 propagate_evidence(V, Evs) :-
 	clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !,
-	generate_szs_with_evidence(Out,Ev,Evs).
+	generate_szs_with_evidence(Out,Ev,Evs,Found),
+	(var(Found) -> 
+	    clpbn:get_atts(V, [key(K)]),
+	    throw(clpbn(evidence_does_not_match,K,Ev,[Out]))
+	;
+	     true
+	).
 propagate_evidence(_, _).

-generate_szs_with_evidence([],_,[]).
-generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs]) :- !,
-	generate_szs_with_evidence(Out,Ev,Evs).
-generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :-
-	generate_szs_with_evidence(Out,Ev,Evs).
+generate_szs_with_evidence([],_,[],_).
+generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs],found) :- !,
+	generate_szs_with_evidence(Out,Ev,Evs,found).
+generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs],Found) :-
+	generate_szs_with_evidence(Out,Ev,Evs,Found).

 find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :-
 	V == V1, !,
--- a/CLPBN/clpbn/gibbs.yap
+++ b/CLPBN/clpbn/gibbs.yap
@@ -18,7 +18,8 @@
 :- use_module(library(lists),
 	      [member/2,
 	       append/3,
-	       delete/3]).
+	       delete/3,
+	       max_list/2]).

 :- use_module(library(ordsets),
 	      [ord_subtract/3]).
@@ -98,6 +99,11 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
 	arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
 	graph_representation(Vs, Graph, I, Keys, TGraph).

+write_pars([]).
+write_pars([V|Parents]) :- 
+	clpbn:get_atts(V, [key(K)]),write(K),nl,
+	write_pars(Parents).
+
 get_sizes([], []).
 get_sizes([V|Parents], [Sz|Szs]) :-
 	clpbn:get_atts(V, [dist(Vals,_,_)]),
@@ -167,6 +173,7 @@ compile_graph(Graph) :-
 compile_vars([],_).
 compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph)
 :-
+	
 	compile_var(I,Vals,Sz,VarSlot,Parents,Graph),
 	compile_vars(VarsInfo,Graph).

@@ -204,7 +211,7 @@ mult_list([Sz|Sizes],Mult0,Mult) :-

 % compile node as set of facts, faster execution 
 compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :-
-	TotSize < 1024, TotSize > 0, !,
+	TotSize < 1024*64, TotSize > 0, !,
 	multiply_all(I,Parents,CPTs,Sz,Graph).
 compile_var(_,I,_,_,_,_,_,_) :-
 	assert(implicit(I)).
@@ -231,13 +238,15 @@ fetch_val([_|Vals],I0,Pos) :-
 	I is I0+1,
 	fetch_val(Vals,I,Pos).

+:- dynamic a/0.
+
 multiply_all(CPTs,Size,Graph,Probs) :-
 	init_factors(Size,Factors0),
 	mult_factors(CPTs,Size,Graph,Factors0,Factors),
-	normalise_factors(Factors,0,_,Probs,_).
+	normalise_factors(Factors,Probs).

 init_factors(0,[]) :- !.
-init_factors(I0,[1|Factors]) :-
+init_factors(I0,[0.0|Factors]) :-
 	I is I0-1,
 	init_factors(I,Factors).
 	
@@ -260,10 +269,21 @@ factor([I|Parents],Table,Graph,Pos0,Weight0,Pos) :-
 mult_with_probs([],_,_,_,[]).
 mult_with_probs([F0|Factors0],Indx,Off,Table,[F|Factors]) :-
 	arg(Indx,Table,P1),
-	F is F0*P1,
+	F is F0+log(P1),
 	Indx1 is Indx+Off,
 	mult_with_probs(Factors0,Indx1,Off,Table,Factors).	

+normalise_factors(Factors,Probs) :-
+	max_list(Factors,Max),
+	logs2list(Factors,Max,NFactors),
+	normalise_factors(NFactors,0,_,Probs,_).
+
+logs2list([],_,[]).
+logs2list([Log|Factors],Max,[P|NFactors]) :-
+	P is exp(Log+Max),
+	logs2list(Factors,Max,NFactors).
+
+
 normalise_factors([],Sum,Sum,[],1.0) :- Sum > 0.0.
 normalise_factors([F|Factors],S0,S,[P0|Probs],PF) :-
 	Si is S0+F,
@@ -360,7 +380,7 @@ gen_e0(Sz,[0|E0L]) :-
 process_chains(0,_,F,F,_,_,Est,Est) :- !.
 process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :-
 	process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti),
-%cvt2problist(Esti, Probs), format('done ~d: ~w~n',[ToDo,Probs]),
+(ToDo mod 100 =:= 0 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true),
 	ToDo1 is ToDo-1,
 	process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf).

@@ -369,7 +389,7 @@ process_chains([], _, [], _, _,[],[]).
 process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :-
 	functor(Sample,sample,SampLen),
 	do_sample(VarOrder,Sample,Sample0,Graph),
-%	format('~w ',[Sample]),
+%format('Sample = ~w~n',[Sample]),
 	update_estimate(E0,Sample,Ef),
 	process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs).

@@ -396,8 +416,7 @@ do_var(I,Sample,Sample0,Graph) :-
 multiply_all_in_context(Parents,Args,CPTs,Sz,Graph,Vals) :-
 	set_pos(Parents,Args,Graph),
 	multiply_all(CPTs,Sz,Graph,Vals),
-	assert(mall(Vals)),
-	fail.
+	assert(mall(Vals)), fail.
 multiply_all_in_context(_,_,_,_,_,Vals) :-
 	retract(mall(Vals)).

--- a/CLPBN/clpbn/topsort.yap
+++ b/CLPBN/clpbn/topsort.yap
@@ -3,28 +3,52 @@
 		    topsort/3,
 		    reversed_topsort/3]).

-:- use_module(library(ordsets),
-	      [ord_subtract/3,
-	       ord_insert/3]).
+:- use_module(library(rbtrees),
+	      [new/1,
+	       lookup/3,
+	       insert/4]).

-:- attribute index/1,count/1.
+:- use_module(library(lists),
+	      [reverse/2]).

 /* simple implementation of a topological sorting algorithm */
 /* graph is as Node-[Parents] */

-topsort([], []) :- !.
-topsort(Graph0,Sorted) :-
-	add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest),
-	sort(IncludedI, Included),
-	delete_parents(Graph1, Included, NoParents),
-	topsort(NoParents, SortedRest).
+topsort(Graph0, Sorted) :-
+	new(RB),
+	topsort(Graph0, [], RB, Sorted).
+
+topsort(Graph0, Sorted0, Sorted) :-
+        new(RB),
+	topsort(Graph0, Sorted0, RB, Sorted).
+
+topsort([], Sort, _, Sort) :- !.
+topsort(Graph0, Sort0, Found0, Sort) :-
+	add_nodes(Graph0, Found0, SortI, NewGraph, Found, Sort),
+	topsort(NewGraph, Sort0, Found, SortI).
+
+add_nodes([], Found, Sort, [], Found, Sort).
+add_nodes([N-Ns|Graph0], Found0, SortI, NewGraph, Found, NSort) :-
+(N=1600 -> write(Ns), nl ; true),
+	delete_nodes(Ns, Found0, NNs),
+	( NNs == [] ->
+	   NewGraph = IGraph,
+	   NSort = [N|Sort],
+	   insert(Found0, N, '$', FoundI)
+	;
+	   NewGraph = [N-NNs|IGraph],
+	   NSort = Sort,
+	   FoundI = Found0
+	),	   
+	add_nodes(Graph0, FoundI, SortI, IGraph, Found, Sort).
+
+delete_nodes([], _, []).
+delete_nodes([N|Ns], Found, NNs) :-
+	lookup(N,'$',Found), !,
+	delete_nodes(Ns, Found, NNs).
+delete_nodes([N|Ns], Found, [N|NNs]) :-
+	delete_nodes(Ns, Found, NNs).

-topsort([], Sorted0, Sorted0) :- !.
-topsort(Graph0,Sorted0, Sorted) :-
-	add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest),
-	sort(IncludedI, Included),
-	delete_parents(Graph1, Included, NoParents),
-	topsort(NoParents, Sorted0, SortedRest).

 %
 % add the first elements found by topsort to the end of the list, so we
--- a/CLPBN/clpbn/vel.yap
+++ b/CLPBN/clpbn/vel.yap
@@ -110,7 +110,7 @@ add_table_deps_to_variables([], []).
 add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :-
 	steal_deps_for_variable(DepGraph, V, NDepGraph, Deps),
 	compute_size(Deps,[],K),
-%	( clpbn:get_atts(V,[key(Key)]) -> write(Key:K), nl ; true),
+%	( clpbn:get_atts(V,[key(Key)]) -> format('~w:~w~n',[Key,K]) ; true),
 	add_table_deps_to_variables(LV, NDepGraph).
 	
 steal_deps_for_variable([V-Info|DepGraph], V0, NDepGraph, [Info|Deps]) :-
@@ -149,6 +149,7 @@ process(LV0, _, Out) :-
 	fetch_tables(LV0, WorkTables),
 	multiply_tables(WorkTables, Out).

+
 find_best([], V, _TF, V, _, [], _).
 %:-
 %	clpbn:get_atts(V,[key(K)]), write(chosen:K:TF), nl.
@@ -242,7 +243,6 @@ include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,P
 include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :-
 	update_tables(Tabs,NTabs,Table,NV),
 	compute_size(NTabs, [], NEst),
-%	( clpbn:get_atts(V,[key(Key)]) -> write(Key:NEst), nl ; true),
 	include(LV,Table,NV,NLV).

 update_tables([],[Table],Table,_).