284 lines
8.2 KiB
Prolog
284 lines
8.2 KiB
Prolog
%
|
|
% generate explicit CPTs
|
|
%
|
|
:- module(clpbn_aggregates, [
|
|
check_for_agg_vars/2,
|
|
cpt_average/6,
|
|
cpt_average/7,
|
|
cpt_max/6,
|
|
cpt_min/6
|
|
]).
|
|
|
|
:- use_module(library(clpbn), [{}/1]).
|
|
|
|
:- use_module(library(lists),
|
|
[last/2,
|
|
sumlist/2,
|
|
sum_list/3,
|
|
max_list/2,
|
|
min_list/2,
|
|
nth0/3
|
|
]).
|
|
|
|
:- use_module(library(matrix),
|
|
[matrix_new/3,
|
|
matrix_to_list/2,
|
|
matrix_set/3]).
|
|
|
|
:- use_module(library('clpbn/dists'),
|
|
[
|
|
dist/4,
|
|
get_dist_domain_size/2]).
|
|
|
|
:- use_module(library('clpbn/matrix_cpt_utils'),
|
|
[normalise_CPT_on_lines/3]).
|
|
|
|
check_for_agg_vars([], []).
|
|
check_for_agg_vars([V|Vs0], [V|Vs1]) :-
|
|
clpbn:get_atts(V, [key(K), dist(Id,Parents)]), !,
|
|
simplify_dist(Id, V, K, Parents, Vs0, Vs00),
|
|
check_for_agg_vars(Vs00, Vs1).
|
|
check_for_agg_vars([_|Vs0], Vs1) :-
|
|
check_for_agg_vars(Vs0, Vs1).
|
|
|
|
% transform aggregate distribution into tree
|
|
simplify_dist(avg(Domain), V, Key, Parents, Vs0, VsF) :- !,
|
|
cpt_average([V|Parents], Key, Domain, NewDist, Vs0, VsF),
|
|
dist(NewDist, Id, Key, ParentsF),
|
|
clpbn:put_atts(V, [dist(Id,ParentsF)]).
|
|
simplify_dist(_, _, _, _, Vs0, Vs0).
|
|
|
|
cpt_average(AllVars, Key, Els0, Tab, Vs, NewVs) :-
|
|
cpt_average(AllVars, Key, Els0, 1.0, Tab, Vs, NewVs).
|
|
|
|
% support variables with evidence from domain. This should make everyone's life easier.
|
|
cpt_average([Ev|Vars], Key, Els0, Softness, p(Els0, CPT, NewParents), Vs, NewVs) :-
|
|
find_evidence(Vars, 0, TotEvidence, RVars),
|
|
build_avg_table(RVars, Vars, Els0, Key, TotEvidence, Softness, MAT0, NewParents0, Vs, IVs),
|
|
include_qevidence(Ev, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs),
|
|
matrix_to_list(MAT, CPT), writeln(NewParents: Vs: NewVs: CPT).
|
|
|
|
% find all fixed kids, this simplifies significantly the function.
|
|
find_evidence([], TotEvidence, TotEvidence, []).
|
|
find_evidence([V|Vars], TotEvidence0, TotEvidence, RVars) :-
|
|
clpbn:get_atts(V,[evidence(Ev)]), !,
|
|
TotEvidenceI is TotEvidence0+Ev,
|
|
find_evidence(Vars, TotEvidenceI, TotEvidence, RVars).
|
|
find_evidence([V|Vars], TotEvidence0, TotEvidence, [V|RVars]) :-
|
|
find_evidence(Vars, TotEvidence0, TotEvidence, RVars).
|
|
|
|
cpt_max([_|Vars], Key, Els0, CPT, Vs, NewVs) :-
|
|
build_max_table(Vars, Els0, Els0, Key, 1.0, CPT, Vs, NewVs).
|
|
|
|
cpt_min([_|Vars], Key, Els0, CPT, Vs, NewVs) :-
|
|
build_min_table(Vars, Els0, Els0, Key, 1.0, CPT, Vs, NewVs).
|
|
|
|
build_avg_table(Vars, OVars, Domain, _, TotEvidence, Softness, CPT, Vars, Vs, Vs) :-
|
|
length(Domain, SDomain),
|
|
int_power(Vars, SDomain, 1, TabSize),
|
|
TabSize =< 256,
|
|
/* case gmp is not there !! */
|
|
TabSize > 0, !,
|
|
average_cpt(Vars, OVars, Domain, TotEvidence, Softness, CPT).
|
|
build_avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, CPT, [V1,V2], Vs, [V1,V2|NewVs]) :-
|
|
length(Vars,L),
|
|
LL1 is L//2,
|
|
LL2 is L-LL1,
|
|
list_split(LL1, Vars, L1, L2),
|
|
Min = 0,
|
|
length(Domain,Max1), Max is Max1-1,
|
|
build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
|
|
build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
|
|
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT).
|
|
|
|
build_max_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
|
|
length(Domain, SDomain),
|
|
int_power(Vars, SDomain, 1, TabSize),
|
|
TabSize =< 16,
|
|
/* case gmp is not there !! */
|
|
TabSize > 0, !,
|
|
max_cpt(Vars, Domain, Softness, CPT).
|
|
build_max_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewVs]) :-
|
|
length(Vars,L),
|
|
LL1 is L//2,
|
|
LL2 is L-LL1,
|
|
list_split(LL1, Vars, L1, L2),
|
|
build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
|
|
build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
|
|
max_cpt([V1,V2], Domain, Softness, CPT).
|
|
|
|
build_min_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
|
|
length(Domain, SDomain),
|
|
int_power(Vars, SDomain, 1, TabSize),
|
|
TabSize =< 16,
|
|
/* case gmp is not there !! */
|
|
TabSize > 0, !,
|
|
min_cpt(Vars, Domain, Softness, CPT).
|
|
build_min_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewVs]) :-
|
|
length(Vars,L),
|
|
LL1 is L//2,
|
|
LL2 is L-LL1,
|
|
list_split(LL1, Vars, L1, L2),
|
|
build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
|
|
build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
|
|
min_cpt([V1,V2], Domain, Softness, CPT).
|
|
|
|
int_power([], _, TabSize, TabSize).
|
|
int_power([_|L], X, I0, TabSize) :-
|
|
I is I0*X,
|
|
int_power(L, X, I, TabSize).
|
|
|
|
build_intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !.
|
|
build_intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !,
|
|
If is I0+1,
|
|
generate_tmp_random(Op, 2, [V1,V2], V, Key, Softness, I0).
|
|
build_intermediate_table(N, Op, L, V, Key, Softness, I0, If, Vs, [V1,V2|NewVs]) :-
|
|
LL1 is N//2,
|
|
LL2 is N-LL1,
|
|
list_split(LL1, L, L1, L2),
|
|
I1 is I0+1,
|
|
build_intermediate_table(LL1, Op, L1, V1, Key, Softness, I1, I2, Vs, Vs1),
|
|
build_intermediate_table(LL2, Op, L2, V2, Key, Softness, I2, If, Vs1, NewVs),
|
|
generate_tmp_random(Op, N, [V1,V2], V, Key, Softness, I0).
|
|
|
|
% averages are transformed into sums.
|
|
generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :-
|
|
Lower is Min*N,
|
|
Upper is Max*N,
|
|
generate_list(Lower, Upper, Nbs),
|
|
sum_cpt([V1,V2], Nbs, Softness, CPT),
|
|
% write(sum(Nbs, CPT, [V1,V2])),nl, % debugging
|
|
{ V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }.
|
|
generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
|
|
{ V = 'MAX'(I,Key) with p(Domain,CPT,[V1,V2]) }.
|
|
generate_tmp_random(min(Domain,CPT), _, [V1,V2], V, Key, I) :-
|
|
{ V = 'MIN'(I,Key) with p(Domain,CPT,[V1,V2]) }.
|
|
|
|
generate_list(M, M, [M]) :- !.
|
|
generate_list(I, M, [I|Nbs]) :-
|
|
I1 is I+1,
|
|
generate_list(I1, M, Nbs).
|
|
|
|
list_split(0, L, [], L) :- !.
|
|
list_split(I, [H|L], [H|L1], L2) :-
|
|
I1 is I-1,
|
|
list_split(I1, L, L1, L2).
|
|
|
|
%
|
|
% if we have evidence, we need to check if we are always consistent, never consistent, or can be consistent
|
|
%
|
|
include_qevidence(V, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
|
|
clpbn:get_atts(V,[evidence(Ev)]), !,
|
|
normalise_CPT_on_lines(MAT0, MAT1, L1),
|
|
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
|
|
include_qevidence(_, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
|
|
|
|
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
|
|
sumlist(L1, Tot),
|
|
nth0(Ev, L1, Val),
|
|
(Val == Tot ->
|
|
writeln(Ev:L1:Val:1),
|
|
MAT1 = MAT,
|
|
NewParents = [],
|
|
Vs = NewVs
|
|
;
|
|
Val == 0.0 ->
|
|
writeln(Ev:L1:Val:2),
|
|
throw(error(domain_error(incompatible_evidence),evidence(Ev)))
|
|
;
|
|
writeln(Ev:L1:Val:3),
|
|
MAT0 = MAT,
|
|
NewParents = NewParents0,
|
|
IVs = NewVs
|
|
).
|
|
|
|
|
|
%
|
|
% generate actual table, instead of trusting the solver
|
|
%
|
|
|
|
average_cpt(Vs, OVars, Vals, Base, _, MCPT) :-
|
|
get_ds_lengths(Vs,Lengs),
|
|
length(OVars, N),
|
|
length(Vals, SVals),
|
|
matrix_new(floats,[SVals|Lengs],MCPT),
|
|
fill_in_average(Lengs,N,Base,MCPT).
|
|
|
|
get_ds_lengths([],[]).
|
|
get_ds_lengths([V|Vs],[Sz|Lengs]) :-
|
|
get_vdist_size(V, Sz),
|
|
get_ds_lengths(Vs,Lengs).
|
|
|
|
fill_in_average(Lengs, N, Base, MCPT) :-
|
|
generate(Lengs, Case),
|
|
average(Case, N, Base, Val),
|
|
matrix_set(MCPT,[Val|Case],1.0),
|
|
fail.
|
|
fill_in_average(_,_,_,_).
|
|
|
|
generate([], []).
|
|
generate([N|Lengs], [C|Case]) :-
|
|
from(0,N,C),
|
|
generate(Lengs, Case).
|
|
|
|
from(I,_,I).
|
|
from(I1,M,J) :-
|
|
I is I1+1,
|
|
I < M,
|
|
from(I,M,J).
|
|
|
|
average(Case, N, Base, Val) :-
|
|
sum_list(Case, Base, Tot),
|
|
Val is integer(round(Tot/N)).
|
|
|
|
|
|
sum_cpt(Vs,Vals,_,CPT) :-
|
|
get_ds_lengths(Vs,Lengs),
|
|
length(Vals,SVals),
|
|
matrix_new(floats,[SVals|Lengs],MCPT),
|
|
fill_in_sum(Lengs,MCPT),
|
|
matrix_to_list(MCPT,CPT).
|
|
|
|
fill_in_sum(Lengs,MCPT) :-
|
|
generate(Lengs, Case),
|
|
sumlist(Case, Val),
|
|
matrix_set(MCPT,[Val|Case],1.0),
|
|
fail.
|
|
fill_in_sum(_,_).
|
|
|
|
|
|
max_cpt(Vs,Vals,_,CPT) :-
|
|
get_ds_lengths(Vs,Lengs),
|
|
length(Vals,SVals),
|
|
matrix_new(floats,[SVals|Lengs],MCPT),
|
|
fill_in_max(Lengs,MCPT),
|
|
matrix_to_list(MCPT,CPT).
|
|
|
|
fill_in_max(Lengs,MCPT) :-
|
|
generate(Lengs, Case),
|
|
max_list(Case, Val),
|
|
matrix_set(MCPT,[Val|Case],1.0),
|
|
fail.
|
|
fill_in_max(_,_).
|
|
|
|
|
|
min_cpt(Vs,Vals,_,CPT) :-
|
|
get_ds_lengths(Vs,Lengs),
|
|
length(Vals,SVals),
|
|
matrix_new(floats,[SVals|Lengs],MCPT),
|
|
fill_in_max(Lengs,MCPT),
|
|
matrix_to_list(MCPT,CPT).
|
|
|
|
fill_in_min(Lengs,MCPT) :-
|
|
generate(Lengs, Case),
|
|
max_list(Case, Val),
|
|
matrix_set(MCPT,[Val|Case],1.0),
|
|
fail.
|
|
fill_in_min(_,_).
|
|
|
|
|
|
get_vdist_size(V, Sz) :-
|
|
clpbn:get_atts(V, [dist(Dist,_)]),
|
|
get_dist_domain_size(Dist, Sz).
|
|
|