learning
This commit is contained in:
Vítor Santos Costa
parent
bc992f552f
commit
5e80c3ca86
|
|
@ -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= \
|
||||
|
|
|
|||
|
|
@ -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,_,_,[]) :- !.
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
|
|
@ -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) :- !.
|
||||
|
|
|
|||
|
|
@ -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)).
|
||||
|
||||
|
|
|
|||
Reference in New Issue