:- module(clpbn_aggregates, [ cpt_average/4, cpt_max/4, cpt_min/4 ]). :- use_module(library(clpbn), [{}/1]). :- use_module(library(lists), [last/2]). cpt_average(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), build_avg_table(Vars, Els, SDomain, Key, CPT). cpt_max(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), build_max_table(Vars, Els, SDomain, Key, CPT). cpt_min(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), build_min_table(Vars, Els, SDomain, Key, CPT). build_avg_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, /* case gmp is not there !! */ TabSize > 0, !, average_cpt(Vars, Domain, CPT). build_avg_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- length(Vars,L), LL1 is L//2, LL2 is L-LL1, list_split(LL1, Vars, L1, L2), Domain = [Min|Els1], last(Els1,Max), build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 0, I1), build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _), normalised_average_cpt(L, [V1,V2], Domain, CPT). build_max_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, !, max_cpt(Vars, Domain, CPT). build_max_table(Vars, Domain, Domain, Key, p(Domain, CPT, [V1,V2])) :- 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, 0, I1), build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, I1, _), max_cpt([V1,V2], Domain, CPT). build_min_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, !, min_cpt(Vars, Domain, CPT). build_min_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- 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, 0, I1), build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, I1, _), min_cpt([V1,V2], Domain, 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) :- !. build_intermediate_table(2, Op, [V1,V2], V, Key, I0, If) :- !, If is I0+1, generate_tmp_random(Op, 2, [V1,V2], V, Key, I0). build_intermediate_table(N, Op, L, V, Key, I0, If) :- 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, I1, I2), build_intermediate_table(LL2, Op, L2, V2, Key, I2, If), generate_tmp_random(Op, N, [V1,V2], V, Key, I0). % averages are transformed into sums. generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :- Lower is Min*N, Upper is Max*N, generate_list(Lower, Upper, Nbs), sum_cpt([V1,V2], Nbs, 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). % allow quick description for a range. check_domain([I0|Is], [I0|Is]) :- integer(I0), check_integer_domain(Is,I0), !. check_domain(D, ND) :- normalise_domain(D, 0, ND). check_integer_domain([],_). check_integer_domain([I1|Is],I0) :- I0 < I1, check_integer_domain(Is,I1). normalise_domain([], _, []). normalise_domain([_|D], I0, [I0|ND]) :- I is I0+1, normalise_domain(D, I, ND). % % generate actual table, instead of trusting the solver % average_cpt(Vs,Vals,CPT) :- generate_indices(Vals,Inds,0,Av), combine_all(Vs, Inds, Cs), length(Vs, Max), average_possible_cases(0, Av, Max, Cs, CPT). sum_cpt(Vs, Vals, CPT) :- length(Vals,Sz), combine_all(Vs, Cs), sum_possible_cases(0, Sz, Cs, CPT). normalised_average_cpt(Max, Vs, Vals, CPT) :- generate_indices(Vals,_,0,Sz), combine_all(Vs, Cs), average_possible_cases(0, Sz, Max, Cs, CPT). generate_indices([],[],Av,Av). generate_indices([_|Ls],[I|Inds],I,Av) :- I1 is I+1, generate_indices(Ls,Inds,I1,Av). combine_all([], [[]]). combine_all([V|LV], Cs) :- combine_all(LV, Cs0), get_dist_size(V,Sz), generate_indices(0, Sz, Vals), add_vals(Vals, Cs0, Cs). combine_all([], _, [[]]). combine_all([_|LV], Vals, Cs) :- combine_all(LV, Vals, Cs0), add_vals(Vals, Cs0, Cs). generate_indices(Sz,Sz,[]) :- !. generate_indices(I0,Sz,[I0|Vals]) :- I is I0+1, generate_indices(I,Sz,Vals). add_vals([], _, []). add_vals([V|Vs], Cs0, Csf) :- add_vals(Vs, Cs0, Cs), add_val_to_cases(Cs0, V, Cs, Csf). add_val_to_cases([], _, Cs, Cs). add_val_to_cases([C|Cs], V, Cs0, [[V|C]|Csf]) :- add_val_to_cases(Cs, V, Cs0, Csf). sum_all([],N,N). sum_all([C|Cs],N0,N) :- X is C+N0, sum_all(Cs,X,N). average_possible_cases(Av,Av,_,_,[]) :- !. average_possible_cases(I,Av,Max,Cs,Lf) :- average_cases2(Cs,I,Max,Lf,L0), I1 is I+1, average_possible_cases(I1,Av,Max,Cs,L0). average_cases2([], _, _, L, L). average_cases2([C|Cs], I, Av, [P|Lf], L0) :- calculate_avg_prob(C, I, Av, P), average_cases2(Cs, I, Av, Lf, L0). calculate_avg_prob(C, I, Av, 1.0) :- sum_all(C,0,N), I =:= integer(round(N/Av)), !. calculate_avg_prob(_, _, _, 0.0). sum_possible_cases(Av,Av,_,[]) :- !. sum_possible_cases(I,Av,Cs,Lf) :- sum_cases2(Cs,I,Lf,L0), I1 is I+1, sum_possible_cases(I1,Av,Cs,L0). sum_cases2([], _, L, L). sum_cases2([C|Cs], I, [P|Lf], L0) :- calculate_sum_prob(C, I, P), sum_cases2(Cs, I, Lf, L0). calculate_sum_prob(C, I, 1.0) :- sum_all(C,0,N), I =:= N, !. calculate_sum_prob(_, _, 0.0). % % generate a CPT for max. % max_cpt(Vs, Domain, CPT) :- combinations(Vs, Domain, Combinations), cpt_from_domain(Domain, Combinations, Domain, max, CPT). min_cpt(Vs, Domain, CPT) :- combinations(Vs, Domain, Combinations), cpt_from_domain(Domain, Combinations, Domain, min, CPT). combinations(Vs, Domain, Combinations) :- mult_domains(Vs, Domain, Domains), cart(Domains, Combinations). mult_domains([], _, []). mult_domains([_|Vs], Domain, [Domain|Domains]) :- mult_domains(Vs, Domain, Domains). cart([], [[]]). cart([L|R], Rf) :- cart(R, R1), add(L, R1, Rf). add([], _, []). add([A|R], R1, RsF) :- add_head(R1, A, RsF, Rs0), add(R, R1, Rs0). add_head([], _, Rs, Rs). add_head([H|L], A, [[A|H]|Rs], Rs0) :- add_head(L, A, Rs, Rs0). cpt_from_domain([], _, _, _, []). cpt_from_domain([El|Domain], Combinations, Domain0, OP, CPT) :- cpt_from_domain_el(Combinations, El, Domain0, OP, CPT, CPT0), cpt_from_domain(Domain, Combinations, Domain0, OP, CPT0). cpt_from_domain_el([], _, _, _, CPT, CPT). cpt_from_domain_el([C|Combinations], El, Domain, OP, [P|CPT], CPT0) :- cpt_for_el(C, OP, El, Domain, 0.0, P), cpt_from_domain_el(Combinations, El, Domain, OP, CPT, CPT0). cpt_for_el([], _, _, _, P, P). cpt_for_el([El|Cs], MAX, El, Domain, _, P) :- !, cpt_for_el(Cs, MAX, El, Domain, 1.0, P). cpt_for_el([C|_], MAX, El, Domain, _, 0.0) :- op_broken(MAX, C, El, Domain), !. cpt_for_el([_|Cs], MAX, El, Domain, P0, P) :- cpt_for_el(Cs, MAX, El, Domain, P0, P). op_broken(max, C, El, Domain) :- lg(Domain, C, El). op_broken(min, C, El, Domain) :- sm(Domain, C, El). lg([El|_], _, El) :- !. lg([C|_], C, _) :- !, fail. lg([_|Vs], C, El) :- lg(Vs, C, El). sm([El|_], _, El) :- !, fail. sm([V|_], V, _) :- !. sm([_|Vs], C, El) :- sm(Vs, C, El). get_dist_size(V, Sz) :- clpbn:get_atts(V, [dist(Vals,_,_)]), length(Vals, Sz).