Merge branch 'master' of ssh://git.code.sf.net/p/yap/yap-6.3

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= \

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

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