(******************************************************************* This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialization Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) BeginPackage["BeliefMatrices`"] \!\(\(\(Belief::usage = \*"\"\\""\)\(\n\) \)\[IndentingNewLine] \(\(Plausibility::usage = \*"\"\\""\)\(\ \[IndentingNewLine]\) \)\n \(\(Commonality::usage = \*"\"\\""\)\(\[IndentingNewLine]\) \)\n \(\(Implicability::usage = \*"\"\\""\)\(\n\) \)\[IndentingNewLine] PignisticProbability::usage = "\"\) bba::usage= "Symbol bba represents the the basic belief assignment (also noted m \ in the litterature)"; b::usage="Symbol b represents the implicability function"; q::usage="Symbol q represents the commonality function"; bel::usage="Symbol bel represents the belief function"; pl::usage="Symbol pl represents the plausibility function"; TransformMatrix::usage= "TransformMatrix[x,y,i] is the 2^i dimensional square matrix that obtains \ x when multiplied with y. Vectors x and y are ordered according to \ usage in the belief function theory: In x\[LeftDoubleBracket]k\ \[RightDoubleBracket] , the argument k must be read in binary as a bitfield \ representing a subset of {1, ..., i}.\n Acceptable x and y are:\n bba the basic belief assignment (also noted m in the litterature),\n b the implicability function\n q the commonality function\n bel the belief function (with the convention bel[0] = 1)\n pl the plausibility function (with the convention pl[0]=1)."; betPMatrix::usage= "betPMatrix[bba,i] is the i lines, 2^i columns matrix that obtains \ pignistic betting probabilities when multiplied with the basic belief \ assigment vector."; SpecializationMatrix::usage= "SpecializationMatrix[m,i] is the 2^i dimension square Depsterian \ specialization matrix associated with the basic belief assignment m. They \ form a commutative and associative familly."; GeneralizationMatrix::usage= "GeneralizationMatrix[m,i] is the 2^i dimension square Depsterian \ generalization matrix associated with the basic belief assignment m. They \ form a commutative and associative familly."; ConditionatingMatrix::usage= "ConditionatingMatrix[k,i] is the 2^i dimension square Dempsterian \ specialization matrix conditioning with respect to subset k ."; NonInteractiveConjunction::usage= "NonInteractiveConjunction[m1, m2 , i] is the non-interactive conjunction \ of basic belief assignments m1 and m2, where i is the cardinality of the \ reference frame (the result uses m1[k] , for 0 \[LessEqual] k \[LessEqual] \ 2^i - 1 )."; NonInteractiveDisjunction::usage= "NonInteractiveDisjunction[m1, m2 , i] is the non-interactive disjunction \ of basic belief assignments m1 and m2, where i is the cardinality of the \ reference frame (the result uses m1[k] , for 0 \[LessEqual] k \[LessEqual] \ 2^i - 1 )."; AlphaJunction::usage= "AlphaJunction[m1 , m2 , i , \[Alpha] , type] is the \[Alpha]-junction of \ basic belief assignments m1 and m2, where i is the cardinality of the \ reference frame (the result uses m1[k] , for 0 \[LessEqual] k \[LessEqual] \ 2^i - 1 ), \[Alpha] is the junction parameter and type is either And for \ conjunction, or Or for disjunction."; AlphaJunctionMatrix::usage= "AlphaJunctionMatrix[m , i , \[Alpha] , type] is the \[Alpha]-junction \ matrix of basic belief assignment m, where i is the cardinality of the \ reference frame (the result uses m1[k] , for 0 \[LessEqual] k \[LessEqual] \ 2^i - 1 ), \[Alpha] is the junction parameter and type is either And for \ conjunction, or Or for disjunction."; Unspecificity::usage= "Unspecificity[m , i] is the relative unspecificity of basic belief \ assignment m, where i is the cardinality of the reference frame (the result \ uses m[k] , for 0 \[LessEqual] k \[LessEqual] 2^i - 1 ). Unspecificity is a \ generalization of cardinality."; CautiousConjunction::usage= "CautiousConjunction[m1, m2 , i] is the cautious junction of basic belief \ assignments m1 and m2, where i is the cardinality of the reference frame \ (the result uses m1[k] , for 0 \[LessEqual] k \[LessEqual] 2^i - 1 )."; Begin["`Private`"] \!\(\(\(TransformMatrix[b, bba, 0] = {1};\)\(\n\) \)\[IndentingNewLine] \(\(TransformMatrix[b, bba, i_]\ /; i > 0\ := \[IndentingNewLine]\(TransformMatrix[b, bba, i] = \[IndentingNewLine]Join[\[IndentingNewLine]Flatten /@ Transpose[{TransformMatrix[b, bba, i - 1], Table[0, {2\^\(i - 1\)}, {2\^\(i - 1\)}]}], \ \[IndentingNewLine]Flatten /@ Transpose[{TransformMatrix[b, bba, i - 1], TransformMatrix[b, bba, i - 1]}]\[IndentingNewLine]]\)\)\(\[IndentingNewLine]\) \)\n \(\(TransformMatrix[j, i_] := \(TransformMatrix[j, i] = Reverse[IdentityMatrix[2\^i]]\)\)\(\n\) \)\n \(\(TransformMatrix[q, bba, i_] := \(TransformMatrix[q, bba, i] = TransformMatrix[j, i] . \ TransformMatrix[b, bba, i] . \ TransformMatrix[j, i]\)\)\(\[IndentingNewLine]\) \)\n \(\(TransformMatrix[b, q, i_] := \(TransformMatrix[b, q, i] = TransformMatrix[b, bba, i] . \ TransformMatrix[bba, q, i]\)\)\(\n\) \)\[IndentingNewLine] \(\(TransformMatrix[bel, bba, i_] := \(TransformMatrix[bel, bba, i] = \ ReplacePart[TransformMatrix[b, bba, i] /. {1, l__} \[Rule] {0, l}, \ 1, {1, 1}]\)\)\(\n\) \)\[IndentingNewLine] \(\(TransformMatrix[pl, bba, i_] := \(TransformMatrix[pl, bba, i] = ReplacePart[\((\ Table[1, {2\^i}, {2\^i}] - TransformMatrix[j, i]\ . TransformMatrix[bel, bba, i])\)\ /. {1, l__} \[Rule] {0, l}\ , 1, {1, 1}]\)\)\(\[IndentingNewLine]\) \)\[IndentingNewLine] TransformMatrix[bba, b, i_] := \(TransformMatrix[bba, b, i] = Inverse[TransformMatrix[b, bba, i]]\)\n TransformMatrix[bba, q, i_] := \(TransformMatrix[bba, q, i] = Inverse[TransformMatrix[q, bba, i]]\)\n \(\(TransformMatrix[q, b, i_] := \(TransformMatrix[q, b, i] = Inverse[TransformMatrix[b, q, i]]\)\)\(\n\) \)\[IndentingNewLine] TransformMatrix[bba, pl, i_] := \(TransformMatrix[bba, pl, i] = Inverse[TransformMatrix[pl, bba, i]]\)\n TransformMatrix[bba, bel, i_] := \(TransformMatrix[bba, bel, i] = Inverse[TransformMatrix[bel, bba, i]]\)\) \!\(\(\(supS[i_] := Transpose[ Table[Reverse[PadLeft[IntegerDigits[k, 2], i]], {k, 0, 2\^i - 1}]]\)\(\[IndentingNewLine]\) \)\[IndentingNewLine] \(\(cardAInv[i_] := \(cardAInv[i] = Join[{0}, Table[1\/DigitCount[k, 2, 1], {k, 1, 2\^i - 1}]]\)\)\(\[IndentingNewLine]\) \)\n betPMatrix[bba, i_] := supS[i] . DiagonalMatrix[cardAInv[i]]\) \!\(Clear[vec]\n vec[bba, m_, i_] := Table[m[k], {k, 0, 2\^i - 1}]\[IndentingNewLine] vec[x_, m_, i_] := TransformMatrix[x, bba, i] . vec[bba, m, i]\) Belief[m_,i_]:=vec[bel,m,i]//Rest Plausibility[m_,i_]:=vec[pl,m,i]//Rest Commonality[m_,i_]:=vec[q,m,i]//Rest Implicability[m_,i_]:=vec[b,m,i]//Rest PignisticProbability[m_, i_]:=betPMatrix[bba,i].vec[bba,m,i] SpecializationMatrix[m_,i_]:= TransformMatrix[bba,q,i].DiagonalMatrix[vec[q,m,i]].TransformMatrix[q,bba, i] GeneralizationMatrix[m_,i_]:= TransformMatrix[bba,b,i].DiagonalMatrix[vec[b,m,i]].TransformMatrix[b,bba,i] characteristicBba[event_][x_]:=KroneckerDelta[event,x] ConditionatingMatrix[k_,i_]:=SpecializationMatrix[characteristicBba[k],i] NonInteractiveConjunction[m1_, m2_,i_]:= SpecializationMatrix[m1,i].vec[bba,m2,i] NonInteractiveDisjunction[m1_, m2_,i_]:= GeneralizationMatrix[m1,i].vec[bba,m2,i] \!\(\(\(AlphaJunction[m1_, \ m2_, i_, \[Alpha]_, \ type_\ ] := AlphaJunctionMatrix[m1, i, \[Alpha], \ type] . vec[bba, m2, i]\)\(\n\) \)\[IndentingNewLine] AlphaJunctionMatrix[m_, i_, \[Alpha]_, \ type_] := Sum[m[k]\ KMatrix[k, i, \[Alpha], type], \ {k, 0, 2\^i - 1}]\) bitUnion[a_,b_]:=BitOr[a,b] bitIntersection[a_,b_]:=BitAnd[a,b] bitSubstraction[a_,b_]:=b-a bitInQ[x_,a_]:=BitAnd[x,a]\[NotEqual]0 bitCardinal[x_]:= Plus@@RealDigits[x,2]\[LeftDoubleBracket]1\[RightDoubleBracket] (* Also used to define unspecificity *) singletonQ[x_]:=bitCardinal[x]\[Equal]1 \!\(\(\(KMatrix[compl[x_], i_, \[Alpha]_, \ And] /; \ singletonQ[x] := \[IndentingNewLine]Table[ Which[\[IndentingNewLine]\((b \[Equal] bitUnion[a, x])\)\ && \ \((\(! \ bitInQ[x, a]\))\), 1, \[IndentingNewLine]\((b \[Equal] a)\)\ && \ \((\(! \ bitInQ[x, b]\))\), \[Alpha], \[IndentingNewLine]\((a \[Equal] bitUnion[b, x])\)\ && \ \((\(! \ bitInQ[x, b]\))\), 1 - \[Alpha], \[IndentingNewLine]True, \ 0], \[IndentingNewLine]{a, 0, 2\^i - 1}, {b, 0, 2\^i - 1}]\)\(\[IndentingNewLine]\) \)\[IndentingNewLine] KMatrix[j_, i_, \[Alpha]_, And] := \[IndentingNewLine]\ IdentityMatrix[2\^i]\ . Dot @@ \((\(KMatrix[compl[#], i, \[Alpha], And] &\) /@ Select[Table[2\^k, {k, 0, i - 1}], \(! bitInQ[#, j]\) &])\)\) \!\(\(\(KMatrix[x_, i_, \[Alpha]_, Or] /; \ singletonQ[x] := \[IndentingNewLine]Table[ Which[\[IndentingNewLine]\((a \[Equal] bitUnion[b, x])\)\ && \ \((\(! \ bitInQ[x, b]\))\), 1, \[IndentingNewLine]\((b \[Equal] a)\)\ && \ \((bitInQ[x, b])\), \[Alpha], \[IndentingNewLine]\((b \[Equal] bitUnion[a, x])\)\ && \ \((\(! \ bitInQ[x, a]\))\), 1 - \[Alpha], \[IndentingNewLine]True, \ 0], \[IndentingNewLine]{a, 0, 2\^i - 1}, {b, 0, 2\^i - 1}]\)\(\[IndentingNewLine]\) \)\[IndentingNewLine] KMatrix[j_, i_, \[Alpha]_, Or] := \[IndentingNewLine]\ IdentityMatrix[2\^i]\ . Dot @@ \((\(KMatrix[#, i, \[Alpha], Or] &\) /@ Select[Table[2\^k, {k, 0, i - 1}], bitInQ[#, j] &])\)\) \!\(Unspecificity[m_, i_] := vec[bba, m, i] . Table[\ bitCardinal[k], {k, 0, 2\^i - 1}]\) \!\(\(\(CautiousConjunction[m1_, \ m2_, i_] := vec[bba, m, i] /. \(cautiousConjunctionProgram[m1, m2, i]\)\[LeftDoubleBracket]2\[RightDoubleBracket]\)\(\ \[IndentingNewLine]\) \)\[IndentingNewLine] \(\(cautiousConjunctionProgram[m1_, \ m2_, i_] := \[IndentingNewLine]\(optimum = ConstrainedMax[\[IndentingNewLine]Unspecificity[m, i], \[IndentingNewLine]constraintList[m, m1, m2, mm1, mm2, i], \[IndentingNewLine]Join[vec[bba, m, i], vec[bba, mm1, i], vec[bba, mm2, i]]\[IndentingNewLine]]\);\)\(\[IndentingNewLine]\) \)\n constraintList[m_, m1_, m2_, mm1_, mm2_, i_] := Flatten[{Table[ mm1[k] \[GreaterEqual] 0, \ {k, 0, 2\^i - 1}], \[IndentingNewLine]Table[ mm2[k] \[GreaterEqual] 0, \ {k, 0, 2\^i - 1}], \[IndentingNewLine]Sum[ mm1[k], \ {k, 0, 2\^i - 1}]\ \[Equal] \ 1\ , \[IndentingNewLine]Sum[ mm2[k], \ {k, 0, 2\^i - 1}]\ \[Equal] \ 1\ , Transpose\ [{vec[bba, m, i], nonInteractiveConjunction[m1, \ mm1, i]}] /. List[a_, b_] \[Rule] Equal[a, b], \[IndentingNewLine]Transpose\ [{vec[bba, m, i], nonInteractiveConjunction[m2, \ mm2, i]}] /. List[a_, b_] \[Rule] Equal[a, b]\[IndentingNewLine]}]\) hyperCautiousConjunction[m1_, m2_,i_]:= TransformMatrix[bba,q, i].(Transpose[{vec[q,m1,i],vec[q,m2,i]}]/.List[a_,b_]\[Rule]Min[a,b]) End[] EndPackage[]