162 lines
3.2 KiB
Prolog
162 lines
3.2 KiB
Prolog
|
|
:- module(pfl_ground_factors,
|
|
[generate_network/5,
|
|
f/3
|
|
]).
|
|
|
|
:- use_module(library(bhash),
|
|
[b_hash_new/1,
|
|
b_hash_lookup/3,
|
|
b_hash_insert/4,
|
|
b_hash_to_list/2
|
|
]).
|
|
|
|
:- use_module(library(lists),
|
|
[member/2]).
|
|
|
|
:- use_module(library(maplist)).
|
|
|
|
:- use_module(library(atts)).
|
|
|
|
:- use_module(library(pfl),
|
|
[factor/6,
|
|
defined_in_factor/2,
|
|
skolem/2
|
|
]).
|
|
|
|
:- use_module(library(clpbn/aggregates),
|
|
[avg_factors/5]).
|
|
|
|
:- use_module(library(clpbn/dists),
|
|
[dist/4]).
|
|
|
|
:- dynamic currently_defined/1, queue/1, f/4.
|
|
|
|
%
|
|
% as you add query vars the network grows
|
|
% until you reach the last variable.
|
|
%
|
|
generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
|
|
init_global_search,
|
|
attributes:all_attvars(AVars),
|
|
b_hash_new(Evidence0),
|
|
foldl(include_evidence,AVars, Evidence0, Evidence1),
|
|
static_evidence(Evidence1, Evidence),
|
|
b_hash_to_list(Evidence, EList0),
|
|
maplist(pair_to_evidence,EList0, EList),
|
|
maplist(queue_evidence, EList),
|
|
foldl(run_through_query(Evidence), QueryVars, [], QueryKeys),
|
|
propagate,
|
|
collect(Keys, Factors).
|
|
|
|
%
|
|
% clean global stateq
|
|
%
|
|
init_global_search :-
|
|
retractall(queue(_)),
|
|
retractall(currently_defined(_)),
|
|
retractall(f(_,_,_)).
|
|
|
|
pair_to_evidence(K-E, K=E).
|
|
|
|
include_evidence(V, Evidence0, Evidence) :-
|
|
clpbn:get_atts(V,[key(K),evidence(E)]), !,
|
|
(
|
|
b_hash_lookup(K, E1, Evidence0)
|
|
->
|
|
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
|
|
;
|
|
b_hash_insert(Evidence0, K, E, Evidence)
|
|
).
|
|
include_evidence(_, Evidence, Evidence).
|
|
|
|
static_evidence(Evidence0, Evidence) :-
|
|
findall(Sk=Var, pfl:evidence(Sk,Var), Evs),
|
|
foldl(include_static_evidence, Evs, Evidence0, Evidence).
|
|
|
|
include_static_evidence(K=E, Evidence0, Evidence) :-
|
|
(
|
|
b_hash_lookup(K, E1, Evidence0)
|
|
->
|
|
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
|
|
;
|
|
b_hash_insert(Evidence0, K, E, Evidence)
|
|
).
|
|
|
|
|
|
queue_evidence(K=_) :-
|
|
queue_in(K).
|
|
|
|
run_through_query(Evidence, V, QueryKeys, QueryKeys) :-
|
|
clpbn:get_atts(V,[key(K)]),
|
|
b_hash_lookup(K, _, Evidence), !.
|
|
run_through_query(_Evidence, V, QueryKeys, [K|QueryKeys]) :-
|
|
clpbn:get_atts(V,[key(K)]),
|
|
queue_in(K).
|
|
|
|
collect(Keys, Factors) :-
|
|
findall(K, currently_defined(K), Keys),
|
|
findall(f(FType,FId,FKeys), f(FType,FId,FKeys), Factors).
|
|
|
|
%
|
|
% gets key K, and collects factors that define it
|
|
queue_in(K) :-
|
|
queue(K), !.
|
|
queue_in(K) :-
|
|
% writeln(q+K),
|
|
assert(queue(K)),
|
|
fail.
|
|
queue_in(_).
|
|
|
|
propagate :-
|
|
retract(queue(K)),!,
|
|
do_propagate(K).
|
|
propagate.
|
|
|
|
do_propagate(K) :-
|
|
%writeln(-K),
|
|
\+ currently_defined(K),
|
|
( ground(K) -> assert(currently_defined(K)) ; true),
|
|
(
|
|
defined_in_factor(K, ParFactor),
|
|
add_factor(ParFactor, Ks)
|
|
*->
|
|
true
|
|
;
|
|
throw(error(no_defining_factor(K)))
|
|
),
|
|
member(K1, Ks),
|
|
\+ currently_defined(K1),
|
|
queue_in(K1),
|
|
fail.
|
|
do_propagate(_K) :-
|
|
propagate.
|
|
|
|
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
|
|
% writeln(+Ks),
|
|
(
|
|
Ks = [K,Els], var(Els)
|
|
->
|
|
% aggregate factor
|
|
once(run(Constraints)),
|
|
avg_factors(K, Els, 0.0, NewKeys, NewId),
|
|
NKs = [K|NewKeys]
|
|
;
|
|
run(Constraints),
|
|
NKs = Ks,
|
|
Id = NewId
|
|
),
|
|
(
|
|
f(Type, NewId, NKs)
|
|
->
|
|
true
|
|
;
|
|
assert(f(Type, NewId, NKs))
|
|
).
|
|
|
|
run([Goal|Goals]) :-
|
|
call(user:Goal),
|
|
run(Goals).
|
|
run([]).
|
|
|