improved mln stuff

packages/CLPBN/examples/mln.pfl

@@ -1,11 +1,14 @@
 
 :- use_module(library(mlns)).
 
-mln_domain a(domain).
+mln_domain a(domain), b(domain), c(domain), d(domain), e(domain), f(domain), g(domain).
-mln_domain b(domain).
 
 mln 10:(a(X) ; b(X)).
 
+mln 10:(c(X) , d(X)).
+
+mln 10: (g(X), e(X) -> f(X)).
+
 domain(1).
 domain(2).
 

packages/CLPBN/mlns.yap

@@ -5,19 +5,26 @@
 
 :- use_module(library(pfl)).
 :- use_module(library(maplist)).
+:- use_module(library(lists)).
 
 :- dynamic mln/1, mln/2, mln_domain/4.
 
 user:term_expansion(mln_domain(P),[]) :-
-	P =.. [Name|Types],
+	expand_domain(P).
-	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)).
 
+expand_domain((P1,P2)) :- !,
+	expand_domain(P1),
+	expand_domain(P2).
+expand_domain(P) :-
+	P =.. [Name|Types],
+	functor(P, Name, Arity),
+	functor(NP, Name, Arity),
+	foldl(do_type(NP), Types, 1, _).
+
 do_type(NP, Type, I0, I) :-
 	I is I0+1,
 	arg(I0, NP, A),
@@ -25,14 +32,29 @@ do_type(NP, Type, I0, I) :-
 	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),
+	(
+	    disj_to_list(D, LP, [], Lits, [])
+	->
+	    findall(F, weight(LP, W0, 1, F), Phi)
+	;
+	    conj_to_list(D, LP, [], Lits, [])
+	->
+            findall(F, weight(LP, 1, W0, F), Phi)
+	;
+	    cnf(D, Fs0, []),
+	    clean_cnf(Fs0, Fs)
+	->
+	    member( LP, Fs), 
+            findall(F, weight(LP, W0, 1, F), Phi),
+	    maplist(remove_not, LP, Lits)
+	),
+	new_mln(Id),
 	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)).
@@ -49,26 +71,68 @@ new_mln(Id) :-
 %
 disj_to_list((C1;C2), L1, L10, L, L0) :-
 	!,
-	disj_to_list(C1, L1, L1I, L, LI),
+	disj_to_list2(C1, L1, L1I, L, LI),
-	disj_to_list(C2, L1I, L10, LI, L0).
+	disj_to_list2(C2, L1I, L10, LI, L0).
-disj_to_list((\+ C), [(\+ C)|L1], L1, [C|L], L) :- !.
+disj_to_list((C1+C2), L1, L10, L, L0) :-
-disj_to_list(C, [C|L1], L1, [C|L], L).
+	!,
+	disj_to_list2(C1, L1, L1I, L, LI),
+	disj_to_list2(C2, L1I, L10, LI, L0).
+
+disj_to_list2((C1;C2), L1, L10, L, L0) :-
+	!,
+	disj_to_list2(C1, L1, L1I, L, LI),
+	disj_to_list2(C2, L1I, L10, LI, L0).
+disj_to_list2((C1+C2), L1, L10, L, L0) :-
+	!,
+	disj_to_list2(C1, L1, L1I, L, LI),
+	disj_to_list2(C2, L1I, L10, LI, L0).
+disj_to_list2((_C1,_C2), _L1, _L10, _L, _L0) :- !, fail.
+disj_to_list2((_C1*_C2), _L1, _L10, _L, _L0) :- !, fail.
+disj_to_list2((\+ C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
+disj_to_list2((- C), [(-C)|L1], L1, [C|L], L) :- literal(C), !.
+disj_to_list2(C, [C|L1], L1, [C|L], L).
+
+conj_to_list((C1,C2), L1, L10, L, L0) :-
+	!,
+	conj_to_list2(C1, L1, L1I, L, LI),
+	conj_to_list2(C2, L1I, L10, LI, L0).
+conj_to_list((C1*C2), L1, L10, L, L0) :-
+	!,
+	conj_to_list2(C1, L1, L1I, L, LI),
+	conj_to_list2(C2, L1I, L10, LI, L0).
+
+conj_to_list2((_C1;_C2), _L1, _L10, _L, _L0) :- !, fail.
+conj_to_list2((_C1+_C2), _L1, _L10, _L, _L0) :- !, fail.
+conj_to_list2((C1,C2), L1, L10, L, L0) :-
+	!,
+	conj_to_list2(C1, L1, L1I, L, LI),
+	conj_to_list2(C2, L1I, L10, LI, L0).
+conj_to_list2((C1*C2), L1, L10, L, L0) :-
+	!,
+	conj_to_list2(C1, L1, L1I, L, LI),
+	conj_to_list2(C2, L1I, L10, LI, L0).
+conj_to_list2((\+ C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
+conj_to_list2((- C), [(C)|L1], L1, [C|L], L) :- literal(C), !.
+conj_to_list2(C, [-C|L1], L1, [C|L], L).
+
+remove_not(-G, G) :- !.
+remove_not( G, G).
 
 %
 % compute the weight table, assuming it is a disjunction
 %
-weight([(\+ _)], W0, P) :- !,
+weight([(- _)], W0, W1, P) :- !,
 	% true case              false case
-	( P = 1 ;  P = W0 ).
+	( P = W1 ;  P = W0 ).
-weight([_], W0, P) :- !,
+weight([_], W0, W1, P) :- !,
 	% true case              false case
-	( P = W0  ;  P = 1 ).
+	( P = W0  ;  P = W1 ).
-weight([(\+ _)|R], W0, P) :- !,
+weight([(- _)|R], W0, W1, P) :- !,
 	% true case              false case
-	( weight(R, W0, P) ;  weight(R, W0, _), P = W0 ).
+	( weight(R, W0, W1, P) ;  weight(R, W0, W1, _), P = W0 ).
-weight([_|R], W0, P) :-
+weight([_|R], W0, W1, P) :-
 	% true case              false case
-	( weight(R, W0, _), P = W0 ;  weight(R, W0, P) ).
+	( weight(R, W0, W1, _), P = W0 ;  weight(R, W0, W1, P) ).
 
 create_domain(Lits, Domain) :-
 	foldl(create_goals, Lits, RDomain, []),
@@ -84,3 +148,65 @@ create_dgoal(I0, Arity, Lit) -->
         [ TypeG ],
 	create_dgoal(I, Arity, Lit).
 
+
+cnf(V) --> { var(V) }, !,
+	[[V]].
+cnf((A->B)) --> !,
+	cnf(-A+B).
+cnf((A*B)) --> !,
+	cnf(A),
+	cnf(B).
+cnf((A,B)) --> !,
+	cnf(A),
+	cnf(B).
+cnf((-A)) --> !,
+	{ cnf(A, B, []) },
+	neg(B).
+cnf((\+ A)) --> !,
+	{ cnf(A, B, []) },
+	neg(B).
+cnf(A+B, Lf, L0) :- !,
+	cnf(A, LA, []),
+	cnf(B, LB, []),
+	foldl(or(LB), LA, Lf, L0).
+cnf((A;B), Lf, L0) :- !,
+	cnf(A, LA, []),
+	cnf(B, LB, []),
+	foldl(or(LB), LA, Lf, L0).
+cnf((A==B)) --> !,
+	cnf((A+ -B)),
+	cnf((B+ -A)).
+cnf(xor(A,B)) --> !,
+	cnf(A+B),
+	cnf(-B + -A).
+cnf(A) -->
+	[[A]].
+
+or(LB, Disj, Lf, L0) :-
+	foldl( add(Disj), LB, Lf, L0).
+
+add( Disj, El) -->
+	{ append(Disj, El, UnSort),
+	  sort(UnSort, Els) },
+	[Els].
+
+neg(Els) -->
+	{ maplist( neg, Els, Conjs) },
+	orl(Conjs).
+
+neg(El, Conj) :-
+	maplist(neg2, El, Conj).
+
+neg2(-X, [X]) :- !.
+neg2(X, [-X]).
+
+orl([C1,C2|C]) -->
+	{ foldl(or(C2), C1, C3, []) },
+	orl([C3|C]).
+orl([Cs]) -->
+	Cs.
+
+clean_cnf(CNF, NCNF) :-
+	maplist(sort, CNF, CNF1),
+	sort(CNF1, NCNF).
+