MLN generative learning
This commit is contained in:
Vitor Santos Costa
parent
bfb4cef8f9
commit
24de22eeb5
@ -9,22 +9,32 @@
|
||||
%
|
||||
%
|
||||
|
||||
:- module(learn_mlns_generative,
|
||||
[learn_mln_generative/0,
|
||||
portray_mln/0]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
|
||||
:- use_module(library(tries)).
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- use_module(library(nb)).
|
||||
|
||||
:- use_module(library(mlns)).
|
||||
:- use_module(library(matrix)).
|
||||
|
||||
:- use_module(library(pfl)).
|
||||
:- reexport(library(mlns)).
|
||||
|
||||
:- reexport(library(pfl)).
|
||||
|
||||
:- use_module(library(lbfgs)).
|
||||
|
||||
:- dynamic diff/4, i/2.
|
||||
:- yap_flag(tabling_mode,local).
|
||||
|
||||
:- dynamic diff/4, lit/1, i/2.
|
||||
|
||||
prior_means(_, 0.0).
|
||||
prior_dev(_, 100.0).
|
||||
prior_dev(_, 1.0).
|
||||
|
||||
learn_mln_generative :-
|
||||
compile,
|
||||
@ -33,43 +43,70 @@ learn_mln_generative :-
|
||||
set_weights :-
|
||||
retract( mln:mln_w(Id, _) ),
|
||||
optimizer_get_x( Id, W),
|
||||
% writeln(weight: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).
|
||||
|
||||
add_lprior(Id-WI, Lik0, Lik) :-
|
||||
prior_means(Id, PM),
|
||||
prior_dev(Id, PV),
|
||||
Lik is Lik0 + ((WI-PM)*(WI-PM))/(2*PV*PV).
|
||||
|
||||
|
||||
likelihood(Lik) :-
|
||||
S = s(0.0),
|
||||
% nb_create_accumulator(0.0, Acc),
|
||||
(
|
||||
lmln:p(_Lit,P,_,_),
|
||||
LogP is log(P),
|
||||
% writeln(_Lit:P),
|
||||
recorded(i, [Ref|N], _),
|
||||
peval(Ref, LogP),
|
||||
%writeln(N*P),
|
||||
S = s(V),
|
||||
V1 is V+LogP,
|
||||
V1 is V+N*LogP,
|
||||
nb_setarg(1, S, V1),
|
||||
% nb_add_to_accumulator( Acc, LogP),
|
||||
fail
|
||||
;
|
||||
% nb_accumulator_value(Acc, Lik)
|
||||
S = s(Lik0),
|
||||
writeln(lik:Lik0),
|
||||
%writeln(lik:Lik0),
|
||||
adjust_lprior(Lik0, Lik1),
|
||||
Lik is -Lik1
|
||||
).
|
||||
|
||||
derive :-
|
||||
nb_getval(i2, Mat),
|
||||
nb_getval(d2, MatD),
|
||||
matrix_set_all(MatD, 0.0),
|
||||
recorded(i, [Ref|NI], _),
|
||||
trie_get_entry(Ref, e(_, Ds, Ps)),
|
||||
member(n(Id,Occs,DN0,DN1), Ds),
|
||||
matrix_get(Mat, [Id], N),
|
||||
matrix_get(MatD, [Id], V),
|
||||
peval(Ps, P0, P1),
|
||||
X is Occs*(N-P0*(N+DN0)-P1*(N+DN1)),
|
||||
%writeln(X is NI*(-P0*(DN0)-P1*(DN1))),
|
||||
V1 is V-NI*X,
|
||||
matrix_set(MatD, [Id], V1),
|
||||
fail.
|
||||
derive :-
|
||||
nb_getval(d2, MatD),
|
||||
mln(Ms),
|
||||
N1 is Ms-1,
|
||||
between(0, N1, Id),
|
||||
matrix_get(MatD, [Id], Sum),
|
||||
%writeln(d:Id:Sum),
|
||||
adjust_prior(Sum, Id, NSum),
|
||||
optimizer_set_g(Id, NSum ),
|
||||
fail.
|
||||
derive.
|
||||
|
||||
adjust_prior(Lik0, _, Lik) :-
|
||||
Lik0 = Lik, !.
|
||||
adjust_prior(Sum, Id, NSum) :-
|
||||
@ -78,44 +115,25 @@ adjust_prior(Sum, Id, NSum) :-
|
||||
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.
|
||||
:- dynamic old_fx/1.
|
||||
|
||||
old_fx(+inf).
|
||||
|
||||
% 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
|
||||
% if the last argument is set to anything else than 0, the optimizer will
|
||||
% stop right now
|
||||
progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls,0) :-
|
||||
user:progress(FX,X_Norm,G_Norm,Step,_N,Iteration,Ls, Out) :-
|
||||
( Iteration mod 100 =:= 0 -> atomic_concat([tmp_,Iteration,'.pfl'], File), open( File, write, S), portray_mln(S), close(S) ; true ),
|
||||
retract(old_fx(FX0)),
|
||||
( Delta is FX-FX0, abs(Delta/FX) < 0.00001 -> Out = 1 ; Out = 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]).
|
||||
assert(old_fx(FX)),
|
||||
format('/* ~d: w[0]=~10f 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) :-
|
||||
|
||||
% This is the call back function which evaluates F and the gradient of F
|
||||
user:evaluate(FX,_N,_Step) :-
|
||||
set_weights,
|
||||
likelihood(FX),
|
||||
derive.
|
||||
@ -123,7 +141,7 @@ evaluate(FX,_N,_Step) :-
|
||||
init_vars(Ev, Pr) :-
|
||||
mln(N),
|
||||
N1 is N-1,
|
||||
format('We start the search at weight=0~2n',[]),
|
||||
format('/* We start the search for ~d weights at weight[_]=0 */~2n',[N]),
|
||||
optimizer_initialize(N, Ev, Pr),
|
||||
between(0, N1, I),
|
||||
optimizer_set_x(I,0.0),
|
||||
@ -131,15 +149,11 @@ init_vars(Ev, Pr) :-
|
||||
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]),
|
||||
( portray_mln,
|
||||
fail
|
||||
;
|
||||
Lik is -BestF,
|
||||
format('Final likelihood=~f~2nLBFGS Status=~w~n',[Lik,Status])
|
||||
format('/* Final likelihood=~f */~n/* LBFGS Status=~w */~n',[Lik,Status])
|
||||
).
|
||||
|
||||
optimize :-
|
||||
@ -151,134 +165,208 @@ optimize :-
|
||||
|
||||
compile :-
|
||||
init_compiler,
|
||||
mln(ParFactor, _Type, _Els, _G),
|
||||
writeln(ParFactor),
|
||||
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)),
|
||||
compile_literals,
|
||||
fail.
|
||||
/*
|
||||
compile :-
|
||||
recorded(i, [Ref|N], _),
|
||||
trie_get_entry(Ref, E),
|
||||
writeln(N:E),
|
||||
fail.
|
||||
*/
|
||||
compile.
|
||||
|
||||
init_compiler :-
|
||||
retractall(i(_,_)),
|
||||
retractall(i(_,_,_,_)),
|
||||
mln(HowMany),
|
||||
D is HowMany+1,
|
||||
matrix_new(ints, [D], M),
|
||||
matrix_new(floats, [D], MD),
|
||||
nb_setval(i2,M),
|
||||
nb_setval(d2,MD),
|
||||
collect_literals,
|
||||
init_trie,
|
||||
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) ).
|
||||
init_trie :-
|
||||
catch(nb_getval( mln_trie, Trie ), _, fail),
|
||||
trie_close( Trie ),
|
||||
eraseall( i ),
|
||||
fail.
|
||||
init_trie :-
|
||||
trie_open( Trie ),
|
||||
nb_setval( mln_trie , Trie ).
|
||||
|
||||
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),
|
||||
collect_literals :-
|
||||
mln(ParFactor, _Type, _Els, _G, _DConstraints),
|
||||
factor(markov, ParFactor, Ks, _, _Phi, _Constraints),
|
||||
maplist(add_lit, Ks),
|
||||
fail.
|
||||
collect_literals.
|
||||
|
||||
add_lit(K) :-
|
||||
functor(K, N, A),
|
||||
functor(K0, N, A),
|
||||
( lit(K0) -> true ; assert(lit(K0)) ).
|
||||
|
||||
compile_literals :-
|
||||
lit(K),
|
||||
functor(K, N, A),
|
||||
statistics(runtime,_),
|
||||
format(user_error, '/** grounding ~a/~d.~45+**/~n',[N,A]),
|
||||
% evidence(K, 1),
|
||||
( ground_lit(K),
|
||||
%writeln(k:K),
|
||||
compile_pw(K)
|
||||
;
|
||||
statistics(runtime,[_,T]),
|
||||
format(user_error, '/** took ~d msec.~45+**/~n',[T]),
|
||||
fail
|
||||
).
|
||||
|
||||
|
||||
ground_lit(K) :-
|
||||
functor(K, _, Ar),
|
||||
ground_lit(0, Ar, K).
|
||||
|
||||
ground_lit(Ar, Ar, _K).
|
||||
ground_lit(I0, Ar, K) :-
|
||||
I is I0+1,
|
||||
(mln):mln_domain(I, K, G, _A),
|
||||
user:G,
|
||||
ground_lit(I, Ar, K).
|
||||
|
||||
compile_pw(VId) :-
|
||||
(evidence(VId, 1) -> P = 1 ; P = 0),
|
||||
compile(VId, P).
|
||||
|
||||
compile(VId, Val) :-
|
||||
findall(p(FId,W,P0,P1,I0,I1), find_prob(VId, Val, FId, W, P0, P1, I0, I1), Fs),
|
||||
(
|
||||
Fs == [] -> fail
|
||||
;
|
||||
Fs = [p(F,W,1,1)]
|
||||
Fs = [p(FId,W,1,1,I0,I1)]
|
||||
->
|
||||
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)
|
||||
fail
|
||||
;
|
||||
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)
|
||||
sort(Fs, FsS),
|
||||
merge_lits(FsS, FsN, Ws),
|
||||
nb_getval( mln_trie, Trie ),
|
||||
store( Trie, e(Val, Ws, FsN) )
|
||||
).
|
||||
|
||||
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
|
||||
)
|
||||
)
|
||||
).
|
||||
store( T , E ) :-
|
||||
trie_check_entry(T, E, R), !,
|
||||
recorded(i, [R|I], Ref),
|
||||
erase(Ref),
|
||||
I1 is I+1,
|
||||
recorda(i, [R|I1], _).
|
||||
store( T , E ) :-
|
||||
trie_put_entry(T, E, R), !,
|
||||
recorda(i, [R|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)), !,
|
||||
merge_lits([], [], []).
|
||||
merge_lits([N*p(F,W,A1,A2,I1,I2), p(F,W,A3,A4,I3,I4)|FsS], FsM, Is) :-
|
||||
A1 == A3,
|
||||
A2 == A4,
|
||||
I1 == I3,
|
||||
I2 == I4, !,
|
||||
N1 is N+1,
|
||||
assert(i(Id, N1)).
|
||||
merge_lits([N1*p(F,W,A3,A4,I3,I4)|FsS], FsM, Is).
|
||||
merge_lits([p(F,W,A1,A2,I1,I2), p(F,W,A3,A4,I3,I4)|FsS], FsM, Is) :-
|
||||
A1 == A3,
|
||||
A2 == A4,
|
||||
I1 == I3,
|
||||
I2 == I4, !,
|
||||
merge_lits([2*p(F,W,A3,A4,I3,I4)|FsS], FsM, Is).
|
||||
merge_lits([p(F,W,A1,A2,I1,I2) | FsS], [p(F,1,W,A1,A2)|FsM], [n(F,1,I1,I2)|Is]) :-
|
||||
merge_lits(FsS, FsM, Is).
|
||||
merge_lits([N*p(F,W,A1,A2,I1,I2) | FsS], [p(F,N,W,A1,A2)|FsM], [n(F,N,I1,I2)|Is]) :-
|
||||
merge_lits(FsS, FsM, Is).
|
||||
|
||||
find_prob(VId, E, ParFactor, W, P0, P1, I0, I1) :-
|
||||
mln(ParFactor, _, _Type, _, Constraints),
|
||||
% maplist(call,Constraints),
|
||||
deletei(Constraints, VId, ConstraintsF, Pol),
|
||||
maplist(expand_domain(VId-Pol), ConstraintsF),
|
||||
% all other literals are false
|
||||
( Pol == (+) ->
|
||||
P0 = 0, P1 = W,
|
||||
(E == 1 -> /* we are making this true */
|
||||
inc(ParFactor),
|
||||
I0 = -1, I1 = 0
|
||||
;
|
||||
/* it is false */
|
||||
I0 = 0, I1 = 1
|
||||
)
|
||||
;
|
||||
P0 = W, P1 = 0,
|
||||
(E == 1 -> /* we are making this false */
|
||||
I0 = 1, I1 = 0
|
||||
;
|
||||
/* it is true */
|
||||
inc(ParFactor),
|
||||
I0 = 0, I1 = -1
|
||||
)
|
||||
).
|
||||
|
||||
expand_domain(VIdPol, true - Lits) :- !,
|
||||
maplist( false_literal(VIdPol), Lits).
|
||||
|
||||
expand_domain(VIdPol, Dom-Lits) :-
|
||||
call(user:Dom),
|
||||
maplist( true_literal(VIdPol), Lits).
|
||||
|
||||
% we need to check if we have
|
||||
% L ; L or L ; -L
|
||||
% in this case skip or it is always true, so fail.
|
||||
false_literal(L-(-), L).
|
||||
false_literal(VId-_, L) :-
|
||||
evidence(L, 1),
|
||||
L \= VId.
|
||||
|
||||
% L is ground
|
||||
true_literal(L-(+), L) :- !.
|
||||
true_literal(VId-_, L) :-
|
||||
L \= VId,
|
||||
\+ evidence(L, 1).
|
||||
|
||||
deletei([true-Lits|More], K, [true-NLits|More], -) :-
|
||||
force_delete(Lits, K, NLits).
|
||||
deletei([true-Lits|More], K, [true-Lits|NMore], -) :- !,
|
||||
force_delete(More, K, NMore).
|
||||
deletei(More, K, NMore, +) :-
|
||||
deletei(More, K, NMore).
|
||||
|
||||
deletei([Dom-Lits|More], K, [Dom-NLits|More]) :-
|
||||
force_delete(Lits, K, NLits).
|
||||
deletei([DomLits|More], K, [DomLits|NMore]) :-
|
||||
deletei(More, K, NMore).
|
||||
|
||||
force_delete([Elem|List], Elem, List).
|
||||
force_delete([Head|List], Elem, [Head|Residue]) :-
|
||||
force_delete(List, Elem, Residue).
|
||||
|
||||
inc(Id) :-
|
||||
assert(i(Id, 1)).
|
||||
nb_getval(i2, M),
|
||||
matrix_inc(M, [Id]).
|
||||
|
||||
% 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).
|
||||
peval(Ref, P) :-
|
||||
trie_get_entry(Ref, e(Side, _, Ps)),
|
||||
foldl2(p_eval, Ps, 0.0, P0, 0.0, P1),
|
||||
logsum(P0, P1, P01),
|
||||
( Side == 0 -> P = P0-P01 ; P = P1-P01 ).
|
||||
|
||||
complement(W, exp(W), 1).
|
||||
complement(W, 1, exp(W)).
|
||||
peval(Ps, P0, P1) :-
|
||||
%writeln(p:Ds:Ps),
|
||||
foldl2(p_eval, Ps, 0.0, AP0, 0.0, AP1),
|
||||
logsum(AP0, AP1, AP01),
|
||||
P0 is exp( AP0 - AP01 ),
|
||||
P1 is 1-P0.
|
||||
|
||||
p_eval(p(WId, N, W, P0, P1), AP0, A0, AP1, A1) :-
|
||||
mln_w(WId, W),
|
||||
A0 is AP0+N*P0,
|
||||
A1 is AP1+N*P1.
|
||||
|
||||
@ -4,14 +4,17 @@
|
||||
mln_domain/1,
|
||||
mln_literal/1,
|
||||
mln/1,
|
||||
mln/4,
|
||||
mln_w/2]).
|
||||
mln/5,
|
||||
mln_w/2,
|
||||
portray_mln/0,
|
||||
portray_mln/1]).
|
||||
|
||||
:- use_module(library(pfl)).
|
||||
:- use_module(library(maplist)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(terms)).
|
||||
|
||||
:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2, mln_domain/5, mln_type_def/1.
|
||||
:- dynamic mln/1, mln/2, mln_domain/4, mln/5, mln_w/2, mln_domain/5, mln_type_def/1.
|
||||
|
||||
user:term_expansion(mln_domain(P),[]) :-
|
||||
expand_domain(P).
|
||||
@ -84,10 +87,22 @@ 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, Domain0),
|
||||
exclude(ground, Domain0, Domain),
|
||||
make_clause(Id, Do, Vs, Domain, Lits, LP, Head),
|
||||
assert(mln_w(Id, W)),
|
||||
assert(mln(Id, Do, LP, Head)).
|
||||
find_pos(LP, NLP, Pos),
|
||||
foldl2(merge_domain_lits, Domain, NDomain, [], _, NLP, [] ),
|
||||
exclude(empty_goal, [true-Pos|NDomain], FDomain),
|
||||
assert(mln(Id, Do, LP, Head, FDomain)).
|
||||
|
||||
empty_goal(_-[]).
|
||||
|
||||
find_pos([], [], []).
|
||||
find_pos([-Lit|Lits], LP, [Lit|Pos]) :- !,
|
||||
find_pos(Lits, LP, Pos).
|
||||
find_pos([Lit|Lits], [Lit|LP], Pos) :-
|
||||
find_pos(Lits, LP, Pos).
|
||||
|
||||
%
|
||||
% naive translation of conj/disjunction into Prolog
|
||||
@ -101,7 +116,7 @@ make_clause(Id, Do, Vs, Domain, _Lits, Fs, Head) :-
|
||||
order_body(disj, Fs, Bd0) :-
|
||||
order_body(Fs, Bd0).
|
||||
order_body(conj, Fs, Bd0) :-
|
||||
andder_body(Fs, Bd0),
|
||||
ander_body(Fs, Bd0),
|
||||
|
||||
|
||||
order_body([-G], (\+ G)).
|
||||
@ -133,6 +148,23 @@ new_mln(Id) :-
|
||||
Id1 is Id+1,
|
||||
assert(mln(Id1)).
|
||||
|
||||
merge_domain_lits( Domain, Domain-Gs, Vs, [V|Vs], LP0, LPF) :-
|
||||
arg(1, Domain, V),
|
||||
delete_with_v(LP0, [V|Vs], LPF, Gs).
|
||||
|
||||
delete_with_v([], _Vs, [], []).
|
||||
delete_with_v([G|LP0], Vs, LPF, NGs) :-
|
||||
new_variables_in_term(Vs, G, NVs),
|
||||
( NVs == [] ->
|
||||
NGs = [G|Gs],
|
||||
LPF = LP1
|
||||
;
|
||||
NGs = Gs,
|
||||
LPF = [G|LP1]
|
||||
),
|
||||
delete_with_v(LP0, Vs, LP1, Gs).
|
||||
|
||||
|
||||
%
|
||||
% make it easier to manipulate
|
||||
%
|
||||
@ -284,7 +316,7 @@ clean_cnf(CNF, NCNF) :-
|
||||
% count groundings
|
||||
%
|
||||
all_true(Id, V) :-
|
||||
mln(Id, _F, _D, Head),
|
||||
mln(Id, _F, _D, Head, _),
|
||||
nb_create_accumulator(0, Acc),
|
||||
(
|
||||
call(user:Head),
|
||||
@ -294,3 +326,29 @@ all_true(Id, V) :-
|
||||
nb_accumulator_value(Acc, V)
|
||||
).
|
||||
|
||||
portray_mln :-
|
||||
portray_mln( user_error ).
|
||||
|
||||
portray_mln(Stream) :-
|
||||
mln(Id, _, LP, _, _),
|
||||
mln_w(Id, W),
|
||||
format(Stream, 'mln ~4f : ( ', [W] ),
|
||||
numbervars(LP, 1, _),
|
||||
portray_lits(Stream, LP),
|
||||
format(Stream, ' ).~n', [] ),
|
||||
fail.
|
||||
portray_mln(_Stream).
|
||||
|
||||
portray_lits(Stream, [L1]) :- !,
|
||||
portray_lit( Stream, L1 ).
|
||||
portray_lits(Stream, [L1|Ls]) :- !,
|
||||
portray_lit( Stream, L1 ),
|
||||
format(Stream, ' ; ', []),
|
||||
portray_lits( Stream, Ls ).
|
||||
|
||||
portray_lit( Stream, -L ) :- !,
|
||||
format( Stream, '\\+ ~q', [L] ).
|
||||
portray_lit( Stream, L ) :-
|
||||
format( Stream, '~q', [L] ).
|
||||
|
||||
|
||||
|
||||
@ -184,7 +184,7 @@ 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 ),
|
||||
( D = [f,t] -> assert((evidence(NSk, 1) :- user:NSk)) ; true ),
|
||||
interface_predicate(NSk),
|
||||
assert(skolem(NSk, D)).
|
||||
|
||||
|
||||
Reference in New Issue
Block a user