This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/CLPBN/clpbn/ground_factors.yap
2012-12-17 17:57:00 +00:00

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([]).