PFL support.
This commit is contained in:
@@ -4,16 +4,17 @@
|
||||
%
|
||||
|
||||
:- module(pfl, [
|
||||
factor/5,
|
||||
factor/6,
|
||||
skolem/2,
|
||||
defined_in_factor/2,
|
||||
get_pfl_parameters/2, % given id return par factor parameter
|
||||
new_pfl_parameters/2, % given id set new parameters
|
||||
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
|
||||
get_factor_pvariable/2, % given id get any pvar
|
||||
op(550,yfx,@),
|
||||
op(550,yfx,::),
|
||||
op(1150,fx,bayes),
|
||||
op(1150,fx,markov),
|
||||
op(1150,fx,parfactor)]).
|
||||
op(1150,fx,markov)]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth0/3,
|
||||
@@ -23,33 +24,66 @@
|
||||
:- dynamic factor/5, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
|
||||
|
||||
:- reexport(library(clpbn),
|
||||
[clpbn_flag/2,
|
||||
clpbn_flag/2 as pfl_flag,
|
||||
set_clpbn_flag/2,
|
||||
[clpbn_flag/2 as pfl_flag,
|
||||
set_clpbn_flag/2 as set_pfl_flag]).
|
||||
|
||||
:- set_pfl_flag(use_factors,on).
|
||||
:- ( % if clp(bn) has done loading, we're top-level
|
||||
predicate_property(set_pfl_flag(_,_), imported_from(clpbn))
|
||||
->
|
||||
% we're using factor language
|
||||
% set appropriate flag
|
||||
set_pfl_flag(use_factors,on)
|
||||
;
|
||||
% we're within clp(bn), no need to do anything
|
||||
true
|
||||
).
|
||||
|
||||
:- pfl_not_clpbn.
|
||||
|
||||
user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :-
|
||||
user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(bayes,Id,FList,FV,Phi,Constraints)) :-
|
||||
!,
|
||||
term_variables(Formula, FreeVars),
|
||||
FV =.. [fv|FreeVars],
|
||||
new_id(Id),
|
||||
process_args(Formula, Id, 0, _, FList, []).
|
||||
user:term_expansion( markov((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :-
|
||||
user:term_expansion( markov((Formula ; Phi ; Constraints)), pfl:factor(markov,Id,FList,FV,Phi,Constraints)) :-
|
||||
!,
|
||||
term_variables(Formula, FreeVars),
|
||||
FV =.. [fv|FreeVars],
|
||||
new_id(Id),
|
||||
process_args(Formula, Id, 0, _, FList, []).
|
||||
user:term_expansion( Id@N, L ) :-
|
||||
atom(Id), number(N), !,
|
||||
findall(G,generate_entity(0, N, Id, G), L).
|
||||
user:term_expansion( Goal, [] ) :-
|
||||
preprocess(Goal, Sk,Var), !,
|
||||
(ground(Goal) -> true ; throw(error('non ground evidence',Goal))),
|
||||
% prolog_load_context(module, M),
|
||||
assert(pfl:evidence(Sk,Var)).
|
||||
|
||||
Id@N :-
|
||||
generate_entity(0, N, Id, G),
|
||||
assert_static(user:G),
|
||||
fail.
|
||||
_Id@_N.
|
||||
|
||||
defined_in_factor(Key, Factor) :-
|
||||
skolem_in(Key, Id),
|
||||
factor(bayes, Id, [Key|FList], FV, Phi, Constraints), !,
|
||||
Factor = factor(bayes, Id, [Key|FList], FV, Phi, Constraints).
|
||||
defined_in_factor(Key, Factor) :-
|
||||
skolem_in(Key, Id),
|
||||
factor(markov, Id, FList, FV, Phi, Constraints),
|
||||
member(Key, FList),
|
||||
Factor = factor(markov, Id, FList, FV, Phi, Constraints).
|
||||
|
||||
|
||||
generate_entity(N, N, _, _) :- !.
|
||||
generate_entity(I0, _N, Id, T) :-
|
||||
atomic_concat(person_, I0, P),
|
||||
T =.. [Id, P].
|
||||
generate_entity(I0, N, Id, T) :-
|
||||
I is I0+1,
|
||||
generate_entity(I, N, Id, T).
|
||||
|
||||
id(0).
|
||||
|
||||
new_id(Id) :-
|
||||
@@ -110,19 +144,19 @@ add_evidence(Sk,Var) :-
|
||||
|
||||
|
||||
get_pfl_parameters(Id,Out) :-
|
||||
factor(Id,_FList,_FV,Phi,_Constraints),
|
||||
writeln(factor(Id,_FList,_FV,_Phi,_Constraints)),
|
||||
factor(_Type,Id,_FList,_FV,Phi,_Constraints),
|
||||
writeln(factor(_Type,Id,_FList,_FV,_Phi,_Constraints)),
|
||||
( is_list(Phi) -> Out = Phi ; call(user:Phi, Out) ).
|
||||
|
||||
|
||||
new_pfl_parameters(Id, NewPhi) :-
|
||||
retract(factor(Id,FList,FV,_Phi,Constraints)),
|
||||
assert(factor(Id,FList,FV,NewPhi,Constraints)),
|
||||
retract(factor(Type.Id,FList,FV,_Phi,Constraints)),
|
||||
assert(factor(Type,Id,FList,FV,NewPhi,Constraints)),
|
||||
fail.
|
||||
new_pfl_parameters(_Id, _NewPhi).
|
||||
|
||||
get_pfl_factor_sizes(Id, DSizes) :-
|
||||
factor(Id, FList, _FV, _Phi, _Constraints),
|
||||
factor(_Type, Id, FList, _FV, _Phi, _Constraints),
|
||||
get_sizes(FList, DSizes).
|
||||
|
||||
get_sizes([], []).
|
||||
@@ -133,11 +167,11 @@ get_sizes(Key.FList, Sz.DSizes) :-
|
||||
|
||||
% only makes sense for bayesian networks
|
||||
get_first_pvariable(Id,Var) :-
|
||||
factor(Id,Var._FList,_FV,_Phi,_Constraints).
|
||||
factor(_Type, Id,Var._FList,_FV,_Phi,_Constraints).
|
||||
|
||||
% only makes sense for bayesian networks
|
||||
get_factor_pvariable(Id,Var) :-
|
||||
factor(Id,FList,_FV,_Phi,_Constraints),
|
||||
factor(_Type, Id,FList,_FV,_Phi,_Constraints),
|
||||
member(Var, FList).
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user