added "lambda" masses computation (relies on integer arithmetic)

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                                                          */

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),
+    (   memberchk(lambda(true), Opts)
+    ->  global_lambda(BSelects, WinclResults, GBBA, Opts),
         trace_global_bba(GBBA, Opts, 1),
-    beliefs(WinclResults, GBBA, Beliefs),
+        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),
+    (   memberchk(lambda(true), Opts)
+    ->  global_lambda(B, Bis, GBBA, Opts),
         trace_gbba(GBBA, Opts, 1),
-    beliefs(Bis, GBBA, Beliefs),
+        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,