87 lines
2.1 KiB
Prolog
87 lines
2.1 KiB
Prolog
:- module(mln,
|
|
[op(1150,fx,mln),
|
|
op(1150,fx,mln_domain),
|
|
mln_domain/1]).
|
|
|
|
:- use_module(library(pfl)).
|
|
:- use_module(library(maplist)).
|
|
|
|
:- dynamic mln/1, mln/2, mln_domain/4.
|
|
|
|
user:term_expansion(mln_domain(P),[]) :-
|
|
P =.. [Name|Types],
|
|
functor(P, Name, Arity),
|
|
functor(NP, Name, Arity),
|
|
foldl(do_type(NP), Types, 1, _).
|
|
|
|
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)).
|
|
|
|
do_type(NP, Type, I0, I) :-
|
|
I is I0+1,
|
|
arg(I0, NP, A),
|
|
TypeG =.. [Type, A],
|
|
assert(mln_domain(I0, NP, TypeG, A)).
|
|
|
|
translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :-
|
|
new_mln(Id),
|
|
disj_to_list(D, LP, [], Lits, []),
|
|
W0 is exp(W),
|
|
findall(F, weight(LP, W0, F), Phi),
|
|
maplist(new_skolem(Id), Lits),
|
|
term_variables(Lits, Vs),
|
|
create_domain(Lits, Domain).
|
|
|
|
new_skolem(Id, Lit) :-
|
|
pfl:new_skolem(Lit, [t,f]),
|
|
assert(pfl:skolem_in(Lit, Id)).
|
|
|
|
mln(0).
|
|
|
|
new_mln(Id) :-
|
|
retract(mln(Id)),
|
|
Id1 is Id+1,
|
|
assert(mln(Id1)).
|
|
|
|
%
|
|
% make it easier to manipulate
|
|
%
|
|
disj_to_list((C1;C2), L1, L10, L, L0) :-
|
|
!,
|
|
disj_to_list(C1, L1, L1I, L, LI),
|
|
disj_to_list(C2, L1I, L10, LI, L0).
|
|
disj_to_list((\+ C), [(\+ C)|L1], L1, [C|L], L) :- !.
|
|
disj_to_list(C, [C|L1], L1, [C|L], L).
|
|
|
|
%
|
|
% compute the weight table, assuming it is a disjunction
|
|
%
|
|
weight([(\+ _)], W0, P) :- !,
|
|
% true case false case
|
|
( P = 1 ; P = W0 ).
|
|
weight([_], W0, P) :- !,
|
|
% true case false case
|
|
( P = W0 ; P = 1 ).
|
|
weight([(\+ _)|R], W0, P) :- !,
|
|
% true case false case
|
|
( weight(R, W0, P) ; weight(R, W0, _), P = W0 ).
|
|
weight([_|R], W0, P) :-
|
|
% true case false case
|
|
( weight(R, W0, _), P = W0 ; weight(R, W0, P) ).
|
|
|
|
create_domain(Lits, Domain) :-
|
|
foldl(create_goals, Lits, RDomain, []),
|
|
sort(RDomain, Domain).
|
|
|
|
create_goals(Lit) -->
|
|
{ functor(Lit, _, Arity) },
|
|
create_dgoal(0, Arity, Lit).
|
|
|
|
create_dgoal(Arity, Arity, _Lit) --> !.
|
|
create_dgoal(I0, Arity, Lit) -->
|
|
{ I is I0+1, arg(I, Lit, A), mln_domain(I, Lit, TypeG, A) },
|
|
[ TypeG ],
|
|
create_dgoal(I, Arity, Lit).
|
|
|