"stv"<-
function(x, mcan = 0, oldcount = F, verbose = T) {
#
# The data matrix x contains the votes themselves.
# Row i of the matrix contains the preferences of voter i
# numbered 1, 2, .., r, 0,0,0,0, in some order
# The columns of the matrix correspond to the candidates.
# The dimnames of the columns are the names of the candidates; if these
# are not supplied then the candidates are lettered A, B, C, ...
#
# If x is a character string it is interpreted as a file name from which the
# votes are to be read. A tab delimited file produced by excel
# will be in the right format, with the candidate names in the first row.
#
# The argument mcan is number of candidates to be elected
#
# If mcan is not supplied it will be assumed that the number of candidates
# to be elected is half the number of candidates standing.
#
# If oldcount=T, the results under the old system of counting will
# be calculated, ie give one vote to each of the first mcan
# preferences for each voter and just add up
#
# If verbose=T, the progress of the count will be printed
#
# The program was written by Bernard Silverman for the IMS in August 2002
# It may be distributed and used freely, with appropriate acknowledgement,
# and at the user’s own risk. Neither IMS nor the author can accept
# liability for the correct or incorrect use of the program.
#
# prepare by finding names of candidates and setting up
# vector w of vote weights and list of elected candidates
#
if(is.character(x)) {
x <- read.table(file = x, header = T, row.names = NULL)
x <- as.matrix(x)
}
nc <- dim(x)[2]
cnames <- dimnames(x)[[2]]
if(length(cnames) != nc) {
cat("Warning: Candidate names not supplied, dummy names used instead\n"
)
cnames <- LETTERS[1:nc]
}
if(mcan == 0) {
mcan <- floor(nc/2)
cat("Number of candidates to be elected not specified.\nDefault value of ",
mcan, "used instead.\n")
}
elected <- NULL
#
# the next step is to remove invalid votes. A vote is invalid if
# the preferences are not numbered in consecutively increasing order.
# A warning is printed out for each invalid vote, but the votes are
# not counted.If necessary, it is possible to correct errors in the
# original x matrix.
# If x is generated from an excel spreadsheet, then the jth vote will
# be in row (j-1) of the spreadsheet.
#
cat("Number of votes cast is", dim(x)[1],
"\nChecking if these are valid ... \n")
ok <- rep(T, dim(x)[1])
for(j in (1:dim(x)[1])) {
z <- sort(diff(c(0, diff(sort(c(0, x[j, ]))), 1)))
ok[j] <- (sum(z[nc]^2) == 0) & (z[nc + 1] == 1)
if(!ok[j])
cat("Vote ",j, " is in trouble; recorded vote is ", x[j,],"\n")
}
x <- x[ok, ]
nvotes <- dim(x)[1]
w <- rep(1, nvotes)
cat("Number of valid votes is ", nvotes, "\n")
#
# calculate results under old counting system
#
if(oldcount) {
vtot <- apply(x <= mcan & x != 0, 2, sum)
names(vtot) <- cnames
cat("\nUnder old counting system totals would be\n")
print(rev(sort(vtot)))
}
#
# the main loop
#
cat("\nCounting the votes by STV ... \n")
while(mcan > 0) {
#
# calculate quota and total first preference votes
#
vcast <- apply(w * (x == 1), 2, sum)
names(vcast) <- cnames
quota <- sum(vcast)/(mcan + 1)
if(verbose) {
cat("\nFirst preferences are now \n")
print(round(vcast[vcast != 0], 1))
cat("Quota is ", round(quota, 2), "\n") }
#
# if leading candidate exceeds quota, declare elected and adjust weights
# mark candidate for elimination in subsequent counting
#
vmax <- max(vcast)
if(vmax >= quota) {
ic <- max((1:nc)[vcast == vmax])
index <- (x[, ic] == 1)
w[index] <- (w[index] * (vmax - quota))/vmax
mcan <- mcan - 1
elected <- c(elected, cnames[ic])
if(verbose) cat("Candidate", cnames[ic], "elected \n")
} else {
#
# if no candidate reaches quota, mark lowest candidate for elimination
vmin <- min(vcast[vcast > 0])
ic <- min((1:nc)[vcast == vmin])
if(verbose) cat("Candidate", cnames[ic], "eliminated \n")
}
for(i in (1:nvotes)) {
jp <- x[i, ic]
if(jp > 0) {
index <- (x[i, ] > jp)
x[i, index] <- x[i, index] - 1
x[i, ic] <- 0
} } }
cat("\nElected candidates are, in order of election: \n", paste(elected,
collapse = ", "), "\n")
invisible() }