MLN stuff

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)).
+

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),
+	translate_to_factor(W, D, FList, Id, FV, Phi, Constraints).
-	writeln(factor(markov,Id,FList,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)
+        ).
+

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),