PFL support.
This commit is contained in:
parent
e130c26c6d
commit
44cb6abcb6
@ -5,7 +5,6 @@
|
||||
set_clpbn_flag/2,
|
||||
clpbn_flag/3,
|
||||
clpbn_key/2,
|
||||
clpbn_language/1,
|
||||
clpbn_init_solver/4,
|
||||
clpbn_run_solver/3,
|
||||
clpbn_finalize_solver/1,
|
||||
@ -14,6 +13,7 @@
|
||||
clpbn_init_graph/1,
|
||||
probability/2,
|
||||
conditional_probability/3,
|
||||
use_parfactors/1,
|
||||
op( 500, xfy, with)]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
@ -118,7 +118,7 @@
|
||||
[clpbn2gviz/4]).
|
||||
|
||||
:- use_module(clpbn/ground_factors,
|
||||
[generate_bn/2]).
|
||||
[generate_network/4]).
|
||||
|
||||
|
||||
:- dynamic solver/1,output/1,use/1,suppress_attribute_display/1, parameter_softening/1, em_solver/1, use_parfactors/1.
|
||||
@ -147,9 +147,6 @@ clpbn_flag(output,Before,After) :-
|
||||
clpbn_flag(solver,Before,After) :-
|
||||
retract(solver(Before)),
|
||||
assert(solver(After)).
|
||||
clpbn_flag(language,Before,After) :-
|
||||
retract(clpbn_language(Before)),
|
||||
assert(clpbn_language(After)).
|
||||
clpbn_flag(em_solver,Before,After) :-
|
||||
retract(em_solver(Before)),
|
||||
assert(em_solver(After)).
|
||||
@ -253,10 +250,12 @@ project_attributes(GVars, AVars0) :-
|
||||
).
|
||||
project_attributes(_, _).
|
||||
|
||||
generate_vars(GVars, _, NewAVars) :-
|
||||
generate_vars(GVars, _, _NewAVars) :-
|
||||
use_parfactors(on),
|
||||
clpbn_flag(solver, Solver), Solver \= fove, !,
|
||||
generate_bn(GVars, NewAVars).
|
||||
generate_network(GVars, Keys, Factors, Evidence),
|
||||
writeln(network(GVars, Keys, Factors, Evidence)),
|
||||
halt.
|
||||
generate_vars(_GVars, AVars, AVars).
|
||||
|
||||
clpbn_vars(AVars, DiffVars, AllVars) :-
|
||||
@ -560,18 +559,5 @@ match_probability([p(V0=C)=Prob|_], C, V, Prob) :-
|
||||
match_probability([_|Probs], C, V, Prob) :-
|
||||
match_probability(Probs, C, V, Prob).
|
||||
|
||||
:- dynamic clpbn_language/1.
|
||||
|
||||
pfl_not_clpbn :-
|
||||
clpbn_language(clpbn), !,
|
||||
throw(error(pfl('should be called before clpbn'))).
|
||||
pfl_not_clpbn :-
|
||||
assert(clpbn_language(pfl)).
|
||||
|
||||
clpbn_not_pfl :-
|
||||
clpbn_language(pfl), !.
|
||||
clpbn_not_pfl :-
|
||||
assert(clpbn_language(clpbn)).
|
||||
|
||||
:- clpbn_not_pfl.
|
||||
:- use_parfactors(on) -> true ; assert(use_parfactors(off)).
|
||||
|
||||
|
@ -8,7 +8,6 @@
|
||||
:- module(clpbn_bp,
|
||||
[bp/3,
|
||||
check_if_bp_done/1,
|
||||
set_horus_flag/2,
|
||||
init_bp_solver/4,
|
||||
run_bp_solver/3,
|
||||
finalize_bp_solver/1
|
||||
@ -31,12 +30,12 @@
|
||||
[check_for_agg_vars/2]).
|
||||
|
||||
|
||||
:- use_module(library(clpbn/horus)).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(charsio)).
|
||||
|
||||
:- use_module(horus).
|
||||
|
||||
:- attribute id/1.
|
||||
|
||||
|
||||
|
@ -31,13 +31,16 @@
|
||||
|
||||
:- use_module(library(lists),[nth0/3,append/3]).
|
||||
|
||||
:- use_module(library(clpbn),
|
||||
[use_parfactors/1]).
|
||||
|
||||
:- use_module(library(matrix),
|
||||
[matrix_new/4,
|
||||
matrix_new/3,
|
||||
matrix_to_list/2,
|
||||
matrix_to_logs/1]).
|
||||
|
||||
:- use_module(library('clpbn/matrix_cpt_utils'),
|
||||
:- use_module(library(clpbn/matrix_cpt_utils),
|
||||
[random_CPT/2,
|
||||
uniform_CPT/2]).
|
||||
|
||||
@ -226,7 +229,7 @@ get_dist_params(Id, Parms) :-
|
||||
recorded(clpbn_dist_db, db(Id, _, Parms, _, _, _, _), _).
|
||||
|
||||
get_dist_domain_size(DistId, DSize) :-
|
||||
clpbn:clpbn_language(pfl), !,
|
||||
use_parfactors(on), !,
|
||||
pfl:get_pfl_parameters(DistId, Dist),
|
||||
length(Dist, DSize).
|
||||
get_dist_domain_size(avg(D,_), DSize) :- !,
|
||||
@ -240,7 +243,7 @@ get_dist_domain(Id, Domain) :-
|
||||
recorded(clpbn_dist_db, db(Id, _, _, _, Domain, _, _), _).
|
||||
|
||||
get_dist_key(Id, Key) :-
|
||||
clpbn:clpbn_language(pfl), !,
|
||||
use_parfactors(on), !,
|
||||
pfl:get_first_pvariable(Id, Key).
|
||||
get_dist_key(Id, Key) :-
|
||||
recorded(clpbn_dist_db, db(Id, Key, _, _, _, _, _), _).
|
||||
@ -273,7 +276,7 @@ get_evidence_from_position(El, Id, Pos) :-
|
||||
dist_to_term(_Id,_Term).
|
||||
|
||||
empty_dist(Dist, TAB) :-
|
||||
clpbn:clpbn_language(pfl), !,
|
||||
use_parfactors(on), !,
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes),
|
||||
matrix_new(floats, DSizes, TAB).
|
||||
empty_dist(Dist, TAB) :-
|
||||
@ -283,7 +286,7 @@ empty_dist(Dist, TAB) :-
|
||||
throw(error(domain_error(no_distribution,Dist),empty_dist(Dist,TAB))).
|
||||
|
||||
dist_new_table(DistId, NewMat) :-
|
||||
clpbn:clpbn_language(pfl), !,
|
||||
use_parfactors(on), !,
|
||||
matrix_to_list(NewMat, List),
|
||||
pfl:set_pfl_parameters(DistId, List).
|
||||
dist_new_table(Id, NewMat) :-
|
||||
@ -314,7 +317,7 @@ randomise_all_dists.
|
||||
|
||||
randomise_dist(Dist) :-
|
||||
(
|
||||
clpbn:clpbn_language(pfl)
|
||||
use_parfactors(on)
|
||||
->
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
;
|
||||
@ -330,7 +333,7 @@ uniformise_all_dists.
|
||||
|
||||
uniformise_dist(Dist) :-
|
||||
(
|
||||
clpbn:clpbn_language(pfl)
|
||||
use_parfactors(on)
|
||||
->
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
;
|
||||
|
@ -8,7 +8,6 @@
|
||||
:- module(clpbn_fove,
|
||||
[fove/3,
|
||||
check_if_fove_done/1,
|
||||
set_horus_flag/2,
|
||||
init_fove_solver/4,
|
||||
run_fove_solver/3,
|
||||
finalize_fove_solver/1
|
||||
@ -24,7 +23,7 @@
|
||||
|
||||
|
||||
:- use_module(library(pfl),
|
||||
[factor/5,
|
||||
[factor/6,
|
||||
skolem/2
|
||||
]).
|
||||
|
||||
@ -69,7 +68,7 @@ get_parfactors(Factors) :-
|
||||
findall(F, is_factor(F), Factors).
|
||||
|
||||
is_factor(pf(Id, Ks, Rs, Phi, Tuples)) :-
|
||||
factor(Id, Ks, Vs, Table, Constraints),
|
||||
factor(_Type, Id, Ks, Vs, Table, Constraints),
|
||||
get_ranges(Ks,Rs),
|
||||
Table \= avg,
|
||||
gen_table(Table, Phi),
|
||||
|
@ -8,31 +8,39 @@
|
||||
|
||||
|
||||
:- module(clpbn_ground_factors, [
|
||||
generate_bn/2,
|
||||
ground_parfactors/1]).
|
||||
generate_network/4]).
|
||||
|
||||
:- use_module(library(bhash), [
|
||||
b_hash_new/1,
|
||||
b_hash_lookup/3,
|
||||
b_hash_insert/4]).
|
||||
|
||||
:- use_module(library(lists), [
|
||||
delete/3,
|
||||
member/2]).
|
||||
|
||||
:- use_module(library(pfl), [
|
||||
factor/5,
|
||||
factor/6,
|
||||
defined_in_factor/2,
|
||||
skolem/2]).
|
||||
|
||||
:- use_module(library(clpbn/dists), [
|
||||
dist/4]).
|
||||
|
||||
:- dynamic currently_defined/1, f/3.
|
||||
|
||||
%
|
||||
% generate a CLP(BN) network that can be run in CLP(BN).
|
||||
%
|
||||
generate_bn(QueryVars, AllAttVars) :-
|
||||
generate_network(QueryVars, Keys, Factors, Evidence) :-
|
||||
attributes:all_attvars(AVars),
|
||||
b_hash_new(H0),
|
||||
check_for_evidence(AVars, EVars),
|
||||
run_through_factors(QueryVars, H0, H1, AllAttVars, IVars),
|
||||
run_through_factors(EVars, H1, _HF, IVars, []).
|
||||
retractall(currently_defined(_)),
|
||||
retractall(f(_,_,_)),
|
||||
initialize_evidence(EVars),
|
||||
findall(K, currently_defined(K), Evidence),
|
||||
run_through_factors(QueryVars),
|
||||
run_through_factors(EVars),
|
||||
findall(K, currently_defined(K), Keys),
|
||||
findall(f(FType,FKeys,FCPT), f(FType,FKeys,FCPT), Factors),
|
||||
listing(f).
|
||||
|
||||
check_for_evidence(V.AVars, V.EVars) :-
|
||||
clpbn:get_atts(V,[evidence(_E)]), !,
|
||||
@ -41,192 +49,38 @@ check_for_evidence(_V.AVars, EVars) :-
|
||||
check_for_evidence(AVars, EVars).
|
||||
check_for_evidence([], []).
|
||||
|
||||
run_through_factors([], H, H) --> [].
|
||||
run_through_factors(V.Vars, H0, HF) -->
|
||||
{ clpbn:get_atts(V,[key(K)]),
|
||||
b_hash_lookup(K,V,H0)
|
||||
}, !,
|
||||
run_through_factors(Vars, H0, HF).
|
||||
run_through_factors(V.Vars, H0, HF) -->
|
||||
% it is a new clpbn variable
|
||||
[V],
|
||||
{
|
||||
% should already have a key
|
||||
clpbn:get_atts(V,[key(K)]),
|
||||
% insert it into a table of seen variables
|
||||
b_hash_insert(H0,K,V,HI),
|
||||
construct_clpbn_node(K, V, HI, MoreVars, Vars)
|
||||
},
|
||||
run_through_factors(MoreVars, HI, HF).
|
||||
run_through_factors([]).
|
||||
run_through_factors([Var|_QueryVars]) :-
|
||||
clpbn:get_atts(Var,[key(K)]),
|
||||
find_factors(K),
|
||||
fail.
|
||||
run_through_factors([_|QueryVars]) :-
|
||||
run_through_factors(QueryVars).
|
||||
|
||||
% aggregates are special.
|
||||
construct_clpbn_node(K, V, HI) -->
|
||||
% and get the corresponding factor
|
||||
{ factor(_Id, [K|Ks], _, avg, Constraints) }, !,
|
||||
{
|
||||
skolem(K, Domain),
|
||||
dist(avg(Domain, Parents), DistId, K, Parents),
|
||||
clpbn:put_atts(V,[dist(DistId,Parents)]),
|
||||
% we also need to set the constraints
|
||||
% this should set all the keys to rights
|
||||
run(Constraints)
|
||||
},
|
||||
% now let's look up parents and set up the graph
|
||||
run_bayesian_factor(Ks, HI, Parents, []).
|
||||
construct_clpbn_node(K, V, HI) -->
|
||||
{
|
||||
% and get the corresponding factor
|
||||
factor(Id, [K|Ks], _, _Phi, Constraints),
|
||||
factor_to_dist(Id, DistId),
|
||||
% and the dist constraint
|
||||
clpbn:put_atts(V,[dist(DistId,Parents)]),
|
||||
% we also need to set the constraints
|
||||
% this should set all the keys to rights
|
||||
run(Constraints)
|
||||
},
|
||||
% now let's look up parents and set up the graph
|
||||
run_bayesian_factor(Ks, HI, Parents, []).
|
||||
initialize_evidence([]).
|
||||
initialize_evidence([V|EVars]) :-
|
||||
clpbn:get_atts(V, [key(K)]),
|
||||
assert(currently_defined(K)),
|
||||
initialize_evidence(EVars).
|
||||
|
||||
factor_to_dist(Id, NewId) :-
|
||||
factor(Id, [K|Ks], _, Phi, _Constraints),
|
||||
skolem(K, Domain),
|
||||
( is_list(Phi)
|
||||
->
|
||||
CPT = Phi
|
||||
;
|
||||
call(user:Phi, CPT)
|
||||
),
|
||||
keys_to_sizes(Ks, Szs),
|
||||
dist(p(Domain, CPT, Szs), NewId, K, Szs).
|
||||
|
||||
keys_to_sizes([], []).
|
||||
keys_to_sizes(K.Ks, Sz.Szs) :-
|
||||
skolem(K, Domain),
|
||||
length(Domain, Sz),
|
||||
keys_to_sizes(Ks, Szs).
|
||||
%
|
||||
% gets key K, and collects factors that define it
|
||||
find_factors(K) :-
|
||||
assert(currently_defined(K)),
|
||||
defined_in_factor(K, ParFactor),
|
||||
add_factor(ParFactor, Ks),
|
||||
member(K1, Ks),
|
||||
\+ currently_defined(K1),
|
||||
find_factors(K1).
|
||||
|
||||
add_factor(factor(Type, _Id, Ks, _, CPT, Constraints), Ks) :-
|
||||
F = f(Type, Ks, CPT),
|
||||
run(Constraints),
|
||||
\+ f(Type, Ks, CPT),
|
||||
assert(F).
|
||||
|
||||
run([Goal|Goals]) :-
|
||||
call(user:Goal),
|
||||
run(Goals).
|
||||
run([]).
|
||||
run(Goal.Constraints) :-
|
||||
user:Goal, !,
|
||||
run(Constraints).
|
||||
|
||||
run_bayesian_factor([], _H, Vs, Vs) --> [].
|
||||
run_bayesian_factor(K.Ks, H, Vs, Vs0) -->
|
||||
run_var(K, H, Vs, Vs1),
|
||||
run_bayesian_factor(Ks, H, Vs1, Vs0).
|
||||
|
||||
%
|
||||
% this function returns a list of *new* variables
|
||||
%
|
||||
% collection of random variables
|
||||
run_var(avg(Els), H, Vs, Vs0) --> !,
|
||||
run_vars(Els, H, Vs, Vs0).
|
||||
% existing random variable
|
||||
run_var(K, H, V.Vs, Vs) -->
|
||||
{ b_hash_lookup(K,V,H) }, !.
|
||||
% new random variable
|
||||
run_var(K, _H, V.Vs, Vs) -->
|
||||
[V],
|
||||
{
|
||||
clpbn:put_atts(V,[key(K)])
|
||||
}.
|
||||
|
||||
run_vars([], _H, Vs, Vs) --> [].
|
||||
run_vars(K.Els, H, Vs, Vs0) -->
|
||||
run_var(K, H, Vs, VsI),
|
||||
run_vars(Els, H, VsI, Vs0).
|
||||
|
||||
ground_parfactors(ParFactors) :-
|
||||
findall(Factor, factor(Factor), SourceFactors),
|
||||
run_all_parfactors(SourceFactors, ParFactors).
|
||||
|
||||
factor(Factor) :-
|
||||
user:parfactor(Factor).
|
||||
factor(Factor) :-
|
||||
user:bayes(Factor).
|
||||
|
||||
run_all_parfactors([], []).
|
||||
run_all_parfactors(Source.SourceFactors, Factor.ParFactors) :-
|
||||
run_parfactors(Source, Factor),
|
||||
run_all_parfactors(SourceFactors, ParFactors).
|
||||
|
||||
run_parfactors((Formula ; Phi ; ConstraintGenerator), parfactor(Formula, Phi, FV, Domain, NewConstraints)) :-
|
||||
term_variables(Formula, FreeVars),
|
||||
FV =.. fv(FreeVars),
|
||||
evaluate_constraints(FV, ConstraintGenerator, NewConstraints, Domain).
|
||||
|
||||
evaluate_constraints(FreeVars, Constraint.ConstraintGenerators, NC, Domain) :-
|
||||
functor(FreeVars, fv, NOf),
|
||||
setof(FreeVars, user:Constraint, Bindings),
|
||||
run_free_vars(0, NOf, FreeVars, Bindings, Domain, Domain0),
|
||||
get_list_of_conditions(Domain, 0, N, Conditions),
|
||||
add_extra_constraints(N, Conditions, Bindings, NC, NC0),
|
||||
evaluate_constraints(FreeVars, ConstraintGenerators, NC0, Domain0).
|
||||
evaluate_constraints(_FreeVars, [], []).
|
||||
|
||||
run_free_vars(N, N, _FreeVars, _Bindings) --> !.
|
||||
run_free_vars(I0, N, FreeVars, Bindings) -->
|
||||
{ I is I0+1,
|
||||
arg(I, FreeVars, V),
|
||||
Bindings = B._,
|
||||
arg(I, B, C), ground(C)
|
||||
}, !,
|
||||
{ setof(C, check_val(Bindings, I, C), Dom) },
|
||||
[domain(I,V,Dom)],
|
||||
run_free_vars(I, N, FreeVars, Bindings).
|
||||
run_free_vars(I0, N, FreeVars, Bindings) -->
|
||||
I is I0+1,
|
||||
run_free_vars(I, N, FreeVars, Bindings).
|
||||
|
||||
add_extra_constraints(0, [], _Bindings) --> !.
|
||||
add_extra_constraints(1, _Conditions, _Bindings) --> !.
|
||||
add_extra_constraints(N, Conditions, Bindings) -->
|
||||
{ extract_unique(Conditions, NewConditions) }, !,
|
||||
{ N1 is N-1 },
|
||||
add_extra_constraints(N1, NewConditions, Bindings).
|
||||
add_extra_constraints(N, [dom(I1,V1,Dom1),dom(I2,V2,Dom2)|Conditions], Bindings) -->
|
||||
{ length(Dom1, Sz), length(Dom2, Sz) }, !,
|
||||
{ N1 is N-2 },
|
||||
{ generate_map(Bindings, I1, I2, Mapping) },
|
||||
[map(V1,V2,Mapping)],
|
||||
add_extra_constraints(N1, dom(I1,V1,Dom1).Conditions, Bindings).
|
||||
add_extra_constraints(_N, Conditions, Bindings) -->
|
||||
[or(Vs,Or)],
|
||||
{ gather_vs(Conditions, Vs, Indices),
|
||||
generate(Bindings, Indices, Or) }.
|
||||
|
||||
% domain is a singleton constant
|
||||
extract_unique(domain(_,_,[_]).Conditions, Conditions) :- !.
|
||||
extract_unique(_.Conditions, NewConditions) :-
|
||||
extract_unique(Conditions, NewConditions).
|
||||
|
||||
get_list_of_conditions([], N, N, []).
|
||||
get_list_of_conditions(Dom._, N, N, _Conditions) :-
|
||||
var(Dom), !.
|
||||
get_list_of_conditions(Dom.Domain, I0, N, Dom.Conditions) :-
|
||||
I is I0+1,
|
||||
get_list_of_conditions(Domain, I, N, Conditions).
|
||||
|
||||
check_val(B._Bindings, I, C) :-
|
||||
arg(I, B, C).
|
||||
check_val(_.Bindings, I, C) :-
|
||||
check_val(Bindings, I, C).
|
||||
|
||||
generate_map(B.Bindings, I1, I2, [[A1|A2]|Mapping]) :-
|
||||
arg(I1, B, A1),
|
||||
arg(I2, B, A2),
|
||||
generate_map(Bindings, I1, I2, Mapping).
|
||||
|
||||
gather_vs([], [], []).
|
||||
gather_vs(domain(I,V,_).Conditions, V.Vs, I.Indices) :-
|
||||
gather_vs(Conditions, Vs, Indices).
|
||||
|
||||
generate([], _, []).
|
||||
generate(B.Bindings, Indices, O.Or) :-
|
||||
generate_el(B, Indices, O),
|
||||
generate(Bindings, Indices, Or).
|
||||
|
||||
generate_el(_B, [], []).
|
||||
generate_el(B, I.Indices, A.O) :-
|
||||
arg(I, B, A),
|
||||
generate_el(B, Indices, O).
|
||||
|
@ -13,4 +13,13 @@
|
||||
free_parfactor_graph/1
|
||||
]).
|
||||
|
||||
:- load_foreign_files(['horus'], [], init_predicates).
|
||||
patch_things_up :-
|
||||
assert_static(clpbn_horus:set_horus_flag(_,_)).
|
||||
|
||||
warning :-
|
||||
format(user_error,"Horus library not installed: cannot use bp, fove~n.",[]).
|
||||
|
||||
:- catch(load_foreign_files(['horus'], [], init_predicates), _, patch_things_up) -> true ; warning.
|
||||
|
||||
|
||||
|
||||
|
@ -412,7 +412,7 @@ registration(r52,c27,s16).
|
||||
registration(r53,c26,s16).
|
||||
registration(r54,c6,s17).
|
||||
registration(r55,c27,s17).
|
||||
%registration(r56,c0,s17).
|
||||
registration(r56,c0,s17).
|
||||
registration(r57,c51,s18).
|
||||
registration(r58,c63,s18).
|
||||
registration(r59,c41,s18).
|
||||
@ -425,7 +425,7 @@ registration(r65,c22,s20).
|
||||
registration(r66,c43,s20).
|
||||
registration(r67,c17,s21).
|
||||
registration(r68,c34,s21).
|
||||
%registration(r69,c0,s21).
|
||||
registration(r69,c0,s21).
|
||||
registration(r70,c42,s22).
|
||||
registration(r71,c7,s22).
|
||||
registration(r72,c46,s22).
|
||||
@ -515,7 +515,7 @@ registration(r155,c57,s46).
|
||||
registration(r156,c25,s46).
|
||||
registration(r157,c46,s46).
|
||||
registration(r158,c15,s46).
|
||||
%registration(r159,c0,s47).
|
||||
registration(r159,c0,s47).
|
||||
registration(r160,c33,s47).
|
||||
registration(r161,c30,s47).
|
||||
registration(r162,c55,s47).
|
||||
@ -544,7 +544,7 @@ registration(r184,c50,s54).
|
||||
registration(r185,c43,s54).
|
||||
registration(r186,c55,s54).
|
||||
registration(r187,c14,s55).
|
||||
%registration(r188,c0,s55).
|
||||
registration(r188,c0,s55).
|
||||
registration(r189,c31,s55).
|
||||
registration(r190,c47,s55).
|
||||
registration(r191,c50,s56).
|
||||
@ -600,7 +600,7 @@ registration(r240,c20,s71).
|
||||
registration(r241,c18,s71).
|
||||
registration(r242,c38,s71).
|
||||
registration(r243,c37,s72).
|
||||
%registration(r244,c0,s72).
|
||||
registration(r244,c0,s72).
|
||||
registration(r245,c62,s72).
|
||||
registration(r246,c47,s73).
|
||||
registration(r247,c53,s73).
|
||||
@ -1140,7 +1140,7 @@ registration(r780,c51,s233).
|
||||
registration(r781,c8,s233).
|
||||
registration(r782,c58,s233).
|
||||
registration(r783,c14,s234).
|
||||
registration(r784,c0,s234).
|
||||
%registration(r784,c0,s234).
|
||||
registration(r785,c23,s234).
|
||||
registration(r786,c59,s234).
|
||||
registration(r787,c5,s235).
|
||||
@ -1161,7 +1161,7 @@ registration(r801,c45,s239).
|
||||
registration(r802,c47,s239).
|
||||
registration(r803,c7,s240).
|
||||
registration(r804,c4,s240).
|
||||
registration(r805,c0,s240).
|
||||
%registration(r805,c0,s240).
|
||||
registration(r806,c54,s240).
|
||||
registration(r807,c9,s240).
|
||||
registration(r808,c11,s241).
|
||||
@ -1169,7 +1169,7 @@ registration(r809,c29,s241).
|
||||
registration(r810,c45,s241).
|
||||
registration(r811,c58,s241).
|
||||
registration(r812,c48,s242).
|
||||
registration(r813,c0,s242).
|
||||
%registration(r813,c0,s242).
|
||||
registration(r814,c51,s242).
|
||||
registration(r815,c12,s243).
|
||||
registration(r816,c24,s243).
|
||||
@ -1212,6 +1212,6 @@ registration(r852,c7,s254).
|
||||
registration(r853,c61,s254).
|
||||
registration(r854,c60,s255).
|
||||
registration(r855,c48,s255).
|
||||
registration(r856,c0,s255).
|
||||
%registration(r856,c0,s255).
|
||||
|
||||
|
||||
|
@ -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