# Voronoi cells

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.

# A simple voting model

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]$$

## Solutions

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)