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.

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)

Endnotes