learning

packages/CLPBN/Makefile.in

@@ -77,6 +77,7 @@ CLPBN_LEARNING_PROGRAMS= \
 	$(CLPBN_LEARNING_SRCDIR)/bnt_parms.yap \
 	$(CLPBN_LEARNING_SRCDIR)/em.yap \
 	$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \
+	$(CLPBN_LEARNING_SRCDIR)/learn_mln_wgts.yap \
 	$(CLPBN_LEARNING_SRCDIR)/mle.yap
 
 CLPBN_EXAMPLES= \

packages/CLPBN/clpbn/gibbs.yap

@@ -116,7 +116,7 @@ graph_representation([V|Vs], Graph, I0, Keys, TGraph) :-
 	length(Vals,Sz),
 	project_evidence_out([V|Parents],[V|Parents],Table,[Sz|Szs],Variables,NewTable),
 	% all variables are parents
-	propagate2parents(Variables, NewTable, Variables, Graph, Keys),
+	maplist( propagate2parent(NewTable, Variables, Graph, Keys), Variables),
 	graph_representation(Vs, Graph, I0, Keys, TGraph).
 graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
 	I is I0+1,
@@ -129,7 +129,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
 	sort_according_to_indices(NewParents,Keys,SortedNVs,SortedIndices),
 	reorder_CPT(Variables,NewTable,[V|SortedNVs],NewTable2,_),
 	add2graph(V, Vals, NewTable2, SortedIndices, Graph, Keys),
-	propagate2parents(NewParents, NewTable, Variables, Graph,Keys),
+	maplist( propagate2parent(NewTable, Variables, Graph,Keys), NewParents),
 	maplist(parent_index(Keys), NewParents, IVariables0),
 	sort(IVariables0, IParents),
 	arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)),
@@ -158,13 +158,11 @@ project_evidence_out([V|Parents],Deps,Table,Szs,NewDeps,NewTable) :-
 project_evidence_out([_Par|Parents],Deps,Table,Szs,NewDeps,NewTable) :-
 	project_evidence_out(Parents,Deps,Table,Szs,NewDeps,NewTable).
 
-propagate2parents([], _, _, _, _).
+propagate2parent(Table, Variables, Graph, Keys, V) :-
-propagate2parents([V|NewParents], Table, Variables, Graph, Keys) :-
 	delete(Variables,V,NVs),
 	sort_according_to_indices(NVs,Keys,SortedNVs,SortedIndices),
 	reorder_CPT(Variables,Table,[V|SortedNVs],NewTable,_),
-	add2graph(V, _, NewTable, SortedIndices, Graph, Keys),
+	add2graph(V, _, NewTable, SortedIndices, Graph, Keys).
-	propagate2parents(NewParents,Table, Variables, Graph, Keys).
 
 add2graph(V, Vals, Table, IParents, Graph, Keys) :-
 	rb_lookup(V, Index, Keys),
@@ -298,14 +296,12 @@ init_chains(I,VarOrder,Len,Graph,[Chain|Chains]) :-
 
 init_chain(VarOrder,Len,Graph,Chain) :-
 	functor(Chain,sample,Len),
-	gen_sample(VarOrder,Graph,Chain).
+	maplist( gen_sample(Graph,Chain), VarOrder).
 
-gen_sample([],_,_) :- !.
+gen_sample(Graph, Chain, I) :-
-gen_sample([I|Vs],Graph,Chain) :-
+	arg(I, Graph, var(_,I,_,_,Sz,_,_,_,_)),
-	arg(I,Graph,var(_,I,_,_,Sz,_,_,_,_)),
 	Pos is integer(random*Sz),
-	arg(I,Chain,Pos),
+	arg(I, Chain, Pos).
-	gen_sample(Vs,Graph,Chain).
 
 
 init_estimates(0,_,_,[]) :- !.

packages/CLPBN/learning/learn_mln_wgts.yap

@@ -152,6 +152,7 @@ optimize :-
 compile :-
 	init_compiler,
 	mln(ParFactor, _Type, _Els, _G),
+	writeln(ParFactor),
 	factor(markov, ParFactor, Ks, _, _Phi, Constraints),
 	maplist(call, Constraints),
 	nth(_L, Ks, VId),

packages/CLPBN/mlns.yap

@@ -2,6 +2,7 @@
 		[op(1150,fx,mln),
 		 op(1150,fx,mln_domain),
 		 mln_domain/1,
+		 mln_literal/1,
 		 mln/1,
 		 mln/4,
 		 mln_w/2]).
@@ -10,13 +11,21 @@
 :- use_module(library(maplist)).
 :- use_module(library(lists)).
 
-:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2.
+:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2, mln_domain/5, mln_type_def/1.
 
 user:term_expansion(mln_domain(P),[]) :-
 	expand_domain(P).
 
 user:term_expansion( mln(W: D), pfl:factor(markov,Id,FList,FV,Phi,Constraints)) :-
-	translate_to_factor(W, D, FList, Id, FV, Phi, Constraints).
+	translate_to_factor(W, D, FList, Id, FV, Phi, Constraints), !.
+user:term_expansion( mln(W: D), _) :-
+	throw(error(domain_error(mln,W:D),error)).
+
+user:term_expansion(end_of_file,_) :-
+	mln_domain(TypeG, NP, I0, A, Type),
+	add_mln_domain(TypeG, NP, I0, A, Type),
+	fail.
+user:term_expansion(end_of_file,end_of_file).
 
 expand_domain((P1,P2)) :- !,
 	expand_domain(P1),
@@ -31,8 +40,26 @@ do_type(NP, Type, I0, I) :-
 	I is I0+1,
 	arg(I0, NP, A),
 	TypeG =.. [Type, A],
+	assert(mln_domain(TypeG, NP, I0, A, Type)),
 	assert(mln_domain(I0, NP, TypeG, A)).
 
+add_mln_domain(TypeG, NP, I0, A, _) :-
+	mln_type_def(TypeG), !,
+	functor(NP, G, Ar),
+	functor(NNP, G, Ar),
+	arg(I0, NNP, A),
+	assert_static(user:(TypeG :- NNP)).
+add_mln_domain(TypeG, _NP, _I0, _A, _) :-
+	predicate_property(user:TypeG, _), !.
+add_mln_domain(TypeG, NP, I0, A, Type) :-
+	assert(mln_type_def(TypeG)), !,
+	functor(NP, G, Ar),
+	functor(NNP, G, Ar),
+	arg(I0, NNP, A),
+	table(user:Type/1),
+	assert_static(user:(TypeG :- NNP)).
+	
+
 translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :-
 	W0 is exp(W),
 	(
@@ -128,8 +155,8 @@ disj_to_list2((C1+C2), L1, L10, L, L0) :-
 	disj_to_list2(C2, L1I, L10, LI, L0).
 disj_to_list2((_C1,_C2), _L1, _L10, _L, _L0) :- !, fail.
 disj_to_list2((_C1*_C2), _L1, _L10, _L, _L0) :- !, fail.
-disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
+disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- !.
-disj_to_list2((- C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
+disj_to_list2((- C), [(-C)|L1], L1, [C|L], L) :- !.
 disj_to_list2(C, [C|L1], L1, [C|L], L).
 
 conj_to_list((C1,C2), L1, L10, L, L0) :-
@@ -151,8 +178,8 @@ conj_to_list2((C1*C2), L1, L10, L, L0) :-
 	!,
 	conj_to_list2(C1, L1, L1I, L, LI),
 	conj_to_list2(C2, L1I, L10, LI, L0).
-conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
+conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :-  !.
-conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
+conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- !.
 conj_to_list2(C, [-C|L1], L1, [C|L], L).
 
 remove_not(-G, G) :- !.

packages/CLPBN/pfl.yap

@@ -167,16 +167,24 @@ process_arg(Sk, Id, _I) -->
 	},
 	[Sk].
 
+%
+% redefinition
+%
 new_skolem(Sk, D) :-
 	copy_term(Sk, Sk1),
 	skolem(Sk1, D1),
 	functor(Sk1, N, A),
-	functor(Sk , N, A),
+	functor(Sk , N, A), !,
-	!,
 	( D1 = D -> true ; throw(pfl(permission_error(redefining_domain(Sk),D:D1)))).
+%
+%
+% create interface and skolem descriptor
+%
 new_skolem(Sk, D) :-
 	functor(Sk, N, A),
 	functor(NSk, N, A),
+	% [f,t] is special for evidence
+	( D = [f,t] -> assert((evidence(NSk, 1) :- call(user:NSk))) ; true ),
 	interface_predicate(NSk),
 	assert(skolem(NSk, D)).