diff --git a/packages/CLPBN/Makefile.in b/packages/CLPBN/Makefile.in index c43612cd1..9ce9c4122 100644 --- a/packages/CLPBN/Makefile.in +++ b/packages/CLPBN/Makefile.in @@ -40,6 +40,7 @@ CLPBN_EXDIR = $(srcdir)/examples CLPBN_TOP= \ $(srcdir)/clpbn.yap \ + $(srcdir)/mlns.yap \ $(srcdir)/pfl.yap CLPBN_PROGRAMS= \ diff --git a/packages/CLPBN/examples/mln.pfl b/packages/CLPBN/examples/mln.pfl new file mode 100644 index 000000000..4c0e473d8 --- /dev/null +++ b/packages/CLPBN/examples/mln.pfl @@ -0,0 +1,11 @@ + +:- use_module(library(mlns)). + +mln_domain(a(domain)). +mln_domain(b(domain)). + +mln 10:(a(X) ; b(X)). + +domain(1). +domain(2). + diff --git a/packages/CLPBN/mlns.yap b/packages/CLPBN/mlns.yap new file mode 100644 index 000000000..b93bab91a --- /dev/null +++ b/packages/CLPBN/mlns.yap @@ -0,0 +1,86 @@ +:- 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). +