diff --git a/evidence.pl b/evidence.pl index efeca6b248fbd3a7d6d60e6913b0ff03be706cb8..8d35f2c7e3ba6c669558337ea56bf91395f59451 100644 --- a/evidence.pl +++ b/evidence.pl @@ -2,7 +2,10 @@ /* a quickly hacked computation of dempster combination rule */ -:- module(evidence, [global_bba/4, beliefs/3, trace_global_bba/3]). +:- module(evidence, [ + global_bba/4, beliefs/3, trace_global_bba/3, + global_lambda/4, lambda_beliefs/3 + ]). :- use_module(library(ordsets), [ ord_intersect/3, ord_subset/2 @@ -230,8 +233,143 @@ print_set_label([S|L]) :- format('~w~w', [S, X]), print_set_label(L). +/*********************************************************************/ +/* using lambda masses instead of belief masses */ +/*********************************************************************/ +%! basic_lambda(+B, +Bis, -BBAs, +Opts) is det +% +% Compute the basic lambda assignments of subsets of B in +% collection Bis. +% +% The resulting BBAs is a list of triplets (BaseLabel, Set, Mass) +% where BaseLabel is a label denoting the Set (subbases are labeled +% with an integer starting from 1, the full base is labeled with 0). +% +% This label is present in the Bis list. Each element of this list is +% a Label/Set term where Set is a set. +% +basic_lambda(B, Bis, BBAs, Opts) :- + length(B, CardB), + basic_lambda2(B, CardB, Bis, BBAs, Opts). + +%! basic_lambda2(+B, +CardB, +Bis, -BBAs) is det +% +% Utility predicate for basic_bbas/3. +basic_lambda2(_, _, [], [], _). +basic_lambda2(B, CardB, [N/Bi|Bis], [[([N], Bi, BBABi), ([0], B, BBAB)]|BBAs], Opts) :- + length(Bi, CardBi), + BBABi #= CardBi, + BBAB #= CardB - CardBi, + trace_bba(N/Bi, N/Bi, BBABi, Opts, 1), % trace_bba should be ok. + trace_bba(N/Bi, 0/B, BBAB, Opts, 1), + basic_lambda2(B, CardB, Bis, BBAs, Opts). + +%! combine_lambdas(+M1, +M2, -M12, +Options) is det +% +% combines two lambda belief assigments (the rule is inspired +% by the Dempster rule but uses integer arithmetic. It performs no +% normalization). each member of the lists is a tuple (Set, Mass). +combine_lambda([], _, [], _). +combine_lambda([Mass1|Masses1], Masses2, RMasses, Opts) :- + combine_lambda1(Mass1, Masses2, RMasses1, Opts), + combine_lambda(Masses1, Masses2, RMasses2, Opts), + append(RMasses1, RMasses2, RMasses). + +combine_lambda1(_, [], [], _). +combine_lambda1((Label1, Set1, Mass1), [(_, Set2, _)|L], Result, Opts) :- + % empty intersection case + ord_intersect(Set1, Set2, []), % empty intersection case + trace('~w inter ~w = emptyset~n', [Set1, Set2], Opts, 2), + combine_lambda1((Label1, Set1, Mass1), L, Result, Opts). +combine_lambda1((Label1, Set1, Mass1), [(Label2, Set2, Mass2)|L], [(RLabel, RSet, RMass)|Result], Opts) :- + ord_intersect(Set1, Set2, RSet), + RSet \= [], % nonempty intersection case + RMass #= Mass1 * Mass2, + ( memberchk(0, Label1) + -> RLabel = Label2 + ; ( memberchk(0, Label2) + -> RLabel = Label1 + ; ord_union(Label1, Label2, RLabel) + ) + ), + trace('~w inter ~w = ~w : ~w~n', [Set1, Set2, RSet, RMass], Opts, 2), + combine_lambda1((Label1, Set1, Mass1), L, Result, Opts). + +%! merge_unique(+BBA1, -BBA2) is det +% +% Merge duplicate sets and add their masses. +merge_unique_lambda([], []). +merge_unique_lambda([(Label, Set, M1)|B1], [(Label, Set, M2)|B3]) :- + collect_lambda_masses_unique((Label, Set), B1, Masses, B2), + M2 #= M1 + Masses, + merge_unique(B2, B3). +%! collect_lambda_masses_unique(+LabelSet, +BBas, -Masses, -B2) is det +% +% Masses is the sum of all masses of be belief assignments in BBAs +% concerning (Label, Set). B2 containts the remaining +% assignments. +collect_lambda_masses_unique(_, [], 0, []). +collect_lambda_masses_unique((Label, Set), [(Label, Set, M1)|BBAs], Masses, FinalBBAs) :- + collect_masses_unique((Label, Set), BBAs, M2, FinalBBAs), + Masses #= M1 + M2. +collect_lambda_masses_unique((Label, Set), [(Label1, S1, M1)|BBAs], Masses, [(Label1, S1, M1)|FinalBBAs]) :- + ( Set \== S1 ; Label \== Label1 + ), + collect_lambda_masses_unique((Label, Set), BBAs, Masses, FinalBBAs). + +%! add_all(+L, -Sum) is semidet +% +% Succeed if Sum is the sum of all elements in L. L is supposed to +% contain integers. +add_all_lambda([], 0). +add_all_lambda([N|L], S) :- + add_all_lambda(L, S1), + S #= S1 + N. + +%! global_lambda(+B, +Bis, -GBBA, +Nonorm) +% +% B is the the belief base. Bis is the collection subsets of B which +% are maximal-consistent with mu (wrt set inclusion). GBBA is the +% computed global belied assignment. +% +global_lambda(B, Bis, GBBA, Opts) :- + trace('---- basic BBAs --------------------------------------~n', [], Opts, 1), + basic_lambda(B, Bis, [B1|BasicBBAs], Opts), + global_lambda2(B1, BasicBBAs, GBBA, Opts). + +%! global_bba2(+BBa, +BBas, GBBA, Opts) +% +% Each BBa is a triplet (BaseLabel, Set, Mass) +% where Base Label is a label denoting the Set (subbases are labeled +% with an integer starting from 1, the full base is labeled with 0). +global_lambda2(B, [], B, _). +global_lambda2(B, [BBa|BBas], GBBA, Opts) :- + trace('---- combining ~w & ~w -----------------------------~n', [B, BBa], Opts, 2), + combine_lambda(B, BBa, B1, Opts), + merge_unique_lambda(B1, B2), + global_lambda2(B2, BBas, GBBA, Opts). + + +%! lambda_beliefs(+Bis, +GBBA, -Bel) +% +% Bel is the set of beliefs for each Bi, given the global lambda BBA +% GBBA. +lambda_beliefs([], _, []). +lambda_beliefs([Ni/Bi|Bis], GBBA, [(Ni, Bi, Bel)|Bels]) :- + lambda_belief(Ni/Bi, GBBA, Bel), + lambda_beliefs(Bis, GBBA, Bels). + +lambda_belief(_, [], 0). +lambda_belief(Ni/Bi, [(Nj, Bj, M)|GBBA], Bel) :- + ord_subset(Bj, Bi), + memberchk(Ni, Nj), + lambda_belief(Ni/Bi, GBBA, Bel1), + Bel #= M + Bel1. +lambda_belief(Ni/Bi, [(Nj, Bj, _)|GBBA], Bel) :- + ( \+ ord_subset(Bj, Bi) ; \+ memberchk(Ni, Nj) ), + lambda_belief(Ni/Bi, GBBA, Bel). /**********************************************************************/ /* test data */ diff --git a/wbel.pl b/wbel.pl index 79f2e60c682cd6c645a1ded18e846b8ecdeb409e..a030d229d034ea39a2a0bf8c094f60f4761fa089 100644 --- a/wbel.pl +++ b/wbel.pl @@ -45,6 +45,8 @@ optspec([ 'described by a collec/1 fact, the argument', 'being a list of subsets, each subset being', 'in turn a list of elements.'])], + [opt(lambda), type(boolean), default(false), shortflags([l]), longflags([lambda]), + help(['use lambda masses instead of basic belief masses.'])], [opt(trace), type(integer), default(0), shortflags([t]), longflags([trace]), help(['trace the computation.'])] ]). @@ -98,9 +100,14 @@ full_evidence_computation(Opts, PosArgs) :- ), nb_getval(form_atom, N), generate_b(N, BSelects, f_), - global_bba(BSelects, WinclResults, GBBA, Opts), - trace_global_bba(GBBA, Opts, 1), - beliefs(WinclResults, GBBA, Beliefs), + ( memberchk(lambda(true), Opts) + -> global_lambda(BSelects, WinclResults, GBBA, Opts), + trace_global_bba(GBBA, Opts, 1), + lambda_beliefs(WinclResults, GBBA, Beliefs) + ; global_bba(BSelects, WinclResults, GBBA, Opts), + trace_global_bba(GBBA, Opts, 1), + beliefs(WinclResults, GBBA, Beliefs) + ), print_beliefs(Beliefs, Assoc). full_evidence_computation(_, PosArgs) :- [_, _] \= PosArgs, @@ -115,9 +122,14 @@ raw_evidence_computation(Opts, PosArgs) :- set_prolog_flag(prefer_rationals, true), [SetFile] = PosArgs, load_raw_collection(SetFile, B, Bis), - global_bba(B, Bis, GBBA, Opts), - trace_gbba(GBBA, Opts, 1), - beliefs(Bis, GBBA, Beliefs), + ( memberchk(lambda(true), Opts) + -> global_lambda(B, Bis, GBBA, Opts), + trace_gbba(GBBA, Opts, 1), + lambda_beliefs(Bis, GBBA, Beliefs) + ; global_bba(B, Bis, GBBA, Opts), + trace_gbba(GBBA, Opts, 1), + beliefs(Bis, GBBA, Beliefs) + ), print_raw_beliefs(Beliefs). raw_evidence_computation(_, PosArgs) :- [_] \= PosArgs,