diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improved mln stuff

Browse Source
This commit is contained in:
Vitor Santos Costa 2013-06-07 18:22:42 -05:00
parent c60e1046a7
commit f1cbc7f3be
2 changed files with 150 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/CLPBN/examples/mln.pfl
View File

@ -1,11 +1,14 @@
:- use_module(library(mlns)).
mln_domain a(domain).
mln_domain b(domain).
mln_domain a(domain), b(domain), c(domain), d(domain), e(domain), f(domain), g(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).

164
packages/CLPBN/mlns.yap
View File

@ -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],
functor(P, Name, Arity),
functor(NP, Name, Arity),
foldl(do_type(NP), Types, 1, _).
expand_domain(P).
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_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).
disj_to_list2(C1, L1, L1I, L, LI),
disj_to_list2(C2, L1I, L10, LI, L0).
disj_to_list((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) :-
!,
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 ).
weight([_], W0, P) :- !,
( P = W1 ; P = W0 ).
weight([_], W0, W1, P) :- !,
% true case false case
( P = W0 ; P = 1 ).
weight([(\+ _)|R], W0, P) :- !,
( P = W0 ; P = W1 ).
weight([(- _)|R], W0, W1, P) :- !,
% true case false case
( weight(R, W0, P) ; weight(R, W0, _), P = W0 ).
weight([_|R], W0, P) :-
( weight(R, W0, W1, P) ; weight(R, W0, W1, _), P = W0 ).
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).