diff --git a/evidence.pl b/evidence.pl index b594d23ff672a809c52c45e2335c072101b5c413..b967db319521c2808984882b15e155712ad0f763 100644 --- a/evidence.pl +++ b/evidence.pl @@ -64,16 +64,24 @@ combine([Mass1|Masses1], Masses2, RMasses, Opts) :- append(RMasses1, RMasses2, RMasses). combine1(_, [], [], _). -combine1((Set1, Mass1), [(Set2, _)|L], Result, Opts) :- +combine1((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), - combine1((Set1, Mass1), L, Result, Opts). -combine1((Set1, Mass1), [(Set2, Mass2)|L], [(RSet, RMass)|Result], Opts) :- + combine1((Label1, Set1, Mass1), L, Result, Opts). +combine1((Label1, Set1, Mass1), [(Label2, Set2, Mass2)|L], [(RLabel, RSet, RMass)|Result], Opts) :- ord_intersect(Set1, Set2, RSet), RSet \= [], % nonempty intersection case RMass is 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), - combine1((Set1, Mass1), L, Result, Opts). + combine1((Label1, Set1, Mass1), L, Result, Opts). %! normalize(+BBA, -NormBBA) is det % @@ -94,22 +102,24 @@ normalize(M1, M2) :- % % Merge duplicate sets and add their masses. merge_unique([], []). -merge_unique([(Set, M1)|B1], [(Set, M2)|B3]) :- - collect_masses_unique(Set, B1, Masses, B2), +merge_unique([(Label, Set, M1)|B1], [(Label, Set, M2)|B3]) :- + collect_masses_unique((Label, Set), B1, Masses, B2), M2 is M1 + Masses, merge_unique(B2, B3). -%! collect_masses_unique(+Set, +BBas, -Masses, -B2) is det +%! collect_masses_unique(+LabelSet, +BBas, -Masses, -B2) is det % % Masses is the sum of all masses of be belief assignments in BBAs -% concerning set Set. B2 containts the remaining assignments. +% concerning (Label, Set). B2 containts the remaining +% assignments. collect_masses_unique(_, [], 0, []). -collect_masses_unique(Set, [(Set, M1)|BBAs], Masses, FinalBBAs) :- - collect_masses_unique(Set, BBAs, M2, FinalBBAs), +collect_masses_unique((Label, Set), [(Label, Set, M1)|BBAs], Masses, FinalBBAs) :- + collect_masses_unique((Label, Set), BBAs, M2, FinalBBAs), Masses is M1 + M2. -collect_masses_unique(Set, [(S1, M1)|BBAs], Masses, [(S1, M1)|FinalBBAs]) :- - Set \== S1, - collect_masses_unique(Set, BBAs, Masses, FinalBBAs). +collect_masses_unique((Label, Set), [(Label1, S1, M1)|BBAs], Masses, [(Label1, S1, M1)|FinalBBAs]) :- + ( Set \== S1 ; Label \== Label1 + ), + collect_masses_unique((Label, Set), BBAs, Masses, FinalBBAs). %! add_all(+L, -Sum) is semidet % @@ -124,7 +134,7 @@ add_all([N|L], S) :- % % Sum is the sum of the masses in IMasses BBA sum_mass([], 0). -sum_mass([(_,M)|L], S) :- +sum_mass([(_, _, M)|L], S) :- sum_mass(L, S1), S is S1 + M. @@ -132,7 +142,7 @@ sum_mass([(_,M)|L], S) :- % % Multiply a BBA L1 by a factor F. mult(_, [], []). -mult(F, [(S1,N1)|L1], [(S1,N2)|L2]) :- +mult(F, [(Lb1, S1, N1)|L1], [(Lb1, S1, N2)|L2]) :- N2 is N1 * F, mult(F, L1, L2). @@ -171,27 +181,30 @@ global_bba2(B, [BBa|BBas], GBBA, Opts) :- % % Bel is the set of beliefs for each Bi, given the global BBA GBBA. beliefs([], _, []). -beliefs([Bi|Bis], GBBA, [(Bi, Bel)|Bels]) :- - belief(Bi, GBBA, Bel), +beliefs([Ni/Bi|Bis], GBBA, [(Ni, Bi, Bel)|Bels]) :- + belief(Ni/Bi, GBBA, Bel), beliefs(Bis, GBBA, Bels). belief(_, [], 0). -belief(Bi, [(Bj, M)|GBBA], Bel) :- +belief(Ni/Bi, [(Nj, Bj, M)|GBBA], Bel) :- ord_subset(Bj, Bi), - belief(Bi, GBBA, Bel1), + memberchk(Ni, Nj), + belief(Ni/Bi, GBBA, Bel1), Bel is M + Bel1. -belief(Bi, [(Bj, _)|GBBA], Bel) :- - \+ ord_subset(Bj, Bi), - belief(Bi, GBBA, Bel). +belief(Ni/Bi, [(Nj, Bj, _)|GBBA], Bel) :- + ( \+ ord_subset(Bj, Bi) ; \+ memberchk(Ni, Nj) ), + belief(Ni/Bi, GBBA, Bel). -%! print_beliefs(+Bels) is semidet + +%! print_beliefs(+Bels, +Assoc) is semidet +% +% essentially used for debugging. print_beliefs([]). -print_beliefs([(Bi, Bel)|Bels]) :- - format('Bel(~w)=~w~n', [Bi, Bel]), +print_beliefs([(Li, Bi, Bel)|Bels]) :- + format('Bel(~w={~w})=~w~n', [Li, Bi, Bel]), print_beliefs(Bels). - /**********************************************************************/ /* test data */ /**********************************************************************/ diff --git a/wbel.pl b/wbel.pl index fe5b68bf9cc0e9e7c0ffc8e9601ec78bd2abeaea..17516956883a47d7923d18101df105a17c89cdf4 100644 --- a/wbel.pl +++ b/wbel.pl @@ -152,14 +152,15 @@ print_raw_beliefs([(Bi, Bel)|Bels]) :- format('Bel(~w)=~w~n', [Bi, Bel]), print_raw_beliefs(Bels). -%! print_beliefs(+Bels,+Assoc) is semidet +%! print_beliefs(+Bels, +Assoc) is semidet print_beliefs([], _). -print_beliefs([(Bi, Bel)|Bels], Assoc) :- - expand_formulae(Bi, Assoc, FBi), - format('Bel(~w)=~w~n', [FBi, Bel]), +print_beliefs([(Li, Bi, Bel)|Bels], Assoc) :- + expand_formulae(Bi, Assoc, Forms), + format('Bel(~w={~w})=~w~n', [Li, Forms, Bel]), print_beliefs(Bels, Assoc). + %! print_wincl(+Bels,+Assoc) is semidet % % print sets of formulas. @@ -201,8 +202,8 @@ generate_b1(N, CountDown, [T|L], Func) :- % % collect ASP answer sets % Each answer set represent subbase of B which is maximaly consistent -% with mu. Number each base, that is, the results is a list of -% i/List terms. +% with mu. Number each base (starting from 1), that is, the results is +% a list of i/List terms. collect_results([], [], _) :- !. collect_results([as(L)|L1], [N/SL|L2], N) :- !,