#!/usr/bin/env perl
#
# condorcet.pl (c) 2009 Geoffrey Park
#
# This perl script tabulates and ranks votes using a Condorcet method (binary pairs).
#
# See http://en.wikipedia.org/wiki/Condorcet_method
#
# * Input is a candidate file and a votefile.
#
# * The candidate file has one candidate per line, formatted as:
# abr=name
# where abr is a short, unique abreviation, and name is candidates' full name.
#
# * The vote file contains one vote per line.
# Each vote ranks several options in order of decreasing preference from left to right.
# Options are comma separated lists of candidate abreviations.
#
# Note: The candidate abreviations should be unique, and none should be a subset of another.
#
# For example:
# A,B,C,D
# D,C,B,A
# B,A,C,D
# ...
my $nArgs = $#ARGV+1;
if($nArgs == 0) {
die "SYNTAX: condorcet.pl candidatefile votefile\n";
}
my @candidates = ("A");
open(CANDIDATEFILE, $ARGV[0]) or die "Can't open $ARGV[0]: $!";
#read the candidate file:
my $nCandidates = 0;
print "\nCandidates: \n\n";
while(<CANDIDATEFILE>) {
print $_;
$_ =~ s/\n//;
@candidates[$nCandidates] = $_;
$nCandidates++;
}
close CANDIDATEFILE;
@candidates[$nCandidates] = "\0";
print "\n\n";
print "Total ",$nCandidates," Candidates.\n";
my @rank=(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
my @votetab;
my @binarymtx;
open(VOTEFILE, $ARGV[1]) or die "Can't open $ARGV[1]: $!";
# initialize the matrices:
for(my $i=0;$i<$nCandidates*$nCandidates;$i++){
$votetab[$i] = 0;
$binarymtx[$i] = 0;
}
#read the vote file:
while(<VOTEFILE>) {
for(my $i=0;$i<$nCandidates;$i++){
$rank[$i]=100000;
}
for(my $i=0;$i<$nCandidates;$i++){
$abrev = $candidates[$i];
$abrev =~ s/=.*//;
if(/$abrev/i){
$pos = $-[0];
$rank[$i]=$pos;
}
}
#tabulate wins:
for($i=0;$i<$nCandidates;$i++){
for($j=0;$j<$nCandidates;$j++){
if($rank[$i] > $rank[$j]) {
$votetab[$i * $nCandidates + $j]++;
}
}
}
}
close VOTEFILE;
#print totals matrix:
print "\nTotals:\n ";
for($i=0;$i<$nCandidates;$i++){
$abrev = $candidates[$i];
$abrev =~ s/=.*//;
print $abrev." ";
}
print "\n";
for($i=0;$i<$nCandidates;$i++){
$abrev = $candidates[$i];
$abrev =~ s/=.*//;
print $abrev." ";
for($j=0;$j<$nCandidates;$j++){
print $votetab[$j * $nCandidates + $i]." ";
}
print "\n";
}
#calculate binary matrix:
for($i=0;$i<$nCandidates;$i++){
for($j=0;$j<$nCandidates;$j++){
$idx = $j*$nCandidates + $i;
$rdx = $i*$nCandidates + $j;
if($votetab[$idx] > $votetab[$rdx]){
$binarymtx[$idx] = 1;
} else {
$binarymtx[$idx] = 0;
}
}
}
#print binary matrix:
print "\nBinary:\n ";
for($i=0;$i<$nCandidates;$i++){
$abrev = $candidates[$i];
$abrev =~ s/=.*//;
print $abrev." ";
}
print "\n";
for($i=0;$i<$nCandidates;$i++){
$abrev = $candidates[$i];
$abrev =~ s/=.*//;
print $abrev." ";
for($j=0;$j<$nCandidates;$j++){
print $binarymtx[$j * $nCandidates + $i]." ";
}
print "\n";
}
#clear rank list:
for($i=0;$i<$nCandidates;$i++){
$rank[$i] = 0;
}
#count binary wins:
for($i=0;$i<$nCandidates;$i++){
for($j=0;$j<$nCandidates;$j++){
$idx = $j*$nCandidates + $i;
if($binarymtx[$idx] == 1) {
$rank[$i]++;
}
}
}
#final ranking:
my @result;
for($i=0;$i<$nCandidates;$i++){
#print $candidates[$i].$rank[$i]."\n";
$name = $candidates[$i];
$name =~ s/^.*=//;
$result[$nCandidates - $rank[$i] - 1] .= $name."=";
#print $rank[$i];
}
#remove trailing '=', so they only apear in ties:
foreach (@result){
s/=$//;
}
#remove leading '>':
my $first = 1;
for($i=0;$i<$nCandidates;$i++){
if($result[$i]){
if(!$first) {
$result[$i] = " > ".$result[$i];
}
$first = 0;
}
}
print "\nranking: ";
print @result;
print "\n"