"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() }