% % 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).