Three candidate election calculations
These are a few routines that you may find useful.
Math 217 Mathematics, Voting, and Democracy
March 29, 2002

T. Ratliff, Wheaton College
ratliff_thomas@wheatoncollege.edu

Execute this code block first

You’ll need to execute this block of commands in order to call the routines. The only commands you’ll need to use are 
	weightedTally[ ]
	procedureLine[ ]
and the matrix M

(* tMat is matrix that defines the linear transformation to map from the simplex in the first octant in (ℝ^3) to an equilateral triangle centered at the origin in (ℝ^2)  *)
tMat = Block[{y1=-Norm[{1/3,1/3,1/3}-{1/2,1/2,0}],
x1=Norm[{1/2,1/2,0}-{1,0,0}],
y2=Norm[{1/3,1/3,1/3}-{0,0,1}]},
Transpose[{ {-x1,y1},{x1,y1},{0,y2}}]];

(* boundaries is the Graphics object that shows the equaliteral triangle divided into the six ranking regions *)
boundaries=Block[ {y1=-Norm[{1/3,1/3,1/3}-{1/2,1/2,0}],
x1=Norm[{1/2,1/2,0}-{1,0,0}],
y2=Norm[{1/3,1/3,1/3}-{0,0,1}],
avertex={-x1,y1},
 bvertex={x1,y1},
cvertex={0,y2}},
Graphics[{Line[{avertex,bvertex,cvertex,avertex}],
		Line[{avertex,1/2*(bvertex+cvertex)}],
		Line[{bvertex,1/2*(avertex+cvertex)}],
		Line[{cvertex,1/2*(avertex+bvertex)}]}]];

(* onSimplex[] scales the weighted tallies of an election outcome so that it lies on the simplex in (ℝ^3) *)
onSimplex[tallies_]:=1/Total[tallies] * tallies;

(* weightedTally[] applies the weights w to profile *)
weightedTally[w_,profile_]:={{w[[1]],w[[1]],w[[2]],w[[3]],w[[3]],w[[2]]},
			{w[[2]],w[[3]],w[[3]],w[[2]],w[[1]],w[[1]]},
			{w[[3]],w[[2]],w[[1]],w[[1]],w[[2]],w[[3]]}}.profile;

(* procedureLine[ ] displays the procedure line for profile *)
procedureLine[profile_]:=Module[ {q0, q1, pLine,Q0,Q1},
	q0 = tMat.onSimplex[weightedTally[{1,0,0},profile]];
	q1 = tMat.onSimplex[weightedTally[{1,1,0},profile]];
	Q0= Graphics[{PointSize[ 0.015],Red,Point[q0]}];
Q1= Graphics[{PointSize[ 0.015],Blue,Point[{q1}]}];
pLine=Graphics[{Magenta,Line[{ q0,q1}]}];
Show[{boundaries,Q0,Q1,pLine,
Graphics[{PointSize[0.025],Red,Point[{0.5,0.5}]}],
Graphics[Text[Style["q0",FontSize->16],{0.6,0.5}]],
Graphics[{PointSize[0.025],Blue,Point[{0.5,0.3}]}],
Graphics[Text[Style["q1",FontSize->16],{0.6,0.3}]]
}]
]
 (* M is the basis matrix for {K, (Subscript[C, y]), (Subscript[R, 1]), (Subscript[R, 2]), (Subscript[B, 1]), (Subscript[B, 2])} *)
M={{1,1,1,0,2,1},{1,0,0,1,2,0},{1,1,0,0,1,0},{1,0,1,0,0,1},{1,1,0,1,0,2},{1,0,0,0,1,2}};

Using the weightedTally[ ] function

Let’s define our favorite profile and determine the Borda Count tallies

p={10,0,6,6,3,6};
weightedTally[{2,1,0},p]

Or, we can use other weights, like {13,1,0}

weightedTally[{13,1,0},p]

Using procedureLine[ ]

We can draw the procedure line for any profile.

procedureLine[p]

Using the matrix M to decompose a profile in terms of {K, (Subscript[C, y]), (Subscript[R, 1]), (Subscript[R, 2]), (Subscript[B, 1]), (Subscript[B, 2])}

The matrix M contains the vectors {K, (Subscript[C, y]), (Subscript[R, 1]), (Subscript[R, 2]), (Subscript[B, 1]), (Subscript[B, 2])} in its columns. 
Let’s decompose our favorite profile p={10,0,6,6,3,6} in terms of this basis by multiplying (M^(-1))p

Inverse[M].p

Thus, p = (17/6)K  +  (7/3)(Subscript[C, y]) + 2(Subscript[R, 1]) - (9/2)(Subscript[R, 2]) + (5/6)(Subscript[B, 1]) + (7/6)(Subscript[B, 2])  

or  p = (1/6)(17K  +  14(Subscript[C, y]) + 12(Subscript[R, 1]) - 27(Subscript[R, 2]) + 5(Subscript[B, 1]) + 7(Subscript[B, 2]) )