Condorcet.R

# Condorcet

Votes <- read.csv("Votes.csv")

candidates <- names(Votes)
nvoters <- dim(Votes)[1]
ncand <- dim(Votes)[2]

allpairs <- combn(1:ncand, 2)

winners <- character(0)
losers  <- character(0)

CondorcetMatrix <- matrix(rep(0, ncand^2), nrow = ncand)
rownames(CondorcetMatrix) <- candidates
colnames(CondorcetMatrix) <- candidates

RowBeatCol <- matrix(rep(FALSE, ncand^2), nrow = ncand)
rownames(RowBeatCol) <- candidates
colnames(RowBeatCol) <- candidates

for (k in 1:dim(allpairs)[2]){
  candx <- Votes[ , allpairs[1, k]]
  candy <- Votes[ , allpairs[2, k]]
  a <- sum(candx < candy, na.rm = TRUE)
  b <- sum(candx > candy, na.rm = TRUE)
  results <- c(a, b)
  names(results) <- c(candidates[allpairs[1, k]], candidates[allpairs[2, k]])
  print(results)
  CondorcetMatrix[allpairs[1,k], allpairs[2,k]] <- results[1]
  CondorcetMatrix[allpairs[2,k], allpairs[1,k]] <- results[2]
  
  if (!isTRUE(all.equal(a, b))){
    winners[k] <- names(results)[which(results == max(results))]
    losers[k] <- names(results)[which(results == min(results))]
    RowBeatCol[winners[k], losers[k]] <- TRUE
  } else {
    # there is a tie
    winners[k] <- NA
    losers[k] <- NA
  }
}

winners
losers
CondorcetMatrix
RowBeatCol

# part b
table(winners)

if (any(table(winners) == ncand - 1)){
  paste("The winner is:", names(table(winners))[which(table(winners) == ncand - 1)], sep = " ")
} else {
  # part c
  
  # generate all possible As and Bs
  temp <- list()
  for (i in 1:ncand) {
    temp[[i]] <- c(TRUE, FALSE)
  }
  inSetA <- expand.grid(temp, KEEP.OUT.ATTRS = FALSE)[-2^ncand, ]
  names(inSetA) <- candidates
  
  AbeatsB <- function(z){
    x <- candidates[z]
    y <- candidates[!z]
    !(sum(RowBeatCol[x, y]) < length(x)*length(y))
  }
  
  # find those A's and B's where A beats B
  whereAbeatsB <- as.logical(apply(inSetA, MARGIN = 1, AbeatsB))
  validAandB <- inSetA[whereAbeatsB, ]
  howManyB <- ncand - rowSums(validAandB)
  RESULT <- validAandB[howManyB == max(howManyB), ]
  
  print("The sets A and B are:")
  print(c("A: ", candidates[as.logical(RESULT)]))
  print(c("B: ", candidates[as.logical(!RESULT)]))
  
}

condorcet.Rnw

\documentclass{article}
\usepackage[margin = 1in]{geometry}
\usepackage{hyperref}
\title{Condorcet Voting}
\author{G.~Jay Kerns}

\begin{document}
\maketitle
\SweaveOpts{concordance=TRUE}
\tableofcontents

\section{Tallying votes}
First, read the data.
<<>>=
Votes <- read.csv("Votes.csv")
@

Here are the data, in full. (I randomly generated them.) They are in a
spreadsheet saved with comma-separated-values (\texttt{.csv}) format.
<<>>=
Votes
@

Then, set up some initial values.
<<>>=
candidates <- names(Votes)
nvoters <- dim(Votes)[1]
ncand <- dim(Votes)[2]
@

Compute all pairwise comparisons.
<<>>=
allpairs <- combn(1:ncand, 2)
allpairs
@

More initialization.
<<>>=
winners <- character(0)
losers  <- character(0)

CondorcetMatrix <- matrix(rep(0, ncand^2), nrow = ncand)
rownames(CondorcetMatrix) <- candidates
colnames(CondorcetMatrix) <- candidates

RowBeatCol <- matrix(rep(FALSE, ncand^2), nrow = ncand)
rownames(RowBeatCol) <- candidates
colnames(RowBeatCol) <- candidates
@

Next, tally the votes.  Special care is needed in case of a tie.
<<>>=
for (k in 1:dim(allpairs)[2]){
  candx <- Votes[ , allpairs[1, k]]
  candy <- Votes[ , allpairs[2, k]]
  a <- sum(candx < candy, na.rm = TRUE)
  b <- sum(candx > candy, na.rm = TRUE)
  results <- c(a, b)
  names(results) <- c(candidates[allpairs[1, k]], candidates[allpairs[2, k]])
  print(results)
  CondorcetMatrix[allpairs[1,k], allpairs[2,k]] <- results[1]
  CondorcetMatrix[allpairs[2,k], allpairs[1,k]] <- results[2]
  if (!isTRUE(all.equal(a, b))){
    winners[k] <- names(results)[which(results == max(results))]
    losers[k] <- names(results)[which(results == min(results))]
    RowBeatCol[winners[k], losers[k]] <- TRUE
  } else {
    # there is a tie
    winners[k] <- NA
    losers[k] <- NA
  }
}
@


Here are the winners of the respective pairwise comparisons.
<<>>=
winners
@

And here are the losers of the respective pairwise comparisons.
<<>>=
losers
@

Here is the Condorcet matrix associated with the election.
<<>>=
CondorcetMatrix
@

And here is whether candidate in Row $i$ beat the candidate in Column
$j$.
<<>>=
RowBeatCol
@


\section{Declaring a winner}

Here is the number of pairwise elections each candidate won.
<<>>=
table(winners)
@

We declare the winner, if one exists.
<<>>=
if (any(table(winners) == ncand - 1)){
  paste("The winner is:", names(table(winners))[which(table(winners) == ncand - 1)], sep = " ")
} else {
  # part c
  
  # generate all possible As and Bs
  temp <- list()
  for (i in 1:ncand) {
    temp[[i]] <- c(TRUE, FALSE)
  }
  inSetA <- expand.grid(temp, KEEP.OUT.ATTRS = FALSE)[-2^ncand, ]
  names(inSetA) <- candidates
  
  AbeatsB <- function(z){
    x <- candidates[z]
    y <- candidates[!z]
    !(sum(RowBeatCol[x, y]) < length(x)*length(y))
  }
  
  # find those A's and B's where A beats B
  whereAbeatsB <- as.logical(apply(inSetA, MARGIN = 1, AbeatsB))
  validAandB <- inSetA[whereAbeatsB, ]
  howManyB <- ncand - rowSums(validAandB)
  RESULT <- validAandB[howManyB == max(howManyB), ]
  
  print("The sets A and B are:")
  print(c("A: ", candidates[as.logical(RESULT)]))
  print(c("B: ", candidates[as.logical(!RESULT)]))
  
}
@

For these data, Candidate 4 was the winner.

\section{When a winner doesn't exist}

For the previous data there was a winner. For other data, there might
not be, and the program calculates sets $A$ and $B$ in that case.  For
instance, perhaps there is a tie.
<<>>=
Votes <- read.csv("VotesTie.csv")
@

Here are the data with a tie, in full. 
<<>>=
Votes
@

Everything else is as above.  The results follow.
<<echo = FALSE>>=
candidates <- names(Votes)
nvoters <- dim(Votes)[1]
ncand <- dim(Votes)[2]

allpairs <- combn(1:ncand, 2)

winners <- character(0)
losers  <- character(0)

CondorcetMatrix <- matrix(rep(0, ncand^2), nrow = ncand)
rownames(CondorcetMatrix) <- candidates
colnames(CondorcetMatrix) <- candidates

RowBeatCol <- matrix(rep(FALSE, ncand^2), nrow = ncand)
rownames(RowBeatCol) <- candidates
colnames(RowBeatCol) <- candidates

for (k in 1:dim(allpairs)[2]){
  candx <- Votes[ , allpairs[1, k]]
  candy <- Votes[ , allpairs[2, k]]
  a <- sum(candx < candy, na.rm = TRUE)
  b <- sum(candx > candy, na.rm = TRUE)
  results <- c(a, b)
  names(results) <- c(candidates[allpairs[1, k]], candidates[allpairs[2, k]])
  print(results)
  CondorcetMatrix[allpairs[1,k], allpairs[2,k]] <- results[1]
  CondorcetMatrix[allpairs[2,k], allpairs[1,k]] <- results[2]
  
  if (!isTRUE(all.equal(a, b))){
    winners[k] <- names(results)[which(results == max(results))]
    losers[k] <- names(results)[which(results == min(results))]
    RowBeatCol[winners[k], losers[k]] <- TRUE
  } else {
    # there is a tie
    winners[k] <- NA
    losers[k] <- NA
  }
}

winners
losers
CondorcetMatrix
RowBeatCol

# part b
table(winners)

if (any(table(winners) == ncand - 1)){
  paste("The winner is:", names(table(winners))[which(table(winners) == ncand - 1)], sep = " ")
} else {
  # part c
  
  # generate all possible As and Bs
  temp <- list()
  for (i in 1:ncand) {
    temp[[i]] <- c(TRUE, FALSE)
  }
  inSetA <- expand.grid(temp, KEEP.OUT.ATTRS = FALSE)[-2^ncand, ]
  names(inSetA) <- candidates
  
  AbeatsB <- function(z){
    x <- candidates[z]
    y <- candidates[!z]
    !(sum(RowBeatCol[x, y]) < length(x)*length(y))
  }
  
  # find those A's and B's where A beats B
  whereAbeatsB <- as.logical(apply(inSetA, MARGIN = 1, AbeatsB))
  validAandB <- inSetA[whereAbeatsB, ]
  howManyB <- ncand - rowSums(validAandB)
  RESULT <- validAandB[howManyB == max(howManyB), ]
  
  print("The sets A and B are:")
  print(c("A: ", candidates[as.logical(RESULT)]))
  print(c("B: ", candidates[as.logical(!RESULT)]))
  
}
@

For these data, Candidates 1 and 2 were tied in group $A$, and
Candidate 3 was delegated to group $B$.


\section{When there are cyclic preferences}

Another thing that can happen with Condorcet voting is the
Rock-Paper-Scissors phenomenon.  In that case our voting method is
useless.
<<>>=
Votes <- read.csv("VotesCyclic.csv")
@

Here are the cyclic data, in full. 
<<>>=
Votes
@

Everything else is just like before.  Here are the results.
<<echo = FALSE>>=
candidates <- names(Votes)
nvoters <- dim(Votes)[1]
ncand <- dim(Votes)[2]

allpairs <- combn(1:ncand, 2)

winners <- character(0)
losers  <- character(0)

CondorcetMatrix <- matrix(rep(0, ncand^2), nrow = ncand)
rownames(CondorcetMatrix) <- candidates
colnames(CondorcetMatrix) <- candidates

RowBeatCol <- matrix(rep(FALSE, ncand^2), nrow = ncand)
rownames(RowBeatCol) <- candidates
colnames(RowBeatCol) <- candidates

for (k in 1:dim(allpairs)[2]){
  candx <- Votes[ , allpairs[1, k]]
  candy <- Votes[ , allpairs[2, k]]
  a <- sum(candx < candy, na.rm = TRUE)
  b <- sum(candx > candy, na.rm = TRUE)
  results <- c(a, b)
  names(results) <- c(candidates[allpairs[1, k]], candidates[allpairs[2, k]])
  print(results)
  CondorcetMatrix[allpairs[1,k], allpairs[2,k]] <- results[1]
  CondorcetMatrix[allpairs[2,k], allpairs[1,k]] <- results[2]
  
  if (!isTRUE(all.equal(a, b))){
    winners[k] <- names(results)[which(results == max(results))]
    losers[k] <- names(results)[which(results == min(results))]
    RowBeatCol[winners[k], losers[k]] <- TRUE
  } else {
    # there is a tie
    winners[k] <- NA
    losers[k] <- NA
  }
}

winners
losers
CondorcetMatrix
RowBeatCol

# part b
table(winners)

if (any(table(winners) == ncand - 1)){
  paste("The winner is:", names(table(winners))[which(table(winners) == ncand - 1)], sep = " ")
} else {
  # part c
  
  # generate all possible As and Bs
  temp <- list()
  for (i in 1:ncand) {
    temp[[i]] <- c(TRUE, FALSE)
  }
  inSetA <- expand.grid(temp, KEEP.OUT.ATTRS = FALSE)[-2^ncand, ]
  names(inSetA) <- candidates
  
  AbeatsB <- function(z){
    x <- candidates[z]
    y <- candidates[!z]
    !(sum(RowBeatCol[x, y]) < length(x)*length(y))
  }
  
  # find those A's and B's where A beats B
  whereAbeatsB <- as.logical(apply(inSetA, MARGIN = 1, AbeatsB))
  validAandB <- inSetA[whereAbeatsB, ]
  howManyB <- ncand - rowSums(validAandB)
  RESULT <- validAandB[howManyB == max(howManyB), ]
  
  print("The sets A and B are:")
  print(c("A: ", candidates[as.logical(RESULT)]))
  print(c("B: ", candidates[as.logical(!RESULT)]))
  
}

@

For these data there are no winners and no losers.  We are right back
where we started.  Though, if there were more candidates then the
program would split them into a rock-paper-scissors-whatever part (in
set $A$) and a losers part (in set $B$) with $B$ as big as possible.

\section{Appendix}
<<echo = FALSE>>=
sessionInfo()
@


\end{document}

Votes.csv

VotesCyclic.csv

VotesTie.csv