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

MLN generative learning

Browse Source
This commit is contained in:
Vitor Santos Costa
2013-07-29 17:56:32 -05:00
parent bfb4cef8f9
commit 24de22eeb5
3 changed files with 331 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
packages/CLPBN/mlns.yap
View File

@@ -4,14 +4,17 @@
mln_domain/1,
mln_literal/1,
mln/1,
mln/4,
mln_w/2]).
mln/5,
mln_w/2,
portray_mln/0,
portray_mln/1]).
:- use_module(library(pfl)).
:- use_module(library(maplist)).
:- use_module(library(lists)).
:- use_module(library(terms)).
:- dynamic mln/1, mln/2, mln_domain/4, mln/4, mln_w/2, mln_domain/5, mln_type_def/1.
:- dynamic mln/1, mln/2, mln_domain/4, mln/5, mln_w/2, mln_domain/5, mln_type_def/1.
user:term_expansion(mln_domain(P),[]) :-
expand_domain(P).
@@ -84,10 +87,22 @@ translate_to_factor(W, D, Lits, Id, Vs, Phi, Domain) :-
new_mln(Id),
maplist(new_skolem(Id), Lits),
term_variables(Lits, Vs),
create_domain(Lits, Domain),
create_domain(Lits, Domain0),
exclude(ground, Domain0, Domain),
make_clause(Id, Do, Vs, Domain, Lits, LP, Head),
assert(mln_w(Id, W)),
assert(mln(Id, Do, LP, Head)).
assert(mln_w(Id, W)),
find_pos(LP, NLP, Pos),
foldl2(merge_domain_lits, Domain, NDomain, [], _, NLP, [] ),
exclude(empty_goal, [true-Pos|NDomain], FDomain),
assert(mln(Id, Do, LP, Head, FDomain)).
empty_goal(_-[]).
find_pos([], [], []).
find_pos([-Lit|Lits], LP, [Lit|Pos]) :- !,
find_pos(Lits, LP, Pos).
find_pos([Lit|Lits], [Lit|LP], Pos) :-
find_pos(Lits, LP, Pos).
%
% naive translation of conj/disjunction into Prolog
@@ -101,7 +116,7 @@ make_clause(Id, Do, Vs, Domain, _Lits, Fs, Head) :-
order_body(disj, Fs, Bd0) :-
order_body(Fs, Bd0).
order_body(conj, Fs, Bd0) :-
andder_body(Fs, Bd0),
ander_body(Fs, Bd0),
order_body([-G], (\+ G)).
@@ -133,6 +148,23 @@ new_mln(Id) :-
Id1 is Id+1,
assert(mln(Id1)).
merge_domain_lits( Domain, Domain-Gs, Vs, [V|Vs], LP0, LPF) :-
arg(1, Domain, V),
delete_with_v(LP0, [V|Vs], LPF, Gs).
delete_with_v([], _Vs, [], []).
delete_with_v([G|LP0], Vs, LPF, NGs) :-
new_variables_in_term(Vs, G, NVs),
( NVs == [] ->
NGs = [G|Gs],
LPF = LP1
;
NGs = Gs,
LPF = [G|LP1]
),
delete_with_v(LP0, Vs, LP1, Gs).
%
% make it easier to manipulate
%
@@ -284,7 +316,7 @@ clean_cnf(CNF, NCNF) :-
% count groundings
%
all_true(Id, V) :-
mln(Id, _F, _D, Head),
mln(Id, _F, _D, Head, _),
nb_create_accumulator(0, Acc),
(
call(user:Head),
@@ -294,3 +326,29 @@ all_true(Id, V) :-
nb_accumulator_value(Acc, V)
).
portray_mln :-
portray_mln( user_error ).
portray_mln(Stream) :-
mln(Id, _, LP, _, _),
mln_w(Id, W),
format(Stream, 'mln ~4f : ( ', [W] ),
numbervars(LP, 1, _),
portray_lits(Stream, LP),
format(Stream, ' ).~n', [] ),
fail.
portray_mln(_Stream).
portray_lits(Stream, [L1]) :- !,
portray_lit( Stream, L1 ).
portray_lits(Stream, [L1|Ls]) :- !,
portray_lit( Stream, L1 ),
format(Stream, ' ; ', []),
portray_lits( Stream, Ls ).
portray_lit( Stream, -L ) :- !,
format( Stream, '\\+ ~q', [L] ).
portray_lit( Stream, L ) :-
format( Stream, '~q', [L] ).