more CLP(BN) fixes

- support clpbn_table for an efficient implementation of deterministic tabling.
- corresponding changes to learning algorithm.

CLPBN/Makefile.in

@@ -45,6 +45,7 @@ CLPBN_PROGRAMS= \
 	$(CLPBN_SRCDIR)/hmm.yap \
 	$(CLPBN_SRCDIR)/jt.yap \
 	$(CLPBN_SRCDIR)/matrix_cpt_utils.yap \
+	$(CLPBN_SRCDIR)/table.yap \
 	$(CLPBN_SRCDIR)/topsort.yap \
 	$(CLPBN_SRCDIR)/utils.yap \
 	$(CLPBN_SRCDIR)/vel.yap \

CLPBN/clpbn.yap

@@ -282,6 +282,8 @@ verify_attributes(Var, T, Goals) :-
 verify_attributes(_, _, []).
 
 
+bind_clpbn(T, Var, _, _, _) :- nonvar(T),
+	!, ( add_evidence(Var,T) -> true ; writeln(T:Var), fail ).
 bind_clpbn(T, Var, Key, Dist, Parents) :- var(T),
 	get_atts(T, [key(Key1),dist(Dist1,Parents1)]), !,
 	bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1),
@@ -345,7 +347,8 @@ same_node(P,P1) :-
 
 
 bind_evidence_from_extra_var(Ev1,Var) :-
-	get_atts(Var, [evidence(Ev0)]),!,Ev0 = Ev1.
+	get_atts(Var, [evidence(Ev0)]), !,
+	Ev0 = Ev1.
 bind_evidence_from_extra_var(Ev1,Var) :-
 	put_atts(Var, [evidence(Ev1)]).
 

CLPBN/clpbn/evidence.yap

@@ -8,7 +8,8 @@
 	   store_evidence/1,
 	   incorporate_evidence/2,
 	   check_stored_evidence/2,
-	   add_evidence/2
+	   add_evidence/2,
+	   put_evidence/2
 	  ]).
 
 :- use_module(library(clpbn), [
@@ -17,6 +18,10 @@
 	set_clpbn_flag/2
     ]).
 
+:- use_module(library('clpbn/dists'), [
+       get_evidence_position/3
+    ]).
+
 :- use_module(library(rbtrees), [
 	rb_new/1,
 	rb_lookup/3,
@@ -123,3 +128,9 @@ check_for_evidence(_, V, Vf, Vf, C, C) :-
 check_for_evidence(K, _, Vf0, Vff, C0, Ci) :-
 	findall(Rt,edge(Rt,K),Rts),
 	add_variables(Rts, _, Vf0, Vff, C0, Ci).
+
+put_evidence(K, V) :-
+	clpbn:get_atts(V, [dist(Id,_)]),
+	get_evidence_position(K, Id, Ev),
+	clpbn:put_atts(V, [evidence(Ev)]).
+

CLPBN/clpbn/hmm.yap

@@ -49,8 +49,6 @@ hmm_state(N/A,Mod) :-
 	        ( First > 2 -> 
 		  Last = Key, !
 		;
-%		  hmm:hmm_tabled(Key)
-%		  nb_hash:nb_hash_lookup(hmm_table, Key, [])
 		  nb_getval(trie, Trie), trie_check_entry(Trie, Key, _)
 		->
 		  % leave work for solver!
@@ -58,8 +56,6 @@ hmm_state(N/A,Mod) :-
 		  Last = Key, !
 		;
 		  % first time we saw this entry
-%		  assert(hmm:hmm_tabled(Key)),
-%		  nb_hash:nb_hash_insert(hmm_table,Key,[]),
 		  nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
 		  fail
 		)

CLPBN/clpbn/table.yap

@@ -0,0 +1,223 @@
+/*
+ Deterministcally table a predicate of the form
+  K -> RV
+
+  where the K are the first N-1 arguments.
+
+  Note that this does not include support for backtracking
+*/
+
+:- module(clpbn_table,
+	[clpbn_table/1,
+	 clpbn_tabled_clause/2,
+	 clpbn_tabled_abolish/1,
+	 clpbn_tabled_asserta/1,
+	 clpbn_tabled_assertz/1,
+	 clpbn_tabled_asserta/2,
+	 clpbn_tabled_assertz/2,
+	 clpbn_tabled_dynamic/1,
+	 clpbn_tabled_number_of_clauses/2,
+	 clpbn_reset_tables/0,
+	 clpbn_reset_tables/1,
+	 clpbn_is_tabled/1
+	]).
+
+:- use_module(library(bhash),
+	[b_hash_new/2,
+	 b_hash_lookup/3,
+	 b_hash_insert/3]).
+
+:- meta_predicate clpbn_table(:),
+	clpbn_tabled_clause(:.?),
+	clpbn_tabled_abolish(:),
+	clpbn_tabled_asserta(:), 
+	clpbn_tabled_assertz(:), 
+	clpbn_tabled_asserta(:,-), 
+	clpbn_tabled_assertz(:,-), 
+	clpbn_tabled_number_of_clauses(:,-), 
+	clpbn_is_tabled(:).
+
+:- dynamic clpbn_table/3.
+
+:- initialization(init).
+
+init :-
+	clpbn_reset_tables.
+
+clpbn_reset_tables :-
+	clpbn_reset_tables(1024).
+
+clpbn_reset_tables(Sz) :-
+	b_hash_new(Tab, Sz),
+	nb_setval(clpbn_tables, Tab).
+
+clpbn_table(M:X) :- !,
+	clpbn_table(X,M).
+clpbn_table(X) :-
+	prolog_load_context(module, M),
+	clpbn_table(X,M).
+
+clpbn_table(M:X,_) :- !,
+	clpbn_table(X,M).
+clpbn_table((P1,P2),M) :- !,
+	clpbn_table(P1,M),
+	clpbn_table(P2,M).
+clpbn_table(F/N,M) :-
+	functor(S,F,N),
+	S =.. L0,
+	take_tail(L0, V, L1, V1, L2),
+	Key =.. L1,
+	atom_concat(F, '___tabled', NF),
+	L2 = [_|Args],
+	S1 =.. [NF|Args],
+	L0 = [_|OArgs],
+	S2 =.. [NF|OArgs],
+	asserta(clpbn_table(S, M, S2)),
+	assert((M:S :- nb_getval(clpbn_tables, Tab), ( b_hash_lookup(Key, V1, Tab) -> true ; M:S1, b_hash_insert(Tab, Key, V1) ; true), ( nonvar(V) -> clpbn_evidence:put_evidence(V, V1)  ; V = V1 ), ! ) ).
+
+take_tail([V], V, [], V1, [V1]) :- !.
+take_tail([A|L0], V, [A|L1], V1, [A|L2]) :-
+	take_tail(L0, V, L1, V1, L2).
+
+user:term_expansion((P :- Gs), NC) :-
+	clpbn_table(P, M, NP),
+	prolog_load_context(module, M), !,
+	assert(M:(NP :- Gs)),
+	NC = (:-true).
+
+in_table(K, V) :-
+	nb_getval(clpbn_tables, Tab),
+	b_hash_lookup(K, V, Tab).
+
+store_in_table(K, V) :-
+	nb_getval(clpbn_tables, Tab),
+	b_hash_insert(Tab, K, V).
+
+clpbn_tabled_clause(M:Head, Body) :- !,
+	clpbn_tabled_clause(Head, M, Body).
+clpbn_tabled_clause(Head, Body) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_clause(Head, M, Body).
+
+clpbn_tabled_clause(M:Head, _, Body) :- !,
+	clpbn_table(Head, M, Body).
+clpbn_tabled_clause(Head, M, Body) :-
+	clpbn_table(Head, M, THead),
+	clause(THead, Body).
+
+
+clpbn_tabled_assertz(M:Clause) :- !,
+	clpbn_tabled_assertz2(Clause, M).
+clpbn_tabled_assertz(Clause) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_assertz2(Clause, M).
+
+clpbn_tabled_assertz2(M:Clause, _) :- !,
+	clpbn_tabled_assertz2(Clause, M).
+clpbn_tabled_assertz2((Head:-Body), M) :- !,
+	clpbn_table(Head, M, THead),
+	assertz(M:(THead :- Body)).
+clpbn_tabled_assertz2(Head, M) :-
+	clpbn_table(Head, M, THead),
+	assertz(THead).
+
+clpbn_tabled_assertz(M:Clause, Ref) :- !,
+	clpbn_tabled_assertz2(Clause, M, Ref).
+clpbn_tabled_assertz(Clause, Ref) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_assertz2(Clause, M, Ref).
+
+clpbn_tabled_assertz2(M:Clause, _, Ref) :- !,
+	clpbn_tabled_assertz2(Clause, M, Ref).
+clpbn_tabled_assertz2((Head:-Body), M, Ref) :- !,
+	clpbn_table(Head, M, THead),
+	assertz(M:(THead :- Body), Ref).
+clpbn_tabled_assertz2(Head, M, Ref) :-
+	clpbn_table(Head, M, THead, Ref),
+	assertz(THead).
+
+
+clpbn_tabled_asserta(M:Clause) :- !,
+	clpbn_tabled_asserta2(Clause, M).
+clpbn_tabled_asserta(Clause) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_asserta2(Clause, M).
+
+clpbn_tabled_asserta2(M:Clause, _) :- !,
+	clpbn_tabled_asserta2(Clause, M).
+clpbn_tabled_asserta2((Head:-Body), M) :- !,
+	clpbn_table(Head, M, THead),
+	asserta(M:(THead :- Body)).
+clpbn_tabled_asserta2(Head, M) :-
+	clpbn_table(Head, M, THead),
+	asserta(THead).
+
+clpbn_tabled_asserta(M:Clause, Ref) :- !,
+	clpbn_tabled_asserta2(Clause, M, Ref).
+clpbn_tabled_asserta(Clause, Ref) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_asserta2(Clause, M, Ref).
+
+clpbn_tabled_asserta2(M:Clause, _, Ref) :- !,
+	clpbn_tabled_asserta2(Clause, M, Ref).
+clpbn_tabled_asserta2((Head:-Body), M, Ref) :- !,
+	clpbn_table(Head, M, THead),
+	asserta(M:(THead :- Body), Ref).
+clpbn_tabled_asserta2(Head, M, Ref) :-
+	clpbn_table(Head, M, THead, Ref),
+	asserta(THead).
+
+
+clpbn_tabled_abolish(M:Clause) :- !,
+	clpbn_tabled_abolish(Clause, M).
+clpbn_tabled_abolish(Clause) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_abolish(Clause, M).
+
+clpbn_tabled_abolish(M:Clause, _) :- !,
+	clpbn_tabled_abolish(Clause, M).
+clpbn_tabled_abolish(N/A, M) :-
+	functor(Head, N, A),
+	clpbn_table(Head, M, THead),
+	functor(THead, TN, A),
+	abolish(M:TN/A).
+
+clpbn_tabled_dynamic(M:Clause) :- !,
+	clpbn_tabled_dynamic(Clause, M).
+clpbn_tabled_dynamic(Clause) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_dynamic(Clause, M).
+
+clpbn_tabled_dynamic(M:Clause, _) :- !,
+	clpbn_tabled_dynamic(Clause, M).
+clpbn_tabled_dynamic(N/A, M) :-
+	functor(Head, N, A),
+	clpbn_table(Head, M, THead),
+	functor(THead, TN, A),
+	dynamic(M:TN/A).
+
+clpbn_tabled_number_of_clauses(M:Clause, N) :- !,
+	clpbn_tabled_number_of_clauses(Clause, M, N).
+clpbn_tabled_number_of_clauses(Clause, N) :-
+	prolog_load_context(module, M),
+	clpbn_tabled_number_of_clauses(Clause, M, N).
+
+clpbn_tabled_number_of_clauses(M:Clause, _, N) :- !,
+	clpbn_tabled_number_of_clauses(Clause, M, N).
+clpbn_tabled_number_of_clauses(Head, M, N) :-
+	clpbn_table(Head, M, THead),
+	predicate_property(M:THead,number_of_clauses(N)).
+
+
+clpbn_is_tabled(M:Clause) :- !,
+	clpbn_is_tabled(Clause, M).
+clpbn_is_tabled(Clause) :-
+	prolog_load_context(module, M),
+	clpbn_is_tabled(Clause, M).
+
+clpbn_is_tabled(M:Clause, _) :- !,
+	clpbn_is_tabled(Clause, M).
+clpbn_is_tabled(Head, M) :-
+	clpbn_table(Head, M, _).
+
+

CLPBN/learning/aleph_params.yap

@@ -10,14 +10,14 @@
 
 :- dynamic rt/2, inited/1.
 
-:- use_module(library('clpbn/learning/em')).
-
 :- use_module(library('clpbn'),
 	[{}/1,
 	 clpbn_flag/2,
 	 clpbn_flag/3,
          set_clpbn_flag/2]).
 
+:- use_module(library('clpbn/learning/em')).
+
 :- use_module(library('clpbn/matrix_cpt_utils'),
 	[uniform_CPT_as_list/2]).
 
@@ -27,6 +27,16 @@
 	 get_dist_params/2
      ]).
 
+:- use_module(library('clpbn/table'),
+	[clpbn_tabled_abolish/1,
+	 clpbn_tabled_asserta/1,
+	 clpbn_tabled_asserta/2,
+	 clpbn_tabled_assertz/1,
+	 clpbn_tabled_clause/2,
+	 clpbn_tabled_number_of_clauses/2,
+	 clpbn_is_tabled/1,
+	 clpbn_tabled_dynamic/1]).
+
 %
 % Tell Aleph not to use default solver during saturation
 %
@@ -53,6 +63,10 @@
 :- user:set(reduce_start_hook, clpbn_aleph:disable_solver).
 :- user:set(reduce_stop_hook, clpbn_aleph:enable_solver).
 
+:- user:set(record_testclause_hook, clpbn_aleph:do_nothing).
+
+%:- user:set(newbest_hook, clpbn_aleph:store_theory).
+
 disable_solver(_) :-
 	clpbn_flag(solver, Old, none),
 	nb_setval(old_clpbn_solver, Old).
@@ -67,6 +81,48 @@ enable_solver(_,_) :-
 	nb_getval(old_clpbn_solver, Old),
 	set_clpbn_flag(solver, Old).
 
+do_nothing(_).
+
+% backup current best theory in DB.
+store_theory(_,_,_) :-
+	eraseall(best_theory),
+	fail.
+store_theory(_,(H:-_),_) :-
+	clpbn_is_tabled(user:H), !,
+	store_tabled_theory(H).
+store_theory(_,(H:-_),_) :-
+	store_theory(H).
+
+store_tabled_theory(H) :-
+	clpbn_tabled_clause(user:H,B),
+	add_correct_cpt(B,NB),
+	store_cl((H:-NB)),
+	fail.
+store_tabled_theory(_).
+	
+store_theory(H) :-
+	clause(user:H,B),
+	add_correct_cpt(B,NB),
+	store_cl((H:-NB)),
+	fail.
+store_theory(_).
+
+add_correct_cpt((G,B),(G,NB)) :- !,
+	add_correct_cpt(B,NB).
+add_correct_cpt(({V = K with Tab }), ({V = K with NTab})) :-
+	correct_tab(Tab,K,NTab).
+
+correct_tab(p(Vs,_),K,p(Vs,TDist)) :-
+	get_dist_key(Id, K),
+	get_dist_parms(Id, TDist).
+correct_tab(p(Vs,_,Ps),K,p(Vs,TDist,Ps)) :-
+	get_dist_key(Id, K),
+	get_dist_parms(Id, TDist).
+
+store_cl(Cl) :-
+	recordz(best_theory, Cl, _).
+	
+
 :- user:set(best_clause_hook, clpbn_aleph:add_new_clause).
 
 add_new_clause(_,(_ :- true),_,_) :- !.
@@ -78,7 +134,13 @@ add_new_clause(_,(H :- B),_,_) :-
 	% need to remember which CPT we want
 	get_dist_key(Id, K),
 	get_dist_params(Id, CPTList),
-	asserta(user:(H :- IB)),
+	(
+	    clpbn_is_tabled(user:H)
+	->
+	    clpbn_tabled_asserta(user:(H :- IB))
+	;
+	    asserta(user:(H :- IB))
+	),
 	user:setting(verbosity,V),
 	( V >= 1 -> 
 	    user:p_message('CLP(BN) Theory'),
@@ -94,7 +156,13 @@ user:cost((H :- B),Inf,Score) :- !,
 	check_info(Inf),
 	rewrite_body(B, IB, Vs, Ds, ( !, { V = K with p(D, CPTList, Vs) })),
 	uniform_cpt([D|Ds], CPTList),
-	asserta(user:(H :- IB), R),
+	(
+	    clpbn_is_tabled(user:H)
+	->
+	    clpbn_tabled_asserta(user:(H :- IB), R)
+	;
+	    asserta(user:(H :- IB), R)
+	),
 	(
 	    cpt_score(Score0)
 	->
@@ -118,13 +186,26 @@ init_clpbn_cost(_, Score) :-
 init_clpbn_cost(H, Score) :-
 	functor(H,N,A),
 	% get rid of Aleph crap
-	abolish(user:N/A),
+	(
-	% make it easy to add and remove clauses.
+	    clpbn_is_tabled(user:H)
-	dynamic(user:N/A),
+	->
+	     clpbn_tabled_abolish(user:N/A),
+ 	     clpbn_tabled_dynamic(user:N/A)
+	;
+	     abolish(user:N/A),
+	     % make it easy to add and remove clauses.
+ 	     dynamic(user:N/A)
+	),
 	domain(H, K, V, D),
 	uniform_cpt([D], CPTList),
 	% This will be the default cause, called when the other rules fail.
-	assert(user:(H :- !, { V = K with p(D, CPTList) })),
+	(
+	    clpbn_is_tabled(user:H)
+	->
+	     clpbn_tabled_assertz(user:(H :- !, { V = K with p(D, CPTList) }))
+	 ;
+	     assert(user:(H :- !, { V = K with p(D, CPTList) }))
+	 ),
 	cpt_score(Score),
 	assert(inited(Score)).
 
@@ -149,7 +230,13 @@ domain(H, K, V, D) :-
 
 key_from_head(H,K,V) :-
 	H =.. [Name|Args],
-	predicate_property(user:H,number_of_clauses(NClauses)),
+	(
+	    clpbn_is_tabled(user:H)
+	->
+	    clpbn_tabled_number_of_clauses(user:H,NClauses)
+	;
+	    predicate_property(user:H,number_of_clauses(NClauses))
+	),
 	atomic_concat(Name,NClauses,NName),
 	append(H0L,[V],Args),
 	K =.. [NName|H0L].

CLPBN/learning/learn_utils.yap

@@ -12,6 +12,9 @@
 :- use_module(library(clpbn),
 	      [clpbn_flag/2]).
 
+:- use_module(library('clpbn/table'),
+	      [clpbn_reset_tables/0]).
+
 :- use_module(library(matrix),
 	      [matrix_agg_lines/3,
 	       matrix_op_to_lines/4,
@@ -30,6 +33,7 @@ run_all([G|Gs]) :-
 	call(G),
 	run_all(Gs).
 run_all(M:Gs) :-
+	clpbn_reset_tables,
 	run_all(Gs,M).
 
 run_all([],_).

library/Makefile.in

@@ -30,6 +30,7 @@ PROGRAMS= $(srcdir)/apply.yap \
 	$(srcdir)/assoc.yap \
 	$(srcdir)/atts.yap \
 	$(srcdir)/avl.yap \
+	$(srcdir)/bhash.yap \
 	$(srcdir)/charsio.yap \
 	$(srcdir)/cleanup.yap \
 	$(srcdir)/clpfd.pl \