Given a discrete subset of \(D \subset
\mathbb{R}^d\), you can imagine that \(D\) is a realization of a Poisson point
process, we associate to each \(x \in
D\), its *Voronoi cell* \(V(x)
\subseteq \mathbb{R}^d\), which consists of all the points \(y \in \mathbb{R}^d\), such that \(\| x- y\| < \|z - y\|\) for all \(z \in D \setminus \{x\}\). You can imagine
that each point (cellphone location) \(y \in
\mathbb{R}^d\) would like to report to the nearest (cellphone
tower) point in \(D\), and \(V(x)\) is all the points that report to
\(x\). For more information see wiki link.

Here we consider a simple voting model studied in by Quas. Suppose we have \(n\) candidates, and their political positions are represented on a point on the unit interval \([0,1]\), and subsets of \([0,1]\) represents a share of the voters. The support that each candidate has, is given by their Voronoi cell. The candidates go through, \(n-1\) rounds of election, where in each round, the candidate with the least support drops out.

- Plot a histogram of the position of the winner, when \(n\) is large, and the candidates are uniformly distributed on \([0,1]\)

Given a set of points (candidates) on the unit interval, the function V computes length of the interval those points would claim under the Voronoi tessellation; this is the length of the area of support corresponding to each candidate. Notice that we treat the endpoints separately.

```
V <- function(x){
y = sort(x, decreasing =F)
L = length(y)
d = y[1] + (y[2] - y[1])/2
if (L>2) {
for (i in 2 :(L-1))
d <- c(d, (y[i] - y[i-1])/2 + (y[i+1] - y[i])/2)
}
d <- c(d, (y[L]-y[L-1])/2 + 1-y[L])
d
}
```

The following version of V does not use a *for* loop, and may
be faster.

```
VV <- function(x){
y = sort(x, decreasing =F)
L = length(y)
d = y[1] + (y[2] - y[1])/2
w =NULL
if(L >2){
yp <- y[-1]
ye <- y[-L]
w=(yp-ye)/2
w<-w[-length(w)]
ypp<- yp[-1]
yp <- yp[-(L-1)]
w <- w + (ypp - yp)/2
}
w <- c(d,w, (y[L]-y[L-1])/2 + 1-y[L])
w
}
```

The following function tells us which candidate drops out.

```
amin <- function(x){
which(x==min(x))
}
```

Finally, we need a way of repeating this procedure until there is one winner, where we start with \(n\) independent and uniformly distributed candidates.

```
Loop <- function(n){
x <- runif(n)
y <- sort(x, decreasing=F)
i=1
while(i < n)
{amin(VV(y))
y <- y[-amin(VV(y))]
i <- i+1}
y
}
```

Here, we plot a histogram of the winner, in the case \(n=10\) and \(n=50\)

```
b = seq(0,1, by=0.01)
x10=replicate(3000, Loop(10))
hist(x10, prob=TRUE, breaks=b)
```

```
x50=replicate(3000, Loop(50))
hist(x50, prob=TRUE, breaks=b)
```

- Version: 12 November 2023
- Rmd
Source