From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Mon, 1 Aug 2016 17:06:00 +0000 (+0100)
Subject: stv: actual tie breaks
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=commitdiff_plain;h=bf778012959670ef232a8b107ceb508296082465

stv: actual tie breaks
---

diff --git a/stv b/stv
index 03f16d8..68940f4 100755
--- 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];
 }