stv: actual tie breaks

[appendix-a6.git] / stv

diff --git a/stv b/stv
index 03f16d8d0e418d2488e30a4011f1e92b9a6342b0..68940f452683825259efcecc5fdc2fffbb7c3a38 100755 (executable)
--- a/stv
+++ b/stv
@@ -20,6 +20,25 @@ use List::MoreUtils qw(nsort_by);
 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);
 
@@ -134,7 +153,17 @@ sub historically_prefer ($@) {
        $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];
 }