# Does STV according to
# http://www.rosenstiel.co.uk/stvrules/av/index.htm
+# Usage:
+# ./stv [TIEBREAK ...] PLACES [INPUT-FILES ...]
+#
+# PLACES is the number of seats to be filled
+#
+# INPUT-FILES are in the format:
+# VOTER PQRST
+# where P, Q, R, etc. are candidates. Candidates
+# must be single letters.
+#
+# Each TIEBREAK is
+# P,Q,...
+
use strict;
use utf8;
use autodie;
our $stage=0;
our @allvotes;
+our %tiebreak; # $tiebreak{ winningcand }{ losingcand } = 1
+
+while (@ARGV && $ARGV[0] =~ m/[<>]/) {
+ my ($losers, $winners) = ($? eq '<' ? ($`, $') : ($', $`));
+ my @losers = sort split /\,/, $losers;
+ my @winners = sort split /\,/, $winners;
+ die "@losers @winners" if @losers>1 && @winners>1;
+ my @all = sort @losers, @winners;
+ my $record = sub {
+ my ($how, $howers) = @_;
+ return unless @$howers == 1;
+ die "@all $how" if defined $tiebreak{$how}{"@all"};
+ $tiebreak{$how}{"@all"} = $howers->[0];
+ };
+ $record->('winner', \@winners);
+ $record->('loser', \@losers);
+ shift @ARGV;
+}
+
our $places = shift @ARGV;
die unless $places eq ($places + 0);
$numequal++;
}
- die 'random choice unimplemented' if $numequal > 1;
+ if ($numequal > 1) {
+ my $how = $signum > 0 ? 'winner' : 'loser';
+ my @all = sort map { $_->{Cand} } @choices[ 0 .. $numequal-1 ];
+ my $hower = $tiebreak{$how}{"@all"};
+ if (defined $hower) {
+ printf "%7.7s %10s !!!!!!!!!!\n", "TIE".(uc $how), $hower;
+ return grep { $_->{Cand} eq $hower } @choices;
+ }
+ die "need tie break for $how between @all\n";
+ }
+
return $choices[0];
}
push @unsorted, @$votes;
}
+open VL, ">.stv.votes" or die $!;
+foreach my $vote (@allvotes) {
+ print VL "----------------------------------------\n";
+ print VL "voter $vote->{Voter}\n";
+ print VL "prefs ". (join " ", @{ $vote->{Prefs} }). "\n";
+ print VL $_, "\n" foreach @{ $vote->{Log} };
+}
+print VL "========================================\n";
+close VL;
+
print "done.\n";