MA102

Voting Theory Example Generator

Copyright 2011, Robert Poodiack, Norwich University

Below, you may use the sliders to choose the number of ballot types (from 2 to 7) and the number of candidates (from 2 to 6).  Mathematica will randomly generate a preference schedule with your desired number of different ballots and the chosen number of candidates.   You can then use the other sliders to change the number of voters who chose each type of ballot (up to 30).

You can then try to compute the election winners using the various social choice methods (Plurality, Borda Count, Pairwise Comparisons (i.e. Condorcet), and Plurality-with-Elimination (i.e. Instant Runoff)) on your own.  Click on the checkboxes to see the answers.

Source code

candidates := {"A", "B", "C", "D", "E", "F"};
ordinals := {"First", "Second", "Third", "Fourth", "Fifth", "Sixth"};
row1[nums_] := Join[{"# of voters"}, nums];
possBallots[cand_List, mycand_] := Permutations[Take[cand, mycand]];
rows[types_, cand_, mycand_] := Module[{i, myrows, theseballots},
    myrows = {};
    theseballots = Table[possBallots[cand, mycand][[RandomInteger[{1, Length[possBallots[cand, mycand]]}]]], {types}];
    For[i = 1, i <= mycand, i++,
      myrows = Join[myrows, {Flatten@{ordinals[[i]] <> " Choice", Table[theseballots[[k, i]], {k, types}]}}]];
    Return[myrows]]
prefSched[firstrow_, otherrows_, types_] := Grid[Join[{firstrow}, otherrows], ItemSize -> {Join[{12}, Table[3, {types}]]}, ItemStyle -> {1 -> Red, {Directive[Bold, Black, 20, FontFamily -> "Helvetica"], 1 -> Directive[Bold, Blue, Underlined, 20, FontFamily -> "Times"]}}, Dividers -> {2 -> True, 2 -> True}];
theRows = rows[3, candidates, 4];
theOldRows = theRows;
oldballottypes = 3;
oldmycandidates = 4;
Manipulate[theRows = rows[ballottypes, candidates, mycandidates];
 If[(oldballottypes != ballottypes) || (oldmycandidates != mycandidates), theOldRows = theRows; oldballottypes = ballottypes; oldmycandidates = mycandidates];
 firstchoice := Rest[theOldRows[[1]]];
 voternums = Join[{type1}, {type2}, {type3}, {type4}, {type5}, {type6}, {type7}];
 totalBallots = Sum[voternums[[i]], {i, 1, ballottypes}];
 plurWinner := Module[{i, winner, fpcount, extwinner},
   fpcount = Table[0, {mycandidates}];
   For[i = 1, i <= ballottypes, i++,
    fpcount[[ToCharacterCode@firstchoice[[i]] - 64]] += voternums[[i]]];
   winner = FromCharacterCode /@ (Flatten[Position[fpcount, Max[fpcount]]] + 64);
   extwinner = FromCharacterCode /@ (Reverse[Ordering[fpcount]] + 64);
   Return[{Join[winner, {Text[Row[{Max[fpcount], " votes"}]]}], extwinner}]];
 bordaCount := Module[{i, k, winner, bcount, extwinner},
   bcount = Table[0, {mycandidates}];
   For[i = 1, i <= ballottypes, i++,
    For[k = 1, k <= mycandidates, k++,
     bcount[[ToCharacterCode@(Rest[theOldRows[[k]]][[i]]) - 64]] += voternums[[i]]*(mycandidates - k + 1)]];
   winner = FromCharacterCode /@ (Flatten[Position[bcount, Max[bcount]]] + 64);
   extwinner = FromCharacterCode /@ (Reverse[Ordering[bcount]] + 64);
   Return[{Join[winner, {Text[Row[{Max[bcount], " points"}]]}], Riffle[extwinner, Sort[bcount, Greater]]}]];
 condorcet := Module[{i, j, k, winner, ccount, ballots, prefresults, preftext, pairs},
   ccount = Table[0, {mycandidates}];
   prefresults = {0, 0};
   preftext = {};
   pairs = Subsets[Take[candidates, mycandidates], {2}];
   ballots = Rest[Transpose[theOldRows]];
   For[j = 1, j <= Length[pairs], j++,
    For[i = 1, i <= ballottypes, i++,
     If[Position[ballots[[i]], pairs[[j, 1]]][[1, 1]] < Position[ballots[[i]], pairs[[j, 2]]][[1, 1]], prefresults[[1]] += voternums[[i]], prefresults[[2]] += voternums[[i]]]];
    If[prefresults[[1]] == prefresults[[2]], ccount[[ToCharacterCode@pairs[[j, 1]] - 64]] += 0.5; ccount[[ToCharacterCode@pairs[[j, 2]] - 64]] += 0.5; preftext = Join[preftext, {Text[Row[{pairs[[j, 1]], " ties ", pairs[[j, 2]], ", ", prefresults[[1]], " to ", prefresults[[2]]}]]}], If[prefresults[[1]] > prefresults[[2]], ccount[[ToCharacterCode@pairs[[j, 1]] - 64]]++; preftext = Join[preftext, {Text[Row[{pairs[[j, 1]], " defeats ", pairs[[j, 2]], ", ", prefresults[[1]], " to ", prefresults[[2]]}]]}], ccount[[ToCharacterCode@pairs[[j, 2]] - 64]]++; preftext = Join[preftext, {Text[Row[{pairs[[j, 1]], " loses to ", pairs[[j, 2]], ", ", prefresults[[1]], " to ", prefresults[[2]]}]]}]]];
    prefresults = {0, 0}];
   winner = FromCharacterCode /@ (Flatten[Position[ccount, Max[ccount]]] + 64);
   Return[{winner, preftext}]];
 IRV := Module[{i, j, k, l, loser, fpcount, ballots, theballots, winner, newballots, loserpos, prevloserpos, rounds},
   fpcount = Table[0, {mycandidates}];
   ballots = Rest[Transpose[theOldRows]];
   rounds = {}; prevloserpos = {};
   For[j = 1, j <= mycandidates, j++,
    For[i = 1, i <= Length[ballots], i++,
     fpcount[[ToCharacterCode@(Transpose[ballots][[1, i]]) - 64]] += voternums[[i]]];
    rounds = Join[rounds, {Text[Row[{"Round ", j, ":", Riffle[Take[candidates, mycandidates], fpcount]}]]}];
    winner = FromCharacterCode /@ (Flatten[Position[fpcount, Max[fpcount]]] + 64);
    If[Max[fpcount] > (1/2)*totalBallots, Return[{winner, rounds}]];
    loserpos = Flatten[Position[fpcount, Min[fpcount]]];
    If[loserpos === prevloserpos, loserpos = Flatten[Position[fpcount, Min[DeleteCases[fpcount, Min[fpcount]]]]]];
    loser = FromCharacterCode /@ (loserpos + 64);
    newballots = {};
    For[k = 1, k <= Length[ballots], k++,
     theballots = ballots[[k]];
     For[l = 1, l <= Length[loser], l++,
      theballots = DeleteCases[theballots, loser[[l]]]];
     newballots = Join[newballots, {theballots}]];
    ballots = newballots;
    prevloserpos = Union[prevloserpos, loserpos];
    fpcount = Table[0, {mycandidates}]];
   winner = First[ballots];
   Return[{winner, rounds}]];
 Grid[{{prefSched[row1[Take[voternums, ballottypes]], theOldRows, ballottypes]}, {Graphics[{Darker[Magenta], Style[Text[Row[{"Total votes: ", totalBallots}]], FontFamily -> "Helvetica", 18]}, ImageSize -> {300, 20}]}, {Graphics[{If[showPlurality, Darker[Green], White], Style[Text[Row[{"Plurality winner(s): ", plurWinner[[1]]}]], FontFamily -> "Helvetica", 18]}, ImageSize -> {300, 20}]}, {Graphics[{If[showPlurality, Darker[Green], White], Style[Text[Row[{"Extended Plurality order: ", plurWinner[[2]]}]], FontFamily -> "Helvetica", 10]}, ImageSize -> {300, 12}]}, {Graphics[{If[showBorda, Darker[Purple], White], Style[Text[Row[{"Borda count winner(s): ", bordaCount[[1]]}]], FontFamily -> "Helvetica", 18]}, ImageSize -> {350, 20}]}, {Graphics[{If[showBorda, Darker[Purple], White], Style[Text[Row[{"Extended Borda count: ", bordaCount[[2]]}]], FontFamily -> "Helvetica", 10]}, ImageSize -> {400, 12}]},
   {Graphics[{If[showCondorcet, Darker[Orange], White], Style[Text[Row[{"Condorcet (pairwise) winner(s): ", condorcet[[1]]}]], FontFamily -> "Helvetica", 18]}, ImageSize -> {350, 20}]}, {Graphics[{If[showCondorcet, Darker[Orange], White], Style[Text[Row[{Style["Pairwise results: ", Bold, 12], Grid@Partition[condorcet[[2]], 3, 3, 1, {}]}]], FontFamily -> "Helvetica", 12]}, ImageSize -> {450, 100}]}, {Graphics[{If[showIRV, Darker[Blue], White], Style[Text[Row[{"Instant runoff winner: ", IRV[[1]]}]], FontFamily -> "Helvetica", 18]}, ImageSize -> {350, 20}]}, {Graphics[{If[showIRV, Darker[Blue], White], Style[Text[Row[{Style["IRV rounds: ", Bold, 12], Grid@Partition[IRV[[2]], 1, 1, 1, {}]}]], FontFamily -> "Helvetica", 12]}, ImageSize -> {450, 120}]}}],
 Style["Voting Theory", Italic, 18],
 Style["Example Generator", Italic, 18], Delimiter, {{ballottypes, 3, "Number of Ballot Types"}, 2, 7, 1, ImageSize -> Small, Appearance -> "Labeled"},
 {{mycandidates, 4, "Number of Candidates"}, 2, 6, 1, ImageSize -> Small, Appearance -> "Labeled"},
 Delimiter, {{type1, 10, "Quantity of Ballot 1"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled"}, {{type2, 9, "Quantity of Ballot 2"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled"},
 {{type3, 8, "Quantity of Ballot 3"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled", Enabled -> If[ballottypes >= 3, True, False]},
 {{type4, 4, "Quantity of Ballot 4"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled", Enabled -> If[ballottypes >= 4, True, False]},
 {{type5, 4, "Quantity of Ballot 5"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled", Enabled -> If[ballottypes >= 5, True, False]},
 {{type6, 5, "Quantity of Ballot 6"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled", Enabled -> If[ballottypes >= 6, True, False]}, {{type7, 1, "Quantity of Ballot 7"}, 1, 30, 1, ImageSize -> Small, Appearance -> "Labeled", Enabled -> If[ballottypes == 7, True, False]},
 Delimiter, Style["Show Results?", Italic, 14], {{showPlurality, False, "Plurality"}, {True, False}}, {{showBorda, False, "Borda Count"}, {True, False}},
 {{showCondorcet, False, "Condorcet (pairwise)"}, {True, False}}, {{showIRV, False, "Instant Runoff"}, {True, False}},
 ControlPlacement -> Left, SaveDefinitions -> True]

Double-click on the pointy bracket to view source code for the module.