Duverger’s Law

Adam Rumpf, 7/22/2015

Introduction

This is an implementation of the simple behavioral model that Duverger’s Law is based on. We begin with a set of political parties lying at various points on a political spectrum, each with a given amount of initial support. We then simulate a sequence of election cycles. After each cycle, if a voter’s preferred candidate did not win, then they will consider changing their support to the most successful candidate on their half of the political spectrum, with centrist supporters being willing to move in either direction.

The main function defined below is votecycle[], and accepts the following arguments:

p (mandatory): A list of the initial support for each political party, ordered from left to right. The length of this list implicitly determines the number of parties.

t (mandatory): Number of election cycles to simulate.

d (optional, default 0.9): The fraction of voters that abandon their current party in favor of the most successful neighbor after each cycle. A lower value causes a more gradual change.

s (optional, default 0): A switching threshold, expressed as a percent. Voters will only consider switching to a party that has beaten their current party by a margin least s percent.

r (optional, default 0): Random drift between neighboring parties. After each iteration, for each party, a random number of supporters chosen uniformly from [0,r] will move to a neighboring party.

This function produces a four-part plot based on the given parameters. The top two bar plots show the initial and final amount of support for each party. The lower left line plot shows each party’s support over the election cycles. The bottom right pie chart shows the fraction of voters that are still supporting their original first choice during the final election cycle.

Code

Initialization

(* voting[...] implements a the above process.
p = list of the initial support for each party
t = number of iterations
d = fraction of supporters to transfer (ex. d = 0.5 means that, if we make a switch, we switch 50% of the current supporters)
s = switching threshold (ex. s = 0.1 means that we only switch if we were beaten by a margin of at least 10%)
r = maximum random drift within each iteration *)
voting[p_,t_,d_:0.9,s_:0,r_:0]:=Module[{n=Length[p],A,l,u,temp,order,drift},
(* A = matrix of outcomes
l = current frontrunner of lower half
u = current frontrunner of upper half
temp = previous iteration's values
order = order in which to randomly shuffle
drift = amount of random shift *)
A=ConstantArray[0,{t,n}];
A[[1]]=p;
For[i=2,i≤t,i++,
temp=A[[i-1]];
If[r>0,
order=RandomSample[Range[n],n];
For[j=1,j<n,j+=2,
drift=Min[RandomReal[r],temp[[order[[j+1]]]]];
temp[[order[[j]]]]+=drift;
temp[[order[[j+1]]]]-=drift;
];
];
A[[i]]=temp;
If[EvenQ[n],
l=Ordering[temp[[1;;n/2]],-1][[1]];
u=Ordering[temp[[n/2+1;;n]],-1][[1]]+n/2,
l=Ordering[temp[[1;;Ceiling[n/2]]],-1][[1]];
u=Ordering[temp[[Ceiling[n/2];;n]],-1][[1]]+Ceiling[n/2]-1;
];
For[j=1,j≤n/2,j++,
If[(1+s)temp[[j]]<temp[[l]],
A[[i,j]]-=d temp[[j]];
A[[i,l]]+=d temp[[j]];
];
];
If[OddQ[n],
If[(1+s)temp[[Ceiling[n/2]]]<temp[[l]]&&(1+s)temp[[Ceiling[n/2]]]<temp[[u]],
A[[i,Ceiling[n/2]]]-=d temp[[Ceiling[n/2]]];
A[[i,l]]+=0.5d temp[[Ceiling[n/2]]];
A[[i,u]]+=0.5d temp[[Ceiling[n/2]]];
];
];
For[j=Ceiling[n/2]+1,j≤n,j++,
If[(1+s)temp[[j]]<temp[[u]],
A[[i,j]]-=d temp[[j]];
A[[i,u]]+=d temp[[j]];
];
];
];
A
]

(* voteplot[...] displays the results. *)
voteplot[in_]:=Module[{init,fin,progress,pie,fc=0,sc=0},
init=BarChart[in[[1]],ChartStyle->"Rainbow",PlotLabel->"Initial Support",AxesLabel->{"party","support"}];
fin=BarChart[in[[-1]],ChartStyle->"Rainbow",PlotLabel->"Final Support",AxesLabel->{"party","support"}];
progress=ListPlot[Transpose[in],Joined->True,PlotStyle->"Rainbow",PlotLabel->"Change in Support",AxesLabel->{"election","support"}];
For[j=1,j≤Length[in[[1]]],j++,
fc+=Min[in[[1,j]],in[[-1,j]]];
];
sc=Total[in[[1]]]-fc;
pie=PieChart[{fc,sc},ChartStyle->"DarkRainbow",PlotLabel->"First Choice Support",ChartLabels->{"yes","no"}];
GraphicsGrid[{{init,fin},{progress,pie}}]
]

(* combines the two *)
votecycle[p_,t_,d_:0.9,s_:0,r_:0]:=voteplot[voting[p,t,d,s,r]]

Demonstration

(* simple bell-curve with drastic support changes *)
votecycle[{9,18,19,20,15,6},10]

(* bimodal distribution with some friction *)
votecycle[{1,3,4,3,2,4,5,3},20,0.5,0.5]

(* stochastic example *)
votecycle[{7,3,5,6,2,6,8,4},20,0.5,0.5,2]

(* stochastic with bell curve *)
votecycle[{9,18,19,20,15,6},20,0.5,0.5,1]