2012-03-31 23:27:37 +01:00
|
|
|
/*******************************************************
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-05-23 19:15:23 +01:00
|
|
|
Interface to Horus Lifted Solvers. Used by:
|
2012-12-17 12:13:08 +00:00
|
|
|
- Generalized Counting First-Order Variable Elimination (GC-FOVE)
|
|
|
|
- Lifted First-Order Belief Propagation
|
|
|
|
- Lifted First-Order Knowledge Compilation
|
2012-11-22 16:33:22 +00:00
|
|
|
|
2012-03-31 23:27:37 +01:00
|
|
|
********************************************************/
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-05-23 19:15:23 +01:00
|
|
|
:- module(clpbn_horus_lifted,
|
2012-12-17 12:13:08 +00:00
|
|
|
[call_horus_lifted_solver/3,
|
|
|
|
check_if_horus_lifted_solver_done/1,
|
|
|
|
init_horus_lifted_solver/4,
|
|
|
|
run_horus_lifted_solver/3,
|
2012-12-18 12:11:45 +00:00
|
|
|
end_horus_lifted_solver/1
|
2012-12-17 12:13:08 +00:00
|
|
|
]).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-05-23 19:15:23 +01:00
|
|
|
:- use_module(horus,
|
2012-12-17 12:13:08 +00:00
|
|
|
[cpp_create_lifted_network/3,
|
|
|
|
cpp_set_parfactors_params/2,
|
|
|
|
cpp_run_lifted_solver/3,
|
|
|
|
cpp_free_lifted_network/1
|
|
|
|
]).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
:- use_module(library('clpbn/display'),
|
2012-12-17 12:13:08 +00:00
|
|
|
[clpbn_bind_vals/3]).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
:- use_module(library(pfl),
|
2012-12-17 12:13:08 +00:00
|
|
|
[factor/6,
|
|
|
|
skolem/2,
|
|
|
|
get_pfl_parameters/2
|
|
|
|
]).
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
:- use_module(library(maplist)).
|
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-11-22 16:33:22 +00:00
|
|
|
call_horus_lifted_solver(QueryVars, AllVars, Output) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
init_horus_lifted_solver(_, AllVars, _, State),
|
|
|
|
run_horus_lifted_solver(QueryVars, Solutions, State),
|
|
|
|
clpbn_bind_vals(QueryVars, Solutions, Output),
|
2012-12-18 12:11:45 +00:00
|
|
|
end_horus_lifted_solver(State).
|
2012-03-31 23:27:37 +01:00
|
|
|
|
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
init_horus_lifted_solver(_, AllVars, _, state(Network, DistIds)) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
get_parfactors(Parfactors),
|
|
|
|
get_dist_ids(Parfactors, DistIds0),
|
|
|
|
sort(DistIds0, DistIds),
|
2012-12-18 12:11:45 +00:00
|
|
|
get_observed_keys(AllVars, ObservedKeys),
|
2012-12-17 12:13:08 +00:00
|
|
|
%writeln(parfactors:Parfactors:'\n'),
|
2012-12-18 12:11:45 +00:00
|
|
|
%writeln(evidence:ObservedKeys:'\n'),
|
|
|
|
cpp_create_lifted_network(Parfactors, ObservedKeys, Network).
|
2012-11-22 16:33:22 +00:00
|
|
|
|
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
run_horus_lifted_solver(QueryVars, Solutions, state(Network, DistIds)) :-
|
|
|
|
maplist(get_query_keys, QueryVars, QueryKeys),
|
2012-12-17 12:13:08 +00:00
|
|
|
get_dists_parameters(DistIds, DistsParams),
|
2012-12-18 12:11:45 +00:00
|
|
|
%writeln(distparams1:DistsParams),
|
|
|
|
%maplist(get_pfl_parameters, DistIds,DistsParams2),
|
|
|
|
%writeln(distparams1:DistsParams2),
|
2012-12-17 12:13:08 +00:00
|
|
|
%writeln(dists:DistsParams), writeln(''),
|
2012-12-18 12:11:45 +00:00
|
|
|
cpp_set_parfactors_params(Network, DistsParams),
|
|
|
|
cpp_run_lifted_solver(Network, QueryKeys, Solutions).
|
2012-11-22 16:33:22 +00:00
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
end_horus_lifted_solver(state(Network, _)) :-
|
|
|
|
cpp_free_lifted_network(Network).
|
2012-03-31 23:27:37 +01:00
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
%
|
2012-12-18 12:11:45 +00:00
|
|
|
% Enumerate all parfactors and enumerate their domain as tuples.
|
2012-01-10 17:01:06 +00:00
|
|
|
%
|
|
|
|
% output is list of pf(
|
2012-03-31 23:27:37 +01:00
|
|
|
% Id: an unique number
|
|
|
|
% Ks: a list of keys, also known as the pf formula [a(X),b(Y),c(X,Y)]
|
|
|
|
% Vs: the list of free variables [X,Y]
|
|
|
|
% Phi: the table following usual CLP(BN) convention
|
|
|
|
% Tuples: ground bindings for variables in Vs, of the form [fv(x,y)]
|
2012-01-10 17:01:06 +00:00
|
|
|
%
|
2012-12-18 12:11:45 +00:00
|
|
|
:- table get_parfactors/1.
|
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
get_parfactors(Factors) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
findall(F, is_factor(F), Factors).
|
2012-03-31 23:27:37 +01:00
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
is_factor(pf(Id, Ks, Rs, Phi, Tuples)) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
factor(_Type, Id, Ks, Vs, Table, Constraints),
|
2012-12-18 12:11:45 +00:00
|
|
|
maplist(get_range, Ks, Rs),
|
2012-12-17 12:13:08 +00:00
|
|
|
Table \= avg,
|
|
|
|
gen_table(Table, Phi),
|
|
|
|
all_tuples(Constraints, Vs, Tuples).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
get_range(K, Range) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
skolem(K,Domain),
|
2012-12-18 12:11:45 +00:00
|
|
|
length(Domain,Range).
|
2012-03-22 11:29:46 +00:00
|
|
|
|
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
gen_table(Table, Phi) :-
|
2012-12-18 12:11:45 +00:00
|
|
|
( is_list(Table) -> Phi = Table ; call(user:Table, Phi) ).
|
2012-03-31 23:27:37 +01:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
all_tuples(Constraints, Tuple, Tuples) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
setof(Tuple, Constraints^run(Constraints), Tuples).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
|
2012-01-10 17:01:06 +00:00
|
|
|
run([]).
|
|
|
|
run(Goal.Constraints) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
user:Goal,
|
|
|
|
run(Constraints).
|
2012-01-10 17:01:06 +00:00
|
|
|
|
2012-03-22 11:29:46 +00:00
|
|
|
|
|
|
|
get_dist_ids([], []).
|
|
|
|
get_dist_ids(pf(Id, _, _, _, _).Parfactors, Id.DistIds) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
get_dist_ids(Parfactors, DistIds).
|
2012-03-22 11:29:46 +00:00
|
|
|
|
|
|
|
|
2012-12-18 12:11:45 +00:00
|
|
|
get_observed_keys([], []).
|
|
|
|
get_observed_keys(V.AllAttVars, [K:E|ObservedKeys]) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
clpbn:get_atts(V,[key(K)]),
|
|
|
|
( clpbn:get_atts(V,[evidence(E)]) ; pfl:evidence(K,E) ), !,
|
2012-12-18 12:11:45 +00:00
|
|
|
get_observed_keys(AllAttVars, ObservedKeys).
|
|
|
|
get_observed_keys(V.AllAttVars, ObservedKeys) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
clpbn:get_atts(V,[key(_K)]), !,
|
2012-12-18 12:11:45 +00:00
|
|
|
get_observed_keys(AllAttVars, ObservedKeys).
|
2012-03-22 11:29:46 +00:00
|
|
|
|
|
|
|
|
2012-11-22 16:33:22 +00:00
|
|
|
get_query_keys([], []).
|
2012-12-18 12:11:45 +00:00
|
|
|
get_query_keys(V.AttVars, K.Ks) :-
|
|
|
|
clpbn:get_atts(V,[key(K)]), !,
|
|
|
|
get_query_keys(AttVars, Ks).
|
2012-03-22 11:29:46 +00:00
|
|
|
|
|
|
|
|
|
|
|
get_dists_parameters([], []).
|
2012-03-22 19:08:36 +00:00
|
|
|
get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :-
|
2012-12-17 12:13:08 +00:00
|
|
|
get_pfl_parameters(Id, Params),
|
|
|
|
get_dists_parameters(Ids, DistsInfo).
|
2012-01-10 17:01:06 +00:00
|
|
|
|