From cc73f426d9501cfeb1f6da8498a2a3ebf746efba Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 19 Jun 2013 21:38:43 -0500 Subject: [PATCH] MLN stuff --- packages/CLPBN/learning/learn_mln_wgts.yap | 283 +++++++++++++++++++++ packages/CLPBN/mlns.yap | 71 +++++- packages/CLPBN/pfl.yap | 18 +- 3 files changed, 364 insertions(+), 8 deletions(-) create mode 100644 packages/CLPBN/learning/learn_mln_wgts.yap diff --git a/packages/CLPBN/learning/learn_mln_wgts.yap b/packages/CLPBN/learning/learn_mln_wgts.yap new file mode 100644 index 000000000..d080af7e2 --- /dev/null +++ b/packages/CLPBN/learning/learn_mln_wgts.yap @@ -0,0 +1,283 @@ +% +% generative learning in MLNs: +% +% maximise SUM log Pw(Xi=xi|mb(Xi)) +% +% or sum N(X) - p(0|mb)n0 - P(1|mb)n1 +% +% note that Pw(X|MB) = P(0|MB) || P(1|MB) +% +% + +:- use_module(library(lists)). + +:- use_module(library(maplist)). + +:- use_module(library(nb)). + +:- use_module(library(mlns)). + +:- use_module(library(pfl)). + +:- use_module(library(lbfgs)). + +:- dynamic diff/4, i/2. + +prior_means(_, 0.0). +prior_dev(_, 100.0). + +learn_mln_generative :- + compile, + optimize. + +set_weights :- + retract( mln:mln_w(Id, _) ), + optimizer_get_x( Id, W), +% writeln(weight:W), + assert( mln:mln_w(Id, W) ), + fail. +set_weights. + +add_lprior(Id-WI, Lik0, Lik) :- + prior_means(Id, PM), + prior_dev(Id, PV), + Lik is Lik0 + ((WI-PM)*(WI-PM))/(2*PV*PV). + +adjust_lprior(Lik0, Lik) :- + Lik0 = Lik, !. +adjust_lprior(Lik0, Lik) :- + findall(I-WI, mln_w(I,WI), WIs), + foldl(add_lprior, WIs, Lik0, Lik). + + +likelihood(Lik) :- + S = s(0.0), +% nb_create_accumulator(0.0, Acc), + ( + lmln:p(_Lit,P,_,_), + LogP is log(P), +% writeln(_Lit:P), + S = s(V), + V1 is V+LogP, + nb_setarg(1, S, V1), +% nb_add_to_accumulator( Acc, LogP), + fail + ; +% nb_accumulator_value(Acc, Lik) + S = s(Lik0), +writeln(lik:Lik0), + adjust_lprior(Lik0, Lik1), + Lik is -Lik1 + ). + +adjust_prior(Lik0, _, Lik) :- + Lik0 = Lik, !. +adjust_prior(Sum, Id, NSum) :- + mln_w(Id, Wi), + prior_means(Id, PM), + prior_dev(Id, PV), + NSum is Sum+(Wi-PM)/(PV*PV). + +derive :- + mln(Id, _, Els, _), + i(Id, N), +%writeln(Id:N), +% nb_create_accumulator(0.0, Acc), + S = s(0.0), +% nb_accumulator_value(Acc, Sum0),writeln(sum0:Sum0), + ( + nth(_L, Els, VId), + p_l(Id, VId, P0, P1), + diff( VId, Id, DN0, DN1), + X is (N-P0*(N+DN0)-P1*(N+DN1)), +%writeln(X is (N-P0*(N+DN0)-P1*(N+DN1))), +% nb_add_to_accumulator(Acc, X), + S = s(V), + V1 is V-X, + nb_setarg(1, S, V1), + fail + ; +% nb_accumulator_value(Acc, Sum), + S = s(Sum), + writeln(d:Id:Sum), + adjust_prior(Sum, Id, NSum), + optimizer_set_g(Id, NSum ), + fail + ). +derive. + +% This is the call back function which is invoked to report the progress +% if the last argument is set to anywhting else than 0, the optimizer will +% stop right now +progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :- + optimizer_get_x(0,X0), + format('~d. Iteration : w=~4f f(X)=~4f |X|=~4f |X\'|=~4f Step=~4f Ls=~4f~n',[Iteration,X0,FX,X_Norm,G_Norm,Step,Ls]). + + +% This is the call back function which evaluates F and the gradient of F +evaluate(FX,_N,_Step) :- + set_weights, + likelihood(FX), + derive. + +init_vars(Ev, Pr) :- + mln(N), + N1 is N-1, + format('We start the search at weight=0~2n',[]), + optimizer_initialize(N, Ev, Pr), + between(0, N1, I), + optimizer_set_x(I,0.0), + fail. +init_vars(_, _). + +output_stat(BestF, Status) :- + mln(N), + N1 is N-1, + ( between(0,N1,I), + optimizer_get_x(I,BestX0), + format('w[~d] = ~f~n', [I, BestX0]), + fail + ; + Lik is -BestF, + format('Final likelihood=~f~2nLBFGS Status=~w~n',[Lik,Status]) + ). + +optimize :- + init_vars(evaluate, progress), + optimizer_run(BestF,Status), + output_stat(BestF, Status), + optimizer_finalize, + format('~2nOptimization done~n',[]). + +compile :- + init_compiler, + mln(ParFactor, _Type, _Els, _G), + factor(markov, ParFactor, Ks, _, _Phi, Constraints), + maplist(call, Constraints), + nth(_L, Ks, VId), + compile_pw(VId, P0, P1, G), + assert((p_l(ParFactor, VId, P0, P1) :- lmln:G)), + fail. +compile. + +init_compiler :- + retractall(i(_,_)), + retractall(i(_,_,_,_)), + retractall(p_l(_,_,_,_)), + retractall(lmln:p(_,_,_,_)), + fail. +init_compiler. + +compile_pw(VId, P0, P1, p(VId, _, P0, P1)) :- + clause(lmln:p(VId, _, P0, P1), _), !. +compile_pw(VId, Head0, Head1, G) :- + G = p(VId, Head, Head0, Head1), + compile(VId,Head,Head0,Head1,Bd), + assert( ( lmln:G :- Bd) ). + +compile(VId, P, P0, P1, Bd) :- + findall(p(FId,W,P0,P1), find_prob(VId, FId, W, P0, P1), Fs), + (evidence(VId, 1) -> P = P1 ; P = P0), + ( + Fs == [] -> fail + ; + Fs = [p(F,W,1,1)] + -> + P0 = 0.5, P1 = 0.5, Bd = true + ; Fs = [p(F,W,P0A,P1A)] + -> + Bd = (mln_w(F, W), P0 is P0A/(P0A+P1A), P1 is 1-P0) + ; + Fs = [p(FA,WA,P0A,P1A),p(FB,WB,P0B,P1B)] + -> + Bd = (mln_w(FA, WA), mln_w(FB, WB), P0 is P0A*P0B/(P0A*P0B+P1A*P1B), P1 is 1-P0) + ; + Bd = ( sumps(Fs, V0, 1.0, V1, 1.0), P0 is V1/(V0+V1), P1 is 1-P0) + ). + +find_prob(VId, ParFactor, W, P0, P1) :- + defined_in_factor(VId, ParFactor, L), + factor(markov, ParFactor, Ks, _, _Phi, Constraints), + nth0(L, Ks, VId), + maplist(call,Constraints), + mln(ParFactor, _Type, LP, _Head), + foldl(true_literal, LP, Ks, 0, NTs), + NTs < 2, % >= 2 ignore, always true... + maplist(polarity(VId, Pol), LP), + (NTs == 0 -> + /* We have no true literal */ + ( Pol == (+) -> +% inc_n(ParFactor, L1, 1), + (evidence(VId, 1) -> /* we are */ + assert(diff(VId,ParFactor,-1, 0)) + ; + assert(diff(VId, ParFactor, 0, 1)) + ), + P0 = 1, P1 = exp(W) + ; +% inc_n(ParFactor, L1, 0), + (evidence(VId, 1) -> /* we are */ + assert(diff(VId,ParFactor, 1, 0)) + ; + assert(diff(VId, ParFactor, 0, -1)) + ), + P0 = exp(W), P1 = 1 + ) + ; + /* L == 0: increment true literals once */ + (L == 0 -> inc(ParFactor) ; true ), + /* We have a single true literal */ + ( %are we that literal ? + Pol == (+) -> + (evidence(VId, 1) -> /* we are */ + % inc_n(ParFactor, L1, 1), + assert(diff(VId,ParFactor, -1, 0)), + P0 = 1, P1 = exp(W) ; + /* we are not */ + assert(diff(VId,ParFactor, 0, 0)), + % inc_n(ParFactor, L1, 0), + % inc_n(ParFactor, L1, 1), + P0 = 1, P1 = 1 + ) + ; + % NEGATIVE polarity + (evidence(VId, 1) -> /* we are not */ + assert(diff(VId,ParFactor, 0, 0)), + % inc_n(ParFactor, L1, 0), + % inc_n(ParFactor, L1, 1), + P0 = 1, P1 = 1 ; + /* we are */ + assert(diff(VId,ParFactor, 0, -1)), + % inc_n(ParFactor, L1, 0), + P0 = exp(W), P1 = 1 + ) + ) + ). + +polarity(L, -, -L) :- !. +polarity(L, +, L) :- !. +polarity(_, _, _). + +true_literal(-L, L, N, N1) :- !, + ( evidence(L, 1) -> N1 = N ; N1 is N+1 ). +true_literal(L, L, N, N1) :- + ( evidence(L, 1) -> N1 is N+1 ; N1 = N ). + +inc(Id) :- + retract(i(Id, N)), !, + N1 is N+1, + assert(i(Id, N1)). +inc(Id) :- + assert(i(Id, 1)). + +% V is f (0) +check(W, V, -V, exp(W), _R, Matters, Matters0) :- !, Matters = Matters0. +check(_W, V, V, R, R, Matters, Matters0) :- !, Matters = Matters0. +check(W, _V, -V, Rf, R0, Matters, Matters0) :- !, + (evidence(V, 1) -> Rf = R0, Matters=Matters0; Rf = exp(W), Matters = not). +check(W, _V, V, Rf, R0, Matters, Matters0) :- + (evidence(V, 1) -> Rf = exp(W), Matters = not ; Rf = R0, Matters=Matters0). + +complement(W, exp(W), 1). +complement(W, 1, exp(W)). + diff --git a/packages/CLPBN/mlns.yap b/packages/CLPBN/mlns.yap index a774f467d..7d625f9fc 100644 --- a/packages/CLPBN/mlns.yap +++ b/packages/CLPBN/mlns.yap @@ -1,20 +1,22 @@ :- module(mln, [op(1150,fx,mln), op(1150,fx,mln_domain), - mln_domain/1]). + mln_domain/1, + mln/1, + mln/4, + mln_w/2]). :- use_module(library(pfl)). :- use_module(library(maplist)). :- use_module(library(lists)). -:- dynamic mln/1, mln/2, mln_domain/4. +:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2. 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), - writeln(factor(markov,Id,FList,FV,Phi,Constraints)). + translate_to_factor(W, D, FList, Id, FV, Phi, Constraints). expand_domain((P1,P2)) :- !, expand_domain(P1), @@ -34,14 +36,17 @@ do_type(NP, Type, I0, I) :- translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :- W0 is exp(W), ( + Do = disj, disj_to_list(D, LP, [], Lits, []) -> findall(F, weight(LP, W0, 1, F), Phi) ; + Do = conj, conj_to_list(D, LP, [], Lits, []) -> findall(F, weight(LP, 1, W0, F), Phi) ; + Do = disj, cnf(D, Fs0, []), clean_cnf(Fs0, Fs) -> @@ -52,11 +57,46 @@ translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :- new_mln(Id), maplist(new_skolem(Id), Lits), term_variables(Lits, Vs), - create_domain(Lits, Domain). + create_domain(Lits, Domain), + make_clause(Id, Do, Vs, Domain, Lits, LP, Head), + assert(mln_w(Id, W)), + assert(mln(Id, Do, LP, Head)). +% +% naive translation of conj/disjunction into Prolog +% +make_clause(Id, Do, Vs, Domain, _Lits, Fs, Head) :- + Head =.. [mln,Id|Vs], + order_body(Do, Fs, Bd0), + add_domain(Domain, Bd, once(Bd0)), + assert_static(user:(Head :- Bd)). + +order_body(disj, Fs, Bd0) :- + order_body(Fs, Bd0). +order_body(conj, Fs, Bd0) :- + andder_body(Fs, Bd0), + + +order_body([-G], (\+ G)). +order_body([G], (G)). +order_body([-G|Gs], (\+G ; NGs)) :- + order_body(Gs, NGs). +order_body([G|Gs], (G ; NGs)) :- + order_body(Gs, NGs). + +ander_body([-G], (\+ G)). +ander_body([G], (G)). +ander_body([-G|Gs], (\+G , NGs)) :- + ander_body(Gs, NGs). +ander_body([G|Gs], (G , NGs)) :- + ander_body(Gs, NGs). + +add_domain([G], (G,B0), B0) :- !. +add_domain([G|Gs], (G,NGs), G0) :- + add_domain(Gs, NGs, G0). new_skolem(Id, Lit) :- - pfl:new_skolem(Lit, [t,f]), + pfl:new_skolem(Lit, [f,t]), assert(pfl:skolem_in(Lit, Id)). mln(0). @@ -148,7 +188,9 @@ create_dgoal(I0, Arity, Lit) --> [ TypeG ], create_dgoal(I, Arity, Lit). - +% +% very simple, inneficient converter from logic expressions to cnf +% cnf(V) --> { var(V) }, !, [[V]]. cnf((A->B)) --> !, @@ -210,3 +252,18 @@ clean_cnf(CNF, NCNF) :- maplist(sort, CNF, CNF1), sort(CNF1, NCNF). + +% +% count groundings +% +all_true(Id, V) :- + mln(Id, _F, _D, Head), + nb_create_accumulator(0, Acc), + ( + call(user:Head), + nb_add_to_accumulator(Acc, 1), + fail + ; + nb_accumulator_value(Acc, V) + ). + diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index f297f0e2b..1e80dc287 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -11,6 +11,8 @@ factor/6, skolem/2, defined_in_factor/2, + defined_in_factor/3, + evidence/2, get_pfl_cpt/5, % given id and keys, return new keys and cpt get_pfl_parameters/3, % given id return par factor parameter new_pfl_parameters/3, % given id set new parameters @@ -77,6 +79,12 @@ user:term_expansion( Goal, [] ) :- (ground(Goal) -> true ; throw(error('non ground evidence',Goal))), % prolog_load_context(module, M), assert(pfl:evidence(Sk,Var)). +user:term_expansion( Goal, [] ) :- + skolem( Goal, Dom), + ( Dom == [f,t] -> true ; throw(error('evidence for what value?',Goal))), + (ground(Goal) -> true ; throw(error('non ground evidence',Goal))), +% prolog_load_context(module, M), + assert(pfl:evidence(Goal,1)). Id@N :- generate_entity(0, N, Id, G), @@ -104,6 +112,15 @@ defined_in_factor(Key, Factor) :- Factor = factor(markov, Id, FList, FV, Phi, Constraints). +defined_in_factor(Key, Id, 0) :- + skolem_in(Key, Id), + factor(bayes, Id, [Key|_FList], _FV, _Phi, _Constraints), !. +defined_in_factor(Key, Id, I) :- + skolem_in(Key, Id), + factor(markov, Id, FList, _FV, _Phi, _Constraints), + nth0(I, FList, Key). + + generate_entity(N, N, _, _) :- !. generate_entity(I0, _N, Id, T) :- atomic_concat(p, I0, P), @@ -192,7 +209,6 @@ add_evidence(Sk,Var) :- get_pfl_cpt(Id, Keys, Ev, NewKeys, Out) :- factor(_Type,Id,[Key|_],_FV,avg,_Constraints), !, Keys = [Key|Parents], - writeln(Key:Parents), avg_factors(Key, Parents, 0.0, Ev, NewKeys, Out). get_pfl_cpt(Id, Keys, _, Keys, Out) :- factor(_Type,Id,Keys,_FV,Phi,_Constraints),