From 5e80c3ca86dd9bfe520108b8c48373cbb0cc44c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 16 Jul 2013 08:00:16 -0500 Subject: [PATCH] learning --- packages/CLPBN/Makefile.in | 1 + packages/CLPBN/clpbn/gibbs.yap | 20 +++++------ packages/CLPBN/learning/learn_mln_wgts.yap | 1 + packages/CLPBN/mlns.yap | 39 ++++++++++++++++++---- packages/CLPBN/pfl.yap | 12 +++++-- 5 files changed, 53 insertions(+), 20 deletions(-) diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index 9ce9c4122..c7402504d 100644 --- a/packages/CLPBN/Makefile.in +++ b/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= \ diff --git a/packages/CLPBN/clpbn/gibbs.yap b/packages/CLPBN/clpbn/gibbs.yap index ac8a88285..ce82f0140 100644 --- a/packages/CLPBN/clpbn/gibbs.yap +++ b/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([], _, _, _, _). -propagate2parents([V|NewParents], Table, Variables, Graph, Keys) :- +propagate2parent(Table, Variables, Graph, Keys, V) :- 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), - propagate2parents(NewParents,Table, Variables, Graph, Keys). + add2graph(V, _, NewTable, SortedIndices, 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([I|Vs],Graph,Chain) :- - arg(I,Graph,var(_,I,_,_,Sz,_,_,_,_)), +gen_sample(Graph, Chain, I) :- + arg(I, Graph, var(_,I,_,_,Sz,_,_,_,_)), Pos is integer(random*Sz), - arg(I,Chain,Pos), - gen_sample(Vs,Graph,Chain). + arg(I, Chain, Pos). init_estimates(0,_,_,[]) :- !. diff --git a/packages/CLPBN/learning/learn_mln_wgts.yap b/packages/CLPBN/learning/learn_mln_wgts.yap index d080af7e2..07aea7dd8 100644 --- a/packages/CLPBN/learning/learn_mln_wgts.yap +++ b/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), diff --git a/packages/CLPBN/mlns.yap b/packages/CLPBN/mlns.yap index 7d625f9fc..f007748a5 100644 --- a/packages/CLPBN/mlns.yap +++ b/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) :- literal(C), !. +disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- !. +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) :- literal(C), !. +conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :- !. +conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- !. conj_to_list2(C, [-C|L1], L1, [C|L], L). remove_not(-G, G) :- !. diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index da3fc1bd2..e26ae3b3e 100644 --- a/packages/CLPBN/pfl.yap +++ b/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)).