Sheldon Ross 10: Example 3.27 (The Ballot Problem)

Question: In an election, candidate A receives n votes, and candidate B receives m votes where n > m. Assuming that all orderings are equally likely, show that the probability that A is always ahead in the count of votes is n− mn+m


Annalytical Solution: This is a very interesting problem indeed.

Prologue: I was studying this problem about the same time there was a Tug-of-War between two candidates for a re-election. Till about the time the results were declared, the leading candidate flipped several times. The “favorite candidate of the channel” did not win at the end, but it was fun to watch the expectations change. 

The probability can be calculated by first conditioning on who gets the last vote.

Pn,m = P { A is always ahead | A gets the last vote} * P{ A gets the last vote} + P { A is always ahead | B gets the last vote} * P{ B gets the last vote}

PA>B = P { A is always ahead | A gets the last vote} * nn+m + P { A is always ahead | B gets the last vote} * mn+m

The proposition can now be proved using the induction hypothesis.

  • We verify the result that  Pn,m = n− mn+m  when n + m = 1 which means that Pn,0 = 1− 01+0 = 1
  • Then we assume that this true whenever n + 1 = k and when n + m = k + 1
  • Pn,m = ( nn+m * ( n-1-mn+m-1 ))+ ( mn+m * ( n-m+1n+m-1 ) )
  • ⇒ Pn,m n-mn+m

In summary, the result depends on the difference on the votes divided by the total votes!!


Simulation Solution

For this problem,  have chosen to do both the generation and the analysis entirely in Mathematica. I needed to modify the Some functions of the “Association” object for tracking the ballot easily. We will perform the simulation in two steps

  • Data simulation
  • Visualization

A tug of war. But who is ahead? This is often a hot topic whenever we look at election results being brought up from all the corners of a county or a larger electoral body. The simulation below has the following set up

  • There are two candidates “A” and “B”
  • There are a total of 200 voters which will be kept a constant
  • The total number of votes that each of the candidate gets would be a variable as in
    • Candidate “A” gets 10 & Candidate “B” gets 190 votes
    • Candidate “A” gets 20 & Candidate “B” gets 180 votes
    • Candidate “A” gets 30 & Candidate “B” gets 170 votes
    • Candidate “A” gets 40 & Candidate “B” gets 160 votes
    • Candidate “A” gets 50 & Candidate “B” gets 150 votes
    • Candidate “A” gets 60 & Candidate “B” gets 140 votes
    • Candidate “A” gets 70 & Candidate “B” gets 130 votes
    • Candidate “A” gets 80 & Candidate “B” gets 120 votes
    • Candidate “A” gets 90 & Candidate “B” gets 110 votes
    • Candidate “A” gets 100 & Candidate “B” gets 100 votes
    • Candidate “A” gets 110 & Candidate “B” gets 90 votes
    • Candidate “A” gets 120 & Candidate “B” gets 80 votes
    • Candidate “A” gets 130 & Candidate “B” gets 70 votes
    • Candidate “A” gets 140 & Candidate “B” gets 60 votes
    • Candidate “A” gets 150 & Candidate “B” gets 50 votes
    • Candidate “A” gets 160 & Candidate “B” gets 40 votes
    • Candidate “A” gets 170 & Candidate “B” gets 30 votes
    • Candidate “A” gets 180 & Candidate “B” gets 20 votes
    • Candidate “A” gets 190 & Candidate “B” gets 10 votes
  • I would like you to observe the following
    • The difference between the total votes that each of the candidate gets
    • The percentage of instances during the counting that higher vote candidate was “leading”
    • The number of crossovers as the difference between the total number of votes that each of the candidates gets
    • There will be a long set of still images followed by a rather long animation of 198 frames

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

————————-

Animation – this runs for a total time of 198 seconds


A thousand scenarios (or races): I have run the above for simulation for a 1000 times for each of the above cases and captured how many instances each of the candidate is ahead in the race. This is shown in the following images.

How to read the charts?

  • Every chart has three sets of points
    • A ahead of B
    • B ahead of A
    • A equal to B
  • For example, a point under the group A ahead of B
    • As the votes are coming in during the counting, how many instances was A seen to be the lead
    • The whole simulation is done for a 1000 races and the results are shown for various differences in the total votes that each candidate gets
    • Notice how the being a leader in the race, depends on the difference of votes between each of the candidates

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


Code:

AppendTo[$Path, "Drive:\\Folder_path_where_you_keep_your_libraries"];
<< utilities`;
ClearAll[ballotGenerator];

ballotGenerator[candidates_Association] :=
    Module[{total = Plus @@ Values[candidates], probabilities, keys,
      values, masterList, votes},
      keys = Keys[candidates];
      values = Values[candidates];
      masterList =
          Join @@ MapThread[ConstantArray[#1, #2] &, {keys, values}];
      votes = RandomSample[masterList, total]
    ]

ballotGenerator[candidates_Association, instances_] :=
    Table[ballotGenerator[candidates], instances]

Module[{plot},
  plot =
      DistributionChart[
        Transpose@Table[
          Module[{data = {valuesMissing[#, "A"],
            valuesMissing[#, "B"]} & /@

              associationAppender[
                ballotGenerator[
                  Association[{"A" -> #[[1]], "B" -> #[[2]]}]]]},
            Length /@ (Select[
              data, #] & /@ {#[[1]] > #[[2]] &, #[[2]] > #[[1]] &,
              #[[1]] == #[[2]] &})
          ], 1000],
        ImageSize -> 788,
        ChartElementFunction -> "PointDensity",
        ChartLabels -> {"A ahead of B", "B head of A", "A equal to B"},
        PlotLabel ->
            "Total A votes = " <> ToString[#[[1]]] <>
                " & total B votes = " <> ToString[#[[2]]],
        FrameLabel -> {None, "Number of occurances in 1000 trials"}];

  Export[
    StringReplace[NotebookFileName[],
      ".nb" -> "_ahead_behind_A_votes_" <> ToString[#[[1]]] <> ".png"],
    plot, ImageSize -> 788, ImageResolution -> 500]
] & /@ ({#, 200 - #} & /@ Range[10, 190, 10])


Module[{plot},
  plot = ListLinePlot[Transpose[
    {valuesMissing[#, "A"], valuesMissing[#, "B"]} & /@
        associationAppender[
          ballotGenerator[Association[{"A" -> #[[1]], "B" -> #[[2]]}]]]],
    PlotLegends -> {"Candidate A", "Candidate B"},
    Frame -> True,
    FrameLabel -> (Style[#, 12] & /@ {"Total number of votes",
      "Votes for A and B"}),
    PlotLabel -> Style[
      "Accumulating votes " <> "A gets " <> ToString[#[[1]]]
          <> " votes and B gets " <> ToString[#[[2]]] <> " votes", Red],
    Filling -> {1 -> {2}}, PlotRange -> {{0, 200}, {0, 200}},
    ImageSize -> 700, AspectRatio -> 1];

  Export[
    StringReplace[NotebookFileName[],
      ".nb" ->
          "_ballot_counting_A_total_" <> ToString[#[[1]]] <> ".png"],
    plot, ImageSize -> 788, ImageResolution -> 500]
] & /@ ({#, 200 - #} & /@ Range[10, 190, 10])



Module[{plot},
  plot = ListLinePlot[Transpose[
    {valuesMissing[#, "A"], valuesMissing[#, "B"]} & /@
        associationAppender[
          ballotGenerator[Association[{"A" -> #[[1]], "B" -> #[[2]]}]]]],
    PlotLegends -> {"Candidate A", "Candidate B"},
    Frame -> True,
    FrameLabel -> (Style[#, 12] & /@ {"Total number of votes",
      "Votes for A and B"}),
    PlotLabel -> Style[
      "Accumulating votes " <> "A gets " <> ToString[#[[1]]]
          <> " votes and B gets " <> ToString[#[[2]]] <> " votes", Red],
    Filling -> {1 -> {2}}, PlotRange -> {{0, 200}, {0, 200}},
    ImageSize -> 700, AspectRatio -> 1] & /@ ({#, 200 - #} & /@
      Range[1, 199, 1]);

  Export[
    StringReplace[NotebookFileName[],
      ".nb" -> "_ballot_counting_animation.gif"],
    plot, ImageSize -> 788, ImageResolution -> 100,
    "DisplayDurations" -> 1]
]

Code from the supporting library
associator[element_] := Association[element -> 1];


associationAppender[associationIn_Association, element_] :=
    Module[{association = associationIn, newEntry = associator[element],
      newEntryKey},
      newEntryKey = Keys[newEntry][[1]];
      If[! MemberQ[Keys[association], Keys[newEntry][[1]]],
        AppendTo[association, newEntry],
        association[newEntryKey] =
            association[newEntryKey] + newEntry[newEntryKey];
        association
      ]
    ]


associationAppender[list_List] :=
    Module[{seedAssociation = <||>},
      Table[seedAssociation =
          associationAppender[seedAssociation, list[[r]]], {r, 1,
        Length@list}]]


valuesMissing[association_, element_] :=
    If[Head[association[element]] === Missing, 0, association[element]]

End of the post 😉


.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.

.