# Programming Coombs method

Coombs methods is a method to have a winner in elections.

I want to program the Coomb methods for elections and I am highly incompetent incompetent in programming

Suppose 4 candidates. This leads to 24 preference orders and we associate an integer random number with each.

In the first round we eliminate the candidate which is the most often classed last. This is without difficulty and the code follows

(here is for the prefences and the associated number --- the number of electors with each type of preference)

  per = Permutations[l]
np = N[ Table[RandomInteger[{0, 100}], {i, 1, 24}] ]


(here is for the elimination of the first looser)

 ScCa1 = Total[
Table[If[Position[per[[i]], a][[1, 1]] == 4, np[[1]], 0], {i, 1,
24}]];
ScCb1 = Total[
Table[If[Position[per[[i]], b][[1, 1]] == 4, np[[2]], 0], {i, 1,
24}]];
ScCc1 = Total[
Table[If[Position[per[[i]], c][[1, 1]] == 4, np[[3]], 0], {i, 1,
24}]];
ScCd1 = Total[
Table[If[Position[per[[i]], d][[1, 1]] == 4, np[[4]], 0], {i, 1,
24}]];
per1 = Table[
Which[
Min[ScCa1, ScCb1, ScCb1, ScCd1] == ScCa1,
Drop[per[[i]], {Position[per[[i]], a][[1, 1]]}],
Min[ScCa1, ScCb1, ScCb1, ScCd1] == ScCb1,
Drop[per[[i]], {Position[per[[i]], b][[1, 1]]}],
Min[ScCa1, ScCb1, ScCb1, ScCd1] == ScCc1,
Drop[per[[i]], {Position[per[[i]], c][[1, 1]]}],
Min[ScCa1, ScCb1, ScCb1, ScCd1] == ScCd1,
Drop[per[[i]], {Position[per[[i]], d][[1, 1]]}]
], {i, 1, 24}]


Now, I dont know who has been eliminated. How can I construct the following stages --- elimination of the second then the third candidates to name the winner ---, without explicitely displaying all cases ?

I thought this would be a little more elegant at the outset, maybe it can be improved... A lot of the lines are printing just to detail whats going on.

Firstly let's simulate a vote, much like you did. We have four candidates "A", "B", "C", and "D", and we give the different preference order permutations a random number of votes:

n = 4;
candidates = ToUpperCase@FromLetterNumber@Range[n];
per = Permutations[candidates];
num = RandomInteger[{0, 100}, Length@per];
frac = N@num/Total[num];
results = Transpose[{per, frac}];


Now some functions. First to total the number of first and last votes each candidate receives:

VotesFirst[list_, candidate_] := Total[Cases[list, x_ :> x[[2]] /; First[x[[1]]] == candidate]]
VotesLast[list_, candidate_] := Total[Cases[list, x_ :> x[[2]] /; Last[x[[1]]] == candidate]]


One to update the results when removing a candidate:

EliminateCandidate[results_, candidate_] := Module[{newResults},
newResults = {DeleteCases[#[[1]], candidate], #[[2]]} & /@ results;
newResults = {#[[1, 1]], Total[#[[;; , 2]]]} & /@ GatherBy[newResults, First]
]


And finally one to run the voting rounds (with a lot of Print lines):

CoombsRound[results_, candidates_] :=
Module[{vFirst, vLast, max, winner, loser, newResults, newCandidates},
vFirst = VotesFirst[results, #] & /@ candidates;
Print["Candidate first vote shares:"];
Print[Transpose[{candidates, vFirst}]];
max = Max[vFirst];

If[max > 0.5,
winner = candidates[[Position[vFirst, max][[1, 1]]]];
Print["WINNER = " <> winner];,
Print["No winner"];
vLast = VotesLast[results, #] & /@ candidates;
Print["Candidate last vote shares:"];
Print[Transpose[{candidates, vLast}]];
loser = candidates[[Position[vLast, Min[vLast]][[1, 1]]]];
Print["Eliminating " <> loser];
newResults = EliminateCandidate[results, loser];
newCandidates = DeleteCases[candidates, loser];
Print["Running next round...\n"];
CoombsRound[newResults, newCandidates];
];
]

CoombsRound[results, candidates]


Candidate first vote shares:

{{A,0.265005},{B,0.20591},{C,0.273315},{D,0.255771}}

No winner

Candidate last vote shares:

{{A,0.284395},{B,0.23361},{C,0.333333},{D,0.148661}}

Eliminating D

Running next round...

Candidate first vote shares:

{{A,0.319483},{B,0.384118},{C,0.296399}}

No winner

Candidate last vote shares:

{{A,0.339797},{B,0.284395},{C,0.375808}}

Eliminating B

Running next round...

Candidate first vote shares:

{{A,0.503232},{C,0.496768}}

WINNER = A

• I just realize that FromLetterNumber is not a Mathematica command Commented Nov 9, 2016 at 19:44
• It was introduced in V10.1. You could replace that line with candidates = FromCharacterCode[List /@ Range[65, 65 + n - 1]] Commented Nov 9, 2016 at 19:55