yap-6.3/packages/CLPBN/clpbn/ground_factors.yap

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