(*******************************************************************
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 = \*"\"\<Belief[m,i] lists the   \!\(2\^i\)-1   values \
the belief function defined by the basic belief assignment  m  when the frame \
of reference has  i  elements. Belief of subset  k  is Belief[m,i]\
\[LeftDoubleBracket]k\[RightDoubleBracket], except for k=0 (the empty subset) \
in which case belief is 0.\>\""\)\(\n\)
  \)\[IndentingNewLine]
  \(\(Plausibility::usage = \*"\"\<Plausibility[m,i] lists the   \!\(2\^i\)-1 \
 values of the plausibility function defined by the basic belief assignment  \
m  when the frame of reference has  i  elements. Plausibility of subset  k  \
is Plausibility[m,i]\[LeftDoubleBracket]k\[RightDoubleBracket], except for \
k=0 (the empty subset) in which case plausibility is 0.\>\""\)\(\
\[IndentingNewLine]\)
  \)\n
  \(\(Commonality::usage = \*"\"\<Commonality[m,i] lists the  \!\(2\^i\)-1  \
values of the commonality function defined by the  basic belief assignment  m \
 when the frame of reference has  i  elements. Commonality of subset  k  is \
Commonality[m,i]\[LeftDoubleBracket]k\[RightDoubleBracket], except for k=0 \
(the empty subset) in which case commonality is \
1.\>\""\)\(\[IndentingNewLine]\)
  \)\n
  \(\(Implicability::usage = \*"\"\<Implicability[m,i]  lists the   \
\!\(2\^i\)-1  values of the commonality function defined by the  basic belief \
assignment  m  when the frame of reference has  i  elements. Implicability of \
subset  k  is  Implicability[m,i]\[LeftDoubleBracket]k\[RightDoubleBracket], \
except for k=0 (the empty subset) in which case implicability is  \
m[0].\>\""\)\(\n\)
  \)\[IndentingNewLine]
  PignisticProbability::usage = "\<PignisticProbability[m,i]  lists the  i  \
values of the pignistic probability function defined by the  basic belief \
assignment  m  when the frame of reference has  i  elements. Pignistic \
probability of outcome  k  is PignisticProbability[m,i]\[LeftDoubleBracket]k\
\[RightDoubleBracket].\>"\)

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[]